diff --git a/Demos/Main/1.fr3 b/Demos/Main/1.fr3
new file mode 100644
index 0000000..e47ae09
--- /dev/null
+++ b/Demos/Main/1.fr3
@@ -0,0 +1,28 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/10.FR3 b/Demos/Main/10.FR3
new file mode 100644
index 0000000..d5daf62
--- /dev/null
+++ b/Demos/Main/10.FR3
@@ -0,0 +1,57 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/100.fr3 b/Demos/Main/100.fr3
new file mode 100644
index 0000000..e3975c1
--- /dev/null
+++ b/Demos/Main/100.fr3
@@ -0,0 +1,19 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/101.fr3 b/Demos/Main/101.fr3
new file mode 100644
index 0000000..8970f93
--- /dev/null
+++ b/Demos/Main/101.fr3
@@ -0,0 +1,51 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/102.fr3 b/Demos/Main/102.fr3
new file mode 100644
index 0000000..63404ce
--- /dev/null
+++ b/Demos/Main/102.fr3
@@ -0,0 +1,13 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/103.fr3 b/Demos/Main/103.fr3
new file mode 100644
index 0000000..7aba74f
--- /dev/null
+++ b/Demos/Main/103.fr3
@@ -0,0 +1,8 @@
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/104.fr3 b/Demos/Main/104.fr3
new file mode 100644
index 0000000..2cfd896
--- /dev/null
+++ b/Demos/Main/104.fr3
@@ -0,0 +1,19 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/105.fr3 b/Demos/Main/105.fr3
new file mode 100644
index 0000000..f7ce1c2
--- /dev/null
+++ b/Demos/Main/105.fr3
@@ -0,0 +1,35 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/11.FR3 b/Demos/Main/11.FR3
new file mode 100644
index 0000000..99cfe40
--- /dev/null
+++ b/Demos/Main/11.FR3
@@ -0,0 +1,20 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/12.FR3 b/Demos/Main/12.FR3
new file mode 100644
index 0000000..1c3c784
--- /dev/null
+++ b/Demos/Main/12.FR3
@@ -0,0 +1,28 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/13.fr3 b/Demos/Main/13.fr3
new file mode 100644
index 0000000..406ca2d
--- /dev/null
+++ b/Demos/Main/13.fr3
@@ -0,0 +1,8 @@
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/2.fr3 b/Demos/Main/2.fr3
new file mode 100644
index 0000000..13fec8d
--- /dev/null
+++ b/Demos/Main/2.fr3
@@ -0,0 +1,32 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/21.FR3 b/Demos/Main/21.FR3
new file mode 100644
index 0000000..b4f242c
--- /dev/null
+++ b/Demos/Main/21.FR3
@@ -0,0 +1,11 @@
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/22.FR3 b/Demos/Main/22.FR3
new file mode 100644
index 0000000..2c02662
--- /dev/null
+++ b/Demos/Main/22.FR3
@@ -0,0 +1,51 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/23.FR3 b/Demos/Main/23.FR3
new file mode 100644
index 0000000..6db8851
--- /dev/null
+++ b/Demos/Main/23.FR3
@@ -0,0 +1,6 @@
+
+
+
+
+
+
diff --git a/Demos/Main/24.FR3 b/Demos/Main/24.FR3
new file mode 100644
index 0000000..497997a
--- /dev/null
+++ b/Demos/Main/24.FR3
@@ -0,0 +1,54 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/25.fr3 b/Demos/Main/25.fr3
new file mode 100644
index 0000000..860bcff
--- /dev/null
+++ b/Demos/Main/25.fr3
@@ -0,0 +1,40 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/3.fr3 b/Demos/Main/3.fr3
new file mode 100644
index 0000000..200445e
--- /dev/null
+++ b/Demos/Main/3.fr3
@@ -0,0 +1,55 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/31.fr3 b/Demos/Main/31.fr3
new file mode 100644
index 0000000..43e20bd
--- /dev/null
+++ b/Demos/Main/31.fr3
@@ -0,0 +1,24 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/32.fr3 b/Demos/Main/32.fr3
new file mode 100644
index 0000000..9aded9c
--- /dev/null
+++ b/Demos/Main/32.fr3
@@ -0,0 +1,13 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/33.FR3 b/Demos/Main/33.FR3
new file mode 100644
index 0000000..151d745
--- /dev/null
+++ b/Demos/Main/33.FR3
@@ -0,0 +1,55 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/34.FR3 b/Demos/Main/34.FR3
new file mode 100644
index 0000000..2cf389e
--- /dev/null
+++ b/Demos/Main/34.FR3
@@ -0,0 +1,55 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/35.fr3 b/Demos/Main/35.fr3
new file mode 100644
index 0000000..fa1fe47
--- /dev/null
+++ b/Demos/Main/35.fr3
@@ -0,0 +1,65 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/36.fr3 b/Demos/Main/36.fr3
new file mode 100644
index 0000000..73137f5
--- /dev/null
+++ b/Demos/Main/36.fr3
@@ -0,0 +1,19 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/4.FR3 b/Demos/Main/4.FR3
new file mode 100644
index 0000000..ed9c679
--- /dev/null
+++ b/Demos/Main/4.FR3
@@ -0,0 +1,54 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/41.FR3 b/Demos/Main/41.FR3
new file mode 100644
index 0000000..341d8fe
--- /dev/null
+++ b/Demos/Main/41.FR3
@@ -0,0 +1,11 @@
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/42.FR3 b/Demos/Main/42.FR3
new file mode 100644
index 0000000..fcc981a
--- /dev/null
+++ b/Demos/Main/42.FR3
@@ -0,0 +1,13 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/43.FR3 b/Demos/Main/43.FR3
new file mode 100644
index 0000000..e600a0c
--- /dev/null
+++ b/Demos/Main/43.FR3
@@ -0,0 +1,15 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/5.FR3 b/Demos/Main/5.FR3
new file mode 100644
index 0000000..07c29bb
--- /dev/null
+++ b/Demos/Main/5.FR3
@@ -0,0 +1,14 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/6.FR3 b/Demos/Main/6.FR3
new file mode 100644
index 0000000..8b049bf
--- /dev/null
+++ b/Demos/Main/6.FR3
@@ -0,0 +1,26 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/60.fr3 b/Demos/Main/60.fr3
new file mode 100644
index 0000000..1b25a7c
--- /dev/null
+++ b/Demos/Main/60.fr3
@@ -0,0 +1,10 @@
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/61.FR3 b/Demos/Main/61.FR3
new file mode 100644
index 0000000..770db68
--- /dev/null
+++ b/Demos/Main/61.FR3
@@ -0,0 +1,10 @@
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/62.FR3 b/Demos/Main/62.FR3
new file mode 100644
index 0000000..7fb6cb7
--- /dev/null
+++ b/Demos/Main/62.FR3
@@ -0,0 +1,10 @@
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/63.FR3 b/Demos/Main/63.FR3
new file mode 100644
index 0000000..062df9c
--- /dev/null
+++ b/Demos/Main/63.FR3
@@ -0,0 +1,10 @@
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/64.FR3 b/Demos/Main/64.FR3
new file mode 100644
index 0000000..bb5dff2
--- /dev/null
+++ b/Demos/Main/64.FR3
@@ -0,0 +1,32 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/65.FR3 b/Demos/Main/65.FR3
new file mode 100644
index 0000000..43e5746
--- /dev/null
+++ b/Demos/Main/65.FR3
@@ -0,0 +1,10 @@
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/66.FR3 b/Demos/Main/66.FR3
new file mode 100644
index 0000000..ef4d006
--- /dev/null
+++ b/Demos/Main/66.FR3
@@ -0,0 +1,10 @@
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/67.FR3 b/Demos/Main/67.FR3
new file mode 100644
index 0000000..28ee795
--- /dev/null
+++ b/Demos/Main/67.FR3
@@ -0,0 +1,18 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/68.FR3 b/Demos/Main/68.FR3
new file mode 100644
index 0000000..40b99f0
--- /dev/null
+++ b/Demos/Main/68.FR3
@@ -0,0 +1,10 @@
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/69.FR3 b/Demos/Main/69.FR3
new file mode 100644
index 0000000..fdd8e27
--- /dev/null
+++ b/Demos/Main/69.FR3
@@ -0,0 +1,7 @@
+
+
+
+
+
+
+
diff --git a/Demos/Main/7.FR3 b/Demos/Main/7.FR3
new file mode 100644
index 0000000..717f0bc
--- /dev/null
+++ b/Demos/Main/7.FR3
@@ -0,0 +1,12 @@
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/70.fr3 b/Demos/Main/70.fr3
new file mode 100644
index 0000000..f665600
--- /dev/null
+++ b/Demos/Main/70.fr3
@@ -0,0 +1,21 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/71.fr3 b/Demos/Main/71.fr3
new file mode 100644
index 0000000..9dcec19
--- /dev/null
+++ b/Demos/Main/71.fr3
@@ -0,0 +1,44 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/72.fr3 b/Demos/Main/72.fr3
new file mode 100644
index 0000000..8bca00f
--- /dev/null
+++ b/Demos/Main/72.fr3
@@ -0,0 +1,57 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/73.fr3 b/Demos/Main/73.fr3
new file mode 100644
index 0000000..ae9209e
--- /dev/null
+++ b/Demos/Main/73.fr3
@@ -0,0 +1,10 @@
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/8.FR3 b/Demos/Main/8.FR3
new file mode 100644
index 0000000..a033d7a
--- /dev/null
+++ b/Demos/Main/8.FR3
@@ -0,0 +1,17 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/80.fr3 b/Demos/Main/80.fr3
new file mode 100644
index 0000000..1e8f33a
--- /dev/null
+++ b/Demos/Main/80.fr3
@@ -0,0 +1,24 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/81.fr3 b/Demos/Main/81.fr3
new file mode 100644
index 0000000..751707a
--- /dev/null
+++ b/Demos/Main/81.fr3
@@ -0,0 +1,26 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/82.fr3 b/Demos/Main/82.fr3
new file mode 100644
index 0000000..71b2341
--- /dev/null
+++ b/Demos/Main/82.fr3
@@ -0,0 +1,10 @@
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/9.FR3 b/Demos/Main/9.FR3
new file mode 100644
index 0000000..ba748c3
--- /dev/null
+++ b/Demos/Main/9.FR3
@@ -0,0 +1,17 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/93.fr3 b/Demos/Main/93.fr3
new file mode 100644
index 0000000..b6d090b
--- /dev/null
+++ b/Demos/Main/93.fr3
@@ -0,0 +1,19 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/94.fr3 b/Demos/Main/94.fr3
new file mode 100644
index 0000000..cbb99ac
--- /dev/null
+++ b/Demos/Main/94.fr3
@@ -0,0 +1,18 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/95.fr3 b/Demos/Main/95.fr3
new file mode 100644
index 0000000..0c091f4
--- /dev/null
+++ b/Demos/Main/95.fr3
@@ -0,0 +1,19 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/96.fr3 b/Demos/Main/96.fr3
new file mode 100644
index 0000000..dcdafec
--- /dev/null
+++ b/Demos/Main/96.fr3
@@ -0,0 +1,19 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/97.fr3 b/Demos/Main/97.fr3
new file mode 100644
index 0000000..2119aab
--- /dev/null
+++ b/Demos/Main/97.fr3
@@ -0,0 +1,34 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/98.fr3 b/Demos/Main/98.fr3
new file mode 100644
index 0000000..5617873
--- /dev/null
+++ b/Demos/Main/98.fr3
@@ -0,0 +1,55 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/99.fr3 b/Demos/Main/99.fr3
new file mode 100644
index 0000000..458f26b
--- /dev/null
+++ b/Demos/Main/99.fr3
@@ -0,0 +1,52 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/Demos/Main/Data/biolife.xml b/Demos/Main/Data/biolife.xml
new file mode 100644
index 0000000..ba0304a
--- /dev/null
+++ b/Demos/Main/Data/biolife.xml
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/Demos/Main/Data/country.xml b/Demos/Main/Data/country.xml
new file mode 100644
index 0000000..86224ec
--- /dev/null
+++ b/Demos/Main/Data/country.xml
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/Demos/Main/Data/crosstest.xml b/Demos/Main/Data/crosstest.xml
new file mode 100644
index 0000000..aa54760
--- /dev/null
+++ b/Demos/Main/Data/crosstest.xml
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/Demos/Main/Data/currency_quoting.xml b/Demos/Main/Data/currency_quoting.xml
new file mode 100644
index 0000000..b04c275
--- /dev/null
+++ b/Demos/Main/Data/currency_quoting.xml
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/Demos/Main/Data/customer.xml b/Demos/Main/Data/customer.xml
new file mode 100644
index 0000000..eacfb9f
--- /dev/null
+++ b/Demos/Main/Data/customer.xml
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/Demos/Main/Data/customer_query.xml b/Demos/Main/Data/customer_query.xml
new file mode 100644
index 0000000..c03c78b
--- /dev/null
+++ b/Demos/Main/Data/customer_query.xml
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/Demos/Main/Data/employee.xml b/Demos/Main/Data/employee.xml
new file mode 100644
index 0000000..233020a
--- /dev/null
+++ b/Demos/Main/Data/employee.xml
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/Demos/Main/Data/items.xml b/Demos/Main/Data/items.xml
new file mode 100644
index 0000000..e764f8b
--- /dev/null
+++ b/Demos/Main/Data/items.xml
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/Demos/Main/Data/nextcust.xml b/Demos/Main/Data/nextcust.xml
new file mode 100644
index 0000000..08fdbe4
--- /dev/null
+++ b/Demos/Main/Data/nextcust.xml
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/Demos/Main/Data/nextitem.xml b/Demos/Main/Data/nextitem.xml
new file mode 100644
index 0000000..b809135
--- /dev/null
+++ b/Demos/Main/Data/nextitem.xml
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/Demos/Main/Data/nextord.xml b/Demos/Main/Data/nextord.xml
new file mode 100644
index 0000000..ec8aae1
--- /dev/null
+++ b/Demos/Main/Data/nextord.xml
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/Demos/Main/Data/orders.xml b/Demos/Main/Data/orders.xml
new file mode 100644
index 0000000..1ef206e
--- /dev/null
+++ b/Demos/Main/Data/orders.xml
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/Demos/Main/Data/parts.xml b/Demos/Main/Data/parts.xml
new file mode 100644
index 0000000..cebe67d
--- /dev/null
+++ b/Demos/Main/Data/parts.xml
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/Demos/Main/Data/unicode.xml b/Demos/Main/Data/unicode.xml
new file mode 100644
index 0000000..615b696
--- /dev/null
+++ b/Demos/Main/Data/unicode.xml
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/Demos/Main/Data/vendors.xml b/Demos/Main/Data/vendors.xml
new file mode 100644
index 0000000..9d89de5
--- /dev/null
+++ b/Demos/Main/Data/vendors.xml
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/Demos/Main/Project1.deployproj b/Demos/Main/Project1.deployproj
new file mode 100644
index 0000000..e124f86
--- /dev/null
+++ b/Demos/Main/Project1.deployproj
@@ -0,0 +1,1449 @@
+
+
+
+ 12
+
+
+
+
+
+
+
+
+
+
+
+ Project1\
+ Project1.exe
+ ProjectOutput
+ 0
+
+
+ True
+ True
+
+
+
+
+ Project1\
+ 7.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 35.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 61.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 21.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 65.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 96.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ awards.png
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 3.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 12.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 66.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 67.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 102.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 99.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\Data\
+ nextitem.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 69.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 68.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 94.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\Data\
+ nextcust.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1\Data\
+ items.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1\Data\
+ orders.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1\Data\
+ vendors.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 36.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 41.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 33.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 104.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\Data\
+ customer_query.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 80.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 34.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\Data\
+ currency_quoting.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ Project1
+ ProjectOutput
+ 1
+
+
+ True
+ True
+
+
+ Project1\
+ 9.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 93.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 98.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 2.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 24.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 43.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\Data\
+ biolife.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1\Data\
+ unicode.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 81.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 97.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 73.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 101.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 95.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 100.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 22.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 23.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 31.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 64.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 71.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\Data\
+ crosstest.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 5.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 63.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 70.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\Data\
+ customer.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 82.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 1.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 25.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 72.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 10.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 11.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ libmidas.so.2
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 13.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 60.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\Data\
+ parts.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 32.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 62.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\Data\
+ employee.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1\Data\
+ country.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 42.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 105.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 103.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 4.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 6.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\
+ 8.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1\Data\
+ nextord.xml
+ File
+ 0
+
+
+ True
+
+
+
+
+ Project1.app\Contents\MacOS\
+ 94.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 100.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 25.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 70.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 32.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 82.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 41.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 96.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 73.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 34.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\Data\
+ unicode.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\Data\
+ parts.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 23.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 35.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 80.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 65.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 2.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 98.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 36.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\Data\
+ vendors.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\Data\
+ nextitem.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ libmidas.dylib
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\Data\
+ nextord.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 64.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 21.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\Data\
+ orders.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\Data\
+ items.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\Data\
+ crosstest.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\Data\
+ customer_query.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 72.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 66.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\
+ Info.plist
+ ProjectOSXInfoPList
+ 1
+
+
+ True
+
+
+ Project1.app\..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF\
+ Project1
+ ProjectOSXDebug
+ 1
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 3.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 11.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 13.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 61.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 5.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\..\
+ Project1.entitlements
+ ProjectOSXEntitlements
+ 1
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 67.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 97.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\Data\
+ currency_quoting.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 63.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 71.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ Project1
+ ProjectOutput
+ 1
+
+
+ True
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 101.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\Resources\
+ Project1.icns
+ ProjectOSXResource
+ 1
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 60.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 99.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 12.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 33.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 62.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 95.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 8.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 105.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ awards.png
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 10.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 104.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 24.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 103.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 43.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 7.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ libmidas.dylib
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\Data\
+ biolife.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 22.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 69.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 81.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 42.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 31.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 9.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 93.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\Data\
+ country.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 1.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\Data\
+ employee.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 68.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 4.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 102.fr3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\Data\
+ customer.xml
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\
+ 6.FR3
+ File
+ 0
+
+
+ True
+
+
+ Project1.app\Contents\MacOS\Data\
+ nextcust.xml
+ File
+ 0
+
+
+ True
+
+
+
+
+
+ Project1.app\
+ libcgunwind.1.0.dylib
+ DependencyModule
+ 1
+
+
+ True
+
+
+ Project1.app\
+ libpcre.dylib
+ DependencyModule
+ 1
+
+
+ True
+
+
+
+
diff --git a/Demos/Main/Project1.dpr b/Demos/Main/Project1.dpr
new file mode 100644
index 0000000..b7540a2
--- /dev/null
+++ b/Demos/Main/Project1.dpr
@@ -0,0 +1,17 @@
+program Project1;
+uses
+ FMX.Forms,
+ FMX.Types,
+ Unit2 in 'Unit2.pas' {Form2},
+ Unit3 in 'Unit3.pas' {DataModule3: TDataModule};
+
+{$R *.res}
+
+begin
+
+ GlobalUseDirect2D := False;
+ Application.Initialize;
+ Application.CreateForm(TDataModule3, DataModule3);
+ Application.CreateForm(TForm2, Form2);
+ Application.Run;
+end.
diff --git a/Demos/Main/Project1.dproj b/Demos/Main/Project1.dproj
new file mode 100644
index 0000000..5da5c1b
--- /dev/null
+++ b/Demos/Main/Project1.dproj
@@ -0,0 +1,1536 @@
+
+
+ {C4BF2255-45AC-4C6F-8A35-10B1653A42E5}
+ Project1.dpr
+ True
+ Debug
+ 4225
+ Application
+ FMX
+ 18.7
+ Linux64
+ Ubuntu 18.04 LTS
+ ubuntu18.04.sdk
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Cfg_1
+ true
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Cfg_2
+ true
+ true
+
+
+ true
+ Cfg_2
+ true
+ true
+
+
+ true
+ Cfg_2
+ true
+ true
+
+
+ true
+ Cfg_2
+ true
+ true
+
+
+ true
+ Cfg_2
+ true
+ true
+
+
+ true
+ Cfg_2
+ true
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ Project1
+ 1049
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)
+ $(BDS)\bin\delphi_PROJECTICON.ico
+ $(BDS)\bin\delphi_PROJECTICNS.icns
+
+
+ package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey=
+ Debug
+ true
+ $(BDS)\bin\Artwork\Android\FM_LauncherIcon_36x36.png
+ $(BDS)\bin\Artwork\Android\FM_LauncherIcon_48x48.png
+ $(BDS)\bin\Artwork\Android\FM_LauncherIcon_72x72.png
+ $(BDS)\bin\Artwork\Android\FM_LauncherIcon_96x96.png
+ $(BDS)\bin\Artwork\Android\FM_LauncherIcon_144x144.png
+ $(BDS)\bin\Artwork\Android\FM_SplashImage_426x320.png
+ $(BDS)\bin\Artwork\Android\FM_SplashImage_470x320.png
+ $(BDS)\bin\Artwork\Android\FM_SplashImage_640x480.png
+ $(BDS)\bin\Artwork\Android\FM_SplashImage_960x720.png
+ true
+ true
+ true
+ true
+ true
+ true
+ true
+ true
+ true
+ true
+ $(BDS)\bin\Artwork\Android\FM_NotificationIcon_24x24.png
+ $(BDS)\bin\Artwork\Android\FM_NotificationIcon_36x36.png
+ $(BDS)\bin\Artwork\Android\FM_NotificationIcon_48x48.png
+ $(BDS)\bin\Artwork\Android\FM_NotificationIcon_72x72.png
+ $(BDS)\bin\Artwork\Android\FM_NotificationIcon_96x96.png
+ android-support-v4.dex.jar;cloud-messaging.dex.jar;com-google-android-gms.play-services-ads-base.17.2.0.dex.jar;com-google-android-gms.play-services-ads-identifier.16.0.0.dex.jar;com-google-android-gms.play-services-ads-lite.17.2.0.dex.jar;com-google-android-gms.play-services-ads.17.2.0.dex.jar;com-google-android-gms.play-services-analytics-impl.16.0.8.dex.jar;com-google-android-gms.play-services-analytics.16.0.8.dex.jar;com-google-android-gms.play-services-base.16.0.1.dex.jar;com-google-android-gms.play-services-basement.16.2.0.dex.jar;com-google-android-gms.play-services-gass.17.2.0.dex.jar;com-google-android-gms.play-services-identity.16.0.0.dex.jar;com-google-android-gms.play-services-maps.16.1.0.dex.jar;com-google-android-gms.play-services-measurement-base.16.4.0.dex.jar;com-google-android-gms.play-services-measurement-sdk-api.16.4.0.dex.jar;com-google-android-gms.play-services-stats.16.0.1.dex.jar;com-google-android-gms.play-services-tagmanager-v4-impl.16.0.8.dex.jar;com-google-android-gms.play-services-tasks.16.0.1.dex.jar;com-google-android-gms.play-services-wallet.16.0.1.dex.jar;com-google-firebase.firebase-analytics.16.4.0.dex.jar;com-google-firebase.firebase-common.16.1.0.dex.jar;com-google-firebase.firebase-iid-interop.16.0.1.dex.jar;com-google-firebase.firebase-iid.17.1.1.dex.jar;com-google-firebase.firebase-measurement-connector.17.0.1.dex.jar;com-google-firebase.firebase-messaging.17.5.0.dex.jar;fmx.dex.jar;google-play-billing.dex.jar;google-play-licensing.dex.jar
+
+
+ CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0;CFBundleShortVersionString=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;CFBundleResourceSpecification=ResourceRules.plist;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;NSLocationAlwaysAndWhenInUseUsageDescription=The reason for accessing the location information of the user;FMLocalNotificationPermission=false;UIBackgroundModes=;NSContactsUsageDescription=The reason for accessing the contacts;NSPhotoLibraryUsageDescription=The reason for accessing the photo library;NSPhotoLibraryAddUsageDescription=The reason for adding to the photo library;NSCameraUsageDescription=The reason for accessing the camera;NSFaceIDUsageDescription=The reason for accessing the face id;NSMicrophoneUsageDescription=The reason for accessing the microphone;NSSiriUsageDescription=The reason for accessing Siri;ITSAppUsesNonExemptEncryption=false
+ iPhoneAndiPad
+ true
+ Debug
+ $(MSBuildProjectName)
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_60x60.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_120x120.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_40x40.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_80x80.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_40x40.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_80x80.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_76x76.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_152x152.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_768x1024.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_1024x768.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1536x2048.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2048x1536.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_87x87.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_180x180.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_750x1334.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1242x2208.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_2208x1242.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1125x2436.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_2436x1125.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_120x120.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_828x1792.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1136x640.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1242x2688.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1334x750.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1792x828.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_2688x1242.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_167x167.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1668x2224.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1668x2388.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_2048x2732.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2224x1668.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2388x1668.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2732x2048.png
+
+
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_87x87.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_180x180.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_750x1334.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1242x2208.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_2208x1242.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1125x2436.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_2436x1125.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_120x120.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_828x1792.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1136x640.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1242x2688.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1334x750.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1792x828.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_2688x1242.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_167x167.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1668x2224.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1668x2388.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_2048x2732.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2224x1668.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2388x1668.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2732x2048.png
+
+
+ CFBundleName=$(MSBuildProjectName);CFBundleDevelopmentRegion=en;CFBundleDisplayName=$(MSBuildProjectName);CFBundleIdentifier=$(MSBuildProjectName);CFBundleInfoDictionaryVersion=7.1;CFBundleVersion=1.0.0;CFBundleShortVersionString=1.0.0;CFBundlePackageType=APPL;CFBundleSignature=????;LSRequiresIPhoneOS=true;CFBundleAllowMixedLocalizations=YES;CFBundleExecutable=$(MSBuildProjectName);UIDeviceFamily=iPhone & iPad;CFBundleResourceSpecification=ResourceRules.plist;NSLocationAlwaysUsageDescription=The reason for accessing the location information of the user;NSLocationWhenInUseUsageDescription=The reason for accessing the location information of the user;NSLocationAlwaysAndWhenInUseUsageDescription=The reason for accessing the location information of the user;FMLocalNotificationPermission=false;UIBackgroundModes=;NSContactsUsageDescription=The reason for accessing the contacts;NSPhotoLibraryUsageDescription=The reason for accessing the photo library;NSPhotoLibraryAddUsageDescription=The reason for adding to the photo library;NSCameraUsageDescription=The reason for accessing the camera;NSFaceIDUsageDescription=The reason for accessing the face id;NSMicrophoneUsageDescription=The reason for accessing the microphone;NSSiriUsageDescription=The reason for accessing Siri;ITSAppUsesNonExemptEncryption=false
+ iPhoneAndiPad
+ true
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_60x60.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_120x120.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_40x40.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_80x80.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_40x40.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_SpotlightSearchIcon_80x80.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_76x76.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_152x152.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_768x1024.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_1024x768.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1536x2048.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2048x1536.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_87x87.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_ApplicationIcon_180x180.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_750x1334.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1242x2208.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_2208x1242.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1125x2436.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_2436x1125.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_SpotlightSearchIcon_120x120.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_828x1792.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1136x640.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1242x2688.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1334x750.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_1792x828.png
+ $(BDS)\bin\Artwork\iOS\iPhone\FM_LaunchImage_2688x1242.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_ApplicationIcon_167x167.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1668x2224.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_1668x2388.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImagePortrait_2048x2732.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2224x1668.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2388x1668.png
+ $(BDS)\bin\Artwork\iOS\iPad\FM_LaunchImageLandscape_2732x2048.png
+
+
+ $(BDS)\bin\delphi_PROJECTICNS.icns
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+ $(BDS)\bin\default_app.manifest
+ true
+ $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png
+ $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png
+
+
+ $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_44.png
+ $(BDS)\bin\Artwork\Windows\UWP\delphi_UwpDefault_150.png
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ true
+ PerMonitorV2
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+
+
+ true
+
+
+ Debug
+
+
+ true
+
+
+ $(BDS)\bin\delphi_PROJECTICNS.icns
+
+
+ Debug
+
+
+ true
+ PerMonitorV2
+
+
+
+ MainSource
+
+
+
+
+
+
+ TDataModule
+
+
+ Cfg_2
+ Base
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+
+ Delphi.Personality.12
+
+
+
+
+ Project1.dpr
+
+
+
+ False
+ False
+ False
+ False
+ True
+ False
+ True
+ True
+ False
+
+
+
+
+ 73.fr3
+ true
+
+
+
+
+ 101.fr3
+ true
+
+
+
+
+ 7.FR3
+ true
+
+
+
+
+ 95.fr3
+ true
+
+
+
+
+ 100.fr3
+ true
+
+
+
+
+ 35.fr3
+ true
+
+
+
+
+ 22.FR3
+ true
+
+
+
+
+ 31.fr3
+ true
+
+
+
+
+ 61.FR3
+ true
+
+
+
+
+ 64.FR3
+ true
+
+
+
+
+ 71.fr3
+ true
+
+
+
+
+ 23.FR3
+ true
+
+
+
+
+ .\Data\
+ crosstest.xml
+ true
+
+
+
+
+ 21.FR3
+ true
+
+
+
+
+ 65.FR3
+ true
+
+
+
+
+ 5.FR3
+ true
+
+
+
+
+ 96.fr3
+ true
+
+
+
+
+ awards.png
+ true
+
+
+
+
+ 3.fr3
+ true
+
+
+
+
+ 63.FR3
+ true
+
+
+
+
+ 12.FR3
+ true
+
+
+
+
+ 66.FR3
+ true
+
+
+
+
+ 67.FR3
+ true
+
+
+
+
+ 102.fr3
+ true
+
+
+
+
+ 99.fr3
+ true
+
+
+
+
+ .\Data\
+ nextitem.xml
+ true
+
+
+
+
+ 69.FR3
+ true
+
+
+
+
+ 70.fr3
+ true
+
+
+
+
+ 68.FR3
+ true
+
+
+
+
+ true
+
+
+
+
+ .\Data\
+ customer.xml
+ true
+
+
+
+
+ 94.fr3
+ true
+
+
+
+
+ .\Data\
+ nextcust.xml
+ true
+
+
+
+
+ 82.fr3
+ true
+
+
+
+
+ true
+
+
+
+
+ 1.fr3
+ true
+
+
+
+
+ .\Data\
+ items.xml
+ true
+
+
+
+
+ 25.fr3
+ true
+
+
+
+
+ 72.fr3
+ true
+
+
+
+
+ .\Data\
+ orders.xml
+ true
+
+
+
+
+ 36.fr3
+ true
+
+
+
+
+ .\Data\
+ vendors.xml
+ true
+
+
+
+
+ 41.FR3
+ true
+
+
+
+
+ 11.FR3
+ true
+
+
+
+
+ 10.FR3
+ true
+
+
+
+
+ libmidas.so.2
+ true
+
+
+
+
+ 13.fr3
+ true
+
+
+
+
+ 60.fr3
+ true
+
+
+
+
+ 33.FR3
+ true
+
+
+
+
+ .\Data\
+ parts.xml
+ true
+
+
+
+
+ 32.fr3
+ true
+
+
+
+
+ 104.fr3
+ true
+
+
+
+
+ 62.FR3
+ true
+
+
+
+
+ .\Data\
+ employee.xml
+ true
+
+
+
+
+ .\Data\
+ country.xml
+ true
+
+
+
+
+ 42.FR3
+ true
+
+
+
+
+ .\Data\
+ customer_query.xml
+ true
+
+
+
+
+ 80.fr3
+ true
+
+
+
+
+ 105.fr3
+ true
+
+
+
+
+ 34.FR3
+ true
+
+
+
+
+ 103.fr3
+ true
+
+
+
+
+ 4.FR3
+ true
+
+
+
+
+ .\Data\
+ currency_quoting.xml
+ true
+
+
+
+
+ true
+
+
+
+
+ Project1
+ true
+
+
+
+
+ 6.FR3
+ true
+
+
+
+
+ 9.FR3
+ true
+
+
+
+
+ 2.fr3
+ true
+
+
+
+
+ 93.fr3
+ true
+
+
+
+
+ 98.fr3
+ true
+
+
+
+
+ 24.FR3
+ true
+
+
+
+
+ Project1.exe
+ true
+
+
+
+
+ 8.FR3
+ true
+
+
+
+
+ 43.FR3
+ true
+
+
+
+
+ .\Data\
+ nextord.xml
+ true
+
+
+
+
+ .\Data\
+ biolife.xml
+ true
+
+
+
+
+ .\Data\
+ unicode.xml
+ true
+
+
+
+
+ 81.fr3
+ true
+
+
+
+
+ 97.fr3
+ true
+
+
+
+
+ 1
+
+
+ Contents\MacOS
+ 1
+
+
+ 0
+
+
+
+
+ classes
+ 1
+
+
+
+
+ res\xml
+ 1
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+
+
+ library\lib\armeabi
+ 1
+
+
+
+
+ library\lib\mips
+ 1
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+
+
+ res\drawable
+ 1
+
+
+
+
+ res\values
+ 1
+
+
+
+
+ res\values-v21
+ 1
+
+
+
+
+ res\values
+ 1
+
+
+
+
+ res\drawable
+ 1
+
+
+
+
+ res\drawable-xxhdpi
+ 1
+
+
+
+
+ res\drawable-ldpi
+ 1
+
+
+
+
+ res\drawable-mdpi
+ 1
+
+
+
+
+ res\drawable-hdpi
+ 1
+
+
+
+
+ res\drawable-xhdpi
+ 1
+
+
+
+
+ res\drawable-mdpi
+ 1
+
+
+
+
+ res\drawable-hdpi
+ 1
+
+
+
+
+ res\drawable-xhdpi
+ 1
+
+
+
+
+ res\drawable-xxhdpi
+ 1
+
+
+
+
+ res\drawable-xxxhdpi
+ 1
+
+
+
+
+ res\drawable-small
+ 1
+
+
+
+
+ res\drawable-normal
+ 1
+
+
+
+
+ res\drawable-large
+ 1
+
+
+
+
+ res\drawable-xlarge
+ 1
+
+
+
+
+ res\values
+ 1
+
+
+
+
+ 1
+
+
+ Contents\MacOS
+ 1
+
+
+ 0
+
+
+
+
+ Contents\MacOS
+ 1
+ .framework
+
+
+ Contents\MacOS
+ 1
+ .framework
+
+
+ 0
+
+
+
+
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+ Contents\MacOS
+ 1
+ .dylib
+
+
+ Contents\MacOS
+ 1
+ .dylib
+
+
+ 0
+ .dll;.bpl
+
+
+
+
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+ 1
+ .dylib
+
+
+ Contents\MacOS
+ 1
+ .dylib
+
+
+ Contents\MacOS
+ 1
+ .dylib
+
+
+ 0
+ .bpl
+
+
+
+
+ 0
+
+
+ 0
+
+
+ 0
+
+
+ 0
+
+
+ Contents\Resources\StartUp\
+ 0
+
+
+ Contents\Resources\StartUp\
+ 0
+
+
+ 0
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
+ 1
+
+
+ ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+
+
+ ..\
+ 1
+
+
+ ..\
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+
+
+ ..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF
+ 1
+
+
+
+
+ ..\
+ 1
+
+
+ ..\
+ 1
+
+
+
+
+ Contents
+ 1
+
+
+ Contents
+ 1
+
+
+
+
+ Contents\Resources
+ 1
+
+
+ Contents\Resources
+ 1
+
+
+
+
+ library\lib\armeabi-v7a
+ 1
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+ 1
+
+
+ Contents\MacOS
+ 1
+
+
+ Contents\MacOS
+ 1
+
+
+ 0
+
+
+
+
+ 1
+
+
+ 1
+
+
+
+
+ Assets
+ 1
+
+
+ Assets
+ 1
+
+
+
+
+ Assets
+ 1
+
+
+ Assets
+ 1
+
+
+
+
+
+
+
+
+
+
+
+
+
+ 12
+
+
+
+
+
diff --git a/Demos/Main/Project1.res b/Demos/Main/Project1.res
new file mode 100644
index 0000000..36f26e2
Binary files /dev/null and b/Demos/Main/Project1.res differ
diff --git a/Demos/Main/Unit2.fmx b/Demos/Main/Unit2.fmx
new file mode 100644
index 0000000..d731256
--- /dev/null
+++ b/Demos/Main/Unit2.fmx
@@ -0,0 +1,735 @@
+object Form2: TForm2
+ Tag = 42
+ Left = 0
+ Top = 0
+ BorderStyle = bsSingle
+ Caption = 'FastReport for Firemonkey'
+ ClientHeight = 561
+ ClientWidth = 567
+ OnCreate = FormCreate
+ object ToolBar1: TToolBar
+ Align = alMostTop
+ Height = 67.000000000000000000
+ Width = 567.000000000000000000
+ object Image1: TImage
+ Bitmap.PNG = {
+ 89504E470D0A1A0A0000000D4948445200000040000000400806000000AA6971
+ DE000013E249444154785EE55B7950D675B767154410455C90555476D9641511
+ 01C17D4DC50541710BCD5D7349DC454184877D5F15DCC8356DBDDD32D3D79A6E
+ B7A96E534DDDA6E9BE4DF76D6A6A7AFFFEDCF3F9C2030F28CFEFC19CE91D6F33
+ 6734447CCEE77BBEE77CCEE79CAFB9999919C4FE5FFF4700909090A06CCA9429
+ 5D161F1F0FBD4D9E3C197A8B8B8B83B2499330A9D3626363418B898951161D1D
+ DD65515151A04546462A8B8888503671E2444C0C0F47B858585898B2D0D05065
+ 212121CA828383954D983001414141CA0203039505040420C0DF1FFE627E7E7E
+ CA7C7D7DE1EBE3031FB1F1E3C72B1B376E1CC68D1D8BB162DEDEDECA3A0F5E1D
+ 7E97F3393939A01D3C78102FBDF492B203070E60FFFEFDCAF6EDDB87BD7BF7E2
+ C5175FC49E3D7B94EDDEBD1BBB76EDC2CE9D3BB163C70E6CDFBE1DDBB66DC3D6
+ AD5B956DD9B2052FBCF002366FDE8C4D9B36213B3B1BCF3FFF3C366EDC880DEB
+ D763DDBA7558BB762DB2B2B2B066CD1AAC5EBD1A999999C8C8C8C0AA55AB909E
+ 9E8E952B5660F9F2E558B66C19D2D2D2B074E9522C59B2048B9F7B0E8B162DC2
+ C2850BB160C102CC9F3F1FF3E6CEC59C3973307BF66CCC9A350B3367CEC48CE9
+ D3919A9A8A9494144C9B360D63C68C819797971E840E00F4CEBFF1C61BA0BDFE
+ FAEB78EDB5D770E7CE1DDCBE7D1BAFBCF20A6EDDBA859B376FE2FAF5EBB876ED
+ 1AAE5EBD8A975F7E1957AE5CC1E5CB9771E9D2255CB870016D6D6D683DDF8A73
+ E7CEA1A5A5054D4D4D686C6C447D7D3DEAEAEA50535383EAAA2A545656A2BCBC
+ 1C656565282929814EA743515111CE9E3D8B3367CE203F3F1FA74F9F466E6E2E
+ 4E9E3881E3C78FE3E8D1A3387CF8300E751E140F8807A30EA5F33078103C0405
+ 3E81CFDEA440DFB06103929392919898D81300863D0178F3CD3795F3FFFCE73F
+ F1C71F7FE0F7DF7FC76FBFFD865F7FFD15BFFCF20B7EFEF967FCE37FFF819F7E
+ FA093FFEF823FEFE3F7FC70F3FFC80EFBFFF1EDF7DF71DBEFDF65B7CF3CD37F8
+ FAEBAFF1E5975FE28B2FBEC0E79F7F8E4F3FFD149F7CF2093EFEF8637CF4D147
+ F8F0C30FF1F0E1433CB87F1FF7EEDDC3DDBB77F1CE3BEFE0EDB7DFC65BF21908
+ FEABAFBEAA80BFD50938C16E17A0F520B79E3FDF052E81ADADAD55A056545428
+ 408B8B8B3BC02C28E800F2D429156D8CB4A953A7C2D3D3B33B020800C3FE5976
+ FEE4C993387EEC38D6C81563C4F709C0B378F27AE78F1C3982CC8C4C95E43D3C
+ 3C7A4600131E43EF590B7B43E70F1D3AA4126BBC54347777F76E0058EA080093
+ DEB374E77B3B7F507C5CB972A52AE18F00C06CFA9A249E6725E13DCE79967296
+ 5372173737B79E11400098799F856CDF97F37BA554924790B0B9B91A00408647
+ 7458F3B54ADD7F4BA9FBFAABAF5579FBECB3CFE4D7FF7ABAA5AEBDBD83535CBC
+ A8F804B9047984A9A5CE98F3246D4B8540C544C7C0D5D5B53B020800C904EBAE
+ 569DFFEACBAF70FFFD0758B16C0D621366C03F3C0EE38327C12B301A1EFE9170
+ F7FB73E6217F7FB8BB1F46B98D836E6636DA845091449952E7B59CDFB9632716
+ 2F5EAC68F9E8D1A30D0090A4B04F282ED99E16C9F9F83FFE13AB3336C2D36B3C
+ 06DA39C0CA7A002C2C2C61666E6EC8AFFFDCEFE567595BDB2036663A6ED5B6A3
+ B9A959484EB55192638AF36487A4CEEC477A00C0AC488E4FD6A5C5F01EFCED21
+ 52662E8483A313CC2D2CFE9CA31D9DE863CDDCDC022EC35D51B3E3145A1A9A50
+ 6984E199EA3CA9F142E919D888B9B8B8744700012097BE71E38626BDBDFFE06F
+ 989A3A1776F68E4FF7D47B01C1A87273F144F5CEE368AA6B40791FF4B63FCE6F
+ 96668C0D13BB5097510600B02CB0B36393A3C5EDDFBFFF000929730480C182A0
+ 76D89BCBF7585A5829A353E6468C7F6E25DF676B650BA7C1CE488E9F89D6AA66
+ D4D7D6A966A937B7EFAFF36C88E64AB7C8F67BD4A851DD1140009821D9E16935
+ 36EFDD7B5F0130709036007428306C0A0A8266A33166291AA297A0294A2C2015
+ CDBDAC31603E1AC46A03E7A12C2805C5D1F3D05ED18CA6DA0609FF4A144BA758
+ D8D925B2437C12E7D97EB355A6EE3072E4C86E005817D9D3B3B5D5EAEAEEBD7F
+ 1F714933616B67AF71FFCDE1347C344E6D9726EBCA75BC7EE755DC91247BE3FA
+ 0DF5EFB0D4B17536ECEA1A1B1AD020C65F5BEA1B70BEA21A0D053A541514A1EA
+ AC98AE0465BA629CC9CBC709698DC9ED496FC9F058C659E77990CCF6FA769861
+ AF5A61719EBAC36CD10828B83C0A80081AED5283B55ADA079203A2E25330C0D6
+ CE2800169696080B8FC7AD76713EAF022D113351EB14885AC700D43AF8A17690
+ EFE3CD5EFE6CB03F6A9C8250352C001523C351E51E83E6E839B8BE250737734B
+ 509E9B8793478FF5DB790A2E1448A8348D1831A2670450D1A1B0A1D5CF3FFCE0
+ 0384444F85D5001BA300585A5921227C325EB92AE249C64E543887A0D8CC456C
+ 1474261ABF57FD1D0B7794D878A3D22918B5DE71684C5D86B3874418399863F2
+ C9D3F94C519966CC98A124B61E0050C3A38A42B1414BCC78F8F00304454C81A5
+ D5000D00AC112500DCBCFC32AEA56D4599FD78931DEF1B2001C3D20D2583C6A3
+ C2230A270F1FC17E21705A61AF779EF2DA7491C6A82F0E1F3EBC3B020800B5BC
+ 8B423FB5941C5E814093001880293129B871E52A6E67E7A07A7838CAAC3D512A
+ 0E949A8F96937515F356562ABFE7D7D4D7CD5D34812A327343E18031A81F1329
+ 5170504961DB3B25B0DE77DED0F915A22D52179C20C26A0F00A8E03269907B6B
+ C958F7A40A04456A47007340F084685CBFF232DEAE388F8BD3B3702176312EC5
+ A5E1F2A434B44F598BEBD33729BB363D1BD76667E36A4A16CE0724A1C4DACD24
+ 107403C7A12D6B17725EDC8BAD4272B49C5F268D1045512ACBC39D9DBB238000
+ 50C16D6D6DD56C6CEEDE7DCFA42B408E3074C8701C9BBF168DA5D5385FD380CB
+ 6D2298B6B6A1B9596ABBE8781DE268B5B21AB15AB186CA6A5C885F009D95A736
+ 08969EA81A3F19B92F1EC00E89E06C836CDFFBE4E93C95E4E4A42425A93B1B02
+ C0E68034919D979680F9EEBB77112077DBD2CA5A93065B0A557612104242E210
+ 169988E08909080A9F82A0D029F00D884660A8FC3F2D2C01C1C217326665E246
+ 590BEAA5DCE90679A3D0CCDD2808459220CB24B9D6AFDF8D97B6EF52523B4B5D
+ 5FCE3F27323A15E14099273C0200B57B4AD8DAEAEDBBF00D8D8385A59526008A
+ E74B63C3EFA599CBB550FD031BA72EB3505FB792E6C7CDC9050533D6A23AEF2C
+ 748E3E028076C528B597723A63050E6EDE86F552EB8D39CF3E808A30072ACEC3
+ 86755F0176471C5CB0EFD696AEFF1D3EA1934C07C048C3D3BB11721EE880DCE4
+ 7454E6E64337C4CF24004AACBD501D94883DD99BB156246F963A667B263C7DD8
+ F3E4E9FCFC79F3902082282749C37A03C0A90DFB6E4DDDFEADB7E017D68F08E8
+ 0700C30580D3720DCA4F9C469163A000E0AA99074AACDC503936063B3766ABA9
+ 9231E74983A97F7284D60300B6871C593131690D2D289C064E8C372907F4D5EA
+ F6F57502909B9486D263B9D00D66046897C412298735C1D3B063C3F3C810C5B7
+ AF93A7F31C954D96CED74FE687C39C9CBAAF0001205FE6D84A6B6273FBF69D4E
+ 008C1321E3CEEBBBC88E5CC0BCC0A4EA32C419A79357A2F8B80060CF1CE0A111
+ 0192041DFCD1342753226013D245F17D5CD8EB9DE78C908D9FAF8F2F9C0C0160
+ 7FCC0CCAB2A435AEA26A646A152008E6E2A0BD5402A751EE70161BE1EA85116E
+ 6331D27D1C467AF8C0C5D317AE5EBEF0F0F693FB390BAD27CA512C5C5F673706
+ 455A57C0DC0DE5238351BF4188D0FAE795E2CB526778E70D9D4F1512142BA48F
+ 93E34700E0E0B0BABA5A7B562703525F1393204FF6A4DF1CD40AB035D56252E7
+ ABA4B5AD2CAF1081A31CA525A528299692572843D18242E8C4CACE14E25AD63E
+ E86C4C0040FA83DA094938B86133D665AE51536363CE272727AB913D47E63D00
+ A040C012C269ADD6A0F2C68D9BF00931AD0A04452429C7EBAB6AF07A411DDEC8
+ 975FF3ABF196AE11EF56B5E1BDFA76BC5B7309FF567E1E6F9634E2D59365B830
+ 7D85F40D3E4289471BE700961E281936010D593BB0356B3DD24C709E1C204A2A
+ DE78D917183A7468770E20009C9C72B2AA39A515D1C4A40890D0CF4AC91000AA
+ D19E9E8DDAA024D40BCD6D084C46BD7F126AC7C6A3DA33163563E250EB93803A
+ DF4454BB47A3549C2FB230E6BC2446AB315226035197BC1C7BD66EC49AF4559A
+ 274FE7391465BEE3C20401E0F5540B125448C8A0A8BB698DA82F5FBE027F5506
+ 8D33418A9ACBA6A52B7A7B69C13A548E0C418970F7629BB1D0597B4367E9258E
+ D23CBB7F3567D23392F9E5CEF36794B946A1227129B6676DC0CAE52BD4A284BE
+ CEF7BEF30C7BBDF3F193E3951EC84D914700E0DCBCB4B454633EDF8EB60B1725
+ 09C6699641DEFF9504A0A20A171767CB69C7A0DCD10F65D2CAB2B72FB624CDE5
+ 49D361BDF5CDFC4AACDD51EE1C880AB9F395CBB3B13B6B235629E7179BEC3C57
+ 7AC2E5B0C77AF70280121129248547ADE58456696618015ABD00C5CF15492B51
+ 595A8EF65D47D13C75319A2267A1313445C27F12CA1C7D250A3CB4333D4511C9
+ 074D63E2D1BC6A0B8E6465E385D56B91B1321D4B64C8B170C142C5F0B44E9ECE
+ B302D057EE08F588000580B0286E55686D669C97498D7FD8241300B04072CC4C
+ E88A74A83CABC3A5C3F9B8BCE7182E6DCF41DBBA9DA88B988162213B45D2D1B1
+ BF37AA1259B8A16DD212E46DD886ED72E75748B9E38487BB41FD713E5A9ABE10
+ 5183BC654788005874CC35CC9446461A49D9D9E85A8AB4CB2D2DE74C03407200
+ 01E0AE4FDEA9D3D0E517A02CFF2C4A4FE5A3E8C8099CDD7710755173D0129882
+ 420B6DC253623B1E8D89CBB14D32FE8AB4654FE47CA42440AA415C927A04006E
+ 661516161ADDC93927DD62434363670E30CE049904D384D5E59DCE538B4D4744
+ BE3A7CE8307244C139B05F36CF44C43820D3A87DA2E4B6FA4FD56E7C2401164B
+ 026C929FB93E63359E5BB8C8E4B0E7C9D379AEE4050506A905A94700E05A1AB7
+ B3381C31B6905423438AA0899355FB6A8CEE1280D52999C83D99DB4BBDDDDBA1
+ E189084B196BEB96AD6A8DAED92D422241E32A502E1BE08D7309CBB17C699A02
+ 40ADC009C3EB9DEDF577DED0F930B9EA6C85B91FD40300AAA404A04036AA8C39
+ 4FCDBE4A884D70643C06D80C340E80DCAF8589696AB5CD24DD5E9868B35BBCCA
+ 07C67282D203256FB4C5CA7EA0B4B804605AAF52D797F3BCFFFED209723F68C8
+ 9021DD398000707786EB64C656D1EA6415AD4A24ABC9712918EC4022D1F77094
+ 53A1900971387AE468BFA46B150966A4C17D478302C9C205CDC189583C7F0152
+ A7A560AA901CB6BAC69CA718CA4D52AEC7F4008089817D745E5E9EF13D3C6175
+ D552D70FA66F41A0A70F1CEC87C0DAC60E96D6B6A2EA50F1B1EE9CFD59C16680
+ 1DB6FA24E358CE61932636864A4EBD73B8666560A758288CB0D83302CBE7CC43
+ 4A62926A7559EA7A873D4F9ECE530AF3913E80EB318E8E8EDD114000B83C744A
+ 96097B8FAB7A6F66A84646C655BBE66722363A117EA1B1181B140D4F598EE072
+ 031724B828E1273AE0C99D393822D9BE3FBABDBE9F6F76099353264F3096175C
+ 5038D01385A1D3903E67011213A6AA66479FF078E70D9DF7F7F3979DE171701D
+ ED0AC7C183BB01A04CCC7F980347AD0D4C92A512A9ED4567649D358FEBAC6232
+ ABE33AEBB163C73AD658655E7728E710720EE4E0A57DFB8DCEEA8C69780DCEB1
+ DAD5411865A94B280A1665615EEA0CD5EC30DB3FCE79863F49D068D90D18DC1B
+ 002E223361E9777B8DEFE488F3FA3D5E6E603EE1A0524BC024C969183AC13808
+ 2C8F3273CC9FB90CB3935314D7EFCB79B6C12C811C8D3B383874470075726E4F
+ B15E3FCD852463535A539CD7D3DB16B738B90A231E658B52160BA54738EB1A8C
+ B929A9B2FC146DD479AECC7B4A05E05CD07ED0A0EE6E90B5914A0A43F7696D63
+ 3D2DE7F5ABEEF58C04039E502C2D7391AD278AA59DE6C9C708D96157DBFBCE33
+ ECD59B01BE151006E82E099053213B3BBB6E0028135349E1C2F4D3DAC6EA6B3E
+ DF9F93D7931CD6798EB46A46468816E08512DBB1281BE68FD2D8F95890324392
+ B19CBC09CE7B797A49021CAD04D18103BB788C999289D95870C9406BE5FC4937
+ 33B426365AFDFC54C9F0D385F1D544CE4739FB87059958953A1B936362558BAB
+ 75F2749E04C845EEFF502141B6B6B6DD8A1001E0F21017A58CEDDBFF55CE53C9
+ A1984163BD9F9B321D739353911037599C0F37D97986FF48B9FF2C813603BA7A
+ 1933C58EF8D464B7ACC9F4F5D8E0AF76BE8BE149B8B3D4454C8C3039EC79F274
+ 9EF59FF79F156080210094899971B924F1B89716FF32CE1B7475C64A9D3EE1E9
+ C35EEF3CEB3FEFFF20A900D6D65D929E99CA929C9A6C9311F9D35845D32F243D
+ 49C233B5AB33F5CE1B3A3F4A36C3D805B20258CB0A8FFEC9A00280CB436C4B0D
+ DFD83C4B274FE759FF87480F602715C0CA1000CAC42C391C90EA1F183D8BCEF3
+ FE33010EB4ED0D809004BEABE37C90AFAB9E55E7391166026409B4949D84AE2B
+ 409D9CCB431C8F7140C2D7554FB284F8AF78E719F63C79BDF3F6F6F6B0B1B1E9
+ 09003B24322D3E2A542F3857CB4E1D5F6FEA5F6E4AABAC7FB9A97FB549E6B8A8
+ F3C5E63C695AE676BED6347CA9D9F1339390285B19AA9653B0909E7D52E7135B
+ AEE6A827B49DDD1B851976A6A4E6E426EAF9AB5C4FF5E4B5F3B527B93C050DF6
+ F46475DCFA6673C3FA3E4256DFB8FA42679D863A29C2C33BCFB0E7C9EB9DB791
+ 1DC71E114000A8947282C21512FD1B627E603EA6501F9ABA7AE7078F8EEAA8C5
+ ECBB23A4FBD2BFFDD5BFF9357CEBAB7FE34B298A7C43FFA6977987038A2EC744
+ A7F3789C639DC98B6B6D7AE758CA9C249B2B07C5286EB0BDA5930E72C2F683EC
+ 55A963B667C2E39D67D8F3E4F5CE737FA9EB0AF0376C1369140C698A3CC807D2
+ A3AD10976726343E36604DD5A3AF4E403E288D21A7C24E3EB0FE43731F479D0A
+ 3FB8184B118D1F5E9D50A7037A277852343AD1E5883843FEAE4C9CA1435D4E89
+ 632436CAE401076BBC32C9F4CCF6349E789719BE73E81C109AB6F0D48F7597FE
+ 6E87FC55DFFF7F099F2797677AC83B0000000049454E44AE426082}
+ Height = 50.000000000000000000
+ Position.X = 8.000000000000000000
+ Position.Y = 8.000000000000000000
+ Width = 50.000000000000000000
+ end
+ object Lb1: TLabel
+ Font.Family = 'Tahoma'
+ Font.Size = 14.000000000000000000
+ Font.Style = [fsBold]
+ Height = 25.000000000000000000
+ Position.X = 64.000000000000000000
+ Position.Y = 13.000000000000000000
+ Text = 'FastReport for FireMonkey'
+ Width = 209.000000000000000000
+ end
+ object Label6: TLabel
+ Cursor = crHandPoint
+ Font.Family = 'Arial'
+ Font.Style = [fsItalic]
+ Height = 15.000000000000000000
+ HitTest = True
+ Position.X = 64.000000000000000000
+ Position.Y = 37.000000000000000000
+ StyleLookup = 'Label6Style1'
+ Text = 'www.fast-report.com'
+ Width = 129.000000000000000000
+ OnClick = Label6Click
+ end
+ end
+ object TreeView1: TTreeView
+ Align = alLeft
+ Height = 494.000000000000000000
+ Position.Y = 67.000000000000000000
+ UseSmallScrollBars = True
+ Width = 217.000000000000000000
+ OnChange = TreeView1Change
+ object TreeViewItem1: TTreeViewItem
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Text = 'Basic reports'
+ Width = 213.000000000000000000
+ object TreeViewItem6: TTreeViewItem
+ Tag = 1
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 95.000000000000000000
+ Text = 'Simple list'
+ Width = 175.000000000000000000
+ end
+ object TreeViewItem5: TTreeViewItem
+ Tag = 2
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 76.000000000000000000
+ Text = 'Simple group'
+ Width = 175.000000000000000000
+ end
+ object TreeViewItem3: TTreeViewItem
+ Tag = 3
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 38.000000000000000000
+ Text = 'Nested group'
+ Width = 175.000000000000000000
+ end
+ object TreeViewItem4: TTreeViewItem
+ Tag = 4
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 57.000000000000000000
+ Text = 'Master-Detail-SubDetail'
+ Width = 175.000000000000000000
+ end
+ object TreeViewItem2: TTreeViewItem
+ Tag = 5
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 19.000000000000000000
+ Text = 'Master-Detail-Detail'
+ Width = 175.000000000000000000
+ end
+ object UnicodeI: TTreeViewItem
+ Tag = 6
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 56.000000000000000000
+ Position.Y = 56.000000000000000000
+ Text = 'Multi-column list'
+ Width = 175.000000000000000000
+ end
+ object TreeViewItem7: TTreeViewItem
+ Tag = 7
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Multi-column band'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem8: TTreeViewItem
+ Tag = 8
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Memos and pictures'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem9: TTreeViewItem
+ Tag = 9
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Split bands'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem10: TTreeViewItem
+ Tag = 10
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Subreports'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem11: TTreeViewItem
+ Tag = 11
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Side-by-side subreports'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem12: TTreeViewItem
+ Tag = 12
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Report with title page'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem13: TTreeViewItem
+ Tag = 13
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Interactive report'
+ Width = 50.000000000000000000
+ end
+ object Charts: TTreeViewItem
+ Tag = 24
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Charts'
+ Width = 50.000000000000000000
+ end
+ end
+ object TreeViewItem14: TTreeViewItem
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.Y = 19.000000000000000000
+ StyleLookup = 'UnicodeIStyle1'
+ Text = 'Cross Tabs'
+ Width = 213.000000000000000000
+ object TreeViewItem15: TTreeViewItem
+ Tag = 61
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'No Rows'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem16: TTreeViewItem
+ Tag = 62
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'No columns'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem17: TTreeViewItem
+ Tag = 63
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'One row, one column'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem18: TTreeViewItem
+ Tag = 65
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Two rows, one column'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem19: TTreeViewItem
+ Tag = 66
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Two columns, one row'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem20: TTreeViewItem
+ Tag = 67
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Two cell values'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem21: TTreeViewItem
+ Tag = 68
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Highlight'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem22: TTreeViewItem
+ Tag = 69
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Alternate column each row'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem24: TTreeViewItem
+ Tag = 60
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Cross from non-DB data'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem25: TTreeViewItem
+ Tag = 70
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Old-style cross tab'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem26: TTreeViewItem
+ Tag = 71
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Calendar'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem27: TTreeViewItem
+ Tag = 73
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Expressions in the cross'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem28: TTreeViewItem
+ Tag = 64
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Objects inside the cross'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem51: TTreeViewItem
+ Tag = 101
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Crosstab features'
+ Width = 50.000000000000000000
+ end
+ end
+ object TreeViewItem31: TTreeViewItem
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.Y = 38.000000000000000000
+ StyleLookup = 'UnicodeIStyle1'
+ Text = 'Dialogs and script'
+ Width = 213.000000000000000000
+ object TreeViewItem32: TTreeViewItem
+ Tag = 41
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Hello Fast Report'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem33: TTreeViewItem
+ Tag = 42
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Ask for parameters'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem34: TTreeViewItem
+ Tag = 43
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Controls and events'
+ Width = 50.000000000000000000
+ end
+ end
+ object TreeViewItem23: TTreeViewItem
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.Y = 57.000000000000000000
+ StyleLookup = 'UnicodeIStyle1'
+ Text = 'Other features'
+ Width = 213.000000000000000000
+ object TreeViewItem30: TTreeViewItem
+ Tag = 31
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Rotation, fills and shapes'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem39: TTreeViewItem
+ Tag = 32
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'HTML tags'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem40: TTreeViewItem
+ Tag = 33
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Keep group together'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem41: TTreeViewItem
+ Tag = 34
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Preview outline'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem42: TTreeViewItem
+ Tag = 35
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'URLs, Anchors'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem43: TTreeViewItem
+ Tag = 36
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Unicode'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem47: TTreeViewItem
+ Tag = 93
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Endlesspage height'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem48: TTreeViewItem
+ Tag = 94
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Endlesspage width and height'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem49: TTreeViewItem
+ Tag = 97
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Drill-down groups'
+ Width = 50.000000000000000000
+ end
+ object TreeViewItem50: TTreeViewItem
+ Tag = 98
+ Height = 19.000000000000000000
+ IsChecked = False
+ IsExpanded = False
+ IsSelected = False
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Drill-down nested groups'
+ Width = 50.000000000000000000
+ end
+ end
+ end
+ object Panel3: TPanel
+ Align = alClient
+ Height = 494.000000000000000000
+ Position.X = 217.000000000000000000
+ Position.Y = 67.000000000000000000
+ Width = 350.000000000000000000
+ object btnPreview: TButton
+ DisableFocusEffect = False
+ Height = 22.000000000000000000
+ Position.X = 256.000000000000000000
+ Position.Y = 456.000000000000000000
+ Text = 'Preview'
+ Width = 80.000000000000000000
+ OnClick = btnPreviewClick
+ end
+ object btnDesign: TButton
+ DisableFocusEffect = False
+ Height = 22.000000000000000000
+ Position.X = 169.000000000000000000
+ Position.Y = 456.000000000000000000
+ Text = 'Design'
+ Width = 80.000000000000000000
+ OnClick = btnDesignClick
+ end
+ object Label2: TLabel
+ Height = 425.000000000000000000
+ Position.X = 16.000000000000000000
+ Position.Y = 16.000000000000000000
+ VertTextAlign = taLeading
+ Width = 321.000000000000000000
+ end
+ end
+end
diff --git a/Demos/Main/Unit2.pas b/Demos/Main/Unit2.pas
new file mode 100644
index 0000000..2df5402
--- /dev/null
+++ b/Demos/Main/Unit2.pas
@@ -0,0 +1,217 @@
+unit Unit2;
+
+interface
+
+uses
+ System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
+ FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Objects,
+ FMX.Layouts, FMX.ExtCtrls, FMX.TreeView, FMX.Edit,
+ FMX.frxClass, FMX.frxDesgn, FMX.frxCross,
+ {$IFDEF LINUX}
+ {$I tee.inc}
+ {$IFDEF TeeChartPro}
+ FMX.frxChart,
+ {$ENDIF}
+ {$ELSE}
+ FMX.frxChart,
+ {$ENDIF}
+ FMX.frxGradient,
+ FMX.frxExportText, FMX.frxExportHTML, FMX.frxExportImage, FMX.frxExportXML, FMX.frxExportCSV, FMX.frxExportPDF,
+ FMX.frxExportRTF, FMX.frxExportODF,
+ FMX.ConverterFR3toFRFMX, FMX.frxChBox
+{$IFDEF VER250}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF VER260}
+, FMX.Graphics
+,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF VER270}
+, FMX.Graphics
+,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF VER280}
+, FMX.Graphics
+,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF VER290}
+, FMX.Graphics
+,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF VER300}
+, FMX.Graphics
+,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF VER310}
+, FMX.Graphics
+,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF VER320}
+, FMX.Graphics
+,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF VER330}
+, FMX.Graphics
+,FMX.StdCtrls, FMX.Controls.Presentation
+{$ENDIF}
+{$IFDEF VER340}
+, FMX.Graphics
+,FMX.StdCtrls, FMX.Controls.Presentation
+{$ENDIF}
+{$IFDEF VER350}
+, FMX.Graphics
+,FMX.StdCtrls, FMX.Controls.Presentation
+{$ENDIF}
+ {$IFDEF MSWINDOWS}
+ , Winapi.ShellAPI, Winapi.Windows
+ {$ENDIF}
+ {$IFDEF MACOS}
+ , Posix.Stdlib
+{$ENDIF}
+{$IFDEF LINUX}
+ , FMUX.Api
+{$ENDIF}, FMX.frxBarcode, FMX.frxBarcode2DView;
+
+type
+
+ TForm2 = class(TForm)
+ ToolBar1: TToolBar;
+ TreeView1: TTreeView;
+ UnicodeI: TTreeViewItem;
+ TreeViewItem2: TTreeViewItem;
+ TreeViewItem3: TTreeViewItem;
+ TreeViewItem4: TTreeViewItem;
+ TreeViewItem5: TTreeViewItem;
+ TreeViewItem6: TTreeViewItem;
+ Image1: TImage;
+ Lb1: TLabel;
+ TreeViewItem1: TTreeViewItem;
+ Label2: TLabel;
+ btnPreview: TButton;
+ TreeViewItem7: TTreeViewItem;
+ TreeViewItem8: TTreeViewItem;
+ TreeViewItem9: TTreeViewItem;
+ TreeViewItem10: TTreeViewItem;
+ TreeViewItem11: TTreeViewItem;
+ TreeViewItem12: TTreeViewItem;
+ TreeViewItem13: TTreeViewItem;
+ TreeViewItem14: TTreeViewItem;
+ TreeViewItem15: TTreeViewItem;
+ TreeViewItem16: TTreeViewItem;
+ TreeViewItem17: TTreeViewItem;
+ TreeViewItem18: TTreeViewItem;
+ TreeViewItem19: TTreeViewItem;
+ TreeViewItem20: TTreeViewItem;
+ TreeViewItem21: TTreeViewItem;
+ TreeViewItem22: TTreeViewItem;
+ TreeViewItem24: TTreeViewItem;
+ TreeViewItem25: TTreeViewItem;
+ TreeViewItem26: TTreeViewItem;
+ TreeViewItem27: TTreeViewItem;
+ TreeViewItem28: TTreeViewItem;
+ Charts: TTreeViewItem;
+ TreeViewItem31: TTreeViewItem;
+ TreeViewItem32: TTreeViewItem;
+ TreeViewItem33: TTreeViewItem;
+ TreeViewItem34: TTreeViewItem;
+ TreeViewItem47: TTreeViewItem;
+ TreeViewItem48: TTreeViewItem;
+ TreeViewItem49: TTreeViewItem;
+ TreeViewItem50: TTreeViewItem;
+ TreeViewItem51: TTreeViewItem;
+ Panel3: TPanel;
+ TreeViewItem23: TTreeViewItem;
+ TreeViewItem30: TTreeViewItem;
+ TreeViewItem39: TTreeViewItem;
+ TreeViewItem40: TTreeViewItem;
+ TreeViewItem41: TTreeViewItem;
+ TreeViewItem42: TTreeViewItem;
+ TreeViewItem43: TTreeViewItem;
+ Label6: TLabel;
+ btnDesign: TButton;
+ procedure FormCreate(Sender: TObject);
+ procedure TreeView1Change(Sender: TObject);
+ procedure Label6Click(Sender: TObject);
+ procedure btnDesignClick(Sender: TObject);
+ procedure btnPreviewClick(Sender: TObject);
+ private
+ FReport: TfrxReport;
+ FTXTExport: TfrxSimpleTextExport;
+ FHTMLExport: TfrxHTMLExport;
+ FJPEGExport: TfrxJPEGExport;
+ FTfrxGIFExport: TfrxGIFExport;
+ FPNGExport: TfrxPNGExport;
+ FTIFFExport: TfrxTIFFExport;
+ FBMPExport: TfrxBMPExport;
+ FXMLExport: TfrxXMLExport;
+ FRTFExport: TfrxRTFExport;
+ FPDFExport: TfrxPDFExport;
+ FCSVExport: TfrxCSVExport;
+ FAppDir: String;
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ Form2: TForm2;
+
+implementation
+
+{$R *.fmx}
+
+procedure TForm2.FormCreate(Sender: TObject);
+begin
+ FAppDir := ExtractFilePath(ParamStr(0));
+ FReport := TfrxReport.Create(Self);
+
+ FTXTExport := TfrxSimpleTextExport.Create(Self);
+ FHTMLExport := TfrxHTMLExport.Create(Self);
+ FJPEGExport := TfrxJPEGExport.Create(Self);
+ FTfrxGIFExport := TfrxGIFExport.Create(Self);
+ FPNGExport := TfrxPNGExport.Create(Self);
+ FTIFFExport := TfrxTIFFExport.Create(Self);
+ FBMPExport := TfrxBMPExport.Create(Self);
+ FXMLExport := TfrxXMLExport.Create(Self);
+ FRTFExport := TfrxRTFExport.Create(Self);
+ FPDFExport := TfrxPDFExport.Create(Self);
+ FCSVExport := TfrxCSVExport.Create(Self);
+ TfrxODTExport.Create(Self);
+ TfrxODSExport.Create(Self);
+ TreeView1.ExpandAll;
+ TreeView1.Selected := TreeView1.Items[0].Items[0];
+end;
+
+procedure TForm2.btnDesignClick(Sender: TObject);
+begin
+ FReport.DesignReport;
+end;
+
+procedure TForm2.btnPreviewClick(Sender: TObject);
+begin
+ FReport.ShowReport;
+end;
+
+procedure TForm2.TreeView1Change(Sender: TObject);
+begin
+ if not FReport.LoadFromFile(FAppDir + PathDelim + IntToStr(TreeView1.Selected.Tag) + '.fr3') then
+ FReport.LoadFromFile(FAppDir + PathDelim + IntToStr(TreeView1.Selected.Tag) + '.FR3');
+ Label2.Text := FReport.ReportOptions.Description.Text;
+ FReport.Script.AddVariable('wPath', 'String', FAppDir{ + PathDelim});
+end;
+
+procedure TForm2.Label6Click(Sender: TObject);
+begin
+{$IFDEF MSWINDOWS}
+ ShellExecute(0, 'open', PChar('http://www.fast-report.com'), '', '', SW_SHOWNORMAL);
+{$ENDIF}
+{$IFDEF LINUX}
+ FmuxOpenUrl(PChar('http://www.fast-report.com'));
+{$ENDIF}
+{$IFDEF MACOS}
+ _system(PAnsiChar('open ' + AnsiString('http://www.fast-report.com')));
+{$ENDIF}
+
+end;
+
+end.
\ No newline at end of file
diff --git a/Demos/Main/Unit2.vlb b/Demos/Main/Unit2.vlb
new file mode 100644
index 0000000..5f28270
--- /dev/null
+++ b/Demos/Main/Unit2.vlb
@@ -0,0 +1 @@
+
\ No newline at end of file
diff --git a/Demos/Main/Unit3.dfm b/Demos/Main/Unit3.dfm
new file mode 100644
index 0000000..34feacd
--- /dev/null
+++ b/Demos/Main/Unit3.dfm
@@ -0,0 +1,128 @@
+object DataModule3: TDataModule3
+ OldCreateOrder = False
+ OnCreate = DataModuleCreate
+ Height = 407
+ Width = 580
+ object CDBio: TClientDataSet
+ Aggregates = <>
+ Params = <>
+ Left = 24
+ Top = 16
+ end
+ object CDCust: TClientDataSet
+ Aggregates = <>
+ FieldDefs = <>
+ IndexDefs = <>
+ IndexFieldNames = 'Company'
+ Params = <>
+ StoreDefs = True
+ Left = 504
+ Top = 16
+ end
+ object CDCross: TClientDataSet
+ Aggregates = <>
+ Params = <>
+ Left = 120
+ Top = 16
+ end
+ object CDUnicode: TClientDataSet
+ Aggregates = <>
+ Params = <>
+ Left = 168
+ Top = 16
+ end
+ object CDCountry: TClientDataSet
+ Aggregates = <>
+ IndexFieldNames = 'Continent'
+ Params = <>
+ Left = 312
+ Top = 208
+ end
+ object CDCurQuote: TClientDataSet
+ Aggregates = <>
+ Params = <>
+ Left = 72
+ Top = 88
+ end
+ object CDCustQuery: TClientDataSet
+ Aggregates = <>
+ Params = <>
+ Left = 400
+ Top = 16
+ end
+ object CDEmpl: TClientDataSet
+ Aggregates = <>
+ Params = <>
+ Left = 144
+ Top = 112
+ end
+ object CDItems: TClientDataSet
+ Aggregates = <>
+ IndexFieldNames = 'OrderNo'
+ MasterFields = 'OrderNo'
+ MasterSource = OrdersDS
+ PacketRecords = 0
+ Params = <>
+ Left = 504
+ Top = 232
+ end
+ object CDnextcust: TClientDataSet
+ Aggregates = <>
+ Params = <>
+ Left = 24
+ Top = 168
+ end
+ object CDnextitem: TClientDataSet
+ Aggregates = <>
+ Params = <>
+ Left = 80
+ Top = 232
+ end
+ object CDnextord: TClientDataSet
+ Aggregates = <>
+ Params = <>
+ Left = 136
+ Top = 168
+ end
+ object CDorders: TClientDataSet
+ Aggregates = <>
+ IndexFieldNames = 'CustNo'
+ MasterFields = 'CustNo'
+ MasterSource = CustDS
+ PacketRecords = 0
+ Params = <>
+ Left = 504
+ Top = 120
+ end
+ object CDparts: TClientDataSet
+ Aggregates = <>
+ IndexFieldNames = 'PartNo'
+ MasterFields = 'PartNo'
+ MasterSource = ItemsDS
+ PacketRecords = 0
+ Params = <>
+ Left = 504
+ Top = 344
+ end
+ object CDVendors: TClientDataSet
+ Aggregates = <>
+ Params = <>
+ Left = 16
+ Top = 224
+ end
+ object CustDS: TDataSource
+ DataSet = CDCust
+ Left = 504
+ Top = 65
+ end
+ object OrdersDS: TDataSource
+ DataSet = CDorders
+ Left = 504
+ Top = 176
+ end
+ object ItemsDS: TDataSource
+ DataSet = CDItems
+ Left = 504
+ Top = 288
+ end
+end
diff --git a/Demos/Main/Unit3.pas b/Demos/Main/Unit3.pas
new file mode 100644
index 0000000..e415864
--- /dev/null
+++ b/Demos/Main/Unit3.pas
@@ -0,0 +1,147 @@
+unit Unit3;
+
+interface
+
+uses
+ System.SysUtils, System.Classes, Data.DB, Datasnap.DBClient, FMX.frxClass, FMX.frxDBSet;
+
+type
+ TDataModule3 = class(TDataModule)
+ CDBio: TClientDataSet;
+ CDCust: TClientDataSet;
+ CDCross: TClientDataSet;
+ CDUnicode: TClientDataSet;
+ CDCountry: TClientDataSet;
+ CDCurQuote: TClientDataSet;
+ CDCustQuery: TClientDataSet;
+ CDEmpl: TClientDataSet;
+ CDItems: TClientDataSet;
+ CDnextcust: TClientDataSet;
+ CDnextitem: TClientDataSet;
+ CDnextord: TClientDataSet;
+ CDorders: TClientDataSet;
+ CDparts: TClientDataSet;
+ CDVendors: TClientDataSet;
+ CustDS: TDataSource;
+ OrdersDS: TDataSource;
+ ItemsDS: TDataSource;
+ procedure DataModuleCreate(Sender: TObject);
+ private
+ FBiolife: TfrxDBDataSet;
+ FCustomers: TfrxDBDataSet;
+ FCrossTest: TfrxDBDataSet;
+ FUnicode: TfrxDBDataSet;
+ FOrders: TfrxDBDataset;
+ FItems: TfrxDBDataset;
+ FPart: TfrxDBDataset;
+ FSales: TfrxDBDataset;
+ FCountry: TfrxDBDataset;
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ DataModule3: TDataModule3;
+
+implementation
+
+{%CLASSGROUP 'System.Classes.TPersistent'}
+
+{$R *.dfm}
+
+procedure TDataModule3.DataModuleCreate(Sender: TObject);
+var
+ DataPath: String;
+begin
+ DataPath := ExtractFilePath(ParamStr(0)) + PathDelim + 'Data' + PathDelim;
+ FBiolife := TfrxDBDataSet.Create(Self);
+ FBiolife.Name := 'Biolife';
+ FBiolife.UserName := 'Bio';
+ CDBio.LoadFromFile(DataPath + 'biolife.xml');
+ FBiolife.DataSet := CDBio;
+ FBiolife.FieldAliases.Delimiter := ';';
+ FBiolife.FieldAliases.StrictDelimiter := True;
+ FBiolife.FieldAliases.DelimitedText := 'Species No=Species No;Category=Category;Common_Name=Common Name;Species Name=Species Name;Length (cm)=Length (cm);Length_In=Length In;Notes=Notes;Graphic=Graphic';
+
+ FCustomers := TfrxDBDataSet.Create(Self);
+ FCustomers.Name := 'Customers';
+ FCustomers.UserName := 'Customers';
+ FCustomers.FieldAliases.Delimiter := ';';
+ FCustomers.FieldAliases.StrictDelimiter := True;
+ FCustomers.FieldAliases.DelimitedText := 'CustNo=Cust No;Company=Company;Addr1=Addr1;Addr2=Addr2;City=City;State=State;Zip=Zip;Country=Country;Phone=Phone;FAX=FAX;TaxRate=Tax Rate;Contact=Contact;LastInvoiceDate=Last Invoice Date';
+
+
+ CDCust.LoadFromFile(DataPath + 'customer.xml');
+ FCustomers.DataSet := CDCust;
+
+ FCrossTest := TfrxDBDataSet.Create(Self);
+ FCrossTest.Name := 'Cross';
+ FCrossTest.UserName := 'Cross';
+ CDCross.LoadFromFile(DataPath + 'crosstest.xml');
+ FCrossTest.DataSet := CDCross;
+
+ FUnicode := TfrxDBDataSet.Create(Self);
+
+ FUnicode.Name := 'Unicode';
+ FUnicode.UserName := 'Unicode';
+ CDUnicode.LoadFromFile(DataPath + 'unicode.xml');
+ FUnicode.DataSet := CDUnicode;
+
+ FOrders := TfrxDBDataset.Create(Self);
+ FOrders.Name := 'Orders';
+ FOrders.UserName := 'Orders';
+ CDorders.LoadFromFile(DataPath + 'orders.xml');
+ FOrders.DataSet := CDorders;
+ FOrders.FieldAliases.Delimiter := ';';
+ FOrders.FieldAliases.StrictDelimiter := True;
+ FOrders.FieldAliases.DelimitedText := 'OrderNo=Order No;CustNo=Cust No;CustCompany=Cust Company;SaleDate=Sale Date;ShipDate=Ship Date;EmpNo=Emp No;' +
+ 'ShipToContact=Ship To Contact;ShipToAddr1=Ship To Addr1;ShipToAddr2=Ship To Addr2;ShipToCity=Ship To City;ShipToState=Ship To State;ShipToZip=Ship To Zip;ShipToCountry=Ship To Country;ShipToPhone=Ship To Phone;ShipVIA=Ship VIA;'+
+ 'PO=PO;Terms=Terms;PaymentMethod=Payment Method;ItemsTotal=Items Total;TaxRate=Tax Rate;Freight=Freight;AmountPaid=Amount Paid';
+
+ FItems := TfrxDBDataset.Create(Self);
+ FItems.Name := 'Items';
+ FItems.UserName := 'Items';
+ CDItems.LoadFromFile(DataPath + 'items.xml');
+ FItems.DataSet := CDItems;
+ FItems.FieldAliases.Delimiter := ';';
+ FItems.FieldAliases.StrictDelimiter := True;
+ //FItems.FieldAliases.DelimitedText := 'OrderNo=Order No;ItemNo=Item No;PartNo=Part No;PartName=Part Name;Qty=Qty;Price=Price;Discount=Discount;Total=Total;ExtendedPrice=Extended Price';
+
+ FPart := TfrxDBDataset.Create(Self);
+ FPart.Name := 'Parts';
+ FPart.UserName := 'Parts';
+ CDParts.LoadFromFile(DataPath + 'parts.xml');
+ FPart.DataSet := CDParts;
+ FPart.FieldAliases.Delimiter := ';';
+ FPart.FieldAliases.StrictDelimiter := True;
+ FPart.FieldAliases.DelimitedText := 'PartNo=Part No;VendorNo=Vendor No;Description=Description;OnHand=On Hand;OnOrder=On Order;Cost=Cost;ListPrice=List Price';
+
+ FSales := TfrxDBDataset.Create(Self);
+ FSales.Name := 'Sales';
+ FSales.UserName := 'Sales';
+ CDCustQuery.LoadFromFile(DataPath + 'customer_query.xml');
+ FSales.DataSet := CDCustQuery;
+ FSales.FieldAliases.Delimiter := ';';
+ FSales.FieldAliases.StrictDelimiter := True;
+// FSales.FieldAliases.DelimitedText := 'CustNo=Cust No;Company=Company;Addr1=Addr1;Addr2=Addr2;City=City;State=State' +
+// 'Zip=Zip;Country=Country;Phone=Phone;FAX=FAX;TaxRate=a.TaxRate;Contact=Contact' +
+// 'LastInvoiceDate=LastInvoiceDate;OrderNo=Order No;CustNo=b.CustNo;SaleDate=Sale Date' +
+// 'ShipDate=ShipDate;EmpNo=EmpNo;ShipToContact=ShipToContact;ShipToAddr1=ShipToAddr1' +
+// 'ShipToAddr2=ShipToAddr2;ShipToCity=ShipToCity;ShipToState=ShipToState;ShipToZip=ShipToZip' +
+// 'ShipToCountry=ShipToCountry;ShipToPhone=ShipToPhone;ShipVIA=ShipVIA;PO=PO;Terms=Terms' +
+// 'PaymentMethod=PaymentMethod;ItemsTotal=ItemsTotal;TaxRate=b.TaxRate;Freight=Freight;AmountPaid=AmountPaid;OrderNo=c.OrderNo' +
+// 'ItemNo=ItemNo;PartNo=Part No;Qty=Qty;Discount=Discount;PartNo=d.PartNo;VendorNo=VendorNo' +
+// 'Description=Description;OnHand=OnHand;OnOrder=OnOrder;Cost=Cost;ListPrice=List Price';
+
+
+ FCountry := TfrxDBDataset.Create(Self);
+ FCountry.Name := 'Country';
+ FCountry.UserName := 'Country';
+ CDCountry.LoadFromFile(DataPath + 'country.xml');
+ FCountry.DataSet := CDCountry;
+ //FCountry.FieldAliases.Delimiter := ';';
+ //FCountry.FieldAliases.DelimitedText :=
+end;
+
+end.
diff --git a/Demos/Main/awards.png b/Demos/Main/awards.png
new file mode 100644
index 0000000..0277dd9
Binary files /dev/null and b/Demos/Main/awards.png differ
diff --git a/FastReports.url b/FastReports.url
new file mode 100644
index 0000000..d3c5305
--- /dev/null
+++ b/FastReports.url
@@ -0,0 +1,2 @@
+[InternetShortcut]
+URL=http://www.fast-report.com
diff --git a/FastReportsT.url b/FastReportsT.url
new file mode 100644
index 0000000..d606b9c
--- /dev/null
+++ b/FastReportsT.url
@@ -0,0 +1,6 @@
+[InternetShortcut]
+URL=http://www.fast-report.com/en/products/report-for-delphi-fastreport-4-feature-matrix.html
+IDList=
+HotKey=0
+[{000214A0-0000-0000-C000-000000000046}]
+Prop3=19,2
diff --git a/FastScript/FMX.BaseTypeAliases.pas b/FastScript/FMX.BaseTypeAliases.pas
new file mode 100644
index 0000000..2d807b0
--- /dev/null
+++ b/FastScript/FMX.BaseTypeAliases.pas
@@ -0,0 +1,283 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Graphics.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.BaseTypeAliases;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Types, FMX.Objects, System.UITypes, System.UIConsts, FMX.Graphics, FMX.Controls, System.Types, System.TypInfo;
+
+type
+
+ TCalloutPositionHelper = record helper for TCalloutPosition
+ const
+ cpTop = TCalloutPosition.Top deprecated 'Use TCalloutPosition.Top';
+ cpLeft = TCalloutPosition.Left deprecated 'Use TCalloutPosition.Left';
+ cpBottom = TCalloutPosition.Bottom deprecated 'Use TCalloutPosition.Bottom';
+ cpRight = TCalloutPosition.Right deprecated 'Use TCalloutPosition.Right';
+ end;
+
+ TCornerHelper = record helper for TCorner
+ const
+ crTopLeft = TCorner.TopLeft deprecated 'Use TCorner.TopLeft';
+ crTopRight = TCorner.TopRight deprecated 'Use TCorner.TopRight';
+ crBottomLeft = TCorner.BottomLeft deprecated 'Use TCorner.BottomLeft';
+ crBottomRight = TCorner.BottomRight deprecated 'Use TCorner.BottomRight';
+ end;
+
+ TCornerTypeHelper = record helper for TCornerType
+ const
+ ctRound = TCornerType.Round deprecated 'Use TCornerType.Round';
+ ctBevel = TCornerType.Bevel deprecated 'Use TCornerType.Bevel';
+ ctInnerRound = TCornerType.InnerRound deprecated 'Use TCornerType.InnerRound';
+ ctInnerLine = TCornerType.InnerLine deprecated 'Use TCornerType.InnerLine';
+ end;
+
+ TSideHelper = record helper for TSide
+ const
+ sdTop = TSide.Top deprecated 'Use TSide.Top';
+ sdLeft = TSide.Left deprecated 'Use TSide.Left';
+ sdBottom = TSide.Bottom deprecated 'Use TSide.Bottom';
+ sdRight = TSide.Right deprecated 'Use TSide.Right';
+ end;
+
+ TTextAlignHelper = record helper for TTextAlign
+ const
+ taCenter = TTextAlign.Center deprecated 'Use TTextAlign.Center';
+ taLeading = TTextAlign.Leading deprecated 'Use TTextAlign.Leading';
+ taTrailing = TTextAlign.Trailing deprecated 'Use TTextAlign.Trailing';
+ end;
+
+ TTextTrimmingHelper = record helper for TTextTrimming
+ const
+ ttNone = TTextTrimming.None deprecated 'Use TTextTrimming.None';
+ ttCharacter = TTextTrimming.Character deprecated 'Use TTextTrimming.Character';
+ ttWord = TTextTrimming.Word deprecated 'Use TTextTrimming.Word';
+ end;
+
+ TStyledSettingHelper = record helper for TStyledSetting
+ const
+ ssFamily = TStyledSetting.Family deprecated 'Use TStyledSetting.Family';
+ ssSize = TStyledSetting.Size deprecated 'Use TStyledSetting.Size';
+ ssStyle = TStyledSetting.Style deprecated 'Use TStyledSetting.Style';
+ ssFontColor = TStyledSetting.FontColor deprecated 'Use TStyledSetting.FontColor';
+ ssOther = TStyledSetting.Other deprecated 'Use TStyledSetting.Other';
+ end;
+
+ TMenuItemChangeHelper = record helper for TMenuItemChange
+ const
+ mcEnabled = TMenuItemChange.Enabled deprecated 'Use TMenuItemChange.Enabled';
+ mcVisible = TMenuItemChange.Visible deprecated 'Use TMenuItemChange.Visible';
+ mcText = TMenuItemChange.Text deprecated 'Use TMenuItemChange.Text';
+ mcShortcut = TMenuItemChange.Shortcut deprecated 'Use TMenuItemChange.Shortcut';
+ mcChecked = TMenuItemChange.Checked deprecated 'Use TMenuItemChange.Checked';
+ mcBitmap = TMenuItemChange.Bitmap deprecated 'Use TMenuItemChange.Bitmap';
+ end;
+
+ TScreenOrientationHelper = record helper for TScreenOrientation
+ const
+ soPortrait = TScreenOrientation.Portrait deprecated 'Use TScreenOrientation.Portrait';
+ soLandscape = TScreenOrientation.Landscape deprecated 'Use TScreenOrientation.Landscape';
+ soInvertedPortrait = TScreenOrientation.InvertedPortrait deprecated 'Use TScreenOrientation.InvertedPortrait';
+ soInvertedLandscape = TScreenOrientation.InvertedLandscape deprecated 'Use TScreenOrientation.InvertedLandscape';
+ end;
+
+ TFormStyleHelper = record helper for TFormStyle
+ const
+ fsNormal = TFormStyle.Normal deprecated 'Use TFormStyle.Normal';
+ fsPopup = TFormStyle.Popup deprecated 'Use TFormStyle.Popup';
+ fsStayOnTop = TFormStyle.StayOnTop deprecated 'Use TFormStyle.StayOnTop';
+ end;
+
+ TAlignLayoutHelper = record helper for TAlignLayout
+ const
+ alNone = TAlignLayout.None deprecated 'Use TAlignLayout.None';
+ alTop = TAlignLayout.Top deprecated 'Use TAlignLayout.Top';
+ alLeft = TAlignLayout.Left deprecated 'Use TAlignLayout.Left';
+ alRight = TAlignLayout.Right deprecated 'Use TAlignLayout.Right';
+ alBottom = TAlignLayout.Bottom deprecated 'Use TAlignLayout.Bottom';
+ alMostTop = TAlignLayout.MostTop deprecated 'Use TAlignLayout.MostTop';
+ alMostBottom = TAlignLayout.MostBottom deprecated 'Use TAlignLayout.MostBottom';
+ alMostLeft = TAlignLayout.MostLeft deprecated 'Use TAlignLayout.MostLeft';
+ alMostRight = TAlignLayout.MostRight deprecated 'Use TAlignLayout.MostRight';
+ alClient = TAlignLayout.Client deprecated 'Use TAlignLayout.Client';
+ alContents = TAlignLayout.Contents deprecated 'Use TAlignLayout.Contents';
+ alCenter = TAlignLayout.Center deprecated 'Use TAlignLayout.Center';
+ alVertCenter = TAlignLayout.VertCenter deprecated 'Use TAlignLayout.VertCenter';
+ alHorzCenter = TAlignLayout.HorzCenter deprecated 'Use TAlignLayout.HorzCenter';
+ alHorizontal = TAlignLayout.Horizontal deprecated 'Use TAlignLayout.Horizontal';
+ alVertical = TAlignLayout.Vertical deprecated 'Use TAlignLayout.Vertical';
+ alScale = TAlignLayout.Scale deprecated 'Use TAlignLayout.Scale';
+ alFit = TAlignLayout.Fit deprecated 'Use TAlignLayout.Fit';
+ alFitLeft = TAlignLayout.FitLeft deprecated 'Use TAlignLayout.FitLeft';
+ alFitRight = TAlignLayout.FitRight deprecated 'Use TAlignLayout.FitRight';
+ end;
+
+ TGradientStyleHelper = record helper for TGradientStyle
+ const
+ gsLinear = TGradientStyle.Linear deprecated 'Use TGradientStyle.Linear';
+ gsRadial = TGradientStyle.Radial deprecated 'Use TGradientStyle.Radial';
+ end;
+
+ TBrushKindHelper = record helper for TBrushKind
+ const
+ bkNone = TBrushKind.None deprecated 'Use TBrushKind.None';
+ bkSolid = TBrushKind.Solid deprecated 'Use TBrushKind.Solid';
+ bkGradient = TBrushKind.Gradient deprecated 'Use TBrushKind.Gradient';
+ bkBitmap = TBrushKind.Bitmap deprecated 'Use TBrushKind.Bitmap';
+ bkResource = TBrushKind.Resource deprecated 'Use TBrushKind.Resource';
+ end;
+
+ TStrokeCapHelper = record helper for TStrokeCap
+ const
+ scFlat = TStrokeCap.Flat deprecated 'Use TStrokeCap.Flat';
+ scRound = TStrokeCap.Round deprecated 'Use TStrokeCap.Round';
+ end;
+
+ TStrokeJoinHelper = record helper for TStrokeJoin
+ const
+ sjMiter = TStrokeJoin.Miter deprecated 'Use TStrokeJoin.Miter';
+ sjRound = TStrokeJoin.Round deprecated 'Use TStrokeJoin.Round';
+ sjBevel = TStrokeJoin.Bevel deprecated 'Use TStrokeJoin.Bevel';
+ end;
+
+ TStrokeDashHelper = record helper for TStrokeDash
+ const
+ sdSolid = TStrokeDash.Solid deprecated 'Use TStrokeDash.Solid';
+ sdDash = TStrokeDash.Dash deprecated 'Use TStrokeDash.Dash';
+ sdDot = TStrokeDash.Dot deprecated 'Use TStrokeDash.Dot';
+ sdDashDot = TStrokeDash.DashDot deprecated 'Use TStrokeDash.DashDot';
+ sdDashDotDot = TStrokeDash.DashDotDot deprecated 'Use TStrokeDash.DashDotDot';
+ sdCustom = TStrokeDash.Custom deprecated 'Use TStrokeDash.Custom';
+ end;
+
+ TFillTextFlagHelper = record helper for TFillTextFlag
+ const
+ ftRightToLeft = TFillTextFlag.RightToLeft deprecated 'Use TFillTextFlag.RightToLeft';
+ end;
+
+ TMapAccessHelper = record helper for TMapAccess
+ const
+ maRead = TMapAccess.Read deprecated 'Use TMapAccess.Read';
+ maWrite = TMapAccess.Write deprecated 'Use TMapAccess.Write';
+ maReadWrite = TMapAccess.ReadWrite deprecated 'Use TMapAccess.ReadWrite';
+ end;
+
+ TOrientationHelper = record helper for TOrientation
+ const
+ orHorizontal = TOrientation.Horizontal deprecated 'Use TOrientation.Horizontal';
+ orVertical = TOrientation.Vertical deprecated 'Use TOrientation.Vertical';
+ end;
+
+ TPlacementHelper = record helper for TPlacement
+ const
+ plBottom = TPlacement.Bottom deprecated 'Use TPlacement.Bottom';
+ plTop = TPlacement.Top deprecated 'Use TPlacement.Top';
+ plLeft = TPlacement.Left deprecated 'Use TPlacement.Left';
+ plRight = TPlacement.Right deprecated 'Use TPlacement.Right';
+ plCenter = TPlacement.Center deprecated 'Use TPlacement.Center';
+ plBottomCenter = TPlacement.BottomCenter deprecated 'Use TPlacement.BottomCenter';
+ plTopCenter = TPlacement.TopCenter deprecated 'Use TPlacement.TopCenter';
+ plLeftCenter = TPlacement.LeftCenter deprecated 'Use TPlacement.LeftCenter';
+ plRightCenter = TPlacement.RightCenter deprecated 'Use TPlacement.RightCenter';
+ plAbsolute = TPlacement.Absolute deprecated 'Use TPlacement.Absolute';
+ plMouse = TPlacement.Mouse deprecated 'Use TPlacement.Mouse';
+ plMouseCenter = TPlacement.MouseCenter deprecated 'Use TPlacement.MouseCenter';
+ end;
+
+ TVirtualKeyboardTypeHelper = record helper for TVirtualKeyboardType
+ const
+ vktDefault = TVirtualKeyboardType.Default deprecated 'Use TVirtualKeyboardType.Default';
+ vktNumbersAndPunctuation = TVirtualKeyboardType.NumbersAndPunctuation deprecated 'Use TVirtualKeyboardType.NumbersAndPunctuation';
+ vktNumberPad = TVirtualKeyboardType.NumberPad deprecated 'Use TVirtualKeyboardType.NumberPad';
+ vktPhonePad = TVirtualKeyboardType.PhonePad deprecated 'Use TVirtualKeyboardType.PhonePad';
+ vktAlphabet = TVirtualKeyboardType.Alphabet deprecated 'Use TVirtualKeyboardType.Alphabet';
+ vktURL = TVirtualKeyboardType.URL deprecated 'Use TVirtualKeyboardType.URL';
+ vktNamePhonePad = TVirtualKeyboardType.NamePhonePad deprecated 'Use TVirtualKeyboardType.NamePhonePad';
+ vktEmailAddress = TVirtualKeyboardType.EmailAddress deprecated 'Use TVirtualKeyboardType.EmailAddress';
+ end;
+
+ TVirtualKeyboardStateHelper = record helper for TVirtualKeyboardState
+ const
+ vksAutoShow = TVirtualKeyboardState.AutoShow deprecated 'Use TVirtualKeyboardState.AutoShow';
+ vksVisible = TVirtualKeyboardState.Visible deprecated 'Use TVirtualKeyboardState.Visible';
+ vksError = TVirtualKeyboardState.Error deprecated 'Use TVirtualKeyboardState.Error';
+ vksTransient = TVirtualKeyboardState.Transient deprecated 'Use TVirtualKeyboardState.Transient';
+ end;
+
+ TReturnKeyTypeHelper = record helper for TReturnKeyType
+ const
+ rktDefault = TReturnKeyType.Default deprecated 'Use TReturnKeyType.Default';
+ rktDone = TReturnKeyType.Done deprecated 'Use TReturnKeyType.Done';
+ rktGo = TReturnKeyType.Go deprecated 'Use TReturnKeyType.Go';
+ rktNext = TReturnKeyType.Next deprecated 'Use TReturnKeyType.Next';
+ rktSearch = TReturnKeyType.Search deprecated 'Use TReturnKeyType.Search';
+ rktSend = TReturnKeyType.Send deprecated 'Use TReturnKeyType.Send';
+ end;
+
+implementation
+
+initialization
+ AddEnumElementAliases(TypeInfo(TCalloutPosition), ['cpTop', 'cpLeft', 'cpBottom', 'cpRight']);
+ AddEnumElementAliases(TypeInfo(TCorner), ['crTopLeft', 'crTopRight', 'crBottomLeft', 'crBottomRight']);
+ AddEnumElementAliases(TypeInfo(TCornerType), ['ctRound', 'ctBevel', 'ctInnerRound', 'ctInnerLine']);
+ AddEnumElementAliases(TypeInfo(TSide), ['sdTop', 'sdLeft', 'sdBottom', 'sdRight']);
+ AddEnumElementAliases(TypeInfo(TTextAlign), ['taCenter', 'taLeading', 'taTrailing']);
+ AddEnumElementAliases(TypeInfo(TTextTrimming), ['ttNone', 'ttCharacter', 'ttWord']);
+ AddEnumElementAliases(TypeInfo(TStyledSetting), ['ssFamily', 'ssSize', 'ssStyle', 'ssFontColor', 'ssOther']);
+ AddEnumElementAliases(TypeInfo(TMenuItemChange), ['mcEnabled', 'mcVisible', 'mcText', 'mcShortcut', 'mcChecked', 'mcBitmap']);
+ AddEnumElementAliases(TypeInfo(TScreenOrientation), ['soPortrait', 'soLandscape', 'soInvertedPortrait', 'soInvertedLandscape']);
+ AddEnumElementAliases(TypeInfo(TFormStyle), ['fsNormal', 'fsPopup', 'fsStayOnTop']);
+ AddEnumElementAliases(TypeInfo(TAlignLayout), ['alNone', 'alTop', 'alLeft', 'alRight', 'alBottom', 'alMostTop', 'alMostBottom', 'alMostLeft', 'alMostRight', 'alClient', 'alContents', 'alCenter', 'alVertCenter', 'alHorzCenter', 'alHorizontal', 'alVertical', 'alScale', 'alFit', 'alFitLeft', 'alFitRight']);
+ AddEnumElementAliases(TypeInfo(TGradientStyle), ['gsLinear', 'gsRadial']);
+ AddEnumElementAliases(TypeInfo(TBrushKind), ['bkNone', 'bkSolid', 'bkGradient', 'bkBitmap', 'bkResource']);
+ AddEnumElementAliases(TypeInfo(TStrokeCap), ['scFlat', 'scRound']);
+ AddEnumElementAliases(TypeInfo(TStrokeJoin), ['sjMiter', 'sjRound', 'sjBevel']);
+ AddEnumElementAliases(TypeInfo(TStrokeDash), ['sdSolid', 'sdDash', 'sdDot', 'sdDashDot', 'sdDashDotDot', 'sdCustom']);
+ AddEnumElementAliases(TypeInfo(TMapAccess), ['maRead', 'maWrite', 'maReadWrite']);
+ AddEnumElementAliases(TypeInfo(TFillTextFlag), ['ftRightToLeft']);
+ AddEnumElementAliases(TypeInfo(TOrientation), ['orHorizontal', 'orVertical']);
+ AddEnumElementAliases(TypeInfo(TPlacement), ['plBottom', 'plTop', 'plLeft', 'plRight', 'plCenter', 'plBottomCenter', 'plTopCenter', 'plLeftCenter', 'plRightCenter', 'plAbsolute', 'plMouse', 'plMouseCenter']);
+ AddEnumElementAliases(TypeInfo(TVirtualKeyboardType), ['vktDefault', 'vktNumbersAndPunctuation', 'vktNumberPad', 'vktPhonePad', 'vktAlphabet', 'vktURL', 'vktNamePhonePad', 'vktEmailAddress']);
+ AddEnumElementAliases(TypeInfo(TReturnKeyType), ['rktDefault', 'rktDone', 'rktGo', 'rktNext', 'rktSearch']);
+ AddEnumElementAliases(TypeInfo(TVirtualKeyboardState), ['vksAutoShow', 'vksVisible', 'vksError', 'vksTransient']);
+
+
+finalization
+ RemoveEnumElementAliases(TypeInfo(TCalloutPosition));
+ RemoveEnumElementAliases(TypeInfo(TCorner));
+ RemoveEnumElementAliases(TypeInfo(TCornerType));
+ RemoveEnumElementAliases(TypeInfo(TSide));
+ RemoveEnumElementAliases(TypeInfo(TTextAlign));
+ RemoveEnumElementAliases(TypeInfo(TTextTrimming));
+ RemoveEnumElementAliases(TypeInfo(TStyledSetting));
+ RemoveEnumElementAliases(TypeInfo(TMenuItemChange));
+ RemoveEnumElementAliases(TypeInfo(TScreenOrientation));
+ RemoveEnumElementAliases(TypeInfo(TFormStyle));
+ RemoveEnumElementAliases(TypeInfo(TAlignLayout));
+ RemoveEnumElementAliases(TypeInfo(TGradientStyle));
+ RemoveEnumElementAliases(TypeInfo(TBrushKind));
+ RemoveEnumElementAliases(TypeInfo(TStrokeCap));
+ RemoveEnumElementAliases(TypeInfo(TStrokeJoin));
+ RemoveEnumElementAliases(TypeInfo(TStrokeDash));
+ RemoveEnumElementAliases(TypeInfo(TMapAccess));
+ RemoveEnumElementAliases(TypeInfo(TFillTextFlag));
+ RemoveEnumElementAliases(TypeInfo(TOrientation));
+ RemoveEnumElementAliases(TypeInfo(TPlacement));
+ RemoveEnumElementAliases(TypeInfo(TVirtualKeyboardType));
+ RemoveEnumElementAliases(TypeInfo(TReturnKeyType));
+ RemoveEnumElementAliases(TypeInfo(TVirtualKeyboardState));
+
+
+end.
diff --git a/FastScript/FMX.FormTypeAliases.pas b/FastScript/FMX.FormTypeAliases.pas
new file mode 100644
index 0000000..99d3df6
--- /dev/null
+++ b/FastScript/FMX.FormTypeAliases.pas
@@ -0,0 +1,70 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Graphics.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.FormTypeAliases;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Types, FMX.Objects, System.UITypes, System.UIConsts, FMX.Graphics, System.Types, System.TypInfo, FMX.Forms;
+
+type
+ TFmxFormBorderStyleHelper = record helper for TFmxFormBorderStyle
+ const
+ bsNone = TFmxFormBorderStyle.None deprecated 'Use TFmxFormBorderStyle.None';
+ bsSingle = TFmxFormBorderStyle.Single deprecated 'Use TFmxFormBorderStyle.Single';
+ bsSizeable = TFmxFormBorderStyle.Sizeable deprecated 'Use TFmxFormBorderStyle.Sizeable';
+ bsToolWindow = TFmxFormBorderStyle.ToolWindow deprecated 'Use TFmxFormBorderStyle.ToolWindow';
+ bsSizeToolWin = TFmxFormBorderStyle.SizeToolWin deprecated 'Use TFmxFormBorderStyle.SizeToolWin';
+ end;
+
+ TFormPositionHelper = record helper for TFormPosition
+ const
+ poDesigned = TFormPosition.Designed deprecated 'Use TFormPosition.Designed';
+ poDefault = TFormPosition.Default deprecated 'Use TFormPosition.Default';
+ poDefaultPosOnly = TFormPosition.DefaultPosOnly deprecated 'Use TFormPosition.DefaultPosOnly';
+ poDefaultSizeOnly = TFormPosition.DefaultSizeOnly deprecated 'Use TFormPosition.DefaultSizeOnly';
+ poScreenCenter = TFormPosition.ScreenCenter deprecated 'Use TFormPosition.ScreenCenter';
+ poDesktopCenter = TFormPosition.DesktopCenter deprecated 'Use TFormPosition.DesktopCenter';
+ poMainFormCenter = TFormPosition.MainFormCenter deprecated 'Use TFormPosition.MainFormCenter';
+ poOwnerFormCenter = TFormPosition.OwnerFormCenter deprecated 'Use TFormPosition.OwnerFormCenter';
+ end;
+
+ TFmxFormStateHelper = record helper for TFmxFormState
+ const
+ fsRecreating = TFmxFormState.Recreating deprecated 'Use TFmxFormState.Recreating';
+ fsModal = TFmxFormState.Modal deprecated 'Use TFmxFormState.Modal';
+ fsReleased = TFmxFormState.Released deprecated 'Use TFmxFormState.Released';
+ fsInDesigner = TFmxFormState.InDesigner deprecated 'Use TFmxFormState.InDesigner';
+ fsWasNotShown = TFmxFormState.WasNotShown deprecated 'Use TFmxFormState.WasNotShown';
+ fsShowing = TFmxFormState.Showing deprecated 'Use TFmxFormState.Showing';
+ fsUpdateBorder = TFmxFormState.UpdateBorder deprecated 'Use TFmxFormState.UpdateBorder';
+ fsActivation = TFmxFormState.Activation deprecated 'Use TFmxFormState.Activation';
+ end;
+
+
+implementation
+
+initialization
+ AddEnumElementAliases(TypeInfo(TFmxFormBorderStyle), ['bsNone', 'bsSingle', 'bsSizeable', 'bsToolWindow', 'bsSizeToolWin']);
+ AddEnumElementAliases(TypeInfo(TFormPosition), ['poDesigned', 'poDefault', 'poDefaultPosOnly', 'poDefaultSizeOnly', 'poScreenCenter', 'poDesktopCenter',
+ 'poMainFormCenter', 'poOwnerFormCenter']);
+ AddEnumElementAliases(TypeInfo(TFmxFormState), ['fsRecreating', 'fsModal', 'fsReleased', 'fsInDesigner', 'fsWasNotShown', 'fsShowing', 'fsUpdateBorder',
+ 'fsActivation']);
+
+finalization
+ RemoveEnumElementAliases(TypeInfo(TFmxFormBorderStyle));
+ RemoveEnumElementAliases(TypeInfo(TFormPosition));
+ RemoveEnumElementAliases(TypeInfo(TFmxFormState));
+
+end.
diff --git a/FastScript/FMX.fs_iadortti.pas b/FastScript/FMX.fs_iadortti.pas
new file mode 100644
index 0000000..f858548
--- /dev/null
+++ b/FastScript/FMX.fs_iadortti.pas
@@ -0,0 +1,129 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ ADO classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iadortti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_itools, FMX.fs_idbrtti,
+ Data.DB, Data.Win.ADODB, Winapi.ADOInt, FMX.Types;
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsADORTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddType('TDataType', fvtInt);
+ AddClass(TADOConnection, 'TComponent');
+ AddClass(TParameter, 'TCollectionItem');
+ with AddClass(TParameters, 'TCollection') do
+ begin
+ AddMethod('function AddParameter: TParameter', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TParameter', CallMethod, True);
+ end;
+ with AddClass(TCustomADODataSet, 'TDataSet') do
+ begin
+ AddProperty('Sort', 'WideString', GetProp, SetProp);
+ end;
+ AddClass(TADOTable, 'TCustomADODataSet');
+ with AddClass(TADOQuery, 'TCustomADODataSet') do
+ AddMethod('procedure ExecSQL', CallMethod);
+ with AddClass(TADOStoredProc, 'TCustomADODataSet') do
+ AddMethod('procedure ExecProc', CallMethod);
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TParameters then
+ begin
+ if MethodName = 'ADDPARAMETER' then
+ Result := frxInteger(TParameters(Instance).AddParameter)
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TParameters(Instance).Items[Caller.Params[0]])
+ end
+ else if ClassType = TADOQuery then
+ begin
+ if MethodName = 'EXECSQL' then
+ TADOQuery(Instance).ExecSQL
+ end
+ else if ClassType = TADOStoredProc then
+ begin
+ if MethodName = 'EXECPROC' then
+ TADOStoredProc(Instance).ExecProc
+ end
+end;
+
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TCustomADODataSet then
+ begin
+ if PropName = 'SORT' then
+ Result := TCustomADODataSet(Instance).Sort;
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+
+ if ClassType = TCustomADODataSet then
+ begin
+ if PropName = 'SORT' then
+ TCustomADODataSet(Instance).Sort := Value;
+ end
+
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsADORTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
+
diff --git a/FastScript/FMX.fs_ibasic.pas b/FastScript/FMX.fs_ibasic.pas
new file mode 100644
index 0000000..8a0c8e7
--- /dev/null
+++ b/FastScript/FMX.fs_ibasic.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Basic grammar }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_ibasic;
+{$i FMX.inc}
+{$i fs_ibasic.pas}
\ No newline at end of file
diff --git a/FastScript/FMX.fs_ichartrtti.pas b/FastScript/FMX.fs_ichartrtti.pas
new file mode 100644
index 0000000..4fdff87
--- /dev/null
+++ b/FastScript/FMX.fs_ichartrtti.pas
@@ -0,0 +1,181 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Chart }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_ichartrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_itools, FMX.fs_iformsrtti, FMX.Objects,
+ FMXTee.Chart, FMXTee.Series, FMXTee.Engine, FMXTee.Procs, FMXTee.Canvas, FMX.Types, System.Types;
+
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsChartRTTI = class(TFmxObject); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddType('TChartValue', fvtFloat);
+ AddEnum('TLegendStyle', 'lsAuto, lsSeries, lsValues, lsLastValues');
+ AddEnum('TLegendAlignment', 'laLeft, laRight, laTop, laBottom');
+ AddEnum('TLegendTextStyle', 'ltsPlain, ltsLeftValue, ltsRightValue, ltsLeftPercent,' +
+ 'ltsRightPercent, ltsXValue');
+ AddEnum('TChartListOrder', 'loNone, loAscending, loDescending');
+ AddEnum('TGradientDirection', 'gdTopBottom, gdBottomTop, gdLeftRight, gdRightLeft');
+ AddEnum('TSeriesMarksStyle', 'smsValue, smsPercent, smsLabel, smsLabelPercent, ' +
+ 'smsLabelValue, smsLegend, smsPercentTotal, smsLabelPercentTotal, smsXValue');
+ AddEnum('TAxisLabelStyle', 'talAuto, talNone, talValue, talMark, talText');
+ AddEnum('THorizAxis', 'aTopAxis, aBottomAxis');
+ AddEnum('TVertAxis', 'aLeftAxis, aRightAxis');
+ AddEnum('TTeeBackImageMode', 'pbmStretch, pbmTile, pbmCenter');
+ AddEnum('TPanningMode', 'pmNone, pmHorizontal, pmVertical, pmBoth');
+ AddEnum('TSeriesPointerStyle', 'psRectangle, psCircle, psTriangle, ' +
+ 'psDownTriangle, psCross, psDiagCross, psStar, psDiamond, psSmallDot');
+ AddEnum('TMultiArea', 'maNone, maStacked, maStacked100');
+ AddEnum('TMultiBar', 'mbNone, mbSide, mbStacked, mbStacked100');
+ AddEnum('TBarStyle', 'bsRectangle, bsPyramid, bsInvPyramid, bsCilinder, ' +
+ 'bsEllipse, bsArrow, bsRectGradient');
+
+ AddEnum('TPenEndStyle', 'esRound, esSquare, esFlat');
+ AddEnum('TPenMode', 'pmBlack, pmWhite, pmNop, pmNot, pmCopy, pmNotCopy, ' +
+ 'pmMergePenNot, pmMaskPenNot, pmMergeNotPen, pmMaskNotPen, pmMerge, ' +
+ 'pmNotMerge, pmMask, pmNotMask, pmXor, pmNotXor');
+ AddEnum('TPenStyle', 'psSolid, psDash, psDot, psDashDot, psDashDotDot, psClear, psInsideFrame');
+ AddClass(TChartValueList, 'TPersistent');
+ AddClass(TChartAxisTitle, 'TPersistent');
+ AddClass(TChartAxis, 'TPersistent');
+ AddClass(TCustomChartLegend, 'TPersistent');
+ AddClass(TChartLegend, 'TCustomChartLegend');
+ AddClass(TSeriesMarks, 'TPersistent');
+ AddClass(TChartGradient, 'TPersistent');
+ AddClass(TChartWall, 'TPersistent');
+ AddClass(TChartBrush, 'TBrush');
+ AddClass(TChartTitle, 'TPersistent');
+ AddClass(TView3DOptions, 'TPersistent');
+ AddClass(TChartPen, 'TComponent');
+ with AddClass(TChartSeries, 'TComponent') do
+ begin
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure Delete(Index: Integer)', CallMethod);
+ AddMethod('function Count: Integer', CallMethod);
+ AddMethod('procedure Add(const AValue: Double; const ALabel: String; AColor: TColor)', CallMethod);
+ AddProperty('Active','Boolean', GetProp, SetProp);
+ AddProperty('ColorEachPoint','Boolean', GetProp, SetProp);
+
+ end;
+ AddClass(TSeriesPointer, 'TPersistent');
+ AddClass(TCustomSeries, 'TChartSeries');
+ AddClass(TLineSeries, 'TCustomSeries');
+ AddClass(TPointSeries, 'TCustomSeries');
+ AddClass(TAreaSeries, 'TCustomSeries');
+ with AddClass(TCustomBarSeries, 'TChartSeries') do
+ begin
+ AddProperty('Title','String', GetProp, SetProp);
+ end;
+ AddClass(TBarSeries, 'TCustomBarSeries');
+ AddClass(THorizBarSeries, 'TCustomBarSeries');
+ AddClass(TCircledSeries, 'TChartSeries');
+ AddClass(TPieSeries, 'TCircledSeries');
+ AddClass(TFastLineSeries, 'TChartSeries');
+ AddClass(TCustomChart, 'TWinControl');
+ AddClass(TChart, 'TCustomChart');
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TChartSeries then
+ begin
+ if MethodName = 'CLEAR' then
+ TChartSeries(Instance).Clear
+ else if MethodName = 'ADD' then
+ TChartSeries(Instance).Add(Caller.Params[0], String(Caller.Params[1]), Caller.Params[2])
+ else if MethodName = 'DELETE' then
+ TChartSeries(Instance).Delete(Caller.Params[0])
+ else if MethodName = 'COUNT' then
+ Result := TChartSeries(Instance).Count
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TChartSeries then
+ begin
+ if PropName = 'ACTIVE' then
+ Result := TChartSeries(Instance).Active
+ else if PropName = 'COLOREACHPOINT' then
+ Result := TChartSeries(Instance).ColorEachPoint
+ end else
+ if ClassType = TCustomBarSeries then
+ begin
+ if PropName = 'Title' then
+ Result := TCustomBarSeries(Instance).Title
+ end;
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TChartSeries then
+ begin
+ if PropName = 'ACTIVE' then
+ TChartSeries(Instance).Active := Value
+ else if PropName = 'COLOREACHPOINT' then
+ TChartSeries(Instance).ColorEachPoint := Value
+ end else
+ if ClassType = TCustomBarSeries then
+ begin
+ if PropName = 'Title' then
+ TCustomBarSeries(Instance).Title := Value
+ end
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsChartRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/FMX.fs_iclassesrtti.pas b/FastScript/FMX.fs_iclassesrtti.pas
new file mode 100644
index 0000000..97fd2ec
--- /dev/null
+++ b/FastScript/FMX.fs_iclassesrtti.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Classes.pas classes and functions }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iclassesrtti;
+{$i FMX.inc}
+{$i fs_iclassesrtti.pas}
\ No newline at end of file
diff --git a/FastScript/FMX.fs_iconst.pas b/FastScript/FMX.fs_iconst.pas
new file mode 100644
index 0000000..c23d7cf
--- /dev/null
+++ b/FastScript/FMX.fs_iconst.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Resources }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iconst;
+{$i FMX.inc}
+{$i fs_iconst.pas}
\ No newline at end of file
diff --git a/FastScript/FMX.fs_icpp.pas b/FastScript/FMX.fs_icpp.pas
new file mode 100644
index 0000000..64a3c70
--- /dev/null
+++ b/FastScript/FMX.fs_icpp.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ C++ grammar }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_icpp;
+{$i FMX.inc}
+{$i fs_icpp.pas}
\ No newline at end of file
diff --git a/FastScript/FMX.fs_idbrtti.pas b/FastScript/FMX.fs_idbrtti.pas
new file mode 100644
index 0000000..dbb1620
--- /dev/null
+++ b/FastScript/FMX.fs_idbrtti.pas
@@ -0,0 +1,570 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ DB.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_idbrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.Types, System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_itools, FMX.fs_iclassesrtti, FMX.fs_ievents,
+ Data.DB, FMX.Types;
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsDBRTTI = class(TComponent); // fake component
+
+ TfsDatasetNotifyEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Dataset: TDataset);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsFilterRecordEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(DataSet: TDataSet; var Accept: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsFieldGetTextEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TField; var Text: String; DisplayText: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TfsDatasetNotifyEvent }
+
+procedure TfsDatasetNotifyEvent.DoEvent(Dataset: TDataset);
+begin
+ CallHandler([Dataset]);
+end;
+
+function TfsDatasetNotifyEvent.GetMethod: Pointer;
+begin
+ Result := @TfsDatasetNotifyEvent.DoEvent;
+end;
+
+
+{ TfsFilterRecordEvent }
+
+procedure TfsFilterRecordEvent.DoEvent(DataSet: TDataSet; var Accept: Boolean);
+begin
+ CallHandler([DataSet, Accept]);
+ Accept := Handler.Params[1].Value;
+end;
+
+function TfsFilterRecordEvent.GetMethod: Pointer;
+begin
+ Result := @TfsFilterRecordEvent.DoEvent;
+end;
+
+
+{ TfsFieldGetTextEvent }
+
+procedure TfsFieldGetTextEvent.DoEvent(Sender: TField; var Text: String; DisplayText: Boolean);
+begin
+ CallHandler([Sender, Text, DisplayText]);
+ Text := Handler.Params[1].Value;
+end;
+
+function TfsFieldGetTextEvent.GetMethod: Pointer;
+begin
+ Result := @TfsFieldGetTextEvent.DoEvent;
+end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TFieldType', 'ftUnknown, ftString, ftSmallint, ftInteger, ftWord,' +
+ 'ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,' +
+ 'ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,' +
+ 'ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString,' +
+ 'ftLargeint, ftADT, ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob,' +
+ 'ftVariant, ftInterface, ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd');
+ AddEnum('TBlobStreamMode', 'bmRead, bmWrite, bmReadWrite');
+ AddEnumSet('TLocateOptions', 'loCaseInsensitive, loPartialKey');
+ AddEnumSet('TFilterOptions', 'foCaseInsensitive, foNoPartialCompare');
+ AddEnum('TParamType', 'ptUnknown, ptInput, ptOutput, ptInputOutput, ptResult');
+
+ with AddClass(TField, 'TComponent') do
+ begin
+ AddProperty('AsBoolean', 'Boolean', GetProp, SetProp);
+ AddProperty('AsCurrency', 'Currency', GetProp, SetProp);
+ AddProperty('AsDateTime', 'TDateTime', GetProp, SetProp);
+ AddProperty('AsFloat', 'Double', GetProp, SetProp);
+ AddProperty('AsInteger', 'Integer', GetProp, SetProp);
+ AddProperty('AsString', 'String', GetProp, SetProp);
+ AddProperty('AsVariant', 'Variant', GetProp, SetProp);
+ AddProperty('DataType', 'TFieldType', GetProp, nil);
+ AddProperty('DisplayName', 'String', GetProp, nil);
+ AddProperty('DisplayText', 'String', GetProp, nil);
+ AddProperty('IsNull', 'Boolean', GetProp, nil);
+ AddProperty('Size', 'Integer', GetProp, SetProp);
+ AddProperty('Value', 'Variant', GetProp, SetProp);
+ AddProperty('OldValue', 'Variant', GetProp, nil);
+ AddEvent('OnGetText', TfsFieldGetTextEvent);
+ end;
+ with AddClass(TFields, 'TObject') do
+ AddDefaultProperty('Fields', 'Integer', 'TField', CallMethod, True);
+ AddClass(TStringField, 'TField');
+ AddClass(TNumericField, 'TField');
+ AddClass(TIntegerField, 'TNumericField');
+ AddClass(TSmallIntField, 'TIntegerField');
+ AddClass(TWordField, 'TIntegerField');
+ AddClass(TAutoIncField, 'TIntegerField');
+ AddClass(TFloatField, 'TNumericField');
+ AddClass(TCurrencyField, 'TFloatField');
+ AddClass(TBooleanField, 'TField');
+ AddClass(TDateTimeField, 'TField');
+ AddClass(TDateField, 'TDateTimeField');
+ AddClass(TTimeField, 'TDateTimeField');
+ AddClass(TBinaryField, 'TField');
+ AddClass(TBytesField, 'TBinaryField');
+ AddClass(TVarBytesField, 'TBinaryField');
+ AddClass(TBCDField, 'TNumericField');
+ with AddClass(TBlobField, 'TField') do
+ begin
+ AddMethod('procedure LoadFromFile(const FileName: String)', CallMethod);
+ AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure SaveToFile(const FileName: String)', CallMethod);
+ AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
+ end;
+ AddClass(TMemoField, 'TBlobField');
+ AddClass(TGraphicField, 'TBlobField');
+ AddClass(TFieldDef, 'TPersistent');
+ with AddClass(TFieldDefs, 'TObject') do
+ begin
+ AddMethod('function AddFieldDef: TFieldDef', CallMethod);
+ AddMethod('function Find(const Name: string): TFieldDef', CallMethod);
+ AddMethod('procedure Add(const Name: string; DataType: TFieldType; Size: Word; Required: Boolean)', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure Update', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TFieldDef', CallMethod, True);
+ end;
+ AddClass(TDataSource, 'TComponent');
+ AddType('TBookmark', fvtVariant);
+ with AddClass(TDataSet, 'TComponent') do
+ begin
+ AddMethod('procedure Open', CallMethod);
+ AddMethod('procedure Close', CallMethod);
+ AddMethod('procedure First', CallMethod);
+ AddMethod('procedure Last', CallMethod);
+ AddMethod('procedure Next', CallMethod);
+ AddMethod('procedure Prior', CallMethod);
+ AddMethod('procedure Cancel', CallMethod);
+ AddMethod('procedure Delete', CallMethod);
+ AddMethod('procedure Post', CallMethod);
+ AddMethod('procedure Append', CallMethod);
+ AddMethod('procedure Insert', CallMethod);
+ AddMethod('procedure Edit', CallMethod);
+
+ AddMethod('function FieldByName(const FieldName: string): TField', CallMethod);
+ AddMethod('procedure GetFieldNames(List: TStrings)', CallMethod);
+ AddMethod('function FindFirst: Boolean', CallMethod);
+ AddMethod('function FindLast: Boolean', CallMethod);
+ AddMethod('function FindNext: Boolean', CallMethod);
+ AddMethod('function FindPrior: Boolean', CallMethod);
+ AddMethod('procedure FreeBookmark(Bookmark: TBookmark)', CallMethod);
+ AddMethod('function GetBookmark: TBookmark', CallMethod);
+ AddMethod('procedure GotoBookmark(Bookmark: TBookmark)', CallMethod);
+ AddMethod('function Locate(const KeyFields: string; const KeyValues: Variant;' +
+ 'Options: TLocateOptions): Boolean', CallMethod);
+ AddMethod('function IsEmpty: Boolean', CallMethod);
+ AddMethod('procedure EnableControls', CallMethod);
+ AddMethod('procedure DisableControls', CallMethod);
+
+ AddProperty('Bof', 'Boolean', GetProp, nil);
+ AddProperty('Eof', 'Boolean', GetProp, nil);
+ AddProperty('FieldCount', 'Integer', GetProp, nil);
+ AddProperty('FieldDefs', 'TFieldDefs', GetProp, nil);
+ AddProperty('Fields', 'TFields', GetProp, nil);
+ AddProperty('Filter', 'string', GetProp, SetProp);
+ AddProperty('Filtered', 'Boolean', GetProp, SetProp);
+ AddProperty('FilterOptions', 'TFilterOptions', GetProp, SetProp);
+ AddProperty('Active', 'Boolean', GetProp, SetProp);
+
+ AddEvent('BeforeOpen', TfsDatasetNotifyEvent);
+ AddEvent('AfterOpen', TfsDatasetNotifyEvent);
+ AddEvent('BeforeClose', TfsDatasetNotifyEvent);
+ AddEvent('AfterClose', TfsDatasetNotifyEvent);
+ AddEvent('BeforeInsert', TfsDatasetNotifyEvent);
+ AddEvent('AfterInsert', TfsDatasetNotifyEvent);
+ AddEvent('BeforeEdit', TfsDatasetNotifyEvent);
+ AddEvent('AfterEdit', TfsDatasetNotifyEvent);
+ AddEvent('BeforePost', TfsDatasetNotifyEvent);
+ AddEvent('AfterPost', TfsDatasetNotifyEvent);
+ AddEvent('BeforeCancel', TfsDatasetNotifyEvent);
+ AddEvent('AfterCancel', TfsDatasetNotifyEvent);
+ AddEvent('BeforeDelete', TfsDatasetNotifyEvent);
+ AddEvent('AfterDelete', TfsDatasetNotifyEvent);
+ AddEvent('BeforeScroll', TfsDatasetNotifyEvent);
+ AddEvent('AfterScroll', TfsDatasetNotifyEvent);
+ AddEvent('OnCalcFields', TfsDatasetNotifyEvent);
+ AddEvent('OnFilterRecord', TfsFilterRecordEvent);
+ AddEvent('OnNewRecord', TfsDatasetNotifyEvent);
+ end;
+
+ with AddClass(TParam, 'TPersistent') do
+ begin
+ AddMethod('procedure Clear', CallMethod);
+ AddProperty('AsBoolean', 'Boolean', GetProp, SetProp);
+ AddProperty('AsCurrency', 'Currency', GetProp, SetProp);
+ AddProperty('AsDateTime', 'TDateTime', GetProp, SetProp);
+ AddProperty('AsFloat', 'Double', GetProp, SetProp);
+ AddProperty('AsInteger', 'Integer', GetProp, SetProp);
+ AddProperty('AsDate', 'TDate', GetProp, SetProp);
+ AddProperty('AsTime', 'TTime', GetProp, SetProp);
+ AddProperty('AsString', 'String', GetProp, SetProp);
+ AddProperty('Bound', 'Boolean', GetProp, SetProp);
+ AddProperty('IsNull', 'Boolean', GetProp, nil);
+ AddProperty('Text', 'String', GetProp, SetProp);
+ end;
+ with AddClass(TParams, 'TPersistent') do
+ begin
+ AddMethod('function ParamByName(const Value: string): TParam', CallMethod);
+ AddMethod('function FindParam(const Value: string): TParam', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TParam', CallMethod, True);
+ end;
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ _TDataSet: TDataSet;
+
+ function IntToLocateOptions(i: Integer): TLocateOptions;
+ begin
+ Result := [];
+ if (i and 1) <> 0 then
+ Result := Result + [loCaseInsensitive];
+ if (i and 2) <> 0 then
+ Result := Result + [loPartialKey];
+ end;
+
+begin
+ Result := 0;
+
+ if ClassType = TFields then
+ begin
+ if MethodName = 'FIELDS.GET' then
+ Result := frxInteger(TFields(Instance)[Caller.Params[0]])
+ end
+ else if ClassType = TFieldDefs then
+ begin
+ if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TFieldDefs(Instance)[Caller.Params[0]])
+ else if MethodName = 'ADD' then
+ TFieldDefs(Instance).Add(Caller.Params[0], TFieldType(Caller.Params[1]), Caller.Params[2], Caller.Params[3])
+ else if MethodName = 'ADDFIELDDEF' then
+ Result := frxInteger(TFieldDefs(Instance).AddFieldDef)
+ else if MethodName = 'CLEAR' then
+ TFieldDefs(Instance).Clear
+ else if MethodName = 'FIND' then
+ Result := frxInteger(TFieldDefs(Instance).Find(Caller.Params[0]))
+ else if MethodName = 'UPDATE' then
+ TFieldDefs(Instance).Update
+ end
+ else if ClassType = TBlobField then
+ begin
+ if MethodName = 'LOADFROMFILE' then
+ TBlobField(Instance).LoadFromFile(Caller.Params[0])
+ else if MethodName = 'LOADFROMSTREAM' then
+ TBlobField(Instance).LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVETOFILE' then
+ TBlobField(Instance).SaveToFile(Caller.Params[0])
+ else if MethodName = 'SAVETOSTREAM' then
+ TBlobField(Instance).SaveToStream(TStream(frxInteger(Caller.Params[0])))
+ end
+ else if ClassType = TDataSet then
+ begin
+ _TDataSet := TDataSet(Instance);
+ if MethodName = 'OPEN' then
+ _TDataSet.Open
+ else if MethodName = 'CLOSE' then
+ _TDataSet.Close
+ else if MethodName = 'FIRST' then
+ _TDataSet.First
+ else if MethodName = 'LAST' then
+ _TDataSet.Last
+ else if MethodName = 'NEXT' then
+ _TDataSet.Next
+ else if MethodName = 'PRIOR' then
+ _TDataSet.Prior
+ else if MethodName = 'CANCEL' then
+ _TDataSet.Cancel
+ else if MethodName = 'DELETE' then
+ _TDataSet.Delete
+ else if MethodName = 'POST' then
+ _TDataSet.Post
+ else if MethodName = 'APPEND' then
+ _TDataSet.Append
+ else if MethodName = 'INSERT' then
+ _TDataSet.Insert
+ else if MethodName = 'EDIT' then
+ _TDataSet.Edit
+ else if MethodName = 'FIELDBYNAME' then
+ Result := frxInteger(_TDataSet.FieldByName(Caller.Params[0]))
+ else if MethodName = 'GETFIELDNAMES' then
+ _TDataSet.GetFieldNames(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'FINDFIRST' then
+ Result := _TDataSet.FindFirst
+ else if MethodName = 'FINDLAST' then
+ Result := _TDataSet.FindLast
+ else if MethodName = 'FINDNEXT' then
+ Result := _TDataSet.FindNext
+ else if MethodName = 'FINDPRIOR' then
+ Result := _TDataSet.FindPrior
+ else if MethodName = 'FREEBOOKMARK' then
+ _TDataSet.FreeBookmark(TBookMark(frxInteger(Caller.Params[0])))
+{$IFNDEF CPUX64}
+ else if MethodName = 'GETBOOKMARK' then
+ Result := frxInteger(_TDataSet.GetBookmark)
+{$ENDIF}
+ else if MethodName = 'GOTOBOOKMARK' then
+ _TDataSet.GotoBookmark(TBookMark(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LOCATE' then
+ Result := _TDataSet.Locate(Caller.Params[0], Caller.Params[1], IntToLocateOptions(Caller.Params[2]))
+ else if MethodName = 'ISEMPTY' then
+ Result := _TDataSet.IsEmpty
+ else if MethodName = 'ENABLECONTROLS' then
+ _TDataSet.EnableControls
+ else if MethodName = 'DISABLECONTROLS' then
+ _TDataSet.DisableControls
+ end
+ else if ClassType = TParam then
+ begin
+ if MethodName = 'CLEAR' then
+ TParam(Instance).Clear
+ end
+ else if ClassType = TParams then
+ begin
+ if MethodName = 'PARAMBYNAME' then
+ Result := frxInteger(TParams(Instance).ParamByName(Caller.Params[0]))
+ else if MethodName = 'FINDPARAM' then
+ Result := frxInteger(TParams(Instance).FindParam(Caller.Params[0]))
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TParams(Instance)[Caller.Params[0]])
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+var
+ _TField: TField;
+ _TParam: TParam;
+ _TDataSet: TDataSet;
+
+ function FilterOptionsToInt(f: TFilterOptions): Integer;
+ begin
+ Result := 0;
+ if foCaseInsensitive in f then
+ Result := Result or 1;
+ if foNoPartialCompare in f then
+ Result := Result or 2;
+ end;
+
+begin
+ Result := 0;
+
+ if ClassType = TField then
+ begin
+ _TField := TField(Instance);
+ if PropName = 'ASBOOLEAN' then
+ Result := _TField.AsBoolean
+ else if PropName = 'ASCURRENCY' then
+ Result := _TField.AsCurrency
+ else if PropName = 'ASDATETIME' then
+ Result := _TField.AsDateTime
+ else if PropName = 'ASFLOAT' then
+ Result := _TField.AsFloat
+ else if PropName = 'ASINTEGER' then
+ Result := _TField.AsInteger
+ else if PropName = 'ASSTRING' then
+ Result := _TField.AsString
+ else if PropName = 'ASVARIANT' then
+ Result := _TField.AsVariant
+ else if PropName = 'DATATYPE' then
+ Result := _TField.DataType
+ else if PropName = 'DISPLAYNAME' then
+ Result := _TField.DisplayName
+ else if PropName = 'DISPLAYTEXT' then
+ Result := _TField.DisplayText
+ else if PropName = 'ISNULL' then
+ Result := _TField.IsNull
+ else if PropName = 'SIZE' then
+ Result := _TField.Size
+ else if PropName = 'VALUE' then
+ Result := _TField.Value
+ else if PropName = 'OLDVALUE' then
+ Result := _TField.OldValue
+ end
+ else if ClassType = TDataSet then
+ begin
+ _TDataSet := TDataSet(Instance);
+ if PropName = 'BOF' then
+ Result := _TDataSet.Bof
+ else if PropName = 'EOF' then
+ Result := _TDataSet.Eof
+ else if PropName = 'FIELDCOUNT' then
+ Result := _TDataSet.FieldCount
+ else if PropName = 'FIELDDEFS' then
+ Result := frxInteger(_TDataSet.FieldDefs)
+ else if PropName = 'FIELDS' then
+ Result := frxInteger(_TDataSet.Fields)
+ else if PropName = 'FILTER' then
+ Result := _TDataSet.Filter
+ else if PropName = 'FILTERED' then
+ Result := _TDataSet.Filtered
+ else if PropName = 'FILTEROPTIONS' then
+ Result := FilterOptionsToInt(_TDataSet.FilterOptions)
+ else if PropName = 'ACTIVE' then
+ Result := _TDataSet.Active
+ end
+ else if ClassType = TParam then
+ begin
+ _TParam := TParam(Instance);
+ if PropName = 'BOUND' then
+ Result := _TParam.Bound
+ else if PropName = 'ISNULL' then
+ Result := _TParam.IsNull
+ else if PropName = 'TEXT' then
+ Result := _TParam.Text
+ else if PropName = 'ASBOOLEAN' then
+ Result := _TParam.AsBoolean
+ else if PropName = 'ASCURRENCY' then
+ Result := _TParam.AsCurrency
+ else if PropName = 'ASDATETIME' then
+ Result := _TParam.AsDateTime
+ else if PropName = 'ASFLOAT' then
+ Result := _TParam.AsFloat
+ else if PropName = 'ASINTEGER' then
+ Result := _TParam.AsInteger
+ else if PropName = 'ASDATE' then
+ Result := _TParam.AsDate
+ else if PropName = 'ASTIME' then
+ Result := _TParam.AsTime
+ else if PropName = 'ASSTRING' then
+ Result := _TParam.AsString
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+var
+ _TField: TField;
+ _TParam: TParam;
+ _TDataSet: TDataSet;
+
+ function IntToFilterOptions(i: Integer): TFilterOptions;
+ begin
+ Result := [];
+ if (i and 1) <> 0 then
+ Result := Result + [foCaseInsensitive];
+ if (i and 2) <> 0 then
+ Result := Result + [foNoPartialCompare];
+ end;
+
+begin
+ if ClassType = TField then
+ begin
+ _TField := TField(Instance);
+ if PropName = 'ASBOOLEAN' then
+ _TField.AsBoolean := Value
+ else if PropName = 'ASCURRENCY' then
+ _TField.AsCurrency := Value
+ else if PropName = 'ASDATETIME' then
+ _TField.AsDateTime := Value
+ else if PropName = 'ASFLOAT' then
+ _TField.AsFloat := Value
+ else if PropName = 'ASINTEGER' then
+ _TField.AsInteger := Value
+ else if PropName = 'ASSTRING' then
+ _TField.AsString := Value
+ else if PropName = 'ASVARIANT' then
+ _TField.AsVariant := Value
+ else if PropName = 'VALUE' then
+ _TField.Value := Value
+ else if PropName = 'SIZE' then
+ _TField.Size := Value
+ end
+ else if ClassType = TDataSet then
+ begin
+ _TDataSet := TDataSet(Instance);
+ if PropName = 'FILTER' then
+ _TDataSet.Filter := Value
+ else if PropName = 'FILTERED' then
+ _TDataSet.Filtered := Value
+ else if PropName = 'FILTEROPTIONS' then
+ _TDataSet.FilterOptions := IntToFilterOptions(Value)
+ else if PropName = 'ACTIVE' then
+ _TDataSet.Active := Value
+ end
+ else if ClassType = TParam then
+ begin
+ _TParam := TParam(Instance);
+ if PropName = 'ASBOOLEAN' then
+ _TParam.AsBoolean := Value
+ else if PropName = 'ASCURRENCY' then
+ _TParam.AsCurrency := Value
+ else if PropName = 'ASDATETIME' then
+ _TParam.AsDateTime := Value
+ else if PropName = 'ASFLOAT' then
+ _TParam.AsFloat := Value
+ else if PropName = 'ASINTEGER' then
+ _TParam.AsInteger := Value
+ else if PropName = 'ASDATE' then
+ _TParam.AsDate := Value
+ else if PropName = 'ASTIME' then
+ _TParam.AsTime := Value
+ else if PropName = 'ASSTRING' then
+ _TParam.AsString := Value
+ else if PropName = 'BOUND' then
+ _TParam.Bound := Value
+ else if PropName = 'TEXT' then
+ _TParam.Text := Value
+ end
+end;
+
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsDBRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/FMX.fs_idialogsrtti.pas b/FastScript/FMX.fs_idialogsrtti.pas
new file mode 100644
index 0000000..0d12fba
--- /dev/null
+++ b/FastScript/FMX.fs_idialogsrtti.pas
@@ -0,0 +1,133 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Dialogs.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_idialogsrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_iclassesrtti, FMX.Types
+, FMX.Dialogs, System.UITypes, System.Types
+{$IFDEF DELPHI19}
+, FMX.Printer
+{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsDialogsRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ THackDialog = class(TCommonDialog);
+
+
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+type
+ TWordSet = set of 0..15;
+ PWordSet = ^TWordSet;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+var
+ dlg: String;
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnumSet('TOpenOptions', 'ofReadOnly, ofOverwritePrompt, ofHideReadOnly,' +
+ 'ofNoChangeDir, ofShowHelp, ofNoValidate, ofAllowMultiSelect,' +
+ 'ofExtensionDifferent, ofPathMustExist, ofFileMustExist, ofCreatePrompt,' +
+ 'ofShareAware, ofNoReadOnlyReturn, ofNoTestFileCreate, ofNoNetworkButton,' +
+ 'ofNoLongNames, ofOldStyleDialog, ofNoDereferenceLinks, ofEnableIncludeNotify,' +
+ 'ofEnableSizing');
+ AddEnum('TFileEditStyle', 'fsEdit, fsComboBox');
+ AddEnumSet('TColorDialogOptions', 'cdFullOpen, cdPreventFullOpen, cdShowHelp,' +
+ 'cdSolidColor, cdAnyColor');
+ AddEnumSet('TFontDialogOptions', 'fdAnsiOnly, fdTrueTypeOnly, fdEffects,' +
+ 'fdFixedPitchOnly, fdForceFontExist, fdNoFaceSel, fdNoOEMFonts,' +
+ 'fdNoSimulations, fdNoSizeSel, fdNoStyleSel, fdNoVectorFonts,' +
+ 'fdShowHelp, fdWysiwyg, fdLimitSize, fdScalableOnly, fdApplyButton');
+ AddEnum('TFontDialogDevice', 'fdScreen, fdPrinter, fdBoth');
+ AddEnum('TPrintRange', 'prAllPages, prSelection, prPageNums');
+ AddEnumSet('TPrintDialogOptions', 'poPrintToFile, poPageNums, poSelection,' +
+ 'poWarning, poHelp, poDisablePrintToFile');
+ AddEnum('TMsgDlgType', 'mtCustom, mtInformation, mtWarning, mtError, mtConfirmation');
+ AddEnumSet('TMsgDlgButtons', 'mbNone, mbOk, mbCancel, mbYes, mbNo, mbAbort, ' +
+ 'mbRetry, mbIgnore');
+
+
+ with AddClass(TCommonDialog, 'TComponent') do
+ AddMethod('function Execute: Boolean', CallMethod);
+ AddClass(TOpenDialog, 'TCommonDialog');
+ AddClass(TSaveDialog, 'TCommonDialog');
+ AddClass(TPrintDialog, dlg);
+ AddClass(TPrinterSetupDialog, dlg);
+
+ AddMethod('function MessageDlg(Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer', CallMethod, 'ctOther');
+ AddMethod('function InputBox(ACaption, APrompt, ADefault: string): string', CallMethod, 'ctOther');
+ AddMethod('function InputQuery(ACaption, APrompt: string; var Value: string): Boolean', CallMethod, 'ctOther');
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ s: String;
+ b: TMsgDlgButtons;
+begin
+ Result := 0;
+
+ if ClassType = TCommonDialog then
+ begin
+ if MethodName = 'EXECUTE' then
+ Result := THackDialog(Instance).Execute
+ end
+ else if MethodName = 'INPUTBOX' then
+ Result := InputBox(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'INPUTQUERY' then
+ begin
+ s := Caller.Params[2];
+ Result := InputQuery(Caller.Params[0], Caller.Params[1], s);
+ Caller.Params[2] := s;
+ end
+ else if MethodName = 'MESSAGEDLG' then
+ begin
+ Word(PWordSet(@b)^) := Caller.Params[2];
+ Result := MessageDlg(Caller.Params[0], Caller.Params[1], b, Caller.Params[3]);
+ end
+end;
+
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsDialogsRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
\ No newline at end of file
diff --git a/FastScript/FMX.fs_idisp.pas b/FastScript/FMX.fs_idisp.pas
new file mode 100644
index 0000000..3ce8fda
--- /dev/null
+++ b/FastScript/FMX.fs_idisp.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ OLE dispatch module }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_idisp;
+{$i FMX.inc}
+{$i fs_idisp.pas}
\ No newline at end of file
diff --git a/FastScript/FMX.fs_ievents.pas b/FastScript/FMX.fs_ievents.pas
new file mode 100644
index 0000000..2d6981e
--- /dev/null
+++ b/FastScript/FMX.fs_ievents.pas
@@ -0,0 +1,379 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Standard events }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_ievents;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Controls, FMX.Forms, System.UITypes, FMX.Types,
+ System.Types, System.Rtti, FMX.fs_iinterpreter, FMX.fs_iclassesrtti
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+type
+
+ PDragObject = ^TDragObject;
+ TfsDragObject = class(TPersistent)
+ private
+ FDragObject: TDragObject;
+ FFiles: TStringList;
+ function GetStringList: TStringList;
+ public
+ function GetRect: TDragObject;
+ function GetRectP: PDragObject;
+ constructor Create(aDragObj: TDragObject);
+ destructor Destroy; override;
+ published
+ property Source: TObject read FDragObject.Source write FDragObject.Source;
+ property Data: {$IFDEF Delphi17}TValue{$ELSE}Variant{$ENDIF} read FDragObject.Data write FDragObject.Data;
+ property Files: TStringList read GetStringList;
+ end;
+
+ TfsNotifyEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsMouseEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Single);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsMouseMoveEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; Shift: TShiftState; X, Y: Single);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsMouseWheelEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsOnPaintEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsCanFocusEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var ACanFocus: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsDragOverEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; const Data: TDragObject; const Point: TPointF; var Accept: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsDragDropEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsKeyEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsKeyPressEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var Key: Char);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsCloseEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var Action: TCloseAction);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsCloseQueryEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var CanClose: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsCanResizeEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var NewWidth, NewHeight: Integer;
+ var Resize: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+
+implementation
+
+
+type
+ TByteSet = set of 0..7;
+ PByteSet = ^TByteSet;
+
+
+{ TfsNotifyEvent }
+
+procedure TfsNotifyEvent.DoEvent(Sender: TObject);
+begin
+ CallHandler([Sender]);
+end;
+
+function TfsNotifyEvent.GetMethod: Pointer;
+begin
+ Result := @TfsNotifyEvent.DoEvent;
+end;
+
+{ TfsMouseEvent }
+
+procedure TfsMouseEvent.DoEvent(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Single);
+var
+ b: Byte;
+begin
+ b := Byte(PByteSet(@Shift)^);
+ CallHandler([Sender, Integer(Button), b, X, Y]);
+end;
+
+function TfsMouseEvent.GetMethod: Pointer;
+begin
+ Result := @TfsMouseEvent.DoEvent;
+end;
+
+{ TfsMouseMoveEvent }
+
+procedure TfsMouseMoveEvent.DoEvent(Sender: TObject; Shift: TShiftState; X,
+ Y: Single);
+var
+ b: Byte;
+begin
+ b := Byte(PByteSet(@Shift)^);
+ CallHandler([Sender, b, X, Y]);
+end;
+
+function TfsMouseMoveEvent.GetMethod: Pointer;
+begin
+ Result := @TfsMouseMoveEvent.DoEvent;
+end;
+
+{ TfsKeyEvent }
+
+procedure TfsKeyEvent.DoEvent(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+var
+ b: Byte;
+begin
+ b := Byte(PByteSet(@Shift)^);
+ CallHandler([Sender, Key, KeyChar, b]);
+ Key := Handler.Params[1].Value;
+ KeyChar := WideChar(Cardinal(Handler.Params[2].Value));
+end;
+
+function TfsKeyEvent.GetMethod: Pointer;
+begin
+ Result := @TfsKeyEvent.DoEvent;
+end;
+
+{ TfsKeyPressEvent }
+
+procedure TfsKeyPressEvent.DoEvent(Sender: TObject; var Key: Char);
+begin
+ CallHandler([Sender, Key]);
+ Key := String(Handler.Params[1].Value)[1];
+end;
+
+function TfsKeyPressEvent.GetMethod: Pointer;
+begin
+ Result := @TfsKeyPressEvent.DoEvent;
+end;
+
+{ TfsCloseEvent }
+
+procedure TfsCloseEvent.DoEvent(Sender: TObject; var Action: TCloseAction);
+begin
+ CallHandler([Sender, Integer(Action)]);
+ Action := Handler.Params[1].Value;
+end;
+
+function TfsCloseEvent.GetMethod: Pointer;
+begin
+ Result := @TfsCloseEvent.DoEvent;
+end;
+
+{ TfsCloseQueryEvent }
+
+procedure TfsCloseQueryEvent.DoEvent(Sender: TObject; var CanClose: Boolean);
+begin
+ CallHandler([Sender, CanClose]);
+ CanClose := Handler.Params[1].Value;
+end;
+
+function TfsCloseQueryEvent.GetMethod: Pointer;
+begin
+ Result := @TfsCloseQueryEvent.DoEvent;
+end;
+
+{ TfsCanResizeEvent }
+
+procedure TfsCanResizeEvent.DoEvent(Sender: TObject; var NewWidth,
+ NewHeight: Integer; var Resize: Boolean);
+begin
+ CallHandler([Sender, NewWidth, NewHeight, Resize]);
+ NewWidth := Handler.Params[1].Value;
+ NewHeight := Handler.Params[2].Value;
+ Resize := Handler.Params[3].Value;
+end;
+
+function TfsCanResizeEvent.GetMethod: Pointer;
+begin
+ Result := @TfsCanResizeEvent.DoEvent;
+end;
+
+{ TfsMouseWheelEvent }
+
+procedure TfsMouseWheelEvent.DoEvent(Sender: TObject;
+ Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
+var
+ b: Byte;
+begin
+ b := Byte(PByteSet(@Shift)^);
+ CallHandler([Sender, b, WheelDelta, Boolean(Handled)]);
+ Handled := Handler.Params[3].Value;
+end;
+
+function TfsMouseWheelEvent.GetMethod: Pointer;
+begin
+ Result := @TfsMouseWheelEvent.DoEvent;
+end;
+
+{ TfsOnPaintEvent }
+
+procedure TfsOnPaintEvent.DoEvent(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF);
+var
+ r: TfsRectF;
+begin
+ r := TfsRectF.Create(ARect);
+ CallHandler([Sender, Canvas, r]);
+ r.Free;
+end;
+
+function TfsOnPaintEvent.GetMethod: Pointer;
+begin
+ Result := @TfsOnPaintEvent.DoEvent;
+end;
+
+{ TfsCanFocusEvent }
+
+procedure TfsCanFocusEvent.DoEvent(Sender: TObject; var ACanFocus: Boolean);
+begin
+ CallHandler([Sender, ACanFocus]);
+ ACanFocus := Handler.Params[1].Value;
+end;
+
+function TfsCanFocusEvent.GetMethod: Pointer;
+begin
+ Result := @TfsCanFocusEvent.DoEvent;
+end;
+
+{ TfsDragOverEvent }
+
+procedure TfsDragOverEvent.DoEvent(Sender: TObject; const Data: TDragObject;
+ const Point: TPointF; var Accept: Boolean);
+var
+ dObj: TfsDragObject;
+begin
+ dObj := TfsDragObject.Create(Data);
+ CallHandler([Sender, dObj, Accept]);
+ dObj.Free;
+ Accept := Handler.Params[3].Value;
+end;
+
+function TfsDragOverEvent.GetMethod: Pointer;
+begin
+ Result := @TfsDragOverEvent.DoEvent;
+end;
+
+{ TfsDragObject }
+
+constructor TfsDragObject.Create(aDragObj: TDragObject);
+var
+ idx: Integer;
+begin
+ FFiles := TStringList.Create;
+ FDragObject.Source := aDragObj.Source;
+ FDragObject.Data := aDragObj.Data;
+ for idx := Low(FDragObject.Files) to High(FDragObject.Files) do
+ FFiles.Add(FDragObject.Files[idx]);
+end;
+
+destructor TfsDragObject.Destroy;
+begin
+ FFiles.Free;
+ inherited;
+end;
+
+function TfsDragObject.GetRect: TDragObject;
+var
+ idx: Integer;
+begin
+ SetLength(FDragObject.Files, FFiles.Count);
+ for idx := 0 to FFiles.Count - 1 do
+ FDragObject.Files[idx] := FFiles.Strings[idx];
+ Result := FDragObject;
+end;
+
+function TfsDragObject.GetRectP: PDragObject;
+var
+ idx: Integer;
+begin
+ SetLength(FDragObject.Files, FFiles.Count);
+ for idx := 0 to FFiles.Count - 1 do
+ FDragObject.Files[idx] := FFiles.Strings[idx];
+ Result := @FDragObject;
+end;
+
+function TfsDragObject.GetStringList: TStringList;
+begin
+ Result := FFiles;
+end;
+
+{ TfsDragDropEvent }
+
+procedure TfsDragDropEvent.DoEvent(Sender: TObject; const Data: TDragObject;
+ const Point: TPointF);
+var
+ dObj: TfsDragObject;
+ aPoint: TfsPointF;
+begin
+ dObj := TfsDragObject.Create(Data);
+ aPoint := TfsPointF.Create(Point);
+ CallHandler([Sender, dObj, aPoint]);
+ dObj.Free;
+ aPoint.Free;
+end;
+
+function TfsDragDropEvent.GetMethod: Pointer;
+begin
+ Result := @TfsDragDropEvent.DoEvent;
+end;
+
+end.
\ No newline at end of file
diff --git a/FastScript/FMX.fs_iexpression.pas b/FastScript/FMX.fs_iexpression.pas
new file mode 100644
index 0000000..f429d38
--- /dev/null
+++ b/FastScript/FMX.fs_iexpression.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Expression parser }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iexpression;
+{$i FMX.inc}
+{$i fs_iexpression.pas}
\ No newline at end of file
diff --git a/FastScript/FMX.fs_iextctrlsrtti.pas b/FastScript/FMX.fs_iextctrlsrtti.pas
new file mode 100644
index 0000000..5bd17eb
--- /dev/null
+++ b/FastScript/FMX.fs_iextctrlsrtti.pas
@@ -0,0 +1,268 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ ExtCtrls }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iextctrlsrtti;
+
+interface
+
+{$i fs.inc}
+
+uses System.Types, System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_ievents, FMX.fs_iformsrtti
+, FMX.ExtCtrls, FMX.ListBox, FMX.Objects, System.UITypes, FMX.Types, FMX.Controls, FMX.Layouts,
+ FMX.TabControl, FMX.TreeView
+{$IFDEF DELPHI18}
+ , FMX.StdCtrls
+{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsExtCtrlsRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TfsTreeViewDragChange = class(TfsCustomEvent)
+ public
+ procedure DoEvent(SourceItem, DestItem: TTreeViewItem; var Allow: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TShapeType', 'stRectangle, stSquare, stRoundRect, stRoundSquare,' +
+ 'stEllipse, stCircle');
+ AddEnum('TBevelStyle', 'bsLowered, bsRaised');
+ AddEnum('TBevelShape', 'bsBox, bsFrame, bsTopLine, bsBottomLine, bsLeftLine,' +
+ 'bsRightLine, bsSpacer');
+ AddEnum('TResizeStyle', 'rsNone, rsLine, rsUpdate, rsPattern');
+ AddEnum('TButtonLayout', 'blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom');
+ AddEnum('TButtonState', 'bsUp, bsDisabled, bsDown, bsExclusive');
+ AddEnum('TButtonStyle', 'bsAutoDetect, bsWin31, bsNew');
+ AddEnum('TBitBtnKind', 'bkCustom, bkOK, bkCancel, bkHelp, bkYes, bkNo,' +
+ 'bkClose, bkAbort, bkRetry, bkIgnore, bkAll');
+ AddType('TNumGlyphs', fvtInt);
+ AddEnum('TTabPosition', 'tpTop, tpBottom, tpLeft, tpRight');
+ AddEnum('TTabStyle', 'tsTabs, tsButtons, tsFlatButtons');
+ AddEnum('TStatusPanelStyle', 'psText, psOwnerDraw');
+ AddEnum('TStatusPanelBevel', 'pbNone, pbLowered, pbRaised');
+ AddEnum('TSortType', 'stNone, stData, stText, stBoth');
+ AddEnum('TTrackBarOrientation', 'trHorizontal, trVertical');
+ AddEnum('TTickMark', 'tmBottomRight, tmTopLeft, tmBoth');
+ AddEnum('TTickStyle', 'tsNone, tsAuto, tsManual');
+ AddEnum('TProgressBarOrientation', 'pbHorizontal, pbVertical');
+ AddEnum('TIconArrangement', 'iaTop, iaLeft');
+ AddEnum('TListArrangement', 'arAlignBottom, arAlignLeft, arAlignRight,' +
+ 'arAlignTop, arDefault, arSnapToGrid');
+ AddEnum('TViewStyle', 'vsIcon, vsSmallIcon, vsList, vsReport');
+ AddEnum('TToolButtonStyle', 'tbsButton, tbsCheck, tbsDropDown, tbsSeparator, tbsDivider');
+ AddEnum('TDateTimeKind', 'dtkDate, dtkTime');
+ AddEnum('TDTDateMode', 'dmComboBox, dmUpDown');
+ AddEnum('TDTDateFormat', 'dfShort, dfLong');
+ AddEnum('TDTCalAlignment', 'dtaLeft, dtaRight');
+ AddEnum('TCalDayOfWeek', 'dowMonday, dowTuesday, dowWednesday, dowThursday,' +
+ 'dowFriday, dowSaturday, dowSunday, dowLocaleDefault');
+
+
+ with AddClass(TPaintBox, 'TControl') do
+ AddEvent('OnPaint', TfsNotifyEvent);
+ AddClass(TImage, 'TControl');
+ with AddClass(TTimer, 'TComponent') do
+ AddEvent('OnTimer', TfsNotifyEvent);
+
+ AddClass(TTabItem, 'TTextControl');
+ with AddClass(TTabControl, 'TStyledControl') do
+ begin
+ AddIndexProperty( 'Tabs', 'Integer', 'TTabItem', CallMethod);
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddProperty('TabCount', 'Integer', GetProp, nil);
+ AddProperty('ActiveTab', 'TTabItem', GetProp, SetProp);
+ end;
+
+ with AddClass(TTreeViewItem, 'TTextControl') do
+ begin
+ AddMethod('function ItemByPoint(const X, Y: Single): TTreeViewItem', CallMethod);
+ AddMethod('function ItemByIndex(const Idx: Integer): TTreeViewItem', CallMethod);
+ AddMethod('function TreeView: TCustomTreeView', CallMethod);
+ AddMethod('function Level: Integer', CallMethod);
+ AddMethod('function ParentItem: TTreeViewItem', CallMethod);
+ AddIndexProperty( 'Items', 'Integer', 'TTreeViewItem', CallMethod);
+ AddProperty('GlobalIndex', 'Integer', GetProp, SetProp);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ end;
+ with AddClass(TTreeView, 'TScrollBox') do
+ begin
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure CollapseAll', CallMethod);
+ AddMethod('procedure ExpandAll', CallMethod);
+ AddMethod('function ItemByText(const AText: string): TTreeViewItem', CallMethod);
+ AddMethod('function ItemByPoint(const X, Y: Single): TTreeViewItem', CallMethod);
+ AddMethod('function ItemByIndex(const Idx: Integer): TTreeViewItem', CallMethod);
+ AddMethod('function ItemByGlobalIndex(const Idx: Integer): TTreeViewItem', CallMethod);
+ AddIndexProperty('Items', 'Integer', 'TTreeViewItem', CallMethod);
+ AddProperty('Selected', 'TTreeViewItem', GetProp, SetProp);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddProperty('GlobalCount', 'Integer', GetProp, nil);
+ AddProperty('CountExpanded', 'Integer', GetProp, nil);
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddEvent('OnChangeCheck', TfsNotifyEvent);
+ AddEvent('OnDragChange', TfsTreeViewDragChange);
+ end;
+
+ { TODO ADD necessary methods for these calasses }
+ //AddClass(TCalendar, 'TStyledControl');
+ //AddClass(TCalendarBox, 'TTextControl');
+ // AddClass(TCalendarEdit, 'TCustomEdit');
+ AddClass(TImageViewer, 'TScrollBox');
+ AddClass(TPlotGrid, 'TControl');
+ AddClass(TDropTarget, 'TTextControl');
+ AddClass(TCornerButton, 'TCustomButton');
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+ if ClassType = TTabControl then
+ begin
+ if MethodName = 'TABS.GET' then
+ Result := frxInteger(TTabControl(Instance).Tabs[Caller.Params[0]])
+ end
+ else if ClassType = TTreeViewItem then
+ begin
+ if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TTreeViewItem(Instance).Items[Caller.Params[0]])
+ else if MethodName = 'ITEMBYPOINT' then
+ Result := frxInteger(TTreeViewItem(Instance).ItemByPoint(Single(Caller.Params[0]), Single(Caller.Params[1])))
+ else if MethodName = 'ITEMBYINDEX' then
+ Result := frxInteger(TTreeViewItem(Instance).ItemByIndex(Caller.Params[0]))
+ else if MethodName = 'TREEVIEW' then
+ Result := frxInteger(TTreeViewItem(Instance).TreeView)
+ else if MethodName = 'LEVEL' then
+ Result := Integer(TTreeViewItem(Instance).Level)
+ else if MethodName = 'PARENTITEM' then
+ Result := frxInteger(TTreeViewItem(Instance).ParentItem)
+ end
+ else if ClassType = TTreeView then
+ begin
+ if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TTreeView(Instance).Items[Caller.Params[0]])
+ else if MethodName = 'ITEMBYPOINT' then
+ Result := frxInteger(TTreeView(Instance).ItemByPoint(Single(Caller.Params[0]), Single(Caller.Params[1])))
+ else if MethodName = 'ITEMBYINDEX' then
+ Result := frxInteger(TTreeView(Instance).ItemByIndex(Caller.Params[0]))
+ else if MethodName = 'ITEMBYTEXT' then
+ Result := frxInteger(TTreeView(Instance).ItemByText(String(Caller.Params[0])))
+ else if MethodName = 'ITEMBYGLOBALINDEX' then
+ Result := frxInteger(TTreeView(Instance).ItemByGlobalIndex(Caller.Params[0]))
+ else if MethodName = 'CLEAR' then
+ TTreeView(Instance).Clear
+ else if MethodName = 'COLLAPSEALL' then
+ TTreeView(Instance).CollapseAll
+ else if MethodName = 'EXPANDALL' then
+ TTreeView(Instance).ExpandAll
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+ if ClassType = TTabControl then
+ begin
+ if PropName = 'TABCOUNT' then
+ Result := TTabControl(Instance).TabCount
+ else if PropName = 'ACTIVETAB' then
+ Result := frxInteger(TTabControl(Instance).ActiveTab)
+ end
+ else if ClassType = TTreeViewItem then
+ begin
+ if PropName = 'GLOBALINDEX' then
+ Result := TTreeViewItem(Instance).GlobalIndex
+ else if PropName = 'COUNT' then
+ Result := TTreeViewItem(Instance).Count
+ end
+ else if ClassType = TTreeView then
+ begin
+ if PropName = 'SELECTED' then
+ Result := frxInteger(TTreeView(Instance).Selected)
+ else if PropName = 'COUNT' then
+ Result := TTreeView(Instance).Count
+ else if PropName = 'GLOBALCOUNT' then
+ Result := TTreeView(Instance).GlobalCount
+ else if PropName = 'COUNTEXPANDED' then
+ Result := TTreeView(Instance).CountExpanded
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TTabControl then
+ begin
+ if PropName = 'ACTIVETAB' then
+ TTabControl(Instance).ActiveTab := TTabItem(frxInteger(Value))
+ end
+ else if ClassType = TTreeViewItem then
+ begin
+// if PropName = 'GLOBALINDEX' then
+// TTreeViewItem(Instance).GlobalIndex := Value
+ end
+ else if ClassType = TTreeView then
+ begin
+ if PropName = 'SELECTED' then
+ TTreeView(Instance).Selected := TTreeViewItem(frxInteger(Value))
+ end
+end;
+
+{ TfsTreeViewDragChange }
+
+procedure TfsTreeViewDragChange.DoEvent(SourceItem, DestItem: TTreeViewItem;
+ var Allow: Boolean);
+begin
+ CallHandler([SourceItem, DestItem, Allow]);
+ Allow := Handler.Params[2].Value;
+end;
+
+function TfsTreeViewDragChange.GetMethod: Pointer;
+begin
+ Result := @TfsTreeViewDragChange.DoEvent;
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsExtCtrlsRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/FMX.fs_iformsrtti.pas b/FastScript/FMX.fs_iformsrtti.pas
new file mode 100644
index 0000000..6edb4c0
--- /dev/null
+++ b/FastScript/FMX.fs_iformsrtti.pas
@@ -0,0 +1,864 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Forms and StdCtrls }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iformsrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_ievents, FMX.fs_iclassesrtti,
+ FMX.fs_igraphicsrtti, FMX.Types, FMX.Controls, FMX.Forms, System.UITypes, System.Types,
+ FMX.Edit, FMX.Memo, FMX.ListBox, FMX.Layouts
+{$IFDEF DELPHI18}
+ , FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF}
+ ;
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsFormsRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddConst('mrNone', 'Integer', mrNone);
+ AddConst('mrOk', 'Integer', mrOk);
+ AddConst('mrCancel', 'Integer', mrCancel);
+ AddConst('mrAbort', 'Integer', mrAbort);
+ AddConst('mrRetry', 'Integer', mrRetry);
+ AddConst('mrIgnore', 'Integer', mrIgnore);
+ AddConst('mrYes', 'Integer', mrYes);
+ AddConst('mrNo', 'Integer', mrNo);
+ AddConst('mrAll', 'Integer', mrAll);
+ AddConst('mrNoToAll', 'Integer', mrNoToAll);
+ AddConst('mrYesToAll', 'Integer', mrYesToAll);
+
+ AddConst('crDefault', 'Integer', crDefault);
+ AddConst('crNone', 'Integer', crNone);
+ AddConst('crArrow', 'Integer', crArrow);
+ AddConst('crCross', 'Integer', crCross);
+ AddConst('crIBeam', 'Integer', crIBeam);
+ AddConst('crSize', 'Integer', crSize);
+ AddConst('crSizeNESW', 'Integer', crSizeNESW);
+ AddConst('crSizeNS', 'Integer', crSizeNS);
+ AddConst('crSizeNWSE', 'Integer', crSizeNWSE);
+ AddConst('crSizeWE', 'Integer', crSizeWE);
+ AddConst('crUpArrow', 'Integer', crUpArrow);
+ AddConst('crHourGlass', 'Integer', crHourGlass);
+ AddConst('crDrag', 'Integer', crDrag);
+ AddConst('crNoDrop', 'Integer', crNoDrop);
+ AddConst('crHSplit', 'Integer', crHSplit);
+ AddConst('crVSplit', 'Integer', crVSplit);
+ AddConst('crMultiDrag', 'Integer', crMultiDrag);
+ AddConst('crSQLWait', 'Integer', crSQLWait);
+ AddConst('crNo', 'Integer', crNo);
+ AddConst('crAppStart', 'Integer', crAppStart);
+ AddConst('crHelp', 'Integer', crHelp);
+ AddConst('crHandPoint', 'Integer', crHandPoint);
+ AddConst('crSizeAll', 'Integer', crSizeAll);
+
+{$IFDEF CLX}
+ AddConst('bsNone', 'Integer', fbsNone);
+ AddConst('bsSingle', 'Integer', fbsSingle);
+ AddConst('bsSizeable', 'Integer', fbsSizeable);
+ AddConst('bsDialog', 'Integer', fbsDialog);
+ AddConst('bsToolWindow', 'Integer', fbsToolWindow);
+ AddConst('bsSizeToolWin', 'Integer', fbsSizeToolWin);
+{$ELSE}
+ AddConst('bsNone', 'Integer', TFmxFormBorderStyle.bsNone);
+ AddConst('bsSingle', 'Integer', TFmxFormBorderStyle.bsSingle);
+ AddConst('bsSizeable', 'Integer', TFmxFormBorderStyle.bsSizeable);
+ AddConst('bsToolWindow', 'Integer', TFmxFormBorderStyle.bsToolWindow);
+ AddConst('bsSizeToolWin', 'Integer', TFmxFormBorderStyle.bsSizeToolWin);
+{$ENDIF}
+
+ AddConst('VK_RBUTTON', 'Integer', VKRBUTTON);
+ AddConst('VKCANCEL', 'Integer', VKCANCEL);
+ AddConst('VKMBUTTON', 'Integer', VKMBUTTON);
+ AddConst('VKBACK', 'Integer', VKBACK);//Backspace key
+ AddConst('VKTAB', 'Integer', VKTAB);//Tab key
+ AddConst('VKRETURN', 'Integer', VKRETURN);//Enter key
+ AddConst('VKSHIFT', 'Integer', VKSHIFT);//Shift key
+ AddConst('VKCONTROL', 'Integer', VKCONTROL);//Ctrl key
+ AddConst('VKMENU', 'Integer', VKMENU);//Alt key
+ AddConst('VKPAUSE', 'Integer', VKPAUSE);//Pause key
+ AddConst('VKCAPITAL', 'Integer', VKCAPITAL);//Caps Lock key
+ AddConst('VKESCAPE', 'Integer', VKESCAPE);//Esc key
+ AddConst('VKSPACE', 'Integer', VKSPACE);//Space bar
+ AddConst('VKPRIOR', 'Integer', VKPRIOR);//Page Up key
+ AddConst('VKNEXT', 'Integer', VKNEXT);// Page Down key
+ AddConst('VKEND', 'Integer', VKEND);// End key
+ AddConst('VKHOME', 'Integer', VKHOME);// Home key
+ AddConst('VKLEFT', 'Integer', VKLEFT);// Left Arrow key
+ AddConst('VKUP', 'Integer', VKUP);// Up Arrow key
+ AddConst('VKRIGHT', 'Integer', VKRIGHT);// Right Arrow key
+ AddConst('VKDOWN', 'Integer', VKDOWN);// Down Arrow key
+ AddConst('VKINSERT', 'Integer', VKINSERT);// Insert key
+ AddConst('VKDELETE', 'Integer', VKDELETE);// Delete key
+ AddConst('VKHELP', 'Integer', VKHELP);// Help key
+ AddConst('VKLWIN', 'Integer', VKLWIN);// Left Windows key (Microsoft keyboard)
+ AddConst('VKRWIN', 'Integer', VKRWIN);// Right Windows key (Microsoft keyboard)
+ AddConst('VKAPPS', 'Integer', VKAPPS);// Applications key (Microsoft keyboard)
+ AddConst('VKNUMPAD0', 'Integer', VKNUMPAD0);// 0 key (numeric keypad)
+ AddConst('VKNUMPAD1', 'Integer', VKNUMPAD1);// 1 key (numeric keypad)
+ AddConst('VKNUMPAD2', 'Integer', VKNUMPAD2);// 2 key (numeric keypad)
+ AddConst('VKNUMPAD3', 'Integer', VKNUMPAD3);// 3 key (numeric keypad)
+ AddConst('VKNUMPAD4', 'Integer', VKNUMPAD4);// 4 key (numeric keypad)
+ AddConst('VKNUMPAD5', 'Integer', VKNUMPAD5);// 5 key (numeric keypad)
+ AddConst('VKNUMPAD6', 'Integer', VKNUMPAD6);// 6 key (numeric keypad)
+ AddConst('VKNUMPAD7', 'Integer', VKNUMPAD7);// 7 key (numeric keypad)
+ AddConst('VKNUMPAD8', 'Integer', VKNUMPAD8);// 8 key (numeric keypad)
+ AddConst('VKNUMPAD9', 'Integer', VKNUMPAD9);// 9 key (numeric keypad)
+ AddConst('VKMULTIPLY', 'Integer', VKMULTIPLY);// Multiply key (numeric keypad)
+ AddConst('VKADD', 'Integer', VKADD);// Add key (numeric keypad)
+ AddConst('VKSEPARATOR', 'Integer', VKSEPARATOR);// Separator key (numeric keypad)
+ AddConst('VKSUBTRACT', 'Integer', VKSUBTRACT);// Subtract key (numeric keypad)
+ AddConst('VKDECIMAL', 'Integer', VKDECIMAL);// Decimal key (numeric keypad)
+ AddConst('VKDIVIDE', 'Integer', VKDIVIDE);// Divide key (numeric keypad)
+ AddConst('VKF1', 'Integer', VKF1);// F1 key
+ AddConst('VKF2', 'Integer', VKF2);// F2 key
+ AddConst('VKF3', 'Integer', VKF3);// F3 key
+ AddConst('VKF4', 'Integer', VKF4);// F4 key
+ AddConst('VKF5', 'Integer', VKF5);// F5 key
+ AddConst('VKF6', 'Integer', VKF6);// F6 key
+ AddConst('VKF7', 'Integer', VKF7);// F7 key
+ AddConst('VKF8', 'Integer', VKF8);// F8 key
+ AddConst('VKF9', 'Integer', VKF9);// F9 key
+ AddConst('VKF10', 'Integer', VKF10);// F10 key
+ AddConst('VKF11', 'Integer', VKF11);// F11 key
+ AddConst('VKF12', 'Integer', VKF12);// F12 key
+ AddConst('VKNUMLOCK', 'Integer', VKNUMLOCK);// Num Lock key
+ AddConst('VKSCROLL', 'Integer', VKSCROLL);// Scroll Lock key
+
+ AddConst('crDefault', 'Integer', crDefault);
+ AddConst('crNone', 'Integer', crNone);
+ AddConst('crArrow', 'Integer', crArrow);
+ AddConst('crCross', 'Integer', crCross);
+ AddConst('crIBeam', 'Integer', crIBeam);
+ AddConst('crSize', 'Integer', crSize);
+ AddConst('crSizeNESW', 'Integer', crSizeNESW);
+ AddConst('crSizeNS', 'Integer', crSizeNS);
+ AddConst('crSizeNWSE', 'Integer', crSizeNWSE);
+ AddConst('crSizeWE', 'Integer', crSizeWE);
+ AddConst('crUpArrow', 'Integer', crUpArrow);
+ AddConst('crHourGlass', 'Integer', crHourGlass);
+ AddConst('crDrag', 'Integer', crDrag);
+ AddConst('crNoDrop', 'Integer', crNoDrop);
+ AddConst('crHSplit', 'Integer', crHSplit);
+ AddConst('crVSplit', 'Integer', crVSplit);
+ AddConst('crMultiDrag', 'Integer', crMultiDrag);
+ AddConst('crSQLWait', 'Integer', crSQLWait);
+ AddConst('crNo', 'Integer', crNo);
+ AddConst('crAppStart', 'Integer', crAppStart);
+ AddConst('crHelp', 'Integer', crHelp);
+ AddConst('crHandPoint', 'Integer', crHandPoint);
+ AddConst('crSizeAll', 'Integer', crSizeAll);
+
+ AddType('TFormBorderStyle', fvtInt);
+ AddType('TBorderStyle', fvtInt);
+
+ AddEnumSet('TShiftState', 'ssShift, ssAlt, ssCtrl, ssLeft, ssRight, ssMiddle, ssDouble, ssTouch, ssPen, ssCommand');
+ AddEnum('TAniIndicatorStyle', 'aiLinear, aiCircular');
+ AddEnum('TAlign', 'alNone, alTop, alBottom, alLeft, alRight, alClient');
+ AddEnum('TMouseButton', 'mbLeft, mbRight, mbMiddle');
+ AddEnumSet('TAnchors', 'akLeft, akTop, akRight, akBottom');
+ AddEnum('TBevelCut', 'bvNone, bvLowered, bvRaised, bvSpace');
+ AddEnum('TTextLayout', 'tlTop, tlCenter, tlBottom');
+ AddEnum('TEditCharCase', 'ecNormal, ecUpperCase, ecLowerCase');
+ AddEnum('TScrollStyle', 'ssNone, ssHorizontal, ssVertical, ssBoth');
+ AddEnum('TComboBoxStyle', 'csDropDown, csSimple, csDropDownList, csOwnerDrawFixed, csOwnerDrawVariable');
+ AddEnum('TCheckBoxState', 'cbUnchecked, cbChecked, cbGrayed');
+ AddEnum('TListBoxStyle', 'lbStandard, lbOwnerDrawFixed, lbOwnerDrawVariable');
+ AddEnum('TWindowState', 'wsNormal, wsMinimized, wsMaximized');
+ AddEnum('TFormStyle', 'fsNormal, fsMDIChild, fsMDIForm, fsStayOnTop');
+ AddEnumSet('TBorderIcons', 'biSystemMenu, biMinimize, biMaximize, biHelp');
+ AddEnum('TFormPosition', 'poDesigned, poDefault, poDefaultPosOnly, poDefaultSizeOnly, poScreenCenter, poDesktopCenter');
+ AddEnum('TCloseAction', 'caNone, caHide, caFree, caMinimize');
+
+ with AddClass(TControl, 'TFmxObject') do
+ begin
+ AddMethod('procedure AddObject(AObject: TFmxObject)', CallMethod);
+ AddMethod('procedure RemoveObject(AObject: TFmxObject)', CallMethod);
+ AddMethod('procedure SetBounds(X: Single; Y: Single; AWidth: Single; AHeight: Single)', CallMethod);
+ AddMethod('function AbsoluteToLocal(P: TfsPointF): TfsPointF', CallMethod);
+ AddMethod('function LocalToAbsolute(P: TfsPointF): TfsPointF', CallMethod);
+ AddMethod('function AbsoluteToLocalVector(P: TfsVector): TfsVector', CallMethod);
+ AddMethod('function LocalToAbsoluteVector(P: TfsVector): TfsVector', CallMethod);
+ AddMethod('function PointInObject(X: Single; Y: Single): Boolean', CallMethod);
+ AddMethod('procedure BeginUpdate()', CallMethod);
+ AddMethod('procedure EndUpdate()', CallMethod);
+{$IFNDEF DELPHI18}
+ AddMethod('procedure ApplyEffect()', CallMethod);
+{$ENDIF}
+ AddMethod('procedure UpdateEffects()', CallMethod);
+ AddMethod('procedure SetFocus()', CallMethod);
+ AddMethod('procedure PaintTo(ACanvas: TCanvas; ARect: TFsRectF; AParent: TFmxObject)', CallMethod);
+ AddMethod('procedure Repaint()', CallMethod);
+ AddMethod('procedure InvalidateRect(ARect: TfsRectF)', CallMethod);
+ AddMethod('procedure Lock()', CallMethod);
+ AddProperty('AbsoluteMatrix', 'TfsMatrix', GetProp, nil);
+ AddProperty('AbsoluteOpacity', 'Single', GetProp, nil);
+ AddProperty('AbsoluteWidth', 'Single', GetProp, nil);
+ AddProperty('AbsoluteHeight', 'Single', GetProp, nil);
+ AddProperty('AbsoluteScale', 'TfsPointF', GetProp, nil);
+ AddProperty('AbsoluteEnabled', 'Boolean', GetProp, nil);
+ AddProperty('HasEffect', 'Boolean', GetProp, nil);
+ AddProperty('HasDisablePaintEffect', 'Boolean', GetProp, nil);
+ AddProperty('HasAfterPaintEffect', 'Boolean', GetProp, nil);
+ AddProperty('ChildrenRect', 'TfsRectF', GetProp, nil);
+ AddProperty('InvertAbsoluteMatrix', 'TfsMatrix', GetProp, nil);
+ AddProperty('InPaintTo', 'Boolean', GetProp, nil);
+ AddProperty('LocalRect', 'TfsRectF', GetProp, nil);
+ AddProperty('AbsoluteRect', 'TfsRectF', GetProp, nil);
+ AddProperty('UpdateRect', 'TfsRectF', GetProp, nil);
+ AddProperty('ParentedRect', 'TfsRectF', GetProp, nil);
+ AddProperty('ParentedVisible', 'Boolean', GetProp, nil);
+ AddProperty('ClipRect', 'TfsRectF', GetProp, nil);
+ AddProperty('Canvas', 'TCanvas', GetProp, nil);
+ AddProperty('AutoCapture', 'Boolean', GetProp, SetProp);
+ AddProperty('CanFocus', 'Boolean', GetProp, SetProp);
+ AddProperty('DisableFocusEffect', 'Boolean', GetProp, SetProp);
+ AddProperty('TabOrder', 'Integer', GetProp, SetProp);
+ AddProperty('BoundsRect', 'TfsRectF', GetProp, SetProp);
+ AddEvent('OnDragEnter', TfsDragDropEvent);
+ AddEvent('OnDragLeave', TfsNotifyEvent);
+ AddEvent('OnDragOver', TfsDragOverEvent);
+ AddEvent('OnDragDrop', TfsDragDropEvent);
+ AddEvent('OnDragEnd', TfsNotifyEvent);
+ AddEvent('OnKeyDown', TfsKeyEvent);
+ AddEvent('OnKeyUp', TfsKeyEvent);
+ AddEvent('OnClick', TfsNotifyEvent);
+ AddEvent('OnDblClick', TfsNotifyEvent);
+ AddEvent('OnCanFocus', TfsCanFocusEvent);
+ AddEvent('OnEnter', TfsNotifyEvent);
+ AddEvent('OnExit', TfsNotifyEvent);
+ AddEvent('OnMouseDown', TfsMouseEvent);
+ AddEvent('OnMouseMove', TfsMouseMoveEvent);
+ AddEvent('OnMouseUp', TfsMouseEvent);
+ AddEvent('OnMouseWheel', TfsMouseWheelEvent);
+ AddEvent('OnMouseEnter', TfsNotifyEvent);
+ AddEvent('OnMouseLeave', TfsNotifyEvent);
+ AddEvent('OnPainting', TfsOnPaintEvent);
+ AddEvent('OnPaint', TfsOnPaintEvent);
+ AddEvent('OnResize', TfsNotifyEvent);
+ AddEvent('OnApplyStyleLookup', TfsNotifyEvent);
+ end;
+
+ { standard controls }
+ with AddClass(TStyledControl, 'TControl') do
+ begin
+ AddMethod('function FindStyleResource(AStyleLookup: string): TFmxObject', CallMethod);
+ AddMethod('procedure ApplyStyleLookup()', CallMethod);
+{$IFNDEF DELPHI20}
+ AddMethod('procedure UpdateStyle()', CallMethod);
+{$ENDIF}
+ AddProperty('StyleLookup', 'String', GetProp, SetProp);
+ end;
+
+ AddClass(TStyledControl, 'TControl');
+ AddClass(TTextControl, 'TStyledControl');
+ AddClass(TPanel, 'TStyledControl');
+ AddClass(TCalloutPanel, 'TPanel');
+ AddClass(TLabel, 'TTextControl');
+ AddClass(TCustomButton, 'TTextControl');
+ AddClass(TButton, 'TCustomButton');
+ AddClass(TSpeedButton, 'TCustomButton');
+ with AddClass(TCheckBox, 'TTextControl') do
+ AddEvent('OnChange', TfsNotifyEvent);
+
+ with AddClass(TRadioButton, 'TTextControl') do
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddClass(TGroupBox, 'TTextControl');
+ AddClass(TStatusBar, 'TStyledControl');
+ AddClass(TToolBar, 'TStyledControl');
+ AddClass(TSizeGrip, 'TStyledControl');
+ AddClass(TSplitter, 'TStyledControl');
+ AddClass(TProgressBar, 'TStyledControl');
+ AddClass(TThumb, 'TStyledControl');
+ with AddClass(TCustomTrack, 'TStyledControl') do
+ begin
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddEvent('OnTracking', TfsNotifyEvent);
+ end;
+ AddClass(TTrack, 'TCustomTrack');
+ AddClass(TTrackBar, 'TCustomTrack');
+ AddClass(TBitmapTrackBar, 'TTrackBar');
+ with AddClass(TSwitch, 'TCustomTrack') do
+ AddEvent('OnSwitch', TfsNotifyEvent);
+ with AddClass(TScrollBar, 'TStyledControl') do
+ AddEvent('OnChange', TfsNotifyEvent);
+
+ AddClass(TSmallScrollBar, 'TScrollBar');
+ AddClass(TAniIndicator, 'TStyledControl');
+ with AddClass(TArcDial, 'TStyledControl') do
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddClass(TExpanderButton, 'TCustomButton');
+ with AddClass(TExpander, 'TTextControl') do
+ AddEvent('OnCheckChange', TfsNotifyEvent);
+ with AddClass(TImageControl, 'TStyledControl') do
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddClass(TPathLabel, 'TStyledControl');
+
+
+ with AddClass(TCustomEdit, 'TStyledControl') do
+ begin
+{$IFNDEF Delphi21}
+ AddMethod('procedure ClearSelection()', CallMethod);
+{$ENDIF}
+ AddMethod('procedure CopyToClipboard()', CallMethod);
+ AddMethod('procedure CutToClipboard()', CallMethod);
+ AddMethod('procedure PasteFromClipboard()', CallMethod);
+ AddMethod('procedure SelectAll()', CallMethod);
+{$IFNDEF Delphi21}
+ AddMethod('function GetCharX(a: Integer): Single', CallMethod);
+ AddMethod('function ContentRect(): TfsRectF', CallMethod);
+{$ENDIF}
+ AddProperty('CaretPosition', 'Integer', GetProp, SetProp);
+ AddProperty('SelStart', 'Integer', GetProp, SetProp);
+ AddProperty('SelLength', 'Integer', GetProp, SetProp);
+ AddProperty('SelText', 'string', GetProp, nil);
+ AddProperty('MaxLength', 'Integer', GetProp, SetProp);
+ AddProperty('SelectionFill', 'TBrush', GetProp, nil);
+ AddProperty('FilterChar', 'string', GetProp, SetProp);
+ AddProperty('Typing', 'Boolean', GetProp, SetProp);
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddEvent('OnChangeTracking', TfsNotifyEvent);
+ AddEvent('OnTyping', TfsNotifyEvent);
+ end;
+ AddClass(TEdit, 'TCustomEdit');
+ with AddClass(TMemo, 'TScrollBox') do
+ begin
+ AddMethod('procedure CopyToClipboard()', CallMethod);
+ AddMethod('procedure PasteFromClipboard()', CallMethod);
+ AddMethod('procedure CutToClipboard()', CallMethod);
+ AddMethod('procedure ClearSelection()', CallMethod);
+ AddMethod('procedure SelectAll()', CallMethod);
+ AddMethod('procedure GoToTextEnd()', CallMethod);
+ AddMethod('procedure GoToTextBegin()', CallMethod);
+ AddMethod('procedure GotoLineEnd()', CallMethod);
+ AddMethod('procedure GoToLineBegin()', CallMethod);
+ AddMethod('procedure UnDo()', CallMethod);
+ AddProperty('SelStart', 'Integer', GetProp, SetProp);
+ AddProperty('SelLength', 'Integer', GetProp, SetProp);
+ AddProperty('SelText', 'string', GetProp, nil);
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddEvent('OnChangeTracking', TfsNotifyEvent);
+ end;
+
+ AddClass(TRadioButton, 'TTextControl');
+ with AddClass(TListBoxItem, 'TTextControl') do
+ begin
+ AddProperty('Data', 'TObject', GetProp, SetProp);
+ AddProperty('Index', 'Integer', GetProp, SetProp);
+ end;
+
+ with AddClass(TCustomListBox, 'TScrollBox') do
+ begin
+ AddMethod('procedure Clear()', CallMethod);
+ AddMethod('function DragChange(SourceItem: TListBoxItem; DestItem: TListBoxItem): Boolean', CallMethod);
+ AddMethod('procedure SelectAll()', CallMethod);
+ AddMethod('procedure ClearSelection()', CallMethod);
+ AddMethod('procedure SelectRange(Item1: TListBoxItem; Item2: TListBoxItem)', CallMethod);
+ AddMethod('function ItemByPoint(X: Single; Y: Single): TListBoxItem', CallMethod);
+ AddMethod('function ItemByIndex(Idx: Integer): TListBoxItem', CallMethod);
+ AddMethod('procedure Exchange(Item1: TListBoxItem; Item2: TListBoxItem)', CallMethod);
+ AddMethod('procedure AddObject(AObject: TFmxObject)', CallMethod);
+ AddMethod('procedure InsertObject(Index: Integer; AObject: TFmxObject)', CallMethod);
+ AddMethod('procedure RemoveObject(AObject: TFmxObject)', CallMethod);
+ AddIndexProperty( 'ListItems', 'Integer', 'TListBoxItem', CallMethod);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddProperty('Selected', 'TListBoxItem', GetProp, nil);
+ AddProperty('Items', 'TStrings', GetProp, SetProp);
+ AddProperty('ItemIndex', 'Integer', GetProp, SetProp);
+ end;
+
+ AddClass(TListBox, 'TCustomListBox');
+ with AddClass(TCustomComboBox, 'TStyledControl') do
+ begin
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure DropDown', CallMethod);
+ AddIndexProperty( 'ListItems', 'Integer', 'TListBoxItem', CallMethod);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddProperty('Selected', 'TListBoxItem', GetProp, nil);
+ AddProperty('Items', 'TStrings', GetProp, SetProp);
+ AddProperty('ItemIndex', 'Integer', GetProp, SetProp);
+ AddEvent('OnDropDown', TfsNotifyEvent);
+ AddEvent('OnCloseUp', TfsNotifyEvent);
+ end;
+
+ with AddClass(TComboBox, 'TCustomComboBox') do
+ AddEvent('OnChange', TfsNotifyEvent);
+
+ with AddClass(TCommonCustomForm, 'TFmxObject') do
+ begin
+ AddConstructor('constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0)', CallMethod);
+ AddMethod('procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; AHeight: Integer)', CallMethod);
+ AddMethod('function ClientToScreen(Point: TfsPointF): TfsPointF', CallMethod);
+ AddMethod('function ScreenToClient(Point: TfsPointF): TfsPointF', CallMethod);
+ AddMethod('function CloseQuery(): Boolean', CallMethod);
+ AddMethod('function ClientRect(): TfsRectF', CallMethod);
+ AddMethod('procedure Release()', CallMethod);
+ AddMethod('procedure Close()', CallMethod);
+ AddMethod('procedure Show()', CallMethod);
+ AddMethod('procedure Hide()', CallMethod);
+ AddMethod('function ShowModal(): Integer', CallMethod);
+ AddMethod('procedure CloseModal()', CallMethod);
+ AddMethod('procedure Invalidate()', CallMethod);
+ AddMethod('procedure BeginUpdate()', CallMethod);
+ AddMethod('procedure EndUpdate()', CallMethod);
+ end;
+
+ with AddClass(TCustomForm, 'TCommonCustomForm') do
+ begin
+ AddEvent('OnActivate', TfsNotifyEvent);
+ AddEvent('OnClose', TfsCloseEvent);
+ AddEvent('OnCloseQuery', TfsCloseQueryEvent);
+ AddEvent('OnCreate', TfsNotifyEvent);
+ AddEvent('OnDestroy', TfsNotifyEvent);
+ AddEvent('OnDeactivate', TfsNotifyEvent);
+ AddEvent('OnHide', TfsNotifyEvent);
+ AddEvent('OnPaint', TfsNotifyEvent);
+ AddEvent('OnShow', TfsNotifyEvent);
+ AddEvent('OnResize', TfsNotifyEvent);
+ AddProperty('Canvas', 'TCanvas', GetProp, nil);
+ AddProperty('ModalResult', 'Integer', GetProp, SetProp);
+ end;
+ AddClass(TForm, 'TCustomForm');
+
+ AddClass(TDataModule, 'TComponent');
+ with AddClass(TApplication, 'TComponent') do
+ begin
+ AddMethod('procedure ProcessMessages', CallMethod);
+ end;
+ AddObject('Application', Application);
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ Form: TCommonCustomForm;
+begin
+ Result := 0;
+
+ if ClassType = TControl then
+ begin
+ if MethodName = 'ADDOBJECT' then
+ TControl(Instance).AddObject(TFmxObject(frxInteger(Caller.Params[0])))
+ else if MethodName = 'REMOVEOBJECT' then
+ TControl(Instance).RemoveObject(TFmxObject(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SETBOUNDS' then
+ TControl(Instance).SetBounds(Single(Caller.Params[0]), Single(Caller.Params[1]), Single(Caller.Params[2]), Single(Caller.Params[3]))
+ else if MethodName = 'ABSOLUTETOLOCAL' then
+ Result := frxInteger(TfsPointF.Create(TControl(Instance).AbsoluteToLocal(TfsPointF(frxInteger(Caller.Params[0])).GetRect)))
+ else if MethodName = 'LOCALTOABSOLUTE' then
+ Result := frxInteger(TfsPointF.Create(TControl(Instance).LocalToAbsolute(TfsPointF(frxInteger(Caller.Params[0])).GetRect)))
+ else if MethodName = 'ABSOLUTETOLOCALVECTOR' then
+ Result := frxInteger(TfsVector.Create(TControl(Instance).AbsoluteToLocalVector(TfsVector(frxInteger(Caller.Params[0])).GetRect)))
+ else if MethodName = 'LOCALTOABSOLUTEVECTOR' then
+ Result := frxInteger(TfsVector.Create(TControl(Instance).LocalToAbsoluteVector(TfsVector(frxInteger(Caller.Params[0])).GetRect)))
+ else if MethodName = 'POINTINOBJECT' then
+ Result := Boolean(TControl(Instance).PointInObject(Single(Caller.Params[0]), Single(Caller.Params[1])))
+ else if MethodName = 'BEGINUPDATE' then
+ TControl(Instance).BeginUpdate()
+ else if MethodName = 'ENDUPDATE' then
+ TControl(Instance).EndUpdate()
+{$IFNDEF DELPHI18}
+ else if MethodName = 'APPLYEFFECT' then
+ TControl(Instance).ApplyEffect()
+{$ENDIF}
+ else if MethodName = 'UPDATEEFFECTS' then
+ TControl(Instance).UpdateEffects()
+ else if MethodName = 'SETFOCUS' then
+ TControl(Instance).SetFocus()
+ else if MethodName = 'PAINTTO' then
+ TControl(Instance).PaintTo(TCanvas(frxInteger(Caller.Params[0])), TfsRectF(frxInteger(Caller.Params[1])).GetRect, TFmxObject(frxInteger(Caller.Params[2])))
+ else if MethodName = 'REPAINT' then
+ TControl(Instance).Repaint()
+ else if MethodName = 'INVALIDATERECT' then
+ TControl(Instance).InvalidateRect(TfsRectF(frxInteger(Caller.Params[0])).GetRect)
+ else if MethodName = 'LOCK' then
+ TControl(Instance).Lock()
+ end
+ else if ClassType = TStyledControl then
+ begin
+ if MethodName = 'FINDSTYLERESOURCE' then
+ Result := frxInteger(TStyledControl(Instance).FindStyleResource(String(Caller.Params[0])))
+ else if MethodName = 'APPLYSTYLELOOKUP' then
+ TStyledControl(Instance).ApplyStyleLookup()
+{$IFNDEF DELPHI20}
+ else if MethodName = 'UPDATESTYLE' then
+ TStyledControl(Instance).UpdateStyle()
+{$ENDIF}
+ end
+ else if ClassType = TCustomEdit then
+ begin
+ {$IFNDEF Delphi21}
+ if MethodName = 'CLEARSELECTION' then
+ TCustomEdit(Instance).ClearSelection()
+ else
+{$ENDIF}
+ if MethodName = 'COPYTOCLIPBOARD' then
+ TCustomEdit(Instance).CopyToClipboard()
+ else if MethodName = 'CUTTOCLIPBOARD' then
+ TCustomEdit(Instance).CutToClipboard()
+ else if MethodName = 'PASTEFROMCLIPBOARD' then
+ TCustomEdit(Instance).PasteFromClipboard()
+ else if MethodName = 'SELECTALL' then
+ TCustomEdit(Instance).SelectAll()
+{$IFNDEF Delphi21}
+ else if MethodName = 'GETCHARX' then
+ Result := Single(TCustomEdit(Instance).GetCharX(Integer(Caller.Params[0])))
+ else if MethodName = 'CONTENTRECT' then
+ Result := frxInteger(TfsRectF.Create(TCustomEdit(Instance).ContentRect()))
+{$ENDIF}
+ end
+ else if ClassType = TMemo then
+ begin
+ if MethodName = 'COPYTOCLIPBOARD' then
+ TMemo(Instance).CopyToClipboard()
+ else if MethodName = 'PASTEFROMCLIPBOARD' then
+ TMemo(Instance).PasteFromClipboard()
+ else if MethodName = 'CUTTOCLIPBOARD' then
+ TMemo(Instance).CutToClipboard()
+ else if MethodName = 'CLEARSELECTION' then
+ TMemo(Instance).ClearSelection()
+ else if MethodName = 'SELECTALL' then
+ TMemo(Instance).SelectAll()
+ else if MethodName = 'GOTOTEXTEND' then
+ TMemo(Instance).GoToTextEnd()
+ else if MethodName = 'GOTOTEXTBEGIN' then
+ TMemo(Instance).GoToTextBegin()
+ else if MethodName = 'GOTOLINEEND' then
+ TMemo(Instance).GotoLineEnd()
+ else if MethodName = 'GOTOLINEBEGIN' then
+ TMemo(Instance).GoToLineBegin()
+ else if MethodName = 'UNDO' then
+ TMemo(Instance).UnDo()
+ end
+ else if ClassType = TCustomListBox then
+ begin
+ if MethodName = 'ASSIGN' then
+ TCustomListBox(Instance).Assign(TPersistent(frxInteger(Caller.Params[0])))
+ else if MethodName = 'CLEAR' then
+ TCustomListBox(Instance).Clear()
+ else if MethodName = 'DRAGCHANGE' then
+ Result := TCustomListBox(Instance).DragChange(TListBoxItem(frxInteger(Caller.Params[0])), TListBoxItem(frxInteger(Caller.Params[1])))
+ else if MethodName = 'SELECTALL' then
+ TCustomListBox(Instance).SelectAll()
+ else if MethodName = 'CLEARSELECTION' then
+ TCustomListBox(Instance).ClearSelection()
+ else if MethodName = 'SELECTRANGE' then
+ TCustomListBox(Instance).SelectRange(TListBoxItem(frxInteger(Caller.Params[0])), TListBoxItem(frxInteger(Caller.Params[1])))
+ else if MethodName = 'ITEMBYPOINT' then
+ Result := frxInteger(TListBoxItem(TCustomListBox(Instance).ItemByPoint(Single(Caller.Params[0]), Single(Caller.Params[1]))))
+ else if MethodName = 'ITEMBYINDEX' then
+ Result := frxInteger(TListBoxItem(TCustomListBox(Instance).ItemByIndex(Integer(Caller.Params[0]))))
+ else if MethodName = 'EXCHANGE' then
+ TCustomListBox(Instance).Exchange(TListBoxItem(frxInteger(Caller.Params[0])), TListBoxItem(frxInteger(Caller.Params[1])))
+ else if MethodName = 'ADDOBJECT' then
+ TCustomListBox(Instance).AddObject(TFmxObject(frxInteger(Caller.Params[0])))
+ else if MethodName = 'INSERTOBJECT' then
+ TCustomListBox(Instance).InsertObject(Integer(Caller.Params[0]), TFmxObject(frxInteger(Caller.Params[1])))
+ else if MethodName = 'REMOVEOBJECT' then
+ TCustomListBox(Instance).RemoveObject(TFmxObject(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LISTITEMS.GET' then
+ Result := frxInteger(TCustomListBox(Instance).ListItems[Caller.Params[0]])
+ end
+ else if ClassType = TCustomComboBox then
+ begin
+ if MethodName = 'CLEAR' then
+ TCustomComboBox(Instance).Clear()
+ else if MethodName = 'DROPDOWN' then
+ TCustomComboBox(Instance).DropDown()
+ else if MethodName = 'LISTITEMS.GET' then
+ Result := frxInteger(TCustomComboBox(Instance).ListItems[Caller.Params[0]])
+ end
+ else if ClassType = TCommonCustomForm then
+ begin
+ Form := TCommonCustomForm(Instance);
+ if MethodName = 'CREATENEW' then
+ Result := frxInteger(Form.CreateNew(TComponent(frxInteger(Caller.Params[0])), Integer(Caller.Params[1])))
+ else if MethodName = 'SETBOUNDS' then
+ Form.SetBounds(Integer(Caller.Params[0]), Integer(Caller.Params[1]), Integer(Caller.Params[2]), Integer(Caller.Params[3]))
+ else if MethodName = 'CLIENTTOSCREEN' then
+ Result := frxInteger(TfsPointF.Create(Form.ClientToScreen(TfsPointF(frxInteger(Caller.Params[0])).GetRect)))
+ else if MethodName = 'SCREENTOCLIENT' then
+ Result := frxInteger(TfsPointF.Create(Form.ScreenToClient(TfsPointF(frxInteger(Caller.Params[0])).GetRect)))
+ else if MethodName = 'CLOSEQUERY' then
+ Result := Form.CloseQuery
+ else if MethodName = 'CLIENTRECT' then
+ Result := frxInteger(TfsRectF.Create(Form.ClientRect))
+ else if MethodName = 'RELEASE' then
+ Form.Release()
+ else if MethodName = 'CLOSE' then
+ Form.Close()
+ else if MethodName = 'SHOW' then
+ Form.Show()
+ else if MethodName = 'HIDE' then
+ Form.Hide()
+ else if MethodName = 'SHOWMODAL' then
+ Result := Integer(Form.ShowModal)
+ else if MethodName = 'CLOSEMODAL' then
+ Form.CloseModal()
+ else if MethodName = 'INVALIDATE' then
+ Form.Invalidate()
+ else if MethodName = 'BEGINUPDATE' then
+ Form.BeginUpdate()
+ else if MethodName = 'ENDUPDATE' then
+ Form.EndUpdate()
+ end
+ else if ClassType = TApplication then
+ begin
+ if MethodName = 'PROCESSMESSAGES' then
+ TApplication(Instance).ProcessMessages
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TControl then
+ begin
+ if PropName = 'ABSOLUTEMATRIX' then
+ Result := frxInteger(TfsMatrix.Create(TControl(Instance).AbsoluteMatrix))
+ else if PropName = 'ABSOLUTEOPACITY' then
+ Result := TControl(Instance).AbsoluteOpacity
+ else if PropName = 'ABSOLUTEWIDTH' then
+ Result := TControl(Instance).AbsoluteWidth
+ else if PropName = 'ABSOLUTEHEIGHT' then
+ Result := TControl(Instance).AbsoluteHeight
+ else if PropName = 'ABSOLUTESCALE' then
+ Result := frxInteger(TfsPointF.Create(TControl(Instance).AbsoluteScale))
+ else if PropName = 'ABSOLUTEENABLED' then
+ Result := TControl(Instance).AbsoluteEnabled
+ else if PropName = 'HASEFFECT' then
+ Result := TControl(Instance).HasEffect
+ else if PropName = 'HASDISABLEPAINTEFFECT' then
+ Result := TControl(Instance).HasDisablePaintEffect
+ else if PropName = 'HASAFTERPAINTEFFECT' then
+ Result := TControl(Instance).HasAfterPaintEffect
+ else if PropName = 'CHILDRENRECT' then
+ Result := frxInteger(TfsRectF.Create(TControl(Instance).ChildrenRect))
+ else if PropName = 'INVERTABSOLUTEMATRIX' then
+ Result := frxInteger(TfsMatrix.Create(TControl(Instance).InvertAbsoluteMatrix))
+ else if PropName = 'INPAINTTO' then
+ Result := TControl(Instance).InPaintTo
+ else if PropName = 'LOCALRECT' then
+ Result := frxInteger(TfsRectF.Create(TControl(Instance).LocalRect))
+ else if PropName = 'ABSOLUTERECT' then
+ Result := frxInteger(TfsRectF.Create(TControl(Instance).AbsoluteRect))
+ else if PropName = 'UPDATERECT' then
+ Result := frxInteger(TfsRectF.Create(TControl(Instance).UpdateRect))
+ else if PropName = 'PARENTEDRECT' then
+ Result := frxInteger(TfsRectF.Create(TControl(Instance).ParentedRect))
+ else if PropName = 'PARENTEDVISIBLE' then
+ Result := TControl(Instance).ParentedVisible
+ else if PropName = 'CLIPRECT' then
+ Result := frxInteger(TfsRectF.Create(TControl(Instance).ClipRect))
+ else if PropName = 'CANVAS' then
+ Result := frxInteger(TControl(Instance).Canvas)
+ else if PropName = 'AUTOCAPTURE' then
+ Result := TControl(Instance).AutoCapture
+ else if PropName = 'CANFOCUS' then
+ Result := TControl(Instance).CanFocus
+ else if PropName = 'DISABLEFOCUSEFFECT' then
+ Result := TControl(Instance).DisableFocusEffect
+ else if PropName = 'TABORDER' then
+ Result := Integer(TControl(Instance).TabOrder)
+ else if PropName = 'BOUNDSRECT' then
+ Result := frxInteger(TfsRectF.Create(TControl(Instance).BoundsRect))
+ end
+ else if ClassType = TStyledControl then
+ begin
+ if PropName = 'STYLELOOKUP' then
+ Result := TStyledControl(Instance).StyleLookup
+ end
+ else if ClassType = TCustomEdit then
+ begin
+ if PropName = 'CARETPOSITION' then
+ Result := TCustomEdit(Instance).CaretPosition
+ else if PropName = 'SELSTART' then
+ Result := TCustomEdit(Instance).SelStart
+ else if PropName = 'SELLENGTH' then
+ Result := TCustomEdit(Instance).SelLength
+ else if PropName = 'SELTEXT' then
+ Result := String(TCustomEdit(Instance).SelText)
+ else if PropName = 'MAXLENGTH' then
+ Result := TCustomEdit(Instance).MaxLength
+ else if PropName = 'SELECTIONFILL' then
+ Result := frxInteger(TCustomEdit(Instance).SelectionFill)
+ else if PropName = 'FILTERCHAR' then
+ Result := TCustomEdit(Instance).FilterChar
+ else if PropName = 'TYPING' then
+ Result := TCustomEdit(Instance).Typing
+ end
+ else if ClassType = TMemo then
+ begin
+ if PropName = 'SELSTART' then
+ Result := TMemo(Instance).SelStart
+ else if PropName = 'SELLENGTH' then
+ Result := TMemo(Instance).SelLength
+ else if PropName = 'SELTEXT' then
+ Result := String(TMemo(Instance).SelText)
+ end
+ else if ClassType = TListBoxItem then
+ begin
+ if PropName = 'DATA' then
+ Result := frxInteger(TListBoxItem(Instance).Data)
+ else if PropName = 'INDEX' then
+ Result := TListBoxItem(Instance).Index
+ end
+ else if ClassType = TCustomListBox then
+ begin
+ if PropName = 'COUNT' then
+ Result := TCustomListBox(Instance).Count
+ else if PropName = 'SELECTED' then
+ Result := frxInteger(TCustomListBox(Instance).Selected)
+ else if PropName = 'ITEMS' then
+ Result := frxInteger(TCustomListBox(Instance).Items)
+ else if PropName = 'ITEMINDEX' then
+ Result := TCustomListBox(Instance).ItemIndex
+ end
+ else if ClassType = TCustomComboBox then
+ begin
+ if PropName = 'COUNT' then
+ Result := TCustomComboBox(Instance).Count
+ else if PropName = 'SELECTED' then
+ Result := frxInteger(TCustomComboBox(Instance).Selected)
+ else if PropName = 'ITEMS' then
+ Result := frxInteger(TCustomComboBox(Instance).Items)
+ else if PropName = 'ITEMINDEX' then
+ Result := TCustomComboBox(Instance).ItemIndex
+ end
+ else if ClassType = TCustomForm then
+ begin
+ if PropName = 'MODALRESULT' then
+ Result := TCustomForm(Instance).ModalResult
+ else if PropName = 'CANVAS' then
+ Result := frxInteger(TCustomForm(Instance).Canvas)
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TControl then
+ begin
+ if PropName = 'AUTOCAPTURE' then
+ TControl(Instance).AutoCapture := Boolean(Value)
+ else if PropName = 'CANFOCUS' then
+ TControl(Instance).CanFocus := Boolean(Value)
+ else if PropName = 'DISABLEFOCUSEFFECT' then
+ TControl(Instance).DisableFocusEffect := Boolean(Value)
+ else if PropName = 'TABORDER' then
+ TControl(Instance).TabOrder := TTabOrder(Integer(Value))
+ else if PropName = 'BOUNDSRECT' then
+ TControl(Instance).BoundsRect := TfsRectF(frxInteger(Value)).GetRect
+ end
+ else if ClassType = TStyledControl then
+ begin
+ if PropName = 'STYLELOOKUP' then
+ TStyledControl(Instance).StyleLookup := Value;
+ end
+ else if ClassType = TCustomEdit then
+ begin
+ if PropName = 'CARETPOSITION' then
+ TCustomEdit(Instance).CaretPosition := Integer(Value)
+ else if PropName = 'SELSTART' then
+ TCustomEdit(Instance).SelStart := Integer(Value)
+ else if PropName = 'SELLENGTH' then
+ TCustomEdit(Instance).SelLength := Integer(Value)
+ else if PropName = 'MAXLENGTH' then
+ TCustomEdit(Instance).MaxLength := Integer(Value)
+ else if PropName = 'FILTERCHAR' then
+ TCustomEdit(Instance).FilterChar := String(Value)
+ else if PropName = 'TYPING' then
+ TCustomEdit(Instance).Typing := Boolean(Value)
+ end
+ else if ClassType = TMemo then
+ begin
+ if PropName = 'SELSTART' then
+ TMemo(Instance).SelStart := Integer(Value)
+ else if PropName = 'SELLENGTH' then
+ TMemo(Instance).SelLength := Integer(Value)
+ end
+ else if ClassType = TListBoxItem then
+ begin
+ if PropName = 'DATA' then
+ TListBoxItem(Instance).Data := TObject(frxInteger(Value))
+ else if PropName = 'INDEX' then
+ TListBoxItem(Instance).Index := Value
+ end
+ else if ClassType = TCustomListBox then
+ begin
+ if PropName = 'ITEMS' then
+ TCustomListBox(Instance).Items := TStrings(frxInteger(Value))
+ else if PropName = 'ITEMINDEX' then
+ TCustomListBox(Instance).ItemIndex := Value
+ end
+ else if ClassType = TCustomComboBox then
+ begin
+ if PropName = 'ITEMS' then
+ TCustomComboBox(Instance).Items := TStrings(frxInteger(Value))
+ else if PropName = 'ITEMINDEX' then
+ TCustomComboBox(Instance).ItemIndex := Value
+ end
+ else if ClassType = TCustomForm then
+ begin
+ if PropName = 'MODALRESULT' then
+ TCustomForm(Instance).ModalResult := Value
+ end
+end;
+
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsFormsRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/FMX.fs_igraphicsrtti.pas b/FastScript/FMX.fs_igraphicsrtti.pas
new file mode 100644
index 0000000..58a4818
--- /dev/null
+++ b/FastScript/FMX.fs_igraphicsrtti.pas
@@ -0,0 +1,522 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Graphics.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_igraphicsrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_iclassesrtti
+, FMX.Types, FMX.Objects, System.UITypes, System.UIConsts, System.Types, System.Variants
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases
+{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsGraphicsRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ procedure GetColorProc(const Name: String);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ GetAlphaColorValues(GetColorProc);
+ AddType('TAlignment', fvtInt);
+ AddType('TLeftRight', fvtInt);
+ AddConst('taLeftJustify', 'Integer', taLeftJustify);
+ AddConst('taRightJustify', 'Integer', taRightJustify);
+ AddConst('taCenter', 'Integer', taCenter);
+ AddType('TVerticalAlignment', fvtInt);
+ AddConst('taAlignTop', 'Integer', taAlignTop);
+ AddConst('taAlignBottom', 'Integer', taAlignBottom);
+ AddConst('taVerticalCenter', 'Integer', taVerticalCenter);
+ //AddEnum('TAlignment', 'taLeftJustify, taRightJustify, taCenter');
+ AddType('TCorners ', fvtInt);
+ AddConst('crTopLeft', 'Integer', TCorner.crTopLeft);
+ AddConst('crTopRight', 'Integer', TCorner.crTopRight);
+ AddConst('crBottomLeft', 'Integer', TCorner.crBottomLeft);
+ AddConst('crBottomRight', 'Integer', TCorner.crBottomRight);
+ AddType('TSides ', fvtInt);
+ AddConst('sdTop', 'Integer', TSide.sdTop);
+ AddConst('sdLeft', 'Integer', TSide.sdLeft);
+ AddConst('sdBottom', 'Integer', TSide.sdBottom);
+ AddConst('sdRight', 'Integer', TSide.sdRight);
+ AddConst('ftRightToLeft', 'Integer', TFillTextFlag.ftRightToLeft);
+ AddType('TFillTextFlags ', fvtInt);
+ AddEnumSet('TFontStyles', 'fsBold, fsItalic, fsUnderline, fsStrikeout');
+ AddEnum('TFontPitch', 'fpDefault, fpVariable, fpFixed');
+ AddEnum('TFontQuality', 'fqDefault, fqDraft, fqProof, fqNonAntialiased, fqAntialiased, fqClearType, fqClearTypeNatural');
+ AddEnum('TGradientStyle', 'gsLinear, gsRadial');
+ AddEnum('TWrapMode', 'wmTile, wmTileOriginal, wmTileStretch');
+ AddEnum('TCornerType', 'ctRound, ctBevel, ctInnerRound, ctInnerLine');
+ AddEnum('TAlignLayout', 'alNone, alTop, alLeft, alRight, alBottom, alMostTop, alMostBottom, alMostLeft, alMostRight, alClient, alContents, alCenter, alVertCenter, alHorzCenter, alHorizontal, alVertical, alScale, alFit, alFitLeft, alFitRight');
+ AddEnum('TPathPointKind', 'ppMoveTo, ppLineTo, ppCurveTo, ppClose');
+ AddEnum('TStrokeCap', 'scFlat, scRound');
+ AddEnum('TStrokeJoin', 'sjMiter, sjRound, sjBevel');
+ AddEnum('TStrokeDash', 'sdSolid, sdDash, sdDot, sdDashDot, sdDashDotDot, sdCustom');
+
+ AddEnum('TBrushKind', 'bkNone, bkSolid, bkGradient, bkBitmap, bkResource, bkGrab');
+
+ AddClass(TfsMatrix, 'TPersistent');
+ with AddClass(TFont, 'TPersistent') do
+ AddConstructor('constructor Create', CallMethod);
+ AddClass(TGradientPoint, 'TCollectionItem');
+ AddClass(TGradientPoints, 'TCollection');
+ AddClass(TGradient, 'TPersistent');
+ AddClass(TBrushBitmap, 'TPersistent');
+ AddClass(TBrushResource, 'TPersistent');
+{$IFNDEF Delphi18}
+ AddClass(TBrushGrab, 'TPersistent');
+{$ENDIF}
+ AddClass(TLineMetricInfo, 'TObject');
+
+ with AddClass(TBrush, 'TPersistent') do
+ begin
+ AddConstructor('Create(ADefaultKind: TBrushKind; ADefaultColor: TAlphaColor)', CallMethod);
+ AddProperty('DefaultColor', 'TAlphaColor', GetProp);
+ AddProperty('DefaultKind', 'TBrushKind', GetProp);
+ end;
+{$IFDEF Delphi17}
+ AddClass(TStrokeBrush, 'TBrush');
+{$ENDIF}
+
+ AddClass(TCanvasSaveState, 'TPersistent');
+ with AddClass(TCanvas, 'TPersistent') do
+ begin
+ AddMethod('function BeginScene: Boolean', CallMethod);
+ AddMethod('procedure EndScene', CallMethod);
+ AddMethod('procedure Clear(Color: TAlphaColor)', CallMethod);
+ AddMethod('procedure ClearRect(ARect: TfsRectF; AColor: TAlphaColor = 0)', CallMethod);
+ AddMethod('procedure SetMatrix(const M: TfsMatrix)', CallMethod);
+{$IFDEF Delphi17}
+ AddMethod('procedure MultiplyMatrix(const M: TfsMatrix)', CallMethod);
+{$ELSE}
+ AddMethod('procedure MultyMatrix(const M: TfsMatrix)', CallMethod);
+{$ENDIF}
+ AddMethod('function SaveState: TCanvasSaveState', CallMethod);
+ AddMethod('procedure RestoreState(State: TCanvasSaveState)', CallMethod);
+ AddMethod('procedure SetClipRects(ARects: array of TfsRectF)', CallMethod);
+ AddMethod('procedure IntersectClipRect(ARect: TfsRectF)', CallMethod);
+ AddMethod('procedure ExcludeClipRect(ARect: TfsRectF)', CallMethod);
+ AddMethod('procedure ResetClipRect', CallMethod);
+ AddMethod('procedure DrawLine(APt1: TfsPointF; APt2: TfsPointF; AOpacity: Single)', CallMethod);
+ AddMethod('procedure FillRect(ARect: TfsRectF; XRadius: Single; YRadius: Single; ACorners: TCorners; AOpacity: Single; ACornerType: TCornerType)', CallMethod);
+ AddMethod('procedure DrawRect(ARect: TfsRectF; XRadius: Single; YRadius: Single; ACorners: TCorners; AOpacity: Single; ACornerType: TCornerType)', CallMethod);
+ AddMethod('procedure FillEllipse(ARect: TfsRectF; AOpacity: Single)', CallMethod);
+ AddMethod('procedure DrawEllipse(ARect: TfsRectF; AOpacity: Single)', CallMethod);
+ AddMethod('procedure FillArc(Center: TfsPointF; Radius: TfsPointF; StartAngle: Single; SweepAngle: Single; AOpacity: Single)', CallMethod);
+ AddMethod('procedure DrawArc(Center: TfsPointF; Radius: TfsPointF; StartAngle: Single; SweepAngle: Single; AOpacity: Single)', CallMethod);
+ AddMethod('function PtInPath(APoint: TfsPointF; APath: TPathData): Boolean', CallMethod);
+ AddMethod('procedure FillPath(APath: TPathData; AOpacity: Single)', CallMethod);
+ AddMethod('procedure DrawPath(APath: TPathData; AOpacity: Single)', CallMethod);
+ AddMethod('procedure DrawBitmap(ABitmap: TBitmap; SrcRect: TfsRectF; DstRect: TfsRectF; AOpacity: Single; HighSpeed: Boolean)', CallMethod);
+ AddMethod('procedure DrawRectSides(ARect: TfsRectF; XRadius: Single; YRadius: Single; ACorners: TCorners; AOpacity: Single; ASides: TSides; ACornerType: TCornerType)', CallMethod);
+ AddMethod('procedure FillPolygon(Points: TPolygon; AOpacity: Single)', CallMethod);
+ AddMethod('procedure DrawPolygon(Points: TPolygon; AOpacity: Single)', CallMethod);
+ AddMethod('function LoadFontFromStream(AStream: TStream): Boolean', CallMethod);
+ AddMethod('procedure FillText(ARect: TfsRectF; AText: string; WordWrap: Boolean; AOpacity: Single; Flags: TFillTextFlags; ATextAlign: TTextAlign; AVTextAlign: TTextAlign)', CallMethod);
+ AddMethod('procedure MeasureText(var ARect: TfsRectF; AText: string; WordWrap: Boolean; Flags: TFillTextFlags; ATextAlign: TTextAlign; AVTextAlign: TTextAlign)', CallMethod);
+ AddMethod('procedure MeasureLines(ALines: TLineMetricInfo; ARect: TfsRectF; AText: string; WordWrap: Boolean; Flags: TFillTextFlags; ATextAlign: TTextAlign; AVTextAlign: TTextAlign)', CallMethod);
+ AddMethod('function TextToPath(Path: TPathData; ARect: TfsRectF; AText: string; WordWrap: Boolean; ATextAlign: TTextAlign; AVTextAlign: TTextAlign): Boolean', CallMethod);
+ AddMethod('function TextWidth(AText: string): Single', CallMethod);
+ AddMethod('function TextHeight(AText: string): Single', CallMethod);
+ AddMethod('procedure SetCustomDash(Dash: array; Offset: Single)', CallMethod);
+{$IFDEF Delphi17}
+ AddProperty('Stroke', 'TStrokeBrush', GetProp);
+ AddProperty('StrokeCap', 'TStrokeCap', nil, SetProp);
+ AddProperty('StrokeDash', 'TStrokeDash', nil, SetProp);
+ AddProperty('StrokeJoin', 'TStrokeJoin', nil, SetProp);
+{$ELSE}
+ AddProperty('Stroke', 'TBrush', GetProp);
+ AddProperty('StrokeCap', 'TStrokeCap', GetProp, SetProp);
+ AddProperty('StrokeDash', 'TStrokeDash', GetProp, SetProp);
+ AddProperty('StrokeJoin', 'TStrokeJoin', GetProp, SetProp);
+{$ENDIF}
+ AddProperty('StrokeThickness', 'Single', GetProp, SetProp);
+ AddProperty('Fill', 'TBrush', GetProp, SetProp);
+ AddProperty('Font', 'TFont', GetProp);
+ AddProperty('Matrix', 'TfsMatrix', GetProp);
+ AddProperty('Width', 'Integer', GetProp);
+ AddProperty('Height', 'Integer', GetProp);
+ end;
+ with AddClass(TBitmap, 'TPersistent') do
+ begin
+ AddConstructor('constructor Create(AWidth, AHeight: Integer)', CallMethod);
+ AddConstructor('constructor CreateFromStream(AStream: TStream)', CallMethod);
+ AddConstructor('constructor CreateFromFile(AFileName: string)', CallMethod);
+ AddMethod('procedure SetSize(AWidth, AHeight: Integer)', CallMethod);
+ AddMethod('procedure Clear(AColor: TAlphaColor)', CallMethod);
+ AddMethod('procedure ClearRect(ARect: TfsRectF; AColor: TAlphaColor = 0)', CallMethod);
+ AddMethod('function IsEmpty: Boolean', CallMethod);
+ AddMethod('procedure Rotate(Angle: Single)', CallMethod);
+ AddMethod('procedure FlipHorizontal', CallMethod);
+ AddMethod('procedure FlipVertical', CallMethod);
+ AddMethod('procedure InvertAlpha', CallMethod);
+{$IFNDEF DELPHI20}
+ AddMethod('procedure LoadFromFile(AFileName: string; Rotate: Single = 0)', CallMethod);
+{$ELSE}
+ AddMethod('procedure LoadFromFile(AFileName: string)', CallMethod);
+{$ENDIF}
+ AddMethod('procedure SaveToFile(AFileName: string)', CallMethod);
+ AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
+{$IFNDEF Delphi17}
+ AddMethod('procedure BitmapChanged', CallMethod);
+ AddIndexProperty( 'Pixels', 'Integer, Integer', 'TAlphaColor', CallMethod);
+{$ENDIF}
+ AddProperty('Canvas', 'TCanvas', GetProp);
+{$IFNDEF Delphi21}
+ AddProperty('ResourceBitmap', 'TBitmap', GetProp);
+{$ENDIF}
+ AddProperty('Width', 'Integer', GetProp, SetProp);
+ AddProperty('Height', 'Integer', GetProp, SetProp);
+ end;
+ AddClass(TSpline, 'TObject');
+ AddClass(TBounds, 'TPersistent');
+ AddClass(TTransform, 'TPersistent');
+
+
+
+{$IFNDEF Delphi17}
+ AddClass(TBitmapCodec, 'TPersistent');
+{$ENDIF}
+ AddClass(TPathData, 'TPersistent');
+ AddClass(TCanvasSaveState, 'TPersistent');
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ _Canvas: TCanvas;
+ _Bitmap: TBitmap;
+// mRects: array of TRectF;
+ mDashs: array of Single;
+ mPoly: TPolygon;
+ Idx, Cnt, nLo: Integer;
+begin
+ Result := 0;
+
+ if ClassType = TFont then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TFont(Instance).Create);
+ end
+ else if ClassType = TBitmap then
+ begin
+ _Bitmap := TBitmap(Instance);
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TBitmap(Instance).Create(Caller.Params[0], Caller.Params[1]))
+ else if MethodName = 'CREATEFROMSTREAM' then
+ Result := frxInteger(_Bitmap.CreateFromStream(TStream(frxInteger(Caller.Params[0]))))
+ else if MethodName = 'CREATEFROMFILE' then
+ Result := frxInteger(_Bitmap.CreateFromFile(String(Caller.Params[0])))
+ else if MethodName = 'SETSIZE' then
+ _Bitmap.SetSize(Integer(Caller.Params[0]), Integer(Caller.Params[1]))
+ else if MethodName = 'CLEAR' then
+ _Bitmap.Clear(TAlphaColor(Caller.Params[0]))
+ else if MethodName = 'CLEARRECT' then
+ begin
+ _Bitmap.ClearRect(TfsRectF(frxInteger(Caller.Params[0])).GetRect, TAlphaColor(Caller.Params[1]));
+ end
+ else if MethodName = 'ISEMPTY' then
+ Result := _Bitmap.IsEmpty
+ else if MethodName = 'ROTATE' then
+ _Bitmap.Rotate(Single(Caller.Params[1]))
+ else if MethodName = 'FLIPHORIZONTAL' then
+ _Bitmap.FlipHorizontal
+ else if MethodName = 'FLIPVERTICAL' then
+ _Bitmap.FlipVertical
+ else if MethodName = 'INVERTALPHA' then
+ _Bitmap.InvertAlpha
+ else if MethodName = 'LOADFROMFILE' then
+{$IFNDEF DELPHI20}
+ _Bitmap.LoadFromFile(String(Caller.Params[0]), Single(Caller.Params[1]))
+{$ELSE}
+ _Bitmap.LoadFromFile(String(Caller.Params[0]))
+{$ENDIF}
+ else if MethodName = 'SAVETOFILE' then
+ _Bitmap.SaveToFile(String(Caller.Params[0]))
+ else if MethodName = 'LOADFROMSTREAM' then
+ _Bitmap.LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVETOSTREAM' then
+ _Bitmap.SaveToStream(TStream(frxInteger(Caller.Params[0])))
+{$IFNDEF Delphi17}
+ else if MethodName = 'BITMAPCHANGED' then
+ _Bitmap.BitmapChanged
+ else if MethodName = 'PIXELS.GET' then
+ Result := _Bitmap.Pixels[Caller.Params[0], Caller.Params[1]]
+ else if MethodName = 'PIXELS.SET' then
+ _Bitmap.Pixels[Caller.Params[0], Caller.Params[1]] := Caller.Params[2]
+{$ENDIF}
+ end
+ else if ClassType = TBrush then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TBrush(Instance).Create(TBrushKind(frxInteger(Caller.Params[0])),
+ TAlphaColor(frxInteger(Caller.Params[0]))))
+ end
+ else if ClassType = TCanvas then
+ begin
+ _Canvas := TCanvas(Instance);
+
+ if MethodName = 'BEGINSCENE' then
+ Result := _Canvas.BeginScene
+ else if MethodName = 'ENDSCENE' then
+ _Canvas.EndScene
+ else if MethodName = 'CLEAR' then
+ _Canvas.Clear(TAlphaColor(Caller.Params[0]))
+ else if MethodName = 'CLEARRECT' then
+ _Canvas.ClearRect(TfsRectF(frxInteger(Caller.Params[0])).GetRect, TAlphaColor(Caller.Params[1]))
+ else if MethodName = 'SETMATRIX' then
+ _Canvas.SetMatrix(TfsMatrix(frxInteger(Caller.Params[0])).GetRect)
+{$IFDEF Delphi17}
+ else if MethodName = 'MULTIPLYMATRIX' then
+ _Canvas.MultiplyMatrix(TfsMatrix(frxInteger(Caller.Params[0])).GetRect)
+{$ELSE}
+ else if MethodName = 'MULTYMATRIX' then
+ _Canvas.MultyMatrix(TfsMatrix(frxInteger(Caller.Params[0])).GetRect)
+{$ENDIF}
+ else if MethodName = 'SAVESTATE' then
+ Result := frxInteger(_Canvas.SaveState)
+ else if MethodName = 'RESTORESTATE' then
+ _Canvas.RestoreState(TCanvasSaveState(frxInteger(Caller.Params[0])))
+ { else if MethodName = 'SETCLIPRECTS' then
+ begin
+ nLo := VarArrayLowBound(Caller.Params[0], 1);
+ Cnt := VarArrayHighBound(Caller.Params[0], 1) - nLo;
+ SetLength(mRects, Cnt);
+ for Idx := 0 to Cnt - 1 do
+ mRects[Idx] := TfsRectF(frxInteger(Caller.Params[0][Idx + nLo])).GetRectP^;
+ _Canvas.SetClipRects(mRects);
+ SetLength(mRects, 0);
+ end }
+ else if MethodName = 'EXCLUDECLIPRECT' then
+ _Canvas.ExcludeClipRect(TfsRectF(frxInteger(Caller.Params[0])).GetRect)
+ else if MethodName = 'INTERSECTCLIPTRECT' then
+ _Canvas.IntersectClipRect(TfsRectF(frxInteger(Caller.Params[0])).GetRect)
+ {else if MethodName = 'RESETCLIPRECT' then
+ _Canvas.ResetClipRect }
+ else if MethodName = 'DRAWLINE' then
+ _Canvas.DrawLine(TfsPointF(frxInteger(Caller.Params[0])).GetRect, TfsPointF(frxInteger(Caller.Params[1])).GetRect, Single(Caller.Params[2]))
+ else if MethodName = 'FILLRECT' then
+ _Canvas.FillRect(TfsRectF(frxInteger(Caller.Params[0])).GetRect, Single(Caller.Params[1]), Single(Caller.Params[2]), TCorners(Byte(Caller.Params[3])), Single(Caller.Params[4]), TCornerType(Caller.Params[5]))
+ else if MethodName = 'DRAWRECT' then
+ _Canvas.DrawRect(TfsRectF(frxInteger(Caller.Params[0])).GetRect, Single(Caller.Params[1]), Single(Caller.Params[2]), TCorners(Byte(Caller.Params[3])), Single(Caller.Params[4]), TCornerType(Caller.Params[5]))
+ else if MethodName = 'FILLELLIPSE' then
+ _Canvas.FillEllipse(TfsRectF(frxInteger(Caller.Params[0])).GetRect, Single(Caller.Params[1]))
+ else if MethodName = 'DRAWELLIPSE' then
+ _Canvas.DrawEllipse(TfsRectF(frxInteger(Caller.Params[0])).GetRect, Single(Caller.Params[1]))
+ else if MethodName = 'FILLARC' then
+ _Canvas.FillArc(TfsPointF(frxInteger(Caller.Params[0])).GetRect, TfsPointF(frxInteger(Caller.Params[1])).GetRect, Single(Caller.Params[2]), Single(Caller.Params[3]), Single(Caller.Params[4]))
+ else if MethodName = 'DRAWARC' then
+ _Canvas.DrawArc(TfsPointF(frxInteger(Caller.Params[0])).GetRect, TfsPointF(frxInteger(Caller.Params[1])).GetRect, Single(Caller.Params[2]), Single(Caller.Params[3]), Single(Caller.Params[4]))
+ else if MethodName = 'PTINPATH' then
+ Result := Boolean(_Canvas.PtInPath(TfsPointF(frxInteger(Caller.Params[0])).GetRect, TPathData(frxInteger(Caller.Params[1]))))
+ else if MethodName = 'FILLPATH' then
+ _Canvas.FillPath(TPathData(frxInteger(Caller.Params[0])), Single(Caller.Params[1]))
+ else if MethodName = 'DRAWPATH' then
+ _Canvas.DrawPath(TPathData(frxInteger(Caller.Params[0])), Single(Caller.Params[1]))
+ else if MethodName = 'DRAWBITMAP' then
+ _Canvas.DrawBitmap(TBitmap(frxInteger(Caller.Params[0])), TfsRectF(frxInteger(Caller.Params[1])).GetRect, TfsRectF(frxInteger(Caller.Params[2])).GetRect, Single(Caller.Params[3]), Boolean(Caller.Params[4]))
+ else if MethodName = 'DRAWRECTSIDES' then
+ _Canvas.DrawRectSides(TfsRectF(frxInteger(Caller.Params[0])).GetRect, Single(Caller.Params[1]), Single(Caller.Params[2]), TCorners(Byte(Caller.Params[3])), Single(Caller.Params[4]), TSides(Byte(Caller.Params[5])), TCornerType(Caller.Params[6]))
+ else if MethodName = 'FILLPOLYGON' then
+ begin
+ nLo := VarArrayLowBound(Caller.Params[0], 1);
+ Cnt := VarArrayHighBound(Caller.Params[0], 1) - nLo;
+ SetLength(mPoly, Cnt);
+ for Idx := 0 to Cnt - 1 do
+ mPoly[Idx] := TfsPointF(frxInteger(Caller.Params[0][Idx + nLo])).GetRectP^;
+ _Canvas.FillPolygon(TPolygon(Caller.Params[0]), Single(Caller.Params[1]));
+ SetLength(mPoly, 0);
+ end
+ else if MethodName = 'DRAWPOLYGON' then
+ begin
+ nLo := VarArrayLowBound(Caller.Params[0], 1);
+ Cnt := VarArrayHighBound(Caller.Params[0], 1) - nLo;
+ SetLength(mPoly, Cnt);
+ for Idx := 0 to Cnt - 1 do
+ mPoly[Idx] := TfsPointF(frxInteger(Caller.Params[0][Idx + nLo])).GetRectP^;
+ _Canvas.DrawPolygon(TPolygon(Caller.Params[0]), Single(Caller.Params[1]));
+ SetLength(mPoly, 0);
+ end
+ else if MethodName = 'LOADFONTFROMSTREAM' then
+ Result := Boolean(_Canvas.LoadFontFromStream(TStream(frxInteger(Caller.Params[0]))))
+ else if MethodName = 'FILLTEXT' then
+ _Canvas.FillText(TfsRectF(frxInteger(Caller.Params[0])).GetRect, String(Caller.Params[1]), Boolean(Caller.Params[2]), Single(Caller.Params[3]), TFillTextFlags(Byte(Caller.Params[4])), TTextAlign(Caller.Params[5]), TTextAlign(Caller.Params[6]))
+ else if MethodName = 'MEASURETEXT' then
+ _Canvas.MeasureText(TfsRectF(frxInteger(Caller.Params[0])).GetRectP^, String(Caller.Params[1]), Boolean(Caller.Params[2]), TFillTextFlags(Byte(Caller.Params[3])), TTextAlign(Caller.Params[4]), TTextAlign(Caller.Params[5]))
+ else if MethodName = 'MEASURELINES' then
+ _Canvas.MeasureLines(TLineMetricInfo(frxInteger(Caller.Params[0])), TfsRectF(frxInteger(Caller.Params[1])).GetRect, String(Caller.Params[2]), Boolean(Caller.Params[3]), TFillTextFlags(Byte(Caller.Params[4])), TTextAlign(Caller.Params[5]), TTextAlign(Caller.Params[6]))
+ else if MethodName = 'TEXTTOPATH' then
+ Result := Boolean(_Canvas.TextToPath(TPathData(frxInteger(Caller.Params[0])), TfsRectF(frxInteger(Caller.Params[1])).GetRect, String(Caller.Params[2]), Boolean(Caller.Params[3]), TTextAlign(Caller.Params[4]), TTextAlign(Caller.Params[5])))
+ else if MethodName = 'TEXTWIDTH' then
+ Result := Single(_Canvas.TextWidth(String(Caller.Params[0])))
+ else if MethodName = 'TEXTHEIGHT' then
+ Result := Single(_Canvas.TextHeight(String(Caller.Params[0])))
+ else if MethodName = 'SETCUSTOMDASH' then
+ begin
+ nLo := VarArrayLowBound(Caller.Params[0], 1);
+ Cnt := VarArrayHighBound(Caller.Params[0], 1) - nLo;
+ SetLength(mDashs, Cnt);
+ for Idx := 0 to Cnt - 1 do
+ mDashs[Idx] := Single(Caller.Params[0][Idx + nLo]);
+{$IFDEF DELPHI25}
+ _Canvas.Stroke.SetCustomDash(mDashs, Single(Caller.Params[1]));
+{$ELSE}
+ _Canvas.SetCustomDash(mDashs, Single(Caller.Params[1]));
+{$ENDIF}
+ SetLength(mDashs, 0);
+ end
+{$IFNDEF CLX}
+ { else if MethodName = 'PIXELS.GET' then
+ Result := _Canvas.Pixels[Caller.Params[0], Caller.Params[1]]
+ else if MethodName = 'PIXELS.SET' then
+ _Canvas.Pixels[Caller.Params[0], Caller.Params[1]] := Caller.Params[2] }
+{$ENDIF}
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+ if ClassType = TBitmap then
+ begin
+ if PropName = 'CANVAS' then
+ Result := frxInteger(TBitmap(Instance).Canvas)
+{$IFNDEF Delphi21}
+ else if PropName = 'RESOURCEBITMAP' then
+ Result := frxInteger(TBitmap(Instance).ResourceBitmap)
+{$ENDIF}
+ else if PropName = 'WIDTH' then
+ Result := Integer(TBitmap(Instance).Width)
+ else if PropName = 'HEIGHT' then
+ Result := Integer(TBitmap(Instance).Height)
+ end
+ else if ClassType = TCanvas then
+ begin
+ if PropName = 'STROKE' then
+ Result := frxInteger(TCanvas(Instance).Stroke)
+ else if PropName = 'WIDTH' then
+ Result := Integer(TCanvas(Instance).Width)
+ else if PropName = 'HEIGHT' then
+ Result := Integer(TCanvas(Instance).Height)
+ else if PropName = 'FONT' then
+ Result := frxInteger(TCanvas(Instance).Font)
+ else if PropName = 'FILL' then
+ Result := frxInteger(TCanvas(Instance).Fill)
+ else if PropName = 'STROKETHICKNESS' then
+{$IFDEF DELPHI25}
+ Result := Single(TCanvas(Instance).Stroke.Thickness)
+{$ELSE}
+ Result := Single(TCanvas(Instance).StrokeThickness)
+{$ENDIF}
+{$IFNDEF Delphi17}
+ else if PropName = 'STROKECAP' then
+ Result := Integer(TCanvas(Instance).StrokeCap)
+ else if PropName = 'STROKEDASH' then
+ Result := Integer(TCanvas(Instance).StrokeDash)
+ else if PropName = 'STROKEJOIN' then
+ Result := Integer(TCanvas(Instance).StrokeJoin)
+{$ENDIF}
+ end;
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TBitmap then
+ begin
+ if PropName = 'WIDTH' then
+ TBitmap(Instance).Width := Integer(Value)
+ else if PropName = 'HEIGHT' then
+ TBitmap(Instance).Height:= Integer(Value)
+ end
+ else if ClassType = TCanvas then
+ begin
+ if PropName = 'STROKETHICKNESS' then
+{$IFDEF DELPHI25}
+ TCanvas(Instance).Stroke.Thickness := Single(Value)
+{$ELSE}
+ TCanvas(Instance).StrokeThickness := Single(Value)
+{$ENDIF}
+ else if PropName = 'STROKECAP' then
+{$IFDEF DELPHI25}
+ TCanvas(Instance).Stroke.Cap := TStrokeCap(Value)
+{$ELSE}
+ TCanvas(Instance).StrokeCap := TStrokeCap(Value)
+{$ENDIF}
+ else if PropName = 'STROKEDASH' then
+{$IFDEF DELPHI25}
+ TCanvas(Instance).Stroke.Dash := TStrokeDash(Value)
+{$ELSE}
+ TCanvas(Instance).StrokeDash := TStrokeDash(Value)
+{$ENDIF}
+ else if PropName = 'STROKEJOIN' then
+{$IFDEF DELPHI25}
+ TCanvas(Instance).Stroke.Join := TStrokeJoin(Value)
+{$ELSE}
+ TCanvas(Instance).StrokeJoin := TStrokeJoin(Value)
+{$ENDIF}
+ end;
+end;
+
+procedure TFunctions.GetColorProc(const Name: String);
+var
+ c: Integer;
+begin
+ IdentToAlphaColor('cla' + Name, c);
+ Script.AddConst('cla' + Name, 'Integer', c);
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsGraphicsRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/FMX.fs_iibxrtti.pas b/FastScript/FMX.fs_iibxrtti.pas
new file mode 100644
index 0000000..dd92476
--- /dev/null
+++ b/FastScript/FMX.fs_iibxrtti.pas
@@ -0,0 +1,125 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ IBX classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iibxrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_itools, FMX.fs_idbrtti, Data.db, FMX.Types
+{$IFDEF DELPHI20}
+ , IBX.ibdatabase, IBX.IBCustomDataSet, IBX.IBQuery, IBX.IBTable, IBX.IBStoredProc
+{$ELSE}
+ , ibdatabase, IBCustomDataSet, IBQuery, IBTable, IBStoredProc
+{$ENDIF}
+ ;
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsIBXRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class (TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass; const MethodName:
+ String; Caller: TfsMethodHelper): Variant;
+ function RecordCount(Instance: TObject; ClassType: TClass; const PropName:
+ String): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddClass(TIBDataBase, 'TComponent');
+
+ with AddClass(TIBTransaction, 'TComponent') do
+ begin
+ AddMethod('procedure Commit', CallMethod);
+ AddMethod('procedure RollBack', CallMethod);
+ AddMethod('procedure StartTransaction', CallMethod);
+ end;
+
+ AddClass(TIBCustomDataSet, 'TDataSet');
+ AddClass(TIBTable, 'TIBCustomDataSet');
+ with AddClass(TIBQuery, 'TIBCustomDataSet') do
+ begin
+ AddMethod('procedure ExecSQL', CallMethod);
+ AddMethod('procedure FetchAll', CallMethod);
+ AddProperty('RecordCount', 'Integer',RecordCount, nil);
+ end;
+ with AddClass(TIBStoredProc, 'TIBCustomDataSet') do
+ AddMethod('procedure ExecProc', CallMethod);
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; const
+ MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TIBQuery then
+ begin
+ if MethodName = 'EXECSQL' then
+ TIBQuery(Instance).ExecSQL
+ else
+ if MethodName = 'FETCHALL' then
+ TIBQuery(Instance).FETCHALL;
+ end
+ else
+ if ClassType = TIBStoredProc then
+ begin
+ if MethodName = 'EXECPROC' then
+ TIBStoredProc(Instance).ExecProc
+ end
+ else
+ if(ClassType = TIBTransaction) AND (MethodName = 'COMMIT') then
+ TIBTransaction(Instance).Commit
+ else
+ if (ClassType = TIBTransaction) AND (MethodName = 'ROLLBACK') then
+ TIBTransaction(Instance).RollBack
+ else
+ if(ClassType = TIBTransaction) AND (MethodName = 'STARTTRANSACTION') then
+ TIBTransaction(Instance).StartTransaction;
+
+end;
+
+function TFunctions.RecordCount(Instance: TObject; ClassType: TClass; const
+ PropName: String): Variant;
+begin
+ Result:=0;
+ if (ClassType = TIBQuery) AND (PropName = 'RECORDCOUNT') then
+ Result:=TIBQuery(Instance).RecordCount;
+
+end;
+
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsIBXRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/FMX.fs_iilparser.pas b/FastScript/FMX.fs_iilparser.pas
new file mode 100644
index 0000000..b8d0425
--- /dev/null
+++ b/FastScript/FMX.fs_iilparser.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Intermediate Language parser }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iilparser;
+{$i FMX.inc}
+{$i fs_iilparser.pas}
\ No newline at end of file
diff --git a/FastScript/FMX.fs_iinirtti.pas b/FastScript/FMX.fs_iinirtti.pas
new file mode 100644
index 0000000..42561a5
--- /dev/null
+++ b/FastScript/FMX.fs_iinirtti.pas
@@ -0,0 +1,372 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ IniFiles.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{ Copyright (c) 2004-2007 }
+{ by Stalker SoftWare }
+{ }
+{******************************************}
+
+unit FMX.fs_iinirtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, System.IniFiles, FMX.Types, System.Types;
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsIniRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass; const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass; const PropName: String): Variant;
+ procedure SaveIniFileToStream(oIniFile: TCustomIniFile; oStream: TStream);
+ procedure LoadIniFileFromStream(oIniFile :TCustomIniFile; oStream :TStream);
+ procedure WriteTStrings(oIniFile: TCustomIniFile; const Section: String; Values: TStrings; IsClear :Boolean = True);
+ procedure ReadTStrings(oIniFile: TCustomIniFile; const Section: String; Values: TStrings; IsClear :Boolean = True);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+
+ with AScript do
+ begin
+ with AddClass(TCustomIniFile, 'TObject') do
+ begin
+ AddConstructor('constructor Create(const FileName: String)', CallMethod);
+ AddMethod('function ReadInteger(const Section, Ident: String; Default: LongInt): LongInt', CallMethod);
+ AddMethod('procedure WriteInteger(const Section, Ident: String; Value: LongInt)', CallMethod);
+ AddMethod('function ReadBool(const Section, Ident: String; Default: Boolean): Boolean', CallMethod);
+ AddMethod('procedure WriteBool(const Section, Ident: String; Value: Boolean)', CallMethod);
+ AddMethod('function ReadDate(const Section, Name: String; Default: TDateTime): TDateTime', CallMethod);
+ AddMethod('procedure WriteDate(const Section, Name: String; Value: TDateTime)', CallMethod);
+ AddMethod('function ReadDateTime(const Section, Name: String; Default: TDateTime): TDateTime', CallMethod);
+ AddMethod('procedure WriteDateTime(const Section, Name: String; Value: TDateTime)', CallMethod);
+ AddMethod('function ReadFloat(const Section, Name: String; Default: Double): Double', CallMethod);
+ AddMethod('procedure WriteFloat(const Section, Name: String; Value: Double)', CallMethod);
+ AddMethod('function ReadTime(const Section, Name: String; Default: TDateTime): TDateTime', CallMethod);
+ AddMethod('procedure WriteTime(const Section, Name: String; Value: TDateTime);', CallMethod);
+{$IFDEF DELPHI6}
+ AddMethod('function ReadBinaryStream(const Section, Name: String; Value: TStream): Integer', CallMethod);
+ AddMethod('procedure WriteBinaryStream(const Section, Name: String; Value: TStream)', CallMethod);
+{$ENDIF}
+ AddMethod('function SectionExists(const Section: String): Boolean', CallMethod);
+ AddMethod('function ValueExists(const Section, Ident: String): Boolean', CallMethod);
+
+ AddMethod('procedure WriteTStrings(const Section :String; Value :TStrings; IsClear :Boolean = True)', CallMethod);
+ AddMethod('function ReadTStrings(const Section :String; Value :TStrings; IsClear :Boolean = True): String;', CallMethod);
+
+ AddProperty('FileName', 'String', GetProp);
+ end;
+
+ with AddClass(TMemIniFile, 'TCustomIniFile') do
+ begin
+ AddConstructor('constructor Create(const FileName: String)', CallMethod);
+ AddMethod('procedure WriteString(const Section, Ident, Value: String)', CallMethod);
+ AddMethod('function ReadString(const Section, Ident, Default: String): String;', CallMethod);
+{$IFDEF DELPHI6}
+ AddMethod('procedure ReadSectionValuesEx(const Section: String; Strings: TStrings)', CallMethod);
+{$ENDIF}
+ AddMethod('procedure DeleteKey(const Section, Ident: String)', CallMethod);
+ AddMethod('procedure ReadSection(const Section: String; Strings: TStrings)', CallMethod);
+ AddMethod('procedure ReadSections(Strings: TStrings)', CallMethod);
+ AddMethod('procedure ReadSectionValues(const Section: String; Strings: TStrings)', CallMethod);
+ AddMethod('procedure EraseSection(const Section: String)', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure GetStrings(List: TStrings)', CallMethod);
+ AddMethod('procedure SetStrings(List: TStrings)', CallMethod);
+ AddMethod('procedure SaveIniFileToStream(oStream: TStream)', CallMethod);
+ AddMethod('procedure LoadIniFileFromStream(oStream: TStream)', CallMethod);
+ end;
+
+ with AddClass(TIniFile, 'TCustomIniFile') do
+ begin
+ AddMethod('procedure WriteString(const Section, Ident, Value: String)', CallMethod);
+ AddMethod('function ReadString(const Section, Ident, Default: String): String;', CallMethod);
+{$IFDEF DELPHI6}
+ AddMethod('procedure ReadSectionValuesEx(const Section: String; Strings: TStrings)', CallMethod);
+{$ENDIF}
+ AddMethod('procedure DeleteKey(const Section, Ident: String)', CallMethod);
+ AddMethod('procedure ReadSection(const Section: String; Strings: TStrings)', CallMethod);
+ AddMethod('procedure ReadSections(Strings: TStrings)', CallMethod);
+ AddMethod('procedure ReadSectionValues(const Section: String; Strings: TStrings)', CallMethod);
+ AddMethod('procedure EraseSection(const Section: String)', CallMethod);
+ AddMethod('procedure SaveIniFileToStream(oStream: TStream)', CallMethod);
+ AddMethod('procedure LoadIniFileFromStream(oStream: TStream)', CallMethod);
+ end;
+
+ end;
+
+end;
+
+{$HINTS OFF}
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ oCustomIniFile: TCustomIniFile;
+ oMemIniFile: TMemIniFile;
+ oIniFile: TIniFile;
+ oList: TStrings;
+ nCou: Integer;
+
+begin
+
+ Result := 0;
+
+ if ClassType = TCustomIniFile then
+ begin
+ oCustomIniFile := TCustomIniFile(Instance);
+ if MethodName = 'CREATE' then
+ Result := frxInteger(oCustomIniFile.Create(Caller.Params[0]))
+ else if MethodName = 'WRITEINTEGER' then
+ oCustomIniFile.WriteInteger(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READINTEGER' then
+ Result := oCustomIniFile.ReadInteger(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITEBOOL' then
+ oCustomIniFile.WriteBool(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READBOOL' then
+ Result := oCustomIniFile.ReadBool(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITEDATE' then
+ oCustomIniFile.WriteDate(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READDATE' then
+ Result := oCustomIniFile.ReadDate(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITEDATETIME' then
+ oCustomIniFile.WriteDateTime(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READDATETIME' then
+ Result := oCustomIniFile.ReadDateTime(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITEFLOAT' then
+ oCustomIniFile.WriteFloat(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READFLOAT' then
+ Result := oCustomIniFile.ReadFloat(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITETIME' then
+ oCustomIniFile.WriteTime(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READTIME' then
+ Result := oCustomIniFile.ReadTime(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+{$IFDEF DELPHI6}
+ else if MethodName = 'WRITEBINARYSTREAM' then
+ oCustomIniFile.WriteBinaryStream(Caller.Params[0], Caller.Params[1], TStream(frxInteger(Caller.Params[2])))
+ else if MethodName = 'READBINARYSTREAM' then
+ Result := oCustomIniFile.ReadBinaryStream(Caller.Params[0], Caller.Params[1], TStream(frxInteger(Caller.Params[2])))
+{$ENDIF}
+ else if MethodName = 'SECTIONEXISTS' then
+ Result := oCustomIniFile.SectionExists(Caller.Params[0])
+ else if MethodName = 'VALUEEXISTS' then
+ Result := oCustomIniFile.ValueExists(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'WRITETSTRINGS' then
+ WriteTStrings(oCustomIniFile, Caller.Params[0], TStrings(frxInteger(Caller.Params[1])), Caller.Params[2])
+ else if MethodName = 'READTSTRINGS' then
+ ReadTStrings(oCustomIniFile, Caller.Params[0], TStrings(frxInteger(Caller.Params[1])), Caller.Params[2])
+
+ end;
+
+ if ClassType = TMemIniFile then
+ begin
+ oMemIniFile := TMemIniFile(Instance);
+ if MethodName = 'CREATE' then
+ Result := frxInteger(oMemIniFile.Create(Caller.Params[0]))
+ else if MethodName = 'WRITESTRING' then
+ oMemIniFile.WriteString(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READSTRING' then
+ Result := oMemIniFile.ReadString(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'DELETEKEY' then
+ oMemIniFile.DeleteKey(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'READSECTION' then
+ oMemIniFile.ReadSection(Caller.Params[0], TStrings(frxInteger(Caller.Params[1])))
+ else if MethodName = 'READSECTIONS' then
+ oMemIniFile.ReadSections(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'READSECTIONVALUES' then
+ oMemIniFile.ReadSectionValues(Caller.Params[0], TStrings(frxInteger(Caller.Params[1])))
+ else if MethodName = 'ERASESECTION' then
+ oMemIniFile.EraseSection(Caller.Params[0])
+{$IFDEF DELPHI6}
+ else if MethodName = 'READSECTIONVALUESEX' then
+ begin
+ oList := TStringList.Create;
+ try
+ oMemIniFile.ReadSectionValues(Caller.Params[0], oList);
+ TStrings(frxInteger(Caller.Params[1])).Clear;
+ for nCou := 0 to oList.Count-1 do
+// TStrings(frxInteger(Caller.Params[1])).Add(oList.ValueFromIndex[nCou]);
+ TStrings(frxInteger(Caller.Params[1])).Add(oList.Values[oList.Names[nCou]]);
+ finally
+ oList.Free;
+ end;
+ end
+{$ENDIF}
+ else if MethodName = 'CLEAR' then
+ oMemIniFile.Clear
+ else if MethodName = 'GETSTRINGS' then
+ oMemIniFile.GetStrings(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SETSTRINGS' then
+ oMemIniFile.SetStrings(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVEINIFILETOSTREAM' then
+ SaveIniFileToStream(oMemIniFile, TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LOADINIFILEFROMSTREAM' then
+ LoadIniFileFromStream(oMemIniFile, TStream(frxInteger(Caller.Params[0])))
+ end;
+
+ if ClassType = TIniFile then
+ begin
+ oIniFile := TIniFile(Instance);
+ if MethodName = 'WRITESTRING' then
+ oIniFile.WriteString(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READSTRING' then
+ Result := oIniFile.ReadString(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'DELETEKEY' then
+ oIniFile.DeleteKey(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'READSECTION' then
+ oIniFile.ReadSection(Caller.Params[0], TStrings(frxInteger(Caller.Params[1])))
+ else if MethodName = 'READSECTIONS' then
+ oIniFile.ReadSections(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'READSECTIONVALUES' then
+ oIniFile.ReadSectionValues(Caller.Params[0], TStrings(frxInteger(Caller.Params[1])))
+ else if MethodName = 'ERASESECTION' then
+ oIniFile.EraseSection(Caller.Params[0])
+{$IFDEF DELPHI6}
+ else if MethodName = 'READSECTIONVALUESEX' then
+ begin
+ oList := TStringList.Create;
+ try
+ oIniFile.ReadSectionValues(Caller.Params[0], oList);
+ TStrings(frxInteger(Caller.Params[1])).Clear;
+ for nCou := 0 to oList.Count-1 do
+// TStrings(frxInteger(Caller.Params[1])).Add(oList.ValueFromIndex[nCou]);
+ TStrings(frxInteger(Caller.Params[1])).Add(oList.Values[oList.Names[nCou]]);
+ finally
+ oList.Free;
+ end;
+ end
+{$ENDIF}
+ else if MethodName = 'SAVEINIFILETOSTREAM' then
+ SaveIniFileToStream(oIniFile, TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LOADINIFILEFROMSTREAM' then
+ LoadIniFileFromStream(oIniFile, TStream(frxInteger(Caller.Params[0])))
+ end;
+
+end;
+{$HINTS ON}
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass; const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TCustomIniFile then
+ begin
+ if PropName = 'FILENAME' then
+ Result := TIniFile(Instance).FileName
+ end;
+end;
+
+procedure TFunctions.SaveIniFileToStream(oIniFile :TCustomIniFile; oStream :TStream);
+var
+ oStrings :TStrings;
+
+begin
+
+ if (not Assigned(oIniFile)) or (not Assigned(oStream)) then Exit;
+
+ if not ((oIniFile is TIniFile) or (oIniFile is TMemIniFile)) then Exit;
+
+ oStrings:= TStringList.Create;
+ try
+
+ if oIniFile is TIniFile then
+ oStrings.LoadFromFile(oIniFile.FileName)
+ else
+ if oIniFile is TMemIniFile then
+ TMemIniFile(oIniFile).GetStrings(oStrings);
+
+ oStrings.SaveToStream(oStream);
+
+ finally
+ oStrings.Free;
+ end;
+
+end;
+
+procedure TFunctions.LoadIniFileFromStream(oIniFile :TCustomIniFile; oStream :TStream);
+var
+ oStrings :TStrings;
+
+begin
+
+ if (not Assigned(oIniFile)) or (not Assigned(oStream)) then Exit;
+
+ if not ((oIniFile is TIniFile) or (oIniFile is TMemIniFile)) then Exit;
+
+ oStrings:= TStringList.Create;
+ try
+
+ oStrings.LoadFromStream(oStream);
+
+ if oIniFile is TIniFile then
+ oStrings.SaveToFile(oIniFile.FileName)
+ else
+ if oIniFile is TMemIniFile then
+ TMemIniFile(oIniFile).SetStrings(oStrings);
+
+ finally
+ oStrings.Free;
+ end;
+
+end;
+
+procedure TFunctions.WriteTStrings(oIniFile :TCustomIniFile; const Section :String; Values :TStrings; IsClear :Boolean = True);
+var
+ nCou :Integer;
+
+begin
+
+ if IsClear then oIniFile.EraseSection(Section);
+
+ for nCou := 0 to Values.Count-1 do
+ oIniFile.WriteString(Section, 'Items'+IntToStr(nCou), Values[nCou]);
+
+ oIniFile.WriteInteger(Section, 'Count', Values.Count);
+
+end;
+
+procedure TFunctions.ReadTStrings(oIniFile :TCustomIniFile; const Section :String; Values :TStrings; IsClear :Boolean = True);
+var
+ nCou, nCount :Integer;
+
+begin
+
+ nCount := oIniFile.ReadInteger(Section, 'Count', 0);
+
+ if IsClear then Values.Clear;
+
+ for nCou := 0 to nCount-1 do
+ Values.Add(oIniFile.ReadString(Section, 'Items'+IntToStr(nCou), ''));
+
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsIniRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/FMX.fs_iinterpreter.pas b/FastScript/FMX.fs_iinterpreter.pas
new file mode 100644
index 0000000..0953f64
--- /dev/null
+++ b/FastScript/FMX.fs_iinterpreter.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Main module }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iinterpreter;
+{$i FMX.inc}
+{$i fs_iinterpreter.pas}
\ No newline at end of file
diff --git a/FastScript/FMX.fs_ijs.pas b/FastScript/FMX.fs_ijs.pas
new file mode 100644
index 0000000..4b321a6
--- /dev/null
+++ b/FastScript/FMX.fs_ijs.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ JScript grammar }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_ijs;
+{$i FMX.inc}
+{$i fs_ijs.pas}
\ No newline at end of file
diff --git a/FastScript/FMX.fs_imenusrtti.pas b/FastScript/FMX.fs_imenusrtti.pas
new file mode 100644
index 0000000..fe9b172
--- /dev/null
+++ b/FastScript/FMX.fs_imenusrtti.pas
@@ -0,0 +1,104 @@
+{**********************************************}
+{ }
+{ FastScript v1.9 }
+{ Menus }
+{ }
+{ Copyright (c) 1998-2011 }
+{ by Fast Reports Inc. }
+{ }
+{**********************************************}
+
+unit FMX.fs_imenusrtti;
+
+interface
+
+{$I fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Menus, FMX.fs_iinterpreter, FMX.fs_ievents, System.Types, System.Variants, FMX.Types;
+
+type
+{$i frxPlatformsAttribute.inc}
+
+ TfsMenusRTTI = class(TComponent); // fake component
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass; const MethodName:
+ string; Caller: TfsMethodHelper): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+
+ with AScript do
+ begin
+
+ AddType('TPopupAlignment', fvtInt);
+
+
+ with AddClass(TMenuItem, 'TTextControl') do
+ begin
+ AddMethod('procedure Popup', CallMethod);
+ AddMethod('procedure NeedPopup', CallMethod);
+ AddMethod('function HavePopup: Boolean', CallMethod);
+ end; { with }
+
+ with AddClass(TMainMenu, 'TFmxObject') do
+ with AddClass(TMenuBar, 'TStyledControl') do
+ AddMethod('procedure StartMenuLoop', CallMethod);
+
+ with AddClass(TPopupMenu, 'TFmxObject') do
+ AddMethod('procedure Popup(X, Y: Single)', CallMethod);
+
+ end; { with }
+
+end; { Create }
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; const
+ MethodName: string; Caller: TfsMethodHelper): Variant;
+var
+ oMenuItem: TMenuItem;
+begin
+ Result := 0;
+
+ if ClassType = TMenuItem then
+ begin
+
+ oMenuItem := TMenuItem(Instance);
+
+ if MethodName = 'POPUP' then
+ oMenuItem.Popup
+ else if MethodName = 'NEEDPOPUP' then
+ oMenuItem.NeedPopup
+ else if MethodName = 'HAVEPOPUP' then
+ Result := oMenuItem.HavePopup;
+
+ end
+ else if ClassType = TPopupMenu then
+ begin
+
+ if MethodName = 'POPUP' then
+ TPopupMenu(Instance).Popup(Caller.Params[0], Caller.Params[1]);
+
+ end;
+end; { CallMethod }
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsMenusRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
+
diff --git a/FastScript/FMX.fs_iparser.pas b/FastScript/FMX.fs_iparser.pas
new file mode 100644
index 0000000..b922d9e
--- /dev/null
+++ b/FastScript/FMX.fs_iparser.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Parser }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iparser;
+{$i FMX.inc}
+{$i fs_iparser.pas}
\ No newline at end of file
diff --git a/FastScript/FMX.fs_ipascal.pas b/FastScript/FMX.fs_ipascal.pas
new file mode 100644
index 0000000..33f4f12
--- /dev/null
+++ b/FastScript/FMX.fs_ipascal.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Pascal grammar }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_ipascal;
+{$i FMX.inc}
+{$i fs_ipascal.pas}
\ No newline at end of file
diff --git a/FastScript/FMX.fs_isysrtti.pas b/FastScript/FMX.fs_isysrtti.pas
new file mode 100644
index 0000000..b1405ee
--- /dev/null
+++ b/FastScript/FMX.fs_isysrtti.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Standard functions }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_isysrtti;
+{$i FMX.inc}
+{$i fs_isysrtti.pas}
\ No newline at end of file
diff --git a/FastScript/FMX.fs_itools.pas b/FastScript/FMX.fs_itools.pas
new file mode 100644
index 0000000..871b7c6
--- /dev/null
+++ b/FastScript/FMX.fs_itools.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Common functions }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_itools;
+{$i FMX.inc}
+{$i fs_itools.pas}
\ No newline at end of file
diff --git a/FastScript/FMX.fs_lazarus.pas b/FastScript/FMX.fs_lazarus.pas
new file mode 100644
index 0000000..7c4d3a2
--- /dev/null
+++ b/FastScript/FMX.fs_lazarus.pas
@@ -0,0 +1,25 @@
+{ This file was automatically created by Lazarus. do not edit!
+ This source is only used to compile and install the package.
+ }
+
+unit fs_lazarus;
+
+interface
+
+uses
+ fs_ipascal, fs_icpp, fs_ijs, fs_ibasic, fs_iclassesrtti, fs_iconst,
+ fs_idialogsrtti, fs_ievents, fs_iexpression, fs_iextctrlsrtti,
+ fs_iformsrtti, fs_igraphicsrtti, fs_iilparser, fs_iinirtti, fs_iinterpreter,
+ fs_iparser, fs_isysrtti, fs_itools, fs_xml, fs_ireg, fs_synmemo, fs_tree,
+ LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+ RegisterUnit('fs_ireg', @fs_ireg.Register);
+end;
+
+initialization
+ RegisterPackage('fs_lazarus', @Register);
+end.
diff --git a/FastScript/FMX.fs_synmemo.fmx b/FastScript/FMX.fs_synmemo.fmx
new file mode 100644
index 0000000..da0b5ed
--- /dev/null
+++ b/FastScript/FMX.fs_synmemo.fmx
@@ -0,0 +1,50 @@
+object fsSynMemoSearch: TfsSynMemoSearch
+ Left = 0
+ Top = 0
+ BorderStyle = bsToolWindow
+ Caption = 'Search for text'
+ ClientHeight = 129
+ ClientWidth = 249
+ Position = poScreenCenter
+ FormFactor.Width = 320
+ FormFactor.Height = 480
+ FormFactor.Devices = [dkDesktop, dkiPhone, dkiPad]
+ DesignerMobile = False
+ DesignerWidth = 0
+ DesignerHeight = 0
+ DesignerDeviceName = ''
+ DesignerOrientation = 0
+ object Edit1: TEdit
+ TabOrder = 0
+ Position.X = 48.000000000000000000
+ Position.Y = 13.000000000000000000
+ Width = 193.000000000000000000
+ Height = 22.000000000000000000
+ KillFocusByReturn = False
+ end
+ object Label1: TLabel
+ Height = 15.000000000000000000
+ Position.X = 8.000000000000000000
+ Position.Y = 16.000000000000000000
+ Text = 'Search :'
+ Width = 49.000000000000000000
+ end
+ object Search: TButton
+ Height = 17.000000000000000000
+ ModalResult = 1
+ Position.X = 88.000000000000000000
+ Position.Y = 48.000000000000000000
+ TabOrder = 2
+ Text = 'Search'
+ Width = 73.000000000000000000
+ end
+ object Button1: TButton
+ Height = 17.000000000000000000
+ ModalResult = 2
+ Position.X = 168.000000000000000000
+ Position.Y = 48.000000000000000000
+ TabOrder = 3
+ Text = 'Cancel'
+ Width = 73.000000000000000000
+ end
+end
diff --git a/FastScript/FMX.fs_synmemo.pas b/FastScript/FMX.fs_synmemo.pas
new file mode 100644
index 0000000..01b86ad
--- /dev/null
+++ b/FastScript/FMX.fs_synmemo.pas
@@ -0,0 +1,2397 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Syntax memo FMX control }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+{ Simple syntax highlighter. Supports Pascal, C++, JS, VB and SQL syntax.
+
+ Assign text to Text property.
+ Assign desired value to SyntaxType property.
+ Call SetPos to move caret.
+ Call ShowMessage to display an error message at the bottom.
+}
+
+unit FMX.fs_synmemo;
+
+interface
+
+{$I fs.inc}
+{$I fmx.inc}
+
+uses
+ System.Classes, System.Variants, System.UIConsts, System.SysUtils, System.UITypes, System.Types,
+ FMX.Controls, FMX.Forms, FMX.Menus, FMX.Types, FMX.Edit, FMX.Platform, FMX.TreeView
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Text
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+ TSyntaxType = (stPascal, stCpp, stJs, stVB, stSQL, stText);
+ TCharAttr = (caNo, caText, caBlock, caComment, caKeyword, caString);
+ TCharAttributes = set of TCharAttr;
+
+type
+ TfsBorderSettings = class(TPersistent)
+ private
+ FFill: TBrush;
+ FWidth: Integer;
+ private
+ procedure SetFill(const Value: TBrush);
+ procedure SetWidth(const Value: Integer);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ published
+ property Fill: TBrush read FFill write SetFill;
+ property Width: Integer read FWidth write SetWidth;
+ end;
+
+ TfsFontSettings = class(TPersistent)
+ private
+ FFill: TBrush;
+ FFont: TFont;
+ procedure SetFill(const Value: TBrush);
+ procedure SetFont(const Value: TFont);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Fill: TBrush read FFill write SetFill;
+ property Font: TFont read FFont write SetFont;
+ end;
+
+{$i frxPlatformsAttribute.inc}
+ TfsSyntaxMemo = class(TStyledControl{$IFDEF DELPHI18}, ICaret{$ENDIF})
+ private
+{$IFDEF DELPHI18}
+ FCaret: TCaret;
+{$ENDIF}
+ FBorder: TfsBorderSettings;
+ FFill: TBrush;
+ FFontSettings: TfsFontSettings;
+ FGutterFill: TBrush;
+ FAllowLinesChange: Boolean;
+ FCharHeight: Single;
+ FCharWidth: Single;
+ FDoubleClicked: Boolean;
+ FDown: Boolean;
+ FGutterWidth: Integer;
+ FFooterHeight: Integer;
+ FIsMonoType: Boolean;
+ FKeywords: String;
+ FMaxLength: Integer;
+ FMessage: String;
+ FModified: Boolean;
+ FMoved: Boolean;
+ FOffset: TPoint;
+ FPos: TPoint;
+ FReadOnly: Boolean;
+ FSelEnd: TPoint;
+ FSelStart: TPoint;
+ FSynStrings: TStrings;
+ FSyntaxType: TSyntaxType;
+ FTempPos: TPoint;
+ FText: TStringList;
+ FKeywordAttr: TfsFontSettings;
+ FStringAttr: TfsFontSettings;
+ FTextAttr: TfsFontSettings;
+ FCommentAttr: TfsFontSettings;
+ FBlockColor: TAlphaColor;
+ FBlockFontColor: TAlphaColor;
+ FUndo: TStringList;
+ FUpdating: Boolean;
+ FUpdatingSyntax: Boolean;
+ FVScroll: TScrollBar;
+ FWindowSize: TPoint;
+ FPopupMenu: TPopupMenu;
+ KWheel: Integer;
+ LastSearch: String;
+ FShowGutter: boolean;
+ FShowFooter: boolean;
+ Bookmarks: array of Integer;
+ FActiveLine: Integer;
+ FOnChange: TNotifyEvent;
+ FTmpCanvas: TBitmap;
+ procedure CalcCharSize;
+ function GetCharWidth(Str: String): Single;
+ function GetText: TStrings;
+ procedure SetText(Value: TStrings);
+ procedure SetSyntaxType(Value: TSyntaxType);
+ procedure SetShowGutter(Value: boolean);
+ procedure SetShowFooter(Value: boolean);
+ function FMemoFind(Text: String; var Position : TPoint): boolean;
+ function GetCharAttr(Pos: TPoint): TCharAttributes;
+ function GetLineBegin(Index: Integer): Integer;
+ function GetPlainTextPos(Pos: TPoint): Integer;
+ function GetPosPlainText(Pos: Integer): TPoint;
+ function GetSelText: String;
+ function LineAt(Index: Integer): String;
+ function LineLength(Index: Integer): Integer;
+ function Pad(n: Integer): String;
+ procedure AddSel;
+ procedure AddUndo;
+ procedure ClearSel;
+ procedure CreateSynArray;
+ procedure DoChange;
+ procedure EnterIndent;
+ procedure SetSelText(Value: String);
+ procedure ShiftSelected(ShiftRight: Boolean);
+ procedure ShowCaretPos;
+ procedure TabIndent;
+ procedure UnIndent;
+ procedure UpdateScrollBar;
+ procedure UpdateSyntax;
+ procedure DoLeft;
+ procedure DoRight;
+ procedure DoUp;
+ procedure DoDown;
+ procedure DoHome(Ctrl: Boolean);
+ procedure DoEnd(Ctrl: Boolean);
+ procedure DoPgUp;
+ procedure DoPgDn;
+ procedure DoChar(Ch: Char);
+ procedure DoReturn;
+ procedure DoDel;
+ procedure DoBackspace;
+ procedure DoCtrlI;
+ procedure DoCtrlU;
+ procedure DoCtrlR;
+ procedure DoCtrlL;
+ procedure ScrollClick(Sender: TObject);
+ procedure ScrollEnter(Sender: TObject);
+ procedure LinesChange(Sender: TObject);
+ procedure ShowPos;
+ procedure BookmarkDraw(Y :Single; ALine : integer);
+ procedure ActiveLineDraw(Y :Single; ALine : integer);
+ procedure CorrectBookmark(Line : integer; delta : integer);
+ procedure SetKeywordAttr(Value: TfsFontSettings);
+ procedure SetStringAttr(Value: TfsFontSettings);
+ procedure SetTextAttr(Value: TfsFontSettings);
+ procedure SetCommentAttr(Value: TfsFontSettings);
+ procedure SetBorder(const Value: TfsBorderSettings);
+ procedure SetFill(const Value: TBrush);
+ procedure SetFontSettings(const Value: TfsFontSettings);
+ procedure SetGutterFill(const Value: TBrush);
+ protected
+ procedure SetParent(const Value: TFmxObject); override;
+ function GetClientRect: TRectF;
+ procedure DblClick; override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
+ procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
+ procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
+ procedure CopyPopup(Sender: TObject);
+ procedure PastePopup(Sender: TObject);
+ procedure CutPopup(Sender: TObject);
+ procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override;
+ procedure DOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+ procedure DDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+ procedure DoExit; override;
+ procedure Resize; override;
+ procedure UpdateWindowSize;
+ procedure FontChanged(Sender: TObject);
+ procedure DialogKey(var Key: Word; Shift: TShiftState); override;
+{$IFDEF Delphi18}
+ function ICaret.GetObject = GetCaret;
+ function GetCaret: TCustomCaret;
+ procedure SetCaret(const Value: TCaret);
+ procedure ShowCaret;
+ procedure HideCaret;
+{$ENDIF}
+{$IFDEF Delphi17}
+ function CreateCaret: TCaret; {$IFNDEF Delphi18} override; {$ENDIF}
+{$ENDIF}
+ procedure SetAttr(aCanvas: TCanvas; a: TCharAttributes);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Paint; override;
+ procedure CopyToClipboard;
+ procedure CutToClipboard;
+ procedure PasteFromClipboard;
+ procedure SetPos(x, y: Integer);
+ procedure ShowMessage(s: String);
+ procedure Undo;
+ procedure UpdateView;
+ function GetPos: TPoint;
+ function Find(Text: String): boolean;
+ property Modified: Boolean read FModified write FModified;
+ property SelText: String read GetSelText write SetSelText;
+ function IsBookmark(Line : integer): integer;
+ procedure AddBookmark(Line, Number : integer);
+ procedure DeleteBookmark(Number : integer);
+ procedure GotoBookmark(Number : integer);
+ procedure SetActiveLine(Line : Integer);
+ function GetActiveLine: Integer;
+{$IFDEF Delphi18}
+ property Caret: TCaret read FCaret write SetCaret;
+{$ENDIF}
+ published
+ property Align;
+ property Anchors;
+ property DragMode;
+ property Enabled;
+ property PopupMenu;
+ property ShowHint;
+ property TabOrder;
+ property Width;
+ property Height;
+ property Visible;
+{$IFDEF Delphi18}
+ property Cursor;
+{$ENDIF}
+ property BlockColor: TAlphaColor read FBlockColor write FBlockColor;
+ property BlockFontColor: TAlphaColor read FBlockFontColor write FBlockFontColor;
+ property CommentAttr: TfsFontSettings read FCommentAttr write SetCommentAttr;
+ property KeywordAttr: TfsFontSettings read FKeywordAttr write SetKeywordAttr;
+ property StringAttr: TfsFontSettings read FStringAttr write SetStringAttr;
+ property TextAttr: TfsFontSettings read FTextAttr write SetTextAttr;
+ property Border: TfsBorderSettings read FBorder write SetBorder;
+ property Fill: TBrush read FFill write SetFill;
+ property FontSettings: TfsFontSettings read FFontSettings write SetFontSettings;
+ property GutterFill: TBrush read FGutterFill write SetGutterFill;
+ property Lines: TStrings read GetText write SetText;
+ property ReadOnly: Boolean read FReadOnly write FReadOnly;
+ property SyntaxType: TSyntaxType read FSyntaxType write SetSyntaxType;
+ property ShowFooter: boolean read FShowFooter write SetShowFooter;
+ property ShowGutter: boolean read FShowGutter write SetShowGutter;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ property OnClick;
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfsSynMemoSearch = class(TForm)
+ Search: TButton;
+ Button1: TButton;
+ Label1: TLabel;
+ Edit1: TEdit;
+ procedure FormKeyPress(Sender: TObject; var Key: Char);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ SynMemoSearch: TfsSynMemoSearch;
+
+implementation
+
+{$R *.FMX}
+{$IFDEF DELPHI18}
+type THachCaret = class(TCaret);
+{$ENDIF}
+
+const
+ PasKeywords =
+ 'and,array,begin,case,const,div,do,downto,else,end,except,finally,'+
+ 'for,function,if,in,is,mod,nil,not,of,or,procedure,program,repeat,shl,'+
+ 'shr,string,then,to,try,until,uses,var,while,with,xor';
+
+ CppKeywords =
+ 'bool,break,case,char,continue,define,default,delete,do,double,else,'+
+ 'except,finally,float,for,if,include,int,is,new,return,string,switch,try,'+
+ 'variant,void,while';
+
+ SQLKeywords =
+ 'active,after,all,alter,and,any,as,asc,ascending,at,auto,' +
+ 'base_name,before,begin,between,by,cache,cast,check,column,commit,' +
+ 'committed,computed,conditional,constraint,containing,count,create,' +
+ 'current,cursor,database,debug,declare,default,delete,desc,descending,' +
+ 'distinct,do,domain,drop,else,end,entry_point,escape,exception,execute,' +
+ 'exists,exit,external,extract,filter,for,foreign,from,full,function,' +
+ 'generator,grant,group,having,if,in,inactive,index,inner,insert,into,is,' +
+ 'isolation,join,key,left,level,like,merge,names,no,not,null,of,on,only,' +
+ 'or,order,outer,parameter,password,plan,position,primary,privileges,' +
+ 'procedure,protected,read,retain,returns,revoke,right,rollback,schema,' +
+ 'select,set,shadow,shared,snapshot,some,suspend,table,then,to,' +
+ 'transaction,trigger,uncommitted,union,unique,update,user,using,values,' +
+ 'view,wait,when,where,while,with,work';
+
+ JSKeywords =
+ 'break,case,continue,default,delete,do,else,except,finally,for,function,' +
+ 'import,in,is,if,new,return,switch,try,var,while,with';
+
+ VBKeywords =
+ 'addressof,and,as,byref,byval,case,catch,delete,dim,do,else,elseif,' +
+ 'end,endif,exit,finally,for,function,if,imports,is,loop,mod,new,next,' +
+ 'not,or,rem,return,select,set,step,sub,then,to,try,wend,while,with,xor';
+
+
+ WordChars = ['a'..'z', 'A'..'Z', '0'..'9', '_'];
+ LineBreak: AnsiString = sLineBreak;
+
+function IsUnicodeChar(Chr: Char): Boolean;
+begin
+ Result := ((Chr >= Char($007F)) and (Chr <= Char($FFFF)));
+end;
+
+
+{ TfsSyntaxMemo }
+
+constructor TfsSyntaxMemo.Create(AOwner: TComponent);
+var
+ m: TMenuItem;
+ i: integer;
+begin
+ inherited Create(AOwner);
+ FTmpCanvas := TBitmap.Create(1, 1);
+{$IFDEF DELPHI18}
+ FCaret := CreateCaret;
+{$ENDIF}
+ FVScroll := TScrollBar.Create(Self);
+ FVScroll.Stored := False;
+ FVScroll.Orientation := TOrientation.orVertical;
+
+ FFontSettings := TfsFontSettings.Create;
+ FFontSettings.Font.OnChanged := FontChanged;
+ FFontSettings.Fill.Color := TAlphaColorRec.Black;
+
+ FCommentAttr := TfsFontSettings.Create;
+ FCommentAttr.Fill.Color := TAlphaColorRec.Green;
+ FCommentAttr.Font.Style := [TFontStyle.fsItalic];
+
+ FKeywordAttr := TfsFontSettings.Create;
+ FKeywordAttr.FFill.Color := TAlphaColorRec.Navy;
+ FKeywordAttr.Font.Style := [TFontStyle.fsBold];
+
+ FStringAttr := TfsFontSettings.Create;
+ FStringAttr.Fill.Color := TAlphaColorRec.Navy;
+ FStringAttr.Font.Style := [];
+
+ FTextAttr := TfsFontSettings.Create;
+ FTextAttr.Fill.Color := TAlphaColorRec.Black;
+ FTextAttr.Font.Style := [];
+
+ FBorder := TfsBorderSettings.Create;
+ FFill := TBrush.Create(TBrushKind.bkSolid, TAlphaColorRec.White);
+ FGutterFill := TBrush.Create(TBrushKind.bkSolid, TAlphaColorRec.Whitesmoke);
+
+ if AOwner is TFmxObject then
+ Parent := AOwner as TFmxObject;
+
+ OnDragOver := DOver;
+ OnDragDrop := DDrop;
+ KWheel := -1;
+
+
+ FText := TStringList.Create;
+ FUndo := TStringList.Create;
+ FSynStrings := TStringList.Create;
+ FText.Add('');
+ FText.OnChange := LinesChange;
+ FMaxLength := 1024;
+ SyntaxType := stPascal;
+ FMoved := True;
+ SetPos(1, 1);
+ FOffset := Point(0, 0);
+ CanFocus := True;
+ Cursor := crIBeam;
+
+ FBlockColor := TAlphaColorRec.Blue;
+ FBlockFontColor := TAlphaColorRec.White;
+
+ FPopupMenu := TPopupMenu.Create(Self);
+ m := TMenuItem.Create(FPopupMenu);
+ m.Text := 'Cut';
+ m.OnClick := CutPopup;
+ FPopupMenu.AddObject(m);
+ m := TMenuItem.Create(FPopupMenu);
+ m.Text := 'Copy';
+ m.OnClick := CopyPopup;
+ FPopupMenu.AddObject(m);
+ m := TMenuItem.Create(FPopupMenu);
+ m.Text := 'Paste';
+ m.OnClick := PastePopup;
+ FPopupMenu.AddObject(m);
+
+ LastSearch := '';
+ Setlength(Bookmarks, 10);
+ for i := 0 to Length(Bookmarks)-1 do
+ Bookmarks[i] := -1;
+
+ FActiveLine := -1;
+
+ Height := 200;
+ Width := 200;
+ CalcCharSize;
+end;
+
+destructor TfsSyntaxMemo.Destroy;
+begin
+ FPopupMenu.Free;
+ FCommentAttr.Free;
+ FKeywordAttr.Free;
+ FStringAttr.Free;
+ FFontSettings.Free;
+ FTextAttr.Free;
+ FText.Free;
+ FUndo.Free;
+ FSynStrings.Free;
+ //FVScroll.Free;
+ FFill.Free;
+ FBorder.Free;
+ FGutterFill.Free;
+{$IFDEF DELPHI18}
+ FCaret.Free;
+{$ENDIF}
+ FreeAndNil(FTmpCanvas);
+ inherited;
+end;
+
+procedure TfsSyntaxMemo.CalcCharSize;
+var
+ tmpBmp: TBitmap;
+ r: TRectF;
+begin
+ tmpBmp := TBitmap.Create(1, 1);
+ with tmpBmp.Canvas do
+ begin
+ Font.Assign(FFontSettings.Font);
+ Font.Style := [];
+ r := RectF(0, 0, 1000, 1000);
+ MeasureText(r, 'WWWWWW', True, [], TTextAlign.taLeading); // taLeading returns incorrect results in xe2
+ FCharHeight := r.Height + 2;
+ FCharWidth := r.Width / 6;
+ FIsMonoType := Pos('COURIER NEW', AnsiUppercase(FFontSettings.Font.Family)) <> 0;
+ end;
+ tmpBmp.Free;
+end;
+
+{$IFDEF Delphi17}
+function TfsSyntaxMemo.CreateCaret: TCaret;
+begin
+ Result := TCaret.Create(Self);
+ Result.Visible := True;
+{$IFDEF DELPHI20}
+ Result.ReadOnly := False;
+ Result.Color := claBlack;
+{$ENDIF}
+ Result.Pos := TPointF.Create(1, 1);
+end;
+{$ENDIF}
+
+{$IFDEF DELPHI18}
+function TfsSyntaxMemo.GetCaret: TCustomCaret;
+begin
+ Result := FCaret;
+end;
+
+procedure TfsSyntaxMemo.SetCaret(const Value: TCaret);
+begin
+ if Assigned(FCaret) then
+ FCaret.Assign(Value);
+end;
+
+procedure TfsSyntaxMemo.ShowCaret;
+begin
+ THachCaret(FCaret).Show;
+end;
+
+procedure TfsSyntaxMemo.HideCaret;
+begin
+ THachCaret(FCaret).Hide;
+end;
+{$ENDIF}
+
+procedure TfsSyntaxMemo.ShowCaretPos;
+var
+ cWidth: Single;
+ LineLen: Integer;
+begin
+ cWidth := GetCharWidth(Copy(LineAt(FPos.Y - 1), FOffset.X, FPos.X - 1 - FOffset.X));
+ LineLen := LineLength(FPos.Y - 1);
+ if LineLen < FPos.X then
+ cWidth := Round(cWidth + FCharWidth * (FPos.X - 1 - LineLen));
+{$IFNDEF Delphi18}
+{$IFDEF Delphi17}
+ if IsFocused then
+ begin
+ CaretVisible := False;
+ SetCaretParams(PointF(
+ FCharWidth * (FPos.X - 1 - FOffset.X) + FGutterWidth + FBorder.Width + 1,
+ FCharHeight * (FPos.Y - 1 - FOffset.Y) + 1),
+ PointF(2, FCharHeight), claBlack);
+ CaretVisible := True;
+ end
+ else
+ CaretVisible := False;
+{$ELSE}
+ if IsFocused then
+ begin
+ SetCaretSize(PointF(2, FCharHeight));
+ SetCaretPos(PointF(
+ FCharWidth * (FPos.X - 1 - FOffset.X) + FGutterWidth + FBorder.Width + 1,
+ FCharHeight * (FPos.Y - 1 - FOffset.Y) + 1));
+ ShowCaretProc;
+ end
+ else
+ HideCaret;
+{$ENDIF}
+{$ELSE}
+ if IsFocused then
+ begin
+ //SetCaretSize(PointF(2, FCharHeight));
+ FCaret.Size := PointF(2, FCharHeight);
+ FCaret.Pos := PointF(
+ cWidth + FGutterWidth + FBorder.Width + 1,
+ FCharHeight * (FPos.Y - 1 - FOffset.Y) + 1);
+ ShowCaret;
+// SetCaretPos(PointF(
+// FCharWidth * (FPos.X - 1 - FOffset.X) + FGutterWidth + FBorder.Width + 1,
+// FCharHeight * (FPos.Y - 1 - FOffset.Y) + 1));
+// ShowCaretProc;
+ end
+ else
+ HideCaret;
+{$ENDIF}
+end;
+
+procedure TfsSyntaxMemo.ShowPos;
+var
+ cRect: TRectF;
+begin
+ if FFooterHeight > 0 then
+ with Canvas do
+ begin
+ Font.Family := 'Tahoma';
+ Font.Style := [];
+ Font.Size := 11;
+ Fill.Color := TAlphaColorRec.Black;
+ cRect := GetClientRect;
+ FillText(RectF(cRect.Left + FGutterWidth + 2, cRect.Bottom - TextHeight('|') - 8,
+ FGutterWidth + 4 + FCharWidth * 10 ,
+ (Self.Height - TextHeight('|') - 4) + FCharHeight), IntToStr(FPos.y)
+ + ' : ' + IntToStr(FPos.x) + ' ', FALSE, 1, [], TTextAlign.taLeading);
+ end;
+end;
+
+procedure TfsSyntaxMemo.SetParent(const Value: TFmxObject);
+begin
+ inherited SetParent(Value);
+ if (Parent = nil) or (csDestroying in ComponentState) then Exit;
+ ShowGutter := True;
+ ShowFooter := True;
+ FVScroll.Parent := Self;
+ FVScroll.OnChange := ScrollClick;
+ FVScroll.OnEnter := ScrollEnter;
+end;
+
+function TfsSyntaxMemo.GetClientRect: TRectF;
+begin
+ if FVScroll.Visible then
+ Result := RectF(FBorder.Width, FBorder.Width,
+ Width - FVScroll.Width - FBorder.Width,
+ Height - FBorder.Width)
+ else
+ Result := RectF(FBorder.Width, FBorder.Width,
+ Width - FBorder.Width, Height - FBorder.Width);
+end;
+
+procedure TfsSyntaxMemo.UpdateSyntax;
+begin
+ CreateSynArray;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.UpdateScrollBar;
+begin
+ with FVScroll do
+ begin
+// prevent OnScroll event
+ FUpdating := True;
+
+ Value := 0;
+ ViewportSize := 0;
+
+ Max := FText.Count;
+ SmallChange := 1;
+ if FWindowSize.Y < Max then
+ begin
+ Visible := True;
+ ViewportSize := FWindowSize.Y;
+ end
+ else
+ Visible := False;
+ ViewportSize := FWindowSize.Y;
+ Value := FOffset.Y;
+
+ FUpdating := False;
+ end;
+end;
+
+function TfsSyntaxMemo.GetText: TStrings;
+var
+ i: Integer;
+begin
+ for i := 0 to FText.Count - 1 do
+ FText[i] := LineAt(i);
+ Result := FText;
+ FAllowLinesChange := True;
+end;
+
+procedure TfsSyntaxMemo.SetText(Value: TStrings);
+begin
+ FAllowLinesChange := True;
+ FText.Assign(Value);
+end;
+
+procedure TfsSyntaxMemo.SetSyntaxType(Value: TSyntaxType);
+begin
+ FSyntaxType := Value;
+ if Value = stPascal then
+ FKeywords := PasKeywords
+ else if Value = stCpp then
+ FKeywords := CppKeywords
+ else if Value = stSQL then
+ FKeywords := SQLKeywords
+ else if Value = stVB then
+ FKeywords := VBKeywords
+ else if Value = stJS then
+ FKeywords := JSKeywords
+ else
+ FKeywords := '';
+ UpdateSyntax;
+end;
+
+function TfsSyntaxMemo.GetPos: TPoint;
+begin
+ Result := FPos;
+end;
+
+procedure TfsSyntaxMemo.DoChange;
+begin
+ FModified := True;
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+end;
+
+procedure TfsSyntaxMemo.LinesChange(Sender: TObject);
+begin
+ if FAllowLinesChange then
+ begin
+ UpdateSyntax;
+ FAllowLinesChange := False;
+ if FText.Count = 0 then
+ FText.Add('');
+ FMoved := True;
+ FUndo.Clear;
+ FPos := Point(1, 1);
+ FOffset := Point(0, 0);
+ SetPos(FPos.X, FPos.Y);
+ ClearSel;
+ ShowCaretPos;
+ UpdateScrollBar;
+ end;
+end;
+
+procedure TfsSyntaxMemo.ShowMessage(s: String);
+begin
+ FMessage := s;
+ Repaint;
+end;
+
+procedure SetClipboard(const Value: String);
+{$IFDEF Delphi17}
+var
+ ClipService: IFMXClipboardService;
+begin
+ if TPlatformServices.Current.SupportsPlatformService(IFMXClipboardService, IInterface(ClipService)) then
+ ClipService.SetClipboard(Value);
+end;
+{$ELSE}
+begin
+ Platform.SetClipboard(Value);
+end;
+{$ENDIF}
+
+function GetClipboard: String;
+{$IFDEF Delphi17}
+var
+ ClipService: IFMXClipboardService;
+begin
+ if TPlatformServices.Current.SupportsPlatformService(IFMXClipboardService, IInterface(ClipService)) then
+ Result := ClipService.GetClipboard.ToString
+ else
+ Result := '';
+end;
+{$ELSE}
+begin
+ Result := VarToStr(Platform.GetClipboard);
+end;
+{$ENDIF}
+
+procedure TfsSyntaxMemo.CopyToClipboard;
+begin
+ if FSelStart.X <> 0 then
+ SetClipboard(SelText);
+end;
+
+procedure TfsSyntaxMemo.CutToClipboard;
+begin
+ if not FReadOnly then
+ begin
+ if FSelStart.X <> 0 then
+ begin
+ SetClipboard(SelText);
+ SelText := '';
+ end;
+ CorrectBookmark(FSelStart.Y, FSelStart.Y - FSelEnd.Y);
+ Repaint;
+ end;
+end;
+
+procedure TfsSyntaxMemo.PasteFromClipboard;
+begin
+ if (not FReadOnly) then
+ SelText := GetClipboard;
+end;
+
+function TfsSyntaxMemo.LineAt(Index: Integer): String;
+begin
+ if Index < FText.Count then
+ Result := TrimRight(FText[Index])
+ else
+ Result := '';
+end;
+
+function TfsSyntaxMemo.LineLength(Index: Integer): Integer;
+begin
+ if Index < 0 then
+ Result := 0 else
+ Result := Length(LineAt(Index));
+end;
+
+function TfsSyntaxMemo.Pad(n: Integer): String;
+begin
+ result := '';
+ SetLength(result, n);
+ Result := StringOfChar(Char(' '), n)
+end;
+
+procedure TfsSyntaxMemo.AddUndo;
+begin
+ if not FMoved then exit;
+ FUndo.Add(Format('%5d%5d', [FPos.X, FPos.Y]) + FText.Text);
+ if FUndo.Count > 32 then
+ FUndo.Delete(0);
+end;
+
+procedure TfsSyntaxMemo.Undo;
+var
+ s: String;
+begin
+ FMoved := True;
+ if FUndo.Count = 0 then exit;
+ s := FUndo[FUndo.Count - 1];
+ FPos.X := StrToInt(Copy(s, 1, 5));
+ FPos.Y := StrToInt(Copy(s, 6, 5));
+ FText.Text := Copy(s, 11, Length(s) - 10);
+ FUndo.Delete(FUndo.Count - 1);
+ SetPos(FPos.X, FPos.Y);
+ UpdateSyntax;
+ DoChange;
+end;
+
+function TfsSyntaxMemo.GetPlainTextPos(Pos: TPoint): Integer;
+var
+ i: Integer;
+begin
+ Result := 0;
+ for i := 0 to Pos.Y - 2 do
+ Result := Result + Length(FText[i]) + Length(LineBreak);
+ Result := Result + Pos.X;
+end;
+
+function TfsSyntaxMemo.GetPosPlainText(Pos: Integer): TPoint;
+var
+ i: Integer;
+ s: String;
+begin
+ Result := Point(0, 1);
+ s := FText.Text;
+ i := 1;
+ while i <= Pos do
+ if s[i] = Char(LineBreak[1]) then
+ begin
+ Inc(i, Length(LineBreak));
+ if i <= Pos then
+ begin
+ Inc(Result.Y);
+ Result.X := 0;
+ end
+ else
+ Inc(Result.X);
+ end
+ else
+ begin
+ Inc(i);
+ Inc(Result.X);
+ end;
+end;
+
+function TfsSyntaxMemo.GetLineBegin(Index: Integer): Integer;
+var
+ s: String;
+begin
+ s := FText[Index];
+ Result := 1;
+ if Trim(s) <> '' then
+ for Result := 1 to Length(s) do
+ if s[Result] <> ' ' then
+ break;
+end;
+
+procedure TfsSyntaxMemo.TabIndent;
+begin
+ SelText := Pad(2);
+end;
+
+procedure TfsSyntaxMemo.EnterIndent;
+var
+ res: Integer;
+begin
+ if Trim(FText[FPos.Y - 1]) = '' then
+ res := FPos.X else
+ res := GetLineBegin(FPos.Y - 1);
+
+ CorrectBookmark(FPos.Y, 1);
+
+ FPos := Point(1, FPos.Y + 1);
+ SelText := Pad(res - 1);
+end;
+
+procedure TfsSyntaxMemo.UnIndent;
+var
+ i, res: Integer;
+begin
+ i := FPos.Y - 2;
+ res := FPos.X - 1;
+ CorrectBookmark(FPos.Y, -1);
+ while i >= 0 do
+ begin
+ res := GetLineBegin(i);
+ if (res < FPos.X) and (Trim(FText[i]) <> '') then
+ break else
+ Dec(i);
+ end;
+ FSelStart := FPos;
+ FSelEnd := FPos;
+ Dec(FSelEnd.X, FPos.X - res);
+ SelText := '';
+end;
+
+procedure TfsSyntaxMemo.ShiftSelected(ShiftRight: Boolean);
+var
+ i, ib, ie: Integer;
+ s: String;
+ Shift: Integer;
+begin
+ if FReadOnly then exit;
+ AddUndo;
+ if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
+ begin
+ ib := FSelStart.Y - 1;
+ ie := FSelEnd.Y - 1;
+ end
+ else
+ begin
+ ib := FSelEnd.Y - 1;
+ ie := FSelStart.Y - 1;
+ end;
+ if FSelEnd.X = 1 then
+ Dec(ie);
+
+ Shift := 2;
+ if not ShiftRight then
+ for i := ib to ie do
+ begin
+ s := FText[i];
+ if (Trim(s) <> '') and (GetLineBegin(i) - 1 < Shift) then
+ Shift := GetLineBegin(i) - 1;
+ end;
+
+ for i := ib to ie do
+ begin
+ s := FText[i];
+ if ShiftRight then
+ s := Pad(Shift) + s
+ else if Trim(s) <> '' then
+ Delete(s, 1, Shift);
+ FText[i] := s;
+ end;
+ UpdateSyntax;
+ DoChange;
+end;
+
+function TfsSyntaxMemo.GetSelText: String;
+var
+ p1, p2: TPoint;
+ i: Integer;
+begin
+ if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
+ begin
+ p1 := FSelStart;
+ p2 := FSelEnd;
+ Dec(p2.X);
+ end
+ else
+ begin
+ p1 := FSelEnd;
+ p2 := FSelStart;
+ Dec(p2.X);
+ end;
+
+ if LineLength(p1.Y - 1) < p1.X then
+ begin
+ Inc(p1.Y);
+ p1.X := 1;
+ end;
+ if LineLength(p2.Y - 1) < p2.X then
+ p2.X := LineLength(p2.Y - 1);
+
+ i := GetPlainTextPos(p1);
+ Result := Copy(FText.Text, i, GetPlainTextPos(p2) - i + 1);
+end;
+
+procedure TfsSyntaxMemo.SetSelText(Value: String);
+var
+ p1, p2, p3: TPoint;
+ i: Integer;
+ s: String;
+begin
+ if FReadOnly then exit;
+ AddUndo;
+ if FSelStart.X = 0 then
+ begin
+ p1 := FPos;
+ p2 := p1;
+ Dec(p2.X);
+ end
+ else if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
+ begin
+ p1 := FSelStart;
+ p2 := FSelEnd;
+ Dec(p2.X);
+ end
+ else
+ begin
+ p1 := FSelEnd;
+ p2 := FSelStart;
+ Dec(p2.X);
+ end;
+
+ if LineLength(p1.Y - 1) < p1.X then
+ FText[p1.Y - 1] := FText[p1.Y - 1] + Pad(p1.X - LineLength(p1.Y - 1) + 1);
+ if LineLength(p2.Y - 1) < p2.X then
+ p2.X := LineLength(p2.Y - 1);
+
+ i := GetPlainTextPos(p1);
+ s := FText.Text;
+ Delete(s, i, GetPlainTextPos(p2) - i + 1);
+ Insert(Value, s, i);
+ FText.Text := s;
+ p3 := GetPosPlainText(i + Length(Value));
+
+ CorrectBookmark(FPos.Y, p3.y-FPos.Y);
+
+ SetPos(p3.X, p3.Y);
+ FSelStart.X := 0;
+ DoChange;
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.ClearSel;
+begin
+ if FSelStart.X <> 0 then
+ begin
+ FSelStart := Point(0, 0);
+ Repaint;
+ end;
+end;
+
+procedure TfsSyntaxMemo.AddSel;
+begin
+ if FSelStart.X = 0 then
+ FSelStart := FTempPos;
+ FSelEnd := FPos;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.SetPos(x, y: Integer);
+begin
+ if FMessage <> '' then
+ begin
+ FMessage := '';
+ Repaint;
+ end;
+
+ if x > FMaxLength then x := FMaxLength;
+ if x < 1 then x := 1;
+ if y > FText.Count then y := FText.Count;
+ if y < 1 then y := 1;
+
+ FPos := Point(x, y);
+ if (FWindowSize.X = 0) or (FWindowSize.Y = 0) then exit;
+
+ if FOffset.Y >= FText.Count then
+ FOffset.Y := FText.Count - 1;
+
+ if FPos.X > FOffset.X + FWindowSize.X then
+ begin
+ FOffset.X := FOffset.X + FPos.X - (FOffset.X + FWindowSize.X);
+ Repaint;
+ end
+ else if FPos.X <= FOffset.X then
+ begin
+ FOffset.X := FOffset.X - (FOffset.X - FPos.X + 1);
+ Repaint;
+ end
+ else if FPos.Y > FOffset.Y + FWindowSize.Y then
+ begin
+ FOffset.Y := FOffset.Y + FPos.Y - (FOffset.Y + FWindowSize.Y);
+ Repaint;
+ end
+ else if FPos.Y <= FOffset.Y then
+ begin
+ FOffset.Y := FOffset.Y - (FOffset.Y - FPos.Y + 1);
+ Repaint;
+ end;
+
+ ShowCaretPos;
+ UpdateScrollBar;
+
+end;
+
+procedure TfsSyntaxMemo.ScrollClick(Sender: TObject);
+begin
+ if FUpdating then exit;
+ FOffset.Y := Round(FVScroll.Value);
+ if FOffset.Y > FText.Count then
+ FOffset.Y := FText.Count;
+ ShowCaretPos;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.ScrollEnter(Sender: TObject);
+begin
+ SetFocus;
+end;
+
+procedure TfsSyntaxMemo.DblClick;
+var
+ s: String;
+begin
+ FDoubleClicked := True;
+ DoCtrlL;
+ FSelStart := FPos;
+ s := LineAt(FPos.Y - 1);
+ if s <> '' then
+ while CharInSet(s[FPos.X],WordChars)
+ or IsUnicodeChar(s[FPos.X]) do
+ Inc(FPos.X);
+ FSelEnd := FPos;
+ Repaint;
+end;
+
+function GetComponentForm(Comp: TFmxObject): TCommonCustomForm;
+begin
+ Result := nil;
+ while (Comp.Parent <> nil) do
+ begin
+ if (Comp.Parent is TCommonCustomForm) then
+ begin
+ Result := Comp.Parent as TCommonCustomForm;
+ Exit;
+ end;
+ Comp := Comp.Parent;
+ end;
+end;
+
+procedure TfsSyntaxMemo.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+var
+ pt: TPointF;
+ f: TCommonCustomForm;
+ r: TRectF;
+ LStr, s: String;
+ i, cIndex: Integer;
+
+begin
+ if FDoubleClicked then
+ begin
+ FDoubleClicked := False;
+ Exit;
+ end;
+ if Button = TMouseButton.mbRight then
+ begin
+ if PopupMenu = nil then
+ begin
+ f := GetComponentForm(Self);
+ if f <> nil then
+ begin
+ pt := f.ClientToScreen(PointF(AbsoluteRect.Left + X, AbsoluteRect.Top + Y));
+ FPopUpMenu.Popup(pt.X, pt.Y);
+ end;
+ end;
+ end
+ else
+ begin
+ FMoved := True;
+ if not IsFocused then
+ SetFocus;
+ FDown := True;
+ if FIsMonoType then
+ SetPos(Round((X - FGutterWidth) / FCharWidth) + 1 + FOffset.X,
+ Trunc(Y / FCharHeight) + 1 + FOffset.Y)
+ else
+ begin
+ cIndex := 0;
+ LStr := LineAt(FPos.Y - 1);
+ LStr := Copy(LineAt(FPos.Y - 1), FOffset.X + 1, Length(LStr) - (FOffset.X + 1));
+ for i := 1 to Length(LStr) do
+ begin
+ s := Copy(LStr, 1, i);
+ r := RectF(0, 0, 100000, 100000);
+ FTmpCanvas.Canvas.MeasureText(r, s, False, [], TTextAlign.taLeading);
+ if r.Width >= X - FGutterWidth then
+ begin
+ cIndex := i;
+ break;
+ end;
+ end;
+ SetPos(cIndex + 1 + FOffset.X,
+ Trunc(Y / FCharHeight) + 1 + FOffset.Y)
+ end;
+ ClearSel;
+ end;
+end;
+
+procedure TfsSyntaxMemo.MouseMove(Shift: TShiftState; X, Y: Single);
+begin
+ if FDown then
+ begin
+ FTempPos := FPos;
+ FPos.X := Round((X - FGutterWidth) / FCharWidth) + 1 + FOffset.X;
+ FPos.Y := Round(Y / FCharHeight) + 1 + FOffset.Y;
+ if (FPos.X <> FTempPos.X) or (FPos.Y <> FTempPos.Y) then
+ begin
+ SetPos(FPos.X, FPos.Y);
+ AddSel;
+ end;
+ end;
+end;
+
+procedure TfsSyntaxMemo.MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Single);
+begin
+ FDown := False;
+end;
+
+procedure TfsSyntaxMemo.MouseWheel(Shift: TShiftState; WheelDelta: Integer;
+ var Handled: Boolean);
+begin
+ inherited;
+ FVScroll.Value := FVScroll.Value + (WheelDelta div ABS(WheelDelta)) * KWheel;
+end;
+
+procedure TfsSyntaxMemo.DialogKey(var Key: Word; Shift: TShiftState);
+begin
+ inherited;
+ if Key = 9 then
+ begin
+ if Shift = [] then
+ begin
+ if FSelStart.X <> 0 then
+ DoCtrlI
+ else
+ TabIndent;
+ end
+ else if Shift = [ssShift] then
+ DoCtrlU;
+ FMoved := True;
+ end;
+end;
+
+procedure TfsSyntaxMemo.KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+var
+ MyKey: Boolean;
+begin
+ inherited;
+ FAllowLinesChange := False;
+
+ FTempPos := FPos;
+ MyKey := True;
+ case Key of
+ vkLeft:
+ if ssCtrl in Shift then
+ DoCtrlL else
+ DoLeft;
+
+ vkRight:
+ if ssCtrl in Shift then
+ DoCtrlR else
+ DoRight;
+
+ vkUp:
+ DoUp;
+
+ vkDown:
+ DoDown;
+
+ vkHome:
+ DoHome(ssCtrl in Shift);
+
+ vkEnd:
+ DoEnd(ssCtrl in Shift);
+
+ vkPrior:
+ DoPgUp;
+
+ vkNext:
+ DoPgDn;
+
+ vkReturn:
+ if Shift = [] then
+ DoReturn;
+
+ vkDelete:
+ if ssShift in Shift then
+ CutToClipboard else
+ DoDel;
+
+ vkBack:
+ DoBackspace;
+
+ vkInsert:
+ if ssCtrl in Shift then
+ CopyToClipboard
+ else if ssShift in Shift then
+ PasteFromClipboard;
+
+ vkF3:
+ Find(LastSearch); // F3 Repeat search
+
+ else
+ MyKey := False;
+ end;
+
+ if (Shift = [ssCtrl]) or (Shift = [ssCommand]) then
+ begin
+ MyKey := True;
+ if (Key = Ord('c')) or (Key = Ord('C')) then // Ctrl+C Copy
+ CopyToClipboard
+ else if (Key = Ord('v')) or (Key = Ord('V')) then // Ctrl+V Paste
+ PasteFromClipboard
+ else if (Key = Ord('x')) or (Key = Ord('X')) then // Ctrl+X Cut
+ CutToClipboard
+ else if (Key = Ord('z')) or (Key = Ord('Z')) then // Ctrl+Z Undo
+ Undo
+ else if (Key = Ord('a')) or (Key = Ord('A')) then // Ctrl+A Select all
+ begin
+ SetPos(0, 0);
+ FSelStart := FPos;
+ SetPos(LineLength(FText.Count - 1) + 1, FText.Count);
+ FSelEnd := FPos;
+ Repaint;
+ end
+ else if (Key = Ord('f')) or (Key = Ord('F')) then // Ctrl+F Search
+ begin
+ SynMemoSearch := TfsSynMemoSearch.Create(nil);
+ if SynMemoSearch.ShowModal = mrOk then
+ Find(SynMemoSearch.Edit1.Text);
+ LastSearch := SynMemoSearch.Edit1.Text;
+ SynMemoSearch.Free;
+ end
+ else if (Key = Ord('y')) or (Key = Ord('Y')) then // Ctrl+Y Delete line
+ begin
+ if FText.Count > FPos.Y then
+ begin
+ FMoved := True;
+ AddUndo;
+ FText.Delete(FPos.Y - 1);
+ CorrectBookmark(FPos.Y, -1);
+ UpdateSyntax;
+ end
+ else
+ if FText.Count = FPos.Y then
+ begin
+ FMoved := True;
+ AddUndo;
+ FText[FPos.Y - 1] := '';
+ FPos.X := 1;
+ SetPos(FPos.X, FPos.Y);
+ UpdateSyntax;
+ end
+ end
+ else if Key in [48..57] then
+ GotoBookmark(Key-48)
+ else
+ MyKey := False;
+ end;
+
+ if Shift = [ssCtrl, ssShift] then
+ if Key in [48..57] then
+ if IsBookmark(FPos.Y - 1) < 0 then
+ AddBookmark(FPos.Y - 1, Key-48)
+ else
+ if IsBookmark(FPos.Y - 1) = (Key-48) then
+ DeleteBookmark(Key-48);
+
+
+ if Key in [vkLeft, vkRight, vkUp, vkDown, vkHome, vkEnd, vkPrior, vkNext] then
+ begin
+ FMoved := True;
+ if ssShift in Shift then
+ AddSel else
+ ClearSel;
+ end
+ else if Key in [vkReturn, vkDelete, vkBack, vkInsert] then
+ FMoved := True;
+
+ case WideChar(KeyChar) of
+ #0032..#$FFFF:
+ if (Shift = []) or (Shift = [ssShift]) then
+ begin
+ DoChar(WideChar(KeyChar));
+ FMoved := True;
+ end;
+ else
+ MyKey := False;
+ end;
+ if MyKey then
+ Key := 0;
+end;
+
+procedure TfsSyntaxMemo.DoLeft;
+begin
+ Dec(FPos.X);
+ if FPos.X < 1 then
+ FPos.X := 1;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoRight;
+begin
+ Inc(FPos.X);
+ if FPos.X > FMaxLength then
+ FPos.X := FMaxLength;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoUp;
+begin
+ Dec(FPos.Y);
+ if FPos.Y < 1 then
+ FPos.Y := 1;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoDown;
+begin
+ Inc(FPos.Y);
+ if FPos.Y > FText.Count then
+ FPos.Y := FText.Count;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoHome(Ctrl: Boolean);
+begin
+ if Ctrl then
+ SetPos(1, 1) else
+ SetPos(1, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoEnd(Ctrl: Boolean);
+begin
+ if Ctrl then
+ SetPos(LineLength(FText.Count - 1) + 1, FText.Count) else
+ SetPos(LineLength(FPos.Y - 1) + 1, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoExit;
+begin
+{$IFDEF Delphi17}
+ inherited;
+{$IFNDEF DELPHI18}
+ CaretVisible := False;
+{$ELSE}
+ HideCaret;
+{$ENDIF}
+{$ELSE}
+ Platform.HideVirtualKeyboard;
+ inherited;
+ HideCaret;
+{$ENDIF}
+end;
+
+procedure TfsSyntaxMemo.DoPgUp;
+begin
+ if FOffset.Y > FWindowSize.Y then
+ begin
+ FOffset.Y := FOffset.Y - (FWindowSize.Y - 1);
+ FPos.Y := FPos.Y - (FWindowSize.Y - 1);
+ end
+ else
+ begin
+ if FOffset.Y > 0 then
+ begin
+ FPos.Y := FPos.Y - FOffset.Y;
+ FOffset.Y := 0;
+ end
+ else
+ FPos.Y := 1;
+ end;
+ SetPos(FPos.X, FPos.Y);
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.DoPgDn;
+begin
+ if FOffset.Y + FWindowSize.Y < FText.Count then
+ begin
+ FOffset.Y := FOffset.Y + (FWindowSize.Y - 1);
+ FPos.Y := FPos.Y + (FWindowSize.Y - 1);
+ end
+ else
+ begin
+ FOffset.Y := FText.Count;
+ FPos.Y := FText.Count;
+ end;
+ SetPos(FPos.X, FPos.Y);
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.DoReturn;
+var
+ s: String;
+begin
+ if FReadOnly then exit;
+ s := LineAt(FPos.Y - 1);
+ FText[FPos.Y - 1] := Copy(s, 1, FPos.X - 1);
+ FText.Insert(FPos.Y, Copy(s, FPos.X, FMaxLength));
+ EnterIndent;
+end;
+
+procedure TfsSyntaxMemo.DoDel;
+var
+ s: String;
+begin
+ if FReadOnly then exit;
+ FMessage := '';
+ if FSelStart.X <> 0 then
+ SelText := ''
+ else
+ begin
+ s := FText[FPos.Y - 1];
+ AddUndo;
+ if FPos.X <= LineLength(FPos.Y - 1) then
+ begin
+ Delete(s, FPos.X, 1);
+ FText[FPos.Y - 1] := s;
+ end
+ else if FPos.Y < FText.Count then
+ begin
+ s := s + Pad(FPos.X - Length(s) - 1) + LineAt(FPos.Y);
+ FText[FPos.Y - 1] := s;
+ FText.Delete(FPos.Y);
+ CorrectBookmark(FSelStart.Y, -1);
+ end;
+ UpdateScrollBar;
+ UpdateSyntax;
+ DoChange;
+ end;
+end;
+
+procedure TfsSyntaxMemo.DoBackspace;
+var
+ s: String;
+begin
+ if FReadOnly then exit;
+ FMessage := '';
+ if FSelStart.X <> 0 then
+ SelText := ''
+ else
+ begin
+ s := FText[FPos.Y - 1];
+ if FPos.X > 1 then
+ begin
+ if (GetLineBegin(FPos.Y - 1) = FPos.X) or (Trim(s) = '') then
+ UnIndent
+ else
+ begin
+ AddUndo;
+ if Trim(s) <> '' then
+ begin
+ Delete(s, FPos.X - 1, 1);
+ FText[FPos.Y - 1] := s;
+ DoLeft;
+ end
+ else
+ DoHome(False);
+ UpdateSyntax;
+ DoChange;
+ end;
+ end
+ else if FPos.Y > 1 then
+ begin
+ AddUndo;
+ CorrectBookmark(FPos.Y, -1);
+ s := LineAt(FPos.Y - 2);
+ FText[FPos.Y - 2] := s + FText[FPos.Y - 1];
+ FText.Delete(FPos.Y - 1);
+ SetPos(Length(s) + 1, FPos.Y - 1);
+ UpdateSyntax;
+ DoChange;
+ end;
+ end;
+end;
+
+procedure TfsSyntaxMemo.DoCtrlI;
+begin
+ if FSelStart.X <> 0 then
+ ShiftSelected(True);
+end;
+
+procedure TfsSyntaxMemo.DoCtrlU;
+begin
+ if FSelStart.X <> 0 then
+ ShiftSelected(False);
+end;
+
+procedure TfsSyntaxMemo.DoCtrlL;
+var
+ i: Integer;
+ s: String;
+begin
+ s := FText.Text;
+ i := Length(LineAt(FPos.Y - 1));
+ if FPos.X > i then
+ FPos.X := i;
+
+ i := GetPlainTextPos(FPos);
+
+ Dec(i);
+ while (i > 0) and not (CharInSet(s[i], WordChars) or IsUnicodeChar(s[i])) do
+ if s[i] = Char(LineBreak[1]) then
+ break else
+ Dec(i);
+ while (i > 0) and (CharInSet(s[i], WordChars) or IsUnicodeChar(s[i])) do
+ Dec(i);
+ Inc(i);
+
+ FPos := GetPosPlainText(i);
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoCtrlR;
+var
+ i: Integer;
+ s: String;
+begin
+ s := FText.Text;
+ i := Length(LineAt(FPos.Y - 1));
+ if FPos.X > i then
+ begin
+ DoDown;
+ DoHome(False);
+ FPos.X := 0;
+ end;
+
+ i := GetPlainTextPos(FPos);
+ while (i < Length(s)) and ((CharInSet(s[i], WordChars)) or IsUnicodeChar(s[i])) do
+ Inc(i);
+ while (i < Length(s)) and not ((CharInSet(s[i], WordChars)) or IsUnicodeChar(s[i])) do
+ if s[i] = Char(LineBreak[1]) then
+ break else
+ Inc(i);
+ FPos := GetPosPlainText(i);
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoChar(Ch: Char);
+begin
+ SelText := Ch;
+end;
+
+function TfsSyntaxMemo.GetCharAttr(Pos: TPoint): TCharAttributes;
+
+ function IsBlock: Boolean;
+ var
+ p1, p2, p3: Integer;
+ begin
+ Result := False;
+ if FSelStart.X = 0 then exit;
+
+ p1 := FSelStart.X + FSelStart.Y * FMaxLength;
+ p2 := FSelEnd.X + FSelEnd.Y * FMaxLength;
+ if p1 > p2 then
+ begin
+ p3 := p1;
+ p1 := p2;
+ p2 := p3;
+ end;
+ p3 := Pos.X + Pos.Y * FMaxLength;
+ Result := (p3 >= p1) and (p3 < p2);
+ end;
+
+ function CharAttr: TCharAttr;
+ var
+ s: String;
+ begin
+ if Pos.Y - 1 < FSynStrings.Count then
+ begin
+ s := FSynStrings[Pos.Y - 1];
+ if Pos.X <= Length(s) then
+ Result := TCharAttr(Ord(s[Pos.X])) else
+ Result := caText;
+ end
+ else
+ Result := caText;
+ end;
+
+begin
+ Result := [CharAttr];
+ if IsBlock then
+ Result := Result + [caBlock];
+end;
+
+function TfsSyntaxMemo.GetCharWidth(Str: String): Single;
+var
+ r: TRectF;
+ dx: Single;
+ j, j1: Integer;
+ a, a1: TCharAttributes;
+
+ function CalcSize(LStr: String): Single;
+ begin
+ if FIsMonoType then
+ begin
+ Result := FCharWidth * Length(LStr);
+ Exit;
+ end;
+ if LStr = '' then
+ begin
+ Result := 0;
+ Exit;
+ end;
+
+ r := RectF(0, 0, 100000, 100000);
+ { MeasureText trunc all spaces at the end, so we are using this hack to calcl size with spaces }
+ FTmpCanvas.Canvas.MeasureText(r, LStr + 'W', False, [], TTextAlign.taLeading);
+ dx := r.Width;
+ FTmpCanvas.Canvas.MeasureText(r, 'W', False, [], TTextAlign.taLeading);
+ Result := dx - r.Width;
+ end;
+begin
+
+ j1 := 1;
+ a := GetCharAttr(Point(1, FPos.Y));
+ a1 := a;
+ Result := 0;
+
+ for j := 1 to Length(Str) do
+ begin
+ a1 := GetCharAttr(Point(j, FPos.Y));
+ if a1 <> a then
+ begin
+ SetAttr(FTmpCanvas.Canvas, a);
+ Result := Result + CalcSize(Copy(Str, j1, (j - j1)));
+ a := a1;
+ j1 := j;
+ end;
+ end;
+ SetAttr(FTmpCanvas.Canvas, a);
+ Result := Result + CalcSize(Copy(Str, j1, Length(Str) - (j1 - 1)));
+end;
+
+procedure TfsSyntaxMemo.Paint;
+var
+ i, j, j1: Integer;
+ a, a1: TCharAttributes;
+ s: String;
+ x, y: Single;
+ aClientR: TRectF;
+ aSelColor, aSelFontColor: TAlphaColor;
+
+ procedure SetAttrL(a: TCharAttributes);
+ begin
+ SetAttr(Canvas, a);
+ aSelColor := FFill.Color;
+ aSelFontColor := Canvas.Fill.Color;
+ if caBlock in a then
+ begin
+ aSelColor := FBlockColor;
+ aSelFontColor := FBlockFontColor;
+ end;
+
+ // make non-selected text looking good
+ if aSelColor = FFill.Color then
+ aSelColor := 0;
+ end;
+
+ function MyTextOut(x, y: Single; const s: String): Single;
+ var
+ i: Integer;
+ dx, dy: Single;
+ r: TRectF;
+ begin
+ with Canvas do
+ begin
+ r := RectF(0, 0, 100000, 100000);
+ { MeasureText trunc all spaces at the end, so we are using this hack to calcl size with spaces }
+ Canvas.MeasureText(r, s + 'W',False, [], TTextAlign.taLeading);
+ dx := r.Width + x;
+ Canvas.MeasureText(r, 'W', False, [], TTextAlign.taLeading);
+ dx := dx - r.Width;
+ if dx > (aClientR.Right - aClientR.Left) then
+ dx := aClientR.Right - aClientR.Left;
+ dy := y + FCharHeight;
+ if FIsMonoType then
+ dx := x + FCharWidth * Length(s);
+ Fill.Color := aSelColor;
+ FillRect(RectF(x + 1, y, dx + 1, dy + 1), 0, 0, AllCorners, 1);
+ Fill.Color := aSelFontColor;
+ if FIsMonoType then
+ FillText(RectF(x, y, dx + 1, 10000),
+ s, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading)
+ else
+ begin
+ for i := 1 to Length(s) do
+ FillText(RectF(x + (i - 1) * FCharWidth, y,
+ (x + (i - 1) * FCharWidth) + FCharWidth, y + FCharHeight),
+ s[i], False, 1, FillTextFlags, TTextAlign.taLeading, TTextAlign.taLeading);
+ end;
+ end;
+ Result := dx;
+ end;
+
+begin
+ aClientR := GetClientRect;
+ with Canvas do
+ begin
+ Fill.Assign(FBorder.Fill);
+ FillRect(RectF(0, 0, Self.Width , Self.Height), 0, 0, AllCorners, 1, TCornerType.ctBevel);
+ Fill.Assign(FFill);
+ FillRect(aClientR, 0, 0, AllCorners, 1, TCornerType.ctBevel);
+ Fill.Assign(FGutterFill);
+ FillRect(RectF(FGutterWidth - aClientR.Left,
+ Self.Height - FFooterHeight - aClientR.Top,
+ aClientR.Left, aClientR.Top), 0, 0, AllCorners, 1, TCornerType.ctBevel);
+ FillRect(RectF(aClientR.Left, Self.Height - FFooterHeight - aClientR.Top,
+ Self.Width - aClientR.Left, Self.Height - aClientR.Top), 1, 1,
+ AllCorners, 1, TCornerType.ctBevel);
+
+ Stroke.Assign(FBorder.Fill);
+{$IFDEF DELPHI25}
+ Stroke.Cap := TStrokeCap.scRound;
+ Stroke.Thickness := FBorder.Width;
+{$ELSE}
+ StrokeCap := TStrokeCap.scRound;
+ StrokeThickness := FBorder.Width;
+{$ENDIF}
+ x := FGutterWidth - FBorder.Width;
+ DrawLine(PointF(x, aClientR.Top + 1), PointF(x, aClientR.Bottom - FFooterHeight ), 1);
+ if FFooterHeight > 0 then
+ DrawLine(PointF(x, aClientR.Bottom - FFooterHeight),
+ PointF(aClientR.Right - 1, aClientR.Bottom - FFooterHeight), 1);
+ if FUpdatingSyntax then Exit;
+
+ for i := FOffset.Y to FOffset.Y + FWindowSize.Y - 1 do
+ begin
+ if i >= FText.Count then break;
+
+ s := FText[i];
+ j1 := FOffset.X + 1;
+ a := GetCharAttr(Point(j1, i + 1));
+ a1 := a;
+ x := FGutterWidth + FBorder.Width;
+ y := aClientR.Top + (i - FOffset.Y) * FCharHeight;
+ for j := j1 to FOffset.X + FWindowSize.X do
+ begin
+ if j > Length(s) then break;
+
+ a1 := GetCharAttr(Point(j, i + 1));
+ if a1 <> a then
+ begin
+ SetAttrL(a);
+ x := MyTextOut(x, y, Copy(FText[i], j1, j - j1));
+ a := a1;
+ j1 := j;
+ end;
+ end;
+
+ SetAttrL(a);
+
+ MyTextOut(x, y, Copy(s, j1, FMaxLength));
+
+ BookmarkDraw(y, i);
+ ActiveLineDraw(y, i);
+ end;
+
+ if FMessage <> '' then
+ begin
+ Font.Family := 'Tahoma';
+ Font.Style := [TFontStyle.fsBold];
+ Font.Size := 8;
+ Fill.Color := TAlphaColorRec.Maroon;
+ FillRect(RectF(aClientR.Left, aClientR.Bottom - TextHeight('|') - 6, aClientR.Right , aClientR.Bottom), 0, 0,
+ AllCorners, 1, TCornerType.ctBevel);
+ Fill.Color := TAlphaColorRec.White;
+ FillText(RectF(aClientR.Left + 6, aClientR.Bottom - TextHeight('|') - 5,
+ 6 + TextWidth('W') * Length(FMessage), aClientR.Bottom), FMessage,
+ False, 1, [], TTextAlign.taLeading)
+ end
+ else
+ ShowPos;
+ end;
+end;
+
+procedure TfsSyntaxMemo.CreateSynArray;
+var
+ i, n, Pos: Integer;
+ ch: Char;
+ FSyn: String;
+
+ procedure SkipSpaces;
+ begin
+ while (Pos <= Length(FSyn)) and
+ ((CharInSet(FSyn[Pos], [#1..#32])) or
+ not (CharInSet(FSyn[Pos],['_', 'A'..'Z', 'a'..'z', '''', '"', '/', '{', '(', '-']))) do
+ Inc(Pos);
+ end;
+
+ function IsKeyWord(const s: String): Boolean;
+ begin
+ Result := False;
+ if FKeywords = '' then exit;
+
+ if FKeywords[1] <> ',' then
+ FKeywords := ',' + FKeywords;
+ if FKeywords[Length(FKeywords)] <> ',' then
+ FKeywords := FKeywords + ',';
+
+ Result := System.Pos(',' + AnsiLowerCase(s) + ',', FKeywords) <> 0;
+ end;
+
+ function GetIdent: TCharAttr;
+ var
+ i: Integer;
+ cm1, cm2, cm3, cm4, st1: Char;
+ begin
+ i := Pos;
+ Result := caText;
+
+ if FSyntaxType = stPascal then
+ begin
+ cm1 := '/';
+ cm2 := '{';
+ cm3 := '(';
+ cm4 := ')';
+ st1 := '''';
+ end
+ else if FSyntaxType in [stCpp,stJs,stVb] then
+ begin
+ cm1 := '/';
+ cm2 := ' ';
+ cm3 := '/';
+ cm4 := '/';
+ st1 := '"';
+ end
+ else if FSyntaxType = stSQL then
+ begin
+ cm1 := '-';
+ cm2 := ' ';
+ cm3 := '/';
+ cm4 := '/';
+ st1 := '"';
+ end
+ else
+ begin
+ cm1 := ' ';
+ cm2 := ' ';
+ cm3 := ' ';
+ cm4 := ' ';
+ st1 := ' ';
+ end;
+
+ if CharInSet(FSyn[Pos], ['_', 'A'..'Z', 'a'..'z']) then
+ begin
+ while CharInSet(FSyn[Pos], ['_', 'A'..'Z', 'a'..'z', '0'..'9']) do
+ Inc(Pos);
+ if IsKeyWord(Copy(FSyn, i, Pos - i)) then
+ Result := caKeyword;
+ Dec(Pos);
+ end
+ else if (FSyn[Pos] = cm1) and (FSyn[Pos + 1] = cm1) then
+ begin
+ while (Pos <= Length(FSyn)) and not (CharInSet(FSyn[Pos], [#10, #13])) do
+ Inc(Pos);
+ Result := caComment;
+ end
+ else if FSyn[Pos] = cm2 then
+ begin
+ while (Pos <= Length(FSyn)) and (FSyn[Pos] <> '}') do
+ Inc(Pos);
+ Result := caComment;
+ end
+ else if (FSyn[Pos] = cm3) and (FSyn[Pos + 1] = '*') then
+ begin
+ while (Pos < Length(FSyn)) and not ((FSyn[Pos] = '*') and (FSyn[Pos + 1] = cm4)) do
+ Inc(Pos);
+ Inc(Pos, 2);
+ Result := caComment;
+ end
+ else if FSyn[Pos] = st1 then
+ begin
+ Inc(Pos);
+ while (Pos < Length(FSyn)) and (FSyn[Pos] <> st1) and not (CharInSet(FSyn[Pos], [#10, #13])) do
+ Inc(Pos);
+ Result := caString;
+ end;
+ Inc(Pos);
+ end;
+
+begin
+ FSyn := FText.Text + #0#0#0#0#0#0#0#0#0#0#0;
+ FAllowLinesChange := False;
+ Pos := 1;
+
+ while Pos < Length(FSyn) do
+ begin
+ n := Pos;
+ SkipSpaces;
+ for i := n to Pos - 1 do
+ if FSyn[i] > #31 then
+ FSyn[i] := Chr(Ord(caText));
+
+ n := Pos;
+ ch := Chr(Ord(GetIdent));
+ for i := n to Pos - 1 do
+ if i <= Length(FSyn) then
+ if FSyn[i] > #31 then
+ FSyn[i] := ch;
+ end;
+
+ FUpdatingSyntax := True;
+ FSynStrings.Text := FSyn;
+ FSynStrings.Add(' ');
+ FUpdatingSyntax := False;
+end;
+
+procedure TfsSyntaxMemo.UpdateView;
+begin
+ UpdateSyntax;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.UpdateWindowSize;
+begin
+ if FCharWidth = 0 then exit;
+ FWindowSize := Point(Trunc((Width - FGutterWidth - FBorder.Width * 2) / FCharWidth),
+ Trunc((Height - FFooterHeight - FBorder.Width * 2) / FCharHeight));
+end;
+
+procedure TfsSyntaxMemo.CopyPopup(Sender: TObject);
+begin
+ CopyToClipboard;
+end;
+
+procedure TfsSyntaxMemo.PastePopup(Sender: TObject);
+begin
+ PasteFromClipboard;
+end;
+
+procedure TfsSyntaxMemo.Resize;
+begin
+ inherited;
+ UpdateWindowSize;
+ FVScroll.Position.Y := FBorder.Width;
+ FVScroll.Height := Height - FFooterHeight - FBorder.Width;
+ FVScroll.Width := 16;
+ FVScroll.Position.X := Width - FVScroll.Width - FBorder.Width;
+ UpdateScrollBar;
+end;
+
+procedure TfsSyntaxMemo.CutPopup(Sender: TObject);
+begin
+ CutToClipboard;
+end;
+
+procedure TfsSyntaxMemo.SetShowGutter(Value: boolean);
+begin
+ FShowGutter := Value;
+ if Value then
+ FGutterWidth := 20
+ else
+ FGutterWidth := 0;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.SetShowFooter(Value: boolean);
+begin
+ FShowFooter := Value;
+ if Value then
+ FFooterHeight := 20
+ else
+ FFooterHeight := 0;
+ Repaint;
+end;
+
+function TfsSyntaxMemo.FMemoFind(Text: String; var Position : TPoint): boolean;
+var
+ i, j : integer;
+begin
+ j := 0;
+ result := False;
+ if FText.Count > 1 then
+ begin
+ Text := UpperCase(Text);
+ for i := Position.Y to FText.Count - 1 do
+ begin
+ j := Pos( Text, UpperCase(FText[i]));
+ if j > 0 then
+ begin
+ Result := True;
+ break;
+ end
+ end;
+ Position.X := j;
+ Position.Y := i + 1;
+ end;
+end;
+
+procedure TfsSyntaxMemo.FontChanged(Sender: TObject);
+begin
+ FCommentAttr.Font.Size := FFontSettings.Font.Size;
+ FCommentAttr.Font.Family := FFontSettings.Font.Family;
+ FKeywordAttr.Font.Size := FFontSettings.Font.Size;
+ FKeywordAttr.Font.Family := FFontSettings.Font.Family;
+ FStringAttr.Font.Size := FFontSettings.Font.Size;
+ FStringAttr.Font.Family := FFontSettings.Font.Family;
+ FTextAttr.Font.Size := FFontSettings.Font.Size;
+ FTextAttr.Font.Family := FFontSettings.Font.Family;
+ CalcCharSize;
+ { need to uptade size, maybe font size was changed }
+ UpdateWindowSize;
+end;
+
+function TfsSyntaxMemo.Find(Text: String): boolean;
+var
+ Position: TPoint;
+begin
+ Position := FPos;
+ if FMemoFind(Text, Position) then
+ begin
+ SetPos(Position.X, Position.Y);
+ result := true;
+ end
+ else
+ begin
+ ShowMessage('Text "'+Text+'" not found.');
+ result := false;
+ end;
+end;
+
+procedure TfsSyntaxMemo.ActiveLineDraw(Y : Single; ALine : integer);
+begin
+ if ShowGutter then
+ with Canvas do
+ if ALine = FActiveLine then
+ begin
+ Fill.Color := TAlphaColorRec.Red;
+ //Pen.Color := clBlack;
+ FillEllipse(RectF(4, Y + 4, 11, Y + 15), 1);
+ end;
+end;
+
+procedure TfsSyntaxMemo.BookmarkDraw(Y : Single; ALine : integer);
+var
+ bm : integer;
+begin
+ if ShowGutter then
+ with Canvas do
+ begin
+ bm := IsBookmark(ALine);
+ if bm >= 0 then
+ begin
+ Fill.Color := TAlphaColorRec.Black;
+ FillRect(RectF(3 + Border.Width, Y + 1, 13 + Border.Width, Y + 12), 0, 0,
+ AllCorners, 1, TCornerType.ctBevel);
+ Fill.Color := TAlphaColorRec.Green;
+ FillRect(RectF(2 + Border.Width, Y + 2, 12 + Border.Width, Y + 13), 0, 0,
+ AllCorners, 1, TCornerType.ctBevel);
+ Font.Family := 'Tahoma';
+ Fill.Color := TAlphaColorRec.White;
+ Font.Style := [TFontStyle.fsBold];
+ Font.Size := 7;
+ y := y + 2.0;
+ FillText(RectF(4 + Border.Width, Y, 4 + TextWidth('7') + Border.Width,
+ Y + TextHeight('7')), IntToStr(bm), False, 1, [], TTextAlign.taLeading)
+ end;
+ end;
+end;
+
+function TfsSyntaxMemo.IsBookmark(Line : integer): integer;
+var
+ Pos : integer;
+begin
+ Result := -1;
+ for Pos := 0 to Length(Bookmarks) - 1 do
+ if Bookmarks[Pos] = Line then
+ begin
+ Result := Pos;
+ break;
+ end;
+end;
+
+procedure TfsSyntaxMemo.AddBookmark(Line, Number : integer);
+begin
+ if Number < Length(Bookmarks) then
+ begin
+ Bookmarks[Number] := Line;
+ Repaint;
+ end;
+end;
+
+procedure TfsSyntaxMemo.DeleteBookmark(Number : integer);
+begin
+ if Number < Length(Bookmarks) then
+ begin
+ Bookmarks[Number] := -1;
+ Repaint;
+ end;
+end;
+
+procedure TfsSyntaxMemo.CorrectBookmark(Line : integer; delta : integer);
+var
+ i : integer;
+begin
+ for i := 0 to Length(Bookmarks) - 1 do
+ if Bookmarks[i] >= Line then
+ Inc(Bookmarks[i], Delta);
+end;
+
+procedure TfsSyntaxMemo.GotoBookmark(Number : integer);
+begin
+ if Number < Length(Bookmarks) then
+ if Bookmarks[Number] >= 0 then
+ SetPos(0, Bookmarks[Number] + 1);
+end;
+
+procedure TfsSyntaxMemo.DOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+begin
+{$IFNDEF DELPHI20}
+ Accept := Data.Source is TTreeView;
+{$ELSE}
+ if Data.Source is TTreeView then
+ Operation := TDragOperation.Copy;
+{$ENDIF}
+end;
+
+procedure TfsSyntaxMemo.DDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+begin
+ if Data.Source is TTreeView then
+ begin
+ SetPos(Round((Point.X - FGutterWidth) / FCharWidth) + 1 + FOffset.X,
+ Round(Point.Y / FCharHeight) + 1 + FOffset.Y);
+ SetSelText(TTreeView(Data.Source).Selected.Text);
+ end;
+end;
+
+procedure TfsSyntaxMemo.SetKeywordAttr(Value: TfsFontSettings);
+begin
+ FKeywordAttr.Assign(Value);
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.SetStringAttr(Value: TfsFontSettings);
+begin
+ FStringAttr.Assign(Value);
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.SetTextAttr(Value: TfsFontSettings);
+begin
+ FTextAttr.Assign(Value);
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.SetCommentAttr(Value: TfsFontSettings);
+begin
+ FCommentAttr.Assign(Value);
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.SetFill(const Value: TBrush);
+begin
+ FFill.Assign(Value);
+end;
+
+procedure TfsSyntaxMemo.SetFontSettings(const Value: TfsFontSettings);
+begin
+ FFontSettings.Assign(Value);
+end;
+
+procedure TfsSyntaxMemo.SetGutterFill(const Value: TBrush);
+begin
+ FGutterFill.Assign(Value);
+end;
+
+procedure TfsSyntaxMemo.SetActiveLine(Line : Integer);
+begin
+ FActiveLine := Line;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.SetAttr(aCanvas: TCanvas; a: TCharAttributes);
+begin
+ with aCanvas do
+ begin
+ Font.Assign(FFontSettings.Font);
+ Canvas.Fill.Assign(FFontSettings.Fill);
+
+ if caText in a then
+ begin
+ Font.Assign(FTextAttr.Font);
+ Canvas.Fill.Assign(FTextAttr.Fill);
+ end;
+
+ if caComment in a then
+ begin
+ Font.Assign(FCommentAttr.Font);
+ Canvas.Fill.Assign(FCommentAttr.Fill);
+ end;
+
+ if caKeyword in a then
+ begin
+ Font.Assign(FKeywordAttr.Font);
+ Canvas.Fill.Assign(FKeywordAttr.Fill);
+ end;
+
+ if caString in a then
+ begin
+ Font.Assign(FStringAttr.Font);
+ Canvas.Fill.Assign(FStringAttr.Fill);
+ end;
+ end;
+end;
+
+
+
+procedure TfsSyntaxMemo.SetBorder(const Value: TfsBorderSettings);
+begin
+ FBorder.Fill.Assign(Value.Fill);
+ FBorder.Width := Value.Width;
+end;
+
+function TfsSyntaxMemo.GetActiveLine: Integer;
+begin
+ Result := FActiveLine;
+end;
+
+procedure TfsSynMemoSearch.FormKeyPress(Sender: TObject; var Key: Char);
+begin
+ if Key = #13 then
+ ModalResult := mrOk;
+end;
+
+{ TfsBorderSettings }
+
+constructor TfsBorderSettings.Create;
+begin
+ FFill := TBrush.Create(TBrushKind.bkSolid, TAlphaColorRec.Silver);
+ FWidth := 1;
+end;
+
+destructor TfsBorderSettings.Destroy;
+begin
+ FFill.Free;
+ inherited;
+end;
+
+procedure TfsBorderSettings.SetFill(const Value: TBrush);
+begin
+ FFill.Assign(Value);
+end;
+
+procedure TfsBorderSettings.SetWidth(const Value: Integer);
+begin
+ if Value > 3 then
+ FWidth := 3
+ else if Value < 0 then
+ FWidth := 0
+ else
+ FWidth := Value;
+end;
+
+{ TfsFontSettings }
+
+procedure TfsFontSettings.Assign(Source: TPersistent);
+begin
+ inherited;
+ if Source is TfsFontSettings then
+ begin
+ Fill.Assign(TfsFontSettings(Source).Fill);
+ Font.Assign(TfsFontSettings(Source).Font);
+ end;
+end;
+
+constructor TfsFontSettings.Create();
+begin
+ FFill := TBrush.Create(TBrushKind.bkSolid, TAlphaColorRec.Black);
+ FFont := TFont.Create;
+ FFont.Family := 'Courier New';
+ FFont.Size := 13;
+end;
+
+destructor TfsFontSettings.Destroy;
+begin
+ FFill.Free;
+ FFont.Free;
+ inherited;
+end;
+
+procedure TfsFontSettings.SetFill(const Value: TBrush);
+begin
+ FFill.Assign(Value);
+end;
+
+procedure TfsFontSettings.SetFont(const Value: TFont);
+begin
+ FFont.Assign(Value);
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsSyntaxMemo, TFmxObject);
+ GroupDescendentsWith(TfsBorderSettings, TFmxObject);
+ GroupDescendentsWith(TfsFontSettings, TFmxObject);
+
+ RegisterFmxClasses([TfsBorderSettings, TfsFontSettings]);
+
+end.
diff --git a/FastScript/FMX.fs_tree.pas b/FastScript/FMX.fs_tree.pas
new file mode 100644
index 0000000..0ebbf74
--- /dev/null
+++ b/FastScript/FMX.fs_tree.pas
@@ -0,0 +1,659 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Function/Classes tree FMX visual control }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_tree;
+
+interface
+
+{$I fs.inc}
+
+uses
+ FMX.Types,
+ System.SysUtils, System.Classes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.ExtCtrls, FMX.fs_synmemo, FMX.Objects,
+ FMX.fs_XML, FMX.fs_iinterpreter, FMX.TreeView, FMX.Memo, System.UITypes, System.Types
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+ TfsTreeViewItem = class(TTreeViewItem)
+ private
+ FButton: TCustomButton;
+ FCloseImageIndex: Integer;
+ FOpenImageIndex: Integer;
+ FImgPos: Single;
+ function GetBitmap():TBitmap;
+ protected
+ procedure ApplyStyle; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure Paint; override;
+ property CloseImageIndex: Integer read FCloseImageIndex write FCloseImageIndex;
+ property OpenImageIndex: Integer read FOpenImageIndex write FOpenImageIndex;
+ end;
+
+{$i frxPlatformsAttribute.inc}
+
+ TfsTreeView = class(TTreeView)
+ private
+ FPicBitmap: TBitmap;
+ FIconWidth: Integer;
+ FIconHeight: Integer;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure LoadResouces(Stream: TStream; IconWidth, IconHeight: Integer);
+ property PicPitmap: TBitmap read FPicBitmap write FPicBitmap;
+ property IconWidth: Integer read FIconWidth write FIconWidth;
+ property IconHeight: Integer read FIconHeight write FIconHeight;
+ function GetBitmapRect(Index: Integer): TRectF;
+ procedure DragOver(const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF}); override;
+ procedure DragDrop(const Data: TDragObject; const Point: TPointF); override;
+ published
+ property StyleLookup;
+ property CanFocus default True;
+ property DisableFocusEffect;
+ property TabOrder;
+ property AllowDrag default False;
+ property AlternatingRowBackground default False;
+ property ItemHeight;
+// property HideSelectionUnfocused default False;
+ property MultiSelect default False;
+ property ShowCheckboxes default False;
+ property Sorted default False;
+ property OnChange;
+ property OnChangeCheck;
+ property OnCompare;
+ property OnDragChange;
+ end;
+
+{$i frxPlatformsAttribute.inc}
+ TfsTree = class(TPanel)
+ private
+ Tree: TfsTreeView;
+ FXML: TfsXMLDocument;
+ FScript: TfsScript;
+ FImages: TList;
+ FShowFunctions: boolean;
+ FShowClasses: boolean;
+ FShowTypes: Boolean;
+ FShowVariables: Boolean;
+ FExpanded: boolean;
+ FExpandLevel : integer;
+ FMemo: TfsSyntaxMemo;
+ FUpdating: Boolean;
+ procedure FillTree;
+
+ procedure SetMemo(Value: TfsSyntaxMemo);
+
+ procedure SetScript(const Value: TfsScript);
+ protected
+ {$IFDEF DELPHI19}
+ procedure CreateImageFromRes(Image: TImage; Bmp: FMX.Graphics.TBitmap;
+ Width, Height: Integer; Index: Integer);
+ {$ELSE}
+ procedure CreateImageFromRes(Image: TImage; Bmp: FMX.Types.TBitmap;
+ Width, Height: Integer; Index: Integer);
+{$ENDIF}
+
+ procedure TreeChange(Sender: TObject; Node: TTreeViewItem);
+ procedure TreeDblClick(Sender: TObject);
+ procedure Notification(AComponent: TComponent;
+ Operation: TOperation); override;
+ protected
+ procedure Loaded; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure SetColor(Color: TAlphaColor);
+ procedure UpdateItems;
+ function GetFieldName: String;
+ published
+ property Align;
+ property Anchors;
+ property DragMode;
+ property Enabled;
+ property PopupMenu;
+ property Script: TfsScript read FScript write SetScript;
+ property ShowHint;
+ property TabOrder;
+ property Visible;
+
+ property SyntaxMemo: TfsSyntaxMemo read FMemo write SetMemo;
+ property ShowClasses: boolean read FShowClasses write FShowClasses;
+ property ShowFunctions: boolean read FShowFunctions write FShowFunctions;
+ property ShowTypes: boolean read FShowTypes write FShowTypes;
+ property ShowVariables: boolean read FShowVariables write FShowVariables;
+ property Expanded: boolean read FExpanded write FExpanded;
+ property ExpandLevel: integer read FExpandLevel write FExpandLevel;
+
+ property OnClick;
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ property Left;
+ property Top;
+ property Width;
+ property Height;
+ end;
+
+implementation
+
+{$IFNDEF FPC}
+ {$R fs_tree.res}
+{$ENDIF}
+
+uses FMX.fs_iTools;
+
+constructor TfsTree.Create(AOwner: TComponent);
+var
+ S: TResourceStream;
+begin
+ inherited;
+ DragMode := TDragMode.dmManual;
+ Tree := TfsTreeView.Create(Self);
+ Tree.Stored := False;
+ with Tree do
+ begin
+ Parent := Self;
+ DragMode := TDragMode.dmAutomatic;
+ Align := TAlignLayout.alClient;
+ TabOrder := 0;
+ end;
+ FImages := TList.Create();
+ S := TResourceStream.Create(HInstance, 'FSTREEFMX', RT_RCDATA);//RT_RCDATA
+ S.Position := 0;
+ Tree.LoadResouces(S, 16, 16);
+ S.Free;
+ Tree.OnDblClick := TreeDblClick;
+ FXML := TfsXMLDocument.Create;
+ Expanded := True;
+ ExpandLevel := 0;
+ ShowClasses := True;
+ ShowFunctions := True;
+ ShowTypes := True;
+ ShowVariables := True;
+ UpdateItems;
+ Top := 0;
+ Left := 0;
+ Height := 250;
+ Width := 200;
+end;
+
+
+ {$IFDEF DELPHI19}
+procedure TfsTree.CreateImageFromRes(Image: TImage; Bmp: FMX.Graphics.TBitmap;
+ Width, Height, Index: Integer);
+ {$ELSE}
+procedure TfsTree.CreateImageFromRes(Image: TImage; Bmp: FMX.Types.TBitmap;
+ Width, Height, Index: Integer);
+{$ENDIF}
+begin
+ Image.Width := Width;
+ Image.Height := Height;
+ Image.Bitmap.SetSize(Width, Height);
+ Image.Bitmap.Canvas.BeginScene;
+ Image.Bitmap.Canvas.DrawBitmap(Bmp, RectF(Width * Index , 0, Width * Index + Width , Height), RectF(0, 0, Width, Height), 1 );
+ Image.Bitmap.Canvas.EndScene;
+ //Image.Bitmap.BitmapChanged;
+end;
+
+destructor TfsTree.Destroy;
+begin
+ FImages.Free;
+ Tree.Free;
+ FUpdating := True;
+ FXML.Free;
+ inherited;
+end;
+
+procedure TfsTree.FillTree;
+
+ function GetCategoryByName(s: String): String;
+ begin
+ if s = 'ctConv' then result := 'Conversion'
+ else if s = 'ctFormat' then result := 'Formatting'
+ else if s = 'ctDate' then result := 'Date/Time'
+ else if s = 'ctString' then result := 'String routines'
+ else if s = 'ctMath' then result := 'Mathematical'
+ else if s = 'ctOther' then result := 'Other'
+ else result := s;
+ end;
+
+ procedure AddClasses(xi: TfsXMLItem; Root: TfsTreeViewItem);
+ var
+ i: Integer;
+ Node: TfsTreeViewItem;
+ s: String;
+ begin
+ s := xi.Prop['text'];
+ Node := TfsTreeViewItem.Create(Tree);
+ Node.Text := s;
+ if Root <> nil then
+ Node.Parent := Root
+ else
+ Node.Parent := Tree;
+ Node.Parent.AddObject(Node);
+ if Root = nil then
+ Node.Text := xi.Name;
+ if xi.Count = 0 then
+ begin
+ Node.OpenImageIndex := 1;
+ Node.CloseImageIndex := 1;
+ end
+ else
+ begin
+ Node.OpenImageIndex := 3;
+ Node.CloseImageIndex := 2;
+ end;
+ for i := 0 to xi.Count - 1 do
+ AddClasses(xi[i], Node);
+ end;
+
+ procedure AddFunctions(xi: TfsXMLItem; Root: TfsTreeViewItem);
+ var
+ i: Integer;
+ Node: TfsTreeViewItem;
+ s: String;
+ begin
+ s := xi.Prop['text'];
+ if xi.Count = 0 then
+ s := Copy(s, Pos(' ', s) + 1, 255) else { function }
+ s := GetCategoryByName(s); { category }
+ Node := TfsTreeViewItem.Create(Tree);
+ Node.DragMode := TDragMode.dmAutomatic;
+ Node.Text := s;
+ if Root <> nil then
+ Node.Parent := Root
+ else
+ Node.Parent := Tree;
+ Node.Parent.AddObject(Node);
+ if Root = nil then
+ Node.Text := xi.Name;
+ if xi.Count = 0 then
+ begin
+ Node.OpenImageIndex := 0;
+ Node.CloseImageIndex := 0;
+ end
+ else
+ begin
+ Node.OpenImageIndex := 3;
+ Node.CloseImageIndex := 2;
+ end;
+ for i := 0 to xi.Count - 1 do
+ AddFunctions(xi[i], Node);
+ end;
+
+ procedure AddTypes(xi: TfsXMLItem; Root: TfsTreeViewItem);
+ var
+ i: Integer;
+ Node: TfsTreeViewItem;
+ s: String;
+ begin
+ s := Copy(xi.Prop['text'], 1, 255);
+ Node := TfsTreeViewItem.Create(Tree);
+ Node.Text := s;
+ if Root <> nil then
+ Node.Parent := Root
+ else
+ Node.Parent := Tree;
+ Node.Parent.AddObject(Node);
+ if Root = nil then
+ Node.Text := xi.Name;
+ if xi.Count = 0 then
+ begin
+ Node.OpenImageIndex := 0;
+ Node.CloseImageIndex := 0;
+ end
+ else
+ begin
+ Node.OpenImageIndex := 3;
+ Node.CloseImageIndex := 2;
+ end;
+ for i := 0 to xi.Count - 1 do
+ AddTypes(xi[i], Node);
+ end;
+
+ procedure AddVariables(xi: TfsXMLItem; Root: TfsTreeViewItem);
+ var
+ i: Integer;
+ Node: TfsTreeViewItem;
+ s: String;
+ begin
+ s := xi.Prop['text'];
+ Node := TfsTreeViewItem.Create(Tree);
+ Node.Text := s;
+ if Root <> nil then
+ Node.Parent := Root
+ else
+ Node.Parent := Tree;
+ Node.Parent.AddObject(Node);
+ if Root = nil then
+ Node.Text := xi.Name;
+ if xi.Count = 0 then
+ begin
+ Node.OpenImageIndex := 0;
+ Node.CloseImageIndex := 0;
+ end
+ else
+ begin
+ Node.OpenImageIndex := 3;
+ Node.CloseImageIndex := 2;
+ end;
+ for i := 0 to xi.Count - 1 do
+ AddVariables(xi[i], Node);
+ end;
+
+ procedure ExpandNodes(level: integer);
+ var
+ j : integer;
+
+ procedure ExpandNode(Node: TTreeViewItem; level: integer);
+ var
+ j : integer;
+ begin
+ if Node.Level < level then
+ for j := 0 to Node.Count - 1 do
+ begin
+ if Node.Items[j].Level < Level then
+ Node.Items[j].IsExpanded := True;
+ ExpandNode(Node.Items[j], Level);
+ end;
+ end;
+ begin
+ if level > 0 then
+ for j := 0 to Tree.Count - 1 do
+ begin
+ if Tree.Items[j].Level <= Level then
+ Tree.Items[j].IsExpanded := True;
+ ExpandNode(Tree.Items[j], Level);
+ end;
+ end;
+
+begin
+ FUpdating := True;
+ FXML.Root.Clear;
+
+ GenerateXMLContents(fsGlobalUnit, FXML.Root);
+ if FScript <> nil then
+ GenerateXMLContents(FScript, FXML.Root);
+
+ Tree.BeginUpdate;
+ Tree.Clear;
+
+ if ShowClasses then
+ AddClasses(FXML.Root.FindItem('Classes'), nil);
+
+ if ShowFunctions then
+ AddFunctions(FXML.Root.FindItem('Functions'), nil);
+
+ if ShowTypes then
+ AddTypes(FXML.Root.FindItem('Types'), nil);
+
+ if ShowVariables then
+ AddVariables(FXML.Root.FindItem('Variables'), nil);
+
+ if Expanded then
+ ExpandNodes(ExpandLevel);
+ Tree.EndUpdate;
+ FUpdating := False;
+end;
+
+procedure TfsTree.UpdateItems;
+begin
+ FillTree;
+end;
+
+procedure TfsTree.TreeChange(Sender: TObject;
+ Node: TTreeViewItem);
+begin
+ if FUpdating then Exit;
+end;
+
+procedure TfsTree.TreeDblClick(Sender: TObject);
+begin
+ //if Assigned(SyntaxMemo) then
+ //if Tree.Selected.Count = 0 then
+ // SyntaxMemo.SelText := Tree.Selected.Text;
+ if Assigned(OnDblClick) then OnDblClick(Self);
+end;
+
+function TfsTree.GetFieldName: String;
+var
+ i, n: Integer;
+ s: String;
+begin
+ Result := '';
+ if (Tree.Selected <> nil) and (Tree.Selected.Count = 0) then
+ begin
+ s := Tree.Selected.Text;
+ if Pos('(', s) <> 0 then
+ n := 1 else
+ n := 0;
+ for i := 1 to Length(s) do
+{$IFDEF Delphi12}
+ if (s[i] = ',') or (s[i] = ';') then
+{$ELSE}
+ if s[i] in [',', ';'] then
+{$ENDIF}
+ Inc(n);
+
+ if n = 0 then
+ s := Copy(s, 1, Pos(':', s) - 1)
+ else
+ begin
+ s := Copy(s, 1, Pos('(', s));
+ for i := 1 to n - 1 do
+ s := s + ',';
+ s := s + ')';
+ end;
+ Result := s;
+ end;
+end;
+
+procedure TfsTree.Loaded;
+begin
+ Inherited;
+
+end;
+
+procedure TfsTree.SetColor(Color: TAlphaColor);
+begin
+ //Tree.Canvas.Stroke.Color := TAlphaColorRec.Azure;
+ // Tree.Color := Color;
+end;
+
+procedure TfsTree.SetMemo(Value: TfsSyntaxMemo);
+begin
+ FMemo := Value;
+end;
+
+procedure TfsTree.SetScript(const Value: TfsScript);
+begin
+ FScript := Value;
+ UpdateItems;
+end;
+
+procedure TfsTree.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited Notification(AComponent, Operation);
+ if Operation = opRemove then
+ if AComponent = FScript then
+ FScript := nil
+ else if AComponent = FMemo then
+ FMemo := nil
+end;
+
+{ TfsTreeViewItem }
+
+procedure TfsTreeViewItem.ApplyStyle;
+var
+ B: TFmxObject;
+ Offset: Single;
+begin
+ inherited;
+ B := FindStyleResource('button');
+ if (B <> nil) and (B is TCustomButton) then
+ begin
+ FButton := TCustomButton(B);
+ B := FindStyleResource('text');
+ Offset := 0;
+ if Self.TreeView is TfsTreeView then
+ Offset := TfsTreeView(Self.TreeView).IconWidth;
+
+ if (B <> nil) and (B is TText) then
+ begin
+{$IFDEF DELPHI17}
+ TText(B).Margins.Left := Offset;
+{$ELSE}
+ TText(B).Padding.Left := Offset;
+{$ENDIF}
+ end;
+ FImgPos := FButton.Position.X + FButton.Width - 2;
+ end;
+end;
+
+
+constructor TfsTreeViewItem.Create(AOwner: TComponent);
+begin
+ inherited;
+ FImgPos := 0;
+ FCloseImageIndex := -1;
+ FOpenImageIndex := -1;
+end;
+
+function TfsTreeViewItem.GetBitmap: TBitmap;
+begin
+ Result := nil;
+ if TreeView is TfsTreeView then
+ begin
+ Result := TfsTreeView(TreeView).FPicBitmap;
+ end;
+end;
+
+procedure TfsTreeViewItem.Paint;
+var
+ Bmp: TBitmap;
+ IconRect: TRectF;
+ Index: Integer;
+begin
+ inherited Paint;
+ if IsExpanded then
+ Index := FOpenImageIndex
+ else
+ Index := FCloseImageIndex;
+
+ if Index = -1 then Exit;
+
+ Bmp := GetBitmap;
+ if TreeView is TfsTreeView then
+ begin
+ IconRect := TfsTreeView(TreeView).GetBitmapRect(Index);
+ end;
+ if (Bmp <> nil) and (FImgPos > 0)then
+ Canvas.DrawBitmap(Bmp, IconRect, RectF(16, 0, 34, 16), 1 );
+end;
+
+{ TfsTreeView }
+
+constructor TfsTreeView.Create(AOwner: TComponent);
+begin
+ inherited;
+ FPicBitmap := nil;
+ FIconWidth := 0;
+ FIconHeight := 0;
+end;
+
+destructor TfsTreeView.Destroy;
+begin
+ if FPicBitmap <> nil then
+ FPicBitmap.Free;
+
+ inherited;
+end;
+
+procedure TfsTreeView.DragDrop(const Data: TDragObject; const Point: TPointF);
+begin
+ //inherited;
+ // don't use TTreeView handlers
+end;
+
+procedure TfsTreeView.DragOver(const Data: TDragObject; const Point: TPointF;
+ {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+begin
+ //inherited;
+ //don't use TTreeView handlers
+end;
+
+function TfsTreeView.GetBitmapRect(Index: Integer): TRectF;
+var
+ maxX, maxY, i: Integer;
+ PosX, PosY: Integer;
+begin
+ Result := RectF(0, 0, 0, 0);
+ if FPicBitmap = nil then Exit;
+ PosX := 0;
+ PosY := 0;
+ maxX := FPicBitmap.Width div FIconWidth;
+ maxY := FPicBitmap.Height div FIconHeight;
+
+ for i := 0 to maxY - 1 do
+ begin
+ if Index < maxX then
+ begin
+ PosX := FIconWidth * Index;
+ break;
+ end;
+ Index := Index div maxY;
+ Inc(PosY);
+ if PosY > maxY then
+ begin
+ PosX := 0;
+ PosY := 0;
+ break;
+ end;
+ end;
+ Result := RectF(PosX, PosY, PosX + FIconWidth, PosY + FIconHeight);
+end;
+
+procedure TfsTreeView.LoadResouces(Stream: TStream; IconWidth,
+ IconHeight: Integer);
+begin
+ FIconWidth := IconWidth;
+ FIconHeight := IconHeight;
+ if FPicBitmap = nil then
+ FPicBitmap := TBitmap.CreateFromStream(Stream)
+ else
+ FPicBitmap.LoadFromStream(Stream);
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsTreeViewItem, TFmxObject);
+ GroupDescendentsWith(TfsTreeView, TFmxObject);
+ GroupDescendentsWith(TfsTree, TFmxObject);
+ RegisterFmxClasses([TfsTreeViewItem, TfsTreeView]);
+
+end.
diff --git a/FastScript/FMX.fs_xml.pas b/FastScript/FMX.fs_xml.pas
new file mode 100644
index 0000000..11723e4
--- /dev/null
+++ b/FastScript/FMX.fs_xml.pas
@@ -0,0 +1,15 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ XML document }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_xml;
+
+{$i FMX.inc}
+{$i fs_xml.pas}
\ No newline at end of file
diff --git a/FastScript/FMX/FMX.BaseTypeAliases.pas b/FastScript/FMX/FMX.BaseTypeAliases.pas
new file mode 100644
index 0000000..2d807b0
--- /dev/null
+++ b/FastScript/FMX/FMX.BaseTypeAliases.pas
@@ -0,0 +1,283 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Graphics.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.BaseTypeAliases;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Types, FMX.Objects, System.UITypes, System.UIConsts, FMX.Graphics, FMX.Controls, System.Types, System.TypInfo;
+
+type
+
+ TCalloutPositionHelper = record helper for TCalloutPosition
+ const
+ cpTop = TCalloutPosition.Top deprecated 'Use TCalloutPosition.Top';
+ cpLeft = TCalloutPosition.Left deprecated 'Use TCalloutPosition.Left';
+ cpBottom = TCalloutPosition.Bottom deprecated 'Use TCalloutPosition.Bottom';
+ cpRight = TCalloutPosition.Right deprecated 'Use TCalloutPosition.Right';
+ end;
+
+ TCornerHelper = record helper for TCorner
+ const
+ crTopLeft = TCorner.TopLeft deprecated 'Use TCorner.TopLeft';
+ crTopRight = TCorner.TopRight deprecated 'Use TCorner.TopRight';
+ crBottomLeft = TCorner.BottomLeft deprecated 'Use TCorner.BottomLeft';
+ crBottomRight = TCorner.BottomRight deprecated 'Use TCorner.BottomRight';
+ end;
+
+ TCornerTypeHelper = record helper for TCornerType
+ const
+ ctRound = TCornerType.Round deprecated 'Use TCornerType.Round';
+ ctBevel = TCornerType.Bevel deprecated 'Use TCornerType.Bevel';
+ ctInnerRound = TCornerType.InnerRound deprecated 'Use TCornerType.InnerRound';
+ ctInnerLine = TCornerType.InnerLine deprecated 'Use TCornerType.InnerLine';
+ end;
+
+ TSideHelper = record helper for TSide
+ const
+ sdTop = TSide.Top deprecated 'Use TSide.Top';
+ sdLeft = TSide.Left deprecated 'Use TSide.Left';
+ sdBottom = TSide.Bottom deprecated 'Use TSide.Bottom';
+ sdRight = TSide.Right deprecated 'Use TSide.Right';
+ end;
+
+ TTextAlignHelper = record helper for TTextAlign
+ const
+ taCenter = TTextAlign.Center deprecated 'Use TTextAlign.Center';
+ taLeading = TTextAlign.Leading deprecated 'Use TTextAlign.Leading';
+ taTrailing = TTextAlign.Trailing deprecated 'Use TTextAlign.Trailing';
+ end;
+
+ TTextTrimmingHelper = record helper for TTextTrimming
+ const
+ ttNone = TTextTrimming.None deprecated 'Use TTextTrimming.None';
+ ttCharacter = TTextTrimming.Character deprecated 'Use TTextTrimming.Character';
+ ttWord = TTextTrimming.Word deprecated 'Use TTextTrimming.Word';
+ end;
+
+ TStyledSettingHelper = record helper for TStyledSetting
+ const
+ ssFamily = TStyledSetting.Family deprecated 'Use TStyledSetting.Family';
+ ssSize = TStyledSetting.Size deprecated 'Use TStyledSetting.Size';
+ ssStyle = TStyledSetting.Style deprecated 'Use TStyledSetting.Style';
+ ssFontColor = TStyledSetting.FontColor deprecated 'Use TStyledSetting.FontColor';
+ ssOther = TStyledSetting.Other deprecated 'Use TStyledSetting.Other';
+ end;
+
+ TMenuItemChangeHelper = record helper for TMenuItemChange
+ const
+ mcEnabled = TMenuItemChange.Enabled deprecated 'Use TMenuItemChange.Enabled';
+ mcVisible = TMenuItemChange.Visible deprecated 'Use TMenuItemChange.Visible';
+ mcText = TMenuItemChange.Text deprecated 'Use TMenuItemChange.Text';
+ mcShortcut = TMenuItemChange.Shortcut deprecated 'Use TMenuItemChange.Shortcut';
+ mcChecked = TMenuItemChange.Checked deprecated 'Use TMenuItemChange.Checked';
+ mcBitmap = TMenuItemChange.Bitmap deprecated 'Use TMenuItemChange.Bitmap';
+ end;
+
+ TScreenOrientationHelper = record helper for TScreenOrientation
+ const
+ soPortrait = TScreenOrientation.Portrait deprecated 'Use TScreenOrientation.Portrait';
+ soLandscape = TScreenOrientation.Landscape deprecated 'Use TScreenOrientation.Landscape';
+ soInvertedPortrait = TScreenOrientation.InvertedPortrait deprecated 'Use TScreenOrientation.InvertedPortrait';
+ soInvertedLandscape = TScreenOrientation.InvertedLandscape deprecated 'Use TScreenOrientation.InvertedLandscape';
+ end;
+
+ TFormStyleHelper = record helper for TFormStyle
+ const
+ fsNormal = TFormStyle.Normal deprecated 'Use TFormStyle.Normal';
+ fsPopup = TFormStyle.Popup deprecated 'Use TFormStyle.Popup';
+ fsStayOnTop = TFormStyle.StayOnTop deprecated 'Use TFormStyle.StayOnTop';
+ end;
+
+ TAlignLayoutHelper = record helper for TAlignLayout
+ const
+ alNone = TAlignLayout.None deprecated 'Use TAlignLayout.None';
+ alTop = TAlignLayout.Top deprecated 'Use TAlignLayout.Top';
+ alLeft = TAlignLayout.Left deprecated 'Use TAlignLayout.Left';
+ alRight = TAlignLayout.Right deprecated 'Use TAlignLayout.Right';
+ alBottom = TAlignLayout.Bottom deprecated 'Use TAlignLayout.Bottom';
+ alMostTop = TAlignLayout.MostTop deprecated 'Use TAlignLayout.MostTop';
+ alMostBottom = TAlignLayout.MostBottom deprecated 'Use TAlignLayout.MostBottom';
+ alMostLeft = TAlignLayout.MostLeft deprecated 'Use TAlignLayout.MostLeft';
+ alMostRight = TAlignLayout.MostRight deprecated 'Use TAlignLayout.MostRight';
+ alClient = TAlignLayout.Client deprecated 'Use TAlignLayout.Client';
+ alContents = TAlignLayout.Contents deprecated 'Use TAlignLayout.Contents';
+ alCenter = TAlignLayout.Center deprecated 'Use TAlignLayout.Center';
+ alVertCenter = TAlignLayout.VertCenter deprecated 'Use TAlignLayout.VertCenter';
+ alHorzCenter = TAlignLayout.HorzCenter deprecated 'Use TAlignLayout.HorzCenter';
+ alHorizontal = TAlignLayout.Horizontal deprecated 'Use TAlignLayout.Horizontal';
+ alVertical = TAlignLayout.Vertical deprecated 'Use TAlignLayout.Vertical';
+ alScale = TAlignLayout.Scale deprecated 'Use TAlignLayout.Scale';
+ alFit = TAlignLayout.Fit deprecated 'Use TAlignLayout.Fit';
+ alFitLeft = TAlignLayout.FitLeft deprecated 'Use TAlignLayout.FitLeft';
+ alFitRight = TAlignLayout.FitRight deprecated 'Use TAlignLayout.FitRight';
+ end;
+
+ TGradientStyleHelper = record helper for TGradientStyle
+ const
+ gsLinear = TGradientStyle.Linear deprecated 'Use TGradientStyle.Linear';
+ gsRadial = TGradientStyle.Radial deprecated 'Use TGradientStyle.Radial';
+ end;
+
+ TBrushKindHelper = record helper for TBrushKind
+ const
+ bkNone = TBrushKind.None deprecated 'Use TBrushKind.None';
+ bkSolid = TBrushKind.Solid deprecated 'Use TBrushKind.Solid';
+ bkGradient = TBrushKind.Gradient deprecated 'Use TBrushKind.Gradient';
+ bkBitmap = TBrushKind.Bitmap deprecated 'Use TBrushKind.Bitmap';
+ bkResource = TBrushKind.Resource deprecated 'Use TBrushKind.Resource';
+ end;
+
+ TStrokeCapHelper = record helper for TStrokeCap
+ const
+ scFlat = TStrokeCap.Flat deprecated 'Use TStrokeCap.Flat';
+ scRound = TStrokeCap.Round deprecated 'Use TStrokeCap.Round';
+ end;
+
+ TStrokeJoinHelper = record helper for TStrokeJoin
+ const
+ sjMiter = TStrokeJoin.Miter deprecated 'Use TStrokeJoin.Miter';
+ sjRound = TStrokeJoin.Round deprecated 'Use TStrokeJoin.Round';
+ sjBevel = TStrokeJoin.Bevel deprecated 'Use TStrokeJoin.Bevel';
+ end;
+
+ TStrokeDashHelper = record helper for TStrokeDash
+ const
+ sdSolid = TStrokeDash.Solid deprecated 'Use TStrokeDash.Solid';
+ sdDash = TStrokeDash.Dash deprecated 'Use TStrokeDash.Dash';
+ sdDot = TStrokeDash.Dot deprecated 'Use TStrokeDash.Dot';
+ sdDashDot = TStrokeDash.DashDot deprecated 'Use TStrokeDash.DashDot';
+ sdDashDotDot = TStrokeDash.DashDotDot deprecated 'Use TStrokeDash.DashDotDot';
+ sdCustom = TStrokeDash.Custom deprecated 'Use TStrokeDash.Custom';
+ end;
+
+ TFillTextFlagHelper = record helper for TFillTextFlag
+ const
+ ftRightToLeft = TFillTextFlag.RightToLeft deprecated 'Use TFillTextFlag.RightToLeft';
+ end;
+
+ TMapAccessHelper = record helper for TMapAccess
+ const
+ maRead = TMapAccess.Read deprecated 'Use TMapAccess.Read';
+ maWrite = TMapAccess.Write deprecated 'Use TMapAccess.Write';
+ maReadWrite = TMapAccess.ReadWrite deprecated 'Use TMapAccess.ReadWrite';
+ end;
+
+ TOrientationHelper = record helper for TOrientation
+ const
+ orHorizontal = TOrientation.Horizontal deprecated 'Use TOrientation.Horizontal';
+ orVertical = TOrientation.Vertical deprecated 'Use TOrientation.Vertical';
+ end;
+
+ TPlacementHelper = record helper for TPlacement
+ const
+ plBottom = TPlacement.Bottom deprecated 'Use TPlacement.Bottom';
+ plTop = TPlacement.Top deprecated 'Use TPlacement.Top';
+ plLeft = TPlacement.Left deprecated 'Use TPlacement.Left';
+ plRight = TPlacement.Right deprecated 'Use TPlacement.Right';
+ plCenter = TPlacement.Center deprecated 'Use TPlacement.Center';
+ plBottomCenter = TPlacement.BottomCenter deprecated 'Use TPlacement.BottomCenter';
+ plTopCenter = TPlacement.TopCenter deprecated 'Use TPlacement.TopCenter';
+ plLeftCenter = TPlacement.LeftCenter deprecated 'Use TPlacement.LeftCenter';
+ plRightCenter = TPlacement.RightCenter deprecated 'Use TPlacement.RightCenter';
+ plAbsolute = TPlacement.Absolute deprecated 'Use TPlacement.Absolute';
+ plMouse = TPlacement.Mouse deprecated 'Use TPlacement.Mouse';
+ plMouseCenter = TPlacement.MouseCenter deprecated 'Use TPlacement.MouseCenter';
+ end;
+
+ TVirtualKeyboardTypeHelper = record helper for TVirtualKeyboardType
+ const
+ vktDefault = TVirtualKeyboardType.Default deprecated 'Use TVirtualKeyboardType.Default';
+ vktNumbersAndPunctuation = TVirtualKeyboardType.NumbersAndPunctuation deprecated 'Use TVirtualKeyboardType.NumbersAndPunctuation';
+ vktNumberPad = TVirtualKeyboardType.NumberPad deprecated 'Use TVirtualKeyboardType.NumberPad';
+ vktPhonePad = TVirtualKeyboardType.PhonePad deprecated 'Use TVirtualKeyboardType.PhonePad';
+ vktAlphabet = TVirtualKeyboardType.Alphabet deprecated 'Use TVirtualKeyboardType.Alphabet';
+ vktURL = TVirtualKeyboardType.URL deprecated 'Use TVirtualKeyboardType.URL';
+ vktNamePhonePad = TVirtualKeyboardType.NamePhonePad deprecated 'Use TVirtualKeyboardType.NamePhonePad';
+ vktEmailAddress = TVirtualKeyboardType.EmailAddress deprecated 'Use TVirtualKeyboardType.EmailAddress';
+ end;
+
+ TVirtualKeyboardStateHelper = record helper for TVirtualKeyboardState
+ const
+ vksAutoShow = TVirtualKeyboardState.AutoShow deprecated 'Use TVirtualKeyboardState.AutoShow';
+ vksVisible = TVirtualKeyboardState.Visible deprecated 'Use TVirtualKeyboardState.Visible';
+ vksError = TVirtualKeyboardState.Error deprecated 'Use TVirtualKeyboardState.Error';
+ vksTransient = TVirtualKeyboardState.Transient deprecated 'Use TVirtualKeyboardState.Transient';
+ end;
+
+ TReturnKeyTypeHelper = record helper for TReturnKeyType
+ const
+ rktDefault = TReturnKeyType.Default deprecated 'Use TReturnKeyType.Default';
+ rktDone = TReturnKeyType.Done deprecated 'Use TReturnKeyType.Done';
+ rktGo = TReturnKeyType.Go deprecated 'Use TReturnKeyType.Go';
+ rktNext = TReturnKeyType.Next deprecated 'Use TReturnKeyType.Next';
+ rktSearch = TReturnKeyType.Search deprecated 'Use TReturnKeyType.Search';
+ rktSend = TReturnKeyType.Send deprecated 'Use TReturnKeyType.Send';
+ end;
+
+implementation
+
+initialization
+ AddEnumElementAliases(TypeInfo(TCalloutPosition), ['cpTop', 'cpLeft', 'cpBottom', 'cpRight']);
+ AddEnumElementAliases(TypeInfo(TCorner), ['crTopLeft', 'crTopRight', 'crBottomLeft', 'crBottomRight']);
+ AddEnumElementAliases(TypeInfo(TCornerType), ['ctRound', 'ctBevel', 'ctInnerRound', 'ctInnerLine']);
+ AddEnumElementAliases(TypeInfo(TSide), ['sdTop', 'sdLeft', 'sdBottom', 'sdRight']);
+ AddEnumElementAliases(TypeInfo(TTextAlign), ['taCenter', 'taLeading', 'taTrailing']);
+ AddEnumElementAliases(TypeInfo(TTextTrimming), ['ttNone', 'ttCharacter', 'ttWord']);
+ AddEnumElementAliases(TypeInfo(TStyledSetting), ['ssFamily', 'ssSize', 'ssStyle', 'ssFontColor', 'ssOther']);
+ AddEnumElementAliases(TypeInfo(TMenuItemChange), ['mcEnabled', 'mcVisible', 'mcText', 'mcShortcut', 'mcChecked', 'mcBitmap']);
+ AddEnumElementAliases(TypeInfo(TScreenOrientation), ['soPortrait', 'soLandscape', 'soInvertedPortrait', 'soInvertedLandscape']);
+ AddEnumElementAliases(TypeInfo(TFormStyle), ['fsNormal', 'fsPopup', 'fsStayOnTop']);
+ AddEnumElementAliases(TypeInfo(TAlignLayout), ['alNone', 'alTop', 'alLeft', 'alRight', 'alBottom', 'alMostTop', 'alMostBottom', 'alMostLeft', 'alMostRight', 'alClient', 'alContents', 'alCenter', 'alVertCenter', 'alHorzCenter', 'alHorizontal', 'alVertical', 'alScale', 'alFit', 'alFitLeft', 'alFitRight']);
+ AddEnumElementAliases(TypeInfo(TGradientStyle), ['gsLinear', 'gsRadial']);
+ AddEnumElementAliases(TypeInfo(TBrushKind), ['bkNone', 'bkSolid', 'bkGradient', 'bkBitmap', 'bkResource']);
+ AddEnumElementAliases(TypeInfo(TStrokeCap), ['scFlat', 'scRound']);
+ AddEnumElementAliases(TypeInfo(TStrokeJoin), ['sjMiter', 'sjRound', 'sjBevel']);
+ AddEnumElementAliases(TypeInfo(TStrokeDash), ['sdSolid', 'sdDash', 'sdDot', 'sdDashDot', 'sdDashDotDot', 'sdCustom']);
+ AddEnumElementAliases(TypeInfo(TMapAccess), ['maRead', 'maWrite', 'maReadWrite']);
+ AddEnumElementAliases(TypeInfo(TFillTextFlag), ['ftRightToLeft']);
+ AddEnumElementAliases(TypeInfo(TOrientation), ['orHorizontal', 'orVertical']);
+ AddEnumElementAliases(TypeInfo(TPlacement), ['plBottom', 'plTop', 'plLeft', 'plRight', 'plCenter', 'plBottomCenter', 'plTopCenter', 'plLeftCenter', 'plRightCenter', 'plAbsolute', 'plMouse', 'plMouseCenter']);
+ AddEnumElementAliases(TypeInfo(TVirtualKeyboardType), ['vktDefault', 'vktNumbersAndPunctuation', 'vktNumberPad', 'vktPhonePad', 'vktAlphabet', 'vktURL', 'vktNamePhonePad', 'vktEmailAddress']);
+ AddEnumElementAliases(TypeInfo(TReturnKeyType), ['rktDefault', 'rktDone', 'rktGo', 'rktNext', 'rktSearch']);
+ AddEnumElementAliases(TypeInfo(TVirtualKeyboardState), ['vksAutoShow', 'vksVisible', 'vksError', 'vksTransient']);
+
+
+finalization
+ RemoveEnumElementAliases(TypeInfo(TCalloutPosition));
+ RemoveEnumElementAliases(TypeInfo(TCorner));
+ RemoveEnumElementAliases(TypeInfo(TCornerType));
+ RemoveEnumElementAliases(TypeInfo(TSide));
+ RemoveEnumElementAliases(TypeInfo(TTextAlign));
+ RemoveEnumElementAliases(TypeInfo(TTextTrimming));
+ RemoveEnumElementAliases(TypeInfo(TStyledSetting));
+ RemoveEnumElementAliases(TypeInfo(TMenuItemChange));
+ RemoveEnumElementAliases(TypeInfo(TScreenOrientation));
+ RemoveEnumElementAliases(TypeInfo(TFormStyle));
+ RemoveEnumElementAliases(TypeInfo(TAlignLayout));
+ RemoveEnumElementAliases(TypeInfo(TGradientStyle));
+ RemoveEnumElementAliases(TypeInfo(TBrushKind));
+ RemoveEnumElementAliases(TypeInfo(TStrokeCap));
+ RemoveEnumElementAliases(TypeInfo(TStrokeJoin));
+ RemoveEnumElementAliases(TypeInfo(TStrokeDash));
+ RemoveEnumElementAliases(TypeInfo(TMapAccess));
+ RemoveEnumElementAliases(TypeInfo(TFillTextFlag));
+ RemoveEnumElementAliases(TypeInfo(TOrientation));
+ RemoveEnumElementAliases(TypeInfo(TPlacement));
+ RemoveEnumElementAliases(TypeInfo(TVirtualKeyboardType));
+ RemoveEnumElementAliases(TypeInfo(TReturnKeyType));
+ RemoveEnumElementAliases(TypeInfo(TVirtualKeyboardState));
+
+
+end.
diff --git a/FastScript/FMX/FMX.FormTypeAliases.pas b/FastScript/FMX/FMX.FormTypeAliases.pas
new file mode 100644
index 0000000..99d3df6
--- /dev/null
+++ b/FastScript/FMX/FMX.FormTypeAliases.pas
@@ -0,0 +1,70 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Graphics.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.FormTypeAliases;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Types, FMX.Objects, System.UITypes, System.UIConsts, FMX.Graphics, System.Types, System.TypInfo, FMX.Forms;
+
+type
+ TFmxFormBorderStyleHelper = record helper for TFmxFormBorderStyle
+ const
+ bsNone = TFmxFormBorderStyle.None deprecated 'Use TFmxFormBorderStyle.None';
+ bsSingle = TFmxFormBorderStyle.Single deprecated 'Use TFmxFormBorderStyle.Single';
+ bsSizeable = TFmxFormBorderStyle.Sizeable deprecated 'Use TFmxFormBorderStyle.Sizeable';
+ bsToolWindow = TFmxFormBorderStyle.ToolWindow deprecated 'Use TFmxFormBorderStyle.ToolWindow';
+ bsSizeToolWin = TFmxFormBorderStyle.SizeToolWin deprecated 'Use TFmxFormBorderStyle.SizeToolWin';
+ end;
+
+ TFormPositionHelper = record helper for TFormPosition
+ const
+ poDesigned = TFormPosition.Designed deprecated 'Use TFormPosition.Designed';
+ poDefault = TFormPosition.Default deprecated 'Use TFormPosition.Default';
+ poDefaultPosOnly = TFormPosition.DefaultPosOnly deprecated 'Use TFormPosition.DefaultPosOnly';
+ poDefaultSizeOnly = TFormPosition.DefaultSizeOnly deprecated 'Use TFormPosition.DefaultSizeOnly';
+ poScreenCenter = TFormPosition.ScreenCenter deprecated 'Use TFormPosition.ScreenCenter';
+ poDesktopCenter = TFormPosition.DesktopCenter deprecated 'Use TFormPosition.DesktopCenter';
+ poMainFormCenter = TFormPosition.MainFormCenter deprecated 'Use TFormPosition.MainFormCenter';
+ poOwnerFormCenter = TFormPosition.OwnerFormCenter deprecated 'Use TFormPosition.OwnerFormCenter';
+ end;
+
+ TFmxFormStateHelper = record helper for TFmxFormState
+ const
+ fsRecreating = TFmxFormState.Recreating deprecated 'Use TFmxFormState.Recreating';
+ fsModal = TFmxFormState.Modal deprecated 'Use TFmxFormState.Modal';
+ fsReleased = TFmxFormState.Released deprecated 'Use TFmxFormState.Released';
+ fsInDesigner = TFmxFormState.InDesigner deprecated 'Use TFmxFormState.InDesigner';
+ fsWasNotShown = TFmxFormState.WasNotShown deprecated 'Use TFmxFormState.WasNotShown';
+ fsShowing = TFmxFormState.Showing deprecated 'Use TFmxFormState.Showing';
+ fsUpdateBorder = TFmxFormState.UpdateBorder deprecated 'Use TFmxFormState.UpdateBorder';
+ fsActivation = TFmxFormState.Activation deprecated 'Use TFmxFormState.Activation';
+ end;
+
+
+implementation
+
+initialization
+ AddEnumElementAliases(TypeInfo(TFmxFormBorderStyle), ['bsNone', 'bsSingle', 'bsSizeable', 'bsToolWindow', 'bsSizeToolWin']);
+ AddEnumElementAliases(TypeInfo(TFormPosition), ['poDesigned', 'poDefault', 'poDefaultPosOnly', 'poDefaultSizeOnly', 'poScreenCenter', 'poDesktopCenter',
+ 'poMainFormCenter', 'poOwnerFormCenter']);
+ AddEnumElementAliases(TypeInfo(TFmxFormState), ['fsRecreating', 'fsModal', 'fsReleased', 'fsInDesigner', 'fsWasNotShown', 'fsShowing', 'fsUpdateBorder',
+ 'fsActivation']);
+
+finalization
+ RemoveEnumElementAliases(TypeInfo(TFmxFormBorderStyle));
+ RemoveEnumElementAliases(TypeInfo(TFormPosition));
+ RemoveEnumElementAliases(TypeInfo(TFmxFormState));
+
+end.
diff --git a/FastScript/FMX/FMX.fs_iadortti.pas b/FastScript/FMX/FMX.fs_iadortti.pas
new file mode 100644
index 0000000..f858548
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_iadortti.pas
@@ -0,0 +1,129 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ ADO classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iadortti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_itools, FMX.fs_idbrtti,
+ Data.DB, Data.Win.ADODB, Winapi.ADOInt, FMX.Types;
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsADORTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddType('TDataType', fvtInt);
+ AddClass(TADOConnection, 'TComponent');
+ AddClass(TParameter, 'TCollectionItem');
+ with AddClass(TParameters, 'TCollection') do
+ begin
+ AddMethod('function AddParameter: TParameter', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TParameter', CallMethod, True);
+ end;
+ with AddClass(TCustomADODataSet, 'TDataSet') do
+ begin
+ AddProperty('Sort', 'WideString', GetProp, SetProp);
+ end;
+ AddClass(TADOTable, 'TCustomADODataSet');
+ with AddClass(TADOQuery, 'TCustomADODataSet') do
+ AddMethod('procedure ExecSQL', CallMethod);
+ with AddClass(TADOStoredProc, 'TCustomADODataSet') do
+ AddMethod('procedure ExecProc', CallMethod);
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TParameters then
+ begin
+ if MethodName = 'ADDPARAMETER' then
+ Result := frxInteger(TParameters(Instance).AddParameter)
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TParameters(Instance).Items[Caller.Params[0]])
+ end
+ else if ClassType = TADOQuery then
+ begin
+ if MethodName = 'EXECSQL' then
+ TADOQuery(Instance).ExecSQL
+ end
+ else if ClassType = TADOStoredProc then
+ begin
+ if MethodName = 'EXECPROC' then
+ TADOStoredProc(Instance).ExecProc
+ end
+end;
+
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TCustomADODataSet then
+ begin
+ if PropName = 'SORT' then
+ Result := TCustomADODataSet(Instance).Sort;
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+
+ if ClassType = TCustomADODataSet then
+ begin
+ if PropName = 'SORT' then
+ TCustomADODataSet(Instance).Sort := Value;
+ end
+
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsADORTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
+
diff --git a/FastScript/FMX/FMX.fs_ibasic.pas b/FastScript/FMX/FMX.fs_ibasic.pas
new file mode 100644
index 0000000..8a0c8e7
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_ibasic.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Basic grammar }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_ibasic;
+{$i FMX.inc}
+{$i fs_ibasic.pas}
\ No newline at end of file
diff --git a/FastScript/FMX/FMX.fs_ichartrtti.pas b/FastScript/FMX/FMX.fs_ichartrtti.pas
new file mode 100644
index 0000000..4fdff87
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_ichartrtti.pas
@@ -0,0 +1,181 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Chart }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_ichartrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_itools, FMX.fs_iformsrtti, FMX.Objects,
+ FMXTee.Chart, FMXTee.Series, FMXTee.Engine, FMXTee.Procs, FMXTee.Canvas, FMX.Types, System.Types;
+
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsChartRTTI = class(TFmxObject); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddType('TChartValue', fvtFloat);
+ AddEnum('TLegendStyle', 'lsAuto, lsSeries, lsValues, lsLastValues');
+ AddEnum('TLegendAlignment', 'laLeft, laRight, laTop, laBottom');
+ AddEnum('TLegendTextStyle', 'ltsPlain, ltsLeftValue, ltsRightValue, ltsLeftPercent,' +
+ 'ltsRightPercent, ltsXValue');
+ AddEnum('TChartListOrder', 'loNone, loAscending, loDescending');
+ AddEnum('TGradientDirection', 'gdTopBottom, gdBottomTop, gdLeftRight, gdRightLeft');
+ AddEnum('TSeriesMarksStyle', 'smsValue, smsPercent, smsLabel, smsLabelPercent, ' +
+ 'smsLabelValue, smsLegend, smsPercentTotal, smsLabelPercentTotal, smsXValue');
+ AddEnum('TAxisLabelStyle', 'talAuto, talNone, talValue, talMark, talText');
+ AddEnum('THorizAxis', 'aTopAxis, aBottomAxis');
+ AddEnum('TVertAxis', 'aLeftAxis, aRightAxis');
+ AddEnum('TTeeBackImageMode', 'pbmStretch, pbmTile, pbmCenter');
+ AddEnum('TPanningMode', 'pmNone, pmHorizontal, pmVertical, pmBoth');
+ AddEnum('TSeriesPointerStyle', 'psRectangle, psCircle, psTriangle, ' +
+ 'psDownTriangle, psCross, psDiagCross, psStar, psDiamond, psSmallDot');
+ AddEnum('TMultiArea', 'maNone, maStacked, maStacked100');
+ AddEnum('TMultiBar', 'mbNone, mbSide, mbStacked, mbStacked100');
+ AddEnum('TBarStyle', 'bsRectangle, bsPyramid, bsInvPyramid, bsCilinder, ' +
+ 'bsEllipse, bsArrow, bsRectGradient');
+
+ AddEnum('TPenEndStyle', 'esRound, esSquare, esFlat');
+ AddEnum('TPenMode', 'pmBlack, pmWhite, pmNop, pmNot, pmCopy, pmNotCopy, ' +
+ 'pmMergePenNot, pmMaskPenNot, pmMergeNotPen, pmMaskNotPen, pmMerge, ' +
+ 'pmNotMerge, pmMask, pmNotMask, pmXor, pmNotXor');
+ AddEnum('TPenStyle', 'psSolid, psDash, psDot, psDashDot, psDashDotDot, psClear, psInsideFrame');
+ AddClass(TChartValueList, 'TPersistent');
+ AddClass(TChartAxisTitle, 'TPersistent');
+ AddClass(TChartAxis, 'TPersistent');
+ AddClass(TCustomChartLegend, 'TPersistent');
+ AddClass(TChartLegend, 'TCustomChartLegend');
+ AddClass(TSeriesMarks, 'TPersistent');
+ AddClass(TChartGradient, 'TPersistent');
+ AddClass(TChartWall, 'TPersistent');
+ AddClass(TChartBrush, 'TBrush');
+ AddClass(TChartTitle, 'TPersistent');
+ AddClass(TView3DOptions, 'TPersistent');
+ AddClass(TChartPen, 'TComponent');
+ with AddClass(TChartSeries, 'TComponent') do
+ begin
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure Delete(Index: Integer)', CallMethod);
+ AddMethod('function Count: Integer', CallMethod);
+ AddMethod('procedure Add(const AValue: Double; const ALabel: String; AColor: TColor)', CallMethod);
+ AddProperty('Active','Boolean', GetProp, SetProp);
+ AddProperty('ColorEachPoint','Boolean', GetProp, SetProp);
+
+ end;
+ AddClass(TSeriesPointer, 'TPersistent');
+ AddClass(TCustomSeries, 'TChartSeries');
+ AddClass(TLineSeries, 'TCustomSeries');
+ AddClass(TPointSeries, 'TCustomSeries');
+ AddClass(TAreaSeries, 'TCustomSeries');
+ with AddClass(TCustomBarSeries, 'TChartSeries') do
+ begin
+ AddProperty('Title','String', GetProp, SetProp);
+ end;
+ AddClass(TBarSeries, 'TCustomBarSeries');
+ AddClass(THorizBarSeries, 'TCustomBarSeries');
+ AddClass(TCircledSeries, 'TChartSeries');
+ AddClass(TPieSeries, 'TCircledSeries');
+ AddClass(TFastLineSeries, 'TChartSeries');
+ AddClass(TCustomChart, 'TWinControl');
+ AddClass(TChart, 'TCustomChart');
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TChartSeries then
+ begin
+ if MethodName = 'CLEAR' then
+ TChartSeries(Instance).Clear
+ else if MethodName = 'ADD' then
+ TChartSeries(Instance).Add(Caller.Params[0], String(Caller.Params[1]), Caller.Params[2])
+ else if MethodName = 'DELETE' then
+ TChartSeries(Instance).Delete(Caller.Params[0])
+ else if MethodName = 'COUNT' then
+ Result := TChartSeries(Instance).Count
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TChartSeries then
+ begin
+ if PropName = 'ACTIVE' then
+ Result := TChartSeries(Instance).Active
+ else if PropName = 'COLOREACHPOINT' then
+ Result := TChartSeries(Instance).ColorEachPoint
+ end else
+ if ClassType = TCustomBarSeries then
+ begin
+ if PropName = 'Title' then
+ Result := TCustomBarSeries(Instance).Title
+ end;
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TChartSeries then
+ begin
+ if PropName = 'ACTIVE' then
+ TChartSeries(Instance).Active := Value
+ else if PropName = 'COLOREACHPOINT' then
+ TChartSeries(Instance).ColorEachPoint := Value
+ end else
+ if ClassType = TCustomBarSeries then
+ begin
+ if PropName = 'Title' then
+ TCustomBarSeries(Instance).Title := Value
+ end
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsChartRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/FMX/FMX.fs_iclassesrtti.pas b/FastScript/FMX/FMX.fs_iclassesrtti.pas
new file mode 100644
index 0000000..97fd2ec
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_iclassesrtti.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Classes.pas classes and functions }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iclassesrtti;
+{$i FMX.inc}
+{$i fs_iclassesrtti.pas}
\ No newline at end of file
diff --git a/FastScript/FMX/FMX.fs_iconst.pas b/FastScript/FMX/FMX.fs_iconst.pas
new file mode 100644
index 0000000..c23d7cf
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_iconst.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Resources }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iconst;
+{$i FMX.inc}
+{$i fs_iconst.pas}
\ No newline at end of file
diff --git a/FastScript/FMX/FMX.fs_icpp.pas b/FastScript/FMX/FMX.fs_icpp.pas
new file mode 100644
index 0000000..64a3c70
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_icpp.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ C++ grammar }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_icpp;
+{$i FMX.inc}
+{$i fs_icpp.pas}
\ No newline at end of file
diff --git a/FastScript/FMX/FMX.fs_idbrtti.pas b/FastScript/FMX/FMX.fs_idbrtti.pas
new file mode 100644
index 0000000..dbb1620
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_idbrtti.pas
@@ -0,0 +1,570 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ DB.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_idbrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.Types, System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_itools, FMX.fs_iclassesrtti, FMX.fs_ievents,
+ Data.DB, FMX.Types;
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsDBRTTI = class(TComponent); // fake component
+
+ TfsDatasetNotifyEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Dataset: TDataset);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsFilterRecordEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(DataSet: TDataSet; var Accept: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsFieldGetTextEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TField; var Text: String; DisplayText: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TfsDatasetNotifyEvent }
+
+procedure TfsDatasetNotifyEvent.DoEvent(Dataset: TDataset);
+begin
+ CallHandler([Dataset]);
+end;
+
+function TfsDatasetNotifyEvent.GetMethod: Pointer;
+begin
+ Result := @TfsDatasetNotifyEvent.DoEvent;
+end;
+
+
+{ TfsFilterRecordEvent }
+
+procedure TfsFilterRecordEvent.DoEvent(DataSet: TDataSet; var Accept: Boolean);
+begin
+ CallHandler([DataSet, Accept]);
+ Accept := Handler.Params[1].Value;
+end;
+
+function TfsFilterRecordEvent.GetMethod: Pointer;
+begin
+ Result := @TfsFilterRecordEvent.DoEvent;
+end;
+
+
+{ TfsFieldGetTextEvent }
+
+procedure TfsFieldGetTextEvent.DoEvent(Sender: TField; var Text: String; DisplayText: Boolean);
+begin
+ CallHandler([Sender, Text, DisplayText]);
+ Text := Handler.Params[1].Value;
+end;
+
+function TfsFieldGetTextEvent.GetMethod: Pointer;
+begin
+ Result := @TfsFieldGetTextEvent.DoEvent;
+end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TFieldType', 'ftUnknown, ftString, ftSmallint, ftInteger, ftWord,' +
+ 'ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,' +
+ 'ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,' +
+ 'ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString,' +
+ 'ftLargeint, ftADT, ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob,' +
+ 'ftVariant, ftInterface, ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd');
+ AddEnum('TBlobStreamMode', 'bmRead, bmWrite, bmReadWrite');
+ AddEnumSet('TLocateOptions', 'loCaseInsensitive, loPartialKey');
+ AddEnumSet('TFilterOptions', 'foCaseInsensitive, foNoPartialCompare');
+ AddEnum('TParamType', 'ptUnknown, ptInput, ptOutput, ptInputOutput, ptResult');
+
+ with AddClass(TField, 'TComponent') do
+ begin
+ AddProperty('AsBoolean', 'Boolean', GetProp, SetProp);
+ AddProperty('AsCurrency', 'Currency', GetProp, SetProp);
+ AddProperty('AsDateTime', 'TDateTime', GetProp, SetProp);
+ AddProperty('AsFloat', 'Double', GetProp, SetProp);
+ AddProperty('AsInteger', 'Integer', GetProp, SetProp);
+ AddProperty('AsString', 'String', GetProp, SetProp);
+ AddProperty('AsVariant', 'Variant', GetProp, SetProp);
+ AddProperty('DataType', 'TFieldType', GetProp, nil);
+ AddProperty('DisplayName', 'String', GetProp, nil);
+ AddProperty('DisplayText', 'String', GetProp, nil);
+ AddProperty('IsNull', 'Boolean', GetProp, nil);
+ AddProperty('Size', 'Integer', GetProp, SetProp);
+ AddProperty('Value', 'Variant', GetProp, SetProp);
+ AddProperty('OldValue', 'Variant', GetProp, nil);
+ AddEvent('OnGetText', TfsFieldGetTextEvent);
+ end;
+ with AddClass(TFields, 'TObject') do
+ AddDefaultProperty('Fields', 'Integer', 'TField', CallMethod, True);
+ AddClass(TStringField, 'TField');
+ AddClass(TNumericField, 'TField');
+ AddClass(TIntegerField, 'TNumericField');
+ AddClass(TSmallIntField, 'TIntegerField');
+ AddClass(TWordField, 'TIntegerField');
+ AddClass(TAutoIncField, 'TIntegerField');
+ AddClass(TFloatField, 'TNumericField');
+ AddClass(TCurrencyField, 'TFloatField');
+ AddClass(TBooleanField, 'TField');
+ AddClass(TDateTimeField, 'TField');
+ AddClass(TDateField, 'TDateTimeField');
+ AddClass(TTimeField, 'TDateTimeField');
+ AddClass(TBinaryField, 'TField');
+ AddClass(TBytesField, 'TBinaryField');
+ AddClass(TVarBytesField, 'TBinaryField');
+ AddClass(TBCDField, 'TNumericField');
+ with AddClass(TBlobField, 'TField') do
+ begin
+ AddMethod('procedure LoadFromFile(const FileName: String)', CallMethod);
+ AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure SaveToFile(const FileName: String)', CallMethod);
+ AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
+ end;
+ AddClass(TMemoField, 'TBlobField');
+ AddClass(TGraphicField, 'TBlobField');
+ AddClass(TFieldDef, 'TPersistent');
+ with AddClass(TFieldDefs, 'TObject') do
+ begin
+ AddMethod('function AddFieldDef: TFieldDef', CallMethod);
+ AddMethod('function Find(const Name: string): TFieldDef', CallMethod);
+ AddMethod('procedure Add(const Name: string; DataType: TFieldType; Size: Word; Required: Boolean)', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure Update', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TFieldDef', CallMethod, True);
+ end;
+ AddClass(TDataSource, 'TComponent');
+ AddType('TBookmark', fvtVariant);
+ with AddClass(TDataSet, 'TComponent') do
+ begin
+ AddMethod('procedure Open', CallMethod);
+ AddMethod('procedure Close', CallMethod);
+ AddMethod('procedure First', CallMethod);
+ AddMethod('procedure Last', CallMethod);
+ AddMethod('procedure Next', CallMethod);
+ AddMethod('procedure Prior', CallMethod);
+ AddMethod('procedure Cancel', CallMethod);
+ AddMethod('procedure Delete', CallMethod);
+ AddMethod('procedure Post', CallMethod);
+ AddMethod('procedure Append', CallMethod);
+ AddMethod('procedure Insert', CallMethod);
+ AddMethod('procedure Edit', CallMethod);
+
+ AddMethod('function FieldByName(const FieldName: string): TField', CallMethod);
+ AddMethod('procedure GetFieldNames(List: TStrings)', CallMethod);
+ AddMethod('function FindFirst: Boolean', CallMethod);
+ AddMethod('function FindLast: Boolean', CallMethod);
+ AddMethod('function FindNext: Boolean', CallMethod);
+ AddMethod('function FindPrior: Boolean', CallMethod);
+ AddMethod('procedure FreeBookmark(Bookmark: TBookmark)', CallMethod);
+ AddMethod('function GetBookmark: TBookmark', CallMethod);
+ AddMethod('procedure GotoBookmark(Bookmark: TBookmark)', CallMethod);
+ AddMethod('function Locate(const KeyFields: string; const KeyValues: Variant;' +
+ 'Options: TLocateOptions): Boolean', CallMethod);
+ AddMethod('function IsEmpty: Boolean', CallMethod);
+ AddMethod('procedure EnableControls', CallMethod);
+ AddMethod('procedure DisableControls', CallMethod);
+
+ AddProperty('Bof', 'Boolean', GetProp, nil);
+ AddProperty('Eof', 'Boolean', GetProp, nil);
+ AddProperty('FieldCount', 'Integer', GetProp, nil);
+ AddProperty('FieldDefs', 'TFieldDefs', GetProp, nil);
+ AddProperty('Fields', 'TFields', GetProp, nil);
+ AddProperty('Filter', 'string', GetProp, SetProp);
+ AddProperty('Filtered', 'Boolean', GetProp, SetProp);
+ AddProperty('FilterOptions', 'TFilterOptions', GetProp, SetProp);
+ AddProperty('Active', 'Boolean', GetProp, SetProp);
+
+ AddEvent('BeforeOpen', TfsDatasetNotifyEvent);
+ AddEvent('AfterOpen', TfsDatasetNotifyEvent);
+ AddEvent('BeforeClose', TfsDatasetNotifyEvent);
+ AddEvent('AfterClose', TfsDatasetNotifyEvent);
+ AddEvent('BeforeInsert', TfsDatasetNotifyEvent);
+ AddEvent('AfterInsert', TfsDatasetNotifyEvent);
+ AddEvent('BeforeEdit', TfsDatasetNotifyEvent);
+ AddEvent('AfterEdit', TfsDatasetNotifyEvent);
+ AddEvent('BeforePost', TfsDatasetNotifyEvent);
+ AddEvent('AfterPost', TfsDatasetNotifyEvent);
+ AddEvent('BeforeCancel', TfsDatasetNotifyEvent);
+ AddEvent('AfterCancel', TfsDatasetNotifyEvent);
+ AddEvent('BeforeDelete', TfsDatasetNotifyEvent);
+ AddEvent('AfterDelete', TfsDatasetNotifyEvent);
+ AddEvent('BeforeScroll', TfsDatasetNotifyEvent);
+ AddEvent('AfterScroll', TfsDatasetNotifyEvent);
+ AddEvent('OnCalcFields', TfsDatasetNotifyEvent);
+ AddEvent('OnFilterRecord', TfsFilterRecordEvent);
+ AddEvent('OnNewRecord', TfsDatasetNotifyEvent);
+ end;
+
+ with AddClass(TParam, 'TPersistent') do
+ begin
+ AddMethod('procedure Clear', CallMethod);
+ AddProperty('AsBoolean', 'Boolean', GetProp, SetProp);
+ AddProperty('AsCurrency', 'Currency', GetProp, SetProp);
+ AddProperty('AsDateTime', 'TDateTime', GetProp, SetProp);
+ AddProperty('AsFloat', 'Double', GetProp, SetProp);
+ AddProperty('AsInteger', 'Integer', GetProp, SetProp);
+ AddProperty('AsDate', 'TDate', GetProp, SetProp);
+ AddProperty('AsTime', 'TTime', GetProp, SetProp);
+ AddProperty('AsString', 'String', GetProp, SetProp);
+ AddProperty('Bound', 'Boolean', GetProp, SetProp);
+ AddProperty('IsNull', 'Boolean', GetProp, nil);
+ AddProperty('Text', 'String', GetProp, SetProp);
+ end;
+ with AddClass(TParams, 'TPersistent') do
+ begin
+ AddMethod('function ParamByName(const Value: string): TParam', CallMethod);
+ AddMethod('function FindParam(const Value: string): TParam', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TParam', CallMethod, True);
+ end;
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ _TDataSet: TDataSet;
+
+ function IntToLocateOptions(i: Integer): TLocateOptions;
+ begin
+ Result := [];
+ if (i and 1) <> 0 then
+ Result := Result + [loCaseInsensitive];
+ if (i and 2) <> 0 then
+ Result := Result + [loPartialKey];
+ end;
+
+begin
+ Result := 0;
+
+ if ClassType = TFields then
+ begin
+ if MethodName = 'FIELDS.GET' then
+ Result := frxInteger(TFields(Instance)[Caller.Params[0]])
+ end
+ else if ClassType = TFieldDefs then
+ begin
+ if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TFieldDefs(Instance)[Caller.Params[0]])
+ else if MethodName = 'ADD' then
+ TFieldDefs(Instance).Add(Caller.Params[0], TFieldType(Caller.Params[1]), Caller.Params[2], Caller.Params[3])
+ else if MethodName = 'ADDFIELDDEF' then
+ Result := frxInteger(TFieldDefs(Instance).AddFieldDef)
+ else if MethodName = 'CLEAR' then
+ TFieldDefs(Instance).Clear
+ else if MethodName = 'FIND' then
+ Result := frxInteger(TFieldDefs(Instance).Find(Caller.Params[0]))
+ else if MethodName = 'UPDATE' then
+ TFieldDefs(Instance).Update
+ end
+ else if ClassType = TBlobField then
+ begin
+ if MethodName = 'LOADFROMFILE' then
+ TBlobField(Instance).LoadFromFile(Caller.Params[0])
+ else if MethodName = 'LOADFROMSTREAM' then
+ TBlobField(Instance).LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVETOFILE' then
+ TBlobField(Instance).SaveToFile(Caller.Params[0])
+ else if MethodName = 'SAVETOSTREAM' then
+ TBlobField(Instance).SaveToStream(TStream(frxInteger(Caller.Params[0])))
+ end
+ else if ClassType = TDataSet then
+ begin
+ _TDataSet := TDataSet(Instance);
+ if MethodName = 'OPEN' then
+ _TDataSet.Open
+ else if MethodName = 'CLOSE' then
+ _TDataSet.Close
+ else if MethodName = 'FIRST' then
+ _TDataSet.First
+ else if MethodName = 'LAST' then
+ _TDataSet.Last
+ else if MethodName = 'NEXT' then
+ _TDataSet.Next
+ else if MethodName = 'PRIOR' then
+ _TDataSet.Prior
+ else if MethodName = 'CANCEL' then
+ _TDataSet.Cancel
+ else if MethodName = 'DELETE' then
+ _TDataSet.Delete
+ else if MethodName = 'POST' then
+ _TDataSet.Post
+ else if MethodName = 'APPEND' then
+ _TDataSet.Append
+ else if MethodName = 'INSERT' then
+ _TDataSet.Insert
+ else if MethodName = 'EDIT' then
+ _TDataSet.Edit
+ else if MethodName = 'FIELDBYNAME' then
+ Result := frxInteger(_TDataSet.FieldByName(Caller.Params[0]))
+ else if MethodName = 'GETFIELDNAMES' then
+ _TDataSet.GetFieldNames(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'FINDFIRST' then
+ Result := _TDataSet.FindFirst
+ else if MethodName = 'FINDLAST' then
+ Result := _TDataSet.FindLast
+ else if MethodName = 'FINDNEXT' then
+ Result := _TDataSet.FindNext
+ else if MethodName = 'FINDPRIOR' then
+ Result := _TDataSet.FindPrior
+ else if MethodName = 'FREEBOOKMARK' then
+ _TDataSet.FreeBookmark(TBookMark(frxInteger(Caller.Params[0])))
+{$IFNDEF CPUX64}
+ else if MethodName = 'GETBOOKMARK' then
+ Result := frxInteger(_TDataSet.GetBookmark)
+{$ENDIF}
+ else if MethodName = 'GOTOBOOKMARK' then
+ _TDataSet.GotoBookmark(TBookMark(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LOCATE' then
+ Result := _TDataSet.Locate(Caller.Params[0], Caller.Params[1], IntToLocateOptions(Caller.Params[2]))
+ else if MethodName = 'ISEMPTY' then
+ Result := _TDataSet.IsEmpty
+ else if MethodName = 'ENABLECONTROLS' then
+ _TDataSet.EnableControls
+ else if MethodName = 'DISABLECONTROLS' then
+ _TDataSet.DisableControls
+ end
+ else if ClassType = TParam then
+ begin
+ if MethodName = 'CLEAR' then
+ TParam(Instance).Clear
+ end
+ else if ClassType = TParams then
+ begin
+ if MethodName = 'PARAMBYNAME' then
+ Result := frxInteger(TParams(Instance).ParamByName(Caller.Params[0]))
+ else if MethodName = 'FINDPARAM' then
+ Result := frxInteger(TParams(Instance).FindParam(Caller.Params[0]))
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TParams(Instance)[Caller.Params[0]])
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+var
+ _TField: TField;
+ _TParam: TParam;
+ _TDataSet: TDataSet;
+
+ function FilterOptionsToInt(f: TFilterOptions): Integer;
+ begin
+ Result := 0;
+ if foCaseInsensitive in f then
+ Result := Result or 1;
+ if foNoPartialCompare in f then
+ Result := Result or 2;
+ end;
+
+begin
+ Result := 0;
+
+ if ClassType = TField then
+ begin
+ _TField := TField(Instance);
+ if PropName = 'ASBOOLEAN' then
+ Result := _TField.AsBoolean
+ else if PropName = 'ASCURRENCY' then
+ Result := _TField.AsCurrency
+ else if PropName = 'ASDATETIME' then
+ Result := _TField.AsDateTime
+ else if PropName = 'ASFLOAT' then
+ Result := _TField.AsFloat
+ else if PropName = 'ASINTEGER' then
+ Result := _TField.AsInteger
+ else if PropName = 'ASSTRING' then
+ Result := _TField.AsString
+ else if PropName = 'ASVARIANT' then
+ Result := _TField.AsVariant
+ else if PropName = 'DATATYPE' then
+ Result := _TField.DataType
+ else if PropName = 'DISPLAYNAME' then
+ Result := _TField.DisplayName
+ else if PropName = 'DISPLAYTEXT' then
+ Result := _TField.DisplayText
+ else if PropName = 'ISNULL' then
+ Result := _TField.IsNull
+ else if PropName = 'SIZE' then
+ Result := _TField.Size
+ else if PropName = 'VALUE' then
+ Result := _TField.Value
+ else if PropName = 'OLDVALUE' then
+ Result := _TField.OldValue
+ end
+ else if ClassType = TDataSet then
+ begin
+ _TDataSet := TDataSet(Instance);
+ if PropName = 'BOF' then
+ Result := _TDataSet.Bof
+ else if PropName = 'EOF' then
+ Result := _TDataSet.Eof
+ else if PropName = 'FIELDCOUNT' then
+ Result := _TDataSet.FieldCount
+ else if PropName = 'FIELDDEFS' then
+ Result := frxInteger(_TDataSet.FieldDefs)
+ else if PropName = 'FIELDS' then
+ Result := frxInteger(_TDataSet.Fields)
+ else if PropName = 'FILTER' then
+ Result := _TDataSet.Filter
+ else if PropName = 'FILTERED' then
+ Result := _TDataSet.Filtered
+ else if PropName = 'FILTEROPTIONS' then
+ Result := FilterOptionsToInt(_TDataSet.FilterOptions)
+ else if PropName = 'ACTIVE' then
+ Result := _TDataSet.Active
+ end
+ else if ClassType = TParam then
+ begin
+ _TParam := TParam(Instance);
+ if PropName = 'BOUND' then
+ Result := _TParam.Bound
+ else if PropName = 'ISNULL' then
+ Result := _TParam.IsNull
+ else if PropName = 'TEXT' then
+ Result := _TParam.Text
+ else if PropName = 'ASBOOLEAN' then
+ Result := _TParam.AsBoolean
+ else if PropName = 'ASCURRENCY' then
+ Result := _TParam.AsCurrency
+ else if PropName = 'ASDATETIME' then
+ Result := _TParam.AsDateTime
+ else if PropName = 'ASFLOAT' then
+ Result := _TParam.AsFloat
+ else if PropName = 'ASINTEGER' then
+ Result := _TParam.AsInteger
+ else if PropName = 'ASDATE' then
+ Result := _TParam.AsDate
+ else if PropName = 'ASTIME' then
+ Result := _TParam.AsTime
+ else if PropName = 'ASSTRING' then
+ Result := _TParam.AsString
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+var
+ _TField: TField;
+ _TParam: TParam;
+ _TDataSet: TDataSet;
+
+ function IntToFilterOptions(i: Integer): TFilterOptions;
+ begin
+ Result := [];
+ if (i and 1) <> 0 then
+ Result := Result + [foCaseInsensitive];
+ if (i and 2) <> 0 then
+ Result := Result + [foNoPartialCompare];
+ end;
+
+begin
+ if ClassType = TField then
+ begin
+ _TField := TField(Instance);
+ if PropName = 'ASBOOLEAN' then
+ _TField.AsBoolean := Value
+ else if PropName = 'ASCURRENCY' then
+ _TField.AsCurrency := Value
+ else if PropName = 'ASDATETIME' then
+ _TField.AsDateTime := Value
+ else if PropName = 'ASFLOAT' then
+ _TField.AsFloat := Value
+ else if PropName = 'ASINTEGER' then
+ _TField.AsInteger := Value
+ else if PropName = 'ASSTRING' then
+ _TField.AsString := Value
+ else if PropName = 'ASVARIANT' then
+ _TField.AsVariant := Value
+ else if PropName = 'VALUE' then
+ _TField.Value := Value
+ else if PropName = 'SIZE' then
+ _TField.Size := Value
+ end
+ else if ClassType = TDataSet then
+ begin
+ _TDataSet := TDataSet(Instance);
+ if PropName = 'FILTER' then
+ _TDataSet.Filter := Value
+ else if PropName = 'FILTERED' then
+ _TDataSet.Filtered := Value
+ else if PropName = 'FILTEROPTIONS' then
+ _TDataSet.FilterOptions := IntToFilterOptions(Value)
+ else if PropName = 'ACTIVE' then
+ _TDataSet.Active := Value
+ end
+ else if ClassType = TParam then
+ begin
+ _TParam := TParam(Instance);
+ if PropName = 'ASBOOLEAN' then
+ _TParam.AsBoolean := Value
+ else if PropName = 'ASCURRENCY' then
+ _TParam.AsCurrency := Value
+ else if PropName = 'ASDATETIME' then
+ _TParam.AsDateTime := Value
+ else if PropName = 'ASFLOAT' then
+ _TParam.AsFloat := Value
+ else if PropName = 'ASINTEGER' then
+ _TParam.AsInteger := Value
+ else if PropName = 'ASDATE' then
+ _TParam.AsDate := Value
+ else if PropName = 'ASTIME' then
+ _TParam.AsTime := Value
+ else if PropName = 'ASSTRING' then
+ _TParam.AsString := Value
+ else if PropName = 'BOUND' then
+ _TParam.Bound := Value
+ else if PropName = 'TEXT' then
+ _TParam.Text := Value
+ end
+end;
+
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsDBRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/FMX/FMX.fs_idialogsrtti.pas b/FastScript/FMX/FMX.fs_idialogsrtti.pas
new file mode 100644
index 0000000..0d12fba
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_idialogsrtti.pas
@@ -0,0 +1,133 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Dialogs.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_idialogsrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_iclassesrtti, FMX.Types
+, FMX.Dialogs, System.UITypes, System.Types
+{$IFDEF DELPHI19}
+, FMX.Printer
+{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsDialogsRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ THackDialog = class(TCommonDialog);
+
+
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+type
+ TWordSet = set of 0..15;
+ PWordSet = ^TWordSet;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+var
+ dlg: String;
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnumSet('TOpenOptions', 'ofReadOnly, ofOverwritePrompt, ofHideReadOnly,' +
+ 'ofNoChangeDir, ofShowHelp, ofNoValidate, ofAllowMultiSelect,' +
+ 'ofExtensionDifferent, ofPathMustExist, ofFileMustExist, ofCreatePrompt,' +
+ 'ofShareAware, ofNoReadOnlyReturn, ofNoTestFileCreate, ofNoNetworkButton,' +
+ 'ofNoLongNames, ofOldStyleDialog, ofNoDereferenceLinks, ofEnableIncludeNotify,' +
+ 'ofEnableSizing');
+ AddEnum('TFileEditStyle', 'fsEdit, fsComboBox');
+ AddEnumSet('TColorDialogOptions', 'cdFullOpen, cdPreventFullOpen, cdShowHelp,' +
+ 'cdSolidColor, cdAnyColor');
+ AddEnumSet('TFontDialogOptions', 'fdAnsiOnly, fdTrueTypeOnly, fdEffects,' +
+ 'fdFixedPitchOnly, fdForceFontExist, fdNoFaceSel, fdNoOEMFonts,' +
+ 'fdNoSimulations, fdNoSizeSel, fdNoStyleSel, fdNoVectorFonts,' +
+ 'fdShowHelp, fdWysiwyg, fdLimitSize, fdScalableOnly, fdApplyButton');
+ AddEnum('TFontDialogDevice', 'fdScreen, fdPrinter, fdBoth');
+ AddEnum('TPrintRange', 'prAllPages, prSelection, prPageNums');
+ AddEnumSet('TPrintDialogOptions', 'poPrintToFile, poPageNums, poSelection,' +
+ 'poWarning, poHelp, poDisablePrintToFile');
+ AddEnum('TMsgDlgType', 'mtCustom, mtInformation, mtWarning, mtError, mtConfirmation');
+ AddEnumSet('TMsgDlgButtons', 'mbNone, mbOk, mbCancel, mbYes, mbNo, mbAbort, ' +
+ 'mbRetry, mbIgnore');
+
+
+ with AddClass(TCommonDialog, 'TComponent') do
+ AddMethod('function Execute: Boolean', CallMethod);
+ AddClass(TOpenDialog, 'TCommonDialog');
+ AddClass(TSaveDialog, 'TCommonDialog');
+ AddClass(TPrintDialog, dlg);
+ AddClass(TPrinterSetupDialog, dlg);
+
+ AddMethod('function MessageDlg(Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer', CallMethod, 'ctOther');
+ AddMethod('function InputBox(ACaption, APrompt, ADefault: string): string', CallMethod, 'ctOther');
+ AddMethod('function InputQuery(ACaption, APrompt: string; var Value: string): Boolean', CallMethod, 'ctOther');
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ s: String;
+ b: TMsgDlgButtons;
+begin
+ Result := 0;
+
+ if ClassType = TCommonDialog then
+ begin
+ if MethodName = 'EXECUTE' then
+ Result := THackDialog(Instance).Execute
+ end
+ else if MethodName = 'INPUTBOX' then
+ Result := InputBox(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'INPUTQUERY' then
+ begin
+ s := Caller.Params[2];
+ Result := InputQuery(Caller.Params[0], Caller.Params[1], s);
+ Caller.Params[2] := s;
+ end
+ else if MethodName = 'MESSAGEDLG' then
+ begin
+ Word(PWordSet(@b)^) := Caller.Params[2];
+ Result := MessageDlg(Caller.Params[0], Caller.Params[1], b, Caller.Params[3]);
+ end
+end;
+
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsDialogsRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
\ No newline at end of file
diff --git a/FastScript/FMX/FMX.fs_idisp.pas b/FastScript/FMX/FMX.fs_idisp.pas
new file mode 100644
index 0000000..3ce8fda
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_idisp.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ OLE dispatch module }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_idisp;
+{$i FMX.inc}
+{$i fs_idisp.pas}
\ No newline at end of file
diff --git a/FastScript/FMX/FMX.fs_ievents.pas b/FastScript/FMX/FMX.fs_ievents.pas
new file mode 100644
index 0000000..2d6981e
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_ievents.pas
@@ -0,0 +1,379 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Standard events }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_ievents;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Controls, FMX.Forms, System.UITypes, FMX.Types,
+ System.Types, System.Rtti, FMX.fs_iinterpreter, FMX.fs_iclassesrtti
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+type
+
+ PDragObject = ^TDragObject;
+ TfsDragObject = class(TPersistent)
+ private
+ FDragObject: TDragObject;
+ FFiles: TStringList;
+ function GetStringList: TStringList;
+ public
+ function GetRect: TDragObject;
+ function GetRectP: PDragObject;
+ constructor Create(aDragObj: TDragObject);
+ destructor Destroy; override;
+ published
+ property Source: TObject read FDragObject.Source write FDragObject.Source;
+ property Data: {$IFDEF Delphi17}TValue{$ELSE}Variant{$ENDIF} read FDragObject.Data write FDragObject.Data;
+ property Files: TStringList read GetStringList;
+ end;
+
+ TfsNotifyEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsMouseEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Single);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsMouseMoveEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; Shift: TShiftState; X, Y: Single);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsMouseWheelEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsOnPaintEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsCanFocusEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var ACanFocus: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsDragOverEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; const Data: TDragObject; const Point: TPointF; var Accept: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsDragDropEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsKeyEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsKeyPressEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var Key: Char);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsCloseEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var Action: TCloseAction);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsCloseQueryEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var CanClose: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsCanResizeEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var NewWidth, NewHeight: Integer;
+ var Resize: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+
+implementation
+
+
+type
+ TByteSet = set of 0..7;
+ PByteSet = ^TByteSet;
+
+
+{ TfsNotifyEvent }
+
+procedure TfsNotifyEvent.DoEvent(Sender: TObject);
+begin
+ CallHandler([Sender]);
+end;
+
+function TfsNotifyEvent.GetMethod: Pointer;
+begin
+ Result := @TfsNotifyEvent.DoEvent;
+end;
+
+{ TfsMouseEvent }
+
+procedure TfsMouseEvent.DoEvent(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Single);
+var
+ b: Byte;
+begin
+ b := Byte(PByteSet(@Shift)^);
+ CallHandler([Sender, Integer(Button), b, X, Y]);
+end;
+
+function TfsMouseEvent.GetMethod: Pointer;
+begin
+ Result := @TfsMouseEvent.DoEvent;
+end;
+
+{ TfsMouseMoveEvent }
+
+procedure TfsMouseMoveEvent.DoEvent(Sender: TObject; Shift: TShiftState; X,
+ Y: Single);
+var
+ b: Byte;
+begin
+ b := Byte(PByteSet(@Shift)^);
+ CallHandler([Sender, b, X, Y]);
+end;
+
+function TfsMouseMoveEvent.GetMethod: Pointer;
+begin
+ Result := @TfsMouseMoveEvent.DoEvent;
+end;
+
+{ TfsKeyEvent }
+
+procedure TfsKeyEvent.DoEvent(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+var
+ b: Byte;
+begin
+ b := Byte(PByteSet(@Shift)^);
+ CallHandler([Sender, Key, KeyChar, b]);
+ Key := Handler.Params[1].Value;
+ KeyChar := WideChar(Cardinal(Handler.Params[2].Value));
+end;
+
+function TfsKeyEvent.GetMethod: Pointer;
+begin
+ Result := @TfsKeyEvent.DoEvent;
+end;
+
+{ TfsKeyPressEvent }
+
+procedure TfsKeyPressEvent.DoEvent(Sender: TObject; var Key: Char);
+begin
+ CallHandler([Sender, Key]);
+ Key := String(Handler.Params[1].Value)[1];
+end;
+
+function TfsKeyPressEvent.GetMethod: Pointer;
+begin
+ Result := @TfsKeyPressEvent.DoEvent;
+end;
+
+{ TfsCloseEvent }
+
+procedure TfsCloseEvent.DoEvent(Sender: TObject; var Action: TCloseAction);
+begin
+ CallHandler([Sender, Integer(Action)]);
+ Action := Handler.Params[1].Value;
+end;
+
+function TfsCloseEvent.GetMethod: Pointer;
+begin
+ Result := @TfsCloseEvent.DoEvent;
+end;
+
+{ TfsCloseQueryEvent }
+
+procedure TfsCloseQueryEvent.DoEvent(Sender: TObject; var CanClose: Boolean);
+begin
+ CallHandler([Sender, CanClose]);
+ CanClose := Handler.Params[1].Value;
+end;
+
+function TfsCloseQueryEvent.GetMethod: Pointer;
+begin
+ Result := @TfsCloseQueryEvent.DoEvent;
+end;
+
+{ TfsCanResizeEvent }
+
+procedure TfsCanResizeEvent.DoEvent(Sender: TObject; var NewWidth,
+ NewHeight: Integer; var Resize: Boolean);
+begin
+ CallHandler([Sender, NewWidth, NewHeight, Resize]);
+ NewWidth := Handler.Params[1].Value;
+ NewHeight := Handler.Params[2].Value;
+ Resize := Handler.Params[3].Value;
+end;
+
+function TfsCanResizeEvent.GetMethod: Pointer;
+begin
+ Result := @TfsCanResizeEvent.DoEvent;
+end;
+
+{ TfsMouseWheelEvent }
+
+procedure TfsMouseWheelEvent.DoEvent(Sender: TObject;
+ Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
+var
+ b: Byte;
+begin
+ b := Byte(PByteSet(@Shift)^);
+ CallHandler([Sender, b, WheelDelta, Boolean(Handled)]);
+ Handled := Handler.Params[3].Value;
+end;
+
+function TfsMouseWheelEvent.GetMethod: Pointer;
+begin
+ Result := @TfsMouseWheelEvent.DoEvent;
+end;
+
+{ TfsOnPaintEvent }
+
+procedure TfsOnPaintEvent.DoEvent(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF);
+var
+ r: TfsRectF;
+begin
+ r := TfsRectF.Create(ARect);
+ CallHandler([Sender, Canvas, r]);
+ r.Free;
+end;
+
+function TfsOnPaintEvent.GetMethod: Pointer;
+begin
+ Result := @TfsOnPaintEvent.DoEvent;
+end;
+
+{ TfsCanFocusEvent }
+
+procedure TfsCanFocusEvent.DoEvent(Sender: TObject; var ACanFocus: Boolean);
+begin
+ CallHandler([Sender, ACanFocus]);
+ ACanFocus := Handler.Params[1].Value;
+end;
+
+function TfsCanFocusEvent.GetMethod: Pointer;
+begin
+ Result := @TfsCanFocusEvent.DoEvent;
+end;
+
+{ TfsDragOverEvent }
+
+procedure TfsDragOverEvent.DoEvent(Sender: TObject; const Data: TDragObject;
+ const Point: TPointF; var Accept: Boolean);
+var
+ dObj: TfsDragObject;
+begin
+ dObj := TfsDragObject.Create(Data);
+ CallHandler([Sender, dObj, Accept]);
+ dObj.Free;
+ Accept := Handler.Params[3].Value;
+end;
+
+function TfsDragOverEvent.GetMethod: Pointer;
+begin
+ Result := @TfsDragOverEvent.DoEvent;
+end;
+
+{ TfsDragObject }
+
+constructor TfsDragObject.Create(aDragObj: TDragObject);
+var
+ idx: Integer;
+begin
+ FFiles := TStringList.Create;
+ FDragObject.Source := aDragObj.Source;
+ FDragObject.Data := aDragObj.Data;
+ for idx := Low(FDragObject.Files) to High(FDragObject.Files) do
+ FFiles.Add(FDragObject.Files[idx]);
+end;
+
+destructor TfsDragObject.Destroy;
+begin
+ FFiles.Free;
+ inherited;
+end;
+
+function TfsDragObject.GetRect: TDragObject;
+var
+ idx: Integer;
+begin
+ SetLength(FDragObject.Files, FFiles.Count);
+ for idx := 0 to FFiles.Count - 1 do
+ FDragObject.Files[idx] := FFiles.Strings[idx];
+ Result := FDragObject;
+end;
+
+function TfsDragObject.GetRectP: PDragObject;
+var
+ idx: Integer;
+begin
+ SetLength(FDragObject.Files, FFiles.Count);
+ for idx := 0 to FFiles.Count - 1 do
+ FDragObject.Files[idx] := FFiles.Strings[idx];
+ Result := @FDragObject;
+end;
+
+function TfsDragObject.GetStringList: TStringList;
+begin
+ Result := FFiles;
+end;
+
+{ TfsDragDropEvent }
+
+procedure TfsDragDropEvent.DoEvent(Sender: TObject; const Data: TDragObject;
+ const Point: TPointF);
+var
+ dObj: TfsDragObject;
+ aPoint: TfsPointF;
+begin
+ dObj := TfsDragObject.Create(Data);
+ aPoint := TfsPointF.Create(Point);
+ CallHandler([Sender, dObj, aPoint]);
+ dObj.Free;
+ aPoint.Free;
+end;
+
+function TfsDragDropEvent.GetMethod: Pointer;
+begin
+ Result := @TfsDragDropEvent.DoEvent;
+end;
+
+end.
\ No newline at end of file
diff --git a/FastScript/FMX/FMX.fs_iexpression.pas b/FastScript/FMX/FMX.fs_iexpression.pas
new file mode 100644
index 0000000..f429d38
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_iexpression.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Expression parser }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iexpression;
+{$i FMX.inc}
+{$i fs_iexpression.pas}
\ No newline at end of file
diff --git a/FastScript/FMX/FMX.fs_iextctrlsrtti.pas b/FastScript/FMX/FMX.fs_iextctrlsrtti.pas
new file mode 100644
index 0000000..5bd17eb
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_iextctrlsrtti.pas
@@ -0,0 +1,268 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ ExtCtrls }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iextctrlsrtti;
+
+interface
+
+{$i fs.inc}
+
+uses System.Types, System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_ievents, FMX.fs_iformsrtti
+, FMX.ExtCtrls, FMX.ListBox, FMX.Objects, System.UITypes, FMX.Types, FMX.Controls, FMX.Layouts,
+ FMX.TabControl, FMX.TreeView
+{$IFDEF DELPHI18}
+ , FMX.StdCtrls
+{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsExtCtrlsRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TfsTreeViewDragChange = class(TfsCustomEvent)
+ public
+ procedure DoEvent(SourceItem, DestItem: TTreeViewItem; var Allow: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TShapeType', 'stRectangle, stSquare, stRoundRect, stRoundSquare,' +
+ 'stEllipse, stCircle');
+ AddEnum('TBevelStyle', 'bsLowered, bsRaised');
+ AddEnum('TBevelShape', 'bsBox, bsFrame, bsTopLine, bsBottomLine, bsLeftLine,' +
+ 'bsRightLine, bsSpacer');
+ AddEnum('TResizeStyle', 'rsNone, rsLine, rsUpdate, rsPattern');
+ AddEnum('TButtonLayout', 'blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom');
+ AddEnum('TButtonState', 'bsUp, bsDisabled, bsDown, bsExclusive');
+ AddEnum('TButtonStyle', 'bsAutoDetect, bsWin31, bsNew');
+ AddEnum('TBitBtnKind', 'bkCustom, bkOK, bkCancel, bkHelp, bkYes, bkNo,' +
+ 'bkClose, bkAbort, bkRetry, bkIgnore, bkAll');
+ AddType('TNumGlyphs', fvtInt);
+ AddEnum('TTabPosition', 'tpTop, tpBottom, tpLeft, tpRight');
+ AddEnum('TTabStyle', 'tsTabs, tsButtons, tsFlatButtons');
+ AddEnum('TStatusPanelStyle', 'psText, psOwnerDraw');
+ AddEnum('TStatusPanelBevel', 'pbNone, pbLowered, pbRaised');
+ AddEnum('TSortType', 'stNone, stData, stText, stBoth');
+ AddEnum('TTrackBarOrientation', 'trHorizontal, trVertical');
+ AddEnum('TTickMark', 'tmBottomRight, tmTopLeft, tmBoth');
+ AddEnum('TTickStyle', 'tsNone, tsAuto, tsManual');
+ AddEnum('TProgressBarOrientation', 'pbHorizontal, pbVertical');
+ AddEnum('TIconArrangement', 'iaTop, iaLeft');
+ AddEnum('TListArrangement', 'arAlignBottom, arAlignLeft, arAlignRight,' +
+ 'arAlignTop, arDefault, arSnapToGrid');
+ AddEnum('TViewStyle', 'vsIcon, vsSmallIcon, vsList, vsReport');
+ AddEnum('TToolButtonStyle', 'tbsButton, tbsCheck, tbsDropDown, tbsSeparator, tbsDivider');
+ AddEnum('TDateTimeKind', 'dtkDate, dtkTime');
+ AddEnum('TDTDateMode', 'dmComboBox, dmUpDown');
+ AddEnum('TDTDateFormat', 'dfShort, dfLong');
+ AddEnum('TDTCalAlignment', 'dtaLeft, dtaRight');
+ AddEnum('TCalDayOfWeek', 'dowMonday, dowTuesday, dowWednesday, dowThursday,' +
+ 'dowFriday, dowSaturday, dowSunday, dowLocaleDefault');
+
+
+ with AddClass(TPaintBox, 'TControl') do
+ AddEvent('OnPaint', TfsNotifyEvent);
+ AddClass(TImage, 'TControl');
+ with AddClass(TTimer, 'TComponent') do
+ AddEvent('OnTimer', TfsNotifyEvent);
+
+ AddClass(TTabItem, 'TTextControl');
+ with AddClass(TTabControl, 'TStyledControl') do
+ begin
+ AddIndexProperty( 'Tabs', 'Integer', 'TTabItem', CallMethod);
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddProperty('TabCount', 'Integer', GetProp, nil);
+ AddProperty('ActiveTab', 'TTabItem', GetProp, SetProp);
+ end;
+
+ with AddClass(TTreeViewItem, 'TTextControl') do
+ begin
+ AddMethod('function ItemByPoint(const X, Y: Single): TTreeViewItem', CallMethod);
+ AddMethod('function ItemByIndex(const Idx: Integer): TTreeViewItem', CallMethod);
+ AddMethod('function TreeView: TCustomTreeView', CallMethod);
+ AddMethod('function Level: Integer', CallMethod);
+ AddMethod('function ParentItem: TTreeViewItem', CallMethod);
+ AddIndexProperty( 'Items', 'Integer', 'TTreeViewItem', CallMethod);
+ AddProperty('GlobalIndex', 'Integer', GetProp, SetProp);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ end;
+ with AddClass(TTreeView, 'TScrollBox') do
+ begin
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure CollapseAll', CallMethod);
+ AddMethod('procedure ExpandAll', CallMethod);
+ AddMethod('function ItemByText(const AText: string): TTreeViewItem', CallMethod);
+ AddMethod('function ItemByPoint(const X, Y: Single): TTreeViewItem', CallMethod);
+ AddMethod('function ItemByIndex(const Idx: Integer): TTreeViewItem', CallMethod);
+ AddMethod('function ItemByGlobalIndex(const Idx: Integer): TTreeViewItem', CallMethod);
+ AddIndexProperty('Items', 'Integer', 'TTreeViewItem', CallMethod);
+ AddProperty('Selected', 'TTreeViewItem', GetProp, SetProp);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddProperty('GlobalCount', 'Integer', GetProp, nil);
+ AddProperty('CountExpanded', 'Integer', GetProp, nil);
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddEvent('OnChangeCheck', TfsNotifyEvent);
+ AddEvent('OnDragChange', TfsTreeViewDragChange);
+ end;
+
+ { TODO ADD necessary methods for these calasses }
+ //AddClass(TCalendar, 'TStyledControl');
+ //AddClass(TCalendarBox, 'TTextControl');
+ // AddClass(TCalendarEdit, 'TCustomEdit');
+ AddClass(TImageViewer, 'TScrollBox');
+ AddClass(TPlotGrid, 'TControl');
+ AddClass(TDropTarget, 'TTextControl');
+ AddClass(TCornerButton, 'TCustomButton');
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+ if ClassType = TTabControl then
+ begin
+ if MethodName = 'TABS.GET' then
+ Result := frxInteger(TTabControl(Instance).Tabs[Caller.Params[0]])
+ end
+ else if ClassType = TTreeViewItem then
+ begin
+ if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TTreeViewItem(Instance).Items[Caller.Params[0]])
+ else if MethodName = 'ITEMBYPOINT' then
+ Result := frxInteger(TTreeViewItem(Instance).ItemByPoint(Single(Caller.Params[0]), Single(Caller.Params[1])))
+ else if MethodName = 'ITEMBYINDEX' then
+ Result := frxInteger(TTreeViewItem(Instance).ItemByIndex(Caller.Params[0]))
+ else if MethodName = 'TREEVIEW' then
+ Result := frxInteger(TTreeViewItem(Instance).TreeView)
+ else if MethodName = 'LEVEL' then
+ Result := Integer(TTreeViewItem(Instance).Level)
+ else if MethodName = 'PARENTITEM' then
+ Result := frxInteger(TTreeViewItem(Instance).ParentItem)
+ end
+ else if ClassType = TTreeView then
+ begin
+ if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TTreeView(Instance).Items[Caller.Params[0]])
+ else if MethodName = 'ITEMBYPOINT' then
+ Result := frxInteger(TTreeView(Instance).ItemByPoint(Single(Caller.Params[0]), Single(Caller.Params[1])))
+ else if MethodName = 'ITEMBYINDEX' then
+ Result := frxInteger(TTreeView(Instance).ItemByIndex(Caller.Params[0]))
+ else if MethodName = 'ITEMBYTEXT' then
+ Result := frxInteger(TTreeView(Instance).ItemByText(String(Caller.Params[0])))
+ else if MethodName = 'ITEMBYGLOBALINDEX' then
+ Result := frxInteger(TTreeView(Instance).ItemByGlobalIndex(Caller.Params[0]))
+ else if MethodName = 'CLEAR' then
+ TTreeView(Instance).Clear
+ else if MethodName = 'COLLAPSEALL' then
+ TTreeView(Instance).CollapseAll
+ else if MethodName = 'EXPANDALL' then
+ TTreeView(Instance).ExpandAll
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+ if ClassType = TTabControl then
+ begin
+ if PropName = 'TABCOUNT' then
+ Result := TTabControl(Instance).TabCount
+ else if PropName = 'ACTIVETAB' then
+ Result := frxInteger(TTabControl(Instance).ActiveTab)
+ end
+ else if ClassType = TTreeViewItem then
+ begin
+ if PropName = 'GLOBALINDEX' then
+ Result := TTreeViewItem(Instance).GlobalIndex
+ else if PropName = 'COUNT' then
+ Result := TTreeViewItem(Instance).Count
+ end
+ else if ClassType = TTreeView then
+ begin
+ if PropName = 'SELECTED' then
+ Result := frxInteger(TTreeView(Instance).Selected)
+ else if PropName = 'COUNT' then
+ Result := TTreeView(Instance).Count
+ else if PropName = 'GLOBALCOUNT' then
+ Result := TTreeView(Instance).GlobalCount
+ else if PropName = 'COUNTEXPANDED' then
+ Result := TTreeView(Instance).CountExpanded
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TTabControl then
+ begin
+ if PropName = 'ACTIVETAB' then
+ TTabControl(Instance).ActiveTab := TTabItem(frxInteger(Value))
+ end
+ else if ClassType = TTreeViewItem then
+ begin
+// if PropName = 'GLOBALINDEX' then
+// TTreeViewItem(Instance).GlobalIndex := Value
+ end
+ else if ClassType = TTreeView then
+ begin
+ if PropName = 'SELECTED' then
+ TTreeView(Instance).Selected := TTreeViewItem(frxInteger(Value))
+ end
+end;
+
+{ TfsTreeViewDragChange }
+
+procedure TfsTreeViewDragChange.DoEvent(SourceItem, DestItem: TTreeViewItem;
+ var Allow: Boolean);
+begin
+ CallHandler([SourceItem, DestItem, Allow]);
+ Allow := Handler.Params[2].Value;
+end;
+
+function TfsTreeViewDragChange.GetMethod: Pointer;
+begin
+ Result := @TfsTreeViewDragChange.DoEvent;
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsExtCtrlsRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/FMX/FMX.fs_iformsrtti.pas b/FastScript/FMX/FMX.fs_iformsrtti.pas
new file mode 100644
index 0000000..28da4fa
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_iformsrtti.pas
@@ -0,0 +1,864 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Forms and StdCtrls }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iformsrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_ievents, FMX.fs_iclassesrtti,
+ FMX.fs_igraphicsrtti, FMX.Types, FMX.Controls, FMX.Forms, System.UITypes, System.Types,
+ FMX.Edit, FMX.Memo, FMX.ListBox, FMX.Layouts
+{$IFDEF DELPHI18}
+ , FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI29}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF}
+ ;
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsFormsRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddConst('mrNone', 'Integer', mrNone);
+ AddConst('mrOk', 'Integer', mrOk);
+ AddConst('mrCancel', 'Integer', mrCancel);
+ AddConst('mrAbort', 'Integer', mrAbort);
+ AddConst('mrRetry', 'Integer', mrRetry);
+ AddConst('mrIgnore', 'Integer', mrIgnore);
+ AddConst('mrYes', 'Integer', mrYes);
+ AddConst('mrNo', 'Integer', mrNo);
+ AddConst('mrAll', 'Integer', mrAll);
+ AddConst('mrNoToAll', 'Integer', mrNoToAll);
+ AddConst('mrYesToAll', 'Integer', mrYesToAll);
+
+ AddConst('crDefault', 'Integer', crDefault);
+ AddConst('crNone', 'Integer', crNone);
+ AddConst('crArrow', 'Integer', crArrow);
+ AddConst('crCross', 'Integer', crCross);
+ AddConst('crIBeam', 'Integer', crIBeam);
+ AddConst('crSize', 'Integer', crSize);
+ AddConst('crSizeNESW', 'Integer', crSizeNESW);
+ AddConst('crSizeNS', 'Integer', crSizeNS);
+ AddConst('crSizeNWSE', 'Integer', crSizeNWSE);
+ AddConst('crSizeWE', 'Integer', crSizeWE);
+ AddConst('crUpArrow', 'Integer', crUpArrow);
+ AddConst('crHourGlass', 'Integer', crHourGlass);
+ AddConst('crDrag', 'Integer', crDrag);
+ AddConst('crNoDrop', 'Integer', crNoDrop);
+ AddConst('crHSplit', 'Integer', crHSplit);
+ AddConst('crVSplit', 'Integer', crVSplit);
+ AddConst('crMultiDrag', 'Integer', crMultiDrag);
+ AddConst('crSQLWait', 'Integer', crSQLWait);
+ AddConst('crNo', 'Integer', crNo);
+ AddConst('crAppStart', 'Integer', crAppStart);
+ AddConst('crHelp', 'Integer', crHelp);
+ AddConst('crHandPoint', 'Integer', crHandPoint);
+ AddConst('crSizeAll', 'Integer', crSizeAll);
+
+{$IFDEF CLX}
+ AddConst('bsNone', 'Integer', fbsNone);
+ AddConst('bsSingle', 'Integer', fbsSingle);
+ AddConst('bsSizeable', 'Integer', fbsSizeable);
+ AddConst('bsDialog', 'Integer', fbsDialog);
+ AddConst('bsToolWindow', 'Integer', fbsToolWindow);
+ AddConst('bsSizeToolWin', 'Integer', fbsSizeToolWin);
+{$ELSE}
+ AddConst('bsNone', 'Integer', TFmxFormBorderStyle.bsNone);
+ AddConst('bsSingle', 'Integer', TFmxFormBorderStyle.bsSingle);
+ AddConst('bsSizeable', 'Integer', TFmxFormBorderStyle.bsSizeable);
+ AddConst('bsToolWindow', 'Integer', TFmxFormBorderStyle.bsToolWindow);
+ AddConst('bsSizeToolWin', 'Integer', TFmxFormBorderStyle.bsSizeToolWin);
+{$ENDIF}
+
+ AddConst('VK_RBUTTON', 'Integer', VKRBUTTON);
+ AddConst('VKCANCEL', 'Integer', VKCANCEL);
+ AddConst('VKMBUTTON', 'Integer', VKMBUTTON);
+ AddConst('VKBACK', 'Integer', VKBACK);//Backspace key
+ AddConst('VKTAB', 'Integer', VKTAB);//Tab key
+ AddConst('VKRETURN', 'Integer', VKRETURN);//Enter key
+ AddConst('VKSHIFT', 'Integer', VKSHIFT);//Shift key
+ AddConst('VKCONTROL', 'Integer', VKCONTROL);//Ctrl key
+ AddConst('VKMENU', 'Integer', VKMENU);//Alt key
+ AddConst('VKPAUSE', 'Integer', VKPAUSE);//Pause key
+ AddConst('VKCAPITAL', 'Integer', VKCAPITAL);//Caps Lock key
+ AddConst('VKESCAPE', 'Integer', VKESCAPE);//Esc key
+ AddConst('VKSPACE', 'Integer', VKSPACE);//Space bar
+ AddConst('VKPRIOR', 'Integer', VKPRIOR);//Page Up key
+ AddConst('VKNEXT', 'Integer', VKNEXT);// Page Down key
+ AddConst('VKEND', 'Integer', VKEND);// End key
+ AddConst('VKHOME', 'Integer', VKHOME);// Home key
+ AddConst('VKLEFT', 'Integer', VKLEFT);// Left Arrow key
+ AddConst('VKUP', 'Integer', VKUP);// Up Arrow key
+ AddConst('VKRIGHT', 'Integer', VKRIGHT);// Right Arrow key
+ AddConst('VKDOWN', 'Integer', VKDOWN);// Down Arrow key
+ AddConst('VKINSERT', 'Integer', VKINSERT);// Insert key
+ AddConst('VKDELETE', 'Integer', VKDELETE);// Delete key
+ AddConst('VKHELP', 'Integer', VKHELP);// Help key
+ AddConst('VKLWIN', 'Integer', VKLWIN);// Left Windows key (Microsoft keyboard)
+ AddConst('VKRWIN', 'Integer', VKRWIN);// Right Windows key (Microsoft keyboard)
+ AddConst('VKAPPS', 'Integer', VKAPPS);// Applications key (Microsoft keyboard)
+ AddConst('VKNUMPAD0', 'Integer', VKNUMPAD0);// 0 key (numeric keypad)
+ AddConst('VKNUMPAD1', 'Integer', VKNUMPAD1);// 1 key (numeric keypad)
+ AddConst('VKNUMPAD2', 'Integer', VKNUMPAD2);// 2 key (numeric keypad)
+ AddConst('VKNUMPAD3', 'Integer', VKNUMPAD3);// 3 key (numeric keypad)
+ AddConst('VKNUMPAD4', 'Integer', VKNUMPAD4);// 4 key (numeric keypad)
+ AddConst('VKNUMPAD5', 'Integer', VKNUMPAD5);// 5 key (numeric keypad)
+ AddConst('VKNUMPAD6', 'Integer', VKNUMPAD6);// 6 key (numeric keypad)
+ AddConst('VKNUMPAD7', 'Integer', VKNUMPAD7);// 7 key (numeric keypad)
+ AddConst('VKNUMPAD8', 'Integer', VKNUMPAD8);// 8 key (numeric keypad)
+ AddConst('VKNUMPAD9', 'Integer', VKNUMPAD9);// 9 key (numeric keypad)
+ AddConst('VKMULTIPLY', 'Integer', VKMULTIPLY);// Multiply key (numeric keypad)
+ AddConst('VKADD', 'Integer', VKADD);// Add key (numeric keypad)
+ AddConst('VKSEPARATOR', 'Integer', VKSEPARATOR);// Separator key (numeric keypad)
+ AddConst('VKSUBTRACT', 'Integer', VKSUBTRACT);// Subtract key (numeric keypad)
+ AddConst('VKDECIMAL', 'Integer', VKDECIMAL);// Decimal key (numeric keypad)
+ AddConst('VKDIVIDE', 'Integer', VKDIVIDE);// Divide key (numeric keypad)
+ AddConst('VKF1', 'Integer', VKF1);// F1 key
+ AddConst('VKF2', 'Integer', VKF2);// F2 key
+ AddConst('VKF3', 'Integer', VKF3);// F3 key
+ AddConst('VKF4', 'Integer', VKF4);// F4 key
+ AddConst('VKF5', 'Integer', VKF5);// F5 key
+ AddConst('VKF6', 'Integer', VKF6);// F6 key
+ AddConst('VKF7', 'Integer', VKF7);// F7 key
+ AddConst('VKF8', 'Integer', VKF8);// F8 key
+ AddConst('VKF9', 'Integer', VKF9);// F9 key
+ AddConst('VKF10', 'Integer', VKF10);// F10 key
+ AddConst('VKF11', 'Integer', VKF11);// F11 key
+ AddConst('VKF12', 'Integer', VKF12);// F12 key
+ AddConst('VKNUMLOCK', 'Integer', VKNUMLOCK);// Num Lock key
+ AddConst('VKSCROLL', 'Integer', VKSCROLL);// Scroll Lock key
+
+ AddConst('crDefault', 'Integer', crDefault);
+ AddConst('crNone', 'Integer', crNone);
+ AddConst('crArrow', 'Integer', crArrow);
+ AddConst('crCross', 'Integer', crCross);
+ AddConst('crIBeam', 'Integer', crIBeam);
+ AddConst('crSize', 'Integer', crSize);
+ AddConst('crSizeNESW', 'Integer', crSizeNESW);
+ AddConst('crSizeNS', 'Integer', crSizeNS);
+ AddConst('crSizeNWSE', 'Integer', crSizeNWSE);
+ AddConst('crSizeWE', 'Integer', crSizeWE);
+ AddConst('crUpArrow', 'Integer', crUpArrow);
+ AddConst('crHourGlass', 'Integer', crHourGlass);
+ AddConst('crDrag', 'Integer', crDrag);
+ AddConst('crNoDrop', 'Integer', crNoDrop);
+ AddConst('crHSplit', 'Integer', crHSplit);
+ AddConst('crVSplit', 'Integer', crVSplit);
+ AddConst('crMultiDrag', 'Integer', crMultiDrag);
+ AddConst('crSQLWait', 'Integer', crSQLWait);
+ AddConst('crNo', 'Integer', crNo);
+ AddConst('crAppStart', 'Integer', crAppStart);
+ AddConst('crHelp', 'Integer', crHelp);
+ AddConst('crHandPoint', 'Integer', crHandPoint);
+ AddConst('crSizeAll', 'Integer', crSizeAll);
+
+ AddType('TFormBorderStyle', fvtInt);
+ AddType('TBorderStyle', fvtInt);
+
+ AddEnumSet('TShiftState', 'ssShift, ssAlt, ssCtrl, ssLeft, ssRight, ssMiddle, ssDouble, ssTouch, ssPen, ssCommand');
+ AddEnum('TAniIndicatorStyle', 'aiLinear, aiCircular');
+ AddEnum('TAlign', 'alNone, alTop, alBottom, alLeft, alRight, alClient');
+ AddEnum('TMouseButton', 'mbLeft, mbRight, mbMiddle');
+ AddEnumSet('TAnchors', 'akLeft, akTop, akRight, akBottom');
+ AddEnum('TBevelCut', 'bvNone, bvLowered, bvRaised, bvSpace');
+ AddEnum('TTextLayout', 'tlTop, tlCenter, tlBottom');
+ AddEnum('TEditCharCase', 'ecNormal, ecUpperCase, ecLowerCase');
+ AddEnum('TScrollStyle', 'ssNone, ssHorizontal, ssVertical, ssBoth');
+ AddEnum('TComboBoxStyle', 'csDropDown, csSimple, csDropDownList, csOwnerDrawFixed, csOwnerDrawVariable');
+ AddEnum('TCheckBoxState', 'cbUnchecked, cbChecked, cbGrayed');
+ AddEnum('TListBoxStyle', 'lbStandard, lbOwnerDrawFixed, lbOwnerDrawVariable');
+ AddEnum('TWindowState', 'wsNormal, wsMinimized, wsMaximized');
+ AddEnum('TFormStyle', 'fsNormal, fsMDIChild, fsMDIForm, fsStayOnTop');
+ AddEnumSet('TBorderIcons', 'biSystemMenu, biMinimize, biMaximize, biHelp');
+ AddEnum('TFormPosition', 'poDesigned, poDefault, poDefaultPosOnly, poDefaultSizeOnly, poScreenCenter, poDesktopCenter');
+ AddEnum('TCloseAction', 'caNone, caHide, caFree, caMinimize');
+
+ with AddClass(TControl, 'TFmxObject') do
+ begin
+ AddMethod('procedure AddObject(AObject: TFmxObject)', CallMethod);
+ AddMethod('procedure RemoveObject(AObject: TFmxObject)', CallMethod);
+ AddMethod('procedure SetBounds(X: Single; Y: Single; AWidth: Single; AHeight: Single)', CallMethod);
+ AddMethod('function AbsoluteToLocal(P: TfsPointF): TfsPointF', CallMethod);
+ AddMethod('function LocalToAbsolute(P: TfsPointF): TfsPointF', CallMethod);
+ AddMethod('function AbsoluteToLocalVector(P: TfsVector): TfsVector', CallMethod);
+ AddMethod('function LocalToAbsoluteVector(P: TfsVector): TfsVector', CallMethod);
+ AddMethod('function PointInObject(X: Single; Y: Single): Boolean', CallMethod);
+ AddMethod('procedure BeginUpdate()', CallMethod);
+ AddMethod('procedure EndUpdate()', CallMethod);
+{$IFNDEF DELPHI18}
+ AddMethod('procedure ApplyEffect()', CallMethod);
+{$ENDIF}
+ AddMethod('procedure UpdateEffects()', CallMethod);
+ AddMethod('procedure SetFocus()', CallMethod);
+ AddMethod('procedure PaintTo(ACanvas: TCanvas; ARect: TFsRectF; AParent: TFmxObject)', CallMethod);
+ AddMethod('procedure Repaint()', CallMethod);
+ AddMethod('procedure InvalidateRect(ARect: TfsRectF)', CallMethod);
+ AddMethod('procedure Lock()', CallMethod);
+ AddProperty('AbsoluteMatrix', 'TfsMatrix', GetProp, nil);
+ AddProperty('AbsoluteOpacity', 'Single', GetProp, nil);
+ AddProperty('AbsoluteWidth', 'Single', GetProp, nil);
+ AddProperty('AbsoluteHeight', 'Single', GetProp, nil);
+ AddProperty('AbsoluteScale', 'TfsPointF', GetProp, nil);
+ AddProperty('AbsoluteEnabled', 'Boolean', GetProp, nil);
+ AddProperty('HasEffect', 'Boolean', GetProp, nil);
+ AddProperty('HasDisablePaintEffect', 'Boolean', GetProp, nil);
+ AddProperty('HasAfterPaintEffect', 'Boolean', GetProp, nil);
+ AddProperty('ChildrenRect', 'TfsRectF', GetProp, nil);
+ AddProperty('InvertAbsoluteMatrix', 'TfsMatrix', GetProp, nil);
+ AddProperty('InPaintTo', 'Boolean', GetProp, nil);
+ AddProperty('LocalRect', 'TfsRectF', GetProp, nil);
+ AddProperty('AbsoluteRect', 'TfsRectF', GetProp, nil);
+ AddProperty('UpdateRect', 'TfsRectF', GetProp, nil);
+ AddProperty('ParentedRect', 'TfsRectF', GetProp, nil);
+ AddProperty('ParentedVisible', 'Boolean', GetProp, nil);
+ AddProperty('ClipRect', 'TfsRectF', GetProp, nil);
+ AddProperty('Canvas', 'TCanvas', GetProp, nil);
+ AddProperty('AutoCapture', 'Boolean', GetProp, SetProp);
+ AddProperty('CanFocus', 'Boolean', GetProp, SetProp);
+ AddProperty('DisableFocusEffect', 'Boolean', GetProp, SetProp);
+ AddProperty('TabOrder', 'Integer', GetProp, SetProp);
+ AddProperty('BoundsRect', 'TfsRectF', GetProp, SetProp);
+ AddEvent('OnDragEnter', TfsDragDropEvent);
+ AddEvent('OnDragLeave', TfsNotifyEvent);
+ AddEvent('OnDragOver', TfsDragOverEvent);
+ AddEvent('OnDragDrop', TfsDragDropEvent);
+ AddEvent('OnDragEnd', TfsNotifyEvent);
+ AddEvent('OnKeyDown', TfsKeyEvent);
+ AddEvent('OnKeyUp', TfsKeyEvent);
+ AddEvent('OnClick', TfsNotifyEvent);
+ AddEvent('OnDblClick', TfsNotifyEvent);
+ AddEvent('OnCanFocus', TfsCanFocusEvent);
+ AddEvent('OnEnter', TfsNotifyEvent);
+ AddEvent('OnExit', TfsNotifyEvent);
+ AddEvent('OnMouseDown', TfsMouseEvent);
+ AddEvent('OnMouseMove', TfsMouseMoveEvent);
+ AddEvent('OnMouseUp', TfsMouseEvent);
+ AddEvent('OnMouseWheel', TfsMouseWheelEvent);
+ AddEvent('OnMouseEnter', TfsNotifyEvent);
+ AddEvent('OnMouseLeave', TfsNotifyEvent);
+ AddEvent('OnPainting', TfsOnPaintEvent);
+ AddEvent('OnPaint', TfsOnPaintEvent);
+ AddEvent('OnResize', TfsNotifyEvent);
+ AddEvent('OnApplyStyleLookup', TfsNotifyEvent);
+ end;
+
+ { standard controls }
+ with AddClass(TStyledControl, 'TControl') do
+ begin
+ AddMethod('function FindStyleResource(AStyleLookup: string): TFmxObject', CallMethod);
+ AddMethod('procedure ApplyStyleLookup()', CallMethod);
+{$IFNDEF DELPHI20}
+ AddMethod('procedure UpdateStyle()', CallMethod);
+{$ENDIF}
+ AddProperty('StyleLookup', 'String', GetProp, SetProp);
+ end;
+
+ AddClass(TStyledControl, 'TControl');
+ AddClass(TTextControl, 'TStyledControl');
+ AddClass(TPanel, 'TStyledControl');
+ AddClass(TCalloutPanel, 'TPanel');
+ AddClass(TLabel, 'TTextControl');
+ AddClass(TCustomButton, 'TTextControl');
+ AddClass(TButton, 'TCustomButton');
+ AddClass(TSpeedButton, 'TCustomButton');
+ with AddClass(TCheckBox, 'TTextControl') do
+ AddEvent('OnChange', TfsNotifyEvent);
+
+ with AddClass(TRadioButton, 'TTextControl') do
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddClass(TGroupBox, 'TTextControl');
+ AddClass(TStatusBar, 'TStyledControl');
+ AddClass(TToolBar, 'TStyledControl');
+ AddClass(TSizeGrip, 'TStyledControl');
+ AddClass(TSplitter, 'TStyledControl');
+ AddClass(TProgressBar, 'TStyledControl');
+ AddClass(TThumb, 'TStyledControl');
+ with AddClass(TCustomTrack, 'TStyledControl') do
+ begin
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddEvent('OnTracking', TfsNotifyEvent);
+ end;
+ AddClass(TTrack, 'TCustomTrack');
+ AddClass(TTrackBar, 'TCustomTrack');
+ AddClass(TBitmapTrackBar, 'TTrackBar');
+ with AddClass(TSwitch, 'TCustomTrack') do
+ AddEvent('OnSwitch', TfsNotifyEvent);
+ with AddClass(TScrollBar, 'TStyledControl') do
+ AddEvent('OnChange', TfsNotifyEvent);
+
+ AddClass(TSmallScrollBar, 'TScrollBar');
+ AddClass(TAniIndicator, 'TStyledControl');
+ with AddClass(TArcDial, 'TStyledControl') do
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddClass(TExpanderButton, 'TCustomButton');
+ with AddClass(TExpander, 'TTextControl') do
+ AddEvent('OnCheckChange', TfsNotifyEvent);
+ with AddClass(TImageControl, 'TStyledControl') do
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddClass(TPathLabel, 'TStyledControl');
+
+
+ with AddClass(TCustomEdit, 'TStyledControl') do
+ begin
+{$IFNDEF Delphi21}
+ AddMethod('procedure ClearSelection()', CallMethod);
+{$ENDIF}
+ AddMethod('procedure CopyToClipboard()', CallMethod);
+ AddMethod('procedure CutToClipboard()', CallMethod);
+ AddMethod('procedure PasteFromClipboard()', CallMethod);
+ AddMethod('procedure SelectAll()', CallMethod);
+{$IFNDEF Delphi21}
+ AddMethod('function GetCharX(a: Integer): Single', CallMethod);
+ AddMethod('function ContentRect(): TfsRectF', CallMethod);
+{$ENDIF}
+ AddProperty('CaretPosition', 'Integer', GetProp, SetProp);
+ AddProperty('SelStart', 'Integer', GetProp, SetProp);
+ AddProperty('SelLength', 'Integer', GetProp, SetProp);
+ AddProperty('SelText', 'string', GetProp, nil);
+ AddProperty('MaxLength', 'Integer', GetProp, SetProp);
+ AddProperty('SelectionFill', 'TBrush', GetProp, nil);
+ AddProperty('FilterChar', 'string', GetProp, SetProp);
+ AddProperty('Typing', 'Boolean', GetProp, SetProp);
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddEvent('OnChangeTracking', TfsNotifyEvent);
+ AddEvent('OnTyping', TfsNotifyEvent);
+ end;
+ AddClass(TEdit, 'TCustomEdit');
+ with AddClass(TMemo, 'TScrollBox') do
+ begin
+ AddMethod('procedure CopyToClipboard()', CallMethod);
+ AddMethod('procedure PasteFromClipboard()', CallMethod);
+ AddMethod('procedure CutToClipboard()', CallMethod);
+ AddMethod('procedure ClearSelection()', CallMethod);
+ AddMethod('procedure SelectAll()', CallMethod);
+ AddMethod('procedure GoToTextEnd()', CallMethod);
+ AddMethod('procedure GoToTextBegin()', CallMethod);
+ AddMethod('procedure GotoLineEnd()', CallMethod);
+ AddMethod('procedure GoToLineBegin()', CallMethod);
+ AddMethod('procedure UnDo()', CallMethod);
+ AddProperty('SelStart', 'Integer', GetProp, SetProp);
+ AddProperty('SelLength', 'Integer', GetProp, SetProp);
+ AddProperty('SelText', 'string', GetProp, nil);
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddEvent('OnChangeTracking', TfsNotifyEvent);
+ end;
+
+ AddClass(TRadioButton, 'TTextControl');
+ with AddClass(TListBoxItem, 'TTextControl') do
+ begin
+ AddProperty('Data', 'TObject', GetProp, SetProp);
+ AddProperty('Index', 'Integer', GetProp, SetProp);
+ end;
+
+ with AddClass(TCustomListBox, 'TScrollBox') do
+ begin
+ AddMethod('procedure Clear()', CallMethod);
+ AddMethod('function DragChange(SourceItem: TListBoxItem; DestItem: TListBoxItem): Boolean', CallMethod);
+ AddMethod('procedure SelectAll()', CallMethod);
+ AddMethod('procedure ClearSelection()', CallMethod);
+ AddMethod('procedure SelectRange(Item1: TListBoxItem; Item2: TListBoxItem)', CallMethod);
+ AddMethod('function ItemByPoint(X: Single; Y: Single): TListBoxItem', CallMethod);
+ AddMethod('function ItemByIndex(Idx: Integer): TListBoxItem', CallMethod);
+ AddMethod('procedure Exchange(Item1: TListBoxItem; Item2: TListBoxItem)', CallMethod);
+ AddMethod('procedure AddObject(AObject: TFmxObject)', CallMethod);
+ AddMethod('procedure InsertObject(Index: Integer; AObject: TFmxObject)', CallMethod);
+ AddMethod('procedure RemoveObject(AObject: TFmxObject)', CallMethod);
+ AddIndexProperty( 'ListItems', 'Integer', 'TListBoxItem', CallMethod);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddProperty('Selected', 'TListBoxItem', GetProp, nil);
+ AddProperty('Items', 'TStrings', GetProp, SetProp);
+ AddProperty('ItemIndex', 'Integer', GetProp, SetProp);
+ end;
+
+ AddClass(TListBox, 'TCustomListBox');
+ with AddClass(TCustomComboBox, 'TStyledControl') do
+ begin
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure DropDown', CallMethod);
+ AddIndexProperty( 'ListItems', 'Integer', 'TListBoxItem', CallMethod);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddProperty('Selected', 'TListBoxItem', GetProp, nil);
+ AddProperty('Items', 'TStrings', GetProp, SetProp);
+ AddProperty('ItemIndex', 'Integer', GetProp, SetProp);
+ AddEvent('OnDropDown', TfsNotifyEvent);
+ AddEvent('OnCloseUp', TfsNotifyEvent);
+ end;
+
+ with AddClass(TComboBox, 'TCustomComboBox') do
+ AddEvent('OnChange', TfsNotifyEvent);
+
+ with AddClass(TCommonCustomForm, 'TFmxObject') do
+ begin
+ AddConstructor('constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0)', CallMethod);
+ AddMethod('procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; AHeight: Integer)', CallMethod);
+ AddMethod('function ClientToScreen(Point: TfsPointF): TfsPointF', CallMethod);
+ AddMethod('function ScreenToClient(Point: TfsPointF): TfsPointF', CallMethod);
+ AddMethod('function CloseQuery(): Boolean', CallMethod);
+ AddMethod('function ClientRect(): TfsRectF', CallMethod);
+ AddMethod('procedure Release()', CallMethod);
+ AddMethod('procedure Close()', CallMethod);
+ AddMethod('procedure Show()', CallMethod);
+ AddMethod('procedure Hide()', CallMethod);
+ AddMethod('function ShowModal(): Integer', CallMethod);
+ AddMethod('procedure CloseModal()', CallMethod);
+ AddMethod('procedure Invalidate()', CallMethod);
+ AddMethod('procedure BeginUpdate()', CallMethod);
+ AddMethod('procedure EndUpdate()', CallMethod);
+ end;
+
+ with AddClass(TCustomForm, 'TCommonCustomForm') do
+ begin
+ AddEvent('OnActivate', TfsNotifyEvent);
+ AddEvent('OnClose', TfsCloseEvent);
+ AddEvent('OnCloseQuery', TfsCloseQueryEvent);
+ AddEvent('OnCreate', TfsNotifyEvent);
+ AddEvent('OnDestroy', TfsNotifyEvent);
+ AddEvent('OnDeactivate', TfsNotifyEvent);
+ AddEvent('OnHide', TfsNotifyEvent);
+ AddEvent('OnPaint', TfsNotifyEvent);
+ AddEvent('OnShow', TfsNotifyEvent);
+ AddEvent('OnResize', TfsNotifyEvent);
+ AddProperty('Canvas', 'TCanvas', GetProp, nil);
+ AddProperty('ModalResult', 'Integer', GetProp, SetProp);
+ end;
+ AddClass(TForm, 'TCustomForm');
+
+ AddClass(TDataModule, 'TComponent');
+ with AddClass(TApplication, 'TComponent') do
+ begin
+ AddMethod('procedure ProcessMessages', CallMethod);
+ end;
+ AddObject('Application', Application);
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ Form: TCommonCustomForm;
+begin
+ Result := 0;
+
+ if ClassType = TControl then
+ begin
+ if MethodName = 'ADDOBJECT' then
+ TControl(Instance).AddObject(TFmxObject(frxInteger(Caller.Params[0])))
+ else if MethodName = 'REMOVEOBJECT' then
+ TControl(Instance).RemoveObject(TFmxObject(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SETBOUNDS' then
+ TControl(Instance).SetBounds(Single(Caller.Params[0]), Single(Caller.Params[1]), Single(Caller.Params[2]), Single(Caller.Params[3]))
+ else if MethodName = 'ABSOLUTETOLOCAL' then
+ Result := frxInteger(TfsPointF.Create(TControl(Instance).AbsoluteToLocal(TfsPointF(frxInteger(Caller.Params[0])).GetRect)))
+ else if MethodName = 'LOCALTOABSOLUTE' then
+ Result := frxInteger(TfsPointF.Create(TControl(Instance).LocalToAbsolute(TfsPointF(frxInteger(Caller.Params[0])).GetRect)))
+ else if MethodName = 'ABSOLUTETOLOCALVECTOR' then
+ Result := frxInteger(TfsVector.Create(TControl(Instance).AbsoluteToLocalVector(TfsVector(frxInteger(Caller.Params[0])).GetRect)))
+ else if MethodName = 'LOCALTOABSOLUTEVECTOR' then
+ Result := frxInteger(TfsVector.Create(TControl(Instance).LocalToAbsoluteVector(TfsVector(frxInteger(Caller.Params[0])).GetRect)))
+ else if MethodName = 'POINTINOBJECT' then
+ Result := Boolean(TControl(Instance).PointInObject(Single(Caller.Params[0]), Single(Caller.Params[1])))
+ else if MethodName = 'BEGINUPDATE' then
+ TControl(Instance).BeginUpdate()
+ else if MethodName = 'ENDUPDATE' then
+ TControl(Instance).EndUpdate()
+{$IFNDEF DELPHI18}
+ else if MethodName = 'APPLYEFFECT' then
+ TControl(Instance).ApplyEffect()
+{$ENDIF}
+ else if MethodName = 'UPDATEEFFECTS' then
+ TControl(Instance).UpdateEffects()
+ else if MethodName = 'SETFOCUS' then
+ TControl(Instance).SetFocus()
+ else if MethodName = 'PAINTTO' then
+ TControl(Instance).PaintTo(TCanvas(frxInteger(Caller.Params[0])), TfsRectF(frxInteger(Caller.Params[1])).GetRect, TFmxObject(frxInteger(Caller.Params[2])))
+ else if MethodName = 'REPAINT' then
+ TControl(Instance).Repaint()
+ else if MethodName = 'INVALIDATERECT' then
+ TControl(Instance).InvalidateRect(TfsRectF(frxInteger(Caller.Params[0])).GetRect)
+ else if MethodName = 'LOCK' then
+ TControl(Instance).Lock()
+ end
+ else if ClassType = TStyledControl then
+ begin
+ if MethodName = 'FINDSTYLERESOURCE' then
+ Result := frxInteger(TStyledControl(Instance).FindStyleResource(String(Caller.Params[0])))
+ else if MethodName = 'APPLYSTYLELOOKUP' then
+ TStyledControl(Instance).ApplyStyleLookup()
+{$IFNDEF DELPHI20}
+ else if MethodName = 'UPDATESTYLE' then
+ TStyledControl(Instance).UpdateStyle()
+{$ENDIF}
+ end
+ else if ClassType = TCustomEdit then
+ begin
+ {$IFNDEF Delphi21}
+ if MethodName = 'CLEARSELECTION' then
+ TCustomEdit(Instance).ClearSelection()
+ else
+{$ENDIF}
+ if MethodName = 'COPYTOCLIPBOARD' then
+ TCustomEdit(Instance).CopyToClipboard()
+ else if MethodName = 'CUTTOCLIPBOARD' then
+ TCustomEdit(Instance).CutToClipboard()
+ else if MethodName = 'PASTEFROMCLIPBOARD' then
+ TCustomEdit(Instance).PasteFromClipboard()
+ else if MethodName = 'SELECTALL' then
+ TCustomEdit(Instance).SelectAll()
+{$IFNDEF Delphi21}
+ else if MethodName = 'GETCHARX' then
+ Result := Single(TCustomEdit(Instance).GetCharX(Integer(Caller.Params[0])))
+ else if MethodName = 'CONTENTRECT' then
+ Result := frxInteger(TfsRectF.Create(TCustomEdit(Instance).ContentRect()))
+{$ENDIF}
+ end
+ else if ClassType = TMemo then
+ begin
+ if MethodName = 'COPYTOCLIPBOARD' then
+ TMemo(Instance).CopyToClipboard()
+ else if MethodName = 'PASTEFROMCLIPBOARD' then
+ TMemo(Instance).PasteFromClipboard()
+ else if MethodName = 'CUTTOCLIPBOARD' then
+ TMemo(Instance).CutToClipboard()
+ else if MethodName = 'CLEARSELECTION' then
+ TMemo(Instance).ClearSelection()
+ else if MethodName = 'SELECTALL' then
+ TMemo(Instance).SelectAll()
+ else if MethodName = 'GOTOTEXTEND' then
+ TMemo(Instance).GoToTextEnd()
+ else if MethodName = 'GOTOTEXTBEGIN' then
+ TMemo(Instance).GoToTextBegin()
+ else if MethodName = 'GOTOLINEEND' then
+ TMemo(Instance).GotoLineEnd()
+ else if MethodName = 'GOTOLINEBEGIN' then
+ TMemo(Instance).GoToLineBegin()
+ else if MethodName = 'UNDO' then
+ TMemo(Instance).UnDo()
+ end
+ else if ClassType = TCustomListBox then
+ begin
+ if MethodName = 'ASSIGN' then
+ TCustomListBox(Instance).Assign(TPersistent(frxInteger(Caller.Params[0])))
+ else if MethodName = 'CLEAR' then
+ TCustomListBox(Instance).Clear()
+ else if MethodName = 'DRAGCHANGE' then
+ Result := TCustomListBox(Instance).DragChange(TListBoxItem(frxInteger(Caller.Params[0])), TListBoxItem(frxInteger(Caller.Params[1])))
+ else if MethodName = 'SELECTALL' then
+ TCustomListBox(Instance).SelectAll()
+ else if MethodName = 'CLEARSELECTION' then
+ TCustomListBox(Instance).ClearSelection()
+ else if MethodName = 'SELECTRANGE' then
+ TCustomListBox(Instance).SelectRange(TListBoxItem(frxInteger(Caller.Params[0])), TListBoxItem(frxInteger(Caller.Params[1])))
+ else if MethodName = 'ITEMBYPOINT' then
+ Result := frxInteger(TListBoxItem(TCustomListBox(Instance).ItemByPoint(Single(Caller.Params[0]), Single(Caller.Params[1]))))
+ else if MethodName = 'ITEMBYINDEX' then
+ Result := frxInteger(TListBoxItem(TCustomListBox(Instance).ItemByIndex(Integer(Caller.Params[0]))))
+ else if MethodName = 'EXCHANGE' then
+ TCustomListBox(Instance).Exchange(TListBoxItem(frxInteger(Caller.Params[0])), TListBoxItem(frxInteger(Caller.Params[1])))
+ else if MethodName = 'ADDOBJECT' then
+ TCustomListBox(Instance).AddObject(TFmxObject(frxInteger(Caller.Params[0])))
+ else if MethodName = 'INSERTOBJECT' then
+ TCustomListBox(Instance).InsertObject(Integer(Caller.Params[0]), TFmxObject(frxInteger(Caller.Params[1])))
+ else if MethodName = 'REMOVEOBJECT' then
+ TCustomListBox(Instance).RemoveObject(TFmxObject(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LISTITEMS.GET' then
+ Result := frxInteger(TCustomListBox(Instance).ListItems[Caller.Params[0]])
+ end
+ else if ClassType = TCustomComboBox then
+ begin
+ if MethodName = 'CLEAR' then
+ TCustomComboBox(Instance).Clear()
+ else if MethodName = 'DROPDOWN' then
+ TCustomComboBox(Instance).DropDown()
+ else if MethodName = 'LISTITEMS.GET' then
+ Result := frxInteger(TCustomComboBox(Instance).ListItems[Caller.Params[0]])
+ end
+ else if ClassType = TCommonCustomForm then
+ begin
+ Form := TCommonCustomForm(Instance);
+ if MethodName = 'CREATENEW' then
+ Result := frxInteger(Form.CreateNew(TComponent(frxInteger(Caller.Params[0])), Integer(Caller.Params[1])))
+ else if MethodName = 'SETBOUNDS' then
+ Form.SetBounds(Integer(Caller.Params[0]), Integer(Caller.Params[1]), Integer(Caller.Params[2]), Integer(Caller.Params[3]))
+ else if MethodName = 'CLIENTTOSCREEN' then
+ Result := frxInteger(TfsPointF.Create(Form.ClientToScreen(TfsPointF(frxInteger(Caller.Params[0])).GetRect)))
+ else if MethodName = 'SCREENTOCLIENT' then
+ Result := frxInteger(TfsPointF.Create(Form.ScreenToClient(TfsPointF(frxInteger(Caller.Params[0])).GetRect)))
+ else if MethodName = 'CLOSEQUERY' then
+ Result := Form.CloseQuery
+ else if MethodName = 'CLIENTRECT' then
+ Result := frxInteger(TfsRectF.Create(Form.ClientRect))
+ else if MethodName = 'RELEASE' then
+ Form.Release()
+ else if MethodName = 'CLOSE' then
+ Form.Close()
+ else if MethodName = 'SHOW' then
+ Form.Show()
+ else if MethodName = 'HIDE' then
+ Form.Hide()
+ else if MethodName = 'SHOWMODAL' then
+ Result := Integer(Form.ShowModal)
+ else if MethodName = 'CLOSEMODAL' then
+ Form.CloseModal()
+ else if MethodName = 'INVALIDATE' then
+ Form.Invalidate()
+ else if MethodName = 'BEGINUPDATE' then
+ Form.BeginUpdate()
+ else if MethodName = 'ENDUPDATE' then
+ Form.EndUpdate()
+ end
+ else if ClassType = TApplication then
+ begin
+ if MethodName = 'PROCESSMESSAGES' then
+ TApplication(Instance).ProcessMessages
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TControl then
+ begin
+ if PropName = 'ABSOLUTEMATRIX' then
+ Result := frxInteger(TfsMatrix.Create(TControl(Instance).AbsoluteMatrix))
+ else if PropName = 'ABSOLUTEOPACITY' then
+ Result := TControl(Instance).AbsoluteOpacity
+ else if PropName = 'ABSOLUTEWIDTH' then
+ Result := TControl(Instance).AbsoluteWidth
+ else if PropName = 'ABSOLUTEHEIGHT' then
+ Result := TControl(Instance).AbsoluteHeight
+ else if PropName = 'ABSOLUTESCALE' then
+ Result := frxInteger(TfsPointF.Create(TControl(Instance).AbsoluteScale))
+ else if PropName = 'ABSOLUTEENABLED' then
+ Result := TControl(Instance).AbsoluteEnabled
+ else if PropName = 'HASEFFECT' then
+ Result := TControl(Instance).HasEffect
+ else if PropName = 'HASDISABLEPAINTEFFECT' then
+ Result := TControl(Instance).HasDisablePaintEffect
+ else if PropName = 'HASAFTERPAINTEFFECT' then
+ Result := TControl(Instance).HasAfterPaintEffect
+ else if PropName = 'CHILDRENRECT' then
+ Result := frxInteger(TfsRectF.Create(TControl(Instance).ChildrenRect))
+ else if PropName = 'INVERTABSOLUTEMATRIX' then
+ Result := frxInteger(TfsMatrix.Create(TControl(Instance).InvertAbsoluteMatrix))
+ else if PropName = 'INPAINTTO' then
+ Result := TControl(Instance).InPaintTo
+ else if PropName = 'LOCALRECT' then
+ Result := frxInteger(TfsRectF.Create(TControl(Instance).LocalRect))
+ else if PropName = 'ABSOLUTERECT' then
+ Result := frxInteger(TfsRectF.Create(TControl(Instance).AbsoluteRect))
+ else if PropName = 'UPDATERECT' then
+ Result := frxInteger(TfsRectF.Create(TControl(Instance).UpdateRect))
+ else if PropName = 'PARENTEDRECT' then
+ Result := frxInteger(TfsRectF.Create(TControl(Instance).ParentedRect))
+ else if PropName = 'PARENTEDVISIBLE' then
+ Result := TControl(Instance).ParentedVisible
+ else if PropName = 'CLIPRECT' then
+ Result := frxInteger(TfsRectF.Create(TControl(Instance).ClipRect))
+ else if PropName = 'CANVAS' then
+ Result := frxInteger(TControl(Instance).Canvas)
+ else if PropName = 'AUTOCAPTURE' then
+ Result := TControl(Instance).AutoCapture
+ else if PropName = 'CANFOCUS' then
+ Result := TControl(Instance).CanFocus
+ else if PropName = 'DISABLEFOCUSEFFECT' then
+ Result := TControl(Instance).DisableFocusEffect
+ else if PropName = 'TABORDER' then
+ Result := Integer(TControl(Instance).TabOrder)
+ else if PropName = 'BOUNDSRECT' then
+ Result := frxInteger(TfsRectF.Create(TControl(Instance).BoundsRect))
+ end
+ else if ClassType = TStyledControl then
+ begin
+ if PropName = 'STYLELOOKUP' then
+ Result := TStyledControl(Instance).StyleLookup
+ end
+ else if ClassType = TCustomEdit then
+ begin
+ if PropName = 'CARETPOSITION' then
+ Result := TCustomEdit(Instance).CaretPosition
+ else if PropName = 'SELSTART' then
+ Result := TCustomEdit(Instance).SelStart
+ else if PropName = 'SELLENGTH' then
+ Result := TCustomEdit(Instance).SelLength
+ else if PropName = 'SELTEXT' then
+ Result := String(TCustomEdit(Instance).SelText)
+ else if PropName = 'MAXLENGTH' then
+ Result := TCustomEdit(Instance).MaxLength
+ else if PropName = 'SELECTIONFILL' then
+ Result := frxInteger(TCustomEdit(Instance).SelectionFill)
+ else if PropName = 'FILTERCHAR' then
+ Result := TCustomEdit(Instance).FilterChar
+ else if PropName = 'TYPING' then
+ Result := TCustomEdit(Instance).Typing
+ end
+ else if ClassType = TMemo then
+ begin
+ if PropName = 'SELSTART' then
+ Result := TMemo(Instance).SelStart
+ else if PropName = 'SELLENGTH' then
+ Result := TMemo(Instance).SelLength
+ else if PropName = 'SELTEXT' then
+ Result := String(TMemo(Instance).SelText)
+ end
+ else if ClassType = TListBoxItem then
+ begin
+ if PropName = 'DATA' then
+ Result := frxInteger(TListBoxItem(Instance).Data)
+ else if PropName = 'INDEX' then
+ Result := TListBoxItem(Instance).Index
+ end
+ else if ClassType = TCustomListBox then
+ begin
+ if PropName = 'COUNT' then
+ Result := TCustomListBox(Instance).Count
+ else if PropName = 'SELECTED' then
+ Result := frxInteger(TCustomListBox(Instance).Selected)
+ else if PropName = 'ITEMS' then
+ Result := frxInteger(TCustomListBox(Instance).Items)
+ else if PropName = 'ITEMINDEX' then
+ Result := TCustomListBox(Instance).ItemIndex
+ end
+ else if ClassType = TCustomComboBox then
+ begin
+ if PropName = 'COUNT' then
+ Result := TCustomComboBox(Instance).Count
+ else if PropName = 'SELECTED' then
+ Result := frxInteger(TCustomComboBox(Instance).Selected)
+ else if PropName = 'ITEMS' then
+ Result := frxInteger(TCustomComboBox(Instance).Items)
+ else if PropName = 'ITEMINDEX' then
+ Result := TCustomComboBox(Instance).ItemIndex
+ end
+ else if ClassType = TCustomForm then
+ begin
+ if PropName = 'MODALRESULT' then
+ Result := TCustomForm(Instance).ModalResult
+ else if PropName = 'CANVAS' then
+ Result := frxInteger(TCustomForm(Instance).Canvas)
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TControl then
+ begin
+ if PropName = 'AUTOCAPTURE' then
+ TControl(Instance).AutoCapture := Boolean(Value)
+ else if PropName = 'CANFOCUS' then
+ TControl(Instance).CanFocus := Boolean(Value)
+ else if PropName = 'DISABLEFOCUSEFFECT' then
+ TControl(Instance).DisableFocusEffect := Boolean(Value)
+ else if PropName = 'TABORDER' then
+ TControl(Instance).TabOrder := TTabOrder(Integer(Value))
+ else if PropName = 'BOUNDSRECT' then
+ TControl(Instance).BoundsRect := TfsRectF(frxInteger(Value)).GetRect
+ end
+ else if ClassType = TStyledControl then
+ begin
+ if PropName = 'STYLELOOKUP' then
+ TStyledControl(Instance).StyleLookup := Value;
+ end
+ else if ClassType = TCustomEdit then
+ begin
+ if PropName = 'CARETPOSITION' then
+ TCustomEdit(Instance).CaretPosition := Integer(Value)
+ else if PropName = 'SELSTART' then
+ TCustomEdit(Instance).SelStart := Integer(Value)
+ else if PropName = 'SELLENGTH' then
+ TCustomEdit(Instance).SelLength := Integer(Value)
+ else if PropName = 'MAXLENGTH' then
+ TCustomEdit(Instance).MaxLength := Integer(Value)
+ else if PropName = 'FILTERCHAR' then
+ TCustomEdit(Instance).FilterChar := String(Value)
+ else if PropName = 'TYPING' then
+ TCustomEdit(Instance).Typing := Boolean(Value)
+ end
+ else if ClassType = TMemo then
+ begin
+ if PropName = 'SELSTART' then
+ TMemo(Instance).SelStart := Integer(Value)
+ else if PropName = 'SELLENGTH' then
+ TMemo(Instance).SelLength := Integer(Value)
+ end
+ else if ClassType = TListBoxItem then
+ begin
+ if PropName = 'DATA' then
+ TListBoxItem(Instance).Data := TObject(frxInteger(Value))
+ else if PropName = 'INDEX' then
+ TListBoxItem(Instance).Index := Value
+ end
+ else if ClassType = TCustomListBox then
+ begin
+ if PropName = 'ITEMS' then
+ TCustomListBox(Instance).Items := TStrings(frxInteger(Value))
+ else if PropName = 'ITEMINDEX' then
+ TCustomListBox(Instance).ItemIndex := Value
+ end
+ else if ClassType = TCustomComboBox then
+ begin
+ if PropName = 'ITEMS' then
+ TCustomComboBox(Instance).Items := TStrings(frxInteger(Value))
+ else if PropName = 'ITEMINDEX' then
+ TCustomComboBox(Instance).ItemIndex := Value
+ end
+ else if ClassType = TCustomForm then
+ begin
+ if PropName = 'MODALRESULT' then
+ TCustomForm(Instance).ModalResult := Value
+ end
+end;
+
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsFormsRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/FMX/FMX.fs_igraphicsrtti.pas b/FastScript/FMX/FMX.fs_igraphicsrtti.pas
new file mode 100644
index 0000000..ec1c1a3
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_igraphicsrtti.pas
@@ -0,0 +1,522 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Graphics.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_igraphicsrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_iclassesrtti
+, FMX.Types, FMX.Objects, System.UITypes, System.UIConsts, System.Types, System.Variants
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI29}
+ , FMX.BaseTypeAliases
+{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsGraphicsRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ procedure GetColorProc(const Name: String);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ GetAlphaColorValues(GetColorProc);
+ AddType('TAlignment', fvtInt);
+ AddType('TLeftRight', fvtInt);
+ AddConst('taLeftJustify', 'Integer', taLeftJustify);
+ AddConst('taRightJustify', 'Integer', taRightJustify);
+ AddConst('taCenter', 'Integer', taCenter);
+ AddType('TVerticalAlignment', fvtInt);
+ AddConst('taAlignTop', 'Integer', taAlignTop);
+ AddConst('taAlignBottom', 'Integer', taAlignBottom);
+ AddConst('taVerticalCenter', 'Integer', taVerticalCenter);
+ //AddEnum('TAlignment', 'taLeftJustify, taRightJustify, taCenter');
+ AddType('TCorners ', fvtInt);
+ AddConst('crTopLeft', 'Integer', TCorner.crTopLeft);
+ AddConst('crTopRight', 'Integer', TCorner.crTopRight);
+ AddConst('crBottomLeft', 'Integer', TCorner.crBottomLeft);
+ AddConst('crBottomRight', 'Integer', TCorner.crBottomRight);
+ AddType('TSides ', fvtInt);
+ AddConst('sdTop', 'Integer', TSide.sdTop);
+ AddConst('sdLeft', 'Integer', TSide.sdLeft);
+ AddConst('sdBottom', 'Integer', TSide.sdBottom);
+ AddConst('sdRight', 'Integer', TSide.sdRight);
+ AddConst('ftRightToLeft', 'Integer', TFillTextFlag.ftRightToLeft);
+ AddType('TFillTextFlags ', fvtInt);
+ AddEnumSet('TFontStyles', 'fsBold, fsItalic, fsUnderline, fsStrikeout');
+ AddEnum('TFontPitch', 'fpDefault, fpVariable, fpFixed');
+ AddEnum('TFontQuality', 'fqDefault, fqDraft, fqProof, fqNonAntialiased, fqAntialiased, fqClearType, fqClearTypeNatural');
+ AddEnum('TGradientStyle', 'gsLinear, gsRadial');
+ AddEnum('TWrapMode', 'wmTile, wmTileOriginal, wmTileStretch');
+ AddEnum('TCornerType', 'ctRound, ctBevel, ctInnerRound, ctInnerLine');
+ AddEnum('TAlignLayout', 'alNone, alTop, alLeft, alRight, alBottom, alMostTop, alMostBottom, alMostLeft, alMostRight, alClient, alContents, alCenter, alVertCenter, alHorzCenter, alHorizontal, alVertical, alScale, alFit, alFitLeft, alFitRight');
+ AddEnum('TPathPointKind', 'ppMoveTo, ppLineTo, ppCurveTo, ppClose');
+ AddEnum('TStrokeCap', 'scFlat, scRound');
+ AddEnum('TStrokeJoin', 'sjMiter, sjRound, sjBevel');
+ AddEnum('TStrokeDash', 'sdSolid, sdDash, sdDot, sdDashDot, sdDashDotDot, sdCustom');
+
+ AddEnum('TBrushKind', 'bkNone, bkSolid, bkGradient, bkBitmap, bkResource, bkGrab');
+
+ AddClass(TfsMatrix, 'TPersistent');
+ with AddClass(TFont, 'TPersistent') do
+ AddConstructor('constructor Create', CallMethod);
+ AddClass(TGradientPoint, 'TCollectionItem');
+ AddClass(TGradientPoints, 'TCollection');
+ AddClass(TGradient, 'TPersistent');
+ AddClass(TBrushBitmap, 'TPersistent');
+ AddClass(TBrushResource, 'TPersistent');
+{$IFNDEF Delphi18}
+ AddClass(TBrushGrab, 'TPersistent');
+{$ENDIF}
+ AddClass(TLineMetricInfo, 'TObject');
+
+ with AddClass(TBrush, 'TPersistent') do
+ begin
+ AddConstructor('Create(ADefaultKind: TBrushKind; ADefaultColor: TAlphaColor)', CallMethod);
+ AddProperty('DefaultColor', 'TAlphaColor', GetProp);
+ AddProperty('DefaultKind', 'TBrushKind', GetProp);
+ end;
+{$IFDEF Delphi17}
+ AddClass(TStrokeBrush, 'TBrush');
+{$ENDIF}
+
+ AddClass(TCanvasSaveState, 'TPersistent');
+ with AddClass(TCanvas, 'TPersistent') do
+ begin
+ AddMethod('function BeginScene: Boolean', CallMethod);
+ AddMethod('procedure EndScene', CallMethod);
+ AddMethod('procedure Clear(Color: TAlphaColor)', CallMethod);
+ AddMethod('procedure ClearRect(ARect: TfsRectF; AColor: TAlphaColor = 0)', CallMethod);
+ AddMethod('procedure SetMatrix(const M: TfsMatrix)', CallMethod);
+{$IFDEF Delphi17}
+ AddMethod('procedure MultiplyMatrix(const M: TfsMatrix)', CallMethod);
+{$ELSE}
+ AddMethod('procedure MultyMatrix(const M: TfsMatrix)', CallMethod);
+{$ENDIF}
+ AddMethod('function SaveState: TCanvasSaveState', CallMethod);
+ AddMethod('procedure RestoreState(State: TCanvasSaveState)', CallMethod);
+ AddMethod('procedure SetClipRects(ARects: array of TfsRectF)', CallMethod);
+ AddMethod('procedure IntersectClipRect(ARect: TfsRectF)', CallMethod);
+ AddMethod('procedure ExcludeClipRect(ARect: TfsRectF)', CallMethod);
+ AddMethod('procedure ResetClipRect', CallMethod);
+ AddMethod('procedure DrawLine(APt1: TfsPointF; APt2: TfsPointF; AOpacity: Single)', CallMethod);
+ AddMethod('procedure FillRect(ARect: TfsRectF; XRadius: Single; YRadius: Single; ACorners: TCorners; AOpacity: Single; ACornerType: TCornerType)', CallMethod);
+ AddMethod('procedure DrawRect(ARect: TfsRectF; XRadius: Single; YRadius: Single; ACorners: TCorners; AOpacity: Single; ACornerType: TCornerType)', CallMethod);
+ AddMethod('procedure FillEllipse(ARect: TfsRectF; AOpacity: Single)', CallMethod);
+ AddMethod('procedure DrawEllipse(ARect: TfsRectF; AOpacity: Single)', CallMethod);
+ AddMethod('procedure FillArc(Center: TfsPointF; Radius: TfsPointF; StartAngle: Single; SweepAngle: Single; AOpacity: Single)', CallMethod);
+ AddMethod('procedure DrawArc(Center: TfsPointF; Radius: TfsPointF; StartAngle: Single; SweepAngle: Single; AOpacity: Single)', CallMethod);
+ AddMethod('function PtInPath(APoint: TfsPointF; APath: TPathData): Boolean', CallMethod);
+ AddMethod('procedure FillPath(APath: TPathData; AOpacity: Single)', CallMethod);
+ AddMethod('procedure DrawPath(APath: TPathData; AOpacity: Single)', CallMethod);
+ AddMethod('procedure DrawBitmap(ABitmap: TBitmap; SrcRect: TfsRectF; DstRect: TfsRectF; AOpacity: Single; HighSpeed: Boolean)', CallMethod);
+ AddMethod('procedure DrawRectSides(ARect: TfsRectF; XRadius: Single; YRadius: Single; ACorners: TCorners; AOpacity: Single; ASides: TSides; ACornerType: TCornerType)', CallMethod);
+ AddMethod('procedure FillPolygon(Points: TPolygon; AOpacity: Single)', CallMethod);
+ AddMethod('procedure DrawPolygon(Points: TPolygon; AOpacity: Single)', CallMethod);
+ AddMethod('function LoadFontFromStream(AStream: TStream): Boolean', CallMethod);
+ AddMethod('procedure FillText(ARect: TfsRectF; AText: string; WordWrap: Boolean; AOpacity: Single; Flags: TFillTextFlags; ATextAlign: TTextAlign; AVTextAlign: TTextAlign)', CallMethod);
+ AddMethod('procedure MeasureText(var ARect: TfsRectF; AText: string; WordWrap: Boolean; Flags: TFillTextFlags; ATextAlign: TTextAlign; AVTextAlign: TTextAlign)', CallMethod);
+ AddMethod('procedure MeasureLines(ALines: TLineMetricInfo; ARect: TfsRectF; AText: string; WordWrap: Boolean; Flags: TFillTextFlags; ATextAlign: TTextAlign; AVTextAlign: TTextAlign)', CallMethod);
+ AddMethod('function TextToPath(Path: TPathData; ARect: TfsRectF; AText: string; WordWrap: Boolean; ATextAlign: TTextAlign; AVTextAlign: TTextAlign): Boolean', CallMethod);
+ AddMethod('function TextWidth(AText: string): Single', CallMethod);
+ AddMethod('function TextHeight(AText: string): Single', CallMethod);
+ AddMethod('procedure SetCustomDash(Dash: array; Offset: Single)', CallMethod);
+{$IFDEF Delphi17}
+ AddProperty('Stroke', 'TStrokeBrush', GetProp);
+ AddProperty('StrokeCap', 'TStrokeCap', nil, SetProp);
+ AddProperty('StrokeDash', 'TStrokeDash', nil, SetProp);
+ AddProperty('StrokeJoin', 'TStrokeJoin', nil, SetProp);
+{$ELSE}
+ AddProperty('Stroke', 'TBrush', GetProp);
+ AddProperty('StrokeCap', 'TStrokeCap', GetProp, SetProp);
+ AddProperty('StrokeDash', 'TStrokeDash', GetProp, SetProp);
+ AddProperty('StrokeJoin', 'TStrokeJoin', GetProp, SetProp);
+{$ENDIF}
+ AddProperty('StrokeThickness', 'Single', GetProp, SetProp);
+ AddProperty('Fill', 'TBrush', GetProp, SetProp);
+ AddProperty('Font', 'TFont', GetProp);
+ AddProperty('Matrix', 'TfsMatrix', GetProp);
+ AddProperty('Width', 'Integer', GetProp);
+ AddProperty('Height', 'Integer', GetProp);
+ end;
+ with AddClass(TBitmap, 'TPersistent') do
+ begin
+ AddConstructor('constructor Create(AWidth, AHeight: Integer)', CallMethod);
+ AddConstructor('constructor CreateFromStream(AStream: TStream)', CallMethod);
+ AddConstructor('constructor CreateFromFile(AFileName: string)', CallMethod);
+ AddMethod('procedure SetSize(AWidth, AHeight: Integer)', CallMethod);
+ AddMethod('procedure Clear(AColor: TAlphaColor)', CallMethod);
+ AddMethod('procedure ClearRect(ARect: TfsRectF; AColor: TAlphaColor = 0)', CallMethod);
+ AddMethod('function IsEmpty: Boolean', CallMethod);
+ AddMethod('procedure Rotate(Angle: Single)', CallMethod);
+ AddMethod('procedure FlipHorizontal', CallMethod);
+ AddMethod('procedure FlipVertical', CallMethod);
+ AddMethod('procedure InvertAlpha', CallMethod);
+{$IFNDEF DELPHI20}
+ AddMethod('procedure LoadFromFile(AFileName: string; Rotate: Single = 0)', CallMethod);
+{$ELSE}
+ AddMethod('procedure LoadFromFile(AFileName: string)', CallMethod);
+{$ENDIF}
+ AddMethod('procedure SaveToFile(AFileName: string)', CallMethod);
+ AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
+{$IFNDEF Delphi17}
+ AddMethod('procedure BitmapChanged', CallMethod);
+ AddIndexProperty( 'Pixels', 'Integer, Integer', 'TAlphaColor', CallMethod);
+{$ENDIF}
+ AddProperty('Canvas', 'TCanvas', GetProp);
+{$IFNDEF Delphi21}
+ AddProperty('ResourceBitmap', 'TBitmap', GetProp);
+{$ENDIF}
+ AddProperty('Width', 'Integer', GetProp, SetProp);
+ AddProperty('Height', 'Integer', GetProp, SetProp);
+ end;
+ AddClass(TSpline, 'TObject');
+ AddClass(TBounds, 'TPersistent');
+ AddClass(TTransform, 'TPersistent');
+
+
+
+{$IFNDEF Delphi17}
+ AddClass(TBitmapCodec, 'TPersistent');
+{$ENDIF}
+ AddClass(TPathData, 'TPersistent');
+ AddClass(TCanvasSaveState, 'TPersistent');
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ _Canvas: TCanvas;
+ _Bitmap: TBitmap;
+// mRects: array of TRectF;
+ mDashs: array of Single;
+ mPoly: TPolygon;
+ Idx, Cnt, nLo: Integer;
+begin
+ Result := 0;
+
+ if ClassType = TFont then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TFont(Instance).Create);
+ end
+ else if ClassType = TBitmap then
+ begin
+ _Bitmap := TBitmap(Instance);
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TBitmap(Instance).Create(Caller.Params[0], Caller.Params[1]))
+ else if MethodName = 'CREATEFROMSTREAM' then
+ Result := frxInteger(_Bitmap.CreateFromStream(TStream(frxInteger(Caller.Params[0]))))
+ else if MethodName = 'CREATEFROMFILE' then
+ Result := frxInteger(_Bitmap.CreateFromFile(String(Caller.Params[0])))
+ else if MethodName = 'SETSIZE' then
+ _Bitmap.SetSize(Integer(Caller.Params[0]), Integer(Caller.Params[1]))
+ else if MethodName = 'CLEAR' then
+ _Bitmap.Clear(TAlphaColor(Caller.Params[0]))
+ else if MethodName = 'CLEARRECT' then
+ begin
+ _Bitmap.ClearRect(TfsRectF(frxInteger(Caller.Params[0])).GetRect, TAlphaColor(Caller.Params[1]));
+ end
+ else if MethodName = 'ISEMPTY' then
+ Result := _Bitmap.IsEmpty
+ else if MethodName = 'ROTATE' then
+ _Bitmap.Rotate(Single(Caller.Params[1]))
+ else if MethodName = 'FLIPHORIZONTAL' then
+ _Bitmap.FlipHorizontal
+ else if MethodName = 'FLIPVERTICAL' then
+ _Bitmap.FlipVertical
+ else if MethodName = 'INVERTALPHA' then
+ _Bitmap.InvertAlpha
+ else if MethodName = 'LOADFROMFILE' then
+{$IFNDEF DELPHI20}
+ _Bitmap.LoadFromFile(String(Caller.Params[0]), Single(Caller.Params[1]))
+{$ELSE}
+ _Bitmap.LoadFromFile(String(Caller.Params[0]))
+{$ENDIF}
+ else if MethodName = 'SAVETOFILE' then
+ _Bitmap.SaveToFile(String(Caller.Params[0]))
+ else if MethodName = 'LOADFROMSTREAM' then
+ _Bitmap.LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVETOSTREAM' then
+ _Bitmap.SaveToStream(TStream(frxInteger(Caller.Params[0])))
+{$IFNDEF Delphi17}
+ else if MethodName = 'BITMAPCHANGED' then
+ _Bitmap.BitmapChanged
+ else if MethodName = 'PIXELS.GET' then
+ Result := _Bitmap.Pixels[Caller.Params[0], Caller.Params[1]]
+ else if MethodName = 'PIXELS.SET' then
+ _Bitmap.Pixels[Caller.Params[0], Caller.Params[1]] := Caller.Params[2]
+{$ENDIF}
+ end
+ else if ClassType = TBrush then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TBrush(Instance).Create(TBrushKind(frxInteger(Caller.Params[0])),
+ TAlphaColor(frxInteger(Caller.Params[0]))))
+ end
+ else if ClassType = TCanvas then
+ begin
+ _Canvas := TCanvas(Instance);
+
+ if MethodName = 'BEGINSCENE' then
+ Result := _Canvas.BeginScene
+ else if MethodName = 'ENDSCENE' then
+ _Canvas.EndScene
+ else if MethodName = 'CLEAR' then
+ _Canvas.Clear(TAlphaColor(Caller.Params[0]))
+ else if MethodName = 'CLEARRECT' then
+ _Canvas.ClearRect(TfsRectF(frxInteger(Caller.Params[0])).GetRect, TAlphaColor(Caller.Params[1]))
+ else if MethodName = 'SETMATRIX' then
+ _Canvas.SetMatrix(TfsMatrix(frxInteger(Caller.Params[0])).GetRect)
+{$IFDEF Delphi17}
+ else if MethodName = 'MULTIPLYMATRIX' then
+ _Canvas.MultiplyMatrix(TfsMatrix(frxInteger(Caller.Params[0])).GetRect)
+{$ELSE}
+ else if MethodName = 'MULTYMATRIX' then
+ _Canvas.MultyMatrix(TfsMatrix(frxInteger(Caller.Params[0])).GetRect)
+{$ENDIF}
+ else if MethodName = 'SAVESTATE' then
+ Result := frxInteger(_Canvas.SaveState)
+ else if MethodName = 'RESTORESTATE' then
+ _Canvas.RestoreState(TCanvasSaveState(frxInteger(Caller.Params[0])))
+ { else if MethodName = 'SETCLIPRECTS' then
+ begin
+ nLo := VarArrayLowBound(Caller.Params[0], 1);
+ Cnt := VarArrayHighBound(Caller.Params[0], 1) - nLo;
+ SetLength(mRects, Cnt);
+ for Idx := 0 to Cnt - 1 do
+ mRects[Idx] := TfsRectF(frxInteger(Caller.Params[0][Idx + nLo])).GetRectP^;
+ _Canvas.SetClipRects(mRects);
+ SetLength(mRects, 0);
+ end }
+ else if MethodName = 'EXCLUDECLIPRECT' then
+ _Canvas.ExcludeClipRect(TfsRectF(frxInteger(Caller.Params[0])).GetRect)
+ else if MethodName = 'INTERSECTCLIPTRECT' then
+ _Canvas.IntersectClipRect(TfsRectF(frxInteger(Caller.Params[0])).GetRect)
+ {else if MethodName = 'RESETCLIPRECT' then
+ _Canvas.ResetClipRect }
+ else if MethodName = 'DRAWLINE' then
+ _Canvas.DrawLine(TfsPointF(frxInteger(Caller.Params[0])).GetRect, TfsPointF(frxInteger(Caller.Params[1])).GetRect, Single(Caller.Params[2]))
+ else if MethodName = 'FILLRECT' then
+ _Canvas.FillRect(TfsRectF(frxInteger(Caller.Params[0])).GetRect, Single(Caller.Params[1]), Single(Caller.Params[2]), TCorners(Byte(Caller.Params[3])), Single(Caller.Params[4]), TCornerType(Caller.Params[5]))
+ else if MethodName = 'DRAWRECT' then
+ _Canvas.DrawRect(TfsRectF(frxInteger(Caller.Params[0])).GetRect, Single(Caller.Params[1]), Single(Caller.Params[2]), TCorners(Byte(Caller.Params[3])), Single(Caller.Params[4]), TCornerType(Caller.Params[5]))
+ else if MethodName = 'FILLELLIPSE' then
+ _Canvas.FillEllipse(TfsRectF(frxInteger(Caller.Params[0])).GetRect, Single(Caller.Params[1]))
+ else if MethodName = 'DRAWELLIPSE' then
+ _Canvas.DrawEllipse(TfsRectF(frxInteger(Caller.Params[0])).GetRect, Single(Caller.Params[1]))
+ else if MethodName = 'FILLARC' then
+ _Canvas.FillArc(TfsPointF(frxInteger(Caller.Params[0])).GetRect, TfsPointF(frxInteger(Caller.Params[1])).GetRect, Single(Caller.Params[2]), Single(Caller.Params[3]), Single(Caller.Params[4]))
+ else if MethodName = 'DRAWARC' then
+ _Canvas.DrawArc(TfsPointF(frxInteger(Caller.Params[0])).GetRect, TfsPointF(frxInteger(Caller.Params[1])).GetRect, Single(Caller.Params[2]), Single(Caller.Params[3]), Single(Caller.Params[4]))
+ else if MethodName = 'PTINPATH' then
+ Result := Boolean(_Canvas.PtInPath(TfsPointF(frxInteger(Caller.Params[0])).GetRect, TPathData(frxInteger(Caller.Params[1]))))
+ else if MethodName = 'FILLPATH' then
+ _Canvas.FillPath(TPathData(frxInteger(Caller.Params[0])), Single(Caller.Params[1]))
+ else if MethodName = 'DRAWPATH' then
+ _Canvas.DrawPath(TPathData(frxInteger(Caller.Params[0])), Single(Caller.Params[1]))
+ else if MethodName = 'DRAWBITMAP' then
+ _Canvas.DrawBitmap(TBitmap(frxInteger(Caller.Params[0])), TfsRectF(frxInteger(Caller.Params[1])).GetRect, TfsRectF(frxInteger(Caller.Params[2])).GetRect, Single(Caller.Params[3]), Boolean(Caller.Params[4]))
+ else if MethodName = 'DRAWRECTSIDES' then
+ _Canvas.DrawRectSides(TfsRectF(frxInteger(Caller.Params[0])).GetRect, Single(Caller.Params[1]), Single(Caller.Params[2]), TCorners(Byte(Caller.Params[3])), Single(Caller.Params[4]), TSides(Byte(Caller.Params[5])), TCornerType(Caller.Params[6]))
+ else if MethodName = 'FILLPOLYGON' then
+ begin
+ nLo := VarArrayLowBound(Caller.Params[0], 1);
+ Cnt := VarArrayHighBound(Caller.Params[0], 1) - nLo;
+ SetLength(mPoly, Cnt);
+ for Idx := 0 to Cnt - 1 do
+ mPoly[Idx] := TfsPointF(frxInteger(Caller.Params[0][Idx + nLo])).GetRectP^;
+ _Canvas.FillPolygon(TPolygon(Caller.Params[0]), Single(Caller.Params[1]));
+ SetLength(mPoly, 0);
+ end
+ else if MethodName = 'DRAWPOLYGON' then
+ begin
+ nLo := VarArrayLowBound(Caller.Params[0], 1);
+ Cnt := VarArrayHighBound(Caller.Params[0], 1) - nLo;
+ SetLength(mPoly, Cnt);
+ for Idx := 0 to Cnt - 1 do
+ mPoly[Idx] := TfsPointF(frxInteger(Caller.Params[0][Idx + nLo])).GetRectP^;
+ _Canvas.DrawPolygon(TPolygon(Caller.Params[0]), Single(Caller.Params[1]));
+ SetLength(mPoly, 0);
+ end
+ else if MethodName = 'LOADFONTFROMSTREAM' then
+ Result := Boolean(_Canvas.LoadFontFromStream(TStream(frxInteger(Caller.Params[0]))))
+ else if MethodName = 'FILLTEXT' then
+ _Canvas.FillText(TfsRectF(frxInteger(Caller.Params[0])).GetRect, String(Caller.Params[1]), Boolean(Caller.Params[2]), Single(Caller.Params[3]), TFillTextFlags(Byte(Caller.Params[4])), TTextAlign(Caller.Params[5]), TTextAlign(Caller.Params[6]))
+ else if MethodName = 'MEASURETEXT' then
+ _Canvas.MeasureText(TfsRectF(frxInteger(Caller.Params[0])).GetRectP^, String(Caller.Params[1]), Boolean(Caller.Params[2]), TFillTextFlags(Byte(Caller.Params[3])), TTextAlign(Caller.Params[4]), TTextAlign(Caller.Params[5]))
+ else if MethodName = 'MEASURELINES' then
+ _Canvas.MeasureLines(TLineMetricInfo(frxInteger(Caller.Params[0])), TfsRectF(frxInteger(Caller.Params[1])).GetRect, String(Caller.Params[2]), Boolean(Caller.Params[3]), TFillTextFlags(Byte(Caller.Params[4])), TTextAlign(Caller.Params[5]), TTextAlign(Caller.Params[6]))
+ else if MethodName = 'TEXTTOPATH' then
+ Result := Boolean(_Canvas.TextToPath(TPathData(frxInteger(Caller.Params[0])), TfsRectF(frxInteger(Caller.Params[1])).GetRect, String(Caller.Params[2]), Boolean(Caller.Params[3]), TTextAlign(Caller.Params[4]), TTextAlign(Caller.Params[5])))
+ else if MethodName = 'TEXTWIDTH' then
+ Result := Single(_Canvas.TextWidth(String(Caller.Params[0])))
+ else if MethodName = 'TEXTHEIGHT' then
+ Result := Single(_Canvas.TextHeight(String(Caller.Params[0])))
+ else if MethodName = 'SETCUSTOMDASH' then
+ begin
+ nLo := VarArrayLowBound(Caller.Params[0], 1);
+ Cnt := VarArrayHighBound(Caller.Params[0], 1) - nLo;
+ SetLength(mDashs, Cnt);
+ for Idx := 0 to Cnt - 1 do
+ mDashs[Idx] := Single(Caller.Params[0][Idx + nLo]);
+{$IFDEF DELPHI25}
+ _Canvas.Stroke.SetCustomDash(mDashs, Single(Caller.Params[1]));
+{$ELSE}
+ _Canvas.SetCustomDash(mDashs, Single(Caller.Params[1]));
+{$ENDIF}
+ SetLength(mDashs, 0);
+ end
+{$IFNDEF CLX}
+ { else if MethodName = 'PIXELS.GET' then
+ Result := _Canvas.Pixels[Caller.Params[0], Caller.Params[1]]
+ else if MethodName = 'PIXELS.SET' then
+ _Canvas.Pixels[Caller.Params[0], Caller.Params[1]] := Caller.Params[2] }
+{$ENDIF}
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+ if ClassType = TBitmap then
+ begin
+ if PropName = 'CANVAS' then
+ Result := frxInteger(TBitmap(Instance).Canvas)
+{$IFNDEF Delphi21}
+ else if PropName = 'RESOURCEBITMAP' then
+ Result := frxInteger(TBitmap(Instance).ResourceBitmap)
+{$ENDIF}
+ else if PropName = 'WIDTH' then
+ Result := Integer(TBitmap(Instance).Width)
+ else if PropName = 'HEIGHT' then
+ Result := Integer(TBitmap(Instance).Height)
+ end
+ else if ClassType = TCanvas then
+ begin
+ if PropName = 'STROKE' then
+ Result := frxInteger(TCanvas(Instance).Stroke)
+ else if PropName = 'WIDTH' then
+ Result := Integer(TCanvas(Instance).Width)
+ else if PropName = 'HEIGHT' then
+ Result := Integer(TCanvas(Instance).Height)
+ else if PropName = 'FONT' then
+ Result := frxInteger(TCanvas(Instance).Font)
+ else if PropName = 'FILL' then
+ Result := frxInteger(TCanvas(Instance).Fill)
+ else if PropName = 'STROKETHICKNESS' then
+{$IFDEF DELPHI25}
+ Result := Single(TCanvas(Instance).Stroke.Thickness)
+{$ELSE}
+ Result := Single(TCanvas(Instance).StrokeThickness)
+{$ENDIF}
+{$IFNDEF Delphi17}
+ else if PropName = 'STROKECAP' then
+ Result := Integer(TCanvas(Instance).StrokeCap)
+ else if PropName = 'STROKEDASH' then
+ Result := Integer(TCanvas(Instance).StrokeDash)
+ else if PropName = 'STROKEJOIN' then
+ Result := Integer(TCanvas(Instance).StrokeJoin)
+{$ENDIF}
+ end;
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TBitmap then
+ begin
+ if PropName = 'WIDTH' then
+ TBitmap(Instance).Width := Integer(Value)
+ else if PropName = 'HEIGHT' then
+ TBitmap(Instance).Height:= Integer(Value)
+ end
+ else if ClassType = TCanvas then
+ begin
+ if PropName = 'STROKETHICKNESS' then
+{$IFDEF DELPHI25}
+ TCanvas(Instance).Stroke.Thickness := Single(Value)
+{$ELSE}
+ TCanvas(Instance).StrokeThickness := Single(Value)
+{$ENDIF}
+ else if PropName = 'STROKECAP' then
+{$IFDEF DELPHI25}
+ TCanvas(Instance).Stroke.Cap := TStrokeCap(Value)
+{$ELSE}
+ TCanvas(Instance).StrokeCap := TStrokeCap(Value)
+{$ENDIF}
+ else if PropName = 'STROKEDASH' then
+{$IFDEF DELPHI25}
+ TCanvas(Instance).Stroke.Dash := TStrokeDash(Value)
+{$ELSE}
+ TCanvas(Instance).StrokeDash := TStrokeDash(Value)
+{$ENDIF}
+ else if PropName = 'STROKEJOIN' then
+{$IFDEF DELPHI25}
+ TCanvas(Instance).Stroke.Join := TStrokeJoin(Value)
+{$ELSE}
+ TCanvas(Instance).StrokeJoin := TStrokeJoin(Value)
+{$ENDIF}
+ end;
+end;
+
+procedure TFunctions.GetColorProc(const Name: String);
+var
+ c: Integer;
+begin
+ IdentToAlphaColor('cla' + Name, c);
+ Script.AddConst('cla' + Name, 'Integer', c);
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsGraphicsRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/FMX/FMX.fs_iibxrtti.pas b/FastScript/FMX/FMX.fs_iibxrtti.pas
new file mode 100644
index 0000000..dd92476
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_iibxrtti.pas
@@ -0,0 +1,125 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ IBX classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iibxrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_itools, FMX.fs_idbrtti, Data.db, FMX.Types
+{$IFDEF DELPHI20}
+ , IBX.ibdatabase, IBX.IBCustomDataSet, IBX.IBQuery, IBX.IBTable, IBX.IBStoredProc
+{$ELSE}
+ , ibdatabase, IBCustomDataSet, IBQuery, IBTable, IBStoredProc
+{$ENDIF}
+ ;
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsIBXRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class (TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass; const MethodName:
+ String; Caller: TfsMethodHelper): Variant;
+ function RecordCount(Instance: TObject; ClassType: TClass; const PropName:
+ String): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddClass(TIBDataBase, 'TComponent');
+
+ with AddClass(TIBTransaction, 'TComponent') do
+ begin
+ AddMethod('procedure Commit', CallMethod);
+ AddMethod('procedure RollBack', CallMethod);
+ AddMethod('procedure StartTransaction', CallMethod);
+ end;
+
+ AddClass(TIBCustomDataSet, 'TDataSet');
+ AddClass(TIBTable, 'TIBCustomDataSet');
+ with AddClass(TIBQuery, 'TIBCustomDataSet') do
+ begin
+ AddMethod('procedure ExecSQL', CallMethod);
+ AddMethod('procedure FetchAll', CallMethod);
+ AddProperty('RecordCount', 'Integer',RecordCount, nil);
+ end;
+ with AddClass(TIBStoredProc, 'TIBCustomDataSet') do
+ AddMethod('procedure ExecProc', CallMethod);
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; const
+ MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TIBQuery then
+ begin
+ if MethodName = 'EXECSQL' then
+ TIBQuery(Instance).ExecSQL
+ else
+ if MethodName = 'FETCHALL' then
+ TIBQuery(Instance).FETCHALL;
+ end
+ else
+ if ClassType = TIBStoredProc then
+ begin
+ if MethodName = 'EXECPROC' then
+ TIBStoredProc(Instance).ExecProc
+ end
+ else
+ if(ClassType = TIBTransaction) AND (MethodName = 'COMMIT') then
+ TIBTransaction(Instance).Commit
+ else
+ if (ClassType = TIBTransaction) AND (MethodName = 'ROLLBACK') then
+ TIBTransaction(Instance).RollBack
+ else
+ if(ClassType = TIBTransaction) AND (MethodName = 'STARTTRANSACTION') then
+ TIBTransaction(Instance).StartTransaction;
+
+end;
+
+function TFunctions.RecordCount(Instance: TObject; ClassType: TClass; const
+ PropName: String): Variant;
+begin
+ Result:=0;
+ if (ClassType = TIBQuery) AND (PropName = 'RECORDCOUNT') then
+ Result:=TIBQuery(Instance).RecordCount;
+
+end;
+
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsIBXRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/FMX/FMX.fs_iilparser.pas b/FastScript/FMX/FMX.fs_iilparser.pas
new file mode 100644
index 0000000..b8d0425
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_iilparser.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Intermediate Language parser }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iilparser;
+{$i FMX.inc}
+{$i fs_iilparser.pas}
\ No newline at end of file
diff --git a/FastScript/FMX/FMX.fs_iinirtti.pas b/FastScript/FMX/FMX.fs_iinirtti.pas
new file mode 100644
index 0000000..42561a5
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_iinirtti.pas
@@ -0,0 +1,372 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ IniFiles.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{ Copyright (c) 2004-2007 }
+{ by Stalker SoftWare }
+{ }
+{******************************************}
+
+unit FMX.fs_iinirtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, System.IniFiles, FMX.Types, System.Types;
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsIniRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass; const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass; const PropName: String): Variant;
+ procedure SaveIniFileToStream(oIniFile: TCustomIniFile; oStream: TStream);
+ procedure LoadIniFileFromStream(oIniFile :TCustomIniFile; oStream :TStream);
+ procedure WriteTStrings(oIniFile: TCustomIniFile; const Section: String; Values: TStrings; IsClear :Boolean = True);
+ procedure ReadTStrings(oIniFile: TCustomIniFile; const Section: String; Values: TStrings; IsClear :Boolean = True);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+
+ with AScript do
+ begin
+ with AddClass(TCustomIniFile, 'TObject') do
+ begin
+ AddConstructor('constructor Create(const FileName: String)', CallMethod);
+ AddMethod('function ReadInteger(const Section, Ident: String; Default: LongInt): LongInt', CallMethod);
+ AddMethod('procedure WriteInteger(const Section, Ident: String; Value: LongInt)', CallMethod);
+ AddMethod('function ReadBool(const Section, Ident: String; Default: Boolean): Boolean', CallMethod);
+ AddMethod('procedure WriteBool(const Section, Ident: String; Value: Boolean)', CallMethod);
+ AddMethod('function ReadDate(const Section, Name: String; Default: TDateTime): TDateTime', CallMethod);
+ AddMethod('procedure WriteDate(const Section, Name: String; Value: TDateTime)', CallMethod);
+ AddMethod('function ReadDateTime(const Section, Name: String; Default: TDateTime): TDateTime', CallMethod);
+ AddMethod('procedure WriteDateTime(const Section, Name: String; Value: TDateTime)', CallMethod);
+ AddMethod('function ReadFloat(const Section, Name: String; Default: Double): Double', CallMethod);
+ AddMethod('procedure WriteFloat(const Section, Name: String; Value: Double)', CallMethod);
+ AddMethod('function ReadTime(const Section, Name: String; Default: TDateTime): TDateTime', CallMethod);
+ AddMethod('procedure WriteTime(const Section, Name: String; Value: TDateTime);', CallMethod);
+{$IFDEF DELPHI6}
+ AddMethod('function ReadBinaryStream(const Section, Name: String; Value: TStream): Integer', CallMethod);
+ AddMethod('procedure WriteBinaryStream(const Section, Name: String; Value: TStream)', CallMethod);
+{$ENDIF}
+ AddMethod('function SectionExists(const Section: String): Boolean', CallMethod);
+ AddMethod('function ValueExists(const Section, Ident: String): Boolean', CallMethod);
+
+ AddMethod('procedure WriteTStrings(const Section :String; Value :TStrings; IsClear :Boolean = True)', CallMethod);
+ AddMethod('function ReadTStrings(const Section :String; Value :TStrings; IsClear :Boolean = True): String;', CallMethod);
+
+ AddProperty('FileName', 'String', GetProp);
+ end;
+
+ with AddClass(TMemIniFile, 'TCustomIniFile') do
+ begin
+ AddConstructor('constructor Create(const FileName: String)', CallMethod);
+ AddMethod('procedure WriteString(const Section, Ident, Value: String)', CallMethod);
+ AddMethod('function ReadString(const Section, Ident, Default: String): String;', CallMethod);
+{$IFDEF DELPHI6}
+ AddMethod('procedure ReadSectionValuesEx(const Section: String; Strings: TStrings)', CallMethod);
+{$ENDIF}
+ AddMethod('procedure DeleteKey(const Section, Ident: String)', CallMethod);
+ AddMethod('procedure ReadSection(const Section: String; Strings: TStrings)', CallMethod);
+ AddMethod('procedure ReadSections(Strings: TStrings)', CallMethod);
+ AddMethod('procedure ReadSectionValues(const Section: String; Strings: TStrings)', CallMethod);
+ AddMethod('procedure EraseSection(const Section: String)', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure GetStrings(List: TStrings)', CallMethod);
+ AddMethod('procedure SetStrings(List: TStrings)', CallMethod);
+ AddMethod('procedure SaveIniFileToStream(oStream: TStream)', CallMethod);
+ AddMethod('procedure LoadIniFileFromStream(oStream: TStream)', CallMethod);
+ end;
+
+ with AddClass(TIniFile, 'TCustomIniFile') do
+ begin
+ AddMethod('procedure WriteString(const Section, Ident, Value: String)', CallMethod);
+ AddMethod('function ReadString(const Section, Ident, Default: String): String;', CallMethod);
+{$IFDEF DELPHI6}
+ AddMethod('procedure ReadSectionValuesEx(const Section: String; Strings: TStrings)', CallMethod);
+{$ENDIF}
+ AddMethod('procedure DeleteKey(const Section, Ident: String)', CallMethod);
+ AddMethod('procedure ReadSection(const Section: String; Strings: TStrings)', CallMethod);
+ AddMethod('procedure ReadSections(Strings: TStrings)', CallMethod);
+ AddMethod('procedure ReadSectionValues(const Section: String; Strings: TStrings)', CallMethod);
+ AddMethod('procedure EraseSection(const Section: String)', CallMethod);
+ AddMethod('procedure SaveIniFileToStream(oStream: TStream)', CallMethod);
+ AddMethod('procedure LoadIniFileFromStream(oStream: TStream)', CallMethod);
+ end;
+
+ end;
+
+end;
+
+{$HINTS OFF}
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ oCustomIniFile: TCustomIniFile;
+ oMemIniFile: TMemIniFile;
+ oIniFile: TIniFile;
+ oList: TStrings;
+ nCou: Integer;
+
+begin
+
+ Result := 0;
+
+ if ClassType = TCustomIniFile then
+ begin
+ oCustomIniFile := TCustomIniFile(Instance);
+ if MethodName = 'CREATE' then
+ Result := frxInteger(oCustomIniFile.Create(Caller.Params[0]))
+ else if MethodName = 'WRITEINTEGER' then
+ oCustomIniFile.WriteInteger(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READINTEGER' then
+ Result := oCustomIniFile.ReadInteger(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITEBOOL' then
+ oCustomIniFile.WriteBool(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READBOOL' then
+ Result := oCustomIniFile.ReadBool(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITEDATE' then
+ oCustomIniFile.WriteDate(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READDATE' then
+ Result := oCustomIniFile.ReadDate(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITEDATETIME' then
+ oCustomIniFile.WriteDateTime(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READDATETIME' then
+ Result := oCustomIniFile.ReadDateTime(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITEFLOAT' then
+ oCustomIniFile.WriteFloat(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READFLOAT' then
+ Result := oCustomIniFile.ReadFloat(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITETIME' then
+ oCustomIniFile.WriteTime(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READTIME' then
+ Result := oCustomIniFile.ReadTime(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+{$IFDEF DELPHI6}
+ else if MethodName = 'WRITEBINARYSTREAM' then
+ oCustomIniFile.WriteBinaryStream(Caller.Params[0], Caller.Params[1], TStream(frxInteger(Caller.Params[2])))
+ else if MethodName = 'READBINARYSTREAM' then
+ Result := oCustomIniFile.ReadBinaryStream(Caller.Params[0], Caller.Params[1], TStream(frxInteger(Caller.Params[2])))
+{$ENDIF}
+ else if MethodName = 'SECTIONEXISTS' then
+ Result := oCustomIniFile.SectionExists(Caller.Params[0])
+ else if MethodName = 'VALUEEXISTS' then
+ Result := oCustomIniFile.ValueExists(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'WRITETSTRINGS' then
+ WriteTStrings(oCustomIniFile, Caller.Params[0], TStrings(frxInteger(Caller.Params[1])), Caller.Params[2])
+ else if MethodName = 'READTSTRINGS' then
+ ReadTStrings(oCustomIniFile, Caller.Params[0], TStrings(frxInteger(Caller.Params[1])), Caller.Params[2])
+
+ end;
+
+ if ClassType = TMemIniFile then
+ begin
+ oMemIniFile := TMemIniFile(Instance);
+ if MethodName = 'CREATE' then
+ Result := frxInteger(oMemIniFile.Create(Caller.Params[0]))
+ else if MethodName = 'WRITESTRING' then
+ oMemIniFile.WriteString(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READSTRING' then
+ Result := oMemIniFile.ReadString(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'DELETEKEY' then
+ oMemIniFile.DeleteKey(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'READSECTION' then
+ oMemIniFile.ReadSection(Caller.Params[0], TStrings(frxInteger(Caller.Params[1])))
+ else if MethodName = 'READSECTIONS' then
+ oMemIniFile.ReadSections(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'READSECTIONVALUES' then
+ oMemIniFile.ReadSectionValues(Caller.Params[0], TStrings(frxInteger(Caller.Params[1])))
+ else if MethodName = 'ERASESECTION' then
+ oMemIniFile.EraseSection(Caller.Params[0])
+{$IFDEF DELPHI6}
+ else if MethodName = 'READSECTIONVALUESEX' then
+ begin
+ oList := TStringList.Create;
+ try
+ oMemIniFile.ReadSectionValues(Caller.Params[0], oList);
+ TStrings(frxInteger(Caller.Params[1])).Clear;
+ for nCou := 0 to oList.Count-1 do
+// TStrings(frxInteger(Caller.Params[1])).Add(oList.ValueFromIndex[nCou]);
+ TStrings(frxInteger(Caller.Params[1])).Add(oList.Values[oList.Names[nCou]]);
+ finally
+ oList.Free;
+ end;
+ end
+{$ENDIF}
+ else if MethodName = 'CLEAR' then
+ oMemIniFile.Clear
+ else if MethodName = 'GETSTRINGS' then
+ oMemIniFile.GetStrings(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SETSTRINGS' then
+ oMemIniFile.SetStrings(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVEINIFILETOSTREAM' then
+ SaveIniFileToStream(oMemIniFile, TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LOADINIFILEFROMSTREAM' then
+ LoadIniFileFromStream(oMemIniFile, TStream(frxInteger(Caller.Params[0])))
+ end;
+
+ if ClassType = TIniFile then
+ begin
+ oIniFile := TIniFile(Instance);
+ if MethodName = 'WRITESTRING' then
+ oIniFile.WriteString(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READSTRING' then
+ Result := oIniFile.ReadString(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'DELETEKEY' then
+ oIniFile.DeleteKey(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'READSECTION' then
+ oIniFile.ReadSection(Caller.Params[0], TStrings(frxInteger(Caller.Params[1])))
+ else if MethodName = 'READSECTIONS' then
+ oIniFile.ReadSections(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'READSECTIONVALUES' then
+ oIniFile.ReadSectionValues(Caller.Params[0], TStrings(frxInteger(Caller.Params[1])))
+ else if MethodName = 'ERASESECTION' then
+ oIniFile.EraseSection(Caller.Params[0])
+{$IFDEF DELPHI6}
+ else if MethodName = 'READSECTIONVALUESEX' then
+ begin
+ oList := TStringList.Create;
+ try
+ oIniFile.ReadSectionValues(Caller.Params[0], oList);
+ TStrings(frxInteger(Caller.Params[1])).Clear;
+ for nCou := 0 to oList.Count-1 do
+// TStrings(frxInteger(Caller.Params[1])).Add(oList.ValueFromIndex[nCou]);
+ TStrings(frxInteger(Caller.Params[1])).Add(oList.Values[oList.Names[nCou]]);
+ finally
+ oList.Free;
+ end;
+ end
+{$ENDIF}
+ else if MethodName = 'SAVEINIFILETOSTREAM' then
+ SaveIniFileToStream(oIniFile, TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LOADINIFILEFROMSTREAM' then
+ LoadIniFileFromStream(oIniFile, TStream(frxInteger(Caller.Params[0])))
+ end;
+
+end;
+{$HINTS ON}
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass; const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TCustomIniFile then
+ begin
+ if PropName = 'FILENAME' then
+ Result := TIniFile(Instance).FileName
+ end;
+end;
+
+procedure TFunctions.SaveIniFileToStream(oIniFile :TCustomIniFile; oStream :TStream);
+var
+ oStrings :TStrings;
+
+begin
+
+ if (not Assigned(oIniFile)) or (not Assigned(oStream)) then Exit;
+
+ if not ((oIniFile is TIniFile) or (oIniFile is TMemIniFile)) then Exit;
+
+ oStrings:= TStringList.Create;
+ try
+
+ if oIniFile is TIniFile then
+ oStrings.LoadFromFile(oIniFile.FileName)
+ else
+ if oIniFile is TMemIniFile then
+ TMemIniFile(oIniFile).GetStrings(oStrings);
+
+ oStrings.SaveToStream(oStream);
+
+ finally
+ oStrings.Free;
+ end;
+
+end;
+
+procedure TFunctions.LoadIniFileFromStream(oIniFile :TCustomIniFile; oStream :TStream);
+var
+ oStrings :TStrings;
+
+begin
+
+ if (not Assigned(oIniFile)) or (not Assigned(oStream)) then Exit;
+
+ if not ((oIniFile is TIniFile) or (oIniFile is TMemIniFile)) then Exit;
+
+ oStrings:= TStringList.Create;
+ try
+
+ oStrings.LoadFromStream(oStream);
+
+ if oIniFile is TIniFile then
+ oStrings.SaveToFile(oIniFile.FileName)
+ else
+ if oIniFile is TMemIniFile then
+ TMemIniFile(oIniFile).SetStrings(oStrings);
+
+ finally
+ oStrings.Free;
+ end;
+
+end;
+
+procedure TFunctions.WriteTStrings(oIniFile :TCustomIniFile; const Section :String; Values :TStrings; IsClear :Boolean = True);
+var
+ nCou :Integer;
+
+begin
+
+ if IsClear then oIniFile.EraseSection(Section);
+
+ for nCou := 0 to Values.Count-1 do
+ oIniFile.WriteString(Section, 'Items'+IntToStr(nCou), Values[nCou]);
+
+ oIniFile.WriteInteger(Section, 'Count', Values.Count);
+
+end;
+
+procedure TFunctions.ReadTStrings(oIniFile :TCustomIniFile; const Section :String; Values :TStrings; IsClear :Boolean = True);
+var
+ nCou, nCount :Integer;
+
+begin
+
+ nCount := oIniFile.ReadInteger(Section, 'Count', 0);
+
+ if IsClear then Values.Clear;
+
+ for nCou := 0 to nCount-1 do
+ Values.Add(oIniFile.ReadString(Section, 'Items'+IntToStr(nCou), ''));
+
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsIniRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/FMX/FMX.fs_iinterpreter.pas b/FastScript/FMX/FMX.fs_iinterpreter.pas
new file mode 100644
index 0000000..0953f64
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_iinterpreter.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Main module }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iinterpreter;
+{$i FMX.inc}
+{$i fs_iinterpreter.pas}
\ No newline at end of file
diff --git a/FastScript/FMX/FMX.fs_ijs.pas b/FastScript/FMX/FMX.fs_ijs.pas
new file mode 100644
index 0000000..4b321a6
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_ijs.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ JScript grammar }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_ijs;
+{$i FMX.inc}
+{$i fs_ijs.pas}
\ No newline at end of file
diff --git a/FastScript/FMX/FMX.fs_imenusrtti.pas b/FastScript/FMX/FMX.fs_imenusrtti.pas
new file mode 100644
index 0000000..fe9b172
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_imenusrtti.pas
@@ -0,0 +1,104 @@
+{**********************************************}
+{ }
+{ FastScript v1.9 }
+{ Menus }
+{ }
+{ Copyright (c) 1998-2011 }
+{ by Fast Reports Inc. }
+{ }
+{**********************************************}
+
+unit FMX.fs_imenusrtti;
+
+interface
+
+{$I fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Menus, FMX.fs_iinterpreter, FMX.fs_ievents, System.Types, System.Variants, FMX.Types;
+
+type
+{$i frxPlatformsAttribute.inc}
+
+ TfsMenusRTTI = class(TComponent); // fake component
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass; const MethodName:
+ string; Caller: TfsMethodHelper): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+
+ with AScript do
+ begin
+
+ AddType('TPopupAlignment', fvtInt);
+
+
+ with AddClass(TMenuItem, 'TTextControl') do
+ begin
+ AddMethod('procedure Popup', CallMethod);
+ AddMethod('procedure NeedPopup', CallMethod);
+ AddMethod('function HavePopup: Boolean', CallMethod);
+ end; { with }
+
+ with AddClass(TMainMenu, 'TFmxObject') do
+ with AddClass(TMenuBar, 'TStyledControl') do
+ AddMethod('procedure StartMenuLoop', CallMethod);
+
+ with AddClass(TPopupMenu, 'TFmxObject') do
+ AddMethod('procedure Popup(X, Y: Single)', CallMethod);
+
+ end; { with }
+
+end; { Create }
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; const
+ MethodName: string; Caller: TfsMethodHelper): Variant;
+var
+ oMenuItem: TMenuItem;
+begin
+ Result := 0;
+
+ if ClassType = TMenuItem then
+ begin
+
+ oMenuItem := TMenuItem(Instance);
+
+ if MethodName = 'POPUP' then
+ oMenuItem.Popup
+ else if MethodName = 'NEEDPOPUP' then
+ oMenuItem.NeedPopup
+ else if MethodName = 'HAVEPOPUP' then
+ Result := oMenuItem.HavePopup;
+
+ end
+ else if ClassType = TPopupMenu then
+ begin
+
+ if MethodName = 'POPUP' then
+ TPopupMenu(Instance).Popup(Caller.Params[0], Caller.Params[1]);
+
+ end;
+end; { CallMethod }
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsMenusRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
+
diff --git a/FastScript/FMX/FMX.fs_iparser.pas b/FastScript/FMX/FMX.fs_iparser.pas
new file mode 100644
index 0000000..b922d9e
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_iparser.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Parser }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iparser;
+{$i FMX.inc}
+{$i fs_iparser.pas}
\ No newline at end of file
diff --git a/FastScript/FMX/FMX.fs_ipascal.pas b/FastScript/FMX/FMX.fs_ipascal.pas
new file mode 100644
index 0000000..33f4f12
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_ipascal.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Pascal grammar }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_ipascal;
+{$i FMX.inc}
+{$i fs_ipascal.pas}
\ No newline at end of file
diff --git a/FastScript/FMX/FMX.fs_isysrtti.pas b/FastScript/FMX/FMX.fs_isysrtti.pas
new file mode 100644
index 0000000..b1405ee
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_isysrtti.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Standard functions }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_isysrtti;
+{$i FMX.inc}
+{$i fs_isysrtti.pas}
\ No newline at end of file
diff --git a/FastScript/FMX/FMX.fs_itools.pas b/FastScript/FMX/FMX.fs_itools.pas
new file mode 100644
index 0000000..871b7c6
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_itools.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Common functions }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_itools;
+{$i FMX.inc}
+{$i fs_itools.pas}
\ No newline at end of file
diff --git a/FastScript/FMX/FMX.fs_lazarus.pas b/FastScript/FMX/FMX.fs_lazarus.pas
new file mode 100644
index 0000000..7c4d3a2
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_lazarus.pas
@@ -0,0 +1,25 @@
+{ This file was automatically created by Lazarus. do not edit!
+ This source is only used to compile and install the package.
+ }
+
+unit fs_lazarus;
+
+interface
+
+uses
+ fs_ipascal, fs_icpp, fs_ijs, fs_ibasic, fs_iclassesrtti, fs_iconst,
+ fs_idialogsrtti, fs_ievents, fs_iexpression, fs_iextctrlsrtti,
+ fs_iformsrtti, fs_igraphicsrtti, fs_iilparser, fs_iinirtti, fs_iinterpreter,
+ fs_iparser, fs_isysrtti, fs_itools, fs_xml, fs_ireg, fs_synmemo, fs_tree,
+ LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+ RegisterUnit('fs_ireg', @fs_ireg.Register);
+end;
+
+initialization
+ RegisterPackage('fs_lazarus', @Register);
+end.
diff --git a/FastScript/FMX/FMX.fs_synmemo.fmx b/FastScript/FMX/FMX.fs_synmemo.fmx
new file mode 100644
index 0000000..da0b5ed
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_synmemo.fmx
@@ -0,0 +1,50 @@
+object fsSynMemoSearch: TfsSynMemoSearch
+ Left = 0
+ Top = 0
+ BorderStyle = bsToolWindow
+ Caption = 'Search for text'
+ ClientHeight = 129
+ ClientWidth = 249
+ Position = poScreenCenter
+ FormFactor.Width = 320
+ FormFactor.Height = 480
+ FormFactor.Devices = [dkDesktop, dkiPhone, dkiPad]
+ DesignerMobile = False
+ DesignerWidth = 0
+ DesignerHeight = 0
+ DesignerDeviceName = ''
+ DesignerOrientation = 0
+ object Edit1: TEdit
+ TabOrder = 0
+ Position.X = 48.000000000000000000
+ Position.Y = 13.000000000000000000
+ Width = 193.000000000000000000
+ Height = 22.000000000000000000
+ KillFocusByReturn = False
+ end
+ object Label1: TLabel
+ Height = 15.000000000000000000
+ Position.X = 8.000000000000000000
+ Position.Y = 16.000000000000000000
+ Text = 'Search :'
+ Width = 49.000000000000000000
+ end
+ object Search: TButton
+ Height = 17.000000000000000000
+ ModalResult = 1
+ Position.X = 88.000000000000000000
+ Position.Y = 48.000000000000000000
+ TabOrder = 2
+ Text = 'Search'
+ Width = 73.000000000000000000
+ end
+ object Button1: TButton
+ Height = 17.000000000000000000
+ ModalResult = 2
+ Position.X = 168.000000000000000000
+ Position.Y = 48.000000000000000000
+ TabOrder = 3
+ Text = 'Cancel'
+ Width = 73.000000000000000000
+ end
+end
diff --git a/FastScript/FMX/FMX.fs_synmemo.pas b/FastScript/FMX/FMX.fs_synmemo.pas
new file mode 100644
index 0000000..4b4f2c4
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_synmemo.pas
@@ -0,0 +1,2397 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Syntax memo FMX control }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+{ Simple syntax highlighter. Supports Pascal, C++, JS, VB and SQL syntax.
+
+ Assign text to Text property.
+ Assign desired value to SyntaxType property.
+ Call SetPos to move caret.
+ Call ShowMessage to display an error message at the bottom.
+}
+
+unit FMX.fs_synmemo;
+
+interface
+
+{$I fs.inc}
+{$I fmx.inc}
+
+uses
+ System.Classes, System.Variants, System.UIConsts, System.SysUtils, System.UITypes, System.Types,
+ FMX.Controls, FMX.Forms, FMX.Menus, FMX.Types, FMX.Edit, FMX.Platform, FMX.TreeView
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Text
+{$ENDIF}
+{$IFDEF DELPHI29}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+ TSyntaxType = (stPascal, stCpp, stJs, stVB, stSQL, stText);
+ TCharAttr = (caNo, caText, caBlock, caComment, caKeyword, caString);
+ TCharAttributes = set of TCharAttr;
+
+type
+ TfsBorderSettings = class(TPersistent)
+ private
+ FFill: TBrush;
+ FWidth: Integer;
+ private
+ procedure SetFill(const Value: TBrush);
+ procedure SetWidth(const Value: Integer);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ published
+ property Fill: TBrush read FFill write SetFill;
+ property Width: Integer read FWidth write SetWidth;
+ end;
+
+ TfsFontSettings = class(TPersistent)
+ private
+ FFill: TBrush;
+ FFont: TFont;
+ procedure SetFill(const Value: TBrush);
+ procedure SetFont(const Value: TFont);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Fill: TBrush read FFill write SetFill;
+ property Font: TFont read FFont write SetFont;
+ end;
+
+{$i frxPlatformsAttribute.inc}
+ TfsSyntaxMemo = class(TStyledControl{$IFDEF DELPHI18}, ICaret{$ENDIF})
+ private
+{$IFDEF DELPHI18}
+ FCaret: TCaret;
+{$ENDIF}
+ FBorder: TfsBorderSettings;
+ FFill: TBrush;
+ FFontSettings: TfsFontSettings;
+ FGutterFill: TBrush;
+ FAllowLinesChange: Boolean;
+ FCharHeight: Single;
+ FCharWidth: Single;
+ FDoubleClicked: Boolean;
+ FDown: Boolean;
+ FGutterWidth: Integer;
+ FFooterHeight: Integer;
+ FIsMonoType: Boolean;
+ FKeywords: String;
+ FMaxLength: Integer;
+ FMessage: String;
+ FModified: Boolean;
+ FMoved: Boolean;
+ FOffset: TPoint;
+ FPos: TPoint;
+ FReadOnly: Boolean;
+ FSelEnd: TPoint;
+ FSelStart: TPoint;
+ FSynStrings: TStrings;
+ FSyntaxType: TSyntaxType;
+ FTempPos: TPoint;
+ FText: TStringList;
+ FKeywordAttr: TfsFontSettings;
+ FStringAttr: TfsFontSettings;
+ FTextAttr: TfsFontSettings;
+ FCommentAttr: TfsFontSettings;
+ FBlockColor: TAlphaColor;
+ FBlockFontColor: TAlphaColor;
+ FUndo: TStringList;
+ FUpdating: Boolean;
+ FUpdatingSyntax: Boolean;
+ FVScroll: TScrollBar;
+ FWindowSize: TPoint;
+ FPopupMenu: TPopupMenu;
+ KWheel: Integer;
+ LastSearch: String;
+ FShowGutter: boolean;
+ FShowFooter: boolean;
+ Bookmarks: array of Integer;
+ FActiveLine: Integer;
+ FOnChange: TNotifyEvent;
+ FTmpCanvas: TBitmap;
+ procedure CalcCharSize;
+ function GetCharWidth(Str: String): Single;
+ function GetText: TStrings;
+ procedure SetText(Value: TStrings);
+ procedure SetSyntaxType(Value: TSyntaxType);
+ procedure SetShowGutter(Value: boolean);
+ procedure SetShowFooter(Value: boolean);
+ function FMemoFind(Text: String; var Position : TPoint): boolean;
+ function GetCharAttr(Pos: TPoint): TCharAttributes;
+ function GetLineBegin(Index: Integer): Integer;
+ function GetPlainTextPos(Pos: TPoint): Integer;
+ function GetPosPlainText(Pos: Integer): TPoint;
+ function GetSelText: String;
+ function LineAt(Index: Integer): String;
+ function LineLength(Index: Integer): Integer;
+ function Pad(n: Integer): String;
+ procedure AddSel;
+ procedure AddUndo;
+ procedure ClearSel;
+ procedure CreateSynArray;
+ procedure DoChange;
+ procedure EnterIndent;
+ procedure SetSelText(Value: String);
+ procedure ShiftSelected(ShiftRight: Boolean);
+ procedure ShowCaretPos;
+ procedure TabIndent;
+ procedure UnIndent;
+ procedure UpdateScrollBar;
+ procedure UpdateSyntax;
+ procedure DoLeft;
+ procedure DoRight;
+ procedure DoUp;
+ procedure DoDown;
+ procedure DoHome(Ctrl: Boolean);
+ procedure DoEnd(Ctrl: Boolean);
+ procedure DoPgUp;
+ procedure DoPgDn;
+ procedure DoChar(Ch: Char);
+ procedure DoReturn;
+ procedure DoDel;
+ procedure DoBackspace;
+ procedure DoCtrlI;
+ procedure DoCtrlU;
+ procedure DoCtrlR;
+ procedure DoCtrlL;
+ procedure ScrollClick(Sender: TObject);
+ procedure ScrollEnter(Sender: TObject);
+ procedure LinesChange(Sender: TObject);
+ procedure ShowPos;
+ procedure BookmarkDraw(Y :Single; ALine : integer);
+ procedure ActiveLineDraw(Y :Single; ALine : integer);
+ procedure CorrectBookmark(Line : integer; delta : integer);
+ procedure SetKeywordAttr(Value: TfsFontSettings);
+ procedure SetStringAttr(Value: TfsFontSettings);
+ procedure SetTextAttr(Value: TfsFontSettings);
+ procedure SetCommentAttr(Value: TfsFontSettings);
+ procedure SetBorder(const Value: TfsBorderSettings);
+ procedure SetFill(const Value: TBrush);
+ procedure SetFontSettings(const Value: TfsFontSettings);
+ procedure SetGutterFill(const Value: TBrush);
+ protected
+ procedure SetParent(const Value: TFmxObject); override;
+ function GetClientRect: TRectF;
+ procedure DblClick; override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
+ procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
+ procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
+ procedure CopyPopup(Sender: TObject);
+ procedure PastePopup(Sender: TObject);
+ procedure CutPopup(Sender: TObject);
+ procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override;
+ procedure DOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+ procedure DDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+ procedure DoExit; override;
+ procedure Resize; override;
+ procedure UpdateWindowSize;
+ procedure FontChanged(Sender: TObject);
+ procedure DialogKey(var Key: Word; Shift: TShiftState); override;
+{$IFDEF Delphi18}
+ function ICaret.GetObject = GetCaret;
+ function GetCaret: TCustomCaret;
+ procedure SetCaret(const Value: TCaret);
+ procedure ShowCaret;
+ procedure HideCaret;
+{$ENDIF}
+{$IFDEF Delphi17}
+ function CreateCaret: TCaret; {$IFNDEF Delphi18} override; {$ENDIF}
+{$ENDIF}
+ procedure SetAttr(aCanvas: TCanvas; a: TCharAttributes);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Paint; override;
+ procedure CopyToClipboard;
+ procedure CutToClipboard;
+ procedure PasteFromClipboard;
+ procedure SetPos(x, y: Integer);
+ procedure ShowMessage(s: String);
+ procedure Undo;
+ procedure UpdateView;
+ function GetPos: TPoint;
+ function Find(Text: String): boolean;
+ property Modified: Boolean read FModified write FModified;
+ property SelText: String read GetSelText write SetSelText;
+ function IsBookmark(Line : integer): integer;
+ procedure AddBookmark(Line, Number : integer);
+ procedure DeleteBookmark(Number : integer);
+ procedure GotoBookmark(Number : integer);
+ procedure SetActiveLine(Line : Integer);
+ function GetActiveLine: Integer;
+{$IFDEF Delphi18}
+ property Caret: TCaret read FCaret write SetCaret;
+{$ENDIF}
+ published
+ property Align;
+ property Anchors;
+ property DragMode;
+ property Enabled;
+ property PopupMenu;
+ property ShowHint;
+ property TabOrder;
+ property Width;
+ property Height;
+ property Visible;
+{$IFDEF Delphi18}
+ property Cursor;
+{$ENDIF}
+ property BlockColor: TAlphaColor read FBlockColor write FBlockColor;
+ property BlockFontColor: TAlphaColor read FBlockFontColor write FBlockFontColor;
+ property CommentAttr: TfsFontSettings read FCommentAttr write SetCommentAttr;
+ property KeywordAttr: TfsFontSettings read FKeywordAttr write SetKeywordAttr;
+ property StringAttr: TfsFontSettings read FStringAttr write SetStringAttr;
+ property TextAttr: TfsFontSettings read FTextAttr write SetTextAttr;
+ property Border: TfsBorderSettings read FBorder write SetBorder;
+ property Fill: TBrush read FFill write SetFill;
+ property FontSettings: TfsFontSettings read FFontSettings write SetFontSettings;
+ property GutterFill: TBrush read FGutterFill write SetGutterFill;
+ property Lines: TStrings read GetText write SetText;
+ property ReadOnly: Boolean read FReadOnly write FReadOnly;
+ property SyntaxType: TSyntaxType read FSyntaxType write SetSyntaxType;
+ property ShowFooter: boolean read FShowFooter write SetShowFooter;
+ property ShowGutter: boolean read FShowGutter write SetShowGutter;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ property OnClick;
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfsSynMemoSearch = class(TForm)
+ Search: TButton;
+ Button1: TButton;
+ Label1: TLabel;
+ Edit1: TEdit;
+ procedure FormKeyPress(Sender: TObject; var Key: Char);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ SynMemoSearch: TfsSynMemoSearch;
+
+implementation
+
+{$R *.FMX}
+{$IFDEF DELPHI18}
+type THachCaret = class(TCaret);
+{$ENDIF}
+
+const
+ PasKeywords =
+ 'and,array,begin,case,const,div,do,downto,else,end,except,finally,'+
+ 'for,function,if,in,is,mod,nil,not,of,or,procedure,program,repeat,shl,'+
+ 'shr,string,then,to,try,until,uses,var,while,with,xor';
+
+ CppKeywords =
+ 'bool,break,case,char,continue,define,default,delete,do,double,else,'+
+ 'except,finally,float,for,if,include,int,is,new,return,string,switch,try,'+
+ 'variant,void,while';
+
+ SQLKeywords =
+ 'active,after,all,alter,and,any,as,asc,ascending,at,auto,' +
+ 'base_name,before,begin,between,by,cache,cast,check,column,commit,' +
+ 'committed,computed,conditional,constraint,containing,count,create,' +
+ 'current,cursor,database,debug,declare,default,delete,desc,descending,' +
+ 'distinct,do,domain,drop,else,end,entry_point,escape,exception,execute,' +
+ 'exists,exit,external,extract,filter,for,foreign,from,full,function,' +
+ 'generator,grant,group,having,if,in,inactive,index,inner,insert,into,is,' +
+ 'isolation,join,key,left,level,like,merge,names,no,not,null,of,on,only,' +
+ 'or,order,outer,parameter,password,plan,position,primary,privileges,' +
+ 'procedure,protected,read,retain,returns,revoke,right,rollback,schema,' +
+ 'select,set,shadow,shared,snapshot,some,suspend,table,then,to,' +
+ 'transaction,trigger,uncommitted,union,unique,update,user,using,values,' +
+ 'view,wait,when,where,while,with,work';
+
+ JSKeywords =
+ 'break,case,continue,default,delete,do,else,except,finally,for,function,' +
+ 'import,in,is,if,new,return,switch,try,var,while,with';
+
+ VBKeywords =
+ 'addressof,and,as,byref,byval,case,catch,delete,dim,do,else,elseif,' +
+ 'end,endif,exit,finally,for,function,if,imports,is,loop,mod,new,next,' +
+ 'not,or,rem,return,select,set,step,sub,then,to,try,wend,while,with,xor';
+
+
+ WordChars = ['a'..'z', 'A'..'Z', '0'..'9', '_'];
+ LineBreak: AnsiString = sLineBreak;
+
+function IsUnicodeChar(Chr: Char): Boolean;
+begin
+ Result := ((Chr >= Char($007F)) and (Chr <= Char($FFFF)));
+end;
+
+
+{ TfsSyntaxMemo }
+
+constructor TfsSyntaxMemo.Create(AOwner: TComponent);
+var
+ m: TMenuItem;
+ i: integer;
+begin
+ inherited Create(AOwner);
+ FTmpCanvas := TBitmap.Create(1, 1);
+{$IFDEF DELPHI18}
+ FCaret := CreateCaret;
+{$ENDIF}
+ FVScroll := TScrollBar.Create(Self);
+ FVScroll.Stored := False;
+ FVScroll.Orientation := TOrientation.orVertical;
+
+ FFontSettings := TfsFontSettings.Create;
+ FFontSettings.Font.OnChanged := FontChanged;
+ FFontSettings.Fill.Color := TAlphaColorRec.Black;
+
+ FCommentAttr := TfsFontSettings.Create;
+ FCommentAttr.Fill.Color := TAlphaColorRec.Green;
+ FCommentAttr.Font.Style := [TFontStyle.fsItalic];
+
+ FKeywordAttr := TfsFontSettings.Create;
+ FKeywordAttr.FFill.Color := TAlphaColorRec.Navy;
+ FKeywordAttr.Font.Style := [TFontStyle.fsBold];
+
+ FStringAttr := TfsFontSettings.Create;
+ FStringAttr.Fill.Color := TAlphaColorRec.Navy;
+ FStringAttr.Font.Style := [];
+
+ FTextAttr := TfsFontSettings.Create;
+ FTextAttr.Fill.Color := TAlphaColorRec.Black;
+ FTextAttr.Font.Style := [];
+
+ FBorder := TfsBorderSettings.Create;
+ FFill := TBrush.Create(TBrushKind.bkSolid, TAlphaColorRec.White);
+ FGutterFill := TBrush.Create(TBrushKind.bkSolid, TAlphaColorRec.Whitesmoke);
+
+ if AOwner is TFmxObject then
+ Parent := AOwner as TFmxObject;
+
+ OnDragOver := DOver;
+ OnDragDrop := DDrop;
+ KWheel := -1;
+
+
+ FText := TStringList.Create;
+ FUndo := TStringList.Create;
+ FSynStrings := TStringList.Create;
+ FText.Add('');
+ FText.OnChange := LinesChange;
+ FMaxLength := 1024;
+ SyntaxType := stPascal;
+ FMoved := True;
+ SetPos(1, 1);
+ FOffset := Point(0, 0);
+ CanFocus := True;
+ Cursor := crIBeam;
+
+ FBlockColor := TAlphaColorRec.Blue;
+ FBlockFontColor := TAlphaColorRec.White;
+
+ FPopupMenu := TPopupMenu.Create(Self);
+ m := TMenuItem.Create(FPopupMenu);
+ m.Text := 'Cut';
+ m.OnClick := CutPopup;
+ FPopupMenu.AddObject(m);
+ m := TMenuItem.Create(FPopupMenu);
+ m.Text := 'Copy';
+ m.OnClick := CopyPopup;
+ FPopupMenu.AddObject(m);
+ m := TMenuItem.Create(FPopupMenu);
+ m.Text := 'Paste';
+ m.OnClick := PastePopup;
+ FPopupMenu.AddObject(m);
+
+ LastSearch := '';
+ Setlength(Bookmarks, 10);
+ for i := 0 to Length(Bookmarks)-1 do
+ Bookmarks[i] := -1;
+
+ FActiveLine := -1;
+
+ Height := 200;
+ Width := 200;
+ CalcCharSize;
+end;
+
+destructor TfsSyntaxMemo.Destroy;
+begin
+ FPopupMenu.Free;
+ FCommentAttr.Free;
+ FKeywordAttr.Free;
+ FStringAttr.Free;
+ FFontSettings.Free;
+ FTextAttr.Free;
+ FText.Free;
+ FUndo.Free;
+ FSynStrings.Free;
+ //FVScroll.Free;
+ FFill.Free;
+ FBorder.Free;
+ FGutterFill.Free;
+{$IFDEF DELPHI18}
+ FCaret.Free;
+{$ENDIF}
+ FreeAndNil(FTmpCanvas);
+ inherited;
+end;
+
+procedure TfsSyntaxMemo.CalcCharSize;
+var
+ tmpBmp: TBitmap;
+ r: TRectF;
+begin
+ tmpBmp := TBitmap.Create(1, 1);
+ with tmpBmp.Canvas do
+ begin
+ Font.Assign(FFontSettings.Font);
+ Font.Style := [];
+ r := RectF(0, 0, 1000, 1000);
+ MeasureText(r, 'WWWWWW', True, [], TTextAlign.taLeading); // taLeading returns incorrect results in xe2
+ FCharHeight := r.Height + 2;
+ FCharWidth := r.Width / 6;
+ FIsMonoType := Pos('COURIER NEW', AnsiUppercase(FFontSettings.Font.Family)) <> 0;
+ end;
+ tmpBmp.Free;
+end;
+
+{$IFDEF Delphi17}
+function TfsSyntaxMemo.CreateCaret: TCaret;
+begin
+ Result := TCaret.Create(Self);
+ Result.Visible := True;
+{$IFDEF DELPHI20}
+ Result.ReadOnly := False;
+ Result.Color := claBlack;
+{$ENDIF}
+ Result.Pos := TPointF.Create(1, 1);
+end;
+{$ENDIF}
+
+{$IFDEF DELPHI18}
+function TfsSyntaxMemo.GetCaret: TCustomCaret;
+begin
+ Result := FCaret;
+end;
+
+procedure TfsSyntaxMemo.SetCaret(const Value: TCaret);
+begin
+ if Assigned(FCaret) then
+ FCaret.Assign(Value);
+end;
+
+procedure TfsSyntaxMemo.ShowCaret;
+begin
+ THachCaret(FCaret).Show;
+end;
+
+procedure TfsSyntaxMemo.HideCaret;
+begin
+ THachCaret(FCaret).Hide;
+end;
+{$ENDIF}
+
+procedure TfsSyntaxMemo.ShowCaretPos;
+var
+ cWidth: Single;
+ LineLen: Integer;
+begin
+ cWidth := GetCharWidth(Copy(LineAt(FPos.Y - 1), FOffset.X, FPos.X - 1 - FOffset.X));
+ LineLen := LineLength(FPos.Y - 1);
+ if LineLen < FPos.X then
+ cWidth := Round(cWidth + FCharWidth * (FPos.X - 1 - LineLen));
+{$IFNDEF Delphi18}
+{$IFDEF Delphi17}
+ if IsFocused then
+ begin
+ CaretVisible := False;
+ SetCaretParams(PointF(
+ FCharWidth * (FPos.X - 1 - FOffset.X) + FGutterWidth + FBorder.Width + 1,
+ FCharHeight * (FPos.Y - 1 - FOffset.Y) + 1),
+ PointF(2, FCharHeight), claBlack);
+ CaretVisible := True;
+ end
+ else
+ CaretVisible := False;
+{$ELSE}
+ if IsFocused then
+ begin
+ SetCaretSize(PointF(2, FCharHeight));
+ SetCaretPos(PointF(
+ FCharWidth * (FPos.X - 1 - FOffset.X) + FGutterWidth + FBorder.Width + 1,
+ FCharHeight * (FPos.Y - 1 - FOffset.Y) + 1));
+ ShowCaretProc;
+ end
+ else
+ HideCaret;
+{$ENDIF}
+{$ELSE}
+ if IsFocused then
+ begin
+ //SetCaretSize(PointF(2, FCharHeight));
+ FCaret.Size := PointF(2, FCharHeight);
+ FCaret.Pos := PointF(
+ cWidth + FGutterWidth + FBorder.Width + 1,
+ FCharHeight * (FPos.Y - 1 - FOffset.Y) + 1);
+ ShowCaret;
+// SetCaretPos(PointF(
+// FCharWidth * (FPos.X - 1 - FOffset.X) + FGutterWidth + FBorder.Width + 1,
+// FCharHeight * (FPos.Y - 1 - FOffset.Y) + 1));
+// ShowCaretProc;
+ end
+ else
+ HideCaret;
+{$ENDIF}
+end;
+
+procedure TfsSyntaxMemo.ShowPos;
+var
+ cRect: TRectF;
+begin
+ if FFooterHeight > 0 then
+ with Canvas do
+ begin
+ Font.Family := 'Tahoma';
+ Font.Style := [];
+ Font.Size := 11;
+ Fill.Color := TAlphaColorRec.Black;
+ cRect := GetClientRect;
+ FillText(RectF(cRect.Left + FGutterWidth + 2, cRect.Bottom - TextHeight('|') - 8,
+ FGutterWidth + 4 + FCharWidth * 10 ,
+ (Self.Height - TextHeight('|') - 4) + FCharHeight), IntToStr(FPos.y)
+ + ' : ' + IntToStr(FPos.x) + ' ', FALSE, 1, [], TTextAlign.taLeading);
+ end;
+end;
+
+procedure TfsSyntaxMemo.SetParent(const Value: TFmxObject);
+begin
+ inherited SetParent(Value);
+ if (Parent = nil) or (csDestroying in ComponentState) then Exit;
+ ShowGutter := True;
+ ShowFooter := True;
+ FVScroll.Parent := Self;
+ FVScroll.OnChange := ScrollClick;
+ FVScroll.OnEnter := ScrollEnter;
+end;
+
+function TfsSyntaxMemo.GetClientRect: TRectF;
+begin
+ if FVScroll.Visible then
+ Result := RectF(FBorder.Width, FBorder.Width,
+ Width - FVScroll.Width - FBorder.Width,
+ Height - FBorder.Width)
+ else
+ Result := RectF(FBorder.Width, FBorder.Width,
+ Width - FBorder.Width, Height - FBorder.Width);
+end;
+
+procedure TfsSyntaxMemo.UpdateSyntax;
+begin
+ CreateSynArray;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.UpdateScrollBar;
+begin
+ with FVScroll do
+ begin
+// prevent OnScroll event
+ FUpdating := True;
+
+ Value := 0;
+ ViewportSize := 0;
+
+ Max := FText.Count;
+ SmallChange := 1;
+ if FWindowSize.Y < Max then
+ begin
+ Visible := True;
+ ViewportSize := FWindowSize.Y;
+ end
+ else
+ Visible := False;
+ ViewportSize := FWindowSize.Y;
+ Value := FOffset.Y;
+
+ FUpdating := False;
+ end;
+end;
+
+function TfsSyntaxMemo.GetText: TStrings;
+var
+ i: Integer;
+begin
+ for i := 0 to FText.Count - 1 do
+ FText[i] := LineAt(i);
+ Result := FText;
+ FAllowLinesChange := True;
+end;
+
+procedure TfsSyntaxMemo.SetText(Value: TStrings);
+begin
+ FAllowLinesChange := True;
+ FText.Assign(Value);
+end;
+
+procedure TfsSyntaxMemo.SetSyntaxType(Value: TSyntaxType);
+begin
+ FSyntaxType := Value;
+ if Value = stPascal then
+ FKeywords := PasKeywords
+ else if Value = stCpp then
+ FKeywords := CppKeywords
+ else if Value = stSQL then
+ FKeywords := SQLKeywords
+ else if Value = stVB then
+ FKeywords := VBKeywords
+ else if Value = stJS then
+ FKeywords := JSKeywords
+ else
+ FKeywords := '';
+ UpdateSyntax;
+end;
+
+function TfsSyntaxMemo.GetPos: TPoint;
+begin
+ Result := FPos;
+end;
+
+procedure TfsSyntaxMemo.DoChange;
+begin
+ FModified := True;
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+end;
+
+procedure TfsSyntaxMemo.LinesChange(Sender: TObject);
+begin
+ if FAllowLinesChange then
+ begin
+ UpdateSyntax;
+ FAllowLinesChange := False;
+ if FText.Count = 0 then
+ FText.Add('');
+ FMoved := True;
+ FUndo.Clear;
+ FPos := Point(1, 1);
+ FOffset := Point(0, 0);
+ SetPos(FPos.X, FPos.Y);
+ ClearSel;
+ ShowCaretPos;
+ UpdateScrollBar;
+ end;
+end;
+
+procedure TfsSyntaxMemo.ShowMessage(s: String);
+begin
+ FMessage := s;
+ Repaint;
+end;
+
+procedure SetClipboard(const Value: String);
+{$IFDEF Delphi17}
+var
+ ClipService: IFMXClipboardService;
+begin
+ if TPlatformServices.Current.SupportsPlatformService(IFMXClipboardService, IInterface(ClipService)) then
+ ClipService.SetClipboard(Value);
+end;
+{$ELSE}
+begin
+ Platform.SetClipboard(Value);
+end;
+{$ENDIF}
+
+function GetClipboard: String;
+{$IFDEF Delphi17}
+var
+ ClipService: IFMXClipboardService;
+begin
+ if TPlatformServices.Current.SupportsPlatformService(IFMXClipboardService, IInterface(ClipService)) then
+ Result := ClipService.GetClipboard.ToString
+ else
+ Result := '';
+end;
+{$ELSE}
+begin
+ Result := VarToStr(Platform.GetClipboard);
+end;
+{$ENDIF}
+
+procedure TfsSyntaxMemo.CopyToClipboard;
+begin
+ if FSelStart.X <> 0 then
+ SetClipboard(SelText);
+end;
+
+procedure TfsSyntaxMemo.CutToClipboard;
+begin
+ if not FReadOnly then
+ begin
+ if FSelStart.X <> 0 then
+ begin
+ SetClipboard(SelText);
+ SelText := '';
+ end;
+ CorrectBookmark(FSelStart.Y, FSelStart.Y - FSelEnd.Y);
+ Repaint;
+ end;
+end;
+
+procedure TfsSyntaxMemo.PasteFromClipboard;
+begin
+ if (not FReadOnly) then
+ SelText := GetClipboard;
+end;
+
+function TfsSyntaxMemo.LineAt(Index: Integer): String;
+begin
+ if Index < FText.Count then
+ Result := TrimRight(FText[Index])
+ else
+ Result := '';
+end;
+
+function TfsSyntaxMemo.LineLength(Index: Integer): Integer;
+begin
+ if Index < 0 then
+ Result := 0 else
+ Result := Length(LineAt(Index));
+end;
+
+function TfsSyntaxMemo.Pad(n: Integer): String;
+begin
+ result := '';
+ SetLength(result, n);
+ Result := StringOfChar(Char(' '), n)
+end;
+
+procedure TfsSyntaxMemo.AddUndo;
+begin
+ if not FMoved then exit;
+ FUndo.Add(Format('%5d%5d', [FPos.X, FPos.Y]) + FText.Text);
+ if FUndo.Count > 32 then
+ FUndo.Delete(0);
+end;
+
+procedure TfsSyntaxMemo.Undo;
+var
+ s: String;
+begin
+ FMoved := True;
+ if FUndo.Count = 0 then exit;
+ s := FUndo[FUndo.Count - 1];
+ FPos.X := StrToInt(Copy(s, 1, 5));
+ FPos.Y := StrToInt(Copy(s, 6, 5));
+ FText.Text := Copy(s, 11, Length(s) - 10);
+ FUndo.Delete(FUndo.Count - 1);
+ SetPos(FPos.X, FPos.Y);
+ UpdateSyntax;
+ DoChange;
+end;
+
+function TfsSyntaxMemo.GetPlainTextPos(Pos: TPoint): Integer;
+var
+ i: Integer;
+begin
+ Result := 0;
+ for i := 0 to Pos.Y - 2 do
+ Result := Result + Length(FText[i]) + Length(LineBreak);
+ Result := Result + Pos.X;
+end;
+
+function TfsSyntaxMemo.GetPosPlainText(Pos: Integer): TPoint;
+var
+ i: Integer;
+ s: String;
+begin
+ Result := Point(0, 1);
+ s := FText.Text;
+ i := 1;
+ while i <= Pos do
+ if s[i] = Char(LineBreak[1]) then
+ begin
+ Inc(i, Length(LineBreak));
+ if i <= Pos then
+ begin
+ Inc(Result.Y);
+ Result.X := 0;
+ end
+ else
+ Inc(Result.X);
+ end
+ else
+ begin
+ Inc(i);
+ Inc(Result.X);
+ end;
+end;
+
+function TfsSyntaxMemo.GetLineBegin(Index: Integer): Integer;
+var
+ s: String;
+begin
+ s := FText[Index];
+ Result := 1;
+ if Trim(s) <> '' then
+ for Result := 1 to Length(s) do
+ if s[Result] <> ' ' then
+ break;
+end;
+
+procedure TfsSyntaxMemo.TabIndent;
+begin
+ SelText := Pad(2);
+end;
+
+procedure TfsSyntaxMemo.EnterIndent;
+var
+ res: Integer;
+begin
+ if Trim(FText[FPos.Y - 1]) = '' then
+ res := FPos.X else
+ res := GetLineBegin(FPos.Y - 1);
+
+ CorrectBookmark(FPos.Y, 1);
+
+ FPos := Point(1, FPos.Y + 1);
+ SelText := Pad(res - 1);
+end;
+
+procedure TfsSyntaxMemo.UnIndent;
+var
+ i, res: Integer;
+begin
+ i := FPos.Y - 2;
+ res := FPos.X - 1;
+ CorrectBookmark(FPos.Y, -1);
+ while i >= 0 do
+ begin
+ res := GetLineBegin(i);
+ if (res < FPos.X) and (Trim(FText[i]) <> '') then
+ break else
+ Dec(i);
+ end;
+ FSelStart := FPos;
+ FSelEnd := FPos;
+ Dec(FSelEnd.X, FPos.X - res);
+ SelText := '';
+end;
+
+procedure TfsSyntaxMemo.ShiftSelected(ShiftRight: Boolean);
+var
+ i, ib, ie: Integer;
+ s: String;
+ Shift: Integer;
+begin
+ if FReadOnly then exit;
+ AddUndo;
+ if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
+ begin
+ ib := FSelStart.Y - 1;
+ ie := FSelEnd.Y - 1;
+ end
+ else
+ begin
+ ib := FSelEnd.Y - 1;
+ ie := FSelStart.Y - 1;
+ end;
+ if FSelEnd.X = 1 then
+ Dec(ie);
+
+ Shift := 2;
+ if not ShiftRight then
+ for i := ib to ie do
+ begin
+ s := FText[i];
+ if (Trim(s) <> '') and (GetLineBegin(i) - 1 < Shift) then
+ Shift := GetLineBegin(i) - 1;
+ end;
+
+ for i := ib to ie do
+ begin
+ s := FText[i];
+ if ShiftRight then
+ s := Pad(Shift) + s
+ else if Trim(s) <> '' then
+ Delete(s, 1, Shift);
+ FText[i] := s;
+ end;
+ UpdateSyntax;
+ DoChange;
+end;
+
+function TfsSyntaxMemo.GetSelText: String;
+var
+ p1, p2: TPoint;
+ i: Integer;
+begin
+ if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
+ begin
+ p1 := FSelStart;
+ p2 := FSelEnd;
+ Dec(p2.X);
+ end
+ else
+ begin
+ p1 := FSelEnd;
+ p2 := FSelStart;
+ Dec(p2.X);
+ end;
+
+ if LineLength(p1.Y - 1) < p1.X then
+ begin
+ Inc(p1.Y);
+ p1.X := 1;
+ end;
+ if LineLength(p2.Y - 1) < p2.X then
+ p2.X := LineLength(p2.Y - 1);
+
+ i := GetPlainTextPos(p1);
+ Result := Copy(FText.Text, i, GetPlainTextPos(p2) - i + 1);
+end;
+
+procedure TfsSyntaxMemo.SetSelText(Value: String);
+var
+ p1, p2, p3: TPoint;
+ i: Integer;
+ s: String;
+begin
+ if FReadOnly then exit;
+ AddUndo;
+ if FSelStart.X = 0 then
+ begin
+ p1 := FPos;
+ p2 := p1;
+ Dec(p2.X);
+ end
+ else if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
+ begin
+ p1 := FSelStart;
+ p2 := FSelEnd;
+ Dec(p2.X);
+ end
+ else
+ begin
+ p1 := FSelEnd;
+ p2 := FSelStart;
+ Dec(p2.X);
+ end;
+
+ if LineLength(p1.Y - 1) < p1.X then
+ FText[p1.Y - 1] := FText[p1.Y - 1] + Pad(p1.X - LineLength(p1.Y - 1) + 1);
+ if LineLength(p2.Y - 1) < p2.X then
+ p2.X := LineLength(p2.Y - 1);
+
+ i := GetPlainTextPos(p1);
+ s := FText.Text;
+ Delete(s, i, GetPlainTextPos(p2) - i + 1);
+ Insert(Value, s, i);
+ FText.Text := s;
+ p3 := GetPosPlainText(i + Length(Value));
+
+ CorrectBookmark(FPos.Y, p3.y-FPos.Y);
+
+ SetPos(p3.X, p3.Y);
+ FSelStart.X := 0;
+ DoChange;
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.ClearSel;
+begin
+ if FSelStart.X <> 0 then
+ begin
+ FSelStart := Point(0, 0);
+ Repaint;
+ end;
+end;
+
+procedure TfsSyntaxMemo.AddSel;
+begin
+ if FSelStart.X = 0 then
+ FSelStart := FTempPos;
+ FSelEnd := FPos;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.SetPos(x, y: Integer);
+begin
+ if FMessage <> '' then
+ begin
+ FMessage := '';
+ Repaint;
+ end;
+
+ if x > FMaxLength then x := FMaxLength;
+ if x < 1 then x := 1;
+ if y > FText.Count then y := FText.Count;
+ if y < 1 then y := 1;
+
+ FPos := Point(x, y);
+ if (FWindowSize.X = 0) or (FWindowSize.Y = 0) then exit;
+
+ if FOffset.Y >= FText.Count then
+ FOffset.Y := FText.Count - 1;
+
+ if FPos.X > FOffset.X + FWindowSize.X then
+ begin
+ FOffset.X := FOffset.X + FPos.X - (FOffset.X + FWindowSize.X);
+ Repaint;
+ end
+ else if FPos.X <= FOffset.X then
+ begin
+ FOffset.X := FOffset.X - (FOffset.X - FPos.X + 1);
+ Repaint;
+ end
+ else if FPos.Y > FOffset.Y + FWindowSize.Y then
+ begin
+ FOffset.Y := FOffset.Y + FPos.Y - (FOffset.Y + FWindowSize.Y);
+ Repaint;
+ end
+ else if FPos.Y <= FOffset.Y then
+ begin
+ FOffset.Y := FOffset.Y - (FOffset.Y - FPos.Y + 1);
+ Repaint;
+ end;
+
+ ShowCaretPos;
+ UpdateScrollBar;
+
+end;
+
+procedure TfsSyntaxMemo.ScrollClick(Sender: TObject);
+begin
+ if FUpdating then exit;
+ FOffset.Y := Round(FVScroll.Value);
+ if FOffset.Y > FText.Count then
+ FOffset.Y := FText.Count;
+ ShowCaretPos;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.ScrollEnter(Sender: TObject);
+begin
+ SetFocus;
+end;
+
+procedure TfsSyntaxMemo.DblClick;
+var
+ s: String;
+begin
+ FDoubleClicked := True;
+ DoCtrlL;
+ FSelStart := FPos;
+ s := LineAt(FPos.Y - 1);
+ if s <> '' then
+ while CharInSet(s[FPos.X],WordChars)
+ or IsUnicodeChar(s[FPos.X]) do
+ Inc(FPos.X);
+ FSelEnd := FPos;
+ Repaint;
+end;
+
+function GetComponentForm(Comp: TFmxObject): TCommonCustomForm;
+begin
+ Result := nil;
+ while (Comp.Parent <> nil) do
+ begin
+ if (Comp.Parent is TCommonCustomForm) then
+ begin
+ Result := Comp.Parent as TCommonCustomForm;
+ Exit;
+ end;
+ Comp := Comp.Parent;
+ end;
+end;
+
+procedure TfsSyntaxMemo.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+var
+ pt: TPointF;
+ f: TCommonCustomForm;
+ r: TRectF;
+ LStr, s: String;
+ i, cIndex: Integer;
+
+begin
+ if FDoubleClicked then
+ begin
+ FDoubleClicked := False;
+ Exit;
+ end;
+ if Button = TMouseButton.mbRight then
+ begin
+ if PopupMenu = nil then
+ begin
+ f := GetComponentForm(Self);
+ if f <> nil then
+ begin
+ pt := f.ClientToScreen(PointF(AbsoluteRect.Left + X, AbsoluteRect.Top + Y));
+ FPopUpMenu.Popup(pt.X, pt.Y);
+ end;
+ end;
+ end
+ else
+ begin
+ FMoved := True;
+ if not IsFocused then
+ SetFocus;
+ FDown := True;
+ if FIsMonoType then
+ SetPos(Round((X - FGutterWidth) / FCharWidth) + 1 + FOffset.X,
+ Trunc(Y / FCharHeight) + 1 + FOffset.Y)
+ else
+ begin
+ cIndex := 0;
+ LStr := LineAt(FPos.Y - 1);
+ LStr := Copy(LineAt(FPos.Y - 1), FOffset.X + 1, Length(LStr) - (FOffset.X + 1));
+ for i := 1 to Length(LStr) do
+ begin
+ s := Copy(LStr, 1, i);
+ r := RectF(0, 0, 100000, 100000);
+ FTmpCanvas.Canvas.MeasureText(r, s, False, [], TTextAlign.taLeading);
+ if r.Width >= X - FGutterWidth then
+ begin
+ cIndex := i;
+ break;
+ end;
+ end;
+ SetPos(cIndex + 1 + FOffset.X,
+ Trunc(Y / FCharHeight) + 1 + FOffset.Y)
+ end;
+ ClearSel;
+ end;
+end;
+
+procedure TfsSyntaxMemo.MouseMove(Shift: TShiftState; X, Y: Single);
+begin
+ if FDown then
+ begin
+ FTempPos := FPos;
+ FPos.X := Round((X - FGutterWidth) / FCharWidth) + 1 + FOffset.X;
+ FPos.Y := Round(Y / FCharHeight) + 1 + FOffset.Y;
+ if (FPos.X <> FTempPos.X) or (FPos.Y <> FTempPos.Y) then
+ begin
+ SetPos(FPos.X, FPos.Y);
+ AddSel;
+ end;
+ end;
+end;
+
+procedure TfsSyntaxMemo.MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Single);
+begin
+ FDown := False;
+end;
+
+procedure TfsSyntaxMemo.MouseWheel(Shift: TShiftState; WheelDelta: Integer;
+ var Handled: Boolean);
+begin
+ inherited;
+ FVScroll.Value := FVScroll.Value + (WheelDelta div ABS(WheelDelta)) * KWheel;
+end;
+
+procedure TfsSyntaxMemo.DialogKey(var Key: Word; Shift: TShiftState);
+begin
+ inherited;
+ if Key = 9 then
+ begin
+ if Shift = [] then
+ begin
+ if FSelStart.X <> 0 then
+ DoCtrlI
+ else
+ TabIndent;
+ end
+ else if Shift = [ssShift] then
+ DoCtrlU;
+ FMoved := True;
+ end;
+end;
+
+procedure TfsSyntaxMemo.KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+var
+ MyKey: Boolean;
+begin
+ inherited;
+ FAllowLinesChange := False;
+
+ FTempPos := FPos;
+ MyKey := True;
+ case Key of
+ vkLeft:
+ if ssCtrl in Shift then
+ DoCtrlL else
+ DoLeft;
+
+ vkRight:
+ if ssCtrl in Shift then
+ DoCtrlR else
+ DoRight;
+
+ vkUp:
+ DoUp;
+
+ vkDown:
+ DoDown;
+
+ vkHome:
+ DoHome(ssCtrl in Shift);
+
+ vkEnd:
+ DoEnd(ssCtrl in Shift);
+
+ vkPrior:
+ DoPgUp;
+
+ vkNext:
+ DoPgDn;
+
+ vkReturn:
+ if Shift = [] then
+ DoReturn;
+
+ vkDelete:
+ if ssShift in Shift then
+ CutToClipboard else
+ DoDel;
+
+ vkBack:
+ DoBackspace;
+
+ vkInsert:
+ if ssCtrl in Shift then
+ CopyToClipboard
+ else if ssShift in Shift then
+ PasteFromClipboard;
+
+ vkF3:
+ Find(LastSearch); // F3 Repeat search
+
+ else
+ MyKey := False;
+ end;
+
+ if (Shift = [ssCtrl]) or (Shift = [ssCommand]) then
+ begin
+ MyKey := True;
+ if (Key = Ord('c')) or (Key = Ord('C')) then // Ctrl+C Copy
+ CopyToClipboard
+ else if (Key = Ord('v')) or (Key = Ord('V')) then // Ctrl+V Paste
+ PasteFromClipboard
+ else if (Key = Ord('x')) or (Key = Ord('X')) then // Ctrl+X Cut
+ CutToClipboard
+ else if (Key = Ord('z')) or (Key = Ord('Z')) then // Ctrl+Z Undo
+ Undo
+ else if (Key = Ord('a')) or (Key = Ord('A')) then // Ctrl+A Select all
+ begin
+ SetPos(0, 0);
+ FSelStart := FPos;
+ SetPos(LineLength(FText.Count - 1) + 1, FText.Count);
+ FSelEnd := FPos;
+ Repaint;
+ end
+ else if (Key = Ord('f')) or (Key = Ord('F')) then // Ctrl+F Search
+ begin
+ SynMemoSearch := TfsSynMemoSearch.Create(nil);
+ if SynMemoSearch.ShowModal = mrOk then
+ Find(SynMemoSearch.Edit1.Text);
+ LastSearch := SynMemoSearch.Edit1.Text;
+ SynMemoSearch.Free;
+ end
+ else if (Key = Ord('y')) or (Key = Ord('Y')) then // Ctrl+Y Delete line
+ begin
+ if FText.Count > FPos.Y then
+ begin
+ FMoved := True;
+ AddUndo;
+ FText.Delete(FPos.Y - 1);
+ CorrectBookmark(FPos.Y, -1);
+ UpdateSyntax;
+ end
+ else
+ if FText.Count = FPos.Y then
+ begin
+ FMoved := True;
+ AddUndo;
+ FText[FPos.Y - 1] := '';
+ FPos.X := 1;
+ SetPos(FPos.X, FPos.Y);
+ UpdateSyntax;
+ end
+ end
+ else if Key in [48..57] then
+ GotoBookmark(Key-48)
+ else
+ MyKey := False;
+ end;
+
+ if Shift = [ssCtrl, ssShift] then
+ if Key in [48..57] then
+ if IsBookmark(FPos.Y - 1) < 0 then
+ AddBookmark(FPos.Y - 1, Key-48)
+ else
+ if IsBookmark(FPos.Y - 1) = (Key-48) then
+ DeleteBookmark(Key-48);
+
+
+ if Key in [vkLeft, vkRight, vkUp, vkDown, vkHome, vkEnd, vkPrior, vkNext] then
+ begin
+ FMoved := True;
+ if ssShift in Shift then
+ AddSel else
+ ClearSel;
+ end
+ else if Key in [vkReturn, vkDelete, vkBack, vkInsert] then
+ FMoved := True;
+
+ case WideChar(KeyChar) of
+ #0032..#$FFFF:
+ if (Shift = []) or (Shift = [ssShift]) then
+ begin
+ DoChar(WideChar(KeyChar));
+ FMoved := True;
+ end;
+ else
+ MyKey := False;
+ end;
+ if MyKey then
+ Key := 0;
+end;
+
+procedure TfsSyntaxMemo.DoLeft;
+begin
+ Dec(FPos.X);
+ if FPos.X < 1 then
+ FPos.X := 1;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoRight;
+begin
+ Inc(FPos.X);
+ if FPos.X > FMaxLength then
+ FPos.X := FMaxLength;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoUp;
+begin
+ Dec(FPos.Y);
+ if FPos.Y < 1 then
+ FPos.Y := 1;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoDown;
+begin
+ Inc(FPos.Y);
+ if FPos.Y > FText.Count then
+ FPos.Y := FText.Count;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoHome(Ctrl: Boolean);
+begin
+ if Ctrl then
+ SetPos(1, 1) else
+ SetPos(1, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoEnd(Ctrl: Boolean);
+begin
+ if Ctrl then
+ SetPos(LineLength(FText.Count - 1) + 1, FText.Count) else
+ SetPos(LineLength(FPos.Y - 1) + 1, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoExit;
+begin
+{$IFDEF Delphi17}
+ inherited;
+{$IFNDEF DELPHI18}
+ CaretVisible := False;
+{$ELSE}
+ HideCaret;
+{$ENDIF}
+{$ELSE}
+ Platform.HideVirtualKeyboard;
+ inherited;
+ HideCaret;
+{$ENDIF}
+end;
+
+procedure TfsSyntaxMemo.DoPgUp;
+begin
+ if FOffset.Y > FWindowSize.Y then
+ begin
+ FOffset.Y := FOffset.Y - (FWindowSize.Y - 1);
+ FPos.Y := FPos.Y - (FWindowSize.Y - 1);
+ end
+ else
+ begin
+ if FOffset.Y > 0 then
+ begin
+ FPos.Y := FPos.Y - FOffset.Y;
+ FOffset.Y := 0;
+ end
+ else
+ FPos.Y := 1;
+ end;
+ SetPos(FPos.X, FPos.Y);
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.DoPgDn;
+begin
+ if FOffset.Y + FWindowSize.Y < FText.Count then
+ begin
+ FOffset.Y := FOffset.Y + (FWindowSize.Y - 1);
+ FPos.Y := FPos.Y + (FWindowSize.Y - 1);
+ end
+ else
+ begin
+ FOffset.Y := FText.Count;
+ FPos.Y := FText.Count;
+ end;
+ SetPos(FPos.X, FPos.Y);
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.DoReturn;
+var
+ s: String;
+begin
+ if FReadOnly then exit;
+ s := LineAt(FPos.Y - 1);
+ FText[FPos.Y - 1] := Copy(s, 1, FPos.X - 1);
+ FText.Insert(FPos.Y, Copy(s, FPos.X, FMaxLength));
+ EnterIndent;
+end;
+
+procedure TfsSyntaxMemo.DoDel;
+var
+ s: String;
+begin
+ if FReadOnly then exit;
+ FMessage := '';
+ if FSelStart.X <> 0 then
+ SelText := ''
+ else
+ begin
+ s := FText[FPos.Y - 1];
+ AddUndo;
+ if FPos.X <= LineLength(FPos.Y - 1) then
+ begin
+ Delete(s, FPos.X, 1);
+ FText[FPos.Y - 1] := s;
+ end
+ else if FPos.Y < FText.Count then
+ begin
+ s := s + Pad(FPos.X - Length(s) - 1) + LineAt(FPos.Y);
+ FText[FPos.Y - 1] := s;
+ FText.Delete(FPos.Y);
+ CorrectBookmark(FSelStart.Y, -1);
+ end;
+ UpdateScrollBar;
+ UpdateSyntax;
+ DoChange;
+ end;
+end;
+
+procedure TfsSyntaxMemo.DoBackspace;
+var
+ s: String;
+begin
+ if FReadOnly then exit;
+ FMessage := '';
+ if FSelStart.X <> 0 then
+ SelText := ''
+ else
+ begin
+ s := FText[FPos.Y - 1];
+ if FPos.X > 1 then
+ begin
+ if (GetLineBegin(FPos.Y - 1) = FPos.X) or (Trim(s) = '') then
+ UnIndent
+ else
+ begin
+ AddUndo;
+ if Trim(s) <> '' then
+ begin
+ Delete(s, FPos.X - 1, 1);
+ FText[FPos.Y - 1] := s;
+ DoLeft;
+ end
+ else
+ DoHome(False);
+ UpdateSyntax;
+ DoChange;
+ end;
+ end
+ else if FPos.Y > 1 then
+ begin
+ AddUndo;
+ CorrectBookmark(FPos.Y, -1);
+ s := LineAt(FPos.Y - 2);
+ FText[FPos.Y - 2] := s + FText[FPos.Y - 1];
+ FText.Delete(FPos.Y - 1);
+ SetPos(Length(s) + 1, FPos.Y - 1);
+ UpdateSyntax;
+ DoChange;
+ end;
+ end;
+end;
+
+procedure TfsSyntaxMemo.DoCtrlI;
+begin
+ if FSelStart.X <> 0 then
+ ShiftSelected(True);
+end;
+
+procedure TfsSyntaxMemo.DoCtrlU;
+begin
+ if FSelStart.X <> 0 then
+ ShiftSelected(False);
+end;
+
+procedure TfsSyntaxMemo.DoCtrlL;
+var
+ i: Integer;
+ s: String;
+begin
+ s := FText.Text;
+ i := Length(LineAt(FPos.Y - 1));
+ if FPos.X > i then
+ FPos.X := i;
+
+ i := GetPlainTextPos(FPos);
+
+ Dec(i);
+ while (i > 0) and not (CharInSet(s[i], WordChars) or IsUnicodeChar(s[i])) do
+ if s[i] = Char(LineBreak[1]) then
+ break else
+ Dec(i);
+ while (i > 0) and (CharInSet(s[i], WordChars) or IsUnicodeChar(s[i])) do
+ Dec(i);
+ Inc(i);
+
+ FPos := GetPosPlainText(i);
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoCtrlR;
+var
+ i: Integer;
+ s: String;
+begin
+ s := FText.Text;
+ i := Length(LineAt(FPos.Y - 1));
+ if FPos.X > i then
+ begin
+ DoDown;
+ DoHome(False);
+ FPos.X := 0;
+ end;
+
+ i := GetPlainTextPos(FPos);
+ while (i < Length(s)) and ((CharInSet(s[i], WordChars)) or IsUnicodeChar(s[i])) do
+ Inc(i);
+ while (i < Length(s)) and not ((CharInSet(s[i], WordChars)) or IsUnicodeChar(s[i])) do
+ if s[i] = Char(LineBreak[1]) then
+ break else
+ Inc(i);
+ FPos := GetPosPlainText(i);
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoChar(Ch: Char);
+begin
+ SelText := Ch;
+end;
+
+function TfsSyntaxMemo.GetCharAttr(Pos: TPoint): TCharAttributes;
+
+ function IsBlock: Boolean;
+ var
+ p1, p2, p3: Integer;
+ begin
+ Result := False;
+ if FSelStart.X = 0 then exit;
+
+ p1 := FSelStart.X + FSelStart.Y * FMaxLength;
+ p2 := FSelEnd.X + FSelEnd.Y * FMaxLength;
+ if p1 > p2 then
+ begin
+ p3 := p1;
+ p1 := p2;
+ p2 := p3;
+ end;
+ p3 := Pos.X + Pos.Y * FMaxLength;
+ Result := (p3 >= p1) and (p3 < p2);
+ end;
+
+ function CharAttr: TCharAttr;
+ var
+ s: String;
+ begin
+ if Pos.Y - 1 < FSynStrings.Count then
+ begin
+ s := FSynStrings[Pos.Y - 1];
+ if Pos.X <= Length(s) then
+ Result := TCharAttr(Ord(s[Pos.X])) else
+ Result := caText;
+ end
+ else
+ Result := caText;
+ end;
+
+begin
+ Result := [CharAttr];
+ if IsBlock then
+ Result := Result + [caBlock];
+end;
+
+function TfsSyntaxMemo.GetCharWidth(Str: String): Single;
+var
+ r: TRectF;
+ dx: Single;
+ j, j1: Integer;
+ a, a1: TCharAttributes;
+
+ function CalcSize(LStr: String): Single;
+ begin
+ if FIsMonoType then
+ begin
+ Result := FCharWidth * Length(LStr);
+ Exit;
+ end;
+ if LStr = '' then
+ begin
+ Result := 0;
+ Exit;
+ end;
+
+ r := RectF(0, 0, 100000, 100000);
+ { MeasureText trunc all spaces at the end, so we are using this hack to calcl size with spaces }
+ FTmpCanvas.Canvas.MeasureText(r, LStr + 'W', False, [], TTextAlign.taLeading);
+ dx := r.Width;
+ FTmpCanvas.Canvas.MeasureText(r, 'W', False, [], TTextAlign.taLeading);
+ Result := dx - r.Width;
+ end;
+begin
+
+ j1 := 1;
+ a := GetCharAttr(Point(1, FPos.Y));
+ a1 := a;
+ Result := 0;
+
+ for j := 1 to Length(Str) do
+ begin
+ a1 := GetCharAttr(Point(j, FPos.Y));
+ if a1 <> a then
+ begin
+ SetAttr(FTmpCanvas.Canvas, a);
+ Result := Result + CalcSize(Copy(Str, j1, (j - j1)));
+ a := a1;
+ j1 := j;
+ end;
+ end;
+ SetAttr(FTmpCanvas.Canvas, a);
+ Result := Result + CalcSize(Copy(Str, j1, Length(Str) - (j1 - 1)));
+end;
+
+procedure TfsSyntaxMemo.Paint;
+var
+ i, j, j1: Integer;
+ a, a1: TCharAttributes;
+ s: String;
+ x, y: Single;
+ aClientR: TRectF;
+ aSelColor, aSelFontColor: TAlphaColor;
+
+ procedure SetAttrL(a: TCharAttributes);
+ begin
+ SetAttr(Canvas, a);
+ aSelColor := FFill.Color;
+ aSelFontColor := Canvas.Fill.Color;
+ if caBlock in a then
+ begin
+ aSelColor := FBlockColor;
+ aSelFontColor := FBlockFontColor;
+ end;
+
+ // make non-selected text looking good
+ if aSelColor = FFill.Color then
+ aSelColor := 0;
+ end;
+
+ function MyTextOut(x, y: Single; const s: String): Single;
+ var
+ i: Integer;
+ dx, dy: Single;
+ r: TRectF;
+ begin
+ with Canvas do
+ begin
+ r := RectF(0, 0, 100000, 100000);
+ { MeasureText trunc all spaces at the end, so we are using this hack to calcl size with spaces }
+ Canvas.MeasureText(r, s + 'W',False, [], TTextAlign.taLeading);
+ dx := r.Width + x;
+ Canvas.MeasureText(r, 'W', False, [], TTextAlign.taLeading);
+ dx := dx - r.Width;
+ if dx > (aClientR.Right - aClientR.Left) then
+ dx := aClientR.Right - aClientR.Left;
+ dy := y + FCharHeight;
+ if FIsMonoType then
+ dx := x + FCharWidth * Length(s);
+ Fill.Color := aSelColor;
+ FillRect(RectF(x + 1, y, dx + 1, dy + 1), 0, 0, AllCorners, 1);
+ Fill.Color := aSelFontColor;
+ if FIsMonoType then
+ FillText(RectF(x, y, dx + 1, 10000),
+ s, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading)
+ else
+ begin
+ for i := 1 to Length(s) do
+ FillText(RectF(x + (i - 1) * FCharWidth, y,
+ (x + (i - 1) * FCharWidth) + FCharWidth, y + FCharHeight),
+ s[i], False, 1, FillTextFlags, TTextAlign.taLeading, TTextAlign.taLeading);
+ end;
+ end;
+ Result := dx;
+ end;
+
+begin
+ aClientR := GetClientRect;
+ with Canvas do
+ begin
+ Fill.Assign(FBorder.Fill);
+ FillRect(RectF(0, 0, Self.Width , Self.Height), 0, 0, AllCorners, 1, TCornerType.ctBevel);
+ Fill.Assign(FFill);
+ FillRect(aClientR, 0, 0, AllCorners, 1, TCornerType.ctBevel);
+ Fill.Assign(FGutterFill);
+ FillRect(RectF(FGutterWidth - aClientR.Left,
+ Self.Height - FFooterHeight - aClientR.Top,
+ aClientR.Left, aClientR.Top), 0, 0, AllCorners, 1, TCornerType.ctBevel);
+ FillRect(RectF(aClientR.Left, Self.Height - FFooterHeight - aClientR.Top,
+ Self.Width - aClientR.Left, Self.Height - aClientR.Top), 1, 1,
+ AllCorners, 1, TCornerType.ctBevel);
+
+ Stroke.Assign(FBorder.Fill);
+{$IFDEF DELPHI25}
+ Stroke.Cap := TStrokeCap.scRound;
+ Stroke.Thickness := FBorder.Width;
+{$ELSE}
+ StrokeCap := TStrokeCap.scRound;
+ StrokeThickness := FBorder.Width;
+{$ENDIF}
+ x := FGutterWidth - FBorder.Width;
+ DrawLine(PointF(x, aClientR.Top + 1), PointF(x, aClientR.Bottom - FFooterHeight ), 1);
+ if FFooterHeight > 0 then
+ DrawLine(PointF(x, aClientR.Bottom - FFooterHeight),
+ PointF(aClientR.Right - 1, aClientR.Bottom - FFooterHeight), 1);
+ if FUpdatingSyntax then Exit;
+
+ for i := FOffset.Y to FOffset.Y + FWindowSize.Y - 1 do
+ begin
+ if i >= FText.Count then break;
+
+ s := FText[i];
+ j1 := FOffset.X + 1;
+ a := GetCharAttr(Point(j1, i + 1));
+ a1 := a;
+ x := FGutterWidth + FBorder.Width;
+ y := aClientR.Top + (i - FOffset.Y) * FCharHeight;
+ for j := j1 to FOffset.X + FWindowSize.X do
+ begin
+ if j > Length(s) then break;
+
+ a1 := GetCharAttr(Point(j, i + 1));
+ if a1 <> a then
+ begin
+ SetAttrL(a);
+ x := MyTextOut(x, y, Copy(FText[i], j1, j - j1));
+ a := a1;
+ j1 := j;
+ end;
+ end;
+
+ SetAttrL(a);
+
+ MyTextOut(x, y, Copy(s, j1, FMaxLength));
+
+ BookmarkDraw(y, i);
+ ActiveLineDraw(y, i);
+ end;
+
+ if FMessage <> '' then
+ begin
+ Font.Family := 'Tahoma';
+ Font.Style := [TFontStyle.fsBold];
+ Font.Size := 8;
+ Fill.Color := TAlphaColorRec.Maroon;
+ FillRect(RectF(aClientR.Left, aClientR.Bottom - TextHeight('|') - 6, aClientR.Right , aClientR.Bottom), 0, 0,
+ AllCorners, 1, TCornerType.ctBevel);
+ Fill.Color := TAlphaColorRec.White;
+ FillText(RectF(aClientR.Left + 6, aClientR.Bottom - TextHeight('|') - 5,
+ 6 + TextWidth('W') * Length(FMessage), aClientR.Bottom), FMessage,
+ False, 1, [], TTextAlign.taLeading)
+ end
+ else
+ ShowPos;
+ end;
+end;
+
+procedure TfsSyntaxMemo.CreateSynArray;
+var
+ i, n, Pos: Integer;
+ ch: Char;
+ FSyn: String;
+
+ procedure SkipSpaces;
+ begin
+ while (Pos <= Length(FSyn)) and
+ ((CharInSet(FSyn[Pos], [#1..#32])) or
+ not (CharInSet(FSyn[Pos],['_', 'A'..'Z', 'a'..'z', '''', '"', '/', '{', '(', '-']))) do
+ Inc(Pos);
+ end;
+
+ function IsKeyWord(const s: String): Boolean;
+ begin
+ Result := False;
+ if FKeywords = '' then exit;
+
+ if FKeywords[1] <> ',' then
+ FKeywords := ',' + FKeywords;
+ if FKeywords[Length(FKeywords)] <> ',' then
+ FKeywords := FKeywords + ',';
+
+ Result := System.Pos(',' + AnsiLowerCase(s) + ',', FKeywords) <> 0;
+ end;
+
+ function GetIdent: TCharAttr;
+ var
+ i: Integer;
+ cm1, cm2, cm3, cm4, st1: Char;
+ begin
+ i := Pos;
+ Result := caText;
+
+ if FSyntaxType = stPascal then
+ begin
+ cm1 := '/';
+ cm2 := '{';
+ cm3 := '(';
+ cm4 := ')';
+ st1 := '''';
+ end
+ else if FSyntaxType in [stCpp,stJs,stVb] then
+ begin
+ cm1 := '/';
+ cm2 := ' ';
+ cm3 := '/';
+ cm4 := '/';
+ st1 := '"';
+ end
+ else if FSyntaxType = stSQL then
+ begin
+ cm1 := '-';
+ cm2 := ' ';
+ cm3 := '/';
+ cm4 := '/';
+ st1 := '"';
+ end
+ else
+ begin
+ cm1 := ' ';
+ cm2 := ' ';
+ cm3 := ' ';
+ cm4 := ' ';
+ st1 := ' ';
+ end;
+
+ if CharInSet(FSyn[Pos], ['_', 'A'..'Z', 'a'..'z']) then
+ begin
+ while CharInSet(FSyn[Pos], ['_', 'A'..'Z', 'a'..'z', '0'..'9']) do
+ Inc(Pos);
+ if IsKeyWord(Copy(FSyn, i, Pos - i)) then
+ Result := caKeyword;
+ Dec(Pos);
+ end
+ else if (FSyn[Pos] = cm1) and (FSyn[Pos + 1] = cm1) then
+ begin
+ while (Pos <= Length(FSyn)) and not (CharInSet(FSyn[Pos], [#10, #13])) do
+ Inc(Pos);
+ Result := caComment;
+ end
+ else if FSyn[Pos] = cm2 then
+ begin
+ while (Pos <= Length(FSyn)) and (FSyn[Pos] <> '}') do
+ Inc(Pos);
+ Result := caComment;
+ end
+ else if (FSyn[Pos] = cm3) and (FSyn[Pos + 1] = '*') then
+ begin
+ while (Pos < Length(FSyn)) and not ((FSyn[Pos] = '*') and (FSyn[Pos + 1] = cm4)) do
+ Inc(Pos);
+ Inc(Pos, 2);
+ Result := caComment;
+ end
+ else if FSyn[Pos] = st1 then
+ begin
+ Inc(Pos);
+ while (Pos < Length(FSyn)) and (FSyn[Pos] <> st1) and not (CharInSet(FSyn[Pos], [#10, #13])) do
+ Inc(Pos);
+ Result := caString;
+ end;
+ Inc(Pos);
+ end;
+
+begin
+ FSyn := FText.Text + #0#0#0#0#0#0#0#0#0#0#0;
+ FAllowLinesChange := False;
+ Pos := 1;
+
+ while Pos < Length(FSyn) do
+ begin
+ n := Pos;
+ SkipSpaces;
+ for i := n to Pos - 1 do
+ if FSyn[i] > #31 then
+ FSyn[i] := Chr(Ord(caText));
+
+ n := Pos;
+ ch := Chr(Ord(GetIdent));
+ for i := n to Pos - 1 do
+ if i <= Length(FSyn) then
+ if FSyn[i] > #31 then
+ FSyn[i] := ch;
+ end;
+
+ FUpdatingSyntax := True;
+ FSynStrings.Text := FSyn;
+ FSynStrings.Add(' ');
+ FUpdatingSyntax := False;
+end;
+
+procedure TfsSyntaxMemo.UpdateView;
+begin
+ UpdateSyntax;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.UpdateWindowSize;
+begin
+ if FCharWidth = 0 then exit;
+ FWindowSize := Point(Trunc((Width - FGutterWidth - FBorder.Width * 2) / FCharWidth),
+ Trunc((Height - FFooterHeight - FBorder.Width * 2) / FCharHeight));
+end;
+
+procedure TfsSyntaxMemo.CopyPopup(Sender: TObject);
+begin
+ CopyToClipboard;
+end;
+
+procedure TfsSyntaxMemo.PastePopup(Sender: TObject);
+begin
+ PasteFromClipboard;
+end;
+
+procedure TfsSyntaxMemo.Resize;
+begin
+ inherited;
+ UpdateWindowSize;
+ FVScroll.Position.Y := FBorder.Width;
+ FVScroll.Height := Height - FFooterHeight - FBorder.Width;
+ FVScroll.Width := 16;
+ FVScroll.Position.X := Width - FVScroll.Width - FBorder.Width;
+ UpdateScrollBar;
+end;
+
+procedure TfsSyntaxMemo.CutPopup(Sender: TObject);
+begin
+ CutToClipboard;
+end;
+
+procedure TfsSyntaxMemo.SetShowGutter(Value: boolean);
+begin
+ FShowGutter := Value;
+ if Value then
+ FGutterWidth := 20
+ else
+ FGutterWidth := 0;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.SetShowFooter(Value: boolean);
+begin
+ FShowFooter := Value;
+ if Value then
+ FFooterHeight := 20
+ else
+ FFooterHeight := 0;
+ Repaint;
+end;
+
+function TfsSyntaxMemo.FMemoFind(Text: String; var Position : TPoint): boolean;
+var
+ i, j : integer;
+begin
+ j := 0;
+ result := False;
+ if FText.Count > 1 then
+ begin
+ Text := UpperCase(Text);
+ for i := Position.Y to FText.Count - 1 do
+ begin
+ j := Pos( Text, UpperCase(FText[i]));
+ if j > 0 then
+ begin
+ Result := True;
+ break;
+ end
+ end;
+ Position.X := j;
+ Position.Y := i + 1;
+ end;
+end;
+
+procedure TfsSyntaxMemo.FontChanged(Sender: TObject);
+begin
+ FCommentAttr.Font.Size := FFontSettings.Font.Size;
+ FCommentAttr.Font.Family := FFontSettings.Font.Family;
+ FKeywordAttr.Font.Size := FFontSettings.Font.Size;
+ FKeywordAttr.Font.Family := FFontSettings.Font.Family;
+ FStringAttr.Font.Size := FFontSettings.Font.Size;
+ FStringAttr.Font.Family := FFontSettings.Font.Family;
+ FTextAttr.Font.Size := FFontSettings.Font.Size;
+ FTextAttr.Font.Family := FFontSettings.Font.Family;
+ CalcCharSize;
+ { need to uptade size, maybe font size was changed }
+ UpdateWindowSize;
+end;
+
+function TfsSyntaxMemo.Find(Text: String): boolean;
+var
+ Position: TPoint;
+begin
+ Position := FPos;
+ if FMemoFind(Text, Position) then
+ begin
+ SetPos(Position.X, Position.Y);
+ result := true;
+ end
+ else
+ begin
+ ShowMessage('Text "'+Text+'" not found.');
+ result := false;
+ end;
+end;
+
+procedure TfsSyntaxMemo.ActiveLineDraw(Y : Single; ALine : integer);
+begin
+ if ShowGutter then
+ with Canvas do
+ if ALine = FActiveLine then
+ begin
+ Fill.Color := TAlphaColorRec.Red;
+ //Pen.Color := clBlack;
+ FillEllipse(RectF(4, Y + 4, 11, Y + 15), 1);
+ end;
+end;
+
+procedure TfsSyntaxMemo.BookmarkDraw(Y : Single; ALine : integer);
+var
+ bm : integer;
+begin
+ if ShowGutter then
+ with Canvas do
+ begin
+ bm := IsBookmark(ALine);
+ if bm >= 0 then
+ begin
+ Fill.Color := TAlphaColorRec.Black;
+ FillRect(RectF(3 + Border.Width, Y + 1, 13 + Border.Width, Y + 12), 0, 0,
+ AllCorners, 1, TCornerType.ctBevel);
+ Fill.Color := TAlphaColorRec.Green;
+ FillRect(RectF(2 + Border.Width, Y + 2, 12 + Border.Width, Y + 13), 0, 0,
+ AllCorners, 1, TCornerType.ctBevel);
+ Font.Family := 'Tahoma';
+ Fill.Color := TAlphaColorRec.White;
+ Font.Style := [TFontStyle.fsBold];
+ Font.Size := 7;
+ y := y + 2.0;
+ FillText(RectF(4 + Border.Width, Y, 4 + TextWidth('7') + Border.Width,
+ Y + TextHeight('7')), IntToStr(bm), False, 1, [], TTextAlign.taLeading)
+ end;
+ end;
+end;
+
+function TfsSyntaxMemo.IsBookmark(Line : integer): integer;
+var
+ Pos : integer;
+begin
+ Result := -1;
+ for Pos := 0 to Length(Bookmarks) - 1 do
+ if Bookmarks[Pos] = Line then
+ begin
+ Result := Pos;
+ break;
+ end;
+end;
+
+procedure TfsSyntaxMemo.AddBookmark(Line, Number : integer);
+begin
+ if Number < Length(Bookmarks) then
+ begin
+ Bookmarks[Number] := Line;
+ Repaint;
+ end;
+end;
+
+procedure TfsSyntaxMemo.DeleteBookmark(Number : integer);
+begin
+ if Number < Length(Bookmarks) then
+ begin
+ Bookmarks[Number] := -1;
+ Repaint;
+ end;
+end;
+
+procedure TfsSyntaxMemo.CorrectBookmark(Line : integer; delta : integer);
+var
+ i : integer;
+begin
+ for i := 0 to Length(Bookmarks) - 1 do
+ if Bookmarks[i] >= Line then
+ Inc(Bookmarks[i], Delta);
+end;
+
+procedure TfsSyntaxMemo.GotoBookmark(Number : integer);
+begin
+ if Number < Length(Bookmarks) then
+ if Bookmarks[Number] >= 0 then
+ SetPos(0, Bookmarks[Number] + 1);
+end;
+
+procedure TfsSyntaxMemo.DOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+begin
+{$IFNDEF DELPHI20}
+ Accept := Data.Source is TTreeView;
+{$ELSE}
+ if Data.Source is TTreeView then
+ Operation := TDragOperation.Copy;
+{$ENDIF}
+end;
+
+procedure TfsSyntaxMemo.DDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+begin
+ if Data.Source is TTreeView then
+ begin
+ SetPos(Round((Point.X - FGutterWidth) / FCharWidth) + 1 + FOffset.X,
+ Round(Point.Y / FCharHeight) + 1 + FOffset.Y);
+ SetSelText(TTreeView(Data.Source).Selected.Text);
+ end;
+end;
+
+procedure TfsSyntaxMemo.SetKeywordAttr(Value: TfsFontSettings);
+begin
+ FKeywordAttr.Assign(Value);
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.SetStringAttr(Value: TfsFontSettings);
+begin
+ FStringAttr.Assign(Value);
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.SetTextAttr(Value: TfsFontSettings);
+begin
+ FTextAttr.Assign(Value);
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.SetCommentAttr(Value: TfsFontSettings);
+begin
+ FCommentAttr.Assign(Value);
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.SetFill(const Value: TBrush);
+begin
+ FFill.Assign(Value);
+end;
+
+procedure TfsSyntaxMemo.SetFontSettings(const Value: TfsFontSettings);
+begin
+ FFontSettings.Assign(Value);
+end;
+
+procedure TfsSyntaxMemo.SetGutterFill(const Value: TBrush);
+begin
+ FGutterFill.Assign(Value);
+end;
+
+procedure TfsSyntaxMemo.SetActiveLine(Line : Integer);
+begin
+ FActiveLine := Line;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.SetAttr(aCanvas: TCanvas; a: TCharAttributes);
+begin
+ with aCanvas do
+ begin
+ Font.Assign(FFontSettings.Font);
+ Canvas.Fill.Assign(FFontSettings.Fill);
+
+ if caText in a then
+ begin
+ Font.Assign(FTextAttr.Font);
+ Canvas.Fill.Assign(FTextAttr.Fill);
+ end;
+
+ if caComment in a then
+ begin
+ Font.Assign(FCommentAttr.Font);
+ Canvas.Fill.Assign(FCommentAttr.Fill);
+ end;
+
+ if caKeyword in a then
+ begin
+ Font.Assign(FKeywordAttr.Font);
+ Canvas.Fill.Assign(FKeywordAttr.Fill);
+ end;
+
+ if caString in a then
+ begin
+ Font.Assign(FStringAttr.Font);
+ Canvas.Fill.Assign(FStringAttr.Fill);
+ end;
+ end;
+end;
+
+
+
+procedure TfsSyntaxMemo.SetBorder(const Value: TfsBorderSettings);
+begin
+ FBorder.Fill.Assign(Value.Fill);
+ FBorder.Width := Value.Width;
+end;
+
+function TfsSyntaxMemo.GetActiveLine: Integer;
+begin
+ Result := FActiveLine;
+end;
+
+procedure TfsSynMemoSearch.FormKeyPress(Sender: TObject; var Key: Char);
+begin
+ if Key = #13 then
+ ModalResult := mrOk;
+end;
+
+{ TfsBorderSettings }
+
+constructor TfsBorderSettings.Create;
+begin
+ FFill := TBrush.Create(TBrushKind.bkSolid, TAlphaColorRec.Silver);
+ FWidth := 1;
+end;
+
+destructor TfsBorderSettings.Destroy;
+begin
+ FFill.Free;
+ inherited;
+end;
+
+procedure TfsBorderSettings.SetFill(const Value: TBrush);
+begin
+ FFill.Assign(Value);
+end;
+
+procedure TfsBorderSettings.SetWidth(const Value: Integer);
+begin
+ if Value > 3 then
+ FWidth := 3
+ else if Value < 0 then
+ FWidth := 0
+ else
+ FWidth := Value;
+end;
+
+{ TfsFontSettings }
+
+procedure TfsFontSettings.Assign(Source: TPersistent);
+begin
+ inherited;
+ if Source is TfsFontSettings then
+ begin
+ Fill.Assign(TfsFontSettings(Source).Fill);
+ Font.Assign(TfsFontSettings(Source).Font);
+ end;
+end;
+
+constructor TfsFontSettings.Create();
+begin
+ FFill := TBrush.Create(TBrushKind.bkSolid, TAlphaColorRec.Black);
+ FFont := TFont.Create;
+ FFont.Family := 'Courier New';
+ FFont.Size := 13;
+end;
+
+destructor TfsFontSettings.Destroy;
+begin
+ FFill.Free;
+ FFont.Free;
+ inherited;
+end;
+
+procedure TfsFontSettings.SetFill(const Value: TBrush);
+begin
+ FFill.Assign(Value);
+end;
+
+procedure TfsFontSettings.SetFont(const Value: TFont);
+begin
+ FFont.Assign(Value);
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsSyntaxMemo, TFmxObject);
+ GroupDescendentsWith(TfsBorderSettings, TFmxObject);
+ GroupDescendentsWith(TfsFontSettings, TFmxObject);
+
+ RegisterFmxClasses([TfsBorderSettings, TfsFontSettings]);
+
+end.
diff --git a/FastScript/FMX/FMX.fs_tree.pas b/FastScript/FMX/FMX.fs_tree.pas
new file mode 100644
index 0000000..be82786
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_tree.pas
@@ -0,0 +1,659 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Function/Classes tree FMX visual control }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_tree;
+
+interface
+
+{$I fs.inc}
+
+uses
+ FMX.Types,
+ System.SysUtils, System.Classes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.ExtCtrls, FMX.fs_synmemo, FMX.Objects,
+ FMX.fs_XML, FMX.fs_iinterpreter, FMX.TreeView, FMX.Memo, System.UITypes, System.Types
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI29}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+ TfsTreeViewItem = class(TTreeViewItem)
+ private
+ FButton: TCustomButton;
+ FCloseImageIndex: Integer;
+ FOpenImageIndex: Integer;
+ FImgPos: Single;
+ function GetBitmap():TBitmap;
+ protected
+ procedure ApplyStyle; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure Paint; override;
+ property CloseImageIndex: Integer read FCloseImageIndex write FCloseImageIndex;
+ property OpenImageIndex: Integer read FOpenImageIndex write FOpenImageIndex;
+ end;
+
+{$i frxPlatformsAttribute.inc}
+
+ TfsTreeView = class(TTreeView)
+ private
+ FPicBitmap: TBitmap;
+ FIconWidth: Integer;
+ FIconHeight: Integer;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure LoadResouces(Stream: TStream; IconWidth, IconHeight: Integer);
+ property PicPitmap: TBitmap read FPicBitmap write FPicBitmap;
+ property IconWidth: Integer read FIconWidth write FIconWidth;
+ property IconHeight: Integer read FIconHeight write FIconHeight;
+ function GetBitmapRect(Index: Integer): TRectF;
+ procedure DragOver(const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF}); override;
+ procedure DragDrop(const Data: TDragObject; const Point: TPointF); override;
+ published
+ property StyleLookup;
+ property CanFocus default True;
+ property DisableFocusEffect;
+ property TabOrder;
+ property AllowDrag default False;
+ property AlternatingRowBackground default False;
+ property ItemHeight;
+// property HideSelectionUnfocused default False;
+ property MultiSelect default False;
+ property ShowCheckboxes default False;
+ property Sorted default False;
+ property OnChange;
+ property OnChangeCheck;
+ property OnCompare;
+ property OnDragChange;
+ end;
+
+{$i frxPlatformsAttribute.inc}
+ TfsTree = class(TPanel)
+ private
+ Tree: TfsTreeView;
+ FXML: TfsXMLDocument;
+ FScript: TfsScript;
+ FImages: TList;
+ FShowFunctions: boolean;
+ FShowClasses: boolean;
+ FShowTypes: Boolean;
+ FShowVariables: Boolean;
+ FExpanded: boolean;
+ FExpandLevel : integer;
+ FMemo: TfsSyntaxMemo;
+ FUpdating: Boolean;
+ procedure FillTree;
+
+ procedure SetMemo(Value: TfsSyntaxMemo);
+
+ procedure SetScript(const Value: TfsScript);
+ protected
+ {$IFDEF DELPHI19}
+ procedure CreateImageFromRes(Image: TImage; Bmp: FMX.Graphics.TBitmap;
+ Width, Height: Integer; Index: Integer);
+ {$ELSE}
+ procedure CreateImageFromRes(Image: TImage; Bmp: FMX.Types.TBitmap;
+ Width, Height: Integer; Index: Integer);
+{$ENDIF}
+
+ procedure TreeChange(Sender: TObject; Node: TTreeViewItem);
+ procedure TreeDblClick(Sender: TObject);
+ procedure Notification(AComponent: TComponent;
+ Operation: TOperation); override;
+ protected
+ procedure Loaded; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure SetColor(Color: TAlphaColor);
+ procedure UpdateItems;
+ function GetFieldName: String;
+ published
+ property Align;
+ property Anchors;
+ property DragMode;
+ property Enabled;
+ property PopupMenu;
+ property Script: TfsScript read FScript write SetScript;
+ property ShowHint;
+ property TabOrder;
+ property Visible;
+
+ property SyntaxMemo: TfsSyntaxMemo read FMemo write SetMemo;
+ property ShowClasses: boolean read FShowClasses write FShowClasses;
+ property ShowFunctions: boolean read FShowFunctions write FShowFunctions;
+ property ShowTypes: boolean read FShowTypes write FShowTypes;
+ property ShowVariables: boolean read FShowVariables write FShowVariables;
+ property Expanded: boolean read FExpanded write FExpanded;
+ property ExpandLevel: integer read FExpandLevel write FExpandLevel;
+
+ property OnClick;
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ property Left;
+ property Top;
+ property Width;
+ property Height;
+ end;
+
+implementation
+
+{$IFNDEF FPC}
+ {$R fs_tree.res}
+{$ENDIF}
+
+uses FMX.fs_iTools;
+
+constructor TfsTree.Create(AOwner: TComponent);
+var
+ S: TResourceStream;
+begin
+ inherited;
+ DragMode := TDragMode.dmManual;
+ Tree := TfsTreeView.Create(Self);
+ Tree.Stored := False;
+ with Tree do
+ begin
+ Parent := Self;
+ DragMode := TDragMode.dmAutomatic;
+ Align := TAlignLayout.alClient;
+ TabOrder := 0;
+ end;
+ FImages := TList.Create();
+ S := TResourceStream.Create(HInstance, 'FSTREEFMX', RT_RCDATA);//RT_RCDATA
+ S.Position := 0;
+ Tree.LoadResouces(S, 16, 16);
+ S.Free;
+ Tree.OnDblClick := TreeDblClick;
+ FXML := TfsXMLDocument.Create;
+ Expanded := True;
+ ExpandLevel := 0;
+ ShowClasses := True;
+ ShowFunctions := True;
+ ShowTypes := True;
+ ShowVariables := True;
+ UpdateItems;
+ Top := 0;
+ Left := 0;
+ Height := 250;
+ Width := 200;
+end;
+
+
+ {$IFDEF DELPHI19}
+procedure TfsTree.CreateImageFromRes(Image: TImage; Bmp: FMX.Graphics.TBitmap;
+ Width, Height, Index: Integer);
+ {$ELSE}
+procedure TfsTree.CreateImageFromRes(Image: TImage; Bmp: FMX.Types.TBitmap;
+ Width, Height, Index: Integer);
+{$ENDIF}
+begin
+ Image.Width := Width;
+ Image.Height := Height;
+ Image.Bitmap.SetSize(Width, Height);
+ Image.Bitmap.Canvas.BeginScene;
+ Image.Bitmap.Canvas.DrawBitmap(Bmp, RectF(Width * Index , 0, Width * Index + Width , Height), RectF(0, 0, Width, Height), 1 );
+ Image.Bitmap.Canvas.EndScene;
+ //Image.Bitmap.BitmapChanged;
+end;
+
+destructor TfsTree.Destroy;
+begin
+ FImages.Free;
+ Tree.Free;
+ FUpdating := True;
+ FXML.Free;
+ inherited;
+end;
+
+procedure TfsTree.FillTree;
+
+ function GetCategoryByName(s: String): String;
+ begin
+ if s = 'ctConv' then result := 'Conversion'
+ else if s = 'ctFormat' then result := 'Formatting'
+ else if s = 'ctDate' then result := 'Date/Time'
+ else if s = 'ctString' then result := 'String routines'
+ else if s = 'ctMath' then result := 'Mathematical'
+ else if s = 'ctOther' then result := 'Other'
+ else result := s;
+ end;
+
+ procedure AddClasses(xi: TfsXMLItem; Root: TfsTreeViewItem);
+ var
+ i: Integer;
+ Node: TfsTreeViewItem;
+ s: String;
+ begin
+ s := xi.Prop['text'];
+ Node := TfsTreeViewItem.Create(Tree);
+ Node.Text := s;
+ if Root <> nil then
+ Node.Parent := Root
+ else
+ Node.Parent := Tree;
+ Node.Parent.AddObject(Node);
+ if Root = nil then
+ Node.Text := xi.Name;
+ if xi.Count = 0 then
+ begin
+ Node.OpenImageIndex := 1;
+ Node.CloseImageIndex := 1;
+ end
+ else
+ begin
+ Node.OpenImageIndex := 3;
+ Node.CloseImageIndex := 2;
+ end;
+ for i := 0 to xi.Count - 1 do
+ AddClasses(xi[i], Node);
+ end;
+
+ procedure AddFunctions(xi: TfsXMLItem; Root: TfsTreeViewItem);
+ var
+ i: Integer;
+ Node: TfsTreeViewItem;
+ s: String;
+ begin
+ s := xi.Prop['text'];
+ if xi.Count = 0 then
+ s := Copy(s, Pos(' ', s) + 1, 255) else { function }
+ s := GetCategoryByName(s); { category }
+ Node := TfsTreeViewItem.Create(Tree);
+ Node.DragMode := TDragMode.dmAutomatic;
+ Node.Text := s;
+ if Root <> nil then
+ Node.Parent := Root
+ else
+ Node.Parent := Tree;
+ Node.Parent.AddObject(Node);
+ if Root = nil then
+ Node.Text := xi.Name;
+ if xi.Count = 0 then
+ begin
+ Node.OpenImageIndex := 0;
+ Node.CloseImageIndex := 0;
+ end
+ else
+ begin
+ Node.OpenImageIndex := 3;
+ Node.CloseImageIndex := 2;
+ end;
+ for i := 0 to xi.Count - 1 do
+ AddFunctions(xi[i], Node);
+ end;
+
+ procedure AddTypes(xi: TfsXMLItem; Root: TfsTreeViewItem);
+ var
+ i: Integer;
+ Node: TfsTreeViewItem;
+ s: String;
+ begin
+ s := Copy(xi.Prop['text'], 1, 255);
+ Node := TfsTreeViewItem.Create(Tree);
+ Node.Text := s;
+ if Root <> nil then
+ Node.Parent := Root
+ else
+ Node.Parent := Tree;
+ Node.Parent.AddObject(Node);
+ if Root = nil then
+ Node.Text := xi.Name;
+ if xi.Count = 0 then
+ begin
+ Node.OpenImageIndex := 0;
+ Node.CloseImageIndex := 0;
+ end
+ else
+ begin
+ Node.OpenImageIndex := 3;
+ Node.CloseImageIndex := 2;
+ end;
+ for i := 0 to xi.Count - 1 do
+ AddTypes(xi[i], Node);
+ end;
+
+ procedure AddVariables(xi: TfsXMLItem; Root: TfsTreeViewItem);
+ var
+ i: Integer;
+ Node: TfsTreeViewItem;
+ s: String;
+ begin
+ s := xi.Prop['text'];
+ Node := TfsTreeViewItem.Create(Tree);
+ Node.Text := s;
+ if Root <> nil then
+ Node.Parent := Root
+ else
+ Node.Parent := Tree;
+ Node.Parent.AddObject(Node);
+ if Root = nil then
+ Node.Text := xi.Name;
+ if xi.Count = 0 then
+ begin
+ Node.OpenImageIndex := 0;
+ Node.CloseImageIndex := 0;
+ end
+ else
+ begin
+ Node.OpenImageIndex := 3;
+ Node.CloseImageIndex := 2;
+ end;
+ for i := 0 to xi.Count - 1 do
+ AddVariables(xi[i], Node);
+ end;
+
+ procedure ExpandNodes(level: integer);
+ var
+ j : integer;
+
+ procedure ExpandNode(Node: TTreeViewItem; level: integer);
+ var
+ j : integer;
+ begin
+ if Node.Level < level then
+ for j := 0 to Node.Count - 1 do
+ begin
+ if Node.Items[j].Level < Level then
+ Node.Items[j].IsExpanded := True;
+ ExpandNode(Node.Items[j], Level);
+ end;
+ end;
+ begin
+ if level > 0 then
+ for j := 0 to Tree.Count - 1 do
+ begin
+ if Tree.Items[j].Level <= Level then
+ Tree.Items[j].IsExpanded := True;
+ ExpandNode(Tree.Items[j], Level);
+ end;
+ end;
+
+begin
+ FUpdating := True;
+ FXML.Root.Clear;
+
+ GenerateXMLContents(fsGlobalUnit, FXML.Root);
+ if FScript <> nil then
+ GenerateXMLContents(FScript, FXML.Root);
+
+ Tree.BeginUpdate;
+ Tree.Clear;
+
+ if ShowClasses then
+ AddClasses(FXML.Root.FindItem('Classes'), nil);
+
+ if ShowFunctions then
+ AddFunctions(FXML.Root.FindItem('Functions'), nil);
+
+ if ShowTypes then
+ AddTypes(FXML.Root.FindItem('Types'), nil);
+
+ if ShowVariables then
+ AddVariables(FXML.Root.FindItem('Variables'), nil);
+
+ if Expanded then
+ ExpandNodes(ExpandLevel);
+ Tree.EndUpdate;
+ FUpdating := False;
+end;
+
+procedure TfsTree.UpdateItems;
+begin
+ FillTree;
+end;
+
+procedure TfsTree.TreeChange(Sender: TObject;
+ Node: TTreeViewItem);
+begin
+ if FUpdating then Exit;
+end;
+
+procedure TfsTree.TreeDblClick(Sender: TObject);
+begin
+ //if Assigned(SyntaxMemo) then
+ //if Tree.Selected.Count = 0 then
+ // SyntaxMemo.SelText := Tree.Selected.Text;
+ if Assigned(OnDblClick) then OnDblClick(Self);
+end;
+
+function TfsTree.GetFieldName: String;
+var
+ i, n: Integer;
+ s: String;
+begin
+ Result := '';
+ if (Tree.Selected <> nil) and (Tree.Selected.Count = 0) then
+ begin
+ s := Tree.Selected.Text;
+ if Pos('(', s) <> 0 then
+ n := 1 else
+ n := 0;
+ for i := 1 to Length(s) do
+{$IFDEF Delphi12}
+ if (s[i] = ',') or (s[i] = ';') then
+{$ELSE}
+ if s[i] in [',', ';'] then
+{$ENDIF}
+ Inc(n);
+
+ if n = 0 then
+ s := Copy(s, 1, Pos(':', s) - 1)
+ else
+ begin
+ s := Copy(s, 1, Pos('(', s));
+ for i := 1 to n - 1 do
+ s := s + ',';
+ s := s + ')';
+ end;
+ Result := s;
+ end;
+end;
+
+procedure TfsTree.Loaded;
+begin
+ Inherited;
+
+end;
+
+procedure TfsTree.SetColor(Color: TAlphaColor);
+begin
+ //Tree.Canvas.Stroke.Color := TAlphaColorRec.Azure;
+ // Tree.Color := Color;
+end;
+
+procedure TfsTree.SetMemo(Value: TfsSyntaxMemo);
+begin
+ FMemo := Value;
+end;
+
+procedure TfsTree.SetScript(const Value: TfsScript);
+begin
+ FScript := Value;
+ UpdateItems;
+end;
+
+procedure TfsTree.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited Notification(AComponent, Operation);
+ if Operation = opRemove then
+ if AComponent = FScript then
+ FScript := nil
+ else if AComponent = FMemo then
+ FMemo := nil
+end;
+
+{ TfsTreeViewItem }
+
+procedure TfsTreeViewItem.ApplyStyle;
+var
+ B: TFmxObject;
+ Offset: Single;
+begin
+ inherited;
+ B := FindStyleResource('button');
+ if (B <> nil) and (B is TCustomButton) then
+ begin
+ FButton := TCustomButton(B);
+ B := FindStyleResource('text');
+ Offset := 0;
+ if Self.TreeView is TfsTreeView then
+ Offset := TfsTreeView(Self.TreeView).IconWidth;
+
+ if (B <> nil) and (B is TText) then
+ begin
+{$IFDEF DELPHI17}
+ TText(B).Margins.Left := Offset;
+{$ELSE}
+ TText(B).Padding.Left := Offset;
+{$ENDIF}
+ end;
+ FImgPos := FButton.Position.X + FButton.Width - 2;
+ end;
+end;
+
+
+constructor TfsTreeViewItem.Create(AOwner: TComponent);
+begin
+ inherited;
+ FImgPos := 0;
+ FCloseImageIndex := -1;
+ FOpenImageIndex := -1;
+end;
+
+function TfsTreeViewItem.GetBitmap: TBitmap;
+begin
+ Result := nil;
+ if TreeView is TfsTreeView then
+ begin
+ Result := TfsTreeView(TreeView).FPicBitmap;
+ end;
+end;
+
+procedure TfsTreeViewItem.Paint;
+var
+ Bmp: TBitmap;
+ IconRect: TRectF;
+ Index: Integer;
+begin
+ inherited Paint;
+ if IsExpanded then
+ Index := FOpenImageIndex
+ else
+ Index := FCloseImageIndex;
+
+ if Index = -1 then Exit;
+
+ Bmp := GetBitmap;
+ if TreeView is TfsTreeView then
+ begin
+ IconRect := TfsTreeView(TreeView).GetBitmapRect(Index);
+ end;
+ if (Bmp <> nil) and (FImgPos > 0)then
+ Canvas.DrawBitmap(Bmp, IconRect, RectF(16, 0, 34, 16), 1 );
+end;
+
+{ TfsTreeView }
+
+constructor TfsTreeView.Create(AOwner: TComponent);
+begin
+ inherited;
+ FPicBitmap := nil;
+ FIconWidth := 0;
+ FIconHeight := 0;
+end;
+
+destructor TfsTreeView.Destroy;
+begin
+ if FPicBitmap <> nil then
+ FPicBitmap.Free;
+
+ inherited;
+end;
+
+procedure TfsTreeView.DragDrop(const Data: TDragObject; const Point: TPointF);
+begin
+ //inherited;
+ // don't use TTreeView handlers
+end;
+
+procedure TfsTreeView.DragOver(const Data: TDragObject; const Point: TPointF;
+ {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+begin
+ //inherited;
+ //don't use TTreeView handlers
+end;
+
+function TfsTreeView.GetBitmapRect(Index: Integer): TRectF;
+var
+ maxX, maxY, i: Integer;
+ PosX, PosY: Integer;
+begin
+ Result := RectF(0, 0, 0, 0);
+ if FPicBitmap = nil then Exit;
+ PosX := 0;
+ PosY := 0;
+ maxX := FPicBitmap.Width div FIconWidth;
+ maxY := FPicBitmap.Height div FIconHeight;
+
+ for i := 0 to maxY - 1 do
+ begin
+ if Index < maxX then
+ begin
+ PosX := FIconWidth * Index;
+ break;
+ end;
+ Index := Index div maxY;
+ Inc(PosY);
+ if PosY > maxY then
+ begin
+ PosX := 0;
+ PosY := 0;
+ break;
+ end;
+ end;
+ Result := RectF(PosX, PosY, PosX + FIconWidth, PosY + FIconHeight);
+end;
+
+procedure TfsTreeView.LoadResouces(Stream: TStream; IconWidth,
+ IconHeight: Integer);
+begin
+ FIconWidth := IconWidth;
+ FIconHeight := IconHeight;
+ if FPicBitmap = nil then
+ FPicBitmap := TBitmap.CreateFromStream(Stream)
+ else
+ FPicBitmap.LoadFromStream(Stream);
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsTreeViewItem, TFmxObject);
+ GroupDescendentsWith(TfsTreeView, TFmxObject);
+ GroupDescendentsWith(TfsTree, TFmxObject);
+ RegisterFmxClasses([TfsTreeViewItem, TfsTreeView]);
+
+end.
diff --git a/FastScript/FMX/FMX.fs_xml.pas b/FastScript/FMX/FMX.fs_xml.pas
new file mode 100644
index 0000000..11723e4
--- /dev/null
+++ b/FastScript/FMX/FMX.fs_xml.pas
@@ -0,0 +1,15 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ XML document }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_xml;
+
+{$i FMX.inc}
+{$i fs_xml.pas}
\ No newline at end of file
diff --git a/FastScript/FMX/FMXfs16.dpk b/FastScript/FMX/FMXfs16.dpk
new file mode 100644
index 0000000..60d40ad
--- /dev/null
+++ b/FastScript/FMX/FMXfs16.dpk
@@ -0,0 +1,60 @@
+// Package file for Delphi XE2
+
+package FMXfs16;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfs16.res b/FastScript/FMX/FMXfs16.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfs16.res differ
diff --git a/FastScript/FMX/FMXfs17.dpk b/FastScript/FMX/FMXfs17.dpk
new file mode 100644
index 0000000..2f51eaa
--- /dev/null
+++ b/FastScript/FMX/FMXfs17.dpk
@@ -0,0 +1,60 @@
+// Package file for Delphi XE3
+
+package FMXfs17;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfs17.res b/FastScript/FMX/FMXfs17.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfs17.res differ
diff --git a/FastScript/FMX/FMXfs18.dpk b/FastScript/FMX/FMXfs18.dpk
new file mode 100644
index 0000000..2e8cc3b
--- /dev/null
+++ b/FastScript/FMX/FMXfs18.dpk
@@ -0,0 +1,60 @@
+// Package file for Delphi XE4
+
+package FMXfs18;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfs18.otares b/FastScript/FMX/FMXfs18.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/FMXfs18.otares differ
diff --git a/FastScript/FMX/FMXfs18.res b/FastScript/FMX/FMXfs18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfs18.res differ
diff --git a/FastScript/FMX/FMXfs19.dpk b/FastScript/FMX/FMXfs19.dpk
new file mode 100644
index 0000000..484cfae
--- /dev/null
+++ b/FastScript/FMX/FMXfs19.dpk
@@ -0,0 +1,60 @@
+// Package file for Delphi XE5
+
+package FMXfs19;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfs19.otares b/FastScript/FMX/FMXfs19.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/FMXfs19.otares differ
diff --git a/FastScript/FMX/FMXfs19.res b/FastScript/FMX/FMXfs19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfs19.res differ
diff --git a/FastScript/FMX/FMXfs20.dpk b/FastScript/FMX/FMXfs20.dpk
new file mode 100644
index 0000000..9e0de3e
--- /dev/null
+++ b/FastScript/FMX/FMXfs20.dpk
@@ -0,0 +1,60 @@
+// Package file for Delphi XE6
+
+package FMXfs20;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfs20.otares b/FastScript/FMX/FMXfs20.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/FMXfs20.otares differ
diff --git a/FastScript/FMX/FMXfs20.res b/FastScript/FMX/FMXfs20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfs20.res differ
diff --git a/FastScript/FMX/FMXfs21.dpk b/FastScript/FMX/FMXfs21.dpk
new file mode 100644
index 0000000..820052a
--- /dev/null
+++ b/FastScript/FMX/FMXfs21.dpk
@@ -0,0 +1,60 @@
+// Package file for Delphi XE7
+
+package FMXfs21;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfs21.otares b/FastScript/FMX/FMXfs21.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/FMXfs21.otares differ
diff --git a/FastScript/FMX/FMXfs21.res b/FastScript/FMX/FMXfs21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfs21.res differ
diff --git a/FastScript/FMX/FMXfs22.dpk b/FastScript/FMX/FMXfs22.dpk
new file mode 100644
index 0000000..6820909
--- /dev/null
+++ b/FastScript/FMX/FMXfs22.dpk
@@ -0,0 +1,60 @@
+// Package file for Delphi XE8
+
+package FMXfs22;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfs22.otares b/FastScript/FMX/FMXfs22.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/FMXfs22.otares differ
diff --git a/FastScript/FMX/FMXfs22.res b/FastScript/FMX/FMXfs22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfs22.res differ
diff --git a/FastScript/FMX/FMXfs23.dpk b/FastScript/FMX/FMXfs23.dpk
new file mode 100644
index 0000000..8c587b3
--- /dev/null
+++ b/FastScript/FMX/FMXfs23.dpk
@@ -0,0 +1,59 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfs23;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfs23.otares b/FastScript/FMX/FMXfs23.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/FMXfs23.otares differ
diff --git a/FastScript/FMX/FMXfs23.res b/FastScript/FMX/FMXfs23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfs23.res differ
diff --git a/FastScript/FMX/FMXfs24.dpk b/FastScript/FMX/FMXfs24.dpk
new file mode 100644
index 0000000..19818d3
--- /dev/null
+++ b/FastScript/FMX/FMXfs24.dpk
@@ -0,0 +1,59 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfs24;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfs24.otares b/FastScript/FMX/FMXfs24.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/FMXfs24.otares differ
diff --git a/FastScript/FMX/FMXfs24.res b/FastScript/FMX/FMXfs24.res
new file mode 100644
index 0000000..3bb7875
Binary files /dev/null and b/FastScript/FMX/FMXfs24.res differ
diff --git a/FastScript/FMX/FMXfs25.dpk b/FastScript/FMX/FMXfs25.dpk
new file mode 100644
index 0000000..2f96717
--- /dev/null
+++ b/FastScript/FMX/FMXfs25.dpk
@@ -0,0 +1,59 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfs25;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfs25.otares b/FastScript/FMX/FMXfs25.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/FMXfs25.otares differ
diff --git a/FastScript/FMX/FMXfs25.res b/FastScript/FMX/FMXfs25.res
new file mode 100644
index 0000000..3bb7875
Binary files /dev/null and b/FastScript/FMX/FMXfs25.res differ
diff --git a/FastScript/FMX/FMXfs26.dpk b/FastScript/FMX/FMXfs26.dpk
new file mode 100644
index 0000000..9738876
--- /dev/null
+++ b/FastScript/FMX/FMXfs26.dpk
@@ -0,0 +1,59 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfs26;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfs27.dpk b/FastScript/FMX/FMXfs27.dpk
new file mode 100644
index 0000000..f5773b1
--- /dev/null
+++ b/FastScript/FMX/FMXfs27.dpk
@@ -0,0 +1,59 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfs27;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfs28.dpk b/FastScript/FMX/FMXfs28.dpk
new file mode 100644
index 0000000..6bdefa5
--- /dev/null
+++ b/FastScript/FMX/FMXfs28.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 11 Seattle
+
+package FMXfs29;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.BaseTypeAliases in 'FMX.BaseTypeAliases.pas',
+ FMX.FormTypeAliases in 'FMX.FormTypeAliases.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfs29.dpk b/FastScript/FMX/FMXfs29.dpk
new file mode 100644
index 0000000..95ece44
--- /dev/null
+++ b/FastScript/FMX/FMXfs29.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 12
+
+package FMXfs29;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.BaseTypeAliases in 'FMX.BaseTypeAliases.pas',
+ FMX.FormTypeAliases in 'FMX.FormTypeAliases.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsADO16.dpk b/FastScript/FMX/FMXfsADO16.dpk
new file mode 100644
index 0000000..10a404d
--- /dev/null
+++ b/FastScript/FMX/FMXfsADO16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package FMXfsADO16;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs16,
+ FMXfsDB16;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsADO16.res b/FastScript/FMX/FMXfsADO16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/FMXfsADO16.res differ
diff --git a/FastScript/FMX/FMXfsADO17.dpk b/FastScript/FMX/FMXfsADO17.dpk
new file mode 100644
index 0000000..52b903a
--- /dev/null
+++ b/FastScript/FMX/FMXfsADO17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package FMXfsADO17;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs17,
+ FMXfsDB17;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsADO17.res b/FastScript/FMX/FMXfsADO17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/FMXfsADO17.res differ
diff --git a/FastScript/FMX/FMXfsADO18.dpk b/FastScript/FMX/FMXfsADO18.dpk
new file mode 100644
index 0000000..f441ad3
--- /dev/null
+++ b/FastScript/FMX/FMXfsADO18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package FMXfsADO18;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs18,
+ FMXfsDB18;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsADO18.res b/FastScript/FMX/FMXfsADO18.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/FMXfsADO18.res differ
diff --git a/FastScript/FMX/FMXfsADO19.dpk b/FastScript/FMX/FMXfsADO19.dpk
new file mode 100644
index 0000000..424714e
--- /dev/null
+++ b/FastScript/FMX/FMXfsADO19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package FMXfsADO19;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs19,
+ FMXfsDB19;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsADO19.res b/FastScript/FMX/FMXfsADO19.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/FMXfsADO19.res differ
diff --git a/FastScript/FMX/FMXfsADO20.dpk b/FastScript/FMX/FMXfsADO20.dpk
new file mode 100644
index 0000000..d19c363
--- /dev/null
+++ b/FastScript/FMX/FMXfsADO20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package FMXfsADO20;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs20,
+ FMXfsDB20;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsADO20.res b/FastScript/FMX/FMXfsADO20.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/FMXfsADO20.res differ
diff --git a/FastScript/FMX/FMXfsADO21.dpk b/FastScript/FMX/FMXfsADO21.dpk
new file mode 100644
index 0000000..83c3ad3
--- /dev/null
+++ b/FastScript/FMX/FMXfsADO21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package FMXfsADO21;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs21,
+ FMXfsDB21;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsADO21.res b/FastScript/FMX/FMXfsADO21.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/FMXfsADO21.res differ
diff --git a/FastScript/FMX/FMXfsADO22.dpk b/FastScript/FMX/FMXfsADO22.dpk
new file mode 100644
index 0000000..ca5d373
--- /dev/null
+++ b/FastScript/FMX/FMXfsADO22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package FMXfsADO22;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs22,
+ FMXfsDB22;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsADO22.res b/FastScript/FMX/FMXfsADO22.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/FMXfsADO22.res differ
diff --git a/FastScript/FMX/FMXfsADO23.dpk b/FastScript/FMX/FMXfsADO23.dpk
new file mode 100644
index 0000000..0bc722e
--- /dev/null
+++ b/FastScript/FMX/FMXfsADO23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsADO23;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs23,
+ FMXfsDB23;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsADO23.res b/FastScript/FMX/FMXfsADO23.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/FMXfsADO23.res differ
diff --git a/FastScript/FMX/FMXfsADO24.dpk b/FastScript/FMX/FMXfsADO24.dpk
new file mode 100644
index 0000000..beb9b84
--- /dev/null
+++ b/FastScript/FMX/FMXfsADO24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsADO24;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs24,
+ FMXfsDB24;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsADO24.res b/FastScript/FMX/FMXfsADO24.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/FMXfsADO24.res differ
diff --git a/FastScript/FMX/FMXfsADO25.dpk b/FastScript/FMX/FMXfsADO25.dpk
new file mode 100644
index 0000000..93c4991
--- /dev/null
+++ b/FastScript/FMX/FMXfsADO25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsADO25;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs25,
+ FMXfsDB25;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsADO25.res b/FastScript/FMX/FMXfsADO25.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/FMXfsADO25.res differ
diff --git a/FastScript/FMX/FMXfsADO26.dpk b/FastScript/FMX/FMXfsADO26.dpk
new file mode 100644
index 0000000..0ed9a68
--- /dev/null
+++ b/FastScript/FMX/FMXfsADO26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsADO26;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs26,
+ FMXfsDB26;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsADO27.dpk b/FastScript/FMX/FMXfsADO27.dpk
new file mode 100644
index 0000000..f2a00b7
--- /dev/null
+++ b/FastScript/FMX/FMXfsADO27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsADO27;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs27,
+ FMXfsDB27;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsADO28.dpk b/FastScript/FMX/FMXfsADO28.dpk
new file mode 100644
index 0000000..1b0ab49
--- /dev/null
+++ b/FastScript/FMX/FMXfsADO28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package FMXfsADO29;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs29,
+ FMXfsDB29;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsADO29.dpk b/FastScript/FMX/FMXfsADO29.dpk
new file mode 100644
index 0000000..c14c3be
--- /dev/null
+++ b/FastScript/FMX/FMXfsADO29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package FMXfsADO29;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs29,
+ FMXfsDB29;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsDB16.dpk b/FastScript/FMX/FMXfsDB16.dpk
new file mode 100644
index 0000000..f6fa97e
--- /dev/null
+++ b/FastScript/FMX/FMXfsDB16.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE2
+
+package FMXfsDB16;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs16,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsDB16.res b/FastScript/FMX/FMXfsDB16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/FMXfsDB16.res differ
diff --git a/FastScript/FMX/FMXfsDB17.dpk b/FastScript/FMX/FMXfsDB17.dpk
new file mode 100644
index 0000000..6df8aa2
--- /dev/null
+++ b/FastScript/FMX/FMXfsDB17.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE3
+
+package FMXfsDB17;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs17,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsDB17.res b/FastScript/FMX/FMXfsDB17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/FMXfsDB17.res differ
diff --git a/FastScript/FMX/FMXfsDB18.dpk b/FastScript/FMX/FMXfsDB18.dpk
new file mode 100644
index 0000000..86897c0
--- /dev/null
+++ b/FastScript/FMX/FMXfsDB18.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE4
+
+package FMXfsDB18;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs18,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsDB18.otares b/FastScript/FMX/FMXfsDB18.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/FMXfsDB18.otares differ
diff --git a/FastScript/FMX/FMXfsDB18.res b/FastScript/FMX/FMXfsDB18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfsDB18.res differ
diff --git a/FastScript/FMX/FMXfsDB19.dpk b/FastScript/FMX/FMXfsDB19.dpk
new file mode 100644
index 0000000..2109b95
--- /dev/null
+++ b/FastScript/FMX/FMXfsDB19.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE5
+
+package FMXfsDB19;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs19,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsDB19.otares b/FastScript/FMX/FMXfsDB19.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/FMXfsDB19.otares differ
diff --git a/FastScript/FMX/FMXfsDB19.res b/FastScript/FMX/FMXfsDB19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfsDB19.res differ
diff --git a/FastScript/FMX/FMXfsDB20.dpk b/FastScript/FMX/FMXfsDB20.dpk
new file mode 100644
index 0000000..01116cd
--- /dev/null
+++ b/FastScript/FMX/FMXfsDB20.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE6
+
+package FMXfsDB20;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs20,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsDB20.otares b/FastScript/FMX/FMXfsDB20.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/FMXfsDB20.otares differ
diff --git a/FastScript/FMX/FMXfsDB20.res b/FastScript/FMX/FMXfsDB20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfsDB20.res differ
diff --git a/FastScript/FMX/FMXfsDB21.dpk b/FastScript/FMX/FMXfsDB21.dpk
new file mode 100644
index 0000000..8848232
--- /dev/null
+++ b/FastScript/FMX/FMXfsDB21.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE7
+
+package FMXfsDB21;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs21,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsDB21.otares b/FastScript/FMX/FMXfsDB21.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/FMXfsDB21.otares differ
diff --git a/FastScript/FMX/FMXfsDB21.res b/FastScript/FMX/FMXfsDB21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfsDB21.res differ
diff --git a/FastScript/FMX/FMXfsDB22.dpk b/FastScript/FMX/FMXfsDB22.dpk
new file mode 100644
index 0000000..08bd29f
--- /dev/null
+++ b/FastScript/FMX/FMXfsDB22.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE8
+
+package FMXfsDB22;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs22,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsDB22.otares b/FastScript/FMX/FMXfsDB22.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/FMXfsDB22.otares differ
diff --git a/FastScript/FMX/FMXfsDB22.res b/FastScript/FMX/FMXfsDB22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfsDB22.res differ
diff --git a/FastScript/FMX/FMXfsDB23.dpk b/FastScript/FMX/FMXfsDB23.dpk
new file mode 100644
index 0000000..fc47610
--- /dev/null
+++ b/FastScript/FMX/FMXfsDB23.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsDB23;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs23,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsDB23.otares b/FastScript/FMX/FMXfsDB23.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/FMXfsDB23.otares differ
diff --git a/FastScript/FMX/FMXfsDB23.res b/FastScript/FMX/FMXfsDB23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfsDB23.res differ
diff --git a/FastScript/FMX/FMXfsDB24.dpk b/FastScript/FMX/FMXfsDB24.dpk
new file mode 100644
index 0000000..6d3f1a9
--- /dev/null
+++ b/FastScript/FMX/FMXfsDB24.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsDB24;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs24,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsDB24.otares b/FastScript/FMX/FMXfsDB24.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/FMXfsDB24.otares differ
diff --git a/FastScript/FMX/FMXfsDB24.res b/FastScript/FMX/FMXfsDB24.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfsDB24.res differ
diff --git a/FastScript/FMX/FMXfsDB25.dpk b/FastScript/FMX/FMXfsDB25.dpk
new file mode 100644
index 0000000..d873f3a
--- /dev/null
+++ b/FastScript/FMX/FMXfsDB25.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsDB25;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs25,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsDB25.otares b/FastScript/FMX/FMXfsDB25.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/FMXfsDB25.otares differ
diff --git a/FastScript/FMX/FMXfsDB25.res b/FastScript/FMX/FMXfsDB25.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfsDB25.res differ
diff --git a/FastScript/FMX/FMXfsDB26.dpk b/FastScript/FMX/FMXfsDB26.dpk
new file mode 100644
index 0000000..359e620
--- /dev/null
+++ b/FastScript/FMX/FMXfsDB26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsDB26;
+
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs26,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsDB27.dpk b/FastScript/FMX/FMXfsDB27.dpk
new file mode 100644
index 0000000..e18c2a2
--- /dev/null
+++ b/FastScript/FMX/FMXfsDB27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsDB27;
+
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs27,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsDB28.dpk b/FastScript/FMX/FMXfsDB28.dpk
new file mode 100644
index 0000000..d7fb8f0
--- /dev/null
+++ b/FastScript/FMX/FMXfsDB28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package FMXfsDB29;
+
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs29,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsDB29.dpk b/FastScript/FMX/FMXfsDB29.dpk
new file mode 100644
index 0000000..d7fb8f0
--- /dev/null
+++ b/FastScript/FMX/FMXfsDB29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package FMXfsDB29;
+
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs29,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsIBX16.dpk b/FastScript/FMX/FMXfsIBX16.dpk
new file mode 100644
index 0000000..a64c4d2
--- /dev/null
+++ b/FastScript/FMX/FMXfsIBX16.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE2
+
+package FMXfsIBX16;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs16,
+ FMXfsDB16;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsIBX16.res b/FastScript/FMX/FMXfsIBX16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/FMXfsIBX16.res differ
diff --git a/FastScript/FMX/FMXfsIBX17.dpk b/FastScript/FMX/FMXfsIBX17.dpk
new file mode 100644
index 0000000..cf3fb7e
--- /dev/null
+++ b/FastScript/FMX/FMXfsIBX17.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE3
+
+package FMXfsIBX17;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs17,
+ FMXfsDB17;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsIBX17.res b/FastScript/FMX/FMXfsIBX17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/FMXfsIBX17.res differ
diff --git a/FastScript/FMX/FMXfsIBX18.dpk b/FastScript/FMX/FMXfsIBX18.dpk
new file mode 100644
index 0000000..7288365
--- /dev/null
+++ b/FastScript/FMX/FMXfsIBX18.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE4
+
+package FMXfsIBX18;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs18,
+ FMXfsDB18;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsIBX18.res b/FastScript/FMX/FMXfsIBX18.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/FMXfsIBX18.res differ
diff --git a/FastScript/FMX/FMXfsIBX19.dpk b/FastScript/FMX/FMXfsIBX19.dpk
new file mode 100644
index 0000000..cf86260
--- /dev/null
+++ b/FastScript/FMX/FMXfsIBX19.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE5
+
+package FMXfsIBX19;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs19,
+ FMXfsDB19;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsIBX19.res b/FastScript/FMX/FMXfsIBX19.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/FMXfsIBX19.res differ
diff --git a/FastScript/FMX/FMXfsIBX20.dpk b/FastScript/FMX/FMXfsIBX20.dpk
new file mode 100644
index 0000000..2e741b2
--- /dev/null
+++ b/FastScript/FMX/FMXfsIBX20.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE6
+
+package FMXfsIBX20;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs20,
+ FMXfsDB20;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsIBX20.res b/FastScript/FMX/FMXfsIBX20.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/FMXfsIBX20.res differ
diff --git a/FastScript/FMX/FMXfsIBX21.dpk b/FastScript/FMX/FMXfsIBX21.dpk
new file mode 100644
index 0000000..d6cd6d2
--- /dev/null
+++ b/FastScript/FMX/FMXfsIBX21.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE7
+
+package FMXfsIBX21;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs21,
+ FMXfsDB21;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsIBX21.res b/FastScript/FMX/FMXfsIBX21.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/FMXfsIBX21.res differ
diff --git a/FastScript/FMX/FMXfsIBX22.dpk b/FastScript/FMX/FMXfsIBX22.dpk
new file mode 100644
index 0000000..e870670
--- /dev/null
+++ b/FastScript/FMX/FMXfsIBX22.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE8
+
+package FMXfsIBX22;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs22,
+ FMXfsDB22;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsIBX22.res b/FastScript/FMX/FMXfsIBX22.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/FMXfsIBX22.res differ
diff --git a/FastScript/FMX/FMXfsIBX23.dpk b/FastScript/FMX/FMXfsIBX23.dpk
new file mode 100644
index 0000000..ef8b9fd
--- /dev/null
+++ b/FastScript/FMX/FMXfsIBX23.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsIBX23;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs23,
+ FMXfsDB23;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsIBX23.res b/FastScript/FMX/FMXfsIBX23.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/FMXfsIBX23.res differ
diff --git a/FastScript/FMX/FMXfsIBX24.dpk b/FastScript/FMX/FMXfsIBX24.dpk
new file mode 100644
index 0000000..d2c75a8
--- /dev/null
+++ b/FastScript/FMX/FMXfsIBX24.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsIBX24;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs24,
+ FMXfsDB24;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsIBX24.res b/FastScript/FMX/FMXfsIBX24.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/FMXfsIBX24.res differ
diff --git a/FastScript/FMX/FMXfsIBX25.dpk b/FastScript/FMX/FMXfsIBX25.dpk
new file mode 100644
index 0000000..5a734d2
--- /dev/null
+++ b/FastScript/FMX/FMXfsIBX25.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsIBX25;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs25,
+ FMXfsDB25;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsIBX25.res b/FastScript/FMX/FMXfsIBX25.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/FMXfsIBX25.res differ
diff --git a/FastScript/FMX/FMXfsIBX26.dpk b/FastScript/FMX/FMXfsIBX26.dpk
new file mode 100644
index 0000000..3acb9cc
--- /dev/null
+++ b/FastScript/FMX/FMXfsIBX26.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsIBX26;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs26,
+ FMXfsDB26;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsIBX27.dpk b/FastScript/FMX/FMXfsIBX27.dpk
new file mode 100644
index 0000000..de6a34e
--- /dev/null
+++ b/FastScript/FMX/FMXfsIBX27.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsIBX27;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs27,
+ FMXfsDB27;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsIBX28.dpk b/FastScript/FMX/FMXfsIBX28.dpk
new file mode 100644
index 0000000..0cba709
--- /dev/null
+++ b/FastScript/FMX/FMXfsIBX28.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 11 Seattle
+
+package FMXfsIBX29;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs29,
+ FMXfsDB29;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsIBX29.dpk b/FastScript/FMX/FMXfsIBX29.dpk
new file mode 100644
index 0000000..b5fa135
--- /dev/null
+++ b/FastScript/FMX/FMXfsIBX29.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 12
+
+package FMXfsIBX29;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs29,
+ FMXfsDB29;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsTee16.dpk b/FastScript/FMX/FMXfsTee16.dpk
new file mode 100644
index 0000000..69bd560
--- /dev/null
+++ b/FastScript/FMX/FMXfsTee16.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE2
+
+package FMXfsTee16;
+
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro916, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee916, FMXTEEUI916, {$ENDIF}
+ FMXfs16;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsTee16.res b/FastScript/FMX/FMXfsTee16.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfsTee16.res differ
diff --git a/FastScript/FMX/FMXfsTee17.dpk b/FastScript/FMX/FMXfsTee17.dpk
new file mode 100644
index 0000000..f51d5e6
--- /dev/null
+++ b/FastScript/FMX/FMXfsTee17.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE3
+
+package FMXfsTee17;
+
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro917, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee917, FMXTEEUI917, {$ENDIF}
+ FMXfs17;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsTee17.res b/FastScript/FMX/FMXfsTee17.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfsTee17.res differ
diff --git a/FastScript/FMX/FMXfsTee18.dpk b/FastScript/FMX/FMXfsTee18.dpk
new file mode 100644
index 0000000..e963a8b
--- /dev/null
+++ b/FastScript/FMX/FMXfsTee18.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE4
+
+package FMXfsTee18;
+
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro918, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee918, FMXTEEUI918, {$ENDIF}
+ FMXfs18;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsTee18.res b/FastScript/FMX/FMXfsTee18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfsTee18.res differ
diff --git a/FastScript/FMX/FMXfsTee19.dpk b/FastScript/FMX/FMXfsTee19.dpk
new file mode 100644
index 0000000..1370860
--- /dev/null
+++ b/FastScript/FMX/FMXfsTee19.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE5
+
+package FMXfsTee19;
+{$I tee.inc}
+{$I fmx.inc}
+
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs19
+{$IFDEF TeeChartStd} ,FMXTEE{$ENDIF}
+{$IFDEF TeeChart9},FMXTeePro919 {$ENDIF}
+{$IFDEF TeeChartStd9},FMXTee919{$ENDIF};
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
+
diff --git a/FastScript/FMX/FMXfsTee19.res b/FastScript/FMX/FMXfsTee19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfsTee19.res differ
diff --git a/FastScript/FMX/FMXfsTee20.dpk b/FastScript/FMX/FMXfsTee20.dpk
new file mode 100644
index 0000000..bf358bd
--- /dev/null
+++ b/FastScript/FMX/FMXfsTee20.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE6
+
+package FMXfsTee20;
+
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro920, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee920, TEEUI920, {$ENDIF}
+ FMXfs20;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsTee20.res b/FastScript/FMX/FMXfsTee20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfsTee20.res differ
diff --git a/FastScript/FMX/FMXfsTee21.dpk b/FastScript/FMX/FMXfsTee21.dpk
new file mode 100644
index 0000000..3481fb5
--- /dev/null
+++ b/FastScript/FMX/FMXfsTee21.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE7
+
+package FMXfsTee21;
+
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro921, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee921, TEEUI921, {$ENDIF}
+ FMXfs21;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsTee21.res b/FastScript/FMX/FMXfsTee21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfsTee21.res differ
diff --git a/FastScript/FMX/FMXfsTee22.dpk b/FastScript/FMX/FMXfsTee22.dpk
new file mode 100644
index 0000000..25e0fa0
--- /dev/null
+++ b/FastScript/FMX/FMXfsTee22.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE8
+
+package FMXfsTee22;
+
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro922, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee922, TEEUI922, {$ENDIF}
+ FMXfs22;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsTee22.res b/FastScript/FMX/FMXfsTee22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfsTee22.res differ
diff --git a/FastScript/FMX/FMXfsTee23.dpk b/FastScript/FMX/FMXfsTee23.dpk
new file mode 100644
index 0000000..7a09181
--- /dev/null
+++ b/FastScript/FMX/FMXfsTee23.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsTee23;
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro923, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee923, TEEUI923, {$ENDIF}
+ FMXfs23;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsTee23.res b/FastScript/FMX/FMXfsTee23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfsTee23.res differ
diff --git a/FastScript/FMX/FMXfsTee24.dpk b/FastScript/FMX/FMXfsTee24.dpk
new file mode 100644
index 0000000..4a295f0
--- /dev/null
+++ b/FastScript/FMX/FMXfsTee24.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsTee24;
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro924, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee924, TEEUI924, {$ENDIF}
+ FMXfs24;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsTee24.res b/FastScript/FMX/FMXfsTee24.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfsTee24.res differ
diff --git a/FastScript/FMX/FMXfsTee25.dpk b/FastScript/FMX/FMXfsTee25.dpk
new file mode 100644
index 0000000..6befc20
--- /dev/null
+++ b/FastScript/FMX/FMXfsTee25.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsTee25;
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro925, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee925, TEEUI925, {$ENDIF}
+ FMXfs25;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsTee25.res b/FastScript/FMX/FMXfsTee25.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/FMXfsTee25.res differ
diff --git a/FastScript/FMX/FMXfsTee26.dpk b/FastScript/FMX/FMXfsTee26.dpk
new file mode 100644
index 0000000..ba7bb49
--- /dev/null
+++ b/FastScript/FMX/FMXfsTee26.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsTee26;
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro926, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee926, TEEUI926, {$ENDIF}
+ FMXfs26;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsTee27.dpk b/FastScript/FMX/FMXfsTee27.dpk
new file mode 100644
index 0000000..69374c7
--- /dev/null
+++ b/FastScript/FMX/FMXfsTee27.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsTee27;
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro927, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee927, TEEUI927, {$ENDIF}
+ FMXfs27;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsTee28.dpk b/FastScript/FMX/FMXfsTee28.dpk
new file mode 100644
index 0000000..b741ede
--- /dev/null
+++ b/FastScript/FMX/FMXfsTee28.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi 11 Seattle
+
+package FMXfsTee29;
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro929, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee929, TEEUI929, {$ENDIF}
+ FMXfs29;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfsTee29.dpk b/FastScript/FMX/FMXfsTee29.dpk
new file mode 100644
index 0000000..29aa466
--- /dev/null
+++ b/FastScript/FMX/FMXfsTee29.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi 12
+
+package FMXfsTee29;
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro929, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee929, TEEUI929, {$ENDIF}
+ FMXfs29;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMX/FMXfs_iadoreg.pas b/FastScript/FMX/FMXfs_iadoreg.pas
new file mode 100644
index 0000000..8decc54
--- /dev/null
+++ b/FastScript/FMX/FMXfs_iadoreg.pas
@@ -0,0 +1,37 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMXfs_iadoreg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ System.Classes
+, DesignIntf
+, FMX.Types
+, FMX.fs_iadortti;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+ //GroupDescendentsWith(TfsADORTTI, TFmxObject);
+ RegisterComponents('FastScript FMX', [TfsADORTTI]);
+end;
+
+end.
diff --git a/FastScript/FMX/FMXfs_idbreg.pas b/FastScript/FMX/FMXfs_idbreg.pas
new file mode 100644
index 0000000..b514773
--- /dev/null
+++ b/FastScript/FMX/FMXfs_idbreg.pas
@@ -0,0 +1,37 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMXfs_idbreg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ System.Classes
+, DesignIntf
+, FMX.Types
+, FMX.fs_idbrtti;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+ // GroupDescendentsWith(TfsDBRTTI, TFmxObject);
+ RegisterComponents('FastScript FMX', [TfsDBRTTI]);
+end;
+
+end.
diff --git a/FastScript/FMX/FMXfs_iibxreg.pas b/FastScript/FMX/FMXfs_iibxreg.pas
new file mode 100644
index 0000000..9a946a4
--- /dev/null
+++ b/FastScript/FMX/FMXfs_iibxreg.pas
@@ -0,0 +1,37 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMXfs_iibxreg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ System.Classes
+, FMX.Types
+, DesignIntf
+, FMX.fs_iibxrtti;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+ //GroupDescendentsWith(TfsIBXRTTI, TFmxObject);
+ RegisterComponents('FastScript FMX', [TfsIBXRTTI]);
+end;
+
+end.
diff --git a/FastScript/FMX/FMXfs_ireg.pas b/FastScript/FMX/FMXfs_ireg.pas
new file mode 100644
index 0000000..496346b
--- /dev/null
+++ b/FastScript/FMX/FMXfs_ireg.pas
@@ -0,0 +1,85 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMXfs_ireg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+uses
+ System.Classes
+{$IFNDEF FPC}
+ {$IFNDEF Delphi6}
+ , DsgnIntf
+ {$ELSE}
+ , DesignIntf
+ {$ENDIF}
+{$ELSE}
+ ,PropEdits
+ ,LazarusPackageIntf
+ ,LResources
+{$ENDIF}
+{$IFDEF DELPHI16}
+ , FMX.Controls, FMX.Types
+{$ENDIF}
+, FMX.fs_iinterpreter, FMX.fs_iclassesrtti, FMX.fs_igraphicsrtti, FMX.fs_iformsrtti,
+ FMX.fs_iextctrlsrtti, FMX.fs_idialogsrtti, FMX.fs_iinirtti, FMX.fs_imenusrtti,
+ FMX.fs_ipascal, FMX.fs_icpp, FMX.fs_ijs, FMX.fs_ibasic, FMX.fs_tree
+{$IFNDEF CLX}
+, FMX.fs_synmemo
+{$ENDIF}
+;
+
+{-----------------------------------------------------------------------}
+
+{$ifdef FPC}
+procedure RegisterUnitfs_ireg;
+{$else}
+procedure Register;
+{$endif}
+begin
+ {GroupDescendentsWith(TfsExtCtrlsRTTI, TFmxObject);
+ GroupDescendentsWith(TfsDialogsRTTI, TFmxObject);
+ GroupDescendentsWith(TfsGraphicsRTTI, TFmxObject);
+ GroupDescendentsWith(TfsMenusRTTI, TFmxObject);
+ GroupDescendentsWith(TfsScript, TFmxObject);
+ GroupDescendentsWith(TfsIniRTTI, TFmxObject);
+ GroupDescendentsWith(TfsFormsRTTI, TFmxObject);
+ GroupDescendentsWith(TfsClassesRTTI, TFmxObject);
+ GroupDescendentsWith(TfsPascal, TFmxObject);
+ GroupDescendentsWith(TfsCPP, TFmxObject);
+ GroupDescendentsWith(TfsJScript, TFmxObject);
+ GroupDescendentsWith(TfsBasic, TFmxObject);}
+ RegisterComponents('FastScript FMX',
+ [TfsScript, TfsPascal, TfsCPP, TfsJScript, TfsBasic,
+ TfsClassesRTTI, TfsGraphicsRTTI, TfsFormsRTTI, TfsExtCtrlsRTTI,
+ TfsDialogsRTTI, TfsMenusRTTI, TfsIniRTTI,
+ TfsTree, TfsSyntaxMemo]);
+
+end;
+
+{$ifdef FPC}
+procedure Register;
+begin
+ RegisterUnit('fs_ireg', @RegisterUnitfs_ireg);
+end;
+{$endif}
+
+initialization
+{$IFDEF FPC}
+ {$INCLUDE fs_ireg.lrs}
+{$ENDIF}
+end.
diff --git a/FastScript/FMX/FMXfs_iteereg.pas b/FastScript/FMX/FMXfs_iteereg.pas
new file mode 100644
index 0000000..f47dea6
--- /dev/null
+++ b/FastScript/FMX/FMXfs_iteereg.pas
@@ -0,0 +1,38 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMXfs_iteereg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ System.Classes
+, FMX.Types
+, DesignIntf
+, FMX.fs_ichartrtti;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+ //GroupDescendentsWith(TfsChartRTTI, TFmxObject);
+ RegisterComponents('FastScript FMX',
+ [TfsChartRTTI]);
+end;
+
+end.
diff --git a/FastScript/FMX/dclFMXfs16.dpk b/FastScript/FMX/dclFMXfs16.dpk
new file mode 100644
index 0000000..58b4aa8
--- /dev/null
+++ b/FastScript/FMX/dclFMXfs16.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE2
+
+package dclFMXfs16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs16;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfs16.res b/FastScript/FMX/dclFMXfs16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfs16.res differ
diff --git a/FastScript/FMX/dclFMXfs17.dpk b/FastScript/FMX/dclFMXfs17.dpk
new file mode 100644
index 0000000..233a78e
--- /dev/null
+++ b/FastScript/FMX/dclFMXfs17.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE3
+
+package dclFMXfs17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs17;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfs17.res b/FastScript/FMX/dclFMXfs17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfs17.res differ
diff --git a/FastScript/FMX/dclFMXfs18.dpk b/FastScript/FMX/dclFMXfs18.dpk
new file mode 100644
index 0000000..77885c7
--- /dev/null
+++ b/FastScript/FMX/dclFMXfs18.dpk
@@ -0,0 +1,44 @@
+// Package file for Delphi XE4
+
+package dclFMXfs18;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs18;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfs18.otares b/FastScript/FMX/dclFMXfs18.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/dclFMXfs18.otares differ
diff --git a/FastScript/FMX/dclFMXfs18.res b/FastScript/FMX/dclFMXfs18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/dclFMXfs18.res differ
diff --git a/FastScript/FMX/dclFMXfs19.dpk b/FastScript/FMX/dclFMXfs19.dpk
new file mode 100644
index 0000000..312058b
--- /dev/null
+++ b/FastScript/FMX/dclFMXfs19.dpk
@@ -0,0 +1,44 @@
+// Package file for Delphi XE5
+
+package dclFMXfs19;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs19;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfs19.otares b/FastScript/FMX/dclFMXfs19.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/dclFMXfs19.otares differ
diff --git a/FastScript/FMX/dclFMXfs19.res b/FastScript/FMX/dclFMXfs19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/dclFMXfs19.res differ
diff --git a/FastScript/FMX/dclFMXfs20.dpk b/FastScript/FMX/dclFMXfs20.dpk
new file mode 100644
index 0000000..4f35242
--- /dev/null
+++ b/FastScript/FMX/dclFMXfs20.dpk
@@ -0,0 +1,44 @@
+// Package file for Delphi XE6
+
+package dclFMXfs20;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs20;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfs20.otares b/FastScript/FMX/dclFMXfs20.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/dclFMXfs20.otares differ
diff --git a/FastScript/FMX/dclFMXfs20.res b/FastScript/FMX/dclFMXfs20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/dclFMXfs20.res differ
diff --git a/FastScript/FMX/dclFMXfs21.dpk b/FastScript/FMX/dclFMXfs21.dpk
new file mode 100644
index 0000000..cf1c58d
--- /dev/null
+++ b/FastScript/FMX/dclFMXfs21.dpk
@@ -0,0 +1,44 @@
+// Package file for Delphi XE7
+
+package dclFMXfs21;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs21;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfs21.otares b/FastScript/FMX/dclFMXfs21.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/dclFMXfs21.otares differ
diff --git a/FastScript/FMX/dclFMXfs21.res b/FastScript/FMX/dclFMXfs21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/dclFMXfs21.res differ
diff --git a/FastScript/FMX/dclFMXfs22.dpk b/FastScript/FMX/dclFMXfs22.dpk
new file mode 100644
index 0000000..e6ac3ff
--- /dev/null
+++ b/FastScript/FMX/dclFMXfs22.dpk
@@ -0,0 +1,44 @@
+// Package file for Delphi XE8
+
+package dclFMXfs22;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs22;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfs22.otares b/FastScript/FMX/dclFMXfs22.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/dclFMXfs22.otares differ
diff --git a/FastScript/FMX/dclFMXfs22.res b/FastScript/FMX/dclFMXfs22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/dclFMXfs22.res differ
diff --git a/FastScript/FMX/dclFMXfs23.dpk b/FastScript/FMX/dclFMXfs23.dpk
new file mode 100644
index 0000000..c1bd62e
--- /dev/null
+++ b/FastScript/FMX/dclFMXfs23.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfs23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs23;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfs23.otares b/FastScript/FMX/dclFMXfs23.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/dclFMXfs23.otares differ
diff --git a/FastScript/FMX/dclFMXfs23.res b/FastScript/FMX/dclFMXfs23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/dclFMXfs23.res differ
diff --git a/FastScript/FMX/dclFMXfs24.dpk b/FastScript/FMX/dclFMXfs24.dpk
new file mode 100644
index 0000000..e793d8b
--- /dev/null
+++ b/FastScript/FMX/dclFMXfs24.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfs24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs24;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfs24.otares b/FastScript/FMX/dclFMXfs24.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/dclFMXfs24.otares differ
diff --git a/FastScript/FMX/dclFMXfs24.res b/FastScript/FMX/dclFMXfs24.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/dclFMXfs24.res differ
diff --git a/FastScript/FMX/dclFMXfs25.dpk b/FastScript/FMX/dclFMXfs25.dpk
new file mode 100644
index 0000000..9128c4d
--- /dev/null
+++ b/FastScript/FMX/dclFMXfs25.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfs25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs25;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfs25.otares b/FastScript/FMX/dclFMXfs25.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/dclFMXfs25.otares differ
diff --git a/FastScript/FMX/dclFMXfs25.res b/FastScript/FMX/dclFMXfs25.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/dclFMXfs25.res differ
diff --git a/FastScript/FMX/dclFMXfs26.dpk b/FastScript/FMX/dclFMXfs26.dpk
new file mode 100644
index 0000000..48cdb6d
--- /dev/null
+++ b/FastScript/FMX/dclFMXfs26.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfs26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs26;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfs27.dpk b/FastScript/FMX/dclFMXfs27.dpk
new file mode 100644
index 0000000..674e7b6
--- /dev/null
+++ b/FastScript/FMX/dclFMXfs27.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfs27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs27;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfs28.dpk b/FastScript/FMX/dclFMXfs28.dpk
new file mode 100644
index 0000000..fc71708
--- /dev/null
+++ b/FastScript/FMX/dclFMXfs28.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 11 Seattle
+
+package dclFMXfs29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsADO16.dpk b/FastScript/FMX/dclFMXfsADO16.dpk
new file mode 100644
index 0000000..51dfee4
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsADO16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclFMXfsADO16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs16,
+ FMXfsADO16;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsADO16.res b/FastScript/FMX/dclFMXfsADO16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsADO16.res differ
diff --git a/FastScript/FMX/dclFMXfsADO17.dpk b/FastScript/FMX/dclFMXfsADO17.dpk
new file mode 100644
index 0000000..645ec65
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsADO17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclFMXfsADO17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs17,
+ FMXfsADO17;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsADO17.res b/FastScript/FMX/dclFMXfsADO17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsADO17.res differ
diff --git a/FastScript/FMX/dclFMXfsADO18.dpk b/FastScript/FMX/dclFMXfsADO18.dpk
new file mode 100644
index 0000000..0262696
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsADO18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package dclFMXfsADO18;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs18,
+ FMXfsADO18;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsADO18.res b/FastScript/FMX/dclFMXfsADO18.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsADO18.res differ
diff --git a/FastScript/FMX/dclFMXfsADO19.dpk b/FastScript/FMX/dclFMXfsADO19.dpk
new file mode 100644
index 0000000..ad55963
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsADO19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package dclFMXfsADO19;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs19,
+ FMXfsADO19;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsADO19.res b/FastScript/FMX/dclFMXfsADO19.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsADO19.res differ
diff --git a/FastScript/FMX/dclFMXfsADO20.dpk b/FastScript/FMX/dclFMXfsADO20.dpk
new file mode 100644
index 0000000..8009901
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsADO20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package dclFMXfsADO20;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs20,
+ FMXfsADO20;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsADO20.res b/FastScript/FMX/dclFMXfsADO20.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsADO20.res differ
diff --git a/FastScript/FMX/dclFMXfsADO21.dpk b/FastScript/FMX/dclFMXfsADO21.dpk
new file mode 100644
index 0000000..40948f9
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsADO21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package dclFMXfsADO21;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs21,
+ FMXfsADO21;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsADO21.res b/FastScript/FMX/dclFMXfsADO21.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsADO21.res differ
diff --git a/FastScript/FMX/dclFMXfsADO22.dpk b/FastScript/FMX/dclFMXfsADO22.dpk
new file mode 100644
index 0000000..a5755db
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsADO22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package dclFMXfsADO22;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs22,
+ FMXfsADO22;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsADO22.res b/FastScript/FMX/dclFMXfsADO22.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsADO22.res differ
diff --git a/FastScript/FMX/dclFMXfsADO23.dpk b/FastScript/FMX/dclFMXfsADO23.dpk
new file mode 100644
index 0000000..404c4c0
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsADO23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsADO23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs23,
+ FMXfsADO23;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsADO23.res b/FastScript/FMX/dclFMXfsADO23.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsADO23.res differ
diff --git a/FastScript/FMX/dclFMXfsADO24.dpk b/FastScript/FMX/dclFMXfsADO24.dpk
new file mode 100644
index 0000000..64bc04f
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsADO24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsADO24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs24,
+ FMXfsADO24;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsADO24.res b/FastScript/FMX/dclFMXfsADO24.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsADO24.res differ
diff --git a/FastScript/FMX/dclFMXfsADO25.dpk b/FastScript/FMX/dclFMXfsADO25.dpk
new file mode 100644
index 0000000..982c24f
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsADO25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsADO25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs25,
+ FMXfsADO25;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsADO25.res b/FastScript/FMX/dclFMXfsADO25.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsADO25.res differ
diff --git a/FastScript/FMX/dclFMXfsADO26.dpk b/FastScript/FMX/dclFMXfsADO26.dpk
new file mode 100644
index 0000000..2fc6d43
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsADO26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsADO26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs26,
+ FMXfsADO26;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsADO27.dpk b/FastScript/FMX/dclFMXfsADO27.dpk
new file mode 100644
index 0000000..fddfc91
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsADO27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsADO27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs27,
+ FMXfsADO27;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsADO28.dpk b/FastScript/FMX/dclFMXfsADO28.dpk
new file mode 100644
index 0000000..7421454
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsADO28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package dclFMXfsADO29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29,
+ FMXfsADO29;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsADO29.dpk b/FastScript/FMX/dclFMXfsADO29.dpk
new file mode 100644
index 0000000..edc9fa5
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsADO29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package dclFMXfsADO29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29,
+ FMXfsADO29;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsDB16.dpk b/FastScript/FMX/dclFMXfsDB16.dpk
new file mode 100644
index 0000000..ae49c7f
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsDB16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclFMXfsDB16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs16,
+ FMXfsDB16;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsDB16.res b/FastScript/FMX/dclFMXfsDB16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsDB16.res differ
diff --git a/FastScript/FMX/dclFMXfsDB17.dpk b/FastScript/FMX/dclFMXfsDB17.dpk
new file mode 100644
index 0000000..65073fc
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsDB17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclFMXfsDB17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs17,
+ FMXfsDB17;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsDB17.res b/FastScript/FMX/dclFMXfsDB17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsDB17.res differ
diff --git a/FastScript/FMX/dclFMXfsDB18.dpk b/FastScript/FMX/dclFMXfsDB18.dpk
new file mode 100644
index 0000000..f944213
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsDB18.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi XE4
+
+package dclFMXfsDB18;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs18,
+ FMXfsDB18;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsDB18.otares b/FastScript/FMX/dclFMXfsDB18.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/dclFMXfsDB18.otares differ
diff --git a/FastScript/FMX/dclFMXfsDB18.res b/FastScript/FMX/dclFMXfsDB18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/dclFMXfsDB18.res differ
diff --git a/FastScript/FMX/dclFMXfsDB19.dpk b/FastScript/FMX/dclFMXfsDB19.dpk
new file mode 100644
index 0000000..6cd2ae6
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsDB19.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi XE5
+
+package dclFMXfsDB19;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs19,
+ FMXfsDB19;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsDB19.otares b/FastScript/FMX/dclFMXfsDB19.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/dclFMXfsDB19.otares differ
diff --git a/FastScript/FMX/dclFMXfsDB19.res b/FastScript/FMX/dclFMXfsDB19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/dclFMXfsDB19.res differ
diff --git a/FastScript/FMX/dclFMXfsDB20.dpk b/FastScript/FMX/dclFMXfsDB20.dpk
new file mode 100644
index 0000000..9c12348
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsDB20.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi XE6
+
+package dclFMXfsDB20;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs20,
+ FMXfsDB20;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsDB20.otares b/FastScript/FMX/dclFMXfsDB20.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/dclFMXfsDB20.otares differ
diff --git a/FastScript/FMX/dclFMXfsDB20.res b/FastScript/FMX/dclFMXfsDB20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/dclFMXfsDB20.res differ
diff --git a/FastScript/FMX/dclFMXfsDB21.dpk b/FastScript/FMX/dclFMXfsDB21.dpk
new file mode 100644
index 0000000..5f18d25
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsDB21.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi XE7
+
+package dclFMXfsDB21;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs21,
+ FMXfsDB21;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsDB21.otares b/FastScript/FMX/dclFMXfsDB21.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/dclFMXfsDB21.otares differ
diff --git a/FastScript/FMX/dclFMXfsDB21.res b/FastScript/FMX/dclFMXfsDB21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/dclFMXfsDB21.res differ
diff --git a/FastScript/FMX/dclFMXfsDB22.dpk b/FastScript/FMX/dclFMXfsDB22.dpk
new file mode 100644
index 0000000..d70808f
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsDB22.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi XE8
+
+package dclFMXfsDB22;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs22,
+ FMXfsDB22;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsDB22.otares b/FastScript/FMX/dclFMXfsDB22.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/dclFMXfsDB22.otares differ
diff --git a/FastScript/FMX/dclFMXfsDB22.res b/FastScript/FMX/dclFMXfsDB22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/dclFMXfsDB22.res differ
diff --git a/FastScript/FMX/dclFMXfsDB23.dpk b/FastScript/FMX/dclFMXfsDB23.dpk
new file mode 100644
index 0000000..bd11a08
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsDB23.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsDB23;
+
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs23,
+ FMXfsDB23;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsDB23.otares b/FastScript/FMX/dclFMXfsDB23.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/dclFMXfsDB23.otares differ
diff --git a/FastScript/FMX/dclFMXfsDB23.res b/FastScript/FMX/dclFMXfsDB23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/dclFMXfsDB23.res differ
diff --git a/FastScript/FMX/dclFMXfsDB24.dpk b/FastScript/FMX/dclFMXfsDB24.dpk
new file mode 100644
index 0000000..21680c2
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsDB24.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsDB24;
+
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs24,
+ FMXfsDB24;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsDB24.otares b/FastScript/FMX/dclFMXfsDB24.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/dclFMXfsDB24.otares differ
diff --git a/FastScript/FMX/dclFMXfsDB24.res b/FastScript/FMX/dclFMXfsDB24.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/dclFMXfsDB24.res differ
diff --git a/FastScript/FMX/dclFMXfsDB25.dpk b/FastScript/FMX/dclFMXfsDB25.dpk
new file mode 100644
index 0000000..3f6b02e
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsDB25.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsDB25;
+
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs25,
+ FMXfsDB25;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsDB25.otares b/FastScript/FMX/dclFMXfsDB25.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMX/dclFMXfsDB25.otares differ
diff --git a/FastScript/FMX/dclFMXfsDB25.res b/FastScript/FMX/dclFMXfsDB25.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMX/dclFMXfsDB25.res differ
diff --git a/FastScript/FMX/dclFMXfsDB26.dpk b/FastScript/FMX/dclFMXfsDB26.dpk
new file mode 100644
index 0000000..5d4661f
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsDB26.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsDB26;
+
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs26,
+ FMXfsDB26;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsDB27.dpk b/FastScript/FMX/dclFMXfsDB27.dpk
new file mode 100644
index 0000000..c8983d1
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsDB27.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsDB27;
+
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs27,
+ FMXfsDB27;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsDB28.dpk b/FastScript/FMX/dclFMXfsDB28.dpk
new file mode 100644
index 0000000..7c302c3
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsDB28.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 11 Seattle
+
+package dclFMXfsDB29;
+
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29,
+ FMXfsDB29;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsDB29.dpk b/FastScript/FMX/dclFMXfsDB29.dpk
new file mode 100644
index 0000000..57a4391
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsDB29.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 12
+
+package dclFMXfsDB29;
+
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29,
+ FMXfsDB29;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsIBX16.dpk b/FastScript/FMX/dclFMXfsIBX16.dpk
new file mode 100644
index 0000000..024903b
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsIBX16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclFMXfsIBX16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs16,
+ FMXfsIBX16;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsIBX16.res b/FastScript/FMX/dclFMXfsIBX16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsIBX16.res differ
diff --git a/FastScript/FMX/dclFMXfsIBX17.dpk b/FastScript/FMX/dclFMXfsIBX17.dpk
new file mode 100644
index 0000000..595bf4e
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsIBX17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclFMXfsIBX17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs17,
+ FMXfsIBX17;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsIBX17.res b/FastScript/FMX/dclFMXfsIBX17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsIBX17.res differ
diff --git a/FastScript/FMX/dclFMXfsIBX18.dpk b/FastScript/FMX/dclFMXfsIBX18.dpk
new file mode 100644
index 0000000..7c1cb8d
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsIBX18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package dclFMXfsIBX18;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs18,
+ FMXfsIBX18;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsIBX18.res b/FastScript/FMX/dclFMXfsIBX18.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsIBX18.res differ
diff --git a/FastScript/FMX/dclFMXfsIBX19.dpk b/FastScript/FMX/dclFMXfsIBX19.dpk
new file mode 100644
index 0000000..c77c2f4
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsIBX19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package dclFMXfsIBX19;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs19,
+ FMXfsIBX19;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsIBX19.res b/FastScript/FMX/dclFMXfsIBX19.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsIBX19.res differ
diff --git a/FastScript/FMX/dclFMXfsIBX20.dpk b/FastScript/FMX/dclFMXfsIBX20.dpk
new file mode 100644
index 0000000..ca64df5
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsIBX20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package dclFMXfsIBX20;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs20,
+ FMXfsIBX20;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsIBX20.res b/FastScript/FMX/dclFMXfsIBX20.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsIBX20.res differ
diff --git a/FastScript/FMX/dclFMXfsIBX21.dpk b/FastScript/FMX/dclFMXfsIBX21.dpk
new file mode 100644
index 0000000..26d360a
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsIBX21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package dclFMXfsIBX21;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs21,
+ FMXfsIBX21;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsIBX21.res b/FastScript/FMX/dclFMXfsIBX21.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsIBX21.res differ
diff --git a/FastScript/FMX/dclFMXfsIBX22.dpk b/FastScript/FMX/dclFMXfsIBX22.dpk
new file mode 100644
index 0000000..854fc1a
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsIBX22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package dclFMXfsIBX22;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs22,
+ FMXfsIBX22;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsIBX22.res b/FastScript/FMX/dclFMXfsIBX22.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsIBX22.res differ
diff --git a/FastScript/FMX/dclFMXfsIBX23.dpk b/FastScript/FMX/dclFMXfsIBX23.dpk
new file mode 100644
index 0000000..e4690f5
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsIBX23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsIBX23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs23,
+ FMXfsIBX23;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsIBX23.res b/FastScript/FMX/dclFMXfsIBX23.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsIBX23.res differ
diff --git a/FastScript/FMX/dclFMXfsIBX24.dpk b/FastScript/FMX/dclFMXfsIBX24.dpk
new file mode 100644
index 0000000..7f67057
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsIBX24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsIBX24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs24,
+ FMXfsIBX24;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsIBX24.res b/FastScript/FMX/dclFMXfsIBX24.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsIBX24.res differ
diff --git a/FastScript/FMX/dclFMXfsIBX25.dpk b/FastScript/FMX/dclFMXfsIBX25.dpk
new file mode 100644
index 0000000..760b971
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsIBX25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsIBX25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs25,
+ FMXfsIBX25;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsIBX25.res b/FastScript/FMX/dclFMXfsIBX25.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsIBX25.res differ
diff --git a/FastScript/FMX/dclFMXfsIBX26.dpk b/FastScript/FMX/dclFMXfsIBX26.dpk
new file mode 100644
index 0000000..5787898
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsIBX26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsIBX26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs26,
+ FMXfsIBX26;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsIBX27.dpk b/FastScript/FMX/dclFMXfsIBX27.dpk
new file mode 100644
index 0000000..dbfac84
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsIBX27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsIBX27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs27,
+ FMXfsIBX27;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsIBX28.dpk b/FastScript/FMX/dclFMXfsIBX28.dpk
new file mode 100644
index 0000000..fc50c43
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsIBX28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package dclFMXfsIBX29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29,
+ FMXfsIBX29;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsIBX29.dpk b/FastScript/FMX/dclFMXfsIBX29.dpk
new file mode 100644
index 0000000..874e96e
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsIBX29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package dclFMXfsIBX29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29,
+ FMXfsIBX29;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsTee16.dpk b/FastScript/FMX/dclFMXfsTee16.dpk
new file mode 100644
index 0000000..3ff825f
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsTee16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclFMXfsTee16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs16,
+ FMXfsTee16;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsTee16.res b/FastScript/FMX/dclFMXfsTee16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsTee16.res differ
diff --git a/FastScript/FMX/dclFMXfsTee17.dpk b/FastScript/FMX/dclFMXfsTee17.dpk
new file mode 100644
index 0000000..6725bc8
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsTee17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclFMXfsTee17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs17,
+ FMXfsTee17;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsTee17.res b/FastScript/FMX/dclFMXfsTee17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsTee17.res differ
diff --git a/FastScript/FMX/dclFMXfsTee18.dpk b/FastScript/FMX/dclFMXfsTee18.dpk
new file mode 100644
index 0000000..86bd659
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsTee18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package dclFMXfsTee18;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs18,
+ FMXfsTee18;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsTee18.res b/FastScript/FMX/dclFMXfsTee18.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsTee18.res differ
diff --git a/FastScript/FMX/dclFMXfsTee19.dpk b/FastScript/FMX/dclFMXfsTee19.dpk
new file mode 100644
index 0000000..2c49235
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsTee19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package dclFMXfsTee19;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs19,
+ FMXfsTee19;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsTee19.res b/FastScript/FMX/dclFMXfsTee19.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsTee19.res differ
diff --git a/FastScript/FMX/dclFMXfsTee20.dpk b/FastScript/FMX/dclFMXfsTee20.dpk
new file mode 100644
index 0000000..5a8268b
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsTee20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package dclFMXfsTee20;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs20,
+ FMXfsTee20;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsTee20.res b/FastScript/FMX/dclFMXfsTee20.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsTee20.res differ
diff --git a/FastScript/FMX/dclFMXfsTee21.dpk b/FastScript/FMX/dclFMXfsTee21.dpk
new file mode 100644
index 0000000..b4f72e7
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsTee21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package dclFMXfsTee21;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs21,
+ FMXfsTee21;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsTee21.res b/FastScript/FMX/dclFMXfsTee21.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsTee21.res differ
diff --git a/FastScript/FMX/dclFMXfsTee22.dpk b/FastScript/FMX/dclFMXfsTee22.dpk
new file mode 100644
index 0000000..33b50de
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsTee22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package dclFMXfsTee22;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs22,
+ FMXfsTee22;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsTee22.res b/FastScript/FMX/dclFMXfsTee22.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsTee22.res differ
diff --git a/FastScript/FMX/dclFMXfsTee23.dpk b/FastScript/FMX/dclFMXfsTee23.dpk
new file mode 100644
index 0000000..81cb335
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsTee23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsTee23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs23,
+ FMXfsTee23;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsTee23.res b/FastScript/FMX/dclFMXfsTee23.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsTee23.res differ
diff --git a/FastScript/FMX/dclFMXfsTee24.dpk b/FastScript/FMX/dclFMXfsTee24.dpk
new file mode 100644
index 0000000..965474b
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsTee24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsTee24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs24,
+ FMXfsTee24;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsTee24.res b/FastScript/FMX/dclFMXfsTee24.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsTee24.res differ
diff --git a/FastScript/FMX/dclFMXfsTee25.dpk b/FastScript/FMX/dclFMXfsTee25.dpk
new file mode 100644
index 0000000..561f9ff
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsTee25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsTee25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs25,
+ FMXfsTee25;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsTee25.res b/FastScript/FMX/dclFMXfsTee25.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMX/dclFMXfsTee25.res differ
diff --git a/FastScript/FMX/dclFMXfsTee26.dpk b/FastScript/FMX/dclFMXfsTee26.dpk
new file mode 100644
index 0000000..a372cd8
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsTee26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsTee26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs26,
+ FMXfsTee26;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsTee27.dpk b/FastScript/FMX/dclFMXfsTee27.dpk
new file mode 100644
index 0000000..943b74e
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsTee27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsTee27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs27,
+ FMXfsTee27;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsTee28.dpk b/FastScript/FMX/dclFMXfsTee28.dpk
new file mode 100644
index 0000000..fcded75
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsTee28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package dclFMXfsTee29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29,
+ FMXfsTee29;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/FMX/dclFMXfsTee29.dpk b/FastScript/FMX/dclFMXfsTee29.dpk
new file mode 100644
index 0000000..ac47668
--- /dev/null
+++ b/FastScript/FMX/dclFMXfsTee29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package dclFMXfsTee29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29,
+ FMXfsTee29;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/FMX/fmx.inc b/FastScript/FMX/fmx.inc
new file mode 100644
index 0000000..e502196
--- /dev/null
+++ b/FastScript/FMX/fmx.inc
@@ -0,0 +1,12 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Include file }
+{ }
+{ (c) 2003, 2004 by Alexander Tzyganenko, }
+{ Fast Reports, Inc }
+{ }
+{******************************************}
+
+{$DEFINE FMX}
diff --git a/FastScript/FMXfs16.dpk b/FastScript/FMXfs16.dpk
new file mode 100644
index 0000000..60d40ad
--- /dev/null
+++ b/FastScript/FMXfs16.dpk
@@ -0,0 +1,60 @@
+// Package file for Delphi XE2
+
+package FMXfs16;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMXfs16.res b/FastScript/FMXfs16.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfs16.res differ
diff --git a/FastScript/FMXfs17.dpk b/FastScript/FMXfs17.dpk
new file mode 100644
index 0000000..2f51eaa
--- /dev/null
+++ b/FastScript/FMXfs17.dpk
@@ -0,0 +1,60 @@
+// Package file for Delphi XE3
+
+package FMXfs17;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMXfs17.res b/FastScript/FMXfs17.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfs17.res differ
diff --git a/FastScript/FMXfs18.dpk b/FastScript/FMXfs18.dpk
new file mode 100644
index 0000000..2e8cc3b
--- /dev/null
+++ b/FastScript/FMXfs18.dpk
@@ -0,0 +1,60 @@
+// Package file for Delphi XE4
+
+package FMXfs18;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMXfs18.otares b/FastScript/FMXfs18.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMXfs18.otares differ
diff --git a/FastScript/FMXfs18.res b/FastScript/FMXfs18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfs18.res differ
diff --git a/FastScript/FMXfs19.dpk b/FastScript/FMXfs19.dpk
new file mode 100644
index 0000000..484cfae
--- /dev/null
+++ b/FastScript/FMXfs19.dpk
@@ -0,0 +1,60 @@
+// Package file for Delphi XE5
+
+package FMXfs19;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMXfs19.otares b/FastScript/FMXfs19.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMXfs19.otares differ
diff --git a/FastScript/FMXfs19.res b/FastScript/FMXfs19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfs19.res differ
diff --git a/FastScript/FMXfs20.dpk b/FastScript/FMXfs20.dpk
new file mode 100644
index 0000000..9e0de3e
--- /dev/null
+++ b/FastScript/FMXfs20.dpk
@@ -0,0 +1,60 @@
+// Package file for Delphi XE6
+
+package FMXfs20;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMXfs20.otares b/FastScript/FMXfs20.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMXfs20.otares differ
diff --git a/FastScript/FMXfs20.res b/FastScript/FMXfs20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfs20.res differ
diff --git a/FastScript/FMXfs21.dpk b/FastScript/FMXfs21.dpk
new file mode 100644
index 0000000..820052a
--- /dev/null
+++ b/FastScript/FMXfs21.dpk
@@ -0,0 +1,60 @@
+// Package file for Delphi XE7
+
+package FMXfs21;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMXfs21.otares b/FastScript/FMXfs21.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMXfs21.otares differ
diff --git a/FastScript/FMXfs21.res b/FastScript/FMXfs21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfs21.res differ
diff --git a/FastScript/FMXfs22.dpk b/FastScript/FMXfs22.dpk
new file mode 100644
index 0000000..6820909
--- /dev/null
+++ b/FastScript/FMXfs22.dpk
@@ -0,0 +1,60 @@
+// Package file for Delphi XE8
+
+package FMXfs22;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMXfs22.otares b/FastScript/FMXfs22.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMXfs22.otares differ
diff --git a/FastScript/FMXfs22.res b/FastScript/FMXfs22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfs22.res differ
diff --git a/FastScript/FMXfs23.dpk b/FastScript/FMXfs23.dpk
new file mode 100644
index 0000000..8c587b3
--- /dev/null
+++ b/FastScript/FMXfs23.dpk
@@ -0,0 +1,59 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfs23;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMXfs23.otares b/FastScript/FMXfs23.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMXfs23.otares differ
diff --git a/FastScript/FMXfs23.res b/FastScript/FMXfs23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfs23.res differ
diff --git a/FastScript/FMXfs24.dpk b/FastScript/FMXfs24.dpk
new file mode 100644
index 0000000..19818d3
--- /dev/null
+++ b/FastScript/FMXfs24.dpk
@@ -0,0 +1,59 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfs24;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMXfs24.otares b/FastScript/FMXfs24.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMXfs24.otares differ
diff --git a/FastScript/FMXfs24.res b/FastScript/FMXfs24.res
new file mode 100644
index 0000000..3bb7875
Binary files /dev/null and b/FastScript/FMXfs24.res differ
diff --git a/FastScript/FMXfs25.dpk b/FastScript/FMXfs25.dpk
new file mode 100644
index 0000000..2f96717
--- /dev/null
+++ b/FastScript/FMXfs25.dpk
@@ -0,0 +1,59 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfs25;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMXfs25.otares b/FastScript/FMXfs25.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMXfs25.otares differ
diff --git a/FastScript/FMXfs25.res b/FastScript/FMXfs25.res
new file mode 100644
index 0000000..3bb7875
Binary files /dev/null and b/FastScript/FMXfs25.res differ
diff --git a/FastScript/FMXfs26.dpk b/FastScript/FMXfs26.dpk
new file mode 100644
index 0000000..9738876
--- /dev/null
+++ b/FastScript/FMXfs26.dpk
@@ -0,0 +1,59 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfs26;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMXfs27.dpk b/FastScript/FMXfs27.dpk
new file mode 100644
index 0000000..f5773b1
--- /dev/null
+++ b/FastScript/FMXfs27.dpk
@@ -0,0 +1,59 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfs27;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMXfs28.dpk b/FastScript/FMXfs28.dpk
new file mode 100644
index 0000000..108da25
--- /dev/null
+++ b/FastScript/FMXfs28.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 11 Seattle
+
+package FMXfs28;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.BaseTypeAliases in 'FMX.BaseTypeAliases.pas',
+ FMX.FormTypeAliases in 'FMX.FormTypeAliases.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMXfs29.dpk b/FastScript/FMXfs29.dpk
new file mode 100644
index 0000000..95ece44
--- /dev/null
+++ b/FastScript/FMXfs29.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 12
+
+package FMXfs29;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.BaseTypeAliases in 'FMX.BaseTypeAliases.pas',
+ FMX.FormTypeAliases in 'FMX.FormTypeAliases.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/FastScript/FMXfsADO16.dpk b/FastScript/FMXfsADO16.dpk
new file mode 100644
index 0000000..10a404d
--- /dev/null
+++ b/FastScript/FMXfsADO16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package FMXfsADO16;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs16,
+ FMXfsDB16;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMXfsADO16.res b/FastScript/FMXfsADO16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMXfsADO16.res differ
diff --git a/FastScript/FMXfsADO17.dpk b/FastScript/FMXfsADO17.dpk
new file mode 100644
index 0000000..52b903a
--- /dev/null
+++ b/FastScript/FMXfsADO17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package FMXfsADO17;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs17,
+ FMXfsDB17;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMXfsADO17.res b/FastScript/FMXfsADO17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMXfsADO17.res differ
diff --git a/FastScript/FMXfsADO18.dpk b/FastScript/FMXfsADO18.dpk
new file mode 100644
index 0000000..f441ad3
--- /dev/null
+++ b/FastScript/FMXfsADO18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package FMXfsADO18;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs18,
+ FMXfsDB18;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMXfsADO18.res b/FastScript/FMXfsADO18.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMXfsADO18.res differ
diff --git a/FastScript/FMXfsADO19.dpk b/FastScript/FMXfsADO19.dpk
new file mode 100644
index 0000000..424714e
--- /dev/null
+++ b/FastScript/FMXfsADO19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package FMXfsADO19;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs19,
+ FMXfsDB19;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMXfsADO19.res b/FastScript/FMXfsADO19.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMXfsADO19.res differ
diff --git a/FastScript/FMXfsADO20.dpk b/FastScript/FMXfsADO20.dpk
new file mode 100644
index 0000000..d19c363
--- /dev/null
+++ b/FastScript/FMXfsADO20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package FMXfsADO20;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs20,
+ FMXfsDB20;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMXfsADO20.res b/FastScript/FMXfsADO20.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMXfsADO20.res differ
diff --git a/FastScript/FMXfsADO21.dpk b/FastScript/FMXfsADO21.dpk
new file mode 100644
index 0000000..83c3ad3
--- /dev/null
+++ b/FastScript/FMXfsADO21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package FMXfsADO21;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs21,
+ FMXfsDB21;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMXfsADO21.res b/FastScript/FMXfsADO21.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMXfsADO21.res differ
diff --git a/FastScript/FMXfsADO22.dpk b/FastScript/FMXfsADO22.dpk
new file mode 100644
index 0000000..ca5d373
--- /dev/null
+++ b/FastScript/FMXfsADO22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package FMXfsADO22;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs22,
+ FMXfsDB22;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMXfsADO22.res b/FastScript/FMXfsADO22.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMXfsADO22.res differ
diff --git a/FastScript/FMXfsADO23.dpk b/FastScript/FMXfsADO23.dpk
new file mode 100644
index 0000000..0bc722e
--- /dev/null
+++ b/FastScript/FMXfsADO23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsADO23;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs23,
+ FMXfsDB23;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMXfsADO23.res b/FastScript/FMXfsADO23.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMXfsADO23.res differ
diff --git a/FastScript/FMXfsADO24.dpk b/FastScript/FMXfsADO24.dpk
new file mode 100644
index 0000000..beb9b84
--- /dev/null
+++ b/FastScript/FMXfsADO24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsADO24;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs24,
+ FMXfsDB24;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMXfsADO24.res b/FastScript/FMXfsADO24.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMXfsADO24.res differ
diff --git a/FastScript/FMXfsADO25.dpk b/FastScript/FMXfsADO25.dpk
new file mode 100644
index 0000000..93c4991
--- /dev/null
+++ b/FastScript/FMXfsADO25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsADO25;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs25,
+ FMXfsDB25;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMXfsADO25.res b/FastScript/FMXfsADO25.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMXfsADO25.res differ
diff --git a/FastScript/FMXfsADO26.dpk b/FastScript/FMXfsADO26.dpk
new file mode 100644
index 0000000..0ed9a68
--- /dev/null
+++ b/FastScript/FMXfsADO26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsADO26;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs26,
+ FMXfsDB26;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMXfsADO27.dpk b/FastScript/FMXfsADO27.dpk
new file mode 100644
index 0000000..f2a00b7
--- /dev/null
+++ b/FastScript/FMXfsADO27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsADO27;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs27,
+ FMXfsDB27;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMXfsADO28.dpk b/FastScript/FMXfsADO28.dpk
new file mode 100644
index 0000000..d175800
--- /dev/null
+++ b/FastScript/FMXfsADO28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package FMXfsADO28;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs28,
+ FMXfsDB28;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMXfsADO29.dpk b/FastScript/FMXfsADO29.dpk
new file mode 100644
index 0000000..c14c3be
--- /dev/null
+++ b/FastScript/FMXfsADO29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package FMXfsADO29;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs29,
+ FMXfsDB29;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/FastScript/FMXfsDB16.dpk b/FastScript/FMXfsDB16.dpk
new file mode 100644
index 0000000..f6fa97e
--- /dev/null
+++ b/FastScript/FMXfsDB16.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE2
+
+package FMXfsDB16;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs16,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsDB16.res b/FastScript/FMXfsDB16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMXfsDB16.res differ
diff --git a/FastScript/FMXfsDB17.dpk b/FastScript/FMXfsDB17.dpk
new file mode 100644
index 0000000..6df8aa2
--- /dev/null
+++ b/FastScript/FMXfsDB17.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE3
+
+package FMXfsDB17;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs17,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsDB17.res b/FastScript/FMXfsDB17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMXfsDB17.res differ
diff --git a/FastScript/FMXfsDB18.dpk b/FastScript/FMXfsDB18.dpk
new file mode 100644
index 0000000..86897c0
--- /dev/null
+++ b/FastScript/FMXfsDB18.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE4
+
+package FMXfsDB18;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs18,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsDB18.otares b/FastScript/FMXfsDB18.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMXfsDB18.otares differ
diff --git a/FastScript/FMXfsDB18.res b/FastScript/FMXfsDB18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfsDB18.res differ
diff --git a/FastScript/FMXfsDB19.dpk b/FastScript/FMXfsDB19.dpk
new file mode 100644
index 0000000..2109b95
--- /dev/null
+++ b/FastScript/FMXfsDB19.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE5
+
+package FMXfsDB19;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs19,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsDB19.otares b/FastScript/FMXfsDB19.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMXfsDB19.otares differ
diff --git a/FastScript/FMXfsDB19.res b/FastScript/FMXfsDB19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfsDB19.res differ
diff --git a/FastScript/FMXfsDB20.dpk b/FastScript/FMXfsDB20.dpk
new file mode 100644
index 0000000..01116cd
--- /dev/null
+++ b/FastScript/FMXfsDB20.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE6
+
+package FMXfsDB20;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs20,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsDB20.otares b/FastScript/FMXfsDB20.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMXfsDB20.otares differ
diff --git a/FastScript/FMXfsDB20.res b/FastScript/FMXfsDB20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfsDB20.res differ
diff --git a/FastScript/FMXfsDB21.dpk b/FastScript/FMXfsDB21.dpk
new file mode 100644
index 0000000..8848232
--- /dev/null
+++ b/FastScript/FMXfsDB21.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE7
+
+package FMXfsDB21;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs21,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsDB21.otares b/FastScript/FMXfsDB21.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMXfsDB21.otares differ
diff --git a/FastScript/FMXfsDB21.res b/FastScript/FMXfsDB21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfsDB21.res differ
diff --git a/FastScript/FMXfsDB22.dpk b/FastScript/FMXfsDB22.dpk
new file mode 100644
index 0000000..08bd29f
--- /dev/null
+++ b/FastScript/FMXfsDB22.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE8
+
+package FMXfsDB22;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs22,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsDB22.otares b/FastScript/FMXfsDB22.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMXfsDB22.otares differ
diff --git a/FastScript/FMXfsDB22.res b/FastScript/FMXfsDB22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfsDB22.res differ
diff --git a/FastScript/FMXfsDB23.dpk b/FastScript/FMXfsDB23.dpk
new file mode 100644
index 0000000..fc47610
--- /dev/null
+++ b/FastScript/FMXfsDB23.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsDB23;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs23,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsDB23.otares b/FastScript/FMXfsDB23.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMXfsDB23.otares differ
diff --git a/FastScript/FMXfsDB23.res b/FastScript/FMXfsDB23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfsDB23.res differ
diff --git a/FastScript/FMXfsDB24.dpk b/FastScript/FMXfsDB24.dpk
new file mode 100644
index 0000000..6d3f1a9
--- /dev/null
+++ b/FastScript/FMXfsDB24.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsDB24;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs24,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsDB24.otares b/FastScript/FMXfsDB24.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMXfsDB24.otares differ
diff --git a/FastScript/FMXfsDB24.res b/FastScript/FMXfsDB24.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfsDB24.res differ
diff --git a/FastScript/FMXfsDB25.dpk b/FastScript/FMXfsDB25.dpk
new file mode 100644
index 0000000..d873f3a
--- /dev/null
+++ b/FastScript/FMXfsDB25.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsDB25;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs25,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsDB25.otares b/FastScript/FMXfsDB25.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/FMXfsDB25.otares differ
diff --git a/FastScript/FMXfsDB25.res b/FastScript/FMXfsDB25.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfsDB25.res differ
diff --git a/FastScript/FMXfsDB26.dpk b/FastScript/FMXfsDB26.dpk
new file mode 100644
index 0000000..359e620
--- /dev/null
+++ b/FastScript/FMXfsDB26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsDB26;
+
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs26,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsDB27.dpk b/FastScript/FMXfsDB27.dpk
new file mode 100644
index 0000000..e18c2a2
--- /dev/null
+++ b/FastScript/FMXfsDB27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsDB27;
+
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs27,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsDB28.dpk b/FastScript/FMXfsDB28.dpk
new file mode 100644
index 0000000..8cac226
--- /dev/null
+++ b/FastScript/FMXfsDB28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package FMXfsDB28;
+
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs28,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsDB29.dpk b/FastScript/FMXfsDB29.dpk
new file mode 100644
index 0000000..d7fb8f0
--- /dev/null
+++ b/FastScript/FMXfsDB29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package FMXfsDB29;
+
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs29,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsIBX16.dpk b/FastScript/FMXfsIBX16.dpk
new file mode 100644
index 0000000..a64c4d2
--- /dev/null
+++ b/FastScript/FMXfsIBX16.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE2
+
+package FMXfsIBX16;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs16,
+ FMXfsDB16;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsIBX16.res b/FastScript/FMXfsIBX16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMXfsIBX16.res differ
diff --git a/FastScript/FMXfsIBX17.dpk b/FastScript/FMXfsIBX17.dpk
new file mode 100644
index 0000000..cf3fb7e
--- /dev/null
+++ b/FastScript/FMXfsIBX17.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE3
+
+package FMXfsIBX17;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs17,
+ FMXfsDB17;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsIBX17.res b/FastScript/FMXfsIBX17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMXfsIBX17.res differ
diff --git a/FastScript/FMXfsIBX18.dpk b/FastScript/FMXfsIBX18.dpk
new file mode 100644
index 0000000..7288365
--- /dev/null
+++ b/FastScript/FMXfsIBX18.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE4
+
+package FMXfsIBX18;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs18,
+ FMXfsDB18;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsIBX18.res b/FastScript/FMXfsIBX18.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMXfsIBX18.res differ
diff --git a/FastScript/FMXfsIBX19.dpk b/FastScript/FMXfsIBX19.dpk
new file mode 100644
index 0000000..cf86260
--- /dev/null
+++ b/FastScript/FMXfsIBX19.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE5
+
+package FMXfsIBX19;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs19,
+ FMXfsDB19;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsIBX19.res b/FastScript/FMXfsIBX19.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMXfsIBX19.res differ
diff --git a/FastScript/FMXfsIBX20.dpk b/FastScript/FMXfsIBX20.dpk
new file mode 100644
index 0000000..2e741b2
--- /dev/null
+++ b/FastScript/FMXfsIBX20.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE6
+
+package FMXfsIBX20;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs20,
+ FMXfsDB20;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsIBX20.res b/FastScript/FMXfsIBX20.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMXfsIBX20.res differ
diff --git a/FastScript/FMXfsIBX21.dpk b/FastScript/FMXfsIBX21.dpk
new file mode 100644
index 0000000..d6cd6d2
--- /dev/null
+++ b/FastScript/FMXfsIBX21.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE7
+
+package FMXfsIBX21;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs21,
+ FMXfsDB21;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsIBX21.res b/FastScript/FMXfsIBX21.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMXfsIBX21.res differ
diff --git a/FastScript/FMXfsIBX22.dpk b/FastScript/FMXfsIBX22.dpk
new file mode 100644
index 0000000..e870670
--- /dev/null
+++ b/FastScript/FMXfsIBX22.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE8
+
+package FMXfsIBX22;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs22,
+ FMXfsDB22;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsIBX22.res b/FastScript/FMXfsIBX22.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMXfsIBX22.res differ
diff --git a/FastScript/FMXfsIBX23.dpk b/FastScript/FMXfsIBX23.dpk
new file mode 100644
index 0000000..ef8b9fd
--- /dev/null
+++ b/FastScript/FMXfsIBX23.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsIBX23;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs23,
+ FMXfsDB23;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsIBX23.res b/FastScript/FMXfsIBX23.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMXfsIBX23.res differ
diff --git a/FastScript/FMXfsIBX24.dpk b/FastScript/FMXfsIBX24.dpk
new file mode 100644
index 0000000..d2c75a8
--- /dev/null
+++ b/FastScript/FMXfsIBX24.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsIBX24;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs24,
+ FMXfsDB24;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsIBX24.res b/FastScript/FMXfsIBX24.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMXfsIBX24.res differ
diff --git a/FastScript/FMXfsIBX25.dpk b/FastScript/FMXfsIBX25.dpk
new file mode 100644
index 0000000..5a734d2
--- /dev/null
+++ b/FastScript/FMXfsIBX25.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsIBX25;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs25,
+ FMXfsDB25;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsIBX25.res b/FastScript/FMXfsIBX25.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/FMXfsIBX25.res differ
diff --git a/FastScript/FMXfsIBX26.dpk b/FastScript/FMXfsIBX26.dpk
new file mode 100644
index 0000000..3acb9cc
--- /dev/null
+++ b/FastScript/FMXfsIBX26.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsIBX26;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs26,
+ FMXfsDB26;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsIBX27.dpk b/FastScript/FMXfsIBX27.dpk
new file mode 100644
index 0000000..de6a34e
--- /dev/null
+++ b/FastScript/FMXfsIBX27.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsIBX27;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs27,
+ FMXfsDB27;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsIBX28.dpk b/FastScript/FMXfsIBX28.dpk
new file mode 100644
index 0000000..ea81b98
--- /dev/null
+++ b/FastScript/FMXfsIBX28.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 11 Seattle
+
+package FMXfsIBX28;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs28,
+ FMXfsDB28;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsIBX29.dpk b/FastScript/FMXfsIBX29.dpk
new file mode 100644
index 0000000..b5fa135
--- /dev/null
+++ b/FastScript/FMXfsIBX29.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 12
+
+package FMXfsIBX29;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs29,
+ FMXfsDB29;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsTee16.dpk b/FastScript/FMXfsTee16.dpk
new file mode 100644
index 0000000..69bd560
--- /dev/null
+++ b/FastScript/FMXfsTee16.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE2
+
+package FMXfsTee16;
+
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro916, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee916, FMXTEEUI916, {$ENDIF}
+ FMXfs16;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsTee16.res b/FastScript/FMXfsTee16.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfsTee16.res differ
diff --git a/FastScript/FMXfsTee17.dpk b/FastScript/FMXfsTee17.dpk
new file mode 100644
index 0000000..f51d5e6
--- /dev/null
+++ b/FastScript/FMXfsTee17.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE3
+
+package FMXfsTee17;
+
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro917, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee917, FMXTEEUI917, {$ENDIF}
+ FMXfs17;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsTee17.res b/FastScript/FMXfsTee17.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfsTee17.res differ
diff --git a/FastScript/FMXfsTee18.dpk b/FastScript/FMXfsTee18.dpk
new file mode 100644
index 0000000..e963a8b
--- /dev/null
+++ b/FastScript/FMXfsTee18.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE4
+
+package FMXfsTee18;
+
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro918, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee918, FMXTEEUI918, {$ENDIF}
+ FMXfs18;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsTee18.res b/FastScript/FMXfsTee18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfsTee18.res differ
diff --git a/FastScript/FMXfsTee19.dpk b/FastScript/FMXfsTee19.dpk
new file mode 100644
index 0000000..1370860
--- /dev/null
+++ b/FastScript/FMXfsTee19.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE5
+
+package FMXfsTee19;
+{$I tee.inc}
+{$I fmx.inc}
+
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs19
+{$IFDEF TeeChartStd} ,FMXTEE{$ENDIF}
+{$IFDEF TeeChart9},FMXTeePro919 {$ENDIF}
+{$IFDEF TeeChartStd9},FMXTee919{$ENDIF};
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
+
diff --git a/FastScript/FMXfsTee19.res b/FastScript/FMXfsTee19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfsTee19.res differ
diff --git a/FastScript/FMXfsTee20.dpk b/FastScript/FMXfsTee20.dpk
new file mode 100644
index 0000000..bf358bd
--- /dev/null
+++ b/FastScript/FMXfsTee20.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE6
+
+package FMXfsTee20;
+
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro920, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee920, TEEUI920, {$ENDIF}
+ FMXfs20;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsTee20.res b/FastScript/FMXfsTee20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfsTee20.res differ
diff --git a/FastScript/FMXfsTee21.dpk b/FastScript/FMXfsTee21.dpk
new file mode 100644
index 0000000..3481fb5
--- /dev/null
+++ b/FastScript/FMXfsTee21.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE7
+
+package FMXfsTee21;
+
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro921, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee921, TEEUI921, {$ENDIF}
+ FMXfs21;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsTee21.res b/FastScript/FMXfsTee21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfsTee21.res differ
diff --git a/FastScript/FMXfsTee22.dpk b/FastScript/FMXfsTee22.dpk
new file mode 100644
index 0000000..25e0fa0
--- /dev/null
+++ b/FastScript/FMXfsTee22.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE8
+
+package FMXfsTee22;
+
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro922, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee922, TEEUI922, {$ENDIF}
+ FMXfs22;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsTee22.res b/FastScript/FMXfsTee22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfsTee22.res differ
diff --git a/FastScript/FMXfsTee23.dpk b/FastScript/FMXfsTee23.dpk
new file mode 100644
index 0000000..7a09181
--- /dev/null
+++ b/FastScript/FMXfsTee23.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsTee23;
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro923, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee923, TEEUI923, {$ENDIF}
+ FMXfs23;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsTee23.res b/FastScript/FMXfsTee23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfsTee23.res differ
diff --git a/FastScript/FMXfsTee24.dpk b/FastScript/FMXfsTee24.dpk
new file mode 100644
index 0000000..4a295f0
--- /dev/null
+++ b/FastScript/FMXfsTee24.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsTee24;
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro924, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee924, TEEUI924, {$ENDIF}
+ FMXfs24;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsTee24.res b/FastScript/FMXfsTee24.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfsTee24.res differ
diff --git a/FastScript/FMXfsTee25.dpk b/FastScript/FMXfsTee25.dpk
new file mode 100644
index 0000000..6befc20
--- /dev/null
+++ b/FastScript/FMXfsTee25.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsTee25;
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro925, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee925, TEEUI925, {$ENDIF}
+ FMXfs25;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsTee25.res b/FastScript/FMXfsTee25.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/FMXfsTee25.res differ
diff --git a/FastScript/FMXfsTee26.dpk b/FastScript/FMXfsTee26.dpk
new file mode 100644
index 0000000..ba7bb49
--- /dev/null
+++ b/FastScript/FMXfsTee26.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsTee26;
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro926, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee926, TEEUI926, {$ENDIF}
+ FMXfs26;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsTee27.dpk b/FastScript/FMXfsTee27.dpk
new file mode 100644
index 0000000..69374c7
--- /dev/null
+++ b/FastScript/FMXfsTee27.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsTee27;
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro927, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee927, TEEUI927, {$ENDIF}
+ FMXfs27;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsTee28.dpk b/FastScript/FMXfsTee28.dpk
new file mode 100644
index 0000000..4270e34
--- /dev/null
+++ b/FastScript/FMXfsTee28.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi 11 Seattle
+
+package FMXfsTee28;
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro928, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee928, TEEUI928, {$ENDIF}
+ FMXfs28;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMXfsTee29.dpk b/FastScript/FMXfsTee29.dpk
new file mode 100644
index 0000000..29aa466
--- /dev/null
+++ b/FastScript/FMXfsTee29.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi 12
+
+package FMXfsTee29;
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro929, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee929, TEEUI929, {$ENDIF}
+ FMXfs29;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/FMXfs_iadoreg.pas b/FastScript/FMXfs_iadoreg.pas
new file mode 100644
index 0000000..8decc54
--- /dev/null
+++ b/FastScript/FMXfs_iadoreg.pas
@@ -0,0 +1,37 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMXfs_iadoreg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ System.Classes
+, DesignIntf
+, FMX.Types
+, FMX.fs_iadortti;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+ //GroupDescendentsWith(TfsADORTTI, TFmxObject);
+ RegisterComponents('FastScript FMX', [TfsADORTTI]);
+end;
+
+end.
diff --git a/FastScript/FMXfs_idbreg.pas b/FastScript/FMXfs_idbreg.pas
new file mode 100644
index 0000000..b514773
--- /dev/null
+++ b/FastScript/FMXfs_idbreg.pas
@@ -0,0 +1,37 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMXfs_idbreg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ System.Classes
+, DesignIntf
+, FMX.Types
+, FMX.fs_idbrtti;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+ // GroupDescendentsWith(TfsDBRTTI, TFmxObject);
+ RegisterComponents('FastScript FMX', [TfsDBRTTI]);
+end;
+
+end.
diff --git a/FastScript/FMXfs_iibxreg.pas b/FastScript/FMXfs_iibxreg.pas
new file mode 100644
index 0000000..9a946a4
--- /dev/null
+++ b/FastScript/FMXfs_iibxreg.pas
@@ -0,0 +1,37 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMXfs_iibxreg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ System.Classes
+, FMX.Types
+, DesignIntf
+, FMX.fs_iibxrtti;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+ //GroupDescendentsWith(TfsIBXRTTI, TFmxObject);
+ RegisterComponents('FastScript FMX', [TfsIBXRTTI]);
+end;
+
+end.
diff --git a/FastScript/FMXfs_ireg.pas b/FastScript/FMXfs_ireg.pas
new file mode 100644
index 0000000..496346b
--- /dev/null
+++ b/FastScript/FMXfs_ireg.pas
@@ -0,0 +1,85 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMXfs_ireg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+uses
+ System.Classes
+{$IFNDEF FPC}
+ {$IFNDEF Delphi6}
+ , DsgnIntf
+ {$ELSE}
+ , DesignIntf
+ {$ENDIF}
+{$ELSE}
+ ,PropEdits
+ ,LazarusPackageIntf
+ ,LResources
+{$ENDIF}
+{$IFDEF DELPHI16}
+ , FMX.Controls, FMX.Types
+{$ENDIF}
+, FMX.fs_iinterpreter, FMX.fs_iclassesrtti, FMX.fs_igraphicsrtti, FMX.fs_iformsrtti,
+ FMX.fs_iextctrlsrtti, FMX.fs_idialogsrtti, FMX.fs_iinirtti, FMX.fs_imenusrtti,
+ FMX.fs_ipascal, FMX.fs_icpp, FMX.fs_ijs, FMX.fs_ibasic, FMX.fs_tree
+{$IFNDEF CLX}
+, FMX.fs_synmemo
+{$ENDIF}
+;
+
+{-----------------------------------------------------------------------}
+
+{$ifdef FPC}
+procedure RegisterUnitfs_ireg;
+{$else}
+procedure Register;
+{$endif}
+begin
+ {GroupDescendentsWith(TfsExtCtrlsRTTI, TFmxObject);
+ GroupDescendentsWith(TfsDialogsRTTI, TFmxObject);
+ GroupDescendentsWith(TfsGraphicsRTTI, TFmxObject);
+ GroupDescendentsWith(TfsMenusRTTI, TFmxObject);
+ GroupDescendentsWith(TfsScript, TFmxObject);
+ GroupDescendentsWith(TfsIniRTTI, TFmxObject);
+ GroupDescendentsWith(TfsFormsRTTI, TFmxObject);
+ GroupDescendentsWith(TfsClassesRTTI, TFmxObject);
+ GroupDescendentsWith(TfsPascal, TFmxObject);
+ GroupDescendentsWith(TfsCPP, TFmxObject);
+ GroupDescendentsWith(TfsJScript, TFmxObject);
+ GroupDescendentsWith(TfsBasic, TFmxObject);}
+ RegisterComponents('FastScript FMX',
+ [TfsScript, TfsPascal, TfsCPP, TfsJScript, TfsBasic,
+ TfsClassesRTTI, TfsGraphicsRTTI, TfsFormsRTTI, TfsExtCtrlsRTTI,
+ TfsDialogsRTTI, TfsMenusRTTI, TfsIniRTTI,
+ TfsTree, TfsSyntaxMemo]);
+
+end;
+
+{$ifdef FPC}
+procedure Register;
+begin
+ RegisterUnit('fs_ireg', @RegisterUnitfs_ireg);
+end;
+{$endif}
+
+initialization
+{$IFDEF FPC}
+ {$INCLUDE fs_ireg.lrs}
+{$ENDIF}
+end.
diff --git a/FastScript/FMXfs_iteereg.pas b/FastScript/FMXfs_iteereg.pas
new file mode 100644
index 0000000..f47dea6
--- /dev/null
+++ b/FastScript/FMXfs_iteereg.pas
@@ -0,0 +1,38 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMXfs_iteereg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ System.Classes
+, FMX.Types
+, DesignIntf
+, FMX.fs_ichartrtti;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+ //GroupDescendentsWith(TfsChartRTTI, TFmxObject);
+ RegisterComponents('FastScript FMX',
+ [TfsChartRTTI]);
+end;
+
+end.
diff --git a/FastScript/bitmaps/TFSADORTTI.bmp b/FastScript/bitmaps/TFSADORTTI.bmp
new file mode 100644
index 0000000..f966d42
Binary files /dev/null and b/FastScript/bitmaps/TFSADORTTI.bmp differ
diff --git a/FastScript/bitmaps/TFSBASIC.bmp b/FastScript/bitmaps/TFSBASIC.bmp
new file mode 100644
index 0000000..13d4c8d
Binary files /dev/null and b/FastScript/bitmaps/TFSBASIC.bmp differ
diff --git a/FastScript/bitmaps/TFSBDERTTI.bmp b/FastScript/bitmaps/TFSBDERTTI.bmp
new file mode 100644
index 0000000..49a8dbc
Binary files /dev/null and b/FastScript/bitmaps/TFSBDERTTI.bmp differ
diff --git a/FastScript/bitmaps/TFSCHARTRTTI.bmp b/FastScript/bitmaps/TFSCHARTRTTI.bmp
new file mode 100644
index 0000000..d1f6f41
Binary files /dev/null and b/FastScript/bitmaps/TFSCHARTRTTI.bmp differ
diff --git a/FastScript/bitmaps/TFSCLASSESRTTI.bmp b/FastScript/bitmaps/TFSCLASSESRTTI.bmp
new file mode 100644
index 0000000..cf81c5b
Binary files /dev/null and b/FastScript/bitmaps/TFSCLASSESRTTI.bmp differ
diff --git a/FastScript/bitmaps/TFSCPP.bmp b/FastScript/bitmaps/TFSCPP.bmp
new file mode 100644
index 0000000..0ce02dc
Binary files /dev/null and b/FastScript/bitmaps/TFSCPP.bmp differ
diff --git a/FastScript/bitmaps/TFSDBCTRLSRTTI.bmp b/FastScript/bitmaps/TFSDBCTRLSRTTI.bmp
new file mode 100644
index 0000000..059d207
Binary files /dev/null and b/FastScript/bitmaps/TFSDBCTRLSRTTI.bmp differ
diff --git a/FastScript/bitmaps/TFSDBRTTI.bmp b/FastScript/bitmaps/TFSDBRTTI.bmp
new file mode 100644
index 0000000..bbcbb34
Binary files /dev/null and b/FastScript/bitmaps/TFSDBRTTI.bmp differ
diff --git a/FastScript/bitmaps/TFSDIALOGSRTTI.bmp b/FastScript/bitmaps/TFSDIALOGSRTTI.bmp
new file mode 100644
index 0000000..0b5a565
Binary files /dev/null and b/FastScript/bitmaps/TFSDIALOGSRTTI.bmp differ
diff --git a/FastScript/bitmaps/TFSEXTCTRLSRTTI.bmp b/FastScript/bitmaps/TFSEXTCTRLSRTTI.bmp
new file mode 100644
index 0000000..7e6fe4d
Binary files /dev/null and b/FastScript/bitmaps/TFSEXTCTRLSRTTI.bmp differ
diff --git a/FastScript/bitmaps/TFSFDRTTI.bat b/FastScript/bitmaps/TFSFDRTTI.bat
new file mode 100644
index 0000000..4246ccf
--- /dev/null
+++ b/FastScript/bitmaps/TFSFDRTTI.bat
@@ -0,0 +1 @@
+brcc32 -fo"fs_ifdreg.dcr" "TFSFDRTTI.rc"
\ No newline at end of file
diff --git a/FastScript/bitmaps/TFSFDRTTI.bmp b/FastScript/bitmaps/TFSFDRTTI.bmp
new file mode 100644
index 0000000..47fabed
Binary files /dev/null and b/FastScript/bitmaps/TFSFDRTTI.bmp differ
diff --git a/FastScript/bitmaps/TFSFDRTTI.rc b/FastScript/bitmaps/TFSFDRTTI.rc
new file mode 100644
index 0000000..b49af30
--- /dev/null
+++ b/FastScript/bitmaps/TFSFDRTTI.rc
@@ -0,0 +1 @@
+TFSFDRTTI BITMAP "TFSFDRTTI.bmp"
\ No newline at end of file
diff --git a/FastScript/bitmaps/TFSFORMSRTTI.bmp b/FastScript/bitmaps/TFSFORMSRTTI.bmp
new file mode 100644
index 0000000..1075a16
Binary files /dev/null and b/FastScript/bitmaps/TFSFORMSRTTI.bmp differ
diff --git a/FastScript/bitmaps/TFSGRAPHICSRTTI.bmp b/FastScript/bitmaps/TFSGRAPHICSRTTI.bmp
new file mode 100644
index 0000000..46c7042
Binary files /dev/null and b/FastScript/bitmaps/TFSGRAPHICSRTTI.bmp differ
diff --git a/FastScript/bitmaps/TFSIBXRTTI.bmp b/FastScript/bitmaps/TFSIBXRTTI.bmp
new file mode 100644
index 0000000..240339d
Binary files /dev/null and b/FastScript/bitmaps/TFSIBXRTTI.bmp differ
diff --git a/FastScript/bitmaps/TFSINIRTTI.bmp b/FastScript/bitmaps/TFSINIRTTI.bmp
new file mode 100644
index 0000000..3dd1e56
Binary files /dev/null and b/FastScript/bitmaps/TFSINIRTTI.bmp differ
diff --git a/FastScript/bitmaps/TFSJSCRIPT.bmp b/FastScript/bitmaps/TFSJSCRIPT.bmp
new file mode 100644
index 0000000..24e7cd8
Binary files /dev/null and b/FastScript/bitmaps/TFSJSCRIPT.bmp differ
diff --git a/FastScript/bitmaps/TFSMENUSRTTI.bmp b/FastScript/bitmaps/TFSMENUSRTTI.bmp
new file mode 100644
index 0000000..ad308c3
Binary files /dev/null and b/FastScript/bitmaps/TFSMENUSRTTI.bmp differ
diff --git a/FastScript/bitmaps/TFSPASCAL.bmp b/FastScript/bitmaps/TFSPASCAL.bmp
new file mode 100644
index 0000000..aee07d9
Binary files /dev/null and b/FastScript/bitmaps/TFSPASCAL.bmp differ
diff --git a/FastScript/bitmaps/TFSSCRIPT.bmp b/FastScript/bitmaps/TFSSCRIPT.bmp
new file mode 100644
index 0000000..df880d1
Binary files /dev/null and b/FastScript/bitmaps/TFSSCRIPT.bmp differ
diff --git a/FastScript/bitmaps/TFSSYNTAXMEMO.bmp b/FastScript/bitmaps/TFSSYNTAXMEMO.bmp
new file mode 100644
index 0000000..f06f89f
Binary files /dev/null and b/FastScript/bitmaps/TFSSYNTAXMEMO.bmp differ
diff --git a/FastScript/bitmaps/TFSTREE.bmp b/FastScript/bitmaps/TFSTREE.bmp
new file mode 100644
index 0000000..9885c37
Binary files /dev/null and b/FastScript/bitmaps/TFSTREE.bmp differ
diff --git a/FastScript/bitmaps/build_fstree.bat b/FastScript/bitmaps/build_fstree.bat
new file mode 100644
index 0000000..299ce53
--- /dev/null
+++ b/FastScript/bitmaps/build_fstree.bat
@@ -0,0 +1 @@
+lazres ..\fs_tree.lrs FSTREE.BMP
diff --git a/FastScript/bitmaps/build_lrs.bat b/FastScript/bitmaps/build_lrs.bat
new file mode 100644
index 0000000..aabec47
--- /dev/null
+++ b/FastScript/bitmaps/build_lrs.bat
@@ -0,0 +1 @@
+lazres ..\fs_ireg.lrs TFSADORTTI.bmp TFSBASIC.bmp TFSBDERTTI.bmp TFSCHARTRTTI.bmp TFSCLASSESRTTI.bmp TFSINIRTTI.bmp TFSMENUSRTTI.bmp TFSCPP.bmp TFSDBCTRLSRTTI.bmp TFSDBRTTI.bmp TFSDIALOGSRTTI.bmp TFSEXTCTRLSRTTI.bmp TFSFORMSRTTI.bmp TFSGRAPHICSRTTI.bmp TFSIBXRTTI.bmp TFSJSCRIPT.bmp TFSPASCAL.bmp TFSSCRIPT.bmp TFSSYNTAXMEMO.bmp TFSTREE.bmp
diff --git a/FastScript/bitmaps/fstree.bmp b/FastScript/bitmaps/fstree.bmp
new file mode 100644
index 0000000..3e3fcdf
Binary files /dev/null and b/FastScript/bitmaps/fstree.bmp differ
diff --git a/FastScript/dclFMXfs16.dpk b/FastScript/dclFMXfs16.dpk
new file mode 100644
index 0000000..58b4aa8
--- /dev/null
+++ b/FastScript/dclFMXfs16.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE2
+
+package dclFMXfs16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs16;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/dclFMXfs16.res b/FastScript/dclFMXfs16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfs16.res differ
diff --git a/FastScript/dclFMXfs17.dpk b/FastScript/dclFMXfs17.dpk
new file mode 100644
index 0000000..233a78e
--- /dev/null
+++ b/FastScript/dclFMXfs17.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE3
+
+package dclFMXfs17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs17;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/dclFMXfs17.res b/FastScript/dclFMXfs17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfs17.res differ
diff --git a/FastScript/dclFMXfs18.dpk b/FastScript/dclFMXfs18.dpk
new file mode 100644
index 0000000..77885c7
--- /dev/null
+++ b/FastScript/dclFMXfs18.dpk
@@ -0,0 +1,44 @@
+// Package file for Delphi XE4
+
+package dclFMXfs18;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs18;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/dclFMXfs18.otares b/FastScript/dclFMXfs18.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/dclFMXfs18.otares differ
diff --git a/FastScript/dclFMXfs18.res b/FastScript/dclFMXfs18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/dclFMXfs18.res differ
diff --git a/FastScript/dclFMXfs19.dpk b/FastScript/dclFMXfs19.dpk
new file mode 100644
index 0000000..312058b
--- /dev/null
+++ b/FastScript/dclFMXfs19.dpk
@@ -0,0 +1,44 @@
+// Package file for Delphi XE5
+
+package dclFMXfs19;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs19;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/dclFMXfs19.otares b/FastScript/dclFMXfs19.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/dclFMXfs19.otares differ
diff --git a/FastScript/dclFMXfs19.res b/FastScript/dclFMXfs19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/dclFMXfs19.res differ
diff --git a/FastScript/dclFMXfs20.dpk b/FastScript/dclFMXfs20.dpk
new file mode 100644
index 0000000..4f35242
--- /dev/null
+++ b/FastScript/dclFMXfs20.dpk
@@ -0,0 +1,44 @@
+// Package file for Delphi XE6
+
+package dclFMXfs20;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs20;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/dclFMXfs20.otares b/FastScript/dclFMXfs20.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/dclFMXfs20.otares differ
diff --git a/FastScript/dclFMXfs20.res b/FastScript/dclFMXfs20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/dclFMXfs20.res differ
diff --git a/FastScript/dclFMXfs21.dpk b/FastScript/dclFMXfs21.dpk
new file mode 100644
index 0000000..cf1c58d
--- /dev/null
+++ b/FastScript/dclFMXfs21.dpk
@@ -0,0 +1,44 @@
+// Package file for Delphi XE7
+
+package dclFMXfs21;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs21;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/dclFMXfs21.otares b/FastScript/dclFMXfs21.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/dclFMXfs21.otares differ
diff --git a/FastScript/dclFMXfs21.res b/FastScript/dclFMXfs21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/dclFMXfs21.res differ
diff --git a/FastScript/dclFMXfs22.dpk b/FastScript/dclFMXfs22.dpk
new file mode 100644
index 0000000..e6ac3ff
--- /dev/null
+++ b/FastScript/dclFMXfs22.dpk
@@ -0,0 +1,44 @@
+// Package file for Delphi XE8
+
+package dclFMXfs22;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs22;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/dclFMXfs22.otares b/FastScript/dclFMXfs22.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/dclFMXfs22.otares differ
diff --git a/FastScript/dclFMXfs22.res b/FastScript/dclFMXfs22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/dclFMXfs22.res differ
diff --git a/FastScript/dclFMXfs23.dpk b/FastScript/dclFMXfs23.dpk
new file mode 100644
index 0000000..c1bd62e
--- /dev/null
+++ b/FastScript/dclFMXfs23.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfs23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs23;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/dclFMXfs23.otares b/FastScript/dclFMXfs23.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/dclFMXfs23.otares differ
diff --git a/FastScript/dclFMXfs23.res b/FastScript/dclFMXfs23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/dclFMXfs23.res differ
diff --git a/FastScript/dclFMXfs24.dpk b/FastScript/dclFMXfs24.dpk
new file mode 100644
index 0000000..e793d8b
--- /dev/null
+++ b/FastScript/dclFMXfs24.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfs24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs24;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/dclFMXfs24.otares b/FastScript/dclFMXfs24.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/dclFMXfs24.otares differ
diff --git a/FastScript/dclFMXfs24.res b/FastScript/dclFMXfs24.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/dclFMXfs24.res differ
diff --git a/FastScript/dclFMXfs25.dpk b/FastScript/dclFMXfs25.dpk
new file mode 100644
index 0000000..9128c4d
--- /dev/null
+++ b/FastScript/dclFMXfs25.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfs25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs25;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/dclFMXfs25.otares b/FastScript/dclFMXfs25.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/dclFMXfs25.otares differ
diff --git a/FastScript/dclFMXfs25.res b/FastScript/dclFMXfs25.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/dclFMXfs25.res differ
diff --git a/FastScript/dclFMXfs26.dpk b/FastScript/dclFMXfs26.dpk
new file mode 100644
index 0000000..48cdb6d
--- /dev/null
+++ b/FastScript/dclFMXfs26.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfs26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs26;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/dclFMXfs27.dpk b/FastScript/dclFMXfs27.dpk
new file mode 100644
index 0000000..674e7b6
--- /dev/null
+++ b/FastScript/dclFMXfs27.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfs27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs27;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/dclFMXfs28.dpk b/FastScript/dclFMXfs28.dpk
new file mode 100644
index 0000000..d904555
--- /dev/null
+++ b/FastScript/dclFMXfs28.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 11 Seattle
+
+package dclFMXfs28;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs28;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/dclFMXfs29.dpk b/FastScript/dclFMXfs29.dpk
new file mode 100644
index 0000000..6c93adc
--- /dev/null
+++ b/FastScript/dclFMXfs29.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 12
+
+package dclFMXfs29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsADO16.dpk b/FastScript/dclFMXfsADO16.dpk
new file mode 100644
index 0000000..51dfee4
--- /dev/null
+++ b/FastScript/dclFMXfsADO16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclFMXfsADO16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs16,
+ FMXfsADO16;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsADO16.res b/FastScript/dclFMXfsADO16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsADO16.res differ
diff --git a/FastScript/dclFMXfsADO17.dpk b/FastScript/dclFMXfsADO17.dpk
new file mode 100644
index 0000000..645ec65
--- /dev/null
+++ b/FastScript/dclFMXfsADO17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclFMXfsADO17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs17,
+ FMXfsADO17;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsADO17.res b/FastScript/dclFMXfsADO17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsADO17.res differ
diff --git a/FastScript/dclFMXfsADO18.dpk b/FastScript/dclFMXfsADO18.dpk
new file mode 100644
index 0000000..0262696
--- /dev/null
+++ b/FastScript/dclFMXfsADO18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package dclFMXfsADO18;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs18,
+ FMXfsADO18;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsADO18.res b/FastScript/dclFMXfsADO18.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsADO18.res differ
diff --git a/FastScript/dclFMXfsADO19.dpk b/FastScript/dclFMXfsADO19.dpk
new file mode 100644
index 0000000..ad55963
--- /dev/null
+++ b/FastScript/dclFMXfsADO19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package dclFMXfsADO19;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs19,
+ FMXfsADO19;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsADO19.res b/FastScript/dclFMXfsADO19.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsADO19.res differ
diff --git a/FastScript/dclFMXfsADO20.dpk b/FastScript/dclFMXfsADO20.dpk
new file mode 100644
index 0000000..8009901
--- /dev/null
+++ b/FastScript/dclFMXfsADO20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package dclFMXfsADO20;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs20,
+ FMXfsADO20;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsADO20.res b/FastScript/dclFMXfsADO20.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsADO20.res differ
diff --git a/FastScript/dclFMXfsADO21.dpk b/FastScript/dclFMXfsADO21.dpk
new file mode 100644
index 0000000..40948f9
--- /dev/null
+++ b/FastScript/dclFMXfsADO21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package dclFMXfsADO21;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs21,
+ FMXfsADO21;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsADO21.res b/FastScript/dclFMXfsADO21.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsADO21.res differ
diff --git a/FastScript/dclFMXfsADO22.dpk b/FastScript/dclFMXfsADO22.dpk
new file mode 100644
index 0000000..a5755db
--- /dev/null
+++ b/FastScript/dclFMXfsADO22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package dclFMXfsADO22;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs22,
+ FMXfsADO22;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsADO22.res b/FastScript/dclFMXfsADO22.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsADO22.res differ
diff --git a/FastScript/dclFMXfsADO23.dpk b/FastScript/dclFMXfsADO23.dpk
new file mode 100644
index 0000000..404c4c0
--- /dev/null
+++ b/FastScript/dclFMXfsADO23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsADO23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs23,
+ FMXfsADO23;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsADO23.res b/FastScript/dclFMXfsADO23.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsADO23.res differ
diff --git a/FastScript/dclFMXfsADO24.dpk b/FastScript/dclFMXfsADO24.dpk
new file mode 100644
index 0000000..64bc04f
--- /dev/null
+++ b/FastScript/dclFMXfsADO24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsADO24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs24,
+ FMXfsADO24;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsADO24.res b/FastScript/dclFMXfsADO24.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsADO24.res differ
diff --git a/FastScript/dclFMXfsADO25.dpk b/FastScript/dclFMXfsADO25.dpk
new file mode 100644
index 0000000..982c24f
--- /dev/null
+++ b/FastScript/dclFMXfsADO25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsADO25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs25,
+ FMXfsADO25;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsADO25.res b/FastScript/dclFMXfsADO25.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsADO25.res differ
diff --git a/FastScript/dclFMXfsADO26.dpk b/FastScript/dclFMXfsADO26.dpk
new file mode 100644
index 0000000..2fc6d43
--- /dev/null
+++ b/FastScript/dclFMXfsADO26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsADO26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs26,
+ FMXfsADO26;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsADO27.dpk b/FastScript/dclFMXfsADO27.dpk
new file mode 100644
index 0000000..fddfc91
--- /dev/null
+++ b/FastScript/dclFMXfsADO27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsADO27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs27,
+ FMXfsADO27;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsADO28.dpk b/FastScript/dclFMXfsADO28.dpk
new file mode 100644
index 0000000..f593517
--- /dev/null
+++ b/FastScript/dclFMXfsADO28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package dclFMXfsADO28;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs28,
+ FMXfsADO28;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsADO29.dpk b/FastScript/dclFMXfsADO29.dpk
new file mode 100644
index 0000000..edc9fa5
--- /dev/null
+++ b/FastScript/dclFMXfsADO29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package dclFMXfsADO29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29,
+ FMXfsADO29;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsDB16.dpk b/FastScript/dclFMXfsDB16.dpk
new file mode 100644
index 0000000..ae49c7f
--- /dev/null
+++ b/FastScript/dclFMXfsDB16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclFMXfsDB16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs16,
+ FMXfsDB16;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsDB16.res b/FastScript/dclFMXfsDB16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsDB16.res differ
diff --git a/FastScript/dclFMXfsDB17.dpk b/FastScript/dclFMXfsDB17.dpk
new file mode 100644
index 0000000..65073fc
--- /dev/null
+++ b/FastScript/dclFMXfsDB17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclFMXfsDB17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs17,
+ FMXfsDB17;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsDB17.res b/FastScript/dclFMXfsDB17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsDB17.res differ
diff --git a/FastScript/dclFMXfsDB18.dpk b/FastScript/dclFMXfsDB18.dpk
new file mode 100644
index 0000000..f944213
--- /dev/null
+++ b/FastScript/dclFMXfsDB18.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi XE4
+
+package dclFMXfsDB18;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs18,
+ FMXfsDB18;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsDB18.otares b/FastScript/dclFMXfsDB18.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/dclFMXfsDB18.otares differ
diff --git a/FastScript/dclFMXfsDB18.res b/FastScript/dclFMXfsDB18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/dclFMXfsDB18.res differ
diff --git a/FastScript/dclFMXfsDB19.dpk b/FastScript/dclFMXfsDB19.dpk
new file mode 100644
index 0000000..6cd2ae6
--- /dev/null
+++ b/FastScript/dclFMXfsDB19.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi XE5
+
+package dclFMXfsDB19;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs19,
+ FMXfsDB19;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsDB19.otares b/FastScript/dclFMXfsDB19.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/dclFMXfsDB19.otares differ
diff --git a/FastScript/dclFMXfsDB19.res b/FastScript/dclFMXfsDB19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/dclFMXfsDB19.res differ
diff --git a/FastScript/dclFMXfsDB20.dpk b/FastScript/dclFMXfsDB20.dpk
new file mode 100644
index 0000000..9c12348
--- /dev/null
+++ b/FastScript/dclFMXfsDB20.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi XE6
+
+package dclFMXfsDB20;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs20,
+ FMXfsDB20;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsDB20.otares b/FastScript/dclFMXfsDB20.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/dclFMXfsDB20.otares differ
diff --git a/FastScript/dclFMXfsDB20.res b/FastScript/dclFMXfsDB20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/dclFMXfsDB20.res differ
diff --git a/FastScript/dclFMXfsDB21.dpk b/FastScript/dclFMXfsDB21.dpk
new file mode 100644
index 0000000..5f18d25
--- /dev/null
+++ b/FastScript/dclFMXfsDB21.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi XE7
+
+package dclFMXfsDB21;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs21,
+ FMXfsDB21;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsDB21.otares b/FastScript/dclFMXfsDB21.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/dclFMXfsDB21.otares differ
diff --git a/FastScript/dclFMXfsDB21.res b/FastScript/dclFMXfsDB21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/dclFMXfsDB21.res differ
diff --git a/FastScript/dclFMXfsDB22.dpk b/FastScript/dclFMXfsDB22.dpk
new file mode 100644
index 0000000..d70808f
--- /dev/null
+++ b/FastScript/dclFMXfsDB22.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi XE8
+
+package dclFMXfsDB22;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs22,
+ FMXfsDB22;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsDB22.otares b/FastScript/dclFMXfsDB22.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/dclFMXfsDB22.otares differ
diff --git a/FastScript/dclFMXfsDB22.res b/FastScript/dclFMXfsDB22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/dclFMXfsDB22.res differ
diff --git a/FastScript/dclFMXfsDB23.dpk b/FastScript/dclFMXfsDB23.dpk
new file mode 100644
index 0000000..bd11a08
--- /dev/null
+++ b/FastScript/dclFMXfsDB23.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsDB23;
+
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs23,
+ FMXfsDB23;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsDB23.otares b/FastScript/dclFMXfsDB23.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/dclFMXfsDB23.otares differ
diff --git a/FastScript/dclFMXfsDB23.res b/FastScript/dclFMXfsDB23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/dclFMXfsDB23.res differ
diff --git a/FastScript/dclFMXfsDB24.dpk b/FastScript/dclFMXfsDB24.dpk
new file mode 100644
index 0000000..21680c2
--- /dev/null
+++ b/FastScript/dclFMXfsDB24.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsDB24;
+
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs24,
+ FMXfsDB24;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsDB24.otares b/FastScript/dclFMXfsDB24.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/dclFMXfsDB24.otares differ
diff --git a/FastScript/dclFMXfsDB24.res b/FastScript/dclFMXfsDB24.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/dclFMXfsDB24.res differ
diff --git a/FastScript/dclFMXfsDB25.dpk b/FastScript/dclFMXfsDB25.dpk
new file mode 100644
index 0000000..3f6b02e
--- /dev/null
+++ b/FastScript/dclFMXfsDB25.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsDB25;
+
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs25,
+ FMXfsDB25;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsDB25.otares b/FastScript/dclFMXfsDB25.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/FastScript/dclFMXfsDB25.otares differ
diff --git a/FastScript/dclFMXfsDB25.res b/FastScript/dclFMXfsDB25.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/FastScript/dclFMXfsDB25.res differ
diff --git a/FastScript/dclFMXfsDB26.dpk b/FastScript/dclFMXfsDB26.dpk
new file mode 100644
index 0000000..5d4661f
--- /dev/null
+++ b/FastScript/dclFMXfsDB26.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsDB26;
+
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs26,
+ FMXfsDB26;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsDB27.dpk b/FastScript/dclFMXfsDB27.dpk
new file mode 100644
index 0000000..c8983d1
--- /dev/null
+++ b/FastScript/dclFMXfsDB27.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsDB27;
+
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs27,
+ FMXfsDB27;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsDB28.dpk b/FastScript/dclFMXfsDB28.dpk
new file mode 100644
index 0000000..a4a0d10
--- /dev/null
+++ b/FastScript/dclFMXfsDB28.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 11 Seattle
+
+package dclFMXfsDB28;
+
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs28,
+ FMXfsDB28;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsDB29.dpk b/FastScript/dclFMXfsDB29.dpk
new file mode 100644
index 0000000..57a4391
--- /dev/null
+++ b/FastScript/dclFMXfsDB29.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 12
+
+package dclFMXfsDB29;
+
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29,
+ FMXfsDB29;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsIBX16.dpk b/FastScript/dclFMXfsIBX16.dpk
new file mode 100644
index 0000000..024903b
--- /dev/null
+++ b/FastScript/dclFMXfsIBX16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclFMXfsIBX16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs16,
+ FMXfsIBX16;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsIBX16.res b/FastScript/dclFMXfsIBX16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsIBX16.res differ
diff --git a/FastScript/dclFMXfsIBX17.dpk b/FastScript/dclFMXfsIBX17.dpk
new file mode 100644
index 0000000..595bf4e
--- /dev/null
+++ b/FastScript/dclFMXfsIBX17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclFMXfsIBX17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs17,
+ FMXfsIBX17;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsIBX17.res b/FastScript/dclFMXfsIBX17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsIBX17.res differ
diff --git a/FastScript/dclFMXfsIBX18.dpk b/FastScript/dclFMXfsIBX18.dpk
new file mode 100644
index 0000000..7c1cb8d
--- /dev/null
+++ b/FastScript/dclFMXfsIBX18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package dclFMXfsIBX18;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs18,
+ FMXfsIBX18;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsIBX18.res b/FastScript/dclFMXfsIBX18.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsIBX18.res differ
diff --git a/FastScript/dclFMXfsIBX19.dpk b/FastScript/dclFMXfsIBX19.dpk
new file mode 100644
index 0000000..c77c2f4
--- /dev/null
+++ b/FastScript/dclFMXfsIBX19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package dclFMXfsIBX19;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs19,
+ FMXfsIBX19;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsIBX19.res b/FastScript/dclFMXfsIBX19.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsIBX19.res differ
diff --git a/FastScript/dclFMXfsIBX20.dpk b/FastScript/dclFMXfsIBX20.dpk
new file mode 100644
index 0000000..ca64df5
--- /dev/null
+++ b/FastScript/dclFMXfsIBX20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package dclFMXfsIBX20;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs20,
+ FMXfsIBX20;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsIBX20.res b/FastScript/dclFMXfsIBX20.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsIBX20.res differ
diff --git a/FastScript/dclFMXfsIBX21.dpk b/FastScript/dclFMXfsIBX21.dpk
new file mode 100644
index 0000000..26d360a
--- /dev/null
+++ b/FastScript/dclFMXfsIBX21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package dclFMXfsIBX21;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs21,
+ FMXfsIBX21;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsIBX21.res b/FastScript/dclFMXfsIBX21.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsIBX21.res differ
diff --git a/FastScript/dclFMXfsIBX22.dpk b/FastScript/dclFMXfsIBX22.dpk
new file mode 100644
index 0000000..854fc1a
--- /dev/null
+++ b/FastScript/dclFMXfsIBX22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package dclFMXfsIBX22;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs22,
+ FMXfsIBX22;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsIBX22.res b/FastScript/dclFMXfsIBX22.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsIBX22.res differ
diff --git a/FastScript/dclFMXfsIBX23.dpk b/FastScript/dclFMXfsIBX23.dpk
new file mode 100644
index 0000000..e4690f5
--- /dev/null
+++ b/FastScript/dclFMXfsIBX23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsIBX23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs23,
+ FMXfsIBX23;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsIBX23.res b/FastScript/dclFMXfsIBX23.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsIBX23.res differ
diff --git a/FastScript/dclFMXfsIBX24.dpk b/FastScript/dclFMXfsIBX24.dpk
new file mode 100644
index 0000000..7f67057
--- /dev/null
+++ b/FastScript/dclFMXfsIBX24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsIBX24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs24,
+ FMXfsIBX24;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsIBX24.res b/FastScript/dclFMXfsIBX24.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsIBX24.res differ
diff --git a/FastScript/dclFMXfsIBX25.dpk b/FastScript/dclFMXfsIBX25.dpk
new file mode 100644
index 0000000..760b971
--- /dev/null
+++ b/FastScript/dclFMXfsIBX25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsIBX25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs25,
+ FMXfsIBX25;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsIBX25.res b/FastScript/dclFMXfsIBX25.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsIBX25.res differ
diff --git a/FastScript/dclFMXfsIBX26.dpk b/FastScript/dclFMXfsIBX26.dpk
new file mode 100644
index 0000000..5787898
--- /dev/null
+++ b/FastScript/dclFMXfsIBX26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsIBX26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs26,
+ FMXfsIBX26;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsIBX27.dpk b/FastScript/dclFMXfsIBX27.dpk
new file mode 100644
index 0000000..dbfac84
--- /dev/null
+++ b/FastScript/dclFMXfsIBX27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsIBX27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs27,
+ FMXfsIBX27;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsIBX28.dpk b/FastScript/dclFMXfsIBX28.dpk
new file mode 100644
index 0000000..cb7e8e5
--- /dev/null
+++ b/FastScript/dclFMXfsIBX28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package dclFMXfsIBX28;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs28,
+ FMXfsIBX28;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsIBX29.dpk b/FastScript/dclFMXfsIBX29.dpk
new file mode 100644
index 0000000..874e96e
--- /dev/null
+++ b/FastScript/dclFMXfsIBX29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package dclFMXfsIBX29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29,
+ FMXfsIBX29;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsTee16.dpk b/FastScript/dclFMXfsTee16.dpk
new file mode 100644
index 0000000..3ff825f
--- /dev/null
+++ b/FastScript/dclFMXfsTee16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclFMXfsTee16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs16,
+ FMXfsTee16;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsTee16.res b/FastScript/dclFMXfsTee16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsTee16.res differ
diff --git a/FastScript/dclFMXfsTee17.dpk b/FastScript/dclFMXfsTee17.dpk
new file mode 100644
index 0000000..6725bc8
--- /dev/null
+++ b/FastScript/dclFMXfsTee17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclFMXfsTee17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs17,
+ FMXfsTee17;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsTee17.res b/FastScript/dclFMXfsTee17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsTee17.res differ
diff --git a/FastScript/dclFMXfsTee18.dpk b/FastScript/dclFMXfsTee18.dpk
new file mode 100644
index 0000000..86bd659
--- /dev/null
+++ b/FastScript/dclFMXfsTee18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package dclFMXfsTee18;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs18,
+ FMXfsTee18;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsTee18.res b/FastScript/dclFMXfsTee18.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsTee18.res differ
diff --git a/FastScript/dclFMXfsTee19.dpk b/FastScript/dclFMXfsTee19.dpk
new file mode 100644
index 0000000..2c49235
--- /dev/null
+++ b/FastScript/dclFMXfsTee19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package dclFMXfsTee19;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs19,
+ FMXfsTee19;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsTee19.res b/FastScript/dclFMXfsTee19.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsTee19.res differ
diff --git a/FastScript/dclFMXfsTee20.dpk b/FastScript/dclFMXfsTee20.dpk
new file mode 100644
index 0000000..5a8268b
--- /dev/null
+++ b/FastScript/dclFMXfsTee20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package dclFMXfsTee20;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs20,
+ FMXfsTee20;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsTee20.res b/FastScript/dclFMXfsTee20.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsTee20.res differ
diff --git a/FastScript/dclFMXfsTee21.dpk b/FastScript/dclFMXfsTee21.dpk
new file mode 100644
index 0000000..b4f72e7
--- /dev/null
+++ b/FastScript/dclFMXfsTee21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package dclFMXfsTee21;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs21,
+ FMXfsTee21;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsTee21.res b/FastScript/dclFMXfsTee21.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsTee21.res differ
diff --git a/FastScript/dclFMXfsTee22.dpk b/FastScript/dclFMXfsTee22.dpk
new file mode 100644
index 0000000..33b50de
--- /dev/null
+++ b/FastScript/dclFMXfsTee22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package dclFMXfsTee22;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs22,
+ FMXfsTee22;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsTee22.res b/FastScript/dclFMXfsTee22.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsTee22.res differ
diff --git a/FastScript/dclFMXfsTee23.dpk b/FastScript/dclFMXfsTee23.dpk
new file mode 100644
index 0000000..81cb335
--- /dev/null
+++ b/FastScript/dclFMXfsTee23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsTee23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs23,
+ FMXfsTee23;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsTee23.res b/FastScript/dclFMXfsTee23.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsTee23.res differ
diff --git a/FastScript/dclFMXfsTee24.dpk b/FastScript/dclFMXfsTee24.dpk
new file mode 100644
index 0000000..965474b
--- /dev/null
+++ b/FastScript/dclFMXfsTee24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsTee24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs24,
+ FMXfsTee24;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsTee24.res b/FastScript/dclFMXfsTee24.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsTee24.res differ
diff --git a/FastScript/dclFMXfsTee25.dpk b/FastScript/dclFMXfsTee25.dpk
new file mode 100644
index 0000000..561f9ff
--- /dev/null
+++ b/FastScript/dclFMXfsTee25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsTee25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs25,
+ FMXfsTee25;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsTee25.res b/FastScript/dclFMXfsTee25.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/FastScript/dclFMXfsTee25.res differ
diff --git a/FastScript/dclFMXfsTee26.dpk b/FastScript/dclFMXfsTee26.dpk
new file mode 100644
index 0000000..a372cd8
--- /dev/null
+++ b/FastScript/dclFMXfsTee26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsTee26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs26,
+ FMXfsTee26;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsTee27.dpk b/FastScript/dclFMXfsTee27.dpk
new file mode 100644
index 0000000..943b74e
--- /dev/null
+++ b/FastScript/dclFMXfsTee27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsTee27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs27,
+ FMXfsTee27;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsTee28.dpk b/FastScript/dclFMXfsTee28.dpk
new file mode 100644
index 0000000..9e28841
--- /dev/null
+++ b/FastScript/dclFMXfsTee28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package dclFMXfsTee28;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs28,
+ FMXfsTee28;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclFMXfsTee29.dpk b/FastScript/dclFMXfsTee29.dpk
new file mode 100644
index 0000000..ac47668
--- /dev/null
+++ b/FastScript/dclFMXfsTee29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package dclFMXfsTee29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29,
+ FMXfsTee29;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfs10.dpk b/FastScript/dclfs10.dpk
new file mode 100644
index 0000000..bc13c13
--- /dev/null
+++ b/FastScript/dclfs10.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 2006
+
+package dclfs10;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs10;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs11.dpk b/FastScript/dclfs11.dpk
new file mode 100644
index 0000000..448c2a5
--- /dev/null
+++ b/FastScript/dclfs11.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 2007
+
+package dclfs11;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs11;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs12.dpk b/FastScript/dclfs12.dpk
new file mode 100644
index 0000000..ee9aed6
--- /dev/null
+++ b/FastScript/dclfs12.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 2009
+
+package dclfs12;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs12;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs14.dpk b/FastScript/dclfs14.dpk
new file mode 100644
index 0000000..334e131
--- /dev/null
+++ b/FastScript/dclfs14.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 2010
+
+package dclfs14;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs14;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs15.dpk b/FastScript/dclfs15.dpk
new file mode 100644
index 0000000..45e4796
--- /dev/null
+++ b/FastScript/dclfs15.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE
+
+package dclfs15;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs15;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs16.dpk b/FastScript/dclfs16.dpk
new file mode 100644
index 0000000..46e1c5a
--- /dev/null
+++ b/FastScript/dclfs16.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE2
+
+package dclfs16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs16;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs17.dpk b/FastScript/dclfs17.dpk
new file mode 100644
index 0000000..67283a4
--- /dev/null
+++ b/FastScript/dclfs17.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE3
+
+package dclfs17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs17;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs18.dpk b/FastScript/dclfs18.dpk
new file mode 100644
index 0000000..3c1de49
--- /dev/null
+++ b/FastScript/dclfs18.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE4
+
+package dclfs18;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs18;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs19.dpk b/FastScript/dclfs19.dpk
new file mode 100644
index 0000000..a249539
--- /dev/null
+++ b/FastScript/dclfs19.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE5
+
+package dclfs19;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs19;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs20.dpk b/FastScript/dclfs20.dpk
new file mode 100644
index 0000000..9236239
--- /dev/null
+++ b/FastScript/dclfs20.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE6
+
+package dclfs20;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs20;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs21.dpk b/FastScript/dclfs21.dpk
new file mode 100644
index 0000000..e6439f7
--- /dev/null
+++ b/FastScript/dclfs21.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE7
+
+package dclfs21;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs21;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs22.dpk b/FastScript/dclfs22.dpk
new file mode 100644
index 0000000..f4ed026
--- /dev/null
+++ b/FastScript/dclfs22.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE8
+
+package dclfs22;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs22;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs23.dpk b/FastScript/dclfs23.dpk
new file mode 100644
index 0000000..3a47e28
--- /dev/null
+++ b/FastScript/dclfs23.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclfs23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs23;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs24.dpk b/FastScript/dclfs24.dpk
new file mode 100644
index 0000000..e2e042c
--- /dev/null
+++ b/FastScript/dclfs24.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclfs24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs24;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs25.dpk b/FastScript/dclfs25.dpk
new file mode 100644
index 0000000..bbfd2a1
--- /dev/null
+++ b/FastScript/dclfs25.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclfs25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs25;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs26.dpk b/FastScript/dclfs26.dpk
new file mode 100644
index 0000000..e7820a0
--- /dev/null
+++ b/FastScript/dclfs26.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclfs26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs26;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs27.dpk b/FastScript/dclfs27.dpk
new file mode 100644
index 0000000..a250656
--- /dev/null
+++ b/FastScript/dclfs27.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclfs27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs27;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs28.dpk b/FastScript/dclfs28.dpk
new file mode 100644
index 0000000..cefcf80
--- /dev/null
+++ b/FastScript/dclfs28.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 11 Seattle
+
+package dclfs28;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs28;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs29.dpk b/FastScript/dclfs29.dpk
new file mode 100644
index 0000000..5ddacda
--- /dev/null
+++ b/FastScript/dclfs29.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 12
+
+package dclfs29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs29;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs4.dpk b/FastScript/dclfs4.dpk
new file mode 100644
index 0000000..297a60e
--- /dev/null
+++ b/FastScript/dclfs4.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 4
+
+package dclfs4;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL40,
+ fs4;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs5.dpk b/FastScript/dclfs5.dpk
new file mode 100644
index 0000000..8384db9
--- /dev/null
+++ b/FastScript/dclfs5.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 5
+
+package dclfs5;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+ fs5;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs6.dpk b/FastScript/dclfs6.dpk
new file mode 100644
index 0000000..a45755b
--- /dev/null
+++ b/FastScript/dclfs6.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 6
+
+package dclfs6;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs6;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs7.dpk b/FastScript/dclfs7.dpk
new file mode 100644
index 0000000..bdace06
--- /dev/null
+++ b/FastScript/dclfs7.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 7
+
+package dclfs7;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs7;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfs9.dpk b/FastScript/dclfs9.dpk
new file mode 100644
index 0000000..50f7a31
--- /dev/null
+++ b/FastScript/dclfs9.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 2005
+
+package dclfs9;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs9;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfsADO10.dpk b/FastScript/dclfsADO10.dpk
new file mode 100644
index 0000000..ce476af
--- /dev/null
+++ b/FastScript/dclfsADO10.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2006
+
+package dclfsADO10;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs10,
+ fsADO10;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsADO11.dpk b/FastScript/dclfsADO11.dpk
new file mode 100644
index 0000000..3e4f6fa
--- /dev/null
+++ b/FastScript/dclfsADO11.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2007
+
+package dclfsADO11;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs11,
+ fsADO11;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsADO12.dpk b/FastScript/dclfsADO12.dpk
new file mode 100644
index 0000000..003e928
--- /dev/null
+++ b/FastScript/dclfsADO12.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2009
+
+package dclfsADO12;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs12,
+ fsADO12;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsADO14.dpk b/FastScript/dclfsADO14.dpk
new file mode 100644
index 0000000..384613f
--- /dev/null
+++ b/FastScript/dclfsADO14.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 2010
+
+package dclfsADO14;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs14,
+ fsADO14;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsADO15.dpk b/FastScript/dclfsADO15.dpk
new file mode 100644
index 0000000..67d77ce
--- /dev/null
+++ b/FastScript/dclfsADO15.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE
+
+package dclfsADO15;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs15,
+ fsADO15;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsADO16.dpk b/FastScript/dclfsADO16.dpk
new file mode 100644
index 0000000..a088873
--- /dev/null
+++ b/FastScript/dclfsADO16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclfsADO16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs16,
+ fsADO16;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsADO17.dpk b/FastScript/dclfsADO17.dpk
new file mode 100644
index 0000000..83cf941
--- /dev/null
+++ b/FastScript/dclfsADO17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclfsADO17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs17,
+ fsADO17;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsADO18.dpk b/FastScript/dclfsADO18.dpk
new file mode 100644
index 0000000..db09bc0
--- /dev/null
+++ b/FastScript/dclfsADO18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package dclfsADO18;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs18,
+ fsADO18;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsADO19.dpk b/FastScript/dclfsADO19.dpk
new file mode 100644
index 0000000..87926c9
--- /dev/null
+++ b/FastScript/dclfsADO19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package dclfsADO19;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs19,
+ fsADO19;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsADO20.dpk b/FastScript/dclfsADO20.dpk
new file mode 100644
index 0000000..4b16e4d
--- /dev/null
+++ b/FastScript/dclfsADO20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package dclfsADO20;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs20,
+ fsADO20;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsADO21.dpk b/FastScript/dclfsADO21.dpk
new file mode 100644
index 0000000..b245111
--- /dev/null
+++ b/FastScript/dclfsADO21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package dclfsADO21;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs21,
+ fsADO21;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsADO22.dpk b/FastScript/dclfsADO22.dpk
new file mode 100644
index 0000000..34c13f0
--- /dev/null
+++ b/FastScript/dclfsADO22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package dclfsADO22;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs22,
+ fsADO22;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsADO23.dpk b/FastScript/dclfsADO23.dpk
new file mode 100644
index 0000000..bde9bab
--- /dev/null
+++ b/FastScript/dclfsADO23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsADO23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs23,
+ fsADO23;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsADO24.dpk b/FastScript/dclfsADO24.dpk
new file mode 100644
index 0000000..4646ef9
--- /dev/null
+++ b/FastScript/dclfsADO24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsADO24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs24,
+ fsADO24;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsADO25.dpk b/FastScript/dclfsADO25.dpk
new file mode 100644
index 0000000..a44ba5e
--- /dev/null
+++ b/FastScript/dclfsADO25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsADO25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs25,
+ fsADO25;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsADO26.dpk b/FastScript/dclfsADO26.dpk
new file mode 100644
index 0000000..616db18
--- /dev/null
+++ b/FastScript/dclfsADO26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsADO26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs26,
+ fsADO26;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsADO27.dpk b/FastScript/dclfsADO27.dpk
new file mode 100644
index 0000000..c892b43
--- /dev/null
+++ b/FastScript/dclfsADO27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsADO27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs27,
+ fsADO27;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsADO28.dpk b/FastScript/dclfsADO28.dpk
new file mode 100644
index 0000000..597b7a5
--- /dev/null
+++ b/FastScript/dclfsADO28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package dclfsADO28;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs28,
+ fsADO28;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsADO29.dpk b/FastScript/dclfsADO29.dpk
new file mode 100644
index 0000000..f0e74bc
--- /dev/null
+++ b/FastScript/dclfsADO29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package dclfsADO29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs29,
+ fsADO29;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsADO5.dpk b/FastScript/dclfsADO5.dpk
new file mode 100644
index 0000000..bf65218
--- /dev/null
+++ b/FastScript/dclfsADO5.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 5
+
+package dclfsADO5;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+ fs5,
+ fsADO5;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsADO6.dpk b/FastScript/dclfsADO6.dpk
new file mode 100644
index 0000000..04c779b
--- /dev/null
+++ b/FastScript/dclfsADO6.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 6
+
+package dclfsADO6;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs6,
+ fsADO6;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsADO7.dpk b/FastScript/dclfsADO7.dpk
new file mode 100644
index 0000000..261ae1b
--- /dev/null
+++ b/FastScript/dclfsADO7.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 7
+
+package dclfsADO7;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs7,
+ fsADO7;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsADO9.dpk b/FastScript/dclfsADO9.dpk
new file mode 100644
index 0000000..6df9798
--- /dev/null
+++ b/FastScript/dclfsADO9.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2005
+
+package dclfsADO9;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs9,
+ fsADO9;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE10.dpk b/FastScript/dclfsBDE10.dpk
new file mode 100644
index 0000000..9ccd14c
--- /dev/null
+++ b/FastScript/dclfsBDE10.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2006
+
+package dclfsBDE10;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs10,
+ fsBDE10;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE11.dpk b/FastScript/dclfsBDE11.dpk
new file mode 100644
index 0000000..3c365fa
--- /dev/null
+++ b/FastScript/dclfsBDE11.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2007
+
+package dclfsBDE11;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs11,
+ fsBDE11;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE12.dpk b/FastScript/dclfsBDE12.dpk
new file mode 100644
index 0000000..076fdc7
--- /dev/null
+++ b/FastScript/dclfsBDE12.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2009
+
+package dclfsBDE12;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs12,
+ fsBDE12;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE14.dpk b/FastScript/dclfsBDE14.dpk
new file mode 100644
index 0000000..28276a6
--- /dev/null
+++ b/FastScript/dclfsBDE14.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 2010
+
+package dclfsBDE14;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs14,
+ fsBDE14;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE15.dpk b/FastScript/dclfsBDE15.dpk
new file mode 100644
index 0000000..7ba0b54
--- /dev/null
+++ b/FastScript/dclfsBDE15.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE
+
+package dclfsBDE15;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs15,
+ fsBDE15;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE16.dpk b/FastScript/dclfsBDE16.dpk
new file mode 100644
index 0000000..720cd4e
--- /dev/null
+++ b/FastScript/dclfsBDE16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclfsBDE16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs16,
+ fsBDE16;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE17.dpk b/FastScript/dclfsBDE17.dpk
new file mode 100644
index 0000000..d6166fc
--- /dev/null
+++ b/FastScript/dclfsBDE17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclfsBDE17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs17,
+ fsBDE17;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE18.dpk b/FastScript/dclfsBDE18.dpk
new file mode 100644
index 0000000..b505311
--- /dev/null
+++ b/FastScript/dclfsBDE18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package dclfsBDE18;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs18,
+ fsBDE18;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE19.dpk b/FastScript/dclfsBDE19.dpk
new file mode 100644
index 0000000..2948eed
--- /dev/null
+++ b/FastScript/dclfsBDE19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package dclfsBDE19;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs19,
+ fsBDE19;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE20.dpk b/FastScript/dclfsBDE20.dpk
new file mode 100644
index 0000000..cfb519b
--- /dev/null
+++ b/FastScript/dclfsBDE20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package dclfsBDE20;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs20,
+ fsBDE20;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE21.dpk b/FastScript/dclfsBDE21.dpk
new file mode 100644
index 0000000..935d85c
--- /dev/null
+++ b/FastScript/dclfsBDE21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package dclfsBDE21;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs21,
+ fsBDE21;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE22.dpk b/FastScript/dclfsBDE22.dpk
new file mode 100644
index 0000000..c0b9085
--- /dev/null
+++ b/FastScript/dclfsBDE22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package dclfsBDE22;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs22,
+ fsBDE22;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE23.dpk b/FastScript/dclfsBDE23.dpk
new file mode 100644
index 0000000..f8058b4
--- /dev/null
+++ b/FastScript/dclfsBDE23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsBDE23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs23,
+ fsBDE23;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE24.dpk b/FastScript/dclfsBDE24.dpk
new file mode 100644
index 0000000..fcb4ff1
--- /dev/null
+++ b/FastScript/dclfsBDE24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsBDE24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs24,
+ fsBDE24;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE25.dpk b/FastScript/dclfsBDE25.dpk
new file mode 100644
index 0000000..673e27d
--- /dev/null
+++ b/FastScript/dclfsBDE25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsBDE25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs25,
+ fsBDE25;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE26.dpk b/FastScript/dclfsBDE26.dpk
new file mode 100644
index 0000000..77e0d61
--- /dev/null
+++ b/FastScript/dclfsBDE26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsBDE26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs26,
+ fsBDE26;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE27.dpk b/FastScript/dclfsBDE27.dpk
new file mode 100644
index 0000000..565753b
--- /dev/null
+++ b/FastScript/dclfsBDE27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsBDE27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs27,
+ fsBDE27;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE28.dpk b/FastScript/dclfsBDE28.dpk
new file mode 100644
index 0000000..33b4e47
--- /dev/null
+++ b/FastScript/dclfsBDE28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package dclfsBDE28;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs28,
+ fsBDE28;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE29.dpk b/FastScript/dclfsBDE29.dpk
new file mode 100644
index 0000000..892ac89
--- /dev/null
+++ b/FastScript/dclfsBDE29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package dclfsBDE29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs29,
+ fsBDE29;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE4.dpk b/FastScript/dclfsBDE4.dpk
new file mode 100644
index 0000000..9062111
--- /dev/null
+++ b/FastScript/dclfsBDE4.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 4
+
+package dclfsBDE4;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL40,
+ fs4,
+ fsBDE4;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE5.dpk b/FastScript/dclfsBDE5.dpk
new file mode 100644
index 0000000..7c6c477
--- /dev/null
+++ b/FastScript/dclfsBDE5.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 5
+
+package dclfsBDE5;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+ fs5,
+ fsBDE5;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE6.dpk b/FastScript/dclfsBDE6.dpk
new file mode 100644
index 0000000..ba99903
--- /dev/null
+++ b/FastScript/dclfsBDE6.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 6
+
+package dclfsBDE6;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs6,
+ fsBDE6;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE7.dpk b/FastScript/dclfsBDE7.dpk
new file mode 100644
index 0000000..b973078
--- /dev/null
+++ b/FastScript/dclfsBDE7.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 7
+
+package dclfsBDE7;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs7,
+ fsBDE7;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsBDE9.dpk b/FastScript/dclfsBDE9.dpk
new file mode 100644
index 0000000..c9ac0c2
--- /dev/null
+++ b/FastScript/dclfsBDE9.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2005
+
+package dclfsBDE9;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs9,
+ fsBDE9;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/FastScript/dclfsDB10.dpk b/FastScript/dclfsDB10.dpk
new file mode 100644
index 0000000..7e728f1
--- /dev/null
+++ b/FastScript/dclfsDB10.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2006
+
+package dclfsDB10;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs10,
+ fsDB10;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB11.dpk b/FastScript/dclfsDB11.dpk
new file mode 100644
index 0000000..cf81001
--- /dev/null
+++ b/FastScript/dclfsDB11.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2007
+
+package dclfsDB11;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs11,
+ fsDB11;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB12.dpk b/FastScript/dclfsDB12.dpk
new file mode 100644
index 0000000..a7707e1
--- /dev/null
+++ b/FastScript/dclfsDB12.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2009
+
+package dclfsDB12;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs12,
+ fsDB12;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB14.dpk b/FastScript/dclfsDB14.dpk
new file mode 100644
index 0000000..7083e22
--- /dev/null
+++ b/FastScript/dclfsDB14.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 2010
+
+package dclfsDB14;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs14,
+ fsDB14;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB15.dpk b/FastScript/dclfsDB15.dpk
new file mode 100644
index 0000000..b1a787a
--- /dev/null
+++ b/FastScript/dclfsDB15.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE
+
+package dclfsDB15;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs15,
+ fsDB15;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB16.dpk b/FastScript/dclfsDB16.dpk
new file mode 100644
index 0000000..491a0f0
--- /dev/null
+++ b/FastScript/dclfsDB16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclfsDB16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs16,
+ fsDB16;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB17.dpk b/FastScript/dclfsDB17.dpk
new file mode 100644
index 0000000..db3ecfd
--- /dev/null
+++ b/FastScript/dclfsDB17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclfsDB17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs17,
+ fsDB17;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB18.dpk b/FastScript/dclfsDB18.dpk
new file mode 100644
index 0000000..053ade5
--- /dev/null
+++ b/FastScript/dclfsDB18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package dclfsDB18;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs18,
+ fsDB18;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB19.dpk b/FastScript/dclfsDB19.dpk
new file mode 100644
index 0000000..a137c99
--- /dev/null
+++ b/FastScript/dclfsDB19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package dclfsDB19;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs19,
+ fsDB19;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB20.dpk b/FastScript/dclfsDB20.dpk
new file mode 100644
index 0000000..e70175d
--- /dev/null
+++ b/FastScript/dclfsDB20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package dclfsDB20;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs20,
+ fsDB20;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB21.dpk b/FastScript/dclfsDB21.dpk
new file mode 100644
index 0000000..da93899
--- /dev/null
+++ b/FastScript/dclfsDB21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package dclfsDB21;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs21,
+ fsDB21;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB22.dpk b/FastScript/dclfsDB22.dpk
new file mode 100644
index 0000000..2546074
--- /dev/null
+++ b/FastScript/dclfsDB22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package dclfsDB22;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs22,
+ fsDB22;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB23.dpk b/FastScript/dclfsDB23.dpk
new file mode 100644
index 0000000..2eb7cc0
--- /dev/null
+++ b/FastScript/dclfsDB23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsDB23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs23,
+ fsDB23;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB24.dpk b/FastScript/dclfsDB24.dpk
new file mode 100644
index 0000000..cd44f2a
--- /dev/null
+++ b/FastScript/dclfsDB24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsDB24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs24,
+ fsDB24;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB25.dpk b/FastScript/dclfsDB25.dpk
new file mode 100644
index 0000000..89732aa
--- /dev/null
+++ b/FastScript/dclfsDB25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsDB25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs25,
+ fsDB25;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB26.dpk b/FastScript/dclfsDB26.dpk
new file mode 100644
index 0000000..8ea689a
--- /dev/null
+++ b/FastScript/dclfsDB26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsDB26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs26,
+ fsDB26;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB27.dpk b/FastScript/dclfsDB27.dpk
new file mode 100644
index 0000000..48e119b
--- /dev/null
+++ b/FastScript/dclfsDB27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsDB27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs27,
+ fsDB27;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB28.dpk b/FastScript/dclfsDB28.dpk
new file mode 100644
index 0000000..ed646e9
--- /dev/null
+++ b/FastScript/dclfsDB28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package dclfsDB28;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs28,
+ fsDB28;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB29.dpk b/FastScript/dclfsDB29.dpk
new file mode 100644
index 0000000..da8f59f
--- /dev/null
+++ b/FastScript/dclfsDB29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package dclfsDB29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs29,
+ fsDB29;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB4.dpk b/FastScript/dclfsDB4.dpk
new file mode 100644
index 0000000..08f858e
--- /dev/null
+++ b/FastScript/dclfsDB4.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 4
+
+package dclfsDB4;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL40,
+ fs4,
+ fsDB4;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB5.dpk b/FastScript/dclfsDB5.dpk
new file mode 100644
index 0000000..9f82559
--- /dev/null
+++ b/FastScript/dclfsDB5.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 5
+
+package dclfsDB5;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+ fs5,
+ fsDB5;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB6.dpk b/FastScript/dclfsDB6.dpk
new file mode 100644
index 0000000..15cc0b3
--- /dev/null
+++ b/FastScript/dclfsDB6.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 6
+
+package dclfsDB6;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs6,
+ fsDB6;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB7.dpk b/FastScript/dclfsDB7.dpk
new file mode 100644
index 0000000..5e535f3
--- /dev/null
+++ b/FastScript/dclfsDB7.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 7
+
+package dclfsDB7;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs7,
+ fsDB7;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsDB9.dpk b/FastScript/dclfsDB9.dpk
new file mode 100644
index 0000000..607b373
--- /dev/null
+++ b/FastScript/dclfsDB9.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2005
+
+package dclfsDB9;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs9,
+ fsDB9;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/FastScript/dclfsFD15.dpk b/FastScript/dclfsFD15.dpk
new file mode 100644
index 0000000..39e761c
--- /dev/null
+++ b/FastScript/dclfsFD15.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE
+
+package dclfsFD15;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs15,
+ fsFD15;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/FastScript/dclfsFD16.dpk b/FastScript/dclfsFD16.dpk
new file mode 100644
index 0000000..dd067a1
--- /dev/null
+++ b/FastScript/dclfsFD16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclfsFD16;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs16,
+ fsFD16;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/FastScript/dclfsFD17.dpk b/FastScript/dclfsFD17.dpk
new file mode 100644
index 0000000..dfc50b0
--- /dev/null
+++ b/FastScript/dclfsFD17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclfsFD17;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs17,
+ fsFD17;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/FastScript/dclfsFD18.dpk b/FastScript/dclfsFD18.dpk
new file mode 100644
index 0000000..37c7041
--- /dev/null
+++ b/FastScript/dclfsFD18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package dclfsFD18;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs18,
+ fsFD18;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/FastScript/dclfsFD19.dpk b/FastScript/dclfsFD19.dpk
new file mode 100644
index 0000000..1a01271
--- /dev/null
+++ b/FastScript/dclfsFD19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package dclfsFD19;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs19,
+ fsFD19;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/FastScript/dclfsFD20.dpk b/FastScript/dclfsFD20.dpk
new file mode 100644
index 0000000..924acc3
--- /dev/null
+++ b/FastScript/dclfsFD20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package dclfsFD20;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs20,
+ fsFD20;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/FastScript/dclfsFD21.dpk b/FastScript/dclfsFD21.dpk
new file mode 100644
index 0000000..29a4a33
--- /dev/null
+++ b/FastScript/dclfsFD21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package dclfsFD21;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs21,
+ fsFD21;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/FastScript/dclfsFD22.dpk b/FastScript/dclfsFD22.dpk
new file mode 100644
index 0000000..6510980
--- /dev/null
+++ b/FastScript/dclfsFD22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package dclfsFD22;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs22,
+ fsFD22;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/FastScript/dclfsFD23.dpk b/FastScript/dclfsFD23.dpk
new file mode 100644
index 0000000..a595230
--- /dev/null
+++ b/FastScript/dclfsFD23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsFD23;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs23,
+ fsFD23;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/FastScript/dclfsFD24.dpk b/FastScript/dclfsFD24.dpk
new file mode 100644
index 0000000..7c95ac6
--- /dev/null
+++ b/FastScript/dclfsFD24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10.1 Berlin
+
+package dclfsFD24;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs24,
+ fsFD24;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/FastScript/dclfsFD25.dpk b/FastScript/dclfsFD25.dpk
new file mode 100644
index 0000000..51b4bd5
--- /dev/null
+++ b/FastScript/dclfsFD25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10.2 Tokyo
+
+package dclfsFD25;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs25,
+ fsFD25;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/FastScript/dclfsFD26.dpk b/FastScript/dclfsFD26.dpk
new file mode 100644
index 0000000..da7fdb2
--- /dev/null
+++ b/FastScript/dclfsFD26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10.3 Rio
+
+package dclfsFD26;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs26,
+ fsFD26;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/FastScript/dclfsFD27.dpk b/FastScript/dclfsFD27.dpk
new file mode 100644
index 0000000..d91e582
--- /dev/null
+++ b/FastScript/dclfsFD27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10.3 Rio
+
+package dclfsFD27;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs27,
+ fsFD27;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/FastScript/dclfsFD28.dpk b/FastScript/dclfsFD28.dpk
new file mode 100644
index 0000000..82f43d0
--- /dev/null
+++ b/FastScript/dclfsFD28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11.3 Rio
+
+package dclfsFD28;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs28,
+ fsFD28;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/FastScript/dclfsFD29.dpk b/FastScript/dclfsFD29.dpk
new file mode 100644
index 0000000..ab5b478
--- /dev/null
+++ b/FastScript/dclfsFD29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package dclfsFD29;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs29,
+ fsFD29;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX10.dpk b/FastScript/dclfsIBX10.dpk
new file mode 100644
index 0000000..31f546b
--- /dev/null
+++ b/FastScript/dclfsIBX10.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2006
+
+package dclfsIBX10;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs10,
+ fsIBX10;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX11.dpk b/FastScript/dclfsIBX11.dpk
new file mode 100644
index 0000000..994c232
--- /dev/null
+++ b/FastScript/dclfsIBX11.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2007
+
+package dclfsIBX11;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs11,
+ fsIBX11;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX12.dpk b/FastScript/dclfsIBX12.dpk
new file mode 100644
index 0000000..f4137a8
--- /dev/null
+++ b/FastScript/dclfsIBX12.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2009
+
+package dclfsIBX12;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs12,
+ fsIBX12;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX14.dpk b/FastScript/dclfsIBX14.dpk
new file mode 100644
index 0000000..994a9fb
--- /dev/null
+++ b/FastScript/dclfsIBX14.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 2010
+
+package dclfsIBX14;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs14,
+ fsIBX14;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX15.dpk b/FastScript/dclfsIBX15.dpk
new file mode 100644
index 0000000..46f9e7a
--- /dev/null
+++ b/FastScript/dclfsIBX15.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE
+
+package dclfsIBX15;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs15,
+ fsIBX15;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX16.dpk b/FastScript/dclfsIBX16.dpk
new file mode 100644
index 0000000..4df76c2
--- /dev/null
+++ b/FastScript/dclfsIBX16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclfsIBX16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs16,
+ fsIBX16;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX17.dpk b/FastScript/dclfsIBX17.dpk
new file mode 100644
index 0000000..52dbea0
--- /dev/null
+++ b/FastScript/dclfsIBX17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclfsIBX17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs17,
+ fsIBX17;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX18.dpk b/FastScript/dclfsIBX18.dpk
new file mode 100644
index 0000000..2025bb1
--- /dev/null
+++ b/FastScript/dclfsIBX18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package dclfsIBX18;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs18,
+ fsIBX18;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX19.dpk b/FastScript/dclfsIBX19.dpk
new file mode 100644
index 0000000..c85697f
--- /dev/null
+++ b/FastScript/dclfsIBX19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package dclfsIBX19;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs19,
+ fsIBX19;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX20.dpk b/FastScript/dclfsIBX20.dpk
new file mode 100644
index 0000000..afbecdf
--- /dev/null
+++ b/FastScript/dclfsIBX20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package dclfsIBX20;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs20,
+ fsIBX20;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX21.dpk b/FastScript/dclfsIBX21.dpk
new file mode 100644
index 0000000..c58d3cb
--- /dev/null
+++ b/FastScript/dclfsIBX21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package dclfsIBX21;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs21,
+ fsIBX21;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX22.dpk b/FastScript/dclfsIBX22.dpk
new file mode 100644
index 0000000..cd8b53a
--- /dev/null
+++ b/FastScript/dclfsIBX22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package dclfsIBX22;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs22,
+ fsIBX22;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX23.dpk b/FastScript/dclfsIBX23.dpk
new file mode 100644
index 0000000..464647c
--- /dev/null
+++ b/FastScript/dclfsIBX23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsIBX23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs23,
+ fsIBX23;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX24.dpk b/FastScript/dclfsIBX24.dpk
new file mode 100644
index 0000000..434d0dd
--- /dev/null
+++ b/FastScript/dclfsIBX24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsIBX24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs24,
+ fsIBX24;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX25.dpk b/FastScript/dclfsIBX25.dpk
new file mode 100644
index 0000000..2dff5f1
--- /dev/null
+++ b/FastScript/dclfsIBX25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsIBX25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs25,
+ fsIBX25;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX26.dpk b/FastScript/dclfsIBX26.dpk
new file mode 100644
index 0000000..59a1405
--- /dev/null
+++ b/FastScript/dclfsIBX26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsIBX26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs26,
+ fsIBX26;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX27.dpk b/FastScript/dclfsIBX27.dpk
new file mode 100644
index 0000000..f8449fc
--- /dev/null
+++ b/FastScript/dclfsIBX27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsIBX27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs27,
+ fsIBX27;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX28.dpk b/FastScript/dclfsIBX28.dpk
new file mode 100644
index 0000000..6a7f530
--- /dev/null
+++ b/FastScript/dclfsIBX28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package dclfsIBX28;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs28,
+ fsIBX28;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX29.dpk b/FastScript/dclfsIBX29.dpk
new file mode 100644
index 0000000..8d3036a
--- /dev/null
+++ b/FastScript/dclfsIBX29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package dclfsIBX29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs29,
+ fsIBX29;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX5.dpk b/FastScript/dclfsIBX5.dpk
new file mode 100644
index 0000000..49131ba
--- /dev/null
+++ b/FastScript/dclfsIBX5.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 5
+
+package dclfsIBX5;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+ fs5,
+ fsIBX5;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX6.dpk b/FastScript/dclfsIBX6.dpk
new file mode 100644
index 0000000..116116e
--- /dev/null
+++ b/FastScript/dclfsIBX6.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 6
+
+package dclfsIBX6;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs6,
+ fsIBX6;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX7.dpk b/FastScript/dclfsIBX7.dpk
new file mode 100644
index 0000000..de31978
--- /dev/null
+++ b/FastScript/dclfsIBX7.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 7
+
+package dclfsIBX7;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs7,
+ fsIBX7;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsIBX9.dpk b/FastScript/dclfsIBX9.dpk
new file mode 100644
index 0000000..7f0571d
--- /dev/null
+++ b/FastScript/dclfsIBX9.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2005
+
+package dclfsIBX9;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs9,
+ fsIBX9;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/FastScript/dclfsTee10.dpk b/FastScript/dclfsTee10.dpk
new file mode 100644
index 0000000..2528ac4
--- /dev/null
+++ b/FastScript/dclfsTee10.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2006
+
+package dclfsTee10;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs10,
+ fsTee10;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee11.dpk b/FastScript/dclfsTee11.dpk
new file mode 100644
index 0000000..01da7b4
--- /dev/null
+++ b/FastScript/dclfsTee11.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2007
+
+package dclfsTee11;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs11,
+ fsTee11;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee12.dpk b/FastScript/dclfsTee12.dpk
new file mode 100644
index 0000000..e2f21ee
--- /dev/null
+++ b/FastScript/dclfsTee12.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2009
+
+package dclfsTee12;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs12,
+ fsTee12;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee14.dpk b/FastScript/dclfsTee14.dpk
new file mode 100644
index 0000000..8602d0a
--- /dev/null
+++ b/FastScript/dclfsTee14.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 2010
+
+package dclfsTee14;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs14,
+ fsTee14;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee15.dpk b/FastScript/dclfsTee15.dpk
new file mode 100644
index 0000000..7edbf47
--- /dev/null
+++ b/FastScript/dclfsTee15.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE
+
+package dclfsTee15;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs15,
+ fsTee15;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee16.dpk b/FastScript/dclfsTee16.dpk
new file mode 100644
index 0000000..57d575d
--- /dev/null
+++ b/FastScript/dclfsTee16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclfsTee16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs16,
+ fsTee16;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee17.dpk b/FastScript/dclfsTee17.dpk
new file mode 100644
index 0000000..241a123
--- /dev/null
+++ b/FastScript/dclfsTee17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclfsTee17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs17,
+ fsTee17;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee18.dpk b/FastScript/dclfsTee18.dpk
new file mode 100644
index 0000000..e800491
--- /dev/null
+++ b/FastScript/dclfsTee18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package dclfsTee18;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs18,
+ fsTee18;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee19.dpk b/FastScript/dclfsTee19.dpk
new file mode 100644
index 0000000..e9bb0d2
--- /dev/null
+++ b/FastScript/dclfsTee19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package dclfsTee19;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs19,
+ fsTee19;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee20.dpk b/FastScript/dclfsTee20.dpk
new file mode 100644
index 0000000..68dba6b
--- /dev/null
+++ b/FastScript/dclfsTee20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package dclfsTee20;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs20,
+ fsTee20;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee21.dpk b/FastScript/dclfsTee21.dpk
new file mode 100644
index 0000000..797396e
--- /dev/null
+++ b/FastScript/dclfsTee21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package dclfsTee21;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs21,
+ fsTee21;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee22.dpk b/FastScript/dclfsTee22.dpk
new file mode 100644
index 0000000..4d25a05
--- /dev/null
+++ b/FastScript/dclfsTee22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package dclfsTee22;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs22,
+ fsTee22;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee23.dpk b/FastScript/dclfsTee23.dpk
new file mode 100644
index 0000000..d37c1af
--- /dev/null
+++ b/FastScript/dclfsTee23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsTee23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs23,
+ fsTee23;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee24.dpk b/FastScript/dclfsTee24.dpk
new file mode 100644
index 0000000..df5becb
--- /dev/null
+++ b/FastScript/dclfsTee24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsTee24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs24,
+ fsTee24;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee25.dpk b/FastScript/dclfsTee25.dpk
new file mode 100644
index 0000000..e0299de
--- /dev/null
+++ b/FastScript/dclfsTee25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsTee25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs25,
+ fsTee25;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee26.dpk b/FastScript/dclfsTee26.dpk
new file mode 100644
index 0000000..a6aa19d
--- /dev/null
+++ b/FastScript/dclfsTee26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsTee26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs26,
+ fsTee26;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee27.dpk b/FastScript/dclfsTee27.dpk
new file mode 100644
index 0000000..7eabf7d
--- /dev/null
+++ b/FastScript/dclfsTee27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsTee27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs27,
+ fsTee27;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee28.dpk b/FastScript/dclfsTee28.dpk
new file mode 100644
index 0000000..80fd3de
--- /dev/null
+++ b/FastScript/dclfsTee28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package dclfsTee28;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs28,
+ fsTee28;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee29.dpk b/FastScript/dclfsTee29.dpk
new file mode 100644
index 0000000..1ba0884
--- /dev/null
+++ b/FastScript/dclfsTee29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package dclfsTee29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs29,
+ fsTee29;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee4.dpk b/FastScript/dclfsTee4.dpk
new file mode 100644
index 0000000..401bc0f
--- /dev/null
+++ b/FastScript/dclfsTee4.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 4
+
+package dclfsTee4;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL40,
+ fs4,
+ fsTee4;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee5.dpk b/FastScript/dclfsTee5.dpk
new file mode 100644
index 0000000..3cc3397
--- /dev/null
+++ b/FastScript/dclfsTee5.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 5
+
+package dclfsTee5;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+ fs5,
+ fsTee5;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee6.dpk b/FastScript/dclfsTee6.dpk
new file mode 100644
index 0000000..074527d
--- /dev/null
+++ b/FastScript/dclfsTee6.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 6
+
+package dclfsTee6;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs6,
+ fsTee6;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee7.dpk b/FastScript/dclfsTee7.dpk
new file mode 100644
index 0000000..f635e9a
--- /dev/null
+++ b/FastScript/dclfsTee7.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 7
+
+package dclfsTee7;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs7,
+ fsTee7;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsTee9.dpk b/FastScript/dclfsTee9.dpk
new file mode 100644
index 0000000..ebb9f57
--- /dev/null
+++ b/FastScript/dclfsTee9.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2005
+
+package dclfsTee9;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs9,
+ fsTee9;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/FastScript/dclfsx.dpk b/FastScript/dclfsx.dpk
new file mode 100644
index 0000000..0c49e2a
--- /dev/null
+++ b/FastScript/dclfsx.dpk
@@ -0,0 +1,46 @@
+// Package file for CLX
+
+package dclfsx;
+
+{$R *.res}
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ rtl,
+ designide,
+ visualclx,
+ fsx
+{$IFNDEF LINUX}
+, bdertl,
+ adortl,
+ tee
+{$ENDIF};
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/FastScript/dclfsx.res b/FastScript/dclfsx.res
new file mode 100644
index 0000000..fa40de9
Binary files /dev/null and b/FastScript/dclfsx.res differ
diff --git a/FastScript/fmx.inc b/FastScript/fmx.inc
new file mode 100644
index 0000000..e502196
--- /dev/null
+++ b/FastScript/fmx.inc
@@ -0,0 +1,12 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Include file }
+{ }
+{ (c) 2003, 2004 by Alexander Tzyganenko, }
+{ Fast Reports, Inc }
+{ }
+{******************************************}
+
+{$DEFINE FMX}
diff --git a/FastScript/frxPlatformsAttribute.inc b/FastScript/frxPlatformsAttribute.inc
new file mode 100644
index 0000000..418ba41
--- /dev/null
+++ b/FastScript/frxPlatformsAttribute.inc
@@ -0,0 +1,12 @@
+{$IFDEF DELPHI16}
+{$IFDEF FMX}
+{$IFDEF DELPHI26}
+[ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidOSX32 or pidOSX64)]
+{$ELSE}
+[ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidOSX32)]
+{$ENDIF}
+{$ELSE}
+[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
+{$ENDIF}
+{$ENDIF}
+
diff --git a/FastScript/fs.inc b/FastScript/fs.inc
new file mode 100644
index 0000000..d5d7aee
--- /dev/null
+++ b/FastScript/fs.inc
@@ -0,0 +1,612 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Include file }
+{ }
+{ (c) 2003, 2004 by Alexander Tzyganenko, }
+{ Fast Reports, Inc }
+{ }
+{******************************************}
+
+
+{$R-} {- Range-Checking }
+{$H+} {- Use long strings by default }
+{$B-} {- Complete Boolean Evaluation }
+{$T-} {- Typed @ operator }
+{$P+} {- Open string params }
+
+{$IFNDEF FPC}
+ {$V-} {- Var-String Checking }
+ {$X+} {- Extended syntax }
+ {$J+} {- Writeable structured consts }
+{$ENDIF}
+
+{$IFDEF VER120} // Delphi 4.0
+ {$DEFINE Delphi4}
+{$ENDIF}
+
+{$IFDEF VER130} // Delphi 5.0
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+{$ENDIF}
+
+{$IFDEF VER140} // Delphi 6.0
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+{$ENDIF}
+
+{$IFDEF VER150} // Delphi 7.0
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+{$ENDIF}
+
+{$IFDEF VER170} // Delphi 9.0
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER180} // Delphi 10.0
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER185} // Delphi 11.0 (Spacely)
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER190} // Delphi 11.0 (Highlander)
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER200} // Delphi 12.0 (Tiburon)
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+// {$WARNINGS OFF}
+{$ENDIF}
+
+{$IFDEF VER210} // Delphi 14.0
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER220} // Delphi XE
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER230} // Delphi XE 2
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER240} // Delphi XE 3
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER250} // Delphi XE 4
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER260} // Delphi XE 4
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER270} // Delphi XE 6
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER280} // Delphi XE 7
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER290} // Delphi XE 8
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER300} // Delphi 10 Seattle
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE Delphi23}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER310}
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE Delphi23}
+ {$DEFINE Delphi24}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER320}
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE Delphi23}
+ {$DEFINE Delphi24}
+ {$DEFINE Delphi25}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER330}
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE Delphi23}
+ {$DEFINE Delphi24}
+ {$DEFINE Delphi25}
+ {$DEFINE Delphi26}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER340}
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE Delphi23}
+ {$DEFINE Delphi24}
+ {$DEFINE Delphi25}
+ {$DEFINE Delphi26}
+ {$DEFINE Delphi27}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER350}
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE Delphi23}
+ {$DEFINE Delphi24}
+ {$DEFINE Delphi25}
+ {$DEFINE Delphi26}
+ {$DEFINE Delphi27}
+ {$DEFINE Delphi28}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER360}
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE Delphi23}
+ {$DEFINE Delphi24}
+ {$DEFINE Delphi25}
+ {$DEFINE Delphi26}
+ {$DEFINE Delphi27}
+ {$DEFINE Delphi28}
+ {$DEFINE Delphi29}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+
+{$IFDEF VER125} // Borland C++ Builder 4.0
+ {$DEFINE Delphi4}
+ {$ObjExportAll on}
+{$ENDIF}
+
+{$IFDEF VER130} // Borland C++ Builder 5.0
+ {$IFDEF BCB}
+ {$ObjExportAll on}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF VER140} // Borland C++ Builder 6.0
+ {$IFDEF BCB}
+ {$ObjExportAll on}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF VER150} // Borland C++ Builder 7.0
+ {$IFDEF BCB}
+ {$ObjExportAll on}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF FPC} // Free pascal compiler
+ {$MODE DELPHI}
+ {$PACKSET 1}
+
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE FS_INT64}
+{$ELSE}
+ {$IFDEF LINUX} // KYLIX
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$IFNDEF Delphi22}
+ {$DEFINE CLX}
+ {$ENDIF}
+ {$IFDEF BCB}
+ {$DEFINE CLXCPP}
+ {$ENDIF}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFNDEF LINUX}
+ {$DEFINE WINDOWS}
+{$ENDIF}
+
+{$IFDEF FPC}
+ {$DEFINE CROSS_COMPILE}
+{$ENDIF}
+
+{$IFDEF CLX}
+ {$DEFINE CROSS_COMPILE}
+{$ENDIF}
+
+// Uncomment below line for CLX compilation
+//{$DEFINE CLX}
+
+// include ole dispatch module
+{$IFNDEF CROSS_COMPILE}
+{$IFNDEF FMX}
+{$DEFINE OLE}
+{$ENDIF}
+{$ENDIF}
+//{$DEFINE NOFORMS}
diff --git a/FastScript/fs10.dpk b/FastScript/fs10.dpk
new file mode 100644
index 0000000..2d7ebc1
--- /dev/null
+++ b/FastScript/fs10.dpk
@@ -0,0 +1,66 @@
+// Package file for Delphi 2006
+
+package fs10;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+
+
+end.
diff --git a/FastScript/fs11.dpk b/FastScript/fs11.dpk
new file mode 100644
index 0000000..168bf98
--- /dev/null
+++ b/FastScript/fs11.dpk
@@ -0,0 +1,66 @@
+// Package file for Delphi 2007
+
+package fs11;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+
+
+end.
diff --git a/FastScript/fs12.dpk b/FastScript/fs12.dpk
new file mode 100644
index 0000000..4770065
--- /dev/null
+++ b/FastScript/fs12.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 2009
+
+package fs12;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/FastScript/fs14.dpk b/FastScript/fs14.dpk
new file mode 100644
index 0000000..b974430
--- /dev/null
+++ b/FastScript/fs14.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 2010
+
+package fs14;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/FastScript/fs15.dpk b/FastScript/fs15.dpk
new file mode 100644
index 0000000..75d0ec0
--- /dev/null
+++ b/FastScript/fs15.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi XE
+
+package fs15;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/FastScript/fs16.dpk b/FastScript/fs16.dpk
new file mode 100644
index 0000000..80ae244
--- /dev/null
+++ b/FastScript/fs16.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi XE2
+
+package fs16;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/FastScript/fs17.dpk b/FastScript/fs17.dpk
new file mode 100644
index 0000000..f873811
--- /dev/null
+++ b/FastScript/fs17.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi XE3
+
+package fs17;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/FastScript/fs18.dpk b/FastScript/fs18.dpk
new file mode 100644
index 0000000..4138707
--- /dev/null
+++ b/FastScript/fs18.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi XE4
+
+package fs18;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/FastScript/fs19.dpk b/FastScript/fs19.dpk
new file mode 100644
index 0000000..31eedb1
--- /dev/null
+++ b/FastScript/fs19.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi XE5
+
+package fs19;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/FastScript/fs20.dpk b/FastScript/fs20.dpk
new file mode 100644
index 0000000..88ff2b8
--- /dev/null
+++ b/FastScript/fs20.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi XE6
+
+package fs20;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/FastScript/fs21.dpk b/FastScript/fs21.dpk
new file mode 100644
index 0000000..981aa84
--- /dev/null
+++ b/FastScript/fs21.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi XE7
+
+package fs21;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/FastScript/fs22.dpk b/FastScript/fs22.dpk
new file mode 100644
index 0000000..f9cdf0c
--- /dev/null
+++ b/FastScript/fs22.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi XE8
+
+package fs22;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/FastScript/fs23.dpk b/FastScript/fs23.dpk
new file mode 100644
index 0000000..d9e605d
--- /dev/null
+++ b/FastScript/fs23.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 10 Seattle
+
+package fs23;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/FastScript/fs24.dpk b/FastScript/fs24.dpk
new file mode 100644
index 0000000..cf0b018
--- /dev/null
+++ b/FastScript/fs24.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 10 Seattle
+
+package fs24;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/FastScript/fs25.dpk b/FastScript/fs25.dpk
new file mode 100644
index 0000000..9a4e65d
--- /dev/null
+++ b/FastScript/fs25.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 10 Seattle
+
+package fs25;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/FastScript/fs26.dpk b/FastScript/fs26.dpk
new file mode 100644
index 0000000..5f2b841
--- /dev/null
+++ b/FastScript/fs26.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 10 Seattle
+
+package fs26;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/FastScript/fs27.dpk b/FastScript/fs27.dpk
new file mode 100644
index 0000000..fdd63ad
--- /dev/null
+++ b/FastScript/fs27.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 10 Seattle
+
+package fs27;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/FastScript/fs28.dpk b/FastScript/fs28.dpk
new file mode 100644
index 0000000..81fb353
--- /dev/null
+++ b/FastScript/fs28.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 11 Seattle
+
+package fs28;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/FastScript/fs29.dpk b/FastScript/fs29.dpk
new file mode 100644
index 0000000..a18ff30
--- /dev/null
+++ b/FastScript/fs29.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 12
+
+package fs29;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/FastScript/fs4.bpk b/FastScript/fs4.bpk
new file mode 100644
index 0000000..2d1aa68
--- /dev/null
+++ b/FastScript/fs4.bpk
@@ -0,0 +1,187 @@
+# ---------------------------------------------------------------------------
+!if !$d(BCB)
+BCB = $(MAKEDIR)\..
+!endif
+
+# ---------------------------------------------------------------------------
+# IDE SECTION
+# ---------------------------------------------------------------------------
+# The following section of the project makefile is managed by the BCB IDE.
+# It is recommended to use the IDE to change any of the values in this
+# section.
+# ---------------------------------------------------------------------------
+
+VERSION = BCB.04.04
+# ---------------------------------------------------------------------------
+PROJECT = FS4.bpl
+OBJFILES = fs_iReg.obj FS4.obj fs_iconst.obj
+RESFILES = FS4.res fs_iReg.dcr
+RESDEPEN = $(RESFILES)
+LIBFILES =
+PACKAGES = vcl40.bpi vclx40.bpi
+DEFFILE =
+# ---------------------------------------------------------------------------
+PATHCPP = .;
+PATHASM = .;
+PATHPAS = .;
+PATHRC = .;
+DEBUGLIBPATH = $(BCB)\lib\debug
+RELEASELIBPATH = $(BCB)\lib\release
+USERDEFINES =
+SYSDEFINES = _RTLDLL;NO_STRICT;USEPACKAGES
+# ---------------------------------------------------------------------------
+CFLAG1 = -I$(BCB)\include;$(BCB)\include\vcl -O2 -Hc -H=$(BCB)\lib\vcl40.csm -w -Ve -a8 \
+ -k- -vi -c -b- -w-par -w-inl -Vx -tWM -D$(SYSDEFINES);$(USERDEFINES)
+PFLAGS = -U$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \
+ -I$(BCB)\include;$(BCB)\include\vcl -$Y- -$L- -$D- -v -JPHNE -M
+RFLAGS = -i$(BCB)\include;$(BCB)\include\vcl
+AFLAGS = /i$(BCB)\include /i$(BCB)\include\vcl /mx /w2 /zn
+LFLAGS = -L$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \
+ -D"FastScript 1.9 Components" -aa -Tpp -x -Gn -Gl -Gi
+# ---------------------------------------------------------------------------
+ALLOBJ = c0pkg32.obj Memmgr.Lib $(PACKAGES) sysinit.obj $(OBJFILES)
+ALLRES = $(RESFILES)
+ALLLIB = $(LIBFILES) $(LIBRARIES) import32.lib cp32mti.lib
+# ---------------------------------------------------------------------------
+!ifdef IDEOPTIONS
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=1
+Item0=$(BCB)\include;$(BCB)\include\vcl
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteDebug=0
+
+[Compiler]
+InMemoryExe=0
+ShowInfoMsgs=0
+
+!endif
+
+# ---------------------------------------------------------------------------
+# MAKE SECTION
+# ---------------------------------------------------------------------------
+# This section of the project file is not used by the BCB IDE. It is for
+# the benefit of building from the command-line using the MAKE utility.
+# ---------------------------------------------------------------------------
+
+.autodepend
+# ---------------------------------------------------------------------------
+!if !$d(BCC32)
+BCC32 = bcc32
+!endif
+
+!if !$d(CPP32)
+CPP32 = cpp32
+!endif
+
+!if !$d(DCC32)
+DCC32 = dcc32
+!endif
+
+!if !$d(TASM32)
+TASM32 = tasm32
+!endif
+
+!if !$d(LINKER)
+LINKER = ilink32
+!endif
+
+!if !$d(BRCC32)
+BRCC32 = brcc32
+!endif
+
+# ---------------------------------------------------------------------------
+!if $d(PATHCPP)
+.PATH.CPP = $(PATHCPP)
+.PATH.C = $(PATHCPP)
+!endif
+
+!if $d(PATHPAS)
+.PATH.PAS = $(PATHPAS)
+!endif
+
+!if $d(PATHASM)
+.PATH.ASM = $(PATHASM)
+!endif
+
+!if $d(PATHRC)
+.PATH.RC = $(PATHRC)
+!endif
+# ---------------------------------------------------------------------------
+$(PROJECT): $(OBJFILES) $(RESDEPEN) $(DEFFILE)
+ $(BCB)\BIN\$(LINKER) @&&!
+ $(LFLAGS) +
+ $(ALLOBJ), +
+ $(PROJECT),, +
+ $(ALLLIB), +
+ $(DEFFILE), +
+ $(ALLRES)
+!
+# ---------------------------------------------------------------------------
+.pas.hpp:
+ $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< }
+
+.pas.obj:
+ $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< }
+
+.cpp.obj:
+ $(BCB)\BIN\$(BCC32) $(CFLAG1) -n$(@D) {$< }
+
+.c.obj:
+ $(BCB)\BIN\$(BCC32) $(CFLAG1) -n$(@D) {$< }
+
+.c.i:
+ $(BCB)\BIN\$(CPP32) $(CFLAG1) -n. {$< }
+
+.cpp.i:
+ $(BCB)\BIN\$(CPP32) $(CFLAG1) -n. {$< }
+
+.asm.obj:
+ $(BCB)\BIN\$(TASM32) $(AFLAGS) $<, $@
+
+.rc.res:
+ $(BCB)\BIN\$(BRCC32) $(RFLAGS) -fo$@ $<
+# ---------------------------------------------------------------------------
diff --git a/FastScript/fs4.cpp b/FastScript/fs4.cpp
new file mode 100644
index 0000000..701945a
--- /dev/null
+++ b/FastScript/fs4.cpp
@@ -0,0 +1,19 @@
+//---------------------------------------------------------------------------
+#include
+#pragma hdrstop
+USERES("FS4.res");
+USEPACKAGE("vcl40.bpi");
+USEPACKAGE("vclx40.bpi");
+USEUNIT("fs_iReg.pas");
+USEUNIT("fs_iconst.pas");
+USERES("fs_iReg.dcr");
+//---------------------------------------------------------------------------
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+// Package source.
+//---------------------------------------------------------------------------
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
diff --git a/FastScript/fs4.dpk b/FastScript/fs4.dpk
new file mode 100644
index 0000000..2401b04
--- /dev/null
+++ b/FastScript/fs4.dpk
@@ -0,0 +1,65 @@
+// Package file for Delphi 4
+
+package fs4;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL40,
+ VCLX40;
+
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+
+end.
diff --git a/FastScript/fs4.res b/FastScript/fs4.res
new file mode 100644
index 0000000..eb2597a
Binary files /dev/null and b/FastScript/fs4.res differ
diff --git a/FastScript/fs5.bpk b/FastScript/fs5.bpk
new file mode 100644
index 0000000..7da84c2
--- /dev/null
+++ b/FastScript/fs5.bpk
@@ -0,0 +1,108 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=1
+Item0=$(BCB)\include;$(BCB)\include\vcl
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Language]
+ActiveLang=
+ProjectLang=
+RootDir=
+
+
\ No newline at end of file
diff --git a/FastScript/fs5.cpp b/FastScript/fs5.cpp
new file mode 100644
index 0000000..75223bc
--- /dev/null
+++ b/FastScript/fs5.cpp
@@ -0,0 +1,23 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+USERES("FS5.res");
+USEPACKAGE("vcl50.bpi");
+USEPACKAGE("vclx50.bpi");
+USEUNIT("fs_ireg.pas");
+USEUNIT("fs_iconst.pas");
+USERES("fs_iReg.dcr");
+//---------------------------------------------------------------------------
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
diff --git a/FastScript/fs5.dpk b/FastScript/fs5.dpk
new file mode 100644
index 0000000..1327eb4
--- /dev/null
+++ b/FastScript/fs5.dpk
@@ -0,0 +1,66 @@
+// Package file for Delphi 5
+
+package fs5;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+ VCLX50;
+
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+
+
+end.
diff --git a/FastScript/fs5.res b/FastScript/fs5.res
new file mode 100644
index 0000000..da3d366
Binary files /dev/null and b/FastScript/fs5.res differ
diff --git a/FastScript/fs6.bpk b/FastScript/fs6.bpk
new file mode 100644
index 0000000..a00493a
--- /dev/null
+++ b/FastScript/fs6.bpk
@@ -0,0 +1,122 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[Excluded Packages]
+d:\delphi\builder6\Projects\Bpl\FR6.bpl=FastReport 2.4 Components
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+Launcher=
+UseLauncher=0
+DebugCWD=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteLauncher=
+RemoteCWD=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+LinkCGLIB=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Linker]
+LibPrefix=
+LibSuffix=
+LibVersion=
+
+
\ No newline at end of file
diff --git a/FastScript/fs6.cpp b/FastScript/fs6.cpp
new file mode 100644
index 0000000..f8b9781
--- /dev/null
+++ b/FastScript/fs6.cpp
@@ -0,0 +1,17 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
+
\ No newline at end of file
diff --git a/FastScript/fs6.dpk b/FastScript/fs6.dpk
new file mode 100644
index 0000000..ffff854
--- /dev/null
+++ b/FastScript/fs6.dpk
@@ -0,0 +1,66 @@
+// Package file for Delphi 6
+
+package fs6;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+
+
+end.
diff --git a/FastScript/fs6.res b/FastScript/fs6.res
new file mode 100644
index 0000000..2bbdbc1
Binary files /dev/null and b/FastScript/fs6.res differ
diff --git a/FastScript/fs7.dpk b/FastScript/fs7.dpk
new file mode 100644
index 0000000..820a3c9
--- /dev/null
+++ b/FastScript/fs7.dpk
@@ -0,0 +1,66 @@
+// Package file for Delphi 7
+
+package fs7;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+
+
+end.
diff --git a/FastScript/fs9.dpk b/FastScript/fs9.dpk
new file mode 100644
index 0000000..0e46e9e
--- /dev/null
+++ b/FastScript/fs9.dpk
@@ -0,0 +1,66 @@
+// Package file for Delphi 2005
+
+package fs9;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+
+
+end.
diff --git a/FastScript/fsADO10.dpk b/FastScript/fsADO10.dpk
new file mode 100644
index 0000000..205b554
--- /dev/null
+++ b/FastScript/fsADO10.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2006
+
+package fsADO10;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs10,
+ fsDB10;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+
+end.
diff --git a/FastScript/fsADO11.dpk b/FastScript/fsADO11.dpk
new file mode 100644
index 0000000..314c61e
--- /dev/null
+++ b/FastScript/fsADO11.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2007
+
+package fsADO11;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs11,
+ fsDB11;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+
+end.
diff --git a/FastScript/fsADO12.dpk b/FastScript/fsADO12.dpk
new file mode 100644
index 0000000..8e3c8bb
--- /dev/null
+++ b/FastScript/fsADO12.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2009
+
+package fsADO12;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs12,
+ fsDB12;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+
+end.
diff --git a/FastScript/fsADO14.dpk b/FastScript/fsADO14.dpk
new file mode 100644
index 0000000..c35e8ad
--- /dev/null
+++ b/FastScript/fsADO14.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 2010
+
+package fsADO14;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs14,
+ fsDB14;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/FastScript/fsADO15.dpk b/FastScript/fsADO15.dpk
new file mode 100644
index 0000000..e05c8f4
--- /dev/null
+++ b/FastScript/fsADO15.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE
+
+package fsADO15;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs15,
+ fsDB15;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/FastScript/fsADO16.dpk b/FastScript/fsADO16.dpk
new file mode 100644
index 0000000..ca0eb87
--- /dev/null
+++ b/FastScript/fsADO16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package fsADO16;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs16,
+ fsDB16;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/FastScript/fsADO17.dpk b/FastScript/fsADO17.dpk
new file mode 100644
index 0000000..6a3d141
--- /dev/null
+++ b/FastScript/fsADO17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package fsADO17;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs17,
+ fsDB17;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/FastScript/fsADO18.dpk b/FastScript/fsADO18.dpk
new file mode 100644
index 0000000..c989d57
--- /dev/null
+++ b/FastScript/fsADO18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package fsADO18;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs18,
+ fsDB18;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/FastScript/fsADO19.dpk b/FastScript/fsADO19.dpk
new file mode 100644
index 0000000..5172497
--- /dev/null
+++ b/FastScript/fsADO19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package fsADO19;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs19,
+ fsDB19;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/FastScript/fsADO20.dpk b/FastScript/fsADO20.dpk
new file mode 100644
index 0000000..aeedd49
--- /dev/null
+++ b/FastScript/fsADO20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package fsADO20;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs20,
+ fsDB20;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/FastScript/fsADO21.dpk b/FastScript/fsADO21.dpk
new file mode 100644
index 0000000..7f60a5a
--- /dev/null
+++ b/FastScript/fsADO21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package fsADO21;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs21,
+ fsDB21;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/FastScript/fsADO22.dpk b/FastScript/fsADO22.dpk
new file mode 100644
index 0000000..f819723
--- /dev/null
+++ b/FastScript/fsADO22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package fsADO22;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs22,
+ fsDB22;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/FastScript/fsADO23.dpk b/FastScript/fsADO23.dpk
new file mode 100644
index 0000000..5236423
--- /dev/null
+++ b/FastScript/fsADO23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package fsADO23;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs23,
+ fsDB23;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/FastScript/fsADO24.dpk b/FastScript/fsADO24.dpk
new file mode 100644
index 0000000..b691767
--- /dev/null
+++ b/FastScript/fsADO24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package fsADO24;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs24,
+ fsDB24;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/FastScript/fsADO25.dpk b/FastScript/fsADO25.dpk
new file mode 100644
index 0000000..9debb8d
--- /dev/null
+++ b/FastScript/fsADO25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package fsADO25;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs25,
+ fsDB25;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/FastScript/fsADO26.dpk b/FastScript/fsADO26.dpk
new file mode 100644
index 0000000..8aedb6b
--- /dev/null
+++ b/FastScript/fsADO26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package fsADO26;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs26,
+ fsDB26;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/FastScript/fsADO27.dpk b/FastScript/fsADO27.dpk
new file mode 100644
index 0000000..4319bff
--- /dev/null
+++ b/FastScript/fsADO27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package fsADO27;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs27,
+ fsDB27;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/FastScript/fsADO28.dpk b/FastScript/fsADO28.dpk
new file mode 100644
index 0000000..f729e72
--- /dev/null
+++ b/FastScript/fsADO28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package fsADO28;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs28,
+ fsDB28;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/FastScript/fsADO29.dpk b/FastScript/fsADO29.dpk
new file mode 100644
index 0000000..f4728e1
--- /dev/null
+++ b/FastScript/fsADO29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package fsADO29;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs29,
+ fsDB29;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/FastScript/fsADO5.bpk b/FastScript/fsADO5.bpk
new file mode 100644
index 0000000..c4bdfc6
--- /dev/null
+++ b/FastScript/fsADO5.bpk
@@ -0,0 +1,108 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=1
+Item0=$(BCB)\include;$(BCB)\include\vcl
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Language]
+ActiveLang=
+ProjectLang=
+RootDir=
+
+
\ No newline at end of file
diff --git a/FastScript/fsADO5.cpp b/FastScript/fsADO5.cpp
new file mode 100644
index 0000000..a145759
--- /dev/null
+++ b/FastScript/fsADO5.cpp
@@ -0,0 +1,25 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+USERES("FS5.res");
+USEPACKAGE("vcl50.bpi");
+USEPACKAGE("vcldb50.bpi");
+USEPACKAGE("vclado50.bpi");
+USEPACKAGE("fs5.bpi");
+USEPACKAGE("fsDB5.bpi");
+USEUNIT("fs_iadoreg.pas");
+USERES("fs_iReg.dcr");
+//---------------------------------------------------------------------------
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
diff --git a/FastScript/fsADO5.dpk b/FastScript/fsADO5.dpk
new file mode 100644
index 0000000..d062b3f
--- /dev/null
+++ b/FastScript/fsADO5.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 5
+
+package fsADO5;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+ VCLDB50,
+ VCLADO50,
+ fs5,
+ fsDB5;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+
+end.
diff --git a/FastScript/fsADO6.bpk b/FastScript/fsADO6.bpk
new file mode 100644
index 0000000..a7591da
--- /dev/null
+++ b/FastScript/fsADO6.bpk
@@ -0,0 +1,124 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[Excluded Packages]
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+Launcher=
+UseLauncher=0
+DebugCWD=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteLauncher=
+RemoteCWD=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+LinkCGLIB=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Linker]
+LibPrefix=
+LibSuffix=
+LibVersion=
+
+
\ No newline at end of file
diff --git a/FastScript/fsADO6.cpp b/FastScript/fsADO6.cpp
new file mode 100644
index 0000000..f8b9781
--- /dev/null
+++ b/FastScript/fsADO6.cpp
@@ -0,0 +1,17 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
+
\ No newline at end of file
diff --git a/FastScript/fsADO6.dpk b/FastScript/fsADO6.dpk
new file mode 100644
index 0000000..c2e52fc
--- /dev/null
+++ b/FastScript/fsADO6.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 6
+
+package fsADO6;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs6,
+ fsDB6;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+
+end.
diff --git a/FastScript/fsADO7.dpk b/FastScript/fsADO7.dpk
new file mode 100644
index 0000000..245f0fd
--- /dev/null
+++ b/FastScript/fsADO7.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 7
+
+package fsADO7;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs7,
+ fsDB7;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+
+end.
diff --git a/FastScript/fsADO9.dpk b/FastScript/fsADO9.dpk
new file mode 100644
index 0000000..e87df33
--- /dev/null
+++ b/FastScript/fsADO9.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2005
+
+package fsADO9;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs9,
+ fsDB9;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE10.dpk b/FastScript/fsBDE10.dpk
new file mode 100644
index 0000000..bfff3e7
--- /dev/null
+++ b/FastScript/fsBDE10.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2006
+
+package fsBDE10;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs10,
+ fsDB10;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE11.dpk b/FastScript/fsBDE11.dpk
new file mode 100644
index 0000000..cc0072a
--- /dev/null
+++ b/FastScript/fsBDE11.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2007
+
+package fsBDE11;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs11,
+ fsDB11;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE12.dpk b/FastScript/fsBDE12.dpk
new file mode 100644
index 0000000..5442db2
--- /dev/null
+++ b/FastScript/fsBDE12.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2009
+
+package fsBDE12;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs12,
+ fsDB12;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE14.dpk b/FastScript/fsBDE14.dpk
new file mode 100644
index 0000000..07e09dd
--- /dev/null
+++ b/FastScript/fsBDE14.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2010
+
+package fsBDE14;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs14,
+ fsDB14;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE15.dpk b/FastScript/fsBDE15.dpk
new file mode 100644
index 0000000..87a27ad
--- /dev/null
+++ b/FastScript/fsBDE15.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE
+
+package fsBDE15;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs15,
+ fsDB15;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE16.dpk b/FastScript/fsBDE16.dpk
new file mode 100644
index 0000000..374d6ba
--- /dev/null
+++ b/FastScript/fsBDE16.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE2
+
+package fsBDE16;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs16,
+ fsDB16;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE17.dpk b/FastScript/fsBDE17.dpk
new file mode 100644
index 0000000..3432481
--- /dev/null
+++ b/FastScript/fsBDE17.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE3
+
+package fsBDE17;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs17,
+ fsDB17;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE18.dpk b/FastScript/fsBDE18.dpk
new file mode 100644
index 0000000..52d5497
--- /dev/null
+++ b/FastScript/fsBDE18.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE4
+
+package fsBDE18;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs18,
+ fsDB18;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE19.dpk b/FastScript/fsBDE19.dpk
new file mode 100644
index 0000000..32f5d27
--- /dev/null
+++ b/FastScript/fsBDE19.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE5
+
+package fsBDE19;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs19,
+ fsDB19;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE20.dpk b/FastScript/fsBDE20.dpk
new file mode 100644
index 0000000..71bff3b
--- /dev/null
+++ b/FastScript/fsBDE20.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE6
+
+package fsBDE20;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs20,
+ fsDB20;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE21.dpk b/FastScript/fsBDE21.dpk
new file mode 100644
index 0000000..0c9f49d
--- /dev/null
+++ b/FastScript/fsBDE21.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE7
+
+package fsBDE21;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs21,
+ fsDB21;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE22.dpk b/FastScript/fsBDE22.dpk
new file mode 100644
index 0000000..f8b934c
--- /dev/null
+++ b/FastScript/fsBDE22.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE8
+
+package fsBDE22;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs22,
+ fsDB22;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE23.dpk b/FastScript/fsBDE23.dpk
new file mode 100644
index 0000000..ff73cf9
--- /dev/null
+++ b/FastScript/fsBDE23.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 10 Seattle
+
+package fsBDE23;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs23,
+ fsDB23;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE24.dpk b/FastScript/fsBDE24.dpk
new file mode 100644
index 0000000..54c218f
--- /dev/null
+++ b/FastScript/fsBDE24.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 10 Seattle
+
+package fsBDE24;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs24,
+ fsDB24;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE25.dpk b/FastScript/fsBDE25.dpk
new file mode 100644
index 0000000..de71408
--- /dev/null
+++ b/FastScript/fsBDE25.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 10 Seattle
+
+package fsBDE25;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs25,
+ fsDB25;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE26.dpk b/FastScript/fsBDE26.dpk
new file mode 100644
index 0000000..23acd7f
--- /dev/null
+++ b/FastScript/fsBDE26.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 10 Seattle
+
+package fsBDE26;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs26,
+ fsDB26;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE27.dpk b/FastScript/fsBDE27.dpk
new file mode 100644
index 0000000..783046d
--- /dev/null
+++ b/FastScript/fsBDE27.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 10 Seattle
+
+package fsBDE27;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs27,
+ fsDB27;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE28.dpk b/FastScript/fsBDE28.dpk
new file mode 100644
index 0000000..1f419d4
--- /dev/null
+++ b/FastScript/fsBDE28.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 11 Seattle
+
+package fsBDE28;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs28,
+ fsDB28;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE29.dpk b/FastScript/fsBDE29.dpk
new file mode 100644
index 0000000..d833080
--- /dev/null
+++ b/FastScript/fsBDE29.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 12
+
+package fsBDE29;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs29,
+ fsDB29;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE4.bpk b/FastScript/fsBDE4.bpk
new file mode 100644
index 0000000..961c052
--- /dev/null
+++ b/FastScript/fsBDE4.bpk
@@ -0,0 +1,187 @@
+# ---------------------------------------------------------------------------
+!if !$d(BCB)
+BCB = $(MAKEDIR)\..
+!endif
+
+# ---------------------------------------------------------------------------
+# IDE SECTION
+# ---------------------------------------------------------------------------
+# The following section of the project makefile is managed by the BCB IDE.
+# It is recommended to use the IDE to change any of the values in this
+# section.
+# ---------------------------------------------------------------------------
+
+VERSION = BCB.04.04
+# ---------------------------------------------------------------------------
+PROJECT = FSBDE4.bpl
+OBJFILES = fs_iReg.obj FSBDE4.obj
+RESFILES = FS4.res fs_iReg.dcr
+RESDEPEN = $(RESFILES)
+LIBFILES =
+PACKAGES = vcl40.bpi vcldb40.bpi fs4.bpi fsDB4.bpi
+DEFFILE =
+# ---------------------------------------------------------------------------
+PATHCPP = .;
+PATHASM = .;
+PATHPAS = .;
+PATHRC = .;
+DEBUGLIBPATH = $(BCB)\lib\debug
+RELEASELIBPATH = $(BCB)\lib\release
+USERDEFINES =
+SYSDEFINES = _RTLDLL;NO_STRICT;USEPACKAGES
+# ---------------------------------------------------------------------------
+CFLAG1 = -I$(BCB)\include;$(BCB)\include\vcl -O2 -Hc -H=$(BCB)\lib\vcl40.csm -w -Ve -a8 \
+ -k- -vi -c -b- -w-par -w-inl -Vx -tWM -D$(SYSDEFINES);$(USERDEFINES)
+PFLAGS = -U$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \
+ -I$(BCB)\include;$(BCB)\include\vcl -$Y- -$L- -$D- -v -JPHNE -M
+RFLAGS = -i$(BCB)\include;$(BCB)\include\vcl
+AFLAGS = /i$(BCB)\include /i$(BCB)\include\vcl /mx /w2 /zn
+LFLAGS = -L$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \
+ -D"FastScript 1.9 BDE Components" -aa -Tpp -x -Gn -Gl -Gi
+# ---------------------------------------------------------------------------
+ALLOBJ = c0pkg32.obj Memmgr.Lib $(PACKAGES) sysinit.obj $(OBJFILES)
+ALLRES = $(RESFILES)
+ALLLIB = $(LIBFILES) $(LIBRARIES) import32.lib cp32mti.lib
+# ---------------------------------------------------------------------------
+!ifdef IDEOPTIONS
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=1
+Item0=$(BCB)\include;$(BCB)\include\vcl
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteDebug=0
+
+[Compiler]
+InMemoryExe=0
+ShowInfoMsgs=0
+
+!endif
+
+# ---------------------------------------------------------------------------
+# MAKE SECTION
+# ---------------------------------------------------------------------------
+# This section of the project file is not used by the BCB IDE. It is for
+# the benefit of building from the command-line using the MAKE utility.
+# ---------------------------------------------------------------------------
+
+.autodepend
+# ---------------------------------------------------------------------------
+!if !$d(BCC32)
+BCC32 = bcc32
+!endif
+
+!if !$d(CPP32)
+CPP32 = cpp32
+!endif
+
+!if !$d(DCC32)
+DCC32 = dcc32
+!endif
+
+!if !$d(TASM32)
+TASM32 = tasm32
+!endif
+
+!if !$d(LINKER)
+LINKER = ilink32
+!endif
+
+!if !$d(BRCC32)
+BRCC32 = brcc32
+!endif
+
+# ---------------------------------------------------------------------------
+!if $d(PATHCPP)
+.PATH.CPP = $(PATHCPP)
+.PATH.C = $(PATHCPP)
+!endif
+
+!if $d(PATHPAS)
+.PATH.PAS = $(PATHPAS)
+!endif
+
+!if $d(PATHASM)
+.PATH.ASM = $(PATHASM)
+!endif
+
+!if $d(PATHRC)
+.PATH.RC = $(PATHRC)
+!endif
+# ---------------------------------------------------------------------------
+$(PROJECT): $(OBJFILES) $(RESDEPEN) $(DEFFILE)
+ $(BCB)\BIN\$(LINKER) @&&!
+ $(LFLAGS) +
+ $(ALLOBJ), +
+ $(PROJECT),, +
+ $(ALLLIB), +
+ $(DEFFILE), +
+ $(ALLRES)
+!
+# ---------------------------------------------------------------------------
+.pas.hpp:
+ $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< }
+
+.pas.obj:
+ $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< }
+
+.cpp.obj:
+ $(BCB)\BIN\$(BCC32) $(CFLAG1) -n$(@D) {$< }
+
+.c.obj:
+ $(BCB)\BIN\$(BCC32) $(CFLAG1) -n$(@D) {$< }
+
+.c.i:
+ $(BCB)\BIN\$(CPP32) $(CFLAG1) -n. {$< }
+
+.cpp.i:
+ $(BCB)\BIN\$(CPP32) $(CFLAG1) -n. {$< }
+
+.asm.obj:
+ $(BCB)\BIN\$(TASM32) $(AFLAGS) $<, $@
+
+.rc.res:
+ $(BCB)\BIN\$(BRCC32) $(RFLAGS) -fo$@ $<
+# ---------------------------------------------------------------------------
diff --git a/FastScript/fsBDE4.cpp b/FastScript/fsBDE4.cpp
new file mode 100644
index 0000000..998594d
--- /dev/null
+++ b/FastScript/fsBDE4.cpp
@@ -0,0 +1,20 @@
+//---------------------------------------------------------------------------
+#include
+#pragma hdrstop
+USERES("FS4.res");
+USEPACKAGE("vcl40.bpi");
+USEPACKAGE("vcldb40.bpi");
+USEPACKAGE("fs4.bpi");
+USEPACKAGE("fsDB4.bpi");
+USEUNIT("fs_ibdereg.pas");
+USERES("fs_ireg.dcr");
+//---------------------------------------------------------------------------
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+// Package source.
+//---------------------------------------------------------------------------
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
diff --git a/FastScript/fsBDE4.dpk b/FastScript/fsBDE4.dpk
new file mode 100644
index 0000000..0d99e8f
--- /dev/null
+++ b/FastScript/fsBDE4.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 4
+
+package fsBDE4;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL40,
+ VCLDB40,
+ fs4,
+ fsDB4;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE5.bpk b/FastScript/fsBDE5.bpk
new file mode 100644
index 0000000..e982132
--- /dev/null
+++ b/FastScript/fsBDE5.bpk
@@ -0,0 +1,108 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=1
+Item0=$(BCB)\include;$(BCB)\include\vcl
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Language]
+ActiveLang=
+ProjectLang=
+RootDir=
+
+
\ No newline at end of file
diff --git a/FastScript/fsBDE5.cpp b/FastScript/fsBDE5.cpp
new file mode 100644
index 0000000..367c0d7
--- /dev/null
+++ b/FastScript/fsBDE5.cpp
@@ -0,0 +1,25 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+USERES("FS5.res");
+USEPACKAGE("vcl50.bpi");
+USEPACKAGE("vcldb50.bpi");
+USEPACKAGE("vclbde50.bpi");
+USEPACKAGE("fs5.bpi");
+USEPACKAGE("fsDB5.bpi");
+USEUNIT("fs_ibdereg.pas");
+USERES("fs_iReg.dcr");
+//---------------------------------------------------------------------------
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
diff --git a/FastScript/fsBDE5.dpk b/FastScript/fsBDE5.dpk
new file mode 100644
index 0000000..5d96d46
--- /dev/null
+++ b/FastScript/fsBDE5.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 5
+
+package fsBDE5;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+ VCLDB50,
+ VCLBDE50,
+ fs5,
+ fsDB5;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE6.bpk b/FastScript/fsBDE6.bpk
new file mode 100644
index 0000000..1455767
--- /dev/null
+++ b/FastScript/fsBDE6.bpk
@@ -0,0 +1,125 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[Excluded Packages]
+d:\delphi\builder6\Projects\Bpl\FR6.bpl=FastReport 2.4 Components
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+Launcher=
+UseLauncher=0
+DebugCWD=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteLauncher=
+RemoteCWD=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+LinkCGLIB=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Linker]
+LibPrefix=
+LibSuffix=
+LibVersion=
+
+
\ No newline at end of file
diff --git a/FastScript/fsBDE6.cpp b/FastScript/fsBDE6.cpp
new file mode 100644
index 0000000..f8b9781
--- /dev/null
+++ b/FastScript/fsBDE6.cpp
@@ -0,0 +1,17 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
+
\ No newline at end of file
diff --git a/FastScript/fsBDE6.dpk b/FastScript/fsBDE6.dpk
new file mode 100644
index 0000000..fa41b8a
--- /dev/null
+++ b/FastScript/fsBDE6.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 6
+
+package fsBDE6;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs6,
+ fsDB6;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE7.dpk b/FastScript/fsBDE7.dpk
new file mode 100644
index 0000000..8c5a9d6
--- /dev/null
+++ b/FastScript/fsBDE7.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 7
+
+package fsBDE7;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs7,
+ fsDB7;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsBDE9.dpk b/FastScript/fsBDE9.dpk
new file mode 100644
index 0000000..48a58bc
--- /dev/null
+++ b/FastScript/fsBDE9.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2005
+
+package fsBDE9;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs9,
+ fsDB9;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/FastScript/fsDB10.dpk b/FastScript/fsDB10.dpk
new file mode 100644
index 0000000..166eb1e
--- /dev/null
+++ b/FastScript/fsDB10.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2006
+
+package fsDB10;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs10;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+
+end.
diff --git a/FastScript/fsDB11.dpk b/FastScript/fsDB11.dpk
new file mode 100644
index 0000000..3997457
--- /dev/null
+++ b/FastScript/fsDB11.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2007
+
+package fsDB11;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs11;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+
+end.
diff --git a/FastScript/fsDB12.dpk b/FastScript/fsDB12.dpk
new file mode 100644
index 0000000..c6bd2b2
--- /dev/null
+++ b/FastScript/fsDB12.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2009
+
+package fsDB12;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs12;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+
+end.
diff --git a/FastScript/fsDB14.dpk b/FastScript/fsDB14.dpk
new file mode 100644
index 0000000..fb31b43
--- /dev/null
+++ b/FastScript/fsDB14.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 2010
+
+package fsDB14;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs14;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/fsDB15.dpk b/FastScript/fsDB15.dpk
new file mode 100644
index 0000000..1093567
--- /dev/null
+++ b/FastScript/fsDB15.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE
+
+package fsDB15;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs15;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/fsDB16.dpk b/FastScript/fsDB16.dpk
new file mode 100644
index 0000000..43eb58b
--- /dev/null
+++ b/FastScript/fsDB16.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE2
+
+package fsDB16;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs16;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/fsDB17.dpk b/FastScript/fsDB17.dpk
new file mode 100644
index 0000000..3b749a9
--- /dev/null
+++ b/FastScript/fsDB17.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE3
+
+package fsDB17;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs17;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/fsDB18.dpk b/FastScript/fsDB18.dpk
new file mode 100644
index 0000000..ef1ea16
--- /dev/null
+++ b/FastScript/fsDB18.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE4
+
+package fsDB18;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs18;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/fsDB19.dpk b/FastScript/fsDB19.dpk
new file mode 100644
index 0000000..8b64749
--- /dev/null
+++ b/FastScript/fsDB19.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE5
+
+package fsDB19;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs19;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/fsDB20.dpk b/FastScript/fsDB20.dpk
new file mode 100644
index 0000000..6b1ecd6
--- /dev/null
+++ b/FastScript/fsDB20.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE6
+
+package fsDB20;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs20;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/fsDB21.dpk b/FastScript/fsDB21.dpk
new file mode 100644
index 0000000..75c41a9
--- /dev/null
+++ b/FastScript/fsDB21.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE7
+
+package fsDB21;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs21;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/fsDB22.dpk b/FastScript/fsDB22.dpk
new file mode 100644
index 0000000..a59385b
--- /dev/null
+++ b/FastScript/fsDB22.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE8
+
+package fsDB22;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs22;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/fsDB23.dpk b/FastScript/fsDB23.dpk
new file mode 100644
index 0000000..4c6e4a4
--- /dev/null
+++ b/FastScript/fsDB23.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package fsDB23;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs23;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/fsDB24.dpk b/FastScript/fsDB24.dpk
new file mode 100644
index 0000000..cc8c55f
--- /dev/null
+++ b/FastScript/fsDB24.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package fsDB24;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs24;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/fsDB25.dpk b/FastScript/fsDB25.dpk
new file mode 100644
index 0000000..dff4be5
--- /dev/null
+++ b/FastScript/fsDB25.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package fsDB25;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs25;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/fsDB26.dpk b/FastScript/fsDB26.dpk
new file mode 100644
index 0000000..b2c005f
--- /dev/null
+++ b/FastScript/fsDB26.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package fsDB26;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs26;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/fsDB27.dpk b/FastScript/fsDB27.dpk
new file mode 100644
index 0000000..0655b35
--- /dev/null
+++ b/FastScript/fsDB27.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package fsDB27;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs27;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/fsDB28.dpk b/FastScript/fsDB28.dpk
new file mode 100644
index 0000000..f3fd31a
--- /dev/null
+++ b/FastScript/fsDB28.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 11 Seattle
+
+package fsDB28;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs28;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/FastScript/fsDB4.bpk b/FastScript/fsDB4.bpk
new file mode 100644
index 0000000..9a07332
--- /dev/null
+++ b/FastScript/fsDB4.bpk
@@ -0,0 +1,187 @@
+# ---------------------------------------------------------------------------
+!if !$d(BCB)
+BCB = $(MAKEDIR)\..
+!endif
+
+# ---------------------------------------------------------------------------
+# IDE SECTION
+# ---------------------------------------------------------------------------
+# The following section of the project makefile is managed by the BCB IDE.
+# It is recommended to use the IDE to change any of the values in this
+# section.
+# ---------------------------------------------------------------------------
+
+VERSION = BCB.04.04
+# ---------------------------------------------------------------------------
+PROJECT = FSDB4.bpl
+OBJFILES = fs_iReg.obj FSDB4.obj
+RESFILES = FS4.res fs_iReg.dcr
+RESDEPEN = $(RESFILES)
+LIBFILES =
+PACKAGES = vcl40.bpi vcldb40.bpi fs4.bpi
+DEFFILE =
+# ---------------------------------------------------------------------------
+PATHCPP = .;
+PATHASM = .;
+PATHPAS = .;
+PATHRC = .;
+DEBUGLIBPATH = $(BCB)\lib\debug
+RELEASELIBPATH = $(BCB)\lib\release
+USERDEFINES =
+SYSDEFINES = _RTLDLL;NO_STRICT;USEPACKAGES
+# ---------------------------------------------------------------------------
+CFLAG1 = -I$(BCB)\include;$(BCB)\include\vcl -O2 -Hc -H=$(BCB)\lib\vcl40.csm -w -Ve -a8 \
+ -k- -vi -c -b- -w-par -w-inl -Vx -tWM -D$(SYSDEFINES);$(USERDEFINES)
+PFLAGS = -U$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \
+ -I$(BCB)\include;$(BCB)\include\vcl -$Y- -$L- -$D- -v -JPHNE -M
+RFLAGS = -i$(BCB)\include;$(BCB)\include\vcl
+AFLAGS = /i$(BCB)\include /i$(BCB)\include\vcl /mx /w2 /zn
+LFLAGS = -L$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \
+ -D"FastScript 1.9 DB Components" -aa -Tpp -x -Gn -Gl -Gi
+# ---------------------------------------------------------------------------
+ALLOBJ = c0pkg32.obj Memmgr.Lib $(PACKAGES) sysinit.obj $(OBJFILES)
+ALLRES = $(RESFILES)
+ALLLIB = $(LIBFILES) $(LIBRARIES) import32.lib cp32mti.lib
+# ---------------------------------------------------------------------------
+!ifdef IDEOPTIONS
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=1
+Item0=$(BCB)\include;$(BCB)\include\vcl
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteDebug=0
+
+[Compiler]
+InMemoryExe=0
+ShowInfoMsgs=0
+
+!endif
+
+# ---------------------------------------------------------------------------
+# MAKE SECTION
+# ---------------------------------------------------------------------------
+# This section of the project file is not used by the BCB IDE. It is for
+# the benefit of building from the command-line using the MAKE utility.
+# ---------------------------------------------------------------------------
+
+.autodepend
+# ---------------------------------------------------------------------------
+!if !$d(BCC32)
+BCC32 = bcc32
+!endif
+
+!if !$d(CPP32)
+CPP32 = cpp32
+!endif
+
+!if !$d(DCC32)
+DCC32 = dcc32
+!endif
+
+!if !$d(TASM32)
+TASM32 = tasm32
+!endif
+
+!if !$d(LINKER)
+LINKER = ilink32
+!endif
+
+!if !$d(BRCC32)
+BRCC32 = brcc32
+!endif
+
+# ---------------------------------------------------------------------------
+!if $d(PATHCPP)
+.PATH.CPP = $(PATHCPP)
+.PATH.C = $(PATHCPP)
+!endif
+
+!if $d(PATHPAS)
+.PATH.PAS = $(PATHPAS)
+!endif
+
+!if $d(PATHASM)
+.PATH.ASM = $(PATHASM)
+!endif
+
+!if $d(PATHRC)
+.PATH.RC = $(PATHRC)
+!endif
+# ---------------------------------------------------------------------------
+$(PROJECT): $(OBJFILES) $(RESDEPEN) $(DEFFILE)
+ $(BCB)\BIN\$(LINKER) @&&!
+ $(LFLAGS) +
+ $(ALLOBJ), +
+ $(PROJECT),, +
+ $(ALLLIB), +
+ $(DEFFILE), +
+ $(ALLRES)
+!
+# ---------------------------------------------------------------------------
+.pas.hpp:
+ $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< }
+
+.pas.obj:
+ $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< }
+
+.cpp.obj:
+ $(BCB)\BIN\$(BCC32) $(CFLAG1) -n$(@D) {$< }
+
+.c.obj:
+ $(BCB)\BIN\$(BCC32) $(CFLAG1) -n$(@D) {$< }
+
+.c.i:
+ $(BCB)\BIN\$(CPP32) $(CFLAG1) -n. {$< }
+
+.cpp.i:
+ $(BCB)\BIN\$(CPP32) $(CFLAG1) -n. {$< }
+
+.asm.obj:
+ $(BCB)\BIN\$(TASM32) $(AFLAGS) $<, $@
+
+.rc.res:
+ $(BCB)\BIN\$(BRCC32) $(RFLAGS) -fo$@ $<
+# ---------------------------------------------------------------------------
diff --git a/FastScript/fsDB4.cpp b/FastScript/fsDB4.cpp
new file mode 100644
index 0000000..e80af50
--- /dev/null
+++ b/FastScript/fsDB4.cpp
@@ -0,0 +1,19 @@
+//---------------------------------------------------------------------------
+#include
+#pragma hdrstop
+USERES("FS4.res");
+USEPACKAGE("vcl40.bpi");
+USEPACKAGE("vcldb40.bpi");
+USEPACKAGE("fs4.bpi");
+USEUNIT("fs_idbreg.pas");
+USERES("fs_ireg.dcr");
+//---------------------------------------------------------------------------
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+// Package source.
+//---------------------------------------------------------------------------
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
diff --git a/FastScript/fsDB4.dpk b/FastScript/fsDB4.dpk
new file mode 100644
index 0000000..3429456
--- /dev/null
+++ b/FastScript/fsDB4.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 4
+
+package fsDB4;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL40,
+ VCLDB40,
+ fs4;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+
+end.
diff --git a/FastScript/fsDB5.bpk b/FastScript/fsDB5.bpk
new file mode 100644
index 0000000..4b727e2
--- /dev/null
+++ b/FastScript/fsDB5.bpk
@@ -0,0 +1,108 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=1
+Item0=$(BCB)\include;$(BCB)\include\vcl
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Language]
+ActiveLang=
+ProjectLang=
+RootDir=
+
+
\ No newline at end of file
diff --git a/FastScript/fsDB5.cpp b/FastScript/fsDB5.cpp
new file mode 100644
index 0000000..a00f350
--- /dev/null
+++ b/FastScript/fsDB5.cpp
@@ -0,0 +1,23 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+USERES("FS5.res");
+USEPACKAGE("vcl50.bpi");
+USEPACKAGE("vcldb50.bpi");
+USEPACKAGE("fs5.bpi");
+USEUNIT("fs_idbreg.pas");
+USERES("fs_iReg.dcr");
+//---------------------------------------------------------------------------
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
diff --git a/FastScript/fsDB5.dpk b/FastScript/fsDB5.dpk
new file mode 100644
index 0000000..670ca1c
--- /dev/null
+++ b/FastScript/fsDB5.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 5
+
+package fsDB5;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+ VCLDB50,
+ fs5;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+
+end.
diff --git a/FastScript/fsDB6.bpk b/FastScript/fsDB6.bpk
new file mode 100644
index 0000000..a57859c
--- /dev/null
+++ b/FastScript/fsDB6.bpk
@@ -0,0 +1,123 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[Excluded Packages]
+d:\delphi\builder6\Projects\Bpl\FR6.bpl=FastReport 2.4 Components
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+Launcher=
+UseLauncher=0
+DebugCWD=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteLauncher=
+RemoteCWD=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+LinkCGLIB=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Linker]
+LibPrefix=
+LibSuffix=
+LibVersion=
+
+
\ No newline at end of file
diff --git a/FastScript/fsDB6.cpp b/FastScript/fsDB6.cpp
new file mode 100644
index 0000000..f8b9781
--- /dev/null
+++ b/FastScript/fsDB6.cpp
@@ -0,0 +1,17 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
+
\ No newline at end of file
diff --git a/FastScript/fsDB6.dpk b/FastScript/fsDB6.dpk
new file mode 100644
index 0000000..c72c556
--- /dev/null
+++ b/FastScript/fsDB6.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 6
+
+package fsDB6;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs6;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+
+end.
diff --git a/FastScript/fsDB7.dpk b/FastScript/fsDB7.dpk
new file mode 100644
index 0000000..045479e
--- /dev/null
+++ b/FastScript/fsDB7.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 7
+
+package fsDB7;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs7;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+
+end.
diff --git a/FastScript/fsDB9.dpk b/FastScript/fsDB9.dpk
new file mode 100644
index 0000000..456067d
--- /dev/null
+++ b/FastScript/fsDB9.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2005
+
+package fsDB9;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs9;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+
+end.
diff --git a/FastScript/fsFD15.dpk b/FastScript/fsFD15.dpk
new file mode 100644
index 0000000..a02903c
--- /dev/null
+++ b/FastScript/fsFD15.dpk
@@ -0,0 +1,44 @@
+// Package file for Delphi XE
+
+package fsFD15;
+
+{$R *.res}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+{$DEFINE BUNDLE}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs15,
+ fsDB15,
+ AnyDAC_Comp_D15,
+ AnyDAC_Phys_D15,
+ AnyDAC_ComI_D15;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/FastScript/fsFD16.dpk b/FastScript/fsFD16.dpk
new file mode 100644
index 0000000..6486155
--- /dev/null
+++ b/FastScript/fsFD16.dpk
@@ -0,0 +1,44 @@
+// Package file for Delphi XE2
+
+package fsFD16;
+
+{$R *.res}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+{$DEFINE BUNDLE}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs16,
+ fsDB16,
+ AnyDAC_Comp_D16,
+ AnyDAC_Phys_D16,
+ AnyDAC_ComI_D16;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/FastScript/fsFD17.dpk b/FastScript/fsFD17.dpk
new file mode 100644
index 0000000..fe2986f
--- /dev/null
+++ b/FastScript/fsFD17.dpk
@@ -0,0 +1,44 @@
+// Package file for Delphi XE3
+
+package fsFD17;
+
+{$R *.res}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+{$DEFINE BUNDLE}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs17,
+ fsDB17,
+ AnyDAC_Comp_D17,
+ AnyDAC_Phys_D17,
+ AnyDAC_ComI_D17;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/FastScript/fsFD18.dpk b/FastScript/fsFD18.dpk
new file mode 100644
index 0000000..00d2d38
--- /dev/null
+++ b/FastScript/fsFD18.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE4
+
+package fsFD18;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs18,
+ fsDB18,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/FastScript/fsFD19.dpk b/FastScript/fsFD19.dpk
new file mode 100644
index 0000000..fe9ec71
--- /dev/null
+++ b/FastScript/fsFD19.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE5
+
+package fsFD19;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs19,
+ fsDB19,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/FastScript/fsFD20.dpk b/FastScript/fsFD20.dpk
new file mode 100644
index 0000000..05ed63c
--- /dev/null
+++ b/FastScript/fsFD20.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE6
+
+package fsFD20;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs20,
+ fsDB20,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/FastScript/fsFD21.dpk b/FastScript/fsFD21.dpk
new file mode 100644
index 0000000..141e7bb
--- /dev/null
+++ b/FastScript/fsFD21.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE7
+
+package fsFD21;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs21,
+ fsDB21,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/FastScript/fsFD22.dpk b/FastScript/fsFD22.dpk
new file mode 100644
index 0000000..b10712c
--- /dev/null
+++ b/FastScript/fsFD22.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE8
+
+package fsFD22;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs22,
+ fsDB22,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/FastScript/fsFD23.dpk b/FastScript/fsFD23.dpk
new file mode 100644
index 0000000..b477cff
--- /dev/null
+++ b/FastScript/fsFD23.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10 Seattle
+
+package fsFD23;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs23,
+ fsDB23,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/FastScript/fsFD24.dpk b/FastScript/fsFD24.dpk
new file mode 100644
index 0000000..a9907c2
--- /dev/null
+++ b/FastScript/fsFD24.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10.1 Berlin
+
+package fsFD24;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs24,
+ fsDB24,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/FastScript/fsFD25.dpk b/FastScript/fsFD25.dpk
new file mode 100644
index 0000000..fc0c319
--- /dev/null
+++ b/FastScript/fsFD25.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10.2 Tokyo
+
+package fsFD25;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs25,
+ fsDB25,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/FastScript/fsFD26.dpk b/FastScript/fsFD26.dpk
new file mode 100644
index 0000000..5761aba
--- /dev/null
+++ b/FastScript/fsFD26.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10.3 Rio
+
+package fsFD26;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs26,
+ fsDB26,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/FastScript/fsFD27.dpk b/FastScript/fsFD27.dpk
new file mode 100644
index 0000000..0655a21
--- /dev/null
+++ b/FastScript/fsFD27.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10.3 Rio
+
+package fsFD27;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs27,
+ fsDB27,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/FastScript/fsFD28.dpk b/FastScript/fsFD28.dpk
new file mode 100644
index 0000000..5eedc20
--- /dev/null
+++ b/FastScript/fsFD28.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 11.3 Rio
+
+package fsFD28;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs28,
+ fsDB28,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/FastScript/fsFD29.dpk b/FastScript/fsFD29.dpk
new file mode 100644
index 0000000..e23ae6c
--- /dev/null
+++ b/FastScript/fsFD29.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 12
+
+package fsFD29;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs29,
+ fsDB29,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/FastScript/fsIBX10.dpk b/FastScript/fsIBX10.dpk
new file mode 100644
index 0000000..65e4900
--- /dev/null
+++ b/FastScript/fsIBX10.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2006
+
+package fsIBX10;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs10,
+ fsDB10;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+
+end.
diff --git a/FastScript/fsIBX11.dpk b/FastScript/fsIBX11.dpk
new file mode 100644
index 0000000..c23cc5c
--- /dev/null
+++ b/FastScript/fsIBX11.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2007
+
+package fsIBX11;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs11,
+ fsDB11;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+
+end.
diff --git a/FastScript/fsIBX12.dpk b/FastScript/fsIBX12.dpk
new file mode 100644
index 0000000..a1d73e4
--- /dev/null
+++ b/FastScript/fsIBX12.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2009
+
+package fsIBX12;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs12,
+ fsDB12;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+
+end.
diff --git a/FastScript/fsIBX14.dpk b/FastScript/fsIBX14.dpk
new file mode 100644
index 0000000..50c3880
--- /dev/null
+++ b/FastScript/fsIBX14.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 2010
+
+package fsIBX14;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs14,
+ fsDB14;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/fsIBX15.dpk b/FastScript/fsIBX15.dpk
new file mode 100644
index 0000000..5466dd8
--- /dev/null
+++ b/FastScript/fsIBX15.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE
+
+package fsIBX15;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs15,
+ fsDB15;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/fsIBX16.dpk b/FastScript/fsIBX16.dpk
new file mode 100644
index 0000000..03bd29b
--- /dev/null
+++ b/FastScript/fsIBX16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package fsIBX16;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs16,
+ fsDB16;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/fsIBX17.dpk b/FastScript/fsIBX17.dpk
new file mode 100644
index 0000000..d65c55e
--- /dev/null
+++ b/FastScript/fsIBX17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package fsIBX17;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs17,
+ fsDB17;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/fsIBX18.dpk b/FastScript/fsIBX18.dpk
new file mode 100644
index 0000000..b75af54
--- /dev/null
+++ b/FastScript/fsIBX18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package fsIBX18;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs18,
+ fsDB18;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/fsIBX19.dpk b/FastScript/fsIBX19.dpk
new file mode 100644
index 0000000..053329e
--- /dev/null
+++ b/FastScript/fsIBX19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package fsIBX19;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs19,
+ fsDB19;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/fsIBX20.dpk b/FastScript/fsIBX20.dpk
new file mode 100644
index 0000000..8be4ffa
--- /dev/null
+++ b/FastScript/fsIBX20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package fsIBX20;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs20,
+ fsDB20;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/fsIBX21.dpk b/FastScript/fsIBX21.dpk
new file mode 100644
index 0000000..dd03f8f
--- /dev/null
+++ b/FastScript/fsIBX21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package fsIBX21;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs21,
+ fsDB21;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/fsIBX22.dpk b/FastScript/fsIBX22.dpk
new file mode 100644
index 0000000..3abd997
--- /dev/null
+++ b/FastScript/fsIBX22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package fsIBX22;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs22,
+ fsDB22;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/fsIBX23.dpk b/FastScript/fsIBX23.dpk
new file mode 100644
index 0000000..7c867a4
--- /dev/null
+++ b/FastScript/fsIBX23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package fsIBX23;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs23,
+ fsDB23;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/fsIBX24.dpk b/FastScript/fsIBX24.dpk
new file mode 100644
index 0000000..291f0f4
--- /dev/null
+++ b/FastScript/fsIBX24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package fsIBX24;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs24,
+ fsDB24;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/fsIBX25.dpk b/FastScript/fsIBX25.dpk
new file mode 100644
index 0000000..a3c63db
--- /dev/null
+++ b/FastScript/fsIBX25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package fsIBX25;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs25,
+ fsDB25;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/fsIBX26.dpk b/FastScript/fsIBX26.dpk
new file mode 100644
index 0000000..cb6b628
--- /dev/null
+++ b/FastScript/fsIBX26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package fsIBX26;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs26,
+ fsDB26;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/fsIBX27.dpk b/FastScript/fsIBX27.dpk
new file mode 100644
index 0000000..5ddc72a
--- /dev/null
+++ b/FastScript/fsIBX27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package fsIBX27;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs27,
+ fsDB27;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/fsIBX28.dpk b/FastScript/fsIBX28.dpk
new file mode 100644
index 0000000..a058907
--- /dev/null
+++ b/FastScript/fsIBX28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package fsIBX28;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs28,
+ fsDB28;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/fsIBX29.dpk b/FastScript/fsIBX29.dpk
new file mode 100644
index 0000000..3369dfd
--- /dev/null
+++ b/FastScript/fsIBX29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package fsIBX29;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs29,
+ fsDB29;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/FastScript/fsIBX5.bpk b/FastScript/fsIBX5.bpk
new file mode 100644
index 0000000..9fada0f
--- /dev/null
+++ b/FastScript/fsIBX5.bpk
@@ -0,0 +1,108 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=1
+Item0=$(BCB)\include;$(BCB)\include\vcl
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Language]
+ActiveLang=
+ProjectLang=
+RootDir=
+
+
\ No newline at end of file
diff --git a/FastScript/fsIBX5.cpp b/FastScript/fsIBX5.cpp
new file mode 100644
index 0000000..ca708ed
--- /dev/null
+++ b/FastScript/fsIBX5.cpp
@@ -0,0 +1,26 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+USERES("FS5.res");
+USEPACKAGE("vcl50.bpi");
+USEPACKAGE("vcldb50.bpi");
+USEPACKAGE("vclib50.bpi");
+USEPACKAGE("fs5.bpi");
+USEPACKAGE("fsDB5.bpi");
+USEUNIT("fs_iibxreg.pas");
+USEUNIT("fs_iibxrtti.pas");
+USERES("fs_iReg.dcr");
+//---------------------------------------------------------------------------
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
diff --git a/FastScript/fsIBX5.dpk b/FastScript/fsIBX5.dpk
new file mode 100644
index 0000000..67c6d1e
--- /dev/null
+++ b/FastScript/fsIBX5.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 5
+
+package fsIBX5;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+ VCLDB50,
+ VCLIB50,
+ fs5,
+ fsDB5;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+
+end.
diff --git a/FastScript/fsIBX6.bpk b/FastScript/fsIBX6.bpk
new file mode 100644
index 0000000..4795716
--- /dev/null
+++ b/FastScript/fsIBX6.bpk
@@ -0,0 +1,125 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[Excluded Packages]
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+Launcher=
+UseLauncher=0
+DebugCWD=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteLauncher=
+RemoteCWD=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+LinkCGLIB=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Linker]
+LibPrefix=
+LibSuffix=
+LibVersion=
+
+
\ No newline at end of file
diff --git a/FastScript/fsIBX6.cpp b/FastScript/fsIBX6.cpp
new file mode 100644
index 0000000..f8b9781
--- /dev/null
+++ b/FastScript/fsIBX6.cpp
@@ -0,0 +1,17 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
+
\ No newline at end of file
diff --git a/FastScript/fsIBX6.dpk b/FastScript/fsIBX6.dpk
new file mode 100644
index 0000000..f18d8bb
--- /dev/null
+++ b/FastScript/fsIBX6.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 6
+
+package fsIBX6;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs6,
+ fsDB6;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+
+end.
diff --git a/FastScript/fsIBX7.dpk b/FastScript/fsIBX7.dpk
new file mode 100644
index 0000000..6b5de3f
--- /dev/null
+++ b/FastScript/fsIBX7.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 7
+
+package fsIBX7;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs7,
+ fsDB7;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+
+end.
diff --git a/FastScript/fsIBX9.dpk b/FastScript/fsIBX9.dpk
new file mode 100644
index 0000000..b9bd413
--- /dev/null
+++ b/FastScript/fsIBX9.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2005
+
+package fsIBX9;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs9,
+ fsDB9;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+
+end.
diff --git a/FastScript/fsTee10.dpk b/FastScript/fsTee10.dpk
new file mode 100644
index 0000000..7deeae0
--- /dev/null
+++ b/FastScript/fsTee10.dpk
@@ -0,0 +1,52 @@
+// Package file for Delphi 2006
+
+package fsTee10;
+
+{$I fs.inc}
+{$I tee.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE710, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE810, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE910, {$ENDIF}
+{$IFDEF TeeChart4} TEE410, {$ENDIF}
+{$IFDEF TeeChart5} TEE510, {$ENDIF}
+{$IFDEF TeeChart6} TEE610, {$ENDIF}
+{$IFDEF TeeChart7} TEE710, {$ENDIF}
+{$IFDEF TeeChart8} TEE810, {$ENDIF}
+{$IFDEF TeeChart9} TEE910, {$ENDIF}
+ VCLX,
+ fs10;
+
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+
+end.
diff --git a/FastScript/fsTee11.dpk b/FastScript/fsTee11.dpk
new file mode 100644
index 0000000..5267d76
--- /dev/null
+++ b/FastScript/fsTee11.dpk
@@ -0,0 +1,52 @@
+// Package file for Delphi 2007
+
+package fsTee11;
+
+{$I fs.inc}
+{$I tee.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE711, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE811, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE911, {$ENDIF}
+{$IFDEF TeeChart4} TEE411, {$ENDIF}
+{$IFDEF TeeChart5} TEE511, {$ENDIF}
+{$IFDEF TeeChart6} TEE611, {$ENDIF}
+{$IFDEF TeeChart7} TEE711, {$ENDIF}
+{$IFDEF TeeChart8} TEE811, {$ENDIF}
+{$IFDEF TeeChart9} TEE911, {$ENDIF}
+ VCLX,
+ fs11;
+
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+
+end.
diff --git a/FastScript/fsTee12.dpk b/FastScript/fsTee12.dpk
new file mode 100644
index 0000000..c6f15b4
--- /dev/null
+++ b/FastScript/fsTee12.dpk
@@ -0,0 +1,52 @@
+// Package file for Delphi 2009
+
+package fsTee12;
+
+{$I fs.inc}
+{$I tee.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE712, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE812, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE912, {$ENDIF}
+{$IFDEF TeeChart4} TEE412, {$ENDIF}
+{$IFDEF TeeChart5} TEE512, {$ENDIF}
+{$IFDEF TeeChart6} TEE612, {$ENDIF}
+{$IFDEF TeeChart7} TEE712, {$ENDIF}
+{$IFDEF TeeChart8} TEE812, {$ENDIF}
+{$IFDEF TeeChart9} TEE912, {$ENDIF}
+ VCLX,
+ fs12;
+
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+
+end.
diff --git a/FastScript/fsTee14.dpk b/FastScript/fsTee14.dpk
new file mode 100644
index 0000000..f03cdc4
--- /dev/null
+++ b/FastScript/fsTee14.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi 2010
+
+package fsTee14;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE714, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE814, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE914, {$ENDIF}
+{$IFDEF TeeChart4} TEE414, {$ENDIF}
+{$IFDEF TeeChart5} TEE514, {$ENDIF}
+{$IFDEF TeeChart6} TEE614, {$ENDIF}
+{$IFDEF TeeChart7} TEE714, {$ENDIF}
+{$IFDEF TeeChart8} TEE814, {$ENDIF}
+{$IFDEF TeeChart9} TEE914, {$ENDIF}
+ VCLX,
+ fs14;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/fsTee15.dpk b/FastScript/fsTee15.dpk
new file mode 100644
index 0000000..0936c3f
--- /dev/null
+++ b/FastScript/fsTee15.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi XE
+
+package fsTee15;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE715, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE815, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE915, {$ENDIF}
+{$IFDEF TeeChart4} TEE415, {$ENDIF}
+{$IFDEF TeeChart5} TEE515, {$ENDIF}
+{$IFDEF TeeChart6} TEE615, {$ENDIF}
+{$IFDEF TeeChart7} TEE715, {$ENDIF}
+{$IFDEF TeeChart8} TEE815, {$ENDIF}
+{$IFDEF TeeChart9} TEE915, {$ENDIF}
+ VCLX,
+ fs15;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/fsTee16.dpk b/FastScript/fsTee16.dpk
new file mode 100644
index 0000000..737d44d
--- /dev/null
+++ b/FastScript/fsTee16.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi XE2
+
+package fsTee16;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE716, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE816, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE916, {$ENDIF}
+{$IFDEF TeeChart4} TEE416, {$ENDIF}
+{$IFDEF TeeChart5} TEE516, {$ENDIF}
+{$IFDEF TeeChart6} TEE616, {$ENDIF}
+{$IFDEF TeeChart7} TEE716, {$ENDIF}
+{$IFDEF TeeChart8} TEE816, {$ENDIF}
+{$IFDEF TeeChart9} TEE916, {$ENDIF}
+ VCLX,
+ fs16;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/fsTee17.dpk b/FastScript/fsTee17.dpk
new file mode 100644
index 0000000..ae74ce1
--- /dev/null
+++ b/FastScript/fsTee17.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi XE3
+
+package fsTee17;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE717, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE817, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE917, {$ENDIF}
+{$IFDEF TeeChart4} TEE417, {$ENDIF}
+{$IFDEF TeeChart5} TEE517, {$ENDIF}
+{$IFDEF TeeChart6} TEE617, {$ENDIF}
+{$IFDEF TeeChart7} TEE717, {$ENDIF}
+{$IFDEF TeeChart8} TEE817, {$ENDIF}
+{$IFDEF TeeChart9} TEE917, {$ENDIF}
+ VCLX,
+ fs17;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/fsTee18.dpk b/FastScript/fsTee18.dpk
new file mode 100644
index 0000000..bc86af4
--- /dev/null
+++ b/FastScript/fsTee18.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi XE4
+
+package fsTee18;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE718, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE818, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE918, {$ENDIF}
+{$IFDEF TeeChart4} TEE418, {$ENDIF}
+{$IFDEF TeeChart5} TEE518, {$ENDIF}
+{$IFDEF TeeChart6} TEE618, {$ENDIF}
+{$IFDEF TeeChart7} TEE718, {$ENDIF}
+{$IFDEF TeeChart8} TEE818, {$ENDIF}
+{$IFDEF TeeChart9} TEE918, {$ENDIF}
+ VCLX,
+ fs18;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/fsTee19.dpk b/FastScript/fsTee19.dpk
new file mode 100644
index 0000000..7227c0d
--- /dev/null
+++ b/FastScript/fsTee19.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi XE5
+
+package fsTee19;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE719, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE819, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE919, {$ENDIF}
+{$IFDEF TeeChart4} TEE419, {$ENDIF}
+{$IFDEF TeeChart5} TEE519, {$ENDIF}
+{$IFDEF TeeChart6} TEE619, {$ENDIF}
+{$IFDEF TeeChart7} TEE719, {$ENDIF}
+{$IFDEF TeeChart8} TEE819, {$ENDIF}
+{$IFDEF TeeChart9} TEE919, {$ENDIF}
+ VCLX,
+ fs19;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/fsTee20.dpk b/FastScript/fsTee20.dpk
new file mode 100644
index 0000000..bac3ca3
--- /dev/null
+++ b/FastScript/fsTee20.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi XE6
+
+package fsTee20;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE720, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE820, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE920, {$ENDIF}
+{$IFDEF TeeChart4} TEE420, {$ENDIF}
+{$IFDEF TeeChart5} TEE520, {$ENDIF}
+{$IFDEF TeeChart6} TEE620, {$ENDIF}
+{$IFDEF TeeChart7} TEE720, {$ENDIF}
+{$IFDEF TeeChart8} TEE820, {$ENDIF}
+{$IFDEF TeeChart9} TEE920, {$ENDIF}
+ VCLX,
+ fs20;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/fsTee21.dpk b/FastScript/fsTee21.dpk
new file mode 100644
index 0000000..53c1e32
--- /dev/null
+++ b/FastScript/fsTee21.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi XE7
+
+package fsTee21;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE721, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE821, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE921, {$ENDIF}
+{$IFDEF TeeChart4} TEE421, {$ENDIF}
+{$IFDEF TeeChart5} TEE521, {$ENDIF}
+{$IFDEF TeeChart6} TEE621, {$ENDIF}
+{$IFDEF TeeChart7} TEE721, {$ENDIF}
+{$IFDEF TeeChart8} TEE821, {$ENDIF}
+{$IFDEF TeeChart9} TEE921, {$ENDIF}
+ VCLX,
+ fs21;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/fsTee22.dpk b/FastScript/fsTee22.dpk
new file mode 100644
index 0000000..21a7bde
--- /dev/null
+++ b/FastScript/fsTee22.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi XE8
+
+package fsTee22;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE722, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE822, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE922, {$ENDIF}
+{$IFDEF TeeChart4} TEE422, {$ENDIF}
+{$IFDEF TeeChart5} TEE522, {$ENDIF}
+{$IFDEF TeeChart6} TEE622, {$ENDIF}
+{$IFDEF TeeChart7} TEE722, {$ENDIF}
+{$IFDEF TeeChart8} TEE822, {$ENDIF}
+{$IFDEF TeeChart9} TEE922, {$ENDIF}
+ VCLX,
+ fs22;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/fsTee23.dpk b/FastScript/fsTee23.dpk
new file mode 100644
index 0000000..4be1127
--- /dev/null
+++ b/FastScript/fsTee23.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi 10 Seattle
+
+package fsTee23;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE723, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE823, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE923, {$ENDIF}
+{$IFDEF TeeChart4} TEE423, {$ENDIF}
+{$IFDEF TeeChart5} TEE523, {$ENDIF}
+{$IFDEF TeeChart6} TEE623, {$ENDIF}
+{$IFDEF TeeChart7} TEE723, {$ENDIF}
+{$IFDEF TeeChart8} TEE823, {$ENDIF}
+{$IFDEF TeeChart9} TEE923, {$ENDIF}
+ VCLX,
+ fs23;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/fsTee24.dpk b/FastScript/fsTee24.dpk
new file mode 100644
index 0000000..0cf4a48
--- /dev/null
+++ b/FastScript/fsTee24.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi 10 Seattle
+
+package fsTee24;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE724, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE824, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE924, {$ENDIF}
+{$IFDEF TeeChart4} TEE424, {$ENDIF}
+{$IFDEF TeeChart5} TEE524, {$ENDIF}
+{$IFDEF TeeChart6} TEE624, {$ENDIF}
+{$IFDEF TeeChart7} TEE724, {$ENDIF}
+{$IFDEF TeeChart8} TEE824, {$ENDIF}
+{$IFDEF TeeChart9} TEE924, {$ENDIF}
+ VCLX,
+ fs24;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/fsTee25.dpk b/FastScript/fsTee25.dpk
new file mode 100644
index 0000000..2cd2e78
--- /dev/null
+++ b/FastScript/fsTee25.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi 10 Seattle
+
+package fsTee25;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE725, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE825, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE925, {$ENDIF}
+{$IFDEF TeeChart4} TEE425, {$ENDIF}
+{$IFDEF TeeChart5} TEE525, {$ENDIF}
+{$IFDEF TeeChart6} TEE625, {$ENDIF}
+{$IFDEF TeeChart7} TEE725, {$ENDIF}
+{$IFDEF TeeChart8} TEE825, {$ENDIF}
+{$IFDEF TeeChart9} TEE925, {$ENDIF}
+ VCLX,
+ fs25;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/fsTee26.dpk b/FastScript/fsTee26.dpk
new file mode 100644
index 0000000..5a15b48
--- /dev/null
+++ b/FastScript/fsTee26.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi 10 Seattle
+
+package fsTee26;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE726, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE826, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE926, {$ENDIF}
+{$IFDEF TeeChart4} TEE426, {$ENDIF}
+{$IFDEF TeeChart5} TEE526, {$ENDIF}
+{$IFDEF TeeChart6} TEE626, {$ENDIF}
+{$IFDEF TeeChart7} TEE726, {$ENDIF}
+{$IFDEF TeeChart8} TEE826, {$ENDIF}
+{$IFDEF TeeChart9} TEE926, {$ENDIF}
+ VCLX,
+ fs26;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/fsTee27.dpk b/FastScript/fsTee27.dpk
new file mode 100644
index 0000000..a178105
--- /dev/null
+++ b/FastScript/fsTee27.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi 10 Seattle
+
+package fsTee27;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE727, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE827, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE927, {$ENDIF}
+{$IFDEF TeeChart4} TEE427, {$ENDIF}
+{$IFDEF TeeChart5} TEE527, {$ENDIF}
+{$IFDEF TeeChart6} TEE627, {$ENDIF}
+{$IFDEF TeeChart7} TEE727, {$ENDIF}
+{$IFDEF TeeChart8} TEE827, {$ENDIF}
+{$IFDEF TeeChart9} TEE927, {$ENDIF}
+ VCLX,
+ fs27;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/fsTee28.dpk b/FastScript/fsTee28.dpk
new file mode 100644
index 0000000..38fc436
--- /dev/null
+++ b/FastScript/fsTee28.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi 11 Seattle
+
+package fsTee28;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE728, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE828, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE928, {$ENDIF}
+{$IFDEF TeeChart4} TEE428, {$ENDIF}
+{$IFDEF TeeChart5} TEE528, {$ENDIF}
+{$IFDEF TeeChart6} TEE628, {$ENDIF}
+{$IFDEF TeeChart7} TEE728, {$ENDIF}
+{$IFDEF TeeChart8} TEE828, {$ENDIF}
+{$IFDEF TeeChart9} TEE928, {$ENDIF}
+ VCLX,
+ fs28;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/fsTee29.dpk b/FastScript/fsTee29.dpk
new file mode 100644
index 0000000..e2b4190
--- /dev/null
+++ b/FastScript/fsTee29.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi 12
+
+package fsTee29;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE729, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE829, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE929, {$ENDIF}
+{$IFDEF TeeChart4} TEE429, {$ENDIF}
+{$IFDEF TeeChart5} TEE529, {$ENDIF}
+{$IFDEF TeeChart6} TEE629, {$ENDIF}
+{$IFDEF TeeChart7} TEE729, {$ENDIF}
+{$IFDEF TeeChart8} TEE829, {$ENDIF}
+{$IFDEF TeeChart9} TEE929, {$ENDIF}
+ VCLX,
+ fs29;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/FastScript/fsTee4.bpk b/FastScript/fsTee4.bpk
new file mode 100644
index 0000000..5b6bc39
--- /dev/null
+++ b/FastScript/fsTee4.bpk
@@ -0,0 +1,187 @@
+# ---------------------------------------------------------------------------
+!if !$d(BCB)
+BCB = $(MAKEDIR)\..
+!endif
+
+# ---------------------------------------------------------------------------
+# IDE SECTION
+# ---------------------------------------------------------------------------
+# The following section of the project makefile is managed by the BCB IDE.
+# It is recommended to use the IDE to change any of the values in this
+# section.
+# ---------------------------------------------------------------------------
+
+VERSION = BCB.04.04
+# ---------------------------------------------------------------------------
+PROJECT = FSTee4.bpl
+OBJFILES = fs_iteereg.obj FSTee4.obj fs_ichartrtti.obj
+RESFILES = FS4.res fs_iReg.dcr
+RESDEPEN = $(RESFILES)
+LIBFILES =
+PACKAGES = vcl40.bpi vclx40.bpi tee40.bpi fs4.bpi
+DEFFILE =
+# ---------------------------------------------------------------------------
+PATHCPP = .;
+PATHASM = .;
+PATHPAS = .;
+PATHRC = .;
+DEBUGLIBPATH = $(BCB)\lib\debug
+RELEASELIBPATH = $(BCB)\lib\release
+USERDEFINES =
+SYSDEFINES = _RTLDLL;NO_STRICT;USEPACKAGES
+# ---------------------------------------------------------------------------
+CFLAG1 = -I$(BCB)\include;$(BCB)\include\vcl -O2 -Hc -H=$(BCB)\lib\vcl40.csm -w -Ve -a8 \
+ -k- -vi -c -b- -w-par -w-inl -Vx -tWM -D$(SYSDEFINES);$(USERDEFINES)
+PFLAGS = -U$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \
+ -I$(BCB)\include;$(BCB)\include\vcl -$Y- -$L- -$D- -v -JPHNE -M
+RFLAGS = -i$(BCB)\include;$(BCB)\include\vcl
+AFLAGS = /i$(BCB)\include /i$(BCB)\include\vcl /mx /w2 /zn
+LFLAGS = -L$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \
+ -D"FastScript 1.9 Tee Components" -aa -Tpp -x -Gn -Gl -Gi
+# ---------------------------------------------------------------------------
+ALLOBJ = c0pkg32.obj Memmgr.Lib $(PACKAGES) sysinit.obj $(OBJFILES)
+ALLRES = $(RESFILES)
+ALLLIB = $(LIBFILES) $(LIBRARIES) import32.lib cp32mti.lib
+# ---------------------------------------------------------------------------
+!ifdef IDEOPTIONS
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=1
+Item0=$(BCB)\include;$(BCB)\include\vcl
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteDebug=0
+
+[Compiler]
+InMemoryExe=0
+ShowInfoMsgs=0
+
+!endif
+
+# ---------------------------------------------------------------------------
+# MAKE SECTION
+# ---------------------------------------------------------------------------
+# This section of the project file is not used by the BCB IDE. It is for
+# the benefit of building from the command-line using the MAKE utility.
+# ---------------------------------------------------------------------------
+
+.autodepend
+# ---------------------------------------------------------------------------
+!if !$d(BCC32)
+BCC32 = bcc32
+!endif
+
+!if !$d(CPP32)
+CPP32 = cpp32
+!endif
+
+!if !$d(DCC32)
+DCC32 = dcc32
+!endif
+
+!if !$d(TASM32)
+TASM32 = tasm32
+!endif
+
+!if !$d(LINKER)
+LINKER = ilink32
+!endif
+
+!if !$d(BRCC32)
+BRCC32 = brcc32
+!endif
+
+# ---------------------------------------------------------------------------
+!if $d(PATHCPP)
+.PATH.CPP = $(PATHCPP)
+.PATH.C = $(PATHCPP)
+!endif
+
+!if $d(PATHPAS)
+.PATH.PAS = $(PATHPAS)
+!endif
+
+!if $d(PATHASM)
+.PATH.ASM = $(PATHASM)
+!endif
+
+!if $d(PATHRC)
+.PATH.RC = $(PATHRC)
+!endif
+# ---------------------------------------------------------------------------
+$(PROJECT): $(OBJFILES) $(RESDEPEN) $(DEFFILE)
+ $(BCB)\BIN\$(LINKER) @&&!
+ $(LFLAGS) +
+ $(ALLOBJ), +
+ $(PROJECT),, +
+ $(ALLLIB), +
+ $(DEFFILE), +
+ $(ALLRES)
+!
+# ---------------------------------------------------------------------------
+.pas.hpp:
+ $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< }
+
+.pas.obj:
+ $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< }
+
+.cpp.obj:
+ $(BCB)\BIN\$(BCC32) $(CFLAG1) -n$(@D) {$< }
+
+.c.obj:
+ $(BCB)\BIN\$(BCC32) $(CFLAG1) -n$(@D) {$< }
+
+.c.i:
+ $(BCB)\BIN\$(CPP32) $(CFLAG1) -n. {$< }
+
+.cpp.i:
+ $(BCB)\BIN\$(CPP32) $(CFLAG1) -n. {$< }
+
+.asm.obj:
+ $(BCB)\BIN\$(TASM32) $(AFLAGS) $<, $@
+
+.rc.res:
+ $(BCB)\BIN\$(BRCC32) $(RFLAGS) -fo$@ $<
+# ---------------------------------------------------------------------------
diff --git a/FastScript/fsTee4.cpp b/FastScript/fsTee4.cpp
new file mode 100644
index 0000000..d5452c2
--- /dev/null
+++ b/FastScript/fsTee4.cpp
@@ -0,0 +1,21 @@
+//---------------------------------------------------------------------------
+#include
+#pragma hdrstop
+USERES("FS4.res");
+USEPACKAGE("vcl40.bpi");
+USEPACKAGE("vclx40.bpi");
+USEPACKAGE("tee40.bpi");
+USEPACKAGE("fs4.bpi");
+USEUNIT("fs_iteeReg.pas");
+USEUNIT("fs_ichartrtti.pas");
+USERES("fs_iReg.dcr");
+//---------------------------------------------------------------------------
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+// Package source.
+//---------------------------------------------------------------------------
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
diff --git a/FastScript/fsTee4.dpk b/FastScript/fsTee4.dpk
new file mode 100644
index 0000000..f8aefa8
--- /dev/null
+++ b/FastScript/fsTee4.dpk
@@ -0,0 +1,48 @@
+// Package file for Delphi 4
+
+package fsTee4;
+
+{$I fs.inc}
+{$I tee.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL40,
+{$IFDEF TeeChartStd} TEE40, {$ENDIF}
+{$IFDEF TeeChart4} TEE44, {$ENDIF}
+{$IFDEF TeeChart5} TEE54, {$ENDIF}
+{$IFDEF TeeChart6} TEE64, {$ENDIF}
+{$IFDEF TeeChart7} TEE74, {$ENDIF}
+{$IFDEF TeeChart8} TEE84, {$ENDIF}
+ VCLX40,
+ fs4;
+
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+
+end.
diff --git a/FastScript/fsTee5.bpk b/FastScript/fsTee5.bpk
new file mode 100644
index 0000000..8e87a0e
--- /dev/null
+++ b/FastScript/fsTee5.bpk
@@ -0,0 +1,108 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=9
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=1
+Item0=$(BCB)\include;$(BCB)\include\vcl
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Language]
+ActiveLang=
+ProjectLang=
+RootDir=
+
+
\ No newline at end of file
diff --git a/FastScript/fsTee5.cpp b/FastScript/fsTee5.cpp
new file mode 100644
index 0000000..f6b90b6
--- /dev/null
+++ b/FastScript/fsTee5.cpp
@@ -0,0 +1,25 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+USERES("FS5.res");
+USEPACKAGE("vcl50.bpi");
+USEPACKAGE("vclx50.bpi");
+USEPACKAGE("tee50.bpi");
+USEPACKAGE("fs5.bpi");
+USEUNIT("fs_iteereg.pas");
+USEUNIT("fs_ichartrtti.pas");
+USERES("fs_iReg.dcr");
+//---------------------------------------------------------------------------
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
diff --git a/FastScript/fsTee5.dpk b/FastScript/fsTee5.dpk
new file mode 100644
index 0000000..f43c9d4
--- /dev/null
+++ b/FastScript/fsTee5.dpk
@@ -0,0 +1,48 @@
+// Package file for Delphi 5
+
+package fsTee5;
+
+{$I fs.inc}
+{$I tee.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+{$IFDEF TeeChartStd} TEE50, {$ENDIF}
+{$IFDEF TeeChart4} TEE45, {$ENDIF}
+{$IFDEF TeeChart5} TEE55, {$ENDIF}
+{$IFDEF TeeChart6} TEE65, {$ENDIF}
+{$IFDEF TeeChart7} TEE75, {$ENDIF}
+{$IFDEF TeeChart8} TEE85, {$ENDIF}
+ VCLX50,
+ fs5;
+
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+
+end.
diff --git a/FastScript/fsTee6.bpk b/FastScript/fsTee6.bpk
new file mode 100644
index 0000000..30ca49c
--- /dev/null
+++ b/FastScript/fsTee6.bpk
@@ -0,0 +1,124 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=9
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[Excluded Packages]
+d:\delphi\builder6\Projects\Bpl\FR6.bpl=FastReport 2.4 Components
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+Launcher=
+UseLauncher=0
+DebugCWD=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteLauncher=
+RemoteCWD=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+LinkCGLIB=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Linker]
+LibPrefix=
+LibSuffix=
+LibVersion=
+
+
\ No newline at end of file
diff --git a/FastScript/fsTee6.cpp b/FastScript/fsTee6.cpp
new file mode 100644
index 0000000..f8b9781
--- /dev/null
+++ b/FastScript/fsTee6.cpp
@@ -0,0 +1,17 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
+
\ No newline at end of file
diff --git a/FastScript/fsTee6.dpk b/FastScript/fsTee6.dpk
new file mode 100644
index 0000000..de14ea5
--- /dev/null
+++ b/FastScript/fsTee6.dpk
@@ -0,0 +1,48 @@
+// Package file for Delphi 6
+
+package fsTee6;
+
+{$I fs.inc}
+{$I tee.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChart4} TEE46, {$ENDIF}
+{$IFDEF TeeChart5} TEE56, {$ENDIF}
+{$IFDEF TeeChart6} TEE66, {$ENDIF}
+{$IFDEF TeeChart7} TEE76, {$ENDIF}
+{$IFDEF TeeChart8} TEE86, {$ENDIF}
+ VCLX,
+ fs6;
+
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+
+end.
diff --git a/FastScript/fsTee7.dpk b/FastScript/fsTee7.dpk
new file mode 100644
index 0000000..22108f0
--- /dev/null
+++ b/FastScript/fsTee7.dpk
@@ -0,0 +1,52 @@
+// Package file for Delphi 7
+
+package fsTee7;
+
+{$I fs.inc}
+{$I tee.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE77, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE87, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE97, {$ENDIF}
+{$IFDEF TeeChart4} TEE47, {$ENDIF}
+{$IFDEF TeeChart5} TEE57, {$ENDIF}
+{$IFDEF TeeChart6} TEE67, {$ENDIF}
+{$IFDEF TeeChart7} TEE77, {$ENDIF}
+{$IFDEF TeeChart8} TEE87, {$ENDIF}
+{$IFDEF TeeChart9} TEE97, {$ENDIF}
+ VCLX,
+ fs7;
+
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+
+end.
diff --git a/FastScript/fsTee9.dpk b/FastScript/fsTee9.dpk
new file mode 100644
index 0000000..cdd566b
--- /dev/null
+++ b/FastScript/fsTee9.dpk
@@ -0,0 +1,52 @@
+// Package file for Delphi 2005
+
+package fsTee9;
+
+{$I fs.inc}
+{$I tee.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE79, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE89, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE99, {$ENDIF}
+{$IFDEF TeeChart4} TEE49, {$ENDIF}
+{$IFDEF TeeChart5} TEE59, {$ENDIF}
+{$IFDEF TeeChart6} TEE69, {$ENDIF}
+{$IFDEF TeeChart7} TEE79, {$ENDIF}
+{$IFDEF TeeChart8} TEE89, {$ENDIF}
+{$IFDEF TeeChart9} TEE99, {$ENDIF}
+ VCLX,
+ fs9;
+
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+
+end.
diff --git a/FastScript/fs_iadoreg.pas b/FastScript/fs_iadoreg.pas
new file mode 100644
index 0000000..0c77572
--- /dev/null
+++ b/FastScript/fs_iadoreg.pas
@@ -0,0 +1,45 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_iadoreg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ Classes
+{$IFNDEF Delphi6}
+, DsgnIntf
+{$ELSE}
+, DesignIntf
+{$ENDIF}
+{$IFDEF DELPHI16}
+, Controls
+{$ENDIF}
+, fs_iadortti;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+{$IFDEF DELPHI16}
+ //GroupDescendentsWith(TfsADORTTI, TControl);
+{$ENDIF}
+ RegisterComponents('FastScript', [TfsADORTTI]);
+end;
+
+end.
diff --git a/FastScript/fs_iadortti.pas b/FastScript/fs_iadortti.pas
new file mode 100644
index 0000000..ac053e4
--- /dev/null
+++ b/FastScript/fs_iadortti.pas
@@ -0,0 +1,135 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ ADO classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_iadortti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, fs_itools, fs_idbrtti,
+ {$IFDEF DELPHI16}Controls, System.Types,
+ Data.DB, Data.Win.ADODB, Winapi.ADOInt;
+ {$ELSE}
+ DB, ADODB, ADOInt;
+ {$ENDIF}
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsADORTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddType('TDataType', fvtInt);
+ AddClass(TADOConnection, 'TComponent');
+ AddClass(TParameter, 'TCollectionItem');
+ with AddClass(TParameters, 'TCollection') do
+ begin
+ AddMethod('function AddParameter: TParameter', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TParameter', CallMethod, True);
+ end;
+ with AddClass(TCustomADODataSet, 'TDataSet') do
+ begin
+ AddProperty('Sort', 'WideString', GetProp, SetProp);
+ end;
+ AddClass(TADOTable, 'TCustomADODataSet');
+ with AddClass(TADOQuery, 'TCustomADODataSet') do
+ AddMethod('procedure ExecSQL', CallMethod);
+ with AddClass(TADOStoredProc, 'TCustomADODataSet') do
+ AddMethod('procedure ExecProc', CallMethod);
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TParameters then
+ begin
+ if MethodName = 'ADDPARAMETER' then
+ Result := frxInteger(TParameters(Instance).AddParameter)
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TParameters(Instance).Items[Caller.Params[0]])
+ end
+ else if ClassType = TADOQuery then
+ begin
+ if MethodName = 'EXECSQL' then
+ TADOQuery(Instance).ExecSQL
+ end
+ else if ClassType = TADOStoredProc then
+ begin
+ if MethodName = 'EXECPROC' then
+ TADOStoredProc(Instance).ExecProc
+ end
+end;
+
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TCustomADODataSet then
+ begin
+ if PropName = 'SORT' then
+ Result := TCustomADODataSet(Instance).Sort;
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+
+ if ClassType = TCustomADODataSet then
+ begin
+ if PropName = 'SORT' then
+ TCustomADODataSet(Instance).Sort := Value;
+ end
+
+end;
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsADORTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
+
diff --git a/FastScript/fs_ibasic.pas b/FastScript/fs_ibasic.pas
new file mode 100644
index 0000000..9ba0755
--- /dev/null
+++ b/FastScript/fs_ibasic.pas
@@ -0,0 +1,193 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Basic grammar }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_ibasic;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_itools{$IFDEF DELPHI16}, Controls{$ENDIF};
+{$ELSE}
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_itools, FMX.Types;
+{$ENDIF}
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsBasic = class(TComponent);
+
+
+implementation
+
+const
+ BASIC_GRAMMAR =
+ '' +
+ '<' +
+ '/keywords>' +
+ '<' +
+ 'string add="file" err="err1"/><' +
+ 'char text="(" add="op"/><' +
+ '/sequence>' +
+ '' +
+ '<' +
+ 'keyword text="OR" add="op" addtext="or"/><' +
+ 'char text="[" add="node"/>' +
+ '<' +
+ 'sequence><' +
+ '/sequence><' +
+ 'caseselector/><' +
+ 'optional>' +
+ '<' +
+ 'keyword text="FINALLY"/>';
+
+
+initialization
+{$IFDEF DELPHI16}
+{$IFDEF FMX}
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsBasic, TFmxObject);
+{$ELSE}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsBasic, TControl);
+{$ENDIF}
+{$ENDIF}
+ fsRegisterLanguage('BasicScript', BASIC_GRAMMAR);
+
+end.
diff --git a/FastScript/fs_ibdereg.pas b/FastScript/fs_ibdereg.pas
new file mode 100644
index 0000000..fa884ea
--- /dev/null
+++ b/FastScript/fs_ibdereg.pas
@@ -0,0 +1,45 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_ibdereg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ Classes
+{$IFNDEF Delphi6}
+, DsgnIntf
+{$ELSE}
+, DesignIntf
+{$ENDIF}
+{$IFDEF DELPHI16}
+, Controls
+{$ENDIF}
+, fs_ibdertti;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+{$IFDEF DELPHI16}
+ //GroupDescendentsWith(TfsBDERTTI, TControl);
+{$ENDIF}
+ RegisterComponents('FastScript', [TfsBDERTTI]);
+end;
+
+end.
diff --git a/FastScript/fs_ibdertti.pas b/FastScript/fs_ibdertti.pas
new file mode 100644
index 0000000..159e7e9
--- /dev/null
+++ b/FastScript/fs_ibdertti.pas
@@ -0,0 +1,171 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ BDE classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_ibdertti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, fs_itools, fs_idbrtti,
+ DB, DBTables
+ {$IFDEF DELPHI16}, Controls, System.Types{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsBDERTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TTableType', 'ttDefault, ttParadox, ttDBase, ttFoxPro, ttASCII');
+ AddEnum('TParamBindMode', 'pbByName, pbByNumber');
+
+ AddClass(TSession, 'TComponent');
+ AddClass(TDatabase, 'TComponent');
+ AddClass(TBDEDataSet, 'TDataSet');
+ AddClass(TDBDataSet, 'TBDEDataSet');
+ with AddClass(TTable, 'TDBDataSet') do
+ begin
+ AddMethod('procedure CreateTable', CallMethod);
+ AddMethod('procedure DeleteTable', CallMethod);
+ AddMethod('procedure EmptyTable', CallMethod);
+ AddMethod('function FindKey(const KeyValues: array): Boolean', CallMethod);
+ AddMethod('procedure FindNearest(const KeyValues: array)', CallMethod);
+ AddMethod('procedure RenameTable(const NewTableName: string)', CallMethod);
+ end;
+ with AddClass(TQuery, 'TDBDataSet') do
+ begin
+ AddMethod('procedure ExecSQL', CallMethod);
+ AddMethod('function ParamByName(const Value: string): TParam', CallMethod);
+ AddMethod('procedure Prepare', CallMethod);
+ AddProperty('ParamCount', 'Word', GetProp, nil);
+ end;
+ with AddClass(TStoredProc, 'TDBDataSet') do
+ begin
+ AddMethod('procedure ExecProc', CallMethod);
+ AddMethod('function ParamByName(const Value: string): TParam', CallMethod);
+ AddMethod('procedure Prepare', CallMethod);
+ AddProperty('ParamCount', 'Word', GetProp, nil);
+ end;
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function DoFindKey: Boolean;
+ var
+ ar: TVarRecArray;
+ sPtrList: TList;
+ begin
+ VariantToVarRec(Caller.Params[0], ar, sPtrList);
+ Result := TTable(Instance).FindKey(ar);
+ ClearVarRec(ar, sPtrList);
+ end;
+
+ procedure DoFindNearest;
+ var
+ ar: TVarRecArray;
+ sPtrList: TList;
+ begin
+ VariantToVarRec(Caller.Params[0], ar, sPtrList);
+ TTable(Instance).FindNearest(ar);
+ ClearVarRec(ar, sPtrList);
+ end;
+
+begin
+ Result := 0;
+
+ if ClassType = TTable then
+ begin
+ if MethodName = 'CREATETABLE' then
+ TTable(Instance).CreateTable
+ else if MethodName = 'DELETETABLE' then
+ TTable(Instance).DeleteTable
+ else if MethodName = 'EMPTYTABLE' then
+ TTable(Instance).EmptyTable
+ else if MethodName = 'FINDKEY' then
+ Result := DoFindKey
+ else if MethodName = 'FINDNEAREST' then
+ DoFindNearest
+ else if MethodName = 'RENAMETABLE' then
+ TTable(Instance).RenameTable(Caller.Params[0])
+ end
+ else if ClassType = TQuery then
+ begin
+ if MethodName = 'EXECSQL' then
+ TQuery(Instance).ExecSQL
+ else if MethodName = 'PARAMBYNAME' then
+ Result := frxInteger(TQuery(Instance).ParamByName(Caller.Params[0]))
+ else if MethodName = 'PREPARE' then
+ TQuery(Instance).Prepare
+ end
+ else if ClassType = TStoredProc then
+ begin
+ if MethodName = 'EXECPROC' then
+ TStoredProc(Instance).ExecProc
+ else if MethodName = 'PARAMBYNAME' then
+ Result := frxInteger(TStoredProc(Instance).ParamByName(Caller.Params[0]))
+ else if MethodName = 'PREPARE' then
+ TStoredProc(Instance).Prepare
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TQuery then
+ begin
+ if PropName = 'PARAMCOUNT' then
+ Result := TQuery(Instance).ParamCount
+ end
+ else if ClassType = TStoredProc then
+ begin
+ if PropName = 'PARAMCOUNT' then
+ Result := TStoredProc(Instance).ParamCount
+ end
+end;
+
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsBDERTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/fs_ibx.lpk b/FastScript/fs_ibx.lpk
new file mode 100644
index 0000000..d714535
--- /dev/null
+++ b/FastScript/fs_ibx.lpk
@@ -0,0 +1,49 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/FastScript/fs_ichartrtti.pas b/FastScript/fs_ichartrtti.pas
new file mode 100644
index 0000000..c01b22f
--- /dev/null
+++ b/FastScript/fs_ichartrtti.pas
@@ -0,0 +1,195 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Chart }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_ichartrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, fs_itools, fs_iformsrtti
+{$IFDEF DELPHI16}
+ , VCLTee.Chart, VCLTee.Series, VCLTee.TeEngine, VCLTee.TeeProcs, VCLTee.TeCanvas, VCLTee.ArrowCha
+{$ELSE}
+ , Chart, Series, TeEngine, TeeProcs, TeCanvas, ArrowCha
+{$ENDIF}
+{$IFDEF Delphi16}
+ , System.Types
+{$ENDIF}
+{$IFDEF DELPHI16}, Controls{$ENDIF};
+
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsChartRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddType('TChartValue', fvtFloat);
+ AddEnum('TLegendStyle', 'lsAuto, lsSeries, lsValues, lsLastValues');
+ AddEnum('TLegendAlignment', 'laLeft, laRight, laTop, laBottom');
+ AddEnum('TLegendTextStyle', 'ltsPlain, ltsLeftValue, ltsRightValue, ltsLeftPercent,' +
+ 'ltsRightPercent, ltsXValue');
+ AddEnum('TChartListOrder', 'loNone, loAscending, loDescending');
+ AddEnum('TGradientDirection', 'gdTopBottom, gdBottomTop, gdLeftRight, gdRightLeft');
+ AddEnum('TSeriesMarksStyle', 'smsValue, smsPercent, smsLabel, smsLabelPercent, ' +
+ 'smsLabelValue, smsLegend, smsPercentTotal, smsLabelPercentTotal, smsXValue');
+ AddEnum('TAxisLabelStyle', 'talAuto, talNone, talValue, talMark, talText');
+ AddEnum('THorizAxis', 'aTopAxis, aBottomAxis');
+ AddEnum('TVertAxis', 'aLeftAxis, aRightAxis');
+ AddEnum('TTeeBackImageMode', 'pbmStretch, pbmTile, pbmCenter');
+ AddEnum('TPanningMode', 'pmNone, pmHorizontal, pmVertical, pmBoth');
+ AddEnum('TSeriesPointerStyle', 'psRectangle, psCircle, psTriangle, ' +
+ 'psDownTriangle, psCross, psDiagCross, psStar, psDiamond, psSmallDot');
+ AddEnum('TMultiArea', 'maNone, maStacked, maStacked100');
+ AddEnum('TMultiBar', 'mbNone, mbSide, mbStacked, mbStacked100');
+ AddEnum('TBarStyle', 'bsRectangle, bsPyramid, bsInvPyramid, bsCilinder, ' +
+ 'bsEllipse, bsArrow, bsRectGradient');
+
+ AddEnum('TPenEndStyle', 'esRound, esSquare, esFlat');
+ AddEnum('TPenMode', 'pmBlack, pmWhite, pmNop, pmNot, pmCopy, pmNotCopy, ' +
+ 'pmMergePenNot, pmMaskPenNot, pmMergeNotPen, pmMaskNotPen, pmMerge, ' +
+ 'pmNotMerge, pmMask, pmNotMask, pmXor, pmNotXor');
+ AddEnum('TPenStyle', 'psSolid, psDash, psDot, psDashDot, psDashDotDot, psClear, psInsideFrame');
+ AddClass(TChartValueList, 'TPersistent');
+ AddClass(TChartAxisTitle, 'TPersistent');
+ AddClass(TChartAxis, 'TPersistent');
+ AddClass(TCustomChartLegend, 'TPersistent');
+ AddClass(TChartLegend, 'TCustomChartLegend');
+ AddClass(TSeriesMarks, 'TPersistent');
+ AddClass(TChartGradient, 'TPersistent');
+ AddClass(TChartWall, 'TPersistent');
+ AddClass(TChartBrush, 'TBrush');
+ AddClass(TChartTitle, 'TPersistent');
+ AddClass(TView3DOptions, 'TPersistent');
+ AddClass(TChartPen, 'TComponent');
+ with AddClass(TChartSeries, 'TComponent') do
+ begin
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure Delete(Index: Integer)', CallMethod);
+ AddMethod('function Count: Integer', CallMethod);
+ AddMethod('procedure Add(const AValue: Double; const ALabel: String; AColor: TColor)', CallMethod);
+ AddProperty('Active','Boolean', GetProp, SetProp);
+ end;
+ AddClass(TSeriesPointer, 'TPersistent');
+ AddClass(TCustomSeries, 'TChartSeries');
+ AddClass(TLineSeries, 'TCustomSeries');
+ AddClass(TPointSeries, 'TCustomSeries');
+ AddClass(TAreaSeries, 'TCustomSeries');
+ AddClass(TArrowSeries, 'TCustomSeries');
+ with AddClass(TCustomBarSeries, 'TChartSeries') do
+ begin
+ AddProperty('Title','String', GetProp, SetProp);
+ end;
+ AddClass(TBarSeries, 'TCustomBarSeries');
+ AddClass(THorizBarSeries, 'TCustomBarSeries');
+ AddClass(TCircledSeries, 'TChartSeries');
+ AddClass(TPieSeries, 'TCircledSeries');
+ AddClass(TFastLineSeries, 'TChartSeries');
+ AddClass(TCustomChart, 'TWinControl');
+ AddClass(TChart, 'TCustomChart');
+{$IFDEF DELPHI19}
+ AddClass(TSeriesPointerItems, 'TSeriesPointerItems');
+{$ENDIF}
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TChartSeries then
+ begin
+ if MethodName = 'CLEAR' then
+ TChartSeries(Instance).Clear
+ else if MethodName = 'ADD' then
+ TChartSeries(Instance).Add(Caller.Params[0], String(Caller.Params[1]), Caller.Params[2])
+ else if MethodName = 'DELETE' then
+ TChartSeries(Instance).Delete(Caller.Params[0])
+ else if MethodName = 'COUNT' then
+ Result := TChartSeries(Instance).Count
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TChartSeries then
+ begin
+ if PropName = 'ACTIVE' then
+ Result := TChartSeries(Instance).Active
+ end else
+ if ClassType = TCustomBarSeries then
+ begin
+ if PropName = 'Title' then
+ Result := TCustomBarSeries(Instance).Title
+ end;
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TChartSeries then
+ begin
+ if PropName = 'ACTIVE' then
+ TChartSeries(Instance).Active := Value
+ end else
+ if ClassType = TCustomBarSeries then
+ begin
+ if PropName = 'Title' then
+ TCustomBarSeries(Instance).Title := Value
+ end
+end;
+
+initialization
+{$IFDEF DELPHI16}
+{$IFDEF FMX}
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsChartRTTI, TFmxObject);
+{$ELSE}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsChartRTTI, TControl);
+{$ENDIF}
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/fs_iclassesrtti.pas b/FastScript/fs_iclassesrtti.pas
new file mode 100644
index 0000000..a102022
--- /dev/null
+++ b/FastScript/fs_iclassesrtti.pas
@@ -0,0 +1,1052 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Classes.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_iclassesrtti;
+
+interface
+
+{$i fs.inc}
+
+uses SysUtils, Classes, fs_iinterpreter, fs_xml{$IFDEF DELPHI16}, Controls{$ENDIF}
+{$IFDEF Delphi16}
+ , System.Types
+{$ENDIF};
+//FMX USES
+{$ELSE}
+interface
+
+{$i fs.inc}
+
+uses System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_xml, System.Types, FMX.Types, System.UITypes
+{$IFDEF DELPHI20}
+ ,System.Math.Vectors
+{$ENDIF};
+{$ENDIF}
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsClassesRTTI = class(TComponent); // fake component
+{$IFDEF FMX}
+{ wrappers for most using structures }
+ TfsRectF = class(TPersistent)
+ private
+ FRectF: TRectF;
+ function GetBottom: Single;
+ function GetLeft: Single;
+ function GetRight: Single;
+ function GetTop: Single;
+ procedure SetBottom(const Value: Single);
+ procedure SetLeft(const Value: Single);
+ procedure SetRight(const Value: Single);
+ procedure SetTop(const Value: Single);
+ public
+ function GetRect: TRectF;
+ function GetRectP: PRectF;
+ constructor Create(aRectF: TRectF);
+ published
+ property Left: Single read GetLeft write SetLeft;
+ property Top: Single read GetTop write SetTop;
+ property Right: Single read GetRight write SetRight;
+ property Bottom: Single read GetBottom write SetBottom;
+ end;
+
+ TfsMatrix = class(TPersistent)
+ private
+ FMatrix: TMatrix;
+ function Getm11: Single;
+ function Getm12: Single;
+ function Getm13: Single;
+ function Getm21: Single;
+ function Getm22: Single;
+ function Getm23: Single;
+ function Getm31: Single;
+ function Getm32: Single;
+ function Getm33: Single;
+ procedure Setm11(const Value: Single);
+ procedure Setm12(const Value: Single);
+ procedure Setm13(const Value: Single);
+ procedure Setm21(const Value: Single);
+ procedure Setm22(const Value: Single);
+ procedure Setm23(const Value: Single);
+ procedure Setm31(const Value: Single);
+ procedure Setm32(const Value: Single);
+ procedure Setm33(const Value: Single);
+ public
+ procedure AssignToRect(var Rect: TMatrix);
+ procedure AssignFromRect(Rect: TMatrix);
+ function GetRect: TMatrix;
+ constructor Create(aMatrix: TMatrix);
+ published
+ property m11: Single read Getm11 write Setm11;
+ property m12: Single read Getm12 write Setm12;
+ property m13: Single read Getm13 write Setm13;
+ property m21: Single read Getm21 write Setm21;
+ property m22: Single read Getm22 write Setm22;
+ property m23: Single read Getm23 write Setm23;
+ property m31: Single read Getm31 write Setm31;
+ property m32: Single read Getm32 write Setm32;
+ property m33: Single read Getm33 write Setm33;
+ end;
+
+ TfsPointF = class(TPersistent)
+ private
+ FPointF: TPointF;
+ function GetX: Single;
+ function GetY: Single;
+ procedure SetX(const Value: Single);
+ procedure SetY(const Value: Single);
+ public
+ function GetRect: TPointF;
+ function GetRectP: PPointF;
+ constructor Create(aPointF: TPointF);
+ published
+ property pX: Single read GetX write SetX;
+ property pY: Single read GetY write SetY;
+ end;
+
+ PVector = ^TVector;
+ TfsVector = class(TPersistent)
+ private
+ FVector: TVector;
+ function GetW: Single;
+ function GetX: Single;
+ function GetY: Single;
+ procedure SetW(const Value: Single);
+ procedure SetX(const Value: Single);
+ procedure SetY(const Value: Single);
+ public
+ function GetRect: TVector;
+ function GetRectP: PVector;
+ constructor Create(aVector: TVector);
+ published
+ property pX: Single read GetX write SetX;
+ property pY: Single read GetY write SetY;
+ property pW: Single read GetW write SetW;
+ end;
+{$ENDIF}
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+{$IFDEF FMX}
+{ TFrxRectF }
+
+constructor TfsRectF.Create(aRectF: TRectF);
+begin
+ FRectF.Left := aRectF.Left;
+ FRectF.Top := aRectF.Top;
+ FRectF.Right := aRectF.Right;
+ FRectF.Bottom := aRectF.Bottom;
+end;
+
+function TfsRectF.GetBottom: Single;
+begin
+ Result := FRectF.Bottom;
+end;
+
+function TfsRectF.GetLeft: Single;
+begin
+ Result := FRectF.Left;
+end;
+
+function TfsRectF.GetRect: TRectF;
+begin
+ Result := FRectF;
+end;
+
+function TfsRectF.GetRectP: PRectF;
+begin
+ Result := @FRectF;
+end;
+
+function TfsRectF.GetRight: Single;
+begin
+ Result := FRectF.Right;
+end;
+
+function TfsRectF.GetTop: Single;
+begin
+ Result := FRectF.Top;
+end;
+
+procedure TfsRectF.SetBottom(const Value: Single);
+begin
+ FRectF.Bottom := Value;
+end;
+
+procedure TfsRectF.SetLeft(const Value: Single);
+begin
+ FRectF.Left := Value;
+end;
+
+procedure TfsRectF.SetRight(const Value: Single);
+begin
+ FRectF.Right := Value;
+end;
+
+procedure TfsRectF.SetTop(const Value: Single);
+begin
+ FRectF.Top := Value;
+end;
+
+{ TfsMatrix }
+
+procedure TfsMatrix.AssignFromRect(Rect: TMatrix);
+begin
+
+end;
+
+procedure TfsMatrix.AssignToRect(var Rect: TMatrix);
+begin
+
+end;
+
+constructor TfsMatrix.Create(aMatrix: TMatrix);
+begin
+ FMatrix.m11 := aMatrix.m11;
+ FMatrix.m12 := aMatrix.m12;
+ FMatrix.m13 := aMatrix.m13;
+ FMatrix.m21 := aMatrix.m21;
+ FMatrix.m22 := aMatrix.m22;
+ FMatrix.m23 := aMatrix.m23;
+ FMatrix.m31 := aMatrix.m31;
+ FMatrix.m32 := aMatrix.m32;
+ FMatrix.m33 := aMatrix.m33;
+end;
+
+function TfsMatrix.Getm11: Single;
+begin
+ Result := FMatrix.m11;
+end;
+
+function TfsMatrix.Getm12: Single;
+begin
+ Result := FMatrix.m12;
+end;
+
+function TfsMatrix.Getm13: Single;
+begin
+ Result := FMatrix.m13;
+end;
+
+function TfsMatrix.Getm21: Single;
+begin
+ Result := FMatrix.m21;
+end;
+
+function TfsMatrix.Getm22: Single;
+begin
+ Result := FMatrix.m22;
+end;
+
+function TfsMatrix.Getm23: Single;
+begin
+ Result := FMatrix.m23;
+end;
+
+function TfsMatrix.Getm31: Single;
+begin
+ Result := FMatrix.m31;
+end;
+
+function TfsMatrix.Getm32: Single;
+begin
+ Result := FMatrix.m32;
+end;
+
+function TfsMatrix.Getm33: Single;
+begin
+ Result := FMatrix.m33;
+end;
+
+function TfsMatrix.GetRect: TMatrix;
+begin
+ Result := FMatrix;
+end;
+
+procedure TfsMatrix.Setm11(const Value: Single);
+begin
+ FMatrix.m11 := Value;
+end;
+
+procedure TfsMatrix.Setm12(const Value: Single);
+begin
+ FMatrix.m12 := Value;
+end;
+
+procedure TfsMatrix.Setm13(const Value: Single);
+begin
+ FMatrix.m13 := Value;
+end;
+
+procedure TfsMatrix.Setm21(const Value: Single);
+begin
+ FMatrix.m21 := Value;
+end;
+
+procedure TfsMatrix.Setm22(const Value: Single);
+begin
+ FMatrix.m22 := Value;
+end;
+
+procedure TfsMatrix.Setm23(const Value: Single);
+begin
+ FMatrix.m23 := Value;
+end;
+
+procedure TfsMatrix.Setm31(const Value: Single);
+begin
+ FMatrix.m31 := Value;
+end;
+
+procedure TfsMatrix.Setm32(const Value: Single);
+begin
+ FMatrix.m32 := Value;
+end;
+
+procedure TfsMatrix.Setm33(const Value: Single);
+begin
+ FMatrix.m33 := Value;
+end;
+
+{ TfsPointF }
+
+constructor TfsPointF.Create(aPointF: TPointF);
+begin
+ FPointF.X := aPointF.X;
+ FPointF.Y := aPointF.Y;
+end;
+
+function TfsPointF.GetRect: TPointF;
+begin
+ Result := FPointF;
+end;
+
+function TfsPointF.GetRectP: PPointF;
+begin
+ Result := @FPointF;
+end;
+
+function TfsPointF.GetX: Single;
+begin
+ Result := FPointF.X;
+end;
+
+function TfsPointF.GetY: Single;
+begin
+ Result := FPointF.Y;
+end;
+
+procedure TfsPointF.SetX(const Value: Single);
+begin
+ FPointF.X := Value;
+end;
+
+procedure TfsPointF.SetY(const Value: Single);
+begin
+ FPointF.Y := Value;
+end;
+
+{ TfsVector }
+
+constructor TfsVector.Create(aVector: TVector);
+begin
+ FVector.X := aVector.X;
+ FVector.Y := aVector.Y;
+ FVector.W := aVector.W;
+end;
+
+function TfsVector.GetRect: TVector;
+begin
+ Result := FVector;
+end;
+
+function TfsVector.GetRectP: PVector;
+begin
+ Result := @FVector;
+end;
+
+function TfsVector.GetW: Single;
+begin
+ Result := FVector.W;
+end;
+
+function TfsVector.GetX: Single;
+begin
+ Result := FVector.X;
+end;
+
+function TfsVector.GetY: Single;
+begin
+ Result := FVector.Y;
+end;
+
+procedure TfsVector.SetW(const Value: Single);
+begin
+ FVector.W := Value;
+end;
+
+procedure TfsVector.SetX(const Value: Single);
+begin
+ FVector.X := Value;
+end;
+
+procedure TfsVector.SetY(const Value: Single);
+begin
+ FVector.Y := Value;
+end;
+
+{$ENDIF}
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddConst('fmCreate', 'Integer', fmCreate);
+ AddConst('fmOpenRead', 'Integer', fmOpenRead);
+ AddConst('fmOpenWrite', 'Integer', fmOpenWrite);
+ AddConst('fmOpenReadWrite', 'Integer', fmOpenReadWrite);
+ AddConst('fmShareExclusive', 'Integer', fmShareExclusive);
+ AddConst('fmShareDenyWrite', 'Integer', fmShareDenyWrite);
+ AddConst('fmShareDenyNone', 'Integer', fmShareDenyNone);
+ AddConst('soFromBeginning', 'Integer', soFromBeginning);
+ AddConst('soFromCurrent', 'Integer', soFromCurrent);
+ AddConst('soFromEnd', 'Integer', soFromEnd);
+ AddEnum('TDuplicates', 'dupIgnore, dupAccept, dupError');
+ AddEnum('TPrinterOrientation', 'poPortrait, poLandscape');
+
+ with AddClass(TObject, '') do
+ begin
+ AddConstructor('constructor Create', CallMethod);
+ AddMethod('procedure Free', CallMethod);
+ AddMethod('function ClassName: String', CallMethod);
+ end;
+ with AddClass(TPersistent, 'TObject') do
+ AddMethod('procedure Assign(Source: TPersistent)', CallMethod);
+ AddClass(TCollectionItem, 'TPersistent');
+ with AddClass(TCollection, 'TPersistent') do
+ begin
+ AddMethod('procedure Clear', CallMethod);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddDefaultProperty('Items', 'Integer', 'TCollectionItem', CallMethod, True);
+ end;
+ with AddClass(TList, 'TObject') do
+ begin
+ AddMethod('function Add(Item: TObject): Integer', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure Delete(Index: Integer)', CallMethod);
+ AddMethod('function IndexOf(Item: TObject): Integer', CallMethod);
+ AddMethod('procedure Insert(Index: Integer; Item: TObject)', CallMethod);
+ AddMethod('function Remove(Item: TObject): Integer', CallMethod);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddDefaultProperty('Items', 'Integer', 'TObject', CallMethod);
+ end;
+ with AddClass(TStrings, 'TPersistent') do
+ begin
+ AddConstructor('constructor Create', CallMethod);
+ AddMethod('function Add(const S: string): Integer', CallMethod);
+ AddMethod('function AddObject(const S: string; AObject: TObject): Integer', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure Delete(Index: Integer)', CallMethod);
+ AddMethod('function IndexOf(const S: string): Integer', CallMethod);
+ AddMethod('function IndexOfName(const Name: string): Integer', CallMethod);
+ AddMethod('function IndexOfObject(AObject: TObject): Integer', CallMethod);
+ AddMethod('procedure Insert(Index: Integer; const S: string)', CallMethod);
+ AddMethod('procedure InsertObject(Index: Integer; const S: string; AObject: TObject)', CallMethod);
+ AddMethod('procedure LoadFromFile(const FileName: string)', CallMethod);
+ AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure SaveToFile(const FileName: string)', CallMethod);
+ AddMethod('procedure Move(CurIndex, NewIndex: Integer)', CallMethod);
+ AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
+
+ AddProperty('CommaText', 'string', GetProp, SetProp);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddIndexProperty('Names', 'Integer', 'string', CallMethod, True);
+ AddIndexProperty('Objects', 'Integer', 'TObject', CallMethod);
+ AddIndexProperty('Values', 'String', 'string', CallMethod);
+ AddDefaultProperty('Strings', 'Integer', 'string', CallMethod);
+ AddProperty('Text', 'string', GetProp, SetProp);
+ end;
+ with AddClass(TStringList, 'TStrings') do
+ begin
+ AddMethod('function Find(s: String; var Index: Integer): Boolean', CallMethod);
+ AddMethod('procedure Sort', CallMethod);
+ AddProperty('Duplicates', 'TDuplicates', GetProp, SetProp);
+ AddProperty('Sorted', 'Boolean', GetProp, SetProp);
+ end;
+ with AddClass(TStream, 'TObject') do
+ begin
+ AddMethod('function Read(var Buffer: string; Count: Longint): Longint', CallMethod);
+ AddMethod('function Write(Buffer: string; Count: Longint): Longint', CallMethod);
+ AddMethod('function Seek(Offset: Longint; Origin: Word): Longint', CallMethod);
+ AddMethod('function CopyFrom(Source: TStream; Count: Longint): Longint', CallMethod);
+ AddProperty('Position', 'Longint', GetProp, SetProp);
+ AddProperty('Size', 'Longint', GetProp, nil);
+ end;
+ with AddClass(TFileStream, 'TStream') do
+ AddConstructor('constructor Create(Filename: String; Mode: Word)', CallMethod);
+ with AddClass(TMemoryStream, 'TStream') do
+ begin
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure LoadFromFile(Filename: String)', CallMethod);
+ AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure SaveToFile(Filename: String)', CallMethod);
+ end;
+ with AddClass(TComponent, 'TPersistent') do
+ begin
+ AddConstructor('constructor Create(AOwner: TComponent)', CallMethod);
+ AddProperty('Owner', 'TComponent', GetProp, nil);
+ end;
+{$IFDEF FMX}
+ AddClass(TfsRectF, 'TPersistent');
+ AddClass(TfsMatrix, 'TPersistent');
+ AddClass(TfsPointF, 'TPersistent');
+ AddClass(TfsVector, 'TPersistent');
+ with AddClass(TFmxObject, 'TComponent') do
+ begin
+ AddMethod('function Clone(AOwner: TComponent): TFmxObject', CallMethod);
+ AddMethod('procedure CloneChildFromStream(AStream: TStream)', CallMethod);
+ AddMethod('procedure AddObject(AObject: TFmxObject)', CallMethod);
+ AddMethod('procedure InsertObject(Index: Integer; AObject: TFmxObject)', CallMethod);
+ AddMethod('procedure RemoveObject(AObject: TFmxObject)', CallMethod);
+ AddMethod('procedure RemoveObject(Index: Integer)', CallMethod);
+ AddMethod('procedure Exchange(AObject1: TFmxObject; AObject2: TFmxObject)', CallMethod);
+ AddMethod('procedure DeleteChildren()', CallMethod);
+ AddMethod('procedure BringToFront()', CallMethod);
+ AddMethod('procedure SendToBack()', CallMethod);
+ AddMethod('procedure AddObjectsToList(AList: TList)', CallMethod);
+{$IFNDEF DELPHI18}
+ AddMethod('procedure AddControlsToList(AList: TList)', CallMethod);
+{$ENDIF}
+{$IFNDEF DELPHI20}
+ AddMethod('procedure GetTabOrderList(List: TList; AChildren: Boolean)', CallMethod);
+{$ENDIF}
+ AddMethod('procedure LoadFromStream(AStream: TStream)', CallMethod);
+ AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure LoadFromBinStream(AStream: TStream)', CallMethod);
+ AddMethod('procedure SaveToBinStream(AStream: TStream)', CallMethod);
+ AddMethod('function FindStyleResource(AStyleLookup: string): TFmxObject', CallMethod);
+{$IFNDEF DELPHI18}
+ AddMethod('procedure UpdateStyle()', CallMethod);
+{$ENDIF}
+{$IFNDEF DELPHI21}
+ AddMethod('procedure StartAnimation(AName: string)', CallMethod);
+ AddMethod('procedure StopAnimation(AName: string)', CallMethod);
+ AddMethod('procedure StartTriggerAnimation(AInstance: TFmxObject; ATrigger: string)', CallMethod);
+ AddMethod('procedure StartTriggerAnimationWait(AInstance: TFmxObject; ATrigger: string)', CallMethod);
+{$IFDEF DELPHI17}
+ AddMethod('procedure StopTriggerAnimation(AInstance: TFmxObject; ATrigger: string)', CallMethod);
+{$ELSE}
+ AddMethod('procedure StopTriggerAnimation(AInstance: TFmxObject)', CallMethod);
+{$ENDIF}
+
+ AddMethod('procedure ApplyTriggerEffect(AInstance: TFmxObject; ATrigger: string)', CallMethod);
+{$ENDIF}
+ AddMethod('procedure AnimateFloat(APropertyName: string; NewValue: Single; Duration: Single; AType: TAnimationType; AInterpolation: TInterpolationType)', CallMethod);
+ AddMethod('procedure AnimateColor(APropertyName: string; NewValue: TAlphaColor; Duration: Single; AType: TAnimationType; AInterpolation: TInterpolationType)', CallMethod);
+ AddMethod('procedure AnimateFloatDelay(APropertyName: string; NewValue: Single; Duration: Single; Delay: Single; AType: TAnimationType; AInterpolation: TInterpolationType)', CallMethod);
+ AddMethod('procedure AnimateFloatWait(APropertyName: string; NewValue: Single; Duration: Single; AType: TAnimationType; AInterpolation: TInterpolationType)', CallMethod);
+ AddMethod('procedure StopPropertyAnimation(APropertyName: string)', CallMethod);
+ AddProperty('Parent', 'TFmxObject', GetProp, SetProp);
+ AddProperty('Index', 'Integer', GetProp, SetProp);
+ end;
+{$ENDIF}
+ with AddClass(TfsXMLItem, 'TObject') do
+ begin
+ AddConstructor('constructor Create', CallMethod);
+ AddMethod('procedure AddItem(Item: TfsXMLItem)', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure InsertItem(Index: Integer; Item: TfsXMLItem)', CallMethod);
+ AddMethod('function Add: TfsXMLItem', CallMethod);
+ AddMethod('function Find(const Name: String): Integer', CallMethod);
+ AddMethod('function FindItem(const Name: String): TfsXMLItem', CallMethod);
+ AddMethod('function Root: TfsXMLItem', CallMethod);
+ AddProperty('Data', 'Integer', GetProp, SetProp);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddDefaultProperty('Items', 'Integer', 'TfsXMLItem', CallMethod, True);
+ AddIndexProperty('Prop', 'String', 'String', CallMethod);
+ AddProperty('Name', 'String', GetProp, SetProp);
+ AddProperty('Parent', 'TfsXMLItem', GetProp, nil);
+ AddProperty('Text', 'String', GetProp, SetProp);
+ end;
+ with AddClass(TfsXMLDocument, 'TObject') do
+ begin
+ AddConstructor('constructor Create', CallMethod);
+ AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure SaveToFile(const FileName: String)', CallMethod);
+ AddMethod('procedure LoadFromFile(const FileName: String)', CallMethod);
+ AddProperty('Root', 'TfsXMLItem', GetProp, nil);
+ end;
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ i: Integer;
+ s: String;
+ _TList: TList;
+ _TStrings: TStrings;
+ _TStream: TStream;
+ _TMemoryStream: TMemoryStream;
+ _TfsXMLItem: TfsXMLItem;
+ _TfsXMLDocument: TfsXMLDocument;
+{$IFDEF FMX}
+ _fmxObj: TFmxObject;
+{$ENDIF}
+begin
+ Result := 0;
+
+ if ClassType = TObject then
+ begin
+ if MethodName = 'CREATE' then
+ {$IFDEF FPC}
+ begin
+ if Instance is TList then
+ Result := frxInteger(TList.Create)
+ else
+ Result := frxInteger(Instance.Create);
+ end
+ {$ELSE}
+ Result := frxInteger(Instance.Create)
+ {$ENDIF}
+ else if MethodName = 'FREE' then
+ Instance.Free
+ else if MethodName = 'CLASSNAME' then
+ Result := Instance.ClassName
+ end
+ else if ClassType = TPersistent then
+ begin
+ if MethodName = 'ASSIGN' then
+ TPersistent(Instance).Assign(TPersistent(frxInteger(Caller.Params[0])));
+ end
+ else if ClassType = TCollection then
+ begin
+ if MethodName = 'CLEAR' then
+ TCollection(Instance).Clear
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TCollection(Instance).Items[Caller.Params[0]])
+ end
+ else if ClassType = TList then
+ begin
+ _TList := TList(Instance);
+ if MethodName = 'ADD' then
+ _TList.Add(Pointer(frxInteger(Caller.Params[0])))
+ else if MethodName = 'CLEAR' then
+ _TList.Clear
+ else if MethodName = 'DELETE' then
+ _TList.Delete(Caller.Params[0])
+ else if MethodName = 'INDEXOF' then
+ Result := _TList.IndexOf(Pointer(frxInteger(Caller.Params[0])))
+ else if MethodName = 'INSERT' then
+ _TList.Insert(Caller.Params[0], Pointer(frxInteger(Caller.Params[1])))
+ else if MethodName = 'REMOVE' then
+ _TList.Remove(Pointer(frxInteger(Caller.Params[0])))
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(_TList.Items[Caller.Params[0]])
+ else if MethodName = 'ITEMS.SET' then
+ _TList.Items[Caller.Params[0]] := Pointer(frxInteger(Caller.Params[1]))
+ end
+ else if ClassType = TStrings then
+ begin
+ _TStrings := TStrings(Instance);
+ if MethodName = 'CREATE' then
+ Result := frxInteger(_TStrings.Create)
+ else if MethodName = 'ADD' then
+ Result := _TStrings.Add(Caller.Params[0])
+ else if MethodName = 'ADDOBJECT' then
+ Result := _TStrings.AddObject(Caller.Params[0], TObject(frxInteger(Caller.Params[1])))
+ else if MethodName = 'CLEAR' then
+ _TStrings.Clear
+ else if MethodName = 'DELETE' then
+ _TStrings.Delete(Caller.Params[0])
+ else if MethodName = 'INDEXOF' then
+ Result := _TStrings.IndexOf(Caller.Params[0])
+ else if MethodName = 'INDEXOFNAME' then
+ Result := _TStrings.IndexOfName(Caller.Params[0])
+ else if MethodName = 'INDEXOFOBJECT' then
+ Result := _TStrings.IndexOfObject(TObject(frxInteger(Caller.Params[0])))
+ else if MethodName = 'INSERT' then
+ _TStrings.Insert(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'INSERTOBJECT' then
+ _TStrings.InsertObject(Caller.Params[0], Caller.Params[1], TObject(frxInteger(Caller.Params[2])))
+ else if MethodName = 'LOADFROMFILE' then
+ _TStrings.LoadFromFile(Caller.Params[0])
+ else if MethodName = 'LOADFROMSTREAM' then
+ _TStrings.LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'MOVE' then
+ _TStrings.Move(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'SAVETOFILE' then
+ _TStrings.SaveToFile(Caller.Params[0])
+ else if MethodName = 'SAVETOSTREAM' then
+ _TStrings.SaveToStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'NAMES.GET' then
+ Result := _TStrings.Names[Caller.Params[0]]
+ else if MethodName = 'OBJECTS.GET' then
+ Result := frxInteger(_TStrings.Objects[Caller.Params[0]])
+ else if MethodName = 'OBJECTS.SET' then
+ _TStrings.Objects[Caller.Params[0]] := TObject(frxInteger(Caller.Params[1]))
+ else if MethodName = 'VALUES.GET' then
+ Result := _TStrings.Values[Caller.Params[0]]
+ else if MethodName = 'VALUES.SET' then
+ _TStrings.Values[Caller.Params[0]] := Caller.Params[1]
+ else if MethodName = 'STRINGS.GET' then
+ Result := _TStrings.Strings[Caller.Params[0]]
+ else if MethodName = 'STRINGS.SET' then
+ _TStrings.Strings[Caller.Params[0]] := Caller.Params[1]
+ end
+ else if ClassType = TStringList then
+ begin
+ if MethodName = 'FIND' then
+ begin
+ Result := TStringList(Instance).Find(Caller.Params[0], i);
+ Caller.Params[1] := i;
+ end
+ else if MethodName = 'SORT' then
+ TStringList(Instance).Sort
+ end
+ else if ClassType = TStream then
+ begin
+ _TStream := TStream(Instance);
+ if MethodName = 'READ' then
+ begin
+ SetLength(s, Integer(Caller.Params[1]));
+ Result := _TStream.Read(s[1], Caller.Params[1]);
+ SetLength(s, Integer(Result));
+ Caller.Params[0] := s;
+ end
+ else if MethodName = 'WRITE' then
+ begin
+ s := Caller.Params[0];
+ Result := _TStream.Write(s[1], Caller.Params[1]);
+ end
+ else if MethodName = 'SEEK' then
+{$IFDEF DELPHI18}
+ Result := _TStream.Seek(Int64(Caller.Params[0]), Word(Caller.Params[1]))
+{$ELSE}
+{$IFDEF FPC}
+ Result := _TStream.Seek(Int64(Caller.Params[0]), Word(Caller.Params[1]))
+{$ELSE}
+ Result := _TStream.Seek(Caller.Params[0], Caller.Params[1])
+{$ENDIF}
+{$ENDIF}
+ else if MethodName = 'COPYFROM' then
+ Result := _TStream.CopyFrom(TStream(frxInteger(Caller.Params[0])), Caller.Params[1])
+ end
+ else if ClassType = TFileStream then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TFileStream(Instance).Create(Caller.Params[0], Caller.Params[1]))
+ end
+ else if ClassType = TMemoryStream then
+ begin
+ _TMemoryStream := TMemoryStream(Instance);
+ if MethodName = 'CLEAR' then
+ _TMemoryStream.Clear
+ else if MethodName = 'LOADFROMSTREAM' then
+ _TMemoryStream.LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LOADFROMFILE' then
+ _TMemoryStream.LoadFromFile(Caller.Params[0])
+ else if MethodName = 'SAVETOSTREAM' then
+ _TMemoryStream.SaveToStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVETOFILE' then
+ _TMemoryStream.SaveToFile(Caller.Params[0])
+ end
+ else if ClassType = TComponent then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TComponent(Instance).Create(TComponent(frxInteger(Caller.Params[0]))))
+ end
+ else if ClassType = TfsXMLItem then
+ begin
+ _TfsXMLItem := TfsXMLItem(Instance);
+ if MethodName = 'CREATE' then
+ Result := frxInteger(_TfsXMLItem.Create)
+ else if MethodName = 'ADDITEM' then
+ _TfsXMLItem.AddItem(TfsXMLItem(frxInteger(Caller.Params[0])))
+ else if MethodName = 'CLEAR' then
+ _TfsXMLItem.Clear
+ else if MethodName = 'INSERTITEM' then
+ _TfsXMLItem.InsertItem(Caller.Params[0], TfsXMLItem(frxInteger(Caller.Params[1])))
+ else if MethodName = 'ADD' then
+ Result := frxInteger(_TfsXMLItem.Add)
+ else if MethodName = 'FIND' then
+ Result := _TfsXMLItem.Find(Caller.Params[0])
+ else if MethodName = 'FINDITEM' then
+ Result := frxInteger(_TfsXMLItem.FindItem(Caller.Params[0]))
+ else if MethodName = 'PROP.GET' then
+ Result := _TfsXMLItem.Prop[Caller.Params[0]]
+ else if MethodName = 'PROP.SET' then
+ _TfsXMLItem.Prop[Caller.Params[0]] := Caller.Params[1]
+ else if MethodName = 'ROOT' then
+ Result := frxInteger(_TfsXMLItem.Root)
+ else if MethodName = 'ROOT' then
+ Result := frxInteger(_TfsXMLItem.Root)
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(_TfsXMLItem[Caller.Params[0]])
+ end
+ else if ClassType = TfsXMLDocument then
+ begin
+ _TfsXMLDocument := TfsXMLDocument(Instance);
+ if MethodName = 'CREATE' then
+ Result := frxInteger(_TfsXMLDocument.Create)
+ else if MethodName = 'SAVETOSTREAM' then
+ _TfsXMLDocument.SaveToStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LOADFROMSTREAM' then
+ _TfsXMLDocument.LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVETOFILE' then
+ _TfsXMLDocument.SaveToFile(Caller.Params[0])
+ else if MethodName = 'LOADFROMFILE' then
+ _TfsXMLDocument.LoadFromFile(Caller.Params[0])
+ end
+{$IFDEF FMX}
+ else if ClassType = TFmxObject then
+ begin
+ _fmxObj := TFmxObject(Instance);
+ if MethodName = 'CLONE' then
+ Result := frxInteger(_fmxObj.Clone(TComponent(frxInteger(Caller.Params[0]))))
+// else if MethodName = 'CLONECHILDFROMSTREAM' then
+// _fmxObj.CloneChildFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'ADDOBJECT' then
+ _fmxObj.AddObject(TFmxObject(frxInteger(Caller.Params[0])))
+ else if MethodName = 'INSERTOBJECT' then
+ _fmxObj.InsertObject(Integer(Caller.Params[0]), TFmxObject(frxInteger(Caller.Params[1])))
+ else if MethodName = 'REMOVEOBJECT' then
+ _fmxObj.RemoveObject(TFmxObject(frxInteger(Caller.Params[0])))
+ else if MethodName = 'REMOVEOBJECT' then
+ _fmxObj.RemoveObject(Integer(Caller.Params[0]))
+ else if MethodName = 'EXCHANGE' then
+ _fmxObj.Exchange(TFmxObject(frxInteger(Caller.Params[0])), TFmxObject(frxInteger(Caller.Params[1])))
+ else if MethodName = 'DELETECHILDREN' then
+ _fmxObj.DeleteChildren()
+ else if MethodName = 'BRINGTOFRONT' then
+ _fmxObj.BringToFront()
+ else if MethodName = 'SENDTOBACK' then
+ _fmxObj.SendToBack()
+{$IFDEF DELPHI17}
+ else if MethodName = 'ADDOBJECTSTOLIST' then
+ _fmxObj.AddObjectsToList(TFmxObjectList(frxInteger(Caller.Params[0])))
+{$IFNDEF DELPHI18}
+ else if MethodName = 'ADDCONTROLSTOLIST' then
+ _fmxObj.AddControlsToList(TFmxObjectList(frxInteger(Caller.Params[0])))
+{$ENDIF}
+{$IFNDEF DELPHI20}
+ else if MethodName = 'GETTABORDERLIST' then
+ _fmxObj.GetTabOrderList(TInterfaceList(frxInteger(Caller.Params[0])), Boolean(Caller.Params[1]))
+{$ENDIF}
+{$ELSE}
+ else if MethodName = 'ADDOBJECTSTOLIST' then
+ _fmxObj.AddObjectsToList(TList(frxInteger(Caller.Params[0])))
+ else if MethodName = 'ADDCONTROLSTOLIST' then
+ _fmxObj.AddControlsToList(TList(frxInteger(Caller.Params[0])))
+ else if MethodName = 'GETTABORDERLIST' then
+ _fmxObj.GetTabOrderList(TList(frxInteger(Caller.Params[0])), Boolean(Caller.Params[1]))
+ else if MethodName = 'LOADFROMSTREAM' then
+ _fmxObj.LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVETOSTREAM' then
+ _fmxObj.SaveToStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LOADFROMBINSTREAM' then
+ _fmxObj.LoadFromBinStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVETOBINSTREAM' then
+ _fmxObj.SaveToBinStream(TStream(frxInteger(Caller.Params[0])))
+{$ENDIF}
+ else if MethodName = 'FINDSTYLERESOURCE' then
+ Result := frxInteger(_fmxObj.FindStyleResource(string(Caller.Params[0])))
+{$IFNDEF DELPHI18}
+ else if MethodName = 'UPDATESTYLE' then
+ _fmxObj.UpdateStyle()
+{$ENDIF}
+{$IFNDEF DELPHI21}
+ else if MethodName = 'STARTANIMATION' then
+ _fmxObj.StartAnimation(string(Caller.Params[0]))
+ else if MethodName = 'STOPANIMATION' then
+ _fmxObj.StopAnimation(string(Caller.Params[0]))
+ else if MethodName = 'STARTTRIGGERANIMATION' then
+ _fmxObj.StartTriggerAnimation(TFmxObject(frxInteger(Caller.Params[0])), string(Caller.Params[1]))
+ else if MethodName = 'STARTTRIGGERANIMATIONWAIT' then
+ _fmxObj.StartTriggerAnimationWait(TFmxObject(frxInteger(Caller.Params[0])), string(Caller.Params[1]))
+ else if MethodName = 'STOPTRIGGERANIMATION' then
+{$IFDEF DELPHI17}
+ _fmxObj.StopTriggerAnimation(TFmxObject(frxInteger(Caller.Params[0])), string(Caller.Params[1]))
+{$ELSE}
+ _fmxObj.StopTriggerAnimation(TFmxObject(frxInteger(Caller.Params[0])))
+{$ENDIF}
+ else if MethodName = 'APPLYTRIGGEREFFECT' then
+ _fmxObj.ApplyTriggerEffect(TFmxObject(frxInteger(Caller.Params[0])), string(Caller.Params[1]))
+{$ENDIF}
+ else if MethodName = 'ANIMATEFLOAT' then
+ _fmxObj.AnimateFloat(string(Caller.Params[0]), Single(Caller.Params[1]), Single(Caller.Params[2]), TAnimationType(Caller.Params[3]), TInterpolationType(Caller.Params[4]))
+ else if MethodName = 'ANIMATECOLOR' then
+ _fmxObj.AnimateColor(string(Caller.Params[0]), TAlphaColor(Caller.Params[1]), Single(Caller.Params[2]), TAnimationType(Caller.Params[3]), TInterpolationType(Caller.Params[4]))
+ else if MethodName = 'ANIMATEFLOATDELAY' then
+ _fmxObj.AnimateFloatDelay(string(Caller.Params[0]), Single(Caller.Params[1]), Single(Caller.Params[2]), Single(Caller.Params[3]), TAnimationType(Caller.Params[4]), TInterpolationType(Caller.Params[5]))
+ else if MethodName = 'ANIMATEFLOATWAIT' then
+ _fmxObj.AnimateFloatWait(string(Caller.Params[0]), Single(Caller.Params[1]), Single(Caller.Params[2]), TAnimationType(Caller.Params[3]), TInterpolationType(Caller.Params[4]))
+ else if MethodName = 'STOPPROPERTYANIMATION' then
+ _fmxObj.StopPropertyAnimation(string(Caller.Params[0]))
+end;
+{$ENDIF}
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TCollection then
+ begin
+ if PropName = 'COUNT' then
+ Result := TCollection(Instance).Count
+ end
+ else if ClassType = TList then
+ begin
+ if PropName = 'COUNT' then
+ Result := TList(Instance).Count
+ end
+ else if ClassType = TStrings then
+ begin
+ if PropName = 'COMMATEXT' then
+ Result := TStrings(Instance).CommaText
+ else if PropName = 'COUNT' then
+ Result := TStrings(Instance).Count
+ else if PropName = 'TEXT' then
+ Result := TStrings(Instance).Text
+ end
+ else if ClassType = TStringList then
+ begin
+ if PropName = 'DUPLICATES' then
+ Result := TStringList(Instance).Duplicates
+ else if PropName = 'SORTED' then
+ Result := TStringList(Instance).Sorted
+ end
+ else if ClassType = TStream then
+ begin
+ if PropName = 'POSITION' then
+ Result := TStream(Instance).Position
+ else if PropName = 'SIZE' then
+ Result := TStream(Instance).Size
+ end
+ else if ClassType = TComponent then
+ begin
+ if PropName = 'OWNER' then
+ Result := frxInteger(TComponent(Instance).Owner)
+ end
+ else if ClassType = TfsXMLItem then
+ begin
+ if PropName = 'DATA' then
+ Result := frxInteger(TfsXMLItem(Instance).Data)
+ else if PropName = 'COUNT' then
+ Result := TfsXMLItem(Instance).Count
+ else if PropName = 'NAME' then
+ Result := TfsXMLItem(Instance).Name
+ else if PropName = 'PARENT' then
+ Result := frxInteger(TfsXMLItem(Instance).Parent)
+ else if PropName = 'TEXT' then
+ Result := TfsXMLItem(Instance).Text
+ end
+ else if ClassType = TfsXMLDocument then
+ begin
+ if PropName = 'ROOT' then
+ Result := frxInteger(TfsXMLDocument(Instance).Root)
+ end
+ {$IFDEF FMX}
+ else if ClassType = TFmxObject then
+ begin
+ if PropName = 'PARENT' then
+ Result := frxInteger(TFmxObject(Instance).Parent)
+ else if PropName = 'INDEX' then
+ Result := TFmxObject(Instance).Index
+ end
+ {$ENDIF}
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TStrings then
+ begin
+ if PropName = 'COMMATEXT' then
+ TStrings(Instance).CommaText := Value
+ else if PropName = 'TEXT' then
+ TStrings(Instance).Text := Value
+ end
+ else if ClassType = TStringList then
+ begin
+ if PropName = 'DUPLICATES' then
+ TStringList(Instance).Duplicates := Value
+ else if PropName = 'SORTED' then
+ TStringList(Instance).Sorted := Value
+ end
+ else if ClassType = TStream then
+ begin
+ if PropName = 'POSITION' then
+ TStream(Instance).Position := Value
+ end
+ else if ClassType = TfsXMLItem then
+ begin
+ if PropName = 'DATA' then
+ TfsXMLItem(Instance).Data := Pointer(frxInteger(Value))
+ else if PropName = 'NAME' then
+ TfsXMLItem(Instance).Name := Value
+ else if PropName = 'TEXT' then
+ TfsXMLItem(Instance).Text := Value
+ end
+ {$IFDEF FMX}
+ else if ClassType = TFmxObject then
+ begin
+ if PropName = 'PARENT' then
+ TFmxObject(Instance).Parent := TFmxObject(frxInteger(Value))
+ else if PropName = 'INDEX' then
+ TFmxObject(Instance).Index := Value
+ end
+ {$ENDIF}
+end;
+
+
+initialization
+{$IFDEF DELPHI16}
+{$IFDEF FMX}
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsClassesRTTI, TFmxObject);
+{$ELSE}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsClassesRTTI, TControl);
+{$ENDIF}
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/fs_iconst.pas b/FastScript/fs_iconst.pas
new file mode 100644
index 0000000..cba1878
--- /dev/null
+++ b/FastScript/fs_iconst.pas
@@ -0,0 +1,66 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Resources }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_iconst;
+{$ENDIF}
+
+interface
+
+{$i fs.inc}
+
+var
+ SLangNotFound: String;
+ SInvalidLanguage: String;
+ SIdRedeclared: String;
+ SUnknownType: String;
+ SIncompatibleTypes: String;
+ SIdUndeclared: String;
+ SClassRequired: String;
+ SIndexRequired: String;
+ SStringError: String;
+ SClassError: String;
+ SArrayRequired: String;
+ SVarRequired: String;
+ SNotEnoughParams: String;
+ STooManyParams: String;
+ SLeftCantAssigned: String;
+ SForError: String;
+ SEventError: String;
+ SComponentError: String;
+ SComponentAssignError: String;
+
+
+implementation
+
+initialization
+ SLangNotFound := 'Language ''%s'' not found';
+ SInvalidLanguage := 'Invalid language definition';
+ SIdRedeclared := 'Identifier redeclared: ';
+ SUnknownType := 'Unknown type: ';
+ SIncompatibleTypes := 'Incompatible types';
+ SIdUndeclared := 'Undeclared identifier: ';
+ SClassRequired := 'Class type required';
+ SIndexRequired := 'Index required';
+ SStringError := 'Strings doesn''t have properties or methods';
+ SClassError := 'Class %s does not have a default property';
+ SArrayRequired := 'Array type required';
+ SVarRequired := 'Variable required';
+ SNotEnoughParams := 'Not enough actual parameters';
+ STooManyParams := 'Too many actual parameters';
+ SLeftCantAssigned := 'Left side cannot be assigned to';
+ SForError := 'For loop variable must be numeric variable';
+ SEventError := 'Event handler must be a procedure';
+ SComponentError := 'Component with name %s not found';
+ SComponentAssignError := 'Can not assign value to component field %s';
+
+end.
diff --git a/FastScript/fs_icpp.pas b/FastScript/fs_icpp.pas
new file mode 100644
index 0000000..dc1f955
--- /dev/null
+++ b/FastScript/fs_icpp.pas
@@ -0,0 +1,183 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ C++ grammar }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_icpp;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_itools{$IFDEF DELPHI16}, Controls{$ENDIF};
+{$ELSE}
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_itools, FMX.Types;
+{$ENDIF}
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsCPP = class(TComponent);
+
+
+implementation
+
+const
+ CPP_GRAMMAR =
+ '' +
+ '' +
+ '<' +
+ 'err20 text="''>'' expected"/>' +
+ '' +
+ '' +
+ '<' +
+ 'sequence>' +
+ '<' +
+ 'sequence>' +
+ '' +
+ '' +
+ '' +
+ '';
+
+
+initialization
+{$IFDEF DELPHI16}
+{$IFDEF FMX}
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsCPP, TFmxObject);
+{$ELSE}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsCPP, TControl);
+{$ENDIF}
+{$ENDIF}
+ fsRegisterLanguage('C++Script', CPP_GRAMMAR);
+
+end.
diff --git a/FastScript/fs_idbctrlsrtti.pas b/FastScript/fs_idbctrlsrtti.pas
new file mode 100644
index 0000000..accf4b5
--- /dev/null
+++ b/FastScript/fs_idbctrlsrtti.pas
@@ -0,0 +1,189 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ DB controls }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_idbctrlsrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, fs_itools, fs_iformsrtti, fs_idbrtti, DB
+{$IFDEF CLX}
+, QDBCtrls, QDBGrids
+{$ELSE}
+, DBCtrls, DBGrids
+{$ENDIF}
+{$IFDEF DELPHI16}, Controls{$ENDIF};
+
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsDBCtrlsRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+{$IFNDEF FPC}
+ THackDBLookupControl = class(TDBLookupControl);
+{$ENDIF}
+
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnumSet('TButtonSet', 'nbFirst, nbPrior, nbNext, nbLast,' +
+ 'nbInsert, nbDelete, nbEdit, nbPost, nbCancel, nbRefresh');
+ AddEnum('TColumnButtonStyle', 'cbsAuto, cbsEllipsis, cbsNone');
+ AddEnumSet('TDBGridOptions', 'dgEditing, dgAlwaysShowEditor, dgTitles,' +
+ 'dgIndicator, dgColumnResize, dgColLines, dgRowLines, dgTabs, dgRowSelect,' +
+ 'dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit, dgMultiSelect');
+
+ AddClass(TDBEdit, 'TWinControl');
+ AddClass(TDBText, 'TGraphicControl');
+ with AddClass(TDBCheckBox, 'TWinControl') do
+ AddProperty('Checked', 'Boolean', GetProp, nil);
+ with AddClass(TDBComboBox, 'TCustomComboBox') do
+ AddProperty('Text', 'String', GetProp, nil);
+ AddClass(TDBListBox, 'TCustomListBox');
+ with AddClass(TDBRadioGroup, 'TWinControl') do
+ begin
+ AddProperty('ItemIndex', 'Integer', GetProp, nil);
+ AddProperty('Value', 'String', GetProp, nil);
+ end;
+ AddClass(TDBMemo, 'TWinControl');
+ AddClass(TDBImage, 'TCustomControl');
+ AddClass(TDBNavigator, 'TWinControl');
+{$IFNDEF FPC}
+ with AddClass(TDBLookupControl, 'TCustomControl') do
+ AddProperty('KeyValue', 'Variant', GetProp, SetProp);
+ with AddClass(TDBLookupListBox, 'TDBLookupControl') do
+ AddProperty('SelectedItem', 'String', GetProp, nil);
+ with AddClass(TDBLookupComboBox, 'TDBLookupControl') do
+ AddProperty('Text', 'String', GetProp, nil);
+{$ENDIF}
+ AddClass(TColumnTitle, 'TPersistent');
+ AddClass(TColumn, 'TPersistent');
+ with AddClass(TDBGridColumns, 'TCollection') do
+ begin
+ AddMethod('function Add: TColumn', CallMethod);
+ AddMethod('procedure RebuildColumns', CallMethod);
+ AddMethod('procedure RestoreDefaults', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TColumn', CallMethod, True);
+ end;
+ AddClass(TDBGrid, 'TWinControl');
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TDBGridColumns then
+ begin
+ if MethodName = 'ADD' then
+ Result := frxInteger(TDBGridColumns(Instance).Add)
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TDBGridColumns(Instance).Items[Caller.Params[0]])
+{$IFNDEF FPC}
+ else if MethodName = 'REBUILDCOLUMNS' then
+ TDBGridColumns(Instance).RebuildColumns
+ else if MethodName = 'RESTOREDEFAULTS' then
+ TDBGridColumns(Instance).RestoreDefaults
+{$ENDIF}
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TDBCheckBox then
+ begin
+ if PropName = 'CHECKED' then
+ Result := TDBCheckBox(Instance).Checked
+ end
+ else if ClassType = TDBComboBox then
+ begin
+ if PropName = 'TEXT' then
+ Result := TDBComboBox(Instance).Text
+ end
+ else if ClassType = TDBRadioGroup then
+ begin
+ if PropName = 'ITEMINDEX' then
+ Result := TDBRadioGroup(Instance).ItemIndex
+ else if PropName = 'VALUE' then
+ Result := TDBRadioGroup(Instance).Value
+ end
+{$IFNDEF FPC}
+ else if ClassType = TDBLookupControl then
+ begin
+ if PropName = 'KEYVALUE' then
+ Result := THackDBLookupControl(Instance).KeyValue
+ end
+ else if ClassType = TDBLookupListBox then
+ begin
+ if PropName = 'SELECTEDITEM' then
+ Result := TDBLookupListBox(Instance).SelectedItem
+ end
+ else if ClassType = TDBLookupComboBox then
+ begin
+ if PropName = 'TEXT' then
+ Result := TDBLookupComboBox(Instance).Text
+ end
+{$ENDIF}
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+{$IFNDEF FPC}
+ if ClassType = TDBLookupControl then
+ begin
+ if PropName = 'KEYVALUE' then
+ THackDBLookupControl(Instance).KeyValue := Value
+ end
+{$ENDIF}
+end;
+
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsDBCtrlsRTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/fs_idbreg.pas b/FastScript/fs_idbreg.pas
new file mode 100644
index 0000000..3c4dcbf
--- /dev/null
+++ b/FastScript/fs_idbreg.pas
@@ -0,0 +1,46 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_idbreg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ Classes
+{$IFNDEF Delphi6}
+, DsgnIntf
+{$ELSE}
+, DesignIntf
+{$ENDIF}
+{$IFDEF DELPHI16}
+, Controls
+{$ENDIF}
+, fs_idbrtti, fs_idbctrlsrtti;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+{$IFDEF DELPHI16}
+ //GroupDescendentsWith(TfsDBRTTI, TControl);
+ //GroupDescendentsWith(TfsDBCtrlsRTTI, TControl);
+{$ENDIF}
+ RegisterComponents('FastScript', [TfsDBRTTI, TfsDBCtrlsRTTI]);
+end;
+
+end.
diff --git a/FastScript/fs_idbrtti.pas b/FastScript/fs_idbrtti.pas
new file mode 100644
index 0000000..d389fd4
--- /dev/null
+++ b/FastScript/fs_idbrtti.pas
@@ -0,0 +1,583 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ DB.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_idbrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, fs_itools, fs_iclassesrtti, fs_ievents,
+ DB
+{$IFDEF Delphi16}
+ , System.Types
+{$ENDIF}
+{$IFDEF DELPHI16}, Controls{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsDBRTTI = class(TComponent); // fake component
+
+ TfsDatasetNotifyEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Dataset: TDataset);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsFilterRecordEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(DataSet: TDataSet; var Accept: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsFieldGetTextEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TField; var Text: String; DisplayText: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TfsDatasetNotifyEvent }
+
+procedure TfsDatasetNotifyEvent.DoEvent(Dataset: TDataset);
+begin
+ CallHandler([Dataset]);
+end;
+
+function TfsDatasetNotifyEvent.GetMethod: Pointer;
+begin
+ Result := @TfsDatasetNotifyEvent.DoEvent;
+end;
+
+
+{ TfsFilterRecordEvent }
+
+procedure TfsFilterRecordEvent.DoEvent(DataSet: TDataSet; var Accept: Boolean);
+begin
+ CallHandler([DataSet, Accept]);
+ Accept := Handler.Params[1].Value;
+end;
+
+function TfsFilterRecordEvent.GetMethod: Pointer;
+begin
+ Result := @TfsFilterRecordEvent.DoEvent;
+end;
+
+
+{ TfsFieldGetTextEvent }
+
+procedure TfsFieldGetTextEvent.DoEvent(Sender: TField; var Text: String; DisplayText: Boolean);
+begin
+ CallHandler([Sender, Text, DisplayText]);
+ Text := Handler.Params[1].Value;
+end;
+
+function TfsFieldGetTextEvent.GetMethod: Pointer;
+begin
+ Result := @TfsFieldGetTextEvent.DoEvent;
+end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TFieldType', 'ftUnknown, ftString, ftSmallint, ftInteger, ftWord,' +
+ 'ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,' +
+ 'ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,' +
+ 'ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString,' +
+ 'ftLargeint, ftADT, ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob,' +
+ 'ftVariant, ftInterface, ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd');
+ AddEnum('TBlobStreamMode', 'bmRead, bmWrite, bmReadWrite');
+ AddEnumSet('TLocateOptions', 'loCaseInsensitive, loPartialKey');
+ AddEnumSet('TFilterOptions', 'foCaseInsensitive, foNoPartialCompare');
+ AddEnum('TParamType', 'ptUnknown, ptInput, ptOutput, ptInputOutput, ptResult');
+
+ with AddClass(TField, 'TComponent') do
+ begin
+ AddProperty('AsBoolean', 'Boolean', GetProp, SetProp);
+ AddProperty('AsCurrency', 'Currency', GetProp, SetProp);
+ AddProperty('AsDateTime', 'TDateTime', GetProp, SetProp);
+ AddProperty('AsFloat', 'Double', GetProp, SetProp);
+ AddProperty('AsInteger', 'Integer', GetProp, SetProp);
+ AddProperty('AsString', 'String', GetProp, SetProp);
+ AddProperty('AsVariant', 'Variant', GetProp, SetProp);
+ AddProperty('DataType', 'TFieldType', GetProp, nil);
+ AddProperty('DisplayName', 'String', GetProp, nil);
+ AddProperty('DisplayText', 'String', GetProp, nil);
+ AddProperty('IsNull', 'Boolean', GetProp, nil);
+ AddProperty('Size', 'Integer', GetProp, SetProp);
+ AddProperty('Value', 'Variant', GetProp, SetProp);
+ AddProperty('OldValue', 'Variant', GetProp, nil);
+ AddEvent('OnGetText', TfsFieldGetTextEvent);
+ end;
+ with AddClass(TFields, 'TObject') do
+ AddDefaultProperty('Fields', 'Integer', 'TField', CallMethod, True);
+ AddClass(TStringField, 'TField');
+ AddClass(TNumericField, 'TField');
+ AddClass(TIntegerField, 'TNumericField');
+ AddClass(TSmallIntField, 'TIntegerField');
+ AddClass(TWordField, 'TIntegerField');
+ AddClass(TAutoIncField, 'TIntegerField');
+ AddClass(TFloatField, 'TNumericField');
+ AddClass(TCurrencyField, 'TFloatField');
+ AddClass(TBooleanField, 'TField');
+ AddClass(TDateTimeField, 'TField');
+ AddClass(TDateField, 'TDateTimeField');
+ AddClass(TTimeField, 'TDateTimeField');
+ AddClass(TBinaryField, 'TField');
+ AddClass(TBytesField, 'TBinaryField');
+ AddClass(TVarBytesField, 'TBinaryField');
+ AddClass(TBCDField, 'TNumericField');
+ with AddClass(TBlobField, 'TField') do
+ begin
+ AddMethod('procedure LoadFromFile(const FileName: String)', CallMethod);
+ AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure SaveToFile(const FileName: String)', CallMethod);
+ AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
+ end;
+ AddClass(TMemoField, 'TBlobField');
+ AddClass(TGraphicField, 'TBlobField');
+ AddClass(TFieldDef, 'TPersistent');
+ with AddClass(TFieldDefs, 'TObject') do
+ begin
+ AddMethod('function AddFieldDef: TFieldDef', CallMethod);
+ AddMethod('function Find(const Name: string): TFieldDef', CallMethod);
+ AddMethod('procedure Add(const Name: string; DataType: TFieldType; Size: Word; Required: Boolean)', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure Update', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TFieldDef', CallMethod, True);
+ end;
+ AddClass(TDataSource, 'TComponent');
+ AddType('TBookmark', fvtVariant);
+ with AddClass(TDataSet, 'TComponent') do
+ begin
+ AddMethod('procedure Open', CallMethod);
+ AddMethod('procedure Close', CallMethod);
+ AddMethod('procedure First', CallMethod);
+ AddMethod('procedure Last', CallMethod);
+ AddMethod('procedure Next', CallMethod);
+ AddMethod('procedure Prior', CallMethod);
+ AddMethod('procedure Cancel', CallMethod);
+ AddMethod('procedure Delete', CallMethod);
+ AddMethod('procedure Post', CallMethod);
+ AddMethod('procedure Append', CallMethod);
+ AddMethod('procedure Insert', CallMethod);
+ AddMethod('procedure Edit', CallMethod);
+
+ AddMethod('function FieldByName(const FieldName: string): TField', CallMethod);
+ AddMethod('procedure GetFieldNames(List: TStrings)', CallMethod);
+ AddMethod('function FindFirst: Boolean', CallMethod);
+ AddMethod('function FindLast: Boolean', CallMethod);
+ AddMethod('function FindNext: Boolean', CallMethod);
+ AddMethod('function FindPrior: Boolean', CallMethod);
+ AddMethod('procedure FreeBookmark(Bookmark: TBookmark)', CallMethod);
+ AddMethod('function GetBookmark: TBookmark', CallMethod);
+ AddMethod('procedure GotoBookmark(Bookmark: TBookmark)', CallMethod);
+ AddMethod('function Locate(const KeyFields: string; const KeyValues: Variant;' +
+ 'Options: TLocateOptions): Boolean', CallMethod);
+ AddMethod('function IsEmpty: Boolean', CallMethod);
+ AddMethod('procedure EnableControls', CallMethod);
+ AddMethod('procedure DisableControls', CallMethod);
+
+ AddProperty('Bof', 'Boolean', GetProp, nil);
+ AddProperty('Eof', 'Boolean', GetProp, nil);
+ AddProperty('FieldCount', 'Integer', GetProp, nil);
+ AddProperty('FieldDefs', 'TFieldDefs', GetProp, nil);
+ AddProperty('Fields', 'TFields', GetProp, nil);
+ AddProperty('Filter', 'string', GetProp, SetProp);
+ AddProperty('Filtered', 'Boolean', GetProp, SetProp);
+ AddProperty('FilterOptions', 'TFilterOptions', GetProp, SetProp);
+ AddProperty('Active', 'Boolean', GetProp, SetProp);
+
+ AddEvent('BeforeOpen', TfsDatasetNotifyEvent);
+ AddEvent('AfterOpen', TfsDatasetNotifyEvent);
+ AddEvent('BeforeClose', TfsDatasetNotifyEvent);
+ AddEvent('AfterClose', TfsDatasetNotifyEvent);
+ AddEvent('BeforeInsert', TfsDatasetNotifyEvent);
+ AddEvent('AfterInsert', TfsDatasetNotifyEvent);
+ AddEvent('BeforeEdit', TfsDatasetNotifyEvent);
+ AddEvent('AfterEdit', TfsDatasetNotifyEvent);
+ AddEvent('BeforePost', TfsDatasetNotifyEvent);
+ AddEvent('AfterPost', TfsDatasetNotifyEvent);
+ AddEvent('BeforeCancel', TfsDatasetNotifyEvent);
+ AddEvent('AfterCancel', TfsDatasetNotifyEvent);
+ AddEvent('BeforeDelete', TfsDatasetNotifyEvent);
+ AddEvent('AfterDelete', TfsDatasetNotifyEvent);
+ AddEvent('BeforeScroll', TfsDatasetNotifyEvent);
+ AddEvent('AfterScroll', TfsDatasetNotifyEvent);
+ AddEvent('OnCalcFields', TfsDatasetNotifyEvent);
+ AddEvent('OnFilterRecord', TfsFilterRecordEvent);
+ AddEvent('OnNewRecord', TfsDatasetNotifyEvent);
+ end;
+
+ with AddClass(TParam, 'TPersistent') do
+ begin
+ AddMethod('procedure Clear', CallMethod);
+ AddProperty('AsBoolean', 'Boolean', GetProp, SetProp);
+ AddProperty('AsCurrency', 'Currency', GetProp, SetProp);
+ AddProperty('AsDateTime', 'TDateTime', GetProp, SetProp);
+ AddProperty('AsFloat', 'Double', GetProp, SetProp);
+ AddProperty('AsInteger', 'Integer', GetProp, SetProp);
+ AddProperty('AsDate', 'TDate', GetProp, SetProp);
+ AddProperty('AsTime', 'TTime', GetProp, SetProp);
+ AddProperty('AsString', 'String', GetProp, SetProp);
+ AddProperty('Bound', 'Boolean', GetProp, SetProp);
+ AddProperty('IsNull', 'Boolean', GetProp, nil);
+ AddProperty('Text', 'String', GetProp, SetProp);
+ end;
+ with AddClass(TParams, 'TPersistent') do
+ begin
+ AddMethod('function ParamByName(const Value: string): TParam', CallMethod);
+ AddMethod('function FindParam(const Value: string): TParam', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TParam', CallMethod, True);
+ end;
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ _TDataSet: TDataSet;
+
+ function IntToLocateOptions(i: Integer): TLocateOptions;
+ begin
+ Result := [];
+ if (i and 1) <> 0 then
+ Result := Result + [loCaseInsensitive];
+ if (i and 2) <> 0 then
+ Result := Result + [loPartialKey];
+ end;
+
+begin
+ Result := 0;
+
+ if ClassType = TFields then
+ begin
+ if MethodName = 'FIELDS.GET' then
+ Result := frxInteger(TFields(Instance)[Caller.Params[0]])
+ end
+ else if ClassType = TFieldDefs then
+ begin
+ if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TFieldDefs(Instance)[Caller.Params[0]])
+ else if MethodName = 'ADD' then
+ TFieldDefs(Instance).Add(Caller.Params[0], TFieldType(Caller.Params[1]), Caller.Params[2], Caller.Params[3])
+ else if MethodName = 'ADDFIELDDEF' then
+ Result := frxInteger(TFieldDefs(Instance).AddFieldDef)
+ else if MethodName = 'CLEAR' then
+ TFieldDefs(Instance).Clear
+ else if MethodName = 'FIND' then
+ Result := frxInteger(TFieldDefs(Instance).Find(Caller.Params[0]))
+ else if MethodName = 'UPDATE' then
+ TFieldDefs(Instance).Update
+ end
+ else if ClassType = TBlobField then
+ begin
+ if MethodName = 'LOADFROMFILE' then
+ TBlobField(Instance).LoadFromFile(Caller.Params[0])
+ else if MethodName = 'LOADFROMSTREAM' then
+ TBlobField(Instance).LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVETOFILE' then
+ TBlobField(Instance).SaveToFile(Caller.Params[0])
+ else if MethodName = 'SAVETOSTREAM' then
+ TBlobField(Instance).SaveToStream(TStream(frxInteger(Caller.Params[0])))
+ end
+ else if ClassType = TDataSet then
+ begin
+ _TDataSet := TDataSet(Instance);
+ if MethodName = 'OPEN' then
+ _TDataSet.Open
+ else if MethodName = 'CLOSE' then
+ _TDataSet.Close
+ else if MethodName = 'FIRST' then
+ _TDataSet.First
+ else if MethodName = 'LAST' then
+ _TDataSet.Last
+ else if MethodName = 'NEXT' then
+ _TDataSet.Next
+ else if MethodName = 'PRIOR' then
+ _TDataSet.Prior
+ else if MethodName = 'CANCEL' then
+ _TDataSet.Cancel
+ else if MethodName = 'DELETE' then
+ _TDataSet.Delete
+ else if MethodName = 'POST' then
+ _TDataSet.Post
+ else if MethodName = 'APPEND' then
+ _TDataSet.Append
+ else if MethodName = 'INSERT' then
+ _TDataSet.Insert
+ else if MethodName = 'EDIT' then
+ _TDataSet.Edit
+ else if MethodName = 'FIELDBYNAME' then
+ Result := frxInteger(_TDataSet.FieldByName(Caller.Params[0]))
+ else if MethodName = 'GETFIELDNAMES' then
+ _TDataSet.GetFieldNames(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'FINDFIRST' then
+ Result := _TDataSet.FindFirst
+ else if MethodName = 'FINDLAST' then
+ Result := _TDataSet.FindLast
+ else if MethodName = 'FINDNEXT' then
+ Result := _TDataSet.FindNext
+ else if MethodName = 'FINDPRIOR' then
+ Result := _TDataSet.FindPrior
+ else if MethodName = 'FREEBOOKMARK' then
+ _TDataSet.FreeBookmark(TBookMark(frxInteger(Caller.Params[0])))
+
+ else if MethodName = 'GETBOOKMARK' then
+{$IFDEF DELPHI16}
+ Result := Variant(_TDataSet.GetBookmark)
+{$ELSE}
+ Result := Variant(frxInteger(_TDataSet.GetBookmark))
+{$ENDIF}
+ else if MethodName = 'GOTOBOOKMARK' then
+{$IFDEF DELPHI16}
+ _TDataSet.GotoBookmark(TBookMark(Variant(Caller.Params[0])))
+{$ELSE}
+ _TDataSet.GotoBookmark(TBookMark(frxInteger(Caller.Params[0])))
+{$ENDIF}
+ else if MethodName = 'LOCATE' then
+ Result := _TDataSet.Locate(Caller.Params[0], Caller.Params[1], IntToLocateOptions(Caller.Params[2]))
+ else if MethodName = 'ISEMPTY' then
+ Result := _TDataSet.IsEmpty
+ else if MethodName = 'ENABLECONTROLS' then
+ _TDataSet.EnableControls
+ else if MethodName = 'DISABLECONTROLS' then
+ _TDataSet.DisableControls
+ end
+ else if ClassType = TParam then
+ begin
+ if MethodName = 'CLEAR' then
+ TParam(Instance).Clear
+ end
+ else if ClassType = TParams then
+ begin
+ if MethodName = 'PARAMBYNAME' then
+ Result := frxInteger(TParams(Instance).ParamByName(Caller.Params[0]))
+ else if MethodName = 'FINDPARAM' then
+ Result := frxInteger(TParams(Instance).FindParam(Caller.Params[0]))
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TParams(Instance)[Caller.Params[0]])
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+var
+ _TField: TField;
+ _TParam: TParam;
+ _TDataSet: TDataSet;
+
+ function FilterOptionsToInt(f: TFilterOptions): Integer;
+ begin
+ Result := 0;
+ if foCaseInsensitive in f then
+ Result := Result or 1;
+ if foNoPartialCompare in f then
+ Result := Result or 2;
+ end;
+
+begin
+ Result := 0;
+
+ if ClassType = TField then
+ begin
+ _TField := TField(Instance);
+ if PropName = 'ASBOOLEAN' then
+ Result := _TField.AsBoolean
+ else if PropName = 'ASCURRENCY' then
+ Result := _TField.AsCurrency
+ else if PropName = 'ASDATETIME' then
+ Result := _TField.AsDateTime
+ else if PropName = 'ASFLOAT' then
+ Result := _TField.AsFloat
+ else if PropName = 'ASINTEGER' then
+ Result := _TField.AsInteger
+ else if PropName = 'ASSTRING' then
+ Result := _TField.AsString
+ else if PropName = 'ASVARIANT' then
+ Result := _TField.AsVariant
+ else if PropName = 'DATATYPE' then
+ Result := _TField.DataType
+ else if PropName = 'DISPLAYNAME' then
+ Result := _TField.DisplayName
+ else if PropName = 'DISPLAYTEXT' then
+ Result := _TField.DisplayText
+ else if PropName = 'ISNULL' then
+ Result := _TField.IsNull
+ else if PropName = 'SIZE' then
+ Result := _TField.Size
+ else if PropName = 'VALUE' then
+ Result := _TField.Value
+ else if PropName = 'OLDVALUE' then
+ Result := _TField.OldValue
+ end
+ else if ClassType = TDataSet then
+ begin
+ _TDataSet := TDataSet(Instance);
+ if PropName = 'BOF' then
+ Result := _TDataSet.Bof
+ else if PropName = 'EOF' then
+ Result := _TDataSet.Eof
+ else if PropName = 'FIELDCOUNT' then
+ Result := _TDataSet.FieldCount
+ else if PropName = 'FIELDDEFS' then
+ Result := frxInteger(_TDataSet.FieldDefs)
+ else if PropName = 'FIELDS' then
+ Result := frxInteger(_TDataSet.Fields)
+ else if PropName = 'FILTER' then
+ Result := _TDataSet.Filter
+ else if PropName = 'FILTERED' then
+ Result := _TDataSet.Filtered
+ else if PropName = 'FILTEROPTIONS' then
+ Result := FilterOptionsToInt(_TDataSet.FilterOptions)
+ else if PropName = 'ACTIVE' then
+ Result := _TDataSet.Active
+ end
+ else if ClassType = TParam then
+ begin
+ _TParam := TParam(Instance);
+ if PropName = 'BOUND' then
+ Result := _TParam.Bound
+ else if PropName = 'ISNULL' then
+ Result := _TParam.IsNull
+ else if PropName = 'TEXT' then
+ Result := _TParam.Text
+ else if PropName = 'ASBOOLEAN' then
+ Result := _TParam.AsBoolean
+ else if PropName = 'ASCURRENCY' then
+ Result := _TParam.AsCurrency
+ else if PropName = 'ASDATETIME' then
+ Result := _TParam.AsDateTime
+ else if PropName = 'ASFLOAT' then
+ Result := _TParam.AsFloat
+ else if PropName = 'ASINTEGER' then
+ Result := _TParam.AsInteger
+ else if PropName = 'ASDATE' then
+ Result := _TParam.AsDate
+ else if PropName = 'ASTIME' then
+ Result := _TParam.AsTime
+ else if PropName = 'ASSTRING' then
+ Result := _TParam.AsString
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+var
+ _TField: TField;
+ _TParam: TParam;
+ _TDataSet: TDataSet;
+
+ function IntToFilterOptions(i: Integer): TFilterOptions;
+ begin
+ Result := [];
+ if (i and 1) <> 0 then
+ Result := Result + [foCaseInsensitive];
+ if (i and 2) <> 0 then
+ Result := Result + [foNoPartialCompare];
+ end;
+
+begin
+ if ClassType = TField then
+ begin
+ _TField := TField(Instance);
+ if PropName = 'ASBOOLEAN' then
+ _TField.AsBoolean := Value
+ else if PropName = 'ASCURRENCY' then
+ _TField.AsCurrency := Value
+ else if PropName = 'ASDATETIME' then
+ _TField.AsDateTime := Value
+ else if PropName = 'ASFLOAT' then
+ _TField.AsFloat := Value
+ else if PropName = 'ASINTEGER' then
+ _TField.AsInteger := Value
+ else if PropName = 'ASSTRING' then
+ _TField.AsString := Value
+ else if PropName = 'ASVARIANT' then
+ _TField.AsVariant := Value
+ else if PropName = 'VALUE' then
+ _TField.Value := Value
+ else if PropName = 'SIZE' then
+ _TField.Size := Value
+ end
+ else if ClassType = TDataSet then
+ begin
+ _TDataSet := TDataSet(Instance);
+ if PropName = 'FILTER' then
+ _TDataSet.Filter := Value
+ else if PropName = 'FILTERED' then
+ _TDataSet.Filtered := Value
+ else if PropName = 'FILTEROPTIONS' then
+ _TDataSet.FilterOptions := IntToFilterOptions(Value)
+ else if PropName = 'ACTIVE' then
+ _TDataSet.Active := Value
+ end
+ else if ClassType = TParam then
+ begin
+ _TParam := TParam(Instance);
+ if PropName = 'ASBOOLEAN' then
+ _TParam.AsBoolean := Value
+ else if PropName = 'ASCURRENCY' then
+ _TParam.AsCurrency := Value
+ else if PropName = 'ASDATETIME' then
+ _TParam.AsDateTime := Value
+ else if PropName = 'ASFLOAT' then
+ _TParam.AsFloat := Value
+ else if PropName = 'ASINTEGER' then
+ _TParam.AsInteger := Value
+ else if PropName = 'ASDATE' then
+ _TParam.AsDate := Value
+ else if PropName = 'ASTIME' then
+ _TParam.AsTime := Value
+ else if PropName = 'ASSTRING' then
+ _TParam.AsString := Value
+ else if PropName = 'BOUND' then
+ _TParam.Bound := Value
+ else if PropName = 'TEXT' then
+ _TParam.Text := Value
+ end
+end;
+
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsDBRTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/fs_idialogsrtti.pas b/FastScript/fs_idialogsrtti.pas
new file mode 100644
index 0000000..6f9a406
--- /dev/null
+++ b/FastScript/fs_idialogsrtti.pas
@@ -0,0 +1,167 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Dialogs.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_idialogsrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, fs_iclassesrtti
+{$IFDEF DELPHI16}
+, System.UITypes
+{$ENDIF}
+{$IFDEF CLX}
+, QDialogs
+{$ELSE}
+, Dialogs
+{$ENDIF}
+{$IFDEF Delphi16}
+ , System.Types
+{$ENDIF}
+{$IFDEF DELPHI16}, Controls{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsDialogsRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+{$IFDEF CLX}
+ THackDialog = class(TDialog);
+{$ELSE}
+ THackDialog = class(TCommonDialog);
+{$ENDIF}
+
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+type
+ TWordSet = set of 0..15;
+ PWordSet = ^TWordSet;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+var
+ dlg: String;
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnumSet('TOpenOptions', 'ofReadOnly, ofOverwritePrompt, ofHideReadOnly,' +
+ 'ofNoChangeDir, ofShowHelp, ofNoValidate, ofAllowMultiSelect,' +
+ 'ofExtensionDifferent, ofPathMustExist, ofFileMustExist, ofCreatePrompt,' +
+ 'ofShareAware, ofNoReadOnlyReturn, ofNoTestFileCreate, ofNoNetworkButton,' +
+ 'ofNoLongNames, ofOldStyleDialog, ofNoDereferenceLinks, ofEnableIncludeNotify,' +
+ 'ofEnableSizing');
+ AddEnum('TFileEditStyle', 'fsEdit, fsComboBox');
+ AddEnumSet('TColorDialogOptions', 'cdFullOpen, cdPreventFullOpen, cdShowHelp,' +
+ 'cdSolidColor, cdAnyColor');
+ AddEnumSet('TFontDialogOptions', 'fdAnsiOnly, fdTrueTypeOnly, fdEffects,' +
+ 'fdFixedPitchOnly, fdForceFontExist, fdNoFaceSel, fdNoOEMFonts,' +
+ 'fdNoSimulations, fdNoSizeSel, fdNoStyleSel, fdNoVectorFonts,' +
+ 'fdShowHelp, fdWysiwyg, fdLimitSize, fdScalableOnly, fdApplyButton');
+ AddEnum('TFontDialogDevice', 'fdScreen, fdPrinter, fdBoth');
+ AddEnum('TPrintRange', 'prAllPages, prSelection, prPageNums');
+ AddEnumSet('TPrintDialogOptions', 'poPrintToFile, poPageNums, poSelection,' +
+ 'poWarning, poHelp, poDisablePrintToFile');
+{$IFNDEF CLX}
+ AddEnum('TMsgDlgType', 'mtWarning, mtError, mtInformation, mtConfirmation, mtCustom');
+ AddEnumSet('TMsgDlgButtons', 'mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, ' +
+ 'mbIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp');
+{$ELSE}
+ AddEnum('TMsgDlgType', 'mtCustom, mtInformation, mtWarning, mtError, mtConfirmation');
+ AddEnumSet('TMsgDlgButtons', 'mbNone, mbOk, mbCancel, mbYes, mbNo, mbAbort, ' +
+ 'mbRetry, mbIgnore');
+{$ENDIF}
+
+{$IFDEF CLX}
+ dlg := 'TDialog';
+ with AddClass(TDialog, 'TComponent') do
+{$ELSE}
+ dlg := 'TCommonDialog';
+ with AddClass(TCommonDialog, 'TComponent') do
+{$ENDIF}
+ AddMethod('function Execute: Boolean', CallMethod);
+ AddClass(TOpenDialog, dlg);
+ AddClass(TSaveDialog, dlg);
+ AddClass(TColorDialog, dlg);
+ AddClass(TFontDialog, dlg);
+{$IFNDEF CLX}
+ {$IFNDEF FPC}
+ // todo: wait lazarus 1.0 TPrintDialog is targeted in Mantis to 1.0
+ AddClass(TPrintDialog, dlg);
+ AddClass(TPrinterSetupDialog, dlg);
+ {$ENDIF}
+{$ENDIF}
+ AddMethod('function MessageDlg(Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer', CallMethod, 'ctOther');
+ AddMethod('function InputBox(ACaption, APrompt, ADefault: string): string', CallMethod, 'ctOther');
+ AddMethod('function InputQuery(ACaption, APrompt: string; var Value: string): Boolean', CallMethod, 'ctOther');
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ s: String;
+ b: TMsgDlgButtons;
+begin
+ Result := 0;
+
+{$IFDEF CLX}
+ if ClassType = TDialog then
+{$ELSE}
+ if ClassType = TCommonDialog then
+{$ENDIF}
+ begin
+ if MethodName = 'EXECUTE' then
+ Result := THackDialog(Instance).Execute
+ end
+ else if MethodName = 'INPUTBOX' then
+ Result := InputBox(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'INPUTQUERY' then
+ begin
+ s := Caller.Params[2];
+ Result := InputQuery(Caller.Params[0], Caller.Params[1], s);
+ Caller.Params[2] := s;
+ end
+ else if MethodName = 'MESSAGEDLG' then
+ begin
+ Word(PWordSet(@b)^) := Caller.Params[2];
+ Result := MessageDlg(Caller.Params[0], Caller.Params[1], b, Caller.Params[3]);
+ end
+end;
+
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsDialogsRTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
\ No newline at end of file
diff --git a/FastScript/fs_idisp.pas b/FastScript/fs_idisp.pas
new file mode 100644
index 0000000..a361d8a
--- /dev/null
+++ b/FastScript/fs_idisp.pas
@@ -0,0 +1,136 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ OLE dispatch module }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_idisp;
+
+interface
+
+{$I fs.inc}
+
+uses
+ Windows, Classes, SysUtils, ActiveX, ComObj, fs_iinterpreter
+{$IFDEF Delphi6}
+, Variants
+{$ENDIF};
+
+
+type
+ TfsOLEHelper = class(TfsCustomHelper)
+ private
+ function DispatchInvoke(const ParamArray: Variant; ParamCount: Integer;
+ Flags: Word): Variant;
+ protected
+ procedure SetValue(const Value: Variant); override;
+ function GetValue: Variant; override;
+ public
+ constructor Create(const AName: String);
+ end;
+
+
+implementation
+
+
+constructor TfsOLEHelper.Create(const AName: String);
+begin
+ inherited Create(AName, fvtVariant, '');
+end;
+
+function TfsOLEHelper.DispatchInvoke(const ParamArray: Variant; ParamCount: Integer;
+ Flags: Word): Variant;
+const
+ DispIDArgs: Longint = DISPID_PROPERTYPUT;
+var
+ DispId: TDispId;
+ Params: TDISPPARAMS;
+ pName: WideString;
+ ExcepMess: WideString;
+ Args: array[0..63] of Variant;
+ i: Integer;
+ PResult: PVariant;
+ Status: Integer;
+ ExcepInfo: TExcepInfo;
+begin
+ ExcepMess := '';
+ pName := WideString(Name);
+ IDispatch(ParentValue).GetIDsOfNames(GUID_NULL, @pName, 1, GetThreadLocale, @DispId);
+
+ for i := 0 to ParamCount - 1 do
+ Args[i] := ParamArray[ParamCount - i - 1];
+
+ Params.rgvarg := @Args;
+ Params.rgdispidNamedArgs := nil;
+ Params.cArgs := ParamCount;
+ Params.cNamedArgs := 0;
+ if (Flags = DISPATCH_PROPERTYPUT) or (Flags = DISPATCH_PROPERTYPUTREF) then
+ begin
+ Params.rgdispidNamedArgs := @DispIDArgs;
+ Params.cNamedArgs := 1;
+ end;
+
+ if NeedResult and (Flags <> DISPATCH_PROPERTYPUT) and (Flags <> DISPATCH_PROPERTYPUTREF) then
+ PResult := @Result else
+ PResult := nil;
+ if PResult <> nil then
+ VarClear(PResult^);
+ if (Flags = DISPATCH_METHOD) {and (ParamCount = 0)} and (PResult <> nil) then
+ Flags := DISPATCH_METHOD or DISPATCH_PROPERTYGET;
+
+ Status := IDispatch(ParentValue).Invoke(DispId, GUID_NULL, 0,
+ Flags, Params, PResult, @ExcepInfo, nil);
+ if Status <> 0 then
+ begin
+ if ExcepInfo.bstrSource <> '' then
+ ExcepMess := #13+#10 + 'Source :: '+ ExcepInfo.bstrSource;
+ if ExcepInfo.bstrDescription <> '' then
+ ExcepMess := ExcepMess + #13#10 + 'Description :: '+ ExcepInfo.bstrDescription;
+ if ExcepInfo.bstrHelpFile <> '' then
+ ExcepMess := ExcepMess + #13#10 + 'Help File :: '+ ExcepInfo.bstrHelpFile;
+{$IFDEF Delphi12}
+ raise Exception.Create('OLE error ' + IntToHex(Status, 8) + ': ' +
+ String(Name) + ': ' + SysErrorMessage(Status) + ExcepMess);
+{$ELSE}
+ raise Exception.Create('OLE error ' + IntToHex(Status, 8) + ': ' +
+ Name + ': ' + SysErrorMessage(Status) + ExcepMess);
+{$ENDIF}
+ end;
+end;
+
+procedure TfsOLEHelper.SetValue(const Value: Variant);
+var
+ i: Integer;
+ v: Variant;
+ Flag: Word;
+begin
+ v := VarArrayCreate([0, Count], varVariant);
+ for i := 0 to Count - 1 do
+ v[i] := Params[i].Value;
+ v[Count] := Value;
+ Flag := DISPATCH_PROPERTYPUT;
+ if VarType(Value) = varDispatch then
+ Flag := DISPATCH_PROPERTYPUTREF;
+ DispatchInvoke(v, Count + 1, Flag);
+ ParentValue := Null;
+end;
+
+function TfsOLEHelper.GetValue: Variant;
+var
+ i: Integer;
+ v: Variant;
+begin
+ v := VarArrayCreate([0, Count - 1], varVariant);
+ for i := 0 to Count - 1 do
+ v[i] := Params[i].Value;
+
+ Result := DispatchInvoke(v, Count, DISPATCH_METHOD);
+ ParentValue := Null;
+end;
+
+end.
diff --git a/FastScript/fs_ievents.pas b/FastScript/fs_ievents.pas
new file mode 100644
index 0000000..310d117
--- /dev/null
+++ b/FastScript/fs_ievents.pas
@@ -0,0 +1,201 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Standard events }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_ievents;
+
+interface
+
+{$i fs.inc}
+
+uses SysUtils, Classes, fs_iinterpreter
+{$IFDEF CLX}
+, QControls, QForms
+{$ELSE}
+, Controls, Forms
+{$ENDIF};
+
+type
+ TfsNotifyEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsMouseEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsMouseMoveEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; Shift: TShiftState; X, Y: Integer);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsKeyEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var Key: Word; Shift: TShiftState);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsKeyPressEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var Key: Char);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsCloseEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var Action: TCloseAction);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsCloseQueryEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var CanClose: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsCanResizeEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var NewWidth, NewHeight: Integer;
+ var Resize: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+
+implementation
+
+
+type
+ TByteSet = set of 0..7;
+ PByteSet = ^TByteSet;
+
+
+{ TfsNotifyEvent }
+
+procedure TfsNotifyEvent.DoEvent(Sender: TObject);
+begin
+ CallHandler([Sender]);
+end;
+
+function TfsNotifyEvent.GetMethod: Pointer;
+begin
+ Result := @TfsNotifyEvent.DoEvent;
+end;
+
+{ TfsMouseEvent }
+
+procedure TfsMouseEvent.DoEvent(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+var
+ b: Byte;
+begin
+ b := Byte(PByteSet(@Shift)^);
+ CallHandler([Sender, Integer(Button), b, X, Y]);
+end;
+
+function TfsMouseEvent.GetMethod: Pointer;
+begin
+ Result := @TfsMouseEvent.DoEvent;
+end;
+
+{ TfsMouseMoveEvent }
+
+procedure TfsMouseMoveEvent.DoEvent(Sender: TObject; Shift: TShiftState; X,
+ Y: Integer);
+var
+ b: Byte;
+begin
+ b := Byte(PByteSet(@Shift)^);
+ CallHandler([Sender, b, X, Y]);
+end;
+
+function TfsMouseMoveEvent.GetMethod: Pointer;
+begin
+ Result := @TfsMouseMoveEvent.DoEvent;
+end;
+
+{ TfsKeyEvent }
+
+procedure TfsKeyEvent.DoEvent(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+var
+ b: Byte;
+begin
+ b := Byte(PByteSet(@Shift)^);
+ CallHandler([Sender, Key, b]);
+ Key := Handler.Params[1].Value;
+end;
+
+function TfsKeyEvent.GetMethod: Pointer;
+begin
+ Result := @TfsKeyEvent.DoEvent;
+end;
+
+{ TfsKeyPressEvent }
+
+procedure TfsKeyPressEvent.DoEvent(Sender: TObject; var Key: Char);
+begin
+ CallHandler([Sender, Key]);
+ Key := String(Handler.Params[1].Value)[1];
+end;
+
+function TfsKeyPressEvent.GetMethod: Pointer;
+begin
+ Result := @TfsKeyPressEvent.DoEvent;
+end;
+
+{ TfsCloseEvent }
+
+procedure TfsCloseEvent.DoEvent(Sender: TObject; var Action: TCloseAction);
+begin
+ CallHandler([Sender, Integer(Action)]);
+ Action := Handler.Params[1].Value;
+end;
+
+function TfsCloseEvent.GetMethod: Pointer;
+begin
+ Result := @TfsCloseEvent.DoEvent;
+end;
+
+{ TfsCloseQueryEvent }
+
+procedure TfsCloseQueryEvent.DoEvent(Sender: TObject; var CanClose: Boolean);
+begin
+ CallHandler([Sender, CanClose]);
+ CanClose := Handler.Params[1].Value;
+end;
+
+function TfsCloseQueryEvent.GetMethod: Pointer;
+begin
+ Result := @TfsCloseQueryEvent.DoEvent;
+end;
+
+{ TfsCanResizeEvent }
+
+procedure TfsCanResizeEvent.DoEvent(Sender: TObject; var NewWidth,
+ NewHeight: Integer; var Resize: Boolean);
+begin
+ CallHandler([Sender, NewWidth, NewHeight, Resize]);
+ NewWidth := Handler.Params[1].Value;
+ NewHeight := Handler.Params[2].Value;
+ Resize := Handler.Params[3].Value;
+end;
+
+function TfsCanResizeEvent.GetMethod: Pointer;
+begin
+ Result := @TfsCanResizeEvent.DoEvent;
+end;
+
+end.
\ No newline at end of file
diff --git a/FastScript/fs_iexpression.pas b/FastScript/fs_iexpression.pas
new file mode 100644
index 0000000..bc7cfdd
--- /dev/null
+++ b/FastScript/fs_iexpression.pas
@@ -0,0 +1,957 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Expression parser }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_iexpression;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter
+{$IFDEF Delphi6}
+, Variants
+{$ENDIF};
+{$ELSE}
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, System.Variants;
+{$ENDIF}
+
+
+type
+ { List of operators }
+
+ TfsOperatorType = (opNone, opGreat, opLess, opLessEq, opGreatEq, opNonEq, opEq,
+ opPlus, opMinus, opOr, opXor, opMul, opDivFloat, opDivInt, opMod, opAnd,
+ opShl, opShr, opLeftBracket, opRightBracket, opNot, opUnMinus, opIn, opIs);
+
+{ TfsExpression class holds a list of operands and operators.
+ List is represented in the tree form.
+ Call to methods AddXXX puts an expression element to the list.
+ Call to function Value calculates and returns the expression value }
+
+ TfsExpressionNode = class(TfsCustomVariable)
+ private
+ FLeft, FRight, FParent: TfsExpressionNode;
+ procedure AddNode(Node: TfsExpressionNode);
+ procedure RemoveNode(Node: TfsExpressionNode);
+ public
+ destructor Destroy; override;
+ function Priority: Integer; virtual; abstract;
+ end;
+
+ TfsOperandNode = class(TfsExpressionNode)
+ public
+ constructor Create(const AValue: Variant);
+ function Priority: Integer; override;
+ end;
+
+ TfsOperatorNode = class(TfsExpressionNode)
+ private
+ FOp: TfsOperatorType;
+ FOptimizeInt: Boolean;
+ FOptimizeBool: Boolean;
+ public
+ constructor Create(Op: TfsOperatorType);
+ function Priority: Integer; override;
+ end;
+
+ TfsDesignatorNode = class(TfsOperandNode)
+ private
+ FDesignator: TfsDesignator;
+ FVar: TfsCustomVariable;
+ protected
+ function GetValue: Variant; override;
+ public
+ constructor Create(ADesignator: TfsDesignator);
+ destructor Destroy; override;
+ end;
+
+ TfsSetNode = class(TfsOperandNode)
+ private
+ FSetExpression: TfsSetExpression;
+ protected
+ function GetValue: Variant; override;
+ public
+ constructor Create(ASet: TfsSetExpression);
+ destructor Destroy; override;
+ end;
+
+ TfsExpression = class(TfsCustomExpression)
+ private
+ FCurNode: TfsExpressionNode;
+ FNode: TfsExpressionNode;
+ FScript: TfsScript;
+ FSource: String;
+ procedure AddOperand(Node: TfsExpressionNode);
+ protected
+ function GetValue: Variant; override;
+ procedure SetValue(const Value: Variant); override;
+ public
+ constructor Create(Script: TfsScript);
+ destructor Destroy; override;
+ procedure AddConst(const AValue: Variant);
+ procedure AddConstWithType(const AValue: Variant; aTyp: TfsVarType);
+ procedure AddDesignator(ADesignator: TfsDesignator);
+ procedure AddOperator(const Op: String);
+ procedure AddSet(ASet: TfsSetExpression);
+
+ function Finalize: String;
+ function Optimize(Designator: TfsDesignator): String;
+ function SingleItem: TfsCustomVariable;
+
+ property Source: String read FSource write FSource;
+ end;
+
+
+implementation
+
+//VCL uses section
+{$IFNDEF FMX}
+uses fs_itools;
+//FMX uses section
+{$ELSE}
+uses FMX.fs_itools;
+{$ENDIF}
+
+type
+ TNoneNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TGreatNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TLessNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TLessEqNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TGreatEqNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TNonEqNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TEqNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TPlusNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TStrCatNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TMinusNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TOrNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TXorNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TMulNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TDivFloatNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TDivIntNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TModNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TAndNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TShlNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TShrNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TLeftBracketNode = class(TfsOperatorNode);
+
+ TRightBracketNode = class(TfsOperatorNode);
+
+ TNotNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TUnMinusNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TInNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TIsNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+
+function TNoneNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+end;
+
+function TGreatNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ Result := Result > FRight.Value;
+end;
+
+function TLessNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ Result := Result < FRight.Value;
+end;
+
+function TLessEqNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ Result := Result <= FRight.Value;
+end;
+
+function TGreatEqNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ Result := Result >= FRight.Value;
+end;
+
+function TNonEqNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ Result := Result <> FRight.Value;
+end;
+
+function TEqNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ Result := Result = FRight.Value;
+end;
+
+function TPlusNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ {$IFDEF FPC}
+ if TVarData(Result).Vtype = varEmpty then
+ Result := 0;
+ {$ENDIF}
+ Result := Result + FRight.Value;
+end;
+
+function TStrCatNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ if (TVarData(Result).VType = varString){$IFDEF Delphi12} or (TVarData(Result).VType = varUString){$ENDIF} then
+ Result := VarToStr(Result) + VarToStr(FRight.Value) else
+ Result := Result + FRight.Value;
+end;
+
+function TMinusNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ if FOptimizeInt then
+ Result := frxInteger(Result) - frxInteger(FRight.Value)
+ else
+ begin
+ {$IFDEF FPC}
+ if TVarData(Result).Vtype = varEmpty then
+ Result := 0;
+ {$ENDIF}
+ Result := Result - FRight.Value;
+ end;
+end;
+
+function TOrNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+
+ if FOptimizeBool then
+ begin
+ if Boolean(Result) = False then
+ Result := FRight.Value;
+ end
+ else
+ Result := Result or FRight.Value;
+end;
+
+function TXorNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ Result := Result xor FRight.Value;
+end;
+
+function TMulNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ if FOptimizeInt then
+ Result := frxInteger(Result) * frxInteger(FRight.Value)
+ else
+ begin
+ {$IFDEF FPC}
+ if TVarData(Result).Vtype = varEmpty then
+ Result := 0;
+ {$ENDIF}
+ Result := Result * FRight.Value;
+ end;
+end;
+
+function TDivFloatNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ {$IFDEF FPC}
+ if TVarData(Result).Vtype = varEmpty then
+ Result := 0;
+ {$ENDIF}
+ Result := Result / FRight.Value;
+end;
+
+function TDivIntNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ if FOptimizeInt then
+ Result := frxInteger(Result) div frxInteger(FRight.Value)
+ else
+ begin
+ {$IFDEF FPC}
+ if TVarData(Result).Vtype = varEmpty then
+ Result := 0;
+ {$ENDIF}
+ Result := Result div FRight.Value;
+ end;
+end;
+
+function TModNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ if FOptimizeInt then
+ Result := frxInteger(Result) mod frxInteger(FRight.Value)
+ else
+ begin
+ {$IFDEF FPC}
+ if TVarData(Result).Vtype = varEmpty then
+ Result := 0;
+ {$ENDIF}
+ Result := Result mod FRight.Value;
+ end;
+end;
+
+function TAndNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ if FOptimizeBool then
+ begin
+ if Boolean(Result) = True then
+ Result := FRight.Value;
+ end
+ else
+ Result := Result and FRight.Value;
+end;
+
+function TShlNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ Result := Result shl FRight.Value;
+end;
+
+function TShrNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ Result := Result shr FRight.Value;
+end;
+
+function TNotNode.GetValue: Variant;
+begin
+ Result := not FLeft.Value;
+end;
+
+function TUnMinusNode.GetValue: Variant;
+begin
+ Result := -FLeft.Value;
+end;
+
+function TInNode.GetValue: Variant;
+var
+ i: Integer;
+ ar, val, selfVal: Variant;
+ Count: Integer;
+begin
+ if FRight is TfsSetNode then
+ Result := TfsSetNode(FRight).FSetExpression.Check(FLeft.Value)
+ else
+ begin
+ Result := False;
+ ar := FRight.Value;
+ Count := VarArrayHighBound(ar, 1);
+ selfVal := FLeft.Value;
+
+ i := 0;
+ while i <= Count do
+ begin
+ val := ar[i];
+ Result := selfVal = val;
+ if (i < Count - 1) and (ar[i + 1] = Null) and not Result then { subrange }
+ begin
+ Result := (selfVal >= val) and (selfVal <= ar[i + 2]);
+ Inc(i, 2);
+ end;
+
+ if Result then break;
+ Inc(i);
+ end;
+ end;
+end;
+
+function TIsNode.GetValue: Variant;
+begin
+ Result := TObject(frxInteger(FLeft.Value)) is
+ TfsClassVariable(TfsDesignatorNode(FRight).FDesignator[0].Ref).ClassRef;
+end;
+
+
+{ TfsExpressionNode }
+
+destructor TfsExpressionNode.Destroy;
+begin
+ FLeft.Free;
+ FRight.Free;
+ inherited;
+end;
+
+procedure TfsExpressionNode.AddNode(Node: TfsExpressionNode);
+begin
+ if FLeft = nil then
+ FLeft := Node
+ else if FRight = nil then
+ FRight := Node;
+ if Node <> nil then
+ Node.FParent := Self;
+end;
+
+procedure TfsExpressionNode.RemoveNode(Node: TfsExpressionNode);
+begin
+ if FLeft = Node then
+ FLeft := nil
+ else if FRight = Node then
+ FRight := nil;
+end;
+
+
+{ TfsOperandNode }
+
+constructor TfsOperandNode.Create(const AValue: Variant);
+var
+ t: TfsVarType;
+begin
+{$IFDEF CPUX64}
+ inherited Create('', fvtInt64, '');
+{$ELSE}
+ inherited Create('', fvtInt, '');
+{$ENDIF}
+ Value := AValue;
+
+ t := fvtInt;
+ if TVarData(AValue).VType = varBoolean then
+ t := fvtBool
+ else if TVarData(AValue).VType in [varSingle, varDouble, varCurrency] then
+ t := fvtFloat
+{$IFDEF FS_INT64}
+ else if (TVarData(AValue).VType = varInt64) then
+ t := fvtInt64
+{$ENDIF}
+ else if (TVarData(AValue).VType = varOleStr) or
+ (TVarData(AValue).VType = varString){$IFDEF Delphi12} or (TVarData(AValue).VType = varUString){$ENDIF} then
+ t := fvtString;
+
+ Typ := t;
+end;
+
+function TfsOperandNode.Priority: Integer;
+begin
+ Result := 0;
+end;
+
+
+{ TfsOperatorNode }
+
+constructor TfsOperatorNode.Create(Op: TfsOperatorType);
+begin
+{$IFDEF CPUX64}
+ inherited Create('', fvtInt64, '');
+{$ELSE}
+ inherited Create('', fvtInt, '');
+{$ENDIF}
+ FOp := Op;
+end;
+
+function TfsOperatorNode.Priority: Integer;
+begin
+ case FOp of
+ opNone:
+ Result := 7;
+ opLeftBracket:
+ Result := 6;
+ opRightBracket:
+ Result := 5;
+ opGreat, opLess, opGreatEq, opLessEq, opNonEq, opEq, opIn, opIs:
+ Result := 4;
+ opPlus, opMinus, opOr, opXor:
+ Result := 3;
+ opMul, opDivFloat, opDivInt, opMod, opAnd, opShr, opShl:
+ Result := 2;
+ opNot, opUnMinus:
+ Result := 1;
+ else
+ Result := 0;
+ end;
+end;
+
+
+{ TfsDesignatorNode }
+
+constructor TfsDesignatorNode.Create(ADesignator: TfsDesignator);
+begin
+ inherited Create(0);
+ FDesignator := ADesignator;
+ Typ := ADesignator.Typ;
+ TypeName := ADesignator.TypeName;
+ if FDesignator is TfsVariableDesignator then
+ FVar := FDesignator.RefItem else
+ FVar := FDesignator;
+end;
+
+destructor TfsDesignatorNode.Destroy;
+begin
+ FDesignator.Free;
+ inherited;
+end;
+
+function TfsDesignatorNode.GetValue: Variant;
+begin
+ Result := FVar.Value;
+end;
+
+
+{ TfsSetNode }
+
+constructor TfsSetNode.Create(ASet: TfsSetExpression);
+begin
+ inherited Create(0);
+ FSetExpression := ASet;
+ Typ := fvtVariant;
+end;
+
+destructor TfsSetNode.Destroy;
+begin
+ FSetExpression.Free;
+ inherited;
+end;
+
+function TfsSetNode.GetValue: Variant;
+begin
+ Result := FSetExpression.Value;
+end;
+
+
+{ TfsExpression }
+
+constructor TfsExpression.Create(Script: TfsScript);
+begin
+{$IFDEF CPUX64}
+ inherited Create('', fvtInt64, '');
+{$ELSE}
+ inherited Create('', fvtInt, '');
+{$ENDIF}
+ FNode := TNoneNode.Create(opNone);
+ FCurNode := FNode;
+ FScript := Script;
+end;
+
+destructor TfsExpression.Destroy;
+begin
+ FNode.Free;
+ inherited;
+end;
+
+function TfsExpression.GetValue: Variant;
+begin
+ Result := FNode.Value;
+end;
+
+procedure TfsExpression.AddOperand(Node: TfsExpressionNode);
+begin
+ FCurNode.AddNode(Node);
+ FCurNode := Node;
+end;
+
+procedure TfsExpression.AddOperator(const Op: String);
+var
+ Node: TfsExpressionNode;
+ n, n1: TfsExpressionNode;
+
+ function CreateOperatorNode(s: String): TfsOperatorNode;
+ begin
+ s := AnsiUpperCase(s);
+ if s = ' ' then
+ Result := TNoneNode.Create(opNone)
+ else if s = '>' then
+ Result := TGreatNode.Create(opGreat)
+ else if s = '<' then
+ Result := TLessNode.Create(opLess)
+ else if s = '<=' then
+ Result := TLessEqNode.Create(opLessEq)
+ else if s = '>=' then
+ Result := TGreatEqNode.Create(opGreatEq)
+ else if s = '<>' then
+ Result := TNonEqNode.Create(opNonEq)
+ else if s = '=' then
+ Result := TEqNode.Create(opEq)
+ else if s = '+' then
+ Result := TPlusNode.Create(opPlus)
+ else if s = 'STRCAT' then
+ Result := TStrCatNode.Create(opPlus)
+ else if s = '-' then
+ Result := TMinusNode.Create(opMinus)
+ else if s = 'OR' then
+ Result := TOrNode.Create(opOr)
+ else if s = 'XOR' then
+ Result := TXorNode.Create(opXor)
+ else if s = '*' then
+ Result := TMulNode.Create(opMul)
+ else if s = '/' then
+ Result := TDivFloatNode.Create(opDivFloat)
+ else if s = 'DIV' then
+ Result := TDivIntNode.Create(opDivInt)
+ else if s = 'MOD' then
+ Result := TModNode.Create(opMod)
+ else if s = 'AND' then
+ Result := TAndNode.Create(opAnd)
+ else if s = 'SHL' then
+ Result := TShlNode.Create(opShl)
+ else if s = 'SHR' then
+ Result := TShrNode.Create(opShr)
+ else if s = '(' then
+ Result := TLeftBracketNode.Create(opLeftBracket)
+ else if s = ')' then
+ Result := TRightBracketNode.Create(opRightBracket)
+ else if s = 'NOT' then
+ Result := TNotNode.Create(opNot)
+ else if s = 'UNMINUS' then
+ Result := TUnMinusNode.Create(opUnMinus)
+ else if s = 'IN' then
+ Result := TInNode.Create(opIn)
+ else if s = 'IS' then
+ Result := TIsNode.Create(opIs)
+ else
+ Result := nil;
+ end;
+
+begin
+ Node := CreateOperatorNode(Op);
+ Node.SourcePos := SourcePos;
+
+ if (Op = '(') or (Op = 'unminus') or (Op = 'not') then
+ AddOperand(Node)
+ else if Op = ')' then
+ begin
+ n := FCurNode;
+ while n.Priority <= Node.Priority do
+ n := n.FParent;
+
+ n.FParent.RemoveNode(n);
+ n.FParent.AddNode(n.FLeft);
+
+ Node.Free;
+ Node := n.FLeft;
+ n.FLeft := nil;
+ n.Free;
+ end
+ else if FCurNode = FNode then
+ FNode.AddNode(Node)
+ else
+ begin
+ n := FCurNode;
+ n1 := nil;
+ if FCurNode.Priority <> 6 then
+ begin
+ n := FCurNode.FParent;
+ n1 := FCurNode;
+ end;
+
+ while n.Priority <= Node.Priority do
+ begin
+ n1 := n;
+ n := n.FParent;
+ end;
+
+ n.RemoveNode(n1);
+ n.AddNode(Node);
+ Node.AddNode(n1);
+ end;
+
+ FCurNode := Node;
+end;
+
+procedure TfsExpression.AddConst(const AValue: Variant);
+var
+ Node: TfsOperandNode;
+begin
+ Node := TfsOperandNode.Create(AValue);
+ Node.SourcePos := SourcePos;
+ AddOperand(Node);
+end;
+
+procedure TfsExpression.AddConstWithType(const AValue: Variant;
+ aTyp: TfsVarType);
+begin
+ AddConst(AValue);
+ if aTyp = fvtClass then
+ FCurNode.Typ := fvtVariant;
+end;
+
+procedure TfsExpression.AddDesignator(ADesignator: TfsDesignator);
+var
+ Node: TfsDesignatorNode;
+begin
+ Node := TfsDesignatorNode.Create(ADesignator);
+ Node.SourcePos := SourcePos;
+ AddOperand(Node);
+end;
+
+procedure TfsExpression.AddSet(ASet: TfsSetExpression);
+var
+ Node: TfsSetNode;
+begin
+ Node := TfsSetNode.Create(ASet);
+ Node.SourcePos := SourcePos;
+ AddOperand(Node);
+end;
+
+function TfsExpression.Finalize: String;
+var
+ ErrorPos: String;
+ TypeRec: TfsTypeRec;
+
+ function GetType(Item: TfsExpressionNode): TfsTypeRec;
+ var
+ Typ1, Typ2: TfsTypeRec;
+ op: TfsOperatorType;
+ Error: Boolean;
+ begin
+ if Item = nil then
+ Result.Typ := fvtVariant
+ else if Item is TfsOperandNode then
+ begin
+ Result.Typ := Item.Typ;
+ Result.TypeName := Item.TypeName;
+ end
+ else
+ begin
+ Typ1 := GetType(Item.FLeft);
+ Typ2 := GetType(Item.FRight);
+// if (Typ1.Typ = fvtInt) and (Typ2.Typ = fvtInt) then
+// TfsOperatorNode(Item).FOptimizeInt := True;
+ if (Typ1.Typ = fvtBool) and (Typ2.Typ = fvtBool) then
+ TfsOperatorNode(Item).FOptimizeBool := True;
+
+ op := TfsOperatorNode(Item).FOp;
+
+ if (op = opIs) and (Typ1.Typ = fvtClass) and (Typ2.Typ = fvtClass) then
+ Error := False
+ else
+ begin
+ { check types compatibility }
+ Error := not TypesCompatible(Typ1, Typ2, FScript);
+ { check operators applicability }
+ if not Error then
+ case Typ1.Typ of
+ fvtBool:
+ Error := not (op in [opNonEq, opEq, opOr, opXor, opAnd, opNot]);
+ fvtChar, fvtString:
+ Error := not (op in [opGreat, opLess, opLessEq, opGreatEq, opNonEq, opEq, opPlus, opIn]);
+ fvtClass, fvtArray:
+ Error := not (op in [opNonEq, opEq]);
+ end;
+ end;
+
+ if not Error then
+ begin
+ Result := Typ1;
+ { if one type is Float, resulting type is float too }
+ if [Typ1.Typ] + [Typ2.Typ] = [fvtInt, fvtFloat] then
+ Result.Typ := fvtFloat;
+ { case int / int = float }
+ if (Typ1.Typ = fvtInt) and (Typ2.Typ = fvtInt) and (op = opDivFloat) then
+ Result.Typ := fvtFloat;
+{$IFDEF FS_INT64}
+ if [Typ1.Typ] + [Typ2.Typ] = [fvtInt64, fvtFloat] then
+ Result.Typ := fvtFloat;
+ { case int / int = float }
+ if ((Typ1.Typ = fvtInt64) or (Typ1.Typ = fvtInt))
+ and ((Typ2.Typ = fvtInt64) or (Typ2.Typ = fvtInt64)) and (op = opDivFloat) then
+ Result.Typ := fvtFloat;
+{$ENDIF}
+ { result of comparing two types is always boolean }
+ if op in [opGreat, opLess, opLessEq, opGreatEq, opNonEq, opEq, opIn, opIs] then
+ Result.Typ := fvtBool;
+ end
+ else if ErrorPos = '' then
+ ErrorPos := Item.SourcePos;
+
+ Item.Typ := Result.Typ;
+ end;
+ end;
+
+begin
+ { remove the empty root node }
+ FCurNode := FNode.FLeft;
+ FNode.RemoveNode(FCurNode);
+ FNode.Free;
+ FNode := FCurNode;
+
+ { check and get the expression type }
+ ErrorPos := '';
+ TypeRec := GetType(FNode);
+ Typ := TypeRec.Typ;
+ TypeName := TypeRec.TypeName;
+ Result := ErrorPos;
+
+ { expression is assignable if it has only one node of type "Variable" }
+ if not ((FNode is TfsDesignatorNode) and not
+ (TfsDesignatorNode(FNode).FDesignator.IsReadOnly)) then
+ IsReadOnly := True;
+end;
+
+procedure TfsExpression.SetValue(const Value: Variant);
+begin
+ if not IsReadOnly then
+ TfsDesignatorNode(FNode).FDesignator.Value := Value;
+end;
+
+function TfsExpression.Optimize(Designator: TfsDesignator): String;
+var
+ Op: TfsOperatorType;
+begin
+ Result := ' ';
+
+ if not (Designator is TfsVariableDesignator) or
+ not (FNode is TfsOperatorNode) then Exit;
+
+ Op := TfsOperatorNode(FNode).FOp;
+ if not (Op in [opPlus, opMinus, opDivFloat, opMul]) then Exit;
+
+ { optimize a := a op b statement }
+ if (FNode.FLeft is TfsDesignatorNode) and
+ (TfsDesignatorNode(FNode.FLeft).FDesignator is TfsVariableDesignator) and
+ (TfsDesignatorNode(FNode.FLeft).FDesignator.RefItem = Designator.RefItem) then
+ begin
+ FCurNode := FNode.FRight;
+ FNode.RemoveNode(FCurNode);
+ FNode.Free;
+ FNode := FCurNode;
+
+ if Op = opPlus then
+ Result := '+'
+ else if Op = opMinus then
+ Result := '-'
+ else if Op = opDivFloat then
+ Result := '/'
+ else if Op = opMul then
+ Result := '*';
+ end
+ { optimize a := b op a statement }
+ else if (FNode.FRight is TfsDesignatorNode) and
+ (TfsDesignatorNode(FNode.FRight).FDesignator is TfsVariableDesignator) and
+ (TfsDesignatorNode(FNode.FRight).FDesignator.RefItem = Designator.RefItem) and
+ (Op in [opPlus, opMul]) and
+ not (Designator.RefItem.Typ in [fvtString, fvtVariant]) then
+ begin
+ FCurNode := FNode.FLeft;
+ FNode.RemoveNode(FCurNode);
+ FNode.Free;
+ FNode := FCurNode;
+
+ if Op = opPlus then
+ Result := '+'
+ else if Op = opMul then
+ Result := '*';
+ end;
+end;
+
+function TfsExpression.SingleItem: TfsCustomVariable;
+begin
+ { if expression contains only one item, returns reference to it }
+ Result := nil;
+
+ if FNode is TfsDesignatorNode then
+ begin
+ if TfsDesignatorNode(FNode).FDesignator is TfsVariableDesignator then
+ Result := TfsDesignatorNode(FNode).FDesignator.RefItem else
+ Result := TfsDesignatorNode(FNode).FDesignator;
+ end
+ else if FNode is TfsOperandNode then
+ Result := FNode;
+end;
+
+end.
diff --git a/FastScript/fs_iextctrlsrtti.pas b/FastScript/fs_iextctrlsrtti.pas
new file mode 100644
index 0000000..4de9bc2
--- /dev/null
+++ b/FastScript/fs_iextctrlsrtti.pas
@@ -0,0 +1,434 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ ExtCtrls }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_iextctrlsrtti;
+
+interface
+
+{$i fs.inc}
+
+uses SysUtils, Classes, fs_iinterpreter, fs_ievents, fs_iformsrtti
+{$IFDEF DELPHI16}
+, System.Types
+{$ENDIF}
+{$IFDEF CLX}
+, QExtCtrls, QButtons, QCheckLst, QComCtrls
+{$ELSE}
+, ExtCtrls, Buttons, CheckLst, ComCtrls
+{$ENDIF}
+{$IFDEF DELPHI16}, Controls{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsExtCtrlsRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TShapeType', 'stRectangle, stSquare, stRoundRect, stRoundSquare,' +
+ 'stEllipse, stCircle');
+ AddEnum('TBevelStyle', 'bsLowered, bsRaised');
+ AddEnum('TBevelShape', 'bsBox, bsFrame, bsTopLine, bsBottomLine, bsLeftLine,' +
+ 'bsRightLine, bsSpacer');
+ AddEnum('TResizeStyle', 'rsNone, rsLine, rsUpdate, rsPattern');
+ AddEnum('TButtonLayout', 'blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom');
+ AddEnum('TButtonState', 'bsUp, bsDisabled, bsDown, bsExclusive');
+ AddEnum('TButtonStyle', 'bsAutoDetect, bsWin31, bsNew');
+ AddEnum('TBitBtnKind', 'bkCustom, bkOK, bkCancel, bkHelp, bkYes, bkNo,' +
+ 'bkClose, bkAbort, bkRetry, bkIgnore, bkAll');
+ AddType('TNumGlyphs', fvtInt);
+ AddEnum('TTabPosition', 'tpTop, tpBottom, tpLeft, tpRight');
+ AddEnum('TTabStyle', 'tsTabs, tsButtons, tsFlatButtons');
+ AddEnum('TStatusPanelStyle', 'psText, psOwnerDraw');
+ AddEnum('TStatusPanelBevel', 'pbNone, pbLowered, pbRaised');
+ AddEnum('TSortType', 'stNone, stData, stText, stBoth');
+ AddEnum('TTrackBarOrientation', 'trHorizontal, trVertical');
+ AddEnum('TTickMark', 'tmBottomRight, tmTopLeft, tmBoth');
+ AddEnum('TTickStyle', 'tsNone, tsAuto, tsManual');
+ AddEnum('TProgressBarOrientation', 'pbHorizontal, pbVertical');
+ AddEnum('TIconArrangement', 'iaTop, iaLeft');
+ AddEnum('TListArrangement', 'arAlignBottom, arAlignLeft, arAlignRight,' +
+ 'arAlignTop, arDefault, arSnapToGrid');
+ AddEnum('TViewStyle', 'vsIcon, vsSmallIcon, vsList, vsReport');
+ AddEnum('TToolButtonStyle', 'tbsButton, tbsCheck, tbsDropDown, tbsSeparator, tbsDivider');
+ AddEnum('TDateTimeKind', 'dtkDate, dtkTime');
+ AddEnum('TDTDateMode', 'dmComboBox, dmUpDown');
+ AddEnum('TDTDateFormat', 'dfShort, dfLong');
+ AddEnum('TDTCalAlignment', 'dtaLeft, dtaRight');
+ AddEnum('TCalDayOfWeek', 'dowMonday, dowTuesday, dowWednesday, dowThursday,' +
+ 'dowFriday, dowSaturday, dowSunday, dowLocaleDefault');
+
+ AddClass(TShape, 'TGraphicControl');
+ with AddClass(TPaintBox, 'TGraphicControl') do
+ AddEvent('OnPaint', TfsNotifyEvent);
+ AddClass(TImage, 'TGraphicControl');
+ AddClass(TBevel, 'TGraphicControl');
+ with AddClass(TTimer, 'TComponent') do
+ AddEvent('OnTimer', TfsNotifyEvent);
+ AddClass(TPanel, 'TCustomControl');
+ AddClass(TSplitter, 'TGraphicControl');
+ AddClass(TBitBtn, 'TButton');
+ AddClass(TSpeedButton, 'TGraphicControl');
+ with AddClass(TCheckListBox, 'TCustomListBox') do
+ AddIndexProperty('Checked', 'Integer', 'Boolean', CallMethod);
+ AddClass(TTabControl, 'TWinControl');
+ with AddClass(TTabSheet, 'TWinControl') do
+ AddProperty('PageControl', 'TPageControl', GetProp, SetProp);
+ with AddClass(TPageControl, 'TWinControl') do
+ begin
+ AddMethod('procedure SelectNextPage(GoForward: Boolean)', CallMethod);
+ AddProperty('PageCount', 'Integer', GetProp, nil);
+ AddIndexProperty('Pages', 'Integer', 'TTabSheet', CallMethod, True);
+ end;
+ AddClass(TStatusPanel, 'TPersistent');
+ with AddClass(TStatusPanels, 'TPersistent') do
+ begin
+ AddMethod('function Add: TStatusPanel', CallMethod);
+ AddIndexProperty('Items', 'Integer', 'TStatusPanel', CallMethod, True);
+ end;
+ AddClass(TStatusBar, 'TWinControl');
+ with AddClass(TTreeNode, 'TPersistent') do
+ begin
+ AddMethod('procedure Delete', CallMethod);
+ AddMethod('function EditText: Boolean', CallMethod);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddProperty('Data', 'Pointer', GetProp, SetProp);
+ AddProperty('ImageIndex', 'Integer', GetProp, SetProp);
+ AddProperty('SelectedIndex', 'Integer', GetProp, SetProp);
+ AddProperty('StateIndex', 'Integer', GetProp, SetProp);
+ AddProperty('Text', 'String', GetProp, SetProp);
+ end;
+ with AddClass(TTreeNodes, 'TPersistent') do
+ begin
+ AddMethod('function Add(Node: TTreeNode; const S: string): TTreeNode', CallMethod);
+ AddMethod('function AddChild(Node: TTreeNode; const S: string): TTreeNode', CallMethod);
+ AddMethod('procedure BeginUpdate', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure Delete(Node: TTreeNode)', CallMethod);
+ AddMethod('procedure EndUpdate', CallMethod);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddDefaultProperty('Item', 'Integer', 'TTreeNode', CallMethod, True);
+ end;
+ with AddClass(TTreeView, 'TWinControl') do
+ begin
+ AddMethod('procedure FullCollapse', CallMethod);
+ AddMethod('procedure FullExpand', CallMethod);
+ AddProperty('Items', 'TTreeNodes', GetProp, nil);
+ AddProperty('Selected', 'TTreeNode', GetProp, SetProp);
+ AddProperty('TopItem', 'TTreeNode', GetProp, SetProp);
+ end;
+ AddClass(TTrackBar, 'TWinControl');
+ AddClass(TProgressBar, 'TWinControl');
+ AddClass(TListColumn, 'TPersistent');
+ with AddClass(TListColumns, 'TPersistent') do
+ begin
+ AddMethod('function Add: TListColumn', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TListColumn', CallMethod, True);
+ end;
+ with AddClass(TListItem, 'TPersistent') do
+ begin
+ AddMethod('procedure Delete', CallMethod);
+ AddMethod('function EditCaption: Boolean', CallMethod);
+ AddProperty('Caption', 'String', GetProp, SetProp);
+ AddProperty('Checked', 'Boolean', GetProp, SetProp);
+ AddProperty('Data', 'Pointer', GetProp, SetProp);
+ AddProperty('ImageIndex', 'Integer', GetProp, SetProp);
+ AddProperty('Selected', 'Boolean', GetProp, SetProp);
+ AddProperty('StateIndex', 'Integer', GetProp, SetProp);
+ AddProperty('SubItems', 'TStrings', GetProp, SetProp);
+ end;
+ with AddClass(TListItems, 'TPersistent') do
+ begin
+ AddMethod('function Add: TListItem', CallMethod);
+ AddMethod('procedure BeginUpdate', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure Delete(Index: Integer)', CallMethod);
+ AddMethod('procedure EndUpdate', CallMethod);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddDefaultProperty('Item', 'Integer', 'TListItem', CallMethod, True);
+ end;
+{$IFNDEF FPC}
+ AddClass(TIconOptions, 'TPersistent');
+{$ENDIF}
+ AddClass(TListView, 'TWinControl');
+ AddClass(TToolButton, 'TGraphicControl');
+ AddClass(TToolBar, 'TWinControl');
+{$IFNDEF CLX}
+ {$IFNDEF FPC}
+ AddClass(TMonthCalColors, 'TPersistent');
+ AddClass(TDateTimePicker, 'TWinControl');
+ AddClass(TMonthCalendar, 'TWinControl');
+ AddClass(TCustomRichEdit, 'TWinControl');
+ AddClass(TRichEdit, 'TCustomRichEdit');
+ {$ENDIF}
+{$ENDIF}
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TCheckListBox then
+ begin
+ if MethodName = 'CHECKED.GET' then
+ Result := TCheckListBox(Instance).Checked[Caller.Params[0]]
+ else if MethodName = 'CHECKED.SET' then
+ TCheckListBox(Instance).Checked[Caller.Params[0]] := Caller.Params[1]
+ end
+ else if ClassType = TPageControl then
+ begin
+ if MethodName = 'SELECTNEXTPAGE' then
+ TPageControl(Instance).SelectNextPage(Caller.Params[0])
+ else if MethodName = 'PAGES.GET' then
+ Result := frxInteger(TPageControl(Instance).Pages[Caller.Params[0]])
+ end
+ else if ClassType = TStatusPanels then
+ begin
+ if MethodName = 'ADD' then
+ Result := frxInteger(TStatusPanels(Instance).Add)
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TStatusPanels(Instance).Items[Caller.Params[0]])
+ end
+ else if ClassType = TTreeNode then
+ begin
+ if MethodName = 'DELETE' then
+ TTreeNode(Instance).Delete
+ else if MethodName = 'EDITTEXT' then
+ Result := TTreeNode(Instance).EditText
+ end
+ else if ClassType = TTreeNodes then
+ begin
+ if MethodName = 'ADD' then
+ Result := frxInteger(TTreeNodes(Instance).Add(TTreeNode(frxInteger(Caller.Params[0])),
+ Caller.Params[1]))
+ else if MethodName = 'ADDCHILD' then
+ Result := frxInteger(TTreeNodes(Instance).AddChild(TTreeNode(frxInteger(Caller.Params[0])),
+ Caller.Params[1]))
+ else if MethodName = 'BEGINUPDATE' then
+ TTreeNodes(Instance).BeginUpdate
+ else if MethodName = 'CLEAR' then
+ TTreeNodes(Instance).Clear
+ else if MethodName = 'DELETE' then
+ TTreeNodes(Instance).Delete(TTreeNode(frxInteger(Caller.Params[0])))
+ else if MethodName = 'ENDUPDATE' then
+ TTreeNodes(Instance).EndUpdate
+ else if MethodName = 'ITEM.GET' then
+ Result := frxInteger(TTreeNodes(Instance).Item[Caller.Params[0]])
+ end
+ else if ClassType = TTreeView then
+ begin
+ if MethodName = 'FULLCOLLAPSE' then
+ TTreeView(Instance).FullCollapse
+ else if MethodName = 'FULLEXPAND' then
+ TTreeView(Instance).FullExpand
+ end
+ else if ClassType = TListColumns then
+ begin
+ if MethodName = 'ADD' then
+ Result := frxInteger(TListColumns(Instance).Add)
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TListColumns(Instance).Items[Caller.Params[0]])
+ end
+ else if ClassType = TListItem then
+ begin
+ if MethodName = 'DELETE' then
+ TListItem(Instance).Delete
+{$IFNDEF CLX}
+ {$IFNDEF FPC}
+ else if MethodName = 'EDITCAPTION' then
+ Result := TListItem(Instance).EditCaption
+ {$ENDIF}
+{$ENDIF}
+ end
+ else if ClassType = TListItems then
+ begin
+ if MethodName = 'ADD' then
+ Result := frxInteger(TListItems(Instance).Add)
+{$IFNDEF FPC}
+ else if MethodName = 'BEGINUPDATE' then
+ TListItems(Instance).BeginUpdate
+{$ENDIF}
+ else if MethodName = 'CLEAR' then
+ TListItems(Instance).Clear
+ else if MethodName = 'DELETE' then
+ TListItems(Instance).Delete(Caller.Params[0])
+{$IFNDEF FPC}
+ else if MethodName = 'ENDUPDATE' then
+ TListItems(Instance).EndUpdate
+{$ENDIF}
+ else if MethodName = 'ITEM.GET' then
+ Result := frxInteger(TListItems(Instance).Item[Caller.Params[0]])
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TPageControl then
+ begin
+ if PropName = 'PAGECOUNT' then
+ Result := TPageControl(Instance).PageCount
+ end
+ else if ClassType = TTabSheet then
+ begin
+ if PropName = 'PAGECONTROL' then
+ Result := frxInteger(TTabSheet(Instance).PageControl)
+ end
+ else if ClassType = TTreeNode then
+ begin
+ if PropName = 'COUNT' then
+ Result := TTreeNode(Instance).Count
+ else if PropName = 'DATA' then
+ Result := frxInteger(TTreeNode(Instance).Data)
+ else if PropName = 'IMAGEINDEX' then
+ Result := TTreeNode(Instance).ImageIndex
+ else if PropName = 'SELECTEDINDEX' then
+ Result := TTreeNode(Instance).SelectedIndex
+{$IFNDEF CLX}
+ else if PropName = 'STATEINDEX' then
+ Result := TTreeNode(Instance).StateIndex
+{$ENDIF}
+ else if PropName = 'TEXT' then
+ Result := TTreeNode(Instance).Text
+ end
+ else if ClassType = TTreeNodes then
+ begin
+ if PropName = 'COUNT' then
+ Result := TTreeNodes(Instance).Count
+ end
+ else if ClassType = TTreeView then
+ begin
+ if PropName = 'ITEMS' then
+ Result := frxInteger(TTreeView(Instance).Items)
+ else if PropName = 'SELECTED' then
+ Result := frxInteger(TTreeView(Instance).Selected)
+ else if PropName = 'TOPITEM' then
+ Result := frxInteger(TTreeView(Instance).TopItem)
+ end
+ else if ClassType = TListItem then
+ begin
+ if PropName = 'CAPTION' then
+ Result := TListItem(Instance).Caption
+ else if PropName = 'CHECKED' then
+ Result := TListItem(Instance).Checked
+ else if PropName = 'DATA' then
+ Result := frxInteger(TListItem(Instance).Data)
+ else if PropName = 'IMAGEINDEX' then
+ Result := TListItem(Instance).ImageIndex
+ else if PropName = 'SELECTED' then
+ Result := TListItem(Instance).Selected
+{$IFNDEF CLX}
+ {$IFNDEF FPC}
+ else if PropName = 'STATEINDEX' then
+ Result := TListItem(Instance).StateIndex
+ {$ENDIF}
+{$ENDIF}
+ else if PropName = 'SUBITEMS' then
+ Result := frxInteger(TListItem(Instance).SubItems)
+ end
+ else if ClassType = TListItems then
+ begin
+ if PropName = 'COUNT' then
+ Result := TListItems(Instance).Count
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TTabSheet then
+ begin
+ if PropName = 'PAGECONTROL' then
+ TTabSheet(Instance).PageControl := TPageControl(frxInteger(Value))
+ end
+ else if ClassType = TTreeNode then
+ begin
+ if PropName = 'DATA' then
+ TTreeNode(Instance).Data := Pointer(frxInteger(Value))
+ else if PropName = 'IMAGEINDEX' then
+ TTreeNode(Instance).ImageIndex := frxInteger(Value)
+ else if PropName = 'SELECTEDINDEX' then
+ TTreeNode(Instance).SelectedIndex := Value
+{$IFNDEF CLX}
+ else if PropName = 'STATEINDEX' then
+ TTreeNode(Instance).StateIndex := Value
+{$ENDIF}
+ else if PropName = 'TEXT' then
+ TTreeNode(Instance).Text := Value
+ end
+ else if ClassType = TTreeView then
+ begin
+ if PropName = 'SELECTED' then
+ TTreeView(Instance).Selected := TTreeNode(frxInteger(Value))
+ else if PropName = 'TOPITEM' then
+ TTreeView(Instance).TopItem := TTreeNode(frxInteger(Value))
+ end
+ else if ClassType = TListItem then
+ begin
+ if PropName = 'CAPTION' then
+ TListItem(Instance).Caption := Value
+ else if PropName = 'CHECKED' then
+ TListItem(Instance).Checked := Value
+ else if PropName = 'DATA' then
+ TListItem(Instance).Data := Pointer(frxInteger(Value))
+ else if PropName = 'IMAGEINDEX' then
+ TListItem(Instance).ImageIndex := Integer(Value)
+ else if PropName = 'SELECTED' then
+ TListItem(Instance).Selected := Value
+{$IFNDEF CLX}
+ {$IFNDEF FPC}
+ else if PropName = 'STATEINDEX' then
+ TListItem(Instance).StateIndex := Value
+ {$ENDIF}
+{$ENDIF}
+ else if PropName = 'SUBITEMS' then
+ TListItem(Instance).SubItems := TStrings(frxInteger(Value))
+ end
+end;
+
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsExtCtrlsRTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/fs_ifdreg.dcr b/FastScript/fs_ifdreg.dcr
new file mode 100644
index 0000000..2d43261
Binary files /dev/null and b/FastScript/fs_ifdreg.dcr differ
diff --git a/FastScript/fs_ifdreg.pas b/FastScript/fs_ifdreg.pas
new file mode 100644
index 0000000..6778e38
--- /dev/null
+++ b/FastScript/fs_ifdreg.pas
@@ -0,0 +1,33 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2019 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_ifdreg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ Classes, DesignIntf, Controls, fs_ifdrtti;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+ RegisterComponents('FastScript', [TfsFDRTTI]);
+end;
+
+end.
diff --git a/FastScript/fs_ifdrtti.pas b/FastScript/fs_ifdrtti.pas
new file mode 100644
index 0000000..0b76bb0
--- /dev/null
+++ b/FastScript/fs_ifdrtti.pas
@@ -0,0 +1,391 @@
+{**********************************************}
+{ }
+{ FastScript v1.9 }
+{ FireDac classes and functions }
+{ }
+{ (c) 2003-2014 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{ Copyright (c) 2018 by Stalker SoftWare }
+{ }
+{ }
+{**********************************************}
+
+unit fs_iFDRTTI;
+
+interface
+
+{$i fs.inc}
+{$IF CompilerVersion <= 24} //XE3 or older
+ {$DEFINE ANYDAC}
+{$IFEND}
+uses
+ SysUtils, Classes, DB, Types, Controls, fs_iinterpreter, fs_itools, fs_idbrtti,
+ {$IFDEF ANYDAC}
+ uADCompClient, uADStanOption, uADCompDataSet, uADStanParam;
+ {$ELSE}
+ FireDAC.DatS, FireDAC.Comp.DataSet, FireDAC.Comp.Client, FireDAC.Stan.Param;
+ {$ENDIF}
+
+
+
+type
+{$IFDEF ANYDAC}
+ TFDDataSetLocateOptions = TADDataSetLocateOptions;
+ TFDCopyDataSetOptions = TADCopyDataSetOptions;
+{$ENDIF}
+
+{$i frxPlatformsAttribute.inc}
+ TfsFDRTTI = class(TComponent); // fake component
+
+ function IntToFDDataSetLocateOptions(i :Integer) :TFDDataSetLocateOptions; forward;
+ function IntToFDCopyDataSetOptions(i :Integer) :TFDCopyDataSetOptions; forward;
+
+implementation
+
+type
+{$IFDEF ANYDAC}
+ TFDCustomConnection = TADCustomConnection;
+ TFDConnection = TADConnection;
+ TFDParam = TADParam;
+ TFDMacro = TADMacro;
+ TFDDataset = TADDataset;
+ TFDTable = TADTable;
+ TFDQuery = TADQuery;
+ TFDMemTable = TADMemTable;
+ TFDStoredProc = TADStoredProc;
+ TFDAdaptedDataSet = TADAdaptedDataset;
+ TFDRdbmsDataSet = TADRdbmsDataSet;
+ TFDManager = TADManager;
+ TFDBlobStream = TADBlobStream;
+{$ENDIF}
+ TfsFDRTTIFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass; const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass; const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass; const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+{ TfsFDRTTIFunctions }
+
+{-------------------------------------------------------------------------------}
+constructor TfsFDRTTIFunctions.Create(AScript: TfsScript);
+begin
+
+ inherited Create(AScript);
+
+ with AScript do begin
+
+ AddClass(TFDManager, 'TComponent');
+
+ with AddClass(TFDBlobStream, 'TMemoryStream') do begin
+ AddConstructor('constructor Create(Field :TBlobField; Mode :TBlobStreamMode)', CallMethod);
+ AddMethod('procedure LoadFromFile(const FileName :String)', CallMethod);
+ AddMethod('procedure LoadFromStream(Stream :TStream)', CallMethod);
+ AddMethod('procedure SaveToStream(Stream :TStream)', CallMethod);
+ AddMethod('procedure SaveToFile(const FileName :String)', CallMethod);
+ end; { with }
+
+ with AddClass(TFDConnection, 'TComponent') do begin
+ AddMethod('procedure StartTransaction', CallMethod);
+ AddMethod('procedure Commit', CallMethod);
+ AddMethod('procedure Rollback', CallMethod);
+ AddProperty('InTransaction', 'Boolean', GetProp, nil);
+ end; { with }
+
+ AddEnumSet('TFDDataSetLocateOptions' ,'lxoCaseInsensitive, lxoPartialKey, lxoFromCurrent, lxoBackward, lxoCheckOnly, lxoNoFetchAll');
+ AddEnumSet('TFDCopyDataSetOptions' ,'coStructure, coCalcFields, coIndexesReset, coIndexesCopy, coConstraintsReset, coConstraintsCopy, ' +
+ 'coAggregatesReset, coAggregatesCopy, coRestart, coAppend, coEdit, ' + {$IFDEF Delphi22} 'coDelete, ' + {$ENDIF} 'coRefresh');
+
+ with AddClass(TFDDataSet, 'TDataSet') do begin
+ AddMethod('function LocateEx(const AKeyFields :String; const AKeyValues :Variant; AOptions :TFDDataSetLocateOptions) :Boolean', CallMethod);
+ AddMethod('function LocateExpr(const AExpression :String; AOptions :TFDDataSetLocateOptions) :Boolean', CallMethod);
+ AddMethod('procedure FetchAll', CallMethod);
+ AddMethod('function CreateBlobStream(Field :TField; Mode :TBlobStreamMode) :TStream', CallMethod);
+ AddMethod('function FindField(const FieldName :String) :TField', CallMethod);
+ AddMethod('procedure CopyDataSet(ASource :TDataset; AOptions :TFDCopyDataSetOptions)', CallMethod);
+ AddMethod('procedure SetFDData(ASource :TFDDataSet)', CallMethod);
+ AddProperty('RecNo', 'LongInt', GetProp, SetProp);
+ AddProperty('RecordCount', 'LongInt', GetProp, nil);
+ AddProperty('FieldDefs', 'TFieldDefs', GetProp, SetProp);
+ end; { with }
+
+ AddClass(TFDAdaptedDataSet, 'TFDDataSet');
+ AddClass(TFDRdbmsDataSet, 'TFDAdaptedDataSet');
+ AddClass(TFDParam, 'TCollectionItem');
+ AddClass(TFDMacro, 'TCollectionItem');
+
+ with AddClass(TFDQuery, 'TFDRdbmsDataSet') do begin
+ AddMethod('procedure ExecSQL', CallMethod);
+ AddMethod('function ParamByName(const Value :String) :TFDParam', CallMethod);
+ AddMethod('procedure Prepare', CallMethod);
+ AddMethod('function MacroByName(const Value :String) :TFDMacro', CallMethod);
+ AddMethod('function OpenOrExecute: Boolean', CallMethod); {added by fduenas}
+ AddProperty('ParamCount', 'Word', GetProp, nil);
+ AddProperty('MacroCount', 'Word', GetProp, nil);
+ end; { with }
+
+ with AddClass(TFDMemTable, 'TFDAdaptedDataSet') do begin
+ AddMethod('procedure CreateDataSet', CallMethod);
+ AddMethod('procedure Refresh', CallMethod);
+ end; { with }
+
+ with AddClass(TFDStoredProc, 'TFDRdbmsDataSet') do begin
+ AddMethod('procedure ExecProc', CallMethod);
+ AddMethod('function ParamByName(const Value :string) :TFDParam', CallMethod);
+ AddMethod('procedure Prepare', CallMethod);
+ AddMethod('function OpenOrExecute: Boolean', CallMethod); {added by fduenas}
+ AddMethod('function ExecFunc: Variant', CallMethod); {added by fduenas}
+ AddProperty('ParamCount', 'Word', GetProp, nil);
+ end;
+
+ end; { with }
+
+end; { Create }
+
+{-------------------------------------------------------------------------------}
+function TfsFDRTTIFunctions.CallMethod(Instance: TObject; ClassType: TClass; const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+
+ Result := 0;
+
+ if ClassType = TFDBlobStream then begin
+
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TFDBlobStream.Create(TBlobField(frxInteger(Caller.Params[0])), Caller.Params[1]))
+ else
+ if MethodName = 'LOADFROMFILE' then
+ TFDBlobStream(Instance).LoadFromFile(Caller.Params[0])
+ else
+ if MethodName = 'LOADFROMSTREAM' then
+ TFDBlobStream(Instance).LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else
+ if MethodName = 'SAVETOFILE' then
+ TFDBlobStream(Instance).SaveToFile(Caller.Params[0])
+ else
+ if MethodName = 'SAVETOSTREAM' then
+ TFDBlobStream(Instance).SaveToStream(TStream(frxInteger(Caller.Params[0])))
+
+ end else
+ if ClassType = TFDConnection then begin
+
+ if MethodName = 'STARTTRANSACTION' then
+ TFDConnection(Instance).StartTransaction
+ else
+ if MethodName = 'COMMIT' then
+ TFDConnection(Instance).Commit
+ else
+ if MethodName = 'ROLLBACK' then
+ TFDConnection(Instance).Rollback
+
+ end else
+ if ClassType = TFDDataSet then begin
+
+ if MethodName = 'LOCATEEX' then
+ Result := TFDDataSet(Instance).LocateEx(Caller.Params[0], Caller.Params[1], IntToFDDataSetLocateOptions(Caller.Params[2]))
+ else
+ if MethodName = 'LOCATEEXPR' then
+ Result := TFDDataSet(Instance).LocateEx(Caller.Params[0], IntToFDDataSetLocateOptions(Caller.Params[1]))
+ else
+ if MethodName = 'FETCHALL' then
+ TFDDataSet(Instance).FetchAll
+ else
+ if MethodName = 'CREATEBLOBSTREAM' then
+ Result := frxInteger(TFDDataSet(Instance).CreateBlobStream(TField(frxInteger(Caller.Params[0])), Caller.Params[1]))
+ else
+ if MethodName = 'FINDFIELD' then
+ Result := frxInteger(TFDDataSet(Instance).FindField(Caller.Params[0]))
+ else
+ if MethodName = 'COPYDATASET' then
+ TFDDataSet(Instance).CopyDataSet(TDataSet(frxInteger(Caller.Params[0])), IntToFDCopyDataSetOptions(Caller.Params[1]))
+ else
+ if MethodName = 'SETFDDATA' then
+ TFDDataSet(Instance).Data := TFDDataSet(frxInteger(Caller.Params[0])).Data;
+
+ end else
+ if ClassType = TFDQuery then begin
+
+ if MethodName = 'EXECSQL' then
+ TFDQuery(Instance).ExecSQL
+ else
+ if MethodName = 'PARAMBYNAME' then
+ Result := frxInteger(TFDQuery(Instance).ParamByName(Caller.Params[0]))
+ else
+ if MethodName = 'PREPARE' then
+ TFDQuery(Instance).Prepare
+ else
+ if MethodName = 'MACROBYNAME' then
+ Result := frxInteger(TFDQuery(Instance).MacroByName(Caller.Params[0]))
+ else
+ if MethodName = 'OPENOREXECUTE' then
+ Result := TFDQuery(Instance).OpenOrExecute; {added by fduenas}
+
+ end else
+ if ClassType = TFDMemTable then begin
+
+ if MethodName = 'CREATEDATASET' then
+ TFDMemTable(Instance).CreateDataSet()
+ else
+ if MethodName = 'REFRESH' then
+ TFDMemTable(Instance).Refresh()
+
+ end else
+ if ClassType = TFDStoredProc then begin
+
+ if MethodName = 'EXECPROC' then
+ TFDStoredProc(Instance).ExecProc
+ else
+ if MethodName = 'PARAMBYNAME' then
+ Result := frxInteger(TFDStoredProc(Instance).ParamByName(Caller.Params[0]))
+ else
+ if MethodName = 'PREPARE' then
+ TFDStoredProc(Instance).Prepare
+ else
+ if MethodName = 'OPENOREXECUTE' then
+ Result := TFDStoredProc(Instance).OpenOrExecute {added by fduenas}
+ else
+ if MethodName = 'EXECFUNC' then
+ Result := TFDStoredProc(Instance).ExecFunc; {added by fduenas}
+
+ end; { if }
+
+end; { CallMethod }
+
+{-------------------------------------------------------------------------------}
+function TfsFDRTTIFunctions.GetProp(Instance: TObject; ClassType: TClass; const PropName: String): Variant;
+begin
+
+ Result := 0;
+
+ if ClassType = TFDConnection then begin
+
+ if PropName = 'INTRANSACTION' then
+ Result := TFDConnection(Instance).InTransaction
+
+ end else
+ if ClassType = TFDDataSet then begin
+
+ if PropName = 'RECNO' then
+ Result := TFDDataSet(Instance).RecNo
+ else
+ if PropName = 'RECORDCOUNT' then
+ Result := TFDDataSet(Instance).RecordCount
+
+ end else
+ if ClassType = TFDQuery then begin
+
+ if PropName = 'PARAMCOUNT' then
+ Result := TFDQuery(Instance).ParamCount
+ else
+ if PropName = 'MacroCount' then
+ Result := TFDQuery(Instance).MacroCount
+
+ end; { if }
+
+end; { GetProp }
+
+{-------------------------------------------------------------------------------}
+procedure TfsFDRTTIFunctions.SetProp(Instance: TObject; ClassType: TClass; const PropName: String; Value: Variant);
+begin
+
+ if ClassType = TFDDataSet then begin
+
+ if PropName = 'RECNO' then
+ TFDDataSet(Instance).RecNo := Value
+
+ end; { if }
+
+end; { SetProp }
+
+{-------------------------------------------------------------------------------}
+function IntToFDDataSetLocateOptions(i :Integer) :TFDDataSetLocateOptions;
+begin
+
+ Result := [];
+
+ if (i and 1) <> 0 then
+ Result := Result + [lxoCaseInsensitive];
+
+ if (i and 2) <> 0 then
+ Result := Result + [lxoPartialKey];
+
+ if (i and 4) <> 0 then
+ Result := Result + [lxoFromCurrent];
+
+ if (i and 8) <> 0 then
+ Result := Result + [lxoBackward];
+
+ if (i and 16) <> 0 then
+ Result := Result + [lxoCheckOnly];
+
+ if (i and 32) <> 0 then
+ Result := Result + [lxoNoFetchAll];
+
+end; { IntToFDDataSetLocateOptions }
+
+{-------------------------------------------------------------------------------}
+function IntToFDCopyDataSetOptions(i :Integer) :TFDCopyDataSetOptions;
+begin
+
+ Result := [];
+
+ if (i and 1) <> 0 then
+ Result := Result + [coStructure];
+
+ if (i and 2) <> 0 then
+ Result := Result + [coCalcFields];
+
+ if (i and 4) <> 0 then
+ Result := Result + [coIndexesReset];
+
+ if (i and 8) <> 0 then
+ Result := Result + [coIndexesCopy];
+
+ if (i and 16) <> 0 then
+ Result := Result + [coConstraintsReset];
+
+ if (i and 32) <> 0 then
+ Result := Result + [coConstraintsCopy];
+
+ if (i and 64) <> 0 then
+ Result := Result + [coAggregatesReset];
+
+ if (i and 128) <> 0 then
+ Result := Result + [coAggregatesCopy];
+
+ if (i and 256) <> 0 then
+ Result := Result + [coRestart];
+
+ if (i and 512) <> 0 then
+ Result := Result + [coAppend];
+
+ if (i and 1024) <> 0 then
+ Result := Result + [coEdit];
+{$IFDEF Delphi22}
+ if (i and 2048) <> 0 then
+ Result := Result + [coDelete];
+
+ if (i and 4096) <> 0 then
+ Result := Result + [coRefresh];
+{$ELSE}
+ if (i and 2048) <> 0 then
+ Result := Result + [coRefresh];
+{$ENDIF}
+
+end; { IntToFDCopyDataSetOptions }
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsFDRTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TfsFDRTTIFunctions);
+
+finalization
+ if fsRTTIModules <> nil then
+ fsRTTIModules.Remove(TfsFDRTTIFunctions);
+
+end.
diff --git a/FastScript/fs_iformsrtti.pas b/FastScript/fs_iformsrtti.pas
new file mode 100644
index 0000000..ddfe5da
--- /dev/null
+++ b/FastScript/fs_iformsrtti.pas
@@ -0,0 +1,439 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Forms and StdCtrls }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_iformsrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, fs_ievents, fs_iclassesrtti,
+ fs_igraphicsrtti
+{$IFDEF CLX}
+ , QControls, QForms, QStdCtrls
+{$ELSE}
+ {$IFNDEF FPC}
+ , Windows
+ {$ELSE}
+ , LCLType, Buttons
+ {$ENDIF}
+ , Controls, Forms, StdCtrls
+{$ENDIF}
+{$IFDEF Delphi16}
+ , System.Types
+{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsFormsRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddConst('mrNone', 'Integer', mrNone);
+ AddConst('mrOk', 'Integer', mrOk);
+ AddConst('mrCancel', 'Integer', mrCancel);
+ AddConst('mrAbort', 'Integer', mrAbort);
+ AddConst('mrRetry', 'Integer', mrRetry);
+ AddConst('mrIgnore', 'Integer', mrIgnore);
+ AddConst('mrYes', 'Integer', mrYes);
+ AddConst('mrNo', 'Integer', mrNo);
+ AddConst('mrAll', 'Integer', mrAll);
+ AddConst('mrNoToAll', 'Integer', mrNoToAll);
+ AddConst('mrYesToAll', 'Integer', mrYesToAll);
+
+ AddConst('crDefault', 'Integer', crDefault);
+ AddConst('crNone', 'Integer', crNone);
+ AddConst('crArrow', 'Integer', crArrow);
+ AddConst('crCross', 'Integer', crCross);
+ AddConst('crIBeam', 'Integer', crIBeam);
+ AddConst('crSize', 'Integer', crSize);
+ AddConst('crSizeNESW', 'Integer', crSizeNESW);
+ AddConst('crSizeNS', 'Integer', crSizeNS);
+ AddConst('crSizeNWSE', 'Integer', crSizeNWSE);
+ AddConst('crSizeWE', 'Integer', crSizeWE);
+ AddConst('crUpArrow', 'Integer', crUpArrow);
+ AddConst('crHourGlass', 'Integer', crHourGlass);
+ AddConst('crDrag', 'Integer', crDrag);
+ AddConst('crNoDrop', 'Integer', crNoDrop);
+ AddConst('crHSplit', 'Integer', crHSplit);
+ AddConst('crVSplit', 'Integer', crVSplit);
+ AddConst('crMultiDrag', 'Integer', crMultiDrag);
+ AddConst('crSQLWait', 'Integer', crSQLWait);
+ AddConst('crNo', 'Integer', crNo);
+ AddConst('crAppStart', 'Integer', crAppStart);
+ AddConst('crHelp', 'Integer', crHelp);
+ AddConst('crHandPoint', 'Integer', crHandPoint);
+ AddConst('crSizeAll', 'Integer', crSizeAll);
+
+{$IFDEF CLX}
+ AddConst('bsNone', 'Integer', fbsNone);
+ AddConst('bsSingle', 'Integer', fbsSingle);
+ AddConst('bsSizeable', 'Integer', fbsSizeable);
+ AddConst('bsDialog', 'Integer', fbsDialog);
+ AddConst('bsToolWindow', 'Integer', fbsToolWindow);
+ AddConst('bsSizeToolWin', 'Integer', fbsSizeToolWin);
+{$ELSE}
+ AddConst('bsNone', 'Integer', bsNone);
+ AddConst('bsSingle', 'Integer', bsSingle);
+ AddConst('bsSizeable', 'Integer', bsSizeable);
+ AddConst('bsDialog', 'Integer', bsDialog);
+ AddConst('bsToolWindow', 'Integer', bsToolWindow);
+ AddConst('bsSizeToolWin', 'Integer', bsSizeToolWin);
+{$ENDIF}
+
+{$IFNDEF CLX}
+ AddConst('VK_RBUTTON', 'Integer', VK_RBUTTON);
+ AddConst('VK_CANCEL', 'Integer', VK_CANCEL);
+ AddConst('VK_MBUTTON', 'Integer', VK_MBUTTON);
+ AddConst('VK_BACK', 'Integer', VK_BACK);//Backspace key
+ AddConst('VK_TAB', 'Integer', VK_TAB);//Tab key
+ AddConst('VK_RETURN', 'Integer', VK_RETURN);//Enter key
+ AddConst('VK_SHIFT', 'Integer', VK_SHIFT);//Shift key
+ AddConst('VK_CONTROL', 'Integer', VK_CONTROL);//Ctrl key
+ AddConst('VK_MENU', 'Integer', VK_MENU);//Alt key
+ AddConst('VK_PAUSE', 'Integer', VK_PAUSE);//Pause key
+ AddConst('VK_CAPITAL', 'Integer', VK_CAPITAL);//Caps Lock key
+ AddConst('VK_ESCAPE', 'Integer', VK_ESCAPE);//Esc key
+ AddConst('VK_SPACE', 'Integer', VK_SPACE);//Space bar
+ AddConst('VK_PRIOR', 'Integer', VK_PRIOR);//Page Up key
+ AddConst('VK_NEXT', 'Integer', VK_NEXT);// Page Down key
+ AddConst('VK_END', 'Integer', VK_END);// End key
+ AddConst('VK_HOME', 'Integer', VK_HOME);// Home key
+ AddConst('VK_LEFT', 'Integer', VK_LEFT);// Left Arrow key
+ AddConst('VK_UP', 'Integer', VK_UP);// Up Arrow key
+ AddConst('VK_RIGHT', 'Integer', VK_RIGHT);// Right Arrow key
+ AddConst('VK_DOWN', 'Integer', VK_DOWN);// Down Arrow key
+ AddConst('VK_INSERT', 'Integer', VK_INSERT);// Insert key
+ AddConst('VK_DELETE', 'Integer', VK_DELETE);// Delete key
+ AddConst('VK_HELP', 'Integer', VK_HELP);// Help key
+ AddConst('VK_LWIN', 'Integer', VK_LWIN);// Left Windows key (Microsoft keyboard)
+ AddConst('VK_RWIN', 'Integer', VK_RWIN);// Right Windows key (Microsoft keyboard)
+ AddConst('VK_APPS', 'Integer', VK_APPS);// Applications key (Microsoft keyboard)
+ AddConst('VK_NUMPAD0', 'Integer', VK_NUMPAD0);// 0 key (numeric keypad)
+ AddConst('VK_NUMPAD1', 'Integer', VK_NUMPAD1);// 1 key (numeric keypad)
+ AddConst('VK_NUMPAD2', 'Integer', VK_NUMPAD2);// 2 key (numeric keypad)
+ AddConst('VK_NUMPAD3', 'Integer', VK_NUMPAD3);// 3 key (numeric keypad)
+ AddConst('VK_NUMPAD4', 'Integer', VK_NUMPAD4);// 4 key (numeric keypad)
+ AddConst('VK_NUMPAD5', 'Integer', VK_NUMPAD5);// 5 key (numeric keypad)
+ AddConst('VK_NUMPAD6', 'Integer', VK_NUMPAD6);// 6 key (numeric keypad)
+ AddConst('VK_NUMPAD7', 'Integer', VK_NUMPAD7);// 7 key (numeric keypad)
+ AddConst('VK_NUMPAD8', 'Integer', VK_NUMPAD8);// 8 key (numeric keypad)
+ AddConst('VK_NUMPAD9', 'Integer', VK_NUMPAD9);// 9 key (numeric keypad)
+ AddConst('VK_MULTIPLY', 'Integer', VK_MULTIPLY);// Multiply key (numeric keypad)
+ AddConst('VK_ADD', 'Integer', VK_ADD);// Add key (numeric keypad)
+ AddConst('VK_SEPARATOR', 'Integer', VK_SEPARATOR);// Separator key (numeric keypad)
+ AddConst('VK_SUBTRACT', 'Integer', VK_SUBTRACT);// Subtract key (numeric keypad)
+ AddConst('VK_DECIMAL', 'Integer', VK_DECIMAL);// Decimal key (numeric keypad)
+ AddConst('VK_DIVIDE', 'Integer', VK_DIVIDE);// Divide key (numeric keypad)
+ AddConst('VK_F1', 'Integer', VK_F1);// F1 key
+ AddConst('VK_F2', 'Integer', VK_F2);// F2 key
+ AddConst('VK_F3', 'Integer', VK_F3);// F3 key
+ AddConst('VK_F4', 'Integer', VK_F4);// F4 key
+ AddConst('VK_F5', 'Integer', VK_F5);// F5 key
+ AddConst('VK_F6', 'Integer', VK_F6);// F6 key
+ AddConst('VK_F7', 'Integer', VK_F7);// F7 key
+ AddConst('VK_F8', 'Integer', VK_F8);// F8 key
+ AddConst('VK_F9', 'Integer', VK_F9);// F9 key
+ AddConst('VK_F10', 'Integer', VK_F10);// F10 key
+ AddConst('VK_F11', 'Integer', VK_F11);// F11 key
+ AddConst('VK_F12', 'Integer', VK_F12);// F12 key
+ AddConst('VK_NUMLOCK', 'Integer', VK_NUMLOCK);// Num Lock key
+ AddConst('VK_SCROLL', 'Integer', VK_SCROLL);// Scroll Lock key
+{$ENDIF}
+
+ AddConst('crDefault', 'Integer', crDefault);
+ AddConst('crNone', 'Integer', crNone);
+ AddConst('crArrow', 'Integer', crArrow);
+ AddConst('crCross', 'Integer', crCross);
+ AddConst('crIBeam', 'Integer', crIBeam);
+ AddConst('crSize', 'Integer', crSize);
+ AddConst('crSizeNESW', 'Integer', crSizeNESW);
+ AddConst('crSizeNS', 'Integer', crSizeNS);
+ AddConst('crSizeNWSE', 'Integer', crSizeNWSE);
+ AddConst('crSizeWE', 'Integer', crSizeWE);
+ AddConst('crUpArrow', 'Integer', crUpArrow);
+ AddConst('crHourGlass', 'Integer', crHourGlass);
+ AddConst('crDrag', 'Integer', crDrag);
+ AddConst('crNoDrop', 'Integer', crNoDrop);
+ AddConst('crHSplit', 'Integer', crHSplit);
+ AddConst('crVSplit', 'Integer', crVSplit);
+ AddConst('crMultiDrag', 'Integer', crMultiDrag);
+ AddConst('crSQLWait', 'Integer', crSQLWait);
+ AddConst('crNo', 'Integer', crNo);
+ AddConst('crAppStart', 'Integer', crAppStart);
+ AddConst('crHelp', 'Integer', crHelp);
+ AddConst('crHandPoint', 'Integer', crHandPoint);
+ AddConst('crSizeAll', 'Integer', crSizeAll);
+
+ AddType('TFormBorderStyle', fvtInt);
+ AddType('TBorderStyle', fvtInt);
+ AddType('TAlignment', fvtInt);
+ AddType('TLeftRight', fvtInt);
+ AddConst('taLeftJustify', 'Integer', taLeftJustify);
+ AddConst('taRightJustify', 'Integer', taRightJustify);
+ AddConst('taCenter', 'Integer', taCenter);
+
+ AddEnumSet('TShiftState', 'ssShift, ssAlt, ssCtrl, ssLeft, ssRight, ssMiddle, ssDouble');
+// AddEnum('TAlignment', 'taLeftJustify, taRightJustify, taCenter');
+ AddEnum('TAlign', 'alNone, alTop, alBottom, alLeft, alRight, alClient');
+ AddEnum('TMouseButton', 'mbLeft, mbRight, mbMiddle');
+ AddEnumSet('TAnchors', 'akLeft, akTop, akRight, akBottom');
+ AddEnum('TBevelCut', 'bvNone, bvLowered, bvRaised, bvSpace');
+ AddEnum('TTextLayout', 'tlTop, tlCenter, tlBottom');
+ AddEnum('TEditCharCase', 'ecNormal, ecUpperCase, ecLowerCase');
+ AddEnum('TScrollStyle', 'ssNone, ssHorizontal, ssVertical, ssBoth');
+ AddEnum('TComboBoxStyle', 'csDropDown, csSimple, csDropDownList, csOwnerDrawFixed, csOwnerDrawVariable');
+ AddEnum('TCheckBoxState', 'cbUnchecked, cbChecked, cbGrayed');
+ AddEnum('TListBoxStyle', 'lbStandard, lbOwnerDrawFixed, lbOwnerDrawVariable');
+ AddEnum('TWindowState', 'wsNormal, wsMinimized, wsMaximized');
+ AddEnum('TFormStyle', 'fsNormal, fsMDIChild, fsMDIForm, fsStayOnTop');
+ AddEnumSet('TBorderIcons', 'biSystemMenu, biMinimize, biMaximize, biHelp');
+ AddEnum('TPosition', 'poDesigned, poDefault, poDefaultPosOnly, poDefaultSizeOnly, poScreenCenter, poDesktopCenter');
+ AddEnum('TCloseAction', 'caNone, caHide, caFree, caMinimize');
+
+ with AddClass(TControl, 'TComponent') do
+ begin
+ AddProperty('Parent', 'TWinControl', GetProp, SetProp);
+ AddMethod('procedure Hide', CallMethod);
+ AddMethod('procedure Show', CallMethod);
+ AddMethod('procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer)', CallMethod);
+ AddEvent('OnCanResize', TfsCanResizeEvent);
+ AddEvent('OnClick', TfsNotifyEvent);
+ AddEvent('OnDblClick', TfsNotifyEvent);
+ AddEvent('OnMouseDown', TfsMouseEvent);
+ AddEvent('OnMouseMove', TfsMouseMoveEvent);
+ AddEvent('OnMouseUp', TfsMouseEvent);
+ AddEvent('OnResize', TfsNotifyEvent);
+ end;
+ with AddClass(TWinControl, 'TControl') do
+ begin
+ AddMethod('procedure SetFocus', CallMethod);
+ AddMethod('procedure Invalidate', CallMethod);
+ AddEvent('OnEnter', TfsNotifyEvent);
+ AddEvent('OnExit', TfsNotifyEvent);
+ AddEvent('OnKeyDown', TfsKeyEvent);
+ AddEvent('OnKeyPress', TfsKeyPressEvent);
+ AddEvent('OnKeyUp', TfsKeyEvent);
+ end;
+ AddClass(TCustomControl, 'TWinControl');
+ AddClass(TGraphicControl, 'TControl');
+ AddClass(TGroupBox, 'TWinControl');
+ AddClass(TLabel, 'TControl');
+ AddClass(TEdit, 'TWinControl');
+ AddClass(TMemo, 'TWinControl');
+ with AddClass(TCustomComboBox, 'TWinControl') do
+ begin
+ AddProperty('DroppedDown', 'Boolean', GetProp, SetProp);
+ AddProperty('ItemIndex', 'Integer', GetProp, SetProp);
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddEvent('OnDropDown', TfsNotifyEvent);
+ AddEvent('OnCloseUp', TfsNotifyEvent);
+ end;
+ AddClass(TComboBox, 'TCustomComboBox');
+ AddClass(TButton, 'TWinControl');
+ AddClass(TCheckBox, 'TWinControl');
+ AddClass(TRadioButton, 'TWinControl');
+ with AddClass(TCustomListBox, 'TWinControl') do
+ begin
+ AddProperty('ItemIndex', 'Integer', GetProp, SetProp);
+ AddProperty('SelCount', 'Integer', GetProp, nil);
+ AddIndexProperty('Selected', 'Integer', 'Boolean', CallMethod);
+ end;
+ AddClass(TListBox, 'TCustomListBox');
+ AddClass(TControlScrollBar, 'TPersistent');
+ AddClass(TScrollingWinControl, 'TWinControl');
+ AddClass(TScrollBox, 'TScrollingWinControl');
+ with AddClass(TCustomForm, 'TScrollingWinControl') do
+ begin
+ AddMethod('procedure Close', CallMethod);
+ AddMethod('procedure Hide', CallMethod);
+ AddMethod('procedure Show', CallMethod);
+ AddMethod('function ShowModal: Integer', CallMethod);
+ AddEvent('OnActivate', TfsNotifyEvent);
+ AddEvent('OnClose', TfsCloseEvent);
+ AddEvent('OnCloseQuery', TfsCloseQueryEvent);
+ AddEvent('OnCreate', TfsNotifyEvent);
+ AddEvent('OnDestroy', TfsNotifyEvent);
+ AddEvent('OnDeactivate', TfsNotifyEvent);
+ AddEvent('OnHide', TfsNotifyEvent);
+ AddEvent('OnPaint', TfsNotifyEvent);
+ AddEvent('OnShow', TfsNotifyEvent);
+ AddProperty('Canvas', 'TCanvas', GetProp, nil);
+ AddProperty('ModalResult', 'Integer', GetProp, SetProp);
+ end;
+ AddClass(TForm, 'TCustomForm');
+ AddClass(TDataModule, 'TComponent');
+ with AddClass(TApplication, 'TComponent') do
+ begin
+ AddMethod('procedure Minimize', CallMethod);
+ AddMethod('procedure ProcessMessages', CallMethod);
+ AddMethod('procedure Restore', CallMethod);
+ AddProperty('ExeName', 'String', GetProp, nil);
+ end;
+ AddObject('Application', Application);
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ Form: TCustomForm;
+begin
+ Result := 0;
+
+ if ClassType = TControl then
+ begin
+ if MethodName = 'HIDE' then
+ TControl(Instance).Hide
+ else if MethodName = 'SHOW' then
+ TControl(Instance).Show
+ else if MethodName = 'SETBOUNDS' then
+ TControl(Instance).SetBounds(Caller.Params[0], Caller.Params[1], Caller.Params[2], Caller.Params[3])
+ end
+ else if ClassType = TWinControl then
+ begin
+ if MethodName = 'SETFOCUS' then
+ TWinControl(Instance).SetFocus
+ else if MethodName = 'INVALIDATE' then
+ TWinControl(Instance).Invalidate;
+ end
+ else if ClassType = TCustomListBox then
+ begin
+ if MethodName = 'SELECTED.GET' then
+ Result := TCustomListBox(Instance).Selected[Caller.Params[0]]
+ else if MethodName = 'SELECTED.SET' then
+ TCustomListBox(Instance).Selected[Caller.Params[0]] := Caller.Params[1]
+ end
+ else if ClassType = TCustomForm then
+ begin
+ Form := TCustomForm(Instance);
+ if MethodName = 'CLOSE' then
+ Form.Close
+ else if MethodName = 'HIDE' then
+ Form.Hide
+ else if MethodName = 'SHOW' then
+ Form.Show
+ else if MethodName = 'SHOWMODAL' then
+ Result := Form.ShowModal;
+ end
+ else if ClassType = TApplication then
+ begin
+ if MethodName = 'MINIMIZE' then
+ TApplication(Instance).Minimize
+ else if MethodName = 'PROCESSMESSAGES' then
+ TApplication(Instance).ProcessMessages
+ else if MethodName = 'RESTORE' then
+ TApplication(Instance).Restore
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TControl then
+ begin
+ if PropName = 'PARENT' then
+ Result := frxInteger(TControl(Instance).Parent)
+ end
+ else if ClassType = TCustomComboBox then
+ begin
+ if PropName = 'DROPPEDDOWN' then
+ Result := TCustomComboBox(Instance).DroppedDown
+ else if PropName = 'ITEMINDEX' then
+ Result := TCustomComboBox(Instance).ItemIndex
+ end
+ else if ClassType = TCustomListBox then
+ begin
+ if PropName = 'SELCOUNT' then
+ Result := TCustomListBox(Instance).SelCount
+ else if PropName = 'ITEMINDEX' then
+ Result := TCustomListBox(Instance).ItemIndex
+ end
+ else if ClassType = TCustomForm then
+ begin
+ if PropName = 'MODALRESULT' then
+ Result := TCustomForm(Instance).ModalResult
+ else if PropName = 'CANVAS' then
+ Result := frxInteger(TCustomForm(Instance).Canvas)
+ end
+ else if ClassType = TApplication then
+ begin
+ if PropName = 'EXENAME' then
+ Result := TApplication(Instance).ExeName
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TControl then
+ begin
+ if PropName = 'PARENT' then
+ TControl(Instance).Parent := TWinControl(frxInteger(Value))
+ end
+ else if ClassType = TCustomComboBox then
+ begin
+ if PropName = 'DROPPEDDOWN' then
+ TCustomComboBox(Instance).DroppedDown := Value
+ else if PropName = 'ITEMINDEX' then
+ TCustomComboBox(Instance).ItemIndex := Value
+ end
+ else if ClassType = TCustomListBox then
+ begin
+ if PropName = 'ITEMINDEX' then
+ TCustomListBox(Instance).ItemIndex := Value
+ end
+ else if ClassType = TCustomForm then
+ begin
+ if PropName = 'MODALRESULT' then
+ TCustomForm(Instance).ModalResult := Value
+ end
+end;
+
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsFormsRTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/fs_igraphicsrtti.pas b/FastScript/fs_igraphicsrtti.pas
new file mode 100644
index 0000000..6e6c627
--- /dev/null
+++ b/FastScript/fs_igraphicsrtti.pas
@@ -0,0 +1,262 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Graphics.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_igraphicsrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, fs_iclassesrtti{$IFDEF DELPHI16}, Controls{$ENDIF}
+{$IFDEF CLX}
+, QGraphics
+{$ELSE}
+, Graphics
+{$ENDIF}
+{$IFDEF Delphi16}
+ , System.Types
+{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsGraphicsRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ THackGraphic = class(TGraphic)
+ end;
+
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ procedure GetColorProc(const Name: String);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ GetColorValues(GetColorProc);
+{$IFDEF FPC}
+ AddEnumSet('TFontStyles', 'fsBold, fsItalic, fsStrikeout, fsUnderline');
+{$ELSE}
+ AddEnumSet('TFontStyles', 'fsBold, fsItalic, fsUnderline, fsStrikeout');
+{$ENDIF}
+ AddEnum('TFontPitch', 'fpDefault, fpVariable, fpFixed');
+ AddEnum('TPenStyle', 'psSolid, psDash, psDot, psDashDot, psDashDotDot, psClear, psInsideFrame');
+ AddEnum('TPenMode', 'pmBlack, pmWhite, pmNop, pmNot, pmCopy, pmNotCopy, pmMergePenNot, ' +
+ 'pmMaskPenNot, pmMergeNotPen, pmMaskNotPen, pmMerge, pmNotMerge, pmMask, pmNotMask, pmXor, pmNotXor');
+ AddEnum('TBrushStyle', 'bsSolid, bsClear, bsHorizontal, bsVertical, ' +
+ 'bsFDiagonal, bsBDiagonal, bsCross, bsDiagCross');
+
+ with AddClass(TFont, 'TPersistent') do
+ AddConstructor('constructor Create', CallMethod);
+ with AddClass(TPen, 'TPersistent') do
+ AddConstructor('constructor Create', CallMethod);
+ with AddClass(TBrush, 'TPersistent') do
+ AddConstructor('constructor Create', CallMethod);
+ with AddClass(TCanvas, 'TPersistent') do
+ begin
+ AddConstructor('constructor Create', CallMethod);
+ AddMethod('procedure Draw(X, Y: Integer; Graphic: TGraphic)', CallMethod);
+ AddMethod('procedure Ellipse(X1, Y1, X2, Y2: Integer)', CallMethod);
+ AddMethod('procedure LineTo(X, Y: Integer)', CallMethod);
+ AddMethod('procedure MoveTo(X, Y: Integer)', CallMethod);
+ AddMethod('procedure Rectangle(X1, Y1, X2, Y2: Integer)', CallMethod);
+ AddMethod('procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer)', CallMethod);
+ AddMethod('procedure StretchDraw(X1, Y1, X2, Y2: Integer; Graphic: TGraphic)', CallMethod);
+ AddMethod('function TextHeight(const Text: string): Integer', CallMethod);
+ AddMethod('procedure TextOut(X, Y: Integer; const Text: string)', CallMethod);
+ AddMethod('function TextWidth(const Text: string): Integer', CallMethod);
+{$IFNDEF CLX}
+ AddIndexProperty('Pixels', 'Integer, Integer', 'TColor', CallMethod);
+{$ENDIF}
+ end;
+ with AddClass(TGraphic, 'TPersistent') do
+ begin
+ AddConstructor('constructor Create', CallMethod);
+ AddMethod('procedure LoadFromFile(const Filename: string)', CallMethod);
+ AddMethod('procedure SaveToFile(const Filename: string)', CallMethod);
+ AddProperty('Height', 'Integer', GetProp, SetProp);
+ AddProperty('Width', 'Integer', GetProp, SetProp);
+ end;
+ with AddClass(TPicture, 'TPersistent') do
+ begin
+ AddMethod('procedure LoadFromFile(const Filename: string)', CallMethod);
+ AddMethod('procedure SaveToFile(const Filename: string)', CallMethod);
+ AddProperty('Height', 'Integer', GetProp, nil);
+ AddProperty('Width', 'Integer', GetProp, nil);
+ end;
+{$IFNDEF CROSS_COMPILE}
+ AddClass(TMetafile, 'TGraphic');
+ with AddClass(TMetafileCanvas, 'TCanvas') do
+ AddConstructor('constructor Create(AMetafile: TMetafile; ReferenceDevice: Integer)', CallMethod);
+{$ENDIF}
+ with AddClass(TBitmap, 'TGraphic') do
+ AddProperty('Canvas', 'TCanvas', GetProp);
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ _Canvas: TCanvas;
+begin
+ Result := 0;
+
+ if ClassType = TFont then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TFont(Instance).Create)
+ end
+ else if ClassType = TPen then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TPen(Instance).Create)
+ end
+ else if ClassType = TBrush then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TBrush(Instance).Create)
+ end
+ else if ClassType = TCanvas then
+ begin
+ _Canvas := TCanvas(Instance);
+
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TCanvas(Instance).Create)
+ else if MethodName = 'DRAW' then
+ _Canvas.Draw(Caller.Params[0], Caller.Params[1], TGraphic(frxInteger(Caller.Params[2])))
+ else if MethodName = 'ELLIPSE' then
+ _Canvas.Ellipse(Caller.Params[0], Caller.Params[1], Caller.Params[2], Caller.Params[3])
+ else if MethodName = 'LINETO' then
+ _Canvas.LineTo(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'MOVETO' then
+ _Canvas.MoveTo(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'RECTANGLE' then
+ _Canvas.Rectangle(Caller.Params[0], Caller.Params[1], Caller.Params[2], Caller.Params[3])
+ else if MethodName = 'ROUNDRECT' then
+ _Canvas.RoundRect(Caller.Params[0], Caller.Params[1], Caller.Params[2], Caller.Params[3], Caller.Params[4], Caller.Params[5])
+ else if MethodName = 'STRETCHDRAW' then
+ _Canvas.StretchDraw(Rect(Caller.Params[0], Caller.Params[1], Caller.Params[2], Caller.Params[3]), TGraphic(frxInteger(Caller.Params[4])))
+ else if MethodName = 'TEXTHEIGHT' then
+ Result := _Canvas.TextHeight(Caller.Params[0])
+ else if MethodName = 'TEXTOUT' then
+ _Canvas.TextOut(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'TEXTWIDTH' then
+ Result := _Canvas.TextWidth(Caller.Params[0])
+{$IFNDEF CLX}
+ else if MethodName = 'PIXELS.GET' then
+ Result := _Canvas.Pixels[Caller.Params[0], Caller.Params[1]]
+ else if MethodName = 'PIXELS.SET' then
+ _Canvas.Pixels[Caller.Params[0], Caller.Params[1]] := Caller.Params[2]
+{$ENDIF}
+ end
+ else if ClassType = TGraphic then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(THackGraphic(Instance).Create)
+ else if MethodName = 'LOADFROMFILE' then
+ TGraphic(Instance).LoadFromFile(Caller.Params[0])
+ else if MethodName = 'SAVETOFILE' then
+ TGraphic(Instance).SaveToFile(Caller.Params[0])
+ end
+ else if ClassType = TPicture then
+ begin
+ if MethodName = 'LOADFROMFILE' then
+ TPicture(Instance).LoadFromFile(Caller.Params[0])
+ else if MethodName = 'SAVETOFILE' then
+ TPicture(Instance).SaveToFile(Caller.Params[0])
+ end
+{$IFNDEF CROSS_COMPILE}
+ else if ClassType = TMetafileCanvas then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TMetafileCanvas(Instance).Create(TMetafile(frxInteger(Caller.Params[0])), Caller.Params[1]))
+ end
+{$ENDIF}
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TGraphic then
+ begin
+ if PropName = 'HEIGHT' then
+ Result := TGraphic(Instance).Height
+ else if PropName = 'WIDTH' then
+ Result := TGraphic(Instance).Width
+ end
+ else if ClassType = TPicture then
+ begin
+ if PropName = 'HEIGHT' then
+ Result := TPicture(Instance).Height
+ else if PropName = 'WIDTH' then
+ Result := TPicture(Instance).Width
+ end
+ else if ClassType = TBitmap then
+ begin
+ if PropName = 'CANVAS' then
+ Result := frxInteger(TBitmap(Instance).Canvas)
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TGraphic then
+ begin
+ if PropName = 'HEIGHT' then
+ TGraphic(Instance).Height := Value
+ else if PropName = 'WIDTH' then
+ TGraphic(Instance).Width := Value
+ end
+end;
+
+procedure TFunctions.GetColorProc(const Name: String);
+var
+ c: Integer;
+begin
+ IdentToColor(Name, c);
+ Script.AddConst(Name, 'Integer', c);
+end;
+
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsGraphicsRTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/fs_iibxreg.pas b/FastScript/fs_iibxreg.pas
new file mode 100644
index 0000000..69c1428
--- /dev/null
+++ b/FastScript/fs_iibxreg.pas
@@ -0,0 +1,58 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_iibxreg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ Classes
+{$IFNDEF FPC}
+ {$IFNDEF Delphi6}
+, DsgnIntf
+{$ELSE}
+{$IFDEF DELPHI16}
+, Controls
+{$ENDIF}
+, DesignIntf
+{$ENDIF}
+{$ELSE}
+,PropEdits, LazarusPackageIntf, LResources
+{$ENDIF}
+, fs_iibxrtti;
+
+
+
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+{$IFDEF DELPHI16}
+ //GroupDescendentsWith(TfsIBXRTTI, TControl);
+{$ENDIF}
+ RegisterComponents('FastScript', [TfsIBXRTTI]);
+end;
+
+initialization
+{$IFDEF FPC}
+ {$INCLUDE fs_ireg.lrs}
+{$ENDIF}
+
+
+end.
diff --git a/FastScript/fs_iibxrtti.pas b/FastScript/fs_iibxrtti.pas
new file mode 100644
index 0000000..78c7372
--- /dev/null
+++ b/FastScript/fs_iibxrtti.pas
@@ -0,0 +1,127 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ IBX classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_iibxrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, fs_itools, fs_idbrtti, db
+{$IFDEF DELPHI20}
+ , IBX.ibdatabase, IBX.IBCustomDataSet, IBX.IBQuery, IBX.IBTable, IBX.IBStoredProc
+{$ELSE}
+ , ibdatabase, IBCustomDataSet, IBQuery, IBTable, IBStoredProc
+{$ENDIF}
+{$IFDEF DELPHI16}, Controls, System.Types{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsIBXRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class (TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass; const MethodName:
+ String; Caller: TfsMethodHelper): Variant;
+ function RecordCount(Instance: TObject; ClassType: TClass; const PropName:
+ String): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddClass(TIBDataBase, 'TComponent');
+
+ with AddClass(TIBTransaction, 'TComponent') do
+ begin
+ AddMethod('procedure Commit', CallMethod);
+ AddMethod('procedure RollBack', CallMethod);
+ AddMethod('procedure StartTransaction', CallMethod);
+ end;
+
+ AddClass(TIBCustomDataSet, 'TDataSet');
+ AddClass(TIBTable, 'TIBCustomDataSet');
+ with AddClass(TIBQuery, 'TIBCustomDataSet') do
+ begin
+ AddMethod('procedure ExecSQL', CallMethod);
+ AddMethod('procedure FetchAll', CallMethod);
+ AddProperty('RecordCount', 'Integer',RecordCount, nil);
+ end;
+ with AddClass(TIBStoredProc, 'TIBCustomDataSet') do
+ AddMethod('procedure ExecProc', CallMethod);
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; const
+ MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TIBQuery then
+ begin
+ if MethodName = 'EXECSQL' then
+ TIBQuery(Instance).ExecSQL
+ else
+ if MethodName = 'FETCHALL' then
+ TIBQuery(Instance).FETCHALL;
+ end
+ else
+ if ClassType = TIBStoredProc then
+ begin
+ if MethodName = 'EXECPROC' then
+ TIBStoredProc(Instance).ExecProc
+ end
+ else
+ if(ClassType = TIBTransaction) AND (MethodName = 'COMMIT') then
+ TIBTransaction(Instance).Commit
+ else
+ if (ClassType = TIBTransaction) AND (MethodName = 'ROLLBACK') then
+ TIBTransaction(Instance).RollBack
+ else
+ if(ClassType = TIBTransaction) AND (MethodName = 'STARTTRANSACTION') then
+ TIBTransaction(Instance).StartTransaction;
+
+end;
+
+function TFunctions.RecordCount(Instance: TObject; ClassType: TClass; const
+ PropName: String): Variant;
+begin
+ Result:=0;
+ if (ClassType = TIBQuery) AND (PropName = 'RECORDCOUNT') then
+ Result:=TIBQuery(Instance).RecordCount;
+
+end;
+
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsIBXRTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/fs_iilparser.pas b/FastScript/fs_iilparser.pas
new file mode 100644
index 0000000..16e5bdf
--- /dev/null
+++ b/FastScript/fs_iilparser.pas
@@ -0,0 +1,2059 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Intermediate Language parser }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_iilparser;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, fs_iparser, fs_iexpression, fs_xml
+{$IFDEF Delphi6}
+, Variants
+{$ENDIF};
+{$ELSE}
+interface
+
+{$i fmx.inc}
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_iparser, FMX.fs_iexpression, FMX.fs_xml, System.Variants;
+{$ENDIF}
+
+
+type
+ TfsEmitOp = (emNone, emCreate, emFree);
+
+{ TfsILParser performs the syntax analyze of source code. Source code
+ can be on ANY language. Grammars are stored in the XML file and
+ can be easily changed to support any structured language. Currently
+ supported languages are Pascal, C++, Basic and Java subsets.
+
+ The result of the analyze (function MakeScript) is the output XML script
+ (called Intermediate Language). This output processed by the ParseILScript
+ method. This method creates the program structure (defined in the
+ fs_Interpreter unit) and fills it by the data }
+
+ TfsILParser = class(TObject)
+ private
+ FErrorPos: String;
+ FGrammar: TfsXMLDocument;
+ FILScript: TfsXMLDocument;
+ FLangName: String;
+ FNeedDeclareVars: Boolean;
+ FParser: TfsParser;
+ FProgram: TfsScript;
+ FProgRoot: TfsXMLItem;
+ FRoot: TfsXMLItem;
+ FUnitName: String;
+ FUsesList: TStrings;
+ FWithList: TStringList;
+ function PropPos(xi: TfsXMLItem): String;
+ procedure ErrorPos(xi: TfsXMLItem);
+ procedure CheckIdent(Prog: TfsScript; const Name: String);
+ function FindClass(const TypeName: String): TfsClassVariable;
+ procedure CheckTypeCompatibility(Var1, Var2: TfsCustomVariable);
+ function FindVar(Prog: TfsScript; const Name: String): TfsCustomVariable;
+ function FindType(s: String): TfsVarType;
+ function CreateVar(xi: TfsXMLItem; Prog: TfsScript; const Name: String;
+ Statement: TfsStatement = nil; CreateParam: Boolean = False;
+ IsVarParam: Boolean = False): TfsCustomVariable;
+ function DoSet(xi: TfsXMLItem; Prog: TfsScript): TfsSetExpression;
+ function DoExpression(xi: TfsXMLItem; Prog: TfsScript): TfsExpression;
+ procedure DoUses(xi: TfsXMLItem; Prog: TfsScript);
+ procedure DoVar(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoConst(xi: TfsXMLItem; Prog: TfsScript);
+ procedure DoParameters(xi: TfsXMLItem; v: TfsProcVariable);
+ procedure DoProc1(xi: TfsXMLItem; Prog: TfsScript);
+ procedure DoProc2(xi: TfsXMLItem; Prog: TfsScript);
+ procedure DoFunc1(xi: TfsXMLItem; Prog: TfsScript);
+ procedure DoFunc2(xi: TfsXMLItem; Prog: TfsScript);
+ procedure DoAssign(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoCall(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoIf(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoFor(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoVbFor(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoCppFor(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoWhile(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoRepeat(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoCase(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoTry(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoBreak(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoContinue(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoExit(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoReturn(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoWith(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoDelete(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoCompoundStmt(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoStmt(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoProgram(xi: TfsXMLItem; Prog: TfsScript);
+ public
+ constructor Create(AProgram: TfsScript);
+ destructor Destroy; override;
+
+ procedure SelectLanguage(const LangName: String);
+ { convert the input script to the Intermediate Language }
+ function MakeILScript(const Text: String): Boolean;
+ { parse IL }
+ procedure ParseILScript;
+ { this method is needed here to implement late-binding }
+ function DoDesignator(xi: TfsXMLItem; Prog: TfsScript;
+ EmitOp: TfsEmitOp = emNone): TfsDesignator;
+ property ILScript: TfsXMLDocument read FILScript;
+ end;
+
+
+implementation
+//VCL uses section
+{$IFNDEF FMX}
+uses fs_itools, fs_iconst
+{$IFDEF CROSS_COMPILE}
+, Types
+{$ELSE}
+, Windows
+{$ENDIF}
+{$IFDEF OLE}
+, fs_idisp
+{$ENDIF};
+//FMX uses section
+{$ELSE}
+uses FMX.fs_itools, FMX.fs_iconst, System.Types, FMX.Types
+{$IFDEF OLE}
+, fs_idisp
+{$ENDIF};
+{$ENDIF}
+
+
+{ TfsILParser }
+
+constructor TfsILParser.Create(AProgram: TfsScript);
+begin
+ FNeedDeclareVars := True;
+ FProgram := AProgram;
+ FGrammar := TfsXMLDocument.Create;
+ FILScript := TfsXMLDocument.Create;
+ FParser := TfsParser.Create;
+ FUsesList := TStringList.Create;
+ FWithList := TStringList.Create;
+end;
+
+destructor TfsILParser.Destroy;
+begin
+ FGrammar.Free;
+ FILScript.Free;
+ FParser.Free;
+ FUsesList.Free;
+ FWithList.Free;
+ inherited;
+end;
+
+procedure TfsILParser.SelectLanguage(const LangName: String);
+var
+ i: Integer;
+ Name, PropText: String;
+ xi: TfsXMLItem;
+ ParserRoot: TfsXMLItem;
+ ss: TStringStream;
+begin
+ FParser.Clear;
+ FLangName := LangName;
+ ss := TStringStream.Create(fsGetLanguage(LangName));
+ try
+ FGrammar.LoadFromStream(ss);
+ finally
+ ss.Free;
+ end;
+
+ FRoot := FGrammar.Root;
+ ParserRoot := FRoot.FindItem('parser');
+
+ xi := ParserRoot.FindItem('keywords');
+ for i := 0 to xi.Count - 1 do
+ FParser.Keywords.Add(xi[i].Name);
+ for i := 0 to ParserRoot.Count - 1 do
+ begin
+ Name := LowerCase(ParserRoot[i].Name);
+ PropText := ParserRoot[i].Prop['text'];
+ if Name = 'identchars' then
+ FParser.ConstructCharset(PropText)
+ else if Name = 'commentline1' then
+ FParser.CommentLine1 := PropText
+ else if Name = 'commentline2' then
+ FParser.CommentLine2 := PropText
+ else if Name = 'commentblock1' then
+ FParser.CommentBlock1 := PropText
+ else if Name = 'commentblock2' then
+ FParser.CommentBlock2 := PropText
+ else if Name = 'stringquotes' then
+ FParser.StringQuotes := PropText
+ else if Name = 'hexsequence' then
+ FParser.HexSequence := PropText
+ else if Name = 'specstrchar' then
+ begin
+ if PropText = '1' then
+ FParser.SpecStrChar := true;
+ end
+ else if Name = 'declarevars' then
+ begin
+ if PropText = '0' then
+ FNeedDeclareVars := False;
+ end
+ else if Name = 'skipeol' then
+ begin
+ if PropText = '0' then
+ FParser.SkipEOL := False;
+ end
+ else if Name = 'skipchar' then
+ FParser.SkipChar := PropText
+ else if Name = 'casesensitive' then
+ begin
+ if PropText = '1' then
+ FParser.CaseSensitive := True;
+ end
+ end;
+
+ if FProgram.ExtendedCharset then
+ for i := 128 to 255 do
+ FParser.IdentifierCharset := FParser.IdentifierCharset + [Chr(i)];
+end;
+
+function TfsILParser.MakeILScript(const Text: String): Boolean;
+var
+ FList: TStrings;
+ FStream: TStream;
+ FErrorMsg: String;
+ FErrorPos: String;
+ FTermError: Boolean;
+ i: Integer;
+
+ function Run(xi: TfsXMLItem): Boolean;
+ var
+ i, j, ParsPos, ParsPos1, LoopPos, ListPos: Integer;
+ s, NodeName, Token, PropText, PropAdd, PropAddText, PropNode: String;
+ Completed, TopLevelNode, Flag: Boolean;
+ const
+ PathD = {$IFDEF MSWINDOWS} '\'; {$ELSE} '/'; {$ENDIF}
+ procedure DoInclude(const Name: String);
+ var
+ sl: TStringList;
+ p: TfsILParser;
+ ss: TStringStream;
+ s, UnitPath: String;
+ idx: Integer;
+ begin
+ if FUsesList.IndexOf(Name) <> -1 then
+ Exit;
+ FUsesList.Add(Name);
+ sl := TStringList.Create;
+ try
+ if Assigned(FProgram.OnGetUnit) then
+ begin
+ s := '';
+ FProgram.OnGetUnit(FProgram, Name, s);
+ sl.Text := s;
+ end
+ else
+ begin
+ UnitPath := '';
+ for idx := 0 to FProgram.IncludePath.Count - 1 do
+ begin
+ UnitPath := FProgram.IncludePath[idx];
+ if (UnitPath <> '') and (PathD <> UnitPath[Length(UnitPath)]) then
+ UnitPath := UnitPath + PathD;
+ if FileExists(UnitPath + Name) then
+ break;
+ end;
+ sl.LoadFromFile(UnitPath + Name);
+ end;
+
+ p := TfsILParser.Create(FProgram);
+ p.FUnitName := Name;
+ ss := TStringStream.Create(''{$IFDEF Delphi12},TEncoding.UTF8{$ENDIF});
+ try
+ s := '';
+ if sl.Count > 0 then
+ begin
+ p.SelectLanguage(FLangName);
+ p.FUsesList.Assign(FUsesList);
+ if p.MakeILScript(sl.Text) then
+ begin
+ FUsesList.Assign(p.FUsesList);
+ p.ILScript.SaveToStream(ss);
+ s := ss.DataString;
+ Delete(s, 1, Pos('?>', s) + 1);
+ end
+ else
+ begin
+ FErrorMsg := FProgram.ErrorMsg;
+ FErrorPos := FProgram.ErrorPos;
+ if FProgram.ErrorUnit = '' then
+ FProgram.ErrorUnit := Name;
+ end;
+ end;
+
+ FList.Insert(ListPos, '');
+ FList.Insert(ListPos, s);
+ FList.Insert(ListPos, '');
+ Inc(ListPos, 3);
+ finally
+ p.Free;
+ ss.Free;
+ end;
+ finally
+ sl.Free;
+ end;
+ end;
+
+ procedure CheckPropNode(Flag: Boolean);
+ var
+ i, ParsPos1: Integer;
+ s: String;
+ begin
+ if CompareText(PropNode, 'uses') = 0 then
+ begin
+ while FList.Count > ListPos do
+ begin
+ s := FList[FList.Count - 1];
+ i := Pos('text="', s);
+ Delete(s, 1, i + 5);
+ i := Pos('" ', s);
+ Delete(s, i, 255);
+ DoInclude(Copy(s, 2, Length(s) - 2));
+ FList.Delete(FList.Count - 1);
+ end;
+ end
+ else if PropNode <> '' then
+ if Flag then
+ begin
+ ParsPos1 := FParser.Position;
+ FParser.Position := ParsPos;
+ FParser.SkipSpaces;
+
+ s := '<' + PropNode + ' pos="' + FParser.GetXYPosition + '"';
+ FParser.Position := ParsPos1;
+
+ if PropNode = 'expr' then
+ s := s + ' pos1="' + FParser.GetXYPosition + '"';
+ s := s + '>';
+
+ FList.Insert(ListPos, s);
+ FList.Add('');
+ end
+ else
+ begin
+ while FList.Count > ListPos do
+ FList.Delete(FList.Count - 1);
+ end;
+ end;
+
+ procedure AddError(xi: TfsXMLItem);
+ var
+ PropErr: String;
+ xi1: TfsXMLItem;
+ begin
+ PropErr := xi.Prop['err'];
+ if (PropErr <> '') and (FErrorMsg = '') then
+ begin
+ xi1 := FRoot.FindItem('parser');
+ xi1 := xi1.FindItem('errors');
+ FErrorMsg := xi1.FindItem(PropErr).Prop['text'];
+ FParser.Position := ParsPos;
+ FParser.SkipSpaces;
+ FErrorPos := FParser.GetXYPosition;
+ FTermError := xi.Prop['term'] = '1';
+ end;
+ end;
+
+ begin
+ Result := True;
+ ParsPos := FParser.Position;
+ ListPos := FList.Count;
+ NodeName := AnsiLowerCase(xi.Name);
+ PropText := AnsiLowerCase(xi.Prop['text']);
+ PropNode := LowerCase(xi.Prop['node']);
+ TopLevelNode := xi.Parent = FRoot;
+
+ Completed := False;
+ Flag := False;
+ Token := '';
+
+ if TopLevelNode then
+ Completed := True
+ else if NodeName = 'char' then
+ begin
+ if xi.Prop['skip'] <> '0' then
+ FParser.SkipSpaces;
+ Token := FParser.GetChar;
+ Flag := True;
+ end
+ else if NodeName = 'keyword' then
+ begin
+ Token := FParser.GetWord;
+ Flag := True;
+ end
+ else if NodeName = 'ident' then
+ begin
+ Token := FParser.GetIdent;
+ Flag := True;
+ end
+ else if NodeName = 'number' then
+ begin
+ Token := FParser.GetNumber;
+ Flag := True;
+ end
+ else if NodeName = 'string' then
+ begin
+ Token := FParser.GetString;
+ Flag := True;
+ end
+ else if NodeName = 'frstring' then
+ begin
+ Token := FParser.GetFRString;
+ s := FParser.GetXYPosition;
+ FList.Add('');
+ FList.Add('');
+ FList.Add('');
+ FList.Add('');
+ FList.Add('');
+ FList.Add('');
+ Flag := True;
+ end
+ else if NodeName = 'eol' then
+ Completed := FParser.GetEOL
+ else if NodeName = 'sequence' then
+ Completed := True
+ else if (NodeName = 'switch') or (NodeName = 'optionalswitch') then
+ begin
+ Completed := True;
+
+ for i := 0 to xi.Count - 1 do
+ begin
+ Completed := Run(xi[i]);
+ if Completed then
+ break;
+ end;
+
+ if not Completed then
+ if NodeName <> 'optionalswitch' then
+ begin
+ Result := False;
+ AddError(xi);
+ end;
+ Exit;
+ end
+ else if (NodeName = 'loop') or (NodeName = 'optionalloop') then
+ begin
+ j := 0;
+ repeat
+ Inc(j);
+ Flag := False;
+ LoopPos := FParser.Position;
+
+ for i := 0 to xi.Count - 1 do
+ begin
+ Result := Run(xi[i]);
+ if not Result then
+ begin
+ Flag := True;
+ break;
+ end;
+ end;
+
+ { try loop delimiter }
+ ParsPos1 := FParser.Position;
+ if Result and (PropText <> '') then
+ begin
+ FParser.SkipSpaces;
+ if FParser.GetChar <> PropText then
+ begin
+ FParser.Position := ParsPos1;
+ Flag := True;
+ end;
+ end;
+
+ { avoid infinity loop }
+ if FParser.Position = LoopPos then
+ Flag := True;
+ until Flag;
+
+ { at least one loop was succesful }
+ if j > 1 then
+ begin
+ { special case - now implemented only in "case" statement }
+ if (xi.Prop['skip'] = '1') or FTermError then
+ FErrorMsg := '';
+ FParser.Position := ParsPos1;
+ Result := True;
+ end;
+
+ if NodeName = 'optionalloop' then
+ begin
+ if not Result then
+ FParser.Position := ParsPos;
+ Result := True;
+ end;
+ Exit;
+ end
+ else if NodeName = 'optional' then
+ begin
+ for i := 0 to xi.Count - 1 do
+ if not Run(xi[i]) then
+ begin
+ FParser.Position := ParsPos;
+ break;
+ end;
+ Exit;
+ end
+ else
+ begin
+ j := FRoot.Find(NodeName);
+ if j = -1 then
+ raise Exception.Create(SInvalidLanguage);
+
+ Completed := Run(FRoot[j]);
+ end;
+
+ if Flag then
+ begin
+ if FParser.CaseSensitive then
+ Completed := (Token <> '') and
+ ((PropText = '') or (Token = PropText))
+ else
+ Completed := (Token <> '') and
+ ((PropText = '') or (AnsiCompareText(Token, PropText) = 0));
+ end;
+
+ if not Completed then
+ begin
+ Result := False;
+ AddError(xi);
+ end
+ else
+ begin
+ if not TopLevelNode then
+ CheckPropNode(True);
+
+ PropAdd := xi.Prop['add'];
+ PropAddText := xi.Prop['addtext'];
+ if PropAdd <> '' then
+ begin
+ if PropAddText = '' then
+ s := Token else
+ s := PropAddText;
+ FList.Add('<' + PropAdd + ' text="' + StrToXML(s) + '" pos="' +
+ FParser.GetXYPosition + '"/>');
+ end;
+
+ for i := 0 to xi.Count - 1 do
+ begin
+ Result := Run(xi[i]);
+ if not Result then
+ break;
+ end;
+ end;
+
+ if not Result then
+ FParser.Position := ParsPos;
+ if TopLevelNode then
+ CheckPropNode(Result);
+ end;
+
+begin
+ FList := TStringList.Create;
+ FErrorMsg := '';
+ FErrorPos := '';
+ Result := False;
+
+ try
+ FParser.Text := Text;
+
+ i := 1;
+ if FParser.GetChar = '#' then
+ begin
+ if CompareText(FParser.GetIdent, 'language') = 0 then
+ begin
+ i := FParser.Position;
+{$IFDEF Windows}
+ while (i <= Length(Text)) and (Text[i] <> #13) do
+{$ELSE}
+ while (i <= Length(Text)) and (Text[i] <> #10) do
+{$ENDIF}
+ Inc(i);
+ SelectLanguage(Trim(Copy(Text, FParser.Position, i - FParser.Position)));
+ Inc(i, 2);
+ end;
+ end;
+ FParser.Position := i;
+
+ if Run(FRoot.FindItem('program')) and (FErrorMsg = '') then
+ begin
+ FErrorMsg := '';
+ FErrorPos := '';
+ FStream := TMemoryStream.Create;
+ try
+ FList.Insert(0, '');
+ FList.Insert(1, '');
+ FList.Add('');
+ FList.SaveToStream(FStream{$IFDEF Delphi12}, TEncoding.UTF8{$ENDIF});
+{$IFDEF Delphi12}
+ FStream.Position := 3;
+{$ELSE}
+ FStream.Position := 0;
+{$ENDIF}
+ FILScript.LoadFromStream(FStream);
+ FILScript.Root.Add.Assign(FRoot.FindItem('types'));
+// uncomment the following lines to see what is IL script
+// FILScript.AutoIndent := True;
+// FILScript.SaveToFile(ExtractFilePath(ParamStr(0)) + 'out.xml');
+ Result := True;
+ finally
+ FStream.Free;
+ end;
+ end;
+
+ FProgram.ErrorPos := FErrorPos;
+ FProgram.ErrorMsg := FErrorMsg;
+ finally
+ FList.Free;
+ end;
+end;
+
+procedure TfsILParser.ParseILScript;
+begin
+ FWithList.Clear;
+ FProgram.ErrorUnit := '';
+ FUnitName := '';
+ FUsesList.Clear;
+ try
+ DoProgram(FILScript.Root, FProgram);
+ FProgram.ErrorPos := '';
+ except
+ on e: Exception do
+ begin
+ FProgram.ErrorMsg := e.Message;
+ FProgram.ErrorPos := FErrorPos;
+ FProgram.ErrorUnit := FUnitName;
+ end;
+ end;
+end;
+
+function TfsILParser.PropPos(xi: TfsXMLItem): String;
+begin
+ Result := xi.Prop['pos'];
+end;
+
+procedure TfsILParser.ErrorPos(xi: TfsXMLItem);
+begin
+ FErrorPos := PropPos(xi);
+end;
+
+procedure TfsILParser.CheckIdent(Prog: TfsScript; const Name: String);
+begin
+ if Prog.FindLocal(Name) <> nil then
+ raise Exception.Create(SIdRedeclared + '''' + Name + '''');
+end;
+
+function TfsILParser.FindClass(const TypeName: String): TfsClassVariable;
+begin
+ Result := FProgram.FindClass(TypeName);
+ if Result = nil then
+ raise Exception.Create(SUnknownType + '''' + TypeName + '''');
+end;
+
+procedure TfsILParser.CheckTypeCompatibility(Var1, Var2: TfsCustomVariable);
+begin
+ if not AssignCompatible(Var1, Var2, FProgram) then
+ raise Exception.Create(SIncompatibleTypes + ': ''' + Var1.GetFullTypeName +
+ ''', ''' + Var2.GetFullTypeName + '''');
+end;
+
+function TfsILParser.FindVar(Prog: TfsScript; const Name: String): TfsCustomVariable;
+begin
+ Result := Prog.Find(Name);
+ if Result = nil then
+ if not FNeedDeclareVars then
+ begin
+ Result := TfsVariable.Create(Name, fvtVariant, '');
+ FProgram.Add(Name, Result);
+ end
+ else
+ raise Exception.Create(SIdUndeclared + '''' + Name + '''');
+end;
+
+function TfsILParser.FindType(s: String): TfsVarType;
+var
+ xi: TfsXMLItem;
+begin
+ xi := FProgRoot.FindItem('types');
+ if xi.Find(s) <> -1 then
+ s := xi[xi.Find(s)].Prop['type']
+ else
+ begin
+ xi := FGrammar.Root.FindItem('types');
+ if xi.Find(s) <> -1 then
+ s := xi[xi.Find(s)].Prop['type']
+ end;
+ Result := StrToVarType(s, FProgram);
+ if Result = fvtClass then
+ FindClass(s);
+end;
+
+function TfsILParser.CreateVar(xi: TfsXMLItem; Prog: TfsScript; const Name: String;
+ Statement: TfsStatement = nil; CreateParam: Boolean = False;
+ IsVarParam: Boolean = False): TfsCustomVariable;
+var
+ i, j: Integer;
+ Typ: TfsVarType;
+ TypeName: String;
+ RefItem: TfsCustomVariable;
+ InitValue: Variant;
+ InitItem: TfsXMLItem;
+ AssignStmt: TfsAssignmentStmt;
+ IsPascal: Boolean;
+ SourcePos: String;
+
+ procedure DoArray(xi: TfsXMLItem);
+ var
+ i, n: Integer;
+ v: array of {$IFDEF FPC}SizeInt{$ELSE}Integer{$ENDIF};
+ Expr: TfsExpression;
+ begin
+ n := xi.Count;
+ SetLength(v, n * 2);
+
+ for i := 0 to n - 1 do
+ begin
+ Expr := DoExpression(xi[i][0], Prog);
+ v[i * 2] := Expr.Value;
+ Expr.Free;
+
+ if xi[i].Count = 2 then
+ begin
+ Expr := DoExpression(xi[i][1], Prog);
+ v[i * 2 + 1] := Expr.Value;
+ Expr.Free;
+ end
+ else
+ begin
+ v[i * 2 + 1] := v[i * 2] - 1;
+ v[i * 2] := 0;
+ end;
+ end;
+
+ if n = 0 then
+ begin
+ SetLength(v, 2);
+ v[0] := 0;
+ v[1] := 0;
+ n := 1;
+ end;
+
+ InitValue := VarArrayCreate(v, varVariant);
+ RefItem := TfsArrayHelper.Create('', n, Typ, TypeName);
+ Prog.Add('', RefItem);
+ v := nil;
+ Typ := fvtArray;
+ end;
+
+ procedure DoInit(xi: TfsXMLItem);
+ var
+ Expr: TfsExpression;
+ Temp: TfsVariable;
+ begin
+ Temp := TfsVariable.Create('', Typ, TypeName);
+ try
+ Expr := DoExpression(xi[0], Prog);
+ InitValue := Expr.Value;
+ try
+ CheckTypeCompatibility(Temp, Expr);
+ finally
+ Expr.Free;
+ end;
+ finally
+ Temp.Free;
+ end;
+ end;
+
+begin
+ RefItem := nil;
+ InitItem := nil;
+ TypeName := 'Variant';
+ IsPascal := False;
+ SourcePos := FErrorPos;
+
+(*
+
+
+
+
+
+
+
+ ...
+
+
+
+
+
+
+
+ - type may be first (in C-like languages) or last (in Pascal-like ones)
+ - type may be skipped (treated as variant)
+ - array and init may be either skipped, or after each
+ - array and init may be after each
+ - do not handle tags - they are handled in calling part
+*)
+
+
+ { find the type }
+ for i := 0 to xi.Count - 1 do
+ if CompareText(xi[i].name, 'type') = 0 then
+ begin
+ IsPascal := i <> 0;
+ TypeName := xi[i].Prop['text'];
+ ErrorPos(xi[i]);
+ break;
+ end;
+
+ Typ := FindType(TypeName);
+ case Typ of
+ fvtInt, fvtInt64, fvtFloat, fvtClass:
+ InitValue := 0;
+ fvtBool:
+ InitValue := False;
+ fvtChar, fvtString:
+ InitValue := '';
+ else
+ InitValue := Null;
+ end;
+
+ { fing the tag corresponding to our variable }
+ for i := 0 to xi.Count - 1 do
+ if CompareText(xi[i].Prop['text'], Name) = 0 then
+ begin
+ { process and tags if any }
+ j := i + 1;
+ while (j < xi.Count) and (IsPascal or (CompareText(xi[j].Name, 'ident') <> 0)) do
+ begin
+ if CompareText(xi[j].Name, 'array') = 0 then
+ DoArray(xi[j])
+ else if CompareText(xi[j].Name, 'init') = 0 then
+ begin
+ if Statement = nil then
+ DoInit(xi[j]);
+ InitItem := xi[j];
+ end;
+ Inc(j);
+ end;
+ break;
+ end;
+
+ if CreateParam then
+ Result := TfsParamItem.Create(Name, Typ, TypeName, InitItem <> nil, IsVarParam)
+ else if Typ in [fvtChar, fvtString] then
+ Result := TfsStringVariable.Create(Name, Typ, TypeName) else
+ Result := TfsVariable.Create(Name, Typ, TypeName);
+
+ try
+ Result.Value := InitValue;
+ Result.RefItem := RefItem;
+ Result.SourcePos := SourcePos;
+ Result.SourceUnit := FUnitName;
+ Result.OnGetVarValue := FProgram.OnGetVarValue;
+
+ { create init statement }
+ if (InitItem <> nil) and (Statement <> nil) then
+ begin
+ AssignStmt := TfsAssignmentStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(AssignStmt);
+ AssignStmt.Designator := TfsVariableDesignator.Create(Prog);
+ AssignStmt.Designator.RefItem := Result;
+ AssignStmt.Expression := DoExpression(InitItem[0], Prog);
+ CheckTypeCompatibility(Result, AssignStmt.Expression);
+ AssignStmt.Optimize;
+ end;
+
+ except
+ on e: Exception do
+ begin
+ Result.Free;
+ raise;
+ end;
+ end;
+end;
+{$HINTS OFF}
+function TfsILParser.DoDesignator(xi: TfsXMLItem; Prog: TfsScript;
+ EmitOp: TfsEmitOp = emNone): TfsDesignator;
+var
+ i, j: Integer;
+ NodeName, NodeText, TypeName: String;
+ Expr: TfsExpression;
+ Item, PriorItem: TfsDesignatorItem;
+ ClassVar: TfsClassVariable;
+ StringVar: TfsStringVariable;
+ Typ: TfsVarType;
+ LateBinding, PriorIsIndex: Boolean;
+ NewDesignator: TfsDesignator;
+ PriorValue: Variant;
+ Component: TComponent;
+
+ function FindInWithList(const Name: String; ResultDS: TfsDesignator;
+ Item: TfsDesignatorItem): Boolean;
+ var
+ i: Integer;
+ WithStmt: TfsWithStmt;
+ WithItem: TfsDesignatorItem;
+ ClassVar: TfsClassVariable;
+ xi1: TfsXMLItem;
+ begin
+ Result := False;
+ LateBinding := False;
+ for i := FWithList.Count - 1 downto 0 do
+ begin
+ { prevent checking non-local 'with' }
+ if Prog.FindLocal(FWithList[i]) = nil then
+ continue;
+ WithStmt := TfsWithStmt(FWithList.Objects[i]);
+
+ if WithStmt.Variable.Typ = fvtVariant then
+ begin
+ { first check all known variables }
+ if Prog.Find(Name) <> nil then
+ Exit;
+ { if nothing found, create late binding information }
+ Item.Ref := WithStmt.Variable;
+ ResultDS.Finalize;
+ ResultDS.LateBindingXMLSource := TfsXMLItem.Create;
+ ResultDS.LateBindingXMLSource.Assign(xi);
+ xi1 := TfsXMLItem.Create;
+ xi1.Name := 'node';
+ xi1.Text := 'text="' + FWithList[i] + '"';
+ ResultDS.LateBindingXMLSource.InsertItem(0, xi1);
+ LateBinding := True;
+ Result := True;
+ break;
+ end
+ else
+ begin
+ ClassVar := FindClass(WithStmt.Variable.TypeName);
+ Item.Ref := ClassVar.Find(NodeText);
+ end;
+
+ if Item.Ref <> nil then
+ begin
+ WithItem := TfsDesignatorItem.Create;
+ WithItem.Ref := WithStmt.Variable;
+ WithItem.SourcePos := Item.SourcePos;
+
+ ResultDS.Remove(Item);
+ ResultDS.Add(WithItem);
+ ResultDS.Add(Item);
+ Result := True;
+ break;
+ end;
+ end;
+ end;
+
+{$IFDEF OLE}
+ procedure CreateOLEHelpers(Index: Integer);
+ var
+ i: Integer;
+ OLEHelper: TfsOLEHelper;
+ begin
+ for i := Index to xi.Count - 1 do
+ begin
+ ErrorPos(xi[i]);
+ NodeName := LowerCase(xi[i].Name);
+ NodeText := xi[i].Prop['text'];
+
+ if (NodeName = 'node') and (NodeText <> '[') then
+ begin
+ Item := TfsDesignatorItem.Create;
+ Result.Add(Item);
+ Item.SourcePos := FErrorPos;
+ OLEHelper := TfsOLEHelper.Create(NodeText);
+ Prog.Add('', OLEHelper);
+ Item.Ref := OLEHelper;
+ end
+ else if NodeName = 'expr' then
+ begin
+ Expr := DoExpression(xi[i], Prog);
+ PriorItem := Result.Items[Result.Count - 1];
+ PriorItem.Add(Expr);
+ PriorItem.Ref.Add(TfsParamItem.Create('', fvtVariant, '', False, False));
+ end
+ end;
+ end;
+{$ENDIF}
+
+begin
+ Result := TfsDesignator.Create(Prog);
+ try
+
+ for i := 0 to xi.Count - 1 do
+ begin
+ ErrorPos(xi[i]);
+ NodeName := LowerCase(xi[i].Name);
+ NodeText := xi[i].Prop['text'];
+
+ if NodeName = 'node' then
+ begin
+ Item := TfsDesignatorItem.Create;
+ Result.Add(Item);
+ Item.SourcePos := FErrorPos;
+
+ if Result.Count = 1 then
+ begin
+ if not FindInWithList(NodeText, Result, Item) then
+ Item.Ref := FindVar(Prog, NodeText);
+
+ { LateBinding flag turned on in the FindInWithList }
+ if LateBinding then
+ Exit;
+ { add .Create for cpp NEW statement, i.e convert o = new TObject
+ to o = TObject.Create }
+ if EmitOp = emCreate then
+ begin
+ if not (Item.Ref is TfsClassVariable) then
+ raise Exception.Create(SClassRequired);
+ ClassVar := TfsClassVariable(Item.Ref);
+ Item := TfsDesignatorItem.Create;
+ Result.Add(Item);
+ Item.Ref := ClassVar.Find('Create');
+ end;
+ end
+ else
+ begin
+ PriorItem := Result.Items[Result.Count - 2];
+ PriorIsIndex := (PriorItem.Ref is TfsMethodHelper) and
+ TfsMethodHelper(PriorItem.Ref).IndexMethod and not PriorItem.Flag;
+ Typ := PriorItem.Ref.Typ;
+ { late binding }
+ if (Typ = fvtVariant) and not PriorIsIndex then
+ begin
+ PriorValue := PriorItem.Ref.Value;
+ if VarIsNull(PriorValue) then
+ begin
+ Result.Remove(Item);
+ Item.Free;
+ Result.Finalize;
+ Result.LateBindingXMLSource := TfsXMLItem.Create;
+ Result.LateBindingXMLSource.Assign(xi);
+ Exit;
+ end
+ else
+ begin
+ if (TVarData(PriorValue).VType = varString) {$IFDEF Delphi12}or (TVarData(PriorValue).VType = varUString){$ENDIF} then
+ { accessing string elements }
+ Typ := fvtString
+ {$IFDEF OLE}
+ else if TVarData(PriorValue).VType = varDispatch then
+ begin
+ { calling ole }
+ Result.Remove(Item);
+ Item.Free;
+ CreateOLEHelpers(i);
+ Result.Finalize;
+ Exit;
+ end
+ {$ENDIF}
+ else if (TVarData(PriorValue).VType and varArray) = varArray then
+ begin
+ { accessing array elements }
+ if NodeText = '[' then { set ref to arrayhelper }
+ Item.Ref := FindVar(Prog, '__ArrayHelper')
+ else
+ raise Exception.Create(SIndexRequired);
+ continue;
+ end
+ else
+ begin
+ { accessing class items }
+ Typ := fvtClass;
+ PriorItem.Ref.TypeName := TObject(frxInteger(PriorItem.Ref.Value)).ClassName;
+ end;
+ end;
+ end;
+
+ if PriorIsIndex then
+ begin
+ PriorItem.Flag := True;
+ Result.Remove(Item); { previous item is set up already }
+ Item.Free;
+ FErrorPos := PriorItem.SourcePos;
+ if NodeText <> '[' then
+ raise Exception.Create(SIndexRequired);
+ end
+ else if Typ = fvtString then
+ begin
+ if NodeText = '[' then { set ref to stringhelper }
+ Item.Ref := FindVar(Prog, '__StringHelper')
+ else
+ raise Exception.Create(SStringError);
+ end
+ else if Typ = fvtClass then
+ begin
+ TypeName := PriorItem.Ref.TypeName;
+ ClassVar := FindClass(TypeName);
+
+ if NodeText = '[' then { default property }
+ begin
+ Item.Flag := True;
+ Item.Ref := ClassVar.DefProperty;
+ if Item.Ref = nil then
+ raise Exception.CreateFmt(SClassError, [TypeName]);
+ end
+ else { property or method }
+ begin
+ Item.Ref := ClassVar.Find(NodeText, False);
+ { property not found. Probably it's a form element such as button? }
+ if Item.Ref = nil then
+ begin
+ PriorValue := PriorItem.Ref.Value;
+ if ((VarIsNull(PriorValue) or (PriorValue = 0)) and not Prog.IsRunning) and Prog.UseClassLateBinding then
+ begin
+ { at compile time, we don't know anything about form elements.
+ So clear the designator items and use the late binding. }
+ Result.Remove(Item);
+ Item.Free;
+ while Result.Count > 1 do
+ begin
+ Item := Result.Items[Result.Count - 1];
+ Result.Remove(Item);
+ Item.Free;
+ end;
+ Item := Result.Items[0];
+ Result.Finalize;
+ Result.Typ := fvtVariant;
+ Result.LateBindingXMLSource := TfsXMLItem.Create;
+ Result.LateBindingXMLSource.Assign(xi);
+ Exit;
+ end
+ else
+ begin
+ { we at run time now. Try to search in the form's elements. }
+ if TObject(frxInteger(PriorValue)) is TComponent then
+ begin
+ Component := TComponent(frxInteger(PriorValue)).FindComponent(NodeText);
+ if Component <> nil then
+ { creates TfsComponentHelper }
+ Item.Ref := ClassVar.AddComponent(Component);
+ end;
+ if Item.Ref = nil then
+ raise Exception.Create(SIdUndeclared + '''' + NodeText + '''');
+ end
+ end;
+ end;
+ end
+ else if Typ = fvtArray then { set ref to array helper }
+ Item.Ref := PriorItem.Ref.RefItem
+ else
+ raise Exception.Create(SArrayRequired);
+ end;
+ end
+ else if NodeName = 'expr' then
+ begin
+ Expr := DoExpression(xi[i], Prog);
+ Result.Items[Result.Count - 1].Add(Expr);
+ end
+ else if NodeName = 'addr' then { @ operator }
+ begin
+ if xi.Count <> 2 then
+ raise Exception.Create(SVarRequired);
+
+ Item := TfsDesignatorItem.Create;
+ Result.Add(Item);
+ ErrorPos(xi[1]);
+ Item.SourcePos := FErrorPos;
+
+ { we just return the string containing a referenced item name. For
+ example, var s: String; procedure B1; begin end; s := @B1
+ will assign 'B1' to the s }
+ StringVar := TfsStringVariable.Create('', fvtString, '');
+ StringVar.Value := xi[1].Prop['text'];
+ Prog.Add('', StringVar);
+ Item.Ref := StringVar;
+
+ break;
+ end;
+ end;
+
+ if EmitOp = emFree then
+ begin
+ PriorItem := Result.Items[Result.Count - 1];
+ if (PriorItem.Ref.Typ <> fvtClass) and (PriorItem.Ref.Typ <> fvtVariant) then
+ raise Exception.Create(SClassRequired);
+ Item := TfsDesignatorItem.Create;
+ Result.Add(Item);
+ ClassVar := FindClass('TObject');
+ Item.Ref := ClassVar.Find('Free');
+ end;
+
+ Result.Finalize;
+ if Result.Kind <> dkOther then
+ begin
+ NewDesignator := nil;
+ if Result.Kind = dkVariable then
+ NewDesignator := TfsVariableDesignator.Create(Prog)
+ else if Result.Kind = dkStringArray then
+ NewDesignator := TfsStringDesignator.Create(Prog)
+ else if Result.Kind = dkArray then
+ NewDesignator := TfsArrayDesignator.Create(Prog);
+
+ NewDesignator.Borrow(Result);
+ Result.Free;
+ Result := NewDesignator;
+ end;
+
+ for i := 0 to Result.Count - 1 do
+ begin
+ Item := Result[i];
+ FErrorPos := Item.SourcePos;
+ if Item.Ref is TfsDesignator then continue;
+
+ if Item.Count < Item.Ref.GetNumberOfRequiredParams then
+ raise Exception.Create(SNotEnoughParams)
+ else if Item.Count > Item.Ref.Count then
+ raise Exception.Create(STooManyParams)
+ else if Item.Count <> Item.Ref.Count then { construct the default params }
+ for j := Item.Count to Item.Ref.Count - 1 do
+ begin
+ Expr := TfsExpression.Create(FProgram);
+ Item.Add(Expr);
+ Expr.AddConstWithType(Item.Ref[j].DefValue, Item.Ref[j].Typ);
+ Expr.Finalize;
+ end;
+
+ for j := 0 to Item.Count - 1 do
+ begin
+ FErrorPos := Item[j].SourcePos;
+ CheckTypeCompatibility(Item.Ref[j], Item[j]);
+ end;
+ end;
+
+ except
+ on e: Exception do
+ begin
+ Result.Free;
+ raise;
+ end;
+ end;
+end;
+{$HINTS ON}
+function TfsILParser.DoSet(xi: TfsXMLItem; Prog: TfsScript): TfsSetExpression;
+var
+ i: Integer;
+ Name: String;
+begin
+ Result := TfsSetExpression.Create('', fvtVariant, '');
+ try
+ for i := 0 to xi.Count - 1 do
+ begin
+ Name := LowerCase(xi[i].Name);
+ if Name = 'expr' then
+ Result.Add(DoExpression(xi[i], Prog))
+ else if Name = 'range' then
+ Result.Add(nil);
+ end;
+
+ except
+ on e: Exception do
+ begin
+ Result.Free;
+ raise;
+ end;
+ end;
+end;
+
+function TfsILParser.DoExpression(xi: TfsXMLItem; Prog: TfsScript): TfsExpression;
+var
+ ErPos: String;
+ SourcePos1, SourcePos2: TPoint;
+
+ procedure DoExpressionItems(xi: TfsXMLItem; Expression: TfsExpression);
+ var
+ i: Integer;
+ NodeName: String;
+ OpName: String;
+ begin
+ i := 0;
+ while i < xi.Count do
+ begin
+ ErrorPos(xi[i]);
+ Expression.SourcePos := FErrorPos;
+ NodeName := Lowercase(xi[i].Name);
+ OpName := xi[i].Prop['text'];
+
+ if (NodeName = 'op') then
+ begin
+ OpName := LowerCase(OpName);
+ if (OpName = ')') or (i < xi.Count - 1) then
+ Expression.AddOperator(OpName);
+ end
+ else if (NodeName = 'number') or (NodeName = 'string') then
+ Expression.AddConst(ParserStringToVariant(OpName))
+ else if NodeName = 'dsgn' then
+ Expression.AddDesignator(DoDesignator(xi[i], Prog))
+ else if NodeName = 'set' then
+ Expression.AddSet(DoSet(xi[i], Prog))
+ else if NodeName = 'new' then
+ Expression.AddDesignator(DoDesignator(xi[i][0], Prog, emCreate))
+ else if NodeName = 'expr' then
+ DoExpressionItems(xi[i], Expression);
+
+ Inc(i);
+ end;
+ end;
+
+ function GetSource(pt1, pt2: TPoint): String;
+ var
+ i1, i2: Integer;
+ begin
+ i1 := FParser.GetPlainPosition(pt1);
+ i2 := FParser.GetPlainPosition(pt2);
+ if (i1 = -1) or (i2 = -1) then
+ Result := ''
+ else
+ Result := Copy(FParser.Text, i1, i2 - i1);
+ end;
+
+begin
+ Result := TfsExpression.Create(FProgram);
+ try
+ DoExpressionItems(xi, Result);
+ SourcePos1 := fsPosToPoint(PropPos(xi));
+ SourcePos2 := fsPosToPoint(xi.Prop['pos1']);
+ Result.Source := GetSource(SourcePos1, SourcePos2);
+
+ ErPos := Result.Finalize;
+ if ErPos <> '' then
+ begin
+ FErrorPos := ErPos;
+ raise Exception.Create(SIncompatibleTypes);
+ end;
+
+ except
+ on e: Exception do
+ begin
+ Result.Free;
+ raise;
+ end;
+ end;
+end;
+
+procedure TfsILParser.DoUses(xi: TfsXMLItem; Prog: TfsScript);
+var
+ i: Integer;
+ SaveUnitName: String;
+ s: String;
+ sl: TStringList;
+ ms: TMemoryStream;
+ xd: TfsXMLDocument;
+begin
+ SaveUnitName := FUnitName;
+ FUnitName := xi.Prop['unit'];
+ xd := nil;
+
+ if FUsesList.IndexOf(FUnitName) <> -1 then
+ begin
+ FUnitName := SaveUnitName;
+ Exit;
+ end;
+ FUsesList.Add(FUnitName);
+ if Assigned(FProgram.OnGetILUnit) then
+ begin
+ s := '';
+ FProgram.OnGetILUnit(FProgram, FUnitName, s);
+ if s <> '' then
+ begin
+ sl := TStringList.Create;
+ sl.Text := s;
+
+ ms := TMemoryStream.Create;
+ sl.SaveToStream(ms);
+ sl.Free;
+ ms.Position := 0;
+
+ xd := TfsXMLDocument.Create;
+ xd.LoadFromStream(ms);
+ ms.Free;
+ end;
+ end;
+
+ if xd <> nil then
+ begin
+ try
+ DoProgram(xd.Root, Prog);
+ finally
+ xd.Free;
+ end;
+ end
+ else
+ begin
+ for i := 0 to xi.Count - 1 do
+ DoProgram(xi[i], Prog);
+ end;
+
+ FUnitName := SaveUnitName;
+end;
+
+procedure TfsILParser.DoVar(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ i: Integer;
+ Name: String;
+begin
+ for i := 0 to xi.Count - 1 do
+ begin
+ ErrorPos(xi[i]);
+ if CompareText(xi[i].Name, 'ident') = 0 then
+ begin
+ Name := xi[i].Prop['text'];
+ CheckIdent(Prog, Name);
+ Prog.Add(Name, CreateVar(xi, Prog, Name, Statement));
+ end;
+ end;
+end;
+
+procedure TfsILParser.DoConst(xi: TfsXMLItem; Prog: TfsScript);
+var
+ Name: String;
+ Expr: TfsExpression;
+ v: TfsVariable;
+begin
+ Name := xi[0].Prop['text'];
+ ErrorPos(xi[0]);
+ CheckIdent(Prog, Name);
+
+ Expr := DoExpression(xi[1], Prog);
+ v := TfsVariable.Create(Name, Expr.Typ, Expr.TypeName);
+ v.Value := Expr.Value;
+ v.IsReadOnly := True;
+ Expr.Free;
+
+ Prog.Add(Name, v);
+end;
+
+procedure TfsILParser.DoParameters(xi: TfsXMLItem; v: TfsProcVariable);
+var
+ i: Integer;
+ s: String;
+ varParams: Boolean;
+
+ procedure DoParam(xi: TfsXMLItem);
+ var
+ i: Integer;
+ Name: String;
+ Param: TfsParamItem;
+ varParam: Boolean;
+ begin
+ varParam := False;
+
+ for i := 0 to xi.Count - 1 do
+ begin
+ ErrorPos(xi[i]);
+ if CompareText(xi[i].Name, 'varparam') = 0 then
+ varParam := True
+ else if CompareText(xi[i].Name, 'ident') = 0 then
+ begin
+ Name := xi[i].Prop['text'];
+ CheckIdent(v.Prog, Name);
+ Param := TfsParamItem(CreateVar(xi, v.Prog, Name, nil, True,
+ varParams or VarParam));
+ Param.DefValue := Param.Value;
+ v.Add(Param);
+ v.Prog.Add(Name, Param);
+ varParam := False;
+ end;
+ end;
+ end;
+
+begin
+ if CompareText(xi.Name, 'parameters') <> 0 then Exit;
+ varParams := False;
+ for i := 0 to xi.Count - 1 do
+ begin
+ s := LowerCase(xi[i].Name);
+ if s = 'varparams' then
+ varParams := True
+ else if s = 'var' then
+ begin
+ DoParam(xi[i]);
+ varParams := False;
+ end;
+ end;
+end;
+
+procedure TfsILParser.DoProc1(xi: TfsXMLItem; Prog: TfsScript);
+var
+ i: Integer;
+ s, Name: String;
+ Proc: TfsProcVariable;
+begin
+ ErrorPos(xi[0]);
+ Name := xi[0].Prop['text'];
+ CheckIdent(Prog, Name);
+
+{$IFDEF CPUX64}
+ Proc := TfsProcVariable.Create(Name, fvtInt64, '', Prog, False);
+{$ELSE}
+ Proc := TfsProcVariable.Create(Name, fvtInt, '', Prog, False);
+{$ENDIF}
+ Proc.SourcePos := PropPos(xi);
+ Proc.SourceUnit := FUnitName;
+ Prog.Add(Name, Proc);
+
+ for i := 0 to xi.Count - 1 do
+ begin
+ s := LowerCase(xi[i].Name);
+ if s = 'parameters' then
+ DoParameters(xi[i], Proc);
+ end;
+end;
+
+procedure TfsILParser.DoProc2(xi: TfsXMLItem; Prog: TfsScript);
+var
+ Name: String;
+ Proc: TfsProcVariable;
+begin
+ Name := xi[0].Prop['text'];
+ Proc := TfsProcVariable(FindVar(Prog, Name));
+ DoProgram(xi, Proc.Prog);
+end;
+
+procedure TfsILParser.DoFunc1(xi: TfsXMLItem; Prog: TfsScript);
+var
+ i: Integer;
+ s, Name, TypeName: String;
+ Typ: TfsVarType;
+ Func: TfsProcVariable;
+begin
+ Name := '';
+ TypeName := '';
+ Typ := fvtVariant;
+
+ for i := 0 to xi.Count - 1 do
+ begin
+ ErrorPos(xi[i]);
+ s := LowerCase(xi[i].Name);
+ if s = 'type' then
+ begin
+ TypeName := xi[i].Prop['text'];
+ Typ := FindType(TypeName);
+ end
+ else if s = 'name' then
+ begin
+ Name := xi[i].Prop['text'];
+ CheckIdent(Prog, Name);
+ end
+ end;
+
+
+ Func := TfsProcVariable.Create(Name, Typ, TypeName, Prog,
+ CompareText(TypeName, 'void') <> 0);
+ Func.SourcePos := PropPos(xi);
+ Func.SourceUnit := FUnitName;
+ Prog.Add(Name, Func);
+
+ for i := 0 to xi.Count - 1 do
+ begin
+ s := LowerCase(xi[i].Name);
+ if s = 'parameters' then
+ DoParameters(xi[i], Func);
+ end;
+end;
+
+procedure TfsILParser.DoFunc2(xi: TfsXMLItem; Prog: TfsScript);
+var
+ i: Integer;
+ s, Name: String;
+ Func: TfsProcVariable;
+begin
+ Name := '';
+
+ for i := 0 to xi.Count - 1 do
+ begin
+ s := LowerCase(xi[i].Name);
+ if s = 'name' then
+ Name := xi[i].Prop['text'];
+ end;
+
+ Func := TfsProcVariable(FindVar(Prog, Name));
+ DoProgram(xi, Func.Prog);
+end;
+
+procedure TfsILParser.DoAssign(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ i: Integer;
+ Stmt: TfsAssignmentStmt;
+ Designator: TfsDesignator;
+ Expression: TfsExpression;
+ Modificator: String;
+begin
+ Designator := nil;
+ Expression := nil;
+
+ try
+ Modificator := ' ';
+ Designator := DoDesignator(xi[0], Prog);
+
+ i := 1;
+ if CompareText(xi[1].Name, 'modificator') = 0 then
+ begin
+ Modificator := xi[1].Prop['text'];
+ Inc(i);
+ end;
+ Expression := DoExpression(xi[i], Prog);
+
+ if Designator.IsReadOnly then
+ raise Exception.Create(SLeftCantAssigned);
+
+ CheckTypeCompatibility(Designator, Expression);
+ if Modificator = ' ' then
+ Modificator := Expression.Optimize(Designator);
+ except
+ on e: Exception do
+ begin
+ if Designator <> nil then
+ Designator.Free;
+ if Expression <> nil then
+ Expression.Free;
+ raise;
+ end;
+ end;
+
+ case Modificator[1] of
+ '+':
+ Stmt := TfsAssignPlusStmt.Create(Prog, FUnitName, PropPos(xi));
+ '-':
+ Stmt := TfsAssignMinusStmt.Create(Prog, FUnitName, PropPos(xi));
+ '*':
+ Stmt := TfsAssignMulStmt.Create(Prog, FUnitName, PropPos(xi));
+ '/':
+ Stmt := TfsAssignDivStmt.Create(Prog, FUnitName, PropPos(xi));
+ else
+ Stmt := TfsAssignmentStmt.Create(Prog, FUnitName, PropPos(xi));
+ end;
+
+ Statement.Add(Stmt);
+ Stmt.Designator := Designator;
+ Stmt.Expression := Expression;
+ Stmt.Optimize;
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoCall(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ Stmt: TfsCallStmt;
+begin
+ Stmt := TfsCallStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+ Stmt.Designator := DoDesignator(xi[0], Prog);
+ if xi.Count > 1 then
+ begin
+ Stmt.Modificator := xi[1].Prop['text'];
+ if Stmt.Designator.IsReadOnly then
+ raise Exception.Create(SLeftCantAssigned);
+ end;
+
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoIf(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ i: Integer;
+ s: String;
+ Stmt: TfsIfStmt;
+begin
+ Stmt := TfsIfStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+ Stmt.Condition := DoExpression(xi[0], Prog);
+
+ for i := 1 to xi.Count - 1 do
+ begin
+ s := Lowercase(xi[i].Name);
+ if s = 'thenstmt' then
+ DoCompoundStmt(xi[1], Prog, Stmt)
+ else if s = 'elsestmt' then
+ DoCompoundStmt(xi[2], Prog, Stmt.ElseStmt);
+ end;
+
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoFor(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ i: Integer;
+ Stmt: TfsForStmt;
+begin
+ Stmt := TfsForStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+ ErrorPos(xi[0]);
+ Stmt.Variable := FindVar(Prog, xi[0].Prop['text']);
+ if not ((Stmt.Variable is TfsVariable) and
+ (Stmt.Variable.Typ in [fvtInt, fvtInt64, fvtVariant, fvtFloat])) then
+ raise Exception.Create(SForError);
+
+ Stmt.BeginValue := DoExpression(xi[1], Prog);
+ CheckTypeCompatibility(Stmt.Variable, Stmt.BeginValue);
+
+ i := 2;
+ if CompareText(xi[2].Name, 'downto') = 0 then
+ begin
+ Stmt.Down := True;
+ Inc(i);
+ end;
+
+ Stmt.EndValue := DoExpression(xi[i], Prog);
+ CheckTypeCompatibility(Stmt.Variable, Stmt.EndValue);
+ if i + 1 < xi.Count then
+ DoStmt(xi[i + 1], Prog, Stmt);
+
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoVbFor(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ i: Integer;
+ Stmt: TfsVbForStmt;
+begin
+ Stmt := TfsVbForStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+ ErrorPos(xi[0]);
+ Stmt.Variable := FindVar(Prog, xi[0].Prop['text']);
+ if not ((Stmt.Variable is TfsVariable) and
+ (Stmt.Variable.Typ in [fvtInt, fvtInt64, fvtVariant, fvtFloat])) then
+ raise Exception.Create(SForError);
+
+ Stmt.BeginValue := DoExpression(xi[1], Prog);
+ CheckTypeCompatibility(Stmt.Variable, Stmt.BeginValue);
+
+ Stmt.EndValue := DoExpression(xi[2], Prog);
+ CheckTypeCompatibility(Stmt.Variable, Stmt.EndValue);
+
+ i := 3;
+ if i < xi.Count then
+ if CompareText(xi[i].Name, 'expr') = 0 then
+ begin
+ Stmt.Step := DoExpression(xi[i], Prog);
+ CheckTypeCompatibility(Stmt.Variable, Stmt.Step);
+ Inc(i);
+ end;
+
+ if i < xi.Count then
+ DoStmt(xi[i], Prog, Stmt);
+
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoCppFor(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ Stmt: TfsCppForStmt;
+begin
+ Stmt := TfsCppForStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+ DoStmt(xi[0], Prog, Stmt.FirstStmt);
+ Stmt.Expression := DoExpression(xi[1], Prog);
+ DoStmt(xi[2], Prog, Stmt.SecondStmt);
+ DoStmt(xi[3], Prog, Stmt);
+
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoWhile(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ Stmt: TfsWhileStmt;
+begin
+ Stmt := TfsWhileStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+ Stmt.Condition := DoExpression(xi[0], Prog);
+ if xi.Count > 1 then
+ DoStmt(xi[1], Prog, Stmt);
+
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoRepeat(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ i, j: Integer;
+ Stmt: TfsRepeatStmt;
+begin
+ Stmt := TfsRepeatStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+
+ j := xi.Count - 1;
+ if CompareText(xi[j].Name, 'inverse') = 0 then
+ begin
+ Stmt.InverseCondition := True;
+ Dec(j);
+ end;
+ Stmt.Condition := DoExpression(xi[j], Prog);
+ Dec(j);
+
+ for i := 0 to j do
+ DoStmt(xi[i], Prog, Stmt);
+
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoCase(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ i: Integer;
+ Stmt: TfsCaseStmt;
+
+ procedure DoCaseSelector(xi: TfsXMLItem);
+ var
+ Selector: TfsCaseSelector;
+ begin
+ if (CompareText(xi.Name, 'caseselector') <> 0) or (xi.Count <> 2) then Exit;
+ Selector := TfsCaseSelector.Create(Prog, FUnitName, PropPos(xi));
+ Stmt.Add(Selector);
+
+ Selector.SetExpression := DoSet(xi[0], Prog);
+ DoStmt(xi[1], Prog, Selector);
+ end;
+
+begin
+ Stmt := TfsCaseStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+ Stmt.Condition := DoExpression(xi[0], Prog);
+
+ for i := 1 to xi.Count - 1 do
+ DoCaseSelector(xi[i]);
+ if CompareText(xi[xi.Count - 1].Name, 'caseselector') <> 0 then
+ DoStmt(xi[xi.Count - 1], Prog, Stmt.ElseStmt);
+
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoTry(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ i: Integer;
+ Stmt: TfsTryStmt;
+begin
+ Stmt := TfsTryStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+
+ for i := 0 to xi.Count - 1 do
+ if CompareText(xi[i].Name, 'exceptstmt') = 0 then
+ begin
+ Stmt.IsExcept := True;
+ DoCompoundStmt(xi[i], Prog, Stmt.ExceptStmt);
+ end
+ else if CompareText(xi[i].Name, 'finallystmt') = 0 then
+ DoCompoundStmt(xi[i], Prog, Stmt.ExceptStmt)
+ else
+ DoStmt(xi[i], Prog, Stmt);
+
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoBreak(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ Stmt: TfsBreakStmt;
+begin
+ Stmt := TfsBreakStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoContinue(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ Stmt: TfsContinueStmt;
+begin
+ Stmt := TfsContinueStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoExit(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ Stmt: TfsExitStmt;
+begin
+ Stmt := TfsExitStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoReturn(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ xi1: TfsXMLItem;
+begin
+ if xi.Count = 1 then { "return expr" }
+ begin
+ xi1 := TfsXMLItem.Create;
+ xi1.Name := 'dsgn';
+ xi.InsertItem(0, xi1);
+ with xi1.Add do
+ begin
+ Name := 'node';
+ Text := 'text="Result" pos="' + xi[1].Prop['pos'] + '"';
+ end;
+
+ DoAssign(xi, Prog, Statement);
+ end;
+
+ DoExit(xi, Prog, Statement);
+end;
+
+procedure TfsILParser.DoWith(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ d: TfsDesignator;
+ i, n: Integer;
+ s: String;
+ v: TfsVariable;
+ Stmt: TfsWithStmt;
+
+ function CreateUniqueVariable: String;
+ var
+ i: Integer;
+ begin
+ i := 0;
+ while (Prog.FindLocal(IntToStr(i)) <> nil) or
+ (FWithList.IndexOf(IntToStr(i)) <> -1) do
+ Inc(i);
+ Result := '_WithList_' + IntToStr(i);
+ end;
+
+begin
+ n := xi.Count - 1;
+
+ for i := 0 to n - 1 do
+ begin
+ d := DoDesignator(xi[i], Prog);
+ if not ((d.Typ = fvtClass) or (d.Typ = fvtVariant)) then
+ begin
+ d.Free;
+ raise Exception.Create(SClassRequired);
+ end;
+
+ { create local variable with unique name }
+ s := CreateUniqueVariable;
+ v := TfsVariable.Create(s, d.Typ, d.TypeName);
+ Prog.Add(s, v);
+
+ Stmt := TfsWithStmt.Create(Prog, FUnitName, PropPos(xi));
+ Stmt.Variable := v;
+ Stmt.Designator := d;
+ Statement.Add(Stmt);
+ FWithList.AddObject(s, Stmt);
+ end;
+
+ DoStmt(xi[xi.Count - 1], Prog, Statement);
+
+ for i := 0 to n - 1 do
+ FWithList.Delete(FWithList.Count - 1);
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoDelete(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ Stmt: TfsCallStmt;
+begin
+ Stmt := TfsCallStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+ Stmt.Designator := DoDesignator(xi[0], Prog, emFree);
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoCompoundStmt(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ i: Integer;
+begin
+ for i := 0 to xi.Count - 1 do
+ DoStmt(xi[i], Prog, Statement);
+end;
+
+procedure TfsILParser.DoStmt(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ s: String;
+begin
+ s := LowerCase(xi.Name);
+ if s = 'assignstmt' then
+ DoAssign(xi, Prog, Statement)
+ else if s = 'callstmt' then
+ DoCall(xi, Prog, Statement)
+ else if s = 'ifstmt' then
+ DoIf(xi, Prog, Statement)
+ else if s = 'casestmt' then
+ DoCase(xi, Prog, Statement)
+ else if s = 'forstmt' then
+ DoFor(xi, Prog, Statement)
+ else if s = 'vbforstmt' then
+ DoVbFor(xi, Prog, Statement)
+ else if s = 'cppforstmt' then
+ DoCppFor(xi, Prog, Statement)
+ else if s = 'whilestmt' then
+ DoWhile(xi, Prog, Statement)
+ else if s = 'repeatstmt' then
+ DoRepeat(xi, Prog, Statement)
+ else if s = 'trystmt' then
+ DoTry(xi, Prog, Statement)
+ else if s = 'break' then
+ DoBreak(xi, Prog, Statement)
+ else if s = 'continue' then
+ DoContinue(xi, Prog, Statement)
+ else if s = 'exit' then
+ DoExit(xi, Prog, Statement)
+ else if s = 'return' then
+ DoReturn(xi, Prog, Statement)
+ else if s = 'with' then
+ DoWith(xi, Prog, Statement)
+ else if s = 'delete' then
+ DoDelete(xi, Prog, Statement)
+ else if s = 'compoundstmt' then
+ DoCompoundStmt(xi, Prog, Statement)
+ else if s = 'uses' then
+ DoUses(xi, Prog)
+ else if s = 'var' then
+ DoVar(xi, Prog, Statement)
+ else if s = 'const' then
+ DoConst(xi, Prog)
+ else if s = 'procedure' then
+ DoProc2(xi, Prog)
+ else if s = 'function' then
+ DoFunc2(xi, Prog)
+end;
+
+procedure TfsILParser.DoProgram(xi: TfsXMLItem; Prog: TfsScript);
+var
+ TempRoot: TfsXMLItem;
+
+ procedure DoFirstPass(xi: TfsXMLItem);
+ var
+ i: Integer;
+ s: String;
+ begin
+ for i := 0 to xi.Count - 1 do
+ begin
+ s := LowerCase(xi[i].Name);
+ if s = 'compoundstmt' then
+ DoFirstPass(xi[i])
+ else if s = 'procedure' then
+ DoProc1(xi[i], Prog)
+ else if s = 'function' then
+ DoFunc1(xi[i], Prog)
+ end;
+ end;
+
+begin
+ TempRoot := FProgRoot;
+ FProgRoot := xi;
+ DoFirstPass(xi);
+ DoCompoundStmt(xi, Prog, Prog.Statement);
+ FProgRoot := TempRoot;
+end;
+
+
+end.
diff --git a/FastScript/fs_iinirtti.pas b/FastScript/fs_iinirtti.pas
new file mode 100644
index 0000000..8ef969b
--- /dev/null
+++ b/FastScript/fs_iinirtti.pas
@@ -0,0 +1,377 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ IniFiles.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{ Copyright (c) 2004-2007 }
+{ by Stalker SoftWare }
+{ }
+{******************************************}
+
+unit fs_iinirtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, IniFiles{$IFDEF DELPHI16}, Controls{$ENDIF}
+{$IFDEF Delphi16}
+ , System.Types
+{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsIniRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass; const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass; const PropName: String): Variant;
+ procedure SaveIniFileToStream(oIniFile: TCustomIniFile; oStream: TStream);
+ procedure LoadIniFileFromStream(oIniFile :TCustomIniFile; oStream :TStream);
+ procedure WriteTStrings(oIniFile: TCustomIniFile; const Section: String; Values: TStrings; IsClear :Boolean = True);
+ procedure ReadTStrings(oIniFile: TCustomIniFile; const Section: String; Values: TStrings; IsClear :Boolean = True);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+
+ with AScript do
+ begin
+ with AddClass(TCustomIniFile, 'TObject') do
+ begin
+ AddConstructor('constructor Create(const FileName: String)', CallMethod);
+ AddMethod('function ReadInteger(const Section, Ident: String; Default: LongInt): LongInt', CallMethod);
+ AddMethod('procedure WriteInteger(const Section, Ident: String; Value: LongInt)', CallMethod);
+ AddMethod('function ReadBool(const Section, Ident: String; Default: Boolean): Boolean', CallMethod);
+ AddMethod('procedure WriteBool(const Section, Ident: String; Value: Boolean)', CallMethod);
+ AddMethod('function ReadDate(const Section, Name: String; Default: TDateTime): TDateTime', CallMethod);
+ AddMethod('procedure WriteDate(const Section, Name: String; Value: TDateTime)', CallMethod);
+ AddMethod('function ReadDateTime(const Section, Name: String; Default: TDateTime): TDateTime', CallMethod);
+ AddMethod('procedure WriteDateTime(const Section, Name: String; Value: TDateTime)', CallMethod);
+ AddMethod('function ReadFloat(const Section, Name: String; Default: Double): Double', CallMethod);
+ AddMethod('procedure WriteFloat(const Section, Name: String; Value: Double)', CallMethod);
+ AddMethod('function ReadTime(const Section, Name: String; Default: TDateTime): TDateTime', CallMethod);
+ AddMethod('procedure WriteTime(const Section, Name: String; Value: TDateTime);', CallMethod);
+{$IFDEF DELPHI6}
+ AddMethod('function ReadBinaryStream(const Section, Name: String; Value: TStream): Integer', CallMethod);
+ AddMethod('procedure WriteBinaryStream(const Section, Name: String; Value: TStream)', CallMethod);
+{$ENDIF}
+ AddMethod('function SectionExists(const Section: String): Boolean', CallMethod);
+ AddMethod('function ValueExists(const Section, Ident: String): Boolean', CallMethod);
+
+ AddMethod('procedure WriteTStrings(const Section :String; Value :TStrings; IsClear :Boolean = True)', CallMethod);
+ AddMethod('function ReadTStrings(const Section :String; Value :TStrings; IsClear :Boolean = True): String;', CallMethod);
+
+ AddProperty('FileName', 'String', GetProp);
+ end;
+
+ with AddClass(TMemIniFile, 'TCustomIniFile') do
+ begin
+ AddConstructor('constructor Create(const FileName: String)', CallMethod);
+ AddMethod('procedure WriteString(const Section, Ident, Value: String)', CallMethod);
+ AddMethod('function ReadString(const Section, Ident, Default: String): String;', CallMethod);
+{$IFDEF DELPHI6}
+ AddMethod('procedure ReadSectionValuesEx(const Section: String; Strings: TStrings)', CallMethod);
+{$ENDIF}
+ AddMethod('procedure DeleteKey(const Section, Ident: String)', CallMethod);
+ AddMethod('procedure ReadSection(const Section: String; Strings: TStrings)', CallMethod);
+ AddMethod('procedure ReadSections(Strings: TStrings)', CallMethod);
+ AddMethod('procedure ReadSectionValues(const Section: String; Strings: TStrings)', CallMethod);
+ AddMethod('procedure EraseSection(const Section: String)', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure GetStrings(List: TStrings)', CallMethod);
+ AddMethod('procedure SetStrings(List: TStrings)', CallMethod);
+ AddMethod('procedure SaveIniFileToStream(oStream: TStream)', CallMethod);
+ AddMethod('procedure LoadIniFileFromStream(oStream: TStream)', CallMethod);
+ end;
+
+ with AddClass(TIniFile, 'TCustomIniFile') do
+ begin
+ AddMethod('procedure WriteString(const Section, Ident, Value: String)', CallMethod);
+ AddMethod('function ReadString(const Section, Ident, Default: String): String;', CallMethod);
+{$IFDEF DELPHI6}
+ AddMethod('procedure ReadSectionValuesEx(const Section: String; Strings: TStrings)', CallMethod);
+{$ENDIF}
+ AddMethod('procedure DeleteKey(const Section, Ident: String)', CallMethod);
+ AddMethod('procedure ReadSection(const Section: String; Strings: TStrings)', CallMethod);
+ AddMethod('procedure ReadSections(Strings: TStrings)', CallMethod);
+ AddMethod('procedure ReadSectionValues(const Section: String; Strings: TStrings)', CallMethod);
+ AddMethod('procedure EraseSection(const Section: String)', CallMethod);
+ AddMethod('procedure SaveIniFileToStream(oStream: TStream)', CallMethod);
+ AddMethod('procedure LoadIniFileFromStream(oStream: TStream)', CallMethod);
+ end;
+
+ end;
+
+end;
+
+{$HINTS OFF}
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ oCustomIniFile: TCustomIniFile;
+ oMemIniFile: TMemIniFile;
+ oIniFile: TIniFile;
+ oList: TStrings;
+ nCou: Integer;
+
+begin
+
+ Result := 0;
+
+ if ClassType = TCustomIniFile then
+ begin
+ oCustomIniFile := TCustomIniFile(Instance);
+ if MethodName = 'CREATE' then
+ Result := frxInteger(oCustomIniFile.Create(Caller.Params[0]))
+ else if MethodName = 'WRITEINTEGER' then
+ oCustomIniFile.WriteInteger(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READINTEGER' then
+ Result := oCustomIniFile.ReadInteger(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITEBOOL' then
+ oCustomIniFile.WriteBool(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READBOOL' then
+ Result := oCustomIniFile.ReadBool(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITEDATE' then
+ oCustomIniFile.WriteDate(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READDATE' then
+ Result := oCustomIniFile.ReadDate(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITEDATETIME' then
+ oCustomIniFile.WriteDateTime(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READDATETIME' then
+ Result := oCustomIniFile.ReadDateTime(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITEFLOAT' then
+ oCustomIniFile.WriteFloat(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READFLOAT' then
+ Result := oCustomIniFile.ReadFloat(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITETIME' then
+ oCustomIniFile.WriteTime(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READTIME' then
+ Result := oCustomIniFile.ReadTime(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+{$IFDEF DELPHI6}
+ else if MethodName = 'WRITEBINARYSTREAM' then
+ oCustomIniFile.WriteBinaryStream(Caller.Params[0], Caller.Params[1], TStream(frxInteger(Caller.Params[2])))
+ else if MethodName = 'READBINARYSTREAM' then
+ Result := oCustomIniFile.ReadBinaryStream(Caller.Params[0], Caller.Params[1], TStream(frxInteger(Caller.Params[2])))
+{$ENDIF}
+ else if MethodName = 'SECTIONEXISTS' then
+ Result := oCustomIniFile.SectionExists(Caller.Params[0])
+ else if MethodName = 'VALUEEXISTS' then
+ Result := oCustomIniFile.ValueExists(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'WRITETSTRINGS' then
+ WriteTStrings(oCustomIniFile, Caller.Params[0], TStrings(frxInteger(Caller.Params[1])), Caller.Params[2])
+ else if MethodName = 'READTSTRINGS' then
+ ReadTStrings(oCustomIniFile, Caller.Params[0], TStrings(frxInteger(Caller.Params[1])), Caller.Params[2])
+
+ end;
+
+ if ClassType = TMemIniFile then
+ begin
+ oMemIniFile := TMemIniFile(Instance);
+ if MethodName = 'CREATE' then
+ Result := frxInteger(oMemIniFile.Create(Caller.Params[0]{$IFDEF FPC}, False{$ENDIF}))
+ else if MethodName = 'WRITESTRING' then
+ oMemIniFile.WriteString(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READSTRING' then
+ Result := oMemIniFile.ReadString(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'DELETEKEY' then
+ oMemIniFile.DeleteKey(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'READSECTION' then
+ oMemIniFile.ReadSection(Caller.Params[0], TStrings(frxInteger(Caller.Params[1])))
+ else if MethodName = 'READSECTIONS' then
+ oMemIniFile.ReadSections(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'READSECTIONVALUES' then
+ oMemIniFile.ReadSectionValues(Caller.Params[0], TStrings(frxInteger(Caller.Params[1])))
+ else if MethodName = 'ERASESECTION' then
+ oMemIniFile.EraseSection(Caller.Params[0])
+{$IFDEF DELPHI6}
+ else if MethodName = 'READSECTIONVALUESEX' then
+ begin
+ oList := TStringList.Create;
+ try
+ oMemIniFile.ReadSectionValues(Caller.Params[0], oList);
+ TStrings(frxInteger(Caller.Params[1])).Clear;
+ for nCou := 0 to oList.Count-1 do
+// TStrings(frxInteger(Caller.Params[1])).Add(oList.ValueFromIndex[nCou]);
+ TStrings(frxInteger(Caller.Params[1])).Add(oList.Values[oList.Names[nCou]]);
+ finally
+ oList.Free;
+ end;
+ end
+{$ENDIF}
+ else if MethodName = 'CLEAR' then
+ oMemIniFile.Clear
+ else if MethodName = 'GETSTRINGS' then
+ oMemIniFile.GetStrings(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SETSTRINGS' then
+ oMemIniFile.SetStrings(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVEINIFILETOSTREAM' then
+ SaveIniFileToStream(oMemIniFile, TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LOADINIFILEFROMSTREAM' then
+ LoadIniFileFromStream(oMemIniFile, TStream(frxInteger(Caller.Params[0])))
+ end;
+
+ if ClassType = TIniFile then
+ begin
+ oIniFile := TIniFile(Instance);
+ if MethodName = 'WRITESTRING' then
+ oIniFile.WriteString(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READSTRING' then
+ Result := oIniFile.ReadString(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'DELETEKEY' then
+ oIniFile.DeleteKey(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'READSECTION' then
+ oIniFile.ReadSection(Caller.Params[0], TStrings(frxInteger(Caller.Params[1])))
+ else if MethodName = 'READSECTIONS' then
+ oIniFile.ReadSections(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'READSECTIONVALUES' then
+ oIniFile.ReadSectionValues(Caller.Params[0], TStrings(frxInteger(Caller.Params[1])))
+ else if MethodName = 'ERASESECTION' then
+ oIniFile.EraseSection(Caller.Params[0])
+{$IFDEF DELPHI6}
+ else if MethodName = 'READSECTIONVALUESEX' then
+ begin
+ oList := TStringList.Create;
+ try
+ oIniFile.ReadSectionValues(Caller.Params[0], oList);
+ TStrings(frxInteger(Caller.Params[1])).Clear;
+ for nCou := 0 to oList.Count-1 do
+// TStrings(frxInteger(Caller.Params[1])).Add(oList.ValueFromIndex[nCou]);
+ TStrings(frxInteger(Caller.Params[1])).Add(oList.Values[oList.Names[nCou]]);
+ finally
+ oList.Free;
+ end;
+ end
+{$ENDIF}
+ else if MethodName = 'SAVEINIFILETOSTREAM' then
+ SaveIniFileToStream(oIniFile, TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LOADINIFILEFROMSTREAM' then
+ LoadIniFileFromStream(oIniFile, TStream(frxInteger(Caller.Params[0])))
+ end;
+
+end;
+{$HINTS ON}
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass; const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TCustomIniFile then
+ begin
+ if PropName = 'FILENAME' then
+ Result := TIniFile(Instance).FileName
+ end;
+end;
+
+procedure TFunctions.SaveIniFileToStream(oIniFile :TCustomIniFile; oStream :TStream);
+var
+ oStrings :TStrings;
+
+begin
+
+ if (not Assigned(oIniFile)) or (not Assigned(oStream)) then Exit;
+
+ if not ((oIniFile is TIniFile) or (oIniFile is TMemIniFile)) then Exit;
+
+ oStrings:= TStringList.Create;
+ try
+
+ if oIniFile is TIniFile then
+ oStrings.LoadFromFile(oIniFile.FileName)
+ else
+ if oIniFile is TMemIniFile then
+ TMemIniFile(oIniFile).GetStrings(oStrings);
+
+ oStrings.SaveToStream(oStream);
+
+ finally
+ oStrings.Free;
+ end;
+
+end;
+
+procedure TFunctions.LoadIniFileFromStream(oIniFile :TCustomIniFile; oStream :TStream);
+var
+ oStrings :TStrings;
+
+begin
+
+ if (not Assigned(oIniFile)) or (not Assigned(oStream)) then Exit;
+
+ if not ((oIniFile is TIniFile) or (oIniFile is TMemIniFile)) then Exit;
+
+ oStrings:= TStringList.Create;
+ try
+
+ oStrings.LoadFromStream(oStream);
+
+ if oIniFile is TIniFile then
+ oStrings.SaveToFile(oIniFile.FileName)
+ else
+ if oIniFile is TMemIniFile then
+ TMemIniFile(oIniFile).SetStrings(oStrings);
+
+ finally
+ oStrings.Free;
+ end;
+
+end;
+
+procedure TFunctions.WriteTStrings(oIniFile :TCustomIniFile; const Section :String; Values :TStrings; IsClear :Boolean = True);
+var
+ nCou :Integer;
+
+begin
+
+ if IsClear then oIniFile.EraseSection(Section);
+
+ for nCou := 0 to Values.Count-1 do
+ oIniFile.WriteString(Section, 'Items'+IntToStr(nCou), Values[nCou]);
+
+ oIniFile.WriteInteger(Section, 'Count', Values.Count);
+
+end;
+
+procedure TFunctions.ReadTStrings(oIniFile :TCustomIniFile; const Section :String; Values :TStrings; IsClear :Boolean = True);
+var
+ nCou, nCount :Integer;
+
+begin
+
+ nCount := oIniFile.ReadInteger(Section, 'Count', 0);
+
+ if IsClear then Values.Clear;
+
+ for nCou := 0 to nCount-1 do
+ Values.Add(oIniFile.ReadString(Section, 'Items'+IntToStr(nCou), ''));
+
+end;
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsIniRTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/FastScript/fs_iinterpreter.pas b/FastScript/fs_iinterpreter.pas
new file mode 100644
index 0000000..916100e
--- /dev/null
+++ b/FastScript/fs_iinterpreter.pas
@@ -0,0 +1,3547 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Main module }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_iinterpreter;
+
+interface
+
+{$I fs.inc}
+
+uses
+ SysUtils, Classes, fs_xml
+{$IFDEF Delphi6}
+, Variants
+{$ENDIF}
+
+, SyncObjs
+{$IFDEF Delphi16}
+ , System.Types
+{$ENDIF};
+//FMX uses section
+{$ELSE}
+interface
+
+{$I fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_xml
+, System.Variants
+, System.SyncObjs, System.Types;
+{$ENDIF}
+
+
+type
+ TfsStatement = class;
+ TfsDesignator = class;
+ TfsCustomVariable = class;
+ TfsClassVariable = class;
+ TfsProcVariable = class;
+ TfsMethodHelper = class;
+ TfsPropertyHelper = class;
+ TfsScript = class;
+ TfsDesignatorItem = class;
+
+{ List of supported types. Actually all values are variants; types needed
+ only to know what kind of operations can be implemented to the variable }
+
+ TfsVarType = (fvtInt, fvtBool, fvtFloat, fvtChar, fvtString, fvtClass,
+ fvtArray, fvtVariant, fvtEnum, fvtConstructor, fvtInt64);
+{$IFDEF DELPHI16}
+ frxInteger = NativeInt;
+{$ELSE}
+ {$IFDEF FPC}
+ frxInteger = PtrInt;
+ {$ELSE}
+ frxInteger = Integer;
+ {$ENDIF}
+{$ENDIF}
+
+ TfsTypeRec = {$IFDEF Delphi12}{$ELSE}packed{$ENDIF} record
+ Typ: TfsVarType;
+{$IFDEF Delphi12}
+ TypeName: String;
+{$ELSE}
+ TypeName: String[64];
+{$ENDIF}
+ end;
+
+{ Events for get/set non-published property values and call methods }
+
+ TfsGetValueEvent = function(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant of object;
+ TfsSetValueEvent = procedure(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant) of object;
+
+ TfsGetValueNewEvent = function(Instance: TObject; ClassType: TClass;
+ const PropName: String; Caler: TfsPropertyHelper): Variant of object;
+ TfsSetValueNewEvent = procedure(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant; Caller: TfsPropertyHelper) of object;
+
+ TfsCallMethodNewEvent = function(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant of object;
+ TfsCallMethodEvent = function(Instance: TObject; ClassType: TClass;
+ const MethodName: String; var Params: Variant): Variant of object;
+ TfsRunLineEvent = procedure(Sender: TfsScript;
+ const UnitName, SourcePos: String) of object;
+ TfsGetUnitEvent = procedure(Sender: TfsScript;
+ const UnitName: String; var UnitText: String) of object;
+ TfsGetVariableValueEvent = function(VarName: String;
+ VarTyp: TfsVarType; OldValue: Variant): Variant of object;
+
+{ List of objects. Unlike TList, Destructor frees all objects in the list }
+
+ TfsItemList = class(TObject)
+ protected
+ FItems: TList;
+ protected
+ procedure Clear; virtual;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Add(Item: TObject);
+ function Count: Integer;
+ procedure Remove(Item: TObject);
+ end;
+
+
+{ TfsScript represents the main script. It holds the list of local variables,
+ constants, procedures in the Items. Entry point is the Statement.
+
+ There is one global object fsGlobalUnit: TfsScript that holds all information
+ about external classes, global variables, methods and constants. To use
+ such globals, pass fsGlobalUnit to the TfsScript.Create.
+ If you want, you can add classes/variables/methods to the TfsScript - they
+ will be local for it and not visible in other programs.
+
+ To execute a program, compile it first by calling Compile method. If error
+ occurs, the ErrorMsg will contain the error message and ErrorPos will point
+ to an error position in the source text. For example:
+
+ if not Prg.Compile then
+ begin
+ ErrorLabel.Caption := Prg.ErrorMsg;
+ Memo1.SetFocus;
+ Memo1.Perform(EM_SETSEL, Prg.ErrorPos - 1, Prg.ErrorPos - 1);
+ Memo1.Perform(EM_SCROLLCARET, 0, 0);
+ end;
+
+ If no errors occured, call Execute method to execute the program }
+
+{$i frxPlatformsAttribute.inc}
+
+ TfsScript = class(TComponent)
+
+ private
+ FAddedBy: TObject;
+ FBreakCalled: Boolean;
+ FContinueCalled: Boolean;
+ FExitCalled: Boolean;
+ FErrorMsg: String;
+ FErrorPos: String;
+ FErrorUnit: String;
+ FExtendedCharset: Boolean;
+ FItems: TStringList;
+ FIsRunning: Boolean;
+ FLines: TStrings;
+ FMacros: TStrings;
+ FMainProg: Boolean;
+ FOnGetILUnit: TfsGetUnitEvent;
+ FOnGetUnit: TfsGetUnitEvent;
+ FOnRunLine: TfsRunLineEvent;
+ FOnGetVarValue: TfsGetVariableValueEvent;
+ FParent: TfsScript;
+ FProgRunning: TfsScript;
+ FRTTIAdded: Boolean;
+ FStatement: TfsStatement;
+ FSyntaxType: String;
+ FTerminated: Boolean;
+ FUnitLines: TStringList;
+ FIncludePath: TStrings;
+ FUseClassLateBinding: Boolean;
+ FEvaluteRiseError: Boolean;
+ FClearLocalVars: Boolean;
+ FLastSourcePos : String;
+ FProgName : String;
+ function GetItem(Index: Integer): TfsCustomVariable;
+ procedure RunLine(const UnitName, Index: String);
+ function GetVariables(Index: String): Variant;
+ procedure SetVariables(Index: String; const Value: Variant);
+ procedure SetLines(const Value: TStrings);
+ function GetProgName: String;
+ procedure SetProgName(const Value: String);
+
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Add(const Name: String; Item: TObject);
+ procedure AddCodeLine(const UnitName, APos: String);
+ procedure AddRTTI;
+ procedure Remove(Item: TObject);
+ procedure RemoveItems(Owner: TObject);
+ procedure Clear;
+ procedure ClearItems(Owner: TObject);
+ procedure ClearRTTI;
+ function Count: Integer;
+
+ { Adds a class. Example:
+ with AddClass(TComponent, 'TPersistent') do
+ begin
+ ... add properties and methods ...
+ end }
+ function AddClass(AClass: TClass; const Ancestor: String): TfsClassVariable; dynamic;
+ { Adds a constant. Example:
+ AddConst('pi', 'Double', 3.14159) }
+ procedure AddConst(const Name, Typ: String; const Value: Variant); dynamic;
+ { Adds an enumeration constant. Example:
+ AddEnum('TFontPitch', 'fpDefault, fpFixed, fpVariable')
+ all constants gets type fvtEnum and values 0,1,2,3.. }
+ procedure AddEnum(const Typ, Names: String); dynamic;
+ { Adds an set constant. Example:
+ AddEnumSet('TFontStyles', 'fsBold, fsItalic, fsUnderline')
+ all constants gets type fvtEnum and values 1,2,4,8,.. }
+ procedure AddEnumSet(const Typ, Names: String); dynamic;
+ { Adds a form or datamodule with all its child components }
+ procedure AddComponent(Form: TComponent); dynamic;
+ procedure AddForm(Form: TComponent); dynamic;
+ { Adds a method. Syntax is the same as for TfsClassVariable.AddMethod }
+ procedure AddMethod(const Syntax: String; CallEvent: TfsCallMethodNewEvent;
+ const Category: String = ''; const Description: String = ''); overload; dynamic;
+ procedure AddMethod(const Syntax: String; CallEvent: TfsCallMethodEvent;
+ const Category: String = ''; const Description: String = ''); overload; dynamic;
+ { Adds an external object. Example:
+ AddObject('Memo1', Memo1) }
+ procedure AddObject(const Name: String; Obj: TObject); dynamic;
+ { Adds a variable. Example:
+ AddVariable('n', 'Variant', 0) }
+ procedure AddVariable(const Name, Typ: String; const Value: Variant); dynamic;
+ { Adds a type. Example:
+ AddType('TDateTime', fvtFloat) }
+ procedure AddType(const TypeName: String; ParentType: TfsVarType); dynamic;
+ { Calls internal procedure or function. Example:
+ val := CallFunction('ScriptFunc1', VarArrayOf([2003, 3])) }
+ function CallFunction(const Name: String; const Params: Variant; sGlobal: Boolean = false): Variant;
+ function CallFunction1(const Name: String; var Params: Variant; sGlobal: Boolean = false): Variant;
+ function CallFunction2(const Func: TfsProcVariable; const Params: Variant): Variant;
+
+ { Compiles the source code. Example:
+ Lines.Text := 'begin i := 0 end.';
+ SyntaxType := 'PascalScript';
+ if Compile then ... }
+ function Compile: Boolean;
+ { Executes compiled code }
+ procedure Execute;
+ { Same as if Compile then Execute. Returns False if compile failed }
+ function Run: Boolean;
+ { terminates the script }
+ procedure Terminate;
+ { Evaluates an expression (useful for debugging purposes). Example:
+ val := Evaluate('i+1'); }
+ function Evaluate(const Expression: String): Variant;
+ { checks whether is the line is executable }
+ function IsExecutableLine(LineN: Integer; const UnitName: String = ''): Boolean;
+
+ { Generates intermediate language. You can save it and compile later
+ by SetILCode method }
+ function GetILCode(Stream: TStream): Boolean;
+ { Compiles intermediate language }
+ function SetILCode(Stream: TStream): Boolean;
+
+ function Find(const Name: String): TfsCustomVariable;
+ function FindClass(const Name: String): TfsClassVariable;
+ function FindLocal(const Name: String): TfsCustomVariable;
+
+ property AddedBy: TObject read FAddedBy write FAddedBy;
+ property ClearLocalVars: Boolean read FClearLocalVars write FClearLocalVars;
+ property ErrorMsg: String read FErrorMsg write FErrorMsg;
+ property ErrorPos: String read FErrorPos write FErrorPos;
+ property ErrorUnit: String read FErrorUnit write FErrorUnit;
+ property ExtendedCharset: Boolean read FExtendedCharset write FExtendedCharset;
+ property Items[Index: Integer]: TfsCustomVariable read GetItem;
+ property IsRunning: Boolean read FIsRunning;
+ property Macros: TStrings read FMacros;
+ property MainProg: Boolean read FMainProg write FMainProg;
+ property Parent: TfsScript read FParent write FParent;
+ property ProgRunning: TfsScript read FProgRunning;
+ property ProgName: String read GetProgName write SetProgName;
+ property Statement: TfsStatement read FStatement;
+ property Variables[Index: String]: Variant read GetVariables write SetVariables;
+ property IncludePath: TStrings read FIncludePath;
+ property UseClassLateBinding: Boolean read FUseClassLateBinding write FUseClassLateBinding;
+ property EvaluteRiseError: Boolean read FEvaluteRiseError;
+ published
+ { the source code }
+ property Lines: TStrings read FLines write SetLines;
+ { the language name }
+ property SyntaxType: String read FSyntaxType write FSyntaxType;
+ property OnGetILUnit: TfsGetUnitEvent read FOnGetILUnit write FOnGetILUnit;
+ property OnGetUnit: TfsGetUnitEvent read FOnGetUnit write FOnGetUnit;
+ property OnRunLine: TfsRunLineEvent read FOnRunLine write FOnRunLine;
+ property OnGetVarValue: TfsGetVariableValueEvent read FOnGetVarValue write FOnGetVarValue;
+ end;
+
+
+ TfsCustomExpression = class;
+ TfsSetExpression = class;
+
+{ Statements }
+
+ TfsStatement = class(TfsItemList)
+ private
+ FProgram: TfsScript;
+ FSourcePos: String;
+ FUnitName: String;
+ function GetItem(Index: Integer): TfsStatement;
+ procedure RunLine;
+ public
+ constructor Create(AProgram: TfsScript; const UnitName, SourcePos: String); virtual;
+ procedure Execute; virtual;
+ property Items[Index: Integer]: TfsStatement read GetItem;
+ end;
+
+ TfsAssignmentStmt = class(TfsStatement)
+ private
+ FDesignator: TfsDesignator;
+ FExpression: TfsCustomExpression;
+ FVar: TfsCustomVariable;
+ FExpr: TfsCustomVariable;
+ public
+ destructor Destroy; override;
+ procedure Execute; override;
+ procedure Optimize;
+ property Designator: TfsDesignator read FDesignator write FDesignator;
+ property Expression: TfsCustomExpression read FExpression write FExpression;
+ end;
+
+ TfsAssignPlusStmt = class(TfsAssignmentStmt)
+ public
+ procedure Execute; override;
+ end;
+
+ TfsAssignMinusStmt = class(TfsAssignmentStmt)
+ public
+ procedure Execute; override;
+ end;
+
+ TfsAssignMulStmt = class(TfsAssignmentStmt)
+ public
+ procedure Execute; override;
+ end;
+
+ TfsAssignDivStmt = class(TfsAssignmentStmt)
+ public
+ procedure Execute; override;
+ end;
+
+ TfsCallStmt = class(TfsStatement)
+ private
+ FDesignator: TfsDesignator;
+ FModificator: String;
+ public
+ destructor Destroy; override;
+ procedure Execute; override;
+ property Designator: TfsDesignator read FDesignator write FDesignator;
+ property Modificator: String read FModificator write FModificator;
+ end;
+
+ TfsIfStmt = class(TfsStatement)
+ private
+ FCondition: TfsCustomExpression;
+ FElseStmt: TfsStatement;
+ public
+ constructor Create(AProgram: TfsScript; const UnitName, SourcePos: String); override;
+ destructor Destroy; override;
+ procedure Execute; override;
+ property Condition: TfsCustomExpression read FCondition write FCondition;
+ property ElseStmt: TfsStatement read FElseStmt write FElseStmt;
+ end;
+
+ TfsCaseSelector = class(TfsStatement)
+ private
+ FSetExpression: TfsSetExpression;
+ public
+ destructor Destroy; override;
+ function Check(const Value: Variant): Boolean;
+ property SetExpression: TfsSetExpression read FSetExpression write FSetExpression;
+ end;
+
+ TfsCaseStmt = class(TfsStatement)
+ private
+ FCondition: TfsCustomExpression;
+ FElseStmt: TfsStatement;
+ public
+ constructor Create(AProgram: TfsScript; const UnitName, SourcePos: String); override;
+ destructor Destroy; override;
+ procedure Execute; override;
+ property Condition: TfsCustomExpression read FCondition write FCondition;
+ property ElseStmt: TfsStatement read FElseStmt write FElseStmt;
+ end;
+
+ TfsRepeatStmt = class(TfsStatement)
+ private
+ FCondition: TfsCustomExpression;
+ FInverseCondition: Boolean;
+ public
+ destructor Destroy; override;
+ procedure Execute; override;
+ property Condition: TfsCustomExpression read FCondition write FCondition;
+ property InverseCondition: Boolean read FInverseCondition write FInverseCondition;
+ end;
+
+ TfsWhileStmt = class(TfsStatement)
+ private
+ FCondition: TfsCustomExpression;
+ public
+ destructor Destroy; override;
+ procedure Execute; override;
+ property Condition: TfsCustomExpression read FCondition write FCondition;
+ end;
+
+ TfsForStmt = class(TfsStatement)
+ private
+ FBeginValue: TfsCustomExpression;
+ FDown: Boolean;
+ FEndValue: TfsCustomExpression;
+ FVariable: TfsCustomVariable;
+ public
+ destructor Destroy; override;
+ procedure Execute; override;
+ property BeginValue: TfsCustomExpression read FBeginValue write FBeginValue;
+ property Down: Boolean read FDown write FDown;
+ property EndValue: TfsCustomExpression read FEndValue write FEndValue;
+ property Variable: TfsCustomVariable read FVariable write FVariable;
+ end;
+
+ TfsVbForStmt = class(TfsStatement)
+ private
+ FBeginValue: TfsCustomExpression;
+ FEndValue: TfsCustomExpression;
+ FStep: TfsCustomExpression;
+ FVariable: TfsCustomVariable;
+ public
+ destructor Destroy; override;
+ procedure Execute; override;
+ property BeginValue: TfsCustomExpression read FBeginValue write FBeginValue;
+ property EndValue: TfsCustomExpression read FEndValue write FEndValue;
+ property Step: TfsCustomExpression read FStep write FStep;
+ property Variable: TfsCustomVariable read FVariable write FVariable;
+ end;
+
+ TfsCppForStmt = class(TfsStatement)
+ private
+ FFirstStmt: TfsStatement;
+ FExpression: TfsCustomExpression;
+ FSecondStmt: TfsStatement;
+ public
+ constructor Create(AProgram: TfsScript; const UnitName, SourcePos: String); override;
+ destructor Destroy; override;
+ procedure Execute; override;
+ property FirstStmt: TfsStatement read FFirstStmt write FFirstStmt;
+ property Expression: TfsCustomExpression read FExpression write FExpression;
+ property SecondStmt: TfsStatement read FSecondStmt write FSecondStmt;
+ end;
+
+ TfsTryStmt = class(TfsStatement)
+ private
+ FIsExcept: Boolean;
+ FExceptStmt: TfsStatement;
+ public
+ constructor Create(AProgram: TfsScript; const UnitName, SourcePos: String); override;
+ destructor Destroy; override;
+ procedure Execute; override;
+ property IsExcept: Boolean read FIsExcept write FIsExcept;
+ property ExceptStmt: TfsStatement read FExceptStmt write FExceptStmt;
+ end;
+
+ TfsBreakStmt = class(TfsStatement)
+ public
+ procedure Execute; override;
+ end;
+
+ TfsContinueStmt = class(TfsStatement)
+ public
+ procedure Execute; override;
+ end;
+
+ TfsExitStmt = class(TfsStatement)
+ public
+ procedure Execute; override;
+ end;
+
+ TfsWithStmt = class(TfsStatement)
+ private
+ FDesignator: TfsDesignator;
+ FVariable: TfsCustomVariable;
+ public
+ destructor Destroy; override;
+ procedure Execute; override;
+ property Designator: TfsDesignator read FDesignator write FDesignator;
+ property Variable: TfsCustomVariable read FVariable write FVariable;
+ end;
+
+{ TfsCustomVariable is the generic class for variables, constants, arrays,
+ properties, methods and procedures/functions }
+
+ TfsParamItem = class;
+
+ TfsCustomVariable = class(TfsItemList)
+ private
+ FAddedBy: TObject;
+ FIsMacro: Boolean;
+ FIsReadOnly: Boolean;
+ FName: String;
+ FNeedResult: Boolean;
+ FRefItem: TfsCustomVariable;
+ FSourcePos: String;
+ FSourceUnit: String;
+ FTyp: TfsVarType;
+ FTypeName: String;
+ FUppercaseName: String;
+ FValue: Variant;
+ FOnGetVarValue: TfsGetVariableValueEvent;
+ function GetParam(Index: Integer): TfsParamItem;
+ function GetPValue: PVariant;
+ protected
+ procedure SetValue(const Value: Variant); virtual;
+ function GetValue: Variant; virtual;
+ public
+ constructor Create(const AName: String; ATyp: TfsVarType;
+ const ATypeName: String);
+ function GetFullTypeName: String;
+ function GetNumberOfRequiredParams: Integer;
+
+ property AddedBy: TObject read FAddedBy write FAddedBy;
+ property IsMacro: Boolean read FIsMacro write FIsMacro;
+ property IsReadOnly: Boolean read FIsReadOnly write FIsReadOnly;
+ property Name: String read FName;
+ property NeedResult: Boolean read FNeedResult write FNeedResult;
+ property Params[Index: Integer]: TfsParamItem read GetParam; default;
+ property PValue: PVariant read GetPValue;
+ property RefItem: TfsCustomVariable read FRefItem write FRefItem;
+ property SourcePos: String read FSourcePos write FSourcePos;
+ property SourceUnit: String read FSourceUnit write FSourceUnit;
+ property Typ: TfsVarType read FTyp write FTyp;
+ property TypeName: String read FTypeName write FTypeName;
+ property Value: Variant read GetValue write SetValue;
+ property OnGetVarValue: TfsGetVariableValueEvent read FOnGetVarValue write FOnGetVarValue;
+ end;
+
+{ TfsVariable represents constant or variable }
+
+ TfsVariable = class(TfsCustomVariable)
+ protected
+ procedure SetValue(const Value: Variant); override;
+ function GetValue: Variant; override;
+ end;
+
+ TfsTypeVariable = class(TfsCustomVariable)
+ end;
+
+ TfsStringVariable = class(TfsVariable)
+ private
+ FStr: String;
+ protected
+ procedure SetValue(const Value: Variant); override;
+ function GetValue: Variant; override;
+ end;
+
+{ TfsParamItem describes one parameter of procedure/function/method call }
+
+ TfsParamItem = class(TfsCustomVariable)
+ private
+ FDefValue: Variant;
+ FIsOptional: Boolean;
+ FIsVarParam: Boolean;
+ public
+ constructor Create(const AName: String; ATyp: TfsVarType;
+ const ATypeName: String; AIsOptional, AIsVarParam: Boolean);
+ property DefValue: Variant read FDefValue write FDefValue;
+ property IsOptional: Boolean read FIsOptional;
+ property IsVarParam: Boolean read FIsVarParam;
+ end;
+
+{ TfsProcVariable is a local internal procedure/function. Formal parameters
+ are in Params, and statement to execute is in Prog: TfsScript }
+
+ TfsLocalVariablesHelper = class(TObject)
+ protected
+ FValue: Variant;
+ FVariableLink :TfsCustomVariable;
+ end;
+
+
+ TfsProcVariable = class(TfsCustomVariable)
+ private
+ FExecuting: Boolean;
+ FIsFunc: Boolean;
+ FProgram: TfsScript;
+ FVarsStack: TList;
+ protected
+ function GetValue: Variant; override;
+ public
+ constructor Create(const AName: String; ATyp: TfsVarType;
+ const ATypeName: String; AParent: TfsScript; AIsFunc: Boolean = True);
+ destructor Destroy; override;
+ function SaveLocalVariables: Integer;
+ procedure RestoreLocalVariables(StackIndex: Integer; bSkipVarParams: Boolean = False; dItem: TfsDesignatorItem = nil);
+ property Executing: Boolean read FExecuting;
+ property IsFunc: Boolean read FIsFunc;
+ property Prog: TfsScript read FProgram;
+ end;
+
+ TfsCustomExpression = class(TfsCustomVariable)
+ end;
+
+{ TfsCustomHelper is the generic class for the "helpers". Helper is
+ a object that takes the data from the parent object and performs some
+ actions. Helpers needed for properties, methods and arrays }
+
+ TfsCustomHelper = class(TfsCustomVariable)
+ private
+ FParentRef: TfsCustomVariable;
+ FParentValue: Variant;
+ FProgram: TfsScript;
+ public
+ property ParentRef: TfsCustomVariable read FParentRef write FParentRef;
+
+ property ParentValue: Variant read FParentValue write FParentValue;
+
+ property Prog: TfsScript read FProgram write FProgram;
+ end;
+
+{ TfsArrayHelper performs access to array elements }
+
+ TfsArrayHelper = class(TfsCustomHelper)
+ protected
+ procedure SetValue(const Value: Variant); override;
+ function GetValue: Variant; override;
+ public
+ constructor Create(const AName: String; DimCount: Integer; Typ: TfsVarType;
+ const TypeName: String);
+ destructor Destroy; override;
+ end;
+
+{ TfsStringHelper performs access to string elements }
+
+ TfsStringHelper = class(TfsCustomHelper)
+ protected
+ procedure SetValue(const Value: Variant); override;
+ function GetValue: Variant; override;
+ public
+ constructor Create;
+ end;
+
+{ TfsPropertyHelper gets/sets the property value. Object instance is
+ stored as Integer in the ParentValue property }
+
+ TfsPropertyHelper = class(TfsCustomHelper)
+ private
+ FClassRef: TClass;
+ FIsPublished: Boolean;
+ FOnGetValue: TfsGetValueEvent;
+ FOnSetValue: TfsSetValueEvent;
+ FOnGetValueNew: TfsGetValueNewEvent;
+ FOnSetValueNew: TfsSetValueNewEvent;
+ protected
+ procedure SetValue(const Value: Variant); override;
+ function GetValue: Variant; override;
+ public
+ property IsPublished: Boolean read FIsPublished;
+ property OnGetValue: TfsGetValueEvent read FOnGetValue write FOnGetValue;
+ property OnSetValue: TfsSetValueEvent read FOnSetValue write FOnSetValue;
+ property OnGetValueNew: TfsGetValueNewEvent read FOnGetValueNew write FOnGetValueNew;
+ property OnSetValueNew: TfsSetValueNewEvent read FOnSetValueNew write FOnSetValueNew;
+ end;
+
+{ TfsMethodHelper gets/sets the method value. Object instance is
+ stored as Integer in the ParentValue property. SetValue is called
+ if the method represents the indexes property. }
+
+ TfsMethodHelper = class(TfsCustomHelper)
+ private
+ FCategory: String;
+ FClassRef: TClass;
+ FDescription: String;
+ FIndexMethod: Boolean;
+ FOnCall: TfsCallMethodEvent;
+ FOnCallNew: TfsCallMethodNewEvent;
+ FSetValue: Variant;
+ FSyntax: String;
+ FVarArray: Variant;
+ function GetVParam(Index: Integer): Variant;
+ procedure SetVParam(Index: Integer; const Value: Variant);
+ protected
+ procedure SetValue(const Value: Variant); override;
+ function GetValue: Variant; override;
+ public
+ constructor Create(const Syntax: String; Script: TfsScript);
+ destructor Destroy; override;
+
+ property Category: String read FCategory write FCategory;
+ property Description: String read FDescription write FDescription;
+ property IndexMethod: Boolean read FIndexMethod;
+ property Params[Index: Integer]: Variant read GetVParam write SetVParam; default;
+ property Syntax: String read FSyntax;
+ property OnCall: TfsCallMethodEvent read FOnCall write FOnCall;
+ property OnCallNew: TfsCallMethodNewEvent read FOnCallNew write FOnCallNew;
+ end;
+
+{ TfsComponentHelper gets the component inside an owner, e.g. Form1.Button1 }
+
+ TfsComponentHelper = class(TfsCustomHelper)
+ protected
+ function GetValue: Variant; override;
+ procedure SetValue(const Value: Variant); override;
+ public
+ constructor Create(const Name: String; const ClassName: String);
+ end;
+
+{ Event helper maintains VCL events }
+
+ TfsCustomEvent = class(TObject)
+ private
+ FHandler: TfsProcVariable;
+ FInstance: TObject;
+ protected
+ procedure CallHandler(Params: array of const);
+ public
+ constructor Create(AObject: TObject; AHandler: TfsProcVariable); virtual;
+ function GetMethod: Pointer; virtual; abstract;
+ property Handler: TfsProcVariable read FHandler;
+ property Instance: TObject read FInstance;
+ end;
+
+ TfsEventClass = class of TfsCustomEvent;
+
+ TfsEventHelper = class(TfsCustomHelper)
+ private
+ FClassRef: TClass;
+ FEvent: TfsEventClass;
+ protected
+ procedure SetValue(const Value: Variant); override;
+ function GetValue: Variant; override;
+ public
+ constructor Create(const Name: String; AEvent: TfsEventClass);
+ end;
+
+{ TfsClassVariable holds information about external class. Call to
+ AddXXX methods adds properties and methods items to the items list }
+
+ TfsClassVariable = class(TfsCustomVariable)
+ private
+ FAncestor: String;
+ FClassRef: TClass;
+ FDefProperty: TfsCustomHelper;
+ FMembers: TfsItemList;
+ FProgram: TfsScript;
+ procedure AddPublishedProperties(AClass: TClass);
+ function GetMembers(Index: Integer): TfsCustomHelper;
+ function GetMembersCount: Integer;
+ protected
+ function GetValue: Variant; override;
+ public
+ constructor Create(AClass: TClass; const Ancestor: String);
+ destructor Destroy; override;
+
+ { Adds a contructor. Example:
+ AddConstructor('constructor Create(AOwner: TComponent)', MyCallEvent) }
+ procedure AddConstructor(Syntax: String; CallEvent: TfsCallMethodNewEvent); overload;
+ procedure AddConstructor(Syntax: String; CallEvent: TfsCallMethodEvent); overload;
+ function AddComponent(c: TComponent): TfsComponentHelper ;
+ { Adds a property. Example:
+ AddProperty('Font', 'TFont', MyGetEvent, MySetEvent) }
+ procedure AddProperty(const Name, Typ: String;
+ GetEvent: TfsGetValueEvent; SetEvent: TfsSetValueEvent = nil);
+ procedure AddPropertyEx(const Name, Typ: String;
+ GetEvent: TfsGetValueNewEvent; SetEvent: TfsSetValueNewEvent = nil);
+ { Adds a default property. Example:
+ AddDefaultProperty('Cell', 'Integer,Integer', 'String', MyCallEvent)
+ will describe real property Cell[Index1, Index2: Integer]: String
+ Note: in the CallEvent you'll get the MethodName parameter
+ 'CELL.GET' and 'CELL.SET', not 'CELL' }
+ procedure AddDefaultProperty(const Name, Params, Typ: String;
+ CallEvent: TfsCallMethodNewEvent; AReadOnly: Boolean = False); overload;
+ procedure AddDefaultProperty(const Name, Params, Typ: String;
+ CallEvent: TfsCallMethodEvent; AReadOnly: Boolean = False); overload;
+ { Adds an indexed property. Example and behavior are the same as
+ for AddDefaultProperty }
+ procedure AddIndexProperty(const Name, Params, Typ: String;
+ CallEvent: TfsCallMethodNewEvent; AReadOnly: Boolean = False); overload;
+ procedure AddIndexProperty(const Name, Params, Typ: String;
+ CallEvent: TfsCallMethodEvent; AReadOnly: Boolean = False); overload;
+ { Adds a method. Example:
+ AddMethod('function IsVisible: Boolean', MyCallEvent) }
+ procedure AddMethod(const Syntax: String; CallEvent: TfsCallMethodNewEvent); overload;
+ procedure AddMethod(const Syntax: String; CallEvent: TfsCallMethodEvent); overload;
+ { Adds an event. Example:
+ AddEvent('OnClick', TfsNotifyEvent) }
+ procedure AddEvent(const Name: String; AEvent: TfsEventClass);
+ function Find(const Name: String; IncludeComponentHelper: Boolean = True): TfsCustomHelper;
+
+ property Ancestor: String read FAncestor;
+ property ClassRef: TClass read FClassRef;
+ property DefProperty: TfsCustomHelper read FDefProperty;
+ property Members[Index: Integer]: TfsCustomHelper read GetMembers;
+ property MembersCount: Integer read GetMembersCount;
+ end;
+
+{ TfsDesignator holds the parts of function/procedure/variable/method/property
+ calls. Items are of type TfsDesignatorItem.
+ For example, Table1.FieldByName('N').AsString[1] will be represented as
+ items[0]: name 'Table1', no params
+ items[1]: name 'FieldByName', 1 param: 'N'
+ items[2]: name 'AsString', no params
+ items[3]: name '[', 1 param: '1'
+ Call to Value calculates and returns the designator value }
+
+ TfsDesignatorKind = (dkOther, dkVariable, dkStringArray, dkArray);
+
+ TfsDesignatorItem = class(TfsItemList)
+ private
+ FFlag: Boolean; { needed for index methods }
+ FRef: TfsCustomVariable;
+ FSourcePos: String;
+ function GetItem(Index: Integer): TfsCustomExpression;
+ public
+ property Items[Index: Integer]: TfsCustomExpression read GetItem; default;
+ property Flag: Boolean read FFlag write FFlag;
+ property Ref: TfsCustomVariable read FRef write FRef;
+ property SourcePos: String read FSourcePos write FSourcePos;
+ end;
+
+ TfsDesignator = class(TfsCustomVariable)
+ private
+ FKind: TfsDesignatorKind;
+ FMainProg: TfsScript;
+ FProgram: TfsScript;
+ FRef1: TfsCustomVariable;
+ FRef2: TfsDesignatorItem;
+ FLateBindingXmlSource: TfsXMLItem;
+ procedure CheckLateBinding;
+ function DoCalc(const AValue: Variant; Flag: Boolean): Variant;
+ function GetItem(Index: Integer): TfsDesignatorItem;
+ protected
+ function GetValue: Variant; override;
+ procedure SetValue(const Value: Variant); override;
+ public
+ constructor Create(AProgram: TfsScript);
+ destructor Destroy; override;
+ procedure Borrow(ADesignator: TfsDesignator);
+ procedure Finalize;
+ property Items[Index: Integer]: TfsDesignatorItem read GetItem; default;
+ property Kind: TfsDesignatorKind read FKind;
+ property LateBindingXmlSource: TfsXMLItem read FLateBindingXmlSource
+ write FLateBindingXmlSource;
+ end;
+
+ TfsVariableDesignator = class(TfsDesignator)
+ protected
+ function GetValue: Variant; override;
+ procedure SetValue(const Value: Variant); override;
+ end;
+
+ TfsStringDesignator = class(TfsDesignator)
+ protected
+ function GetValue: Variant; override;
+ procedure SetValue(const Value: Variant); override;
+ end;
+
+ TfsArrayDesignator = class(TfsDesignator)
+ protected
+ function GetValue: Variant; override;
+ procedure SetValue(const Value: Variant); override;
+ end;
+
+{ TfsSetExpression represents a set of values like ['_', '0'..'9'] }
+
+ TfsSetExpression = class(TfsCustomVariable)
+ private
+ function GetItem(Index: Integer): TfsCustomExpression;
+ protected
+ function GetValue: Variant; override;
+ public
+ function Check(const Value: Variant): Boolean;
+ property Items[Index: Integer]: TfsCustomExpression read GetItem;
+ end;
+
+ TfsRTTIModule = class(TObject)
+ private
+ FScript: TfsScript;
+ public
+ constructor Create(AScript: TfsScript); virtual;
+ property Script: TfsScript read FScript;
+ end;
+
+
+function fsGlobalUnit: TfsScript;
+function fsIsGlobalUnitExist: Boolean;
+function fsRTTIModules: TList;
+
+
+implementation
+//VCL uses section
+{$IFNDEF FMX}
+uses
+ TypInfo, fs_isysrtti, fs_iexpression, fs_iparser, fs_iilparser,
+ fs_itools, fs_iconst
+{$IFDEF DELPHI16}
+ , Vcl.Controls
+{$ENDIF}
+{$IFDEF CLX}
+, QForms, QDialogs, Types
+{$ELSE}
+ {$IFDEF FPC}
+ {$IFDEF NOFORMS}
+ // nothing
+ {$ELSE}
+ , Forms, Dialogs
+ {$ENDIF}
+ {$ELSE}
+ , Windows
+ {$IFDEF NOFORMS}
+ , Messages
+ {$ELSE}
+ , Forms, Dialogs
+ {$ENDIF}
+ {$ENDIF}
+{$ENDIF};
+//FMX uses section
+{$ELSE}
+uses
+ System.TypInfo, FMX.fs_isysrtti, FMX.fs_iexpression, FMX.fs_iparser, FMX.fs_iilparser,
+ FMX.fs_itools, FMX.fs_iconst, FMX.Types
+ {$IFDEF NOFORMS}
+ , Windows, Messages
+ {$ELSE}
+ , FMX.Forms, FMX.Dialogs
+ {$ENDIF};
+{$ENDIF}
+
+var
+ FGlobalUnit: TfsScript = nil;
+ FGlobalUnitDestroyed: Boolean = False;
+ FRTTIModules: TList = nil;
+ FRTTIModulesDestroyed: Boolean = False;
+
+
+{ TfsItemsList }
+
+constructor TfsItemList.Create;
+begin
+ FItems := TList.Create;
+end;
+
+destructor TfsItemList.Destroy;
+begin
+ Clear;
+ FItems.Free;
+ inherited;
+end;
+
+procedure TfsItemList.Clear;
+begin
+ while FItems.Count > 0 do
+ begin
+ TObject(FItems[0]).Free;
+ FItems.Delete(0);
+ end;
+end;
+
+function TfsItemList.Count: Integer;
+begin
+ Result := FItems.Count;
+end;
+
+procedure TfsItemList.Add(Item: TObject);
+begin
+ FItems.Add(Item);
+end;
+
+procedure TfsItemList.Remove(Item: TObject);
+begin
+ FItems.Remove(Item);
+end;
+
+
+{ TfsCustomVariable }
+
+constructor TfsCustomVariable.Create(const AName: String; ATyp: TfsVarType;
+ const ATypeName: String);
+begin
+ inherited Create;
+ FName := AName;
+ FTyp := ATyp;
+ FTypeName := ATypeName;
+ FValue := Null;
+ FNeedResult := True;
+ FUppercaseName := AnsiUppercase(FName);
+end;
+
+function TfsCustomVariable.GetValue: Variant;
+begin
+ Result := FValue;
+end;
+
+procedure TfsCustomVariable.SetValue(const Value: Variant);
+begin
+ if not FIsReadOnly then
+ FValue := Value;
+end;
+
+function TfsCustomVariable.GetParam(Index: Integer): TfsParamItem;
+begin
+ Result := FItems[Index];
+end;
+
+function TfsCustomVariable.GetPValue: PVariant;
+begin
+ Result := @FValue;
+end;
+
+function TfsCustomVariable.GetFullTypeName: String;
+begin
+ case FTyp of
+ fvtInt: Result := 'Integer';
+ fvtInt64: Result := 'Int64';
+ fvtBool: Result := 'Boolean';
+ fvtFloat: Result := 'Extended';
+ fvtChar: Result := 'Char';
+ fvtString: Result := 'String';
+ fvtClass: Result := FTypeName;
+ fvtArray: Result := 'Array';
+ fvtEnum: Result := FTypeName;
+ else
+ Result := 'Variant';
+ end;
+end;
+
+function TfsCustomVariable.GetNumberOfRequiredParams: Integer;
+var
+ i: Integer;
+begin
+ Result := 0;
+ for i := 0 to Count - 1 do
+ if not Params[i].IsOptional then
+ Inc(Result);
+end;
+
+
+{ TfsStringVariable }
+
+function TfsStringVariable.GetValue: Variant;
+begin
+ Result := FStr;
+ if Assigned(FOnGetVarValue) then
+ begin
+ Result := FOnGetVarValue(FName, FTyp, FStr);
+ if Result = null then Result := FStr;
+ end;
+end;
+
+procedure TfsStringVariable.SetValue(const Value: Variant);
+begin
+ FStr := Value;
+end;
+
+
+{ TfsParamItem }
+
+constructor TfsParamItem.Create(const AName: String; ATyp: TfsVarType;
+ const ATypeName: String; AIsOptional, AIsVarParam: Boolean);
+begin
+ inherited Create(AName, ATyp, ATypeName);
+ FIsOptional := AIsOptional;
+ FIsVarParam := AIsVarParam;
+ FDefValue := Null;
+end;
+
+
+{ TfsProcVariable }
+
+constructor TfsProcVariable.Create(const AName: String; ATyp: TfsVarType;
+ const ATypeName: String; AParent: TfsScript; AIsFunc: Boolean = True);
+begin
+ inherited Create(AName, ATyp, ATypeName);
+ FIsReadOnly := True;
+ FVarsStack := TList.Create;
+ FIsFunc := AIsFunc;
+ FProgram := TfsScript.Create(nil);
+ FProgram.Parent := AParent;
+ if FProgram.Parent <> nil then
+ FProgram.UseClassLateBinding := FProgram.Parent.UseClassLateBinding;
+ if FIsFunc then
+ begin
+ FRefItem := TfsVariable.Create('Result', ATyp, ATypeName);
+ FProgram.Add('Result', FRefItem);
+ end;
+end;
+
+
+
+destructor TfsProcVariable.Destroy;
+var
+ i: Integer;
+begin
+ { avoid destroying the param objects twice }
+ for i := 0 to Count - 1 do
+ FProgram.FItems.Delete(FProgram.FItems.IndexOfObject(Params[i]));
+
+ FProgram.Free;
+ FVarsStack.Free;
+ inherited;
+end;
+
+function TfsProcVariable.GetValue: Variant;
+var
+ Temp: Boolean;
+ ParentProg, SaveProg: TfsScript;
+ i: Integer;
+begin
+ Temp := FExecuting;
+ FExecuting := True;
+ if FIsFunc then
+ FRefItem.Value := Unassigned;
+
+ ParentProg := FProgram;
+ SaveProg := nil;
+ while ParentProg <> nil do
+ if ParentProg.FMainProg then
+ begin
+ SaveProg := ParentProg.FProgRunning;
+ ParentProg.FProgRunning := FProgram;
+ break;
+ end
+ else
+ ParentProg := ParentProg.FParent;
+
+ try
+// avoid trial message
+// same as FProgram.Execute
+ with FProgram do
+ begin
+ FExitCalled := False;
+ FTerminated := False;
+ FIsRunning := True;
+ FProgName := Self.FName;
+ try
+ FStatement.Execute;
+ finally
+ FExitCalled := False;
+ FTerminated := False;
+ FIsRunning := False;
+ FProgName := '';
+ end;
+ end;
+//
+
+ if FIsFunc then
+ Result := FRefItem.Value else
+ Result := Null;
+ finally
+ if ParentProg <> nil then
+ ParentProg.FProgRunning := SaveProg;
+ FExecuting := Temp;
+ if (ParentProg <> nil) and ParentProg.FClearLocalVars then
+ for i := 0 to Prog.Count - 1 do
+ if (Prog.Items[i] is TfsVariable) and
+ (CompareText('Result', Prog.Items[i].Name) <> 0)
+{$IFDEF DELPHI6}
+ and not VarIsClear(Prog.Items[i].Value)
+{$ENDIF}
+ then
+ case TfsVariable(Prog.Items[i]).Typ of
+ fvtString:
+ TfsVariable(Prog.Items[i]).Value := '';
+ fvtInt, fvtFloat, fvtChar:
+ TfsVariable(Prog.Items[i]).Value := 0;
+ fvtVariant:
+ TfsVariable(Prog.Items[i]).Value := Null;
+ end;
+ end;
+end;
+
+function TfsProcVariable.SaveLocalVariables: Integer;
+var
+ i: Integer;
+ LocalVars: TList;
+ StackItem: TfsLocalVariablesHelper;
+begin
+ LocalVars := TList.Create;
+ FVarsStack.Add(LocalVars);
+ Result := FVarsStack.Count - 1;
+ for i := 0 to Prog.Count - 1 do
+ if (Prog.Items[i] is TfsVariable) or (Prog.Items[i] is TfsParamItem) then
+ begin
+ StackItem := TfsLocalVariablesHelper.Create;
+ StackItem.FValue := Prog.Items[i].Value;
+ StackItem.FVariableLink := Prog.Items[i];
+ LocalVars.Add(StackItem);
+ end;
+end;
+
+procedure TfsProcVariable.RestoreLocalVariables(StackIndex: Integer; bSkipVarParams: Boolean; dItem: TfsDesignatorItem);
+var
+ i: Integer;
+ LocalVars: TList;
+ StackItem: TfsLocalVariablesHelper;
+ bIsVar: Boolean;
+ Temp1: array of Variant;
+begin
+ if (FVarsStack.Count < StackIndex) or (StackIndex < 0) then Exit;
+ LocalVars := TList(FVarsStack[StackIndex]);
+ SetLength(Temp1, Count);
+ try
+ { save var parameters value, need when pass same variable as VAR parameter }
+ if Assigned(dItem) then
+ for i := 0 to Count - 1 do
+ if Params[i].IsVarParam then
+ Temp1[i] := Params[i].Value;
+ for i := 0 to LocalVars.Count - 1 do
+ begin
+ StackItem := TfsLocalVariablesHelper(LocalVars[i]);
+ bIsVar := TfsParamItem(StackItem.FVariableLink).FIsVarParam;
+ if not (bSkipVarParams and (StackItem.FVariableLink is TfsParamItem) and bIsVar) then
+ StackItem.FVariableLink.Value := StackItem.FValue;
+ StackItem.Free;
+ end;
+ if Assigned(dItem) then
+ for i := 0 to Count - 1 do
+ if Params[i].IsVarParam then
+ dItem[i].Value := Temp1[i];
+ finally
+ Temp1 := nil;
+ LocalVars.Free;
+ FVarsStack.Delete(StackIndex);
+ end;
+end;
+
+
+{ TfsPropertyHelper }
+
+function TfsPropertyHelper.GetValue: Variant;
+var
+ p: PPropInfo;
+ Instance: TObject;
+begin
+
+ Result := Null;
+ Instance := TObject(frxInteger(ParentValue));
+
+ if FIsPublished and Assigned(Instance) then
+ begin
+ p := GetPropInfo(Instance.ClassInfo, Name);
+ if p <> nil then
+ case p.PropType^.Kind of
+ tkInteger, tkSet, tkEnumeration, tkClass
+ {$IFDEF FPC} ,tkBool {$ENDIF}:
+ Result := GetOrdProp(Instance, p);
+{$IFDEF FS_INT64}
+ tkInt64:
+ Result := GetInt64Prop(Instance, p);
+{$ENDIF}
+ tkFloat:
+ Result := GetFloatProp(Instance, p);
+
+// tkString, tkLString, tkWString{$IFDEF Delphi12}, tkUString{$ENDIF}:
+// Result := GetStrProp(Instance, p);
+
+ tkChar, tkWChar:
+ Result := Chr(GetOrdProp(Instance, p));
+
+ tkVariant:
+ Result := GetVariantProp(Instance, p);
+{$IFDEF Delphi12}
+ tkString, tkLString:
+ Result := GetAnsiStrProp(Instance, p);
+ tkWString, tkUString:
+ Result := GetUnicodeStrProp(Instance, p);
+{$ELSE}
+ tkString, tkLString, tkWString{$ifdef FPC}, tkAString{$endif}:
+ Result := GetStrProp(Instance, p);
+{$ENDIF}
+ end;
+ end
+ else if Assigned(FOnGetValue) then
+ Result := FOnGetValue(Instance, FClassRef, FUppercaseName)
+ else if Assigned(FOnGetValueNew) then
+ Result := FOnGetValueNew(Instance, FClassRef, FUppercaseName, Self);
+
+ if Typ = fvtBool then
+ if Result = 0 then
+ Result := False else
+ Result := True;
+
+end;
+
+procedure TfsPropertyHelper.SetValue(const Value: Variant);
+var
+ p: PPropInfo;
+ Instance: TObject;
+ IntVal: frxInteger;
+ Int64Val: Int64;
+begin
+
+ if IsReadOnly then Exit;
+ Instance := TObject(frxInteger(ParentValue));
+
+
+
+ if FIsPublished then
+ begin
+ p := GetPropInfo(Instance.ClassInfo, Name);
+ if p <> nil then
+ case p.PropType^.Kind of
+ tkInteger, tkSet, tkEnumeration, tkClass
+ {$IFDEF FPC} ,tkBool {$ENDIF}:
+// {$IFDEF Delphi12}, tkInt64{$ENDIF}:
+ begin
+{$IFNDEF Delphi4}
+ if VarType(Value) <> varInteger then
+ begin
+ SetSetProp(Instance, p, fsSetToString(p, Value));
+ end
+ else
+{$ENDIF}
+ begin
+ if Typ = fvtBool then
+ if Value = True then
+ IntVal := 1 else
+ IntVal := 0
+ else
+{$IFNDEF CPUX64}
+{$IFDEF Delphi12}
+ if (VarType(Value) = varInt64)
+ or (VarType(Value) = varUInt64) then
+ begin
+ Int64Val := Value;
+ IntVal := Cardinal(Int64Rec(Int64Val).Lo);
+ end
+ else
+{$ENDIF}
+{$ENDIF}
+ IntVal := frxInteger(Value);
+ SetOrdProp(Instance, p, IntVal);
+ end;
+ end;
+{$IFNDEF DELPHI16}
+{$IFDEF FS_INT64}
+ tkInt64:
+ SetInt64Prop(Instance, p, Value);
+{$ENDIF}
+{$ELSE}
+ tkInt64:
+ SetInt64Prop(Instance, p, Int64(Value));
+{$ENDIF}
+ tkFloat:
+ SetFloatProp(Instance, p, Extended(Value));
+
+// tkString, tkLString:
+// SetStrProp(Instance, p, String(Value));
+
+// tkWString{$IFDEF Delphi12}, tkUString{$ENDIF}:
+// SetStrProp(Instance, p, WideString(Value));
+
+ tkChar, tkWChar:
+ SetOrdProp(Instance, p, Ord(String(Value)[1]));
+
+ tkVariant:
+ SetVariantProp(Instance, p, Value);
+
+{$IFDEF Delphi12}
+ tkString, tkLString:
+ SetAnsiStrProp(Instance, p, AnsiString(Value));
+ tkWString, tkUString:
+ SetUnicodeStrProp(Instance, p, WideString(Value));
+{$ELSE}
+ tkString, tkLString, tkWString{$ifdef FPC}, tkAString{$endif}:
+ SetStrProp(Instance, p, String(Value));
+{$ENDIF}
+ end;
+ end
+ else if Assigned(FOnSetValue) then
+ FOnSetValue(Instance, FClassRef, FUppercaseName, Value)
+ else if Assigned(FOnSetValueNew) then
+ FOnSetValueNew(Instance, FClassRef, FUppercaseName, Value, Self);
+
+end;
+
+
+{ TfsMethodHelper }
+
+constructor TfsMethodHelper.Create(const Syntax: String; Script: TfsScript);
+var
+ i: Integer;
+ v: TfsCustomVariable;
+begin
+ v := ParseMethodSyntax(Syntax, Script);
+ inherited Create(v.Name, v.Typ, v.TypeName);
+ FIsReadOnly := True;
+ FSyntax := Syntax;
+ IsMacro := v.IsMacro;
+
+ { copying params }
+ for i := 0 to v.Count - 1 do
+ Add(v.Params[i]);
+ while v.Count > 0 do
+ v.FItems.Delete(0);
+ v.Free;
+
+ // FPC and Delphi do this different way. FPC implementation more honest, so
+ // if Count = 0 then we get exception about bad bounds
+ if Count > 0 then
+ FVarArray := VarArrayCreate([0, Count - 1], varVariant);
+end;
+
+destructor TfsMethodHelper.Destroy;
+begin
+ FVarArray := Null;
+ inherited;
+end;
+
+function TfsMethodHelper.GetVParam(Index: Integer): Variant;
+begin
+ if Index = Count then
+ Result := FSetValue
+ else
+ Result := TfsParamItem(FItems[Index]).Value;
+end;
+
+procedure TfsMethodHelper.SetVParam(Index: Integer; const Value: Variant);
+begin
+ TfsParamItem(FItems[Index]).Value := Value;
+end;
+
+function TfsMethodHelper.GetValue: Variant;
+var
+ i: Integer;
+ Instance: TObject;
+begin
+ if Assigned(FOnCall) then
+ begin
+ for i := 0 to Count - 1 do
+ FVarArray[i] := inherited Params[i].Value;
+
+ Instance := nil;
+ if not VarIsNull(ParentValue) then
+ Instance := TObject(frxInteger(ParentValue));
+
+ if FIndexMethod then
+ Result := FOnCall(Instance, FClassRef, FUppercaseName + '.GET', FVarArray)
+ else
+ Result := FOnCall(Instance, FClassRef, FUppercaseName, FVarArray);
+ for i := 0 to Count - 1 do
+ begin
+ if inherited Params[i].IsVarParam then
+ inherited Params[i].Value := FVarArray[i];
+ FVarArray[i] := Null;
+ end;
+ end
+ else if Assigned(FOnCallNew) then
+ begin
+ Instance := nil;
+ if not VarIsNull(ParentValue) then
+ Instance := TObject(frxInteger(ParentValue));
+
+ if FIndexMethod then
+ Result := FOnCallNew(Instance, FClassRef, FUppercaseName + '.GET', Self)
+ else
+ Result := FOnCallNew(Instance, FClassRef, FUppercaseName, Self);
+ end
+ else
+ Result := 0;
+end;
+
+procedure TfsMethodHelper.SetValue(const Value: Variant);
+var
+ v: Variant;
+ i: Integer;
+begin
+ if FIndexMethod then
+ if Assigned(FOnCall) then
+ begin
+ v := VarArrayCreate([0, Count], varVariant);
+ for i := 0 to Count - 1 do
+ v[i] := inherited Params[i].Value;
+ v[Count] := Value;
+
+ FOnCall(TObject(frxInteger(ParentValue)), FClassRef, FUppercaseName + '.SET', v);
+ v := Null;
+ end
+ else if Assigned(FOnCallNew) then
+ begin
+ FSetValue := Value;
+ FOnCallNew(TObject(frxInteger(ParentValue)), FClassRef, FUppercaseName + '.SET', Self);
+ FSetValue := Null;
+ end;
+end;
+
+
+{ TfsComponentHelper }
+
+constructor TfsComponentHelper.Create(const Name: String; const ClassName: String);
+begin
+ inherited Create(Name, fvtClass, ClassName);
+end;
+
+function TfsComponentHelper.GetValue: Variant;
+var
+ c: TObject;
+begin
+ c := TObject(frxInteger(ParentValue));
+ if c is TComponent then
+ c := TComponent(c).FindComponent(Name)
+ else
+ c := nil;
+ if Assigned(c) then
+ Result := frxInteger(c)
+ else
+ raise Exception.Create(Format(SComponentError, [Name]));
+end;
+
+procedure TfsComponentHelper.SetValue(const Value: Variant);
+begin
+ raise Exception.Create(Format(SComponentAssignError, [Name]));
+end;
+
+{ TfsEventHelper }
+
+constructor TfsEventHelper.Create(const Name: String; AEvent: TfsEventClass);
+begin
+ inherited Create(Name, fvtString, '');
+ FEvent := AEvent;
+end;
+
+function TfsEventHelper.GetValue: Variant;
+begin
+ Result := '';
+end;
+
+procedure TfsEventHelper.SetValue(const Value: Variant);
+var
+ Instance: TPersistent;
+ v: TfsCustomVariable;
+ e: TfsCustomEvent;
+ p: PPropInfo;
+ m: TMethod;
+begin
+
+ Instance := TPersistent(frxInteger(ParentValue));
+ if VarToStr(Value) = '0' then
+ begin
+ m.Code := nil;
+ m.Data := nil;
+ end
+ else
+ begin
+ v := FProgram.Find(Value);
+ if (v = nil) or not (v is TfsProcVariable) then
+ raise Exception.Create(SEventError);
+
+ e := TfsCustomEvent(FEvent.NewInstance);
+ e.Create(Instance, TfsProcVariable(v));
+ FProgram.Add('', e);
+ m.Code := e.GetMethod;
+ m.Data := e;
+ end;
+
+ p := GetPropInfo(Instance.ClassInfo, Name);
+ SetMethodProp(Instance, p, m);
+end;
+
+
+{ TfsClassVariable }
+
+constructor TfsClassVariable.Create(AClass: TClass; const Ancestor: String);
+begin
+ inherited Create(AClass.ClassName, fvtClass, AClass.ClassName);
+ FMembers := TfsItemList.Create;
+ FAncestor := Ancestor;
+ FClassRef := AClass;
+
+ AddPublishedProperties(AClass);
+ Add(TfsParamItem.Create('', fvtVariant, '', True, False));
+end;
+
+destructor TfsClassVariable.Destroy;
+begin
+ FMembers.Free;
+ inherited;
+end;
+
+function TfsClassVariable.GetMembers(Index: Integer): TfsCustomHelper;
+begin
+ Result := FMembers.FItems[Index];
+end;
+
+function TfsClassVariable.GetMembersCount: Integer;
+begin
+ Result := FMembers.Count;
+end;
+
+procedure TfsClassVariable.AddConstructor(Syntax: String; CallEvent: TfsCallMethodEvent);
+var
+ i: Integer;
+begin
+ i := Pos(' ', Syntax);
+ Delete(Syntax, 1, i - 1);
+ Syntax := 'function' + Syntax + ': ' + 'Constructor';
+ AddMethod(Syntax, CallEvent);
+end;
+
+procedure TfsClassVariable.AddConstructor(Syntax: String;
+ CallEvent: TfsCallMethodNewEvent);
+var
+ i: Integer;
+begin
+ i := Pos(' ', Syntax);
+ Delete(Syntax, 1, i - 1);
+ Syntax := 'function' + Syntax + ': ' + 'Constructor';
+ AddMethod(Syntax, CallEvent);
+end;
+
+procedure TfsClassVariable.AddMethod(const Syntax: String; CallEvent: TfsCallMethodEvent);
+var
+ m: TfsMethodHelper;
+begin
+ m := TfsMethodHelper.Create(Syntax, FProgram);
+ m.FOnCall := CallEvent;
+ m.FClassRef := FClassRef;
+ FMembers.Add(m);
+end;
+
+procedure TfsClassVariable.AddMethod(const Syntax: String; CallEvent: TfsCallMethodNewEvent);
+var
+ m: TfsMethodHelper;
+begin
+ m := TfsMethodHelper.Create(Syntax, FProgram);
+ m.FOnCallNew := CallEvent;
+ m.FClassRef := FClassRef;
+ FMembers.Add(m);
+end;
+
+procedure TfsClassVariable.AddEvent(const Name: String; AEvent: TfsEventClass);
+var
+ e: TfsEventHelper;
+begin
+ e := TfsEventHelper.Create(Name, AEvent);
+ e.FClassRef := FClassRef;
+ FMembers.Add(e);
+end;
+
+procedure TfsClassVariable.AddProperty(const Name, Typ: String;
+ GetEvent: TfsGetValueEvent; SetEvent: TfsSetValueEvent);
+var
+ p: TfsPropertyHelper;
+begin
+ p := TfsPropertyHelper.Create(Name, StrToVarType(Typ, FProgram), Typ);
+ p.FClassRef := FClassRef;
+ p.FOnGetValue := GetEvent;
+ p.FOnSetValue := SetEvent;
+ p.IsReadOnly := not Assigned(SetEvent);
+ FMembers.Add(p);
+end;
+
+procedure TfsClassVariable.AddPropertyEx(const Name, Typ: String;
+ GetEvent: TfsGetValueNewEvent; SetEvent: TfsSetValueNewEvent);
+var
+ p: TfsPropertyHelper;
+begin
+ p := TfsPropertyHelper.Create(Name, StrToVarType(Typ, FProgram), Typ);
+ p.FClassRef := FClassRef;
+ p.FOnGetValueNew := GetEvent;
+ p.FOnSetValueNew := SetEvent;
+ p.IsReadOnly := not Assigned(SetEvent);
+ FMembers.Add(p);
+end;
+
+procedure TfsClassVariable.AddDefaultProperty(const Name, Params, Typ: String;
+ CallEvent: TfsCallMethodEvent; AReadOnly: Boolean = False);
+begin
+ AddIndexProperty(Name, Params, Typ, CallEvent, AReadOnly);
+ FDefProperty := Members[FMembers.Count - 1];
+end;
+
+procedure TfsClassVariable.AddDefaultProperty(const Name, Params,
+ Typ: String; CallEvent: TfsCallMethodNewEvent; AReadOnly: Boolean);
+begin
+ AddIndexProperty(Name, Params, Typ, CallEvent, AReadOnly);
+ FDefProperty := Members[FMembers.Count - 1];
+end;
+
+procedure TfsClassVariable.AddIndexProperty(const Name, Params,
+ Typ: String; CallEvent: TfsCallMethodEvent; AReadOnly: Boolean = False);
+var
+ i: Integer;
+ sl: TStringList;
+ s: String;
+begin
+ sl := TStringList.Create;
+ sl.CommaText := Params;
+
+ s := '';
+ for i := 0 to sl.Count - 1 do
+ s := s + 'p' + IntToStr(i) + ': ' + sl[i] + '; ';
+
+ SetLength(s, Length(s) - 2);
+ try
+ AddMethod('function ' + Name + '(' + s + '): ' + Typ, CallEvent);
+ with TfsMethodHelper(Members[FMembers.Count - 1]) do
+ begin
+ IsReadOnly := AReadOnly;
+ FIndexMethod := True;
+ end;
+ finally
+ sl.Free;
+ end;
+end;
+
+procedure TfsClassVariable.AddIndexProperty(const Name, Params,
+ Typ: String; CallEvent: TfsCallMethodNewEvent; AReadOnly: Boolean);
+var
+ i: Integer;
+ sl: TStringList;
+ s: String;
+begin
+ sl := TStringList.Create;
+ sl.CommaText := Params;
+
+ s := '';
+ for i := 0 to sl.Count - 1 do
+ s := s + 'p' + IntToStr(i) + ': ' + sl[i] + '; ';
+
+ SetLength(s, Length(s) - 2);
+ try
+ AddMethod('function ' + Name + '(' + s + '): ' + Typ, CallEvent);
+ with TfsMethodHelper(Members[FMembers.Count - 1]) do
+ begin
+ IsReadOnly := AReadOnly;
+ FIndexMethod := True;
+ end;
+ finally
+ sl.Free;
+ end;
+end;
+
+function TfsClassVariable.AddComponent(c: TComponent): TfsComponentHelper;
+var
+ Helper: TfsCustomHelper;
+begin
+ { check if member alreeady exist }
+ Helper := Find(c.Name);
+ Result := nil;
+ { member has different purpose, name conflict }
+ if Helper is TfsComponentHelper then
+ Result := TfsComponentHelper(Helper);
+ if Assigned(Helper) then Exit;
+ Result := TfsComponentHelper.Create(c.Name, c.ClassName);
+ FMembers.Add(Result);
+end;
+
+procedure TfsClassVariable.AddPublishedProperties(AClass: TClass);
+var
+ TypeInfo: PTypeInfo;
+ PropCount: Integer;
+ PropList: PPropList;
+ i: Integer;
+ cl: String;
+ t: TfsVarType;
+ FClass: TClass;
+ p: TfsPropertyHelper;
+begin
+ TypeInfo := AClass.ClassInfo;
+ if TypeInfo = nil then Exit;
+
+ PropCount := GetPropList(TypeInfo, tkProperties, nil);
+ GetMem(PropList, PropCount * SizeOf(PPropInfo));
+ GetPropList(TypeInfo, tkProperties, PropList);
+
+ try
+ for i := 0 to PropCount - 1 do
+ begin
+ t := fvtInt;
+ cl := '';
+
+ case PropList[i].PropType^.Kind of
+ tkInteger:
+ t := fvtInt;
+{$IFDEF FS_INT64}
+ tkInt64:
+ t := fvtInt64;
+{$ENDIF}
+ tkSet:
+ begin
+ t := fvtEnum;
+ cl := String(PropList[i].PropType^.Name);
+ end;
+ tkEnumeration:
+ begin
+ t := fvtEnum;
+ cl := String(PropList[i].PropType^.Name);
+ if (CompareText(cl, 'Boolean') = 0) or (CompareText(cl, 'bool') = 0) then
+ t := fvtBool;
+ end;
+{$ifdef FPC}
+ tkBool:
+ t := fvtBool;
+{$ENDIF}
+ tkFloat:
+ t := fvtFloat;
+ tkChar, tkWChar:
+ t := fvtChar;
+ tkString, tkLString, tkWString{$IFDEF Delphi12}, tkUString{$ENDIF}{$ifdef FPC},tkAString{$endif}:
+ t := fvtString;
+ tkVariant:
+ t := fvtVariant;
+ tkClass:
+ begin
+ t := fvtClass;
+ {$IFNDEF FPC}
+ FClass := GetTypeData(PropList[i].PropType^).ClassType;
+ {$ELSE}
+ FClass := GetTypeData(PropList[i].PropType).ClassType;
+ {$ENDIF}
+ cl := FClass.ClassName;
+ end;
+ end;
+
+ p := TfsPropertyHelper.Create(String(PropList[i].Name), t, cl);
+ p.FClassRef := FClassRef;
+ p.FIsPublished := True;
+ FMembers.Add(p);
+ end;
+
+ finally
+ FreeMem(PropList, PropCount * SizeOf(PPropInfo));
+ end;
+end;
+
+function TfsClassVariable.Find(const Name: String; IncludeComponentHelper: Boolean = True): TfsCustomHelper;
+var
+ cl: TfsClassVariable;
+
+ function DoFind(const Name: String): TfsCustomHelper;
+ var
+ i: Integer;
+ begin
+ Result := nil;
+ for i := 0 to FMembers.Count - 1 do
+ if CompareText(Name, Members[i].Name) = 0 then
+ begin
+ Result := Members[i];
+ Exit;
+ end;
+ end;
+
+begin
+ Result := DoFind(Name);
+ if Result = nil then
+ begin
+ cl := FProgram.FindClass(FAncestor);
+ if cl <> nil then
+ Result := cl.Find(Name);
+ end;
+ if not IncludeComponentHelper and (Result is TfsComponentHelper) then
+ Result := nil;
+end;
+
+function TfsClassVariable.GetValue: Variant;
+begin
+ if Params[0].Value = Null then
+ Result := frxInteger(FClassRef.NewInstance) else { constructor call }
+ Result := Params[0].Value; { typecast }
+ Params[0].Value := Null;
+end;
+
+
+{ TfsDesignatorItem }
+
+function TfsDesignatorItem.GetItem(Index: Integer): TfsCustomExpression;
+begin
+ Result := FItems[Index];
+end;
+
+
+{ TfsDesignator }
+
+constructor TfsDesignator.Create(AProgram: TfsScript);
+var
+ ParentProg: TfsScript;
+begin
+{$IFDEF CPUX64}
+ inherited Create('', fvtInt64, '');
+{$ELSE}
+ inherited Create('', fvtInt, '');
+{$ENDIF}
+ FProgram := AProgram;
+ FMainProg := FProgram;
+ ParentProg := FProgram;
+ while ParentProg <> nil do
+ if ParentProg.FMainProg then
+ begin
+ FMainProg := ParentProg;
+ break;
+ end
+ else
+ ParentProg := ParentProg.FParent;
+ FProgram.UseClassLateBinding := FMainProg.UseClassLateBinding;
+end;
+
+destructor TfsDesignator.Destroy;
+begin
+ if FLateBindingXMLSource <> nil then
+ FLateBindingXMLSource.Free;
+ inherited;
+end;
+
+procedure TfsDesignator.Borrow(ADesignator: TfsDesignator);
+var
+ SaveItems: TList;
+begin
+ SaveItems := FItems;
+ FItems := ADesignator.FItems;
+ ADesignator.FItems := SaveItems;
+ FKind := ADesignator.FKind;
+ FRef1 := ADesignator.FRef1;
+ FRef2 := ADesignator.FRef2;
+ FTyp := ADesignator.Typ;
+ FTypeName := ADesignator.TypeName;
+ FIsReadOnly := ADesignator.IsReadOnly;
+ RefItem := ADesignator.RefItem;
+end;
+
+procedure TfsDesignator.Finalize;
+var
+ Item: TfsDesignatorItem;
+begin
+ Item := Items[Count - 1];
+ FTyp := Item.Ref.Typ;
+ FTypeName := Item.Ref.TypeName;
+ if FTyp = fvtConstructor then
+ begin
+ FTyp := fvtClass;
+ FTypeName := Items[Count - 2].Ref.TypeName;
+ end;
+
+ FIsReadOnly := Item.Ref.IsReadOnly;
+
+ { speed optimization for access to single variable, string element or array }
+ if (Count = 1) and (Items[0].Ref is TfsVariable) then
+ begin
+ RefItem := Items[0].Ref;
+ FKind := dkVariable;
+ end
+ else if (Count = 2) and (Items[0].Ref is TfsStringVariable) then
+ begin
+ RefItem := Items[0].Ref;
+ FRef1 := Items[1][0];
+ FKind := dkStringArray;
+ end
+ else if (Count = 2) and (Items[0].Ref is TfsVariable) and (Items[0].Ref.Typ = fvtArray) then
+ begin
+ RefItem := Items[0].Ref;
+ FRef1 := RefItem.RefItem;
+ FRef2 := Items[1];
+ FKind := dkArray;
+ end
+ else
+ FKind := dkOther;
+end;
+
+function TfsDesignator.GetItem(Index: Integer): TfsDesignatorItem;
+begin
+ Result := FItems[Index];
+end;
+
+function TfsDesignator.DoCalc(const AValue: Variant; Flag: Boolean): Variant;
+var
+ i, j: Integer;
+ Item: TfsCustomVariable;
+ Val: Variant;
+ Ref: TfsCustomVariable;
+ Temp1: array of Variant;
+ StackIndex: Integer;
+begin
+ Ref := nil;
+ Val := Null;
+ StackIndex := -1;
+ for i := 0 to Count - 1 do
+ begin
+ Item := Items[i].Ref;
+
+ if Item is TfsDesignator then { it is true for "WITH" statements }
+ begin
+ Ref := Item;
+ Val := Item.Value;
+ continue;
+ end;
+
+ try
+ { we're trying to call the local procedure that is already executing -
+ i.e. we have a recursion }
+ if (Item is TfsProcVariable) and TfsProcVariable(Item).Executing then
+ StackIndex := TfsProcVariable(Item).SaveLocalVariables;
+
+ if Item.Count > 0 then
+ begin
+ SetLength(Temp1, Item.Count);
+ try
+ { calculate params and copy param values to the temp1 array }
+ for j := 0 to Item.Count - 1 do
+ if Item.IsMacro then
+ Temp1[j] := TfsExpression(Items[i][j]).Source
+ else
+ Temp1[j] := Items[i][j].Value;
+ { copy calculated values to the item params }
+ for j := 0 to Item.Count - 1 do
+ Item.Params[j].Value := Temp1[j];
+ finally
+ Temp1 := nil;
+ end;
+ end;
+
+ { copy value and var reference to the helper object }
+ if Item is TfsCustomHelper then
+ begin
+ TfsCustomHelper(Item).ParentRef := Ref;
+ TfsCustomHelper(Item).ParentValue := Val;
+ TfsCustomHelper(Item).Prog := FProgram;
+ end;
+
+ Ref := Item;
+ { assign a value to the last designator node if called from SetValue }
+ if Flag and (i = Count - 1) then
+ begin
+ Item.Value := AValue
+ end
+ else
+ begin
+ Item.NeedResult := (i <> Count - 1) or NeedResult;
+ Val := Item.Value;
+ end;
+
+ { copy back var params }
+ for j := 0 to Item.Count - 1 do
+ if Item.Params[j].IsVarParam then
+ Items[i][j].Value := Item.Params[j].Value;
+
+ finally
+ { restore proc variables if it was called from itself }
+ if (Item is TfsProcVariable) and TfsProcVariable(Item).Executing then
+ TfsProcVariable(Item).RestoreLocalVariables(StackIndex, False, Items[i]);
+ end;
+ end;
+
+ Result := Val;
+end;
+
+procedure TfsDesignator.CheckLateBinding;
+var
+ NewDesignator: TfsDesignator;
+ Parser: TfsILParser;
+begin
+ if FLateBindingXMLSource <> nil then
+ begin
+ Parser := TfsILParser.Create(FProgram);
+ try
+ NewDesignator := Parser.DoDesignator(FLateBindingXMLSource, FProgram);
+ Borrow(NewDesignator);
+ NewDesignator.Free;
+ finally
+ Parser.Free;
+ FLateBindingXMLSource.Free;
+ FLateBindingXMLSource := nil;
+ end;
+ end;
+end;
+
+function TfsDesignator.GetValue: Variant;
+begin
+ CheckLateBinding;
+ Result := DoCalc(Null, False);
+end;
+
+procedure TfsDesignator.SetValue(const Value: Variant);
+begin
+ CheckLateBinding;
+ DoCalc(Value, True);
+end;
+
+
+{ TfsVariableDesignator }
+
+function TfsVariableDesignator.GetValue: Variant;
+begin
+ Result := RefItem.Value;
+end;
+
+procedure TfsVariableDesignator.SetValue(const Value: Variant);
+begin
+ RefItem.Value := Value;
+end;
+
+
+{ TfsStringDesignator }
+
+function TfsStringDesignator.GetValue: Variant;
+begin
+ Result := TfsStringVariable(RefItem).FStr[Integer(FRef1.Value)];
+end;
+
+procedure TfsStringDesignator.SetValue(const Value: Variant);
+begin
+ TfsStringVariable(RefItem).FStr[Integer(FRef1.Value)] := VarToStr(Value)[1];
+end;
+
+
+{ TfsArrayDesignator }
+
+function TfsArrayDesignator.GetValue: Variant;
+var
+ i: Integer;
+begin
+ TfsCustomHelper(FRef1).ParentRef := RefItem;
+ for i := 0 to FRef2.Count - 1 do
+ FRef1.Params[i].Value := FRef2[i].Value;
+ Result := FRef1.Value;
+end;
+
+procedure TfsArrayDesignator.SetValue(const Value: Variant);
+var
+ i: Integer;
+begin
+ TfsCustomHelper(FRef1).ParentRef := RefItem;
+ for i := 0 to FRef2.Count - 1 do
+ FRef1.Params[i].Value := FRef2[i].Value;
+ FRef1.Value := Value;
+end;
+
+
+{ TfsSetExpression }
+
+function TfsSetExpression.Check(const Value: Variant): Boolean;
+var
+ i: Integer;
+ Expr: TfsCustomExpression;
+begin
+ Result := False;
+
+ (* TfsSetExpression encapsulates the set like [1,2,3..10]
+ In the example above we'll have the following Items:
+ TfsExpression {1}
+ TfsExpression {2}
+ TfsExpression {3}
+ nil (indicates the range )
+ TfsExpression {10} *)
+
+ i := 0;
+ while i < Count do
+ begin
+ Expr := Items[i];
+
+ if (i < Count - 1) and (Items[i + 1] = nil) then { subrange }
+ begin
+ Result := (Value >= Expr.Value) and (Value <= Items[i + 2].Value);
+ Inc(i, 2);
+ end
+ else
+ Result := Value = Expr.Value;
+
+ if Result then break;
+ Inc(i);
+ end;
+end;
+
+function TfsSetExpression.GetItem(Index: Integer): TfsCustomExpression;
+begin
+ Result := FItems[Index];
+end;
+
+function TfsSetExpression.GetValue: Variant;
+var
+ i: Integer;
+begin
+ Result := VarArrayCreate([0, Count - 1], varVariant);
+
+ for i := 0 to Count - 1 do
+ if Items[i] = nil then
+ Result[i] := Null else
+ Result[i] := Items[i].Value;
+end;
+
+
+{ TfsScript }
+
+constructor TfsScript.Create(AOwner: TComponent);
+begin
+ inherited;
+ FEvaluteRiseError := False;
+ FItems := TStringList.Create;
+ FItems.Sorted := True;
+ FItems.Duplicates := dupAccept;
+ FLines := TStringList.Create;
+ FMacros := TStringList.Create;
+ FIncludePath := TStringList.Create;
+ FIncludePath.Add('');
+ FStatement := TfsStatement.Create(Self, '', '');
+ FSyntaxType := 'PascalScript';
+ FUnitLines := TStringList.Create;
+ FUseClassLateBinding := False;
+end;
+
+destructor TfsScript.Destroy;
+begin
+ inherited;
+ Clear;
+ ClearRTTI;
+ FItems.Free;
+ FLines.Free;
+ FMacros.Free;
+ FIncludePath.Free;
+ FStatement.Free;
+ FUnitLines.Free;
+end;
+
+procedure TfsScript.Add(const Name: String; Item: TObject);
+begin
+ FItems.AddObject(Name, Item);
+ if Item is TfsCustomVariable then
+ TfsCustomVariable(Item).AddedBy := FAddedBy;
+end;
+
+function TfsScript.Count: Integer;
+begin
+ Result := FItems.Count;
+end;
+
+procedure TfsScript.Remove(Item: TObject);
+begin
+ FItems.Delete(FItems.IndexOfObject(Item));
+end;
+
+procedure TfsScript.Clear;
+var
+ i: Integer;
+ item: TObject;
+begin
+ i := 0;
+ while i < FItems.Count do
+ begin
+ item := FItems.Objects[i];
+ if (item is TfsRTTIModule) or
+ ((item is TfsCustomVariable) and
+ (TfsCustomVariable(item).AddedBy = TObject(1))) then
+ Inc(i)
+ else
+ begin
+ item.Free;
+ FItems.Delete(i);
+ end;
+ end;
+ FStatement.Clear;
+
+
+ for i := 0 to FUnitLines.Count - 1 do
+ FUnitLines.Objects[i].Free;
+
+ FUnitLines.Clear;
+
+ FErrorPos := '';
+ FErrorMsg := '';
+ FErrorUnit := '';
+end;
+
+procedure TfsScript.ClearItems(Owner: TObject);
+var
+ i: Integer;
+begin
+ RemoveItems(Owner);
+ FStatement.Clear;
+
+ for i := 0 to FUnitLines.Count - 1 do
+ FUnitLines.Objects[i].Free;
+
+ FUnitLines.Clear;
+end;
+
+procedure TfsScript.RemoveItems(Owner: TObject);
+var
+ i: Integer;
+begin
+ for i := Count - 1 downto 0 do
+ if FItems.Objects[i] is TfsCustomVariable then
+ if Items[i].AddedBy = Owner then
+ begin
+ Items[i].Free;
+ Remove(Items[i]);
+ end;
+end;
+
+function TfsScript.GetItem(Index: Integer): TfsCustomVariable;
+begin
+ Result := TfsCustomVariable(FItems.Objects[Index]);
+end;
+
+function TfsScript.GetProgName: String;
+begin
+ if Assigned(ProgRunning) then
+ Result := ProgRunning.ProgName
+ else
+ Result := FProgName;
+end;
+
+function TfsScript.Find(const Name: String): TfsCustomVariable;
+begin
+ Result := FindLocal(Name);
+
+ { trying to find the identifier in all parent programs }
+ if (Result = nil) and (FParent <> nil) then
+ Result := FParent.Find(Name);
+end;
+
+function TfsScript.FindLocal(const Name: String): TfsCustomVariable;
+var
+ i: Integer;
+begin
+ Result := nil;
+ i := FItems.IndexOf(Name);
+ if (i <> -1) and (FItems.Objects[i] is TfsCustomVariable) then
+ Result := TfsCustomVariable(FItems.Objects[i]);
+end;
+
+function TfsScript.Compile: Boolean;
+var
+ p: TfsILParser;
+begin
+ Result := False;
+ FErrorMsg := '';
+
+ p := TfsILParser.Create(Self);
+ try
+ p.SelectLanguage(FSyntaxType);
+ if p.MakeILScript(FLines.Text) then
+ p.ParseILScript;
+ finally
+ p.Free;
+ end;
+
+ if FErrorMsg = '' then
+ begin
+ Result := True;
+ FErrorPos := '';
+ end
+end;
+
+procedure TfsScript.Execute;
+begin
+
+ FExitCalled := False;
+ FTerminated := False;
+ FIsRunning := True;
+ FMainProg := True;
+ try
+ FStatement.Execute;
+ finally
+ FExitCalled := False;
+ FTerminated := False;
+ FIsRunning := False;
+ end;
+end;
+
+function TfsScript.Run: Boolean;
+begin
+ Result := Compile;
+ if Result then
+ Execute;
+end;
+
+function TfsScript.GetILCode(Stream: TStream): Boolean;
+var
+ p: TfsILParser;
+begin
+ Result := False;
+ FErrorMsg := '';
+
+ p := TfsILParser.Create(Self);
+ try
+ p.SelectLanguage(FSyntaxType);
+ if p.MakeILScript(FLines.Text) then
+ p.ILScript.SaveToStream(Stream);
+ finally
+ p.Free;
+ end;
+
+ if FErrorMsg = '' then
+ begin
+ Result := True;
+ FErrorPos := '';
+ end;
+end;
+
+function TfsScript.SetILCode(Stream: TStream): Boolean;
+var
+ p: TfsILParser;
+begin
+ Result := False;
+ FErrorMsg := '';
+
+ p := TfsILParser.Create(Self);
+ try
+ p.SelectLanguage(FSyntaxType);
+ p.ILScript.LoadFromStream(Stream);
+ p.ParseILScript;
+ finally
+ p.Free;
+ end;
+
+ if FErrorMsg = '' then
+ begin
+ Result := True;
+ FErrorPos := '';
+ end;
+end;
+
+procedure TfsScript.AddType(const TypeName: String; ParentType: TfsVarType);
+var
+ v: TfsTypeVariable;
+begin
+ if Find(TypeName) <> nil then Exit;
+ v := TfsTypeVariable.Create(TypeName, ParentType, '');
+ Add(TypeName, v);
+end;
+
+function TfsScript.AddClass(AClass: TClass; const Ancestor: String): TfsClassVariable;
+var
+ cl: TfsClassVariable;
+begin
+ Result := nil;
+ if Find(AClass.ClassName) <> nil then Exit;
+
+ Result := TfsClassVariable.Create(AClass, Ancestor);
+ Result.FProgram := Self;
+ Add(Result.Name, Result);
+
+ cl := TfsClassVariable(Find(Ancestor));
+ if cl <> nil then
+ Result.FDefProperty := cl.DefProperty;
+end;
+
+procedure TfsScript.AddConst(const Name, Typ: String; const Value: Variant);
+var
+ v: TfsVariable;
+begin
+ if Find(Name) <> nil then Exit;
+
+ v := TfsVariable.Create(Name, StrToVarType(Typ, Self), Typ);
+ v.Value := Value;
+ v.IsReadOnly := True;
+ Add(v.Name, v);
+end;
+
+procedure TfsScript.AddEnum(const Typ, Names: String);
+var
+ i: Integer;
+ v: TfsVariable;
+ sl: TStringList;
+begin
+ v := TfsVariable.Create(Typ, fvtEnum, Typ);
+ Add(v.Name, v);
+
+ sl := TStringList.Create;
+ sl.CommaText := Names;
+
+ try
+ for i := 0 to sl.Count - 1 do
+ begin
+ v := TfsVariable.Create(Trim(sl[i]), fvtEnum, Typ);
+ v.Value := i;
+ v.IsReadOnly := True;
+ Add(v.Name, v);
+ end;
+ finally
+ sl.Free;
+ end;
+end;
+
+procedure TfsScript.AddEnumSet(const Typ, Names: String);
+var
+ i, j: Integer;
+ v: TfsVariable;
+ sl: TStringList;
+begin
+ v := TfsVariable.Create(Typ, fvtEnum, Typ);
+ Add(v.Name, v);
+
+ sl := TStringList.Create;
+ sl.CommaText := Names;
+
+ try
+ j := 1;
+ for i := 0 to sl.Count - 1 do
+ begin
+ v := TfsVariable.Create(Trim(sl[i]), fvtEnum, Typ);
+ v.Value := j;
+ v.IsReadOnly := True;
+ Add(v.Name, v);
+ j := j * 2;
+ end;
+ finally
+ sl.Free;
+ end;
+end;
+
+procedure TfsScript.AddMethod(const Syntax: String; CallEvent: TfsCallMethodEvent;
+ const Category: String = ''; const Description: String = '');
+var
+ v: TfsMethodHelper;
+begin
+ v := TfsMethodHelper.Create(Syntax, Self);
+ v.FOnCall := CallEvent;
+ if Description = '' then
+ v.FDescription := v.Name else
+ v.FDescription := Description;
+ v.FCategory := Category;
+ Add(v.Name, v);
+end;
+
+procedure TfsScript.AddMethod(const Syntax: String; CallEvent: TfsCallMethodNewEvent;
+ const Category: String = ''; const Description: String = '');
+var
+ v: TfsMethodHelper;
+begin
+ v := TfsMethodHelper.Create(Syntax, Self);
+ v.FOnCallNew := CallEvent;
+ if Description = '' then
+ v.FDescription := v.Name else
+ v.FDescription := Description;
+ v.FCategory := Category;
+ Add(v.Name, v);
+end;
+
+procedure TfsScript.AddObject(const Name: String; Obj: TObject);
+begin
+ AddVariable(Name, Obj.ClassName, frxInteger(Obj));
+end;
+
+procedure TfsScript.AddVariable(const Name, Typ: String; const Value: Variant);
+var
+ v: TfsVariable;
+begin
+ if Find(Name) <> nil then Exit;
+
+ v := TfsVariable.Create(Name, StrToVarType(Typ, Self), Typ);
+ v.Value := Value;
+ v.OnGetVarValue := FOnGetVarValue;
+ Add(v.Name, v);
+end;
+
+procedure TfsScript.AddForm(Form: TComponent);
+begin
+ AddComponent(Form);
+end;
+
+procedure TfsScript.AddComponent(Form: TComponent);
+{$IFNDEF NOFORMS}
+var
+ i: Integer;
+ v: TfsClassVariable;
+{$ENDIF}
+begin
+{$IFNDEF NOFORMS}
+ v := FindClass(Form.ClassName);
+ if v = nil then
+ begin
+ if Form.InheritsFrom(TForm) then
+ AddClass(Form.ClassType, 'TForm')
+ else if Form.InheritsFrom(TDataModule) then
+ AddClass(Form.ClassType, 'TDataModule')
+{$IFNDEF FMX}
+{$IFDEF Delphi5}
+ else if Form.InheritsFrom(TFrame) then
+ AddClass(Form.ClassType, 'TFrame')
+{$ENDIF}
+{$ENDIF}
+ else
+ Exit;
+ v := FindClass(Form.ClassName);
+ end;
+
+ for i := 0 to Form.ComponentCount - 1 do
+ v.AddComponent(Form.Components[i]);
+ AddObject(Form.Name, Form);
+{$ENDIF}
+end;
+
+procedure TfsScript.AddRTTI;
+var
+ i: Integer;
+ rtti: TfsRTTIModule;
+ obj: TClass;
+begin
+ if FRTTIAdded then Exit;
+
+ AddedBy := TObject(1); // do not clear
+ for i := 0 to FRTTIModules.Count - 1 do
+ begin
+ obj := TClass(FRTTIModules[i]);
+ rtti := TfsRTTIModule(obj.NewInstance);
+ rtti.Create(Self);
+ Add('', rtti);
+ end;
+ AddedBy := nil;
+
+ FRTTIAdded := True;
+end;
+
+procedure TfsScript.ClearRTTI;
+var
+ i: Integer;
+ item: TObject;
+begin
+ if not FRTTIAdded then Exit;
+
+ i := 0;
+ while i < FItems.Count do
+ begin
+ item := FItems.Objects[i];
+ if (item is TfsRTTIModule) or
+ ((item is TfsCustomVariable) and
+ (TfsCustomVariable(item).AddedBy = TObject(1))) then
+ begin
+ item.Free;
+ FItems.Delete(i);
+ end
+ else
+ Inc(i);
+ end;
+
+ FRTTIAdded := False;
+end;
+
+function TfsScript.CallFunction(const Name: String; const Params: Variant; sGlobal: Boolean): Variant;
+var
+ i, StackIndex: Integer;
+ v: TfsCustomVariable;
+ p: TfsProcVariable;
+begin
+ if sGlobal then
+ v := Find(Name)
+ else
+ v := FindLocal(Name);
+ if (v <> nil) and (v is TfsProcVariable) then
+ begin
+ p := TfsProcVariable(v);
+
+ StackIndex := -1;
+ if p.Executing then
+ StackIndex := p.SaveLocalVariables;
+ try
+ if VarIsArray(Params) then
+ for i := 0 to VarArrayHighBound(Params, 1) do
+ p.Params[i].Value := Params[i];
+ Result := p.Value;
+ finally
+ p.RestoreLocalVariables(StackIndex, True);
+ end;
+ end
+ else
+ begin
+ Result := Null;
+ end
+end;
+
+function TfsScript.CallFunction1(const Name: String; var Params: Variant; sGlobal: Boolean): Variant;
+var
+ i, StackIndex: Integer;
+ v: TfsCustomVariable;
+ p: TfsProcVariable;
+begin
+ if sGlobal then
+ v := Find(Name)
+ else
+ v := FindLocal(Name);
+ if (v <> nil) and (v is TfsProcVariable) then
+ begin
+ p := TfsProcVariable(v);
+
+ StackIndex := -1;
+ if p.Executing then
+ StackIndex := p.SaveLocalVariables;
+ try
+ if VarIsArray(Params) then
+ for i := 0 to VarArrayHighBound(Params, 1) do
+ p.Params[i].Value := Params[i];
+ Result := p.Value;
+ if VarIsArray(Params) then
+ for i := 0 to VarArrayHighBound(Params, 1) do
+ Params[i] := p.Params[i].Value;
+ finally
+ p.RestoreLocalVariables(StackIndex, True);
+ end;
+ end
+ else
+ Result := Null;
+end;
+
+function TfsScript.CallFunction2(const Func: TfsProcVariable; const Params: Variant): Variant;
+var
+ i, StackIndex: Integer;
+begin
+ if (Func <> nil) then
+ begin
+ StackIndex := -1;
+ if Func.Executing then
+ StackIndex := Func.SaveLocalVariables;
+ try
+ if VarIsArray(Params) then
+ for i := 0 to VarArrayHighBound(Params, 1) do
+ Func.Params[i].Value := Params[i];
+ Result := Func.Value;
+ finally
+ Func.RestoreLocalVariables(StackIndex, True);
+ end;
+ end
+ else
+ begin
+ Result := Null;
+ end
+end;
+
+function TfsScript.Evaluate(const Expression: String): Variant;
+var
+ p: TfsScript;
+ Prog: TfsScript;
+ SaveEvent: TfsRunLineEvent;
+begin
+ FEvaluteRiseError := False;
+ Result := Null;
+ if FProgRunning = nil then
+ p := Self else
+ p := FProgRunning;
+
+ Prog := TfsScript.Create(nil);
+ if not p.FRTTIAdded then
+ Prog.AddRTTI;
+ Prog.Parent := p;
+ Prog.OnGetVarValue := p.OnGetVarValue;
+ SaveEvent := FOnRunLine;
+ FOnRunLine := nil;
+ try
+ prog.SyntaxType := SyntaxType;
+ if CompareText(SyntaxType, 'PascalScript') = 0 then
+ Prog.Lines.Text := 'function fsEvaluateFUNC: Variant; begin Result := ' + Expression + ' end; begin end.'
+ else if CompareText(SyntaxType, 'C++Script') = 0 then
+ Prog.Lines.Text := 'Variant fsEvaluateFUNC() { return ' + Expression + '; } {}'
+ else if CompareText(SyntaxType, 'BasicScript') = 0 then
+ Prog.Lines.Text := 'function fsEvaluateFUNC' + #13#10 + 'return ' + Expression + #13#10 + 'end function'
+ else if CompareText(SyntaxType, 'JScript') = 0 then
+ Prog.Lines.Text := 'function fsEvaluateFUNC() { return (' + Expression + '); }';
+ if not Prog.Compile then
+ begin
+ Result := Prog.ErrorMsg;
+ FEvaluteRiseError := True;
+ end
+ else
+ Result := Prog.FindLocal('fsEvaluateFUNC').Value;
+ finally
+ Prog.Free;
+ FOnRunLine := SaveEvent;
+ end;
+end;
+
+function TfsScript.FindClass(const Name: String): TfsClassVariable;
+var
+ Item: TfsCustomVariable;
+begin
+ Item := Find(Name);
+ if (Item <> nil) and (Item is TfsClassVariable) then
+ Result := TfsClassVariable(Item) else
+ Result := nil
+end;
+
+procedure TfsScript.RunLine(const UnitName, Index: String);
+var
+ p: TfsScript;
+begin
+ p := Self;
+ while p <> nil do
+ if Assigned(p.FOnRunLine) then
+ begin
+ p.FOnRunLine(Self, UnitName, Index);
+ break;
+ end
+ else
+ p := p.FParent;
+end;
+
+function TfsScript.GetVariables(Index: String): Variant;
+var
+ v: TfsCustomVariable;
+begin
+ v := Find(Index);
+ if v <> nil then
+ Result := v.Value else
+ Result := Null;
+end;
+
+procedure TfsScript.SetVariables(Index: String; const Value: Variant);
+var
+ v: TfsCustomVariable;
+begin
+ v := Find(Index);
+ if v <> nil then
+ v.Value := Value else
+ AddVariable(Index, 'Variant', Value);
+end;
+
+procedure TfsScript.SetLines(const Value: TStrings);
+begin
+ FLines.Assign(Value);
+end;
+
+procedure TfsScript.SetProgName(const Value: String);
+begin
+ if Assigned(FProgRunning) then
+ FProgRunning.FProgName := Value
+ else
+ FProgName := Value;
+end;
+
+procedure TfsScript.Terminate;
+
+ procedure TerminateAll(Script: TfsScript);
+ var
+ i: Integer;
+ begin
+ Script.FExitCalled := True;
+ Script.FTerminated := True;
+ for i := 0 to Script.Count - 1 do
+ if Script.Items[i] is TfsProcVariable then
+ TerminateAll(TfsProcVariable(Script.Items[i]).Prog);
+ end;
+
+begin
+ TerminateAll(Self);
+end;
+
+procedure TfsScript.AddCodeLine(const UnitName, APos: String);
+var
+ sl: TStringList;
+ LineN: String;
+ i : Integer;
+begin
+ i := FUnitLines.IndexOf(UnitName);
+
+ if (i = -1) then
+ begin
+ sl := TStringList.Create;
+ sl.Sorted := True;
+ FUnitLines.AddObject(UnitName, sl);
+ end else
+ begin
+ sl := TStringList(FUnitLines.Objects[i]);
+ end;
+
+ LineN := Copy(APos, 1, Pos(':', APos) - 1);
+ if sl.IndexOf(LineN) = -1 then
+ begin
+ sl.Add(LineN);
+ end;
+end;
+
+function TfsScript.IsExecutableLine(LineN: Integer; const UnitName: String = ''): Boolean;
+var
+ sl: TStringList;
+ i: Integer;
+begin
+ Result := False;
+
+ i := FUnitLines.IndexOf(UnitName);
+ if (i = -1) then Exit;
+
+ sl := TStringList(FUnitLines.Objects[i]);
+ if sl.IndexOf(IntToStr(LineN)) <> -1 then
+ Result := True;
+end;
+
+
+
+
+{ TfsStatement }
+
+constructor TfsStatement.Create(AProgram: TfsScript; const UnitName,
+ SourcePos: String);
+begin
+ inherited Create;
+ FProgram := AProgram;
+ FSourcePos := SourcePos;
+ FUnitName := UnitName;
+end;
+
+function TfsStatement.GetItem(Index: Integer): TfsStatement;
+begin
+ Result := FItems[Index];
+end;
+
+procedure TfsStatement.Execute;
+var
+ i: Integer;
+begin
+ FProgram.ErrorPos := '';
+ for i := 0 to Count - 1 do
+ begin
+ if FProgram.FTerminated then break;
+ try
+ FProgram.FLastSourcePos := Items[i].FSourcePos;
+ Items[i].Execute;
+ except
+ on E: Exception do
+ begin
+ if FProgram.ErrorPos = '' then
+ FProgram.ErrorPos := FProgram.FLastSourcePos;
+ raise;
+ end;
+ end;
+ if FProgram.FBreakCalled or FProgram.FContinueCalled or
+ FProgram.FExitCalled then break;
+ end;
+end;
+
+procedure TfsStatement.RunLine;
+begin
+ FProgram.RunLine(FUnitName, FSourcePos);
+end;
+
+
+{ TfsAssignmentStmt }
+
+destructor TfsAssignmentStmt.Destroy;
+begin
+ FDesignator.Free;
+ FExpression.Free;
+ inherited;
+end;
+
+procedure TfsAssignmentStmt.Optimize;
+begin
+ FVar := FDesignator;
+ FExpr := FExpression;
+
+ if FDesignator is TfsVariableDesignator then
+ FVar := FDesignator.RefItem;
+ if TfsExpression(FExpression).SingleItem <> nil then
+ FExpr := TfsExpression(FExpression).SingleItem;
+end;
+
+procedure TfsAssignmentStmt.Execute;
+begin
+ RunLine;
+ if FProgram.FTerminated then Exit;
+ FVar.Value := FExpr.Value;
+end;
+
+procedure TfsAssignPlusStmt.Execute;
+begin
+ RunLine;
+ if FProgram.FTerminated then Exit;
+ FVar.Value := FVar.Value + FExpr.Value;
+end;
+
+procedure TfsAssignMinusStmt.Execute;
+begin
+ RunLine;
+ if FProgram.FTerminated then Exit;
+ FVar.Value := FVar.Value - FExpr.Value;
+end;
+
+procedure TfsAssignMulStmt.Execute;
+begin
+ RunLine;
+ if FProgram.FTerminated then Exit;
+ FVar.Value := FVar.Value * FExpr.Value;
+end;
+
+procedure TfsAssignDivStmt.Execute;
+begin
+ RunLine;
+ if FProgram.FTerminated then Exit;
+ FVar.Value := FVar.Value / FExpr.Value;
+end;
+
+
+{ TfsCallStmt }
+
+destructor TfsCallStmt.Destroy;
+begin
+ FDesignator.Free;
+ inherited;
+end;
+
+procedure TfsCallStmt.Execute;
+begin
+ RunLine;
+ if FProgram.FTerminated then Exit;
+ if FModificator = '' then
+ begin
+ FDesignator.NeedResult := False;
+ FDesignator.Value;
+ end
+ else if FModificator = '+' then
+ FDesignator.Value := FDesignator.Value + 1
+ else if FModificator = '-' then
+ FDesignator.Value := FDesignator.Value - 1
+end;
+
+
+{ TfsIfStmt }
+
+constructor TfsIfStmt.Create(AProgram: TfsScript; const UnitName,
+ SourcePos: String);
+begin
+ inherited;
+ FElseStmt := TfsStatement.Create(FProgram, UnitName, SourcePos);
+end;
+
+destructor TfsIfStmt.Destroy;
+begin
+ FCondition.Free;
+ FElseStmt.Free;
+ inherited;
+end;
+
+procedure TfsIfStmt.Execute;
+begin
+ RunLine;
+ if FProgram.FTerminated then Exit;
+ if Boolean(FCondition.Value) = True then
+ inherited Execute else
+ FElseStmt.Execute;
+end;
+
+
+{ TfsRepeatStmt }
+
+destructor TfsRepeatStmt.Destroy;
+begin
+ FCondition.Free;
+ inherited;
+end;
+
+procedure TfsRepeatStmt.Execute;
+begin
+ RunLine;
+ if FProgram.FTerminated then Exit;
+
+ repeat
+ inherited Execute;
+ if FProgram.FBreakCalled or FProgram.FExitCalled then break;
+ FProgram.FContinueCalled := False;
+ until Boolean(FCondition.Value) = not FInverseCondition;
+
+ FProgram.FBreakCalled := False;
+end;
+
+
+{ TfsWhileStmt }
+
+destructor TfsWhileStmt.Destroy;
+begin
+ FCondition.Free;
+ inherited;
+end;
+
+procedure TfsWhileStmt.Execute;
+begin
+ RunLine;
+ if FProgram.FTerminated then Exit;
+
+ while Boolean(FCondition.Value) = True do
+ begin
+ inherited Execute;
+ if FProgram.FBreakCalled or FProgram.FExitCalled then break;
+ FProgram.FContinueCalled := False;
+ end;
+
+ FProgram.FBreakCalled := False;
+end;
+
+
+{ TfsForStmt }
+
+destructor TfsForStmt.Destroy;
+begin
+ FBeginValue.Free;
+ FEndValue.Free;
+ inherited;
+end;
+
+procedure TfsForStmt.Execute;
+var
+ i, bValue, eValue: Integer;
+begin
+ try
+ bValue := FBeginValue.Value;
+ eValue := FEndValue.Value;
+ finally
+ RunLine;
+ end;
+ if FProgram.FTerminated then Exit;
+
+ if FDown then
+ for i := bValue downto eValue do
+ begin
+ FVariable.FValue := i;
+ inherited Execute;
+ if FProgram.FBreakCalled or FProgram.FExitCalled then break;
+ FProgram.FContinueCalled := False;
+ end
+ else
+ for i := bValue to eValue do
+ begin
+ FVariable.FValue := i;
+ inherited Execute;
+ if FProgram.FBreakCalled or FProgram.FExitCalled then break;
+ FProgram.FContinueCalled := False;
+ end;
+
+ FProgram.FBreakCalled := False;
+end;
+
+
+{ TfsVbForStmt }
+
+destructor TfsVbForStmt.Destroy;
+begin
+ FBeginValue.Free;
+ FEndValue.Free;
+ if FStep <> nil then
+ FStep.Free;
+ inherited;
+end;
+
+procedure TfsVbForStmt.Execute;
+var
+ i, bValue, eValue, sValue: Variant;
+ Down: Boolean;
+begin
+ bValue := FBeginValue.Value;
+ eValue := FEndValue.Value;
+ if FStep <> nil then
+ sValue := FStep.Value else
+ sValue := 1;
+ Down := sValue < 0;
+
+ RunLine;
+ if FProgram.FTerminated then Exit;
+ i := bValue;
+ if Down then
+ while i >= eValue do
+ begin
+ FVariable.FValue := i;
+ inherited Execute;
+ if FProgram.FBreakCalled or FProgram.FExitCalled then break;
+ FProgram.FContinueCalled := False;
+ i := i + sValue;
+ end
+ else
+ while i <= eValue do
+ begin
+ FVariable.FValue := i;
+ inherited Execute;
+ if FProgram.FBreakCalled or FProgram.FExitCalled then break;
+ FProgram.FContinueCalled := False;
+ i := i + sValue;
+ end;
+
+ FProgram.FBreakCalled := False;
+end;
+
+
+{ TfsCppForStmt }
+
+constructor TfsCppForStmt.Create(AProgram: TfsScript; const UnitName,
+ SourcePos: String);
+begin
+ inherited;
+ FFirstStmt := TfsStatement.Create(FProgram, UnitName, SourcePos);
+ FSecondStmt := TfsStatement.Create(FProgram, UnitName, SourcePos);
+end;
+
+destructor TfsCppForStmt.Destroy;
+begin
+ FFirstStmt.Free;
+ FExpression.Free;
+ FSecondStmt.Free;
+ inherited;
+end;
+
+procedure TfsCppForStmt.Execute;
+begin
+ RunLine;
+ if FProgram.FTerminated then Exit;
+ FFirstStmt.Execute;
+ if FProgram.FTerminated then Exit;
+ while Boolean(FExpression.Value) = True do
+ begin
+ inherited Execute;
+ if FProgram.FBreakCalled or FProgram.FExitCalled then break;
+ FProgram.FContinueCalled := False;
+ FSecondStmt.Execute;
+ end;
+
+ FProgram.FBreakCalled := False;
+end;
+
+
+{ TfsCaseSelector }
+
+destructor TfsCaseSelector.Destroy;
+begin
+ FSetExpression.Free;
+ inherited;
+end;
+
+function TfsCaseSelector.Check(const Value: Variant): Boolean;
+begin
+ Result := FSetExpression.Check(Value);
+end;
+
+
+{ TfsCaseStmt }
+
+constructor TfsCaseStmt.Create(AProgram: TfsScript; const UnitName,
+ SourcePos: String);
+begin
+ inherited;
+ FElseStmt := TfsStatement.Create(FProgram, UnitName, SourcePos);
+end;
+
+destructor TfsCaseStmt.Destroy;
+begin
+ FCondition.Free;
+ FElseStmt.Free;
+ inherited;
+end;
+
+procedure TfsCaseStmt.Execute;
+var
+ i: Integer;
+ Value: Variant;
+ Executed: Boolean;
+begin
+ Value := FCondition.Value;
+ Executed := False;
+
+ RunLine;
+ if FProgram.FTerminated then Exit;
+ for i := 0 to Count - 1 do
+ if TfsCaseSelector(Items[i]).Check(Value) then
+ begin
+ Items[i].Execute;
+ Executed := True;
+ break;
+ end;
+
+ if not Executed then
+ FElseStmt.Execute;
+end;
+
+
+{ TfsTryStmt }
+
+constructor TfsTryStmt.Create(AProgram: TfsScript; const UnitName,
+ SourcePos: String);
+begin
+ inherited;
+ FExceptStmt := TfsStatement.Create(AProgram, UnitName, SourcePos);
+end;
+
+destructor TfsTryStmt.Destroy;
+begin
+ FExceptStmt.Free;
+ inherited;
+end;
+
+procedure TfsTryStmt.Execute;
+var
+ SaveExitCalled: Boolean;
+begin
+ RunLine;
+ if FProgram.FTerminated then Exit;
+ if IsExcept then
+ begin
+ try
+ inherited Execute;
+ except
+ on E: Exception do
+ begin
+ FProgram.SetVariables('ExceptionClassName', E.ClassName);
+ FProgram.SetVariables('ExceptionMessage', E.Message);
+ FProgram.ErrorPos := FProgram.FLastSourcePos;
+ ExceptStmt.Execute;
+ end;
+ end;
+ end
+ else
+ begin
+ try
+ inherited Execute;
+ finally
+ SaveExitCalled := FProgram.FExitCalled;
+ FProgram.FExitCalled := False;
+ ExceptStmt.Execute;
+ FProgram.FExitCalled := SaveExitCalled;
+ end
+ end;
+end;
+
+{ TfsBreakStmt }
+
+procedure TfsBreakStmt.Execute;
+begin
+ FProgram.FBreakCalled := True;
+end;
+
+
+{ TfsContinueStmt }
+
+procedure TfsContinueStmt.Execute;
+begin
+ FProgram.FContinueCalled := True;
+end;
+
+
+{ TfsExitStmt }
+
+procedure TfsExitStmt.Execute;
+begin
+ RunLine;
+ FProgram.FExitCalled := True;
+end;
+
+
+{ TfsWithStmt }
+
+destructor TfsWithStmt.Destroy;
+begin
+ FDesignator.Free;
+ inherited;
+end;
+
+procedure TfsWithStmt.Execute;
+begin
+ inherited;
+ FVariable.Value := FDesignator.Value;
+end;
+
+
+{ TfsArrayHelper }
+
+constructor TfsArrayHelper.Create(const AName: String; DimCount: Integer;
+ Typ: TfsVarType; const TypeName: String);
+var
+ i: Integer;
+begin
+ inherited Create(AName, Typ, TypeName);
+
+ if DimCount <> -1 then
+ begin
+ for i := 0 to DimCount - 1 do
+{$IFDEF CPUX64}
+ Add(TfsParamItem.Create('', fvtInt64, '', False, False));
+{$ELSE}
+ Add(TfsParamItem.Create('', fvtInt, '', False, False));
+{$ENDIF}
+ end
+ else
+ for i := 0 to 2 do
+{$IFDEF CPUX64}
+ Add(TfsParamItem.Create('', fvtInt64, '', i > 0, False));
+{$ELSE}
+ Add(TfsParamItem.Create('', fvtInt, '', i > 0, False));
+{$ENDIF}
+end;
+
+destructor TfsArrayHelper.Destroy;
+begin
+ inherited;
+end;
+
+function TfsArrayHelper.GetValue: Variant;
+var
+ DimCount: Integer;
+begin
+ DimCount := VarArrayDimCount(ParentRef.PValue^);
+ case DimCount of
+ 1: Result := ParentRef.PValue^[Params[0].Value];
+ 2: Result := ParentRef.PValue^[Params[0].Value, Params[1].Value];
+ 3: Result := ParentRef.PValue^[Params[0].Value, Params[1].Value, Params[2].Value];
+ else
+ Result := Null;
+ end;
+end;
+
+procedure TfsArrayHelper.SetValue(const Value: Variant);
+var
+ DimCount: Integer;
+begin
+ DimCount := VarArrayDimCount(ParentRef.PValue^);
+ case DimCount of
+ 1: ParentRef.PValue^[Params[0].Value] := Value;
+ 2: ParentRef.PValue^[Params[0].Value, Params[1].Value] := Value;
+ 3: ParentRef.PValue^[Params[0].Value, Params[1].Value, Params[2].Value] := Value;
+ end;
+end;
+
+
+{ TfsStringHelper }
+
+constructor TfsStringHelper.Create;
+begin
+ inherited Create('__StringHelper', fvtChar, '');
+ Add(TfsParamItem.Create('', fvtInt, '', False, False));
+end;
+
+function TfsStringHelper.GetValue: Variant;
+begin
+ Result := String(ParentValue)[Integer(Params[0].Value)];
+end;
+
+procedure TfsStringHelper.SetValue(const Value: Variant);
+var
+ s: String;
+begin
+ s := ParentValue;
+ s[Integer(Params[0].Value)] := String(Value)[1];
+ TfsCustomVariable(frxInteger(ParentRef)).Value := s;
+end;
+
+
+{ TfsCustomEvent }
+
+constructor TfsCustomEvent.Create(AObject: TObject; AHandler: TfsProcVariable);
+begin
+ FInstance := AObject;
+ FHandler := AHandler;
+end;
+
+procedure TfsCustomEvent.CallHandler(Params: array of const);
+var
+ i, StackIndex: Integer;
+begin
+ StackIndex := -1;
+ if FHandler.Executing then
+ StackIndex := FHandler.SaveLocalVariables;
+ try
+ for i := 0 to FHandler.Count - 1 do
+ FHandler.Params[i].Value := VarRecToVariant(Params[i]);
+ FHandler.Value;
+ finally
+ FHandler.RestoreLocalVariables(StackIndex, True);
+ end;
+end;
+
+
+{ TfsRTTIModule }
+
+constructor TfsRTTIModule.Create(AScript: TfsScript);
+begin
+ FScript := AScript;
+end;
+
+
+function fsGlobalUnit: TfsScript;
+begin
+ if (FGlobalUnit = nil) and not FGlobalUnitDestroyed then
+ begin
+ FGlobalUnit := TfsScript.Create(nil);
+ FGlobalUnit.AddRTTI;
+ end;
+ Result := FGlobalUnit;
+end;
+
+function fsIsGlobalUnitExist: Boolean;
+begin
+ Result := Assigned(FGlobalUnit);
+end;
+
+function fsRTTIModules: TList;
+begin
+ if (FRTTIModules = nil) and not FRTTIModulesDestroyed then
+ begin
+ FRTTIModules := TList.Create;
+ FRTTIModules.Add(TfsSysFunctions);
+ end;
+ Result := FRTTIModules;
+end;
+
+{ TfsVariable }
+
+function TfsVariable.GetValue: Variant;
+begin
+ Result := inherited GetValue;
+ if Assigned(FOnGetVarValue) then
+ begin
+ Result := FOnGetVarValue(FName, FTyp, FValue);
+ if Result = null then Result := FValue;
+ end;
+end;
+
+procedure TfsVariable.SetValue(const Value: Variant);
+begin
+ if not FIsReadOnly then
+ case FTyp of
+ fvtInt: FValue := VarAsType(Value, varInteger);
+{$IFDEF FS_INT64}
+ fvtInt64: FValue := VarAsType(Value, varInt64);
+{$ENDIF}
+ fvtBool: FValue := VarAsType(Value, varBoolean);
+ fvtFloat:
+ if (VarType(Value) = varDate) then
+ FValue := VarAsType(Value, varDate)
+ else
+ FValue := VarAsType(Value, varDouble);
+{$IFDEF Delphi12}
+ fvtString: FValue := VarAsType(Value, varUString);
+{$ELSE}
+ fvtString: FValue := VarAsType(Value, varString);
+{$ENDIF}
+ else
+ FValue := Value;
+ end;
+end;
+
+initialization
+{$IFDEF FMX}
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsScript, TFmxObject);
+{$ELSE}
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsScript, TControl);
+{$ENDIF}
+{$ENDIF}
+ FGlobalUnitDestroyed := False;
+ FRTTIModulesDestroyed := False;
+ fsRTTIModules;
+
+finalization
+ if FGlobalUnit <> nil then
+ FGlobalUnit.Free;
+ FGlobalUnit := nil;
+ FGlobalUnitDestroyed := True;
+ FRTTIModules.Free;
+ FRTTIModules := nil;
+ FRTTIModulesDestroyed := True;
+
+end.
\ No newline at end of file
diff --git a/FastScript/fs_ijs.pas b/FastScript/fs_ijs.pas
new file mode 100644
index 0000000..5c6a50d
--- /dev/null
+++ b/FastScript/fs_ijs.pas
@@ -0,0 +1,168 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ JScript grammar }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_ijs;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_itools{$IFDEF DELPHI16}, Controls{$ENDIF};
+{$ELSE}
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_itools, FMX.Types;
+{$ENDIF}
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsJScript = class(TComponent);
+
+
+implementation
+
+const
+ JS_GRAMMAR =
+ '' +
+ '' +
+ '<' +
+ 'loop text=","><' +
+ 'char text="!" add="op" addtext="not"/>' +
+ '<' +
+ 'char text="-" add="op"/><' +
+ 'expression err="err2"/>' +
+ '<' +
+ 'forstmtitem/>';
+
+
+initialization
+{$IFDEF DELPHI16}
+{$IFDEF FMX}
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsJScript, TFmxObject);
+{$ELSE}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsJScript, TControl);
+{$ENDIF}
+{$ENDIF}
+ fsRegisterLanguage('JScript', JS_GRAMMAR);
+
+end.
diff --git a/FastScript/fs_imenusrtti.pas b/FastScript/fs_imenusrtti.pas
new file mode 100644
index 0000000..c82f935
--- /dev/null
+++ b/FastScript/fs_imenusrtti.pas
@@ -0,0 +1,183 @@
+{**********************************************}
+{ }
+{ FastScript v1.9 }
+{ Menus }
+{ }
+{ Copyright (c) 1998-2007 }
+{ by Fast Reports Inc. }
+{ }
+{ Copyright (c) 2006 by }
+{ Copyright (c) 2006-2007 by Stalker SoftWare }
+{ }
+{**********************************************}
+
+unit fs_imenusrtti;
+
+interface
+
+{$I fs.inc}
+
+uses
+ SysUtils, Classes, Menus, fs_iinterpreter, fs_ievents, ImgList{$IFDEF DELPHI16}, Controls{$ENDIF}
+{$IFDEF Delphi6}
+, Types , Variants
+{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsMenusRTTI = class(TComponent); // fake component
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass; const MethodName:
+ string; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass; const PropName:
+ string): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass; const PropName:
+ string; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+
+ with AScript do
+ begin
+
+ AddType('TPopupAlignment', fvtInt);
+
+ AddClass(TCustomImageList, 'TComponent');
+
+ with AddClass(TMenuItem, 'TComponent') do
+ begin
+ AddMethod('procedure Add(Item: TMenuItem)', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure Delete(Index: Integer)', CallMethod);
+ AddMethod('procedure Insert(Index: Integer; Item: TMenuItem)',
+ CallMethod);
+ AddMethod('procedure Remove(Item: TMenuItem)', CallMethod);
+ AddMethod('function GetParentMenu: TMenu', CallMethod);
+ AddEvent('OnClick', TfsNotifyEvent);
+ AddProperty('Count', 'Integer', GetProp);
+ AddDefaultProperty('Items', 'Integer', 'TMenuItem', CallMethod, True);
+ end; { with }
+
+ with AddClass(TMenu, 'TComponent') do
+ AddIndexProperty('Items', 'Integer', 'TMenuItem', CallMethod, True);
+
+ with AddClass(TPopupMenu, 'TMenu') do
+ begin
+ AddEvent('OnPopup', TfsNotifyEvent);
+ AddMethod('procedure Popup(X, Y: Extended)', CallMethod);
+ AddProperty('PopupComponent', 'TComponent', GetProp, SetProp);
+ AddProperty('Images', 'TCustomImageList', GetProp, SetProp);
+ end; { with }
+
+ end; { with }
+
+end; { Create }
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; const
+ MethodName: string; Caller: TfsMethodHelper): Variant;
+var
+ oMenuItem: TMenuItem;
+begin
+ Result := 0;
+
+ if ClassType = TMenuItem then
+ begin
+
+ oMenuItem := TMenuItem(Instance);
+
+ if MethodName = 'ADD' then
+ oMenuItem.Add(TMenuItem(frxInteger(Caller.Params[0])))
+{$IFDEF Delphi5}
+ else if MethodName = 'CLEAR' then
+ oMenuItem.Clear
+{$ENDIF}
+ else if MethodName = 'DELETE' then
+ oMenuItem.Delete(Caller.Params[0])
+ else if MethodName = 'INSERT' then
+ oMenuItem.Insert(Caller.Params[0], TMenuItem(frxInteger(Caller.Params[1])))
+ else if MethodName = 'REMOVE' then
+ oMenuItem.Remove(TMenuItem(frxInteger(Caller.Params[0])))
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(oMenuItem.Items[Caller.Params[0]])
+ else if MethodName = 'GETPARENTMENU' then
+ Result := frxInteger(oMenuItem.GetParentMenu());
+
+ end
+ else if ClassType = TMenu then
+ begin
+
+ if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TMenu(Instance).Items[Caller.Params[0]])
+
+ end
+ else if ClassType = TPopupMenu then
+ begin
+
+ if MethodName = 'POPUP' then
+ TPopupMenu(Instance).Popup(Caller.Params[0], Caller.Params[1]);
+
+ end; { if }
+
+end; { CallMethod }
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass; const
+ PropName: string): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TMenuItem then
+ begin
+
+ if PropName = 'COUNT' then
+ Result := TMenuItem(Instance).Count;
+
+ end
+ else if ClassType = TPopupMenu then
+ begin
+
+ if PropName = 'POPUPCOMPONENT' then
+ Result := frxInteger(TPopupMenu(Instance).PopupComponent)
+ else if PropName = 'IMAGES' then
+ Result := frxInteger(TPopupMenu(Instance).Images)
+
+ end; { if }
+
+end; { GetProp }
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass; const
+ PropName: string; Value: Variant);
+begin
+ if ClassType = TPopupMenu then
+ begin
+ if PropName = 'IMAGES' then
+ TPopupMenu(Instance).Images := TCustomImageList(frxInteger(Value))
+ else if PropName = 'POPUPCOMPONENT' then
+ TPopupMenu(Instance).PopupComponent := TComponent(frxInteger(Value))
+
+ end; { if }
+
+end; { SetProp }
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsMenusRTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
+
diff --git a/FastScript/fs_iparser.pas b/FastScript/fs_iparser.pas
new file mode 100644
index 0000000..cef63e1
--- /dev/null
+++ b/FastScript/fs_iparser.pas
@@ -0,0 +1,762 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Parser }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_iparser;
+
+interface
+
+{$i fs.inc}
+
+uses
+{$IFNDEF CROSS_COMPILE}
+ Windows,
+{$ENDIF}
+ SysUtils, Classes;
+//FMX uses
+{$ELSE}
+interface
+
+{$i fs.inc}
+
+uses
+ System.Types, FMX.Types, System.SysUtils, System.Classes;
+{$ENDIF}
+
+
+
+type
+ TfsIdentifierCharset = set of AnsiChar;
+
+ { TfsParser parser the source text and return such elements as identifiers,
+ keywords, punctuation, strings and numbers. }
+
+ TfsParser = class(TObject)
+ private
+ FCaseSensitive: Boolean;
+ FCommentBlock1: String;
+ FCommentBlock11: String;
+ FCommentBlock12: String;
+ FCommentBlock2: String;
+ FCommentBlock21: String;
+ FCommentBlock22: String;
+ FCommentLine1: String;
+ FCommentLine2: String;
+ FHexSequence: String;
+ FIdentifierCharset: TfsIdentifierCharset;
+ FKeywords: TStrings;
+ FLastPosition: Integer;
+ FPosition: Integer;
+ FSize: Integer;
+ FSkiPChar: String;
+ FSkipEOL: Boolean;
+ FSkipSpace: Boolean;
+ FStringQuotes: String;
+ FText: String;
+ FUseY: Boolean;
+ FYList: TList;
+ FSpecStrChar: Boolean;
+ function DoDigitSequence: Boolean;
+ function DoHexDigitSequence: Boolean;
+ function DoScaleFactor: Boolean;
+ function DoUnsignedInteger: Boolean;
+ function DoUnsignedReal: Boolean;
+ procedure SetPosition(const Value: Integer);
+ procedure SetText(const Value: String);
+ function Ident: String;
+ procedure SetCommentBlock1(const Value: String);
+ procedure SetCommentBlock2(const Value: String);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Clear;
+ procedure ConstructCharset(const s: String);
+
+ { skip all #0..#31 symbols }
+ procedure SkipSpaces;
+ { get EOL symbol }
+ function GetEOL: Boolean;
+ { get any valid ident except keyword }
+ function GetIdent: String;
+ { get any valid punctuation symbol like ,.;: }
+ function GetChar: String;
+ { get any valid ident or keyword }
+ function GetWord: String;
+ { get valid hex/int/float number }
+ function GetNumber: String;
+ { get valid quoted/control string like 'It''s'#13#10'working' }
+ function GetString: String;
+ { get FR-specific string - variable or db field like [main data."field 1"] }
+ function GetFRString: String;
+ { get Y:X position }
+ function GetXYPosition: String;
+ { get plain position from X:Y }
+ function GetPlainPosition(pt: TPoint): Integer;
+ { is this keyword? }
+ function IsKeyWord(const s: String): Boolean;
+
+ // Language-dependent elements
+ // For Pascal:
+ // CommentLine1 := '//';
+ // CommentBlock1 := '{,}';
+ // CommentBlock2 := '(*,*)';
+ // HexSequence := '$'
+ // IdentifierCharset := ['_', '0'..'9', 'a'..'z', 'A'..'Z'];
+ // Keywords: 'begin','end', ...
+ // StringQuotes := ''''
+ property CaseSensitive: Boolean read FCaseSensitive write FCaseSensitive;
+ property CommentBlock1: String read FCommentBlock1 write SetCommentBlock1;
+ property CommentBlock2: String read FCommentBlock2 write SetCommentBlock2;
+ property CommentLine1: String read FCommentLine1 write FCommentLine1;
+ property CommentLine2: String read FCommentLine2 write FCommentLine2;
+ property HexSequence: String read FHexSequence write FHexSequence;
+ property IdentifierCharset: TfsIdentifierCharset read FIdentifierCharset
+ write FIdentifierCharset;
+ property Keywords: TStrings read FKeywords;
+ property SkiPChar: String read FSkiPChar write FSkiPChar;
+ property SkipEOL: Boolean read FSkipEOL write FSkipEOL;
+ property SkipSpace: Boolean read FSkipSpace write FSkipSpace;
+ property StringQuotes: String read FStringQuotes write FStringQuotes;
+ property SpecStrChar: Boolean read FSpecStrChar write FSpecStrChar;
+ property UseY: Boolean read FUseY write FUseY;
+
+ { Current position }
+ property Position: Integer read FPosition write SetPosition;
+ { Text to parse }
+ property Text: String read FText write SetText;
+ end;
+
+
+implementation
+
+
+{ TfsParser }
+
+constructor TfsParser.Create;
+begin
+ FKeywords := TStringList.Create;
+ TStringList(FKeywords).Sorted := True;
+ FYList := TList.Create;
+ FUseY := True;
+ Clear;
+end;
+
+destructor TfsParser.Destroy;
+begin
+ FKeywords.Free;
+ FYList.Free;
+ inherited;
+end;
+
+procedure TfsParser.Clear;
+begin
+ FKeywords.Clear;
+ FSpecStrChar := False;
+ FCommentLine1 := '//';
+ CommentBlock1 := '{,}';
+ CommentBlock2 := '(*,*)';
+ FHexSequence := '$';
+ FIdentifierCharset := ['_', '0'..'9', 'a'..'z', 'A'..'Z'];
+ FSkipChar := '';
+ FSkipEOL := True;
+ FStringQuotes := '''';
+ FSkipSpace := True;
+end;
+
+procedure TfsParser.SetCommentBlock1(const Value: String);
+var
+ sl: TStringList;
+begin
+ FCommentBlock1 := Value;
+ FCommentBlock11 := '';
+ FCommentBlock12 := '';
+
+ sl := TStringList.Create;
+ sl.CommaText := FCommentBlock1;
+ if sl.Count > 0 then
+ FCommentBlock11 := sl[0];
+ if sl.Count > 1 then
+ FCommentBlock12 := sl[1];
+ sl.Free;
+end;
+
+procedure TfsParser.SetCommentBlock2(const Value: String);
+var
+ sl: TStringList;
+begin
+ FCommentBlock2 := Value;
+ FCommentBlock21 := '';
+ FCommentBlock22 := '';
+
+ sl := TStringList.Create;
+ sl.CommaText := FCommentBlock2;
+ if sl.Count > 0 then
+ FCommentBlock21 := sl[0];
+ if sl.Count > 1 then
+ FCommentBlock22 := sl[1];
+ sl.Free;
+end;
+
+procedure TfsParser.SetPosition(const Value: Integer);
+begin
+ FPosition := Value;
+ FLastPosition := Value;
+end;
+
+procedure TfsParser.SetText(const Value: String);
+var
+ i: Integer;
+begin
+ FText := Value + #0;
+ FLastPosition := 1;
+ FPosition := 1;
+ FSize := Length(Value);
+
+ if FUseY then
+ begin
+ FYList.Clear;
+ FYList.Add(TObject(0));
+ for i := 1 to FSize do
+ if FText[i] = #10 then
+ FYList.Add(TObject(i));
+ end;
+end;
+
+procedure TfsParser.ConstructCharset(const s: String);
+var
+ i: Integer;
+begin
+ FIdentifierCharset := [];
+ for i := 1 to Length(s) do
+ FIdentifierCharset := FIdentifierCharset + [s[i]];
+end;
+
+function TfsParser.GetEOL: Boolean;
+begin
+ SkipSpaces;
+{$IFDEF Delphi12}
+ if CharInSet(FText[FPosition], [#10, #13]) then
+{$ELSE}
+ if FText[FPosition] in [#10, #13] then
+{$ENDIF}
+ begin
+ Result := True;
+{$IFDEF Delphi12}
+ while CharInSet(FText[FPosition], [#10, #13]) do
+{$ELSE}
+ while FText[FPosition] in [#10, #13] do
+{$ENDIF}
+ Inc(FPosition);
+ end
+ else
+ Result := False;
+end;
+
+procedure TfsParser.SkipSpaces;
+var
+ s1, s2: String;
+ Flag, CLine: Boolean;
+ Spaces: set of AnsiChar;
+begin
+ Spaces := [#0..#32];
+ if not FSkipEOL then
+{$IFDEF Windows}
+ Spaces := Spaces - [#13];
+{$ELSE}
+ Spaces := Spaces - [#10];
+{$ENDIF}
+{$IFDEF Delphi12}
+ while (FPosition <= FSize) and (CharInSet(FText[FPosition], Spaces)) do
+{$ELSE}
+ while (FPosition <= FSize) and (FText[FPosition] in Spaces) do
+{$ENDIF}
+ Inc(FPosition);
+ { skip basic '_' }
+ if (FPosition <= FSize) and (FSkipChar <> '') and (FText[FPosition] = FSkipChar[1]) then
+ begin
+ Inc(FPosition);
+ GetEOL;
+ SkipSpaces;
+ end;
+
+ if FPosition < FSize then
+ begin
+ if FCommentLine1 <> '' then
+ s1 := Copy(FText, FPosition, Length(FCommentLine1)) else
+ s1 := ' ';
+ if FCommentLine2 <> '' then
+ s2 := Copy(FText, FPosition, Length(FCommentLine2)) else
+ s2 := ' ';
+
+ if (s1 = FCommentLine1) or (s2 = FCommentLine2) then
+ begin
+ CLine := (FPosition - 1 > 0) and (FText[FPosition - 1] <> #10) and not FSkipEOL;
+ while (FPosition <= FSize) and (FText[FPosition] <> #10) do
+ begin
+ if (FText[FPosition] = {$IFDEF LINUX}#10{$ELSE}#13{$ENDIF}) and CLine then break;
+ Inc(FPosition);
+ end;
+ SkipSpaces;
+ end
+ else
+ begin
+ Flag := False;
+
+ if FCommentBlock1 <> '' then
+ begin
+ s1 := Copy(FText, FPosition, Length(FCommentBlock11));
+ if s1 = FCommentBlock11 then
+ begin
+ Flag := True;
+ s2 := FCommentBlock12;
+ end;
+ end;
+
+ if not Flag and (FCommentBlock2 <> '') then
+ begin
+ s1 := Copy(FText, FPosition, Length(FCommentBlock21));
+ if s1 = FCommentBlock21 then
+ begin
+ Flag := True;
+ s2 := FCommentBlock22;
+ end;
+ end;
+
+ if Flag then
+ begin
+ Inc(FPosition, Length(s2));
+ while (FPosition <= FSize) and (Copy(FText, FPosition, Length(s2)) <> s2) do
+ Inc(FPosition);
+ Inc(FPosition, Length(s2));
+ SkipSpaces;
+ end;
+ end;
+ end;
+
+ FLastPosition := FPosition;
+end;
+
+function TfsParser.Ident: String;
+begin
+ if FSkipSpace then
+ SkipSpaces;
+{$IFDEF Delphi12}
+ if (CharInSet(FText[FPosition], FIdentifierCharset - ['0'..'9']))
+ or ((FText[FPosition] >= Char($007F)) and (FText[FPosition] <= Char($FFFF))) then
+ begin
+ while CharInSet(FText[FPosition], FIdentifierCharset)
+ or ((FText[FPosition] >= Char($007F)) and (FText[FPosition] <= Char($FFFF))) do
+{$ELSE}
+ if (FText[FPosition] in FIdentifierCharset) and not (FText[FPosition] in ['0'..'9']) then
+ begin
+ while (FText[FPosition] in FIdentifierCharset) do
+{$ENDIF}
+ Inc(FPosition);
+ Result := Copy(FText, FLastPosition, FPosition - FLastPosition);
+ end
+ else
+ Result := '';
+end;
+
+function TfsParser.IsKeyWord(const s: String): Boolean;
+var
+ i: Integer;
+begin
+ if FCaseSensitive then
+ begin
+ Result := False;
+ for i := 0 to FKeywords.Count - 1 do
+ begin
+ Result := FKeywords[i] = s;
+ if Result then break;
+ end;
+ end
+ else
+ Result := FKeywords.IndexOf(s) <> -1;
+end;
+
+function TfsParser.GetIdent: String;
+begin
+ Result := Ident;
+ if IsKeyWord(Result) then
+ Result := '';
+end;
+
+function TfsParser.GetWord: String;
+begin
+ Result := Ident;
+end;
+
+function TfsParser.GetChar: String;
+begin
+{$IFDEF Delphi12}
+ if CharInSet(FText[FPosition], ['!', '@', '#', '$', '%', '^', '&', '|', '\',
+ '.', ',', ':', ';', '?', '''', '"', '~', '`', '_', '[', ']', '{', '}',
+ '(', ')', '+', '-', '*', '/', '=', '<', '>']) then
+{$ELSE}
+ if FText[FPosition] in ['!', '@', '#', '$', '%', '^', '&', '|', '\',
+ '.', ',', ':', ';', '?', '''', '"', '~', '`', '_', '[', ']', '{', '}',
+ '(', ')', '+', '-', '*', '/', '=', '<', '>'] then
+{$ENDIF}
+ begin
+ Result := FText[FPosition];
+ Inc(FPosition);
+ end
+ else
+ Result := '';
+end;
+
+function TfsParser.GetString: String;
+var
+ Flag: Boolean;
+ Str: String;
+ FError: Boolean;
+ FCpp: Boolean;
+
+ function DoQuotedString: Boolean;
+ var
+ i, j: Integer;
+ begin
+ Result := False;
+ i := FPosition;
+
+ if FText[FPosition] = FStringQuotes[1] then
+ begin
+ repeat
+ Inc(FPosition);
+
+ if FCpp and (FText[FPosition] = '\') then
+ begin
+ {$IFNDEF FPC}
+ {$IFDEF Delphi12}
+ case Lowercase(Char(FText[FPosition + 1]))[1] of
+ {$ELSE}
+ case Lowercase(FText[FPosition + 1])[1] of
+ {$ENDIF}
+ {$ELSE}
+ case Lowercase(FText[FPosition + 1]) of
+ {$ENDIF}
+ 'n':
+ begin
+ Str := Str + #10;
+ Inc(FPosition);
+ end;
+ 'r':
+ begin
+ Str := Str + #13;
+ Inc(FPosition);
+ end;
+ 'x':
+ begin
+ Inc(FPosition, 2);
+ j := FPosition;
+ Result := DoHexDigitSequence;
+ if Result then
+ Str := Str + Chr(StrToInt('$' + Copy(FText, j, FPosition - j))) else
+ FPosition := j;
+ Dec(FPosition);
+ end
+ else
+ begin
+ Str := Str + FText[FPosition + 1];
+ Inc(FPosition);
+ end;
+ end;
+ end
+ else if FText[FPosition] = FStringQuotes[1] then
+ begin
+ if not FCpp and (FText[FPosition + 1] = FStringQuotes[1]) then
+ begin
+ Str := Str + FStringQuotes[1];
+ Inc(FPosition);
+ end
+ else
+ break
+ end
+ else
+ Str := Str + FText[FPosition];
+{$IFDEF Delphi12}
+ until CharInSet(FText[FPosition], [#0..#31] - [#9]);
+{$ELSE}
+ until FText[FPosition] in [#0..#31] - [#9];
+{$ENDIF}
+ if FText[FPosition] = FStringQuotes[1] then
+ begin
+ Inc(FPosition);
+ Result := True;
+ end
+ else
+ FPosition := i;
+ end;
+ end;
+
+ function DoControlString: Boolean;
+ var
+ i: Integer;
+ begin
+ Result := False;
+ i := FPosition;
+
+ if FText[FPosition] = '#' then
+ begin
+ Inc(FPosition);
+ Result := DoUnsignedInteger;
+ if Result then
+ Str := Chr(StrToInt(Copy(FText, i + 1, FPosition - i - 1))) else
+ FPosition := i;
+ end;
+ end;
+{$HINTS OFF}
+begin
+ Result := '';
+ if FSkipSpace then
+ SkipSpaces;
+ Flag := True;
+ FError := False;
+ FCpp := {FStringQuotes = '"'} FSpecStrChar;
+
+ repeat
+ Str := '';
+ if DoQuotedString or DoControlString then
+ Result := Result + Str
+ else
+ begin
+ FError := Flag;
+ break;
+ end;
+
+ Flag := False;
+ until False;
+
+ if not FError then
+ Result := '''' + Result + '''';
+end;
+{$HINTS ON}
+function TfsParser.DoDigitSequence: Boolean;
+begin
+ Result := False;
+
+{$IFDEF Delphi12}
+ if CharInSet(FText[FPosition], ['0'..'9']) then
+ begin
+ while CharInSet(FText[FPosition], ['0'..'9']) do
+{$ELSE}
+ if FText[FPosition] in ['0'..'9'] then
+ begin
+ while FText[FPosition] in ['0'..'9'] do
+{$ENDIF}
+ Inc(FPosition);
+ Result := True;
+ end;
+end;
+
+function TfsParser.DoHexDigitSequence: Boolean;
+begin
+ Result := False;
+
+{$IFDEF Delphi12}
+ if CharInSet(FText[FPosition], ['0'..'9', 'a'..'f', 'A'..'F']) then
+ begin
+ while CharInSet(FText[FPosition], ['0'..'9', 'a'..'f', 'A'..'F']) do
+{$ELSE}
+ if FText[FPosition] in ['0'..'9', 'a'..'f', 'A'..'F'] then
+ begin
+ while FText[FPosition] in ['0'..'9', 'a'..'f', 'A'..'F'] do
+{$ENDIF}
+ Inc(FPosition);
+ Result := True;
+ end;
+end;
+
+function TfsParser.DoUnsignedInteger: Boolean;
+var
+ Pos1: Integer;
+ s: String;
+begin
+ Pos1 := FPosition;
+
+ s := Copy(FText, FPosition, Length(FHexSequence));
+ if s = FHexSequence then
+ begin
+ Inc(FPosition, Length(s));
+ Result := DoHexDigitSequence;
+ end
+ else
+ Result := DoDigitSequence;
+
+ if not Result then
+ FPosition := Pos1;
+end;
+
+function TfsParser.DoUnsignedReal: Boolean;
+var
+ Pos1, Pos2: Integer;
+begin
+ Pos1 := FPosition;
+ Result := DoUnsignedInteger;
+
+ if Result then
+ begin
+ if FText[FPosition] = '.' then
+ begin
+ Inc(FPosition);
+ Result := DoDigitSequence;
+ end;
+
+ if Result then
+ begin
+ Pos2 := FPosition;
+ if not DoScaleFactor then
+ FPosition := Pos2;
+ end;
+ end;
+
+ if not Result then
+ FPosition := Pos1;
+end;
+
+function TfsParser.DoScaleFactor: Boolean;
+begin
+ Result := False;
+{$IFDEF Delphi12}
+ if CharInSet(FText[FPosition], ['e', 'E']) then
+{$ELSE}
+ if FText[FPosition] in ['e', 'E'] then
+{$ENDIF}
+ begin
+ Inc(FPosition);
+{$IFDEF Delphi12}
+ if CharInSet(FText[FPosition], ['+', '-']) then
+{$ELSE}
+ if FText[FPosition] in ['+', '-'] then
+{$ENDIF}
+ Inc(FPosition);
+ Result := DoDigitSequence;
+ end;
+end;
+
+function TfsParser.GetNumber: String;
+var
+ Pos1: Integer;
+begin
+ Result := '';
+ if FSkipSpace then
+ SkipSpaces;
+ Pos1 := FPosition;
+
+ if DoUnsignedReal or DoUnsignedInteger then
+ Result := Copy(FText, FLastPosition, FPosition - FLastPosition) else
+ FPosition := Pos1;
+
+ if FHexSequence <> '$' then
+ while Pos(FHexSequence, Result) <> 0 do
+ begin
+ Pos1 := Pos(FHexSequence, Result);
+ Delete(Result, Pos1, Length(FHexSequence));
+ Insert('$', Result, Pos1);
+ end;
+end;
+
+function TfsParser.GetFRString: String;
+var
+ i, c: Integer;
+ fl1, fl2: Boolean;
+begin
+ Result := '';
+ i := FPosition;
+ fl1 := True;
+ fl2 := True;
+ c := 1;
+
+ Dec(FPosition);
+ repeat
+ Inc(FPosition);
+{ if FText[FPosition] in [#10, #13] then
+ begin
+ FPosition := i;
+ break;
+ end;}
+ if fl1 and fl2 then
+{$IFDEF Delphi12}
+ if CharInSet(FText[FPosition], ['<', '[']) then
+{$ELSE}
+ if FText[FPosition] in ['<', '['] then
+{$ENDIF}
+ Inc(c)
+{$IFDEF Delphi12}
+ else if CharInSet(FText[FPosition], ['>', ']']) then
+{$ELSE}
+ else if FText[FPosition] in ['>', ']'] then
+{$ENDIF}
+ Dec(c);
+ if fl1 then
+ if FText[FPosition] = '"' then
+ fl2 := not fl2;
+ if fl2 then
+ if FText[FPosition] = '''' then
+ fl1 := not fl1;
+ until (c = 0) or (FPosition >= Length(FText));
+
+ Result := Copy(FText, i, FPosition - i);
+end;
+
+function TfsParser.GetXYPosition: String;
+var
+ i, i0, i1, c, pos, X, Y: Integer;
+begin
+ i0 := 0;
+ i1 := FYList.Count - 1;
+
+ while i0 <= i1 do
+ begin
+ i := (i0 + i1) div 2;
+ pos := Integer(FYList[i]);
+
+ if pos = FPosition then
+ c := 0
+ else if pos > FPosition then
+ c := 1
+ else
+ c := -1;
+
+ if c < 0 then
+ i0 := i + 1
+ else
+ begin
+ i1 := i - 1;
+ if c = 0 then
+ i0 := i;
+ end;
+ end;
+
+ X := 1;
+ Y := i0;
+ i := Integer(FYList[i0 - 1]) + 1;
+
+ while i < FPosition do
+ begin
+ Inc(i);
+ Inc(X);
+ end;
+ Result := IntToStr(Y) + ':' + IntToStr(X)
+end;
+
+function TfsParser.GetPlainPosition(pt: TPoint): Integer;
+var
+ i: Integer;
+begin
+ Result := -1;
+ i := pt.Y - 1;
+ if (i >= 0) and (i < FYList.Count) then
+ Result := Integer(FYList[i]) + pt.X;
+end;
+
+end.
\ No newline at end of file
diff --git a/FastScript/fs_ipascal.pas b/FastScript/fs_ipascal.pas
new file mode 100644
index 0000000..0c14a1a
--- /dev/null
+++ b/FastScript/fs_ipascal.pas
@@ -0,0 +1,201 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Pascal grammar }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+{$IFNDEF FMX}
+unit fs_ipascal;
+{$ENDIF}
+
+interface
+
+{$i fs.inc}
+
+uses
+{$IFNDEF FMX}
+ SysUtils, Classes, fs_itools{$IFDEF DELPHI16}, Controls{$ENDIF};
+{$ELSE}
+ System.SysUtils, System.Classes, FMX.fs_itools, FMX.Types;
+{$ENDIF}
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsPascal = class(TComponent);
+
+procedure fsModifyPascalForFR2;
+
+implementation
+
+const
+ PASCAL_GRAMMAR =
+ '<' +
+ 'except/>' +
+ '' +
+ '' +
+ '' +
+ '<' +
+ 'string add="file" err="err1"/>' +
+ '<' +
+ 'sequence><' +
+ 'char text="="/><' +
+ 'sequence><' +
+ '/sequence><' +
+ 'optionalloop text=",">' +
+ '<' +
+ 'expression err="err2"/><' +
+ '/casestmt>' +
+ '' +
+ '<' +
+ '/sequence><' +
+ 'procedureheading>' +
+ '' +
+ '<' +
+ 'keyword text="CONST"/>';
+
+
+procedure fsModifyPascalForFR2;
+var
+ i: Integer;
+ s, s1: String;
+begin
+ s := PASCAL_GRAMMAR;
+ s1 := '';
+ i := Pos(s1, s);
+ if i <> 0 then
+ begin
+ Delete(s, i, Length(s1));
+ s1 := '' +
+ '';
+ Insert(s1, s, i);
+ end;
+
+ i := Pos(' 0 then
+ begin
+ s1 := '';
+ Insert(s1, s, i);
+ end;
+
+ fsRegisterLanguage('PascalScript', s);
+end;
+
+
+initialization
+{$IFDEF DELPHI16}
+{$IFDEF FMX}
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsPascal, TFmxObject);
+{$ELSE}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsPascal, TControl);
+{$ENDIF}
+{$ENDIF}
+ fsRegisterLanguage('PascalScript', PASCAL_GRAMMAR);
+
+end.
diff --git a/FastScript/fs_ireg.dcr b/FastScript/fs_ireg.dcr
new file mode 100644
index 0000000..4fa33bf
Binary files /dev/null and b/FastScript/fs_ireg.dcr differ
diff --git a/FastScript/fs_ireg.lrs b/FastScript/fs_ireg.lrs
new file mode 100644
index 0000000..ddce913
--- /dev/null
+++ b/FastScript/fs_ireg.lrs
@@ -0,0 +1,1741 @@
+LazarusResources.Add('TFSADORTTI','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#196#14#0#0#196#14#0#0#0#0#0#0#0#0#0#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#128#128
+ +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
+ +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
+ +#128#128#128#128#128#128#128#128#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#207#156#156#207#156#156#207#156#156
+ +#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207
+ +#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156
+ +#156#128#128#128#192#192#192#176#191#202#139#192#234'p'#173#224'_'#154#219'S'
+ +#142#214'N'#136#210#207#156#156#248#237#213#245#233#209#243#230#204#241#226
+ +#198#238#222#193#235#218#187#233#215#182#230#211#175#227#207#169#225#203#164
+ +#222#199#158#219#195#154#217#191#149#215#188#143#207#156#156#128#128#128#192
+ +#192#192#159#206#244't'#174#236'S'#140#229'@v'#224'5i'#219'1d'#214#209#158
+ +#158#249#238#217#247#235#212#244#232#207#242#229#202#239#225#196#237#221#191
+ +#234#217#185#231#213#179#228#210#174#226#205#168#223#201#162#221#198#157#218
+ +#194#151#215#190#147#207#156#156#128#128#128#192#192#192#133#195#246'['#149
+ +#241''#253#0'1'#248#0'0'#243#240#188
+ +#189#255#247#228#4#4#4#4#4#4#249#240#218#248#236#214#4#4#4#4#4#4#4#4#4#237
+ +#223#193#235#218#187#232#214#181#4#4#4#4#4#4#224#202#164#207#156#156#128#128
+ +#128#192#192#192#130#183#255'U'#136#255'.`'#255#16'C'#255#0'3'#253#0'1'#248
+ +#245#192#192#255#247#229#254#246#227#253#243#224#251#241#221#249#238#217#247
+ +#235#212#245#232#208#242#228#202#240#225#197#237#221#191#234#217#185#232#213
+ +#179#228#210#173#226#205#167#207#156#156#128#128#128#192#192#192#135#186#255
+ +'['#140#255'6f'#255#25'J'#255#6'8'#255#0'3'#253#245#193#193#255#247#229#255
+ +#247#229#254#245#226#252#243#223#251#240#219#249#237#215#247#235#211#244#231
+ +#205#242#228#200#239#224#195#236#220#189#233#216#183#231#211#177#228#207#172
+ +#207#156#156#128#128#128#192#192#192#139#188#255'a'#145#255'>l'#255'"Q'#255
+ +#15'?'#255#6'7'#255#245#193#193#245#193#193#245#193#193#245#193#193#243#191
+ +#191#240#188#188#236#185#185#232#181#181#229#178#178#225#174#173#221#170#170
+ +#217#166#165#213#162#162#210#159#159#207#156#156#207#156#156#192#192#192#192
+ +#192#192#143#190#255'f'#148#255'Eq'#255'*W'#255#24'F'#255#15'?'#255#5'7'#255
+ +#0'2'#253#0'1'#247#0'0'#241#9'9'#235#28'L'#228'5i'#222'S'#141#216#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#147#188#255'l'#144#255'Lm'#255'1K'#255' <'
+ +#255'"]'#255'6'#141#255'-'#136#255#12'L'#252#0#31#246#10'&'#239#29'C'#233'7c'
+ +#226'V'#140#221#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#160#207#255'~'
+ +#179#255'c'#159#255'N'#138#255'@'#129#255'C'#152#255'P'#188#255'I'#186#255'+'
+ +#139#255#28'g'#250'"i'#244'1y'#237'H'#137#231'd'#163#225#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#175#227#255#146#208#254'y'#191#250'd'#174#248'X'#164
+ +#245'Q'#161#245'L'#159#244'D'#155#243'9'#148#243'1'#143#244'8'#148#240'G'#160
+ +#236'\'#174#234'v'#189#229#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#178
+ +#227#253#147#200#245'v'#168#232'a'#145#223'R'#129#218'Ht'#216';d'#212'3]'#210
+ +'0b'#209'*d'#209'-m'#213'@'#132#217']'#165#226'|'#193#231#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#171#209#242#139#174#231'p'#141#219'[w'#212'Nk'#209
+ +'Gg'#208'?b'#207'7\'#205'/R'#202'%I'#199'#K'#198'5_'#202'Q'#131#211'u'#173
+ +#221#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#171#203#237#144#177#229'|'
+ ,#165#229'm'#157#231'a'#152#233']'#154#237'W'#153#239'P'#149#238'F'#140#234'>'
+ +#131#229'<~'#224'D'#219'Y'#138#214'w'#168#217#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#189#228#250#167#214#250#148#209#252#132#200#253'x'#191#252
+ +'r'#189#253'm'#187#253'g'#184#253'_'#181#252'['#178#252']'#183#252'f'#191#251
+ +'y'#194#247#149#208#241#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#214#242
+ +#254#178#220#255#149#195#255#132#181#255'v'#170#255'o'#165#255'i'#160#255'd'
+ +#156#255']'#153#255'Z'#152#255']'#156#255'i'#170#255#143#204#255#193#235#254
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#194#208#213#197#230#255#162#195
+ +#255#146#178#255#133#168#255''#161#255'y'#158#255't'#155#255'o'#150#255'l'
+ +#151#255'q'#156#255''#173#255#170#219#255#185#203#211#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#193#198#199#201#232#255#183#220#255#174#211#255#164
+ +#202#255#158#197#255#154#195#255#150#192#255#148#191#255#147#193#255#152#200
+ +#255#157#207#255#178#223#255#190#196#199#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+]);
+LazarusResources.Add('TFSBASIC','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#196#14#0#0#196#14#0#0#0#0#0#0#0#0#0#0#200#208#212#200#208#212#200
+ +#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#128#128
+ +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
+ +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
+ +#128#128#128#128#128#128#128#128#200#208#212#200#208#212#200#208#212#200#208
+ +#212#200#208#212#200#208#212#200#208#212#207#156#156#207#156#156#207#156#156
+ +#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207
+ +#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156
+ +#156#128#128#128#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212
+ +#200#208#212#200#208#212#207#156#156#248#236#213#248#236#213#243#230#204#239
+ +#224#196#239#224#196#234#217#185#233#215#182#231#212#178#226#204#167#226#204
+ +#167#222#200#159#218#193#151#218#193#151#212#185#140#207#156#156#128#128#128
+ +#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200
+ +#208#212#207#156#156#248#236#213#248#236#213#243#230#204#243#230#204#239#224
+ +#196#236#220#189#234#217#185#231#212#178#228#209#173#226#204#167#222#200#159
+ +#222#200#159#218#193#151#218#193#151#207#156#156#128#128#128#200#208#212#200
+ +#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#212#161
+ +#161#255#246#228#248#236#213#248#236#213#0#0#0#0#0#0#236#220#189#236#220#189
+ +#0#0#0#0#0#0#0#0#0#226#204#167#222#200#159#222#200#159#218#193#151#207#156
+ +#156#128#128#128#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212
+ +#200#208#212#200#208#212#220#170#170#255#246#228#252#242#221#248#236#213#0#0
+ +#0#0#0#0#236#220#189#236#220#189#0#0#0#231#212#178#228#209#173#0#0#0#226#204
+ +#167#222#200#159#222#200#159#207#156#156#128#128#128#200#208#212#200#208#212
+ +#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#232#181#181#255
+ +#246#228#252#242#221#0#0#0#248#236#213#243#230#204#0#0#0#234#217#185#0#0#0#0
+ +#0#0#0#0#0#234#217#185#226#204#167#222#200#159#222#200#159#207#156#156#128
+ +#128#128#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208
+ +#212#200#208#212#232#181#181#255#246#228#252#242#221#0#0#0#252#242#221#248
+ +#236#213#0#0#0#243#230#204#0#0#0#234#217#185#234#217#185#0#0#0#228#209#173
+ +#226#204#167#226#204#167#207#156#156#128#128#128#200#208#212#200#208#212#200
+ +#208#212#200#208#212#200#208#212#200#208#212#200#208#212#244#192#192#255#246
+ +#228#255#246#228#0#0#0#248#236#213#248#236#213#0#0#0#248#236#213#0#0#0#0#0#0
+ +#0#0#0#239#224#196#234#217#185#234#217#185#226#204#167#207#156#156#128#128
+ +#128#200#208#212#200#208#212#232#181#181#157'hk'#137'ZS'#226#196#197#200#208
+ +#212#244#192#192#255#246#228#255#246#228#252#242#221#252#242#221#248#236#213
+ +#248#236#213#252#242#221#248#236#213#239#224#196#236#220#189#234#217#185#231
+ +#212#178#228#209#173#226#204#167#207#156#156#128#128#128#200#208#212#200#208
+ +#212'W'#211#250#23#221#213'_'#253#0'1'#248#0'0'#243#240#188#189#255#247#228#138#30#25#138#30#25#138#30
+ +#25#248#236#214#245#233#209#138#30#25#138#30#25#138#30#25#235#218#187#232#214
+ +#181#138#30#25#138#30#25#138#30#25#207#156#156#128#128#128#192#192#192#130
+ +#183#255'U'#136#255'.`'#255#16'C'#255#0'3'#253#0'1'#248#245#192#192#255#247
+ +#229#254#246#227#253#243#224#251#241#221#249#238#217#247#235#212#245#232#208
+ +#242#228#202#240#225#197#237#221#191#234#217#185#232#213#179#228#210#173#226
+ +#205#167#207#156#156#128#128#128#192#192#192#135#186#255'['#140#255'6f'#255
+ +#25'J'#255#6'8'#255#0'3'#253#245#193#193#255#247#229#255#247#229#254#245#226
+ +#252#243#223#251#240#219#249#237#215#247#235#211#244#231#205#242#228#200#239
+ +#224#195#236#220#189#233#216#183#231#211#177#228#207#172#207#156#156#128#128
+ +#128#192#192#192#139#188#255'a'#145#255'>l'#255'"Q'#255#15'?'#255#6'7'#255
+ +#245#193#193#245#193#193#245#193#193#245#193#193#243#191#191#240#188#188#236
+ +#185#185#232#181#181#229#178#178#225#174#173#221#170#170#217#166#165#213#162
+ +#162#210#159#159#207#156#156#207#156#156#192#192#192#192#192#192#143#190#255
+ +'f'#148#255'Eq'#255'*W'#255#24'F'#255#15'?'#255#5'7'#255#0'2'#253#0'1'#247#0
+ +'0'#241#9'9'#235#28'L'#228'5i'#222'S'#141#216#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#147#188#255'l'#144#255'Lm'#255'1K'#255' <'#255'"]'#255'6'#141
+ +#255'-'#136#255#12'L'#252#0#31#246#10'&'#239#29'C'#233'7c'#226'V'#140#221#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#160#207#255'~'#179#255'c'#159#255'N'
+ +#138#255'@'#129#255'C'#152#255'P'#188#255'I'#186#255'+'#139#255#28'g'#250'"i'
+ +#244'1y'#237'H'#137#231'd'#163#225#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#175#227#255#146#208#254'y'#191#250'd'#174#248'X'#164#245'Q'#161#245'L'
+ +#159#244'D'#155#243'9'#148#243'1'#143#244'8'#148#240'G'#160#236'\'#174#234'v'
+ +#189#229#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#178#227#253#147#200#245
+ +'v'#168#232'a'#145#223'R'#129#218'Ht'#216';d'#212'3]'#210'0b'#209'*d'#209'-m'
+ +#213'@'#132#217']'#165#226'|'#193#231#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#171#209#242#139#174#231'p'#141#219'[w'#212'Nk'#209'Gg'#208'?b'#207'7\'
+ +#205'/R'#202'%I'#199'#K'#198'5_'#202'Q'#131#211'u'#173#221#192#192#192#192
+ ,#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#171#203#237#144#177#229'|'#165#229'm'#157#231'a'
+ +#152#233']'#154#237'W'#153#239'P'#149#238'F'#140#234'>'#131#229'<~'#224'D'
+ +#219'Y'#138#214'w'#168#217#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#189
+ +#228#250#167#214#250#148#209#252#132#200#253'x'#191#252'r'#189#253'm'#187#253
+ +'g'#184#253'_'#181#252'['#178#252']'#183#252'f'#191#251'y'#194#247#149#208
+ +#241#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#214#242#254#178#220#255#149
+ +#195#255#132#181#255'v'#170#255'o'#165#255'i'#160#255'd'#156#255']'#153#255
+ +'Z'#152#255']'#156#255'i'#170#255#143#204#255#193#235#254#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#194#208#213#197#230#255#162#195#255#146#178#255#133
+ +#168#255''#161#255'y'#158#255't'#155#255'o'#150#255'l'#151#255'q'#156#255''
+ +#173#255#170#219#255#185#203#211#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#193#198#199#201#232#255#183#220#255#174#211#255#164#202#255#158#197#255#154
+ +#195#255#150#192#255#148#191#255#147#193#255#152#200#255#157#207#255#178#223
+ +#255#190#196#199#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192
+]);
+LazarusResources.Add('TFSCHARTRTTI','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#196#14#0#0#196#14#0#0#0#0#0#0#0#0#0#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192'ff'#164'BB'#138'BB'#140'IB'#129#128'BI'#132'BB}BB'#150'ff'#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192''#186'||'#184#1#20#152#0#10#154#0#0#137#10#0'VQ'#0#9'u'#21#0'}"'#0'p'
+ +#23#1#165'||'#165''#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +'PP'#185#0#4#160#0#13#156#0' '#182#0#15#178#0#0#157#10#0'WQ'#0#10#129#30#0
+ +#142'3'#0'~$'#0'g'#14#0'e'#15#0#142'SP'#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#188#188#191'<<'
+ +#171#0#0#200#0#14#238#0'-'#227#0#8#147#0#1'x'#0#1#128#11#1'g]'#1#11'i'#1#0'['
+ +#0#0'e'#9#0#141'2'#0#146'6'#0'p'#23#0'y=<'#189#187#187#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192'/='#178#11#23#235#2#7
+ +#215#0#0#148#0#6#158#0'!'#207#0'('#207#0'!'#200#17'$'#170#142':'#19#162':'#0
+ +#150'8'#0#136'*'#0'c'#6#0'Y'#6#0'x'#29#0#131'+'#7't//'#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#10'$'#168#9#30#192#6'!'
+ +#209#4'-'#199#1#29#206#0'1'#250#0'5'#241#0'.'#231#20'3'#203#164'S'#23#187'T'
+ +#0#174'O'#0#160'A'#0'~'#30#0'y'#31#0'w'#26#0'i'#18#0'X'#0#0#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#14'3'#169#13'7'#176
+ +#11'H'#225#9'U'#255#6'J'#255#4'>'#255#1'5'#255#0'.'#247#20'3'#211#167'T'#24
+ +#191'U'#0#173'M'#0#169'J'#0#168'J'#0#169'K'#0#135')'#0'`'#8#0'\'#6#6#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#18'B'#187#16
+ +'['#242#15'd'#255#13'Y'#255#11'R'#255#9'K'#255#5'C'#255#2'6'#255#21'7'#225
+ +#175'['#26#200'\'#0#182'T'#0#176'O'#0#169'I'#0#162'D'#0#165'H'#0#144'1'#0'g'
+ +#12#6#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#21'k'#247#20'l'#254#19'j'#255#17'd'#255#15'_'#255#13'X'#255#10'P'#255#7'D'
+ +#255#24'B'#229#182'a'#27#209'd'#0#190'['#0#183'U'#0#177'P'#0#170'J'#0#165'G'
+ +#0#159'@'#0#151'<'#6#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#24'y'#255#23'v'#255#23's'#255#21'o'#255#19'j'#255#17'd'#255
+ +#15'^'#255#12'L'#255#26'?'#243#202'['#19#239'Y'#2#219'Q'#0#212'L'#0#204'G'#0
+ +#197'C'#0#190'>'#0#185'<'#0#185'A'#6#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#27''#255#26'~'#255#26'|'#255#24'y'#255#23
+ +'t'#255#21'o'#255#18'\'#255#21'g'#243','#149#190'l'#178#144'|'#177'|t'#169'p'
+ +'q'#161'jm'#152'ei'#142'_f'#133'Zc}V`wR'#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192'B'#154#255'#'#137#255#28#132#255#27#129
+ +#255#26'~'#255#24'u'#255#25'p'#246'-'#158#195'A'#236#131#13#255#237#9#255#255
+ +#5#255#255#1#255#255#0#245#246#0#230#233#0#216#221#7#205#212'/'#205#212#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#188#191
+ +#193'T'#167#255#31#139#255#30#136#255#29#133#255#27'u'#255'2'#176#201'I'#229
+ +#139'C'#217#142'C'#212#130#28#242#217#9#255#255#5#255#255#2#255#255#1#244#245
+ +#1#230#233'='#227#231#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192'f'#179#255' '#139#255#31
+ +#140#253'9'#188#199'H'#220#162'I'#227#149'D'#218#148'E'#214#136'<'#216#143#30
+ +#239#208#8#255#255#5#255#255#1#255#255'Q'#247#248#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#144#198#255#141#197#254'I'#218#174'O'#235#151'G'
+ +#221#160'F'#220#153'D'#218#148'H'#211'}9'#218#148' '#237#201#129#255#254#129
+ ,#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#188#191#193'd'#218#195'N'#231#158'I'#223#161'G'#221#156'E'#219
+ +#150'B'#217#144'D'#212#128'V'#226#167#188#193#193#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+]);
+LazarusResources.Add('TFSCLASSESRTTI','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#196#14#0#0#196#14#0#0#0#0#0#0#0#0#0#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#206'c'#0#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#206'c'#0#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#206'c'
+ +#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#206'c'#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0
+ +#206'c'#0#214'{!'#255#247#239#255#247#239#255#239#214#255#239#214#255#222#181
+ +#255#214#165#206'c'#0#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#206'c'#0#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#214'{!'#255#255#255
+ +#255#255#255#255#255#255#255#239#214#255#222#181#255#214#165#206'c'#0#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#206'c'#0#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#214'{!'#214'{!'#214'{!'#214'{!'#214'{!'#214'{!'
+ +#214'{!'#206'c'#0#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#206'c'#0#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#206'c'#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#206'c'#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0
+ +#206'c'#0#206'c'#0#206'c'#0#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#206
+ +'c'#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#214'{!O'#235#151'L'#230
+ +#145'D'#213#128'8'#192'i,'#169'Q'#31#148':'#206'c'#0#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#206'c'#0#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#214'{!O'#235#151'O'#235#151'O'#235#151'H'#222#137'='#203'u1'#181
+ +']'#206'c'#0#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#206'c'#0#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#214'{!'#214'{!'#214'{!'#214
+ +'{!'#214'{!'#214'{!'#214'{!'#206'c'#0#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#206'c'#0#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#206'c'#0#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#206'c'#0#206'c'#0#206'c'
+ +#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#206'c'#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#214'{'
+ +'!'#136#187#255'a'#157#255'9'#255#25'f'#255#15'^'#255#15'^'#255#206'c'#0#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#206'c'#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#214'{!'#153#201#255'u'#173#255'L'#142#255
+ +'''q'#255#15'^'#255#15'^'#255#206'c'#0#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#206'c'#0#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ ,#214'{!'#214'{!'#214'{!'#214'{!'#214'{!'#214'{!'#214'{!'#206'c'#0#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#206'c'#0#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#206'c'#0#206'c'#0#206'c'
+ +#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#214'{!'#255#247#239#255#247#239#255#239#214#255#239#214#255#222
+ +#181#255#214#165#206'c'#0#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#214'{!'#255
+ +#255#255#255#255#255#255#255#255#255#239#214#255#222#181#255#214#165#206'c'#0
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#214'{!'#214'{!'#214'{!'#214'{!'#214
+ +'{!'#214'{!'#214'{!'#206'c'#0#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+]);
+LazarusResources.Add('TFSINIRTTI','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#0#255#255#0#255#255#0#255#255
+ +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
+ +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
+ +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#188#144#134
+ +#139'A1'#136'?1'#134'=0'#132';/'#130'9/'#128'7.}5.{3-y1-x0-v.,t,,t,,s--u02y5'
+ +'8'#174#135#138#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
+ +#151'P='#242#234#220#239#229#211#236#223#202#233#217#193#229#212#184#226#207
+ +#175#224#202#167#221#198#160#219#194#154#217#191#150#217#191#149#217#191#149
+ +#217#192#150#218#193#153#221#197#159#223#200#164'z8:'#255#0#255#255#0#255#255
+ +#0#255#255#0#255#255#0#255#255#0#255#154'S>'#245#239#228#242#234#220#239#228
+ +#211#236#223#201#233#217#192#229#212#183#226#207#175#223#202#167#221#198#160
+ +#219#194#154#217#191#150#217#191#149#211#184#145#199#172#137#196#169#141#205
+ +#180#152't24'#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#158
+ +'V?'#248#243#236#245#239#228#242#233#219#239#228#210#236#222#201#232#217#192
+ +#229#211#183#219#197#167#202#177#146#193#164#133#192#162#129#190#159'|'#177
+ +#145'q'#152't^'#142'iY'#167#136'x'#133'SS'#255#0#255#255#0#255#255#0#255#255
+ +#0#255#255#0#255#255#0#255#161'YA'#251#247#242#248#243#235#245#238#227#242
+ +#233#219#239#228#210#235#222#200#232#216#191#207#185#159#163#130'n'#139'fT'
+ +#139'dP'#137'cN'#130'YFi'#175#170'6'#173#169'8RS'#136'ba'#176#150#150#160#129
+ +#129#184#161#161#255#0#255#255#0#255#255#0#255#164'\B'#253#251#248#250#247
+ +#242#248#243#235#245#238#227#242#233#218#232#218#200#213#194#175#181#153#136
+ +'_'#219#253#13#219#213'c4Lb'#153#249#192#152#135'i'#175#248'5n'#169'n&'#29'a'
+ +'75Jo'#163','#156#249'RJ\'#255#0#255#255#0#255#255#0#255#167'_C'#254#254#253
+ +#252#251#248#250#247#242#248#243#234#245#238#226#219#203#190#171#143#131#140
+ +'g]^'#220#253#13#220#213'd3K,'#154#248'+'#154#247#139#205#247#213#150#144'$'
+ +#148#143'&'#209#251')'#147#249'+'#155#247'QK\'#168#140#140#255#0#255#255#0
+ +#255#170'cC'#255#255#255#254#254#253#252#251#248#250#247#241#247#242#234#214
+ +#198#189#194'aa|BB|KK'#13#254#254#18#198#203'e7R*'#166#247#139#170#245#170
+ +#178#244';Z'#143';Z'#144#173#230#248#255#230#242#136'M\P'#31#31#176#150#150
+ +#255#0#255#174'eD'#255#255#255#255#255#255#254#253#253#252#250#247#250#246
+ +#241#216#202#194'CI7'#156#252'8'#155#251'w?Nd'#197#252#248#251#250#175#250
+ +#247#0#250#246#128#251#245#150#251#248#13#252#249#14#210#250'K>aKy'#198'M'
+ +#211#254'r1'#131':06.{2-w/,s,,p)+n''*m&*m&*m&*v37'#178#140#142#255#0#255#194
+ +'wH'#251#246#244#189#155#155's,,~=='#243#236#235#159'T7'#255#187'T'#255#187
+ +'T'#255#187'T'#251#182'R'#244#174'O'#237#166'K'#228#156'H'#220#146'D'#213#138
+ +'@'#206#130'='#202'};'#202'};'#202'};'#202'};'#197'x:v37'#255#0#255#196'yI'
+ +#251#247#244#255#255#255#255#255#255#255#255#255#249#245#243#159'T7'#255#187
+ +'T'#155'U7r++r++r++r++r++r++r++r++r++r++w0,'#202'};'#197'x:v37'#255#0#255#198
+ +'zI'#251#247#244#255#255#255#255#255#255#255#255#255#249#245#243#159'T7'#255
+ +#187'T'#254#233#203#254#252#252#254#252#252#254#252#252#254#252#252#254#252
+ +#252#254#252#252#254#252#252#254#252#252#254#252#252#254#252#252#251#245#241
+ ,#202'};'#197'x:v37'#255#0#255#199'|J'#251#247#244#255#255#255#255#255#255#255
+ +#255#255#249#245#243#159'T7'#255#187'T'#255#187'T'#255#187'T'#255#187'T'#255
+ +#187'T'#255#187'T'#251#182'R'#244#174'O'#237#166'K'#228#156'H'#220#146'D'#213
+ +#138'@'#206#130'='#202'};'#197'x:x67'#255#0#255#224#182#153#199'zH'#195's>'
+ +#193'r>'#195'wH'#200#132'Z'#176'lO'#153'N5'#153'N5'#153'N5'#153'N5'#153'N5'
+ +#153'N5'#151'L4'#148'J4'#145'G3'#141'C2'#137'@1'#133'<0'#129'8/}4.'#129'=9'
+ +#182#144#143#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255
+ +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
+ +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
+ +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
+ +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
+ +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
+ +#255#0#255#255#0#255#255#0#255#255#0#255
+]);
+LazarusResources.Add('TFSCPP','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#196#14#0#0#196#14#0#0#0#0#0#0#0#0#0#0#200#208#212#200#208#212#200
+ +#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#128#128
+ +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
+ +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
+ +#128#128#128#128#128#128#128#128#200#208#212#200#208#212#200#208#212#200#208
+ +#212#200#208#212#200#208#212#200#208#212#207#156#156#207#156#156#207#156#156
+ +#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207
+ +#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156
+ +#156#128#128#128#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212
+ +#200#208#212#200#208#212#207#156#156#248#236#213#248#236#213#243#230#204#239
+ +#224#196#239#224#196#234#217#185#233#215#182#231#212#178#226#204#167#226#204
+ +#167#222#200#159#218#193#151#218#193#151#212#185#140#207#156#156#128#128#128
+ +#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200
+ +#208#212#207#156#156#248#236#213#248#236#213#243#230#204#243#230#204#239#224
+ +#196#236#220#189#234#217#185#231#212#178#228#209#173#226#204#167#222#200#159
+ +#222#200#159#218#193#151#218#193#151#207#156#156#128#128#128#200#208#212#200
+ +#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#212#161
+ +#161#255#246#228#255#246#228#0#0#0#0#0#0#0#0#0#236#220#189#236#220#189#236
+ +#220#189#231#212#178#228#209#173#226#204#167#222#200#159#222#200#159#218#193
+ +#151#207#156#156#128#128#128#200#208#212#200#208#212#200#208#212#200#208#212
+ +#200#208#212#200#208#212#200#208#212#220#170#170#255#246#228#0#0#0#248#236
+ +#213#248#236#213#243#230#204#239#224#196#0#0#0#236#220#189#231#212#178#228
+ +#209#173#0#0#0#226#204#167#222#200#159#222#200#159#207#156#156#128#128#128
+ +#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200
+ +#208#212#232#181#181#255#246#228#0#0#0#248#236#213#248#236#213#243#230#204#0
+ +#0#0#0#0#0#0#0#0#231#212#178#0#0#0#0#0#0#0#0#0#222#200#159#222#200#159#207
+ +#156#156#128#128#128#200#208#212#200#208#212#200#208#212#200#208#212#200#208
+ +#212#200#208#212#200#208#212#232#181#181#255#246#228#0#0#0#252#242#221#252
+ +#242#221#248#236#213#243#230#204#0#0#0#239#224#196#234#217#185#234#217#185#0
+ +#0#0#228#209#173#226#204#167#226#204#167#207#156#156#128#128#128#200#208#212
+ +#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#244
+ +#192#192#255#246#228#255#246#228#0#0#0#0#0#0#0#0#0#248#236#213#248#236#213
+ +#243#230#204#239#224#196#234#217#185#233#215#182#234#217#185#234#217#185#226
+ +#204#167#207#156#156#128#128#128#200#208#212#200#208#212#232#181#181#157'hk'
+ +#137'ZS'#226#196#197#200#208#212#244#192#192#255#246#228#255#246#228#252#242
+ +#221#252#242#221#248#236#213#248#236#213#252#242#221#248#236#213#239#224#196
+ +#236#220#189#234#217#185#231#212#178#228#209#173#226#204#167#207#156#156#128
+ +#128#128#200#208#212#200#208#212'W'#211#250#23#221#213'_'#253#0'1'#248#0'0'#243#197'u?'#197'u?'#197'u?'#197
+ +'u?'#196's?'#194'o='#192'l<'#190'g:'#187'b9'#185'\8'#182'W6'#179'P4'#176'K2'
+ +#174'D0'#171'?.'#168'9,'#128#128#128#192#192#192#130#183#255'U'#136#255'.`'
+ +#255#16'C'#255#0'3'#253#0'1'#248#197'u?'#255#247#229#254#246#227#253#243#224
+ +#197'u?'#249#238#217#247#235#212#245#232#208#242#228#202#240#225#197#187'`9'
+ +#234#217#185#232#213#179#228#210#173#226#205#167#173'C0'#128#128#128#192#192
+ +#192#135#186#255'['#140#255'6f'#255#25'J'#255#6'8'#255#0'3'#253#197'u?'#255
+ +#247#229#255#247#229#254#245#226#197'u?'#251#240#219#249#237#215#247#235#211
+ +#244#231#205#242#228#200#192'i;'#236#220#189#233#216#183#231#211#177#228#207
+ +#172#177'M2'#128#128#128#192#192#192#139#188#255'a'#145#255'>l'#255'"Q'#255
+ +#15'?'#255#6'7'#255#197'u?'#197'u?'#197'u?'#197'u?'#197'u?'#197'u?'#197'u?'
+ +#197'u?'#197'u?'#196't?'#195'p='#193'l<'#191'h;'#189'c:'#185'^8'#183'W6'#192
+ +#192#192#192#192#192#143#190#255'f'#148#255'Eq'#255'*W'#255#24'F'#255#15'?'
+ +#255#5'7'#255#0'2'#253#0'1'#247#0'0'#241#9'9'#235#28'L'#228'5i'#222'S'#141
+ +#216#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#147#188#255'l'#144#255'Lm'
+ +#255'1K'#255' <'#255'"]'#255'6'#141#255'-'#136#255#12'L'#252#0#31#246#10'&'
+ +#239#29'C'#233'7c'#226'V'#140#221#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#160#207#255'~'#179#255'c'#159#255'N'#138#255'@'#129#255'C'#152#255'P'#188
+ +#255'I'#186#255'+'#139#255#28'g'#250'"i'#244'1y'#237'H'#137#231'd'#163#225
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#175#227#255#146#208#254'y'#191
+ +#250'd'#174#248'X'#164#245'Q'#161#245'L'#159#244'D'#155#243'9'#148#243'1'#143
+ +#244'8'#148#240'G'#160#236'\'#174#234'v'#189#229#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#178#227#253#147#200#245'v'#168#232'a'#145#223'R'#129#218'Ht'
+ +#216';d'#212'3]'#210'0b'#209'*d'#209'-m'#213'@'#132#217']'#165#226'|'#193#231
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#171#209#242#139#174#231'p'#141
+ +#219'[w'#212'Nk'#209'Gg'#208'?b'#207'7\'#205'/R'#202'%I'#199'#K'#198'5_'#202
+ +'Q'#131#211'u'#173#221#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#171#203
+ +#237#144#177#229'|'#165#229'm'#157#231'a'#152#233']'#154#237'W'#153#239'P'
+ +#149#238'F'#140#234'>'#131#229'<~'#224'D'#219'Y'#138#214'w'#168#217#192#192
+ ,#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#189#228#250#167#214#250#148#209#252#132
+ +#200#253'x'#191#252'r'#189#253'm'#187#253'g'#184#253'_'#181#252'['#178#252']'
+ +#183#252'f'#191#251'y'#194#247#149#208#241#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#214#242#254#178#220#255#149#195#255#132#181#255'v'#170#255'o'
+ +#165#255'i'#160#255'd'#156#255']'#153#255'Z'#152#255']'#156#255'i'#170#255
+ +#143#204#255#193#235#254#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#194#208
+ +#213#197#230#255#162#195#255#146#178#255#133#168#255''#161#255'y'#158#255't'
+ +#155#255'o'#150#255'l'#151#255'q'#156#255''#173#255#170#219#255#185#203#211
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#193#198#199#201#232#255#183#220
+ +#255#174#211#255#164#202#255#158#197#255#154#195#255#150#192#255#148#191#255
+ +#147#193#255#152#200#255#157#207#255#178#223#255#190#196#199#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+]);
+LazarusResources.Add('TFSDBRTTI','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#196#14#0#0#196#14#0#0#0#0#0#0#0#0#0#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#176#191#202#139#184#234'p'#173#224'_'#154#219'S'#142#214'N'#136#210'J'#133
+ +#205'H'#130#202'E'#199'E'#196'I'#132#193'Q'#142#192'k'#152#200#165#180#191
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#159#193#243't'#172#236'S'#140
+ +#229'@v'#224'5i'#219'1d'#214'/b'#210'-_'#205'+]'#202'+]'#199'0c'#196':q'#193
+ +'O'#135#193'z'#157#205#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#133#195
+ +#246'['#149#241''#253#0'1'#248#0'0'
+ +#243#0'/'#237#0'.'#232#0','#227#0'+'#222#8'4'#217#24'E'#212'-`'#206'H'#130
+ +#202#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#130#183#255'U'#136#255'.`'
+ +#255#16'C'#255#0'3'#253#0'1'#248#0'0'#243#0'/'#237#0'-'#232#0','#226#8'5'#221
+ +#25'G'#215'/b'#210'J'#133#205#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#135
+ +#186#255'['#140#255'6f'#255#25'J'#255#6'8'#255#0'3'#253#0'0'#248#0'/'#243#0
+ +'/'#237#0'-'#231#9'6'#226#26'H'#219'1d'#214'M'#135#209#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#139#188#255'a'#145#255'>l'#255'"Q'#255#15'?'#255#6
+ +'7'#255#0'0'#253#0'.'#248#0'/'#242#0'.'#236#9'8'#230#27'J'#224'3f'#218'P'#138
+ +#212#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#143#190#255'f'#148#255'Eq'
+ +#255'*W'#255#24'F'#255#15'?'#255#5'7'#255#0'2'#253#0'1'#247#0'0'#241#9'9'#235
+ +#28'L'#228'5i'#222'S'#141#216#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#147
+ +#188#255'l'#144#255'Lm'#255'1K'#255' <'#255'"]'#255'6'#141#255'-'#136#255#12
+ +'L'#252#0#31#246#10'&'#239#29'C'#233'7c'#226'V'#140#221#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#160#207#255'~'#179#255'c'#159#255'N'#138#255'@'#129
+ +#255'C'#152#255'P'#188#255'I'#186#255'+'#139#255#28'g'#250'"i'#244'1y'#237'H'
+ +#137#231'd'#163#225#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#175#227#255
+ +#146#208#254'y'#191#250'd'#174#248'X'#164#245'Q'#161#245'L'#159#244'D'#155
+ +#243'9'#148#243'1'#143#244'8'#148#240'G'#160#236'\'#174#234'v'#189#229#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#178#227#253#147#200#245'v'#168#232
+ +'a'#145#223'R'#129#218'Ht'#216';d'#212'3]'#210'0b'#209'*d'#209'-m'#213'@'#132
+ +#217']'#165#226'|'#193#231#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#171
+ +#209#242#139#174#231'p'#141#219'[w'#212'Nk'#209'Gg'#208'?b'#207'7\'#205'/R'
+ +#202'%I'#199'#K'#198'5_'#202'Q'#131#211'u'#173#221#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ ,#192#192#192#192#192#171#203#237#144#177#229'|'#165#229'm'#157#231'a'#152#233
+ +']'#154#237'W'#153#239'P'#149#238'F'#140#234'>'#131#229'<~'#224'D'#219'Y'
+ +#138#214'w'#168#217#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#189#227#250
+ +#167#214#250#148#209#252#132#200#253'x'#191#252'r'#189#253'm'#187#253'g'#184
+ +#253'_'#181#252'['#178#252']'#183#252'f'#191#251'y'#194#247#149#207#241#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#214#228#254#178#217#255#149#195#255
+ +#132#181#255'v'#170#255'o'#165#255'i'#160#255'd'#156#255']'#153#255'Z'#152
+ +#255']'#156#255'i'#170#255#143#199#255#193#219#253#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#194#208#213#197#222#255#162#195#255#146#178#255#133#168
+ +#255''#161#255'y'#158#255't'#155#255'o'#150#255'l'#151#255'q'#156#255''#173
+ +#255#170#211#255#185#203#211#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#193
+ +#198#199#201#222#255#183#220#255#174#211#255#164#202#255#158#197#255#154#195
+ +#255#150#192#255#148#191#255#147#193#255#152#200#255#157#207#255#178#213#255
+ +#190#196#199#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+]);
+LazarusResources.Add('TFSDIALOGSRTTI','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#196#14#0#0#196#14#0#0#0#0#0#0#0#0#0#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192'h'#170#193'3w'#144'4aoPgpttu'
+ +#141#139#139#159#161#162#177#182#185#191#198#202#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#175#197#206
+ +'N'#180#215'W'#204#250'C'#184#230'1'#159#201'$'#135#171'!r'#142'6fwPahemo'
+ +#128#131#133#157#156#156#178#179#181#187#191#194#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#173#197#206'J'#176#210'~'#218#254'w'#220#255'q'#219#255'n'
+ +#218#255'a'#209#251'K'#192#235'1'#176#220'$'#146#184'*x'#147'2ev=am[kr~}~'
+ +#150#147#147#175#182#185#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#175#197#206'8'#168#205#130#219#250'z'#222
+ +#255'x'#221#254'y'#221#254'z'#222#255'|'#223#255'~'#225#255'y'#224#255'g'#217
+ +#254'R'#207#248'D'#184#222'4'#155#189'!'#128#160'$e|r|'#191#198#202#192#192
+ +#192#202#132'0'#193'r'#25#196'y-'#195'z4'#192'w2'#161#194#207'$'#162#205#140
+ +#224#250#128#228#255'~'#227#254'~'#227#254'~'#227#254'~'#227#254'~'#227#254
+ +''#227#254#129#229#255#133#231#255#132#233#255'{'#231#255's'#229#255'+'#168
+ +#213'Oem'#187#191#193#192#192#192#189'k'#22#199#130'3'#228#192#150#232#204
+ +#173#229#198#166#168#198#210#27#159#205#144#225#247#134#236#255#131#234#254
+ +#131#234#254#131#234#254#131#234#254#131#234#254#131#234#254#131#234#254#131
+ +#234#254#132#234#254#134#235#254#137#235#255'?'#190#238'Gdo'#177#180#182#192
+ +#192#192#181'b'#28#201#141'O'#245#233#220#253#250#246#252#249#244#175#201#211
+ +','#166#211#157#229#248#140#241#255#137#239#254#137#239#254#137#239#254#137
+ +#239#254#137#239#254#137#239#254#137#239#254#137#239#254#137#239#254#138#240
+ +#254#138#238#255'R'#201#242'=kz'#164#167#169#192#192#192#181'c!'#200#139'R'
+ +#247#240#233#255#255#255#255#255#255#165#198#211'%'#167#213#163#232#248#147
+ +#248#255#144#246#254#144#246#254#144#246#254#144#246#254#144#246#254#144#246
+ +#254#144#246#254#144#246#254#144#246#254#145#247#254#141#243#255'h'#214#247
+ +'5r'#132#151#153#155#192#192#192#182'c '#199#137'L'#246#237#227#255#255#255
+ +#253#254#255#164#200#214'+'#172#219#150#222#241#153#254#255#150#252#254#150
+ +#252#254#150#252#254#150#252#254#150#252#254#150#252#254#150#252#254#150#252
+ +#254#150#252#254#151#253#254#144#247#255''#225#252'.}'#150#138#140#142#192
+ +#192#192#182'c '#199#137'M'#246#237#227#255#255#255#253#254#255#173#203#215
+ +'T'#189#229#159#223#241#160#255#255#159#254#254#159#254#254#160#254#254#160
+ +#254#254#160#254#254#160#254#254#160#254#254#160#254#254#160#254#254#161#255
+ +#254#149#247#254#158#239#255'/'#138#167'|'#128#192#192#192#182'c '#199#137
+ +'N'#246#237#227#255#255#255#254#254#255#159#197#211'Y'#191#230#141#211#235
+ +#202#251#254#192#252#254#190#255#255#188#255#255#184#255#255#179#254#254#180
+ +#254#254#180#254#254#180#254#254#180#254#254#182#255#254#167#247#254#167#239
+ +#255'A'#160#189'qrt'#192#192#192#182'c '#199#137'N'#246#237#227#255#255#255
+ +#253#254#255#138#189#209#128#217#244'T'#202#232'Q'#191#224'u'#204#231#139#212
+ +#235#171#224#241#207#246#251#205#255#255#195#254#254#197#254#254#197#254#254
+ +#197#254#254#199#255#254#181#247#254#176#239#255'['#177#203'`lq'#187#193#196
+ +#182'c '#199#137'N'#246#237#227#255#255#255#253#254#255#152#195#213#166#237
+ +#251#151#252#255#143#247#254''#237#248'g'#222#240'N'#206#232'Z'#192#224#218
+ +#243#250#234#255#255#228#255#255#224#255#255#222#255#255#225#255#255#202#248
+ +#255#186#239#255'|'#194#215'Ljt'#179#182#185#182'c '#200#137'N'#247#237#227
+ +#255#255#255#253#254#255#155#197#214#170#239#250#155#255#255#151#254#254#154
+ +#255#255#158#255#255#160#255#255'y'#230#243'['#197#228's'#203#229#134#211#233
+ +#157#221#238#183#230#242#212#239#247#201#236#247#202#241#255#157#212#230'Ct'
+ +#133#179#180#181#182'c '#200#137'N'#247#237#227#255#255#255#253#254#255#155
+ +#195#211#163#222#240#171#255#255#146#255#254#150#255#254#147#254#254#172#255
+ +#255#190#237#248#148#217#233#144#226#243#139#225#241#131#220#239'x'#215#236
+ +'f'#205#230'l'#208#232'_'#183#210'`'#176#204'{'#167#183#197#199#201#181'b '
+ +#199#137'N'#247#237#227#255#255#255#253#254#255#190#203#209#131#194#219#190
+ +#242#250#187#250#254#178#252#254#176#255#255#193#240#248'k'#161#182#147#177
+ +#190#169#201#215#164#201#217#150#199#217#141#201#220#139#209#227'u'#210#234
+ +'['#168#193#153#178#188#199'u'#29#192#192#192#182'c '#200#138'O'#246#237#227
+ +#255#255#255#253#255#255#251#253#255#158#196#209'y'#187#212#130#196#219#146
+ +#204#225#165#214#230#132#191#212#163#181#188#234#247#255#230#246#255#227#245
+ +#255#225#244#255#221#244#255#189#202#209#191#203#210#212#242#243#204#172'y'
+ +#206'}'#30#192#192#192#189'p '#206#148'Z'#248#239#231#255#255#255#255#255#255
+ +#254#255#255#252#255#255#252#255#255#250#255#255#195#205#210#175#198#207#191
+ ,#203#208#239#255#255#237#255#255#233#254#255#230#253#255#227#250#255#223#248
+ +#255#220#248#255#215#252#255#212#249#246#206#180#129#209#130#31#192#192#192
+ +#212#142';'#222#168'l'#251#242#233#255#255#255#255#254#250#254#252#249#251
+ +#251#248#250#251#247#248#250#246#244#249#245#241#248#245#239#248#245#237#247
+ +#246#234#247#246#230#247#247#227#246#248#226#247#253#222#247#255#223#246#246
+ +#233#252#232#232#251#224#215#183'v'#213#135'!'#192#192#192#231#171'Z'#224#165
+ +'X'#210#178#130#206#177#136#205#174#131#205#174#130#203#173#128#202#172''
+ +#201#170''#199#170''#198#170''#197#170''#197#170#129#197#171#130#195#172
+ +#131#195#174#133#195#177#139#195#178#139#195#177#139#192#178#147#191#177#142
+ +#197#152'N'#217#142' '#192#192#192#234#173'X'#219#152'='#189'}'''#178'p'#29
+ +#178'p'#29#180'q'#30#179'q'#29#179'p'#29#178'p'#29#179'o'#28#178'o'#27#177'm'
+ +#26#176'l'#26#176'k'#25#175'j'#25#175'j'#24#175'j'#23#179'j'#21#152'lFSe'#180
+ +'IP'#167#161'k='#224#139#13#192#192#192#234#181'l'#223#154'>'#214#139','#208
+ +#131''''#207#130'&'#208#132'('#208#132'('#208#132'('#208#132''''#208#132''''
+ +#207#129'$'#204'~!'#201'{'#30#199'u'#25#196'p'#21#192'k'#16#192'f'#5#192'a'#3
+ +#144'dR*Y'#239#23'5'#216#147'Z@'#235#154'-'#192#192#192#192#192#192#235#180
+ +'h'#237#181'h'#237#185'n'#237#184'm'#237#184'm'#237#184'm'#237#184'm'#237#184
+ +'m'#237#184'm'#236#182'k'#235#180'i'#233#177'f'#229#172'a'#226#167'\'#222#161
+ +'W'#219#154'K'#212#148'I'#191#144'g'#158#138#142#144'x|'#180'|A'#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+]);
+LazarusResources.Add('TFSEXTCTRLSRTTI','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#196#14#0#0#196#14#0#0#0#0#0#0#0#0#0#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#23'Y'#211#21'U'#203#20'P'#195#18'K'#188#16'G'
+ +#180#15'C'#173#9'0'#137#8'-'#133#7'+'#128#7')|'#0#12'i'#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#25'_'#220#23'['
+ +#213#22'V'#205#20'Q'#197#18'L'#189#17'H'#182#15'D'#175#14'@'#168#8'.'#134#7
+ +'+'#129#0#22#161#0#12'j'#14'z'#19#12's'#16#11'o'#15#10'k'#13#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192'&z'#254'!u'#252#31'p'#244#29'j'#236#27'e'#227#25'_'#218#23'Y'#209#21'T'
+ +#201#14'A'#170#13'='#164#0#25#167#0#23#162#0#12'k'#14'x'#18#12's'#16#11'n'#14
+ +#10'k'#13#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192'.'#130#254')}'#255'#x'#255' r'#248#30'm'#240#28'g'#231#26'b'
+ +#222#24'\'#213#22'X'#204#15'D'#193#0#27#176#0#24#169#0#23#164#0#24#161#14't'
+ +#24#12'n'#21#11'k'#19#10'l'#14#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#189'^.6'#137#254'1'#133#255','#128#255'&{'#255'!v'#253#31'p'
+ +#244#29'j'#235#27'd'#225#25'`'#216#17'J'#203#0#29#185#0#26#177#0#25#171#0#25
+ +#167#15'z'#27#14't'#24#12'q'#18#11'p'#15#192#192#192#192#192#192#192#192#192
+ +#192#192#192#214#130'@'#200'X'#0'Z'#169#255'9'#140#255'5'#136#255'0'#132#255
+ +'*~'#255'#x'#255' r'#247#30'l'#238#28'h'#228#19'P'#214#0' '#195#0#28#186#0#27
+ +#178#0#27#173#17#128#30#15'z'#27#14'y'#18#13'u'#17#192#192#192#192#192#192
+ +#192#192#192#239#168'S'#228'y'#0#215'i'#0'`'#173#255'A'#147#255'='#144#255'9'
+ +#140#255'3'#134#255'-'#129#255'&z'#255'!t'#250#31'p'#240#21'V'#225#0'"'#204#0
+ +#31#195#0#28#186#0#28#180#20#136'#'#17#129#29#16''#21#192#192#192#192#192
+ +#192#192#192#192#255#194'f'#254#190'^'#245#141#0#233''#0'j'#181#255'H'#153
+ +#255'D'#150#255'A'#147#255'<'#142#255'6'#137#255'.'#130#255'''{'#255'"x'#251
+ +#23'\'#236#0'$'#214#0'!'#204#0#31#195#0#30#187#22#144''''#20#138#31#18#134#24
+ +#192#192#192#192#192#192#192#192#192#255#202'y'#255#165#31#255#160#17#255#153
+ +#0'n'#184#255'L'#157#255'J'#154#255'F'#151#255'B'#147#255'<'#141#255'5'#135
+ +#255'.'#129#255'''|'#255#23'^'#246#0'%'#224#0'#'#214#0'!'#204#0'!'#195#24#152
+ +'+'#22#148#29#20#141#26#192#192#192#192#192#192#192#192#192#255#187'U'#255
+ +#179'@'#255#176':'#255#171'.'#131#204#255'^'#178#255'\'#176#254'Y'#173#254'U'
+ +#170#254'P'#166#254'K'#161#254'D'#155#254'>'#152#254'.'#250#2'-'#235#0'!'
+ +#224#0'#'#213#0'$'#204#26#159'.'#24#156' '#192#192#192#192#192#192#192#192
+ +#192#192#192#192#255#194'g'#255#191'_'#255#191'^'#255#189'Z'#255#185'O'#151
+ +#223#254#147#222#254't'#204#253'q'#202#253'm'#200#253'h'#197#253'c'#193#253
+ +']'#190#252'W'#187#252'>'#149#249#13'?'#236#0#29#222#0'$'#213#28#167'.'#26
+ +#163'"'#192#192#192#192#192#192#192#192#192#192#192#192#255#206#131#255#202
+ +'z'#255#203'}'#255#203'}'#255#201'x'#255#194'g'#150#223#254#148#222#254#146
+ +#221#254#143#219#254#140#218#254#136#216#253'`'#192#253'Z'#189#253'X'#193#255
+ +'K'#177#254'!f'#241#3'+'#226#30#175'-'#27#168'%'#192#192#192#192#192#192#192
+ +#192#192#192#192#192#255#240#219#255#211#144#255#228#188#255#229#189#255#228
+ +#187#255#206#133#255#194'g'#152#224#254#147#222#254#145#220#254#142#219#254
+ +#139#217#254#135#215#253#131#213#253'~'#210#253'y'#207#253't'#205#253'1'#135
+ +#201' '#182','#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#255#217#160#255#219#165#255#233#199#255#232#197#255#212#148#255
+ +#202'z'#255#187'T'#255#168'%'#249#146#0#227'w'#0#209'c'#0#197'T'#0'!'#228'H!'
+ +#208'6!'#202':!'#195':!'#190'8!'#183'8'#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#255#244#228#255#223#174#255#223#175#255
+ +#233#201#255#215#154#255#205#130#255#192'a'#255#175'7'#255#157#11#241#136#0
+ +#224't'#0#163'8'#0'!'#229'H!'#212'1!'#204':!'#198':!'#193'6!'#191','#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#255#245#231#255#224#177#255#221#170#255#215#155#255#206#133#255#195'h'#255
+ +#181'E'#255#165#31#252#192'j'#237#168']'#192#192#192#192#192#192'!'#233',!'
+ +#206':!'#200':!'#198'/!'#194','#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#255#245#230#255#220#168
+ +#255#215#154#255#207#134#255#197'm'#255#185'O'#255#207#135#255#199't'#192#192
+ +#192#192#192#192#192#192#192'!'#234',!'#209'8!'#202'9!'#199'1'#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#255#244#226#255#231#195#255#227#185#255#222
+ ,#173#255#216#158#255#209#141#192#192#192#192#192#192#192#192#192#192#192#192
+ +'!'#234',!'#210'3!'#204'7!'#203','#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192'!'#235',!'#213'/!'#207'2!'
+ +#204','#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192'!'#212'9!'#210','#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192'!'#215',!'#209'3'#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192'!'#216
+ +',*'#208'I'#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192'!'#216',!'#213','#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192
+]);
+LazarusResources.Add('TFSFORMSRTTI','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#196#14#0#0#196#14#0#0#0#0#0#0#0#0#0#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#0#0#147#0#0#143#0#0#139#0#0#136#0#0#132#0#0#129#0#0'~'#0#0'|'#0
+ +#0'y'#0#0'w'#0#0'v'#0#0't'#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192'L{'#255'2'#148#252'Cn'#246'?g'#240';`'#234'6Y'#228'2R'#223'.L'#217
+ +'+F'#212'''A'#208'$;'#204#0#0'y'#0#0'w'#0#0'u'#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192'U'#134#255':'#158#255'Jy'#255'Fs'#250'Bl'#244'>f'#239':^'
+ +#233'6X'#227'1Q'#221'.J'#216'*D'#211'&?'#206#0#0'z'#0#0'x'#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192']'#145#255'E'#167#255'T'#134#255'O'#255#0#0#0#0
+ +#0#0'Ak'#243'=d'#237#0#0#0'4U'#225#0#0#0',G'#213'(A'#208#0#0'{'#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192'e'#154#255'N'#175#255'^'#145#255#0#0#0'S'
+ +#133#255'N~'#255#0#0#0'Dp'#247#0#0#0';`'#234#0#0#0'1P'#221',I'#215#0#0''#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192'l'#163#255'W'#182#255'f'#156#255#0#0
+ +#0']'#145#255'X'#138#255#0#0#0'K{'#255#0#0#0#0#0#0''#196'y$'#197'|5'#194'{5'#192'x5'#191'v5'#190'u5'
+ +#190'v5'#189'v5r'#170#255'_'#189#255'm'#165#255'j'#161#255#0#0#0#0#0#0'['#142
+ +#255'U'#134#255#0#0#0'Hu'#252#0#0#0'=c'#237'7['#230#0#0#135#192#192#192#188
+ +'i'#21#205#143'G'#237#213#184#235#210#183#233#208#181#231#207#181#229#206#181
+ +#227#206#181#226#206#181'w'#177#255#178#255#254't'#172#255'q'#169#255'm'#164
+ +#255'i'#159#255'c'#152#255']'#145#255'V'#136#255'O'#255'Hv'#252'Cm'#245'=d'
+ +#237#0#0#139#192#192#192#181'b '#208#156'i'#255#255#255#255#255#255#255#255
+ +#255#254#255#255#252#255#255#250#255#255#248#255#255'|'#182#255#181#255#254
+ +#180#255#254'f'#195#255'b'#192#255'^'#188#255'X'#183#255'R'#178#255'J'#172
+ +#255'B'#165#255':'#158#255'3'#149#253'Cm'#245#0#0#144#192#192#192#182'c '#206
+ +#152'b'#255#255#255#255#255#255#252#254#255#250#254#255#248#253#255#246#251
+ +#255#244#251#255#241#250#255'~'#185#255'|'#183#255'z'#180#255'w'#177#255's'
+ +#172#255'o'#167#255'j'#160#255'd'#153#255'^'#145#255'V'#136#255'O'#255'Hv'
+ +#252#192#192#192#192#192#192#173'R'#5#206#152'b'#5#4#236#5#4#236#5#4#236#5#4
+ +#236#248#253#255#245#252#255#5#4#236#5#4#236#5#4#236#5#4#236#232#247#255#229
+ +#246#255#226#243#255#0'f'#0#218#242#255#216#244#255#215#249#255#191#155'r'
+ +#184'f '#192#192#192#192#192#192#192#192#192#178'\'#21#206#152'c'#255#255#255
+ +#5#4#236#253#254#255#250#254#255#248#253#255#246#251#255#244#251#255#5#4#236
+ +#5#4#236#235#248#255#232#247#255#229#245#255#226#244#255#0'f'#0#219#242#255
+ +#216#244#255#215#249#255#191#155's'#184'e '#192#192#192#192#192#192#192#192
+ +#192#182'c '#206#152'c'#255#255#255#255#255#255#5#4#236#250#254#255#248#253
+ +#255#245#251#255#244#251#255#5#4#236#0'f'#0#0'f'#0#0'f'#0#0'f'#0#0'f'#0#222
+ +#243#255#219#242#255#216#244#255#215#249#255#191#155'r'#184'e '#192#192#192
+ +#192#192#192#192#192#192#182'c '#206#152'c'#255#255#255#255#255#255#5#4#236#5
+ +#4#236#5#4#236#5#4#236#5#4#236#5#4#236#0'f'#0#235#248#255#233#247#255#229#245
+ +#255#226#244#255#0'f'#0#219#242#255#216#244#255#214#249#255#193#156'r'#187'h'
+ +' '#192#192#192#192#192#192#192#192#192#182'c '#207#152'c'#255#255#255#255
+ +#255#255#5#4#236#250#254#255#248#253#255#246#251#255#5#4#236#241#250#255#0'f'
+ +#0#235#248#255#233#247#255#229#245#255#226#244#255#0'f'#0#219#242#255#216#243
+ +#255#214#248#255#196#160'q'#191'm '#192#192#192#192#192#192#192#192#192#182
+ +'b '#207#152'c'#255#255#255#255#255#255#252#254#255#5#4#236#249#253#255#5#4
+ +#236#5#4#236#241#250#255#0'f'#0#235#248#255#233#247#255#229#245#255#226#244
+ +#255#0'f'#0#219#242#255#216#243#255#214#248#255#200#165'r'#198't '#192#192
+ +#192#192#192#192#192#192#192#181'b '#206#152'c'#255#255#255#255#255#255#252
+ +#254#255#5#4#236#248#253#255#5#4#236#5#4#236#0'f'#0#0'f'#0#0'f'#0#0'f'#0#0'f'
+ +#0#0'f'#0#223#243#255#219#242#255#216#243#255#213#248#255#204#174'}'#206'~!'
+ +#192#192#192#192#192#192#192#192#192#192's#'#214#164'q'#255#255#255#255#255
+ +#255#255#255#255#253#255#255#5#4#236#5#4#236#248#255#255#245#255#255#242#255
+ +#255#239#255#255#236#254#255#232#253#255#229#251#255#225#249#255#221#248#255
+ +#217#249#255#214#255#255#207#183#134#211#133'#'#192#192#192#192#192#192#192
+ ,#192#192#219#153'F'#228#180'z'#248#242#233#248#240#229#246#238#226#243#236
+ +#224#241#236#224#5#4#236#236#233#221#232#232#221#231#232#221#229#231#222#226
+ +#231#222#222#231#224#221#232#227#219#233#232#216#232#231#225#234#212#227#241
+ +#217#213#180'p'#216#139'$'#192#192#192#192#192#192#192#192#192#235#177'b'#217
+ +#155'G'#185#138'F'#182#132'A'#183#133'A'#182#132'@'#182#131'?'#180#130'?'#180
+ +#130'?'#180#130'?'#179#130'?'#180#130'@'#180#131'A'#179#131'B'#180#134'D'#180
+ +#135'G'#181#136'H'#153#135'y'#140'~'#130#178#129'@'#222#147'#'#192#192#192
+ +#192#192#192#192#192#192#231#170'X'#218#148'7'#203'"'#197'w'#28#198'x'#29
+ +#198'y'#30#198'y'#30#198'y'#29#198'x'#28#197'v'#26#194's'#23#191'o'#19#189'j'
+ +#15#187'f'#12#183'c'#7#183'^'#0#171'^'#22'6`'#227#0'1'#249#140'XJ'#235#144#19
+ +#192#192#192#192#192#192#192#192#192#246#224#194#234#176'_'#237#183'l'#236
+ +#184'm'#236#184'm'#236#184'm'#235#183'm'#235#183'm'#234#183'm'#233#181'k'#231
+ +#178'i'#228#175'f'#223#169'`'#219#164'['#213#156'S'#210#149'G'#193#132'B'#161
+ +'~k'#143'z'#132#177'yA'#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192
+]);
+LazarusResources.Add('TFSGRAPHICSRTTI','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#196#14#0#0#196#14#0#0#0#0#0#0#0#0#0#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#232#168'O'#232#168'O'#232#168'O'#231#166'M'
+ +#228#162'J'#226#158'F'#222#154'B'#219#149'='#216#144'8'#212#139'2'#208#133','
+ +#203''''#200'y!'#195't'#28#192'o'#23#188'i'#18#184'd'#12#182'`'#9#179'\'#5
+ +#177'Z'#2#176'X'#0#176'X'#0#176'X'#0#176'X'#0#232#168'O'#232#168'O'#232#168
+ +'O'#231#167'N'#229#164'K'#226#160'G'#224#156'C'#220#151'?'#217#146'9'#213#141
+ +'4'#209#136'/'#205#130')'#201'|#'#197'v'#30#193'q'#25#189'l'#19#186'g'#14#183
+ +'b'#10#180'^'#6#178'['#3#176'X'#0#176'X'#0#176'X'#0#176'X'#0#232#168'O'#232
+ +#168'O'#232#168'O'#232#168'O'#230#166'L'#228#162'I'#225#158'E'#222#153'A'#218
+ +#149'<'#214#143'6'#211#138'1'#207#132','#203'~%'#199'x '#195's'#26#191'm'#21
+ +#187'i'#17#184'd'#12#181'_'#8#179'\'#3#177'Y'#1#176'X'#0#176'X'#0#176'X'#0
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#0#128#255#176'X'#0#176'X'#0#128
+ +#171'.'#192#192#192#192#192#192#192#192#192#0#128#255#0#128#255#0#128#255'@'
+ +#7#29#27#28#31'Y\b'#132#151#210#132#151#210#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#0#128#255#232#168'O'#176'X'#0#176'X'#0#128#171'.'#192#192#192#0#128#255#220
+ +#18'1'#220#18'1'#220#18'1'#220#18'1'#7#3#17#10#8#17#27#27'!pt{'#132#151#210
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#0#128#255#0#128#255#0#128#255#0#128#255#11#186#244#192
+ +#192#192#192#192#192#11#186#244#11#186#244#129#139#157#0#128#255#220#18'1r",'
+ +#12#6#31#8#6#17#132#151#210#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#0#128#255#11#186#244#167#173#184#146'hu'#147'dq'#19#19#30'$%('#132#151
+ +#210#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#11#186#244';CQ'#11#186#244#11
+ +#186#244#11#186#244'ht'#137#14#16#19#132#151#210#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#151#160#172'ft'#140#11#186#244#11#186#244#6#7#8'&'''
+ +',NHF'#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#150
+ +#159#175'[g}cp'#135'Y[_'#160#149'd'#128#171'.'#134#134#135#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#173#181#189'{~'#137#128#171
+ +'.'#195#200#203#128#171'.'#128#171'.|'#129#131#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#161#143#134#128#171'.'#128
+ +#171'.Vb'#136#26' ;w{~'#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#168#169#169'FQp'#132#151#210'R]'#132#27'!<'#130#135
+ +#138#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#160#164#167'BJh'#132#151#210'S_'#133#27'!<'#148#154#157#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#159#164#166'ENm'
+ ,#132#151#210'DOo'#26' ;'#160#166#170#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#159#164#166'OY}'#132#151#210''#253#0'1'#248#0
+ +'0'#243#240#188#189#255#247#228#4#4#4#4#4#4#4#4#4#248#236#214#4#4#4#4#4#4#4#4
+ +#4#237#223#193#235#218#187#4#4#4#230#211#175#227#206#170#4#4#4#207#156#156
+ +#128#128#128#192#192#192#130#183#255'U'#136#255'.`'#255#16'C'#255#0'3'#253#0
+ +'1'#248#245#192#192#255#247#229#254#246#227#253#243#224#251#241#221#249#238
+ +#217#247#235#212#245#232#208#242#228#202#240#225#197#237#221#191#234#217#185
+ +#232#213#179#228#210#173#226#205#167#207#156#156#128#128#128#192#192#192#135
+ +#186#255'['#140#255'6f'#255#25'J'#255#6'8'#255#0'3'#253#245#193#193#255#247
+ +#229#255#247#229#254#245#226#252#243#223#251#240#219#249#237#215#247#235#211
+ +#244#231#205#242#228#200#239#224#195#236#220#189#233#216#183#231#211#177#228
+ +#207#172#207#156#156#128#128#128#192#192#192#139#188#255'a'#145#255'>l'#255
+ +'"Q'#255#15'?'#255#6'7'#255#245#193#193#245#193#193#245#193#193#245#193#193
+ +#243#191#191#240#188#188#236#185#185#232#181#181#229#178#178#225#174#173#221
+ +#170#170#217#166#165#213#162#162#210#159#159#207#156#156#207#156#156#192#192
+ +#192#192#192#192#143#190#255'f'#148#255'Eq'#255'*W'#255#24'F'#255#15'?'#255#5
+ +'7'#255#0'2'#253#0'1'#247#0'0'#241#9'9'#235#28'L'#228'5i'#222'S'#141#216#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#147#188#255'l'#144#255'Lm'#255'1K'
+ +#255' <'#255'"]'#255'6'#141#255'-'#136#255#12'L'#252#0#31#246#10'&'#239#29'C'
+ +#233'7c'#226'V'#140#221#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#160#207
+ +#255'~'#179#255'c'#159#255'N'#138#255'@'#129#255'C'#152#255'P'#188#255'I'#186
+ +#255'+'#139#255#28'g'#250'"i'#244'1y'#237'H'#137#231'd'#163#225#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#175#227#255#146#208#254'y'#191#250'd'#174
+ +#248'X'#164#245'Q'#161#245'L'#159#244'D'#155#243'9'#148#243'1'#143#244'8'#148
+ +#240'G'#160#236'\'#174#234'v'#189#229#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#178#227#253#147#200#245'v'#168#232'a'#145#223'R'#129#218'Ht'#216';d'#212
+ +'3]'#210'0b'#209'*d'#209'-m'#213'@'#132#217']'#165#226'|'#193#231#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#171#209#242#139#174#231'p'#141#219'[w'#212
+ +'Nk'#209'Gg'#208'?b'#207'7\'#205'/R'#202'%I'#199'#K'#198'5_'#202'Q'#131#211
+ +'u'#173#221#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#171#203#237#144#177
+ ,#229'|'#165#229'm'#157#231'a'#152#233']'#154#237'W'#153#239'P'#149#238'F'#140
+ +#234'>'#131#229'<~'#224'D'#219'Y'#138#214'w'#168#217#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#189#228#250#167#214#250#148#209#252#132#200#253'x'#191
+ +#252'r'#189#253'm'#187#253'g'#184#253'_'#181#252'['#178#252']'#183#252'f'#191
+ +#251'y'#194#247#149#208#241#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#214
+ +#242#254#178#220#255#149#195#255#132#181#255'v'#170#255'o'#165#255'i'#160#255
+ +'d'#156#255']'#153#255'Z'#152#255']'#156#255'i'#170#255#143#204#255#193#235
+ +#254#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#194#208#213#197#230#255#162
+ +#195#255#146#178#255#133#168#255''#161#255'y'#158#255't'#155#255'o'#150#255
+ +'l'#151#255'q'#156#255''#173#255#170#219#255#185#203#211#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#193#198#199#201#232#255#183#220#255#174#211#255#164
+ +#202#255#158#197#255#154#195#255#150#192#255#148#191#255#147#193#255#152#200
+ +#255#157#207#255#178#223#255#190#196#199#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+]);
+LazarusResources.Add('TFSJSCRIPT','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#196#14#0#0#196#14#0#0#0#0#0#0#0#0#0#0#200#208#212#200#208#212#200
+ +#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#128#128
+ +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
+ +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
+ +#128#128#128#128#128#128#128#128#200#208#212#200#208#212#200#208#212#200#208
+ +#212#200#208#212#200#208#212#200#208#212#207#156#156#207#156#156#207#156#156
+ +#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207
+ +#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156
+ +#156#128#128#128#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212
+ +#200#208#212#200#208#212#207#156#156#248#236#213#248#236#213#243#230#204#239
+ +#224#196#239#224#196#234#217#185#233#215#182#231#212#178#226#204#167#226#204
+ +#167#222#200#159#218#193#151#218#193#151#212#185#140#207#156#156#128#128#128
+ +#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200
+ +#208#212#207#156#156#248#236#213#248#236#213#243#230#204#243#230#204#239#224
+ +#196#236#220#189#234#217#185#231#212#178#228#209#173#226#204#167#222#200#159
+ +#222#200#159#218#193#151#218#193#151#207#156#156#128#128#128#200#208#212#200
+ +#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#212#161
+ +#161#255#246#228#248#236#213#248#236#213#0#0#0#0#0#0#236#220#189#236#220#189
+ +#0#0#0#0#0#0#0#0#0#226#204#167#222#200#159#222#200#159#218#193#151#207#156
+ +#156#128#128#128#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212
+ +#200#208#212#200#208#212#220#170#170#255#246#228#252#242#221#0#0#0#248#236
+ +#213#243#230#204#0#0#0#236#220#189#236#220#189#231#212#178#228#209#173#0#0#0
+ +#226#204#167#222#200#159#222#200#159#207#156#156#128#128#128#200#208#212#200
+ +#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#232#181
+ +#181#255#246#228#252#242#221#248#236#213#248#236#213#243#230#204#0#0#0#234
+ +#217#185#236#220#189#0#0#0#0#0#0#234#217#185#226#204#167#222#200#159#222#200
+ +#159#207#156#156#128#128#128#200#208#212#200#208#212#200#208#212#200#208#212
+ +#200#208#212#200#208#212#200#208#212#232#181#181#255#246#228#252#242#221#252
+ +#242#221#252#242#221#248#236#213#0#0#0#243#230#204#0#0#0#234#217#185#234#217
+ +#185#233#215#182#228#209#173#226#204#167#226#204#167#207#156#156#128#128#128
+ +#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200
+ +#208#212#244#192#192#255#246#228#255#246#228#255#246#228#0#0#0#0#0#0#0#0#0
+ +#248#236#213#243#230#204#0#0#0#0#0#0#0#0#0#234#217#185#234#217#185#226#204
+ +#167#207#156#156#128#128#128#200#208#212#200#208#212#232#181#181#157'hk'#137
+ +'ZS'#226#196#197#200#208#212#244#192#192#255#246#228#255#246#228#252#242#221
+ +#252#242#221#248#236#213#248#236#213#252#242#221#248#236#213#239#224#196#236
+ +#220#189#234#217#185#231#212#178#228#209#173#226#204#167#207#156#156#128#128
+ +#128#200#208#212#200#208#212'W'#211#250#23#221#213'_'#255#255'0qq'#22'UU"'#130#132#21'xy'#168#220#219'|AB*~'#128#24'gg'
+ +#0'rr'#4'|}'#162'os'#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#167#174#173
+ +#145'np7'#214#215#8#242#242'+WW'#0'XX'#0'jj'#216#198#198#11'lk9&&'#0'pp'#224
+ +#240#240#157#185#185#158'_dpUS'#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#187#133#137#162'[\A``4q'
+ +'q'#0'zz'#155#212#212#221#238#238'#'#242#242#24#255#255#215#255#255'5'#234
+ +#234#0#236#236';'#139#139'iJJ;'#146#147'Z'#129#129'X99'#192#192#192#192#192
+ +#192#234#184#182#168'hm'#139'_\'#223#192#189#192#192#192'k'#182#178'.'#166
+ +#160'@RSB'#175#175'd\Wo3,'#176#133#131#163#151#151'DJJ`BB<<<'#182#203#203#0
+ +#231#231'S'#18#18#20#149#149#129#181#181#216#214#214#192#192#192#192#192#192
+ +'e'#208#250#20#215#208'd8P^'#157#234#192#136#135'g'#175#251'4n'#173'n&'#29'n'
+ +')'#28'Mn'#163'.'#159#237'SC['#191#139#136#211#159#159#156'hh'#160'aa'#15#132
+ +#130#248#255#255#0#242#242#230#247#240#1#225#226'Z99'#192#192#192#192#192#192
+ +'V'#227#255#9#223#216'i/G-'#168#255'/'#146#249#141#208#255#213#157#149'$'#140
+ +#129#25#209#248'4'#141#251'%'#162#255'QGb'#157'b_]66J$$U$$E '#16#255#255#196
+ +#188#189#156'qu'#142'tx'#192#192#192#194'cc'#130';;wRR'#0#255#255#26#205#202
+ +'e7R$'#162#255#137#171#225#171#188#229'AY'#140'9Z'#151#173#229#255#255#234
+ +#228#136'UUU'#31#31#211#163#163#255#248#250#4#255#255#254#255#255#0#252#252
+ +#26'wt'#168'w|'#192#192#192#192#192#192#129'>A+'#163#255':'#146#240'~?Nb'#189
+ +#255#248#255#255#175#247#243#0#248#246#128#248#246#153#251#249#5#255#255#21
+ +#206#255'W>Y;v'#197'Y'#219#255'st'#255#0':'#255#255']"'#183#199
+ +#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202
+ +#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183
+ +#199#202#183#199#202#255']$'#183#199#202#183#199#202#183#199#202#255#134'5'
+ +#255#135'5'#255#131'4'#255'~4'#255'^#'#183#199#202#183#199#202#183#199#202
+ +#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183
+ +#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#255'`$'
+ +#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183
+ ,#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199
+ +#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202
+ +#183#199#202#183#199#202#255'_$'#255'^$'#255'^#'#255'[#'#255'_"'#183#199#202
+ +#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183
+ +#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199
+ +#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#255#130'4'
+ +#255#251#246#255#255#242#255#240#176#255']#'#183#199#202#183#199#202#183#199
+ +#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202
+ +#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183
+ +#199#202#183#199#202#183#199#202#183#199#202#255#132'5'#255#255#255#254#255
+ +#255#255#240#175#255'`$'#183#199#202#183#199#202#183#199#202#183#199#202#183
+ +#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199
+ +#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202
+ +#183#199#202#183#199#202#255#128'4'#255#129'4'#255#131'6'#255#132'6'#255']$'
+ +#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183
+ +#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199
+ +#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202
+ +#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183
+ +#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199
+ +#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202
+ +#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183
+ +#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199
+ +#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202
+ +#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183
+ +#199#202
+]);
diff --git a/FastScript/fs_ireg.pas b/FastScript/fs_ireg.pas
new file mode 100644
index 0000000..3e4b7ca
--- /dev/null
+++ b/FastScript/fs_ireg.pas
@@ -0,0 +1,90 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_ireg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+uses
+ Classes
+{$IFNDEF FPC}
+ {$IFNDEF Delphi6}
+ , DsgnIntf
+ {$ELSE}
+ , DesignIntf
+ {$ENDIF}
+{$ELSE}
+ ,PropEdits
+ ,LazarusPackageIntf
+ ,LResources
+{$ENDIF}
+{$IFDEF DELPHI16}
+ , Controls
+{$ENDIF}
+, fs_iinterpreter, fs_iclassesrtti, fs_igraphicsrtti, fs_iformsrtti,
+ fs_iextctrlsrtti, fs_idialogsrtti, fs_iinirtti, fs_imenusrtti,
+ fs_ipascal, fs_icpp, fs_ijs, fs_ibasic, fs_tree
+{$IFNDEF CLX}
+, fs_synmemo
+{$ENDIF}
+;
+
+{-----------------------------------------------------------------------}
+
+{$ifdef FPC}
+procedure RegisterUnitfs_ireg;
+{$else}
+procedure Register;
+{$endif}
+begin
+{$IFDEF DELPHI16}
+ {GroupDescendentsWith(TfsExtCtrlsRTTI, TControl);
+ GroupDescendentsWith(TfsDialogsRTTI, TControl);
+ GroupDescendentsWith(TfsGraphicsRTTI, TControl);
+ GroupDescendentsWith(TfsMenusRTTI, TControl);
+ GroupDescendentsWith(TfsScript, TControl);
+ GroupDescendentsWith(TfsIniRTTI, TControl);
+ GroupDescendentsWith(TfsFormsRTTI, TControl);
+ GroupDescendentsWith(TfsClassesRTTI, TControl);
+ GroupDescendentsWith(TfsPascal, TControl);
+ GroupDescendentsWith(TfsCPP, TControl);
+ GroupDescendentsWith(TfsJScript, TControl);
+ GroupDescendentsWith(TfsBasic, TControl);}
+{$ENDIF}
+ RegisterComponents('FastScript',
+ [TfsScript, TfsPascal, TfsCPP, TfsJScript, TfsBasic,
+ TfsClassesRTTI, TfsGraphicsRTTI, TfsFormsRTTI, TfsExtCtrlsRTTI,
+ TfsDialogsRTTI, TfsMenusRTTI, TfsIniRTTI,
+ TfsTree
+{$IFNDEF CLX}
+ , TfsSyntaxMemo
+{$ENDIF}
+ ]);
+end;
+
+{$ifdef FPC}
+procedure Register;
+begin
+ RegisterUnit('fs_ireg', @RegisterUnitfs_ireg);
+end;
+{$endif}
+
+initialization
+{$IFDEF FPC}
+ {$INCLUDE fs_ireg.lrs}
+{$ENDIF}
+end.
diff --git a/FastScript/fs_isysrtti.pas b/FastScript/fs_isysrtti.pas
new file mode 100644
index 0000000..c0dc1dc
--- /dev/null
+++ b/FastScript/fs_isysrtti.pas
@@ -0,0 +1,623 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Standard functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_isysrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, fs_itools
+{$IFDEF CLX}
+ , QDialogs, MaskUtils, Variants
+{$ELSE}
+ {$IFNDEF NOFORMS}
+ , Dialogs
+ {$ENDIF}
+ {$IFDEF FPC}
+ {, Mask}, Variants
+ {$ELSE}
+ {$IFDEF Delphi6}
+ , MaskUtils, Variants, Windows
+ {$ELSE}
+ , Mask
+ {$ENDIF}
+ {$ENDIF}
+{$ENDIF}
+{$IFDEF OLE}
+ , ComObj
+{$ENDIF};
+{$ELSE}
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_itools
+ {$IFNDEF NOFORMS}
+ , FMX.Dialogs
+ {$ENDIF}
+ , System.MaskUtils, System.Variants, FMX.Types
+ {$IFDEF OLE}
+ , System.Win.ComObj
+ {$ENDIF};
+{$ENDIF}
+
+type
+ TfsSysFunctions = class(TfsRTTIModule)
+ private
+ FCatConv: String;
+ FCatDate: String;
+ FCatFormat: String;
+ FCatMath: String;
+ FCatOther: String;
+ FCatStr: String;
+ function CallMethod1(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function CallMethod2(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function CallMethod3(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function CallMethod4(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function CallMethod5(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function CallMethod6(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function CallMethod7(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+implementation
+
+{$IFDEF FPC}
+uses lazutf8;
+{$ENDIF}
+
+
+function FormatV(const Fmt: String; Args: Variant): String;
+var
+ ar: TVarRecArray;
+ sPtrList: TList;
+begin
+ VariantToVarRec(Args, ar, sPtrList);
+ try
+ Result := Format(Fmt, ar);
+ finally
+ ClearVarRec(ar, sPtrList);
+ end;
+end;
+
+function VArrayCreate(Args: Variant; Typ: Integer): Variant;
+var
+ i, n: Integer;
+ ar: array of {$IFDEF FPC}SizeInt{$ELSE}Integer{$ENDIF};
+begin
+ n := VarArrayHighBound(Args, 1) + 1;
+ SetLength(ar, n);
+ for i := 0 to n - 1 do
+ ar[i] := Args[i];
+
+ Result := VarArrayCreate(ar, Typ);
+ ar := nil;
+end;
+
+function NameCase(const s: String): String;
+var
+ i: Integer;
+begin
+{$IFDEF FPC}
+ Result := UTF8LowerString(s);
+ for i := 1 to UTF8Length(s) do
+ if i = 1 then
+ begin
+ UTF8Insert(UTF8UpperString(UTF8Copy(s, i, 1)), Result, i + 1);
+ UTF8Delete(Result, i, 1);
+ end
+ else if i < UTF8Length(s) then
+ if UTF8Copy(s, i, 1)[1] = ' ' then
+ begin
+ UTF8Insert(UTF8UpperString(UTF8Copy(s, i + 1, 1)), Result, i + 2);
+ UTF8Delete(Result, i + 1, 1);
+ end;
+{$ELSE}
+ Result := AnsiLowercase(s);
+ for i := 1 to Length(s) do
+ if i = 1 then
+ Result[i] := AnsiUpperCase(s[i])[1]
+ else if i < Length(s) then
+ if s[i] = ' ' then
+ Result[i + 1] := AnsiUpperCase(s[i + 1])[1];
+ {$ENDIF}
+end;
+
+function ValidInt(cInt: String): Boolean;
+begin
+ Result := True;
+ try
+ StrToInt(cInt);
+ except
+ Result := False;
+ end;
+end;
+
+function ValidFloat(cFlt: String): Boolean;
+begin
+ Result := True;
+ try
+ StrToFloat(cFlt);
+ except
+ Result := False;
+ end;
+end;
+
+function ValidDate(cDate: String) :Boolean;
+begin
+ Result := True;
+ try
+ StrToDate(cDate);
+ except
+ Result := False;
+ end;
+end;
+
+function DaysInMonth(nYear, nMonth: Integer): Integer;
+const
+ Days: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
+begin
+ Result := Days[nMonth];
+ if (nMonth = 2) and IsLeapYear(nYear) then Inc(Result);
+end;
+
+
+{ TfsSysFunctions }
+
+constructor TfsSysFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ FCatStr := 'ctString';
+ FCatDate := 'ctDate';
+ FCatConv := 'ctConv';
+ FCatFormat := 'ctFormat';
+ FCatMath := 'ctMath';
+ FCatOther := 'ctOther';
+
+ with AScript do
+ begin
+ AddType('Byte', fvtInt);
+ AddType('Word', fvtInt);
+ AddType('Integer', fvtInt);
+{$IFDEF FS_INT64}
+ AddType('Int64', fvtInt64);
+{$ENDIF}
+ AddType('Longint', fvtInt);
+ AddType('Cardinal', fvtInt);
+ AddType('TColor', fvtInt);
+ AddType('TAlphaColor', fvtInt);
+ AddType('Boolean', fvtBool);
+ AddType('Real', fvtFloat);
+ AddType('Single', fvtFloat);
+ AddType('Double', fvtFloat);
+ AddType('Extended', fvtFloat);
+ AddType('Currency', fvtFloat);
+ AddType('TDate', fvtFloat);
+ AddType('TTime', fvtFloat);
+ AddType('TDateTime', fvtFloat);
+ AddType('Char', fvtChar);
+ AddType('String', fvtString);
+ AddType('Variant', fvtVariant);
+ AddType('Pointer', fvtVariant);
+ AddType('Array', fvtArray);
+ AddType('Constructor', fvtConstructor);
+
+ AddConst('True', 'Boolean', True);
+ AddConst('False', 'Boolean', False);
+ AddConst('nil', 'Variant', 0);
+ AddConst('Null', 'Variant', Null);
+
+ Add('__StringHelper', TfsStringHelper.Create);
+ Add('__ArrayHelper', TfsArrayHelper.Create('__ArrayHelper', -1, fvtVariant, ''));
+ AddVariable('ExceptionClassName', 'String', '');
+ AddVariable('ExceptionMessage', 'String', '');
+
+ AddMethod('function IntToStr(i: Integer): String', CallMethod1, FCatConv);
+ AddMethod('function FloatToStr(e: Extended): String', CallMethod1, FCatConv);
+ AddMethod('function DateToStr(e: Extended): String', CallMethod1, FCatConv);
+ AddMethod('function TimeToStr(e: Extended): String', CallMethod1, FCatConv);
+ AddMethod('function DateTimeToStr(e: Extended): String', CallMethod1, FCatConv);
+{$IFDEF Delphi6}
+ AddMethod('function BoolToStr(B: Boolean): string;', CallMethod1, FCatConv);
+{$ENDIF}
+ AddMethod('function VarToStr(v: Variant): String', CallMethod7, FCatConv);
+
+ AddMethod('function StrToInt(s: String): Integer', CallMethod2, FCatConv);
+{$IFDEF FS_INT64}
+ AddMethod('function StrToInt64(s: String): Int64', CallMethod2, FCatConv);
+{$ENDIF}
+ AddMethod('function StrToFloat(s: String): Extended', CallMethod2, FCatConv);
+ AddMethod('function StrToDate(s: String): Extended', CallMethod2, FCatConv);
+ AddMethod('function StrToTime(s: String): Extended', CallMethod2, FCatConv);
+ AddMethod('function StrToDateTime(s: String): Extended', CallMethod2, FCatConv);
+{$IFDEF Delphi6}
+ AddMethod('function StrToBool(const S: string): Boolean;', CallMethod2, FCatConv);
+{$ENDIF}
+
+ AddMethod('function Format(Fmt: String; Args: array): String', CallMethod3, FCatFormat);
+ AddMethod('function FormatFloat(Fmt: String; Value: Extended): String', CallMethod3, FCatFormat);
+ AddMethod('function FormatDateTime(Fmt: String; DateTime: TDateTime): String', CallMethod3, FCatFormat);
+ AddMethod('function FormatMaskText(EditMask: string; Value: string): string', CallMethod3, FCatFormat);
+
+ AddMethod('function EncodeDate(Year, Month, Day: Word): TDateTime', CallMethod4, FCatDate);
+ AddMethod('procedure DecodeDate(Date: TDateTime; var Year, Month, Day: Word)', CallMethod4, FCatDate);
+ AddMethod('function EncodeTime(Hour, Min, Sec, MSec: Word): TDateTime', CallMethod4, FCatDate);
+ AddMethod('procedure DecodeTime(Time: TDateTime; var Hour, Min, Sec, MSec: Word)', CallMethod4, FCatDate);
+ AddMethod('function Date: TDateTime', CallMethod4, FCatDate);
+ AddMethod('function Time: TDateTime', CallMethod4, FCatDate);
+ AddMethod('function Now: TDateTime', CallMethod4, FCatDate);
+ AddMethod('function DayOfWeek(aDate: TDateTime): Integer', CallMethod4, FCatDate);
+ AddMethod('function IsLeapYear(Year: Word): Boolean', CallMethod4, FCatDate);
+ AddMethod('function DaysInMonth(nYear, nMonth: Integer): Integer', CallMethod4, FCatDate);
+
+ AddMethod('function Length(s: Variant): Integer', CallMethod5, FCatStr);
+ AddMethod('function Copy(s: String; from, count: Integer): String', CallMethod5, FCatStr);
+ AddMethod('function Pos(substr, s: String): Integer', CallMethod5, FCatStr);
+ AddMethod('procedure Delete(var s: String; from, count: Integer)', CallMethod5, FCatStr);
+ AddMethod('procedure DeleteStr(var s: String; from, count: Integer)', CallMethod5, FCatStr);
+ AddMethod('procedure Insert(s: String; var s2: String; pos: Integer)', CallMethod5, FCatStr);
+ AddMethod('function Uppercase(s: String): String', CallMethod5, FCatStr);
+ AddMethod('function Lowercase(s: String): String', CallMethod5, FCatStr);
+ AddMethod('function Trim(s: String): String', CallMethod5, FCatStr);
+ AddMethod('function NameCase(s: String): String', CallMethod5, FCatStr);
+ AddMethod('function CompareText(s, s1: String): Integer', CallMethod5, FCatStr);
+ AddMethod('function Chr(i: Integer): Char', CallMethod5, FCatStr);
+ AddMethod('function Ord(ch: Char): Integer', CallMethod5, FCatStr);
+ AddMethod('procedure SetLength(var S: Variant; L: Integer)', CallMethod5, FCatStr);
+
+ AddMethod('function Round(e: Extended): Integer', CallMethod6, FCatMath);
+ AddMethod('function Trunc(e: Extended): Integer', CallMethod6, FCatMath);
+ AddMethod('function Int(e: Extended): Integer', CallMethod6, FCatMath);
+ AddMethod('function Frac(X: Extended): Extended', CallMethod6, FCatMath);
+ AddMethod('function Sqrt(e: Extended): Extended', CallMethod6, FCatMath);
+ AddMethod('function Abs(e: Extended): Extended', CallMethod6, FCatMath);
+ AddMethod('function Sin(e: Extended): Extended', CallMethod6, FCatMath);
+ AddMethod('function Cos(e: Extended): Extended', CallMethod6, FCatMath);
+ AddMethod('function ArcTan(X: Extended): Extended', CallMethod6, FCatMath);
+ AddMethod('function Tan(X: Extended): Extended', CallMethod6, FCatMath);
+ AddMethod('function Exp(X: Extended): Extended', CallMethod6, FCatMath);
+ AddMethod('function Ln(X: Extended): Extended', CallMethod6, FCatMath);
+ AddMethod('function Pi: Extended', CallMethod6, FCatMath);
+
+ AddMethod('procedure Inc(var i: Integer; incr: Integer = 1)', CallMethod7, FCatOther);
+ AddMethod('procedure Dec(var i: Integer; decr: Integer = 1)', CallMethod7, FCatOther);
+ AddMethod('procedure RaiseException(Param: String)', CallMethod7, FCatOther);
+ AddMethod('procedure ShowMessage(Msg: Variant)', CallMethod7, FCatOther);
+ AddMethod('procedure Randomize', CallMethod7, FCatOther);
+ AddMethod('function Random: Extended', CallMethod7, FCatOther);
+ AddMethod('function ValidInt(cInt: String): Boolean', CallMethod7, FCatOther);
+ AddMethod('function ValidFloat(cFlt: String): Boolean', CallMethod7, FCatOther);
+ AddMethod('function ValidDate(cDate: String): Boolean', CallMethod7, FCatOther);
+ AddMethod('function ExtractFilePath(const FileName: string): string;', CallMethod7, FCatOther);
+{$IFDEF OLE}
+ AddMethod('function CreateOleObject(ClassName: String): Variant', CallMethod7, FCatOther);
+{$ENDIF};
+ AddMethod('function VarArrayCreate(Bounds: Array; Typ: Integer): Variant', CallMethod7, FCatOther);
+ AddMethod('function VarType(V: Variant): Integer', CallMethod7, FCatOther);
+
+ AddConst('varEmpty', 'Integer', 0);
+ AddConst('varNull', 'Integer', 1);
+ AddConst('varSmallint', 'Integer', 2);
+ AddConst('varInteger', 'Integer', 3);
+ AddConst('varSingle', 'Integer', 4);
+ AddConst('varDouble', 'Integer', 5);
+ AddConst('varCurrency', 'Integer', 6);
+ AddConst('varDate', 'Integer', 7);
+ AddConst('varOleStr', 'Integer', 8);
+ AddConst('varDispatch', 'Integer', 9);
+ AddConst('varError', 'Integer', $000A);
+ AddConst('varBoolean', 'Integer', $000B);
+ AddConst('varVariant', 'Integer', $000C);
+ AddConst('varUnknown', 'Integer', $000D);
+ AddConst('varShortInt', 'Integer', $0010);
+ AddConst('varByte', 'Integer', $0011);
+ AddConst('varWord', 'Integer', $0012);
+ AddConst('varLongWord', 'Integer', $0013);
+ AddConst('varInt64', 'Integer', $0014);
+ AddConst('varStrArg', 'Integer', $0048);
+ AddConst('varString', 'Integer', $0100);
+ AddConst('varAny', 'Integer', $0101);
+ AddConst('varTypeMask', 'Integer', $0FFF);
+ AddConst('varArray', 'Integer', $2000);
+ AddConst('varByRef', 'Integer', $4000);
+ end;
+end;
+
+function TfsSysFunctions.CallMethod1(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+{$IFDEF DELPHI6}
+ i: Int64;
+{$ELSE}
+ i: Integer;
+{$ENDIF}
+begin
+ if MethodName = 'INTTOSTR' then
+ begin
+ i := Caller.Params[0];
+ Result := IntToStr(i)
+ end
+ else if MethodName = 'FLOATTOSTR' then
+ Result := FloatToStr(Caller.Params[0])
+ else if MethodName = 'DATETOSTR' then
+ Result := DateToStr(Caller.Params[0])
+ else if MethodName = 'TIMETOSTR' then
+ Result := TimeToStr(Caller.Params[0])
+ else if MethodName = 'DATETIMETOSTR' then
+ Result := DateTimeToStr(Caller.Params[0])
+{$IFDEF Delphi6}
+ else if MethodName = 'BOOLTOSTR' then
+ Result := BoolToStr(Caller.Params[0])
+{$ENDIF}
+end;
+
+function TfsSysFunctions.CallMethod2(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ if MethodName = 'STRTOINT' then
+ Result := StrToInt(Caller.Params[0])
+{$IFDEF DELPHI6}
+ else if MethodName = 'STRTOINT64' then
+ Result := StrToInt64(Caller.Params[0])
+{$ENDIF}
+ else if MethodName = 'STRTOFLOAT' then
+ Result := StrToFloat(Caller.Params[0])
+ else if MethodName = 'STRTODATE' then
+ Result := StrToDate(Caller.Params[0])
+ else if MethodName = 'STRTOTIME' then
+ Result := StrToTime(Caller.Params[0])
+ else if MethodName = 'STRTODATETIME' then
+ Result := StrToDateTime(Caller.Params[0])
+{$IFDEF Delphi6}
+ else if MethodName = 'STRTOBOOL' then
+ Result := BoolToStr(Caller.Params[0])
+{$ENDIF}
+end;
+
+function TfsSysFunctions.CallMethod3(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ if MethodName = 'FORMAT' then
+ Result := FormatV(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'FORMATFLOAT' then
+ Result := FormatFloat(Caller.Params[0], Caller.Params[1] * 1.00000)
+ else if MethodName = 'FORMATDATETIME' then
+ Result := FormatDateTime(Caller.Params[0], Caller.Params[1])
+{$IFNDEF FPC}
+// fpc still have no maskedit
+ else if MethodName = 'FORMATMASKTEXT' then
+ Result := FormatMaskText(Caller.Params[0], Caller.Params[1])
+{$ENDIF}
+end;
+
+function TfsSysFunctions.CallMethod4(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ w1, w2, w3, w4: Word;
+begin
+ if MethodName = 'ENCODEDATE' then
+ Result := EncodeDate(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'ENCODETIME' then
+ Result := EncodeTime(Caller.Params[0], Caller.Params[1], Caller.Params[2], Caller.Params[3])
+ else if MethodName = 'DECODEDATE' then
+ begin
+ DecodeDate(Caller.Params[0], w1, w2, w3);
+ Caller.Params[1] := w1;
+ Caller.Params[2] := w2;
+ Caller.Params[3] := w3;
+ end
+ else if MethodName = 'DECODETIME' then
+ begin
+ DecodeTime(Caller.Params[0], w1, w2, w3, w4);
+ Caller.Params[1] := w1;
+ Caller.Params[2] := w2;
+ Caller.Params[3] := w3;
+ Caller.Params[4] := w4;
+ end
+ else if MethodName = 'DATE' then
+ Result := Date
+ else if MethodName = 'TIME' then
+ Result := Time
+ else if MethodName = 'NOW' then
+ Result := Now
+ else if MethodName = 'DAYOFWEEK' then
+ Result := DayOfWeek(Caller.Params[0])
+ else if MethodName = 'ISLEAPYEAR' then
+ Result := IsLeapYear(Caller.Params[0])
+ else if MethodName = 'DAYSINMONTH' then
+ Result := DaysInMonth(Caller.Params[0], Caller.Params[1])
+end;
+
+function TfsSysFunctions.CallMethod5(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ s: String;
+ v: Variant;
+begin
+ if MethodName = 'LENGTH' then
+ begin
+ v := Caller.Params[0];
+ if VarIsArray(v) then
+ Result := VarArrayHighBound(v, 1) - VarArrayLowBound(v, 1) + 1
+ else
+ {$IFDEF FPC}
+ Result := UTF8Length(v)
+ {$ELSE}
+ Result := Length(v)
+ {$ENDIF}
+ end
+ else if MethodName = 'COPY' then
+ {$IFDEF FPC}
+ Result := UTF8Copy(Caller.Params[0], frxInteger(Caller.Params[1]), frxInteger(Caller.Params[2]))
+ {$ELSE}
+ Result := Copy(Caller.Params[0], frxInteger(Caller.Params[1]), frxInteger(Caller.Params[2]))
+ {$ENDIF}
+ else if MethodName = 'POS' then
+ {$IFNDEF FPC}
+ Result := Pos(Caller.Params[0], Caller.Params[1])
+ {$ELSE}
+ Result := UTF8Pos(AnsiString(Caller.Params[0]), AnsiString(Caller.Params[1]))
+ {$ENDIF}
+ else if (MethodName = 'DELETE') or (MethodName = 'DELETESTR') then
+ begin
+ s := Caller.Params[0];
+ {$IFNDEF FPC}
+ Delete(s, frxInteger(Caller.Params[1]), frxInteger(Caller.Params[2]));
+ {$ELSE}
+ UTF8Delete(s, frxInteger(Caller.Params[1]), frxInteger(Caller.Params[2]));
+ {$ENDIF}
+ Caller.Params[0] := s;
+ end
+ else if MethodName = 'INSERT' then
+ begin
+ s := Caller.Params[1];
+ {$IFNDEF FPC}
+ Insert(Caller.Params[0], s, Integer(Caller.Params[2]));
+ {$ELSE}
+ UTF8Insert(AnsiString(Caller.Params[0]), s, Integer(Caller.Params[2]));
+ {$ENDIF}
+ Caller.Params[1] := s;
+ end
+ else if MethodName = 'UPPERCASE' then
+ Result := {$IFDEF FPC}UTF8UpperString(Caller.Params[0]){$ELSE}AnsiUppercase(Caller.Params[0]){$ENDIF}
+ else if MethodName = 'LOWERCASE' then
+ Result := {$IFDEF FPC}UTF8LowerString(Caller.Params[0]){$ELSE}AnsiLowercase(Caller.Params[0]){$ENDIF}
+ else if MethodName = 'TRIM' then
+ Result := {$IFDEF FPC}UTF8Trim(Caller.Params[0]){$ELSE}Trim(Caller.Params[0]){$ENDIF}
+ else if MethodName = 'NAMECASE' then
+ Result := NameCase(Caller.Params[0])
+ else if MethodName = 'COMPARETEXT' then
+ Result := {$IFDEF FPC}UTF8CompareText(Caller.Params[0], Caller.Params[1]){$ELSE}AnsiCompareText(Caller.Params[0], Caller.Params[1]){$ENDIF}
+ else if MethodName = 'CHR' then
+ Result := Chr(Integer(Caller.Params[0]))
+ else if MethodName = 'ORD' then
+ Result := Ord(String(Caller.Params[0])[1])
+ else if MethodName = 'SETLENGTH' then
+ begin
+ if (TVarData(Caller.Params[0]).VType = varString) or
+{$IFDEF Delphi12}
+ (TVarData(Caller.Params[0]).VType = varUString) or
+{$ENDIF}
+ (TVarData(Caller.Params[0]).VType = varOleStr) then
+ begin
+ s := Caller.Params[0];
+ SetLength(s, Integer(Caller.Params[1]));
+ Caller.Params[0] := s;
+ end
+ else
+ begin
+ v := Caller.Params[0];
+ VarArrayRedim(v, Integer(Caller.Params[1]) - 1);
+ Caller.Params[0] := v;
+ end;
+ end
+end;
+
+function TfsSysFunctions.CallMethod6(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ if MethodName = 'ROUND' then
+ {$IFNDEF FPC}
+ Result := frxInteger(Round(Caller.Params[0] * 1.00000))
+ {$ELSE}
+ Result := frxInteger(Round(Extended(Caller.Params[0]) * 1.00000))
+ {$ENDIF}
+ else if MethodName = 'TRUNC' then
+ {$IFNDEF FPC}
+ Result := frxInteger(Trunc(Caller.Params[0] * 1.00000))
+ {$ELSE}
+ Result := frxInteger(Trunc(Extended(Caller.Params[0]) * 1.00000))
+ {$ENDIF}
+ else if MethodName = 'INT' then
+ Result := Int(Caller.Params[0] * 1.00000)
+ else if MethodName = 'FRAC' then
+ Result := Frac(Caller.Params[0] * 1.00000)
+ else if MethodName = 'SQRT' then
+ Result := Sqrt(Caller.Params[0] * 1.00000)
+ else if MethodName = 'ABS' then
+ Result := Abs(Caller.Params[0] * 1.00000)
+ else if MethodName = 'SIN' then
+ Result := Sin(Caller.Params[0] * 1.00000)
+ else if MethodName = 'COS' then
+ Result := Cos(Caller.Params[0] * 1.00000)
+ else if MethodName = 'ARCTAN' then
+ Result := ArcTan(Caller.Params[0] * 1.00000)
+ else if MethodName = 'TAN' then
+ Result := Sin(Caller.Params[0] * 1.00000) / Cos(Caller.Params[0] * 1.00000)
+ else if MethodName = 'EXP' then
+ Result := Exp(Caller.Params[0] * 1.00000)
+ else if MethodName = 'LN' then
+ Result := Ln(Caller.Params[0] * 1.00000)
+ else if MethodName = 'PI' then
+ Result := Pi
+end;
+
+function TfsSysFunctions.CallMethod7(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ if MethodName = 'INC' then
+ begin
+ Caller.Params[0] := Caller.Params[0] + Caller.Params[1];
+ end
+ else if MethodName = 'DEC' then
+ begin
+ Caller.Params[0] := Caller.Params[0] - Caller.Params[1];
+ end
+ else if MethodName = 'RAISEEXCEPTION' then
+ raise Exception.Create(Caller.Params[0])
+{$IFNDEF NOFORMS}
+ else if MethodName = 'SHOWMESSAGE' then
+ ShowMessage(Caller.Params[0])
+{$ENDIF}
+ else if MethodName = 'RANDOMIZE' then
+ Randomize
+ else if MethodName = 'RANDOM' then
+ Result := Random
+ else if MethodName = 'VALIDINT' then
+ Result := ValidInt(Caller.Params[0])
+ else if MethodName = 'VALIDFLOAT' then
+ Result := ValidFloat(Caller.Params[0])
+ else if MethodName = 'VALIDDATE' then
+ begin
+ if VarType(Caller.Params[0]) = varDate then
+ Result := ValidDate(DateToStr(Caller.Params[0]))
+ else Result := ValidDate(Caller.Params[0]);
+ end
+{$IFDEF OLE}
+ else if MethodName = 'CREATEOLEOBJECT' then
+ Result := CreateOleObject(Caller.Params[0])
+{$ENDIF}
+ else if MethodName = 'VARARRAYCREATE' then
+ Result := VArrayCreate(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'VARTOSTR' then
+ Result := VarToStr(Caller.Params[0])
+ else if MethodName = 'VARTYPE' then
+ Result := VarType(Caller.Params[0])
+ else if MethodName = 'EXTRACTFILEPATH' then
+ Result := ExtractFilePath(Caller.Params[0])
+end;
+
+
+end.
diff --git a/FastScript/fs_iteereg.pas b/FastScript/fs_iteereg.pas
new file mode 100644
index 0000000..6ddbd56
--- /dev/null
+++ b/FastScript/fs_iteereg.pas
@@ -0,0 +1,46 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_iteereg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ Classes
+{$IFNDEF Delphi6}
+, DsgnIntf
+{$ELSE}
+{$IFDEF DELPHI16}
+, Controls
+{$ENDIF}
+, DesignIntf
+{$ENDIF}
+, fs_ichartrtti;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+{$IFDEF DELPHI16}
+// GroupDescendentsWith(TfsChartRTTI, TControl);
+{$ENDIF}
+ RegisterComponents('FastScript',
+ [TfsChartRTTI]);
+end;
+
+end.
diff --git a/FastScript/fs_itools.pas b/FastScript/fs_itools.pas
new file mode 100644
index 0000000..0600c66
--- /dev/null
+++ b/FastScript/fs_itools.pas
@@ -0,0 +1,712 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Common functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_itools;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, TypInfo, fs_iinterpreter, fs_xml
+{$IFDEF Delphi6}
+, Variants
+{$ENDIF}
+{$IFDEF CROSS_COMPILE}
+, Types
+{$ELSE}
+, Windows
+{$ENDIF};
+// FMX USES section
+{$ELSE}
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, System.TypInfo, FMX.fs_iinterpreter, FMX.fs_xml
+{$IFDEF Delphi6}
+, System.Variants
+{$ENDIF}
+, System.Types, FMX.Types;
+{$ENDIF}
+
+type
+ TVarRecArray = array of TVarRec;
+
+
+procedure fsRegisterLanguage(const Name, Grammar: String);
+function fsGetLanguage(const Name: String): String;
+procedure fsGetLanguageList(List: TStrings);
+
+procedure GenerateXMLContents(Prog: TfsScript; Item: TfsXMLItem;
+ FunctionsOnly: Boolean = False);
+procedure GenerateMembers(Prog: TfsScript; cl: TClass; Item: TfsXMLItem);
+function StrToVarType(const TypeName: String; Script: TfsScript): TfsVarType;
+function TypesCompatible(Typ1, Typ2: TfsTypeRec; Script: TfsScript): Boolean;
+function AssignCompatible(Var1, Var2: TfsCustomVariable; Script: TfsScript): Boolean;
+function VarRecToVariant(v: TVarRec): Variant;
+procedure VariantToVarRec(v: Variant; var ar: TVarRecArray; var sPtrList: Tlist);
+procedure ClearVarRec(var ar: TVarRecArray; var sPtrList: TList);
+function ParserStringToVariant(s: String): Variant;
+function ParseMethodSyntax(const Syntax: String; Script: TfsScript): TfsCustomVariable;
+function fsPosToPoint(const ErrorPos: String): TPoint;
+{$IFNDEF Delphi4}
+function fsSetToString(PropInfo: PPropInfo; const Value: Variant): string;
+{$ENDIF}
+
+implementation
+//VCL uses section
+{$IFNDEF FMX}
+uses
+ fs_iparser,
+ fs_iconst;
+//FMX uses section
+{$ELSE}
+uses
+ FMX.fs_iparser,
+ FMX.fs_iconst;
+{$ENDIF}
+
+var
+ Languages: TStringList;
+
+procedure fsRegisterLanguage(const Name, Grammar: String);
+var
+ i: Integer;
+begin
+ i := Languages.IndexOfName(Name);
+ if i = -1 then
+ Languages.Add(Name + '=' + Grammar)
+ else
+ Languages[i] := Name + '=' + Grammar;
+end;
+
+function fsGetLanguage(const Name: String): String;
+begin
+ if Languages.IndexOfName(Name) = -1 then
+ raise Exception.CreateFmt(SLangNotFound, [Name]) else
+ Result := Languages.Values[Name];
+end;
+
+procedure fsGetLanguageList(List: TStrings);
+var
+ i: Integer;
+begin
+ List.Clear;
+ for i := 0 to Languages.Count - 1 do
+ if Languages.Names[i][1] <> '@' then
+ List.Add(Languages.Names[i]);
+end;
+
+
+function StrToVarType(const TypeName: String; Script: TfsScript): TfsVarType;
+var
+ v: TfsCustomVariable;
+begin
+ v := Script.Find(TypeName);
+ if v = nil then
+ Result := fvtClass else
+ Result := v.Typ;
+end;
+
+function ClassesCompatible(const Class1, Class2: String; Script: TfsScript): Boolean;
+var
+ cl1, cl2: TfsClassVariable;
+begin
+ Result := False;
+ cl1 := Script.FindClass(Class1);
+ cl2 := Script.FindClass(Class2);
+ if (cl1 <> nil) and (cl2 <> nil) then
+ Result := cl2.ClassRef.InheritsFrom(cl1.ClassRef);
+end;
+
+function TypesCompatible(Typ1, Typ2: TfsTypeRec; Script: TfsScript): Boolean;
+begin
+ Result := False;
+ case Typ1.Typ of
+ fvtInt:
+ Result := Typ2.Typ in [fvtInt, fvtFloat, fvtVariant, fvtEnum, fvtInt64];
+{$IFDEF FS_INT64}
+ fvtInt64:
+ Result := Typ2.Typ in [fvtInt64, fvtInt, fvtFloat, fvtVariant, fvtEnum];
+{$ENDIF}
+ fvtFloat:
+ Result := Typ2.Typ in [fvtInt, fvtFloat, fvtVariant];
+ fvtBool:
+ Result := Typ2.Typ in [fvtBool, fvtVariant];
+ fvtChar, fvtString:
+ Result := Typ2.Typ in [fvtChar, fvtString, fvtVariant];
+ fvtClass:
+ Result := (Typ2.Typ = fvtVariant) or ((Typ2.Typ = fvtClass) and
+ ClassesCompatible(Typ1.TypeName, Typ2.TypeName, Script));
+ fvtArray:
+ Result := Typ2.Typ in [fvtArray, fvtVariant];
+ fvtVariant:
+ Result := True;
+ fvtEnum:
+ begin
+ Result := Typ2.Typ in [fvtInt, fvtInt64, fvtVariant, fvtEnum];
+ if Typ2.Typ = fvtEnum then
+ Result := AnsiCompareText(Typ1.TypeName, Typ2.TypeName) = 0;
+ end;
+ end;
+end;
+
+function AssignCompatible(Var1, Var2: TfsCustomVariable; Script: TfsScript): Boolean;
+var
+ t1, t2: TfsTypeRec;
+begin
+ t1.Typ := Var1.Typ;
+ t1.TypeName := Var1.TypeName;
+ t2.Typ := Var2.Typ;
+ t2.TypeName := Var2.TypeName;
+
+ Result := TypesCompatible(t1, t2, Script);
+ if Result and (Var1.Typ = fvtInt) and (Var2.Typ = fvtFloat) then
+ Result := False;
+end;
+
+function VarRecToVariant(v: TVarRec): Variant;
+begin
+ with v do
+ case VType of
+{$IFDEF FS_INT64}
+ vtInt64:
+ Result := VInt64^;
+{$ENDIF}
+{$IFDEF CPUX64}
+ vtInteger:
+ Result := VInteger;
+ vtObject:
+ Result := frxInteger(VObject);
+{$ELSE}
+ vtInteger, vtObject:
+ Result := VInteger;
+{$ENDIF}
+ vtBoolean:
+ Result := VBoolean;
+ vtExtended, vtCurrency:
+ Result := VExtended^;
+ vtChar:
+ Result := VChar;
+ vtString:
+ Result := VString^;
+ vtAnsiString:
+ Result := AnsiString(VAnsiString);
+{$IFDEF Delphi12}
+ vtUnicodeString:
+ Result := String(VUnicodeString);
+ vtWideString:
+ Result := WideString(VWideString);
+ vtWideChar:
+ Result := VWideChar;
+{$ENDIF}
+ vtVariant:
+ Result := VVariant^;
+ else
+ Result := Null;
+ end;
+end;
+
+procedure VariantToVarRec(v: Variant; var ar: TVarRecArray; var sPtrList: TList);
+var
+ i: Integer;
+{$IFDEF Delphi12}
+ pWStr: PWideString;
+{$ELSE}
+{$IFDEF FPC}
+ pWStr: PWideString;
+{$ELSE}
+ pAStr: PAnsiString;
+{$ENDIF}
+{$ENDIF}
+begin
+ SetLength(ar, VarArrayHighBound(v, 1) + 1);
+
+ sPtrList := TList.Create;
+ for i := 0 to VarArrayHighBound(v, 1) do
+ case TVarData(v[i]).VType of
+ varSmallint, varInteger, varByte{$IFDEF Delphi6}, varShortInt, varWord, varLongWord{$ENDIF}:
+ begin
+ ar[i].VType := vtInteger;
+ ar[i].VInteger := v[i];
+ end;
+{$IFDEF DELPHI6}
+ varInt64:
+ begin
+ ar[i].VType := vtInt64;
+ New(ar[i].VInt64);
+ ar[i].VInt64^ := v[i];
+ end;
+{$ENDIF}
+ varSingle, varDouble, varCurrency, varDate:
+ begin
+ ar[i].VType := vtExtended;
+ New(ar[i].VExtended);
+ ar[i].VExtended^ := v[i];
+ end;
+ varBoolean:
+ begin
+ ar[i].VType := vtBoolean;
+ ar[i].VBoolean := v[i];
+ end;
+ varString:
+ begin
+ ar[i].VType := vtString;
+ New(ar[i].VString);
+{$IFDEF Delphi12}
+ ar[i].VString^ := AnsiString(v[i]);
+{$ELSE}
+ ar[i].VString^ := v[i];
+{$ENDIF}
+ end;
+ varOleStr:
+ begin
+{$IFDEF Delphi12}
+ ar[i].VType := vtWideString;
+ New(pWStr);
+ sPtrList.Add(pWStr);
+ pWStr^ := WideString(v[i]);
+ ar[i].VWideString := PWideString(pWStr^);
+{$ELSE}
+{$IFDEF FPC}
+ ar[i].VType := vtWideString;
+ New(pWStr);
+ sPtrList.Add(pWStr);
+ pWStr^ := WideString(v[i]);
+ ar[i].VWideString := PWideString(pWStr^);
+{$ELSE}
+ ar[i].VType := vtAnsiString;
+ //New(ar[i].VAnsiString);
+ New(pAStr);
+ sPtrList.Add(pAStr);
+ pAStr^ := AnsiString(v[i]);
+ ar[i].VAnsiString := PAnsiString(pAStr^);
+{$ENDIF}
+{$ENDIF}
+ end;
+{$IFDEF Delphi12}
+ varUString:
+ begin
+ ar[i].VType := vtUnicodeString;
+ New(ar[i].VUnicodeString);
+ PUnicodeString(ar[i].VUnicodeString)^ := v[i];
+ end;
+{$ENDIF}
+ varVariant:
+ begin
+ ar[i].VType := vtVariant;
+ New(ar[i].VVariant);
+ ar[i].VVariant^ := v[i];
+ end;
+ end;
+end;
+
+procedure ClearVarRec(var ar: TVarRecArray; var sPtrList: TList);
+var
+ i: Integer;
+begin
+ for i := 0 to Length(ar) - 1 do
+ if ar[i].VType in [vtExtended, vtString, vtVariant {$IFDEF Delphi6}, vtInt64 {$ENDIF}] then
+ Dispose(ar[i].VExtended)
+{$IFDEF Delphi12}
+ else if ar[i].VType in [vtWideString] then
+ WideString(ar[i].VWideString) := ''
+{$ENDIF}
+ else if ar[i].VType in [vtAnsiString] then
+ AnsiString(ar[i].VAnsiString) := '';
+ for i := 0 to sPtrList.Count - 1 do
+ Dispose(sPtrList[i]);
+ sPtrList.Free;
+ Finalize(ar);
+end;
+
+function ParserStringToVariant(s: String): Variant;
+var
+ i: Int64;
+ k: Integer;
+ iPos: Integer;
+begin
+ Result := Null;
+ if s <> '' then
+ if s[1] = '''' then
+ Result := Copy(s, 2, Length(s) - 2)
+ else
+ begin
+ Val(s, i, k);
+ if k = 0 then
+{$IFDEF Delphi6}
+ if i > MaxInt then
+ Result := i
+ else
+ Result := Integer(i)
+{$ELSE}
+ Result := Integer(i)
+{$ENDIF}
+ else
+ begin
+{$IFDEF FMX}
+ if FormatSettings.DecimalSeparator <> '.' then
+{$ELSE}
+{$IFDEF DELPHI16}
+ if FormatSettings.DecimalSeparator <> '.' then
+{$ELSE}
+ if DecimalSeparator <> '.' then
+{$ENDIF}
+{$ENDIF}
+ begin
+ iPos := Pos('.', s);
+ if iPos > 0 then
+ s[iPos] := {$IFDEF DELPHI16}FormatSettings.{$ENDIF}DecimalSeparator;
+ end;
+ Result := StrToFloat(s);
+ end;
+ end;
+end;
+
+function ParseMethodSyntax(const Syntax: String; Script: TfsScript): TfsCustomVariable;
+var
+ Parser: TfsParser;
+ i, j: Integer;
+ Name, Params, TypeName, s: String;
+ isFunc, isMacro, varParam: Boolean;
+ InitValue: Variant;
+ IsParamWithDef: Boolean;
+ v: TfsCustomVariable;
+
+ procedure AddParams;
+ var
+ i: Integer;
+ p: TfsParamItem;
+ sl: TStringList;
+ begin
+ sl := TStringList.Create;
+ try
+ Delete(Params, Length(Params), 1);
+ sl.CommaText := Params;
+ for i := 0 to sl.Count - 2 do
+ begin
+ p := TfsParamItem.Create(sl[i], StrToVarType(TypeName, Script), TypeName,
+ False, varParam);
+ Result.Add(p);
+ end;
+ p := TfsParamItem.Create(sl[sl.Count - 1], StrToVarType(TypeName, Script), TypeName,
+ IsParamWithDef, varParam);
+ p.DefValue := InitValue;
+ Result.Add(p);
+
+ finally
+ sl.Free;
+ end;
+ end;
+
+begin
+ Parser := TfsParser.Create;
+ if Script.ExtendedCharset then
+ for i := 128 to 255 do
+ Parser.IdentifierCharset := Parser.IdentifierCharset + [Chr(i)];
+ Parser.Text := Syntax;
+
+ s := Parser.GetIdent;
+ isMacro := Pos('macro', AnsiLowercase(s)) = 1;
+ if isMacro then
+ s := Copy(s, 6, 255);
+ isFunc := CompareText(s, 'function') = 0;
+ Name := Parser.GetIdent;
+
+ if isFunc then
+ begin
+ j := Length(Syntax);
+ while (Syntax[j] <> ':') and (j <> 0) do
+ Dec(j);
+
+ i := Parser.Position;
+ Parser.Position := j + 1;
+ TypeName := Parser.GetIdent;
+ Parser.Position := i;
+ end
+ else
+ TypeName := '';
+
+ Result := TfsCustomVariable.Create(Name, StrToVarType(TypeName, Script), TypeName);
+ Result.IsMacro := IsMacro;
+
+ Parser.SkipSpaces;
+ s := Parser.GetChar;
+ if s = '(' then
+ begin
+ repeat
+ varParam := False;
+ Params := '';
+
+ repeat
+ s := Parser.GetIdent;
+ if CompareText(s, 'var') = 0 then
+ varParam := True
+ else if CompareText(s, 'const') = 0 then // do nothing
+ else
+ Params := Params + s + ',';
+ Parser.SkipSpaces;
+ s := Parser.GetChar;
+ if s = ':' then
+ begin
+ TypeName := Parser.GetIdent;
+ Parser.SkipSpaces;
+ i := Parser.Position;
+ IsParamWithDef:=False;
+ if Parser.GetChar = '=' then
+ begin
+ IsParamWithDef:=True;
+ s := Parser.GetNumber;
+ if s = '' then
+ s := Parser.GetString;
+ if s = '' then
+ begin
+ i := Parser.Position;
+ s := Parser.GetChar;
+ if s = '-' then
+ s := '-' + Parser.GetNumber else
+ Parser.Position := i;
+ end;
+
+ if s <> '' then
+ InitValue := ParserStringToVariant(s)
+ else
+ begin
+ s := Parser.GetIdent; { it's constant }
+ v := Script.Find(s);
+ if v <> nil then
+ InitValue := v.Value else
+ InitValue := Null;
+ end
+ end
+ else
+ begin
+ InitValue := Null;
+ Parser.Position := i;
+ end;
+ AddParams;
+ s := ';';
+ end
+ else if s = ')' then
+ begin
+ Parser.Position := Parser.Position - 1;
+ break;
+ end;
+ until s = ';';
+
+ Parser.SkipSpaces;
+ until Parser.GetChar = ')';
+ end;
+
+ Parser.Free;
+end;
+
+function fsPosToPoint(const ErrorPos: String): TPoint;
+begin
+ Result.X := 0;
+ Result.Y := 0;
+ if ErrorPos <> '' then
+ begin
+ Result.Y := StrToInt(Copy(ErrorPos, 1, Pos(':', ErrorPos) - 1));
+ Result.X := StrToInt(Copy(ErrorPos, Pos(':', ErrorPos) + 1, 255));
+ end;
+end;
+
+procedure GenerateXMLContents(Prog: TfsScript; Item: TfsXMLItem;
+ FunctionsOnly: Boolean = False);
+var
+ i, j: Integer;
+ v: TfsCustomVariable;
+ c: TfsClassVariable;
+ xi: TfsXMLItem;
+ clItem: TfsCustomHelper;
+ s: String;
+begin
+ Item.FindItem('Functions');
+ Item.FindItem('Classes');
+ Item.FindItem('Types');
+ Item.FindItem('Variables');
+ Item.FindItem('Constants');
+
+ for i := 0 to Prog.Count - 1 do
+ begin
+ v := Prog.Items[i];
+ if not (v is TfsMethodHelper) and FunctionsOnly then
+ continue;
+ if v is TfsMethodHelper then
+ begin
+ xi := Item.FindItem('Functions');
+ xi := xi.FindItem(TfsMethodHelper(v).Category);
+ xi.Text := 'text="' + xi.Name + '"';
+ with xi.Add do
+ begin
+ Name := 'item';
+ s := TfsMethodHelper(v).Syntax;
+ Text := 'text="' + s + '" description="' +
+ TfsMethodHelper(v).Description + '"';
+ end;
+ end
+ else if v is TfsClassVariable then
+ begin
+ c := TfsClassVariable(v);
+ xi := Item.FindItem('Classes');
+ xi := xi.Add;
+ with xi do
+ begin
+ Name := 'item';
+ Text := 'text="' + c.Name + ' = class(' + c.Ancestor + ')"';
+ end;
+
+ for j := 0 to c.MembersCount - 1 do
+ begin
+ clItem := c.Members[j];
+ with xi.Add do
+ begin
+ Name := 'item';
+ Text := 'text="';
+ if clItem is TfsPropertyHelper then
+ Text := Text + 'property ' + clItem.Name + ': ' + clItem.GetFullTypeName + '"'
+ else if clItem is TfsMethodHelper then
+ begin
+ s := TfsMethodHelper(clItem).Syntax;
+ if TfsMethodHelper(clItem).IndexMethod then
+ s := 'index property' + Copy(s, Pos(' ', s), 255);
+ Text := Text + s + '"';
+ end
+ else
+ Text := Text + 'event ' + clItem.Name + '"';
+ end;
+ end;
+ end
+ else if v is TfsVariable then
+ begin
+ if v.Typ = fvtEnum then
+ begin
+ xi := Item.FindItem('Types');
+ with xi.FindItem(v.TypeName) do
+ begin
+ if v.Name <> v.TypeName then
+ if Text = '' then
+ Text := v.Name else
+ Text := Text + ',' + v.Name;
+ end;
+ end
+ else
+ begin
+ if v.IsReadOnly then
+ xi := Item.FindItem('Constants') else
+ xi := Item.FindItem('Variables');
+ with xi.Add do
+ begin
+ Name := 'item';
+ Text := 'text="' + v.Name + ': ' + v.GetFullTypeName;
+ if v.IsReadOnly then
+ Text := Text + ' = ' + VarToStr(v.Value);
+ Text := Text + '"';
+ end;
+ end;
+ end;
+ end;
+
+ xi := Item.FindItem('types');
+ for i := 0 to xi.Count - 1 do
+ if xi[i].Name <> 'item' then
+ begin
+ xi[i].Text := 'text="' + xi[i].Name + ': (' + xi[i].Text + ')"';
+ xi[i].Name := 'item';
+ end;
+end;
+
+procedure GenerateMembers(Prog: TfsScript; cl: TClass; Item: TfsXMLItem);
+var
+ i, j: Integer;
+ v: TfsCustomVariable;
+ c: TfsClassVariable;
+ xi: TfsXMLItem;
+ clItem: TfsCustomHelper;
+ s: String;
+begin
+ for i := 0 to Prog.Count - 1 do
+ begin
+ v := Prog.Items[i];
+ if v is TfsClassVariable then
+ begin
+ c := TfsClassVariable(v);
+ if cl.InheritsFrom(c.ClassRef) then
+ begin
+ xi := Item;
+ for j := 0 to c.MembersCount - 1 do
+ begin
+ clItem := c.Members[j];
+ with xi.Add do
+ begin
+ Name := 'item';
+ Text := 'text="';
+ if clItem is TfsPropertyHelper then
+ Text := Text + 'property ' + clItem.Name + ': ' + clItem.GetFullTypeName + '"'
+ else if clItem is TfsMethodHelper then
+ begin
+ s := TfsMethodHelper(clItem).Syntax;
+ if TfsMethodHelper(clItem).IndexMethod then
+ s := 'index property' + Copy(s, Pos(' ', s), 255);
+ Text := Text + s + '"';
+ end
+ else
+ Text := Text + 'event ' + clItem.Name + '"';
+ end;
+ end;
+ end;
+ end;
+ end;
+end;
+
+{$IFNDEF Delphi4}
+function fsSetToString(PropInfo: PPropInfo; const Value: Variant): string;
+var
+ S: TIntegerSet;
+ TypeInfo: PTypeInfo;
+ I: Integer;
+begin
+ Result := '';
+{$IFNDEF FPC}
+ TypeInfo := GetTypeData(PropInfo^.PropType^)^.CompType^;
+{$ELSE}
+ TypeInfo := GetTypeData(PropInfo^.PropType)^.CompType;
+{$ENDIF}
+
+ Integer(S) := 0;
+ if VarIsArray(Value) then
+ for I := 0 to VarArrayHighBound(Value, 1) do
+ begin
+ Integer(S) := Integer(S) or Value[I];
+ end;
+
+ for I := 0 to SizeOf(Integer) * 8 - 1 do
+ if I in S then
+ begin
+ if Result <> '' then
+ Result := Result + ',';
+ Result := Result + GetEnumName(TypeInfo, I);
+ end;
+ Result := '[' + Result + ']';
+end;
+{$ENDIF}
+
+initialization
+ Languages := TStringList.Create;
+
+finalization
+ Languages.Free;
+
+end.
\ No newline at end of file
diff --git a/FastScript/fs_lazarus.lpk b/FastScript/fs_lazarus.lpk
new file mode 100644
index 0000000..3002007
--- /dev/null
+++ b/FastScript/fs_lazarus.lpk
@@ -0,0 +1,159 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/FastScript/fs_lazarus.pas b/FastScript/fs_lazarus.pas
new file mode 100644
index 0000000..7b46f56
--- /dev/null
+++ b/FastScript/fs_lazarus.pas
@@ -0,0 +1,25 @@
+{ This file was automatically created by Lazarus. do not edit!
+ This source is only used to compile and install the package.
+ }
+
+unit fs_lazarus;
+
+interface
+
+uses
+ fs_ipascal, fs_icpp, fs_ijs, fs_ibasic, fs_iclassesrtti, fs_iconst,
+ fs_idialogsrtti, fs_ievents, fs_iexpression, fs_iextctrlsrtti,
+ fs_iformsrtti, fs_igraphicsrtti, fs_iilparser, fs_iinirtti, fs_iinterpreter,
+ fs_iparser, fs_isysrtti, fs_itools, fs_xml, fs_ireg, fs_synmemo, fs_tree,
+ fs_idbrtti, LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+ RegisterUnit('fs_ireg', @fs_ireg.Register);
+end;
+
+initialization
+ RegisterPackage('fs_lazarus', @Register);
+end.
diff --git a/FastScript/fs_synmemo.dfm b/FastScript/fs_synmemo.dfm
new file mode 100644
index 0000000..de03635
Binary files /dev/null and b/FastScript/fs_synmemo.dfm differ
diff --git a/FastScript/fs_synmemo.lfm b/FastScript/fs_synmemo.lfm
new file mode 100644
index 0000000..f594eee
--- /dev/null
+++ b/FastScript/fs_synmemo.lfm
@@ -0,0 +1,56 @@
+object fsSynMemoSearch: TfsSynMemoSearch
+ Left = 289
+ Height = 50
+ Top = 229
+ Width = 243
+ HorzScrollBar.Page = 242
+ VertScrollBar.Page = 49
+ ActiveControl = Edit1
+ BorderStyle = bsToolWindow
+ Caption = 'Search'
+ ClientHeight = 50
+ ClientWidth = 243
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ KeyPreview = True
+ OnKeyPress = FormKeyPress
+ Position = poScreenCenter
+ LCLVersion = '0.9.29'
+ object Label1: TLabel
+ Left = 6
+ Height = 13
+ Top = 7
+ Width = 69
+ AutoSize = False
+ Caption = 'Text to find'
+ ParentColor = False
+ end
+ object Search: TButton
+ Left = 111
+ Height = 17
+ Top = 31
+ Width = 58
+ BorderSpacing.InnerBorder = 4
+ Caption = 'Search'
+ ModalResult = 1
+ TabOrder = 0
+ end
+ object Button1: TButton
+ Left = 175
+ Height = 17
+ Top = 31
+ Width = 61
+ BorderSpacing.InnerBorder = 4
+ Cancel = True
+ Caption = 'Cancel'
+ ModalResult = 2
+ TabOrder = 1
+ end
+ object Edit1: TEdit
+ Left = 80
+ Height = 21
+ Top = 4
+ Width = 156
+ TabOrder = 2
+ end
+end
diff --git a/FastScript/fs_synmemo.pas b/FastScript/fs_synmemo.pas
new file mode 100644
index 0000000..8b4df07
--- /dev/null
+++ b/FastScript/fs_synmemo.pas
@@ -0,0 +1,2113 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Syntax memo control }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+{ Simple syntax highlighter. Supports Pascal, C++, JS, VB and SQL syntax.
+
+ Assign text to Text property.
+ Assign desired value to SyntaxType property.
+ Call SetPos to move caret.
+ Call ShowMessage to display an error message at the bottom.
+}
+
+unit fs_synmemo;
+
+interface
+
+{$I fs.inc}
+
+uses
+{$IFNDEF FPC}
+ Windows, Messages,
+{$ELSE}
+ LCLType, LMessages, Buttons, LCLIntf,
+{$ENDIF}
+ StdCtrls, Controls, Classes,
+ SysUtils, Graphics, Forms, Menus;
+
+type
+
+ TSyntaxType = (stPascal, stCpp, stJs, stVB, stSQL, stText);
+ TCharAttr = (caNo, caText, caBlock, caComment, caKeyword, caString);
+ TCharAttributes = set of TCharAttr;
+
+{$i frxPlatformsAttribute.inc}
+ TfsSyntaxMemo = class(TCustomControl)
+ private
+ FAllowLinesChange: Boolean;
+ FCharHeight: Integer;
+ FCharWidth: Integer;
+ FDoubleClicked: Boolean;
+ FDown: Boolean;
+ FGutterWidth: Integer;
+ FFooterHeight: Integer;
+ FIsMonoType: Boolean;
+ FKeywords: String;
+ FMaxLength: Integer;
+ FMessage: String;
+ FModified: Boolean;
+ FMoved: Boolean;
+ FOffset: TPoint;
+ FPos: TPoint;
+ FReadOnly: Boolean;
+ FSelEnd: TPoint;
+ FSelStart: TPoint;
+ FSynStrings: TStrings;
+ FSyntaxType: TSyntaxType;
+ FTempPos: TPoint;
+ FText: TStringList;
+ FKeywordAttr: TFont;
+ FStringAttr: TFont;
+ FTextAttr: TFont;
+ FCommentAttr: TFont;
+ FBlockColor: TColor;
+ FBlockFontColor: TColor;
+ FUndo: TStringList;
+ FUpdating: Boolean;
+ FUpdatingSyntax: Boolean;
+ FVScroll: TScrollBar;
+ FWindowSize: TPoint;
+ FPopupMenu: TPopupMenu;
+ KWheel: Integer;
+ LastSearch: String;
+ FShowGutter: boolean;
+ FShowFooter: boolean;
+ Bookmarks: array of Integer;
+ FActiveLine: Integer;
+ FOnChange: TNotifyEvent;
+ function GetText: TStrings;
+ procedure SetText(Value: TStrings);
+ procedure SetSyntaxType(Value: TSyntaxType);
+ procedure SetShowGutter(Value: boolean);
+ procedure SetShowFooter(Value: boolean);
+ function FMemoFind(Text: String; var Position : TPoint): boolean;
+ function GetCharAttr(Pos: TPoint): TCharAttributes;
+ function GetLineBegin(Index: Integer): Integer;
+ function GetPlainTextPos(Pos: TPoint): Integer;
+ function GetPosPlainText(Pos: Integer): TPoint;
+ function GetSelText: String;
+ function LineAt(Index: Integer): String;
+ function LineLength(Index: Integer): Integer;
+ function Pad(n: Integer): String;
+ procedure AddSel;
+ procedure AddUndo;
+ procedure ClearSel;
+ procedure CreateSynArray;
+ procedure DoChange;
+ procedure EnterIndent;
+ procedure SetSelText(Value: String);
+ procedure ShiftSelected(ShiftRight: Boolean);
+ procedure ShowCaretPos;
+ procedure TabIndent;
+ procedure UnIndent;
+ procedure UpdateScrollBar;
+ procedure UpdateSyntax;
+ procedure DoLeft;
+ procedure DoRight;
+ procedure DoUp;
+ procedure DoDown;
+ procedure DoHome(Ctrl: Boolean);
+ procedure DoEnd(Ctrl: Boolean);
+ procedure DoPgUp;
+ procedure DoPgDn;
+ procedure DoChar(Ch: Char);
+ procedure DoReturn;
+ procedure DoDel;
+ procedure DoBackspace;
+ procedure DoCtrlI;
+ procedure DoCtrlU;
+ procedure DoCtrlR;
+ procedure DoCtrlL;
+ procedure ScrollClick(Sender: TObject);
+ procedure ScrollEnter(Sender: TObject);
+ procedure LinesChange(Sender: TObject);
+ procedure ShowPos;
+ procedure BookmarkDraw(Y :integer; ALine : integer);
+ procedure ActiveLineDraw(Y :integer; ALine : integer);
+ procedure CorrectBookmark(Line : integer; delta : integer);
+ procedure SetKeywordAttr(Value: TFont);
+ procedure SetStringAttr(Value: TFont);
+ procedure SetTextAttr(Value: TFont);
+ procedure SetCommentAttr(Value: TFont);
+
+ protected
+ { Windows-specific stuff }
+ procedure CreateParams(var Params: TCreateParams); override;
+ procedure WMGetDlgCode(var Message: {$IFNDEF FPC}TWMGetDlgCode{$ELSE}TLMNoParams{$ENDIF}); message {$IFNDEF FPC}WM_GETDLGCODE{$ELSE}LM_GETDLGCODE{$ENDIF};
+ procedure WMKillFocus(var Msg: {$IFNDEF FPC}TWMKillFocus{$ELSE}TLMKillFocus{$ENDIF}); message {$IFNDEF FPC}WM_KILLFOCUS{$ELSE}LM_KILLFOCUS{$ENDIF};
+ procedure WMSetFocus(var Msg: {$IFNDEF FPC}TWMSetFocus{$ELSE}TLMSetFocus{$ENDIF}); message {$IFNDEF FPC}WM_SETFOCUS{$ELSE}LM_SETFOCUS{$ENDIF};
+ {$IFNDEF FPC}
+ procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
+ {$ELSE}
+ procedure FontChanged(Sender: TObject); override;
+ {$ENDIF}
+ { End of stuff }
+ procedure SetParent(Value: TWinControl); override;
+ function GetClientRect: TRect; override;
+ procedure DblClick; override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer); override;
+ procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer); override;
+ procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+ procedure KeyPress(var Key: Char); override;
+ procedure CopyPopup(Sender: TObject);
+ procedure PastePopup(Sender: TObject);
+ procedure CutPopup(Sender: TObject);
+{$IFDEF Delphi4}
+ procedure MouseWheelUp(Sender: TObject; Shift: TShiftState;
+ MousePos: TPoint; var Handled: Boolean);
+ procedure MouseWheelDown(Sender: TObject; Shift: TShiftState;
+ MousePos: TPoint; var Handled: Boolean);
+{$ENDIF}
+ procedure DOver(Sender, Source: TObject; X, Y: Integer;
+ State: TDragState; var Accept: Boolean);
+ procedure DDrop(Sender, Source: TObject; X, Y: Integer);
+
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
+ procedure Paint; override;
+ procedure CopyToClipboard;
+ procedure CutToClipboard;
+ procedure PasteFromClipboard;
+ procedure SetPos(x, y: Integer);
+ procedure ShowMessage(s: String);
+ procedure Undo;
+ procedure UpdateView;
+ function GetPos: TPoint;
+ function Find(Text: String): boolean;
+ property Modified: Boolean read FModified write FModified;
+ property SelText: String read GetSelText write SetSelText;
+ function IsBookmark(Line : integer): integer;
+ procedure AddBookmark(Line, Number : integer);
+ procedure DeleteBookmark(Number : integer);
+ procedure GotoBookmark(Number : integer);
+ procedure SetActiveLine(Line : Integer);
+ function GetActiveLine: Integer;
+
+ published
+ property Align;
+ property Anchors;
+ property BiDiMode;
+ property Color;
+ property Constraints;
+ property DragCursor;
+ property DragKind;
+ property DragMode;
+ property Enabled;
+ property Font;
+ property ParentColor;
+ property ParentBiDiMode;
+{$IFNDEF FPC}
+ property ParentCtl3D;
+{$ENDIF}
+ property ParentFont;
+ property ParentShowHint;
+ property PopupMenu;
+ property ShowHint;
+ property TabOrder;
+ property TabStop;
+ property Width;
+ property Height;
+ property Visible;
+ property BlockColor: TColor read FBlockColor write FBlockColor;
+ property BlockFontColor: TColor read FBlockFontColor write FBlockFontColor;
+ property CommentAttr: TFont read FCommentAttr write SetCommentAttr;
+ property KeywordAttr: TFont read FKeywordAttr write SetKeywordAttr;
+ property StringAttr: TFont read FStringAttr write SetStringAttr;
+ property TextAttr: TFont read FTextAttr write SetTextAttr;
+ property Lines: TStrings read GetText write SetText;
+ property ReadOnly: Boolean read FReadOnly write FReadOnly;
+ property SyntaxType: TSyntaxType read FSyntaxType write SetSyntaxType;
+ property ShowFooter: boolean read FShowFooter write SetShowFooter;
+ property ShowGutter: boolean read FShowGutter write SetShowGutter;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ property OnClick;
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEndDrag;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ property OnStartDrag;
+ end;
+
+ TfsSynMemoSearch = class(TForm)
+ Search: TButton;
+ Button1: TButton;
+ Label1: TLabel;
+ Edit1: TEdit;
+ procedure FormKeyPress(Sender: TObject; var Key: Char);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ SynMemoSearch: TfsSynMemoSearch;
+
+implementation
+
+{$IFNDEF FPC}
+ {$R *.dfm}
+{$ELSE}
+ {$R *.lfm}
+{$ENDIF}
+
+uses Clipbrd, comctrls;
+
+const
+ PasKeywords =
+ 'and,array,begin,case,const,div,do,downto,else,end,except,finally,'+
+ 'for,function,if,in,is,mod,nil,not,of,or,procedure,program,repeat,shl,'+
+ 'shr,string,then,to,try,until,uses,var,while,with,xor';
+
+ CppKeywords =
+ 'bool,break,case,char,continue,define,default,delete,do,double,else,'+
+ 'except,finally,float,for,if,include,int,is,new,return,string,switch,try,'+
+ 'variant,void,while';
+
+ SQLKeywords =
+ 'active,after,all,alter,and,any,as,asc,ascending,at,auto,' +
+ 'base_name,before,begin,between,by,cache,cast,check,column,commit,' +
+ 'committed,computed,conditional,constraint,containing,count,create,' +
+ 'current,cursor,database,debug,declare,default,delete,desc,descending,' +
+ 'distinct,do,domain,drop,else,end,entry_point,escape,exception,execute,' +
+ 'exists,exit,external,extract,filter,for,foreign,from,full,function,' +
+ 'generator,grant,group,having,if,in,inactive,index,inner,insert,into,is,' +
+ 'isolation,join,key,left,level,like,merge,names,no,not,null,of,on,only,' +
+ 'or,order,outer,parameter,password,plan,position,primary,privileges,' +
+ 'procedure,protected,read,retain,returns,revoke,right,rollback,schema,' +
+ 'select,set,shadow,shared,snapshot,some,suspend,table,then,to,' +
+ 'transaction,trigger,uncommitted,union,unique,update,user,using,values,' +
+ 'view,wait,when,where,while,with,work';
+
+ JSKeywords =
+ 'break,case,continue,default,delete,do,else,except,finally,for,function,' +
+ 'import,in,is,if,new,return,switch,try,var,while,with';
+
+ VBKeywords =
+ 'addressof,and,as,byref,byval,case,catch,delete,dim,do,else,elseif,' +
+ 'end,endif,exit,finally,for,function,if,imports,is,loop,mod,new,next,' +
+ 'not,or,rem,return,select,set,step,sub,then,to,try,wend,while,with,xor';
+
+
+ WordChars = ['a'..'z', 'A'..'Z', '0'..'9', '_'];
+
+{$IFDEF Linux}
+ LineBreak: AnsiString = #$A;
+{$ELSE}
+ LineBreak: String = #$D#$A;
+{$ENDIF}
+
+{$IFDEF Delphi12}
+function IsUnicodeChar(Chr: Char): Boolean;
+begin
+ Result := ((Chr >= Char($007F)) and (Chr <= Char($FFFF)));
+end;
+{$ENDIF}
+
+{type
+ THackScrollBar = class(TScrollBar);
+}
+
+
+{ TfsSyntaxMemo }
+
+constructor TfsSyntaxMemo.Create(AOwner: TComponent);
+var
+ m: TMenuItem;
+ i: integer;
+begin
+ inherited Create(AOwner);
+
+ FVScroll := TScrollBar.Create(Self);
+
+ FCommentAttr := TFont.Create;
+ FCommentAttr.Color := clNavy;
+ FCommentAttr.Style := [fsItalic];
+
+ FKeywordAttr := TFont.Create;
+ FKeywordAttr.Color := clWindowText;
+ FKeywordAttr.Style := [fsBold];
+
+ FStringAttr := TFont.Create;
+ FStringAttr.Color := clNavy;
+ FStringAttr.Style := [];
+
+ FTextAttr := TFont.Create;
+ FTextAttr.Color := clWindowText;
+ FTextAttr.Style := [];
+
+
+ FText := TStringList.Create;
+ FUndo := TStringList.Create;
+ FSynStrings := TStringList.Create;
+ if AOwner is TWinControl then
+ Parent := AOwner as TWinControl;
+
+ OnDragOver := DOver;
+ OnDragDrop := DDrop;
+
+{$IFDEF Delphi4}
+ OnMouseWheelUp := MouseWheelUp;
+ OnMouseWheelDown := MouseWheelDown;
+ KWheel := 1;
+{$ENDIF}
+
+ FText.Add('');
+ FText.OnChange := LinesChange;
+ FMaxLength := 1024;
+ SyntaxType := stPascal;
+ FMoved := True;
+ SetPos(1, 1);
+ FOffset := Point(0, 0);
+
+ Cursor := crIBeam;
+ FBlockColor := clHighlight;
+ FBlockFontColor := clHighlightText;
+
+ Font.Size := 10;
+ Font.Name := 'Courier New';
+
+ FPopupMenu := TPopupMenu.Create(Self);
+ m := TMenuItem.Create(FPopupMenu);
+ m.Caption := 'Cut';
+ m.OnClick := CutPopup;
+ FPopupMenu.Items.Add(m);
+ m := TMenuItem.Create(FPopupMenu);
+ m.Caption := 'Copy';
+ m.OnClick := CopyPopup;
+ FPopupMenu.Items.Add(m);
+ m := TMenuItem.Create(FPopupMenu);
+ m.Caption := 'Paste';
+ m.OnClick := PastePopup;
+ FPopupMenu.Items.Add(m);
+
+ LastSearch := '';
+ Setlength(Bookmarks, 10);
+ for i := 0 to Length(Bookmarks)-1 do
+ Bookmarks[i] := -1;
+
+ FActiveLine := -1;
+
+ Height := 200;
+ Width := 200;
+
+end;
+
+destructor TfsSyntaxMemo.Destroy;
+begin
+ FPopupMenu.Free;
+ FCommentAttr.Free;
+ FKeywordAttr.Free;
+ FStringAttr.Free;
+ FTextAttr.Free;
+ FText.Free;
+ FUndo.Free;
+ FSynStrings.Free;
+ FVScroll.Free;
+ inherited;
+end;
+
+{ Windows-specific stuff }
+
+procedure TfsSyntaxMemo.CreateParams(var Params: TCreateParams);
+begin
+ inherited;
+ with Params do
+ ExStyle := ExStyle or WS_EX_CLIENTEDGE;
+end;
+
+procedure TfsSyntaxMemo.WMKillFocus(var Msg: {$IFNDEF FPC}TWMKillFocus{$ELSE}TLMKillFocus{$ENDIF});
+begin
+ inherited;
+
+ HideCaret(Handle);
+ DestroyCaret{$IFDEF FPC}(Handle){$ENDIF};
+end;
+
+procedure TfsSyntaxMemo.WMSetFocus(var Msg: {$IFNDEF FPC}TWMSetFocus{$ELSE}TLMSetFocus{$ENDIF});
+begin
+ inherited;
+ CreateCaret(Handle, 0, 2, FCharHeight);
+ ShowCaretPos;
+end;
+
+procedure TfsSyntaxMemo.ShowCaretPos;
+begin
+ SetCaretPos(FCharWidth * (FPos.X - 1 - FOffset.X) + FGutterWidth,
+ FCharHeight * (FPos.Y - 1 - FOffset.Y));
+ ShowCaret(Handle);
+ ShowPos;
+end;
+
+procedure TfsSyntaxMemo.ShowPos;
+begin
+ if FFooterHeight > 0 then
+ with Canvas do
+ begin
+ Font.Name := 'Tahoma';
+ Font.Color := clBlack;
+ Font.Style := [];
+ Font.Size := 8;
+ Brush.Color := clBtnFace;
+ {$IFDEF FPC}
+ FillRect(FGutterWidth + 4, Height - TextHeight('|') - 5, Width - 5, Height - 5);
+ {$ENDIF}
+ TextOut(FGutterWidth + 4, Height - TextHeight('|') - 5, IntToStr(FPos.y) + ' : ' + IntToStr(FPos.x) + ' ');
+ end;
+end;
+
+procedure TfsSyntaxMemo.WMGetDlgCode(var Message: {$IFNDEF FPC}TWMGetDlgCode{$ELSE}TLMNoParams{$ENDIF});
+begin
+ Message.Result := DLGC_WANTARROWS or DLGC_WANTTAB or DLGC_WANTALLKEYS or DLGC_WANTCHARS;
+end;
+
+{$IFNDEF FPC}
+procedure TfsSyntaxMemo.CMFontChanged(var Message: TMessage);
+{$ELSE}
+procedure TfsSyntaxMemo.FontChanged(Sender: TObject);
+{$ENDIF}
+var
+ b: TBitmap;
+begin
+ FCommentAttr.Size := Font.Size;
+ FCommentAttr.Name := Font.Name;
+ FKeywordAttr.Size := Font.Size;
+ FKeywordAttr.Name := Font.Name;
+ FStringAttr.Size := Font.Size;
+ FStringAttr.Name := Font.Name;
+ FTextAttr.Size := Font.Size;
+ FTextAttr.Name := Font.Name;
+
+ b := TBitmap.Create;
+ with b.Canvas do
+ begin
+ Font.Assign(Self.Font);
+ Font.Style := [fsBold];
+ FCharHeight := TextHeight('Wg');
+ FCharWidth := TextWidth('W');
+ {$IFNDEF FPC}
+ FIsMonoType := Pos('COURIER NEW', AnsiUppercase(Self.Font.Name)) <> 0;
+ {$ELSE}
+ FIsMonoType := Font.IsMonoSpace;
+ {$ENDIF}
+ end;
+ b.Free;
+end;
+
+{ End of stuff }
+
+procedure TfsSyntaxMemo.SetParent(Value: TWinControl);
+begin
+ inherited SetParent(Value);
+ if (Parent = nil) or (csDestroying in ComponentState) then Exit;
+
+ DoubleBuffered := True;
+ ShowGutter := True;
+ ShowFooter := True;
+ FVScroll.Parent := Self;
+ FVScroll.Kind := sbVertical;
+ FVScroll.OnChange := ScrollClick;
+ FVScroll.OnEnter := ScrollEnter;
+{$IFNDEF FPC}
+ FVScroll.Ctl3D := False;
+{$ENDIF}
+ Color := clWindow;
+ TabStop := True;
+end;
+
+
+function TfsSyntaxMemo.GetClientRect: TRect;
+begin
+ if FVScroll.Visible then
+ Result := Bounds(0, 0, Width - FVScroll.Width - 4, Height) else
+ Result := inherited GetClientRect;
+end;
+
+procedure TfsSyntaxMemo.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
+begin
+ inherited;
+ if FCharWidth = 0 then exit;
+ FWindowSize := Point((ClientWidth - FGutterWidth) div FCharWidth,
+ (Height - FFooterHeight) div FCharHeight );
+ FVScroll.SetBounds(Width - FVScroll.Width - 4, 0, FVScroll.Width, Height - 4);
+ UpdateScrollBar;
+end;
+
+procedure TfsSyntaxMemo.UpdateSyntax;
+begin
+ CreateSynArray;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.UpdateScrollBar;
+begin
+ with FVScroll do
+ begin
+// prevent OnScroll event
+ FUpdating := True;
+
+ Position := 0;
+ PageSize := 0;
+ Max := FText.Count;
+ SmallChange := 1;
+ if FWindowSize.Y < Max then
+ begin
+ Visible := True;
+ PageSize := FWindowSize.Y;
+ end
+ else
+ Visible := False;
+ LargeChange := FWindowSize.Y;
+ Position := FOffset.Y;
+
+// need to do this due to bug in the VCL
+// THackScrollBar(FVScroll).RecreateWnd;
+ FUpdating := False;
+ end;
+end;
+
+function TfsSyntaxMemo.GetText: TStrings;
+var
+ i: Integer;
+begin
+ for i := 0 to FText.Count - 1 do
+ FText[i] := LineAt(i);
+ Result := FText;
+ FAllowLinesChange := True;
+end;
+
+procedure TfsSyntaxMemo.SetText(Value: TStrings);
+begin
+ FAllowLinesChange := True;
+ FText.Assign(Value);
+end;
+
+procedure TfsSyntaxMemo.SetSyntaxType(Value: TSyntaxType);
+begin
+ FSyntaxType := Value;
+ if Value = stPascal then
+ FKeywords := PasKeywords
+ else if Value = stCpp then
+ FKeywords := CppKeywords
+ else if Value = stSQL then
+ FKeywords := SQLKeywords
+ else if Value = stVB then
+ FKeywords := VBKeywords
+ else if Value = stJS then
+ FKeywords := JSKeywords
+ else
+ FKeywords := '';
+ UpdateSyntax;
+end;
+
+function TfsSyntaxMemo.GetPos: TPoint;
+begin
+ Result := FPos;
+end;
+
+procedure TfsSyntaxMemo.DoChange;
+begin
+ FModified := True;
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+end;
+
+procedure TfsSyntaxMemo.LinesChange(Sender: TObject);
+begin
+ if FAllowLinesChange then
+ begin
+ UpdateSyntax;
+ FAllowLinesChange := False;
+ if FText.Count = 0 then
+ FText.Add('');
+ FMoved := True;
+ FUndo.Clear;
+ //FPos := Point(1, 1);
+ // FOffset := Point(0, 0);
+ SetPos(FPos.X, FPos.Y);
+ ClearSel;
+ ShowCaretPos;
+ UpdateScrollBar;
+ end;
+end;
+
+procedure TfsSyntaxMemo.ShowMessage(s: String);
+begin
+ FMessage := s;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.CopyToClipboard;
+begin
+ if FSelStart.X <> 0 then
+ Clipboard.AsText := SelText;
+end;
+
+procedure TfsSyntaxMemo.CutToClipboard;
+begin
+ if not FReadOnly then
+ begin
+ if FSelStart.X <> 0 then
+ begin
+ Clipboard.AsText := SelText;
+ SelText := '';
+ end;
+ CorrectBookmark(FSelStart.Y, FSelStart.Y - FSelEnd.Y);
+ Repaint;
+ end;
+end;
+
+procedure TfsSyntaxMemo.PasteFromClipboard;
+begin
+ if not FReadOnly then
+ SelText := Clipboard.AsText;
+end;
+
+function TfsSyntaxMemo.LineAt(Index: Integer): String;
+begin
+ if Index < FText.Count then
+ Result := TrimRight(FText[Index])
+ else
+ Result := '';
+end;
+
+function TfsSyntaxMemo.LineLength(Index: Integer): Integer;
+begin
+ if Index < 0 then
+ Result := 0 else
+ Result := Length(LineAt(Index));
+end;
+
+function TfsSyntaxMemo.Pad(n: Integer): String;
+begin
+ result := '';
+ SetLength(result, n);
+{$IFDEF Delphi12}
+ Result := StringOfChar(Char(' '), n)
+{$ELSE}
+ FillChar(result[1], n, Char(' '));
+{$ENDIF}
+end;
+
+procedure TfsSyntaxMemo.AddUndo;
+begin
+ if not FMoved then exit;
+ FUndo.Add(Format('%5d%5d', [FPos.X, FPos.Y]) + FText.Text);
+ if FUndo.Count > 32 then
+ FUndo.Delete(0);
+end;
+
+procedure TfsSyntaxMemo.Undo;
+var
+ s: String;
+begin
+ FMoved := True;
+ if FUndo.Count = 0 then exit;
+ s := FUndo[FUndo.Count - 1];
+ FPos.X := StrToInt(Copy(s, 1, 5));
+ FPos.Y := StrToInt(Copy(s, 6, 5));
+ FText.Text := Copy(s, 11, Length(s) - 10);
+ FUndo.Delete(FUndo.Count - 1);
+ SetPos(FPos.X, FPos.Y);
+ UpdateSyntax;
+ DoChange;
+end;
+
+function TfsSyntaxMemo.GetPlainTextPos(Pos: TPoint): Integer;
+var
+ i: Integer;
+begin
+ Result := 0;
+ for i := 0 to Pos.Y - 2 do
+ Result := Result + Length(FText[i]) + Length(LineBreak);
+ Result := Result + Pos.X;
+end;
+
+function TfsSyntaxMemo.GetPosPlainText(Pos: Integer): TPoint;
+var
+ i: Integer;
+ s: String;
+begin
+ Result := Point(0, 1);
+ s := FText.Text;
+ i := 1;
+ while i <= Pos do
+{$IFDEF Delphi12}
+ if s[i] = Char(LineBreak[1]) then
+{$ELSE}
+ if s[i] = LineBreak[1] then
+{$ENDIF}
+ begin
+ Inc(i, Length(LineBreak));
+ if i <= Pos then
+ begin
+ Inc(Result.Y);
+ Result.X := 0;
+ end
+ else
+ Inc(Result.X);
+ end
+ else
+ begin
+ Inc(i);
+ Inc(Result.X);
+ end;
+end;
+
+function TfsSyntaxMemo.GetLineBegin(Index: Integer): Integer;
+var
+ s: String;
+begin
+ s := FText[Index];
+ Result := 1;
+ if Trim(s) <> '' then
+ for Result := 1 to Length(s) do
+ if s[Result] <> ' ' then
+ break;
+end;
+
+procedure TfsSyntaxMemo.TabIndent;
+var
+ i, n, res: Integer;
+ s: String;
+begin
+ res := FPos.X;
+ i := FPos.Y - 2;
+
+ while i >= 0 do
+ begin
+ res := FPos.X;
+ s := FText[i];
+ n := LineLength(i);
+
+ if res > n then
+ Dec(i)
+ else
+ begin
+ if s[res] = ' ' then
+ begin
+ while s[res] = ' ' do
+ Inc(res);
+ end
+ else
+ begin
+ while (res <= n) and (s[res] <> ' ') do
+ Inc(res);
+
+ while (res <= n) and (s[res] = ' ') do
+ Inc(res);
+ end;
+ break;
+ end;
+ end;
+
+ SelText := Pad(res - FPos.X);
+end;
+
+procedure TfsSyntaxMemo.EnterIndent;
+var
+ res: Integer;
+begin
+ if Trim(FText[FPos.Y - 1]) = '' then
+ res := FPos.X else
+ res := GetLineBegin(FPos.Y - 1);
+
+ CorrectBookmark(FPos.Y, 1);
+
+ FPos := Point(1, FPos.Y + 1);
+ SelText := Pad(res - 1);
+end;
+
+procedure TfsSyntaxMemo.UnIndent;
+var
+ i, res: Integer;
+begin
+ i := FPos.Y - 2;
+ res := FPos.X - 1;
+ CorrectBookmark(FPos.Y, -1);
+ while i >= 0 do
+ begin
+ res := GetLineBegin(i);
+ if (res < FPos.X) and (Trim(FText[i]) <> '') then
+ break else
+ Dec(i);
+ end;
+ FSelStart := FPos;
+ FSelEnd := FPos;
+ Dec(FSelEnd.X, FPos.X - res);
+ SelText := '';
+end;
+
+procedure TfsSyntaxMemo.ShiftSelected(ShiftRight: Boolean);
+var
+ i, ib, ie: Integer;
+ s: String;
+ Shift: Integer;
+begin
+ if FReadOnly then exit;
+ AddUndo;
+ if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
+ begin
+ ib := FSelStart.Y - 1;
+ ie := FSelEnd.Y - 1;
+ end
+ else
+ begin
+ ib := FSelEnd.Y - 1;
+ ie := FSelStart.Y - 1;
+ end;
+ if FSelEnd.X = 1 then
+ Dec(ie);
+
+ Shift := 2;
+ if not ShiftRight then
+ for i := ib to ie do
+ begin
+ s := FText[i];
+ if (Trim(s) <> '') and (GetLineBegin(i) - 1 < Shift) then
+ Shift := GetLineBegin(i) - 1;
+ end;
+
+ for i := ib to ie do
+ begin
+ s := FText[i];
+ if ShiftRight then
+ s := Pad(Shift) + s
+ else if Trim(s) <> '' then
+ Delete(s, 1, Shift);
+ FText[i] := s;
+ end;
+ UpdateSyntax;
+ DoChange;
+end;
+
+function TfsSyntaxMemo.GetSelText: String;
+var
+ p1, p2: TPoint;
+ i: Integer;
+begin
+ if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
+ begin
+ p1 := FSelStart;
+ p2 := FSelEnd;
+ Dec(p2.X);
+ end
+ else
+ begin
+ p1 := FSelEnd;
+ p2 := FSelStart;
+ Dec(p2.X);
+ end;
+
+ if LineLength(p1.Y - 1) < p1.X then
+ begin
+ Inc(p1.Y);
+ p1.X := 1;
+ end;
+ if LineLength(p2.Y - 1) < p2.X then
+ p2.X := LineLength(p2.Y - 1);
+
+ i := GetPlainTextPos(p1);
+ Result := Copy(FText.Text, i, GetPlainTextPos(p2) - i + 1);
+end;
+
+procedure TfsSyntaxMemo.SetSelText(Value: String);
+var
+ p1, p2, p3: TPoint;
+ i: Integer;
+ s: String;
+begin
+ if FReadOnly then exit;
+ AddUndo;
+ if FSelStart.X = 0 then
+ begin
+ p1 := FPos;
+ p2 := p1;
+ Dec(p2.X);
+ end
+ else if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
+ begin
+ p1 := FSelStart;
+ p2 := FSelEnd;
+ Dec(p2.X);
+ end
+ else
+ begin
+ p1 := FSelEnd;
+ p2 := FSelStart;
+ Dec(p2.X);
+ end;
+
+ if LineLength(p1.Y - 1) < p1.X then
+ FText[p1.Y - 1] := FText[p1.Y - 1] + Pad(p1.X - LineLength(p1.Y - 1) + 1);
+ if LineLength(p2.Y - 1) < p2.X then
+ p2.X := LineLength(p2.Y - 1);
+
+ i := GetPlainTextPos(p1);
+ s := FText.Text;
+ Delete(s, i, GetPlainTextPos(p2) - i + 1);
+ Insert(Value, s, i);
+ FText.Text := s;
+ p3 := GetPosPlainText(i + Length(Value));
+
+ CorrectBookmark(FPos.Y, p3.y-FPos.Y);
+
+ SetPos(p3.X, p3.Y);
+ FSelStart.X := 0;
+ DoChange;
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.ClearSel;
+begin
+ if FSelStart.X <> 0 then
+ begin
+ FSelStart := Point(0, 0);
+ Repaint;
+ end;
+end;
+
+procedure TfsSyntaxMemo.AddSel;
+begin
+ if FSelStart.X = 0 then
+ FSelStart := FTempPos;
+ FSelEnd := FPos;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.SetPos(x, y: Integer);
+begin
+ if FMessage <> '' then
+ begin
+ FMessage := '';
+ Repaint;
+ end;
+
+ if x > FMaxLength then x := FMaxLength;
+ if x < 1 then x := 1;
+ if y > FText.Count then y := FText.Count;
+ if y < 1 then y := 1;
+
+ FPos := Point(x, y);
+ if (FWindowSize.X = 0) or (FWindowSize.Y = 0) then exit;
+
+ if FOffset.Y >= FText.Count then
+ FOffset.Y := FText.Count - 1;
+
+ if FPos.X > FOffset.X + FWindowSize.X then
+ begin
+ Inc(FOffset.X, FPos.X - (FOffset.X + FWindowSize.X));
+ Repaint;
+ end
+ else if FPos.X <= FOffset.X then
+ begin
+ Dec(FOffset.X, FOffset.X - FPos.X + 1);
+ Repaint;
+ end
+ else if FPos.Y > FOffset.Y + FWindowSize.Y then
+ begin
+ Inc(FOffset.Y, FPos.Y - (FOffset.Y + FWindowSize.Y));
+ Repaint;
+ end
+ else if FPos.Y <= FOffset.Y then
+ begin
+ Dec(FOffset.Y, FOffset.Y - FPos.Y + 1);
+ Repaint;
+ end;
+
+ ShowCaretPos;
+ UpdateScrollBar;
+
+end;
+
+procedure TfsSyntaxMemo.ScrollClick(Sender: TObject);
+begin
+ if FUpdating then exit;
+ FOffset.Y := FVScroll.Position;
+ if FOffset.Y > FText.Count then
+ FOffset.Y := FText.Count;
+ ShowCaretPos;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.ScrollEnter(Sender: TObject);
+begin
+ SetFocus;
+end;
+
+procedure TfsSyntaxMemo.DblClick;
+var
+ s: String;
+begin
+ FDoubleClicked := True;
+ DoCtrlL;
+ FSelStart := FPos;
+ s := LineAt(FPos.Y - 1);
+ if s <> '' then
+{$IFDEF Delphi12}
+ while CharInSet(s[FPos.X],WordChars)
+ or IsUnicodeChar(s[FPos.X]) do
+{$ELSE}
+ while s[FPos.X] in WordChars do
+{$ENDIF}
+ Inc(FPos.X);
+ FSelEnd := FPos;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.MouseDown(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer);
+begin
+ if FDoubleClicked then
+ begin
+ FDoubleClicked := False;
+ Exit;
+ end;
+ if Button = mbRight then
+ begin
+ if(PopupMenu = nil) then FPopUpMenu.Popup(Mouse.CursorPos.x, Mouse.CursorPos.y);
+ end
+ else
+ begin
+ FMoved := True;
+ if not Focused then
+ SetFocus;
+ FDown := True;
+ SetPos((X - FGutterWidth) div FCharWidth + 1 + FOffset.X,
+ Y div FCharHeight + 1 + FOffset.Y);
+ ClearSel;
+ end;
+end;
+
+procedure TfsSyntaxMemo.MouseMove(Shift: TShiftState; X, Y: Integer);
+begin
+ if FDown then
+ begin
+ FTempPos := FPos;
+ FPos.X := (X - FGutterWidth) div FCharWidth + 1 + FOffset.X;
+ FPos.Y := Y div FCharHeight + 1 + FOffset.Y;
+ if (FPos.X <> FTempPos.X) or (FPos.Y <> FTempPos.Y) then
+ begin
+ SetPos(FPos.X, FPos.Y);
+ AddSel;
+ end;
+ end;
+end;
+
+procedure TfsSyntaxMemo.MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer);
+begin
+ FDown := False;
+end;
+
+procedure TfsSyntaxMemo.KeyDown(var Key: Word; Shift: TShiftState);
+var
+ MyKey: Boolean;
+begin
+ inherited;
+ FAllowLinesChange := False;
+
+ FTempPos := FPos;
+ MyKey := True;
+ case Key of
+ vk_Left:
+ if ssCtrl in Shift then
+ DoCtrlL else
+ DoLeft;
+
+ vk_Right:
+ if ssCtrl in Shift then
+ DoCtrlR else
+ DoRight;
+
+ vk_Up:
+ DoUp;
+
+ vk_Down:
+ DoDown;
+
+ vk_Home:
+ DoHome(ssCtrl in Shift);
+
+ vk_End:
+ DoEnd(ssCtrl in Shift);
+
+ vk_Prior:
+ DoPgUp;
+
+ vk_Next:
+ DoPgDn;
+
+ vk_Return:
+ if Shift = [] then
+ DoReturn;
+
+ vk_Delete:
+ if ssShift in Shift then
+ CutToClipboard else
+ DoDel;
+
+ vk_Back:
+ DoBackspace;
+
+ vk_Insert:
+ if ssCtrl in Shift then
+ CopyToClipboard
+ else if ssShift in Shift then
+ PasteFromClipboard;
+
+ vk_Tab:
+ TabIndent;
+
+ vk_F3:
+ Find(LastSearch); // F3 Repeat search
+
+ else
+ MyKey := False;
+ end;
+
+ if Shift = [ssCtrl] then
+ if Key = 65 then // Ctrl+A Select all
+ begin
+ SetPos(0, 0);
+ FSelStart := FPos;
+ SetPos(LineLength(FText.Count - 1) + 1, FText.Count);
+ FSelEnd := FPos;
+ Repaint;
+ end
+ else
+ if Key = 70 then // Ctrl+F Search
+ begin
+ SynMemoSearch := TfsSynMemoSearch.Create(nil);
+ if SynMemoSearch.ShowModal = mrOk then
+ Find(SynMemoSearch.Edit1.Text);
+ LastSearch := SynMemoSearch.Edit1.Text;
+ SynMemoSearch.Free;
+ end
+ else
+ if Key = 89 then // Ctrl+Y Delete line
+ begin
+ if FText.Count > FPos.Y then
+ begin
+ FMoved := True;
+ AddUndo;
+ FText.Delete(FPos.Y - 1);
+ CorrectBookmark(FPos.Y, -1);
+ UpdateSyntax;
+ end
+ else
+ if FText.Count = FPos.Y then
+ begin
+ FMoved := True;
+ AddUndo;
+ FText[FPos.Y - 1] := '';
+ FPos.X := 1;
+ SetPos(FPos.X, FPos.Y);
+ UpdateSyntax;
+ end
+ end
+ else
+ if Key in [48..57] then
+ GotoBookmark(Key-48);
+
+ if Shift = [ssCtrl, ssShift] then
+ if Key in [48..57] then
+ if IsBookmark(FPos.Y - 1) < 0 then
+ AddBookmark(FPos.Y - 1, Key-48)
+ else
+ if IsBookmark(FPos.Y - 1) = (Key-48) then
+ DeleteBookmark(Key-48);
+
+
+ if Key in [vk_Left, vk_Right, vk_Up, vk_Down, vk_Home, vk_End, vk_Prior, vk_Next] then
+ begin
+ FMoved := True;
+ if ssShift in Shift then
+ AddSel else
+ ClearSel;
+ end
+ else if Key in [vk_Return, vk_Delete, vk_Back, vk_Insert, vk_Tab] then
+ FMoved := True;
+
+ if MyKey then
+ Key := 0;
+end;
+
+procedure TfsSyntaxMemo.KeyPress(var Key: Char);
+var
+ MyKey: Boolean;
+begin
+ inherited;
+
+ MyKey := True;
+ case Key of
+ #3:
+ CopyToClipboard;
+
+ #9:
+ DoCtrlI;
+
+ #21:
+ DoCtrlU;
+
+ #22:
+ PasteFromClipboard;
+
+ #24:
+ CutToClipboard;
+
+ #26:
+ Undo;
+
+ #32..#255:
+ begin
+ DoChar(Key);
+ FMoved := True;
+ end;
+ else
+ MyKey := False;
+ end;
+
+ if MyKey then
+ Key := #0;
+end;
+
+procedure TfsSyntaxMemo.DoLeft;
+begin
+ Dec(FPos.X);
+ if FPos.X < 1 then
+ FPos.X := 1;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoRight;
+begin
+ Inc(FPos.X);
+ if FPos.X > FMaxLength then
+ FPos.X := FMaxLength;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoUp;
+begin
+ Dec(FPos.Y);
+ if FPos.Y < 1 then
+ FPos.Y := 1;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoDown;
+begin
+ Inc(FPos.Y);
+ if FPos.Y > FText.Count then
+ FPos.Y := FText.Count;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoHome(Ctrl: Boolean);
+begin
+ if Ctrl then
+ SetPos(1, 1) else
+ SetPos(1, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoEnd(Ctrl: Boolean);
+begin
+ if Ctrl then
+ SetPos(LineLength(FText.Count - 1) + 1, FText.Count) else
+ SetPos(LineLength(FPos.Y - 1) + 1, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoPgUp;
+begin
+ if FOffset.Y > FWindowSize.Y then
+ begin
+ Dec(FOffset.Y, FWindowSize.Y - 1);
+ Dec(FPos.Y, FWindowSize.Y - 1);
+ end
+ else
+ begin
+ if FOffset.Y > 0 then
+ begin
+ Dec(FPos.Y, FOffset.Y);
+ FOffset.Y := 0;
+ end
+ else
+ FPos.Y := 1;
+ end;
+ SetPos(FPos.X, FPos.Y);
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.DoPgDn;
+begin
+ if FOffset.Y + FWindowSize.Y < FText.Count then
+ begin
+ Inc(FOffset.Y, FWindowSize.Y - 1);
+ Inc(FPos.Y, FWindowSize.Y - 1);
+ end
+ else
+ begin
+ FOffset.Y := FText.Count;
+ FPos.Y := FText.Count;
+ end;
+ SetPos(FPos.X, FPos.Y);
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.DoReturn;
+var
+ s: String;
+begin
+ if FReadOnly then exit;
+ s := LineAt(FPos.Y - 1);
+ FText[FPos.Y - 1] := Copy(s, 1, FPos.X - 1);
+ FText.Insert(FPos.Y, Copy(s, FPos.X, FMaxLength));
+ EnterIndent;
+end;
+
+procedure TfsSyntaxMemo.DoDel;
+var
+ s: String;
+begin
+ if FReadOnly then exit;
+ FMessage := '';
+ if FSelStart.X <> 0 then
+ SelText := ''
+ else
+ begin
+ s := FText[FPos.Y - 1];
+ AddUndo;
+ if FPos.X <= LineLength(FPos.Y - 1) then
+ begin
+ Delete(s, FPos.X, 1);
+ FText[FPos.Y - 1] := s;
+ end
+ else if FPos.Y < FText.Count then
+ begin
+ s := s + Pad(FPos.X - Length(s) - 1) + LineAt(FPos.Y);
+ FText[FPos.Y - 1] := s;
+ FText.Delete(FPos.Y);
+ CorrectBookmark(FSelStart.Y, -1);
+ end;
+ UpdateScrollBar;
+ UpdateSyntax;
+ DoChange;
+ end;
+end;
+
+procedure TfsSyntaxMemo.DoBackspace;
+var
+ s: String;
+begin
+ if FReadOnly then exit;
+ FMessage := '';
+ if FSelStart.X <> 0 then
+ SelText := ''
+ else
+ begin
+ s := FText[FPos.Y - 1];
+ if FPos.X > 1 then
+ begin
+ if (GetLineBegin(FPos.Y - 1) = FPos.X) or (Trim(s) = '') then
+ UnIndent
+ else
+ begin
+ AddUndo;
+ if Trim(s) <> '' then
+ begin
+ Delete(s, FPos.X - 1, 1);
+ FText[FPos.Y - 1] := s;
+ DoLeft;
+ end
+ else
+ DoHome(False);
+ UpdateSyntax;
+ DoChange;
+ end;
+ end
+ else if FPos.Y > 1 then
+ begin
+ AddUndo;
+ CorrectBookmark(FPos.Y, -1);
+ s := LineAt(FPos.Y - 2);
+ FText[FPos.Y - 2] := s + FText[FPos.Y - 1];
+ FText.Delete(FPos.Y - 1);
+ SetPos(Length(s) + 1, FPos.Y - 1);
+ UpdateSyntax;
+ DoChange;
+ end;
+ end;
+end;
+
+procedure TfsSyntaxMemo.DoCtrlI;
+begin
+ if FSelStart.X <> 0 then
+ ShiftSelected(True);
+end;
+
+procedure TfsSyntaxMemo.DoCtrlU;
+begin
+ if FSelStart.X <> 0 then
+ ShiftSelected(False);
+end;
+
+procedure TfsSyntaxMemo.DoCtrlL;
+var
+ i: Integer;
+ s: String;
+begin
+ s := FText.Text;
+ i := Length(LineAt(FPos.Y - 1));
+ if FPos.X > i then
+ FPos.X := i;
+
+ i := GetPlainTextPos(FPos);
+
+ Dec(i);
+{$IFDEF Delphi12}
+ while (i > 0) and not (CharInSet(s[i], WordChars) or IsUnicodeChar(s[i])) do
+ if s[i] = Char(LineBreak[1]) then
+{$ELSE}
+ while (i > 0) and not (s[i] in WordChars) do
+ if s[i] = LineBreak[1] then
+{$ENDIF}
+ break else
+ Dec(i);
+{$IFDEF Delphi12}
+ while (i > 0) and (CharInSet(s[i], WordChars) or IsUnicodeChar(s[i])) do
+{$ELSE}
+ while (i > 0) and (s[i] in WordChars) do
+{$ENDIF}
+ Dec(i);
+ Inc(i);
+
+ FPos := GetPosPlainText(i);
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoCtrlR;
+var
+ i: Integer;
+ s: String;
+begin
+ s := FText.Text;
+ i := Length(LineAt(FPos.Y - 1));
+ if FPos.X > i then
+ begin
+ DoDown;
+ DoHome(False);
+ FPos.X := 0;
+ end;
+
+ i := GetPlainTextPos(FPos);
+{$IFDEF Delphi12}
+ while (i < Length(s)) and ((CharInSet(s[i], WordChars)) or IsUnicodeChar(s[i])) do
+ Inc(i);
+ while (i < Length(s)) and not ((CharInSet(s[i], WordChars)) or IsUnicodeChar(s[i])) do
+ if s[i] = Char(LineBreak[1]) then
+ break else
+ Inc(i);
+{$ELSE}
+ while (i < Length(s)) and (s[i] in WordChars) do
+ Inc(i);
+ while (i < Length(s)) and not (s[i] in WordChars) do
+ if s[i] = LineBreak[1] then
+ break else
+ Inc(i);
+{$ENDIF}
+ FPos := GetPosPlainText(i);
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoChar(Ch: Char);
+begin
+ SelText := Ch;
+end;
+
+function TfsSyntaxMemo.GetCharAttr(Pos: TPoint): TCharAttributes;
+
+ function IsBlock: Boolean;
+ var
+ p1, p2, p3: Integer;
+ begin
+ Result := False;
+ if FSelStart.X = 0 then exit;
+
+ p1 := FSelStart.X + FSelStart.Y * FMaxLength;
+ p2 := FSelEnd.X + FSelEnd.Y * FMaxLength;
+ if p1 > p2 then
+ begin
+ p3 := p1;
+ p1 := p2;
+ p2 := p3;
+ end;
+ p3 := Pos.X + Pos.Y * FMaxLength;
+ Result := (p3 >= p1) and (p3 < p2);
+ end;
+
+ function CharAttr: TCharAttr;
+ var
+ s: String;
+ begin
+ if Pos.Y - 1 < FSynStrings.Count then
+ begin
+ s := FSynStrings[Pos.Y - 1];
+ if Pos.X <= Length(s) then
+ Result := TCharAttr(Ord(s[Pos.X])) else
+ Result := caText;
+ end
+ else
+ Result := caText;
+ end;
+
+begin
+ Result := [CharAttr];
+ if IsBlock then
+ Result := Result + [caBlock];
+end;
+
+{$HINTS OFF}
+procedure TfsSyntaxMemo.Paint;
+var
+ i, j, j1: Integer;
+ a, a1: TCharAttributes;
+ s: String;
+
+ procedure SetAttr(a: TCharAttributes);
+ begin
+ with Canvas do
+ begin
+ Brush.Color := Self.Color;
+
+ if caText in a then
+ Font.Assign(FTextAttr);
+
+ if caComment in a then
+ Font.Assign(FCommentAttr);
+
+ if caKeyword in a then
+ Font.Assign(FKeywordAttr);
+
+ if caString in a then
+ Font.Assign(FStringAttr);
+
+ if caBlock in a then
+ begin
+ Brush.Color := FBlockColor;
+ Font.Color := FBlockFontColor;
+ end;
+
+ Font.Charset := Self.Font.Charset;
+ end;
+ end;
+
+ procedure MyTextOut(x, y: Integer; const s: String);
+ var
+ i: Integer;
+ begin
+ with Canvas do
+ begin
+ FillRect(Rect(x, y, x + Length(s) * FCharWidth, y + FCharHeight));
+ if FIsMonoType then
+ TextOut(x, y, s)
+ else
+ begin
+ for i := 1 to Length(s) do
+ TextOut(x + (i - 1) * FCharWidth, y, s[i]);
+ MoveTo(x + Length(s) * FCharWidth, y);
+ end;
+ end;
+ end;
+
+begin
+ with Canvas do
+ begin
+ Brush.Color := clBtnFace;
+ FillRect(Rect(0, 0, FGutterWidth - 2, Height - FFooterHeight));
+ FillRect(Rect(0, Height - FFooterHeight, Width, Height));
+ Pen.Color := clBtnHighlight;
+ MoveTo(FGutterWidth - 4, 0);
+ LineTo(FGutterWidth - 4, Height - FFooterHeight + 1);
+ if FFooterHeight > 0 then
+ LineTo(Width, Height - FFooterHeight + 1);
+
+ if FUpdatingSyntax then Exit;
+
+ for i := FOffset.Y to FOffset.Y + FWindowSize.Y - 1 do
+ begin
+ if i >= FText.Count then break;
+
+ s := FText[i];
+ PenPos := Point(FGutterWidth, (i - FOffset.Y) * FCharHeight);
+ j1 := FOffset.X + 1;
+ a := GetCharAttr(Point(j1, i + 1));
+ a1 := a;
+
+ for j := j1 to FOffset.X + FWindowSize.X do
+ begin
+ if j > Length(s) then break;
+
+ a1 := GetCharAttr(Point(j, i + 1));
+ if a1 <> a then
+ begin
+ SetAttr(a);
+ MyTextOut(PenPos.X, PenPos.Y, Copy(FText[i], j1, j - j1));
+ a := a1;
+ j1 := j;
+ end;
+ end;
+
+ SetAttr(a);
+ MyTextOut(PenPos.X, PenPos.Y, Copy(s, j1, FMaxLength));
+ if caBlock in GetCharAttr(Point(1, i + 1)) then
+ MyTextOut(PenPos.X, PenPos.Y, Pad(FWindowSize.X - Length(s) - FOffset.X + 3));
+
+ BookmarkDraw(PenPos.Y, i);
+ ActiveLineDraw(PenPos.Y, i);
+ end;
+
+ if FMessage <> '' then
+ begin
+ Font.Name := 'Tahoma';
+ Font.Color := clWhite;
+ Font.Style := [fsBold];
+ Font.Size := 8;
+ Brush.Color := clMaroon;
+ FillRect(Rect(0, Height - TextHeight('|') - 6, Width, Height));
+ TextOut(6, Height - TextHeight('|') - 5, FMessage);
+ end
+ else
+ ShowPos;
+ end;
+end;
+{$HINTS ON}
+
+procedure TfsSyntaxMemo.CreateSynArray;
+var
+ i, n, Pos: Integer;
+ ch: Char;
+ FSyn: String;
+
+ procedure SkipSpaces;
+ begin
+{$IFDEF Delphi12}
+ while (Pos <= Length(FSyn)) and
+ ((CharInSet(FSyn[Pos], [#1..#32])) or
+ not (CharInSet(FSyn[Pos],['_', 'A'..'Z', 'a'..'z', '''', '"', '/', '{', '(', '-']))) do
+ Inc(Pos);
+{$ELSE}
+ while (Pos <= Length(FSyn)) and
+ ((FSyn[Pos] in [#1..#32]) or
+ not (FSyn[Pos] in ['_', 'A'..'Z', 'a'..'z', '''', '"', '/', '{', '(', '-'])) do
+ Inc(Pos);
+{$ENDIF}
+ end;
+
+ function IsKeyWord(const s: String): Boolean;
+ begin
+ Result := False;
+ if FKeywords = '' then exit;
+
+ if FKeywords[1] <> ',' then
+ FKeywords := ',' + FKeywords;
+ if FKeywords[Length(FKeywords)] <> ',' then
+ FKeywords := FKeywords + ',';
+
+ Result := System.Pos(',' + AnsiLowerCase(s) + ',', FKeywords) <> 0;
+ end;
+
+ function GetIdent: TCharAttr;
+ var
+ i: Integer;
+ cm1, cm2, cm3, cm4, st1: Char;
+ begin
+ i := Pos;
+ Result := caText;
+
+ if FSyntaxType = stPascal then
+ begin
+ cm1 := '/';
+ cm2 := '{';
+ cm3 := '(';
+ cm4 := ')';
+ st1 := '''';
+ end
+ else if FSyntaxType in [stCpp,stJs,stVb] then
+ begin
+ cm1 := '/';
+ cm2 := ' ';
+ cm3 := '/';
+ cm4 := '/';
+ st1 := '"';
+ end
+ else if FSyntaxType = stSQL then
+ begin
+ cm1 := '-';
+ cm2 := ' ';
+ cm3 := '/';
+ cm4 := '/';
+ st1 := '"';
+ end
+ else
+ begin
+ cm1 := ' ';
+ cm2 := ' ';
+ cm3 := ' ';
+ cm4 := ' ';
+ st1 := ' ';
+ end;
+
+{$IFDEF Delphi12}
+ if CharInSet(FSyn[Pos], ['_', 'A'..'Z', 'a'..'z']) then
+ begin
+ while CharInSet(FSyn[Pos], ['_', 'A'..'Z', 'a'..'z', '0'..'9']) do
+ Inc(Pos);
+ if IsKeyWord(Copy(FSyn, i, Pos - i)) then
+ Result := caKeyword;
+ Dec(Pos);
+ end
+ else if (FSyn[Pos] = cm1) and (FSyn[Pos + 1] = cm1) then
+ begin
+ while (Pos <= Length(FSyn)) and not (CharInSet(FSyn[Pos], [#10, #13])) do
+ Inc(Pos);
+ Result := caComment;
+ end
+{$ELSE}
+ if FSyn[Pos] in ['_', 'A'..'Z', 'a'..'z'] then
+ begin
+ while FSyn[Pos] in ['_', 'A'..'Z', 'a'..'z', '0'..'9'] do
+ Inc(Pos);
+ if IsKeyWord(Copy(FSyn, i, Pos - i)) then
+ Result := caKeyword;
+ Dec(Pos);
+ end
+ else if (FSyn[Pos] = cm1) and (FSyn[Pos + 1] = cm1) then
+ begin
+ while (Pos <= Length(FSyn)) and not (FSyn[Pos] in [#10, #13]) do
+ Inc(Pos);
+ Result := caComment;
+ end
+{$ENDIF}
+ else if FSyn[Pos] = cm2 then
+ begin
+ while (Pos <= Length(FSyn)) and (FSyn[Pos] <> '}') do
+ Inc(Pos);
+ Result := caComment;
+ end
+ else if (FSyn[Pos] = cm3) and (FSyn[Pos + 1] = '*') then
+ begin
+ while (Pos < Length(FSyn)) and not ((FSyn[Pos] = '*') and (FSyn[Pos + 1] = cm4)) do
+ Inc(Pos);
+ Inc(Pos, 2);
+ Result := caComment;
+ end
+ else if FSyn[Pos] = st1 then
+ begin
+ Inc(Pos);
+{$IFDEF Delphi12}
+ while (Pos < Length(FSyn)) and (FSyn[Pos] <> st1) and not (CharInSet(FSyn[Pos], [#10, #13])) do
+ Inc(Pos);
+{$ELSE}
+ while (Pos < Length(FSyn)) and (FSyn[Pos] <> st1) and not (FSyn[Pos] in [#10, #13]) do
+ Inc(Pos);
+{$ENDIF}
+ Result := caString;
+ end;
+ Inc(Pos);
+ end;
+
+begin
+ FSyn := FText.Text + #0#0#0#0#0#0#0#0#0#0#0;
+ FAllowLinesChange := False;
+ Pos := 1;
+
+ while Pos < Length(FSyn) do
+ begin
+ n := Pos;
+ SkipSpaces;
+ for i := n to Pos - 1 do
+ if FSyn[i] > #31 then
+ FSyn[i] := Chr(Ord(caText));
+
+ n := Pos;
+ ch := Chr(Ord(GetIdent));
+ for i := n to Pos - 1 do
+ if i <= Length(FSyn) then
+ if FSyn[i] > #31 then
+ FSyn[i] := ch;
+ end;
+
+ FUpdatingSyntax := True;
+ FSynStrings.Text := FSyn;
+ FSynStrings.Add(' ');
+ FUpdatingSyntax := False;
+end;
+
+procedure TfsSyntaxMemo.UpdateView;
+begin
+ UpdateSyntax;
+ Invalidate;
+end;
+
+procedure TfsSyntaxMemo.CopyPopup(Sender: TObject);
+begin
+ CopyToClipboard;
+end;
+
+procedure TfsSyntaxMemo.PastePopup(Sender: TObject);
+begin
+ PasteFromClipboard;
+end;
+
+procedure TfsSyntaxMemo.CutPopup(Sender: TObject);
+begin
+ CutToClipboard;
+end;
+
+{$IFDEF Delphi4}
+procedure TfsSyntaxMemo.MouseWheelUp(Sender: TObject;
+ Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
+begin
+ FVScroll.Position := FVScroll.Position - FVScroll.SmallChange * KWheel;
+end;
+
+procedure TfsSyntaxMemo.MouseWheelDown(Sender: TObject;
+ Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
+begin
+ FVScroll.Position := FVScroll.Position + FVScroll.SmallChange * KWheel;
+end;
+{$ENDIF}
+
+procedure TfsSyntaxMemo.SetShowGutter(Value: boolean);
+begin
+ FShowGutter := Value;
+ if Value then
+ FGutterWidth := 20
+ else
+ FGutterWidth := 0;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.SetShowFooter(Value: boolean);
+begin
+ FShowFooter := Value;
+ if Value then
+ FFooterHeight := 20
+ else
+ FFooterHeight := 0;
+ Repaint;
+end;
+
+function TfsSyntaxMemo.FMemoFind(Text: String; var Position : TPoint): boolean;
+var
+ i, j : integer;
+begin
+ j := 0;
+ result := False;
+ if FText.Count > 1 then
+ begin
+ Text := UpperCase(Text);
+ for i := Position.Y to FText.Count - 1 do
+ begin
+ j := Pos( Text, UpperCase(FText[i]));
+ if j > 0 then
+ begin
+ Result := True;
+ break;
+ end
+ end;
+ Position.X := j;
+ Position.Y := i + 1;
+ end;
+end;
+
+function TfsSyntaxMemo.Find(Text: String): boolean;
+var
+ Position: TPoint;
+begin
+ Position := FPos;
+ if FMemoFind(Text, Position) then
+ begin
+ SetPos(Position.X, Position.Y);
+ result := true;
+ end
+ else
+ begin
+ ShowMessage('Text "'+Text+'" not found.');
+ result := false;
+ end;
+end;
+
+procedure TfsSyntaxMemo.ActiveLineDraw(Y : integer; ALine : integer);
+begin
+ if ShowGutter then
+ with Canvas do
+ if ALine = FActiveLine then
+ begin
+ Brush.Color := clRed;
+ Pen.Color := clBlack;
+ Ellipse(4, Y+4, 11, Y+11);
+ end;
+end;
+
+procedure TfsSyntaxMemo.BookmarkDraw(Y : integer; ALine : integer);
+var
+ bm : integer;
+begin
+ if ShowGutter then
+ with Canvas do
+ begin
+ bm := IsBookmark(ALine);
+ if bm >= 0 then
+ begin
+ Brush.Color := clBlack;
+ FillRect(Rect(3, Y + 1, 13, Y + 12));
+ Brush.Color := clGreen;
+ FillRect(Rect(2, Y + 2, 12, Y + 13));
+ Font.Name := 'Tahoma';
+ Font.Color := clWhite;
+ Font.Style := [fsBold];
+ Font.Size := 7;
+ TextOut(4, Y + 2, IntToStr(bm));
+ end
+ else
+ begin
+ Brush.Color := clBtnFace;
+ FillRect(Rect(2, Y + 2, 13, Y + 13));
+ end;
+ end;
+end;
+
+function TfsSyntaxMemo.IsBookmark(Line : integer): integer;
+var
+ Pos : integer;
+begin
+ Result := -1;
+ for Pos := 0 to Length(Bookmarks) - 1 do
+ if Bookmarks[Pos] = Line then
+ begin
+ Result := Pos;
+ break;
+ end;
+end;
+
+procedure TfsSyntaxMemo.AddBookmark(Line, Number : integer);
+begin
+ if Number < Length(Bookmarks) then
+ begin
+ Bookmarks[Number] := Line;
+ Repaint;
+ end;
+end;
+
+procedure TfsSyntaxMemo.DeleteBookmark(Number : integer);
+begin
+ if Number < Length(Bookmarks) then
+ begin
+ Bookmarks[Number] := -1;
+ Repaint;
+ end;
+end;
+
+procedure TfsSyntaxMemo.CorrectBookmark(Line : integer; delta : integer);
+var
+ i : integer;
+begin
+ for i := 0 to Length(Bookmarks) - 1 do
+ if Bookmarks[i] >= Line then
+ Inc(Bookmarks[i], Delta);
+end;
+
+procedure TfsSyntaxMemo.GotoBookmark(Number : integer);
+begin
+ if Number < Length(Bookmarks) then
+ if Bookmarks[Number] >= 0 then
+ SetPos(0, Bookmarks[Number] + 1);
+end;
+
+procedure TfsSyntaxMemo.DOver(Sender, Source: TObject; X, Y: Integer;
+ State: TDragState; var Accept: Boolean);
+begin
+ Accept := Source is TTreeView;
+end;
+
+procedure TfsSyntaxMemo.DDrop(Sender, Source: TObject; X, Y: Integer);
+begin
+ if Source is TTreeView then
+ begin
+ SetPos((X - FGutterWidth) div FCharWidth + 1 + FOffset.X,
+ Y div FCharHeight + 1 + FOffset.Y);
+ SetSelText(TTreeView(Source).Selected.Text);
+ end;
+end;
+
+procedure TfsSyntaxMemo.SetKeywordAttr(Value: TFont);
+begin
+ FKeywordAttr.Assign(Value);
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.SetStringAttr(Value: TFont);
+begin
+ FStringAttr.Assign(Value);
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.SetTextAttr(Value: TFont);
+begin
+ FTextAttr.Assign(Value);
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.SetCommentAttr(Value: TFont);
+begin
+ FCommentAttr.Assign(Value);
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.SetActiveLine(Line : Integer);
+begin
+ FActiveLine := Line;
+ Repaint;
+end;
+
+function TfsSyntaxMemo.GetActiveLine: Integer;
+begin
+ Result := FActiveLine;
+end;
+
+//
+
+procedure TfsSynMemoSearch.FormKeyPress(Sender: TObject; var Key: Char);
+begin
+ if Key = #13 then
+ ModalResult := mrOk;
+end;
+
+{$IFDEF DELPHI16}
+initialization
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsSyntaxMemo, TControl);
+{$ENDIF}
+
+end.
diff --git a/FastScript/fs_tree.pas b/FastScript/fs_tree.pas
new file mode 100644
index 0000000..de63a33
--- /dev/null
+++ b/FastScript/fs_tree.pas
@@ -0,0 +1,426 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Function/Classes tree visual control }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_tree;
+
+interface
+
+{$I fs.inc}
+
+uses
+{$IFNDEF CLX}
+ {$IFNDEF FPC}
+ Windows, Messages,
+ {$ENDIF}
+ SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ StdCtrls, ExtCtrls, ComCtrls, fs_synmemo
+{$ELSE}
+ Classes, QGraphics, QControls, QStdCtrls, QExtCtrls, QComCtrls, QImgList
+{$ENDIF},
+ fs_XML, fs_iinterpreter;
+
+type
+ TfsTree = class(TPanel)
+ private
+ Tree: TTreeView;
+ FXML: TfsXMLDocument;
+ FImages: TImageList;
+ FScript: TfsScript;
+ FShowFunctions: boolean;
+ FShowClasses: boolean;
+ FShowTypes: Boolean;
+ FShowVariables: Boolean;
+ FExpanded: boolean;
+ FExpandLevel : integer;
+{$IFNDEF CLX}
+ FMemo: TfsSyntaxMemo;
+{$ELSE}
+ FMemo: TMemo;
+{$ENDIF}
+ FUpdating: Boolean;
+ procedure FillTree;
+{$IFNDEF CLX}
+ procedure SetMemo(Value: TfsSyntaxMemo);
+{$ELSE}
+ procedure SetMemo(Value: TMemo);
+{$ENDIF}
+ procedure SetImageIndex(Node: TTreeNode; Index: Integer);
+ procedure SetScript(const Value: TfsScript);
+ procedure TreeCollapsed(Sender: TObject; Node: TTreeNode);
+ procedure TreeExpanded(Sender: TObject; Node: TTreeNode);
+ protected
+ procedure TreeChange(Sender: TObject; Node: TTreeNode);
+ procedure TreeDblClick(Sender: TObject);
+ procedure Notification(AComponent: TComponent;
+ Operation: TOperation); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure SetColor(Color: TColor);
+ procedure UpdateItems;
+ function GetFieldName: String;
+ published
+ property Align;
+ property Anchors;
+{$IFNDEF CLX}
+ {$IFNDEF FPC}
+ property ParentCtl3D;
+ {$ENDIF}
+ property DragCursor;
+ property DragKind;
+ property DragMode;
+ property BiDiMode;
+ property ParentBiDiMode;
+{$ENDIF}
+ property Color;
+ property Constraints;
+ property Enabled;
+ property Font;
+ property ParentColor;
+ property ParentFont;
+ property ParentShowHint;
+ property PopupMenu;
+ property Script: TfsScript read FScript write SetScript;
+ property ShowHint;
+ property TabOrder;
+ property TabStop;
+ property Visible;
+{$IFNDEF CLX}
+ property SyntaxMemo: TfsSyntaxMemo read FMemo write SetMemo;
+{$ELSE}
+ property SyntaxMemo: TMemo read FMemo write SetMemo;
+{$ENDIF}
+ property ShowClasses: boolean read FShowClasses write FShowClasses;
+ property ShowFunctions: boolean read FShowFunctions write FShowFunctions;
+ property ShowTypes: boolean read FShowTypes write FShowTypes;
+ property ShowVariables: boolean read FShowVariables write FShowVariables;
+ property Expanded: boolean read FExpanded write FExpanded;
+ property ExpandLevel: integer read FExpandLevel write FExpandLevel;
+
+ property OnClick;
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEndDrag;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ property OnStartDrag;
+ end;
+
+implementation
+
+{$R *.res}
+
+uses fs_iTools;
+
+procedure TfsTree.SetImageIndex(Node: TTreeNode; Index: Integer);
+begin
+ Node.ImageIndex := Index;
+{$IFNDEF CLX}
+ Node.StateIndex := Index;
+{$ENDIF}
+ Node.SelectedIndex := Index;
+end;
+
+constructor TfsTree.Create(AOwner: TComponent);
+var
+ Images: TBitmap;
+begin
+ inherited;
+ Parent := AOwner as TWinControl;
+ BevelOuter := bvNone;
+ Tree := TTreeView.Create(Self);
+ with Tree do
+ begin
+ Parent := Self;
+ Align := alClient;
+ DragMode := dmAutomatic;
+ ReadOnly := True;
+ TabOrder := 0;
+ end;
+ FImages := TImageList.Create(Self);
+ FImages.Masked := true;
+ Images := TBitmap.Create;
+ Images.LoadFromResourceName(hInstance, 'FSTREE');
+{$IFNDEF CLX}
+ FImages.AddMasked(Images, Images.TransparentColor);
+{$ELSE}
+ Images.Transparent := true;
+ FImages.Add(Images, nil);
+{$ENDIF}
+ Images.Free;
+ Tree.Images := FImages;
+ Tree.OnCollapsed := TreeCollapsed;
+ Tree.OnExpanded := TreeExpanded;
+ Tree.OnDblClick := TreeDblClick;
+ FXML := TfsXMLDocument.Create;
+ Expanded := True;
+ ExpandLevel := 2;
+ ShowClasses := True;
+ ShowFunctions := True;
+ ShowTypes := True;
+ ShowVariables := True;
+ UpdateItems;
+ Height := 250;
+ Width := 200;
+end;
+
+destructor TfsTree.Destroy;
+begin
+ FImages.Free;
+ Tree.Free;
+ FUpdating := True;
+ FXML.Free;
+ inherited;
+end;
+
+procedure TfsTree.FillTree;
+
+ function GetCategoryByName(s: String): String;
+ begin
+ if s = 'ctConv' then result := 'Conversion'
+ else if s = 'ctFormat' then result := 'Formatting'
+ else if s = 'ctDate' then result := 'Date/Time'
+ else if s = 'ctString' then result := 'String routines'
+ else if s = 'ctMath' then result := 'Mathematical'
+ else if s = 'ctOther' then result := 'Other'
+ else result := s;
+ end;
+
+ procedure AddClasses(xi: TfsXMLItem; Root: TTreeNode);
+ var
+ i: Integer;
+ Node: TTreeNode;
+ s: String;
+ begin
+ s := xi.Prop['text'];
+ Node := Tree.Items.AddChild(Root, s);
+ if xi.Count = 0 then
+ Node.Data := xi;
+ if Root = nil then
+ Node.Text := xi.Name;
+ if xi.Count = 0 then
+ SetImageIndex(Node, 1)
+ else
+ SetImageIndex(Node, 2);
+ for i := 0 to xi.Count - 1 do
+ AddClasses(xi[i], Node);
+ end;
+
+ procedure AddFunctions(xi: TfsXMLItem; Root: TTreeNode);
+ var
+ i: Integer;
+ Node: TTreeNode;
+ s: String;
+ begin
+ s := xi.Prop['text'];
+ if xi.Count = 0 then
+ s := Copy(s, Pos(' ', s) + 1, 255) else { function }
+ s := GetCategoryByName(s); { category }
+ Node := Tree.Items.AddChild(Root, s);
+ if xi.Count = 0 then
+ Node.Data := xi;
+ if Root = nil then
+ Node.Text := xi.Name;
+ if xi.Count = 0 then
+ SetImageIndex(Node, 0)
+ else
+ SetImageIndex(Node, 2);
+ for i := 0 to xi.Count - 1 do
+ AddFunctions(xi[i], Node);
+ end;
+
+ procedure AddTypes(xi: TfsXMLItem; Root: TTreeNode);
+ var
+ i: Integer;
+ Node: TTreeNode;
+ s: String;
+ begin
+ s := Copy(xi.Prop['text'], 1, 255);
+ Node := Tree.Items.AddChild(Root, s);
+ if xi.Count = 0 then
+ Node.Data := xi;
+ if Root = nil then
+ Node.Text := xi.Name;
+ if xi.Count = 0 then
+ SetImageIndex(Node, 0)
+ else
+ SetImageIndex(Node, 2);
+ for i := 0 to xi.Count - 1 do
+ AddTypes(xi[i], Node);
+ end;
+
+ procedure AddVariables(xi: TfsXMLItem; Root: TTreeNode);
+ var
+ i: Integer;
+ Node: TTreeNode;
+ s: String;
+ begin
+ s := xi.Prop['text'];
+ Node := Tree.Items.AddChild(Root, s);
+ if xi.Count = 0 then
+ Node.Data := xi;
+ if Root = nil then
+ Node.Text := xi.Name;
+ if xi.Count = 0 then
+ SetImageIndex(Node, 0)
+ else
+ SetImageIndex(Node, 2);
+ for i := 0 to xi.Count - 1 do
+ AddVariables(xi[i], Node);
+ end;
+
+ procedure ExpandNodes(level: integer);
+ var
+ j : integer;
+ begin
+ if level > 1 then
+ for j := 0 to Tree.Items.Count-1 do
+ if Tree.Items[j].Level < Level-1 then
+ Tree.Items[j].Expand(false);
+ end;
+
+begin
+ FUpdating := True;
+ FXML.Root.Clear;
+
+ GenerateXMLContents(fsGlobalUnit, FXML.Root);
+ if FScript <> nil then
+ GenerateXMLContents(FScript, FXML.Root);
+
+ Tree.Items.BeginUpdate;
+ Tree.Items.Clear;
+
+ if ShowClasses then
+ AddClasses(FXML.Root.FindItem('Classes'), nil);
+
+ if ShowFunctions then
+ AddFunctions(FXML.Root.FindItem('Functions'), nil);
+
+ if ShowTypes then
+ AddTypes(FXML.Root.FindItem('Types'), nil);
+
+ if ShowVariables then
+ AddVariables(FXML.Root.FindItem('Variables'), nil);
+
+ if Expanded then
+ ExpandNodes(ExpandLevel);
+
+ Tree.TopItem := Tree.Items[0];
+ Tree.Items.EndUpdate;
+ FUpdating := False;
+
+end;
+
+procedure TfsTree.UpdateItems;
+begin
+ FillTree;
+end;
+
+procedure TfsTree.TreeChange(Sender: TObject;
+ Node: TTreeNode);
+begin
+ if FUpdating then Exit;
+end;
+
+procedure TfsTree.TreeDblClick(Sender: TObject);
+begin
+ if Assigned(SyntaxMemo) then
+ if Tree.Selected.Count = 0 then
+ SyntaxMemo.SelText := Tree.Selected.Text;
+ if Assigned(OnDblClick) then OnDblClick(Self);
+end;
+
+function TfsTree.GetFieldName: String;
+var
+ i, n: Integer;
+ s: String;
+begin
+ Result := '';
+ if (Tree.Selected <> nil) and (Tree.Selected.Count = 0) then
+ begin
+ s := Tree.Selected.Text;
+ if Pos('(', s) <> 0 then
+ n := 1 else
+ n := 0;
+ for i := 1 to Length(s) do
+{$IFDEF Delphi12}
+ if (s[i] = ',') or (s[i] = ';') then
+{$ELSE}
+ if s[i] in [',', ';'] then
+{$ENDIF}
+ Inc(n);
+
+ if n = 0 then
+ s := Copy(s, 1, Pos(':', s) - 1)
+ else
+ begin
+ s := Copy(s, 1, Pos('(', s));
+ for i := 1 to n - 1 do
+ s := s + ',';
+ s := s + ')';
+ end;
+ Result := s;
+ end;
+end;
+
+procedure TfsTree.SetColor(Color: TColor);
+begin
+ Tree.Color := Color;
+end;
+
+{$IFNDEF CLX}
+procedure TfsTree.SetMemo(Value: TfsSyntaxMemo);
+{$ELSE}
+procedure TfsTree.SetMemo(Value: TMemo);
+{$ENDIF}
+begin
+ FMemo := Value;
+end;
+
+procedure TfsTree.SetScript(const Value: TfsScript);
+begin
+ FScript := Value;
+ UpdateItems;
+end;
+
+procedure TfsTree.TreeCollapsed(Sender: TObject; Node: TTreeNode);
+begin
+ SetImageIndex(Node, 2);
+end;
+
+procedure TfsTree.TreeExpanded(Sender: TObject; Node: TTreeNode);
+begin
+ SetImageIndex(Node, 3);
+end;
+
+procedure TfsTree.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited Notification(AComponent, Operation);
+ if Operation = opRemove then
+ if AComponent = FScript then
+ FScript := nil
+ else if AComponent = FMemo then
+ FMemo := nil
+end;
+
+{$IFDEF DELPHI16}
+initialization
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsTree, TControl);
+{$ENDIF}
+
+end.
diff --git a/FastScript/fs_tree.res b/FastScript/fs_tree.res
new file mode 100644
index 0000000..098958a
Binary files /dev/null and b/FastScript/fs_tree.res differ
diff --git a/FastScript/fs_xml.pas b/FastScript/fs_xml.pas
new file mode 100644
index 0000000..9699572
--- /dev/null
+++ b/FastScript/fs_xml.pas
@@ -0,0 +1,756 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ XML document }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_xml;
+
+interface
+
+{$i fs.inc}
+
+uses
+{$IFNDEF CROSS_COMPILE}
+ Windows,
+{$ENDIF}
+ SysUtils, Classes
+{$IFDEF Delphi12}
+ , AnsiStrings
+{$ENDIF}
+{$IFDEF Delphi16}
+ , System.Types
+{$ENDIF};
+//FMX uses
+{$ELSE}
+interface
+
+{$i fs.inc}
+
+uses
+ FMX.Types, System.SysUtils, System.Classes, System.AnsiStrings, System.Types;
+{$ENDIF}
+
+type
+ TfsXMLItem = class(TObject)
+ private
+ FData: Pointer; { optional item data }
+ FItems: TList; { subitems }
+ FName: String; { item name }
+ FParent: TfsXMLItem; { item parent }
+ FText: String; { item attributes }
+ function GetCount: Integer;
+ function GetItems(Index: Integer): TfsXMLItem;
+ function GetProp(Index: String): String;
+ procedure SetProp(Index: String; const Value: String);
+ procedure SetParent(const Value: TfsXMLItem);
+ public
+ destructor Destroy; override;
+ procedure AddItem(Item: TfsXMLItem);
+ procedure Assign(Item: TfsXMLItem);
+ procedure Clear;
+ procedure InsertItem(Index: Integer; Item: TfsXMLItem);
+
+ function Add: TfsXMLItem;
+ function Find(const Name: String): Integer;
+ function FindItem(const Name: String): TfsXMLItem;
+ function IndexOf(Item: TfsXMLItem): Integer;
+ function PropExists(const Index: String): Boolean;
+ function Root: TfsXMLItem;
+
+ property Count: Integer read GetCount;
+ property Data: Pointer read FData write FData;
+ property Items[Index: Integer]: TfsXMLItem read GetItems; default;
+ property Name: String read FName write FName;
+ property Parent: TfsXMLItem read FParent write SetParent;
+ property Prop[Index: String]: String read GetProp write SetProp;
+ property Text: String read FText write FText;
+ end;
+
+ TfsXMLDocument = class(TObject)
+ private
+ FAutoIndent: Boolean; { use indents when writing document to a file }
+ FRoot: TfsXMLItem; { root item }
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Clear;
+ procedure SaveToStream(Stream: TStream);
+ procedure LoadFromStream(Stream: TStream);
+ procedure SaveToFile(const FileName: String);
+ procedure LoadFromFile(const FileName: String);
+
+ property AutoIndent: Boolean read FAutoIndent write FAutoIndent;
+ property Root: TfsXMLItem read FRoot;
+ end;
+
+{ TfsXMLReader and TfsXMLWriter are doing actual read/write to the XML file.
+ Read/write process is buffered. }
+
+ TfsXMLReader = class(TObject)
+ private
+ FBuffer: PAnsiChar;
+ FBufPos: Integer;
+ FBufEnd: Integer;
+ FPosition: Int64;
+ FSize: Int64;
+ FStream: TStream;
+ procedure SetPosition(const Value: Int64);
+ procedure ReadBuffer;
+ procedure ReadItem(var {$IFDEF Delphi12}NameS{$ELSE}Name{$ENDIF}: String; var Text: String);
+ public
+ constructor Create(Stream: TStream);
+ destructor Destroy; override;
+ procedure RaiseException;
+ procedure ReadHeader;
+ procedure ReadRootItem(Item: TfsXMLItem);
+ property Position: Int64 read FPosition write SetPosition;
+ property Size: Int64 read FSize;
+ end;
+
+ TfsXMLWriter = class(TObject)
+ private
+ FAutoIndent: Boolean;
+ FBuffer: AnsiString;
+ FStream: TStream;
+ FTempStream: TStream;
+ procedure FlushBuffer;
+ procedure WriteLn(const s: AnsiString);
+ procedure WriteItem(Item: TfsXMLItem; Level: Integer = 0);
+ public
+ constructor Create(Stream: TStream);
+ procedure WriteHeader;
+ procedure WriteRootItem(RootItem: TfsXMLItem);
+ property TempStream: TStream read FTempStream write FTempStream;
+ end;
+
+
+{ StrToXML changes '<', '>', '"', cr, lf symbols to its ascii codes }
+function StrToXML(const s: String): String;
+
+{ ValueToXML convert a value to the valid XML string }
+function ValueToXML(const Value: Variant): String;
+
+{ XMLToStr is opposite to StrToXML function }
+function XMLToStr(const s: String): String;
+
+
+implementation
+
+
+function StrToXML(const s: String): String;
+const
+ SpecChars = ['<', '>', '"', #10, #13, '&'];
+var
+ i: Integer;
+
+ procedure ReplaceChars(var s: String; i: Integer);
+ begin
+ Insert('#' + IntToStr(Ord(s[i])) + ';', s, i + 1);
+ s[i] := '&';
+ end;
+
+begin
+ Result := s;
+ for i := Length(s) downto 1 do
+{$IFDEF Delphi12}
+ if CharInSet(s[i], SpecChars) then
+{$ELSE}
+ if s[i] in SpecChars then
+{$ENDIF}
+ if s[i] <> '&' then
+ ReplaceChars(Result, i)
+ else
+ begin
+ if Copy(s, i + 1, 5) = 'quot;' then
+ begin
+ Delete(Result, i, 6);
+ Insert('"', Result, i);
+ end;
+ end;
+end;
+
+function XMLToStr(const s: String): String;
+var
+ i, j, h, n: Integer;
+begin
+ Result := s;
+
+ i := 1;
+ n := Length(s);
+ while i < n do
+ begin
+ if Result[i] = '&' then
+ if (i + 3 <= n) and (Result[i + 1] = '#') then
+ begin
+ j := i + 3;
+ while Result[j] <> ';' do
+ Inc(j);
+ h := StrToInt(Copy(Result, i + 2, j - i - 2));
+ Delete(Result, i, j - i);
+ Result[i] := Chr(h);
+ Dec(n, j - i);
+ end
+ else if Copy(Result, i + 1, 5) = 'quot;' then
+ begin
+ Delete(Result, i, 5);
+ Result[i] := '"';
+ Dec(n, 5);
+ end;
+ Inc(i);
+ end;
+end;
+
+function ValueToXML(const Value: Variant): String;
+begin
+ case TVarData(Value).VType of
+ varSmallint, varInteger, varByte:
+ Result := IntToStr(Integer(Value));
+
+ varSingle, varDouble, varCurrency:
+ Result := FloatToStr(Double(Value));
+
+ varDate:
+ Result := DateToStr(TDateTime(Value));
+
+ varOleStr, varString, varVariant{$IFDEF Delphi12}, varUString{$ENDIF}:
+ Result := StrToXML(Value);
+
+ varBoolean:
+ if Value = True then Result := '1' else Result := '0';
+
+ else
+ Result := '';
+ end;
+end;
+
+
+{ TfsXMLItem }
+
+destructor TfsXMLItem.Destroy;
+begin
+ Clear;
+ if FParent <> nil then
+ FParent.FItems.Remove(Self);
+ inherited;
+end;
+
+procedure TfsXMLItem.Clear;
+begin
+ if FItems <> nil then
+ begin
+ while FItems.Count > 0 do
+ TfsXMLItem(FItems[0]).Free;
+ FItems.Free;
+ FItems := nil;
+ end;
+end;
+
+function TfsXMLItem.GetItems(Index: Integer): TfsXMLItem;
+begin
+ Result := TfsXMLItem(FItems[Index]);
+end;
+
+function TfsXMLItem.GetCount: Integer;
+begin
+ if FItems = nil then
+ Result := 0 else
+ Result := FItems.Count;
+end;
+
+function TfsXMLItem.Add: TfsXMLItem;
+begin
+ Result := TfsXMLItem.Create;
+ AddItem(Result);
+end;
+
+procedure TfsXMLItem.AddItem(Item: TfsXMLItem);
+begin
+ if FItems = nil then
+ FItems := TList.Create;
+
+ FItems.Add(Item);
+ if Item.FParent <> nil then
+ Item.FParent.FItems.Remove(Item);
+ Item.FParent := Self;
+end;
+
+procedure TfsXMLItem.InsertItem(Index: Integer; Item: TfsXMLItem);
+begin
+ AddItem(Item);
+ FItems.Delete(FItems.Count - 1);
+ FItems.Insert(Index, Item);
+end;
+
+procedure TfsXMLItem.SetParent(const Value: TfsXMLItem);
+begin
+ if FParent <> nil then
+ FParent.FItems.Remove(Self);
+ FParent := Value;
+end;
+
+function TfsXMLItem.Find(const Name: String): Integer;
+var
+ i: Integer;
+begin
+ Result := -1;
+ for i := 0 to Count - 1 do
+ if AnsiCompareText(Items[i].Name, Name) = 0 then
+ begin
+ Result := i;
+ break;
+ end;
+end;
+
+function TfsXMLItem.FindItem(const Name: String): TfsXMLItem;
+var
+ i: Integer;
+begin
+ i := Find(Name);
+ if i = -1 then
+ begin
+ Result := Add;
+ Result.Name := Name;
+ end
+ else
+ Result := Items[i];
+end;
+
+function TfsXMLItem.Root: TfsXMLItem;
+begin
+ Result := Self;
+ while Result.Parent <> nil do
+ Result := Result.Parent;
+end;
+
+function TfsXMLItem.GetProp(Index: String): String;
+var
+ i: Integer;
+begin
+ i := Pos(' ' + AnsiUppercase(Index) + '="', AnsiUppercase(' ' + FText));
+ if i <> 0 then
+ begin
+ Result := Copy(FText, i + Length(Index + '="'), MaxInt);
+ Result := XMLToStr(Copy(Result, 1, Pos('"', Result) - 1));
+ end
+ else
+ Result := '';
+end;
+
+procedure TfsXMLItem.SetProp(Index: String; const Value: String);
+var
+ i, j: Integer;
+ s: String;
+begin
+ i := Pos(' ' + AnsiUppercase(Index) + '="', AnsiUppercase(' ' + FText));
+ if i <> 0 then
+ begin
+ j := i + Length(Index + '="');
+ while (j <= Length(FText)) and (FText[j] <> '"') do
+ Inc(j);
+ Delete(FText, i, j - i + 1);
+ end
+ else
+ i := Length(FText) + 1;
+
+ s := Index + '="' + StrToXML(Value) + '"';
+ if (i > 1) and (FText[i - 1] <> ' ') then
+ s := ' ' + s;
+ Insert(s, FText, i);
+end;
+
+function TfsXMLItem.PropExists(const Index: String): Boolean;
+begin
+ Result := Pos(' ' + AnsiUppercase(Index) + '="', ' ' + AnsiUppercase(FText)) > 0;
+end;
+
+function TfsXMLItem.IndexOf(Item: TfsXMLItem): Integer;
+begin
+ Result := FItems.IndexOf(Item);
+end;
+
+procedure TfsXMLItem.Assign(Item: TfsXMLItem);
+
+ procedure DoAssign(ItemFrom, ItemTo: TfsXMLItem);
+ var
+ i: Integer;
+ begin
+ ItemTo.Name := ItemFrom.Name;
+ ItemTo.Text := ItemFrom.Text;
+ ItemTo.Data := ItemFrom.Data;
+ for i := 0 to ItemFrom.Count - 1 do
+ DoAssign(ItemFrom[i], ItemTo.Add);
+ end;
+
+begin
+ Clear;
+ if Item <> nil then
+ DoAssign(Item, Self);
+end;
+
+
+{ TfsXMLDocument }
+
+constructor TfsXMLDocument.Create;
+begin
+ FRoot := TfsXMLItem.Create;
+end;
+
+destructor TfsXMLDocument.Destroy;
+begin
+ FRoot.Free;
+ inherited;
+end;
+
+procedure TfsXMLDocument.Clear;
+begin
+ FRoot.Clear;
+end;
+
+procedure TfsXMLDocument.LoadFromStream(Stream: TStream);
+var
+ rd: TfsXMLReader;
+begin
+ rd := TfsXMLReader.Create(Stream);
+ try
+ FRoot.Clear;
+ rd.ReadHeader;
+ rd.ReadRootItem(FRoot);
+ finally
+ rd.Free;
+ end;
+end;
+
+procedure TfsXMLDocument.SaveToStream(Stream: TStream);
+var
+ wr: TfsXMLWriter;
+begin
+ wr := TfsXMLWriter.Create(Stream);
+ wr.FAutoIndent := FAutoIndent;
+
+ try
+ wr.WriteHeader;
+ wr.WriteRootItem(FRoot);
+ finally
+ wr.Free;
+ end;
+end;
+
+procedure TfsXMLDocument.LoadFromFile(const FileName: String);
+var
+ s: TFileStream;
+begin
+ s := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ try
+ LoadFromStream(s);
+ finally
+ s.Free;
+ end;
+end;
+
+procedure TfsXMLDocument.SaveToFile(const FileName: String);
+var
+ s: TFileStream;
+begin
+ s := TFileStream.Create(FileName, fmCreate);
+ try
+ SaveToStream(s);
+ finally
+ s.Free;
+ end;
+end;
+
+
+{ TfsXMLReader }
+
+constructor TfsXMLReader.Create(Stream: TStream);
+begin
+ FStream := Stream;
+ FSize := Stream.Size;
+ FPosition := Stream.Position;
+ GetMem(FBuffer, 4096);
+end;
+
+destructor TfsXMLReader.Destroy;
+begin
+ FreeMem(FBuffer, 4096);
+ FStream.Position := FPosition;
+ inherited;
+end;
+
+procedure TfsXMLReader.ReadBuffer;
+begin
+ FBufEnd := FStream.Read(FBuffer^, 4096);
+ FBufPos := 0;
+end;
+
+procedure TfsXMLReader.SetPosition(const Value: Int64);
+begin
+ FPosition := Value;
+ FStream.Position := Value;
+ FBufPos := 0;
+ FBufEnd := 0;
+end;
+
+procedure TfsXMLReader.RaiseException;
+begin
+ raise Exception.Create('Invalid file format');
+end;
+
+procedure TfsXMLReader.ReadHeader;
+var
+ s1: String;
+ s2: String;
+begin
+ ReadItem(s1, s2);
+ if Pos('?xml', s1) <> 1 then
+ RaiseException;
+end;
+
+procedure TfsXMLReader.ReadItem(var {$IFDEF Delphi12}NameS{$ELSE}Name{$ENDIF}: String; var Text: String);
+var
+ c: byte;
+ curpos, len: Integer;
+ state: (FindLeft, FindRight, FindComment, Done);
+ i, comment: Integer;
+ ps: PAnsiChar;
+{$IFDEF Delphi12}
+ Name: AnsiString;
+{$ENDIF}
+begin
+ Text := '';
+ comment := 0;
+ state := FindLeft;
+ curpos := 0;
+ len := 4096;
+ SetLength(Name, len);
+ ps := @Name[1];
+
+ while FPosition < FSize do
+ begin
+ if FBufPos = FBufEnd then
+ ReadBuffer;
+ c := Ord(FBuffer[FBufPos]);
+ Inc(FBufPos);
+ Inc(FPosition);
+
+ if state = FindLeft then
+ begin
+ if c = Ord('<') then
+ state := FindRight
+ end
+ else if state = FindRight then
+ begin
+ if c = Ord('>') then
+ begin
+ state := Done;
+ break;
+ end
+ else if c = Ord('<') then
+ RaiseException
+ else
+ begin
+ ps[curpos] := AnsiChar(Chr(c));
+ Inc(curpos);
+ if (curpos = 3) and (Pos(AnsiString('!--'), Name) = 1) then
+ begin
+ state := FindComment;
+ comment := 0;
+ curpos := 0;
+ end;
+ if curpos >= len - 1 then
+ begin
+ Inc(len, 4096);
+ SetLength(Name, len);
+ ps := @Name[1];
+ end;
+ end;
+ end
+ else if State = FindComment then
+ begin
+ if comment = 2 then
+ begin
+ if c = Ord('>') then
+ state := FindLeft
+ else
+ comment := 0;
+ end
+ else begin
+ if c = Ord('-') then
+ Inc(comment)
+ else
+ comment := 0;
+ end;
+ end;
+ end;
+
+ len := curpos;
+ SetLength(Name, len);
+
+ if state = FindRight then
+ RaiseException;
+ if (Name <> '') and (Name[len] = ' ') then
+ SetLength(Name, len - 1);
+
+ i := Pos(AnsiString(' '), Name);
+ if i <> 0 then
+ begin
+{$IFDEF Delphi12}
+ Text := UTF8Decode(Copy(Name, i + 1, len - i));
+{$ELSE}
+ Text := Copy(Name, i + 1, len - i);
+{$ENDIF}
+ Delete(Name, i, len - i + 1);
+ end;
+{$IFDEF Delphi12}
+ NameS := String(Name);
+{$ENDIF}
+end;
+
+procedure TfsXMLReader.ReadRootItem(Item: TfsXMLItem);
+var
+ LastName: String;
+
+ function DoRead(RootItem: TfsXMLItem): Boolean;
+ var
+ n: Integer;
+ ChildItem: TfsXMLItem;
+ Done: Boolean;
+ begin
+ Result := False;
+ ReadItem(RootItem.FName, RootItem.FText);
+ LastName := RootItem.FName;
+
+ if (RootItem.Name = '') or (RootItem.Name[1] = '/') then
+ begin
+ Result := True;
+ Exit;
+ end;
+
+ n := Length(RootItem.Name);
+ if RootItem.Name[n] = '/' then
+ begin
+ SetLength(RootItem.FName, n - 1);
+ Exit;
+ end;
+
+ n := Length(RootItem.Text);
+ if (n > 0) and (RootItem.Text[n] = '/') then
+ begin
+ SetLength(RootItem.FText, n - 1);
+ Exit;
+ end;
+
+ repeat
+ ChildItem := TfsXMLItem.Create;
+ Done := DoRead(ChildItem);
+ if not Done then
+ RootItem.AddItem(ChildItem) else
+ ChildItem.Free;
+ until Done;
+
+ if (LastName <> '') and (AnsiCompareText(LastName, '/' + RootItem.Name) <> 0) then
+ RaiseException;
+ end;
+
+begin
+ DoRead(Item);
+end;
+
+
+{ TfsXMLWriter }
+
+constructor TfsXMLWriter.Create(Stream: TStream);
+begin
+ FStream := Stream;
+end;
+
+procedure TfsXMLWriter.FlushBuffer;
+begin
+ if FBuffer <> '' then
+ FStream.Write(FBuffer[1], Length(FBuffer));
+ FBuffer := '';
+end;
+
+procedure TfsXMLWriter.WriteLn(const s: AnsiString);
+begin
+ if not FAutoIndent then
+ Insert(s, FBuffer, MaxInt) else
+ Insert(s + #13#10, FBuffer, MaxInt);
+ if Length(FBuffer) > 4096 then
+ FlushBuffer;
+end;
+
+procedure TfsXMLWriter.WriteHeader;
+begin
+ WriteLn('');
+end;
+
+function Dup(n: Integer): AnsiString;
+begin
+ SetLength(Result, n);
+ FillChar(Result[1], n, ' ');
+end;
+
+procedure TfsXMLWriter.WriteItem(Item: TfsXMLItem; Level: Integer = 0);
+var
+ s: AnsiString;
+begin
+ if Item.FText <> '' then
+ begin
+{$IFDEF Delphi12}
+ s := UTF8Encode(Item.FText);
+{$ELSE}
+ s := Item.FText;
+{$ENDIF}
+ if (s = '') or (s[1] <> ' ') then
+ s := ' ' + s;
+ end
+ else
+ s := '';
+
+ if Item.Count = 0 then
+ s := s + '/>' else
+ s := s + '>';
+ if not FAutoIndent then
+ s := '<' + AnsiString(Item.Name) + s else
+ s := Dup(Level) + '<' + AnsiString(Item.Name) + s;
+ WriteLn(s);
+end;
+
+procedure TfsXMLWriter.WriteRootItem(RootItem: TfsXMLItem);
+
+ procedure DoWrite(RootItem: TfsXMLItem; Level: Integer = 0);
+ var
+ i: Integer;
+ NeedClear: Boolean;
+ begin
+ NeedClear := False;
+ if not FAutoIndent then
+ Level := 0;
+
+ WriteItem(RootItem, Level);
+ for i := 0 to RootItem.Count - 1 do
+ DoWrite(RootItem[i], Level + 2);
+ if RootItem.Count > 0 then
+ if not FAutoIndent then
+ WriteLn('') else
+ WriteLn(Dup(Level) + '');
+
+ if NeedClear then
+ RootItem.Clear;
+ end;
+
+begin
+ DoWrite(RootItem);
+ FlushBuffer;
+end;
+
+end.
diff --git a/FastScript/fsx.dpk b/FastScript/fsx.dpk
new file mode 100644
index 0000000..9f2efd7
--- /dev/null
+++ b/FastScript/fsx.dpk
@@ -0,0 +1,76 @@
+// Package file for CLX
+
+package fsx;
+
+{$I fs.inc}
+
+{$R *.res}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD ON}
+
+requires
+{$IFDEF LINUX}
+ rtl,
+ visualclx,
+ visualdbclx,
+ vcl;
+{$ELSE}
+ rtl,
+ dbrtl,
+ visualclx,
+ visualdbclx,
+ ibxpress,
+ vcl,
+ vclx,
+ vcldb;
+{$ENDIF}
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+{$IFNDEF LINUX}
+ fs_iibxrtti in 'fs_iibxrtti.pas',
+{$ENDIF}
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/FastScript/fsx.res b/FastScript/fsx.res
new file mode 100644
index 0000000..5a84b72
Binary files /dev/null and b/FastScript/fsx.res differ
diff --git a/FastScript/readme_lazarus.txt b/FastScript/readme_lazarus.txt
new file mode 100644
index 0000000..f90c82b
--- /dev/null
+++ b/FastScript/readme_lazarus.txt
@@ -0,0 +1,6 @@
+Cant be installed (no such db engines under lazarus):
+ fs_idbreg, fs_iibxreg, fs_iadoreg, fs_ibdereg, fs_iteereg
+ fs_ibdertti, fs_ichartrtti, fs_iadortti, fs_iibxrtti,
+
+todo for future fpc, lazarus:
+ fs_idisp
diff --git a/FastScript/tee.inc b/FastScript/tee.inc
new file mode 100644
index 0000000..285c35d
--- /dev/null
+++ b/FastScript/tee.inc
@@ -0,0 +1,85 @@
+//------------------- TeeChart component ----------------------------
+{$DEFINE TeeChartStd}
+
+//------------------- TeeChart Std 7 component ----------------------
+// If you have TeeChart Std 7, uncomment the following line:
+//{$DEFINE TeeChartStd7}
+
+//------------------- TeeChart Pro 4 component --------------------
+// If you have TeeChart Pro 4, uncomment the following line:
+//{$DEFINE TeeChart4}
+
+//------------------- TeeChart Pro 5 component --------------------
+// If you have TeeChart Pro 5, uncomment the following line:
+//{$DEFINE TeeChart5}
+
+//------------------- TeeChart Pro 6 component ----------------------
+// If you have TeeChart Pro 6, uncomment the following line:
+//{$DEFINE TeeChart6}
+
+//------------------- TeeChart Pro 7 component ----------------------
+// If you have TeeChart Pro 7, uncomment the following line:
+//{$DEFINE TeeChart7}
+
+//------------------- TeeChart Pro 8 component ----------------------
+// If you have TeeChart Pro 8, uncomment the following line:
+//{$DEFINE TeeChart8}
+
+//------------------- TeeChart Std 8 component ----------------------
+// If you have TeeChart Std 8, uncomment the following line:
+//{$DEFINE TeeChartStd8}
+
+//------------------- TeeChart Pro 9(2010) component ----------------------
+// If you have TeeChart Pro 9(2010), uncomment the following line:
+//{$DEFINE TeeChart9}
+
+//------------------- TeeChart Std 9(2010) component ----------------------
+// If you have TeeChart Std 9(2010), uncomment the following line:
+//{$DEFINE TeeChartStd9}
+
+
+// Don't change here ------------------------------------------------
+{$IFDEF TeeChartStd7}
+ {$UNDEF TeeChartStd}
+ {$DEFINE TeeChartStandart}
+{$ENDIF}
+
+{$IFDEF TeeChartStd8}
+ {$UNDEF TeeChartStd}
+ {$DEFINE TeeChartStandart}
+{$ENDIF}
+
+{$IFDEF TeeChartStd9}
+ {$UNDEF TeeChartStd}
+ {$DEFINE TeeChartStandart}
+{$ENDIF}
+
+{$IFDEF TeeChart4}
+ {$UNDEF TeeChartStd}
+ {$DEFINE TeeChartPro}
+{$ENDIF}
+
+{$IFDEF TeeChart5}
+ {$UNDEF TeeChartStd}
+ {$DEFINE TeeChartPro}
+{$ENDIF}
+
+{$IFDEF TeeChart6}
+ {$UNDEF TeeChartStd}
+ {$DEFINE TeeChartPro}
+{$ENDIF}
+
+{$IFDEF TeeChart7}
+ {$UNDEF TeeChartStd}
+ {$DEFINE TeeChartPro}
+{$ENDIF}
+
+{$IFDEF TeeChart8}
+ {$UNDEF TeeChartStd}
+ {$DEFINE TeeChartPro}
+{$ENDIF}
+
+{$IFDEF TeeChart9}
+ {$UNDEF TeeChartStd}
+ {$DEFINE TeeChartPro}
+{$ENDIF}
diff --git a/LibD28/FMX.BaseTypeAliases.pas b/LibD28/FMX.BaseTypeAliases.pas
new file mode 100644
index 0000000..2d807b0
--- /dev/null
+++ b/LibD28/FMX.BaseTypeAliases.pas
@@ -0,0 +1,283 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Graphics.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.BaseTypeAliases;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Types, FMX.Objects, System.UITypes, System.UIConsts, FMX.Graphics, FMX.Controls, System.Types, System.TypInfo;
+
+type
+
+ TCalloutPositionHelper = record helper for TCalloutPosition
+ const
+ cpTop = TCalloutPosition.Top deprecated 'Use TCalloutPosition.Top';
+ cpLeft = TCalloutPosition.Left deprecated 'Use TCalloutPosition.Left';
+ cpBottom = TCalloutPosition.Bottom deprecated 'Use TCalloutPosition.Bottom';
+ cpRight = TCalloutPosition.Right deprecated 'Use TCalloutPosition.Right';
+ end;
+
+ TCornerHelper = record helper for TCorner
+ const
+ crTopLeft = TCorner.TopLeft deprecated 'Use TCorner.TopLeft';
+ crTopRight = TCorner.TopRight deprecated 'Use TCorner.TopRight';
+ crBottomLeft = TCorner.BottomLeft deprecated 'Use TCorner.BottomLeft';
+ crBottomRight = TCorner.BottomRight deprecated 'Use TCorner.BottomRight';
+ end;
+
+ TCornerTypeHelper = record helper for TCornerType
+ const
+ ctRound = TCornerType.Round deprecated 'Use TCornerType.Round';
+ ctBevel = TCornerType.Bevel deprecated 'Use TCornerType.Bevel';
+ ctInnerRound = TCornerType.InnerRound deprecated 'Use TCornerType.InnerRound';
+ ctInnerLine = TCornerType.InnerLine deprecated 'Use TCornerType.InnerLine';
+ end;
+
+ TSideHelper = record helper for TSide
+ const
+ sdTop = TSide.Top deprecated 'Use TSide.Top';
+ sdLeft = TSide.Left deprecated 'Use TSide.Left';
+ sdBottom = TSide.Bottom deprecated 'Use TSide.Bottom';
+ sdRight = TSide.Right deprecated 'Use TSide.Right';
+ end;
+
+ TTextAlignHelper = record helper for TTextAlign
+ const
+ taCenter = TTextAlign.Center deprecated 'Use TTextAlign.Center';
+ taLeading = TTextAlign.Leading deprecated 'Use TTextAlign.Leading';
+ taTrailing = TTextAlign.Trailing deprecated 'Use TTextAlign.Trailing';
+ end;
+
+ TTextTrimmingHelper = record helper for TTextTrimming
+ const
+ ttNone = TTextTrimming.None deprecated 'Use TTextTrimming.None';
+ ttCharacter = TTextTrimming.Character deprecated 'Use TTextTrimming.Character';
+ ttWord = TTextTrimming.Word deprecated 'Use TTextTrimming.Word';
+ end;
+
+ TStyledSettingHelper = record helper for TStyledSetting
+ const
+ ssFamily = TStyledSetting.Family deprecated 'Use TStyledSetting.Family';
+ ssSize = TStyledSetting.Size deprecated 'Use TStyledSetting.Size';
+ ssStyle = TStyledSetting.Style deprecated 'Use TStyledSetting.Style';
+ ssFontColor = TStyledSetting.FontColor deprecated 'Use TStyledSetting.FontColor';
+ ssOther = TStyledSetting.Other deprecated 'Use TStyledSetting.Other';
+ end;
+
+ TMenuItemChangeHelper = record helper for TMenuItemChange
+ const
+ mcEnabled = TMenuItemChange.Enabled deprecated 'Use TMenuItemChange.Enabled';
+ mcVisible = TMenuItemChange.Visible deprecated 'Use TMenuItemChange.Visible';
+ mcText = TMenuItemChange.Text deprecated 'Use TMenuItemChange.Text';
+ mcShortcut = TMenuItemChange.Shortcut deprecated 'Use TMenuItemChange.Shortcut';
+ mcChecked = TMenuItemChange.Checked deprecated 'Use TMenuItemChange.Checked';
+ mcBitmap = TMenuItemChange.Bitmap deprecated 'Use TMenuItemChange.Bitmap';
+ end;
+
+ TScreenOrientationHelper = record helper for TScreenOrientation
+ const
+ soPortrait = TScreenOrientation.Portrait deprecated 'Use TScreenOrientation.Portrait';
+ soLandscape = TScreenOrientation.Landscape deprecated 'Use TScreenOrientation.Landscape';
+ soInvertedPortrait = TScreenOrientation.InvertedPortrait deprecated 'Use TScreenOrientation.InvertedPortrait';
+ soInvertedLandscape = TScreenOrientation.InvertedLandscape deprecated 'Use TScreenOrientation.InvertedLandscape';
+ end;
+
+ TFormStyleHelper = record helper for TFormStyle
+ const
+ fsNormal = TFormStyle.Normal deprecated 'Use TFormStyle.Normal';
+ fsPopup = TFormStyle.Popup deprecated 'Use TFormStyle.Popup';
+ fsStayOnTop = TFormStyle.StayOnTop deprecated 'Use TFormStyle.StayOnTop';
+ end;
+
+ TAlignLayoutHelper = record helper for TAlignLayout
+ const
+ alNone = TAlignLayout.None deprecated 'Use TAlignLayout.None';
+ alTop = TAlignLayout.Top deprecated 'Use TAlignLayout.Top';
+ alLeft = TAlignLayout.Left deprecated 'Use TAlignLayout.Left';
+ alRight = TAlignLayout.Right deprecated 'Use TAlignLayout.Right';
+ alBottom = TAlignLayout.Bottom deprecated 'Use TAlignLayout.Bottom';
+ alMostTop = TAlignLayout.MostTop deprecated 'Use TAlignLayout.MostTop';
+ alMostBottom = TAlignLayout.MostBottom deprecated 'Use TAlignLayout.MostBottom';
+ alMostLeft = TAlignLayout.MostLeft deprecated 'Use TAlignLayout.MostLeft';
+ alMostRight = TAlignLayout.MostRight deprecated 'Use TAlignLayout.MostRight';
+ alClient = TAlignLayout.Client deprecated 'Use TAlignLayout.Client';
+ alContents = TAlignLayout.Contents deprecated 'Use TAlignLayout.Contents';
+ alCenter = TAlignLayout.Center deprecated 'Use TAlignLayout.Center';
+ alVertCenter = TAlignLayout.VertCenter deprecated 'Use TAlignLayout.VertCenter';
+ alHorzCenter = TAlignLayout.HorzCenter deprecated 'Use TAlignLayout.HorzCenter';
+ alHorizontal = TAlignLayout.Horizontal deprecated 'Use TAlignLayout.Horizontal';
+ alVertical = TAlignLayout.Vertical deprecated 'Use TAlignLayout.Vertical';
+ alScale = TAlignLayout.Scale deprecated 'Use TAlignLayout.Scale';
+ alFit = TAlignLayout.Fit deprecated 'Use TAlignLayout.Fit';
+ alFitLeft = TAlignLayout.FitLeft deprecated 'Use TAlignLayout.FitLeft';
+ alFitRight = TAlignLayout.FitRight deprecated 'Use TAlignLayout.FitRight';
+ end;
+
+ TGradientStyleHelper = record helper for TGradientStyle
+ const
+ gsLinear = TGradientStyle.Linear deprecated 'Use TGradientStyle.Linear';
+ gsRadial = TGradientStyle.Radial deprecated 'Use TGradientStyle.Radial';
+ end;
+
+ TBrushKindHelper = record helper for TBrushKind
+ const
+ bkNone = TBrushKind.None deprecated 'Use TBrushKind.None';
+ bkSolid = TBrushKind.Solid deprecated 'Use TBrushKind.Solid';
+ bkGradient = TBrushKind.Gradient deprecated 'Use TBrushKind.Gradient';
+ bkBitmap = TBrushKind.Bitmap deprecated 'Use TBrushKind.Bitmap';
+ bkResource = TBrushKind.Resource deprecated 'Use TBrushKind.Resource';
+ end;
+
+ TStrokeCapHelper = record helper for TStrokeCap
+ const
+ scFlat = TStrokeCap.Flat deprecated 'Use TStrokeCap.Flat';
+ scRound = TStrokeCap.Round deprecated 'Use TStrokeCap.Round';
+ end;
+
+ TStrokeJoinHelper = record helper for TStrokeJoin
+ const
+ sjMiter = TStrokeJoin.Miter deprecated 'Use TStrokeJoin.Miter';
+ sjRound = TStrokeJoin.Round deprecated 'Use TStrokeJoin.Round';
+ sjBevel = TStrokeJoin.Bevel deprecated 'Use TStrokeJoin.Bevel';
+ end;
+
+ TStrokeDashHelper = record helper for TStrokeDash
+ const
+ sdSolid = TStrokeDash.Solid deprecated 'Use TStrokeDash.Solid';
+ sdDash = TStrokeDash.Dash deprecated 'Use TStrokeDash.Dash';
+ sdDot = TStrokeDash.Dot deprecated 'Use TStrokeDash.Dot';
+ sdDashDot = TStrokeDash.DashDot deprecated 'Use TStrokeDash.DashDot';
+ sdDashDotDot = TStrokeDash.DashDotDot deprecated 'Use TStrokeDash.DashDotDot';
+ sdCustom = TStrokeDash.Custom deprecated 'Use TStrokeDash.Custom';
+ end;
+
+ TFillTextFlagHelper = record helper for TFillTextFlag
+ const
+ ftRightToLeft = TFillTextFlag.RightToLeft deprecated 'Use TFillTextFlag.RightToLeft';
+ end;
+
+ TMapAccessHelper = record helper for TMapAccess
+ const
+ maRead = TMapAccess.Read deprecated 'Use TMapAccess.Read';
+ maWrite = TMapAccess.Write deprecated 'Use TMapAccess.Write';
+ maReadWrite = TMapAccess.ReadWrite deprecated 'Use TMapAccess.ReadWrite';
+ end;
+
+ TOrientationHelper = record helper for TOrientation
+ const
+ orHorizontal = TOrientation.Horizontal deprecated 'Use TOrientation.Horizontal';
+ orVertical = TOrientation.Vertical deprecated 'Use TOrientation.Vertical';
+ end;
+
+ TPlacementHelper = record helper for TPlacement
+ const
+ plBottom = TPlacement.Bottom deprecated 'Use TPlacement.Bottom';
+ plTop = TPlacement.Top deprecated 'Use TPlacement.Top';
+ plLeft = TPlacement.Left deprecated 'Use TPlacement.Left';
+ plRight = TPlacement.Right deprecated 'Use TPlacement.Right';
+ plCenter = TPlacement.Center deprecated 'Use TPlacement.Center';
+ plBottomCenter = TPlacement.BottomCenter deprecated 'Use TPlacement.BottomCenter';
+ plTopCenter = TPlacement.TopCenter deprecated 'Use TPlacement.TopCenter';
+ plLeftCenter = TPlacement.LeftCenter deprecated 'Use TPlacement.LeftCenter';
+ plRightCenter = TPlacement.RightCenter deprecated 'Use TPlacement.RightCenter';
+ plAbsolute = TPlacement.Absolute deprecated 'Use TPlacement.Absolute';
+ plMouse = TPlacement.Mouse deprecated 'Use TPlacement.Mouse';
+ plMouseCenter = TPlacement.MouseCenter deprecated 'Use TPlacement.MouseCenter';
+ end;
+
+ TVirtualKeyboardTypeHelper = record helper for TVirtualKeyboardType
+ const
+ vktDefault = TVirtualKeyboardType.Default deprecated 'Use TVirtualKeyboardType.Default';
+ vktNumbersAndPunctuation = TVirtualKeyboardType.NumbersAndPunctuation deprecated 'Use TVirtualKeyboardType.NumbersAndPunctuation';
+ vktNumberPad = TVirtualKeyboardType.NumberPad deprecated 'Use TVirtualKeyboardType.NumberPad';
+ vktPhonePad = TVirtualKeyboardType.PhonePad deprecated 'Use TVirtualKeyboardType.PhonePad';
+ vktAlphabet = TVirtualKeyboardType.Alphabet deprecated 'Use TVirtualKeyboardType.Alphabet';
+ vktURL = TVirtualKeyboardType.URL deprecated 'Use TVirtualKeyboardType.URL';
+ vktNamePhonePad = TVirtualKeyboardType.NamePhonePad deprecated 'Use TVirtualKeyboardType.NamePhonePad';
+ vktEmailAddress = TVirtualKeyboardType.EmailAddress deprecated 'Use TVirtualKeyboardType.EmailAddress';
+ end;
+
+ TVirtualKeyboardStateHelper = record helper for TVirtualKeyboardState
+ const
+ vksAutoShow = TVirtualKeyboardState.AutoShow deprecated 'Use TVirtualKeyboardState.AutoShow';
+ vksVisible = TVirtualKeyboardState.Visible deprecated 'Use TVirtualKeyboardState.Visible';
+ vksError = TVirtualKeyboardState.Error deprecated 'Use TVirtualKeyboardState.Error';
+ vksTransient = TVirtualKeyboardState.Transient deprecated 'Use TVirtualKeyboardState.Transient';
+ end;
+
+ TReturnKeyTypeHelper = record helper for TReturnKeyType
+ const
+ rktDefault = TReturnKeyType.Default deprecated 'Use TReturnKeyType.Default';
+ rktDone = TReturnKeyType.Done deprecated 'Use TReturnKeyType.Done';
+ rktGo = TReturnKeyType.Go deprecated 'Use TReturnKeyType.Go';
+ rktNext = TReturnKeyType.Next deprecated 'Use TReturnKeyType.Next';
+ rktSearch = TReturnKeyType.Search deprecated 'Use TReturnKeyType.Search';
+ rktSend = TReturnKeyType.Send deprecated 'Use TReturnKeyType.Send';
+ end;
+
+implementation
+
+initialization
+ AddEnumElementAliases(TypeInfo(TCalloutPosition), ['cpTop', 'cpLeft', 'cpBottom', 'cpRight']);
+ AddEnumElementAliases(TypeInfo(TCorner), ['crTopLeft', 'crTopRight', 'crBottomLeft', 'crBottomRight']);
+ AddEnumElementAliases(TypeInfo(TCornerType), ['ctRound', 'ctBevel', 'ctInnerRound', 'ctInnerLine']);
+ AddEnumElementAliases(TypeInfo(TSide), ['sdTop', 'sdLeft', 'sdBottom', 'sdRight']);
+ AddEnumElementAliases(TypeInfo(TTextAlign), ['taCenter', 'taLeading', 'taTrailing']);
+ AddEnumElementAliases(TypeInfo(TTextTrimming), ['ttNone', 'ttCharacter', 'ttWord']);
+ AddEnumElementAliases(TypeInfo(TStyledSetting), ['ssFamily', 'ssSize', 'ssStyle', 'ssFontColor', 'ssOther']);
+ AddEnumElementAliases(TypeInfo(TMenuItemChange), ['mcEnabled', 'mcVisible', 'mcText', 'mcShortcut', 'mcChecked', 'mcBitmap']);
+ AddEnumElementAliases(TypeInfo(TScreenOrientation), ['soPortrait', 'soLandscape', 'soInvertedPortrait', 'soInvertedLandscape']);
+ AddEnumElementAliases(TypeInfo(TFormStyle), ['fsNormal', 'fsPopup', 'fsStayOnTop']);
+ AddEnumElementAliases(TypeInfo(TAlignLayout), ['alNone', 'alTop', 'alLeft', 'alRight', 'alBottom', 'alMostTop', 'alMostBottom', 'alMostLeft', 'alMostRight', 'alClient', 'alContents', 'alCenter', 'alVertCenter', 'alHorzCenter', 'alHorizontal', 'alVertical', 'alScale', 'alFit', 'alFitLeft', 'alFitRight']);
+ AddEnumElementAliases(TypeInfo(TGradientStyle), ['gsLinear', 'gsRadial']);
+ AddEnumElementAliases(TypeInfo(TBrushKind), ['bkNone', 'bkSolid', 'bkGradient', 'bkBitmap', 'bkResource']);
+ AddEnumElementAliases(TypeInfo(TStrokeCap), ['scFlat', 'scRound']);
+ AddEnumElementAliases(TypeInfo(TStrokeJoin), ['sjMiter', 'sjRound', 'sjBevel']);
+ AddEnumElementAliases(TypeInfo(TStrokeDash), ['sdSolid', 'sdDash', 'sdDot', 'sdDashDot', 'sdDashDotDot', 'sdCustom']);
+ AddEnumElementAliases(TypeInfo(TMapAccess), ['maRead', 'maWrite', 'maReadWrite']);
+ AddEnumElementAliases(TypeInfo(TFillTextFlag), ['ftRightToLeft']);
+ AddEnumElementAliases(TypeInfo(TOrientation), ['orHorizontal', 'orVertical']);
+ AddEnumElementAliases(TypeInfo(TPlacement), ['plBottom', 'plTop', 'plLeft', 'plRight', 'plCenter', 'plBottomCenter', 'plTopCenter', 'plLeftCenter', 'plRightCenter', 'plAbsolute', 'plMouse', 'plMouseCenter']);
+ AddEnumElementAliases(TypeInfo(TVirtualKeyboardType), ['vktDefault', 'vktNumbersAndPunctuation', 'vktNumberPad', 'vktPhonePad', 'vktAlphabet', 'vktURL', 'vktNamePhonePad', 'vktEmailAddress']);
+ AddEnumElementAliases(TypeInfo(TReturnKeyType), ['rktDefault', 'rktDone', 'rktGo', 'rktNext', 'rktSearch']);
+ AddEnumElementAliases(TypeInfo(TVirtualKeyboardState), ['vksAutoShow', 'vksVisible', 'vksError', 'vksTransient']);
+
+
+finalization
+ RemoveEnumElementAliases(TypeInfo(TCalloutPosition));
+ RemoveEnumElementAliases(TypeInfo(TCorner));
+ RemoveEnumElementAliases(TypeInfo(TCornerType));
+ RemoveEnumElementAliases(TypeInfo(TSide));
+ RemoveEnumElementAliases(TypeInfo(TTextAlign));
+ RemoveEnumElementAliases(TypeInfo(TTextTrimming));
+ RemoveEnumElementAliases(TypeInfo(TStyledSetting));
+ RemoveEnumElementAliases(TypeInfo(TMenuItemChange));
+ RemoveEnumElementAliases(TypeInfo(TScreenOrientation));
+ RemoveEnumElementAliases(TypeInfo(TFormStyle));
+ RemoveEnumElementAliases(TypeInfo(TAlignLayout));
+ RemoveEnumElementAliases(TypeInfo(TGradientStyle));
+ RemoveEnumElementAliases(TypeInfo(TBrushKind));
+ RemoveEnumElementAliases(TypeInfo(TStrokeCap));
+ RemoveEnumElementAliases(TypeInfo(TStrokeJoin));
+ RemoveEnumElementAliases(TypeInfo(TStrokeDash));
+ RemoveEnumElementAliases(TypeInfo(TMapAccess));
+ RemoveEnumElementAliases(TypeInfo(TFillTextFlag));
+ RemoveEnumElementAliases(TypeInfo(TOrientation));
+ RemoveEnumElementAliases(TypeInfo(TPlacement));
+ RemoveEnumElementAliases(TypeInfo(TVirtualKeyboardType));
+ RemoveEnumElementAliases(TypeInfo(TReturnKeyType));
+ RemoveEnumElementAliases(TypeInfo(TVirtualKeyboardState));
+
+
+end.
diff --git a/LibD28/FMX.ConverterFR3toFRFMX.pas b/LibD28/FMX.ConverterFR3toFRFMX.pas
new file mode 100644
index 0000000..ad00f04
--- /dev/null
+++ b/LibD28/FMX.ConverterFR3toFRFMX.pas
@@ -0,0 +1,174 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ RB -> FR importer }
+{ }
+{ Copyright (c) 1998-2008 }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.ConverterFR3toFRFMX ;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.SysUtils, System.Classes, FMX.Types, System.UITypes,
+ FMX.frxClass, FMX.frxVariables, FMX.frxDCtrl,
+ {$IFDEF LINUX}
+ {$I tee.inc}
+ {$IFDEF TeeChartPro}
+ FMX.frxChart,
+ {$ENDIF}
+ {$ELSE}
+ FMX.frxChart,
+ {$ENDIF}
+ FMX.frxCross, System.Variants, FMX.frxGradient;
+
+
+type
+ TfrxCustomCrossViewHack = class(TfrxCustomCrossView);
+ TfrxConverterEventsNew = class(TObject)
+ private
+ procedure DoAfterLoad(Sender: TfrxReport);
+ function DoLoad(Sender: TfrxReport; Stream: TStream): Boolean;
+ end;
+
+var
+ frxConverterEventsNew: TfrxConverterEventsNew;
+
+function RGB(r, g, b: Byte): TAlphaColor; inline;
+begin
+ Result := (r or (g shl 8) or (b shl 16));
+end;
+
+procedure ToRGB(Color: TAlphaColor; var r, g, b: Byte); inline;
+begin
+ r := Color and $000000ff;
+ g := (Color shr 8) and $000000ff;
+ b := (Color shr 16) and $000000ff;
+end;
+
+function ColorToAlphaColor(Color: TAlphaColor): TAlphaColor; inline;
+var
+ R, G, B : BYTE;
+begin
+ ToRGB(Color, R, G, B);
+ Result := RGB(B, G, R) or $FF000000;
+end;
+
+procedure ConvertViewObj(View: TfrxView);
+begin
+ if View.Color = $1FFFFFFF then View.Color := 0
+ else if(View.Color <> 0) then
+ begin
+ View.Color := ColorToAlphaColor(View.Color);
+ end;
+
+ View.Font.Color := ColorToAlphaColor(View.Font.Color);
+ View.Frame.Color := ColorToAlphaColor(View.Frame.Color);
+ View.Frame.LeftLine.Color := ColorToAlphaColor(View.Frame.LeftLine.Color);
+ View.Frame.RightLine.Color := ColorToAlphaColor(View.Frame.LeftLine.Color);
+ View.Frame.TopLine.Color := ColorToAlphaColor(View.Frame.LeftLine.Color);
+ View.Frame.BottomLine.Color := ColorToAlphaColor(View.Frame.LeftLine.Color);
+end;
+
+procedure ConvertMemoView(Memo: TfrxCustomMemoView);
+begin
+ ConvertViewObj(Memo);
+ Memo.Highlight.Color := ColorToAlphaColor(Memo.Highlight.Color);
+end;
+
+procedure CorrectProperties(Report: TfrxReport);
+var
+ i, j: Integer;
+ Obj: TObject;
+ ObjList: TList;
+begin
+ for i := 0 to Report.AllObjects.Count - 1 do
+ begin
+ Obj := Report.AllObjects[i];
+ if Obj is TfrxView then
+ begin
+ ConvertViewObj(TfrxView(Obj));
+ end;
+ if Obj is TfrxCustomMemoView then
+ TfrxCustomMemoView(Obj).Highlight.Color := ColorToAlphaColor(TfrxCustomMemoView(Obj).Highlight.Color);
+ if Obj is TfrxGradientView then
+ begin
+ TfrxGradientView(Obj).BeginColor := ColorToAlphaColor(TfrxGradientView(Obj).BeginColor);
+ TfrxGradientView(Obj).EndColor := ColorToAlphaColor(TfrxGradientView(Obj).EndColor);
+ end;
+ if Obj is TfrxCustomCrossView then
+ begin
+ ObjList := TfrxCustomCrossViewHack(Obj).GetNestedObjects;
+ try
+ for j := 0 to ObjList.Count - 1 do
+ if TObject(ObjList[j]) is TfrxView then ConvertViewObj(TfrxView(ObjList[j]));
+ finally
+ ObjList.Free;
+ end;
+ ObjList := TfrxCustomCrossViewHack(Obj).FCellMemos;
+ for j := 0 to ObjList.Count - 1 do
+ if TObject(ObjList[j]) is TfrxCustomMemoView then ConvertMemoView(TfrxCustomMemoView(ObjList[j]));
+ ObjList := TfrxCustomCrossViewHack(Obj).FCellHeaderMemos;
+ for j := 0 to ObjList.Count - 1 do
+ if TObject(ObjList[j]) is TfrxCustomMemoView then ConvertMemoView(TfrxCustomMemoView(ObjList[j]));
+
+ ObjList := TfrxCustomCrossViewHack(Obj).FColumnMemos;
+ for j := 0 to ObjList.Count - 1 do
+ if TObject(ObjList[j]) is TfrxCustomMemoView then ConvertMemoView(TfrxCustomMemoView(ObjList[j]));
+
+ ObjList := TfrxCustomCrossViewHack(Obj).FColumnTotalMemos;
+ for j := 0 to ObjList.Count - 1 do
+ if TObject(ObjList[j]) is TfrxCustomMemoView then ConvertMemoView(TfrxCustomMemoView(ObjList[j]));
+
+ ObjList := TfrxCustomCrossViewHack(Obj).FCornerMemos;
+ for j := 0 to ObjList.Count - 1 do
+ if TObject(ObjList[j]) is TfrxCustomMemoView then ConvertMemoView(TfrxCustomMemoView(ObjList[j]));
+
+ ObjList := TfrxCustomCrossViewHack(Obj).FRowMemos;
+ for j := 0 to ObjList.Count - 1 do
+ if TObject(ObjList[j]) is TfrxCustomMemoView then ConvertMemoView(TfrxCustomMemoView(ObjList[j]));
+
+ ObjList := TfrxCustomCrossViewHack(Obj).FRowTotalMemos;
+ for j := 0 to ObjList.Count - 1 do
+ if TObject(ObjList[j]) is TfrxCustomMemoView then ConvertMemoView(TfrxCustomMemoView(ObjList[j]));
+
+ end;
+
+ end;
+end;
+
+procedure TfrxConverterEventsNew.DoAfterLoad(Sender: TfrxReport);
+begin
+ if not Sender.ReportOptions.IsFMXReport then
+ CorrectProperties(Sender);
+ Sender.ReportOptions.IsFMXReport := True;
+end;
+
+
+
+function TfrxConverterEventsNew.DoLoad(Sender: TfrxReport;
+ Stream: TStream): Boolean;
+begin
+ Sender.ReportOptions.IsFMXReport := False;
+ Result := False;
+end;
+
+initialization
+ frxConverterEventsNew := TfrxConverterEventsNew.Create;
+ frxConverter.OnAfterLoad := frxConverterEventsNew.DoAfterLoad;
+ frxConverter.OnLoad := frxConverterEventsNew.DoLoad;
+ frxConverter.Filter := '*.fr3';
+
+finalization
+ frxConverterEventsNew.Free;
+
+
+end.
\ No newline at end of file
diff --git a/LibD28/FMX.DelphiZXIngQRCode.pas b/LibD28/FMX.DelphiZXIngQRCode.pas
new file mode 100644
index 0000000..f1b4a95
--- /dev/null
+++ b/LibD28/FMX.DelphiZXIngQRCode.pas
@@ -0,0 +1,3795 @@
+unit FMX.DelphiZXingQRCode;
+
+// ZXing QRCode port to Delphi, by Debenu Pty Ltd
+// www.debenu.com
+
+// Original copyright notice
+(*
+ * Copyright 2008 ZXing authors
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *)
+
+interface
+
+{$I frx.inc}
+
+type
+ TQRCodeEncoding = (qrAuto, qrNumeric, qrAlphanumeric, qrISO88591, qrUTF8NoBOM, qrUTF8BOM, qrShift_JIS);
+ TQRErrorLevels = (ecL, ecM, ecQ, ecH);
+ T2DBooleanArray = array of array of Boolean;
+
+ TErrorCorrectionLevel = class
+ private
+ FBits: Integer;
+ FOrdinal: Integer;
+ public
+ procedure Assign(Source: TErrorCorrectionLevel);
+ property Bits: Integer read FBits write FBits;
+ property Ordinal: Integer read FOrdinal write FOrdinal;
+ end;
+
+ TDelphiZXingQRCode = class
+ private
+ procedure SetErrorLevels(const Value: TQRErrorLevels);
+ procedure SetCodePage(const Value: Longint);
+ protected
+ FData: WideString;
+ FRows: Integer;
+ FColumns: Integer;
+ FEncoding: TQRCodeEncoding;
+ FQuietZone: Integer;
+ FElements: T2DBooleanArray;
+ FErrorLevels: TQRErrorLevels;
+ FLevel: TErrorCorrectionLevel;
+ FCodePage: Longint;
+ procedure SetEncoding(NewEncoding: TQRCodeEncoding);
+ procedure SetData(const NewData: WideString);
+ procedure SetQuietZone(NewQuietZone: Integer);
+ function GetIsBlack(Row, Column: Integer): Boolean;
+ procedure Update;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ property Data: WideString read FData write SetData;
+ property Encoding: TQRCodeEncoding read FEncoding write SetEncoding;
+ property QuietZone: Integer read FQuietZone write SetQuietZone;
+ property Rows: Integer read FRows;
+ property Columns: Integer read FColumns;
+ property IsBlack[Row, Column: Integer]: Boolean read GetIsBlack;
+ property ErrorLevels: TQRErrorLevels read FErrorLevels write SetErrorLevels;
+ property CodePage: Longint read FCodePage write SetCodePage;
+ end;
+
+implementation
+
+uses
+ System.contnrs, System.Math, System.Classes, System.SysUtils;
+
+type
+ TByteArray = array of Byte;
+ T2DByteArray = array of array of Byte;
+ TIntegerArray = array of Integer;
+
+const
+ NUM_MASK_PATTERNS = 8;
+
+ QUIET_ZONE_SIZE = 4;
+
+ ALPHANUMERIC_TABLE: array[0..95] of Integer = (
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, // 0x00-0x0f
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, // 0x10-0x1f
+ 36, -1, -1, -1, 37, 38, -1, -1, -1, -1, 39, 40, -1, 41, 42, 43, // 0x20-0x2f
+ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 44, -1, -1, -1, -1, -1, // 0x30-0x3f
+ -1, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, // 0x40-0x4f
+ 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1 // 0x50-0x5f
+ );
+
+ DEFAULT_BYTE_MODE_ENCODING = 'ISO-8859-1';
+ DefaultECIValue = 3; // Corresponding 'ISO-8859-1' See https://strokescribe.com/ru/ECI.html
+
+ QRErrorLevelsBits: array[0..3] of Integer = (1, 0, 3, 2);
+
+ POSITION_DETECTION_PATTERN: array[0..6, 0..6] of Integer = (
+ (1, 1, 1, 1, 1, 1, 1),
+ (1, 0, 0, 0, 0, 0, 1),
+ (1, 0, 1, 1, 1, 0, 1),
+ (1, 0, 1, 1, 1, 0, 1),
+ (1, 0, 1, 1, 1, 0, 1),
+ (1, 0, 0, 0, 0, 0, 1),
+ (1, 1, 1, 1, 1, 1, 1));
+
+ HORIZONTAL_SEPARATION_PATTERN: array[0..0, 0..7] of Integer = (
+ (0, 0, 0, 0, 0, 0, 0, 0));
+
+ VERTICAL_SEPARATION_PATTERN: array[0..6, 0..0] of Integer = (
+ (0), (0), (0), (0), (0), (0), (0));
+
+ POSITION_ADJUSTMENT_PATTERN: array[0..4, 0..4] of Integer = (
+ (1, 1, 1, 1, 1),
+ (1, 0, 0, 0, 1),
+ (1, 0, 1, 0, 1),
+ (1, 0, 0, 0, 1),
+ (1, 1, 1, 1, 1));
+
+ // From Appendix E. Table 1, JIS0510X:2004 (p 71). The table was double-checked by komatsu.
+ POSITION_ADJUSTMENT_PATTERN_COORDINATE_TABLE: array[0..39, 0..6] of Integer = (
+ (-1, -1, -1, -1, -1, -1, -1), // Version 1
+ ( 6, 18, -1, -1, -1, -1, -1), // Version 2
+ ( 6, 22, -1, -1, -1, -1, -1), // Version 3
+ ( 6, 26, -1, -1, -1, -1, -1), // Version 4
+ ( 6, 30, -1, -1, -1, -1, -1), // Version 5
+ ( 6, 34, -1, -1, -1, -1, -1), // Version 6
+ ( 6, 22, 38, -1, -1, -1, -1), // Version 7
+ ( 6, 24, 42, -1, -1, -1, -1), // Version 8
+ ( 6, 26, 46, -1, -1, -1, -1), // Version 9
+ ( 6, 28, 50, -1, -1, -1, -1), // Version 10
+ ( 6, 30, 54, -1, -1, -1, -1), // Version 11
+ ( 6, 32, 58, -1, -1, -1, -1), // Version 12
+ ( 6, 34, 62, -1, -1, -1, -1), // Version 13
+ ( 6, 26, 46, 66, -1, -1, -1), // Version 14
+ ( 6, 26, 48, 70, -1, -1, -1), // Version 15
+ ( 6, 26, 50, 74, -1, -1, -1), // Version 16
+ ( 6, 30, 54, 78, -1, -1, -1), // Version 17
+ ( 6, 30, 56, 82, -1, -1, -1), // Version 18
+ ( 6, 30, 58, 86, -1, -1, -1), // Version 19
+ ( 6, 34, 62, 90, -1, -1, -1), // Version 20
+ ( 6, 28, 50, 72, 94, -1, -1), // Version 21
+ ( 6, 26, 50, 74, 98, -1, -1), // Version 22
+ ( 6, 30, 54, 78, 102, -1, -1), // Version 23
+ ( 6, 28, 54, 80, 106, -1, -1), // Version 24
+ ( 6, 32, 58, 84, 110, -1, -1), // Version 25
+ ( 6, 30, 58, 86, 114, -1, -1), // Version 26
+ ( 6, 34, 62, 90, 118, -1, -1), // Version 27
+ ( 6, 26, 50, 74, 98, 122, -1), // Version 28
+ ( 6, 30, 54, 78, 102, 126, -1), // Version 29
+ ( 6, 26, 52, 78, 104, 130, -1), // Version 30
+ ( 6, 30, 56, 82, 108, 134, -1), // Version 31
+ ( 6, 34, 60, 86, 112, 138, -1), // Version 32
+ ( 6, 30, 58, 86, 114, 142, -1), // Version 33
+ ( 6, 34, 62, 90, 118, 146, -1), // Version 34
+ ( 6, 30, 54, 78, 102, 126, 150), // Version 35
+ ( 6, 24, 50, 76, 102, 128, 154), // Version 36
+ ( 6, 28, 54, 80, 106, 132, 158), // Version 37
+ ( 6, 32, 58, 84, 110, 136, 162), // Version 38
+ ( 6, 26, 54, 82, 110, 138, 166), // Version 39
+ ( 6, 30, 58, 86, 114, 142, 170) // Version 40
+ );
+
+ // Type info cells at the left top corner.
+ TYPE_INFO_COORDINATES: array[0..14, 0..1] of Integer = (
+ (8, 0),
+ (8, 1),
+ (8, 2),
+ (8, 3),
+ (8, 4),
+ (8, 5),
+ (8, 7),
+ (8, 8),
+ (7, 8),
+ (5, 8),
+ (4, 8),
+ (3, 8),
+ (2, 8),
+ (1, 8),
+ (0, 8)
+ );
+
+ // From Appendix D in JISX0510:2004 (p. 67)
+ VERSION_INFO_POLY = $1f25; // 1 1111 0010 0101
+
+ // From Appendix C in JISX0510:2004 (p.65).
+ TYPE_INFO_POLY = $537;
+ TYPE_INFO_MASK_PATTERN = $5412;
+
+
+ VERSION_DECODE_INFO: array[0..33] of Integer = (
+
+ $07C94, $085BC, $09A99, $0A4D3, $0BBF6,
+ $0C762, $0D847, $0E60D, $0F928, $10B78,
+ $1145D, $12A17, $13532, $149A6, $15683,
+ $168C9, $177EC, $18EC4, $191E1, $1AFAB,
+ $1B08E, $1CC1A, $1D33F, $1ED75, $1F250,
+ $209D5, $216F0, $228BA, $2379F, $24B0B,
+ $2542E, $26A64, $27541, $28C69);
+
+type
+ TMode = (qmTerminator, qmNumeric, qmAlphanumeric, qmStructuredAppend,
+ qmByte, qmECI, qmKanji, qmFNC1FirstPosition, qmFNC1SecondPosition,
+ qmHanzi);
+
+const
+ ModeCharacterCountBits: array[TMode] of array[0..2] of Integer = (
+ (0, 0, 0), (10, 12, 14), (9, 11, 13), (0, 0, 0), (8, 16, 16),
+ (0, 0, 0), (8, 10, 12), (0, 0, 0), (0, 0, 0), (8, 10, 12));
+
+ ModeBits: array[TMode] of Integer = (0, 1, 2, 3, 4, 7, 8, 5, 9, 13);
+
+type
+ TECB = class
+ private
+ Count: Integer;
+ DataCodewords: Integer;
+ public
+ constructor Create(Count, DataCodewords: Integer);
+ function GetCount: Integer;
+ function GetDataCodewords: Integer;
+ end;
+
+ TECBArray = array of TECB;
+
+ TECBlocks = class
+ private
+ ECCodewordsPerBlock: Integer;
+ ECBlocks: TECBArray;
+ public
+ constructor Create(ECCodewordsPerBlock: Integer; ECBlocks: TECB); overload;
+ constructor Create(ECCodewordsPerBlock: Integer; ECBlocks1, ECBlocks2: TECB); overload;
+ destructor Destroy; override;
+ function GetTotalECCodewords: Integer;
+ function GetNumBlocks: Integer;
+ function GetECCodewordsPerBlock: Integer;
+ function GetECBlocks: TECBArray;
+ end;
+
+ TByteMatrix = class
+ protected
+ Bytes: T2DByteArray;
+ FWidth: Integer;
+ FHeight: Integer;
+ public
+ constructor Create(Width, Height: Integer);
+ function Get(X, Y: Integer): Integer;
+ procedure SetBoolean(X, Y: Integer; Value: Boolean);
+ procedure SetInteger(X, Y: Integer; Value: Integer);
+ function GetArray: T2DByteArray;
+ procedure Assign(Source: TByteMatrix);
+ procedure Clear(Value: Byte);
+ function Hash: AnsiString;
+ property Width: Integer read FWidth;
+ property Height: Integer read FHeight;
+ end;
+
+ TBitArray = class
+ private
+ Bits: array of Integer;
+ Size: Integer;
+ procedure EnsureCapacity(Size: Integer);
+ public
+ constructor Create; overload;
+ constructor Create(Size: Integer); overload;
+ procedure Clear;
+ function GetSizeInBytes: Integer;
+ function GetSize: Integer;
+ function Get(I: Integer): Boolean;
+ procedure SetBit(Index: Integer);
+ procedure AppendBit(Bit: Boolean);
+ procedure AppendBits(Value, NumBits: Integer);
+ procedure AppendBitArray(NewBitArray: TBitArray);
+ procedure ToBytes(BitOffset: Integer; Source: TByteArray; Offset,
+ NumBytes: Integer);
+ procedure XorOperation(Other: TBitArray);
+ end;
+
+ TCharacterSetECI = class
+
+ end;
+
+ TVersion = class
+ private
+ VersionNumber: Integer;
+ AlignmentPatternCenters: array of Integer;
+ ECBlocks: array of TECBlocks;
+ TotalCodewords: Integer;
+ ECCodewords: Integer;
+ public
+ constructor Create(VersionNumber: Integer; AlignmentPatternCenters: array of Integer; ECBlocks1, ECBlocks2, ECBlocks3, ECBlocks4: TECBlocks);
+ destructor Destroy; override;
+ class function GetVersionForNumber(VersionNum: Integer): TVersion;
+ class function ChooseVersion(NumInputBits: Integer; ecLevel: TErrorCorrectionLevel): TVersion;
+ function GetTotalCodewords: Integer;
+ function GetECBlocksForLevel(ECLevel: TErrorCorrectionLevel): TECBlocks;
+ function GetDimensionForVersion: Integer;
+ end;
+
+ TMaskUtil = class
+ public
+ function GetDataMaskBit(MaskPattern, X, Y: Integer): Boolean;
+ end;
+
+ TQRCode = class
+ private
+ FMode: TMode;
+ FECLevel: TErrorCorrectionLevel;
+ FVersion: Integer;
+ FMatrixWidth: Integer;
+ FMaskPattern: Integer;
+ FNumTotalBytes: Integer;
+ FNumDataBytes: Integer;
+ FNumECBytes: Integer;
+ FNumRSBlocks: Integer;
+ FMatrix: TByteMatrix;
+ FQRCodeError: Boolean;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function At(X, Y: Integer): Integer;
+ function IsValid: Boolean;
+ function IsValidMaskPattern(MaskPattern: Integer): Boolean;
+ procedure SetMatrix(NewMatrix: TByteMatrix);
+ procedure SetECLevel(NewECLevel: TErrorCorrectionLevel);
+ procedure SetAll(VersionNum, NumBytes, NumDataBytes, NumRSBlocks, NumECBytes, MatrixWidth: Integer);
+ property QRCodeError: Boolean read FQRCodeError;
+ property Mode: TMode read FMode write FMode;
+ property Version: Integer read FVersion write FVersion;
+ property NumDataBytes: Integer read FNumDataBytes;
+ property NumTotalBytes: Integer read FNumTotalBytes;
+ property NumRSBlocks: Integer read FNumRSBlocks;
+ property MatrixWidth: Integer read FMatrixWidth;
+ property MaskPattern: Integer read FMaskPattern write FMaskPattern;
+ property ECLevel: TErrorCorrectionLevel read FECLevel;
+ end;
+
+ TMatrixUtil = class
+
+ private
+ FMatrixUtilError: Boolean;
+ procedure ClearMatrix(Matrix: TByteMatrix);
+
+ procedure EmbedBasicPatterns(Version: Integer; Matrix: TByteMatrix);
+ procedure EmbedTypeInfo(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Matrix: TByteMatrix);
+ procedure MaybeEmbedVersionInfo(Version: Integer; Matrix: TByteMatrix);
+ procedure EmbedDataBits(DataBits: TBitArray; MaskPattern: Integer; Matrix: TByteMatrix);
+ function FindMSBSet(Value: Integer): Integer;
+ function CalculateBCHCode(Value, Poly: Integer): Integer;
+ procedure MakeTypeInfoBits(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Bits: TBitArray);
+ procedure MakeVersionInfoBits(Version: Integer; Bits: TBitArray);
+ function IsEmpty(Value: Integer): Boolean;
+ procedure EmbedTimingPatterns(Matrix: TByteMatrix);
+ procedure EmbedDarkDotAtLeftBottomCorner(Matrix: TByteMatrix);
+ procedure EmbedHorizontalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
+ procedure EmbedVerticalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
+ procedure EmbedPositionAdjustmentPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
+ procedure EmbedPositionDetectionPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
+ procedure EmbedPositionDetectionPatternsAndSeparators(Matrix: TByteMatrix);
+ procedure MaybeEmbedPositionAdjustmentPatterns(Version: Integer; Matrix: TByteMatrix);
+ public
+ constructor Create;
+ property MatrixUtilError: Boolean read FMatrixUtilError;
+ procedure BuildMatrix(DataBits: TBitArray; ECLevel: TErrorCorrectionLevel; Version, MaskPattern: Integer; Matrix: TByteMatrix);
+ end;
+
+function GetModeBits(Mode: TMode): Integer;
+begin
+ Result := ModeBits[Mode];
+end;
+
+function GetModeCharacterCountBits(Mode: TMode; Version: TVersion): Integer;
+var
+ Number: Integer;
+ Offset: Integer;
+begin
+ Number := Version.VersionNumber;
+
+ if (Number <= 9) then
+ begin
+ Offset := 0;
+ end else
+ if (number <= 26) then
+ begin
+ Offset := 1;
+ end else
+ begin
+ Offset := 2;
+ end;
+ Result := ModeCharacterCountBits[Mode][Offset];
+end;
+
+type
+ TBlockPair = class
+ private
+ FDataBytes: TByteArray;
+ FErrorCorrectionBytes: TByteArray;
+ public
+ constructor Create(BA1, BA2: TByteArray);
+ function GetDataBytes: TByteArray;
+ function GetErrorCorrectionBytes: TByteArray;
+ end;
+
+ TGenericGFPoly = class;
+
+ TGenericGF = class
+ private
+ FExpTable: TIntegerArray;
+ FLogTable: TIntegerArray;
+ FZero: TGenericGFPoly;
+ FOne: TGenericGFPoly;
+ FSize: Integer;
+ FPrimitive: Integer;
+ FGeneratorBase: Integer;
+ FInitialized: Boolean;
+ FPolyList: array of TGenericGFPoly;
+
+ procedure CheckInit;
+ procedure Initialize;
+ public
+ class function CreateQRCodeField256: TGenericGF;
+ class function AddOrSubtract(A, B: Integer): Integer;
+ constructor Create(Primitive, Size, B: Integer);
+ destructor Destroy; override;
+ function GetZero: TGenericGFPoly;
+ function Exp(A: Integer): Integer;
+ function GetGeneratorBase: Integer;
+ function Inverse(A: Integer): Integer;
+ function Multiply(A, B: Integer): Integer;
+ function BuildMonomial(Degree, Coefficient: Integer): TGenericGFPoly;
+ end;
+
+ TGenericGFPolyArray = array of TGenericGFPoly;
+ TGenericGFPoly = class
+ private
+ FField: TGenericGF;
+ FCoefficients: TIntegerArray;
+ public
+ constructor Create(AField: TGenericGF; ACoefficients: TIntegerArray);
+ destructor Destroy; override;
+ function Coefficients: TIntegerArray;
+ function Multiply(Other: TGenericGFPoly): TGenericGFPoly;
+ function MultiplyByMonomial(Degree, Coefficient: Integer): TGenericGFPoly;
+ function Divide(Other: TGenericGFPoly): TGenericGFPolyArray;
+ function GetCoefficients: TIntegerArray;
+ function IsZero: Boolean;
+ function GetCoefficient(Degree: Integer): Integer;
+ function GetDegree: Integer;
+ function AddOrSubtract(Other: TGenericGFPoly): TGenericGFPoly;
+ end;
+
+ TReedSolomonEncoder = class
+ private
+ FField: TGenericGF;
+ FCachedGenerators: TObjectList;
+ public
+ constructor Create(AField: TGenericGF);
+ destructor Destroy; override;
+ procedure Encode(ToEncode: TIntegerArray; ECBytes: Integer);
+ function BuildGenerator(Degree: Integer): TGenericGFPoly;
+ end;
+
+ TEncoder = class
+ private
+ FEncoderError: Boolean;
+ FCodepage: Integer;
+ FCodeVersion: Integer;
+
+ function ApplyMaskPenaltyRule1Internal(Matrix: TByteMatrix;
+ IsHorizontal: Boolean): Integer;
+ function ChooseMode(const Content: WideString; var EncodeOptions: Integer): TMode; overload;
+ function PosECI(Content: string): integer;
+ function IsContainECI(Content: string): boolean;
+ function IsStartWithECI(Content: string): boolean;
+ function FilterContent(const Content: WideString; Mode: TMode; EncodeOptions: Integer): WideString;
+ procedure AppendECIBytes(const Content: WideString; Bits: TBitArray);
+ procedure Append8BitBytes(const Content: WideString; Bits: TBitArray; EncodeOptions: Integer);
+
+ procedure AppendAlphanumericBytes(const Content: WideString;
+ Bits: TBitArray);
+ procedure AppendBytes(const Content: WideString; Mode: TMode;
+ Bits: TBitArray; EncodeOptions: Integer);
+ procedure AppendKanjiBytes(const Content: WideString; Bits: TBitArray);
+ procedure AppendLengthInfo(NumLetters, VersionNum: Integer; Mode: TMode;
+ Bits: TBitArray);
+ procedure AppendModeInfo(Mode: TMode; Bits: TBitArray);
+ procedure AppendNumericBytes(const Content: WideString; Bits: TBitArray);
+ function ChooseMaskPattern(Bits: TBitArray; ECLevel: TErrorCorrectionLevel;
+ Version: Integer; Matrix: TByteMatrix): Integer;
+ function GenerateECBytes(DataBytes: TByteArray;
+
+ NumECBytesInBlock: Integer): TByteArray;
+ function GetAlphanumericCode(Code: Integer): Integer;
+ procedure GetNumDataBytesAndNumECBytesForBlockID(NumTotalBytes,
+ NumDataBytes, NumRSBlocks, BlockID: Integer; var NumDataBytesInBlock: TIntegerArray;
+ var NumECBytesInBlock: TIntegerArray);
+ procedure InterleaveWithECBytes(Bits: TBitArray; NumTotalBytes,
+ NumDataBytes, NumRSBlocks: Integer; var Result: TBitArray);
+ //function IsOnlyDoubleByteKanji(const Content: WideString): Boolean;
+ procedure TerminateBits(NumDataBytes: Integer; var Bits: TBitArray);
+ function CalculateMaskPenalty(Matrix: TByteMatrix): Integer;
+ function ApplyMaskPenaltyRule1(Matrix: TByteMatrix): Integer;
+ function ApplyMaskPenaltyRule2(Matrix: TByteMatrix): Integer;
+ function ApplyMaskPenaltyRule3(Matrix: TByteMatrix): Integer;
+ function ApplyMaskPenaltyRule4(Matrix: TByteMatrix): Integer;
+ //procedure Encode(const Content: WideString; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode); overload;
+ procedure Encode(const Content: WideString; EncodeOptions: Integer; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode);
+ procedure SetCodepage(const Value: Integer);
+ public
+ constructor Create;
+ property EncoderError: Boolean read FEncoderError;
+ property Codepage: Integer read FCodepage write SetCodepage;
+ property CodeVersion: Integer read FCodeVersion write FCodeVersion;
+ end;
+
+function TEncoder.ApplyMaskPenaltyRule1(Matrix: TByteMatrix): Integer;
+begin
+ Result := ApplyMaskPenaltyRule1Internal(Matrix, True) +
+ ApplyMaskPenaltyRule1Internal(Matrix, False);
+end;
+
+// Apply mask penalty rule 2 and return the penalty. Find 2x2 blocks with the same color and give
+// penalty to them.
+function TEncoder.ApplyMaskPenaltyRule2(Matrix: TByteMatrix): Integer;
+var
+ Penalty: Integer;
+ TheArray: T2DByteArray;
+ Width: Integer;
+ Height: Integer;
+ X: Integer;
+ Y: Integer;
+ Value: Integer;
+begin
+ Penalty := 0;
+ TheArray := Matrix.GetArray;
+ Width := Matrix.Width;
+ Height := Matrix.Height;
+ for Y := 0 to Height - 2 do
+ begin
+ for X := 0 to Width - 2 do
+ begin
+ Value := TheArray[Y][X];
+ if ((Value = TheArray[Y][X + 1]) and (Value = TheArray[Y + 1][X]) and
+ (Value = TheArray[Y + 1][X + 1])) then
+ begin
+ Inc(Penalty, 3);
+ end;
+ end;
+ end;
+ Result := Penalty;
+end;
+
+// Apply mask penalty rule 3 and return the penalty. Find consecutive cells of 00001011101 or
+// 10111010000, and give penalty to them. If we find patterns like 000010111010000, we give
+// penalties twice (i.e. 40 * 2).
+function TEncoder.ApplyMaskPenaltyRule3(Matrix: TByteMatrix): Integer;
+var
+ Penalty: Integer;
+ TheArray: T2DByteArray;
+ Width: Integer;
+ Height: Integer;
+ X: Integer;
+ Y: Integer;
+begin
+ Penalty := 0;
+ TheArray := Matrix.GetArray;
+ Width := Matrix.Width;
+ Height := Matrix.Height;
+ for Y := 0 to Height - 1 do
+ begin
+ for X := 0 to Width - 1 do
+ begin
+ if ((X + 6 < Width) and
+ (TheArray[Y][X] = 1) and
+ (TheArray[Y][X + 1] = 0) and
+ (TheArray[Y][X + 2] = 1) and
+ (TheArray[Y][X + 3] = 1) and
+ (TheArray[Y][X + 4] = 1) and
+ (TheArray[Y][X + 5] = 0) and
+ (TheArray[Y][X + 6] = 1) and
+ (((X + 10 < Width) and
+ (TheArray[Y][X + 7] = 0) and
+ (TheArray[Y][X + 8] = 0) and
+ (TheArray[Y][X + 9] = 0) and
+ (TheArray[Y][X + 10] = 0)) or
+ ((x - 4 >= 0) and
+ (TheArray[Y][X - 1] = 0) and
+ (TheArray[Y][X - 2] = 0) and
+ (TheArray[Y][X - 3] = 0) and
+ (TheArray[Y][X - 4] = 0)))) then
+ begin
+ Inc(Penalty, 40);
+ end;
+ if ((Y + 6 < Height) and
+ (TheArray[Y][X] = 1) and
+ (TheArray[Y + 1][X] = 0) and
+ (TheArray[Y + 2][X] = 1) and
+ (TheArray[Y + 3][X] = 1) and
+ (TheArray[Y + 4][X] = 1) and
+ (TheArray[Y + 5][X] = 0) and
+ (TheArray[Y + 6][X] = 1) and
+ (((Y + 10 < Height) and
+ (TheArray[Y + 7][X] = 0) and
+ (TheArray[Y + 8][X] = 0) and
+ (TheArray[Y + 9][X] = 0) and
+ (TheArray[Y + 10][X] = 0)) or
+ ((Y - 4 >= 0) and
+ (TheArray[Y - 1][X] = 0) and
+ (TheArray[Y - 2][X] = 0) and
+ (TheArray[Y - 3][X] = 0) and
+ (TheArray[Y - 4][X] = 0)))) then
+ begin
+ Inc(Penalty, 40);
+ end;
+ end;
+ end;
+ Result := Penalty;
+end;
+
+// Apply mask penalty rule 4 and return the penalty. Calculate the ratio of dark cells and give
+// penalty if the ratio is far from 50%. It gives 10 penalty for 5% distance. Examples:
+// - 0% => 100
+// - 40% => 20
+// - 45% => 10
+// - 50% => 0
+// - 55% => 10
+// - 55% => 20
+// - 100% => 100
+function TEncoder.ApplyMaskPenaltyRule4(Matrix: TByteMatrix): Integer;
+var
+ NumDarkCells: Integer;
+ TheArray: T2DByteArray;
+ Width: Integer;
+ Height: Integer;
+ NumTotalCells: Integer;
+ DarkRatio: Double;
+ X: Integer;
+ Y: Integer;
+begin
+ NumDarkCells := 0;
+ TheArray := Matrix.GetArray;
+ Width := Matrix.Width;
+ Height := matrix.Height;
+ for Y := 0 to Height - 1 do
+ begin
+ for X := 0 to Width - 1 do
+ begin
+ if (TheArray[Y][X] = 1) then
+ begin
+ Inc(NumDarkCells);
+ end;
+ end;
+ end;
+ numTotalCells := matrix.Height * Matrix.Width;
+ DarkRatio := NumDarkCells / NumTotalCells;
+ Result := Round(Abs((DarkRatio * 100 - 50)) / 50);
+end;
+
+// Helper function for applyMaskPenaltyRule1. We need this for doing this calculation in both
+// vertical and horizontal orders respectively.
+function TEncoder.ApplyMaskPenaltyRule1Internal(Matrix: TByteMatrix; IsHorizontal: Boolean): Integer;
+var
+ Penalty: Integer;
+ NumSameBitCells: Integer;
+ PrevBit: Integer;
+ TheArray: T2DByteArray;
+ I: Integer;
+ J: Integer;
+ Bit: Integer;
+ ILimit: Integer;
+ JLimit: Integer;
+begin
+ Penalty := 0;
+ NumSameBitCells := 0;
+ PrevBit := -1;
+ // Horizontal mode:
+ // for (int i = 0; i < matrix.height(); ++i) {
+ // for (int j = 0; j < matrix.width(); ++j) {
+ // int bit = matrix.get(i, j);
+ // Vertical mode:
+ // for (int i = 0; i < matrix.width(); ++i) {
+ // for (int j = 0; j < matrix.height(); ++j) {
+ // int bit = matrix.get(j, i);
+ if (IsHorizontal) then
+ begin
+ ILimit := Matrix.Height;
+ JLimit := Matrix.Width;
+ end else
+ begin
+ ILimit := Matrix.Width;
+ JLimit := Matrix.Height;
+ end;
+ TheArray := Matrix.GetArray;
+
+ for I := 0 to ILimit - 1 do
+ begin
+ for J := 0 to JLimit - 1 do
+ begin
+ if (IsHorizontal) then
+ begin
+ Bit := TheArray[I][J];
+ end else
+ begin
+ Bit := TheArray[J][I];
+ end;
+ if (Bit = PrevBit) then
+ begin
+ Inc(NumSameBitCells);
+ // Found five repetitive cells with the same color (bit).
+ // We'll give penalty of 3.
+ if (NumSameBitCells = 5) then
+ begin
+ Inc(Penalty, 3);
+ end else if (NumSameBitCells > 5) then
+ begin
+ // After five repetitive cells, we'll add the penalty one
+ // by one.
+ Inc(Penalty, 1);;
+ end;
+ end else
+ begin
+ NumSameBitCells := 1; // Include the cell itself.
+ PrevBit := bit;
+ end;
+ end;
+ NumSameBitCells := 0; // Clear at each row/column.
+ end;
+ Result := Penalty;
+end;
+
+{ TQRCode }
+
+constructor TQRCode.Create;
+begin
+ FMode := qmTerminator;
+ FQRCodeError := False;
+ FECLevel := nil;
+ FVersion := -1;
+ FMatrixWidth := -1;
+ FMaskPattern := -1;
+ FNumTotalBytes := -1;
+ FNumDataBytes := -1;
+ FNumECBytes := -1;
+ FNumRSBlocks := -1;
+ FMatrix := nil;
+end;
+
+destructor TQRCode.Destroy;
+begin
+ if (Assigned(FECLevel)) then
+ begin
+ FECLevel.Free;
+ end;
+ if (Assigned(FMatrix)) then
+ begin
+ FMatrix.Free;
+ end;
+ inherited;
+end;
+
+function TQRCode.At(X, Y: Integer): Integer;
+var
+ Value: Integer;
+begin
+ // The value must be zero or one.
+ Value := FMatrix.Get(X, Y);
+ if (not ((Value = 0) or (Value = 1))) then
+ begin
+ FQRCodeError := True;
+ end;
+ Result := Value;
+end;
+
+function TQRCode.IsValid: Boolean;
+begin
+ Result :=
+ // First check if all version are not uninitialized.
+ ((FECLevel <> nil) and
+ (FVersion <> -1) and
+ (FMatrixWidth <> -1) and
+ (FMaskPattern <> -1) and
+ (FNumTotalBytes <> -1) and
+ (FNumDataBytes <> -1) and
+ (FNumECBytes <> -1) and
+ (FNumRSBlocks <> -1) and
+ // Then check them in other ways..
+ IsValidMaskPattern(FMaskPattern) and
+ (FNumTotalBytes = FNumDataBytes + FNumECBytes) and
+ // ByteMatrix stuff.
+ (Assigned(FMatrix)) and
+ (FMatrixWidth = FMatrix.Width) and
+ // See 7.3.1 of JISX0510:2004 (Fp.5).
+ (FMatrix.Width = FMatrix.Height)); // Must be square.
+end;
+
+function TQRCode.IsValidMaskPattern(MaskPattern: Integer): Boolean;
+begin
+ Result := (MaskPattern >= 0) and (MaskPattern < NUM_MASK_PATTERNS);
+end;
+
+procedure TQRCode.SetMatrix(NewMatrix: TByteMatrix);
+begin
+ if (Assigned(FMatrix)) then
+ begin
+ FMatrix.Free;
+ FMatrix := nil;
+ end;
+ FMatrix := NewMatrix;
+end;
+
+procedure TQRCode.SetAll(VersionNum, NumBytes, NumDataBytes, NumRSBlocks,
+ NumECBytes, MatrixWidth: Integer);
+begin
+ FVersion := VersionNum;
+ FNumTotalBytes := NumBytes;
+ FNumDataBytes := NumDataBytes;
+ FNumRSBlocks := NumRSBlocks;
+ FNumECBytes := NumECBytes;
+ FMatrixWidth := MatrixWidth;
+end;
+
+procedure TQRCode.SetECLevel(NewECLevel: TErrorCorrectionLevel);
+begin
+ if (Assigned(FECLevel)) then
+ begin
+ FECLevel.Free;
+ end;
+ FECLevel := TErrorCorrectionLevel.Create;
+ FECLevel.Assign(NewECLevel);
+end;
+
+{ TByteMatrix }
+
+procedure TByteMatrix.Clear(Value: Byte);
+var
+ X, Y: Integer;
+begin
+ for Y := 0 to FHeight - 1 do
+ begin
+ for X := 0 to FWidth - 1 do
+ begin
+ Bytes[Y][X] := Value;
+ end;
+ end;
+end;
+
+constructor TByteMatrix.Create(Width, Height: Integer);
+var
+ Y: Integer;
+ X: Integer;
+begin
+ FWidth := Width;
+ FHeight := Height;
+ SetLength(Bytes, Height);
+ for Y := 0 to Height - 1 do
+ begin
+ SetLength(Bytes[Y], Width);
+ for X := 0 to Width - 1 do
+ begin
+ Bytes[Y][X] := 0;
+ end;
+ end;
+end;
+
+function TByteMatrix.Get(X, Y: Integer): Integer;
+begin
+ if (Bytes[Y][X] = 255) then Result := -1 else Result := Bytes[Y][X];
+end;
+
+function TByteMatrix.GetArray: T2DByteArray;
+begin
+ Result := Bytes;
+end;
+
+function TByteMatrix.Hash: AnsiString;
+var
+ X, Y: Integer;
+ Counter: Integer;
+ CC: Integer;
+begin
+ Result := '';
+ for Y := 0 to FHeight - 1 do
+ begin
+ Counter := 0;
+ for X := 0 to FWidth - 1 do
+ begin
+ CC := Get(X, Y);
+ if (CC = -1) then CC := 255;
+ Counter := Counter + CC;
+ end;
+ Result := Result + AnsiChar((Counter mod 26) + 65);
+ end;
+end;
+
+procedure TByteMatrix.SetBoolean(X, Y: Integer; Value: Boolean);
+begin
+ Bytes[Y][X] := Byte(Value) and $FF;
+end;
+
+procedure TByteMatrix.SetInteger(X, Y, Value: Integer);
+begin
+ Bytes[Y][X] := Value and $FF;
+end;
+
+procedure TByteMatrix.Assign(Source: TByteMatrix);
+var
+ SourceLength: Integer;
+begin
+ SourceLength := Length(Source.Bytes);
+ SetLength(Bytes, SourceLength);
+ if (SourceLength > 0) then
+ begin
+ Move(Source.Bytes[0], Bytes[0], SourceLength);
+ end;
+ FWidth := Source.Width;
+ FHeight := Source.Height;
+end;
+
+{ TEncoder }
+
+function TEncoder.CalculateMaskPenalty(Matrix: TByteMatrix): Integer;
+var
+ Penalty: Integer;
+begin
+ Penalty := 0;
+ Inc(Penalty, ApplyMaskPenaltyRule1(Matrix));
+ Inc(Penalty, ApplyMaskPenaltyRule2(Matrix));
+ Inc(Penalty, ApplyMaskPenaltyRule3(Matrix));
+ Inc(Penalty, ApplyMaskPenaltyRule4(Matrix));
+ Result := Penalty;
+end;
+
+{procedure TEncoder.Encode(const Content: WideString; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode);
+begin
+ Encode(Content, ECLevel, nil, QRCode);
+end;}
+
+procedure TEncoder.Encode(const Content: WideString; EncodeOptions: Integer; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode);
+var
+ Mode: TMode;
+ DataBits: TBitArray;
+ FinalBits: TBitArray;
+ HeaderBits: TBitArray;
+ HeaderAndDataBits: TBitArray;
+ Matrix: TByteMatrix;
+ NumLetters: Integer;
+ MatrixUtil: TMatrixUtil;
+ BitsNeeded: Integer;
+ ProvisionalBitsNeeded: Integer;
+ ProvisionalVersion: TVersion;
+ Version: TVersion;
+ ECBlocks: TECBlocks;
+ NumDataBytes: Integer;
+ Dimension: Integer;
+ FilteredContent: WideString;
+begin
+ DataBits := TBitArray.Create;
+ HeaderBits := TBitArray.Create;
+
+ // Pick an encoding mode appropriate for the content. Note that this will not attempt to use
+ // multiple modes / segments even if that were more efficient. Twould be nice.
+ // Collect data within the main segment, separately, to count its size if needed. Don't add it to
+ // main payload yet.
+
+ Mode := ChooseMode(Content, EncodeOptions);
+ FilteredContent := FilterContent(Content, Mode, EncodeOptions);
+ AppendBytes(FilteredContent, Mode, DataBits, EncodeOptions);
+
+ if Mode <> qmECI then
+ begin
+ // (With ECI in place,) Write the mode marker
+ AppendModeInfo(Mode, HeaderBits);
+ end;
+
+ // Hard part: need to know version to know how many bits length takes. But need to know how many
+ // bits it takes to know version. First we take a guess at version by assuming version will be
+ // the minimum, 1:
+ ProvisionalVersion := TVersion.GetVersionForNumber(1);
+ try
+ ProvisionalBitsNeeded := HeaderBits.GetSize +
+ GetModeCharacterCountBits(Mode, ProvisionalVersion) +
+ DataBits.GetSize;
+ finally
+ ProvisionalVersion.Free;
+ end;
+
+ ProvisionalVersion := TVersion.ChooseVersion(ProvisionalBitsNeeded, ECLevel);
+ try
+ // Use that guess to calculate the right version. I am still not sure this works in 100% of cases.
+ BitsNeeded := HeaderBits.GetSize +
+ GetModeCharacterCountBits(Mode, ProvisionalVersion) +
+ DataBits.GetSize;
+ Version := TVersion.ChooseVersion(BitsNeeded, ECLevel);
+ finally
+ ProvisionalVersion.Free;
+ end;
+
+ // versions above 9 should write data size as 16 bit's - rebuild data for ECI
+ if (Mode = qmECI) and (Version.VersionNumber >= 10) then
+ begin
+ DataBits.Clear;
+ CodeVersion := Version.VersionNumber;
+ AppendBytes(FilteredContent, Mode, DataBits, EncodeOptions);
+ end;
+
+ HeaderAndDataBits := TBitArray.Create;
+ FinalBits := TBitArray.Create;
+ try
+ if Mode <> qmECI then
+ begin
+ HeaderAndDataBits.AppendBitArray(HeaderBits);
+
+ // Find "length" of main segment and write it
+ if (Mode = qmByte) then
+ begin
+ NumLetters := DataBits.GetSizeInBytes;
+ end else
+ begin
+ NumLetters := Length(FilteredContent);
+ end;
+ AppendLengthInfo(NumLetters, Version.VersionNumber, Mode, HeaderAndDataBits);
+ end;
+ // Put data together into the overall payload
+ HeaderAndDataBits.AppendBitArray(DataBits);
+
+ ECBlocks := Version.GetECBlocksForLevel(ECLevel);
+ NumDataBytes := Version.GetTotalCodewords - ECBlocks.GetTotalECCodewords;
+
+ // Terminate the bits properly.
+ TerminateBits(NumDataBytes, HeaderAndDataBits);
+
+ // Interleave data bits with error correction code.
+ InterleaveWithECBytes(HeaderAndDataBits, Version.GetTotalCodewords,
+ NumDataBytes, ECBlocks.GetNumBlocks, FinalBits);
+
+ // QRCode qrCode = new QRCode(); // This is passed in
+
+
+ QRCode.SetECLevel(ECLevel);
+ QRCode.Mode := Mode;
+ QRCode.Version := Version.VersionNumber;
+
+ // Choose the mask pattern and set to "qrCode".
+ Dimension := Version.GetDimensionForVersion;
+ Matrix := TByteMatrix.Create(Dimension, Dimension);
+
+ QRCode.MaskPattern := ChooseMaskPattern(FinalBits, ECLevel, Version.VersionNumber, Matrix);
+
+ Matrix.Free;
+ Matrix := TByteMatrix.Create(Dimension, Dimension);
+
+ // Build the matrix and set it to "qrCode".
+ MatrixUtil := TMatrixUtil.Create;
+ try
+ MatrixUtil.BuildMatrix(FinalBits, QRCode.ECLevel, QRCode.Version,
+ QRCode.MaskPattern, Matrix);
+ finally
+ MatrixUtil.Free;
+ end;
+
+ QRCode.SetMatrix(Matrix); // QRCode will free the matrix
+ finally
+ DataBits.Free;
+ HeaderAndDataBits.Free;
+ FinalBits.Free;
+ HeaderBits.Free;
+ Version.Free;
+ end;
+end;
+
+function TEncoder.FilterContent(const Content: WideString; Mode: TMode;
+ EncodeOptions: Integer): WideString;
+var
+ X: Integer;
+ CanAdd: Boolean;
+begin
+ if (Mode in [qmECI, qmKanji]) then
+ begin
+ Result := Content;
+ Exit;
+ end;
+ Result := '';
+ for X := 1 to Length(Content) do
+ begin
+ CanAdd := False;
+ if (Mode = qmNumeric) then
+ begin
+ CanAdd := (Content[X] >= '0') and (Content[X] <= '9');
+ end else
+ if (Mode = qmAlphanumeric) then
+ begin
+ CanAdd := GetAlphanumericCode(Ord(Content[X])) >= 0;
+ end else
+ if (Mode = qmByte) then
+ begin
+ if (EncodeOptions = 3) then
+ begin
+ CanAdd := Ord(Content[X]) <= $FF;
+ end else
+ if ((EncodeOptions = 4) or (EncodeOptions = 5)) then
+ begin
+ CanAdd := True;
+ end;
+ end;
+ if (CanAdd) then
+ begin
+ Result := Result + Content[X];
+ end;
+ end;
+end;
+
+// Return the code point of the table used in alphanumeric mode or
+// -1 if there is no corresponding code in the table.
+function TEncoder.GetAlphanumericCode(Code: Integer): Integer;
+begin
+ if (Code < Length(ALPHANUMERIC_TABLE)) then
+ begin
+ Result := ALPHANUMERIC_TABLE[Code];
+ end else
+ begin
+ Result := -1;
+ end;
+end;
+
+// Choose the mode based on the content
+function TEncoder.ChooseMode(const Content: WideString; var EncodeOptions: Integer): TMode;
+var
+ AllNumeric: Boolean;
+ AllAlphanumeric: Boolean;
+ AllISO: Boolean;
+ I: Integer;
+ C: WideChar;
+begin
+ if (EncodeOptions = 0 {qrAuto}) and (IsContainECI(Content) or (FCodepage <> 0)) then
+ Result := qmECI
+ else
+ if (EncodeOptions = 0) then
+ begin
+ AllNumeric := Length(Content) > 0;
+ I := 1;
+ while (I <= Length(Content)) and (AllNumeric) do
+ begin
+ C := Content[I];
+ if ((C < '0') or (C > '9')) then
+ begin
+ AllNumeric := False;
+ end else
+ begin
+ Inc(I);
+ end;
+ end;
+
+ if (not AllNumeric) then
+ begin
+ AllAlphanumeric := Length(Content) > 0;
+ I := 1;
+ while (I <= Length(Content)) and (AllAlphanumeric) do
+ begin
+ C := Content[I];
+ if (GetAlphanumericCode(Ord(C)) < 0) then
+ begin
+ AllAlphanumeric := False;
+ end else
+ begin
+ Inc(I);
+ end;
+ end;
+ end else
+ begin
+ AllAlphanumeric := False;
+ end;
+
+ if (not AllAlphanumeric) then
+ begin
+ AllISO := Length(Content) > 0;
+ I := 1;
+ while (I <= Length(Content)) and (AllISO) do
+ begin
+ C := Content[I];
+ if (Ord(C) > $FF) then
+ begin
+ AllISO := False;
+ end else
+ begin
+ Inc(I);
+ end;
+ end;
+ end else
+ begin
+ AllISO := False;
+ end;
+
+ if (AllNumeric) then
+ begin
+ Result := qmNumeric;
+ end else
+ if (AllAlphanumeric) then
+ begin
+ Result := qmAlphanumeric;
+ end else
+ if (AllISO) then
+ begin
+ Result := qmByte;
+ EncodeOptions := 3;
+ end else
+ begin
+ Result := qmByte;
+ EncodeOptions := 4;
+ end;
+ end else
+ if (EncodeOptions = 1) then
+ begin
+ Result := qmNumeric;
+ end else
+ if (EncodeOptions = 2) then
+ begin
+ Result := qmAlphanumeric;
+ end
+ else if (EncodeOptions = 6) then
+ begin
+ Result := qmKanji;
+ end else
+ begin
+ Result := qmByte;
+ end;
+end;
+
+constructor TEncoder.Create;
+begin
+ FEncoderError := False;
+ FCodepage := 0;
+end;
+
+{function TEncoder.IsOnlyDoubleByteKanji(const Content: WideString): Boolean;
+var
+ I: Integer;
+ Char1: Integer;
+begin
+ Result := True;
+ I := 0;
+ while ((I < Length(Content)) and Result) do
+ begin
+ Char1 := Ord(Content[I + 1]);
+ if (((Char1 < $81) or (Char1 > $9F)) and ((Char1 < $E0) or (Char1 > $EB))) then
+ begin
+ Result := False;
+ end;
+ end;
+end;}
+
+function TEncoder.ChooseMaskPattern(Bits: TBitArray; ECLevel: TErrorCorrectionLevel; Version: Integer; Matrix: TByteMatrix): Integer;
+var
+ MinPenalty: Integer;
+ BestMaskPattern: Integer;
+ MaskPattern: Integer;
+ MatrixUtil: TMatrixUtil;
+ Penalty: Integer;
+begin
+ MinPenalty := MaxInt;
+ BestMaskPattern := -1;
+
+ // We try all mask patterns to choose the best one.
+ for MaskPattern := 0 to NUM_MASK_PATTERNS - 1 do
+ begin
+ MatrixUtil := TMatrixUtil.Create;
+ try
+ MatrixUtil.BuildMatrix(Bits, ECLevel, Version, MaskPattern, Matrix);
+ finally
+ MatrixUtil.Free;
+ end;
+ Penalty := CalculateMaskPenalty(Matrix);
+ if (Penalty < MinPenalty) then
+ begin
+ MinPenalty := Penalty;
+ BestMaskPattern := MaskPattern;
+ end;
+ end;
+
+ Result := BestMaskPattern;
+end;
+
+// Terminate bits as described in 8.4.8 and 8.4.9 of JISX0510:2004 (p.24).
+procedure TEncoder.TerminateBits(NumDataBytes: Integer; var Bits: TBitArray);
+var
+ Capacity: Integer;
+ I: Integer;
+ NumBitsInLastByte: Integer;
+ NumPaddingBytes: Integer;
+begin
+ Capacity := NumDataBytes shl 3;
+ if (Bits.GetSize > Capacity) then
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+ I := 0;
+ while ((I < 4) and (Bits.GetSize < capacity)) do
+ begin
+ Bits.AppendBit(False);
+ Inc(I);
+ end;
+
+ // Append termination bits. See 8.4.8 of JISX0510:2004 (p.24) for details.
+ // If the last byte isn't 8-bit aligned, we'll add padding bits.
+ NumBitsInLastByte := Bits.GetSize and $07;
+ if (NumBitsInLastByte > 0) then
+ begin
+ for I := numBitsInLastByte to 7 do
+ begin
+ Bits.AppendBit(False);
+ end;
+ end;
+
+ // If we have more space, we'll fill the space with padding patterns defined in 8.4.9 (p.24).
+ NumPaddingBytes := NumDataBytes - Bits.GetSizeInBytes;
+ for I := 0 to NumPaddingBytes - 1 do
+ begin
+ if ((I and $01) = 0) then
+ begin
+ Bits.AppendBits($EC, 8);
+ end else
+ begin
+ Bits.AppendBits($11, 8);
+ end;
+ end;
+ if (Bits.GetSize <> Capacity) then
+ begin
+ FEncoderError := True;
+ end;
+end;
+
+// Get number of data bytes and number of error correction bytes for block id "blockID". Store
+// the result in "numDataBytesInBlock", and "numECBytesInBlock". See table 12 in 8.5.1 of
+// JISX0510:2004 (p.30)
+procedure TEncoder.GetNumDataBytesAndNumECBytesForBlockID(NumTotalBytes, NumDataBytes,
+ NumRSBlocks, BlockID: Integer; var NumDataBytesInBlock: TIntegerArray;
+ var NumECBytesInBlock: TIntegerArray);
+var
+ NumRSBlocksInGroup1: Integer;
+ NumRSBlocksInGroup2: Integer;
+ NumTotalBytesInGroup1: Integer;
+ NumTotalBytesInGroup2: Integer;
+ NumDataBytesInGroup1: Integer;
+ NumDataBytesInGroup2: Integer;
+ NumECBytesInGroup1: Integer;
+ NumECBytesInGroup2: Integer;
+begin
+ if (BlockID >= NumRSBlocks) then
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+ // numRsBlocksInGroup2 = 196 % 5 = 1
+ NumRSBlocksInGroup2 := NumTotalBytes mod NumRSBlocks;
+ // numRsBlocksInGroup1 = 5 - 1 = 4
+ NumRSBlocksInGroup1 := NumRSBlocks - NumRSBlocksInGroup2;
+ // numTotalBytesInGroup1 = 196 / 5 = 39
+ NumTotalBytesInGroup1 := NumTotalBytes div NumRSBlocks;
+ // numTotalBytesInGroup2 = 39 + 1 = 40
+ NumTotalBytesInGroup2 := NumTotalBytesInGroup1 + 1;
+ // numDataBytesInGroup1 = 66 / 5 = 13
+ NumDataBytesInGroup1 := NumDataBytes div NumRSBlocks;
+ // numDataBytesInGroup2 = 13 + 1 = 14
+ NumDataBytesInGroup2 := NumDataBytesInGroup1 + 1;
+ // numEcBytesInGroup1 = 39 - 13 = 26
+ NumECBytesInGroup1 := NumTotalBytesInGroup1 - NumDataBytesInGroup1;
+ // numEcBytesInGroup2 = 40 - 14 = 26
+ NumECBytesInGroup2 := NumTotalBytesInGroup2 - NumDataBytesInGroup2;
+ // Sanity checks.
+ // 26 = 26
+ if (NumECBytesInGroup1 <> NumECBytesInGroup2) then
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+ // 5 = 4 + 1.
+ if (NumRSBlocks <> (NumRSBlocksInGroup1 + NumRSBlocksInGroup2)) then
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+ // 196 = (13 + 26) * 4 + (14 + 26) * 1
+ if (NumTotalBytes <>
+ ((NumDataBytesInGroup1 + NumECBytesInGroup1) * NumRsBlocksInGroup1) +
+ ((NumDataBytesInGroup2 + NumECBytesInGroup2) * NumRsBlocksInGroup2)) then
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+
+ if (BlockID < NumRSBlocksInGroup1) then
+ begin
+ NumDataBytesInBlock[0] := NumDataBytesInGroup1;
+ NumECBytesInBlock[0] := numECBytesInGroup1;
+ end else
+ begin
+ NumDataBytesInBlock[0] := NumDataBytesInGroup2;
+ NumECBytesInBlock[0] := numEcBytesInGroup2;
+ end;
+end;
+
+// Interleave "bits" with corresponding error correction bytes. On success, store the result in
+// "result". The interleave rule is complicated. See 8.6 of JISX0510:2004 (p.37) for details.
+procedure TEncoder.InterleaveWithECBytes(Bits: TBitArray; NumTotalBytes,
+ NumDataBytes, NumRSBlocks: Integer; var Result: TBitArray);
+var
+ DataBytesOffset: Integer;
+ MaxNumDataBytes: Integer;
+ MaxNumECBytes: Integer;
+ Blocks: TObjectList;
+ NumDataBytesInBlock: TIntegerArray;
+ NumECBytesInBlock: TIntegerArray;
+ Size: Integer;
+ DataBytes: TByteArray;
+ ECBytes: TByteArray;
+ I, J: Integer;
+ BlockPair: TBlockPair;
+begin
+ SetLength(ECBytes, 0);
+
+ // "bits" must have "getNumDataBytes" bytes of data.
+ if (Bits.GetSizeInBytes <> NumDataBytes) then
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+
+ // Step 1. Divide data bytes into blocks and generate error correction bytes for them. We'll
+ // store the divided data bytes blocks and error correction bytes blocks into "blocks".
+ DataBytesOffset := 0;
+ MaxNumDataBytes := 0;
+ MaxNumEcBytes := 0;
+
+ // Since, we know the number of reedsolmon blocks, we can initialize the vector with the number.
+ Blocks := TObjectList.Create(True);
+ try
+ Blocks.Capacity := NumRSBlocks;
+
+ for I := 0 to NumRSBlocks - 1 do
+ begin
+ SetLength(NumDataBytesInBlock, 1);
+ SetLength(NumECBytesInBlock, 1);
+ GetNumDataBytesAndNumECBytesForBlockID(
+ NumTotalBytes, NumDataBytes, NumRSBlocks, I,
+ NumDataBytesInBlock, NumEcBytesInBlock);
+
+ Size := NumDataBytesInBlock[0];
+ SetLength(DataBytes, Size);
+ Bits.ToBytes(8 * DataBytesOffset, DataBytes, 0, Size);
+ ECBytes := GenerateECBytes(DataBytes, NumEcBytesInBlock[0]);
+ BlockPair := TBlockPair.Create(DataBytes, ECBytes);
+ Blocks.Add(BlockPair);
+
+ MaxNumDataBytes := Max(MaxNumDataBytes, Size);
+ MaxNumECBytes := Max(MaxNumECBytes, Length(ECBytes));
+ Inc(DataBytesOffset, NumDataBytesInBlock[0]);
+ end;
+ if (NumDataBytes <> DataBytesOffset) then
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+
+ // First, place data blocks.
+ for I := 0 to MaxNumDataBytes - 1 do
+ begin
+ for J := 0 to Blocks.Count - 1 do
+ begin
+ DataBytes := TBlockPair(Blocks.Items[J]).GetDataBytes;
+ if (I < Length(DataBytes)) then
+ begin
+ Result.AppendBits(DataBytes[I], 8);
+ end;
+ end;
+ end;
+ // Then, place error correction blocks.
+ for I := 0 to MaxNumECBytes - 1 do
+ begin
+ for J := 0 to Blocks.Count - 1 do
+ begin
+ ECBytes := TBlockPair(Blocks.Items[J]).GetErrorCorrectionBytes;
+ if (I < Length(ECBytes)) then
+ begin
+ Result.AppendBits(ECBytes[I], 8);
+ end;
+ end;
+ end;
+ finally
+ Blocks.Free;
+ end;
+ if (numTotalBytes <> Result.GetSizeInBytes) then // Should be same.
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+end;
+
+function TEncoder.IsContainECI(Content: string): boolean;
+begin
+ Result := PosECI(Content) > 0;
+end;
+
+function TEncoder.IsStartWithECI(Content: string): boolean;
+begin
+ Result := PosECI(Content) = 1;
+end;
+
+function TEncoder.PosECI(Content: string): integer;
+const
+ LenECI = Length('&ECIXX;');
+var
+ i: integer;
+begin
+ Result := 0;
+ for i := LenECI to Length(Content) do
+ if (Content[i] = ';') and (Copy(Content, i - LenECI + 1, 4) = '&ECI') then
+ begin
+ Result := i - LenECI + 1;
+ Break;
+ end;
+end;
+
+procedure TEncoder.SetCodepage(const Value: Integer);
+begin
+ FCodepage := Value;
+end;
+
+function TEncoder.GenerateECBytes(DataBytes: TByteArray; NumECBytesInBlock: Integer): TByteArray;
+var
+ NumDataBytes: Integer;
+ ToEncode: TIntegerArray;
+ ReedSolomonEncoder: TReedSolomonEncoder;
+ I: Integer;
+ ECBytes: TByteArray;
+ GenericGF: TGenericGF;
+begin
+ NumDataBytes := Length(DataBytes);
+ SetLength(ToEncode, NumDataBytes + NumECBytesInBlock);
+
+ for I := 0 to NumDataBytes - 1 do
+ begin
+ ToEncode[I] := DataBytes[I] and $FF;
+ end;
+
+ GenericGF := TGenericGF.CreateQRCodeField256;
+ try
+ ReedSolomonEncoder := TReedSolomonEncoder.Create(GenericGF);
+ try
+ ReedSolomonEncoder.Encode(ToEncode, NumECBytesInBlock);
+ finally
+ ReedSolomonEncoder.Free;
+ end;
+ finally
+ GenericGF.Free;
+ end;
+
+ SetLength(ECBytes, NumECBytesInBlock);
+ for I := 0 to NumECBytesInBlock - 1 do
+ begin
+ ECBytes[I] := ToEncode[NumDataBytes + I];
+ end;
+
+ Result := ECBytes;
+end;
+
+// Append mode info. On success, store the result in "bits".
+procedure TEncoder.AppendModeInfo(Mode: TMode; Bits: TBitArray);
+begin
+ Bits.AppendBits(GetModeBits(Mode), 4);
+end;
+
+// Append length info. On success, store the result in "bits".
+procedure TEncoder.AppendLengthInfo(NumLetters, VersionNum: Integer; Mode: TMode; Bits: TBitArray);
+var
+ NumBits: Integer;
+ Version: TVersion;
+begin
+ Version := TVersion.GetVersionForNumber(VersionNum);
+ try
+ NumBits := GetModeCharacterCountBits(Mode, Version);
+ finally
+ Version.Free;
+ end;
+
+ if (NumLetters > ((1 shl NumBits) - 1)) then
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+
+ Bits.AppendBits(NumLetters, NumBits);
+end;
+
+// Append "bytes" in "mode" mode (encoding) into "bits". On success, store the result in "bits".
+procedure TEncoder.AppendBytes(const Content: WideString; Mode: TMode; Bits: TBitArray; EncodeOptions: Integer);
+begin
+ case Mode of
+// qmTerminator: ;
+ qmNumeric: AppendNumericBytes(Content, Bits);
+ qmAlphanumeric: AppendAlphanumericBytes(Content, Bits);
+// qmStructuredAppend: ;
+ qmByte: Append8BitBytes(Content, Bits, EncodeOptions);
+ qmECI: AppendECIBytes(Content, Bits);
+ qmKanji: AppendKanjiBytes(Content, Bits);
+// qmFNC1FirstPosition: ;
+// qmFNC1SecondPosition: ;
+// qmHanzi: ;
+ else
+ FEncoderError := True;
+ end;
+end;
+
+procedure TEncoder.AppendECIBytes(const Content: WideString; Bits: TBitArray);
+var
+ AnsiSt: TBytes;
+ ECIValue: integer;
+ B: Byte;
+ WideText: WideString;
+
+ function CodePageFromECI(aECI: Integer): Integer;
+ begin
+ Result := 0;
+ case aECI of
+ 3: Result := 28591;
+ 4: Result := 28592;
+ 5: Result := 28593;
+ 6: Result := 28594;
+ 7: Result := 28595;
+ 8: Result := 28596;
+ 9: Result := 28597;
+ 10: Result := 28598;
+ 11: Result := 28599;
+ 12: Result := 28600;
+ 13: Result := 874;
+ 15: Result := 28603;
+ 16: Result := 28604;
+ 17: Result := 28605;
+ 18: Result := 28606;
+ 20: Result := 932;
+ 21: Result := 1250;
+ 22: Result := 1251;
+ 23: Result := 1252;
+ 24: Result := 1256;
+ 25: Result := 1200;// this one maybe wrong
+ 26: Result := 65001;
+ 27: Result := 20127;// and this too
+ 28: Result := 950;
+ 29: Result := 936;
+ 30: Result := 949;
+ end;
+ end;
+
+ function ECIFromCodePage(aCodePage: Longint): Longint;
+ begin
+ Result := DefaultECIValue;
+ case aCodePage of
+ 28591: Result := 3;
+ 28592: Result := 4;
+ 28593: Result := 5;
+ 28594: Result := 6;
+ 28595: Result := 7;
+ 28596: Result := 8;
+ 28597: Result := 9;
+ 28598: Result := 10;
+ 28599: Result := 11;
+ 28600: Result := 12;
+ 874: Result := 13;
+ 28603: Result := 15;
+ 28604: Result := 16;
+ 28605: Result := 17;
+ 28606: Result := 18;
+ 932: Result := 20;
+ 1250: Result := 21;
+ 1251: Result := 22;
+ 1252: Result := 23;
+ 1256: Result := 24;
+ 1200: Result := 25;// this one maybe wrong
+ 65001: Result := 26;
+ 20127: Result := 27;// and this too
+ 950: Result := 28;
+ 936: Result := 29;
+ 949: Result := 30;
+ end;
+ end;
+
+ procedure AppendEciFragment(Len: Integer);
+ var
+ I: Integer;
+ e: TEncoding;
+ begin
+ e := TEncoding.GetEncoding(CodePageFromECI(ECIValue));
+ try
+ AnsiSt := e.GetBytes(WideText);
+ finally
+ e.Free
+ end;
+
+ Bits.AppendBits(7, 4); // ECI Mode Indicator = b0111
+ Bits.AppendBits(ECIValue, 8); // ECI Assignment number = 00..30
+ Bits.AppendBits(4, 4); // Mode indicator (8-bit byte) = b0100
+ if CodeVersion >= 10 then
+ Bits.AppendBits(Len, 16)
+ else
+ Bits.AppendBits(Len, 8); // Character count indicator up to 255 (?)
+ for I := 1 to Len do
+ begin
+ B := Ord(AnsiSt[I]);
+ Bits.AppendBits(B, 8);
+ end;
+ Delete(WideText, 1, Len);
+ end;
+begin
+ WideText := Content;
+ ECIValue := ECIFromCodePage(FCodepage);
+
+ while WideText <> '' do
+ if not IsContainECI(String(WideText)) then
+ AppendEciFragment(Length(WideText))
+ else if IsStartWithECI(String(WideText)) then
+ begin
+ if not TryStrToInt(String(Copy(WideText, 5, 2)), ECIValue) then
+ ECIValue := DefaultECIValue;
+ Delete(WideText, 1, Length('&ECIXX;'));
+ end
+ else // ECI in the middle
+ AppendEciFragment(PosECI(string(WideText)) - 1);
+end;
+
+procedure TEncoder.AppendNumericBytes(const Content: WideString; Bits: TBitArray);
+var
+ ContentLength: Integer;
+ I: Integer;
+ Num1: Integer;
+ Num2: Integer;
+ Num3: Integer;
+begin
+ ContentLength := Length(Content);
+ I := 0;
+ while (I < ContentLength) do
+ begin
+ Num1 := Ord(Content[I + 0 + 1]) - Ord('0');
+ if (I + 2 < ContentLength) then
+ begin
+ // Encode three numeric letters in ten bits.
+ Num2 := Ord(Content[I + 1 + 1]) - Ord('0');
+ Num3 := Ord(Content[I + 2 + 1]) - Ord('0');
+ Bits.AppendBits(Num1 * 100 + Num2 * 10 + Num3, 10);
+ Inc(I, 3);
+ end else
+ if (I + 1 < ContentLength) then
+ begin
+ // Encode two numeric letters in seven bits.
+ Num2 := Ord(Content[I + 1 + 1]) - Ord('0');
+ Bits.AppendBits(Num1 * 10 + Num2, 7);
+ Inc(I, 2);
+ end else
+ begin
+ // Encode one numeric letter in four bits.
+ Bits.AppendBits(Num1, 4);
+ Inc(I);
+ end;
+ end;
+end;
+
+procedure TEncoder.AppendAlphanumericBytes(const Content: WideString; Bits: TBitArray);
+var
+ ContentLength: Integer;
+ I: Integer;
+ Code1: Integer;
+ Code2: Integer;
+begin
+ ContentLength := Length(Content);
+ I := 0;
+ while (I < ContentLength) do
+ begin
+ Code1 := GetAlphanumericCode(Ord(Content[I + 0 + 1]));
+ if (Code1 = -1) then
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+ if (I + 1 < ContentLength) then
+ begin
+ Code2 := GetAlphanumericCode(Ord(Content[I + 1 + 1]));
+ if (Code2 = -1) then
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+ // Encode two alphanumeric letters in 11 bits.
+ Bits.AppendBits(Code1 * 45 + Code2, 11);
+ Inc(I, 2);
+ end else
+ begin
+ // Encode one alphanumeric letter in six bits.
+ Bits.AppendBits(Code1, 6);
+ Inc(I);
+ end;
+ end;
+end;
+
+procedure TEncoder.Append8BitBytes(const Content: WideString; Bits: TBitArray; EncodeOptions: Integer);
+var
+ Bytes: TByteArray;
+ I: Integer;
+ UTF8Version: AnsiString;
+begin
+ SetLength(Bytes, 0);
+ if (EncodeOptions = 3) then
+ begin
+ SetLength(Bytes, Length(Content));
+ for I := 1 to Length(Content) do
+ begin
+ Bytes[I - 1] := Ord(Content[I]) and $FF;
+ end;
+ end else
+ if (EncodeOptions = 5) then
+ begin
+ // Add the UTF-8 BOM
+ UTF8Version := #$EF#$BB#$BF + UTF8Encode(Content);
+ SetLength(Bytes, Length(UTF8Version));
+ if (Length(UTF8Version) > 0) then
+ begin
+ Move(UTF8Version[1], Bytes[0], Length(UTF8Version));
+ end;
+ end else
+ if (EncodeOptions = 4) then
+ begin
+ // No BOM
+ UTF8Version := UTF8Encode(Content);
+ SetLength(Bytes, Length(UTF8Version));
+ if (Length(UTF8Version) > 0) then
+ begin
+ Move(UTF8Version[1], Bytes[0], Length(UTF8Version));
+ end;
+ end;
+ for I := 0 to Length(Bytes) - 1 do
+ begin
+ Bits.AppendBits(Bytes[I], 8);
+ end;
+end;
+
+procedure TEncoder.AppendKanjiBytes(const Content: WideString; Bits: TBitArray);
+var
+ Bytes: TByteArray;
+ ByteLength: Integer;
+ I: Integer;
+ Byte1: Integer;
+ Byte2: Integer;
+ Code: Integer;
+ Subtracted: Integer;
+ Encoded: Integer;
+begin
+ SetLength(Bytes, 0);
+ try
+
+ except
+ FEncoderError := True;
+ Exit;
+ end;
+
+ ByteLength := Length(Bytes);
+ I := 0;
+ while (I < ByteLength) do
+ begin
+ Byte1 := Bytes[I] and $FF;
+ Byte2 := Bytes[I + 1] and $FF;
+ Code := (Byte1 shl 8) or Byte2;
+ Subtracted := -1;
+ if ((Code >= $8140) and (Code <= $9ffc)) then
+ begin
+ Subtracted := Code - $8140;
+ end else
+ if ((Code >= $e040) and (Code <= $ebbf)) then
+ begin
+ Subtracted := Code - $c140;
+ end;
+ if (Subtracted = -1) then
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+ Encoded := ((Subtracted shr 8) * $c0) + (Subtracted and $ff);
+ Bits.AppendBits(Encoded, 13);
+ Inc(I, 2);
+ end;
+end;
+
+procedure TMatrixUtil.ClearMatrix(Matrix: TByteMatrix);
+begin
+ Matrix.Clear(Byte(-1));
+end;
+
+constructor TMatrixUtil.Create;
+begin
+ FMatrixUtilError := False;
+end;
+
+// Build 2D matrix of QR Code from "dataBits" with "ecLevel", "version" and "getMaskPattern". On
+// success, store the result in "matrix" and return true.
+procedure TMatrixUtil.BuildMatrix(DataBits: TBitArray; ECLevel: TErrorCorrectionLevel;
+ Version, MaskPattern: Integer; Matrix: TByteMatrix);
+begin
+ ClearMatrix(Matrix);
+ EmbedBasicPatterns(Version, Matrix);
+
+ // Type information appear with any version.
+ EmbedTypeInfo(ECLevel, MaskPattern, Matrix);
+
+ // Version info appear if version >= 7.
+ MaybeEmbedVersionInfo(Version, Matrix);
+
+ // Data should be embedded at end.
+ EmbedDataBits(DataBits, MaskPattern, Matrix);
+end;
+
+// Embed basic patterns. On success, modify the matrix and return true.
+// The basic patterns are:
+// - Position detection patterns
+// - Timing patterns
+// - Dark dot at the left bottom corner
+// - Position adjustment patterns, if need be
+procedure TMatrixUtil.EmbedBasicPatterns(Version: Integer; Matrix: TByteMatrix);
+begin
+ // Let's get started with embedding big squares at corners.
+ EmbedPositionDetectionPatternsAndSeparators(Matrix);
+
+ // Then, embed the dark dot at the left bottom corner.
+ EmbedDarkDotAtLeftBottomCorner(Matrix);
+
+ // Position adjustment patterns appear if version >= 2.
+ MaybeEmbedPositionAdjustmentPatterns(Version, Matrix);
+
+ // Timing patterns should be embedded after position adj. patterns.
+ EmbedTimingPatterns(Matrix);
+end;
+
+// Embed type information. On success, modify the matrix.
+procedure TMatrixUtil.EmbedTypeInfo(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Matrix: TByteMatrix);
+var
+ TypeInfoBits: TBitArray;
+ I: Integer;
+ Bit: Boolean;
+ X1, Y1: Integer;
+ X2, Y2: Integer;
+begin
+ TypeInfoBits := TBitArray.Create;
+ try
+ MakeTypeInfoBits(ECLevel, MaskPattern, TypeInfoBits);
+
+ for I := 0 to TypeInfoBits.GetSize - 1 do
+ begin
+ // Place bits in LSB to MSB order. LSB (least significant bit) is the last value in
+ // "typeInfoBits".
+ Bit := TypeInfoBits.Get(TypeInfoBits.GetSize - 1 - I);
+
+ // Type info bits at the left top corner. See 8.9 of JISX0510:2004 (p.46).
+ X1 := TYPE_INFO_COORDINATES[I][0];
+ Y1 := TYPE_INFO_COORDINATES[I][1];
+ Matrix.SetBoolean(X1, Y1, Bit);
+
+ if (I < 8) then
+ begin
+ // Right top corner.
+ X2 := Matrix.Width - I - 1;
+ Y2 := 8;
+ Matrix.SetBoolean(X2, Y2, Bit);
+ end else
+ begin
+ // Left bottom corner.
+ X2 := 8;
+ Y2 := Matrix.Height - 7 + (I - 8);
+ Matrix.SetBoolean(X2, Y2, Bit);
+ end;
+ end;
+ finally
+ TypeInfoBits.Free;
+ end;
+end;
+
+// Embed version information if need be. On success, modify the matrix and return true.
+// See 8.10 of JISX0510:2004 (p.47) for how to embed version information.
+procedure TMatrixUtil.MaybeEmbedVersionInfo(Version: Integer; Matrix: TByteMatrix);
+var
+ VersionInfoBits: TBitArray;
+ I, J: Integer;
+ BitIndex: Integer;
+ Bit: Boolean;
+begin
+ if (Version < 7) then
+ begin
+ Exit; // Don't need version info.
+ end;
+
+ VersionInfoBits := TBitArray.Create;
+ try
+ MakeVersionInfoBits(Version, VersionInfoBits);
+
+ BitIndex := 6 * 3 - 1; // It will decrease from 17 to 0.
+ for I := 0 to 5 do
+ begin
+ for J := 0 to 2 do
+ begin
+ // Place bits in LSB (least significant bit) to MSB order.
+ Bit := VersionInfoBits.Get(BitIndex);
+ Dec(BitIndex);
+ // Left bottom corner.
+ Matrix.SetBoolean(I, Matrix.Height - 11 + J, Bit);
+ // Right bottom corner.
+ Matrix.SetBoolean(Matrix.Height - 11 + J, I, bit);
+ end;
+ end;
+ finally
+ VersionInfoBits.Free;
+ end;
+end;
+
+// Embed "dataBits" using "getMaskPattern". On success, modify the matrix and return true.
+// For debugging purposes, it skips masking process if "getMaskPattern" is -1.
+// See 8.7 of JISX0510:2004 (p.38) for how to embed data bits.
+procedure TMatrixUtil.EmbedDataBits(DataBits: TBitArray; MaskPattern: Integer; Matrix: TByteMatrix);
+var
+ BitIndex: Integer;
+ Direction: Integer;
+ X, Y, I, XX: Integer;
+ Bit: Boolean;
+ MaskUtil: TMaskUtil;
+begin
+ MaskUtil := TMaskUtil.Create;
+ try
+ bitIndex := 0;
+ direction := -1;
+ // Start from the right bottom cell.
+ X := Matrix.Width - 1;
+ Y := Matrix.Height - 1;
+ while (X > 0) do
+ begin
+ // Skip the vertical timing pattern.
+ if (X = 6) then
+ begin
+ Dec(X, 1);
+ end;
+ while ((Y >= 0) and (y < Matrix.Height)) do
+ begin
+ for I := 0 to 1 do
+ begin
+ XX := X - I;
+ // Skip the cell if it's not empty.
+ if (not IsEmpty(Matrix.Get(XX, Y))) then
+ begin
+ Continue;
+ end;
+
+ if (BitIndex < DataBits.GetSize) then
+ begin
+ Bit := DataBits.Get(BitIndex);
+ Inc(BitIndex);
+ end else
+ begin
+ // Padding bit. If there is no bit left, we'll fill the left cells with 0, as described
+ // in 8.4.9 of JISX0510:2004 (p. 24).
+ Bit := False;
+ end;
+
+ // Skip masking if mask_pattern is -1.
+ if (MaskPattern <> -1) then
+ begin
+ if (MaskUtil.GetDataMaskBit(MaskPattern, XX, Y)) then
+ begin
+ Bit := not Bit;
+ end;
+ end;
+ Matrix.SetBoolean(XX, Y, Bit);
+ end;
+ Inc(Y, Direction);
+ end;
+ Direction := -Direction; // Reverse the direction.
+ Inc(Y, Direction);
+ Dec(X, 2); // Move to the left.
+ end;
+ finally
+ MaskUtil.Free;
+ end;
+
+ // All bits should be consumed.
+ if (BitIndex <> DataBits.GetSize()) then
+ begin
+ FMatrixUtilError := True;
+ Exit;
+ end;
+end;
+
+// Return the position of the most significant bit set (to one) in the "value". The most
+// significant bit is position 32. If there is no bit set, return 0. Examples:
+// - findMSBSet(0) => 0
+// - findMSBSet(1) => 1
+// - findMSBSet(255) => 8
+function TMatrixUtil.FindMSBSet(Value: Integer): Integer;
+var
+ NumDigits: Integer;
+begin
+ NumDigits := 0;
+ while (Value <> 0) do
+ begin
+ Value := Value shr 1;
+ Inc(NumDigits);
+ end;
+ Result := NumDigits;
+end;
+
+// Calculate BCH (Bose-Chaudhuri-Hocquenghem) code for "value" using polynomial "poly". The BCH
+// code is used for encoding type information and version information.
+// Example: Calculation of version information of 7.
+// f(x) is created from 7.
+// - 7 = 000111 in 6 bits
+// - f(x) = x^2 + x^1 + x^0
+// g(x) is given by the standard (p. 67)
+// - g(x) = x^12 + x^11 + x^10 + x^9 + x^8 + x^5 + x^2 + 1
+// Multiply f(x) by x^(18 - 6)
+// - f'(x) = f(x) * x^(18 - 6)
+// - f'(x) = x^14 + x^13 + x^12
+// Calculate the remainder of f'(x) / g(x)
+// x^2
+// __________________________________________________
+// g(x) )x^14 + x^13 + x^12
+// x^14 + x^13 + x^12 + x^11 + x^10 + x^7 + x^4 + x^2
+// --------------------------------------------------
+// x^11 + x^10 + x^7 + x^4 + x^2
+//
+// The remainder is x^11 + x^10 + x^7 + x^4 + x^2
+// Encode it in binary: 110010010100
+// The return value is 0xc94 (1100 1001 0100)
+//
+// Since all coefficients in the polynomials are 1 or 0, we can do the calculation by bit
+// operations. We don't care if cofficients are positive or negative.
+function TMatrixUtil.CalculateBCHCode(Value, Poly: Integer): Integer;
+var
+ MSBSetInPoly: Integer;
+begin
+ // If poly is "1 1111 0010 0101" (version info poly), msbSetInPoly is 13. We'll subtract 1
+ // from 13 to make it 12.
+ MSBSetInPoly := FindMSBSet(Poly);
+ Value := Value shl (MSBSetInPoly - 1);
+ // Do the division business using exclusive-or operations.
+ while (FindMSBSet(Value) >= MSBSetInPoly) do
+ begin
+ Value := Value xor (Poly shl (FindMSBSet(Value) - MSBSetInPoly));
+ end;
+ // Now the "value" is the remainder (i.e. the BCH code)
+ Result := Value;
+end;
+
+// Make bit vector of type information. On success, store the result in "bits" and return true.
+// Encode error correction level and mask pattern. See 8.9 of
+// JISX0510:2004 (p.45) for details.
+procedure TMatrixUtil.MakeTypeInfoBits(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Bits: TBitArray);
+var
+ TypeInfo: Integer;
+ BCHCode: Integer;
+ MaskBits: TBitArray;
+begin
+ if ((MaskPattern >= 0) and (MaskPattern < NUM_MASK_PATTERNS)) then
+ begin
+ TypeInfo := (ECLevel.Bits shl 3) or MaskPattern;
+ Bits.AppendBits(TypeInfo, 5);
+
+ BCHCode := CalculateBCHCode(TypeInfo, TYPE_INFO_POLY);
+ Bits.AppendBits(BCHCode, 10);
+
+ MaskBits := TBitArray.Create;
+ try
+ MaskBits.AppendBits(TYPE_INFO_MASK_PATTERN, 15);
+ Bits.XorOperation(MaskBits);
+ finally
+ MaskBits.Free;
+ end;
+
+ if (Bits.GetSize <> 15) then // Just in case.
+ begin
+ FMatrixUtilError := True;
+ Exit;
+ end;
+ end;
+end;
+
+// Make bit vector of version information. On success, store the result in "bits" and return true.
+// See 8.10 of JISX0510:2004 (p.45) for details.
+procedure TMatrixUtil.MakeVersionInfoBits(Version: Integer; Bits: TBitArray);
+var
+ BCHCode: Integer;
+begin
+ Bits.AppendBits(Version, 6);
+ BCHCode := CalculateBCHCode(Version, VERSION_INFO_POLY);
+ Bits.AppendBits(BCHCode, 12);
+
+ if (Bits.GetSize() <> 18) then
+ begin
+ FMatrixUtilError := True;
+ Exit;
+ end;
+end;
+
+// Check if "value" is empty.
+function TMatrixUtil.IsEmpty(Value: Integer): Boolean;
+begin
+ Result := (Value = -1);
+end;
+
+procedure TMatrixUtil.EmbedTimingPatterns(Matrix: TByteMatrix);
+var
+ I: Integer;
+ Bit: Integer;
+begin
+ // -8 is for skipping position detection patterns (size 7), and two horizontal/vertical
+ // separation patterns (size 1). Thus, 8 = 7 + 1.
+ for I := 8 to Matrix.Width - 9 do
+ begin
+ Bit := (I + 1) mod 2;
+ // Horizontal line.
+ if (IsEmpty(Matrix.Get(I, 6))) then
+ begin
+ Matrix.SetInteger(I, 6, Bit);
+ end;
+ // Vertical line.
+ if (IsEmpty(Matrix.Get(6, I))) then
+ begin
+ Matrix.SetInteger(6, I, Bit);
+ end;
+ end;
+end;
+
+// Embed the lonely dark dot at left bottom corner. JISX0510:2004 (p.46)
+procedure TMatrixUtil.EmbedDarkDotAtLeftBottomCorner(Matrix: TByteMatrix);
+begin
+ if (Matrix.Get(8, Matrix.Height - 8) = 0) then
+ begin
+ FMatrixUtilError := True;
+ Exit;
+ end;
+ Matrix.SetInteger(8, Matrix.Height - 8, 1);
+end;
+
+procedure TMatrixUtil.EmbedHorizontalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
+var
+ X: Integer;
+begin
+ // We know the width and height.
+ for X := 0 to 7 do
+ begin
+ if (not IsEmpty(Matrix.Get(XStart + X, YStart))) then
+ begin
+ FMatrixUtilError := True;
+ Exit;
+ end;
+ Matrix.SetInteger(XStart + X, YStart, HORIZONTAL_SEPARATION_PATTERN[0][X]);
+ end;
+end;
+
+procedure TMatrixUtil.EmbedVerticalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
+var
+ Y: Integer;
+begin
+ // We know the width and height.
+ for Y := 0 to 6 do
+ begin
+ if (not IsEmpty(Matrix.Get(XStart, YStart + Y))) then
+ begin
+ FMatrixUtilError := True;
+ Exit;
+ end;
+ Matrix.SetInteger(XStart, YStart + Y, VERTICAL_SEPARATION_PATTERN[Y][0]);
+ end;
+end;
+
+// Note that we cannot unify the function with embedPositionDetectionPattern() despite they are
+// almost identical, since we cannot write a function that takes 2D arrays in different sizes in
+// C/C++. We should live with the fact.
+procedure TMatrixUtil.EmbedPositionAdjustmentPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
+var
+ X, Y: Integer;
+begin
+ // We know the width and height.
+ for Y := 0 to 4 do
+ begin
+ for X := 0 to 4 do
+ begin
+ if (not IsEmpty(Matrix.Get(XStart + X, YStart + Y))) then
+ begin
+ FMatrixUtilError := True;
+ Exit;
+ end;
+ Matrix.SetInteger(XStart + X, YStart + Y, POSITION_ADJUSTMENT_PATTERN[Y][X]);
+ end;
+ end;
+end;
+
+procedure TMatrixUtil.EmbedPositionDetectionPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
+var
+ X, Y: Integer;
+begin
+ // We know the width and height.
+ for Y := 0 to 6 do
+ begin
+ for X := 0 to 6 do
+ begin
+ if (not IsEmpty(Matrix.Get(XStart + X, YStart + Y))) then
+ begin
+ FMatrixUtilError := True;
+ Exit;
+ end;
+ Matrix.SetInteger(XStart + X, YStart + Y, POSITION_DETECTION_PATTERN[Y][X]);
+ end;
+ end;
+end;
+
+// Embed position detection patterns and surrounding vertical/horizontal separators.
+procedure TMatrixUtil.EmbedPositionDetectionPatternsAndSeparators(Matrix: TByteMatrix);
+var
+ PDPWidth: Integer;
+ HSPWidth: Integer;
+ VSPSize: Integer;
+begin
+ // Embed three big squares at corners.
+ PDPWidth := Length(POSITION_DETECTION_PATTERN[0]);
+ // Left top corner.
+ EmbedPositionDetectionPattern(0, 0, Matrix);
+ // Right top corner.
+ EmbedPositionDetectionPattern(Matrix.Width - PDPWidth, 0, Matrix);
+ // Left bottom corner.
+ EmbedPositionDetectionPattern(0, Matrix.Width- PDPWidth, Matrix);
+
+ // Embed horizontal separation patterns around the squares.
+ HSPWidth := Length(HORIZONTAL_SEPARATION_PATTERN[0]);
+ // Left top corner.
+ EmbedHorizontalSeparationPattern(0, HSPWidth - 1, Matrix);
+ // Right top corner.
+ EmbedHorizontalSeparationPattern(Matrix.Width - HSPWidth,
+ HSPWidth - 1, Matrix);
+ // Left bottom corner.
+ EmbedHorizontalSeparationPattern(0, Matrix.Width - HSPWidth, Matrix);
+
+ // Embed vertical separation patterns around the squares.
+ VSPSize := Length(VERTICAL_SEPARATION_PATTERN);
+ // Left top corner.
+ EmbedVerticalSeparationPattern(VSPSize, 0, Matrix);
+ // Right top corner.
+ EmbedVerticalSeparationPattern(Matrix.Height - VSPSize - 1, 0, Matrix);
+ // Left bottom corner.
+ EmbedVerticalSeparationPattern(VSPSize, Matrix.Height - VSPSize, Matrix);
+end;
+
+// Embed position adjustment patterns if need be.
+procedure TMatrixUtil.MaybeEmbedPositionAdjustmentPatterns(Version: Integer; Matrix: TByteMatrix);
+var
+ Index: Integer;
+ Coordinates: array of Integer;
+ NumCoordinates: Integer;
+ X, Y, I, J: Integer;
+begin
+ if (Version >= 2) then
+ begin
+ Index := Version - 1;
+ NumCoordinates := Length(POSITION_ADJUSTMENT_PATTERN_COORDINATE_TABLE[Index]);
+ SetLength(Coordinates, NumCoordinates);
+ Move(POSITION_ADJUSTMENT_PATTERN_COORDINATE_TABLE[Index][0], Coordinates[0], NumCoordinates * SizeOf(Integer));
+ for I := 0 to NumCoordinates - 1 do
+ begin
+ for J := 0 to NumCoordinates - 1 do
+ begin
+ Y := Coordinates[I];
+ X := Coordinates[J];
+ if ((X = -1) or (Y = -1)) then
+ begin
+ Continue;
+ end;
+ // If the cell is unset, we embed the position adjustment pattern here.
+ if (IsEmpty(Matrix.Get(X, Y))) then
+ begin
+ // -2 is necessary since the x/y coordinates point to the center of the pattern, not the
+ // left top corner.
+ EmbedPositionAdjustmentPattern(X - 2, Y - 2, Matrix);
+ end;
+ end;
+ end;
+ end;
+end;
+
+
+{ TBitArray }
+
+
+procedure TBitArray.AppendBits(Value, NumBits: Integer);
+var
+ NumBitsLeft: Integer;
+begin
+ if ((NumBits < 0) or (NumBits > 32)) then
+ begin
+
+ end;
+ EnsureCapacity(Size + NumBits);
+ for NumBitsLeft := NumBits downto 1 do
+ begin
+ AppendBit(((Value shr (NumBitsLeft - 1)) and $01) = 1);
+ end;
+end;
+
+procedure TBitArray.Clear;
+begin
+ Size := 0;
+ SetLength(Bits, 1);
+ Bits[0] := 0;
+end;
+
+constructor TBitArray.Create(Size: Integer);
+
+begin
+ Size := Size;
+ SetLength(Bits, (Size + 31) shr 5);
+end;
+
+constructor TBitArray.Create;
+begin
+ Size := 0;
+ SetLength(Bits, 1);
+end;
+
+function TBitArray.Get(I: Integer): Boolean;
+begin
+ Result := (Bits[I shr 5] and (1 shl (I and $1F))) <> 0;
+end;
+
+function TBitArray.GetSize: Integer;
+begin
+ Result := Size;
+end;
+
+function TBitArray.GetSizeInBytes: Integer;
+begin
+ Result := (Size + 7) shr 3;
+end;
+
+procedure TBitArray.SetBit(Index: Integer);
+begin
+ Bits[Index shr 5] := Bits[Index shr 5] or (1 shl (Index and $1F));
+end;
+
+procedure TBitArray.AppendBit(Bit: Boolean);
+begin
+ EnsureCapacity(Size + 1);
+ if (Bit) then
+ begin
+ Bits[Size shr 5] := Bits[Size shr 5] or (1 shl (Size and $1F));
+ end;
+ Inc(Size);
+end;
+
+procedure TBitArray.ToBytes(BitOffset: Integer; Source: TByteArray; Offset,
+ NumBytes: Integer);
+var
+ I: Integer;
+ J: Integer;
+ TheByte: Integer;
+begin
+ for I := 0 to NumBytes - 1 do
+ begin
+ TheByte := 0;
+ for J := 0 to 7 do
+ begin
+ if (Get(BitOffset)) then
+ begin
+ TheByte := TheByte or (1 shl (7 - J));
+ end;
+ Inc(BitOffset);
+ end;
+ Source[Offset + I] := TheByte;
+ end;
+end;
+
+procedure TBitArray.XorOperation(Other: TBitArray);
+var
+ I: Integer;
+begin
+ if (Length(Bits) = Length(Other.Bits)) then
+ begin
+ for I := 0 to Length(Bits) - 1 do
+ begin
+ // The last byte could be incomplete (i.e. not have 8 bits in
+ // it) but there is no problem since 0 XOR 0 == 0.
+ Bits[I] := Bits[I] xor Other.Bits[I];
+ end;
+ end;
+end;
+
+procedure TBitArray.AppendBitArray(NewBitArray: TBitArray);
+var
+ OtherSize: Integer;
+ I: Integer;
+begin
+ OtherSize := NewBitArray.GetSize;
+ EnsureCapacity(Size + OtherSize);
+ for I := 0 to OtherSize - 1 do
+ begin
+ AppendBit(NewBitArray.Get(I));
+ end;
+end;
+
+procedure TBitArray.EnsureCapacity(Size: Integer);
+begin
+ if (Size > (Length(Bits) shl 5)) then
+ begin
+ SetLength(Bits, Size);
+ end;
+end;
+
+{ TErrorCorrectionLevel }
+
+procedure TErrorCorrectionLevel.Assign(Source: TErrorCorrectionLevel);
+begin
+ Self.FBits := Source.FBits;
+end;
+
+{ TVersion }
+
+class function TVersion.ChooseVersion(NumInputBits: Integer;
+ ECLevel: TErrorCorrectionLevel): TVersion;
+var
+ VersionNum: Integer;
+ Version: TVersion;
+ NumBytes: Integer;
+ ECBlocks: TECBlocks;
+ NumECBytes: Integer;
+ NumDataBytes: Integer;
+ TotalInputBytes: Integer;
+begin
+ Result := nil;
+ // In the following comments, we use numbers of Version 7-H.
+ for VersionNum := 1 to 40 do
+ begin
+ Version := TVersion.GetVersionForNumber(VersionNum);
+
+ // numBytes = 196
+ NumBytes := Version.GetTotalCodewords;
+ // getNumECBytes = 130
+ ECBlocks := Version.GetECBlocksForLevel(ECLevel);
+ NumECBytes := ECBlocks.GetTotalECCodewords;
+ // getNumDataBytes = 196 - 130 = 66
+ NumDataBytes := NumBytes - NumECBytes;
+ TotalInputBytes := (NumInputBits + 7) div 8;
+
+ if (numDataBytes >= totalInputBytes) then
+ begin
+ Result := Version;
+ Exit;
+ end else
+ begin
+ Version.Free;
+ end;
+ end;
+end;
+
+constructor TVersion.Create(VersionNumber: Integer;
+ AlignmentPatternCenters: array of Integer; ECBlocks1, ECBlocks2, ECBlocks3,
+ ECBlocks4: TECBlocks);
+var
+ Total: Integer;
+ ECBlock: TECB;
+ ECBArray: TECBArray;
+ I: Integer;
+begin
+ Self.VersionNumber := VersionNumber;
+ SetLength(Self.AlignmentPatternCenters, Length(AlignmentPatternCenters));
+ if (Length(AlignmentPatternCenters) > 0) then
+ begin
+ Move(AlignmentPatternCenters[0], Self.AlignmentPatternCenters[0],
+ Length(AlignmentPatternCenters) * SizeOf(Integer));
+ end;
+ SetLength(ECBlocks, 4);
+ ECBlocks[0] := ECBlocks1;
+ ECBlocks[1] := ECBlocks2;
+ ECBlocks[2] := ECBlocks3;
+ ECBlocks[3] := ECBlocks4;
+ Total := 0;
+ ECCodewords := ECBlocks1.GetECCodewordsPerBlock;
+ ECBArray := ECBlocks1.GetECBlocks;
+ for I := 0 to Length(ECBArray) - 1 do
+ begin
+ ECBlock := ECBArray[I];
+ Inc(Total, ECBlock.GetCount * (ECBlock.GetDataCodewords + ECCodewords));
+ end;
+ TotalCodewords := Total;
+end;
+
+destructor TVersion.Destroy;
+var
+ X: Integer;
+begin
+ for X := 0 to Length(ECBlocks) - 1 do
+ begin
+ ECBlocks[X].Free;
+ end;
+ inherited;
+end;
+
+function TVersion.GetDimensionForVersion: Integer;
+begin
+ Result := 17 + 4 * VersionNumber;
+end;
+
+function TVersion.GetECBlocksForLevel(ECLevel: TErrorCorrectionLevel): TECBlocks;
+begin
+ Result := ECBlocks[ECLevel.Ordinal];
+end;
+
+function TVersion.GetTotalCodewords: Integer;
+begin
+ Result := TotalCodewords;
+end;
+
+class function TVersion.GetVersionForNumber(VersionNum: Integer): TVersion;
+begin
+ if (VersionNum = 1) then
+ begin
+ Result := TVersion.Create(1, [],
+ TECBlocks.Create(7, TECB.Create(1, 19)),
+ TECBlocks.Create(10, TECB.Create(1, 16)),
+ TECBlocks.Create(13, TECB.Create(1, 13)),
+ TECBlocks.Create(17, TECB.Create(1, 9)));
+ end else
+ if (VersionNum = 2) then
+ begin
+ Result := TVersion.Create(2, [6, 18],
+ TECBlocks.Create(10, TECB.Create(1, 34)),
+ TECBlocks.Create(16, TECB.Create(1, 28)),
+ TECBlocks.Create(22, TECB.Create(1, 22)),
+ TECBlocks.Create(28, TECB.Create(1, 16)));
+ end else
+ if (VersionNum = 3) then
+ begin
+ Result := TVersion.Create(3, [6, 22],
+ TECBlocks.Create(15, TECB.Create(1, 55)),
+ TECBlocks.Create(26, TECB.Create(1, 44)),
+ TECBlocks.Create(18, TECB.Create(2, 17)),
+ TECBlocks.Create(22, TECB.Create(2, 13)));
+ end else
+ if (VersionNum = 4) then
+ begin
+ Result := TVersion.Create(4, [6, 26],
+ TECBlocks.Create(20, TECB.Create(1, 80)),
+ TECBlocks.Create(18, TECB.Create(2, 32)),
+ TECBlocks.Create(26, TECB.Create(2, 24)),
+ TECBlocks.Create(16, TECB.Create(4, 9)));
+ end else
+ if (VersionNum = 5) then
+ begin
+ Result := TVersion.Create(5, [6, 30],
+ TECBlocks.Create(26, TECB.Create(1, 108)),
+ TECBlocks.Create(24, TECB.Create(2, 43)),
+ TECBlocks.Create(18, TECB.Create(2, 15),
+ TECB.Create(2, 16)),
+ TECBlocks.Create(22, TECB.Create(2, 11),
+ TECB.Create(2, 12)));
+ end else
+ if (VersionNum = 6) then
+ begin
+ Result := TVersion.Create(6, [6, 34],
+ TECBlocks.Create(18, TECB.Create(2, 68)),
+ TECBlocks.Create(16, TECB.Create(4, 27)),
+ TECBlocks.Create(24, TECB.Create(4, 19)),
+ TECBlocks.Create(28, TECB.Create(4, 15)));
+ end else
+ if (VersionNum = 7) then
+ begin
+ Result := TVersion.Create(7, [6, 22, 38],
+ TECBlocks.Create(20, TECB.Create(2, 78)),
+ TECBlocks.Create(18, TECB.Create(4, 31)),
+ TECBlocks.Create(18, TECB.Create(2, 14),
+ TECB.Create(4, 15)),
+ TECBlocks.Create(26, TECB.Create(4, 13),
+ TECB.Create(1, 14)));
+ end else
+ if (VersionNum = 8) then
+ begin
+ Result := TVersion.Create(8, [6, 24, 42],
+ TECBlocks.Create(24, TECB.Create(2, 97)),
+ TECBlocks.Create(22, TECB.Create(2, 38),
+ TECB.Create(2, 39)),
+ TECBlocks.Create(22, TECB.Create(4, 18),
+ TECB.Create(2, 19)),
+ TECBlocks.Create(26, TECB.Create(4, 14),
+ TECB.Create(2, 15)));
+ end else
+ if (VersionNum = 9) then
+ begin
+ Result := TVersion.Create(9, [6, 26, 46],
+ TECBlocks.Create(30, TECB.Create(2, 116)),
+ TECBlocks.Create(22, TECB.Create(3, 36),
+ TECB.Create(2, 37)),
+ TECBlocks.Create(20, TECB.Create(4, 16),
+ TECB.Create(4, 17)),
+ TECBlocks.Create(24, TECB.Create(4, 12),
+ TECB.Create(4, 13)));
+ end else
+ if (VersionNum = 10) then
+ begin
+ Result := TVersion.Create(10, [6, 28, 50],
+ TECBlocks.Create(18, TECB.Create(2, 68),
+ TECB.Create(2, 69)),
+ TECBlocks.Create(26, TECB.Create(4, 43),
+ TECB.Create(1, 44)),
+ TECBlocks.Create(24, TECB.Create(6, 19),
+ TECB.Create(2, 20)),
+ TECBlocks.Create(28, TECB.Create(6, 15),
+ TECB.Create(2, 16)));
+ end else
+ if (VersionNum = 11) then
+ begin
+ Result := TVersion.Create(11, [6, 30, 54],
+ TECBlocks.Create(20, TECB.Create(4, 81)),
+ TECBlocks.Create(30, TECB.Create(1, 50),
+ TECB.Create(4, 51)),
+ TECBlocks.Create(28, TECB.Create(4, 22),
+ TECB.Create(4, 23)),
+ TECBlocks.Create(24, TECB.Create(3, 12),
+ TECB.Create(8, 13)));
+ end else
+ if (VersionNum = 12) then
+ begin
+ Result := TVersion.Create(12, [6, 32, 58],
+ TECBlocks.Create(24, TECB.Create(2, 92),
+ TECB.Create(2, 93)),
+ TECBlocks.Create(22, TECB.Create(6, 36),
+ TECB.Create(2, 37)),
+ TECBlocks.Create(26, TECB.Create(4, 20),
+ TECB.Create(6, 21)),
+ TECBlocks.Create(28, TECB.Create(7, 14),
+ TECB.Create(4, 15)));
+ end else
+ if (VersionNum = 13) then
+ begin
+ Result := TVersion.Create(13, [6, 34, 62],
+ TECBlocks.Create(26, TECB.Create(4, 107)),
+ TECBlocks.Create(22, TECB.Create(8, 37),
+ TECB.Create(1, 38)),
+ TECBlocks.Create(24, TECB.Create(8, 20),
+ TECB.Create(4, 21)),
+ TECBlocks.Create(22, TECB.Create(12, 11),
+ TECB.Create(4, 12)));
+ end else
+ if (VersionNum = 14) then
+ begin
+ Result := TVersion.Create(14, [6, 26, 46, 66],
+ TECBlocks.Create(30, TECB.Create(3, 115),
+ TECB.Create(1, 116)),
+ TECBlocks.Create(24, TECB.Create(4, 40),
+ TECB.Create(5, 41)),
+ TECBlocks.Create(20, TECB.Create(11, 16),
+ TECB.Create(5, 17)),
+ TECBlocks.Create(24, TECB.Create(11, 12),
+ TECB.Create(5, 13)));
+ end else
+ if (VersionNum = 15) then
+ begin
+ Result := TVersion.Create(15, [6, 26, 48, 70],
+ TECBlocks.Create(22, TECB.Create(5, 87),
+ TECB.Create(1, 88)),
+ TECBlocks.Create(24, TECB.Create(5, 41),
+ TECB.Create(5, 42)),
+ TECBlocks.Create(30, TECB.Create(5, 24),
+ TECB.Create(7, 25)),
+ TECBlocks.Create(24, TECB.Create(11, 12),
+ TECB.Create(7, 13)));
+ end else
+ if (VersionNum = 16) then
+ begin
+ Result := TVersion.Create(16, [6, 26, 50, 74],
+ TECBlocks.Create(24, TECB.Create(5, 98),
+ TECB.Create(1, 99)),
+ TECBlocks.Create(28, TECB.Create(7, 45),
+ TECB.Create(3, 46)),
+ TECBlocks.Create(24, TECB.Create(15, 19),
+ TECB.Create(2, 20)),
+ TECBlocks.Create(30, TECB.Create(3, 15),
+ TECB.Create(13, 16)));
+ end else
+ if (VersionNum = 17) then
+ begin
+ Result := TVersion.Create(17, [6, 30, 54, 78],
+ TECBlocks.Create(28, TECB.Create(1, 107),
+ TECB.Create(5, 108)),
+ TECBlocks.Create(28, TECB.Create(10, 46),
+ TECB.Create(1, 47)),
+ TECBlocks.Create(28, TECB.Create(1, 22),
+ TECB.Create(15, 23)),
+ TECBlocks.Create(28, TECB.Create(2, 14),
+ TECB.Create(17, 15)));
+ end else
+ if (VersionNum = 18) then
+ begin
+ Result := TVersion.Create(18, [6, 30, 56, 82],
+ TECBlocks.Create(30, TECB.Create(5, 120),
+ TECB.Create(1, 121)),
+ TECBlocks.Create(26, TECB.Create(9, 43),
+ TECB.Create(4, 44)),
+ TECBlocks.Create(28, TECB.Create(17, 22),
+ TECB.Create(1, 23)),
+ TECBlocks.Create(28, TECB.Create(2, 14),
+ TECB.Create(19, 15)));
+ end else
+ if (VersionNum = 19) then
+ begin
+ Result := TVersion.Create(19, [6, 30, 58, 86],
+ TECBlocks.Create(28, TECB.Create(3, 113),
+ TECB.Create(4, 114)),
+ TECBlocks.Create(26, TECB.Create(3, 44),
+ TECB.Create(11, 45)),
+ TECBlocks.Create(26, TECB.Create(17, 21),
+ TECB.Create(4, 22)),
+ TECBlocks.Create(26, TECB.Create(9, 13),
+ TECB.Create(16, 14)));
+ end else
+ if (VersionNum = 20) then
+ begin
+ Result := TVersion.Create(20, [6, 34, 62, 90],
+ TECBlocks.Create(28, TECB.Create(3, 107),
+ TECB.Create(5, 108)),
+ TECBlocks.Create(26, TECB.Create(3, 41),
+ TECB.Create(13, 42)),
+ TECBlocks.Create(30, TECB.Create(15, 24),
+ TECB.Create(5, 25)),
+ TECBlocks.Create(28, TECB.Create(15, 15),
+ TECB.Create(10, 16)));
+ end else
+ if (VersionNum = 21) then
+ begin
+ Result := TVersion.Create(21, [6, 28, 50, 72, 94],
+ TECBlocks.Create(28, TECB.Create(4, 116),
+ TECB.Create(4, 117)),
+ TECBlocks.Create(26, TECB.Create(17, 42)),
+ TECBlocks.Create(28, TECB.Create(17, 22),
+ TECB.Create(6, 23)),
+ TECBlocks.Create(30, TECB.Create(19, 16),
+ TECB.Create(6, 17)));
+ end else
+ if (VersionNum = 22) then
+ begin
+ Result := TVersion.Create(22, [6, 26, 50, 74, 98],
+ TECBlocks.Create(28, TECB.Create(2, 111),
+ TECB.Create(7, 112)),
+ TECBlocks.Create(28, TECB.Create(17, 46)),
+ TECBlocks.Create(30, TECB.Create(7, 24),
+ TECB.Create(16, 25)),
+ TECBlocks.Create(24, TECB.Create(34, 13)));
+ end else
+ if (VersionNum = 23) then
+ begin
+ Result := TVersion.Create(23, [6, 30, 54, 78, 102],
+ TECBlocks.Create(30, TECB.Create(4, 121),
+ TECB.Create(5, 122)),
+ TECBlocks.Create(28, TECB.Create(4, 47),
+ TECB.Create(14, 48)),
+ TECBlocks.Create(30, TECB.Create(11, 24),
+ TECB.Create(14, 25)),
+ TECBlocks.Create(30, TECB.Create(16, 15),
+ TECB.Create(14, 16)));
+ end else
+ if (VersionNum = 24) then
+ begin
+ Result := TVersion.Create(24, [6, 28, 54, 80, 106],
+ TECBlocks.Create(30, TECB.Create(6, 117),
+ TECB.Create(4, 118)),
+ TECBlocks.Create(28, TECB.Create(6, 45),
+ TECB.Create(14, 46)),
+ TECBlocks.Create(30, TECB.Create(11, 24),
+ TECB.Create(16, 25)),
+ TECBlocks.Create(30, TECB.Create(30, 16),
+ TECB.Create(2, 17)));
+ end else
+ if (VersionNum = 25) then
+ begin
+ Result := TVersion.Create(25, [6, 32, 58, 84, 110],
+ TECBlocks.Create(26, TECB.Create(8, 106),
+ TECB.Create(4, 107)),
+ TECBlocks.Create(28, TECB.Create(8, 47),
+ TECB.Create(13, 48)),
+ TECBlocks.Create(30, TECB.Create(7, 24),
+ TECB.Create(22, 25)),
+ TECBlocks.Create(30, TECB.Create(22, 15),
+ TECB.Create(13, 16)));
+ end else
+ if (VersionNum = 26) then
+ begin
+ Result := TVersion.Create(26, [6, 30, 58, 86, 114],
+ TECBlocks.Create(28, TECB.Create(10, 114),
+ TECB.Create(2, 115)),
+ TECBlocks.Create(28, TECB.Create(19, 46),
+ TECB.Create(4, 47)),
+ TECBlocks.Create(28, TECB.Create(28, 22),
+ TECB.Create(6, 23)),
+ TECBlocks.Create(30, TECB.Create(33, 16),
+ TECB.Create(4, 17)));
+ end else
+ if (VersionNum = 27) then
+ begin
+ Result := TVersion.Create(27, [6, 34, 62, 90, 118],
+ TECBlocks.Create(30, TECB.Create(8, 122),
+ TECB.Create(4, 123)),
+ TECBlocks.Create(28, TECB.Create(22, 45),
+ TECB.Create(3, 46)),
+ TECBlocks.Create(30, TECB.Create(8, 23),
+ TECB.Create(26, 24)),
+ TECBlocks.Create(30, TECB.Create(12, 15),
+ TECB.Create(28, 16)));
+ end else
+ if (VersionNum = 28) then
+ begin
+ Result := TVersion.Create(28, [6, 26, 50, 74, 98, 122],
+ TECBlocks.Create(30, TECB.Create(3, 117),
+ TECB.Create(10, 118)),
+ TECBlocks.Create(28, TECB.Create(3, 45),
+ TECB.Create(23, 46)),
+ TECBlocks.Create(30, TECB.Create(4, 24),
+ TECB.Create(31, 25)),
+ TECBlocks.Create(30, TECB.Create(11, 15),
+ TECB.Create(31, 16)));
+ end else
+ if (VersionNum = 29) then
+ begin
+ Result := TVersion.Create(29, [6, 30, 54, 78, 102, 126],
+ TECBlocks.Create(30, TECB.Create(7, 116),
+ TECB.Create(7, 117)),
+ TECBlocks.Create(28, TECB.Create(21, 45),
+ TECB.Create(7, 46)),
+ TECBlocks.Create(30, TECB.Create(1, 23),
+ TECB.Create(37, 24)),
+ TECBlocks.Create(30, TECB.Create(19, 15),
+ TECB.Create(26, 16)));
+ end else
+ if (VersionNum = 30) then
+ begin
+ Result := TVersion.Create(30, [6, 26, 52, 78, 104, 130],
+ TECBlocks.Create(30, TECB.Create(5, 115),
+ TECB.Create(10, 116)),
+ TECBlocks.Create(28, TECB.Create(19, 47),
+ TECB.Create(10, 48)),
+ TECBlocks.Create(30, TECB.Create(15, 24),
+ TECB.Create(25, 25)),
+ TECBlocks.Create(30, TECB.Create(23, 15),
+ TECB.Create(25, 16)));
+ end else
+ if (VersionNum = 31) then
+ begin
+ Result := TVersion.Create(31, [6, 30, 56, 82, 108, 134],
+ TECBlocks.Create(30, TECB.Create(13, 115),
+ TECB.Create(3, 116)),
+ TECBlocks.Create(28, TECB.Create(2, 46),
+ TECB.Create(29, 47)),
+ TECBlocks.Create(30, TECB.Create(42, 24),
+ TECB.Create(1, 25)),
+ TECBlocks.Create(30, TECB.Create(23, 15),
+ TECB.Create(28, 16)));
+ end else
+ if (VersionNum = 32) then
+ begin
+ Result := TVersion.Create(32, [6, 34, 60, 86, 112, 138],
+ TECBlocks.Create(30, TECB.Create(17, 115)),
+ TECBlocks.Create(28, TECB.Create(10, 46),
+ TECB.Create(23, 47)),
+ TECBlocks.Create(30, TECB.Create(10, 24),
+ TECB.Create(35, 25)),
+ TECBlocks.Create(30, TECB.Create(19, 15),
+ TECB.Create(35, 16)));
+ end else
+ if (VersionNum = 33) then
+ begin
+ Result := TVersion.Create(33, [6, 30, 58, 86, 114, 142],
+ TECBlocks.Create(30, TECB.Create(17, 115),
+ TECB.Create(1, 116)),
+ TECBlocks.Create(28, TECB.Create(14, 46),
+ TECB.Create(21, 47)),
+ TECBlocks.Create(30, TECB.Create(29, 24),
+ TECB.Create(19, 25)),
+ TECBlocks.Create(30, TECB.Create(11, 15),
+ TECB.Create(46, 16)));
+ end else
+ if (VersionNum = 34) then
+ begin
+ Result := TVersion.Create(34, [6, 34, 62, 90, 118, 146],
+ TECBlocks.Create(30, TECB.Create(13, 115),
+ TECB.Create(6, 116)),
+ TECBlocks.Create(28, TECB.Create(14, 46),
+ TECB.Create(23, 47)),
+ TECBlocks.Create(30, TECB.Create(44, 24),
+ TECB.Create(7, 25)),
+ TECBlocks.Create(30, TECB.Create(59, 16),
+ TECB.Create(1, 17)));
+ end else
+ if (VersionNum = 35) then
+ begin
+ Result := TVersion.Create(35, [6, 30, 54, 78, 102, 126, 150],
+ TECBlocks.Create(30, TECB.Create(12, 121),
+ TECB.Create(7, 122)),
+ TECBlocks.Create(28, TECB.Create(12, 47),
+ TECB.Create(26, 48)),
+ TECBlocks.Create(30, TECB.Create(39, 24),
+ TECB.Create(14, 25)),
+ TECBlocks.Create(30, TECB.Create(22, 15),
+ TECB.Create(41, 16)));
+ end else
+ if (VersionNum = 36) then
+ begin
+ Result := TVersion.Create(36, [6, 24, 50, 76, 102, 128, 154],
+ TECBlocks.Create(30, TECB.Create(6, 121),
+ TECB.Create(14, 122)),
+ TECBlocks.Create(28, TECB.Create(6, 47),
+ TECB.Create(34, 48)),
+ TECBlocks.Create(30, TECB.Create(46, 24),
+ TECB.Create(10, 25)),
+ TECBlocks.Create(30, TECB.Create(2, 15),
+ TECB.Create(64, 16)));
+ end else
+ if (VersionNum = 37) then
+ begin
+ Result := TVersion.Create(37, [6, 28, 54, 80, 106, 132, 158],
+ TECBlocks.Create(30, TECB.Create(17, 122),
+ TECB.Create(4, 123)),
+ TECBlocks.Create(28, TECB.Create(29, 46),
+ TECB.Create(14, 47)),
+ TECBlocks.Create(30, TECB.Create(49, 24),
+ TECB.Create(10, 25)),
+ TECBlocks.Create(30, TECB.Create(24, 15),
+ TECB.Create(46, 16)));
+ end else
+ if (VersionNum = 38) then
+ begin
+ Result := TVersion.Create(38, [6, 32, 58, 84, 110, 136, 162],
+ TECBlocks.Create(30, TECB.Create(4, 122),
+ TECB.Create(18, 123)),
+ TECBlocks.Create(28, TECB.Create(13, 46),
+ TECB.Create(32, 47)),
+ TECBlocks.Create(30, TECB.Create(48, 24),
+ TECB.Create(14, 25)),
+ TECBlocks.Create(30, TECB.Create(42, 15),
+ TECB.Create(32, 16)));
+ end else
+ if (VersionNum = 39) then
+ begin
+ Result := TVersion.Create(39, [6, 26, 54, 82, 110, 138, 166],
+ TECBlocks.Create(30, TECB.Create(20, 117),
+ TECB.Create(4, 118)),
+ TECBlocks.Create(28, TECB.Create(40, 47),
+ TECB.Create(7, 48)),
+ TECBlocks.Create(30, TECB.Create(43, 24),
+ TECB.Create(22, 25)),
+ TECBlocks.Create(30, TECB.Create(10, 15),
+ TECB.Create(67, 16)));
+ end else
+ if (VersionNum = 40) then
+ begin
+ Result := TVersion.Create(40, [6, 30, 58, 86, 114, 142, 170],
+ TECBlocks.Create(30, TECB.Create(19, 118),
+ TECB.Create(6, 119)),
+ TECBlocks.Create(28, TECB.Create(18, 47),
+ TECB.Create(31, 48)),
+ TECBlocks.Create(30, TECB.Create(34, 24),
+ TECB.Create(34, 25)),
+ TECBlocks.Create(30, TECB.Create(20, 15),
+ TECB.Create(61, 16)));
+ end else
+ begin
+ Result := nil;
+ end;
+end;
+
+{ TMaskUtil }
+
+// Return the mask bit for "getMaskPattern" at "x" and "y". See 8.8 of JISX0510:2004 for mask
+// pattern conditions.
+function TMaskUtil.GetDataMaskBit(MaskPattern, X, Y: Integer): Boolean;
+var
+ Intermediate: Integer;
+ Temp: Integer;
+begin
+ Intermediate := 0;
+ if ((MaskPattern >= 0) and (MaskPattern < NUM_MASK_PATTERNS)) then
+ begin
+ case (maskPattern) of
+ 0: Intermediate := (Y + X) and 1;
+ 1: Intermediate := Y and 1;
+ 2: Intermediate := X mod 3;
+ 3: Intermediate := (Y + X) mod 3;
+ 4: Intermediate := ((y shr 1) + (X div 3)) and 1;
+ 5:
+ begin
+ Temp := Y * X;
+ Intermediate := (Temp and 1) + (Temp mod 3);
+ end;
+ 6:
+ begin
+ Temp := Y * X;
+ Intermediate := ((Temp and 1) + (Temp mod 3)) and 1;
+ end;
+ 7:
+ begin
+ Temp := Y * X;
+ Intermediate := ((temp mod 3) + ((Y + X) and 1)) and 1;
+ end;
+ end;
+ end;
+ Result := Intermediate = 0;
+end;
+
+{ TECBlocks }
+
+constructor TECBlocks.Create(ECCodewordsPerBlock: Integer; ECBlocks: TECB);
+begin
+ Self.ECCodewordsPerBlock := ECCodewordsPerBlock;
+ SetLength(Self.ECBlocks, 1);
+ Self.ECBlocks[0] := ECBlocks;
+end;
+
+constructor TECBlocks.Create(ECCodewordsPerBlock: Integer; ECBlocks1,
+ ECBlocks2: TECB);
+begin
+ Self.ECCodewordsPerBlock := ECCodewordsPerBlock;
+ SetLength(Self.ECBlocks, 2);
+ ECBlocks[0] := ECBlocks1;
+ ECBlocks[1] := ECBlocks2;
+end;
+
+destructor TECBlocks.Destroy;
+var
+ X: Integer;
+begin
+ for X := 0 to Length(ECBlocks) - 1 do
+ begin
+ ECBlocks[X].Free;
+ end;
+ inherited;
+end;
+
+function TECBlocks.GetECBlocks: TECBArray;
+begin
+ Result := ECBlocks;
+end;
+
+function TECBlocks.GetECCodewordsPerBlock: Integer;
+begin
+ Result := ECCodewordsPerBlock;
+end;
+
+function TECBlocks.GetNumBlocks: Integer;
+var
+ Total: Integer;
+ I: Integer;
+begin
+ Total := 0;
+ for I := 0 to Length(ECBlocks) - 1 do
+ begin
+ Inc(Total, ECBlocks[I].GetCount);
+ end;
+ Result := Total;
+end;
+
+function TECBlocks.GetTotalECCodewords: Integer;
+begin
+ Result := ECCodewordsPerBlock * GetNumBlocks;
+end;
+
+{ TBlockPair }
+
+constructor TBlockPair.Create(BA1, BA2: TByteArray);
+begin
+ FDataBytes := BA1;
+ FErrorCorrectionBytes := BA2;
+end;
+
+function TBlockPair.GetDataBytes: TByteArray;
+begin
+ Result := FDataBytes;
+end;
+
+function TBlockPair.GetErrorCorrectionBytes: TByteArray;
+begin
+ Result := FErrorCorrectionBytes;
+end;
+
+{ TReedSolomonEncoder }
+
+function TReedSolomonEncoder.BuildGenerator(Degree: Integer): TGenericGFPoly;
+var
+ LastGenerator: TGenericGFPoly;
+ NextGenerator: TGenericGFPoly;
+ Poly: TGenericGFPoly;
+ D: Integer;
+ CA: TIntegerArray;
+begin
+ if (Degree >= FCachedGenerators.Count) then
+ begin
+ LastGenerator := TGenericGFPoly(FCachedGenerators[FCachedGenerators.Count - 1]);
+
+ for D := FCachedGenerators.Count to Degree do
+ begin
+ SetLength(CA, 2);
+ CA[0] := 1;
+ CA[1] := FField.Exp(D - 1 + FField.GetGeneratorBase);
+ Poly := TGenericGFPoly.Create(FField, CA);
+ NextGenerator := LastGenerator.Multiply(Poly);
+ FCachedGenerators.Add(NextGenerator);
+ LastGenerator := NextGenerator;
+ end;
+ end;
+ Result := TGenericGFPoly(FCachedGenerators[Degree]);
+end;
+
+constructor TReedSolomonEncoder.Create(AField: TGenericGF);
+var
+ GenericGFPoly: TGenericGFPoly;
+ IntArray: TIntegerArray;
+begin
+ FField := AField;
+
+ // Contents of FCachedGenerators will be freed by FGenericGF.Destroy
+ FCachedGenerators := TObjectList.Create(False);
+
+ SetLength(IntArray, 1);
+ IntArray[0] := 1;
+ GenericGFPoly := TGenericGFPoly.Create(AField, IntArray);
+ FCachedGenerators.Add(GenericGFPoly);
+end;
+
+destructor TReedSolomonEncoder.Destroy;
+begin
+ FCachedGenerators.Free;
+ inherited;
+end;
+
+procedure TReedSolomonEncoder.Encode(ToEncode: TIntegerArray; ECBytes: Integer);
+var
+ DataBytes: Integer;
+ Generator: TGenericGFPoly;
+ InfoCoefficients: TIntegerArray;
+ Info: TGenericGFPoly;
+ Remainder: TGenericGFPoly;
+ Coefficients: TIntegerArray;
+ NumZeroCoefficients: Integer;
+ I: Integer;
+begin
+ SetLength(Coefficients, 0);
+ if (ECBytes > 0) then
+ begin
+ DataBytes := Length(ToEncode) - ECBytes;
+ if (DataBytes > 0) then
+ begin
+ Generator := BuildGenerator(ECBytes);
+ SetLength(InfoCoefficients, DataBytes);
+ InfoCoefficients := Copy(ToEncode, 0, DataBytes);
+ Info := TGenericGFPoly.Create(FField, InfoCoefficients);
+ Info := Info.MultiplyByMonomial(ECBytes, 1);
+ Remainder := Info.Divide(Generator)[1];
+ Coefficients := Remainder.GetCoefficients;
+ NumZeroCoefficients := ECBytes - Length(Coefficients);
+ for I := 0 to NumZeroCoefficients - 1 do
+ begin
+ ToEncode[DataBytes + I] := 0;
+ end;
+ Move(Coefficients[0], ToEncode[DataBytes + NumZeroCoefficients], Length(Coefficients) * SizeOf(Integer));
+ end;
+ end;
+end;
+
+{ TECB }
+
+constructor TECB.Create(Count, DataCodewords: Integer);
+begin
+ Self.Count := Count;
+ Self.DataCodewords := DataCodewords;
+end;
+
+function TECB.GetCount: Integer;
+begin
+ Result := Count;
+end;
+
+function TECB.GetDataCodewords: Integer;
+begin
+ Result := DataCodewords;
+end;
+
+{ TGenericGFPoly }
+
+function TGenericGFPoly.AddOrSubtract(Other: TGenericGFPoly): TGenericGFPoly;
+var
+ SmallerCoefficients: TIntegerArray;
+ LargerCoefficients: TIntegerArray;
+ Temp: TIntegerArray;
+ SumDiff: TIntegerArray;
+ LengthDiff: Integer;
+ I: Integer;
+begin
+ SetLength(SmallerCoefficients, 0);
+ SetLength(LargerCoefficients, 0);
+ SetLength(Temp, 0);
+ SetLength(SumDiff, 0);
+
+ Result := nil;
+ if (Assigned(Other)) then
+ begin
+ if (FField = Other.FField) then
+ begin
+ if (IsZero) then
+ begin
+ Result := Other;
+ Exit;
+ end;
+
+ if (Other.IsZero) then
+ begin
+ Result := Self;
+ Exit;
+ end;
+
+ SmallerCoefficients := FCoefficients;
+ LargerCoefficients := Other.Coefficients;
+ if (Length(SmallerCoefficients) > Length(LargerCoefficients)) then
+ begin
+ Temp := smallerCoefficients;
+ SmallerCoefficients := LargerCoefficients;
+ LargerCoefficients := temp;
+ end;
+ SetLength(SumDiff, Length(LargerCoefficients));
+ LengthDiff := Length(LargerCoefficients) - Length(SmallerCoefficients);
+
+ // Copy high-order terms only found in higher-degree polynomial's coefficients
+ if (LengthDiff > 0) then
+ begin
+ //SumDiff := Copy(LargerCoefficients, 0, LengthDiff);
+ Move(LargerCoefficients[0], SumDiff[0], LengthDiff * SizeOf(Integer));
+ end;
+
+ for I := LengthDiff to Length(LargerCoefficients) - 1 do
+ begin
+ SumDiff[I] := TGenericGF.AddOrSubtract(SmallerCoefficients[I - LengthDiff], LargerCoefficients[I]);
+ end;
+
+ Result := TGenericGFPoly.Create(FField, SumDiff);
+ end;
+ end;
+end;
+
+function TGenericGFPoly.Coefficients: TIntegerArray;
+begin
+ Result := FCoefficients;
+end;
+
+constructor TGenericGFPoly.Create(AField: TGenericGF;
+ ACoefficients: TIntegerArray);
+var
+ CoefficientsLength: Integer;
+ FirstNonZero: Integer;
+begin
+ FField := AField;
+ SetLength(FField.FPolyList, Length(FField.FPolyList) + 1);
+ FField.FPolyList[Length(FField.FPolyList) - 1] := Self;
+ CoefficientsLength := Length(ACoefficients);
+ if ((CoefficientsLength > 1) and (ACoefficients[0] = 0)) then
+ begin
+ // Leading term must be non-zero for anything except the constant polynomial "0"
+ FirstNonZero := 1;
+ while ((FirstNonZero < CoefficientsLength) and (ACoefficients[FirstNonZero] = 0)) do
+ begin
+ Inc(FirstNonZero);
+ end;
+
+ if (FirstNonZero = CoefficientsLength) then
+ begin
+ FCoefficients := AField.GetZero.Coefficients;
+ end else
+ begin
+ SetLength(FCoefficients, CoefficientsLength - FirstNonZero);
+ FCoefficients := Copy(ACoefficients, FirstNonZero, Length(FCoefficients));
+ end;
+ end else
+ begin
+ FCoefficients := ACoefficients;
+ end;
+end;
+
+destructor TGenericGFPoly.Destroy;
+begin
+ Self.FField := FField;
+ inherited;
+end;
+
+function TGenericGFPoly.Divide(Other: TGenericGFPoly): TGenericGFPolyArray;
+var
+ Quotient: TGenericGFPoly;
+ Remainder: TGenericGFPoly;
+ DenominatorLeadingTerm: Integer;
+ InverseDenominatorLeadingTerm: integer;
+ DegreeDifference: Integer;
+ Scale: Integer;
+ Term: TGenericGFPoly;
+ IterationQuotient: TGenericGFPoly;
+begin
+ SetLength(Result, 0);
+ if ((FField = Other.FField) and (not Other.IsZero)) then
+ begin
+
+ Quotient := FField.GetZero;
+ Remainder := Self;
+
+ DenominatorLeadingTerm := Other.GetCoefficient(Other.GetDegree);
+ InverseDenominatorLeadingTerm := FField.Inverse(DenominatorLeadingTerm);
+
+ while ((Remainder.GetDegree >= Other.GetDegree) and (not Remainder.IsZero)) do
+ begin
+ DegreeDifference := Remainder.GetDegree - Other.GetDegree;
+ Scale := FField.Multiply(Remainder.GetCoefficient(Remainder.GetDegree), InverseDenominatorLeadingTerm);
+ Term := Other.MultiplyByMonomial(DegreeDifference, Scale);
+ IterationQuotient := FField.BuildMonomial(degreeDifference, scale);
+ Quotient := Quotient.AddOrSubtract(IterationQuotient);
+ Remainder := Remainder.AddOrSubtract(Term);
+ end;
+
+ SetLength(Result, 2);
+ Result[0] := Quotient;
+ Result[1] := Remainder;
+ end;
+end;
+
+function TGenericGFPoly.GetCoefficient(Degree: Integer): Integer;
+begin
+ Result := FCoefficients[Length(FCoefficients) - 1 - Degree];
+end;
+
+function TGenericGFPoly.GetCoefficients: TIntegerArray;
+begin
+ Result := FCoefficients;
+end;
+
+function TGenericGFPoly.GetDegree: Integer;
+begin
+ Result := Length(FCoefficients) - 1;
+end;
+
+function TGenericGFPoly.IsZero: Boolean;
+begin
+ Result := FCoefficients[0] = 0;
+end;
+
+function TGenericGFPoly.Multiply(Other: TGenericGFPoly): TGenericGFPoly;
+var
+ ACoefficients: TIntegerArray;
+ BCoefficients: TIntegerArray;
+ Product: TIntegerArray;
+ ALength: Integer;
+ BLength: Integer;
+ I: Integer;
+ J: Integer;
+ ACoeff: Integer;
+begin
+ SetLength(ACoefficients, 0);
+ SetLength(BCoefficients, 0);
+ Result := nil;
+
+ if (FField = Other.FField) then
+ begin
+ if (IsZero or Other.IsZero) then
+ begin
+ Result := FField.GetZero;
+ Exit;
+ end;
+
+ ACoefficients := FCoefficients;
+ ALength := Length(ACoefficients);
+ BCoefficients := Other.Coefficients;
+ BLength := Length(BCoefficients);
+ SetLength(Product, aLength + bLength - 1);
+ for I := 0 to ALength - 1 do
+ begin
+ ACoeff := ACoefficients[I];
+ for J := 0 to BLength - 1 do
+ begin
+ Product[I + J] := TGenericGF.AddOrSubtract(Product[I + J],
+ FField.Multiply(ACoeff, BCoefficients[J]));
+ end;
+ end;
+ Result := TGenericGFPoly.Create(FField, Product);
+ end;
+end;
+
+function TGenericGFPoly.MultiplyByMonomial(Degree,
+ Coefficient: Integer): TGenericGFPoly;
+var
+ I: Integer;
+ Size: Integer;
+ Product: TIntegerArray;
+begin
+ Result := nil;
+ if (Degree >= 0) then
+ begin
+ if (Coefficient = 0) then
+ begin
+ Result := FField.GetZero;
+ Exit;
+ end;
+ Size := Length(Coefficients);
+ SetLength(Product, Size + Degree);
+ for I := 0 to Size - 1 do
+ begin
+ Product[I] := FField.Multiply(FCoefficients[I], Coefficient);
+ end;
+ Result := TGenericGFPoly.Create(FField, Product);
+ end;
+end;
+
+{ TGenericGF }
+
+class function TGenericGF.AddOrSubtract(A, B: Integer): Integer;
+begin
+ Result := A xor B;
+end;
+
+function TGenericGF.BuildMonomial(Degree, Coefficient: Integer): TGenericGFPoly;
+var
+ Coefficients: TIntegerArray;
+begin
+ CheckInit();
+
+ if (Degree >= 0) then
+ begin
+ if (Coefficient = 0) then
+ begin
+ Result := FZero;
+ Exit;
+ end;
+ SetLength(Coefficients, Degree + 1);
+ Coefficients[0] := Coefficient;
+ Result := TGenericGFPoly.Create(Self, Coefficients);
+ end else
+ begin
+ Result := nil;
+ end;
+end;
+
+procedure TGenericGF.CheckInit;
+begin
+ if (not FInitialized) then
+ begin
+ Initialize;
+ end;
+end;
+
+constructor TGenericGF.Create(Primitive, Size, B: Integer);
+begin
+ FInitialized := False;
+ FPrimitive := Primitive;
+ FSize := Size;
+ FGeneratorBase := B;
+ if (FSize < 0) then
+ begin
+ Initialize;
+ end;
+end;
+
+class function TGenericGF.CreateQRCodeField256: TGenericGF;
+begin
+ Result := TGenericGF.Create($011D, 256, 0);
+end;
+
+destructor TGenericGF.Destroy;
+var
+ X: Integer;
+ Y: Integer;
+begin
+ for X := 0 to Length(FPolyList) - 1 do
+ begin
+ if (Assigned(FPolyList[X])) then
+ begin
+ for Y := X + 1 to Length(FPolyList) - 1 do
+ begin
+ if (FPolyList[Y] = FPolyList[X]) then
+ begin
+ FPolyList[Y] := nil;
+ end;
+ end;
+ FPolyList[X].Free;
+ end;
+ end;
+ inherited;
+end;
+
+function TGenericGF.Exp(A: Integer): Integer;
+begin
+ CheckInit;
+ Result := FExpTable[A];
+end;
+
+function TGenericGF.GetGeneratorBase: Integer;
+begin
+ Result := FGeneratorBase;
+end;
+
+function TGenericGF.GetZero: TGenericGFPoly;
+begin
+ CheckInit;
+ Result := FZero;
+end;
+
+procedure TGenericGF.Initialize;
+var
+ X: Integer;
+ I: Integer;
+ CA: TIntegerArray;
+begin
+ SetLength(FExpTable, FSize);
+ SetLength(FLogTable, FSize);
+ X := 1;
+ for I := 0 to FSize - 1 do
+ begin
+ FExpTable[I] := x;
+ X := X shl 1; // x = x * 2; we're assuming the generator alpha is 2
+ if (X >= FSize) then
+ begin
+ X := X xor FPrimitive;
+ X := X and (FSize - 1);
+ end;
+ end;
+
+ for I := 0 to FSize - 2 do
+ begin
+ FLogTable[FExpTable[I]] := I;
+ end;
+
+ // logTable[0] == 0 but this should never be used
+
+ SetLength(CA, 1);
+ CA[0] := 0;
+ FZero := TGenericGFPoly.Create(Self, CA);
+
+ SetLength(CA, 1);
+ CA[0] := 1;
+ FOne := TGenericGFPoly.Create(Self, CA);
+
+ FInitialized := True;
+end;
+
+function TGenericGF.Inverse(A: Integer): Integer;
+begin
+ CheckInit;
+
+ if (a <> 0) then
+ begin
+ Result := FExpTable[FSize - FLogTable[A] - 1];
+ end else
+ begin
+ Result := 0;
+ end;
+end;
+
+function TGenericGF.Multiply(A, B: Integer): Integer;
+begin
+ CheckInit;
+ if ((A <> 0) and (B <> 0)) then
+ begin
+ Result := FExpTable[(FLogTable[A] + FLogTable[B]) mod (FSize - 1)];
+ end else
+ begin
+ Result := 0;
+ end;
+end;
+
+function GenerateQRCode(const Input: WideString; EncodeOptions: Integer; Level: TErrorCorrectionLevel; aCodePage: Longint): T2DBooleanArray;
+var
+ Encoder: TEncoder;
+ //Level: TErrorCorrectionLevel;
+ QRCode: TQRCode;
+ X: Integer;
+ Y: Integer;
+begin
+ //Level := TErrorCorrectionLevel.Create;
+ //Level.FBits := 1;
+ Encoder := TEncoder.Create;
+ Encoder.Codepage := aCodePage;
+ QRCode := TQRCode.Create;
+ try
+ Encoder.Encode(Input, EncodeOptions, Level, QRCode);
+ if (Assigned(QRCode.FMatrix)) then
+ begin
+ SetLength(Result, QRCode.FMatrix.FHeight);
+ for Y := 0 to QRCode.FMatrix.FHeight - 1 do
+ begin
+ SetLength(Result[Y], QRCode.FMatrix.FWidth);
+ for X := 0 to QRCode.FMatrix.FWidth - 1 do
+ begin
+ Result[Y][X] := QRCode.FMatrix.Get(Y, X) = 1;
+ end;
+ end;
+ end;
+ finally
+ QRCode.Free;
+ Encoder.Free;
+ //Level.Free;
+ end;
+end;
+
+{ TDelphiZXingQRCode }
+
+constructor TDelphiZXingQRCode.Create;
+begin
+ FData := '';
+ FEncoding := qrAuto;
+ FQuietZone := 4;
+ FRows := 0;
+ FColumns := 0;
+ FErrorLevels := ecL;
+ FCodePage := 0;
+ FLevel := TErrorCorrectionLevel.Create;
+end;
+
+destructor TDelphiZXingQRCode.Destroy;
+begin
+ FLevel.Free;
+end;
+
+function TDelphiZXingQRCode.GetIsBlack(Row, Column: Integer): Boolean;
+begin
+ Dec(Row, FQuietZone);
+ Dec(Column, FQuietZone);
+ if ((Row >= 0) and (Column >= 0) and (Row < (FRows - FQuietZone * 2)) and (Column < (FColumns - FQuietZone * 2))) then
+ begin
+ Result := FElements[Column, Row];
+ end else
+ begin
+ Result := False;
+ end;
+end;
+
+procedure TDelphiZXingQRCode.SetCodePage(const Value: Longint);
+begin
+ if (FCodePage <> Value) then
+ begin
+ FCodePage := Value;
+ Update;
+ end;
+end;
+
+procedure TDelphiZXingQRCode.SetData(const NewData: WideString);
+begin
+ if (FData <> NewData) then
+ begin
+ FData := NewData;
+ Update;
+ end;
+end;
+
+procedure TDelphiZXingQRCode.SetEncoding(NewEncoding: TQRCodeEncoding);
+begin
+ if (FEncoding <> NewEncoding) then
+ begin
+ FEncoding := NewEncoding;
+ Update;
+ end;
+end;
+
+procedure TDelphiZXingQRCode.SetErrorLevels(const Value: TQRErrorLevels);
+begin
+ FErrorLevels := Value;
+ Update;
+end;
+
+procedure TDelphiZXingQRCode.SetQuietZone(NewQuietZone: Integer);
+begin
+ if ((FQuietZone <> NewQuietZone) and (NewQuietZone >= 0) and (NewQuietZone <= 100)) then
+ begin
+ FQuietZone := NewQuietZone;
+ Update;
+ end;
+end;
+
+procedure TDelphiZXingQRCode.Update;
+begin
+ FLevel.FBits := QRErrorLevelsBits[Ord(FErrorLevels)];
+ FLevel.Ordinal := Ord(FErrorLevels);
+ FElements := GenerateQRCode(FData, Ord(FEncoding), FLevel, FCodePage);
+ FRows := Length(FElements) + FQuietZone * 2;
+ FColumns := FRows;
+end;
+
+end.
diff --git a/LibD28/FMX.ExportTTFFont.pas b/LibD28/FMX.ExportTTFFont.pas
new file mode 100644
index 0000000..5fd4a8c
--- /dev/null
+++ b/LibD28/FMX.ExportTTFFont.pas
@@ -0,0 +1,803 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Font parser }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Aleksey Mandrykin, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.ExportTTFFont;
+
+strict private ExportTTFFont = class (IDisposable)
+ // Methods
+ public constructor Create(font: Font);
+ [DllImport('Gdi32.dll')]
+ strict private class extern function DeleteObject(hgdiobj: IntPtr): IntPtr; static;
+ public procedure Dispose;
+ public procedure FillOutlineTextMetrix;
+ public function GetEnglishFontName: string;
+ public function GetFontData: Byte[];
+ [DllImport('Gdi32.dll', CharSet=CharSet.Auto)]
+ strict private class extern function GetFontData(hdc: IntPtr; dwTable: Cardinal; dwOffset: Cardinal; [In, Out] lpvBuffer: Byte[]; cbData: Cardinal): Cardinal; static;
+ [DllImport('Gdi32.dll', CharSet=CharSet.Auto)]
+ strict private class extern function GetFontData(hdc: IntPtr; dwTable: Cardinal; dwOffset: Cardinal; [In, Out] lpvBuffer: IntPtr; cbData: Cardinal): Cardinal; static;
+ [DllImport('Gdi32.dll', CharSet=CharSet.Auto)]
+ strict private class extern function GetGlyphIndices(hdc: IntPtr; lpstr: string; c: Integer; [In, Out] pgi: Word[]; fl: Cardinal): Cardinal; static;
+ strict private function GetGlyphIndices(hdc: IntPtr; text: string; glyphs: Word[]; widths: Integer[]; rtl: boolean): Integer;
+ strict private function GetGlyphs(hdc: IntPtr; run: Run; glyphs: Word[]; widths: Integer[]; maxGlyphs: Integer; rtl: boolean): Integer;
+ public function GetGlyphWidth(c: Char): Integer;
+ [DllImport('Gdi32.dll')]
+ strict private class extern function GetOutlineTextMetrics(hdc: IntPtr; cbData: Integer; var lpOTM: OutlineTextMetric): Integer; static;
+ public function GetPANOSE: string;
+ strict private function Itemize(s: string; rtl: boolean; maxItems: Integer): List;
+ strict private function Layout(runs: List; rtl: boolean): List;
+ public function RemapString(str: string; rtl: boolean): string;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptApplyDigitSubstitution(var psds: SCRIPT_DIGITSUBSTITUTE; var psc: SCRIPT_CONTROL; var pss: SCRIPT_STATE): Integer; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptFreeCache(var psc: IntPtr): Integer; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptItemize([MarshalAs(UnmanagedType.LPWStr)] pwcInChars: string; cInChars: Integer; cMaxItems: Integer; var psControl: SCRIPT_CONTROL; var psState: SCRIPT_STATE; [In, Out] pItems: SCRIPT_ITEM[]; var pcItems: Integer): Integer; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptLayout(cRuns: Integer; [MarshalAs(UnmanagedType.LPArray)] pbLevel: Byte[]; [MarshalAs(UnmanagedType.LPArray)] piVisualToLogical: Integer[]; [MarshalAs(UnmanagedType.LPArray)] piLogicalToVisual: Integer[]): Integer; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptPlace(hdc: IntPtr; var psc: IntPtr; [MarshalAs(UnmanagedType.LPArray)] pwGlyphs: Word[]; cGlyphs: Integer; [MarshalAs(UnmanagedType.LPArray)] psva: SCRIPT_VISATTR[]; var psa: SCRIPT_ANALYSIS; [MarshalAs(UnmanagedType.LPArray)] piAdvance: Integer[]; [Out, MarshalAs(UnmanagedType.LPArray)] pGoffset: GOFFSET[]; var pABC: ABC): Integer; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptRecordDigitSubstitution(lcid: Cardinal; var psds: SCRIPT_DIGITSUBSTITUTE): Cardinal; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptShape(hdc: IntPtr; var psc: IntPtr; [MarshalAs(UnmanagedType.LPWStr)] pwcChars: string; cChars: Integer; cMaxGlyphs: Integer; var psa: SCRIPT_ANALYSIS; [Out, MarshalAs(UnmanagedType.LPArray)] pwOutGlyphs: Word[]; [Out, MarshalAs(UnmanagedType.LPArray)] pwLogClust: Word[]; [Out, MarshalAs(UnmanagedType.LPArray)] psva: SCRIPT_VISATTR[]; var pcGlyphs: Integer): Integer; static;
+ [DllImport('Gdi32.dll')]
+ strict private class extern function SelectObject(hdc: IntPtr; hgdiobj: IntPtr): IntPtr; static;
+
+ // Properties
+ public property Name: string read get_Name write set_Name;
+ public property Reference: Int64 read get_Reference write set_Reference;
+ public property Saved: boolean read get_Saved write set_Saved;
+ public property SourceFont: Font read get_SourceFont;
+ public property TextMetric: OutlineTextMetric read get_TextMetric;
+ public property UsedAlphabetUnicode: List read get_UsedAlphabetUnicode;
+ public property UsedGlyphIndexes: List read get_UsedGlyphIndexes;
+ public property Widths: List read get_Widths;
+
+ // Fields
+ strict private FDigitSubstitute: SCRIPT_DIGITSUBSTITUTE;
+ strict private FDpiFX: Single;
+ strict private FName: string;
+ strict private FReference: Int64;
+ strict private FSaved: boolean;
+ strict private FSourceFont: Font;
+ strict private FTextMetric: OutlineTextMetric;
+ strict private FUSCache: IntPtr;
+ strict private FUsedAlphabetUnicode: List;
+ strict private FUsedGlyphIndexes: List;
+ strict private FWidths: List;
+ strict private tempBitmap: Bitmap;
+
+ type // Nested Types
+ [StructLayout(LayoutKind.Sequential)]
+ public ABC = record
+ // Fields
+ public abcA: Integer;
+ public abcB: Integer;
+ public abcC: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public FontPanose = record
+ // Fields
+ public ArmStyle: Byte;
+ public bContrast: Byte;
+ public bFamilyType: Byte;
+ public bLetterform: Byte;
+ public bMidline: Byte;
+ public bProportion: Byte;
+ public bSerifStyle: Byte;
+ public bStrokeVariation: Byte;
+ public bWeight: Byte;
+ public bXHeight: Byte;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public FontPoint = record
+ // Fields
+ public x: Integer;
+ public y: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public FontRect = record
+ // Fields
+ public bottom: Integer;
+ public left: Integer;
+ public right: Integer;
+ public top: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public FontTextMetric = record
+ // Fields
+ public tmAscent: Integer;
+ public tmAveCharWidth: Integer;
+ public tmBreakChar: Char;
+ public tmCharSet: Byte;
+ public tmDefaultChar: Char;
+ public tmDescent: Integer;
+ public tmDigitizedAspectX: Integer;
+ public tmDigitizedAspectY: Integer;
+ public tmExternalLeading: Integer;
+ public tmFirstChar: Char;
+ public tmHeight: Integer;
+ public tmInternalLeading: Integer;
+ public tmItalic: Byte;
+ public tmLastChar: Char;
+ public tmMaxCharWidth: Integer;
+ public tmOverhang: Integer;
+ public tmPitchAndFamily: Byte;
+ public tmStruckOut: Byte;
+ public tmUnderlined: Byte;
+ public tmWeight: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public GOFFSET = record
+ // Fields
+ public du: Integer;
+ public dv: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public OutlineTextMetric = record
+ // Fields
+ public otmAscent: Integer;
+ public otmDescent: Integer;
+ public otmEMSquare: Cardinal;
+ public otmFiller: Byte;
+ public otmfsSelection: Cardinal;
+ public otmfsType: Cardinal;
+ public otmItalicAngle: Integer;
+ public otmLineGap: Cardinal;
+ public otmMacAscent: Integer;
+ public otmMacDescent: Integer;
+ public otmMacLineGap: Cardinal;
+ public otmPanoseNumber: FontPanose;
+ public otmpFaceName: string;
+ public otmpFamilyName: string;
+ public otmpFullName: string;
+ public otmpStyleName: string;
+ public otmptSubscriptOffset: FontPoint;
+ public otmptSubscriptSize: FontPoint;
+ public otmptSuperscriptOffset: FontPoint;
+ public otmptSuperscriptSize: FontPoint;
+ public otmrcFontBox: FontRect;
+ public otmsCapEmHeight: Cardinal;
+ public otmsCharSlopeRise: Integer;
+ public otmsCharSlopeRun: Integer;
+ public otmSize: Cardinal;
+ public otmsStrikeoutPosition: Integer;
+ public otmsStrikeoutSize: Cardinal;
+ public otmsUnderscorePosition: Integer;
+ public otmsUnderscoreSize: Integer;
+ public otmsXHeight: Cardinal;
+ public otmTextMetrics: FontTextMetric;
+ public otmusMinimumPPEM: Cardinal;
+
+ end;
+
+ strict private Run = class
+ // Methods
+ public constructor Create(text: string; a: SCRIPT_ANALYSIS);
+
+ // Fields
+ public analysis: SCRIPT_ANALYSIS;
+ public text: string;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_ANALYSIS = record
+ // Fields
+ public data: Smallint;
+ public state: SCRIPT_STATE;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_CONTROL = record
+ // Fields
+ public data: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_DIGITSUBSTITUTE = record
+ // Fields
+ public DigitSubstitute: Byte;
+ public dwReserved: Integer;
+ public NationalDigitLanguage: Smallint;
+ public TraditionalDigitLanguage: Smallint;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_ITEM = record
+ // Fields
+ public analysis: SCRIPT_ANALYSIS;
+ public iCharPos: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_STATE = record
+ // Methods
+ public procedure SetRtl;
+
+ // Properties
+ public property uBidiLevel: Integer read get_uBidiLevel;
+
+ // Fields
+ public data: Smallint;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_VISATTR = record
+ // Fields
+ public data: Smallint;
+
+ end;
+
+
+end;
+
+
+// Methods
+ constructor ExportTTFFont.Create(font: Font);
+ begin
+ self.FSourceFont := Font.Create(font.Name, (750 * self.FDpiFX), font.Style);
+ self.FSaved := false;
+ self.FTextMetric := OutlineTextMetric.Create;
+ self.FUsedGlyphIndexes := List.Create;
+ self.FUsedAlphabetUnicode := List.Create;
+ self.FWidths := List.Create;
+ self.tempBitmap := Bitmap.Create(1, 1);
+ self.FUSCache := IntPtr.Zero;
+ self.FDigitSubstitute := SCRIPT_DIGITSUBSTITUTE.Create;
+ ExportTTFFont.ScriptRecordDigitSubstitution($400, @(self.FDigitSubstitute))
+ end;
+
+ [DllImport('Gdi32.dll')]
+ strict private class extern function DeleteObject(hgdiobj: IntPtr): IntPtr; static;
+ procedure ExportTTFFont.Dispose;
+ begin
+ ExportTTFFont.ScriptFreeCache(@(self.FUSCache));
+ self.tempBitmap.Dispose;
+ self.FSourceFont.Dispose
+ end;
+
+ procedure ExportTTFFont.FillOutlineTextMetrix;
+ var
+ g: Graphics;
+ begin
+ if (self.FSourceFont <> nil) then
+ {using g}
+ begin
+ g := Graphics.FromImage(self.tempBitmap);
+ try
+ hdc := g.GetHdc;
+ f := self.FSourceFont.ToHfont;
+ try
+ ExportTTFFont.SelectObject(hdc, f);
+ ExportTTFFont.GetOutlineTextMetrics(hdc, Marshal.SizeOf(typeof(OutlineTextMetric)), @(self.FTextMetric))
+ finally
+ ExportTTFFont.DeleteObject(f);
+ g.ReleaseHdc(hdc)
+ end
+ finally
+ g.Dispose
+ end
+ end
+ end;
+
+ function ExportTTFFont.GetEnglishFontName: string;
+ var
+ c: Char;
+ begin
+ fontName := self.FSourceFont.FontFamily.GetName($409);
+ Result := StringBuilder.Create((fontName.Length * 3));
+
+ for c in fontName do
+ begin
+ case c of
+ '#':
+ '%':
+ '(':
+ ')':
+ '/':
+ ' ':
+ '<':
+ '>':
+ '[':
+ ']':
+ '{':
+ '}':
+ begin
+ Result.Append('#');
+ Result.Append((c as Integer).ToString('X2'));
+ break;
+
+ end;
+ default:begin
+ if ((c > '~') or (c < ' ')) then
+ begin
+ Result.Append('#');
+ Result.Append((c as Integer).ToString('X2'))
+ end
+ else
+ Result.Append(c);
+ break;
+
+ end;
+ end
+ end;
+ Style := StringBuilder.Create(9);
+ if ((self.FSourceFont.Style and FontStyle.Bold) > FontStyle.Regular) then
+ Style.Append('Bold');
+ if ((self.FSourceFont.Style and FontStyle.Italic) > FontStyle.Regular) then
+ Style.Append('Italic');
+ if (Style.Length > 0) then
+ Result.Append(',').Append(Style.ToString);
+ begin
+ Result := Result.ToString;
+ exit
+ end
+ end;
+
+ function ExportTTFFont.GetFontData: Byte[];
+ var
+ font_collection: TrueTypeCollection;
+ begin
+ result := nil;
+ if (self.FSourceFont = nil) then
+ begin
+ Result := result;
+ exit
+ end;
+ {using font_collection}
+ begin
+ font_collection := TrueTypeCollection.Create(self.FSourceFont);
+ try
+ skip_list := New(array[5] of TablesID, ( ( TablesID.HorizontakDeviceMetrix, TablesID.DigitalSignature, TablesID.GlyphPosition, TablesID.EmbedBitmapLocation, TablesID.EmbededBitmapData ) ));
+
+ for f in font_collection.FontCollection do
+ begin
+ f.PrepareFont(skip_list)
+ end;
+ font := font_collection.Item[self.FSourceFont];
+
+ for ch in self.FUsedGlyphIndexes do
+ begin
+ font.AddCharacterToKeepList(ch)
+ end;
+ begin
+ Result := font.PackFont(FontType.TrueTypeFont, true);
+ exit
+ end
+ finally
+ font_collection.Dispose
+ end
+ end
+ end;
+
+ [DllImport('Gdi32.dll', CharSet=CharSet.Auto)]
+ strict private class extern function GetFontData(hdc: IntPtr; dwTable: Cardinal; dwOffset: Cardinal; [In, Out] lpvBuffer: Byte[]; cbData: Cardinal): Cardinal; static;
+ [DllImport('Gdi32.dll', CharSet=CharSet.Auto)]
+ strict private class extern function GetFontData(hdc: IntPtr; dwTable: Cardinal; dwOffset: Cardinal; [In, Out] lpvBuffer: IntPtr; cbData: Cardinal): Cardinal; static;
+ [DllImport('Gdi32.dll', CharSet=CharSet.Auto)]
+ strict private class extern function GetGlyphIndices(hdc: IntPtr; lpstr: string; c: Integer; [In, Out] pgi: Word[]; fl: Cardinal): Cardinal; static;
+ function ExportTTFFont.GetGlyphIndices(hdc: IntPtr; text: string; glyphs: Word[]; widths: Integer[]; rtl: boolean): Integer;
+ var
+ run: Run;
+ begin
+ if (string.IsNullOrEmpty(text)) then
+ begin
+ Result := 0;
+ exit
+ end;
+ destIndex := 0;
+ maxGlyphs := (text.Length * 3);
+ maxItems := (text.Length * 2);
+ runs := self.Itemize(text, rtl, maxItems);
+ runs := self.Layout(runs, rtl);
+
+ for run in runs do
+ begin
+ tempGlyphs := New(array[maxGlyphs] of Word);
+ tempWidths := New(array[maxGlyphs] of Integer);
+ length := self.GetGlyphs(hdc, run, tempGlyphs, tempWidths, maxGlyphs, rtl);
+ Array.Copy(tempGlyphs, 0, glyphs, destIndex, length);
+ Array.Copy(tempWidths, 0, widths, destIndex, length);
+ inc(destIndex, length)
+ end;
+ begin
+ Result := destIndex;
+ exit
+ end
+ end;
+
+ function ExportTTFFont.GetGlyphs(hdc: IntPtr; run: Run; glyphs: Word[]; widths: Integer[]; maxGlyphs: Integer; rtl: boolean): Integer;
+ begin
+ psa := run.analysis;
+ pwLogClust := New(array[maxGlyphs] of Word);
+ pcGlyphs := 0;
+ psva := New(array[maxGlyphs] of SCRIPT_VISATTR);
+ pGoffset := New(array[maxGlyphs] of GOFFSET);
+ pABC := ABC.Create;
+ ExportTTFFont.ScriptShape(hdc, @(self.FUSCache), run.text, run.text.Length, glyphs.Length, @(psa), glyphs, pwLogClust, psva, @(pcGlyphs));
+ ExportTTFFont.ScriptPlace(hdc, @(self.FUSCache), glyphs, pcGlyphs, psva, @(psa), widths, pGoffset, @(pABC));
+ Result := pcGlyphs
+ end;
+
+ function ExportTTFFont.GetGlyphWidth(c: Char): Integer;
+ begin
+ Result := self.FWidths.Item[self.FUsedGlyphIndexes.IndexOf(c)]
+ end;
+
+ [DllImport('Gdi32.dll')]
+ strict private class extern function GetOutlineTextMetrics(hdc: IntPtr; cbData: Integer; var lpOTM: OutlineTextMetric): Integer; static;
+ function ExportTTFFont.GetPANOSE: string;
+ begin
+ panose := StringBuilder.Create($24);
+ panose.Append('01 05 ');
+ panose.Append(self.FTextMetric.otmPanoseNumber.bFamilyType.ToString('X')).Append(' ');
+ panose.Append(self.FTextMetric.otmPanoseNumber.bSerifStyle.ToString('X')).Append(' ');
+ panose.Append(self.FTextMetric.otmPanoseNumber.bWeight.ToString('X')).Append(' ');
+ panose.Append(self.FTextMetric.otmPanoseNumber.bProportion.ToString('X')).Append(' ');
+ panose.Append(self.FTextMetric.otmPanoseNumber.bContrast.ToString('X')).Append(' ');
+ panose.Append(self.FTextMetric.otmPanoseNumber.bStrokeVariation.ToString('X')).Append(' ');
+ panose.Append(self.FTextMetric.otmPanoseNumber.ArmStyle.ToString('X')).Append(' ');
+ panose.Append(self.FTextMetric.otmPanoseNumber.bLetterform.ToString('X')).Append(' ');
+ panose.Append(self.FTextMetric.otmPanoseNumber.bMidline.ToString('X')).Append(' ');
+ panose.Append(self.FTextMetric.otmPanoseNumber.bXHeight.ToString('X'));
+ Result := panose.ToString
+ end;
+
+ function ExportTTFFont.Itemize(s: string; rtl: boolean; maxItems: Integer): List;
+ begin
+ pItems := New(array[maxItems] of SCRIPT_ITEM);
+ pcItems := 0;
+ control := SCRIPT_CONTROL.Create;
+ state := SCRIPT_STATE.Create;
+ if (rtl) then
+ begin
+ state.SetRtl;
+ ExportTTFFont.ScriptApplyDigitSubstitution(@(self.FDigitSubstitute), @(control), @(state))
+ end;
+ ExportTTFFont.ScriptItemize(s, s.Length, pItems.Length, @(control), @(state), pItems, @(pcItems));
+ list := List.Create;
+ i := 0;
+ while ((i < pcItems)) do
+ begin
+ text := s.Substring(pItems[i].iCharPos, (pItems[(i + 1)].iCharPos - pItems[i].iCharPos));
+ list.Add(Run.Create(text, pItems[i].analysis));
+ inc(i)
+ end;
+ begin
+ Result := list;
+ exit
+ end
+ end;
+
+ function ExportTTFFont.Layout(runs: List; rtl: boolean): List;
+ var
+ i: Integer;
+ begin
+ pbLevel := New(array[runs.Count] of Byte);
+ piVisualToLogical := New(array[runs.Count] of Integer);
+ i := 0;
+ while ((i < runs.Count)) do
+ begin
+ pbLevel[i] := (runs.Item[i].analysis.state.uBidiLevel as Byte);
+ inc(i)
+ end;
+ ExportTTFFont.ScriptLayout(runs.Count, pbLevel, piVisualToLogical, nil);
+ visualRuns := List.Create;
+ i := 0;
+ while ((i < piVisualToLogical.Length)) do
+ begin
+ visualRuns.Add(runs.Item[piVisualToLogical[i]]);
+ inc(i)
+ end;
+ begin
+ Result := visualRuns;
+ exit
+ end
+ end;
+
+ function ExportTTFFont.RemapString(str: string; rtl: boolean): string;
+ var
+ g: Graphics;
+ begin
+ str := str.Replace('#13', '').Replace('#10', '');
+ maxGlyphs := (str.Length * 3);
+ glyphs := New(array[maxGlyphs] of Word);
+ widths := New(array[maxGlyphs] of Integer);
+ actualLength := 0;
+ {using g}
+ begin
+ g := Graphics.FromImage(self.tempBitmap);
+ try
+ hdc := g.GetHdc;
+ f := self.FSourceFont.ToHfont;
+ try
+ ExportTTFFont.SelectObject(hdc, f);
+ actualLength := self.GetGlyphIndices(hdc, str, glyphs, widths, rtl)
+ finally
+ ExportTTFFont.DeleteObject(f);
+ g.ReleaseHdc(hdc)
+ end
+ finally
+ g.Dispose
+ end
+ endsb := StringBuilder.Create(actualLength);
+ i := 0;
+ while ((i < actualLength)) do
+ begin
+ c := glyphs[i];
+ if (self.FUsedGlyphIndexes.IndexOf(c) = -1) then
+ begin
+ self.FUsedGlyphIndexes.Add(c);
+ self.FWidths.Add(widths[i]);
+ if (actualLength > str.Length) then
+ self.FUsedAlphabetUnicode.Add(self.FTextMetric.otmTextMetrics.tmDefaultChar)
+ else
+ self.FUsedAlphabetUnicode.Add(str.Chars[ {pseudo} (if rtl then ((actualLength - i) - 1) else i)])
+ end;
+ sb.Append((c as Char));
+ inc(i)
+ end;
+ begin
+ Result := sb.ToString;
+ exit
+ end
+ end;
+
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptApplyDigitSubstitution(var psds: SCRIPT_DIGITSUBSTITUTE; var psc: SCRIPT_CONTROL; var pss: SCRIPT_STATE): Integer; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptFreeCache(var psc: IntPtr): Integer; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptItemize([MarshalAs(UnmanagedType.LPWStr)] pwcInChars: string; cInChars: Integer; cMaxItems: Integer; var psControl: SCRIPT_CONTROL; var psState: SCRIPT_STATE; [In, Out] pItems: SCRIPT_ITEM[]; var pcItems: Integer): Integer; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptLayout(cRuns: Integer; [MarshalAs(UnmanagedType.LPArray)] pbLevel: Byte[]; [MarshalAs(UnmanagedType.LPArray)] piVisualToLogical: Integer[]; [MarshalAs(UnmanagedType.LPArray)] piLogicalToVisual: Integer[]): Integer; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptPlace(hdc: IntPtr; var psc: IntPtr; [MarshalAs(UnmanagedType.LPArray)] pwGlyphs: Word[]; cGlyphs: Integer; [MarshalAs(UnmanagedType.LPArray)] psva: SCRIPT_VISATTR[]; var psa: SCRIPT_ANALYSIS; [MarshalAs(UnmanagedType.LPArray)] piAdvance: Integer[]; [Out, MarshalAs(UnmanagedType.LPArray)] pGoffset: GOFFSET[]; var pABC: ABC): Integer; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptRecordDigitSubstitution(lcid: Cardinal; var psds: SCRIPT_DIGITSUBSTITUTE): Cardinal; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptShape(hdc: IntPtr; var psc: IntPtr; [MarshalAs(UnmanagedType.LPWStr)] pwcChars: string; cChars: Integer; cMaxGlyphs: Integer; var psa: SCRIPT_ANALYSIS; [Out, MarshalAs(UnmanagedType.LPArray)] pwOutGlyphs: Word[]; [Out, MarshalAs(UnmanagedType.LPArray)] pwLogClust: Word[]; [Out, MarshalAs(UnmanagedType.LPArray)] psva: SCRIPT_VISATTR[]; var pcGlyphs: Integer): Integer; static;
+ [DllImport('Gdi32.dll')]
+ strict private class extern function SelectObject(hdc: IntPtr; hgdiobj: IntPtr): IntPtr; static;
+
+ // Properties
+ public property Name: string read get_Name write set_Name;
+ public property Reference: Int64 read get_Reference write set_Reference;
+ public property Saved: boolean read get_Saved write set_Saved;
+ public property SourceFont: Font read get_SourceFont;
+ public property TextMetric: OutlineTextMetric read get_TextMetric;
+ public property UsedAlphabetUnicode: List read get_UsedAlphabetUnicode;
+ public property UsedGlyphIndexes: List read get_UsedGlyphIndexes;
+ public property Widths: List read get_Widths;
+
+ // Fields
+ strict private FDigitSubstitute: SCRIPT_DIGITSUBSTITUTE;
+ strict private FDpiFX: Single = (96 div (DrawUtils.ScreenDpi as Single));
+ strict private FName: string;
+ strict private FReference: Int64;
+ strict private FSaved: boolean;
+ strict private FSourceFont: Font;
+ strict private FTextMetric: OutlineTextMetric;
+ strict private FUSCache: IntPtr;
+ strict private FUsedAlphabetUnicode: List;
+ strict private FUsedGlyphIndexes: List;
+ strict private FWidths: List;
+ strict private tempBitmap: Bitmap;
+
+ type // Nested Types
+ [StructLayout(LayoutKind.Sequential)]
+ public ABC = record
+ // Fields
+ public abcA: Integer;
+ public abcB: Integer;
+ public abcC: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public FontPanose = record
+ // Fields
+ public ArmStyle: Byte;
+ public bContrast: Byte;
+ public bFamilyType: Byte;
+ public bLetterform: Byte;
+ public bMidline: Byte;
+ public bProportion: Byte;
+ public bSerifStyle: Byte;
+ public bStrokeVariation: Byte;
+ public bWeight: Byte;
+ public bXHeight: Byte;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public FontPoint = record
+ // Fields
+ public x: Integer;
+ public y: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public FontRect = record
+ // Fields
+ public bottom: Integer;
+ public left: Integer;
+ public right: Integer;
+ public top: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public FontTextMetric = record
+ // Fields
+ public tmAscent: Integer;
+ public tmAveCharWidth: Integer;
+ public tmBreakChar: Char;
+ public tmCharSet: Byte;
+ public tmDefaultChar: Char;
+ public tmDescent: Integer;
+ public tmDigitizedAspectX: Integer;
+ public tmDigitizedAspectY: Integer;
+ public tmExternalLeading: Integer;
+ public tmFirstChar: Char;
+ public tmHeight: Integer;
+ public tmInternalLeading: Integer;
+ public tmItalic: Byte;
+ public tmLastChar: Char;
+ public tmMaxCharWidth: Integer;
+ public tmOverhang: Integer;
+ public tmPitchAndFamily: Byte;
+ public tmStruckOut: Byte;
+ public tmUnderlined: Byte;
+ public tmWeight: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public GOFFSET = record
+ // Fields
+ public du: Integer;
+ public dv: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public OutlineTextMetric = record
+ // Fields
+ public otmAscent: Integer;
+ public otmDescent: Integer;
+ public otmEMSquare: Cardinal;
+ public otmFiller: Byte;
+ public otmfsSelection: Cardinal;
+ public otmfsType: Cardinal;
+ public otmItalicAngle: Integer;
+ public otmLineGap: Cardinal;
+ public otmMacAscent: Integer;
+ public otmMacDescent: Integer;
+ public otmMacLineGap: Cardinal;
+ public otmPanoseNumber: FontPanose;
+ public otmpFaceName: string;
+ public otmpFamilyName: string;
+ public otmpFullName: string;
+ public otmpStyleName: string;
+ public otmptSubscriptOffset: FontPoint;
+ public otmptSubscriptSize: FontPoint;
+ public otmptSuperscriptOffset: FontPoint;
+ public otmptSuperscriptSize: FontPoint;
+ public otmrcFontBox: FontRect;
+ public otmsCapEmHeight: Cardinal;
+ public otmsCharSlopeRise: Integer;
+ public otmsCharSlopeRun: Integer;
+ public otmSize: Cardinal;
+ public otmsStrikeoutPosition: Integer;
+ public otmsStrikeoutSize: Cardinal;
+ public otmsUnderscorePosition: Integer;
+ public otmsUnderscoreSize: Integer;
+ public otmsXHeight: Cardinal;
+ public otmTextMetrics: FontTextMetric;
+ public otmusMinimumPPEM: Cardinal;
+
+ end;
+
+ strict private Run = class
+ // Methods
+ constructor ExportTTFFont.Run.Create(text: string; a: SCRIPT_ANALYSIS);
+ begin
+ self.text := text;
+ self.analysis := a
+ end;
+
+
+ // Fields
+ public analysis: SCRIPT_ANALYSIS;
+ public text: string;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_ANALYSIS = record
+ // Fields
+ public data: Smallint;
+ public state: SCRIPT_STATE;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_CONTROL = record
+ // Fields
+ public data: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_DIGITSUBSTITUTE = record
+ // Fields
+ public DigitSubstitute: Byte;
+ public dwReserved: Integer;
+ public NationalDigitLanguage: Smallint;
+ public TraditionalDigitLanguage: Smallint;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_ITEM = record
+ // Fields
+ public analysis: SCRIPT_ANALYSIS;
+ public iCharPos: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_STATE = record
+ // Methods
+ procedure ExportTTFFont.SCRIPT_STATE.SetRtl;
+ begin
+ self.data := $801
+ end;
+
+
+ // Properties
+ public property uBidiLevel: Integer read get_uBidiLevel;
+
+ // Fields
+ public data: Smallint;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_VISATTR = record
+ // Fields
+ public data: Smallint;
+
+ end;
+
+
+end;
diff --git a/LibD28/FMX.FormTypeAliases.pas b/LibD28/FMX.FormTypeAliases.pas
new file mode 100644
index 0000000..99d3df6
--- /dev/null
+++ b/LibD28/FMX.FormTypeAliases.pas
@@ -0,0 +1,70 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Graphics.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.FormTypeAliases;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Types, FMX.Objects, System.UITypes, System.UIConsts, FMX.Graphics, System.Types, System.TypInfo, FMX.Forms;
+
+type
+ TFmxFormBorderStyleHelper = record helper for TFmxFormBorderStyle
+ const
+ bsNone = TFmxFormBorderStyle.None deprecated 'Use TFmxFormBorderStyle.None';
+ bsSingle = TFmxFormBorderStyle.Single deprecated 'Use TFmxFormBorderStyle.Single';
+ bsSizeable = TFmxFormBorderStyle.Sizeable deprecated 'Use TFmxFormBorderStyle.Sizeable';
+ bsToolWindow = TFmxFormBorderStyle.ToolWindow deprecated 'Use TFmxFormBorderStyle.ToolWindow';
+ bsSizeToolWin = TFmxFormBorderStyle.SizeToolWin deprecated 'Use TFmxFormBorderStyle.SizeToolWin';
+ end;
+
+ TFormPositionHelper = record helper for TFormPosition
+ const
+ poDesigned = TFormPosition.Designed deprecated 'Use TFormPosition.Designed';
+ poDefault = TFormPosition.Default deprecated 'Use TFormPosition.Default';
+ poDefaultPosOnly = TFormPosition.DefaultPosOnly deprecated 'Use TFormPosition.DefaultPosOnly';
+ poDefaultSizeOnly = TFormPosition.DefaultSizeOnly deprecated 'Use TFormPosition.DefaultSizeOnly';
+ poScreenCenter = TFormPosition.ScreenCenter deprecated 'Use TFormPosition.ScreenCenter';
+ poDesktopCenter = TFormPosition.DesktopCenter deprecated 'Use TFormPosition.DesktopCenter';
+ poMainFormCenter = TFormPosition.MainFormCenter deprecated 'Use TFormPosition.MainFormCenter';
+ poOwnerFormCenter = TFormPosition.OwnerFormCenter deprecated 'Use TFormPosition.OwnerFormCenter';
+ end;
+
+ TFmxFormStateHelper = record helper for TFmxFormState
+ const
+ fsRecreating = TFmxFormState.Recreating deprecated 'Use TFmxFormState.Recreating';
+ fsModal = TFmxFormState.Modal deprecated 'Use TFmxFormState.Modal';
+ fsReleased = TFmxFormState.Released deprecated 'Use TFmxFormState.Released';
+ fsInDesigner = TFmxFormState.InDesigner deprecated 'Use TFmxFormState.InDesigner';
+ fsWasNotShown = TFmxFormState.WasNotShown deprecated 'Use TFmxFormState.WasNotShown';
+ fsShowing = TFmxFormState.Showing deprecated 'Use TFmxFormState.Showing';
+ fsUpdateBorder = TFmxFormState.UpdateBorder deprecated 'Use TFmxFormState.UpdateBorder';
+ fsActivation = TFmxFormState.Activation deprecated 'Use TFmxFormState.Activation';
+ end;
+
+
+implementation
+
+initialization
+ AddEnumElementAliases(TypeInfo(TFmxFormBorderStyle), ['bsNone', 'bsSingle', 'bsSizeable', 'bsToolWindow', 'bsSizeToolWin']);
+ AddEnumElementAliases(TypeInfo(TFormPosition), ['poDesigned', 'poDefault', 'poDefaultPosOnly', 'poDefaultSizeOnly', 'poScreenCenter', 'poDesktopCenter',
+ 'poMainFormCenter', 'poOwnerFormCenter']);
+ AddEnumElementAliases(TypeInfo(TFmxFormState), ['fsRecreating', 'fsModal', 'fsReleased', 'fsInDesigner', 'fsWasNotShown', 'fsShowing', 'fsUpdateBorder',
+ 'fsActivation']);
+
+finalization
+ RemoveEnumElementAliases(TypeInfo(TFmxFormBorderStyle));
+ RemoveEnumElementAliases(TypeInfo(TFormPosition));
+ RemoveEnumElementAliases(TypeInfo(TFmxFormState));
+
+end.
diff --git a/LibD28/FMX.Linux.Old.frxPrinter.pas b/LibD28/FMX.Linux.Old.frxPrinter.pas
new file mode 100644
index 0000000..c309691
--- /dev/null
+++ b/LibD28/FMX.Linux.Old.frxPrinter.pas
@@ -0,0 +1,591 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Printer }
+{ }
+{ Copyright (c) 1998-2020 }
+{ by Alexander Syrykh, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.Linux.Old.frxPrinter;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.SysUtils,System.Types, System.UITypes, System.Variants,
+ FMX.Types, FMX.frxPrinter, FMX.Printer.Linux, FMX.Printer, FMX.frxClass
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+
+type
+ THackCanvas = class(TCanvas);
+ THackPrinter = class(TPrinter);
+
+
+ TfrxPrinter = class(TfrxCustomPrinter)
+ private
+ FIsFirst: Boolean;
+ public
+ constructor Create(const AName, APort: String); override;
+ destructor Destroy; override;
+ procedure Init; override;
+ procedure Abort; override;
+ procedure BeginDoc; override;
+ procedure BeginPage; override;
+ procedure BeginRAWDoc; override;
+ procedure EndDoc; override;
+ procedure EndPage; override;
+ procedure EndRAWDoc; override;
+ procedure WriteRAWDoc(const buf: AnsiString); override;
+ procedure SetViewParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended;
+ AOrientation: TPrinterOrientation); override;
+ procedure SetPrintParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
+ ABin, ADuplex, ACopies: Integer); override;
+ procedure PropertiesDlg; override;
+ function ShowPrintDialog: Boolean; override;
+ function UpdateDeviceCaps: Boolean;
+ end;
+
+ TfrxPrinters = class(TfrxCustomPrinters)
+ protected
+ function GetDefaultPrinter: String; override;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure FillPrinters; override;
+ end;
+
+function ActualfrxPrinterClass : TfrxCustomPrintersClass;
+
+implementation
+
+uses
+ FMX.frxUtils, FMX.frxRes, FMX.frxFMX, FMX.Forms, FMUX.Api;
+
+type
+ TPaperInfo = {packed} record
+ Typ: Integer;
+ Name: String;
+ X, Y: Integer;
+ end;
+
+const
+ PAPERCOUNT = 66;
+ PaperInfo: array[0..PAPERCOUNT - 1] of TPaperInfo = (
+ (Typ:1; Name: ''; X:2159; Y:2794),
+ (Typ:2; Name: ''; X:2159; Y:2794),
+ (Typ:3; Name: ''; X:2794; Y:4318),
+ (Typ:4; Name: ''; X:4318; Y:2794),
+ (Typ:5; Name: ''; X:2159; Y:3556),
+ (Typ:6; Name: ''; X:1397; Y:2159),
+ (Typ:7; Name: ''; X:1842; Y:2667),
+ (Typ:8; Name: ''; X:2970; Y:4200),
+ (Typ:9; Name: ''; X:2100; Y:2970),
+ (Typ:10; Name: ''; X:2100; Y:2970),
+ (Typ:11; Name: ''; X:1480; Y:2100),
+ (Typ:12; Name: ''; X:2500; Y:3540),
+ (Typ:13; Name: ''; X:1820; Y:2570),
+ (Typ:14; Name: ''; X:2159; Y:3302),
+ (Typ:15; Name: ''; X:2150; Y:2750),
+ (Typ:16; Name: ''; X:2540; Y:3556),
+ (Typ:17; Name: ''; X:2794; Y:4318),
+ (Typ:18; Name: ''; X:2159; Y:2794),
+ (Typ:19; Name: ''; X:984; Y:2254),
+ (Typ:20; Name: ''; X:1048; Y:2413),
+ (Typ:21; Name: ''; X:1143; Y:2635),
+ (Typ:22; Name: ''; X:1207; Y:2794),
+ (Typ:23; Name: ''; X:1270; Y:2921),
+ (Typ:24; Name: ''; X:4318; Y:5588),
+ (Typ:25; Name: ''; X:5588; Y:8636),
+ (Typ:26; Name: ''; X:8636; Y:11176),
+ (Typ:27; Name: ''; X:1100; Y:2200),
+ (Typ:28; Name: ''; X:1620; Y:2290),
+ (Typ:29; Name: ''; X:3240; Y:4580),
+ (Typ:30; Name: ''; X:2290; Y:3240),
+ (Typ:31; Name: ''; X:1140; Y:1620),
+ (Typ:32; Name: ''; X:1140; Y:2290),
+ (Typ:33; Name: ''; X:2500; Y:3530),
+ (Typ:34; Name: ''; X:1760; Y:2500),
+ (Typ:35; Name: ''; X:1760; Y:1250),
+ (Typ:36; Name: ''; X:1100; Y:2300),
+ (Typ:37; Name: ''; X:984; Y:1905),
+ (Typ:38; Name: ''; X:920; Y:1651),
+ (Typ:39; Name: ''; X:3778; Y:2794),
+ (Typ:40; Name: ''; X:2159; Y:3048),
+ (Typ:41; Name: ''; X:2159; Y:3302),
+ (Typ:42; Name: ''; X:2500; Y:3530),
+ (Typ:43; Name: ''; X:1000; Y:1480),
+ (Typ:44; Name: ''; X:2286; Y:2794),
+ (Typ:45; Name: ''; X:2540; Y:2794),
+ (Typ:46; Name: ''; X:3810; Y:2794),
+ (Typ:47; Name: ''; X:2200; Y:2200),
+ (Typ:50; Name: ''; X:2355; Y:3048),
+ (Typ:51; Name: ''; X:2355; Y:3810),
+ (Typ:52; Name: ''; X:2969; Y:4572),
+ (Typ:53; Name: ''; X:2354; Y:3223),
+ (Typ:54; Name: ''; X:2101; Y:2794),
+ (Typ:55; Name: ''; X:2100; Y:2970),
+ (Typ:56; Name: ''; X:2355; Y:3048),
+ (Typ:57; Name: ''; X:2270; Y:3560),
+ (Typ:58; Name: ''; X:3050; Y:4870),
+ (Typ:59; Name: ''; X:2159; Y:3223),
+ (Typ:60; Name: ''; X:2100; Y:3300),
+ (Typ:61; Name: ''; X:1480; Y:2100),
+ (Typ:62; Name: ''; X:1820; Y:2570),
+ (Typ:63; Name: ''; X:3220; Y:4450),
+ (Typ:64; Name: ''; X:1740; Y:2350),
+ (Typ:65; Name: ''; X:2010; Y:2760),
+ (Typ:66; Name: ''; X:4200; Y:5940),
+ (Typ:67; Name: ''; X:2970; Y:4200),
+ (Typ:68; Name: ''; X:3220; Y:4450));
+
+type
+ TPaperInfoLCL = {packed} record
+ Name: String;
+ W, H: Extended;
+ end;
+const
+ LCLPaperCount = 119;
+ PtPrIn = 72;
+ CmPrIn = 2.54;
+ PtPrCm = PtPrIn/CmPrIn;
+ PtPrmm = PtPrCm/10;
+ LCLPaperInfo : array[0..LCLPAPERCOUNT-1] of TPaperInfoLCL =
+ ((Name: 'Letter 8 1/2 x 11 in'; W: 8.5 * PtPrIn; H: 11 * PtPrIn),
+ (Name: 'Letter Small 8 1/2 x 11 in'; W: 8.5 * PtPrIn; H: 11 * PtPrIn),
+ (Name: 'Tabloid 11 x 17 in'; W: 11 * PtPrIn; H: 17 * PtPrIn),
+ (Name: 'Ledger 17 x 11 in'; W: 17 * PtPrIn; H: 11 * PtPrIn),
+ (Name: 'Legal 8 1/2 x 14 in'; W: 8.5 * PtPrIn; H: 14 * PtPrIn),
+ (Name: 'Statement 5 1/2 x 8 1/2 in'; W: 5.5 * PtPrIn; H: 8.5 * PtPrIn),
+ (Name: 'Executive 7 1/4 x 10 1/2 in'; W: 7.25 * PtPrIn; H: 10.5 * PtPrIn),
+ (Name: 'A3 297 x 420 mm'; W: 297 * PtPrmm; H: 420 * PtPrmm),
+ (Name: 'A4 210 x 297 mm'; W: 210 * PtPrmm; H: 297 * PtPrmm),
+ (Name: 'A4 Small 210 x 297 mm'; W: 210 * PtPrmm; H: 297 * PtPrmm),
+ (Name: 'A5 148 x 210 mm'; W: 148 * PtPrmm; H: 210 * PtPrmm),
+ (Name: 'B4 (JIS) 250 x 354 mm'; W: 250 * PtPrmm; H: 354 * PtPrmm),
+ (Name: 'B5 (JIS) 182 x 257 mm'; W: 182 * PtPrmm; H: 257 * PtPrmm),
+ (Name: 'Folio 8 1/2 x 13 in'; W: 8.5 * PtPrIn; H: 13 * PtPrIn),
+ (Name: 'Quarto 215 x 275 mm'; W: 215 * PtPrmm; H: 275 * PtPrmm),
+ (Name: '10x14 in'; W: 10 * PtPrIn; H: 14 * PtPrIn),
+ (Name: '11x17 in'; W: 11 * PtPrIn; H: 17 * PtPrIn),
+ (Name: 'Note 8 1/2 x 11 in'; W: 8.5 * PtPrIn; H: 11 * PtPrIn),
+ (Name: 'Envelope #9 3 7/8 x 8 7/8'; W: 3 * 7 / 8 * PtPrIn; H: 8 * 7 / 8 * PtPrIn),
+ (Name: 'Envelope #10 4 1/8 x 9 1/2'; W: 3 * 1 / 8 * PtPrIn; H: 9.5 * PtPrIn),
+ (Name: 'Envelope #11 4 1/2 x 10 3/8'; W: 4.5 * PtPrIn; H: 10 * 3 / 8 * PtPrIn),
+ (Name: 'Envelope #12 4 3/4 x 11'; W: 4.75 * PtPrIn; H: 11 * PtPrIn),
+ (Name: 'Envelope #14 5 x 11 1/2'; W: 5 * PtPrIn; H: 11.5 * PtPrIn),
+ (Name: 'C size sheet 17 x 22 in'; W: 17 * PtPrIn; H: 22 * PtPrIn),
+ (Name: 'D size sheet 22 x 34 in'; W: 22 * PtPrIn; H: 34 * PtPrIn),
+ (Name: 'E size sheet 34 x 44 in'; W: 34 * PtPrIn; H: 44 * PtPrIn),
+ (Name: 'Envelope DL 110 x 220mm'; W: 110 * PtPrmm; H: 220 * PtPrmm),
+ (Name: 'Envelope C5 162 x 229 mm'; W: 162 * PtPrmm; H: 229 * PtPrmm),
+ (Name: 'Envelope C3 324 x 458 mm'; W: 324 * PtPrmm; H: 458 * PtPrmm),
+ (Name: 'Envelope C4 229 x 324 mm'; W: 229 * PtPrmm; H: 324 * PtPrmm),
+ (Name: 'Envelope C6 114 x 162 mm'; W: 114 * PtPrmm; H: 162 * PtPrmm),
+ (Name: 'Envelope C65 114 x 229 mm'; W: 114 * PtPrmm; H: 229 * PtPrmm),
+ (Name: 'Envelope B4 250 x 353 mm'; W: 250 * PtPrmm; H: 353 * PtPrmm),
+ (Name: 'Envelope B5 176 x 250 mm'; W: 176 * PtPrmm; H: 250 * PtPrmm),
+ (Name: 'Envelope B6 176 x 125 mm'; W: 176 * PtPrmm; H: 125 * PtPrmm),
+ (Name: 'Envelope 110 x 230 mm'; W: 110 * PtPrmm; H: 230 * PtPrmm),
+ (Name: 'Envelope Monarch 3 7/8 x 7 1/2 in'; W: 3 * 7 / 8 * PtPrIn; H: 7.5 * PtPrIn),
+ (Name: '6 34 Envelope 3 5/8 x 6 1/2 in'; W: 3 * 5 / 8 * PtPrIn; H: 6.5 * PtPrIn),
+ (Name: 'US Std Fanfold 14 7/8 x 11 in'; W: 14 * 7 / 8 * PtPrIn; H: 11 * PtPrIn),
+ (Name: 'German Std Fanfold 8 1/2 x 12 in'; W: 8.5 * PtPrIn; H: 12 * PtPrIn),
+ (Name: 'German Legal Fanfold 8 1/2 x 13 in'; W: 8.5 * PtPrIn; H: 13 * PtPrIn),
+ (Name: 'B4 (ISO) 250 x 353 mm'; W: 250 * PtPrmm; H: 353 * PtPrmm),
+ (Name: 'Japanese Postcard 100 x 148 mm'; W: 100 * PtPrmm; H: 148 * PtPrmm),
+ (Name: '9 x 11 in'; W: 9 * PtPrIn; H: 11 * PtPrIn),
+ (Name: '10 x 11 in'; W: 10 * PtPrIn; H: 11 * PtPrIn),
+ (Name: '15 x 11 in'; W: 15 * PtPrIn; H: 11 * PtPrIn),
+ (Name: 'Envelope Invite 220 x 220 mm'; W: 220 * PtPrmm; H: 220 * PtPrmm),
+ (Name: 'RESERVED--DO NOT USE'; W: 0; H: 0),
+ (Name: 'RESERVED--DO NOT USE'; W: 0; H: 0),
+ (Name: 'Letter Extra 9 \275 x 12 in'; W: 9.275 * PtPrIn; H: 12 * PtPrIn),
+ (Name: 'Legal Extra 9 \275 x 15 in'; W: 9.275 * PtPrIn; H: 15 * PtPrIn),
+ (Name: 'Tabloid Extra 11.69 x 18 in'; W: 11.69 * PtPrIn; H: 18 * PtPrIn),
+ (Name: 'A4 Extra 9.27 x 12.69 in'; W: 9.27 * PtPrIn; H: 12.69 * PtPrIn),
+ (Name: 'Letter Transverse 8 \275 x 11 in'; W: 8.275 * PtPrIn; H: 11 * PtPrIn),
+ (Name: 'A4 Transverse 210 x 297 mm'; W: 210 * PtPrmm; H: 297 * PtPrmm),
+ (Name: 'Letter Extra Transverse 9\275 x 12 in'; W: 9.275 * PtPrIn; H: 12 * PtPrIn),
+ (Name: 'SuperASuperAA4 227 x 356 mm'; W: 227 * PtPrmm; H: 356 * PtPrmm),
+ (Name: 'SuperBSuperBA3 305 x 487 mm'; W: 305 * PtPrmm; H: 487 * PtPrmm),
+ (Name: 'Letter Plus 8.5 x 12.69 in'; W: 8.5 * PtPrIn; H: 12.69 * PtPrIn),
+ (Name: 'A4 Plus 210 x 330 mm'; W: 210 * PtPrmm; H: 330 * PtPrmm),
+ (Name: 'A5 Transverse 148 x 210 mm'; W: 148 * PtPrmm; H: 210 * PtPrmm),
+ (Name: 'B5 (JIS) Transverse 182 x 257 mm'; W: 182 * PtPrmm; H: 257 * PtPrmm),
+ (Name: 'A3 Extra 322 x 445 mm'; W: 322 * PtPrmm; H: 445 * PtPrmm),
+ (Name: 'A5 Extra 174 x 235 mm'; W: 174 * PtPrmm; H: 235 * PtPrmm),
+ (Name: 'B5 (ISO) Extra 201 x 276 mm'; W: 201 * PtPrmm; H: 276 * PtPrmm),
+ (Name: 'A2 420 x 594 mm'; W: 420 * PtPrmm; H: 594 * PtPrmm),
+ (Name: 'A3 Transverse 297 x 420 mm'; W: 297 * PtPrmm; H: 420 * PtPrmm),
+ (Name: 'A3 Extra Transverse 322 x 445 mm'; W: 322 * PtPrmm; H: 445 * PtPrmm),
+ (Name: 'Japanese Double Postcard 200 x 148 mm'; W: 200 * PtPrmm; H: 148 * PtPrmm),
+ (Name: 'A6 105 x 148 mm'; W: 105 * PtPrmm; H: 148 * PtPrmm),
+ (Name: 'Japanese Envelope Kaku #2'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Kaku #3'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Chou #3'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Chou #4'; W: 0; H: 0),
+ (Name: 'Letter Rotated 11 x 8 1/2 11 in'; W: 11 * PtPrIn; H: 8.5 * PtPrIn),
+ (Name: 'A3 Rotated 420 x 297 mm'; W: 420 * PtPrmm; H: 297 * PtPrmm),
+ (Name: 'A4 Rotated 297 x 210 mm'; W: 297 * PtPrmm; H: 210 * PtPrmm),
+ (Name: 'A5 Rotated 210 x 148 mm'; W: 210 * PtPrmm; H: 148 * PtPrmm),
+ (Name: 'B4 (JIS) Rotated 364 x 257 mm'; W: 364 * PtPrmm; H: 257 * PtPrmm),
+ (Name: 'B5 (JIS) Rotated 257 x 182 mm'; W: 257 * PtPrmm; H: 182 * PtPrmm),
+ (Name: 'Japanese Postcard Rotated 148 x 100 mm'; W: 148 * PtPrmm; H: 100 * PtPrmm),
+ (Name: 'Double Japanese Postcard Rotated 148 x 200 mm'; W: 148 * PtPrmm; H: 200 * PtPrmm),
+ (Name: 'A6 Rotated 148 x 105 mm'; W: 148 * PtPrmm; H: 105 * PtPrmm),
+ (Name: 'Japanese Envelope Kaku #2 Rotated'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Kaku #3 Rotated'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Chou #3 Rotated'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Chou #4 Rotated'; W: 0; H: 0),
+ (Name: 'B6 (JIS) 128 x 182 mm'; W: 128 * PtPrmm; H: 182 * PtPrmm),
+ (Name: 'B6 (JIS) Rotated 182 x 128 mm'; W: 182 * PtPrmm; H: 128 * PtPrmm),
+ (Name: '12 x 11 in'; W: 12 * PtPrIn; H: 11 * PtPrIn),
+ (Name: 'Japanese Envelope You #4'; W: 0; H: 0),
+ (Name: 'Japanese Envelope You #4 Rotated'; W: 0; H: 0),
+ (Name: 'PRC 16K 146 x 215 mm'; W: 146 * PtPrmm; H: 215 * PtPrmm),
+ (Name: 'PRC 32K 97 x 151 mm'; W: 97 * PtPrmm; H: 151 * PtPrmm),
+ (Name: 'PRC 32K(Big) 97 x 151 mm'; W: 97 * PtPrmm; H: 151 * PtPrmm),
+ (Name: 'PRC Envelope #1 102 x 165 mm'; W: 102 * PtPrmm; H: 165 * PtPrmm),
+ (Name: 'PRC Envelope #2 102 x 176 mm'; W: 102 * PtPrmm; H: 176 * PtPrmm),
+ (Name: 'PRC Envelope #3 125 x 176 mm'; W: 125 * PtPrmm; H: 176 * PtPrmm),
+ (Name: 'PRC Envelope #4 110 x 208 mm'; W: 110 * PtPrmm; H: 208 * PtPrmm),
+ (Name: 'PRC Envelope #5 110 x 220 mm'; W: 110 * PtPrmm; H: 220 * PtPrmm),
+ (Name: 'PRC Envelope #6 120 x 230 mm'; W: 120 * PtPrmm; H: 230 * PtPrmm),
+ (Name: 'PRC Envelope #7 160 x 230 mm'; W: 160 * PtPrmm; H: 230 * PtPrmm),
+ (Name: 'PRC Envelope #8 120 x 309 mm'; W: 120 * PtPrmm; H: 309 * PtPrmm),
+ (Name: 'PRC Envelope #9 229 x 324 mm'; W: 229 * PtPrmm; H: 324 * PtPrmm),
+ (Name: 'PRC Envelope #10 324 x 458 mm'; W: 324 * PtPrmm; H: 458 * PtPrmm),
+ (Name: 'PRC 16K Rotated 215 x 146 mm'; W: 215 * PtPrmm; H: 146 * PtPrmm),
+ (Name: 'PRC 32K Rotated 151 x 97 mm'; W: 151 * PtPrmm; H: 97 * PtPrmm),
+ (Name: 'PRC 32K(Big) Rotated 151 x 97 mm'; W: 151 * PtPrmm; H: 97 * PtPrmm),
+ (Name: 'PRC Envelope #1 Rotated 165 x 102 mm'; W: 165 * PtPrmm; H: 102 * PtPrmm),
+ (Name: 'PRC Envelope #2 Rotated 176 x 102 mm'; W: 176 * PtPrmm; H: 102 * PtPrmm),
+ (Name: 'PRC Envelope #3 Rotated 176 x 125 mm'; W: 176 * PtPrmm; H: 125 * PtPrmm),
+ (Name: 'PRC Envelope #4 Rotated 208 x 110 mm'; W: 208 * PtPrmm; H: 110 * PtPrmm),
+ (Name: 'PRC Envelope #5 Rotated 220 x 110 mm'; W: 220 * PtPrmm; H: 110 * PtPrmm),
+ (Name: 'PRC Envelope #6 Rotated 230 x 120 mm'; W: 230 * PtPrmm; H: 120 * PtPrmm),
+ (Name: 'PRC Envelope #7 Rotated 230 x 160 mm'; W: 230 * PtPrmm; H: 160 * PtPrmm),
+ (Name: 'PRC Envelope #8 Rotated 309 x 120 mm'; W: 309 * PtPrmm; H: 120 * PtPrmm),
+ (Name: 'PRC Envelope #9 Rotated 324 x 229 mm'; W: 324 * PtPrmm; H: 229 * PtPrmm),
+ (Name: 'PRC Envelope #10 Rotated 458 x 324 mm'; W: 458 * PtPrmm; H: 324 * PtPrmm),
+ (Name: 'Custom size'; W: 0; H: 0));
+
+constructor TfrxPrinter.Create(const AName, APort: String);
+begin
+ inherited Create(AName, APort);
+end;
+
+destructor TfrxPrinter.Destroy;
+begin
+ inherited;
+end;
+
+procedure TfrxPrinter.Init;
+ function FindLinuxPaper(w, h: Integer): Integer;
+ var
+ I: Integer;
+ p: TPaperInfo;
+ lw,lh: Integer;
+ begin
+ Result := 0;
+ for I := 0 to Length(PaperInfo) - 1 do
+ begin
+ p := PaperInfo[I];
+ lw :=p.X;
+ lh :=p.Y;
+ if ((w >= lw - 6) and (w <= lw + 6)) and ((h >= lh - 6) and (h <= lh + 6)) then
+ begin
+ Result := I;
+ Break;
+ end;
+ end;
+ end;
+
+ procedure FillPapers;
+ var
+ i,k: Integer;
+ fw, fh: Integer;
+ begin
+ for I := 0 to PAPERCOUNT - 1 do
+ begin
+ fw := PaperInfo[I].X;
+ fh := PaperInfo[I].Y;
+ k := FindLinuxPaper(fw, fh);
+ if k > 0 then
+ FPapers.AddObject(LCLPaperInfo[i].Name, TObject(PaperInfo[k].Typ));
+ end;
+ end;
+
+ procedure AssignActivePrinter;
+ var
+ i: Integer;
+ begin
+ for i := 0 to FMX.Printer.Printer.Count - 1 do
+ if TPrinterLinux(FMX.Printer.Printer).Printers[i].Device = Name then
+ TPrinterLinux(FMX.Printer.Printer).ActivePrinter:=
+ TPrinterLinux(FMX.Printer.Printer).Printers[i];
+ end;
+
+begin
+ AssignActivePrinter;
+
+ if FInitialized then Exit;
+ UpdateDeviceCaps;
+ FDefOrientation := TPrinterLinux(FMX.Printer.Printer).Orientation;
+ FOrientation := FDefOrientation;
+
+ FDefPaper := 256;
+ FDefBin := 0;
+ FDefDuplex := 0;
+ FPaper := FDefPaper;
+ FDefPaperWidth := FPaperWidth;
+ FDefPaperHeight := FPaperHeight;
+ FOrientation := FDefOrientation;
+ FillPapers;
+ FBin := -1;
+ FDuplex := -1;
+
+ FInitialized := True;
+
+ FBin := -1;
+ FDuplex := -1;
+
+ FInitialized := True;
+end;
+
+procedure TfrxPrinter.Abort;
+begin
+ TPrinterLinux(FMX.Printer.Printer).Abort;
+end;
+
+procedure TfrxPrinter.BeginDoc;
+begin
+ FPrinting := True;
+ FCanvas := TPrinterLinux(FMX.Printer.Printer).Canvas;
+
+ FIsFirst := True;
+ if FTitle <> '' then
+ TPrinterLinux(FMX.Printer.Printer).Title := FTitle
+ else
+ TPrinterLinux(FMX.Printer.Printer).Title := 'Fast Report Document';
+
+ UpdateDeviceCaps;
+ TPrinterLinux(FMX.Printer.Printer).BeginDoc;
+ FCanvas := TPrinterLinux(FMX.Printer.Printer).Canvas;
+end;
+
+procedure TfrxPrinter.BeginPage;
+begin
+ inherited;
+
+ if not (FIsFirst) then
+ begin
+ TPrinterLinux(FMX.Printer.Printer).NewPage;
+ TPrinterLinux(FMX.Printer.Printer).Canvas.BeginScene;
+ end;
+ FIsFirst := False;
+end;
+
+procedure TfrxPrinter.EndDoc;
+var
+ LSettings: TFmuxPageSettings;
+begin
+
+ TPrinterLinux(FMX.Printer.Printer).EndDoc;
+ FmuxGetPageSettings(LSettings);
+ FPaperWidth := LSettings.Width * 25.4 / 96;
+ FPaperHeight := LSettings.Height * 25.4 / 96;
+
+{$IFDEF DELPHI25}
+ try
+ if TPrinterLinux(FMX.Printer.Printer).Canvas.BeginSceneCount > 0 then
+ TPrinterLinux(FMX.Printer.Printer).Canvas.EndScene;
+ except
+ end;
+{$ELSE}
+ TPrinterLinux(FMX.Printer.Printer).Canvas.EndScene;
+{$ENDIF}
+
+ FPrinting := False;
+ THackPrinter(FMX.Printer.Printer).FPrinting := False;
+ FBin := -1;
+ FDuplex := -1;
+
+end;
+
+procedure TfrxPrinter.EndPage;
+begin
+//todo
+end;
+
+procedure TfrxPrinter.BeginRAWDoc;
+begin
+//todo
+end;
+
+procedure TfrxPrinter.EndRAWDoc;
+begin
+//todo
+end;
+
+procedure TfrxPrinter.WriteRAWDoc(const buf: AnsiString);
+begin
+//todo
+end;
+
+procedure TfrxPrinter.SetViewParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation);
+begin
+ FPaper := APaperSize;
+ FOrientation := AOrientation;
+
+ if APaperSize <> 256 then
+ begin
+ FPaperHeight := LCLPaperInfo[FPaper].H;
+ FPaperWidth := LCLPaperInfo[FPaper].W;
+ if not UpdateDeviceCaps then Exit;
+ end
+ else
+ begin
+ // copy the margins from A4 paper
+ SetViewParams(DMPAPER_A4, 0, 0, AOrientation);
+ FPaperHeight := APaperHeight;
+ FPaperWidth := APaperWidth;
+ end;
+
+end;
+
+function TfrxPrinter.ShowPrintDialog: Boolean;
+begin
+ Result := False;
+end;
+
+procedure TfrxPrinter.SetPrintParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
+ ABin, ADuplex, ACopies: Integer);
+var
+ LPaperHeight, LPaperWidth: Double;
+begin
+
+ { later fix these values }
+ FPaper := APaperSize;
+
+ if TPrinterLinux(FMX.Printer.Printer).Orientation <> AOrientation then
+ begin
+ if FPrinting then
+ begin
+ EndDoc;
+ TPrinterLinux(FMX.Printer.Printer).Orientation := AOrientation;
+ BeginDoc;
+ end
+ else
+ TPrinterLinux(FMX.Printer.Printer).Orientation := AOrientation;
+ end;
+
+ LPaperHeight := FPaperHeight * FDPI.Y / 96;
+ LPaperWidth := FPaperWidth * FDPI.X / 96;
+{$IFDEF DELPHI18}
+ TPrinterLinux(FMX.Printer.Printer).Canvas.SetSize(Round(LPaperWidth), Round(LPaperHeight));
+{$ELSE}
+ TPrinterLinux(FMX.Printer.Printer).Canvas.ResizeBuffer(Round(LPaperWidth), Round(LPaperHeight);
+{$ENDIF}
+ FOrientation := AOrientation;
+ UpdateDeviceCaps;
+end;
+
+function TfrxPrinter.UpdateDeviceCaps: Boolean;
+var
+ Idx: Integer;
+ LSettings: TFmuxPageSettings;
+begin
+ FCanvas := TPrinterLinux(FMX.Printer.Printer).Canvas;
+ Idx := TPrinterLinux(FMX.Printer.Printer).ActivePrinter.ActiveDPIIndex;
+
+ if Idx <> -1 then
+ begin
+ FDPI.X := TPrinterLinux(FMX.Printer.Printer).ActivePrinter.DPI[Idx].X;
+ FDPI.y := TPrinterLinux(FMX.Printer.Printer).ActivePrinter.DPI[Idx].Y;
+ end
+ else if TPrinterLinux(FMX.Printer.Printer).ActivePrinter.DPICount > 0 then
+ begin
+ FDPI.X := TPrinterLinux(FMX.Printer.Printer).ActivePrinter.DPI[0].X;
+ FDPI.y := TPrinterLinux(FMX.Printer.Printer).ActivePrinter.DPI[0].Y;
+ end
+ else
+ begin
+ FDPI := System.Classes.Point(72, 72);
+ end;
+
+ FmuxGetPageSettings(LSettings);
+
+ FPaperWidth := LSettings.Width * 25.4 / 96; // DPI / DPI
+ FPaperHeight := LSettings.Height * 25.4 / 96; // DPI / DPI
+
+ FLeftMargin := LSettings.Margins.Left * 25.4 / 96; // mm per Inch / DPI = mm
+ FTopMargin := LSettings.Margins.Top * 25.4 / 96; // DPI
+ FRightMargin := LSettings.Margins.Right * 25.4 / 96; // DPI
+ FBottomMargin := LSettings.Margins.Bottom * 25.4 / 96; // DPI
+
+ Result := True;
+
+end;
+
+procedure TfrxPrinter.PropertiesDlg;
+begin
+end;
+
+{ TfrxPrinters }
+
+constructor TfrxPrinters.Create;
+begin
+ Inherited;
+end;
+
+destructor TfrxPrinters.Destroy;
+begin
+ inherited;
+end;
+
+function TfrxPrinters.GetDefaultPrinter: String;
+begin
+ Result := TPrinterLinux(FMX.Printer.Printer).ActivePrinter.Device;
+end;
+
+
+procedure TfrxPrinters.FillPrinters;
+var
+ i: Integer;
+
+ procedure AddPrinter(ADevice, APort: String);
+ begin
+ FPrinterList.Add(TfrxPrinter.Create(ADevice, APort));
+ FPrinters.Add(ADevice);
+ end;
+
+begin
+ Clear;
+ for i := 0 to TPrinterLinux(FMX.Printer.Printer).Count - 1 do
+ AddPrinter(FMX.Printer.Printer.Printers[i].Device, TPrinterLinux(FMX.Printer.Printer).Printers[i].Port);
+end;
+
+
+function ActualfrxPrinterClass : TfrxCustomPrintersClass;
+begin
+ Result := TfrxPrinters;
+end;
+
+initialization
+
+finalization
+
+end.
diff --git a/LibD28/FMX.Linux.frxPrinter.pas b/LibD28/FMX.Linux.frxPrinter.pas
new file mode 100644
index 0000000..caf0444
--- /dev/null
+++ b/LibD28/FMX.Linux.frxPrinter.pas
@@ -0,0 +1,1324 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Linux printer classes }
+{ }
+{ Copyright (c) 1998-2021 }
+{ by Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.Linux.frxPrinter;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.SysUtils, System.Types, System.UITypes,
+ System.Variants, FMX.Types, FMX.frxPrinter, FMX.Printer.Linux, FMX.Printer
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+type
+ TPGtkPrinter = Pointer;
+ TPGtkPrintBackend = Pointer;
+ TPGtkPrintJob = Pointer;
+ TPGtkPrintSettings = Pointer;
+ TPGtkPageSetup = Pointer;
+ TPGtkPaperSize = Pointer;
+ TPcairo_surface_t = Pointer;
+ TPcairo_t = Pointer;
+
+ TfrxDevUpdateType = (fdtMargins, fdtPageSize, fdtBin, fdtDuplex, fdtOrientation);
+ TfrxDevUpdateTypes = set of TfrxDevUpdateType;
+
+ TfrxPrinter = class(TfrxCustomPrinter)
+ private
+ FIsFirst: Boolean;
+ FPrinterContext: Pointer;
+ FPageSet: TPGtkPageSetup;
+ FCustomPaper: TPGtkPaperSize;
+ FSettings: TPGtkPrintSettings;
+ FJob: TPGtkPrintJob;
+ FSurf: TPcairo_surface_t;
+ FGTKPapers: TStrings;
+ FTerminated: Boolean;
+ protected
+ procedure ClearGTKPapers;
+ public
+ constructor Create(const AName: String; ADevice: NativeInt); reintroduce;
+ destructor Destroy; override;
+ procedure Init; override;
+ procedure Abort; override;
+ procedure BeginDoc; override;
+ procedure BeginPage; override;
+ procedure BeginRAWDoc; override;
+ procedure EndDoc; override;
+ procedure EndPage; override;
+ procedure EndRAWDoc; override;
+ procedure WriteRAWDoc(const buf: AnsiString); override;
+ procedure SetViewParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended;
+ AOrientation: TPrinterOrientation); override;
+ procedure SetPrintParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
+ ABin, ADuplex, ACopies: Integer); override;
+ procedure PropertiesDlg; override;
+ function ShowPrintDialog: Boolean; override;
+ function UpdateFromDeviceCaps: Boolean;
+ function UpdateToDeviceCaps(Params: TfrxDevUpdateTypes): Boolean;
+ procedure UpdatePageSettings;
+ end;
+
+ TfrxPrinters = class(TfrxCustomPrinters)
+ protected
+ function GetDefaultPrinter: String; override;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure FillPrinters; override;
+ end;
+
+function ActualfrxPrinterClass: TfrxCustomPrintersClass;
+
+implementation
+
+uses
+ FMX.frxUtils, FMX.frxRes, FMX.frxFMX, System.Math.Vectors, System.Math,
+ System.AnsiStrings, FMX.Canvas.Linux, FMX.frxCanvas.Linux, FMX.frxClass, FMX.Forms, System.Diagnostics;
+
+type
+ TPaperInfo = { packed } record
+ Typ: Integer;
+ Name: String;
+ X, Y: Integer;
+ end;
+
+ TGList = record
+ pData: Pointer;
+ pNext: ^TGList;
+ pPrev: ^TGList;
+ end;
+
+ TPGList = ^TGList;
+ TPGtkWidget = Pointer;
+ TPGtkPrintUnixDialog = Pointer;
+
+ TGConnectFlags = (G_CONNECT_AFTER, G_CONNECT_SWAPPED);
+ TGtkPageOrientation = (GTK_PAGE_ORIENTATION_PORTRAIT,
+ GTK_PAGE_ORIENTATION_LANDSCAPE, GTK_PAGE_ORIENTATION_REVERSE_PORTRAIT,
+ GTK_PAGE_ORIENTATION_REVERSE_LANDSCAPE);
+
+ TGtkPrintDuplex = (GTK_PRINT_DUPLEX_SIMPLEX, GTK_PRINT_DUPLEX_HORIZONTAL,
+ GTK_PRINT_DUPLEX_VERTICAL);
+
+ TGtkUnit = (GTK_UNIT_NONE, GTK_UNIT_POINTS, GTK_UNIT_INCH, GTK_UNIT_MM);
+
+ TCairo_surface_type = (
+
+ CAIRO_SURFACE_TYPE_IMAGE, CAIRO_SURFACE_TYPE_PDF, CAIRO_SURFACE_TYPE_PS,
+ CAIRO_SURFACE_TYPE_XLIB, CAIRO_SURFACE_TYPE_XCB, CAIRO_SURFACE_TYPE_GLITZ,
+ CAIRO_SURFACE_TYPE_QUARTZ, CAIRO_SURFACE_TYPE_WIN32,
+ CAIRO_SURFACE_TYPE_BEOS, CAIRO_SURFACE_TYPE_DIRECTFB,
+ CAIRO_SURFACE_TYPE_SVG, CAIRO_SURFACE_TYPE_OS2,
+ CAIRO_SURFACE_TYPE_WIN32_PRINTING, CAIRO_SURFACE_TYPE_QUARTZ_IMAGE,
+ CAIRO_SURFACE_TYPE_SCRIPT, CAIRO_SURFACE_TYPE_QT,
+ CAIRO_SURFACE_TYPE_RECORDING, CAIRO_SURFACE_TYPE_VG, CAIRO_SURFACE_TYPE_GL,
+ CAIRO_SURFACE_TYPE_DRM, CAIRO_SURFACE_TYPE_TEE, CAIRO_SURFACE_TYPE_XML,
+ CAIRO_SURFACE_TYPE_SKIA, CAIRO_SURFACE_TYPE_SUBSURFACE);
+
+ TPGtkPrintJobCompleteFunc = procedure(print_job: TPGtkPrintJob;
+ user_data: Pointer; error: Pointer); cdecl;
+ TPGDestroyNotify = procedure(pData: Pointer); cdecl;
+
+ TPGtkPrinterFunc = function(printer: TPGtkPrinter; pData: Pointer): LongBool; cdecl;
+ TPDetails_acquiredFunc = procedure(printer: TpGtkPrinter; success: LongBool; user_data: Pointer); cdecl;
+
+ Tfn_g_free = procedure(prt: Pointer); cdecl;
+ Tfn_g_list_free = procedure(prt: Pointer); cdecl;
+
+ Tfn_cairo_surface_finish = procedure(surface: TPcairo_surface_t); cdecl;
+
+ Tfn_cairo_create = function(target: TPcairo_surface_t): TPcairo_t; cdecl;
+ Tfn_cairo_destroy = procedure(cr: TPcairo_t); cdecl;
+ Tfn_cairo_show_page = procedure(cr: TPcairo_t); cdecl;
+
+ Tfn_cairo_surface_get_type = function(surface: TPcairo_surface_t): TCairo_surface_type; cdecl;
+ Tfn_cairo_ps_surface_set_size = procedure(surface: TPcairo_surface_t; width_in_points: double; height_in_points: double); cdecl;
+ Tfn_cairo_ps_surface_dsc_begin_setup = procedure(surface: TPcairo_surface_t); cdecl;
+ Tfn_cairo_ps_surface_dsc_begin_page_setup = procedure(surface: TPcairo_surface_t); cdecl;
+ Tfn_cairo_ps_surface_dsc_comment = procedure(surface: TPcairo_surface_t; const comment: PAnsiChar); cdecl;
+ Tfn_cairo_pdf_surface_set_size = procedure(surface: TPcairo_surface_t; width_in_points: double; height_in_points: double); cdecl;
+
+ Tfn_g_signal_connect_data = function(instance: Pointer; const detailed_signal: PAnsiChar; c_handler: Pointer; data: Pointer; destroy_data: Pointer; connect_flags: TGConnectFlags): UInt32; cdecl;
+ Tfn_g_object_unref = procedure(obj: Pointer); cdecl;
+ Tfn_g_object_ref = function(obj: Pointer): Pointer; cdecl;
+ Tfn_gtk_print_job_new = function(const title: PAnsiChar; Printer: TPGtkPrinter; settings: TPGtkPrintSettings; page_setup: TPGtkPageSetup): TPGtkPrintJob; cdecl;
+ Tfn_gtk_print_job_get_surface = function(job: TPGtkPrintJob; error: Pointer): TPcairo_surface_t; cdecl;
+ Tfn_gtk_print_job_send = procedure(job: TPGtkPrintJob; callback: TPGtkPrintJobCompleteFunc; user_data: Pointer; dnotify: TPGDestroyNotify); cdecl;
+ Tfn_gtk_printer_get_default_page_size = function(Printer: TPGtkPrinter): TPGtkPageSetup; cdecl;
+ Tfn_gtk_print_job_get_settings = function(job: TPGtkPrintJob): TPGtkPrintSettings; cdecl;
+ Tfn_gtk_enumerate_printers = procedure(GtkPrinterFunc: TPGtkPrinterFunc; data: Pointer; destroy: TPGDestroyNotify; wait: LongBool ); cdecl;
+ Tfn_gtk_printer_list_papers = function(printer: TPGtkPrinter): TPGList; cdecl;
+ Tfn_gtk_printer_has_details = function(printer: TPGtkPrinter): LongBool; cdecl;
+ Tfn_gtk_printer_request_details = procedure(printer: TPGtkPrinter); cdecl;
+ Tfn_gtk_printer_get_name = function(printer: TPGtkPrinter): PAnsiChar; cdecl;
+ Tfn_gtk_printer_is_default = function(printer: TPGtkPrinter): LongBool; cdecl;
+
+ // Tfn_gtk_print_context_get_page_setup = function(context: TPGtkPrintContext): TPGtkPageSetup;
+
+ Tfn_gtk_print_unix_dialog_new = function(const title: PAnsiChar; parent: TPGtkWidget): TPGtkPrintUnixDialog; cdecl;
+ Tfn_gtk_print_unix_dialog_set_page_setup = procedure(dialog: TPGtkPrintUnixDialog; page_setup: TPGtkPageSetup); cdecl;
+ Tfn_gtk_print_unix_dialog_get_page_setup = function(dialog: TPGtkPrintUnixDialog): TPGtkPageSetup; cdecl;
+ Tfn_gtk_print_unix_dialog_set_settings = procedure(dialog: TPGtkPrintUnixDialog; settings: TPGtkPrintSettings); cdecl;
+ Tfn_gtk_print_unix_dialog_get_settings = function(dialog: TPGtkPrintUnixDialog): TPGtkPrintSettings; cdecl;
+ Tfn_gtk_dialog_run = function(dialog: TPGtkPrintUnixDialog): Integer; cdecl;
+
+ { page_setup }
+ Tfn_gtk_page_setup_new = function: TPGtkPageSetup; cdecl;
+ Tfn_gtk_page_setup_copy = function(other: TPGtkPageSetup): TPGtkPageSetup; cdecl;
+
+ Tfn_gtk_page_setup_get_paper_size = function(setup: TPGtkPageSetup): TPGtkPaperSize; cdecl;
+ Tfn_gtk_page_setup_set_paper_size = procedure(setup: TPGtkPageSetup; size: TPGtkPaperSize); cdecl;
+ Tfn_gtk_page_setup_get_orientation = function(setup: TPGtkPageSetup): TGtkPageOrientation; cdecl;
+ Tfn_gtk_page_setup_set_orientation = procedure(setup: TPGtkPageSetup; orientation: TGtkPageOrientation); cdecl;
+ Tfn_gtk_page_setup_get_top_margin = function(setup: TPGtkPageSetup; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_page_setup_set_top_margin = procedure(setup: TPGtkPageSetup; margin: double; units: TGtkUnit); cdecl;
+ Tfn_gtk_page_setup_get_bottom_margin = function(setup: TPGtkPageSetup; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_page_setup_set_bottom_margin = procedure(setup: TPGtkPageSetup; margin: double; units: TGtkUnit); cdecl;
+ Tfn_gtk_page_setup_get_left_margin = function(setup: TPGtkPageSetup; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_page_setup_set_left_margin = procedure(setup: TPGtkPageSetup; margin: double; units: TGtkUnit); cdecl;
+ Tfn_gtk_page_setup_get_right_margin = function(setup: TPGtkPageSetup; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_page_setup_set_right_margin = procedure(setup: TPGtkPageSetup; margin: double; units: TGtkUnit); cdecl;
+ Tfn_gtk_page_setup_get_paper_width = function(setup: TPGtkPageSetup; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_page_setup_get_paper_height = function(setup: TPGtkPageSetup; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_page_setup_get_page_width = function(setup: TPGtkPageSetup; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_page_setup_get_page_height = function(setup: TPGtkPageSetup; units: TGtkUnit): double; cdecl;
+ { paper_size }
+ Tfn_gtk_paper_size_new = function(const Name: PAnsiChar): TPGtkPaperSize; cdecl;
+ Tfn_gtk_paper_size_new_from_ppd = function(const ppd_name: PAnsiChar; const ppd_display_name: PAnsiChar; width: double; height: double) : TPGtkPaperSize; cdecl;
+ Tfn_gtk_paper_size_new_from_ipp = function(const ipp_name: PAnsiChar; width: double; height: double): TPGtkPaperSize; cdecl;
+ Tfn_gtk_paper_size_new_custom = function(const Name: PAnsiChar; const display_name: PAnsiChar; width: double; height: double; units: TGtkUnit) : TPGtkPaperSize; cdecl;
+ Tfn_gtk_paper_size_copy = function(other: TPGtkPaperSize) : TPGtkPaperSize; cdecl;
+ Tfn_gtk_paper_size_free = procedure(size: TPGtkPaperSize); cdecl;
+ Tfn_gtk_paper_size_is_equal = function(size1: TPGtkPaperSize; size2: TPGtkPaperSize): LongBool; cdecl;
+ // GList *Tfn_gtk_paper_size_get_paper_sizes (gboolean include_custom);
+ Tfn_gtk_paper_size_get_name = function(size: TPGtkPaperSize): PAnsiChar; cdecl;
+ Tfn_gtk_paper_size_get_display_name = function(size: TPGtkPaperSize): PAnsiChar; cdecl;
+ Tfn_gtk_paper_size_get_ppd_name = function(size: TPGtkPaperSize): PAnsiChar; cdecl;
+ Tfn_gtk_paper_size_get_width = function(size: TPGtkPaperSize; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_paper_size_get_height = function(size: TPGtkPaperSize; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_paper_size_is_custom = function(size: TPGtkPaperSize): LongBool; cdecl;
+ Tfn_gtk_paper_size_is_ipp = function(size: TPGtkPaperSize): LongBool; cdecl;
+ Tfn_gtk_paper_size_set_size = procedure(size: TPGtkPaperSize; width: double; height: double; units: TGtkUnit); cdecl;
+ Tfn_gtk_paper_size_get_default_top_margin = function(size: TPGtkPaperSize; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_paper_size_get_default_bottom_margin = function(size: TPGtkPaperSize; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_paper_size_get_default_left_margin = function(size: TPGtkPaperSize; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_paper_size_get_default_right_margin = function(size: TPGtkPaperSize; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_paper_size_get_default = function: PAnsiChar; cdecl;
+ { print_settings }
+ Tfn_gtk_print_settings_new = function: TPGtkPrintSettings; cdecl;
+ Tfn_gtk_print_settings_get_printer = function(settings: TPGtkPrintSettings): PAnsiChar; cdecl;
+ Tfn_gtk_print_settings_set_printer = procedure(settings: TPGtkPrintSettings; const Printer: PAnsiChar); cdecl;
+ Tfn_gtk_print_settings_get_orientation = function(settings: TPGtkPrintSettings): TGtkPageOrientation; cdecl;
+ Tfn_gtk_print_settings_set_orientation = procedure(settings: TPGtkPrintSettings; orientation: TGtkPageOrientation); cdecl;
+ Tfn_gtk_print_settings_get_paper_size = function(settings: TPGtkPrintSettings): TPGtkPaperSize; cdecl;
+ Tfn_gtk_print_settings_set_paper_size = procedure(settings: TPGtkPrintSettings; paper_size: TPGtkPaperSize); cdecl;
+ Tfn_gtk_print_settings_get_paper_width = function(settings: TPGtkPrintSettings; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_print_settings_set_paper_width = procedure(settings: TPGtkPrintSettings; width: double; units: TGtkUnit); cdecl;
+ Tfn_gtk_print_settings_get_paper_height = function(settings: TPGtkPrintSettings; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_print_settings_set_paper_height = procedure(settings: TPGtkPrintSettings; height: double; units: TGtkUnit); cdecl;
+ Tfn_gtk_print_settings_get_collate = function(settings: TPGtkPrintSettings): LongBool; cdecl;
+ Tfn_gtk_print_settings_set_collate = procedure(settings: TPGtkPrintSettings; collate: LongBool); cdecl;
+ Tfn_gtk_print_settings_get_duplex = function(settings: TPGtkPrintSettings): TGtkPrintDuplex; cdecl;
+ Tfn_gtk_print_settings_set_duplex = procedure(settings: TPGtkPrintSettings; duplex: TGtkPrintDuplex); cdecl;
+ Tfn_gtk_print_settings_get_n_copies = function(settings: TPGtkPrintSettings): Integer; cdecl;
+ Tfn_gtk_print_settings_set_n_copies = procedure(settings: TPGtkPrintSettings; num_copies: Integer); cdecl;
+ Tfn_gtk_print_settings_get_resolution_x = function(settings: TPGtkPrintSettings): Integer; cdecl;
+ Tfn_gtk_print_settings_get_resolution_y = function(settings: TPGtkPrintSettings): Integer; cdecl;
+ Tfn_gtk_print_settings_get_default_source = function(settings: TPGtkPrintSettings): PAnsiChar; cdecl;
+ Tfn_gtk_print_settings_set_default_source = procedure(settings: TPGtkPrintSettings; const default_source: PAnsiChar); cdecl;
+ Tfn_gtk_print_settings_get_media_type = function(settings: TPGtkPrintSettings): PAnsiChar; cdecl;
+ Tfn_gtk_print_settings_set_media_type = procedure(settings: TPGtkPrintSettings; const media_type: PAnsiChar); cdecl;
+ Tfn_gtk_print_settings_get_output_bin = function(settings: TPGtkPrintSettings): PAnsiChar; cdecl;
+ Tfn_gtk_print_settings_set_output_bin = procedure(settings: TPGtkPrintSettings; output_bin: PAnsiChar); cdecl;
+
+const
+ PAPERCOUNT = 66;
+ PaperInfo: array[0..PAPERCOUNT - 1] of TPaperInfo = (
+ (Typ:1; Name: ''; X:2159; Y:2794),
+ (Typ:2; Name: ''; X:2159; Y:2794),
+ (Typ:3; Name: ''; X:2794; Y:4318),
+ (Typ:4; Name: ''; X:4318; Y:2794),
+ (Typ:5; Name: ''; X:2159; Y:3556),
+ (Typ:6; Name: ''; X:1397; Y:2159),
+ (Typ:7; Name: ''; X:1842; Y:2667),
+ (Typ:8; Name: ''; X:2970; Y:4200),
+ (Typ:9; Name: ''; X:2100; Y:2970),
+ (Typ:10; Name: ''; X:2100; Y:2970),
+ (Typ:11; Name: ''; X:1480; Y:2100),
+ (Typ:12; Name: ''; X:2500; Y:3540),
+ (Typ:13; Name: ''; X:1820; Y:2570),
+ (Typ:14; Name: ''; X:2159; Y:3302),
+ (Typ:15; Name: ''; X:2150; Y:2750),
+ (Typ:16; Name: ''; X:2540; Y:3556),
+ (Typ:17; Name: ''; X:2794; Y:4318),
+ (Typ:18; Name: ''; X:2159; Y:2794),
+ (Typ:19; Name: ''; X:984; Y:2254),
+ (Typ:20; Name: ''; X:1048; Y:2413),
+ (Typ:21; Name: ''; X:1143; Y:2635),
+ (Typ:22; Name: ''; X:1207; Y:2794),
+ (Typ:23; Name: ''; X:1270; Y:2921),
+ (Typ:24; Name: ''; X:4318; Y:5588),
+ (Typ:25; Name: ''; X:5588; Y:8636),
+ (Typ:26; Name: ''; X:8636; Y:11176),
+ (Typ:27; Name: ''; X:1100; Y:2200),
+ (Typ:28; Name: ''; X:1620; Y:2290),
+ (Typ:29; Name: ''; X:3240; Y:4580),
+ (Typ:30; Name: ''; X:2290; Y:3240),
+ (Typ:31; Name: ''; X:1140; Y:1620),
+ (Typ:32; Name: ''; X:1140; Y:2290),
+ (Typ:33; Name: ''; X:2500; Y:3530),
+ (Typ:34; Name: ''; X:1760; Y:2500),
+ (Typ:35; Name: ''; X:1760; Y:1250),
+ (Typ:36; Name: ''; X:1100; Y:2300),
+ (Typ:37; Name: ''; X:984; Y:1905),
+ (Typ:38; Name: ''; X:920; Y:1651),
+ (Typ:39; Name: ''; X:3778; Y:2794),
+ (Typ:40; Name: ''; X:2159; Y:3048),
+ (Typ:41; Name: ''; X:2159; Y:3302),
+ (Typ:42; Name: ''; X:2500; Y:3530),
+ (Typ:43; Name: ''; X:1000; Y:1480),
+ (Typ:44; Name: ''; X:2286; Y:2794),
+ (Typ:45; Name: ''; X:2540; Y:2794),
+ (Typ:46; Name: ''; X:3810; Y:2794),
+ (Typ:47; Name: ''; X:2200; Y:2200),
+ (Typ:50; Name: ''; X:2355; Y:3048),
+ (Typ:51; Name: ''; X:2355; Y:3810),
+ (Typ:52; Name: ''; X:2969; Y:4572),
+ (Typ:53; Name: ''; X:2354; Y:3223),
+ (Typ:54; Name: ''; X:2101; Y:2794),
+ (Typ:55; Name: ''; X:2100; Y:2970),
+ (Typ:56; Name: ''; X:2355; Y:3048),
+ (Typ:57; Name: ''; X:2270; Y:3560),
+ (Typ:58; Name: ''; X:3050; Y:4870),
+ (Typ:59; Name: ''; X:2159; Y:3223),
+ (Typ:60; Name: ''; X:2100; Y:3300),
+ (Typ:61; Name: ''; X:1480; Y:2100),
+ (Typ:62; Name: ''; X:1820; Y:2570),
+ (Typ:63; Name: ''; X:3220; Y:4450),
+ (Typ:64; Name: ''; X:1740; Y:2350),
+ (Typ:65; Name: ''; X:2010; Y:2760),
+ (Typ:66; Name: ''; X:4200; Y:5940),
+ (Typ:67; Name: ''; X:2970; Y:4200),
+ (Typ:68; Name: ''; X:3220; Y:4450));
+
+type
+ TPaperInfoLCL = {packed} record
+ Name: String;
+ W, H: Extended;
+ end;
+
+ TfrxInfoLinkData = packed record
+ Num : Integer;
+ Name: AnsiString;
+ end;
+
+const
+ LCLPaperCount = 119;
+ CmPrIn = 2.54;
+ PtPrCm = frxDefPPIUnits/CmPrIn;
+ PtPrmm = PtPrCm/10;
+ LCLPaperInfo : array[0..LCLPAPERCOUNT-1] of TPaperInfoLCL =
+ ((Name: 'Letter 8 1/2 x 11 in'; W: 8.5 * frxDefPPIUnits; H: 11 * frxDefPPIUnits),
+ (Name: 'Letter Small 8 1/2 x 11 in'; W: 8.5 * frxDefPPIUnits; H: 11 * frxDefPPIUnits),
+ (Name: 'Tabloid 11 x 17 in'; W: 11 * frxDefPPIUnits; H: 17 * frxDefPPIUnits),
+ (Name: 'Ledger 17 x 11 in'; W: 17 * frxDefPPIUnits; H: 11 * frxDefPPIUnits),
+ (Name: 'Legal 8 1/2 x 14 in'; W: 8.5 * frxDefPPIUnits; H: 14 * frxDefPPIUnits),
+ (Name: 'Statement 5 1/2 x 8 1/2 in'; W: 5.5 * frxDefPPIUnits; H: 8.5 * frxDefPPIUnits),
+ (Name: 'Executive 7 1/4 x 10 1/2 in'; W: 7.25 * frxDefPPIUnits; H: 10.5 * frxDefPPIUnits),
+ (Name: 'A3 297 x 420 mm'; W: 297 * PtPrmm; H: 420 * PtPrmm),
+ (Name: 'A4 210 x 297 mm'; W: 210 * PtPrmm; H: 297 * PtPrmm),
+ (Name: 'A4 Small 210 x 297 mm'; W: 210 * PtPrmm; H: 297 * PtPrmm),
+ (Name: 'A5 148 x 210 mm'; W: 148 * PtPrmm; H: 210 * PtPrmm),
+ (Name: 'B4 (JIS) 250 x 354 mm'; W: 250 * PtPrmm; H: 354 * PtPrmm),
+ (Name: 'B5 (JIS) 182 x 257 mm'; W: 182 * PtPrmm; H: 257 * PtPrmm),
+ (Name: 'Folio 8 1/2 x 13 in'; W: 8.5 * frxDefPPIUnits; H: 13 * frxDefPPIUnits),
+ (Name: 'Quarto 215 x 275 mm'; W: 215 * PtPrmm; H: 275 * PtPrmm),
+ (Name: '10x14 in'; W: 10 * frxDefPPIUnits; H: 14 * frxDefPPIUnits),
+ (Name: '11x17 in'; W: 11 * frxDefPPIUnits; H: 17 * frxDefPPIUnits),
+ (Name: 'Note 8 1/2 x 11 in'; W: 8.5 * frxDefPPIUnits; H: 11 * frxDefPPIUnits),
+ (Name: 'Envelope #9 3 7/8 x 8 7/8'; W: 3 * 7 / 8 * frxDefPPIUnits; H: 8 * 7 / 8 * frxDefPPIUnits),
+ (Name: 'Envelope #10 4 1/8 x 9 1/2'; W: 3 * 1 / 8 * frxDefPPIUnits; H: 9.5 * frxDefPPIUnits),
+ (Name: 'Envelope #11 4 1/2 x 10 3/8'; W: 4.5 * frxDefPPIUnits; H: 10 * 3 / 8 * frxDefPPIUnits),
+ (Name: 'Envelope #12 4 3/4 x 11'; W: 4.75 * frxDefPPIUnits; H: 11 * frxDefPPIUnits),
+ (Name: 'Envelope #14 5 x 11 1/2'; W: 5 * frxDefPPIUnits; H: 11.5 * frxDefPPIUnits),
+ (Name: 'C size sheet 17 x 22 in'; W: 17 * frxDefPPIUnits; H: 22 * frxDefPPIUnits),
+ (Name: 'D size sheet 22 x 34 in'; W: 22 * frxDefPPIUnits; H: 34 * frxDefPPIUnits),
+ (Name: 'E size sheet 34 x 44 in'; W: 34 * frxDefPPIUnits; H: 44 * frxDefPPIUnits),
+ (Name: 'Envelope DL 110 x 220mm'; W: 110 * PtPrmm; H: 220 * PtPrmm),
+ (Name: 'Envelope C5 162 x 229 mm'; W: 162 * PtPrmm; H: 229 * PtPrmm),
+ (Name: 'Envelope C3 324 x 458 mm'; W: 324 * PtPrmm; H: 458 * PtPrmm),
+ (Name: 'Envelope C4 229 x 324 mm'; W: 229 * PtPrmm; H: 324 * PtPrmm),
+ (Name: 'Envelope C6 114 x 162 mm'; W: 114 * PtPrmm; H: 162 * PtPrmm),
+ (Name: 'Envelope C65 114 x 229 mm'; W: 114 * PtPrmm; H: 229 * PtPrmm),
+ (Name: 'Envelope B4 250 x 353 mm'; W: 250 * PtPrmm; H: 353 * PtPrmm),
+ (Name: 'Envelope B5 176 x 250 mm'; W: 176 * PtPrmm; H: 250 * PtPrmm),
+ (Name: 'Envelope B6 176 x 125 mm'; W: 176 * PtPrmm; H: 125 * PtPrmm),
+ (Name: 'Envelope 110 x 230 mm'; W: 110 * PtPrmm; H: 230 * PtPrmm),
+ (Name: 'Envelope Monarch 3 7/8 x 7 1/2 in'; W: 3 * 7 / 8 * frxDefPPIUnits; H: 7.5 * frxDefPPIUnits),
+ (Name: '6 34 Envelope 3 5/8 x 6 1/2 in'; W: 3 * 5 / 8 * frxDefPPIUnits; H: 6.5 * frxDefPPIUnits),
+ (Name: 'US Std Fanfold 14 7/8 x 11 in'; W: 14 * 7 / 8 * frxDefPPIUnits; H: 11 * frxDefPPIUnits),
+ (Name: 'German Std Fanfold 8 1/2 x 12 in'; W: 8.5 * frxDefPPIUnits; H: 12 * frxDefPPIUnits),
+ (Name: 'German Legal Fanfold 8 1/2 x 13 in'; W: 8.5 * frxDefPPIUnits; H: 13 * frxDefPPIUnits),
+ (Name: 'B4 (ISO) 250 x 353 mm'; W: 250 * PtPrmm; H: 353 * PtPrmm),
+ (Name: 'Japanese Postcard 100 x 148 mm'; W: 100 * PtPrmm; H: 148 * PtPrmm),
+ (Name: '9 x 11 in'; W: 9 * frxDefPPIUnits; H: 11 * frxDefPPIUnits),
+ (Name: '10 x 11 in'; W: 10 * frxDefPPIUnits; H: 11 * frxDefPPIUnits),
+ (Name: '15 x 11 in'; W: 15 * frxDefPPIUnits; H: 11 * frxDefPPIUnits),
+ (Name: 'Envelope Invite 220 x 220 mm'; W: 220 * PtPrmm; H: 220 * PtPrmm),
+ (Name: 'RESERVED--DO NOT USE'; W: 0; H: 0),
+ (Name: 'RESERVED--DO NOT USE'; W: 0; H: 0),
+ (Name: 'Letter Extra 9 \275 x 12 in'; W: 9.275 * frxDefPPIUnits; H: 12 * frxDefPPIUnits),
+ (Name: 'Legal Extra 9 \275 x 15 in'; W: 9.275 * frxDefPPIUnits; H: 15 * frxDefPPIUnits),
+ (Name: 'Tabloid Extra 11.69 x 18 in'; W: 11.69 * frxDefPPIUnits; H: 18 * frxDefPPIUnits),
+ (Name: 'A4 Extra 9.27 x 12.69 in'; W: 9.27 * frxDefPPIUnits; H: 12.69 * frxDefPPIUnits),
+ (Name: 'Letter Transverse 8 \275 x 11 in'; W: 8.275 * frxDefPPIUnits; H: 11 * frxDefPPIUnits),
+ (Name: 'A4 Transverse 210 x 297 mm'; W: 210 * PtPrmm; H: 297 * PtPrmm),
+ (Name: 'Letter Extra Transverse 9\275 x 12 in'; W: 9.275 * frxDefPPIUnits; H: 12 * frxDefPPIUnits),
+ (Name: 'SuperASuperAA4 227 x 356 mm'; W: 227 * PtPrmm; H: 356 * PtPrmm),
+ (Name: 'SuperBSuperBA3 305 x 487 mm'; W: 305 * PtPrmm; H: 487 * PtPrmm),
+ (Name: 'Letter Plus 8.5 x 12.69 in'; W: 8.5 * frxDefPPIUnits; H: 12.69 * frxDefPPIUnits),
+ (Name: 'A4 Plus 210 x 330 mm'; W: 210 * PtPrmm; H: 330 * PtPrmm),
+ (Name: 'A5 Transverse 148 x 210 mm'; W: 148 * PtPrmm; H: 210 * PtPrmm),
+ (Name: 'B5 (JIS) Transverse 182 x 257 mm'; W: 182 * PtPrmm; H: 257 * PtPrmm),
+ (Name: 'A3 Extra 322 x 445 mm'; W: 322 * PtPrmm; H: 445 * PtPrmm),
+ (Name: 'A5 Extra 174 x 235 mm'; W: 174 * PtPrmm; H: 235 * PtPrmm),
+ (Name: 'B5 (ISO) Extra 201 x 276 mm'; W: 201 * PtPrmm; H: 276 * PtPrmm),
+ (Name: 'A2 420 x 594 mm'; W: 420 * PtPrmm; H: 594 * PtPrmm),
+ (Name: 'A3 Transverse 297 x 420 mm'; W: 297 * PtPrmm; H: 420 * PtPrmm),
+ (Name: 'A3 Extra Transverse 322 x 445 mm'; W: 322 * PtPrmm; H: 445 * PtPrmm),
+ (Name: 'Japanese Double Postcard 200 x 148 mm'; W: 200 * PtPrmm; H: 148 * PtPrmm),
+ (Name: 'A6 105 x 148 mm'; W: 105 * PtPrmm; H: 148 * PtPrmm),
+ (Name: 'Japanese Envelope Kaku #2'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Kaku #3'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Chou #3'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Chou #4'; W: 0; H: 0),
+ (Name: 'Letter Rotated 11 x 8 1/2 11 in'; W: 11 * frxDefPPIUnits; H: 8.5 * frxDefPPIUnits),
+ (Name: 'A3 Rotated 420 x 297 mm'; W: 420 * PtPrmm; H: 297 * PtPrmm),
+ (Name: 'A4 Rotated 297 x 210 mm'; W: 297 * PtPrmm; H: 210 * PtPrmm),
+ (Name: 'A5 Rotated 210 x 148 mm'; W: 210 * PtPrmm; H: 148 * PtPrmm),
+ (Name: 'B4 (JIS) Rotated 364 x 257 mm'; W: 364 * PtPrmm; H: 257 * PtPrmm),
+ (Name: 'B5 (JIS) Rotated 257 x 182 mm'; W: 257 * PtPrmm; H: 182 * PtPrmm),
+ (Name: 'Japanese Postcard Rotated 148 x 100 mm'; W: 148 * PtPrmm; H: 100 * PtPrmm),
+ (Name: 'Double Japanese Postcard Rotated 148 x 200 mm'; W: 148 * PtPrmm; H: 200 * PtPrmm),
+ (Name: 'A6 Rotated 148 x 105 mm'; W: 148 * PtPrmm; H: 105 * PtPrmm),
+ (Name: 'Japanese Envelope Kaku #2 Rotated'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Kaku #3 Rotated'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Chou #3 Rotated'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Chou #4 Rotated'; W: 0; H: 0),
+ (Name: 'B6 (JIS) 128 x 182 mm'; W: 128 * PtPrmm; H: 182 * PtPrmm),
+ (Name: 'B6 (JIS) Rotated 182 x 128 mm'; W: 182 * PtPrmm; H: 128 * PtPrmm),
+ (Name: '12 x 11 in'; W: 12 * frxDefPPIUnits; H: 11 * frxDefPPIUnits),
+ (Name: 'Japanese Envelope You #4'; W: 0; H: 0),
+ (Name: 'Japanese Envelope You #4 Rotated'; W: 0; H: 0),
+ (Name: 'PRC 16K 146 x 215 mm'; W: 146 * PtPrmm; H: 215 * PtPrmm),
+ (Name: 'PRC 32K 97 x 151 mm'; W: 97 * PtPrmm; H: 151 * PtPrmm),
+ (Name: 'PRC 32K(Big) 97 x 151 mm'; W: 97 * PtPrmm; H: 151 * PtPrmm),
+ (Name: 'PRC Envelope #1 102 x 165 mm'; W: 102 * PtPrmm; H: 165 * PtPrmm),
+ (Name: 'PRC Envelope #2 102 x 176 mm'; W: 102 * PtPrmm; H: 176 * PtPrmm),
+ (Name: 'PRC Envelope #3 125 x 176 mm'; W: 125 * PtPrmm; H: 176 * PtPrmm),
+ (Name: 'PRC Envelope #4 110 x 208 mm'; W: 110 * PtPrmm; H: 208 * PtPrmm),
+ (Name: 'PRC Envelope #5 110 x 220 mm'; W: 110 * PtPrmm; H: 220 * PtPrmm),
+ (Name: 'PRC Envelope #6 120 x 230 mm'; W: 120 * PtPrmm; H: 230 * PtPrmm),
+ (Name: 'PRC Envelope #7 160 x 230 mm'; W: 160 * PtPrmm; H: 230 * PtPrmm),
+ (Name: 'PRC Envelope #8 120 x 309 mm'; W: 120 * PtPrmm; H: 309 * PtPrmm),
+ (Name: 'PRC Envelope #9 229 x 324 mm'; W: 229 * PtPrmm; H: 324 * PtPrmm),
+ (Name: 'PRC Envelope #10 324 x 458 mm'; W: 324 * PtPrmm; H: 458 * PtPrmm),
+ (Name: 'PRC 16K Rotated 215 x 146 mm'; W: 215 * PtPrmm; H: 146 * PtPrmm),
+ (Name: 'PRC 32K Rotated 151 x 97 mm'; W: 151 * PtPrmm; H: 97 * PtPrmm),
+ (Name: 'PRC 32K(Big) Rotated 151 x 97 mm'; W: 151 * PtPrmm; H: 97 * PtPrmm),
+ (Name: 'PRC Envelope #1 Rotated 165 x 102 mm'; W: 165 * PtPrmm; H: 102 * PtPrmm),
+ (Name: 'PRC Envelope #2 Rotated 176 x 102 mm'; W: 176 * PtPrmm; H: 102 * PtPrmm),
+ (Name: 'PRC Envelope #3 Rotated 176 x 125 mm'; W: 176 * PtPrmm; H: 125 * PtPrmm),
+ (Name: 'PRC Envelope #4 Rotated 208 x 110 mm'; W: 208 * PtPrmm; H: 110 * PtPrmm),
+ (Name: 'PRC Envelope #5 Rotated 220 x 110 mm'; W: 220 * PtPrmm; H: 110 * PtPrmm),
+ (Name: 'PRC Envelope #6 Rotated 230 x 120 mm'; W: 230 * PtPrmm; H: 120 * PtPrmm),
+ (Name: 'PRC Envelope #7 Rotated 230 x 160 mm'; W: 230 * PtPrmm; H: 160 * PtPrmm),
+ (Name: 'PRC Envelope #8 Rotated 309 x 120 mm'; W: 309 * PtPrmm; H: 120 * PtPrmm),
+ (Name: 'PRC Envelope #9 Rotated 324 x 229 mm'; W: 324 * PtPrmm; H: 229 * PtPrmm),
+ (Name: 'PRC Envelope #10 Rotated 458 x 324 mm'; W: 458 * PtPrmm; H: 324 * PtPrmm),
+ (Name: 'Custom size'; W: 0; H: 0));
+
+ DefGtkPapersCount = 63;
+ GTKPapers: array[0 .. DefGtkPapersCount - 1] of TfrxInfoLinkData = (
+ (Num: DMPAPER_USER; Name: ''),
+ (Num: FRX_DMPAPER_LETTER_TRANSVERSE; Name: 'na_letter'),
+ (Num: FRX_DMPAPER_LETTER; Name: 'na_letter'),
+ (Num: FRX_DMPAPER_LETTERSMALL; Name: 'na_letter'),
+ (Num: FRX_DMPAPER_TABLOID; Name: 'na_ledger'),
+ (Num: FRX_DMPAPER_LEDGER; Name: 'na_ledger'),
+ (Num: FRX_DMPAPER_LEGAL; Name: 'na_legal'),
+ (Num: FRX_DMPAPER_STATEMENT; Name: 'na_invoice'),
+ (Num: FRX_DMPAPER_EXECUTIVE; Name: 'na_executive'),
+ (Num: FRX_DMPAPER_A3; Name: 'iso_a3'),
+ (Num: FRX_DMPAPER_A3_TRANSVERSE; Name: 'iso_a3'),
+ (Num: FRX_DMPAPER_A4; Name: 'iso_a4'),
+ (Num: FRX_DMPAPER_A4SMALL; Name: 'iso_a4'),
+ (Num: FRX_DMPAPER_A4_TRANSVERSE; Name: 'iso_a4'),
+ (Num: FRX_DMPAPER_A5; Name: 'iso_a5'),
+ (Num: FRX_DMPAPER_A5_TRANSVERSE; Name: 'iso_a5'),
+ (Num: FRX_DMPAPER_B4; Name: 'jis_b4'),
+ (Num: FRX_DMPAPER_B5; Name: 'jis_b5'),
+ (Num: FRX_DMPAPER_B5_TRANSVERSE; Name: 'jis_b5'),
+ (Num: FRX_DMPAPER_QUARTO; Name: 'na_quarto'),
+ (Num: FRX_DMPAPER_10X14; Name: 'na_10x14'),
+ (Num: FRX_DMPAPER_11X17; Name: 'na_ledger'),
+ (Num: FRX_DMPAPER_NOTE; Name: 'na_letter'),
+ (Num: FRX_DMPAPER_ENV_9; Name: 'na_number-9'),
+ (Num: FRX_DMPAPER_ENV_10; Name: 'na_number-10'),
+ (Num: FRX_DMPAPER_ENV_11; Name: 'na_number-11'),
+ (Num: FRX_DMPAPER_ENV_12; Name: 'na_number-12'),
+ (Num: FRX_DMPAPER_ENV_14; Name: 'na_number-14'),
+ (Num: FRX_DMPAPER_CSHEET; Name: 'na_c'),
+ (Num: FRX_DMPAPER_DSHEET; Name: 'na_d'),
+ (Num: FRX_DMPAPER_ESHEET; Name: 'na_e'),
+ (Num: FRX_DMPAPER_ENV_DL; Name: 'iso_dl'),
+ (Num: FRX_DMPAPER_ENV_C5; Name: 'iso_c5'),
+ (Num: FRX_DMPAPER_ENV_C3; Name: 'iso_c3'),
+ (Num: FRX_DMPAPER_ENV_C4; Name: 'iso_c4'),
+ (Num: FRX_DMPAPER_ENV_C6; Name: 'iso_c6'),
+ (Num: FRX_DMPAPER_ENV_C65; Name: 'iso_c6c5'),
+ (Num: FRX_DMPAPER_ENV_B4; Name: 'iso_b4'),
+ (Num: FRX_DMPAPER_ENV_B5; Name: 'iso_b5'),
+ (Num: FRX_DMPAPER_ENV_B6; Name: 'iso_b6'),
+ (Num: FRX_DMPAPER_ENV_ITALY; Name: 'om_italian'),
+ (Num: FRX_DMPAPER_ENV_MONARCH; Name: 'na_monarch'),
+ (Num: FRX_DMPAPER_ENV_PERSONAL; Name: 'na_personal'),
+ (Num: FRX_DMPAPER_FANFOLD_US; Name: 'na_fanfold-us'),
+ (Num: FRX_DMPAPER_FANFOLD_STD_GERMAN; Name: 'na_fanfold-eur'),
+ (Num: FRX_DMPAPER_FANFOLD_LGL_GERMAN; Name: 'na_foolscap'),
+ (Num: FRX_DMPAPER_ISO_B4; Name: 'iso_b4'),
+ (Num: FRX_DMPAPER_JAPANESE_POSTCARD; Name: 'jpn_hagaki'),
+ (Num: FRX_DMPAPER_9X11; Name: 'na_9x11'),
+ (Num: FRX_DMPAPER_10X11; Name: 'na_10x11'),
+ (Num: FRX_DMPAPER_ENV_INVITE; Name: 'om_invite'),
+ (Num: FRX_DMPAPER_LETTER_EXTRA; Name: 'na_letter-extra'),
+ (Num: FRX_DMPAPER_LETTER_EXTRA_TRANSVERSE; Name: 'na_letter-extra'),
+ (Num: FRX_DMPAPER_LEGAL_EXTRA; Name: 'na_legal-extra'),
+ (Num: FRX_DMPAPER_TABLOID_EXTRA; Name: 'na_arch'),
+ (Num: FRX_DMPAPER_A4_EXTRA; Name: 'iso_a4-extra'),
+ (Num: FRX_DMPAPER_B_PLUS; Name: 'na_b-plus'),
+ (Num: FRX_DMPAPER_LETTER_PLUS; Name: 'na_letter-plus'),
+ (Num: FRX_DMPAPER_A3_EXTRA; Name: 'iso_a3-extra'),
+ (Num: FRX_DMPAPER_A3_EXTRA_TRANSVERSE; Name: 'iso_a3-extra'),
+ (Num: FRX_DMPAPER_A5_EXTRA; Name: 'iso_a5-extra'),
+ (Num: FRX_DMPAPER_B5_EXTRA; Name: 'iso_b5-extra'),
+ (Num: FRX_DMPAPER_A2; Name: 'iso_a2'));
+
+ DefGtkBinsCount = 13;
+ GTKBins: array[0 .. DefGtkBinsCount - 1] of TfrxInfoLinkData = (
+ (Num: FRX_DMBIN_AUTO; Name: 'auto'),
+ (Num: FRX_DMBIN_CASSETTE; Name: 'cassette'),
+ (Num: FRX_DMBIN_ENVELOPE; Name: 'envelope'),
+ (Num: FRX_DMBIN_ENVMANUAL; Name: 'envelope-manual'),
+ (Num: FRX_DMBIN_LOWER; Name: 'lower'),
+ (Num: FRX_DMBIN_MANUAL; Name: 'manual'),
+ (Num: FRX_DMBIN_MIDDLE; Name: 'middle'),
+ (Num: FRX_DMBIN_ONLYONE; Name: 'only-one'),
+ (Num: FRX_DMBIN_FORMSOURCE; Name: 'form-source'),
+ (Num: FRX_DMBIN_LARGECAPACITY; Name: 'large-capacity'),
+ (Num: FRX_DMBIN_LARGEFMT; Name: 'large-format'),
+ (Num: FRX_DMBIN_TRACTOR; Name: 'tractor'),
+ (Num: FRX_DMBIN_SMALLFMT; Name: 'small-format'));
+
+var
+ cairo_surface_finish: Tfn_cairo_surface_finish;
+ cairo_create: Tfn_cairo_create;
+ cairo_destroy: Tfn_cairo_destroy;
+ cairo_show_page: Tfn_cairo_show_page;
+
+ cairo_surface_get_type: Tfn_cairo_surface_get_type;
+ cairo_ps_surface_set_size: Tfn_cairo_ps_surface_set_size;
+ cairo_ps_surface_dsc_begin_setup: Tfn_cairo_ps_surface_dsc_begin_setup;
+ cairo_ps_surface_dsc_begin_page_setup: Tfn_cairo_ps_surface_dsc_begin_page_setup;
+ cairo_ps_surface_dsc_comment: Tfn_cairo_ps_surface_dsc_comment;
+ cairo_pdf_surface_set_size: Tfn_cairo_pdf_surface_set_size;
+
+ g_free: Tfn_g_free;
+ g_list_free: Tfn_g_list_free;
+
+ g_signal_connect_data: Tfn_g_signal_connect_data;
+ g_object_unref: Tfn_g_object_unref;
+ g_object_ref: Tfn_g_object_ref;
+ gtk_print_job_new: Tfn_gtk_print_job_new;
+ gtk_print_job_get_surface: Tfn_gtk_print_job_get_surface;
+ gtk_print_job_send: Tfn_gtk_print_job_send;
+ gtk_printer_get_default_page_size: Tfn_gtk_printer_get_default_page_size;
+ gtk_print_job_get_settings: Tfn_gtk_print_job_get_settings;
+ gtk_enumerate_printers: Tfn_gtk_enumerate_printers;
+ gtk_printer_list_papers: Tfn_gtk_printer_list_papers;
+ gtk_printer_has_details: Tfn_gtk_printer_has_details;
+ gtk_printer_request_details: Tfn_gtk_printer_request_details;
+ gtk_printer_get_name: Tfn_gtk_printer_get_name;
+ gtk_printer_is_default: Tfn_gtk_printer_is_default;
+
+ gtk_print_unix_dialog_new: Tfn_gtk_print_unix_dialog_new;
+ gtk_print_unix_dialog_set_page_setup: Tfn_gtk_print_unix_dialog_set_page_setup;
+ gtk_print_unix_dialog_get_page_setup: Tfn_gtk_print_unix_dialog_get_page_setup;
+ gtk_print_unix_dialog_set_settings: Tfn_gtk_print_unix_dialog_set_settings;
+ gtk_print_unix_dialog_get_settings: Tfn_gtk_print_unix_dialog_get_settings;
+ gtk_dialog_run: Tfn_gtk_dialog_run;
+
+ { page_setup }
+ gtk_page_setup_new: Tfn_gtk_page_setup_new;
+ gtk_page_setup_copy: Tfn_gtk_page_setup_copy;
+ gtk_page_setup_get_paper_size: Tfn_gtk_page_setup_get_paper_size;
+ gtk_page_setup_set_paper_size: Tfn_gtk_page_setup_set_paper_size;
+ gtk_page_setup_get_orientation: Tfn_gtk_page_setup_get_orientation;
+ gtk_page_setup_set_orientation: Tfn_gtk_page_setup_set_orientation;
+ gtk_page_setup_get_top_margin: Tfn_gtk_page_setup_get_top_margin;
+ gtk_page_setup_set_top_margin: Tfn_gtk_page_setup_set_top_margin;
+ gtk_page_setup_get_bottom_margin: Tfn_gtk_page_setup_get_bottom_margin;
+ gtk_page_setup_set_bottom_margin: Tfn_gtk_page_setup_set_bottom_margin;
+ gtk_page_setup_get_left_margin: Tfn_gtk_page_setup_get_left_margin;
+ gtk_page_setup_set_left_margin: Tfn_gtk_page_setup_set_left_margin;
+ gtk_page_setup_get_right_margin: Tfn_gtk_page_setup_get_right_margin;
+ gtk_page_setup_set_right_margin: Tfn_gtk_page_setup_set_right_margin;
+ gtk_page_setup_get_paper_width: Tfn_gtk_page_setup_get_paper_width;
+ gtk_page_setup_get_paper_height: Tfn_gtk_page_setup_get_paper_height;
+ gtk_page_setup_get_page_width: Tfn_gtk_page_setup_get_page_width;
+ gtk_page_setup_get_page_height: Tfn_gtk_page_setup_get_page_height;
+ { paper_size }
+ gtk_paper_size_new: Tfn_gtk_paper_size_new;
+ gtk_paper_size_new_from_ppd: Tfn_gtk_paper_size_new_from_ppd;
+ gtk_paper_size_new_from_ipp: Tfn_gtk_paper_size_new_from_ipp;
+ gtk_paper_size_new_custom: Tfn_gtk_paper_size_new_custom;
+ gtk_paper_size_copy: Tfn_gtk_paper_size_copy;
+ gtk_paper_size_free: Tfn_gtk_paper_size_free;
+ gtk_paper_size_is_equal: Tfn_gtk_paper_size_is_equal;
+ //GList *Tfn_gtk_paper_size_get_paper_sizes (gboolean include_custom);
+ gtk_paper_size_get_name: Tfn_gtk_paper_size_get_name;
+ gtk_paper_size_get_display_name: Tfn_gtk_paper_size_get_display_name;
+ gtk_paper_size_get_ppd_name: Tfn_gtk_paper_size_get_ppd_name;
+ gtk_paper_size_get_width: Tfn_gtk_paper_size_get_width;
+ gtk_paper_size_get_height: Tfn_gtk_paper_size_get_height;
+ gtk_paper_size_is_custom: Tfn_gtk_paper_size_is_custom;
+ gtk_paper_size_is_ipp: Tfn_gtk_paper_size_is_ipp;
+ gtk_paper_size_set_size: Tfn_gtk_paper_size_set_size;
+ gtk_paper_size_get_default_top_margin: Tfn_gtk_paper_size_get_default_top_margin;
+ gtk_paper_size_get_default_bottom_margin: Tfn_gtk_paper_size_get_default_bottom_margin;
+ gtk_paper_size_get_default_left_margin: Tfn_gtk_paper_size_get_default_left_margin;
+ gtk_paper_size_get_default_right_margin: Tfn_gtk_paper_size_get_default_right_margin;
+ gtk_paper_size_get_default: Tfn_gtk_paper_size_get_default;
+ { print_settings }
+ gtk_print_settings_new: Tfn_gtk_print_settings_new;
+ gtk_print_settings_get_printer: Tfn_gtk_print_settings_get_printer;
+ gtk_print_settings_set_printer: Tfn_gtk_print_settings_set_printer;
+ gtk_print_settings_get_orientation: Tfn_gtk_print_settings_get_orientation;
+ gtk_print_settings_set_orientation: Tfn_gtk_print_settings_set_orientation;
+ gtk_print_settings_get_paper_size: Tfn_gtk_print_settings_get_paper_size;
+ gtk_print_settings_set_paper_size: Tfn_gtk_print_settings_set_paper_size;
+ gtk_print_settings_get_paper_width: Tfn_gtk_print_settings_get_paper_width;
+ gtk_print_settings_set_paper_width: Tfn_gtk_print_settings_set_paper_width;
+ gtk_print_settings_get_paper_height: Tfn_gtk_print_settings_get_paper_height;
+ gtk_print_settings_set_paper_height: Tfn_gtk_print_settings_set_paper_height;
+ gtk_print_settings_get_collate: Tfn_gtk_print_settings_get_collate;
+ gtk_print_settings_set_collate: Tfn_gtk_print_settings_set_collate;
+ gtk_print_settings_get_duplex: Tfn_gtk_print_settings_get_duplex;
+ gtk_print_settings_set_duplex: Tfn_gtk_print_settings_set_duplex;
+ gtk_print_settings_get_n_copies: Tfn_gtk_print_settings_get_n_copies;
+ gtk_print_settings_set_n_copies: Tfn_gtk_print_settings_set_n_copies;
+ gtk_print_settings_get_resolution_x: Tfn_gtk_print_settings_get_resolution_x;
+ gtk_print_settings_get_resolution_y: Tfn_gtk_print_settings_get_resolution_y;
+ gtk_print_settings_get_default_source: Tfn_gtk_print_settings_get_default_source;
+ gtk_print_settings_set_default_source: Tfn_gtk_print_settings_set_default_source;
+ gtk_print_settings_get_media_type: Tfn_gtk_print_settings_get_media_type;
+ gtk_print_settings_set_media_type: Tfn_gtk_print_settings_set_media_type;
+ gtk_print_settings_get_output_bin: Tfn_gtk_print_settings_get_output_bin;
+ gtk_print_settings_set_output_bin: Tfn_gtk_print_settings_set_output_bin;
+
+
+function frxGtkOrientationToFMX(Orientation: TGtkPageOrientation): TPrinterOrientation; inline;
+begin
+ Result := TPrinterOrientation(Byte(Orientation) div 2);
+end;
+
+function frxFMXOrientationToGtk(Orientation: TPrinterOrientation): TGtkPageOrientation;
+begin
+ Result := TGtkPageOrientation(Byte(Orientation));
+end;
+
+function GtkInfoNameFromConst(const InfoArr: array of TfrxInfoLinkData; const aConst: Integer): AnsiString;
+var
+ i: Integer;
+begin
+ Result := '';
+ for I := Low(InfoArr) to High(InfoArr) do
+ if InfoArr[i].Num = aConst then
+ begin
+ Result := InfoArr[i].Name;
+ break;
+ end;
+end;
+
+function InfoConstFromGtkName(const InfoArr: array of TfrxInfoLinkData; const Name: AnsiString): Integer;
+var
+ i: Integer;
+begin
+ Result := InfoArr[0].Num;
+ for I := Low(InfoArr) to High(InfoArr) do
+ if SameText(InfoArr[i].Name, Name) then
+ begin
+ Result := InfoArr[i].Num;
+ break;
+ end;
+end;
+
+function GtkPaperNameFromConst(PaperConst: Integer): AnsiString;
+begin
+ Result := GtkInfoNameFromConst(GTKPapers, PaperConst);
+end;
+
+function GtkBinNameFromConst(PaperConst: Integer): AnsiString;
+begin
+ Result := GtkInfoNameFromConst(GTKBins, PaperConst);
+end;
+
+function PaperConstFromGtkName(const PaperName: AnsiString): Integer;
+begin
+ Result := InfoConstFromGtkName(GTKPapers, PaperName);
+end;
+
+function BinConstFromGtkName(const PBinName: AnsiString): Integer;
+begin
+ Result := InfoConstFromGtkName(GTKBins, PBinName);
+end;
+
+destructor TfrxPrinter.Destroy;
+begin
+ inherited;
+ ClearGTKPapers;
+ FreeAndNil(FGTKPapers);
+ if Assigned(FPageSet) then
+ g_object_unref(FPageSet);
+ if Assigned(FSettings) then
+ g_object_unref(FSettings);
+ if Assigned(FCustomPaper) then
+ gtk_paper_size_free(FCustomPaper);
+end;
+
+procedure TfrxPrinter.Init;
+ procedure FillPapers;
+ var
+ pList, pOrgList: TPGList;
+ sName: AnsiString;
+ PSize: TPGtkPaperSize;
+ begin
+ pList := gtk_printer_list_papers(Pointer(Handle));
+ pOrgList := pList;
+ while pList <> nil do
+ begin
+ if pList.pData <> nil then
+ begin
+ PSize := gtk_page_setup_get_paper_size(pList.pData);
+ sName := AnsiString(gtk_paper_size_get_name(PSize));
+ FPapers.AddObject(String(gtk_paper_size_get_display_name(PSize)), TObject(PaperConstFromGtkName(sName)));
+ FGTKPapers.AddObject(String(sName), TObject(pList.pData))
+ end;
+ pList := TPGList(pList.pNext);
+ end;
+ g_list_free(pOrgList);
+ end;
+
+ procedure FillBins;
+ var
+ i: Integer;
+ begin
+ for i := Low(GTKBins) to High(GTKBins) do
+ FBins.AddObject(String(GTKBins[i].Name), Pointer(GTKBins[i].Num));
+ end;
+
+var
+ LPageSetup: TPGtkPageSetup;
+ LPaperSize: TPGtkPaperSize;
+ WaitTimer: TStopwatch;
+begin
+ if FInitialized then Exit;
+ FDPI := System.Classes.Point(300, 300);
+ gtk_printer_request_details(Pointer(Handle));
+ WaitTimer := TStopwatch.StartNew;
+ { wait for paper }
+ while not gtk_printer_has_details(Pointer(Handle)) and (WaitTimer.ElapsedMilliseconds < 30000) do Application.ProcessMessages;
+ WaitTimer.Stop;
+ FCanvas := TfrxLinuxCanvas.CreateFromFrxPrinter(Self);
+ FCanvas.Stroke.Kind := TBrushKind.Solid;
+ FCanvas.Stroke.Color := TAlphaColors.Black;
+ FCanvas.Fill.Kind := TBrushKind.Solid;
+ FCanvas.Fill.Color := TAlphaColors.Black;
+ FillPapers;
+ FillBins;
+ LPageSetup := gtk_printer_get_default_page_size(Pointer(FHandle));
+ if LPageSetup = nil then
+ LPageSetup := gtk_page_setup_new;
+ FPageSet := gtk_page_setup_copy(LPageSetup);
+ FSettings := gtk_print_settings_new;
+ FDefOrientation := frxGtkOrientationToFMX(gtk_page_setup_get_orientation(FPageSet));
+ LPaperSize := gtk_page_setup_get_paper_size(FPageSet);
+ FPaperHeight := gtk_page_setup_get_paper_height(FPageSet, GTK_UNIT_MM);
+ FPaperWidth := gtk_page_setup_get_paper_width(FPageSet, GTK_UNIT_MM);
+ FCustomPaper := gtk_paper_size_new_custom (PAnsiChar('frxPaper'), PAnsiChar('frxPaper'), FPaperWidth, FPaperHeight, GTK_UNIT_MM);
+ FOrientation := FDefOrientation;
+ FDefPaper := PaperConstFromGtkName(AnsiString(gtk_paper_size_get_name(LPaperSize)));
+ FDefBin := BinConstFromGtkName(AnsiString(gtk_print_settings_get_default_source(FSettings)));
+ FDefDuplex := Integer(gtk_print_settings_get_duplex(FSettings));
+ FPaper := FDefPaper;
+ FDefPaperWidth := FPaperWidth;
+ FDefPaperHeight := FPaperHeight;
+ FBin := -1;
+ FDuplex := -1;
+ FDPI.X := gtk_print_settings_get_resolution_x(FSettings);
+ FDPI.Y := gtk_print_settings_get_resolution_y(FSettings);
+ FCanvas.SetSize(Round(FPaperWidth * FDPI.X / frxDefDPIUnits * fr01cm), Round(FPaperHeight * FDPI.Y / frxDefDPIUnits * fr01cm));
+ FInitialized := True;
+ g_object_unref(LPageSetup);
+end;
+
+procedure TfrxPrinter.Abort;
+begin
+ FTerminated := True;
+end;
+
+procedure TfrxPrinter.BeginDoc;
+begin
+ if not FInitialized then Exit;
+ FTerminated := False;
+ FPrinting := True;
+ //UpdateFromDeviceCaps;
+ gtk_print_settings_set_n_copies(FSettings, 1);
+ FJob := gtk_print_job_new(PAnsiChar(AnsiString(FTitle)), Pointer(Handle), FSettings, FPageset);
+ FSurf := gtk_print_job_get_surface(FJob, nil);
+ FPrinterContext := Pointer(cairo_create(FSurf));
+ if Assigned(FPrinterContext) then
+ UpdateToDeviceCaps([fdtMargins, fdtPageSize, fdtBin, fdtDuplex, fdtOrientation])
+ else
+ raise Exception.Create('Can''t create canvas for Printer');
+
+ FIsFirst := True;
+end;
+
+procedure TfrxPrinter.BeginPage;
+begin
+ if FTerminated or not FInitialized then Exit;
+ FCanvas.BeginScene(nil, NativeInt(FPrinterContext));
+ inherited;
+ FIsFirst := False;
+end;
+
+procedure TfrxPrinter.EndDoc;
+begin
+ if not FInitialized then Exit;
+ cairo_surface_finish(FSurf);
+ FSurf := nil;
+ if not FTerminated then
+ gtk_print_job_send(FJob, nil, Pointer(Self), nil);
+ g_object_unref(FJob);
+ FJob := nil;
+ FPrinterContext := nil;
+ FPrinting := False;
+ FBin := -1;
+ FDuplex := -1;
+ FTerminated := False;
+end;
+
+procedure TfrxPrinter.EndPage;
+begin
+ if FTerminated or not FInitialized then Exit;
+ FCanvas.EndScene;
+ cairo_show_page(FPrinterContext);
+end;
+
+procedure TfrxPrinter.BeginRAWDoc;
+begin
+//todo
+end;
+
+procedure TfrxPrinter.ClearGTKPapers;
+var
+ i: Integer;
+begin
+ for i := 0 to FGTKPapers.Count - 1 do
+ g_object_unref(Pointer(FGTKPapers.Objects[i]));
+ FGTKPapers.Clear;
+end;
+
+constructor TfrxPrinter.Create(const AName: String; ADevice: NativeInt);
+begin
+ inherited Create(AName, '');
+ FHandle := ADevice;
+ FGTKPapers := TStringList.Create;
+end;
+
+procedure TfrxPrinter.EndRAWDoc;
+begin
+//todo
+end;
+
+procedure TfrxPrinter.WriteRAWDoc(const buf: AnsiString);
+begin
+//todo
+end;
+
+procedure TfrxPrinter.SetViewParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation);
+var
+ LPaperSize: TPGtkPaperSize;
+begin
+ FPaper := APaperSize;
+ FOrientation := AOrientation;
+ if not FInitialized then Exit;
+ if APaperSize = 256 then
+ begin
+ // copy the margins from A4 paper
+ SetViewParams(DMPAPER_A4, 0, 0, AOrientation);
+ FPaperHeight := APaperHeight;
+ FPaperWidth := APaperWidth;
+ end;
+ UpdateToDeviceCaps([fdtMargins, fdtPageSize, fdtOrientation]);
+ UpdateFromDeviceCaps;
+ FOrientation := AOrientation;
+ { Page setup doesnt change orientation until Job created }
+ { so we need to swap size manually. Used in page dialog }
+ LPaperSize := gtk_page_setup_get_paper_size(FPageSet);
+ if FOrientation = poPortrait then
+ begin
+ FPaperWidth := gtk_paper_size_get_width(LPaperSize, GTK_UNIT_MM);
+ FPaperHeight := gtk_paper_size_get_height(LPaperSize, GTK_UNIT_MM);
+ end
+ else
+ begin
+ FPaperHeight := gtk_paper_size_get_width(LPaperSize, GTK_UNIT_MM);
+ FPaperWidth := gtk_paper_size_get_height(LPaperSize, GTK_UNIT_MM);
+ end;
+end;
+
+function TfrxPrinter.ShowPrintDialog: Boolean;
+begin
+ Result := False;
+end;
+
+procedure TfrxPrinter.SetPrintParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
+ ABin, ADuplex, ACopies: Integer);
+var
+ ParamsToUpd: TfrxDevUpdateTypes;
+begin
+ if not FInitialized then Exit;
+ ParamsToUpd := [];
+ if FOrientation <> AOrientation then
+ Include(ParamsToUpd, fdtOrientation);
+ if (APaperSize <> FPaper) or (not SameValue(APaperWidth, FPaperWidth, 0.001) or not SameValue(APaperHeight, FPaperHeight, 0.001)) then
+ Include(ParamsToUpd, fdtPageSize);
+ if FDuplex <> ADuplex then
+ Include(ParamsToUpd, fdtDuplex);
+ if FBin <> ABin then
+ Include(ParamsToUpd, fdtBin);
+ FPaper := APaperSize;
+ FPaperHeight := APaperHeight;
+ FPaperWidth := APaperWidth;
+ FOrientation := AOrientation;
+ FBin := ABin;
+ FDuplex := ADuplex;
+ UpdateToDeviceCaps(ParamsToUpd);
+end;
+
+function TfrxPrinter.UpdateFromDeviceCaps: Boolean;
+var
+ LPSettings: TPGtkPrintSettings;
+ LPaperSize: TPGtkPaperSize;
+begin
+ Result := False;
+ if not FInitialized then Exit;
+ LPSettings := nil;
+ if Assigned(FJob) then
+ LPSettings := gtk_print_job_get_settings(FJob);
+
+ if LPSettings = nil then
+ LPSettings := FSettings;
+ FDPI.X := gtk_print_settings_get_resolution_x(FSettings);
+ FDPI.Y := gtk_print_settings_get_resolution_y(FSettings);
+ FLeftMargin := gtk_page_setup_get_left_margin(FPageSet, GTK_UNIT_MM);
+ FTopMargin := gtk_page_setup_get_top_margin(FPageSet, GTK_UNIT_MM);
+ FRightMargin := gtk_page_setup_get_right_margin(FPageSet, GTK_UNIT_MM);
+ FBottomMargin := gtk_page_setup_get_bottom_margin(FPageSet, GTK_UNIT_MM);
+
+ FOrientation := frxGtkOrientationToFMX(gtk_page_setup_get_orientation(FPageSet));
+ LPaperSize := gtk_page_setup_get_paper_size(FPageSet);
+
+ FPaperHeight := gtk_page_setup_get_paper_height(FPageSet, GTK_UNIT_MM);
+ FPaperWidth := gtk_page_setup_get_paper_width(FPageSet, GTK_UNIT_MM);
+ FPaper := PaperConstFromGtkName(gtk_paper_size_get_name(LPaperSize));
+ FBin := BinConstFromGtkName(gtk_print_settings_get_default_source(LPSettings));
+ FDuplex := Integer(gtk_print_settings_get_duplex(LPSettings));
+
+ Result := True;
+end;
+
+procedure TfrxPrinter.UpdatePageSettings;
+var
+ PaperSize: TPGtkPaperSize;
+ SurfType: TCairo_surface_type;
+ W, H: Double;
+
+ procedure SetPSSurfSize;
+ begin
+ cairo_ps_surface_set_size (FSurf, W, H);
+ cairo_ps_surface_dsc_begin_page_setup(FSurf);
+ case gtk_page_setup_get_orientation(FPageset) of
+ GTK_PAGE_ORIENTATION_PORTRAIT, GTK_PAGE_ORIENTATION_REVERSE_PORTRAIT:
+ cairo_ps_surface_dsc_comment(FSurf, '%%PageOrientation: Portrait');
+ GTK_PAGE_ORIENTATION_LANDSCAPE, GTK_PAGE_ORIENTATION_REVERSE_LANDSCAPE:
+ cairo_ps_surface_dsc_comment(FSurf, '%%PageOrientation: Landscape');
+ end;
+ end;
+begin
+ if FSurf = nil then Exit;
+
+ PaperSize := gtk_page_setup_get_paper_size(FPageset);
+ W := gtk_paper_size_get_width(PaperSize, GTK_UNIT_POINTS);
+ H := gtk_paper_size_get_height(PaperSize, GTK_UNIT_POINTS);
+ SurfType := cairo_surface_get_type(FSurf);
+
+ case SurfType of
+ CAIRO_SURFACE_TYPE_IMAGE: ;
+ CAIRO_SURFACE_TYPE_PDF: cairo_pdf_surface_set_size (FSurf, W, H);
+ CAIRO_SURFACE_TYPE_PS: SetPSSurfSize;
+ end;
+ FCanvas.SetSize(Round(FPaperWidth * FDPI.X / frxDefDPIUnits * fr01cm), Round(FPaperHeight * FDPI.Y / frxDefDPIUnits * fr01cm));
+end;
+
+function TfrxPrinter.UpdateToDeviceCaps(Params: TfrxDevUpdateTypes): Boolean;
+var
+ LPSettings: TPGtkPrintSettings;
+ LPaperSize: TPGtkPaperSize;
+ sName: AnsiString;
+ i: Integer;
+begin
+ Result := False;
+ if not FInitialized then Exit;
+ LPSettings := nil;
+ if Assigned(FJob) then
+ LPSettings := gtk_print_job_get_settings(FJob);
+
+ if LPSettings = nil then
+ LPSettings := FSettings;
+
+ if fdtOrientation in Params then
+ gtk_page_setup_set_orientation(FPageSet, frxFMXOrientationToGtk(FOrientation));
+
+ LPaperSize := gtk_page_setup_get_paper_size(FPageSet);
+
+ if fdtPageSize in Params then
+ begin
+ if FPaper <> 256 then
+ begin
+ sName := GtkPaperNameFromConst(FPaper);
+ i := FGTKPapers.IndexOf(String(sName));
+ if i <> -1 then
+ LPaperSize := gtk_page_setup_get_paper_size(FGTKPapers.Objects[i])
+ else
+ FPaper := 256;
+ end;
+ if FPaper = 256 then
+ begin
+ gtk_paper_size_set_size(FCustomPaper, FPaperWidth, FPaperHeight, GTK_UNIT_MM);
+ LPaperSize := FCustomPaper;
+ end;
+ gtk_page_setup_set_paper_size(FPageSet, LPaperSize);
+ end;
+ { TODO: Doesnt work. We should start new jobs for each new input slot }
+ if fdtBin in Params then
+ gtk_print_settings_set_default_source(LPSettings, PAnsiChar(AnsiString(GtkBinNameFromConst(FBin))));
+ if fdtDuplex in Params then
+ gtk_print_settings_set_duplex(LPSettings, TGtkPrintDuplex(FDuplex));
+
+ if fdtMargins in Params then
+ begin
+ gtk_page_setup_set_left_margin(FPageSet, FLeftMargin, GTK_UNIT_MM);
+ gtk_page_setup_set_top_margin(FPageSet, FTopMargin, GTK_UNIT_MM);
+ gtk_page_setup_set_right_margin(FPageSet, FRightMargin, GTK_UNIT_MM);
+ gtk_page_setup_set_bottom_margin(FPageSet, FBottomMargin, GTK_UNIT_MM);
+ end;
+ if fdtOrientation in Params then
+ gtk_page_setup_set_orientation(FPageSet, frxFMXOrientationToGtk(FOrientation));
+ if (fdtOrientation in Params) or (fdtPageSize in Params) then
+ UpdatePageSettings;
+ Result := True;
+end;
+
+procedure TfrxPrinter.PropertiesDlg;
+//var
+// Dlg: TPGtkPrintUnixDialog;
+begin
+// TODO need export more functions
+// Dlg := gtk_print_unix_dialog_new(PAnsiChar(AnsiString('Settings')), nil);
+// gtk_print_unix_dialog_set_page_setup(Dlg, FPageSet);
+// gtk_print_unix_dialog_set_settings(Dlg, FSettings);
+// gtk_dialog_run(Dlg);
+end;
+
+{ TfrxPrinters }
+
+constructor TfrxPrinters.Create;
+begin
+ Inherited;
+end;
+
+destructor TfrxPrinters.Destroy;
+begin
+ inherited;
+end;
+
+function TfrxPrinters.GetDefaultPrinter: String;
+var
+ i: Integer;
+begin
+ Result := '';
+ for I := 0 to FPrinterList.Count - 1 do
+ if gtk_printer_is_default(Pointer(TfrxPrinter(FPrinterList[i]).Handle)) then
+ begin
+ Result := TfrxPrinter(FPrinterList[i]).Name;
+ Break;
+ end;
+end;
+
+function PrintersEnum(printer: TPGtkPrinter; pData: Pointer): LongBool; cdecl;
+var
+ sName: String;
+ pStr: PAnsiChar;
+begin
+ Result := False;
+ if printer = nil then Exit;
+ g_object_ref(printer);
+ pStr := gtk_printer_get_name(printer);
+ gtk_printer_request_details(printer);
+ sName := String(AnsiString(pStr));
+ TfrxPrinters(pData).FPrinterList.Add(TfrxPrinter.Create(sName, NativeInt(Printer)));
+ TfrxPrinters(pData).FPrinters.Add(sName);
+end;
+
+procedure TfrxPrinters.FillPrinters;
+begin
+ Clear;
+ gtk_enumerate_printers(@PrintersEnum, Pointer(Self), nil, True);
+end;
+
+
+function ActualfrxPrinterClass : TfrxCustomPrintersClass;
+begin
+ Result := TfrxPrinters;
+end;
+
+const
+ cairoLib: String = 'libcairo.so.2';
+ ObjectsLib: String = 'libgobject-2.0.so.0';
+ GLIBLib: String = 'libglib-2.0.so.0';
+ cairoLoadError: String = 'Could not load libcairo library.';
+ GTKLib: String = 'libgtk-3.so.0';
+ GTKLoadError: String = 'Could not load GTK 3 library.';
+
+procedure InitGtkAPI;
+var
+ H: NativeInt;
+begin
+ H := LoadLibrary(PChar(cairoLib));
+ if H = 0 then raise Exception.Create(cairoLoadError);
+ cairo_surface_finish := GetProcAddress(H, 'cairo_surface_finish');
+ cairo_create := GetProcAddress(H, 'cairo_create');
+ cairo_destroy := GetProcAddress(H, 'cairo_destroy');
+ cairo_show_page := GetProcAddress(H, 'cairo_show_page');
+
+ cairo_surface_get_type := GetProcAddress(H, 'cairo_surface_get_type');
+ cairo_ps_surface_set_size := GetProcAddress(H, 'cairo_ps_surface_set_size');
+ cairo_ps_surface_dsc_begin_setup := GetProcAddress(H, 'cairo_ps_surface_dsc_begin_setup');
+ cairo_ps_surface_dsc_begin_page_setup := GetProcAddress(H, 'cairo_ps_surface_dsc_begin_page_setup');
+
+ cairo_ps_surface_dsc_comment := GetProcAddress(H, 'cairo_ps_surface_dsc_comment');
+ cairo_pdf_surface_set_size := GetProcAddress(H, 'cairo_pdf_surface_set_size');
+
+ if (@cairo_surface_finish = nil) or (@cairo_create = nil) or (@cairo_destroy = nil) or (@cairo_show_page = nil) or
+ (@cairo_surface_get_type = nil) or (@cairo_ps_surface_set_size = nil) or (@cairo_ps_surface_dsc_begin_setup = nil) or (@cairo_ps_surface_dsc_begin_page_setup = nil) or
+ (@cairo_ps_surface_dsc_comment = nil) or (@cairo_pdf_surface_set_size = nil) then
+ raise Exception.Create(cairoLoadError);
+
+ H := LoadLibrary(PChar(ObjectsLib));
+ if H = 0 then raise Exception.Create(GTKLoadError);
+ g_object_unref := GetProcAddress(H, 'g_object_unref');
+ g_object_ref := GetProcAddress(H, 'g_object_ref');
+ g_signal_connect_data := GetProcAddress(H, 'g_signal_connect_data');
+
+ H := LoadLibrary(PChar(GLIBLib));
+ if H = 0 then raise Exception.Create(GTKLoadError);
+ g_free := GetProcAddress(H, 'g_free');
+ g_list_free := GetProcAddress(H, 'g_list_free');
+
+ H := LoadLibrary(PChar(GTKLib));
+ if H = 0 then raise Exception.Create(GTKLoadError);
+
+ gtk_print_job_new := GetProcAddress(H, 'gtk_print_job_new');
+ gtk_print_job_get_surface := GetProcAddress(H, 'gtk_print_job_get_surface');
+ gtk_print_job_send := GetProcAddress(H, 'gtk_print_job_send');
+
+ gtk_printer_get_default_page_size := GetProcAddress(H, 'gtk_printer_get_default_page_size');
+ gtk_print_job_get_settings := GetProcAddress(H, 'gtk_print_job_get_settings');
+ gtk_enumerate_printers := GetProcAddress(H, 'gtk_enumerate_printers');
+ gtk_printer_list_papers := GetProcAddress(H, 'gtk_printer_list_papers');
+
+ gtk_printer_has_details := GetProcAddress(H, 'gtk_printer_has_details');
+ gtk_printer_request_details := GetProcAddress(H, 'gtk_printer_request_details');
+ gtk_printer_get_name := GetProcAddress(H, 'gtk_printer_get_name');
+ gtk_printer_is_default := GetProcAddress(H, 'gtk_printer_is_default');
+
+ if (@gtk_print_job_new = nil) or (@gtk_print_job_get_surface = nil) or (@gtk_print_job_send = nil) or
+ (@g_object_unref = nil) or (@gtk_printer_get_default_page_size = nil) or (@gtk_print_job_get_settings = nil) or
+ (@gtk_printer_has_details = nil) or (@g_free = nil) or (@gtk_printer_list_papers = nil) or
+ (@gtk_printer_request_details = nil) or (@g_free = nil) or (@gtk_printer_get_name = nil) or
+ (@g_object_ref = nil) or (@g_list_free = nil) or (@gtk_printer_is_default = nil) or
+ (@g_signal_connect_data = nil) then
+ raise Exception.Create(GTKLoadError);
+
+ gtk_print_unix_dialog_new := GetProcAddress(H, 'gtk_print_unix_dialog_new');
+ gtk_print_unix_dialog_set_page_setup := GetProcAddress(H, 'gtk_print_unix_dialog_set_page_setup');
+ gtk_print_unix_dialog_get_page_setup := GetProcAddress(H, 'gtk_print_unix_dialog_get_page_setup');
+ gtk_print_unix_dialog_set_settings := GetProcAddress(H, 'gtk_print_unix_dialog_set_settings');
+ gtk_print_unix_dialog_get_settings := GetProcAddress(H, 'gtk_print_unix_dialog_get_settings');
+ gtk_dialog_run := GetProcAddress(H, 'gtk_dialog_run');
+
+ if (@gtk_print_unix_dialog_new = nil) or (@gtk_print_unix_dialog_set_page_setup = nil) or (@gtk_print_unix_dialog_get_page_setup = nil) or
+ (@gtk_print_unix_dialog_set_settings = nil) or (@gtk_print_unix_dialog_get_settings = nil) or (@gtk_dialog_run = nil) then
+ raise Exception.Create(GTKLoadError);
+
+ gtk_page_setup_new := GetProcAddress(H, 'gtk_page_setup_new');
+ gtk_page_setup_copy := GetProcAddress(H, 'gtk_page_setup_copy');
+
+ gtk_page_setup_get_paper_size := GetProcAddress(H, 'gtk_page_setup_get_paper_size');
+ gtk_page_setup_set_paper_size := GetProcAddress(H, 'gtk_page_setup_set_paper_size');
+
+ gtk_page_setup_get_orientation := GetProcAddress(H, 'gtk_page_setup_get_orientation');
+ gtk_page_setup_set_orientation := GetProcAddress(H, 'gtk_page_setup_set_orientation');
+ gtk_page_setup_get_top_margin := GetProcAddress(H, 'gtk_page_setup_get_top_margin');
+
+ gtk_page_setup_set_top_margin := GetProcAddress(H, 'gtk_page_setup_set_top_margin');
+ gtk_page_setup_get_bottom_margin := GetProcAddress(H, 'gtk_page_setup_get_bottom_margin');
+ gtk_page_setup_set_bottom_margin := GetProcAddress(H, 'gtk_page_setup_set_bottom_margin');
+
+ gtk_page_setup_get_left_margin := GetProcAddress(H, 'gtk_page_setup_get_left_margin');
+ gtk_page_setup_set_left_margin := GetProcAddress(H, 'gtk_page_setup_set_left_margin');
+ gtk_page_setup_get_right_margin := GetProcAddress(H, 'gtk_page_setup_get_right_margin');
+
+ gtk_page_setup_set_right_margin := GetProcAddress(H, 'gtk_page_setup_set_right_margin');
+ gtk_page_setup_get_paper_width := GetProcAddress(H, 'gtk_page_setup_get_paper_width');
+ gtk_page_setup_get_paper_height := GetProcAddress(H, 'gtk_page_setup_get_paper_height');
+
+ gtk_page_setup_get_page_width := GetProcAddress(H, 'gtk_page_setup_get_page_width');
+ gtk_page_setup_get_page_height := GetProcAddress(H, 'gtk_page_setup_get_page_height');
+ if (@gtk_page_setup_new = nil) or (@gtk_page_setup_get_paper_size = nil) or (@gtk_page_setup_set_paper_size = nil) or
+ (@gtk_page_setup_get_orientation = nil) or (@gtk_page_setup_set_orientation = nil) or (@gtk_page_setup_get_top_margin = nil) or
+ (@gtk_page_setup_set_top_margin = nil) or (@gtk_page_setup_get_bottom_margin = nil) or (@gtk_page_setup_set_bottom_margin = nil) or
+ (@gtk_page_setup_get_left_margin = nil) or (@gtk_page_setup_set_left_margin = nil) or (@gtk_page_setup_get_right_margin = nil) or
+ (@gtk_page_setup_set_right_margin = nil) or (@gtk_page_setup_get_paper_width = nil) or (@gtk_page_setup_get_paper_height = nil) or
+ (@gtk_page_setup_get_page_width = nil) or (@gtk_page_setup_get_paper_size = nil) or (@gtk_page_setup_set_paper_size = nil) or
+ (@gtk_page_setup_new = nil) or (@gtk_page_setup_get_page_height = nil) or (@gtk_page_setup_copy = nil) then
+ raise Exception.Create(GTKLoadError);
+
+ gtk_paper_size_new := GetProcAddress(H, 'gtk_paper_size_new');
+ gtk_paper_size_new_from_ppd := GetProcAddress(H, 'gtk_paper_size_new_from_ppd');
+ gtk_paper_size_new_from_ipp := GetProcAddress(H, 'gtk_paper_size_new_from_ipp');
+
+ gtk_paper_size_new_custom := GetProcAddress(H, 'gtk_paper_size_new_custom');
+ gtk_paper_size_copy := GetProcAddress(H, 'gtk_paper_size_copy');
+ gtk_paper_size_free := GetProcAddress(H, 'gtk_paper_size_free');
+
+ gtk_paper_size_is_equal := GetProcAddress(H, 'gtk_paper_size_is_equal');
+ gtk_paper_size_get_name := GetProcAddress(H, 'gtk_paper_size_get_name');
+ gtk_paper_size_get_display_name := GetProcAddress(H, 'gtk_paper_size_get_display_name');
+
+ gtk_paper_size_get_ppd_name := GetProcAddress(H, 'gtk_paper_size_get_ppd_name');
+ gtk_paper_size_get_width := GetProcAddress(H, 'gtk_paper_size_get_width');
+ gtk_paper_size_get_height := GetProcAddress(H, 'gtk_paper_size_get_height');
+
+ gtk_paper_size_is_custom := GetProcAddress(H, 'gtk_paper_size_is_custom');
+ gtk_paper_size_is_ipp := GetProcAddress(H, 'gtk_paper_size_is_ipp');
+ gtk_paper_size_set_size := GetProcAddress(H, 'gtk_paper_size_set_size');
+
+ gtk_paper_size_get_default_top_margin := GetProcAddress(H, 'gtk_paper_size_get_default_top_margin');
+ gtk_paper_size_get_default_bottom_margin := GetProcAddress(H, 'gtk_paper_size_get_default_bottom_margin');
+ gtk_paper_size_get_default_left_margin := GetProcAddress(H, 'gtk_paper_size_get_default_left_margin');
+
+ gtk_paper_size_get_default_right_margin := GetProcAddress(H, 'gtk_paper_size_get_default_right_margin');
+ gtk_paper_size_get_default := GetProcAddress(H, 'gtk_paper_size_get_default');
+
+ if (@gtk_paper_size_new = nil) or (@gtk_paper_size_new_from_ppd = nil) or (@gtk_paper_size_new_from_ipp = nil) or
+ (@gtk_paper_size_new_custom = nil) or (@gtk_paper_size_copy = nil) or (@gtk_paper_size_free = nil) or
+ (@gtk_paper_size_is_equal = nil) or (@gtk_paper_size_get_name = nil) or (@gtk_paper_size_get_display_name = nil) or
+ (@gtk_paper_size_get_ppd_name = nil) or (@gtk_paper_size_get_width = nil) or (@gtk_paper_size_get_height = nil) or
+ (@gtk_paper_size_is_custom = nil) or (@gtk_paper_size_is_ipp = nil) or (@gtk_paper_size_set_size = nil) or
+ (@gtk_paper_size_get_default_top_margin = nil) or (@gtk_paper_size_get_default_bottom_margin = nil) or (@gtk_paper_size_get_default_left_margin = nil) or
+ (@gtk_paper_size_get_default_right_margin = nil) or (@gtk_paper_size_get_default = nil) then
+ raise Exception.Create(GTKLoadError);
+
+ gtk_print_settings_new := GetProcAddress(H, 'gtk_print_settings_new');
+ gtk_print_settings_get_printer := GetProcAddress(H, 'gtk_print_settings_get_printer');
+ gtk_print_settings_set_printer := GetProcAddress(H, 'gtk_print_settings_set_printer');
+
+ gtk_print_settings_get_orientation := GetProcAddress(H, 'gtk_print_settings_get_orientation');
+ gtk_print_settings_set_orientation := GetProcAddress(H, 'gtk_print_settings_set_orientation');
+ gtk_print_settings_get_paper_size := GetProcAddress(H, 'gtk_print_settings_get_paper_size');
+
+ gtk_print_settings_set_paper_size := GetProcAddress(H, 'gtk_print_settings_set_paper_size');
+ gtk_print_settings_get_paper_width := GetProcAddress(H, 'gtk_print_settings_get_paper_width');
+ gtk_print_settings_set_paper_width := GetProcAddress(H, 'gtk_print_settings_set_paper_width');
+
+ gtk_print_settings_get_paper_height := GetProcAddress(H, 'gtk_print_settings_get_paper_height');
+ gtk_print_settings_set_paper_height := GetProcAddress(H, 'gtk_print_settings_set_paper_height');
+ gtk_print_settings_get_collate := GetProcAddress(H, 'gtk_print_settings_get_collate');
+
+ gtk_print_settings_set_collate := GetProcAddress(H, 'gtk_print_settings_set_collate');
+ gtk_print_settings_get_duplex := GetProcAddress(H, 'gtk_print_settings_get_duplex');
+ gtk_print_settings_set_duplex := GetProcAddress(H, 'gtk_print_settings_set_duplex');
+
+ gtk_print_settings_get_n_copies := GetProcAddress(H, 'gtk_print_settings_get_n_copies');
+ gtk_print_settings_set_n_copies := GetProcAddress(H, 'gtk_print_settings_set_n_copies');
+ gtk_print_settings_get_resolution_x := GetProcAddress(H, 'gtk_print_settings_get_resolution_x');
+
+ gtk_print_settings_get_resolution_y := GetProcAddress(H, 'gtk_print_settings_get_resolution_y');
+ gtk_print_settings_get_default_source := GetProcAddress(H, 'gtk_print_settings_get_default_source');
+ gtk_print_settings_set_default_source := GetProcAddress(H, 'gtk_print_settings_set_default_source');
+
+ gtk_print_settings_get_media_type := GetProcAddress(H, 'gtk_print_settings_get_media_type');
+ gtk_print_settings_set_media_type := GetProcAddress(H, 'gtk_print_settings_set_media_type');
+ gtk_print_settings_get_output_bin := GetProcAddress(H, 'gtk_print_settings_get_output_bin');
+
+ gtk_print_settings_set_output_bin := GetProcAddress(H, 'gtk_print_settings_set_output_bin');
+
+ if (@gtk_print_settings_new = nil) or (@gtk_print_settings_get_printer = nil) or (@gtk_print_settings_set_printer = nil) or
+ (@gtk_print_settings_get_orientation = nil) or (@gtk_print_settings_set_orientation = nil) or (@gtk_print_settings_get_paper_size = nil) or
+ (@gtk_print_settings_set_paper_size = nil) or (@gtk_print_settings_get_paper_width = nil) or (@gtk_print_settings_set_paper_width = nil) or
+ (@gtk_print_settings_get_paper_height = nil) or (@gtk_print_settings_set_paper_height = nil) or (@gtk_print_settings_get_collate = nil) or
+ (@gtk_print_settings_set_collate = nil) or (@gtk_print_settings_get_duplex = nil) or (@gtk_print_settings_set_duplex = nil) or
+ (@gtk_print_settings_get_n_copies = nil) or (@gtk_print_settings_set_n_copies = nil) or (@gtk_print_settings_get_resolution_x = nil) or
+ (@gtk_print_settings_get_resolution_y = nil) or (@gtk_print_settings_get_default_source = nil) or (@gtk_print_settings_set_default_source = nil) or
+ (@gtk_print_settings_get_media_type = nil) or (@gtk_print_settings_set_media_type = nil) or (@gtk_print_settings_get_output_bin = nil) or
+ (@gtk_print_settings_set_output_bin = nil) then
+ raise Exception.Create(GTKLoadError);
+end;
+
+initialization
+ InitGtkAPI;
+
+finalization
+
+end.
diff --git a/LibD28/FMX.Mac.frxPrinter.pas b/LibD28/FMX.Mac.frxPrinter.pas
new file mode 100644
index 0000000..24aa39c
--- /dev/null
+++ b/LibD28/FMX.Mac.frxPrinter.pas
@@ -0,0 +1,529 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Printer }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.Mac.frxPrinter;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.SysUtils, System.Types, System.UITypes, System.Variants,
+ FMX.Types, FMX.frxPrinter, FMX.Printer.Mac, FMX.Printer
+{$IFDEF DELPHI27}
+ ,System.Rtti, FMX.frxCanvas.Mac
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+
+type
+ THackCanvas = class(TCanvas);
+ THackPrinter = class(TPrinter);
+
+
+ TfrxPrinter = class(TfrxCustomPrinter)
+ private
+ //FDriver: String;
+ //FPrintDLG: TPrintDialog;
+ //FOnChangedFont: TNotifyEvent;
+ FIsFirst: Boolean;
+ public
+ constructor Create(const AName, APort: String); override;
+ destructor Destroy; override;
+ procedure Init; override;
+ procedure Abort; override;
+ procedure BeginDoc; override;
+ procedure BeginPage; override;
+ procedure BeginRAWDoc; override;
+ procedure EndDoc; override;
+ procedure EndPage; override;
+ procedure EndRAWDoc; override;
+ procedure WriteRAWDoc(const buf: AnsiString); override;
+ procedure SetViewParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended;
+ AOrientation: TPrinterOrientation); override;
+ procedure SetPrintParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
+ ABin, ADuplex, ACopies: Integer); override;
+ procedure PropertiesDlg; override;
+ function ShowPrintDialog: Boolean; override;
+ function UpdateDeviceCaps: Boolean;
+ end;
+
+
+ TfrxPrinters = class(TfrxCustomPrinters)
+ protected
+ function GetDefaultPrinter: String; override;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure FillPrinters; override;
+ end;
+
+
+
+function frxGetPaperDimensions(PaperSize: Integer; var Width, Height: Extended): Boolean;
+function ActualfrxPrinterClass : TfrxCustomPrintersClass;
+
+
+implementation
+
+uses
+ FMX.frxUtils, FMX.frxRes, FMX.frxFMX, FMX.Forms, Macapi.CoreServices, Macapi.CoreFoundation, Macapi.Foundation,
+ Macapi.CocoaTypes, Macapi.AppKit;
+
+
+const
+{$IFDEF MACOS64}
+ libPrintCore = '/System/Library/Frameworks/ApplicationServices.framework/ApplicationServices';
+{$ELSE}
+ libPrintCore = '/System/Library/Frameworks/ApplicationServices.framework/Frameworks/PrintCore.framework/PrintCore';
+{$ENDIF}
+ kPMCancel = 128;
+{$IFDEF UNDERSCOREIMPORTNAME}
+ _PFX = '_';
+{$ELSE}
+ _PFX = '';
+{$ENDIF}
+{$EXTERNALSYM _PFX}
+
+function PMGetCopies(printSettings: PMPrintSettings; copies: PUInt32): OSStatus; cdecl; external libPrintCore name _PFX + 'PMGetCopies';
+function PMSetCopies(printSettings: PMPrintSettings; copies: UInt32; lock: Boolean): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSetCopies';
+function PMGetAdjustedPageRect(pageFormat: PMPageFormat; pageRect: PPMRect): OSStatus; cdecl; external libPrintCore name _PFX + 'PMGetAdjustedPageRect';
+function PMGetAdjustedPaperRect(pageFormat: PMPageFormat; paperRect: PPMRect): OSStatus; cdecl; external libPrintCore name _PFX + 'PMGetAdjustedPaperRect';
+function PMGetPageFormatPaper(format: PMPageFormat; paper: PPMPaper): OSStatus; cdecl; external libPrintCore name _PFX + 'PMGetPageFormatPaper';
+function PMPaperGetHeight(paper: PMPaper; paperHeight: PDouble): OSStatus; cdecl; external libPrintCore name _PFX + 'PMPaperGetHeight';
+function PMPaperGetWidth(paper: PMPaper; paperWidth: PDouble): OSStatus; cdecl; external libPrintCore name _PFX + 'PMPaperGetWidth';
+function PMPaperGetMargins(paper: PMPaper; paperMargins: PPMPaperMargins): OSStatus; cdecl; external libPrintCore name _PFX + 'PMPaperGetMargins';
+function PMPrinterGetDriverCreator(printer: PMPrinter; creator: POSType): OSStatus; cdecl; external libPrintCore name _PFX + 'PMPrinterGetDriverCreator';
+function PMPrinterGetDriverReleaseInfo(printer: PMPrinter; release: VersRecPtr): OSStatus; cdecl; external libPrintCore name _PFX + 'PMPrinterGetDriverReleaseInfo';
+function PMPrinterGetID(printer: PMPrinter): CFStringRef; cdecl; external libPrintCore name _PFX + 'PMPrinterGetID';
+function PMPrinterGetMakeAndModelName(printer: PMPrinter; makeAndModel: PCFStringRef): OSStatus; cdecl; external libPrintCore name _PFX + 'PMPrinterGetMakeAndModelName';
+function PMPrinterGetName(printer: PMPrinter): CFStringRef; cdecl; external libPrintCore name _PFX + 'PMPrinterGetName';
+function PMPrinterIsDefault(printer: PMPrinter): Boolean; cdecl; external libPrintCore name _PFX + 'PMPrinterIsDefault';
+function PMPrinterSetOutputResolution(printer: PMPrinter; printSettings: PMPrintSettings; resolutionP: PPMResolution): OSStatus; cdecl; external libPrintCore name _PFX + 'PMPrinterSetOutputResolution';
+function PMPrinterGetPrinterResolutionCount(printer: PMPrinter; countP: PUInt32): OSStatus; cdecl; external libPrintCore name _PFX + 'PMPrinterGetPrinterResolutionCount';
+function PMPrinterGetIndexedPrinterResolution(printer: PMPrinter; index: UInt32; resolutionP: PPMResolution): OSStatus; cdecl; external libPrintCore name _PFX + 'PMPrinterGetIndexedPrinterResolution';
+function PMPrinterGetOutputResolution(printer: PMPrinter; printSettings: PMPrintSettings; resolutionP: PPMResolution): OSStatus; cdecl; external libPrintCore name _PFX + 'PMPrinterGetOutputResolution';
+function PMServerCreatePrinterList(server: PMServer; printerList: PCFArrayRef): OSStatus; cdecl; external libPrintCore name _PFX + 'PMServerCreatePrinterList';
+function PMSessionBeginCGDocumentNoDialog(printSession: PMPrintSession; printSettings: PMPrintSettings; pageFormat: PMPageFormat): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSessionBeginCGDocumentNoDialog';
+function PMSessionBeginPageNoDialog(printSession: PMPrintSession; pageFormat: PMPageFormat; pageFrame: PPMRect): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSessionBeginPageNoDialog';
+function PMSessionDefaultPageFormat(printSession: PMPrintSession; pageFormat: PMPageFormat): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSessionDefaultPageFormat';
+function PMSessionDefaultPrintSettings(printSession: PMPrintSession; printSettings: PMPrintSettings): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSessionDefaultPrintSettings';
+function PMSessionEndDocumentNoDialog(printSession: PMPrintSession): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSessionEndDocumentNoDialog';
+function PMSessionEndPageNoDialog(printSession: PMPrintSession): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSessionEndPageNoDialog';
+function PMSessionSetCurrentPMPrinter(session: PMPrintSession; printer: PMPrinter): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSessionSetCurrentPMPrinter';
+function PMSessionSetError(printSession: PMPrintSession; printError: OSStatus): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSessionSetError';
+function PMSessionValidatePageFormat(printSession: PMPrintSession; pageFormat: PMPageFormat; result: PBoolean): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSessionValidatePageFormat';
+function PMSessionValidatePrintSettings(printSession: PMPrintSession; printSettings: PMPrintSettings; result: PBoolean): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSessionValidatePrintSettings';
+function PMSessionSetDestination(printSession: PMPrintSession; printSettings: PMPrintSettings; destType: PMDestinationType; destFormat: CFStringRef; destLocation: CFURLRef): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSessionSetDestination';
+function PMSetOrientation(pageFormat: PMPageFormat; orientation: PMOrientation; lock: Boolean): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSetOrientation';
+
+type
+ TPaperInfo = {packed} record
+ Typ: Integer;
+ Name: String;
+ X, Y: Integer;
+ end;
+
+
+const
+ PAPERCOUNT = 66;
+ PaperInfo: array[0..PAPERCOUNT - 1] of TPaperInfo = (
+ (Typ:1; Name: ''; X:2159; Y:2794),
+ (Typ:2; Name: ''; X:2159; Y:2794),
+ (Typ:3; Name: ''; X:2794; Y:4318),
+ (Typ:4; Name: ''; X:4318; Y:2794),
+ (Typ:5; Name: ''; X:2159; Y:3556),
+ (Typ:6; Name: ''; X:1397; Y:2159),
+ (Typ:7; Name: ''; X:1842; Y:2667),
+ (Typ:8; Name: ''; X:2970; Y:4200),
+ (Typ:9; Name: ''; X:2100; Y:2970),
+ (Typ:10; Name: ''; X:2100; Y:2970),
+ (Typ:11; Name: ''; X:1480; Y:2100),
+ (Typ:12; Name: ''; X:2500; Y:3540),
+ (Typ:13; Name: ''; X:1820; Y:2570),
+ (Typ:14; Name: ''; X:2159; Y:3302),
+ (Typ:15; Name: ''; X:2150; Y:2750),
+ (Typ:16; Name: ''; X:2540; Y:3556),
+ (Typ:17; Name: ''; X:2794; Y:4318),
+ (Typ:18; Name: ''; X:2159; Y:2794),
+ (Typ:19; Name: ''; X:984; Y:2254),
+ (Typ:20; Name: ''; X:1048; Y:2413),
+ (Typ:21; Name: ''; X:1143; Y:2635),
+ (Typ:22; Name: ''; X:1207; Y:2794),
+ (Typ:23; Name: ''; X:1270; Y:2921),
+ (Typ:24; Name: ''; X:4318; Y:5588),
+ (Typ:25; Name: ''; X:5588; Y:8636),
+ (Typ:26; Name: ''; X:8636; Y:11176),
+ (Typ:27; Name: ''; X:1100; Y:2200),
+ (Typ:28; Name: ''; X:1620; Y:2290),
+ (Typ:29; Name: ''; X:3240; Y:4580),
+ (Typ:30; Name: ''; X:2290; Y:3240),
+ (Typ:31; Name: ''; X:1140; Y:1620),
+ (Typ:32; Name: ''; X:1140; Y:2290),
+ (Typ:33; Name: ''; X:2500; Y:3530),
+ (Typ:34; Name: ''; X:1760; Y:2500),
+ (Typ:35; Name: ''; X:1760; Y:1250),
+ (Typ:36; Name: ''; X:1100; Y:2300),
+ (Typ:37; Name: ''; X:984; Y:1905),
+ (Typ:38; Name: ''; X:920; Y:1651),
+ (Typ:39; Name: ''; X:3778; Y:2794),
+ (Typ:40; Name: ''; X:2159; Y:3048),
+ (Typ:41; Name: ''; X:2159; Y:3302),
+ (Typ:42; Name: ''; X:2500; Y:3530),
+ (Typ:43; Name: ''; X:1000; Y:1480),
+ (Typ:44; Name: ''; X:2286; Y:2794),
+ (Typ:45; Name: ''; X:2540; Y:2794),
+ (Typ:46; Name: ''; X:3810; Y:2794),
+ (Typ:47; Name: ''; X:2200; Y:2200),
+ (Typ:50; Name: ''; X:2355; Y:3048),
+ (Typ:51; Name: ''; X:2355; Y:3810),
+ (Typ:52; Name: ''; X:2969; Y:4572),
+ (Typ:53; Name: ''; X:2354; Y:3223),
+ (Typ:54; Name: ''; X:2101; Y:2794),
+ (Typ:55; Name: ''; X:2100; Y:2970),
+ (Typ:56; Name: ''; X:2355; Y:3048),
+ (Typ:57; Name: ''; X:2270; Y:3560),
+ (Typ:58; Name: ''; X:3050; Y:4870),
+ (Typ:59; Name: ''; X:2159; Y:3223),
+ (Typ:60; Name: ''; X:2100; Y:3300),
+ (Typ:61; Name: ''; X:1480; Y:2100),
+ (Typ:62; Name: ''; X:1820; Y:2570),
+ (Typ:63; Name: ''; X:3220; Y:4450),
+ (Typ:64; Name: ''; X:1740; Y:2350),
+ (Typ:65; Name: ''; X:2010; Y:2760),
+ (Typ:66; Name: ''; X:4200; Y:5940),
+ (Typ:67; Name: ''; X:2970; Y:4200),
+ (Typ:68; Name: ''; X:3220; Y:4450));
+
+
+function frxGetPaperDimensions(PaperSize: Integer; var Width, Height: Extended): Boolean;
+var
+ i: Integer;
+begin
+ Result := False;
+ for i := 0 to PAPERCOUNT - 1 do
+ if PaperInfo[i].Typ = PaperSize then
+ begin
+ Width := PaperInfo[i].X / 10;
+ Height := PaperInfo[i].Y / 10;
+ Result := True;
+ break;
+ end;
+end;
+
+destructor TfrxPrinter.Destroy;
+begin
+ inherited;
+ //FPrintDLG.Free;
+end;
+
+procedure TfrxPrinter.Init;
+begin
+ if FInitialized then Exit;
+ UpdateDeviceCaps;
+ FDefOrientation := TPrinterMac(FMX.Printer.Printer).Orientation;
+ FOrientation := FDefOrientation;
+ FPaperHeight := TPrinterMac(FMX.Printer.Printer).PrintInfo.paperSize.height;
+ FPaperWidth := TPrinterMac(FMX.Printer.Printer).PrintInfo.paperSize.width;
+
+ FDefPaper := 256;
+ FDefBin := 0;
+ FDefDuplex := 0;
+ FPaper := FDefPaper;
+ FDefPaperWidth := FPaperWidth;
+ FDefPaperHeight := FPaperHeight;
+ FOrientation := FDefOrientation;
+ FBin := -1;
+ FDuplex := -1;
+
+ FInitialized := True;
+
+ FBin := -1;
+ FDuplex := -1;
+
+ FInitialized := True;
+end;
+
+procedure TfrxPrinter.Abort;
+begin
+ FMX.Printer.Printer.EndDoc;
+end;
+
+procedure TfrxPrinter.BeginDoc;
+begin
+ FPrinting := True;
+ FCanvas := TPrinterMac(FMX.Printer.Printer).Canvas;
+ FIsFirst := True;
+ UpdateDeviceCaps;
+ FMX.Printer.Printer.BeginDoc;
+ FCanvas := TPrinterMac(FMX.Printer.Printer).Canvas;
+end;
+
+procedure TfrxPrinter.BeginPage;
+begin
+ inherited;
+
+ if not (FIsFirst) then
+ begin
+ with TPrinterMac(FMX.Printer.Printer).PrintInfo do
+ begin
+ PMSessionBeginPageNoDialog(PMPrintSession, PMPageFormat, nil);
+ end;
+ TPrinterMac(FMX.Printer.Printer).Canvas.BeginScene;
+ end;
+ FIsFirst := False;
+end;
+
+procedure TfrxPrinter.EndDoc;
+begin
+
+ FPaperHeight := FMX.Printer.Printer.PageHeight;
+ FPaperWidth := FMX.Printer.Printer.PageWidth;
+ //FMX.Printer.Printer.EndDoc;
+
+ PMSessionEndDocumentNoDialog(TPrinterMac(FMX.Printer.Printer).PrintInfo.PMPrintSession);
+{$IFDEF DELPHI25}
+ try
+ if TPrinterMac(FMX.Printer.Printer).Canvas.BeginSceneCount > 0 then
+ TPrinterMac(FMX.Printer.Printer).Canvas.EndScene;
+ except
+ end;
+{$ELSE}
+ TPrinterMac(FMX.Printer.Printer).Canvas.EndScene;
+{$ENDIF}
+ FPrinting := False;
+ THackPrinter(FMX.Printer.Printer).FPrinting := False;
+ FBin := -1;
+ FDuplex := -1;
+end;
+
+procedure TfrxPrinter.EndPage;
+begin
+ TPrinterMac(FMX.Printer.Printer).Canvas.EndScene;
+ with TPrinterMac(FMX.Printer.Printer).PrintInfo do
+ begin
+ PMSessionEndPageNoDialog(PMPrintSession);
+ end;
+end;
+
+procedure TfrxPrinter.BeginRAWDoc;
+begin
+//todo
+end;
+
+procedure TfrxPrinter.EndRAWDoc;
+begin
+//todo
+end;
+
+procedure TfrxPrinter.WriteRAWDoc(const buf: AnsiString);
+begin
+ //todo
+end;
+
+constructor TfrxPrinter.Create(const AName, APort: String);
+begin
+ inherited Create(AName, APort);
+ //FPrintDLG := TPrintDialog.Create(nil);
+end;
+
+procedure TfrxPrinter.SetViewParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation);
+begin
+ {if APaperSize <> 256 then
+ begin
+
+ if not UpdateDeviceCaps then Exit;
+ end
+ else
+ begin
+ // copy the margins from A4 paper
+ SetViewParams(DMPAPER_A4, 0, 0, AOrientation);
+ FPaperHeight := APaperHeight;
+ FPaperWidth := APaperWidth;
+ end; }
+
+ FPaper := APaperSize;
+ FOrientation := AOrientation;
+end;
+
+function TfrxPrinter.ShowPrintDialog: Boolean;
+begin
+// Result := FPrintDLG.Execute;
+ Result := False;
+end;
+
+procedure TfrxPrinter.SetPrintParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
+ ABin, ADuplex, ACopies: Integer);
+var
+ sSize: NSSize;
+ Changed: Boolean;
+ lOrientation: NSPrintingOrientation;
+begin
+
+ { later fix these values }
+ FPaper := APaperSize;
+ sSize.Height := APaperHeight * 2.835;
+ sSize.Width := APaperWidth * 2.835;
+
+ if AOrientation = TPrinterOrientation.poPortrait then
+ lOrientation := NSPortraitOrientation
+ else
+ lOrientation := NSLandscapeOrientation;
+
+ TPrinterMac(FMX.Printer.Printer).PrintInfo.setPaperSize(sSize);
+
+ with TPrinterMac(FMX.Printer.Printer) do
+ begin
+ //kPMPortrait = 1
+ //kPMLandscape = 2
+ //PMSetOrientation(PrintInfo.PMPageFormat, lOrientation + 1, false);
+ PMSessionValidatePageFormat(PrintInfo.PMPrintSession, PrintInfo.PMPageFormat, @Changed);
+ end;
+ TPrinterMac(FMX.Printer.Printer).PrintInfo.setOrientation(lOrientation);
+ TPrinterMac(FMX.Printer.Printer).PrintInfo.updateFromPMPageFormat;
+ FPaperHeight := TPrinterMac(FMX.Printer.Printer).PrintInfo.paperSize.height;
+ FPaperWidth := TPrinterMac(FMX.Printer.Printer).PrintInfo.paperSize.width;
+{$IFDEF DELPHI18}
+ TPrinterMac(FMX.Printer.Printer).Canvas.SetSize(Round(FPaperWidth), Round(FPaperHeight));
+{$ELSE}
+ TPrinterMac(FMX.Printer.Printer).Canvas.ResizeBuffer(Round(FPaperWidth), Round(FPaperHeight));
+{$ENDIF}
+ FOrientation := AOrientation;
+ UpdateDeviceCaps;
+end;
+
+function TfrxPrinter.UpdateDeviceCaps: Boolean;
+var
+ Idx: Integer;
+begin
+ FCanvas := TPrinterMac(FMX.Printer.Printer).Canvas;
+ FPaperHeight := TPrinterMac(FMX.Printer.Printer).PrintInfo.paperSize.height;
+ FPaperWidth := TPrinterMac(FMX.Printer.Printer).PrintInfo.paperSize.width;
+ Idx := FMX.Printer.Printer.ActivePrinter.ActiveDPIIndex;
+
+ if Idx <> -1 then
+ begin
+ FDPI.X := FMX.Printer.Printer.ActivePrinter.DPI[Idx].X;
+ FDPI.y := FMX.Printer.Printer.ActivePrinter.DPI[Idx].Y;
+ end
+ else if FMX.Printer.Printer.ActivePrinter.DPICount > 0 then
+ begin
+ FDPI.X := FMX.Printer.Printer.ActivePrinter.DPI[0].X;
+ FDPI.y := FMX.Printer.Printer.ActivePrinter.DPI[0].Y;
+ end
+ else
+ begin
+ FDPI := System.Classes.Point(72, 72);
+ end;
+
+ FLeftMargin := TPrinterMac(FMX.Printer.Printer).PrintInfo.imageablePageBounds.origin.x / 3;
+ FTopMargin := TPrinterMac(FMX.Printer.Printer).PrintInfo.imageablePageBounds.origin.y / 3;
+ FBottomMargin := FPaperHeight - TPrinterMac(FMX.Printer.Printer).PrintInfo.imageablePageBounds.size.height / 3 - FTopMargin;
+ FRightMargin := FPaperWidth - TPrinterMac(FMX.Printer.Printer).PrintInfo.imageablePageBounds.size.width / 3 - FLeftMargin;
+ Result := True;
+ { Result := True;
+ if FDC = 0 then GetDC;
+
+ FDPI := Point(GetDeviceCaps(FDC, LOGPIXELSX), GetDeviceCaps(FDC, LOGPIXELSY));
+ if (FDPI.X = 0) or (FDPI.Y = 0) then
+ begin
+ Result := False;
+ frxErrorMsg('Printer selected is not valid');
+ Exit;
+ end;
+ FPaperHeight := Round(GetDeviceCaps(FDC, PHYSICALHEIGHT) / FDPI.Y * 25.4);
+ FPaperWidth := Round(GetDeviceCaps(FDC, PHYSICALWIDTH) / FDPI.X * 25.4);
+ FLeftMargin := Round(GetDeviceCaps(FDC, PHYSICALOFFSETX) / FDPI.X * 25.4);
+ FTopMargin := Round(GetDeviceCaps(FDC, PHYSICALOFFSETY) / FDPI.Y * 25.4);
+ FRightMargin := FPaperWidth - Round(GetDeviceCaps(FDC, HORZRES) / FDPI.X * 25.4) - FLeftMargin;
+ FBottomMargin := FPaperHeight - Round(GetDeviceCaps(FDC, VERTRES) / FDPI.Y * 25.4) - FTopMargin;}
+end;
+
+procedure TfrxPrinter.PropertiesDlg;
+begin
+ //todo
+end;
+
+{ TfrxPrinters }
+
+constructor TfrxPrinters.Create;
+begin
+ Inherited;
+end;
+
+destructor TfrxPrinters.Destroy;
+begin
+ inherited;
+end;
+
+
+
+function TfrxPrinters.GetDefaultPrinter: String;
+begin
+ Result := FMX.Printer.Printer.ActivePrinter.Device;
+end;
+
+
+procedure TfrxPrinters.FillPrinters;
+var
+ i: Integer;
+ LPrinter: TPrinter;
+{$IFDEF DELPHI27}
+ RtCtx: TRttiContext;
+ RtFd: TRttiField;
+ Val: TValue;
+
{$ENDIF}
+
+ procedure AddPrinter(ADevice, APort: String);
+ begin
+ FPrinterList.Add(TfrxPrinter.Create(ADevice, APort));
+ FPrinters.Add(ADevice);
+ end;
+
+begin
+ Clear;
+ LPrinter := FMX.Printer.Printer;
+{$IFDEF DELPHI27}
+ RtCtx := TRttiContext.Create;
+ try
+ RtFd := RtCtx.GetType(TPrinterMac).GetField('FCanvas');
+ if Assigned(RtFd) then
+ begin
+ TValue.Make(TfrxCanvasQuartz.CreateFromPrinter(LPrinter), Val);
+ RtFd.SetValue(LPrinter, Val);
+ end;
+ finally
+ RtCtx.Free;
+ end;
+{$ENDIF}
+ for i := 0 to LPrinter.Count - 1 do
+ AddPrinter(LPrinter.Printers[i].Device, LPrinter.Printers[i].Port);
+end;
+
+function ActualfrxPrinterClass : TfrxCustomPrintersClass;
+begin
+ Result := TfrxPrinters;
+end;
+
+initialization
+
+finalization
+
+end.
+
diff --git a/LibD28/FMX.TTFHelpers.pas b/LibD28/FMX.TTFHelpers.pas
new file mode 100644
index 0000000..bdb06c3
--- /dev/null
+++ b/LibD28/FMX.TTFHelpers.pas
@@ -0,0 +1,68 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Font parser }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Aleksey Mandrykin, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.TTFHelpers;
+
+interface
+
+type
+
+TTF_Helpers = class abstract
+ // Methods
+ strict protected constructor Create;
+ public class function Increment(ptr: Pointer; cbSize: Integer): Pointer; static;
+ public class function SwapInt16(v: Smallint): Smallint; static;
+ public class function SwapInt32(v: Integer): Integer; static;
+ public class function SwapUInt16(v: Word): Word; static;
+ public class function SwapUInt32(v: Cardinal): Cardinal; static;
+ public class function SwapUInt64(v: UInt64): UInt64; static;
+
+end;
+
+implementation
+
+// Methods
+ constructor TTF_Helpers.Create;
+ begin
+ end;
+
+ class function TTF_Helpers.Increment(ptr: Pointer; cbSize: Integer): Pointer;
+ begin
+ Result := Pointer(NativeInt(ptr) + cbSize)
+ end;
+
+ class function TTF_Helpers.SwapInt16(v: Smallint): Smallint;
+ begin
+ Result := Smallint((((v and $ff) shl 8) or ((v shr 8) and $ff)))
+ end;
+
+ class function TTF_Helpers.SwapInt32(v: Integer): Integer;
+ begin
+ Result := ((TTF_Helpers.SwapInt16(Smallint(v)) and $ffff) shl $10) or (TTF_Helpers.SwapInt16(Smallint(v shr $10)) and $ffff)
+ end;
+
+ class function TTF_Helpers.SwapUInt16(v: Word): Word;
+ begin
+ Result := Word((((v and $ff) shl 8) or ((v shr 8) and $ff)))
+ end;
+
+ class function TTF_Helpers.SwapUInt32(v: Cardinal): Cardinal;
+ begin
+ Result := Cardinal((((TTF_Helpers.SwapUInt16(Word(v)) and $ffff) shl $10) or (TTF_Helpers.SwapUInt16(Word(v shr $10)) and $ffff)))
+ end;
+
+ class function TTF_Helpers.SwapUInt64(v: UInt64): UInt64;
+ begin
+ Result := (((TTF_Helpers.SwapUInt32(Cardinal(v)) and $ffffffff) shl $20) or (TTF_Helpers.SwapUInt32((Cardinal(v shr $20))) and $ffffffff))
+ end;
+
+ end.
+
diff --git a/LibD28/FMX.Win.frxPrinter.pas b/LibD28/FMX.Win.frxPrinter.pas
new file mode 100644
index 0000000..36c6a53
--- /dev/null
+++ b/LibD28/FMX.Win.frxPrinter.pas
@@ -0,0 +1,901 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Printer }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.Win.frxPrinter;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.SysUtils, Winapi.Windows, Winapi.WinSpool, System.Types, System.UITypes, System.Variants,
+ FMX.Types, FMX.frxPrinter, FMX.Printer.Win, FMX.Printer, FMX.Canvas.GDIP, FMX.frxClass
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+
+type
+ THackCanvas = class(TCanvas);
+// Fake printer used only for canvas creation
+ TFakePrinterWin = class(TPrinterWin)
+ protected
+ FPageHeight: Integer;
+ FPageWidth: Integer;
+ FCanvas: TCanvas;
+ procedure ActivePrinterChanged; override;
+ procedure DoAbortDoc; override;
+ procedure DoBeginDoc; override;
+ procedure DoEndDoc; override;
+ procedure DoNewPage; override;
+ function GetCanvas: TCanvas; override;
+ function GetNumCopies: Integer; override;
+ function GetOrientation: TPrinterOrientation; override;
+ function GetPageHeight: Integer; override;
+ function GetPageWidth: Integer; override;
+ function GetCapabilities: TPrinterCapabilities; override;
+ procedure RefreshFonts; override;
+ procedure RefreshPrinterDevices; override;
+ procedure SetOrientation(Value: TPrinterOrientation); override;
+ procedure SetNumCopies(Value: Integer); override;
+ procedure SetDefaultPrinter; override;
+ public
+ constructor Create; override;
+ destructor Destroy; override;
+ end;
+
+ TfrxPrinter = class(TfrxCustomPrinter)
+ private
+ FDeviceMode: THandle;
+ FDC: HDC;
+ FDriver: String;
+ FMode: PDeviceMode;
+ FWinPrinter: TFakePrinterWin;
+ FOldWinPrinter: TPrinterWin;
+ FOnChangedFont: TNotifyEvent;
+ procedure CreateDevMode;
+ procedure FreeDevMode;
+ procedure GetDC;
+ procedure FontChanged(Sender: TObject);
+ public
+ constructor Create(const AName, APort: String); override;
+ destructor Destroy; override;
+ procedure Init; override;
+ procedure RecreateDC;
+ procedure Abort; override;
+ procedure BeginDoc; override;
+ procedure BeginPage; override;
+ procedure BeginRAWDoc; override;
+ procedure EndDoc; override;
+ procedure EndPage; override;
+ procedure EndRAWDoc; override;
+ procedure WriteRAWDoc(const buf: AnsiString); override;
+ procedure SetViewParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended;
+ AOrientation: TPrinterOrientation); override;
+ procedure SetPrintParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
+ ABin, ADuplex, ACopies: Integer); override;
+ procedure PropertiesDlg; override;
+ function ShowPrintDialog: Boolean; override;
+ function UpdateDeviceCaps: Boolean;
+ property DeviceMode: PDeviceMode read FMode;
+ end;
+
+
+ TfrxPrinters = class(TfrxCustomPrinters)
+ protected
+ function GetDefaultPrinter: String; override;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure FillPrinters; override;
+ end;
+
+ TfrxPrinterCanvas = class(TCanvas)
+{$IFNDEF FMX}
+ private
+ FPrinter: TfrxCustomPrinter;
+ procedure UpdateFont;
+ public
+ procedure Changing; override;
+{$ENDIF}
+ end;
+
+
+
+function frxGetPaperDimensions(PaperSize: Integer; var Width, Height: Extended): Boolean;
+function ActualfrxPrinterClass : TfrxCustomPrintersClass;
+
+
+implementation
+
+uses
+ FMX.frxUtils, FMX.frxRes, FMX.frxFMX;
+
+
+type
+ TPaperInfo = {packed} record
+ Typ: Integer;
+ Name: String;
+ X, Y: Integer;
+ end;
+
+
+const
+ PAPERCOUNT = 66;
+ PaperInfo: array[0..PAPERCOUNT - 1] of TPaperInfo = (
+ (Typ:1; Name: ''; X:2159; Y:2794),
+ (Typ:2; Name: ''; X:2159; Y:2794),
+ (Typ:3; Name: ''; X:2794; Y:4318),
+ (Typ:4; Name: ''; X:4318; Y:2794),
+ (Typ:5; Name: ''; X:2159; Y:3556),
+ (Typ:6; Name: ''; X:1397; Y:2159),
+ (Typ:7; Name: ''; X:1842; Y:2667),
+ (Typ:8; Name: ''; X:2970; Y:4200),
+ (Typ:9; Name: ''; X:2100; Y:2970),
+ (Typ:10; Name: ''; X:2100; Y:2970),
+ (Typ:11; Name: ''; X:1480; Y:2100),
+ (Typ:12; Name: ''; X:2500; Y:3540),
+ (Typ:13; Name: ''; X:1820; Y:2570),
+ (Typ:14; Name: ''; X:2159; Y:3302),
+ (Typ:15; Name: ''; X:2150; Y:2750),
+ (Typ:16; Name: ''; X:2540; Y:3556),
+ (Typ:17; Name: ''; X:2794; Y:4318),
+ (Typ:18; Name: ''; X:2159; Y:2794),
+ (Typ:19; Name: ''; X:984; Y:2254),
+ (Typ:20; Name: ''; X:1048; Y:2413),
+ (Typ:21; Name: ''; X:1143; Y:2635),
+ (Typ:22; Name: ''; X:1207; Y:2794),
+ (Typ:23; Name: ''; X:1270; Y:2921),
+ (Typ:24; Name: ''; X:4318; Y:5588),
+ (Typ:25; Name: ''; X:5588; Y:8636),
+ (Typ:26; Name: ''; X:8636; Y:11176),
+ (Typ:27; Name: ''; X:1100; Y:2200),
+ (Typ:28; Name: ''; X:1620; Y:2290),
+ (Typ:29; Name: ''; X:3240; Y:4580),
+ (Typ:30; Name: ''; X:2290; Y:3240),
+ (Typ:31; Name: ''; X:1140; Y:1620),
+ (Typ:32; Name: ''; X:1140; Y:2290),
+ (Typ:33; Name: ''; X:2500; Y:3530),
+ (Typ:34; Name: ''; X:1760; Y:2500),
+ (Typ:35; Name: ''; X:1760; Y:1250),
+ (Typ:36; Name: ''; X:1100; Y:2300),
+ (Typ:37; Name: ''; X:984; Y:1905),
+ (Typ:38; Name: ''; X:920; Y:1651),
+ (Typ:39; Name: ''; X:3778; Y:2794),
+ (Typ:40; Name: ''; X:2159; Y:3048),
+ (Typ:41; Name: ''; X:2159; Y:3302),
+ (Typ:42; Name: ''; X:2500; Y:3530),
+ (Typ:43; Name: ''; X:1000; Y:1480),
+ (Typ:44; Name: ''; X:2286; Y:2794),
+ (Typ:45; Name: ''; X:2540; Y:2794),
+ (Typ:46; Name: ''; X:3810; Y:2794),
+ (Typ:47; Name: ''; X:2200; Y:2200),
+ (Typ:50; Name: ''; X:2355; Y:3048),
+ (Typ:51; Name: ''; X:2355; Y:3810),
+ (Typ:52; Name: ''; X:2969; Y:4572),
+ (Typ:53; Name: ''; X:2354; Y:3223),
+ (Typ:54; Name: ''; X:2101; Y:2794),
+ (Typ:55; Name: ''; X:2100; Y:2970),
+ (Typ:56; Name: ''; X:2355; Y:3048),
+ (Typ:57; Name: ''; X:2270; Y:3560),
+ (Typ:58; Name: ''; X:3050; Y:4870),
+ (Typ:59; Name: ''; X:2159; Y:3223),
+ (Typ:60; Name: ''; X:2100; Y:3300),
+ (Typ:61; Name: ''; X:1480; Y:2100),
+ (Typ:62; Name: ''; X:1820; Y:2570),
+ (Typ:63; Name: ''; X:3220; Y:4450),
+ (Typ:64; Name: ''; X:1740; Y:2350),
+ (Typ:65; Name: ''; X:2010; Y:2760),
+ (Typ:66; Name: ''; X:4200; Y:5940),
+ (Typ:67; Name: ''; X:2970; Y:4200),
+ (Typ:68; Name: ''; X:3220; Y:4450));
+
+
+
+
+
+function frxGetPaperDimensions(PaperSize: Integer; var Width, Height: Extended): Boolean;
+var
+ i: Integer;
+begin
+ Result := False;
+ for i := 0 to PAPERCOUNT - 1 do
+ if PaperInfo[i].Typ = PaperSize then
+ begin
+ Width := PaperInfo[i].X / 10;
+ Height := PaperInfo[i].Y / 10;
+ Result := True;
+ break;
+ end;
+end;
+
+
+{$IFNDEF FMX}
+{ TfrxPrinterCanvas }
+
+procedure TfrxPrinterCanvas.Changing;
+begin
+ inherited;
+ UpdateFont;
+end;
+
+procedure TfrxPrinterCanvas.UpdateFont;
+var
+ FontSize: Integer;
+begin
+ if FPrinter.DPI.Y <> Font.PixelsPerInch then
+ begin
+ FontSize := Font.Size;
+ Font.PixelsPerInch := FPrinter.DPI.Y;
+ Font.Size := FontSize;
+ end;
+end;
+{$ENDIF}
+
+
+
+destructor TfrxPrinter.Destroy;
+begin
+ if Assigned(FOldWinPrinter) then
+ SetPrinter(FOldWinPrinter);
+ FreeDevMode;
+ FWinPrinter.Free;
+ inherited;
+end;
+
+procedure TfrxPrinter.Init;
+
+ procedure FillPapers;
+ var
+ i, PaperSizesCount: Integer;
+ PaperSizes: array[0..255] of Word;
+ PaperNames: PChar;
+ begin
+ FillChar(PaperSizes, SizeOf(PaperSizes), 0);
+ PaperSizesCount := DeviceCapabilities(PChar(FName), PChar(FPort), DC_PAPERS, @PaperSizes, FMode);
+ GetMem(PaperNames, PaperSizesCount * 64 * sizeof(char));
+ DeviceCapabilities(PChar(FName), PChar(FPort), DC_PAPERNAMES, PaperNames, FMode);
+ for i := 0 to PaperSizesCount - 1 do
+ if PaperSizes[i] <> 256 then
+ FPapers.AddObject(StrPas(PWideChar(PaperNames + i * 64)), Pointer(PaperSizes[i]));
+
+ FreeMem(PaperNames, PaperSizesCount * 64 * sizeof(char));
+ end;
+
+ procedure FillBins;
+ var
+ i, BinsCount: Integer;
+ BinNumbers: array[0..255] of Word;
+ BinNames: PChar;
+ begin
+ FillChar(BinNumbers, SizeOf(BinNumbers), 0);
+ BinsCount := DeviceCapabilities(PChar(FName), PChar(FPort), DC_BINS, @BinNumbers[0], FMode);
+ GetMem(BinNames, BinsCount * 24 * sizeof(char));
+ try
+ DeviceCapabilities(PChar(FName), PChar(FPort), DC_BINNAMES, BinNames, FMode);
+ except
+ end;
+
+ for i := 0 to BinsCount - 1 do
+ if BinNumbers[i] <> DMBIN_AUTO then
+ FBins.AddObject(StrPas(PwideChar(BinNames + i * 24)), Pointer(BinNumbers[i]));
+
+ FreeMem(BinNames, BinsCount * 24 * sizeof(char));
+ end;
+
+begin
+ if FInitialized then Exit;
+ CreateDevMode;
+ if FDeviceMode = 0 then Exit;
+ RecreateDC;
+
+ if not UpdateDeviceCaps then
+ begin
+ FreeDevMode;
+ Exit;
+ end;
+
+ FDefPaper := FMode.dmPaperSize;
+ FDefBin := FMode.dmDefaultSource;
+ FDefDuplex := FMode.dmDuplex;
+ FPaper := FDefPaper;
+ FDefPaperWidth := FPaperWidth;
+ FDefPaperHeight := FPaperHeight;
+ if FMode.dmOrientation = DMORIENT_PORTRAIT then
+ FDefOrientation := poPortrait else
+ FDefOrientation := poLandscape;
+ FOrientation := FDefOrientation;
+ FillPapers;
+ FillBins;
+ FBin := -1;
+ FDuplex := -1;
+
+ FInitialized := True;
+ FOldWinPrinter := nil;
+end;
+
+procedure TfrxPrinter.Abort;
+begin
+ AbortDoc(FDC);
+ EndDoc;
+end;
+
+procedure TfrxPrinter.BeginDoc;
+var
+ DocInfo: TDocInfo;
+begin
+ FPrinting := True;
+ FillChar(DocInfo, SizeOf(DocInfo), 0);
+ DocInfo.cbSize := SizeOf(DocInfo);
+ if FTitle <> '' then
+ DocInfo.lpszDocName := PChar(FTitle)
+ else DocInfo.lpszDocName := PChar('Fast Report Document');
+
+ if FFileName <> '' then
+ DocInfo.lpszOutput := PChar(FFileName);
+
+ RecreateDC;
+ StartDoc(FDC, DocInfo);
+end;
+
+procedure TfrxPrinter.BeginPage;
+begin
+ StartPage(FDC);
+{$IFDEF DELPHI28}
+ Canvas.BeginScene;
+{$ENDIF}
+end;
+
+procedure TfrxPrinter.EndDoc;
+var
+ Saved8087CW: Word;
+begin
+ Saved8087CW := Default8087CW;
+ Set8087CW($133F);
+ try
+ Winapi.Windows.EndDoc(FDC);
+ except
+ end;
+ Set8087CW(Saved8087CW);
+
+ FPrinting := False;
+ RecreateDC;
+ FBin := -1;
+ FDuplex := -1;
+
+ FMode.dmFields := FMode.dmFields or DM_DEFAULTSOURCE or DM_DUPLEX;
+ FMode.dmDefaultSource := FDefBin;
+ FMode.dmDuplex := FDefDuplex;
+ if FCanvas <> nil then
+ FCanvas.Free;
+
+ FDC := ResetDC(FDC, FMode^);
+ TFakePrinterWin(FWinPrinter).FDC := FDC;
+{$IFNDEF Delphi17}
+ FCanvas := DefaultCanvasClass.CreateFromPrinter(FWinPrinter);
+{$ELSE}
+ FCanvas := TCanvasManager.CreateFromPrinter(FWinPrinter);
+{$ENDIF}
+ FOnChangedFont := THackCanvas(FCanvas).FFont.OnChanged;
+ THackCanvas(FCanvas).FFont.OnChanged := FontChanged;
+ SetPrinter(FOldWinPrinter);
+ FOldWinPrinter := nil;
+end;
+
+procedure TfrxPrinter.EndPage;
+begin
+ Winapi.Windows.EndPage(FDC);
+{$IFDEF Delphi28}
+ Canvas.EndScene;
+{$ENDIF}
+end;
+
+procedure TfrxPrinter.BeginRAWDoc;
+var
+ DocInfo1: TDocInfo1;
+begin
+ RecreateDC;
+ DocInfo1.pDocName := PChar(FTitle);
+ DocInfo1.pOutputFile := nil;
+ DocInfo1.pDataType := 'RAW';
+ StartDocPrinter(FHandle, 1, @DocInfo1);
+ StartPagePrinter(FHandle);
+end;
+
+procedure TfrxPrinter.EndRAWDoc;
+begin
+ EndPagePrinter(FHandle);
+ EndDocPrinter(FHandle);
+end;
+
+procedure TfrxPrinter.WriteRAWDoc(const buf: AnsiString);
+var
+ N: DWORD;
+begin
+ WritePrinter(FHandle, PAnsiChar(buf), Length(buf), N);
+end;
+
+constructor TfrxPrinter.Create(const AName, APort: String);
+begin
+ inherited Create(AName, APort);
+ FWinPrinter := TFakePrinterWin.Create;
+end;
+
+procedure TfrxPrinter.CreateDevMode;
+var
+ bufSize: Integer;
+begin
+ if OpenPrinter(PChar(FName), FHandle, nil) then
+ begin
+ bufSize := DocumentProperties(0, FHandle, PChar(FName), nil, nil, 0);
+ if bufSize > 0 then
+ begin
+ FDeviceMode := GlobalAlloc(GHND, bufSize);
+ if FDeviceMode <> 0 then
+ begin
+ FMode := GlobalLock(FDeviceMode);
+ if DocumentProperties(0, FHandle, PChar(FName), FMode^, FMode^,
+ DM_OUT_BUFFER) < 0 then
+ begin
+ GlobalUnlock(FDeviceMode);
+ GlobalFree(FDeviceMode);
+ FDeviceMode := 0;
+ FMode := nil;
+ end
+ end;
+ end;
+ end;
+end;
+
+procedure TfrxPrinter.FontChanged(Sender: TObject);
+begin
+ if Assigned(FOnChangedFont) then
+ FOnChangedFont(Sender);
+ //if FDPI.Y <> FCanvas.Font.PixelsPerInch then
+ begin
+ //FontSize := Round(FCanvas.Font.Size);
+ ///Font.PixelsPerInch := FPrinter.DPI.Y;
+ //FCanvas.Font.Size := MulDiv(FontSize, DPI.Y, 72)
+ end;
+end;
+
+procedure TfrxPrinter.FreeDevMode;
+begin
+ //FCanvas.Handle := 0;
+ if FDC <> 0 then
+ DeleteDC(FDC);
+ if FHandle <> 0 then
+ ClosePrinter(FHandle);
+ if FDeviceMode <> 0 then
+ begin
+ GlobalUnlock(FDeviceMode);
+ GlobalFree(FDeviceMode);
+ end;
+ FDeviceMode := 0;
+ FDC := 0;
+ FHandle := 0;
+ if FCanvas <> nil then
+ FCanvas.Free;
+end;
+
+procedure TfrxPrinter.RecreateDC;
+begin
+ if FDC <> 0 then
+ try
+ DeleteDC(FDC);
+ except
+ end;
+ FDC := 0;
+ GetDC;
+end;
+
+procedure TfrxPrinter.GetDC;
+begin
+ if FDC = 0 then
+ begin
+ if FPrinting then
+ FDC := CreateDC(PChar(FDriver), PChar(FName), nil, FMode) else
+ FDC := CreateIC(PChar(FDriver), PChar(FName), nil, FMode);
+
+ TFakePrinterWin(FWinPrinter).FDC := FDC;
+ //FWinPrinter.PageHeight
+ TFakePrinterWin(FWinPrinter).FState := TPrinterState.psHandleDC;
+{$IFNDEF Delphi17}
+ if FCanvas <> nil then
+ FCanvas.CreateFromPrinter(FWinPrinter)
+ else
+ FCanvas := DefaultCanvasClass.CreateFromPrinter(FWinPrinter);
+{$ELSE}
+ if FCanvas <> nil then
+ FreeAndNil(FCanvas);
+
+ FCanvas := TCanvasManager.CreateFromPrinter(FWinPrinter);
+{$ENDIF}
+ FOnChangedFont := THackCanvas(FCanvas).FFont.OnChanged;
+ THackCanvas(FCanvas).FFont.OnChanged := FontChanged;
+{$IFDEF Delphi28}
+ FCanvas.SetSize(Round(FPaperWidth * FDPI.X / 25.4), Round(FPaperHeight * FDPI.Y / 25.4));
+{$ENDIF}
+
+// FDC := THackPrinterWin(FWinPrinter).FDC;
+//
+// THackPrinterWin(FWinPrinter).SetState(TPrinterState.psNoHandle);
+// THackPrinterWin(FWinPrinter).SetState(TPrinterState.psHandleDC);
+// // on a second document printing process, the canvas must reconnect its
+// // underlying objects to the new DC
+// THackPrinterWin(FWinPrinter).Canvas.CreateFromPrinter(FWinPrinter);
+// THackPrinterWin(FWinPrinter).SetCanvasDefaultSettings;
+// FCanvas := THackPrinterWin(FWinPrinter).Canvas;
+// FDC := THackPrinterWin(FWinPrinter).FDC;
+// FHandle := THackPrinterWin(FWinPrinter).FPrinterHandle;
+// FMode := THackPrinterWin(FWinPrinter).FDevMode;
+// FDeviceMode := THackPrinterWin(FWinPrinter).FDeviceMode;
+
+ //FCanvas.Handle := FDC;
+ //FCanvas.Refresh;
+ //FCanvas.UpdateFont;
+ end;
+end;
+
+procedure TfrxPrinter.SetViewParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation);
+begin
+ if APaperSize <> 256 then
+ begin
+ FMode.dmFields := DM_PAPERSIZE or DM_ORIENTATION;
+ FMode.dmPaperSize := APaperSize;
+ if AOrientation = poPortrait then
+ FMode.dmOrientation := DMORIENT_PORTRAIT else
+ FMode.dmOrientation := DMORIENT_LANDSCAPE;
+ RecreateDC;
+ if not UpdateDeviceCaps then Exit;
+ end
+ else
+ begin
+ // copy the margins from A4 paper
+ SetViewParams(DMPAPER_A4, 0, 0, AOrientation);
+ FPaperHeight := APaperHeight;
+ FPaperWidth := APaperWidth;
+ end;
+
+ FPaper := APaperSize;
+ FOrientation := AOrientation;
+end;
+
+function TfrxPrinter.ShowPrintDialog: Boolean;
+begin
+ Result := False;
+end;
+
+procedure TfrxPrinter.SetPrintParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
+ ABin, ADuplex, ACopies: Integer);
+begin
+ FMode.dmFields := FMode.dmFields or DM_PAPERSIZE or DM_ORIENTATION or DM_COPIES
+ or DM_DEFAULTSOURCE;
+
+
+ if APaperSize = 256 then
+ begin
+ FMode.dmFields := FMode.dmFields or DM_PAPERLENGTH or DM_PAPERWIDTH;
+ if AOrientation = poLandscape then
+ begin
+ FMode.dmPaperLength := Round(APaperWidth * 10);
+ FMode.dmPaperWidth := Round(APaperHeight * 10);
+ end
+ else
+ begin
+ FMode.dmPaperLength := Round(APaperHeight * 10);
+ FMode.dmPaperWidth := Round(APaperWidth * 10);
+ end;
+ end
+ else
+ begin
+ FMode.dmPaperLength := 0;
+ FMode.dmPaperWidth := 0;
+ end;
+
+ FMode.dmPaperSize := APaperSize;
+ if AOrientation = poPortrait then
+ FMode.dmOrientation := DMORIENT_PORTRAIT else
+ FMode.dmOrientation := DMORIENT_LANDSCAPE;
+
+ FMode.dmCopies := ACopies;
+ if ABin = DMBIN_AUTO then
+ if FBin <> -1 then
+ ABin := FBin
+ else
+ ABin := DefBin;
+ FMode.dmDefaultSource := ABin;
+
+ if ADuplex = 0 then
+ ADuplex := FDefDuplex
+ else Inc(ADuplex);
+ if ADuplex = 4 then
+ ADuplex := DMDUP_SIMPLEX;
+ if FDuplex <> -1 then
+ ADuplex := FDuplex;
+ if ADuplex <> 1 then
+ FMode.dmFields := FMode.dmFields or DM_DUPLEX;
+ FMode.dmDuplex := ADuplex;
+
+
+ { strange behaviour with GDI+ canvas
+ need to release canvas and all gdi+ objects before call ResetDC
+ otherwise it return error }
+ if FCanvas <> nil then
+ FCanvas.Free;
+
+ FDC := ResetDC(FDC, FMode^);
+ FDC := ResetDC(FDC, FMode^); // needed for some printers
+ TFakePrinterWin(FWinPrinter).FDC := FDC;
+{$IFNDEF Delphi17}
+ FCanvas := DefaultCanvasClass.CreateFromPrinter(FWinPrinter);
+{$ELSE}
+ FCanvas := TCanvasManager.CreateFromPrinter(FWinPrinter);
+{$ENDIF}
+ FWinPrinter.FCanvas := FCanvas;
+ if {PrinterAssigned and} not Assigned(FOldWinPrinter) then
+ FOldWinPrinter := TPrinterWin(Printer);
+ SetPrinter(FWinPrinter);
+ FOnChangedFont := THackCanvas(FCanvas).FFont.OnChanged;
+ THackCanvas(FCanvas).FFont.OnChanged := FontChanged;
+
+
+ //FCanvas.Refresh;
+ if not UpdateDeviceCaps then Exit;
+ FPaper := APaperSize;
+ FOrientation := AOrientation;
+{$IFDEF Delphi28}
+ FCanvas.SetSize(Round(FPaperWidth * FDPI.X / 25.4), Round(FPaperHeight * FDPI.Y / 25.4));
+{$ENDIF}
+end;
+
+function TfrxPrinter.UpdateDeviceCaps: Boolean;
+begin
+ Result := True;
+ if FDC = 0 then GetDC;
+
+ FDPI := Point(GetDeviceCaps(FDC, LOGPIXELSX), GetDeviceCaps(FDC, LOGPIXELSY));
+ if (FDPI.X = 0) or (FDPI.Y = 0) then
+ begin
+ Result := False;
+ frxErrorMsg('Printer selected is not valid');
+ Exit;
+ end;
+ FPaperHeight := Round(GetDeviceCaps(FDC, PHYSICALHEIGHT) / FDPI.Y * 25.4);
+ FPaperWidth := Round(GetDeviceCaps(FDC, PHYSICALWIDTH) / FDPI.X * 25.4);
+ FLeftMargin := Round(GetDeviceCaps(FDC, PHYSICALOFFSETX) / FDPI.X * 25.4);
+ FTopMargin := Round(GetDeviceCaps(FDC, PHYSICALOFFSETY) / FDPI.Y * 25.4);
+ FRightMargin := FPaperWidth - Round(GetDeviceCaps(FDC, HORZRES) / FDPI.X * 25.4) - FLeftMargin;
+ FBottomMargin := FPaperHeight - Round(GetDeviceCaps(FDC, VERTRES) / FDPI.Y * 25.4) - FTopMargin;
+end;
+
+procedure TfrxPrinter.PropertiesDlg;
+var
+ h: THandle;
+ PrevDuplex: Integer;
+begin
+ PrevDuplex := FMode.dmDuplex;
+ //if Screen.ActiveForm <> nil then
+ // h := Screen.ActiveForm.Handle else
+ h := 0;
+ if DocumentProperties(h, FHandle, PChar(FName), FMode^,
+ FMode^, DM_IN_BUFFER or DM_OUT_BUFFER or DM_IN_PROMPT) > 0 then
+ begin
+ FBin := FMode.dmDefaultSource;
+ if PrevDuplex <> FMode.dmDuplex then
+ FDuplex := FMode.dmDuplex;
+ RecreateDC;
+ end;
+end;
+
+{ TfrxPrinters }
+
+constructor TfrxPrinters.Create;
+begin
+ Inherited;
+end;
+
+destructor TfrxPrinters.Destroy;
+begin
+ inherited;
+end;
+
+
+
+function TfrxPrinters.GetDefaultPrinter: String;
+var
+ prnName: array[0..255] of Char;
+begin
+ GetProfileString('windows', 'device', '', prnName, 255);
+ Result := Copy(prnName, 1, Pos(',', prnName) - 1);
+end;
+
+
+procedure TfrxPrinters.FillPrinters;
+var
+ i, j: Integer;
+ Buf, prnInfo: PByte;
+ Flags, bufSize, prnCount: DWORD;
+ Level: Byte;
+ sl: TStringList;
+
+ procedure AddPrinter(ADevice, APort: String);
+ begin
+ FPrinterList.Add(TfrxPrinter.Create(ADevice, APort));
+ FPrinters.Add(ADevice);
+ end;
+
+begin
+ Clear;
+ if Win32Platform = VER_PLATFORM_WIN32_NT then
+ begin
+ Flags := PRINTER_ENUM_CONNECTIONS or PRINTER_ENUM_LOCAL;
+ Level := 4;
+ end
+ else
+ begin
+ Flags := PRINTER_ENUM_LOCAL;
+ Level := 5;
+ end;
+
+ bufSize := 0;
+ EnumPrinters(Flags, nil, Level, nil, 0, bufSize, prnCount);
+ if bufSize = 0 then Exit;
+
+ GetMem(Buf, bufSize);
+ try
+
+ if not EnumPrinters(Flags, nil, Level, PByte(Buf), bufSize, bufSize, prnCount) then
+ Exit;
+ prnInfo := Buf;
+ for i := 0 to prnCount - 1 do
+ if Level = 4 then
+ with PPrinterInfo4(prnInfo)^ do
+ begin
+ AddPrinter(pPrinterName, '');
+ Inc(prnInfo, SizeOf(TPrinterInfo4));
+ end
+ else
+ with PPrinterInfo5(prnInfo)^ do
+ begin
+ sl := TStringList.Create;
+ frxSetCommaText(pPortName, sl, ',');
+
+ for j := 0 to sl.Count - 1 do
+ AddPrinter(pPrinterName, sl[j]);
+
+ sl.Free;
+ Inc(prnInfo, SizeOf(TPrinterInfo5));
+ end;
+
+ finally
+ FreeMem(Buf, bufSize);
+ end;
+end;
+
+
+
+
+{ THackPrinterWin }
+
+procedure TFakePrinterWin.ActivePrinterChanged;
+begin
+//do nothing
+end;
+
+constructor TFakePrinterWin.Create;
+begin
+ //inherited;
+inherited;
+end;
+
+destructor TFakePrinterWin.Destroy;
+begin
+ FCanvas := nil;
+inherited;
+ //inherited;
+end;
+
+procedure TFakePrinterWin.DoAbortDoc;
+begin
+ //do nothing
+end;
+
+procedure TFakePrinterWin.DoBeginDoc;
+begin
+ //do nothing
+end;
+
+procedure TFakePrinterWin.DoEndDoc;
+begin
+ //do nothing
+end;
+
+procedure TFakePrinterWin.DoNewPage;
+begin
+ //do nothing
+
+end;
+
+function TFakePrinterWin.GetCanvas: TCanvas;
+begin
+ Result := FCanvas;
+end;
+
+function TFakePrinterWin.GetCapabilities: TPrinterCapabilities;
+begin
+ Result := FCapabilities;
+end;
+
+function TFakePrinterWin.GetNumCopies: Integer;
+begin
+ Result := 0;
+ //do nothing
+end;
+
+function TFakePrinterWin.GetOrientation: TPrinterOrientation;
+begin
+ Result := TPrinterOrientation.poPortrait;
+ //do nothing
+end;
+
+function TFakePrinterWin.GetPageHeight: Integer;
+begin
+ Result := FPageHeight;
+end;
+
+function TFakePrinterWin.GetPageWidth: Integer;
+begin
+ Result := FPageWidth;
+end;
+
+procedure TFakePrinterWin.RefreshFonts;
+begin
+ //do nothing
+end;
+
+procedure TFakePrinterWin.RefreshPrinterDevices;
+begin
+ //do nothing
+end;
+
+procedure TFakePrinterWin.SetDefaultPrinter;
+begin
+ //do nothing
+end;
+
+procedure TFakePrinterWin.SetNumCopies(Value: Integer);
+begin
+ //do nothing
+end;
+
+procedure TFakePrinterWin.SetOrientation(Value: TPrinterOrientation);
+begin
+ //do nothing
+end;
+
+function ActualfrxPrinterClass : TfrxCustomPrintersClass;
+begin
+ Result := TfrxPrinters;
+end;
+
+initialization
+
+finalization
+
+end.
+
diff --git a/LibD28/FMX.frxADOComponents.pas b/LibD28/FMX.frxADOComponents.pas
new file mode 100644
index 0000000..6071857
--- /dev/null
+++ b/LibD28/FMX.frxADOComponents.pas
@@ -0,0 +1,1051 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ ADO enduser components }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxADOComponents;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.Classes, System.SysUtils, FMX.frxClass, FMX.frxCustomDB, Data.DB, Data.Win.ADODB, Winapi.ADOInt
+, System.Variants, FMX.Types
+{$IFDEF QBUILDER}
+, FMX.fqbClass
+{$ENDIF};
+
+type
+[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
+ TfrxADOComponents = class(TfrxDBComponents)
+ private
+ FDefaultDatabase: TADOConnection;
+ FOldComponents: TfrxADOComponents;
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetDefaultDatabase(Value: TADOConnection);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function GetDescription: String; override;
+ published
+ property DefaultDatabase: TADOConnection read FDefaultDatabase write SetDefaultDatabase;
+ end;
+
+ TfrxADODatabase = class(TfrxCustomDatabase)
+ private
+ FDatabase: TADOConnection;
+ protected
+ procedure SetConnected(Value: Boolean); override;
+ procedure SetDatabaseName(const Value: String); override;
+ procedure SetLoginPrompt(Value: Boolean); override;
+ function GetConnected: Boolean; override;
+ function GetDatabaseName: String; override;
+ function GetLoginPrompt: Boolean; override;
+ procedure ADOBeforeConnect(Sende: TObject);
+ procedure ADOAfterDisconnect(Sende: TObject);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ procedure SetLogin(const Login, Password: String); override;
+ function ToString: WideString; override;
+ procedure FromString(const Connection: WideString); override;
+ property Database: TADOConnection read FDatabase;
+ published
+ property DatabaseName;
+ property LoginPrompt;
+ property Connected;
+ end;
+
+
+ TfrxADOTable = class(TfrxCustomTable)
+ private
+ FDatabase: TfrxADODatabase;
+ FTable: TADOTable;
+ procedure SetDatabase(Value: TfrxADODatabase);
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetMaster(const Value: TDataSource); override;
+ procedure SetMasterFields(const Value: String); override;
+ procedure SetIndexFieldNames(const Value: String); override;
+ procedure SetIndexName(const Value: String); override;
+ procedure SetTableName(const Value: String); override;
+ function GetIndexFieldNames: String; override;
+ function GetIndexName: String; override;
+ function GetTableName: String; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor DesignCreate(AOwner: TComponent; Flags: Word); override;
+ class function GetDescription: String; override;
+ procedure BeforeStartReport; override;
+ property Table: TADOTable read FTable;
+ published
+ property Database: TfrxADODatabase read FDatabase write SetDatabase;
+ end;
+
+ TfrxADOQuery = class(TfrxCustomQuery)
+ private
+ FDatabase: TfrxADODatabase;
+ FQuery: TADOQuery;
+ FStrings: TStrings;
+ FLock: Boolean;
+ procedure SetDatabase(Value: TfrxADODatabase);
+ function GetCommandTimeout: Integer;
+ procedure SetCommandTimeout(const Value: Integer);
+ function GetLockType: TADOLockType;
+ procedure SetLockType(const Value: TADOLockType);
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure OnChangeSQL(Sender: TObject); override;
+ procedure SetMaster(const Value: TDataSource); override;
+ procedure SetSQL(Value: TStrings); override;
+ function GetSQL: TStrings; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor DesignCreate(AOwner: TComponent; Flags: Word); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ procedure BeforeStartReport; override;
+ procedure UpdateParams; override;
+{$IFDEF QBUILDER}
+ function QBEngine: TfqbEngine; override;
+{$ENDIF}
+ property Query: TADOQuery read FQuery;
+ published
+ property CommandTimeout: Integer read GetCommandTimeout write SetCommandTimeout;
+ property Database: TfrxADODatabase read FDatabase write SetDatabase;
+ property LockType: TADOLockType read GetLockType write SetLockType;
+ end;
+
+{$IFDEF QBUILDER}
+ TfrxEngineADO = class(TfqbEngine)
+ private
+ FQuery: TADOQuery;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure ReadTableList(ATableList: TStrings); override;
+ procedure ReadFieldList(const ATableName: string; var AFieldList: TfqbFieldList); override;
+ function ResultDataSet: TDataSet; override;
+ procedure SetSQL(const Value: string); override;
+ end;
+{$ENDIF}
+
+procedure frxParamsToTParameters(Query: TfrxCustomQuery; Params: TParameters);
+procedure frxADOGetTableNames(conADO: TADOConnection; List: TStrings; SystemTables: Boolean);
+
+var
+ ADOComponents: TfrxADOComponents;
+
+implementation
+
+uses
+ FMX.frxADORTTI,
+{$IFNDEF NO_EDITORS}
+ FMX.frxADOEditor,
+{$ENDIF}
+ FMX.frxDsgnIntf, FMX.frxRes;
+
+type
+ THackQuery = class(TADOQuery);
+
+
+{ frxParamsToTParameters }
+
+procedure frxParamsToTParameters(Query: TfrxCustomQuery; Params: TParameters);
+var
+ i: Integer;
+ Item: TfrxParamItem;
+begin
+ for i := 0 to Params.Count - 1 do
+ if Query.Params.IndexOf(Params[i].Name) <> -1 then
+ begin
+ Item := Query.Params[Query.Params.IndexOf(Params[i].Name)];
+ Params[i].DataType := Item.DataType;
+ Params[i].Attributes := [paNullable];
+ if Trim(Item.Expression) <> '' then
+ if not (Query.IsLoading or Query.IsDesigning) then
+ begin
+ Query.Report.CurObject := Query.Name;
+ Item.Value := Query.Report.Calc(Item.Expression);
+ end;
+ Params[i].Value := Item.Value;
+ end;
+end;
+
+procedure frxADOGetTableNames(conADO: TADOConnection; List: TStrings; SystemTables: Boolean);
+var
+ tbl: TADODataSet;
+ s: string;
+begin
+ tbl := TADODataSet.Create(nil);
+ List.Clear;
+ try
+ conADO.OpenSchema(siTables, EmptyParam, EmptyParam, tbl);
+ tbl.First;
+ while not tbl.Eof do
+ begin
+ s := Trim(tbl.FieldByName('TABLE_SCHEMA').AsString);
+ if s <> '' then
+ List.Add(s + '.' + tbl.FieldByName('TABLE_NAME').AsString)
+ else
+ List.Add(tbl.FieldByName('TABLE_NAME').AsString);
+ tbl.Next;
+ end;
+ finally
+ tbl.Free;
+ end;
+end;
+
+{ TfrxDBComponents }
+
+constructor TfrxADOComponents.Create(AOwner: TComponent);
+begin
+ inherited;
+ FOldComponents := ADOComponents;
+ FDefaultDatabase := nil;
+ ADOComponents := Self;
+end;
+
+destructor TfrxADOComponents.Destroy;
+begin
+ if ADOComponents = Self then
+ ADOComponents := FOldComponents;
+ inherited;
+end;
+
+function TfrxADOComponents.GetDescription: String;
+begin
+ Result := 'ADO';
+end;
+
+procedure TfrxADOComponents.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited;
+ if (AComponent = FDefaultDatabase) and (Operation = opRemove) then
+ FDefaultDatabase := nil;
+end;
+
+
+{ TfrxADODatabase }
+
+constructor TfrxADODatabase.Create(AOwner: TComponent);
+begin
+ inherited;
+ FDatabase := TADOConnection.Create(nil);
+ FDatabase.BeforeConnect := ADOBeforeConnect;
+ FDatabase.AfterDisconnect := ADOAfterDisconnect;
+ Component := FDatabase;
+end;
+
+class function TfrxADODatabase.GetDescription: String;
+begin
+ Result := frxResources.Get('obADODB');
+end;
+
+function TfrxADODatabase.GetConnected: Boolean;
+begin
+ Result := FDatabase.Connected;
+end;
+
+function TfrxADODatabase.GetDatabaseName: String;
+begin
+ Result := FDatabase.ConnectionString;
+end;
+
+function TfrxADODatabase.GetLoginPrompt: Boolean;
+begin
+ Result := FDatabase.LoginPrompt;
+end;
+
+procedure TfrxADODatabase.SetConnected(Value: Boolean);
+begin
+ BeforeConnect(Value);
+ FDatabase.Connected := Value;
+end;
+
+procedure TfrxADODatabase.SetDatabaseName(const Value: String);
+begin
+ FDatabase.ConnectionString := Value;
+end;
+
+procedure TfrxADODatabase.SetLoginPrompt(Value: Boolean);
+begin
+ FDatabase.LoginPrompt := Value;
+end;
+
+procedure TfrxADODatabase.SetLogin(const Login, Password: String);
+var
+ i, j: Integer;
+ s: String;
+begin
+ s := DatabaseName;
+ i := Pos('USER ID=', AnsiUppercase(s));
+ if i <> 0 then
+ begin
+ for j := i to Length(s) do
+ if s[j] = ';' then
+ break;
+ Delete(s, i, j - i);
+ Insert('User ID=' + Login, s, i);
+ end
+ else
+ s := s + ';User ID=' + Login;
+
+ i := Pos('PASSWORD=', AnsiUppercase(s));
+ if i <> 0 then
+ begin
+ for j := i to Length(s) do
+ if s[j] = ';' then
+ break;
+ Delete(s, i, j - i);
+ Insert('Password=' + Password, s, i);
+ end
+ else
+ s := s + ';Password=' + Password;
+
+ DatabaseName := s;
+end;
+{$IFDEF FR_COM}
+// helper function that supports IUnknown and IDispatchable interfaces
+function TfrxADODatabase.COM_Object: TfrxADODatabase;
+var
+ idsp: IInterfaceComponentReference;
+begin
+ if not Assigned( VCLComObject ) then Result := Self
+ else try
+ idsp := IVCLComObject(VCLComObject) as IInterfaceComponentReference;
+ Result := TfrxADODatabase( idsp.GetComponent );
+ except
+ Result := Self;
+ end;
+end;
+
+function TfrxADODatabase.Get_ConnectionString: WideString; safecall;
+begin
+ Result := PChar(COM_Object.DatabaseName);
+end;
+
+procedure TfrxADODatabase.Set_ConnectionString(const Value: WideString); safecall;
+begin
+ COM_Object.DatabaseName := Value;
+end;
+
+function TfrxADODatabase.Get_LoginPrompt: WordBool; safecall;
+begin
+ Result := COM_Object.LoginPrompt;
+end;
+
+procedure TfrxADODatabase.Set_LoginPrompt(Value: WordBool); safecall;
+begin
+ COM_Object.LoginPrompt := Value;
+end;
+
+function TfrxADODatabase.Get_Connected: WordBool; safecall;
+begin
+ Result := COM_Object.Connected;
+end;
+
+procedure TfrxADODatabase.Set_Connected(Value: WordBool); safecall;
+begin
+ COM_Object.Connected := Value;
+end;
+
+function TfrxADODatabase.Get_ConnectionTimeout: Integer; safecall;
+begin
+ Result := COM_Object.FDatabase.ConnectionTimeout;
+end;
+
+procedure TfrxADODatabase.Set_ConnectionTimeout(Value: Integer); safecall;
+begin
+ COM_Object.FDatabase.ConnectionTimeout := Value;
+end;
+
+function TfrxADODatabase.Get_CommandTimeout: Integer; safecall;
+begin
+ Result := COM_Object.FDatabase.CommandTimeout;
+end;
+
+procedure TfrxADODatabase.Set_CommandTimeout(Value: Integer); safecall;
+begin
+ COM_Object.FDatabase.CommandTimeout := Value;
+end;
+{$ENDIF}
+
+procedure TfrxADODatabase.FromString(const Connection: WideString);
+begin
+ FDatabase.ConnectionString := Connection;
+end;
+
+function TfrxADODatabase.ToString: WideString;
+begin
+ Result := FDatabase.ConnectionString;
+end;
+
+procedure TfrxADODatabase.ADOBeforeConnect(Sende: TObject);
+var
+ Param: Boolean;
+begin
+ Param := True;
+ BeforeConnect(Param);
+end;
+
+procedure TfrxADODatabase.ADOAfterDisconnect(Sende: TObject);
+begin
+ AfterDisconnect;
+end;
+
+procedure TfrxADOComponents.SetDefaultDatabase(Value: TADOConnection);
+begin
+ if (Value <> nil) then
+ Value.FreeNotification(Self);
+
+ if FDefaultDatabase <> nil then
+ FDefaultDatabase.RemoveFreeNotification(Self);
+
+ FDefaultDatabase := Value;
+end;
+
+{ TfrxADOTable }
+
+constructor TfrxADOTable.Create(AOwner: TComponent);
+begin
+ FTable := TADOTable.Create(nil);
+ DataSet := FTable;
+ SetDatabase(nil);
+ inherited;
+end;
+
+constructor TfrxADOTable.DesignCreate(AOwner: TComponent; Flags: Word);
+var
+ i: Integer;
+ l: TList;
+begin
+ inherited;
+ l := Report.AllObjects;
+ for i := 0 to l.Count - 1 do
+ if TObject(l[i]) is TfrxADODatabase then
+ begin
+ SetDatabase(TfrxADODatabase(l[i]));
+ break;
+ end;
+end;
+
+class function TfrxADOTable.GetDescription: String;
+begin
+ Result := frxResources.Get('obADOTb');
+end;
+
+procedure TfrxADOTable.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FDatabase) then
+ SetDatabase(nil);
+end;
+
+procedure TfrxADOTable.SetDatabase(Value: TfrxADODatabase);
+begin
+ FDatabase := Value;
+ if Value <> nil then
+ FTable.Connection := Value.Database
+ else if ADOComponents <> nil then
+ FTable.Connection := ADOComponents.DefaultDatabase
+ else
+ FTable.Connection := nil;
+ DBConnected := FTable.Connection <> nil;
+end;
+
+function TfrxADOTable.GetIndexFieldNames: String;
+begin
+ Result := FTable.IndexFieldNames;
+end;
+
+function TfrxADOTable.GetIndexName: String;
+begin
+ Result := FTable.IndexName;
+end;
+
+function TfrxADOTable.GetTableName: String;
+begin
+ Result := FTable.TableName;
+end;
+
+procedure TfrxADOTable.SetIndexFieldNames(const Value: String);
+begin
+ FTable.IndexFieldNames := Value;
+end;
+
+procedure TfrxADOTable.SetIndexName(const Value: String);
+begin
+ FTable.IndexName := Value;
+end;
+
+procedure TfrxADOTable.SetTableName(const Value: String);
+begin
+ FTable.TableName := Value;
+end;
+
+procedure TfrxADOTable.SetMaster(const Value: TDataSource);
+begin
+ FTable.MasterSource := Value;
+end;
+
+procedure TfrxADOTable.SetMasterFields(const Value: String);
+begin
+ FTable.MasterFields := Value;
+end;
+
+procedure TfrxADOTable.BeforeStartReport;
+begin
+ SetDatabase(FDatabase);
+end;
+
+{$IFDEF FR_COM}
+// helper function that supports IUnknown and IDispatchable interfaces
+function TfrxADOTable.COM_Object: TfrxADOTable;
+var
+ idsp: IInterfaceComponentReference;
+begin
+ if not Assigned( VCLComObject ) then Result := Self
+ else try
+ idsp := IVCLComObject(VCLComObject) as IInterfaceComponentReference;
+ Result := TfrxADOTable( idsp.GetComponent );
+ except
+ Result := Self;
+ end;
+end;
+
+function TfrxADOTable.Get_DataBase(out Value: IfrxADODatabase): HResult; stdcall;
+begin
+ Value := COM_Object.Database;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Set_DataBase(const Value: IfrxADODatabase): HResult; stdcall;
+var
+ idsp : IInterfaceComponentReference;
+ WorkingObject: TfrxADOTable;
+begin
+ WorkingObject := COM_Object;
+ if Value <> nil then
+ begin
+ Result := Value.QueryInterface( IInterfaceComponentReference, idsp);
+ if Result = S_OK then
+ WorkingObject.Database := TfrxADODatabase( idsp.GetComponent );
+ end
+ else
+ begin
+ WorkingObject.Database := nil;
+ Result := S_OK;
+ end;
+end;
+
+function TfrxADOTable.Get_IndexName(out Value: WideString): HResult; stdcall;
+begin
+ Value := COM_Object.FTable.IndexName;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Set_IndexName(const Value: WideString): HResult; stdcall;
+begin
+ COM_Object.FTable.IndexName := Value;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Get_TableName( out Value : WideString): HResult; stdcall;
+begin
+ Value := COM_Object.FTable.TableName;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Set_TableName(const Value: WideString): HResult; stdcall;
+begin
+ COM_Object.FTable.TableName := Value;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Get_Name(out Value: WideString): HResult; stdcall;
+begin
+ Value := COM_Object.Name;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Set_Name(const Value: WideString): HResult; stdcall;
+begin
+ COM_Object.Name := Value;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Set_Master(const Value: IfrxDataSet): HResult; stdcall;
+var
+ idsp : IInterfaceComponentReference;
+ WorkingObject: TfrxADOTable;
+begin
+ try
+ WorkingObject := COM_Object;
+ if Value <> nil then
+ begin
+ Result := Value.QueryInterface( IInterfaceComponentReference, idsp);
+ if Result = S_OK then
+ WorkingObject.Master := TfrxDBDataSet( idsp.GetComponent );
+ end
+ else
+ begin
+ WorkingObject.Master := nil;
+ Result := S_OK;
+ end;
+ except
+ Result := E_INVALIDARG;
+ end;
+end;
+
+function TfrxADOTable.Get_MasterFileds(out Value: WideString): HResult; stdcall;
+begin
+ Value := COM_Object.MasterFields;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Set_MasterFileds(const Value: WideString): HResult; stdcall;
+begin
+ COM_Object.MasterFields := Value;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Get_DataBaseEx(out Value: IfrxADODatabase): HResult; stdcall;
+begin
+ Value := COM_Object.Database;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Set_DataBaseEx(const Value: IfrxADODatabase): HResult; stdcall;
+begin
+ Result := Set_DataBase(value);
+end;
+
+function TfrxADOTable._Set_DataBaseEx(var Value: IfrxADODatabase): HResult; stdcall;
+begin
+ Result := Set_DataBase(value);
+end;
+
+function TfrxADOTable.Get_FieldsCount(out Value: Integer): HResult; stdcall;
+begin
+ Value := COM_Object.FTable.FieldDefs.Count;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.FieldName(Index: Integer; out Name: WideString): HResult; stdcall;
+begin
+ Result := E_FAIL;
+ if (Index < 0) or (Index > COM_Object.FTable.Fields.Count) then exit;
+ Name := COM_Object.FTable.Fields.Fields[Index].FieldName;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Get_Active(out Value: WordBool): HResult; stdcall;
+begin
+ Value := COM_Object.Active;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Set_Active(Value: WordBool): HResult; stdcall;
+begin
+ COM_Object.Active := Value;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.FieldType(Index: Integer; out Value: frxFieldType): HResult; stdcall;
+begin
+ Value := frxFieldType(COM_Object.FTable.Fields.Fields[Index].DataType);
+ Result := S_OK;
+end;
+
+function TfrxADOTable.DisplayWidth(Index: Integer; out Value: Integer): HResult; stdcall;
+begin
+ Value := COM_Object.FTable.Fields.Fields[Index].DisplayWidth;
+ Result := S_OK;
+end;
+{$ENDIF}
+
+{ TfrxADOQuery }
+
+constructor TfrxADOQuery.Create(AOwner: TComponent);
+begin
+ FStrings := TStringList.Create;
+ FQuery := TADOQuery.Create(nil);
+{$IFDEF Delphi7}
+ FQuery.LockType := ltReadOnly;
+{$ENDIF}
+ Dataset := FQuery;
+ SetDatabase(nil);
+ FLock := False;
+ inherited;
+end;
+
+constructor TfrxADOQuery.DesignCreate(AOwner: TComponent; Flags: Word);
+var
+ i: Integer;
+ l: TList;
+begin
+ inherited;
+ l := Report.AllObjects;
+ for i := 0 to l.Count - 1 do
+ if TObject(l[i]) is TfrxADODatabase then
+ begin
+ SetDatabase(TfrxADODatabase(l[i]));
+ break;
+ end;
+end;
+
+destructor TfrxADOQuery.Destroy;
+begin
+ FStrings.Free;
+ inherited;
+end;
+
+class function TfrxADOQuery.GetDescription: String;
+begin
+ Result := frxResources.Get('obADOQ');
+end;
+
+procedure TfrxADOQuery.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FDatabase) then
+ SetDatabase(nil);
+end;
+
+function TfrxADOQuery.GetSQL: TStrings;
+begin
+ FLock := True;
+ FStrings.Assign(FQuery.SQL);
+ FLock := False;
+ Result := FStrings;
+end;
+
+procedure TfrxADOQuery.SetSQL(Value: TStrings);
+begin
+ FQuery.SQL.Assign(Value);
+ FStrings.Assign(FQuery.SQL);
+end;
+
+procedure TfrxADOQuery.SetDatabase(Value: TfrxADODatabase);
+begin
+ FDatabase := Value;
+ if Value <> nil then
+ FQuery.Connection := Value.Database
+ else if ADOComponents <> nil then
+ FQuery.Connection := ADOComponents.DefaultDatabase
+ else
+ FQuery.Connection := nil;
+ DBConnected := FQuery.Connection <> nil;
+end;
+
+procedure TfrxADOQuery.SetMaster(const Value: TDataSource);
+begin
+ FQuery.DataSource := Value;
+end;
+
+function TfrxADOQuery.GetCommandTimeout: Integer;
+begin
+ Result := THackQuery(FQuery).CommandTimeout;
+end;
+
+procedure TfrxADOQuery.SetCommandTimeout(const Value: Integer);
+begin
+ THackQuery(FQuery).CommandTimeout := Value;
+end;
+
+procedure TfrxADOQuery.UpdateParams;
+begin
+ frxParamsToTParameters(Self, FQuery.Parameters);
+end;
+
+procedure TfrxADOQuery.OnChangeSQL(Sender: TObject);
+var
+ i, ind: Integer;
+ Param: TfrxParamItem;
+ QParam: TParameter;
+begin
+ if not FLock then
+ begin
+ { needed to update parameters }
+ FQuery.SQL.Text := '';
+ FQuery.SQL.Assign(FStrings);
+ inherited;
+
+ { fill datatype automatically, if possible }
+ for i := 0 to FQuery.Parameters.Count - 1 do
+ begin
+ QParam := FQuery.Parameters[i];
+ ind := Params.IndexOf(QParam.Name);
+ if ind <> -1 then
+ begin
+ Param := Params[ind];
+ if (Param.DataType = ftUnknown) and (QParam.DataType <> ftUnknown) then
+ Param.DataType := QParam.DataType;
+ end;
+ end;
+ end;
+end;
+
+procedure TfrxADOQuery.BeforeStartReport;
+begin
+ SetDatabase(FDatabase);
+ { needed to update parameters }
+ SQL.Text := SQL.Text;
+end;
+
+{$IFDEF QBUILDER}
+function TfrxADOQuery.QBEngine: TfqbEngine;
+begin
+ Result := TfrxEngineADO.Create(nil);
+ TfrxEngineADO(Result).FQuery.Connection := FQuery.Connection;
+end;
+{$ENDIF}
+
+{$IFDEF Delphi7}
+function TfrxADOQuery.GetLockType: TADOLockType;
+begin
+ Result := FQuery.LockType;
+end;
+
+procedure TfrxADOQuery.SetLockType(const Value: TADOLockType);
+begin
+ FQuery.LockType := Value;
+end;
+{$ENDIF}
+
+{$IFDEF FR_COM}
+// helper function that supports IUnknown and IDispatchable interfaces
+function TfrxADOQuery.COM_Object: TfrxADOQuery;
+var
+ idsp: IInterfaceComponentReference;
+begin
+ if not Assigned( VCLComObject ) then Result := Self
+ else try
+ idsp := IVCLComObject(VCLComObject) as IInterfaceComponentReference;
+ Result := TfrxADOQuery( idsp.GetComponent );
+ except
+ Result := Self;
+ end;
+end;
+
+function TfrxADOQuery.Get_Database: IfrxADODatabase; safecall;
+begin
+ Result := COM_Object.Database;
+end;
+
+procedure TfrxADOQuery.Set_Database(const Value: IfrxADODatabase); safecall;
+//var
+// idsp : IInterfaceComponentReference;
+begin
+// with COM_Object do
+// if Val <> nil then
+// begin
+// Result := Val.QueryInterface( IInterfaceComponentReference, idsp );
+// if Result = S_OK then Database := TfrxADODatabase( idsp.GetComponent );
+// end else begin
+// Database := nil;
+// end;
+ Database := TfrxADODatabase( value );
+end;
+
+function TfrxADOQuery.Get_Query: WideString; safecall;
+begin
+ Result := COM_Object.SQL.GetText;
+end;
+
+procedure TfrxADOQuery.Set_Query(const Value: WideString); safecall;
+begin
+ COM_Object.SQL.Text := Value;
+end;
+
+function TfrxADOQuery.Get_Name: WideString; safecall;
+begin
+ Result := COM_Object.Name;
+end;
+
+procedure TfrxADOQuery.Set_Name(const Value: WideString); safecall;
+begin
+ COM_Object.Name := Value;
+end;
+
+function TfrxADOQuery.Get_CommandTimeout: Integer; safecall;
+begin
+ Result := COM_Object.CommandTimeout;
+end;
+
+procedure TfrxADOQuery.Set_CommandTimeout(Value: Integer); safecall;
+begin
+ COM_Object.CommandTimeout := Value;
+end;
+
+function TfrxADOQuery.ParamByName(const Name: WideString): IfrxParamItem; safecall;
+var
+ par: TfrxParamItem;
+begin
+ par := inherited ParamByName(Name);
+ if par <> nil then Result := par;
+end;
+
+function TfrxADOQuery.AddParameter(const Name: WideString): IfrxParamItem; safecall;
+var
+ par: TfrxParamItem;
+begin
+ par := Params.Add;
+ par.Name := Name;
+ Result := par;
+end;
+
+function TfrxADOQuery.Get_Filter: WideString; safecall;
+begin
+ Result := COM_Object.Query.Filter;
+end;
+
+procedure TfrxADOQuery.Set_Filter(const Value: WideString); safecall;
+begin
+ if Value <> '' then
+ begin
+ COM_Object.Query.Filtered := False;
+ COM_Object.Query.Filter := Value;
+ COM_Object.Query.Filtered := True;
+ end
+ else
+ COM_Object.Query.Filtered := False;
+end;
+
+procedure TfrxADOQuery.Set_Master(const Param1: IfrxDataSet); safecall;
+var
+ idsp : IInterfaceComponentReference;
+ Res: HResult;
+begin
+ with COM_Object do
+ if Param1 <> nil then
+ begin
+ Res := Param1.QueryInterface( IInterfaceComponentReference, idsp);
+ if Res = S_OK then
+ Master := TfrxDBDataSet( idsp.GetComponent );
+ end
+ else
+ begin
+ Master := nil;
+ end;
+end;
+
+function TfrxADOQuery.Get_DataBaseEx: IfrxADODatabase; safecall;
+begin
+ Result := COM_Object.Database;
+end;
+
+procedure TfrxADOQuery.Set_DataBaseEx(const Value: IfrxADODatabase); safecall;
+begin
+ Set_DataBase(value);
+end;
+
+procedure TfrxADOQuery._Set_DataBaseEx(var Value: IfrxADODatabase); safecall;
+begin
+ Set_DataBase(value);
+end;
+
+function TfrxADOQuery.Get_FieldAliases: WideString; safecall;
+begin
+ Result := FieldAliases.GetText;
+end;
+
+procedure TfrxADOQuery.Set_FieldAliases(const Value: WideString); safecall;
+begin
+ FieldAliases.SetText( PChar(Value));
+end;
+{$ENDIF}
+
+{$IFDEF QBUILDER}
+constructor TfrxEngineADO.Create(AOwner: TComponent);
+begin
+ inherited;
+ FQuery := TADOQuery.Create(Self);
+end;
+
+destructor TfrxEngineADO.Destroy;
+begin
+ FQuery.Free;
+ inherited;
+end;
+
+procedure TfrxEngineADO.ReadFieldList(const ATableName: string;
+ var AFieldList: TfqbFieldList);
+var
+ TempTable: TADOTable;
+ Fields: TFieldDefs;
+ i: Integer;
+ tmpField: TfqbField;
+begin
+ AFieldList.Clear;
+ TempTable := TADOTable.Create(Self);
+ TempTable.Connection := FQuery.Connection;
+ TempTable.TableName := ATableName;
+ Fields := TempTable.FieldDefs;
+ try
+ try
+ TempTable.Active := True;
+ tmpField:= TfqbField(AFieldList.Add);
+ tmpField.FieldName := '*';
+ for i := 0 to Fields.Count - 1 do
+ begin
+ tmpField := TfqbField(AFieldList.Add);
+ tmpField.FieldName := Fields.Items[i].Name;
+ tmpField.FieldType := Ord(Fields.Items[i].DataType)
+ end;
+ except
+ end;
+ finally
+ TempTable.Free;
+ end;
+end;
+
+procedure TfrxEngineADO.ReadTableList(ATableList: TStrings);
+begin
+ ATableList.Clear;
+ frxADOGetTableNames(FQuery.Connection, ATableList, ShowSystemTables);
+// FQuery.Connection.GetTableNames(ATableList, ShowSystemTables);
+end;
+
+function TfrxEngineADO.ResultDataSet: TDataSet;
+begin
+ Result := FQuery;
+end;
+
+procedure TfrxEngineADO.SetSQL(const Value: string);
+begin
+ FQuery.SQL.Text := Value;
+end;
+{$ENDIF}
+
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxADODataBase, TFmxObject);
+ GroupDescendentsWith(TfrxADOTable, TFmxObject);
+ GroupDescendentsWith(TfrxADOQuery, TFmxObject);
+ frxObjects.RegisterObject1(TfrxADODataBase, nil, '', {$IFDEF DB_CAT}'DATABASES'{$ELSE}''{$ENDIF}, 0, 240);
+ frxObjects.RegisterObject1(TfrxADOTable, nil, '', {$IFDEF DB_CAT}'TABLES'{$ELSE}''{$ENDIF}, 0, 241);
+ frxObjects.RegisterObject1(TfrxADOQuery, nil, '', {$IFDEF DB_CAT}'QUERIES'{$ELSE}''{$ENDIF}, 0, 242);
+
+
+finalization
+ frxObjects.UnRegister(TfrxADODataBase);
+ frxObjects.UnRegister(TfrxADOTable);
+ frxObjects.UnRegister(TfrxADOQuery);
+
+end.
\ No newline at end of file
diff --git a/LibD28/FMX.frxADOEditor.pas b/LibD28/FMX.frxADOEditor.pas
new file mode 100644
index 0000000..7175808
--- /dev/null
+++ b/LibD28/FMX.frxADOEditor.pas
@@ -0,0 +1,157 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ ADO components design editors }
+{ }
+{ Copyright (c) 1998-2011 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxADOEditor;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ Winapi.Windows, System.Classes, System.SysUtils, FMX.Forms, FMX.frxADOComponents, FMX.frxCustomDB,
+ FMX.frxDsgnIntf, FMX.frxRes, Data.DB, Data.Win.ADODB, Winapi.ADOInt, System.Variants, FMX.Platform.Win;
+
+
+type
+ TfrxDatabaseNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+ TfrxDatabaseProperty = class(TfrxComponentProperty)
+ public
+ function GetValue: String; override;
+ end;
+
+ TfrxTableNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxIndexNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ end;
+
+
+{ TfrxDatabaseNameProperty }
+
+function TfrxDatabaseNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog];
+end;
+
+function TfrxDatabaseNameProperty.Edit: Boolean;
+var
+ SaveConnected: Boolean;
+ db: TADOConnection;
+ fName: String;
+begin
+ db := TfrxADODatabase(Component).Database;
+
+ SaveConnected := db.Connected;
+ db.Connected := False;
+ //FmxHandleToHWND(Application.MainForm.Handle)
+ fName := PromptDataSource(0, db.ConnectionString);
+ Result := fName <> '';
+ if Result then
+ db.ConnectionString := fName;
+ db.Connected := SaveConnected;
+end;
+
+
+{ TfrxDatabaseProperty }
+
+function TfrxDatabaseProperty.GetValue: String;
+var
+ db: TfrxADODatabase;
+begin
+ db := TfrxADODatabase(GetOrdValue);
+ if db = nil then
+ begin
+ if (ADOComponents <> nil) and (ADOComponents.DefaultDatabase <> nil) then
+ Result := ADOComponents.DefaultDatabase.Name
+ else
+ Result := frxResources.Get('prNotAssigned');
+ end
+ else
+ Result := inherited GetValue;
+end;
+
+
+{ TfrxTableNameProperty }
+
+function TfrxTableNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paSortList];
+end;
+
+procedure TfrxTableNameProperty.GetValues;
+begin
+ inherited;
+ with TfrxADOTable(Component).Table do
+ if Connection <> nil then
+ frxADOGetTableNames(Connection, Values, False);
+end;
+
+procedure TfrxTableNameProperty.SetValue(const Value: String);
+begin
+ inherited;
+ Designer.UpdateDataTree;
+end;
+
+
+{ TfrxIndexProperty }
+
+function TfrxIndexNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList];
+end;
+
+procedure TfrxIndexNameProperty.GetValues;
+var
+ i: Integer;
+begin
+ inherited;
+ try
+ with TfrxADOTable(Component).Table do
+ if (TableName <> '') and (IndexDefs <> nil) then
+ begin
+ IndexDefs.Update;
+ for i := 0 to IndexDefs.Count - 1 do
+ if IndexDefs[i].Name <> '' then
+ Values.Add(IndexDefs[i].Name);
+ end;
+ except
+ end;
+end;
+
+
+initialization
+ frxPropertyEditors.Register(TypeInfo(String), TfrxADODataBase, 'DatabaseName',
+ TfrxDataBaseNameProperty);
+ frxPropertyEditors.Register(TypeInfo(TfrxADODatabase), TfrxADOTable, 'Database',
+ TfrxDatabaseProperty);
+ frxPropertyEditors.Register(TypeInfo(TfrxADODatabase), TfrxADOQuery, 'Database',
+ TfrxDatabaseProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxADOTable, 'TableName',
+ TfrxTableNameProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxADOTable, 'IndexName',
+ TfrxIndexNameProperty);
+
+end.
diff --git a/LibD28/FMX.frxADORTTI.pas b/LibD28/FMX.frxADORTTI.pas
new file mode 100644
index 0000000..48b404b
--- /dev/null
+++ b/LibD28/FMX.frxADORTTI.pas
@@ -0,0 +1,102 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ ADO components RTTI }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxADORTTI;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, FMX.fs_iinterpreter, FMX.frxADOComponents, FMX.fs_iadortti
+, System.Variants;
+
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TADOLockType', 'ltUnspecified, ltReadOnly, ltPessimistic, ltOptimistic, ltBatchOptimistic');
+ with AddClass(TfrxADODatabase, 'TfrxCustomDatabase') do
+ AddProperty('Database', 'TADOConnection', GetProp, nil);
+ with AddClass(TfrxADOTable, 'TfrxCustomTable') do
+ AddProperty('Table', 'TADOTable', GetProp, nil);
+ with AddClass(TfrxADOQuery, 'TfrxCustomQuery') do
+ begin
+ AddMethod('procedure ExecSQL', CallMethod);
+ AddProperty('Query', 'TADOQuery', GetProp, nil);
+ end;
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TfrxADOQuery then
+ begin
+ if MethodName = 'EXECSQL' then
+ begin
+ TfrxADOQuery(Instance).UpdateParams;
+ TfrxADOQuery(Instance).Query.ExecSQL
+ end
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TfrxADODatabase then
+ begin
+ if PropName = 'DATABASE' then
+ Result := frxInteger(TfrxADODatabase(Instance).Database)
+ end
+ else if ClassType = TfrxADOTable then
+ begin
+ if PropName = 'TABLE' then
+ Result := frxInteger(TfrxADOTable(Instance).Table)
+ end
+ else if ClassType = TfrxADOQuery then
+ begin
+ if PropName = 'QUERY' then
+ Result := frxInteger(TfrxADOQuery(Instance).Query)
+ end
+end;
+
+
+initialization
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/FMX.frxAbout.fmx b/LibD28/FMX.frxAbout.fmx
new file mode 100644
index 0000000..3e5829c
--- /dev/null
+++ b/LibD28/FMX.frxAbout.fmx
@@ -0,0 +1,274 @@
+object frxAboutForm: TfrxAboutForm
+ Left = 0
+ Top = 0
+ Caption = 'About FastReport'
+ BorderStyle = bsSingle
+ ClientHeight = 276
+ ClientWidth = 255
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object Label2: TLabel
+ Position.Point = '(136,44)'
+ Width = 102.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 0
+ Font.Style = [fsBold]
+ TextAlign = taTrailing
+ end
+ object Label3: TLabel
+ Position.Point = '(16,88)'
+ Width = 214.000000000000000000
+ Height = 29.000000000000000000
+ TabOrder = 1
+ end
+ object Label5: TLabel
+ Tag = 1
+ Cursor = crHandPoint
+ Position.Point = '(62,156)'
+ Width = 179.000000000000000000
+ Height = 13.000000000000000000
+ OnClick = LabelClick
+ TabOrder = 2
+ Font.Style = [fsUnderline]
+ TextAlign = taTrailing
+ Text = 'http://www.fast-report.com'
+ end
+ object Shape1: TLine
+ Position.Point = '(16,128)'
+ Width = 229.000000000000000000
+ Height = 1.000000000000000000
+ LineType = ltDiagonal
+ end
+ object Label1: TLabel
+ Position.Point = '(56,16)'
+ Width = 185.000000000000000000
+ Height = 29.000000000000000000
+ TabOrder = 4
+ Font.Size = 20.000000000000000000
+ Font.Style = [fsBold]
+ TextAlign = taTrailing
+ Text = 'FastReport FMX'
+ end
+ object Image1: TImage
+ Position.Point = '(16,16)'
+ Width = 62.000000000000000000
+ Height = 62.000000000000000000
+ Bitmap.PNG = {
+ 89504E470D0A1A0A0000000D4948445200000040000000400806000000AA6971
+ DE000000017352474200AECE1CE90000000467414D410000B18F0BFC61050000
+ 00097048597300000EC300000EC301C76FA864000012F749444154785EE55B77
+ 50D5D7BAA563C18620225550BAA0880222D2047B2F282A28B6A0B16137621705
+ 2987DE9B0236628DA6989B9B18A3D76472F332495E26C9242F93C9BB99BC9B49
+ 2699E4EFF5BEB50F0739823F0E897F385E67D650E49CB3D7DA7B7FDFB7BEBD7F
+ 66F20FFFE1D07F131313A33065CA940E4447477760F2E4C91D888A8AD263D224
+ 4C6A476464A4424444844278787807264E9CA83061C20485B0B03085F1E3C763
+ 7C68284205E3C68D53183B76AC42484888427070B0C2983163101414A4101818
+ A810101080007F7FF80BFCFCFC147C7D7DE1EBE3031FC1E8D1A315468D1A8551
+ DEDEF01678797929180960209F9595A570F0E041BCF4D24B0A070E1CC0FEFDFB
+ 15F6EDDB87BD7BF762CF9E3DD8BD7BB7C2AE5DBBB073E74E64666662C78E1DD8
+ BE7D3BB66DDB86AD5BB72A6CD9B2052FBEF822366FDE8C4D9B36212323032FBC
+ F002366EDC880DEBD763DDBA7558BB762DD2D3D3B166CD1AAC5EBD1A69696948
+ 4D4DC5AA55ABB072E54AAC4849C1F2E5CBB16CD93224272763E9D2A558B26409
+ 162F5A84850B1762C18205983F7F3EE6CD9B87B973E660F6ECD998356B1666CE
+ 9C8919336660FAB469484A4A42626222A64E9D8A912347C2D3D3D3580003F937
+ DE7843E1F5D75FC76BAFBD86DBB76FE3D6AD5B78E5955770F3E64DDCB87103D7
+ AE5DC3D5AB5771E5CA15BCFCF2CBB87CF9322E5DBA848B172FE2FCF9F3686D6D
+ 454B730BCE9D3B87B367CFA2B1B1110D0D0DA8ABAB436D6D2DAAABAB51555989
+ 8A8A0A949595A1B4B414C5C5C5D0E974282C2C447E7E3ECE9C3983DCDC5C9C3E
+ 7D1AD9D9D93879E2048E1F3F8EA3478FE2F0E1C338D43E519C204E8C9A94F6C9
+ E044701294F8143E6393127DC3860D48884F405C5C9CB1005CEE247FE7CE1D45
+ FE8F3FFEC0EFBFFF8EDF7EFB0DBFFEFA2B7EF9E517FCFCF3CFF8E9A79FF0EFFF
+ FB377EFCF147FCF0C30FF8D7FFFE0BDF7FFF3DBEFBEE3B7CFBEDB7F8E69B6FF0
+ F5D75FE3ABAFBEC2175F7C81CF3FFF1C9F7DF6193EF9E4137CFCF1C7F8E8A38F
+ F0E1871FE2830F3EC0C3870FF1E0FE7DDCBB770F77EFDEC5DB6FBF8DB7DE7A0B
+ 6FCA1828FEABAFBEAA84BFD92E38C56E13A10D22B7343777884B616B6A6A94A8
+ E5E5E54AD0A2A222BD9879797A214F9D52AB8D2B2D3636161E1E1EC60250CDE7
+ 99FCC9932771FCD871AC912DC615FF44019E67F2478E1C415A6A9AE2EBEEEE6E
+ 2C00031E07F03C933F74E8900AACD192C9DCDCDC1E09C034470118F49E67F207
+ 85E38A152B540AEF2200A3E96B3288E7993C5339D329EB165757D7AE027020CF
+ 33F9BD922A5947B0607375E92400AB3BFE01737E4FE4FF47C87FF5E5578AF0A7
+ 9F7E2A5FFFFBE9926F6BD3D714172EA87A82B5C4D322CFA26DA9145011E11170
+ 7171311680C50407D3D3CC7FF9C597B8FFDE03A42C5B83C898E9F00F8DC2E8E0
+ 49F00C0C87BBFF04B8F9FD35B80B1CDDFC30DC7514743332D02A05158BA8A741
+ 3E734726162F5EACCAF211234674124082C23E297159EDF5B4EC3FFAE77F6175
+ EA4678788E46DF7E0360656D030B0B4B98999B1BDEF0AF43DECBDADA169111D3
+ 70B3A60D4D8D4D42BEEA2F936775C8D2997EC448004645D6F85C8A3DEDF907FF
+ 7888C4190B3060903DCC2D2C8C07FE14616E6E0167471754EF3885B3F58DA878
+ 0AE4591A2F10CF4023E6ECEC6CF82CBD00ACA5AF5FBFDE63C0BBFFE01F884D9A
+ 837E76839EEEAC3F06AE2A57670F54651E47636D3DCA9E02F9CD62C66898E842
+ 9D877712806981CE8E81488B3CA3FD7BF71F202671B60830505EDCB300E6F237
+ 9616560A2465AE01FEBF95FC5D1FAB3EB01FE88084E81968A96C425D4DAD324B
+ 7F953C0DD11C718BB4DFC3870F378C512F005F4087A7459ED1FEDD7BEF2901FA
+ F6EF5900120A1C37057941B3D010B114F5E14BD03851109084A6C7D010300FF5
+ 829AC0B9280D4A4451F85CB49537A1B1A65E967F058AC42916B4BB443AC43F43
+ 7E83D86F5A65F61D9C9C9C0CE3345379913692D6568B3C53DDBDF7EE232A7E06
+ FAF4B33322DB15E6B0771C8153DBC5635CBE86D76FBF8ADB1264AF5FBBAE3E87
+ A9EEF13CDF505F8F7A01BF9EADAB47737915EAF374A8CC2B4465BE40578C525D
+ 11CEE4E4E28458E3DE9267DF61D6CC99AAE1D25580CC4C9583B5C833CF3F9018
+ 30313A11367DFA7522DB1516969618171A8D9B6D423EA71C67C366A0C63E1035
+ 83025033C00F35FD7DBB879DFCDF407F54DB07A1726800CA9D4251E91681A6F0
+ D9B8B6250B37B28B51969D8393478FF59A3C1B2E6C90B0D3346CD830C358F502
+ B0A3C3C686167916390FDF7F1F21E1B1B0B2B13522FC382CADAC10163A19AF5C
+ B986ABA999287708419199B360387426827FAB5E63E186625B2F54D807A3C62B
+ 0A0D49CB907FE8280E1FCCEA15F9B4D4544C9F3E5DB5D88C04600F8F5D14969F
+ 5AE459E13D7CF83E82C2A608411B23C28FC3D2CA1A1345801B975EC6D5E4AD28
+ B51BDD2DC9DE41C4B0744571FFD128779F8893878F60BF1470A692677B6D5A52
+ 92EA2F3A3A3A1AC6AA1780BDBC0B527E6A916779CB2D106892003698129188EB
+ 97AFE0564616AA1C43516AED81122150623E4266D645E0A55022DFF377EAF7E6
+ CEDD103746A1992B0A6C46A26EE404590507552B6CBB09E4535252545F704C50
+ 90B100ECDC523DD6DE5AE459DBDF932C1034A16701180382C784E3DAE597F156
+ 79332E4C4BC7F9C8C5B818958C4B9392D136652DAE4DDBA470755A06AECECAC0
+ 95C4743407C4A3D8DAB55BE29D4111747D47A1357D27B2F6ECC55613C82F1323
+ C4A6283BCB8E0E0E86B1EA056007B7A5A545933C8DCDDDBBEF9AB4059805860C
+ 76C4B1796BD1505285E6EA7A5C6A3D8FD696563435496E1773A36F8E5629540B
+ 6A04F51555381F3D1F3A2B8F6E897746A1A5072A474F46F69E03D8212B38A307
+ F2EC2427C4C7AB96BA436701680EB87CE8BCB4C8D3D5BDF3CE5D04C8DEE61E7F
+ 44B67B584AA96C2F2284844461DC8438048F8F4150E814048D9D02DF8070048E
+ 959F89713108967A2175661AAE979E459DA43B5D7F2F1498B9754BDC80428909
+ A5125CEBD6EFC24BDB77AA56BB16F9458B16A98E706040405701D8BB673ED622
+ AFB7B4EFC0776C942C712B23B24F8494CBFC5BC25CB685F20F2CA13B60A17E6F
+ 25E6C7D5DE1979D3D7A22A271FBA413E2240F7C43BA3C44E52E7F4141CDCBC0D
+ EB65F6B5C8D307B023CC031587A1430D633453EE8807172C46B4C9D3CFFF1D3E
+ 6327992E402FE0D07700B21356A2223B17BAC17E2609506CED89AAA038ECCED8
+ 8CB5E9E99AE4E7CD9D8B982953D449D2D0C705E0A90D7DB736F9B7F0E69B6FC2
+ 6F5C2F56402FE028029C966D5076E2340A07058A002EDD92EE8C622B57547847
+ 207363863A55D222CF3298DD2F1EA11909407BC8232B06264DF277EEA8C669E0
+ F8689362406F4101B2E39351722C1BBA815C013DA7C4624987D5C153B163C30B
+ 485DB54A933C8FCAD8FBF0F3F5C5507B7BC3E7EA0560FAE0B1951679B6B16EDD
+ BADD2E404F59400B0613A58F038C0B14D479B0034E27AC40D17111C08E31C0BD
+ 5BD28F204170803F1A67A7C90AD884952B566892E719218D9FAF8F2FEC3B0B40
+ 7FCC08CAB4A4459E3D3C768D4CCD0284B910B4934C603FDC0D0E82612E9E18E6
+ EA0D27B7517072F781B3872F5C3C7DE1EEE527FB73265A4E94A1486A7D5DBF91
+ 12E57BD802E6AE28730A46DD062984D6BFA03ABE5AE493A4088A94A28F27C75D
+ 04E0C1615555952679D5C0BC7953B280694190337BD26F366A44D8EA2A81E4F9
+ 4AB1B61565E5282B2D434971098A8B24E515E8509857009DA0F44C01AEA6EF83
+ CED60401C41FD48C89C7C10D9BB12E6D8D3A35D6229F9090A06A1E1E991B09C0
+ 060153084F6B35C9DFB881EBD76FC027C4340182C2E215F1BACA6ABC9E578B37
+ 72E56B6E15DED435E09DCA56BC5BD78677AA2FE26F65CDB853DC80574F96E2FC
+ B414F10D3E52128FE89E743B0A2DDD513C740CEAD377606BFA7A249B409E35C0
+ 4409F8A3478DC29021430CE3D40BB06EDD3AD574D422AF5AD757AF9AB60264E9
+ A727A68A0055685B99819AA078D449995B1F98803AFF78D47847A3CA2312D523
+ A350E313835ADF3854B9854B5EF741A1851679098C5623254D06A236613976AF
+ DD88352B5799449E87A28C77BC304101B83D65AC66AA43C20A8A7D374DF257AE
+ E0D2A5CBF05769503B06B0A9B96CEA4A55DE5E9CBF0E154E212896DABDC8D61B
+ 3A6B2FE82C3D8528E1F1E8AB39839E46E4973DCFF728759988F2B8A5D89EBE01
+ 2B96A7A88B12A6908F9E1CADB63B6F8A741180E7E62525259AE4DB2EB7A1F5FC
+ 050982513D0641EEFF1514A0BC12171667C86C47A06C901F4AC5CAD2DB1759B2
+ CCE54C93B001DD906E47B1B51BCA1C02512E7BBE62790676A56FC42A457EB1C9
+ E479A52754B87A7B3D26005B442C21D9787C3279FD71558B9819AE809E05B044
+ 4AFC0A549494A16DE75134C52E46E3849968189B28CB7F124A07F9CA2A70EF39
+ D009180F1A4746A369D5161C49CFC08BABD72275C54A2C594CF20B4C26CF0C40
+ AEBC23D45500A9A2D876D622CF1E5E73738B0830C9A41590103103BA421D2AF2
+ 75B878381797761FC3C5ED59685D9789DAB0E9289262878E4E59DB6E8877C0C2
+ 15AD93962067C3366C973D9F22E98E273CBC1BD41BF2E1E279428283E13572A4
+ 12C082BE8483658F8C6524DBCE5AE45BC42E9F3D7BCE3401240650007671734E
+ 9D862E370FA5B9F92839958BC2232790BFEF206A27CEC6D9C0441458F45CF014
+ F7198D86B8E5D826113F2579D99F223F410220BB41BC24D54500DECC2A282878
+ 32F9E6669C13B7585FDFD01E03B42B410A902C555DCEE91C75B1E9C8E123387C
+ E830B278B169FF01ECDFB31707F6EEC5BE3D7BD0E21FDBB3F19100582401B051
+ DE737DEA6A2C5AB0B0D7E479252F2830485D90EA2200AFA5F176D693C81B5AD7
+ D535B5081A3F59D9D7CE841F0705589D9886EC93D98F756FF7EA7B789999AA8D
+ B575CB5665C59B5CC36425F4B015D82EB3F1C2B998E558BE345909D01BF2E364
+ ABD30AF37E909100EC925280BCBC3C4DF2ECD9574A61133C211A36B67DBB90EE
+ 0CC6800571C9EA6A9B49AD6BA9449B5CA3553CD08A09AA1F2871A33572A18AFE
+ 1460AA89E4B9FFFDC509F27ED0E0C1838D05E0DD191E393D893C9D626D4D0D2A
+ 2BAAC4512562E0004651F506DD82A7422163A270F4C8D15EB5AED54A306319AC
+ 2D42A185339A82E3B078DE7C244D4D442CC98BD5D522CF66A8AF38415E8F3112
+ 8081813E3A2727E789E4D5F9BC54755592D70FAEDC82400F1F0CB01B0C6BDB7E
+ B0B4EE0373A90CCDA538D29FF359C1D6A61FB6FA24E058D6E15EF5ED398E3A87
+ 504D01083AC502A9088B3CC2B07CF65C24C6C52BABAB459EAD301FF101BC1E33
+ 68D02063017879E8D4A9534F26DF7E394119993C1D76CE4B4364781CFCC646C2
+ 3B281C1EFEFACB0DEA92837CEF1712859399593822D1BE37E40D7EBEC9799CCC
+ 32EB042D219C51D0D7030563A762E5ECF9888B895566E749E4FDFDFC31CA7B14
+ 5C46B860D0C0818F04609B981FCC03472DF23C9F67B1542CB9BDF04C3ECEE4F0
+ 3AAB2027575D673D76EC98FE1AAB04BD4359879075200B2FEDDBDF6BF2064B5B
+ EF10D97376908AB2C4792CF216A6636ED27465769E449ECB9F45D00867670C7C
+ 5C005E4466C0D222FFE87C5EC8F3889AF778794AFB270F2AB5C81BCADBFA2163
+ B445607AB40F44EE8C65989590A86AFD2791A70D660AE4D1F88001031E09C03E
+ 396F4F315FF74CFEAF9DCFF786BC21CF9F758D92AD30AC1BF2B205C423E4BB04
+ 634E62122264F96B91E795790FC9003C17B4EBDFFF5129CCDCC80F2789678DBC
+ CAF34949A8E34AE854271489652EECE38122B1D39CF908097C34755AE45902BB
+ 4900E4A950BF7EFD1E09C036313F9CF7859F39F252E430CFF348ABDA290C3A2B
+ 4F298BBD513AD41F2591F3303F71BA0463997913C87B7A784A001CA11AA27DFB
+ 76D43166AA4DCCDA9A249E35F2860A2F5622FC34F9B97AC23C94D13FCC4FC3AA
+ A459981C11A92CAE29E4590039CBFE1F2235409F3E7D8C05E0E5215E947A16C9
+ 1B2A3C82F97E4EE234CC4948424CD464211F6A32792E7F27D9FF4C81B6361D5E
+ C64CBD808F9AECDAB9F39925DF51E1C97267AA0B1B1F66F2B2379067FEE7FE67
+ 06B0E92C00DBC41C002F493CD3E4352A3C53C833FF73FFF7970C606DDD61E7CD
+ D48B38806D5BB73ED7E4873B392917C80C606DD5D1D4D50BC0CB43B4A5CF3379
+ E6FFC1E201FA4906B0EA2C00DBC41C040F489F67F2DCFF0C807DFB3C2E80BC98
+ C506493CCFE47922CC00C814686969F94800F6C97979884D091E903CCFE4EDEC
+ EC606B6B6B2C001D122B2D3E54A89EE05C2D44F8F4A6E1C94DB1CA8627370D4F
+ 6D92D4C2F62736E70AB139428C4F6B767E5253FF9EF1888B8DD51364C3423CFB
+ A4F6476C7933453D42DB4E928D191A3396E6AC4DD4E3AFB23DD523AF24294686
+ B53C1B1AF4F4ACEA78EB9BE686F97D98A3A3BAFA42B2F643EC55C1C33DCF65DF
+ 99BCAD4D3702B053CA99E015120E964F9271C086678579AC6C7836387CA23E17
+ 7386C2C47D199EFD353CF3DBF9595FC333BE6C4571D60CCFF432EEF080A28398
+ 8707DCBB236698C54EE498CAEC259A2B82023637686F49728090B4EB6FA7521D
+ A33D031EF73C977D67F2BCBFD42100C1411806A206D3AEB4416D35301717053E
+ 6CC0256618A461A086C11A066C1834EFE3A859E1C0054C450407AF66A89D8081
+ 04678A20890E2202D6EF0A4286843A480958D82858DBA81CAF20818EC18E50A4
+ 0D78449E6798CA11FD87C20CFF0F487B6657493B6B380000000049454E44AE42
+ 6082}
+ end
+ object Label4: TLabel
+ Position.Point = '(16,140)'
+ Width = 229.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 6
+ end
+ object Label6: TLabel
+ Position.Point = '(16,180)'
+ Width = 49.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 7
+ end
+ object Label7: TLabel
+ Tag = 2
+ Cursor = crHandPoint
+ Position.Point = '(116,180)'
+ Width = 125.000000000000000000
+ Height = 13.000000000000000000
+ OnClick = LabelClick
+ TabOrder = 8
+ Font.Style = [fsUnderline]
+ TextAlign = taTrailing
+ Text = 'sales@fast-report.com'
+ end
+ object Label8: TLabel
+ Position.Point = '(16,196)'
+ Width = 49.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 9
+ end
+ object Label9: TLabel
+ Tag = 2
+ Cursor = crHandPoint
+ Position.Point = '(100,196)'
+ Width = 141.000000000000000000
+ Height = 13.000000000000000000
+ OnClick = LabelClick
+ TabOrder = 10
+ Font.Style = [fsUnderline]
+ TextAlign = taTrailing
+ Text = 'support@fast-report.com'
+ end
+ object Label10: TLabel
+ Position.Point = '(240,14)'
+ Width = 3.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 11
+ end
+ object Button1: TButton
+ Position.Point = '(93,232)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 12
+ ModalResult = 1
+ Text = 'OK'
+ Default = True
+ end
+end
diff --git a/LibD28/FMX.frxAbout.pas b/LibD28/FMX.frxAbout.pas
new file mode 100644
index 0000000..6c9c681
--- /dev/null
+++ b/LibD28/FMX.frxAbout.pas
@@ -0,0 +1,98 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ About window }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxAbout;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, System.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.Objects, FMX.Types
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+type
+ TfrxAboutForm = class(TForm)
+ Button1: TButton;
+ Label2: TLabel;
+ Label3: TLabel;
+ Image1: TImage;
+ Label5: TLabel;
+ Shape1: TLine;
+ Label1: TLabel;
+ Label4: TLabel;
+ Label6: TLabel;
+ Label7: TLabel;
+ Label8: TLabel;
+ Label9: TLabel;
+ Label10: TLabel;
+ procedure FormCreate(Sender: TObject);
+ procedure LabelClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+
+implementation
+
+uses FMX.frxClass, FMX.frxUtils, FMX.frxRes
+{$IFDEF MSWINDOWS}
+ , Winapi.ShellAPI, Winapi.Windows
+ {$ENDIF}
+ {$IFDEF MACOS}
+ , Posix.Stdlib
+{$ENDIF};
+
+{$R *.FMX}
+
+procedure TfrxAboutForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(2600);
+ Label4.Text := frxGet(2601);
+ Label6.Text := frxGet(2602);
+ Label8.Text := frxGet(2603);
+ Label2.Text := 'Version ' + FR_VERSION;
+ Label10.Text := #174;
+ Label3.Text := '(c) 2011-' + FormatDateTime('YYYY', Now) + ' by Alexander Tzyganenko, Fast Reports Inc.';
+end;
+
+procedure TfrxAboutForm.LabelClick(Sender: TObject);
+var
+ sLink: String;
+begin
+ case TLabel(Sender).Tag of
+ 1: sLink := TLabel(Sender).Text;
+ 2: sLink := 'mailto:' + TLabel(Sender).Text;
+ end;
+
+{$IFDEF MSWINDOWS}
+ ShellExecute(0, 'open', PChar(sLink), '', '', SW_SHOWNORMAL);
+{$ENDIF}
+{$IFDEF MACOS}
+ _system(PAnsiChar('open ' + AnsiString(sLink)));
+{$ENDIF}
+end;
+
+procedure TfrxAboutForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKESCAPE then
+ ModalResult := mrCancel;
+end;
+
+end.
+
diff --git a/LibD28/FMX.frxAggregate.pas b/LibD28/FMX.frxAggregate.pas
new file mode 100644
index 0000000..4620941
--- /dev/null
+++ b/LibD28/FMX.frxAggregate.pas
@@ -0,0 +1,698 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Aggregate Functions }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxAggregate;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.frxClass, System.Variants;
+
+
+type
+ TfrxAggregateFunction = (agSum, agAvg, agMin, agMax, agCount);
+
+ TfrxAggregateItem = class(TObject)
+ private
+ FAggregateFunction: TfrxAggregateFunction;
+ FBand: TfrxDataBand;
+ FCountInvisibleBands: Boolean;
+ FDontReset: Boolean;
+ FExpression: String;
+ FIsPageFooter: Boolean;
+ FItemsArray: Variant; { used for vbands }
+ FItemsCount: Integer;
+ FItemsCountArray: Variant; { used for vbands }
+ FItemsValue: Variant;
+ FKeeping: Boolean;
+ FLastCount: Integer;
+ FLastValue: Variant;
+ FMemoName: String;
+ FOriginalName: String;
+ FParentBand: TfrxBand;
+ FReport: TfrxReport;
+ FTempItemsCount: Integer;
+ FTempItemsValue: Variant;
+ FVColumn: Integer; { used for vbands }
+ public
+ procedure Calc;
+ procedure DeleteValue;
+ procedure Reset;
+ procedure StartKeep;
+ procedure EndKeep;
+ function Value: Variant;
+ end;
+
+ TfrxAggregateList = class(TObject)
+ private
+ FList: TList;
+ FReport: TfrxReport;
+ function GetItem(Index: Integer): TfrxAggregateItem;
+ procedure FindAggregates(Memo: TfrxCustomMemoView; DataBand: TfrxDataBand);
+ procedure ParseName(const ComplexName: String; var Func: TfrxAggregateFunction;
+ var Expr: String; var Band: TfrxDataBand; var CountInvisible, DontReset: Boolean);
+ property Items[Index: Integer]: TfrxAggregateItem read GetItem; default;
+ public
+ constructor Create(AReport: TfrxReport);
+ destructor Destroy; override;
+ procedure Clear;
+ procedure ClearValues;
+
+ procedure AddItems(Page: TfrxReportPage);
+ procedure AddValue(Band: TfrxBand; VColumn: Integer = 0);
+ procedure DeleteValue(Band: TfrxBand);
+ procedure EndKeep;
+ procedure Reset(ParentBand: TfrxBand);
+ procedure StartKeep;
+ function GetValue(ParentBand: TfrxBand; const ComplexName: String;
+ VColumn: Integer = 0): Variant; overload;
+ function GetValue(ParentBand: TfrxBand; VColumn: Integer;
+ const Name, Expression: String; Band: TfrxBand; Flags: Integer): Variant; overload;
+ end;
+
+
+implementation
+
+uses
+ FMX.frxVariables, FMX.frxUtils, FMX.frxFMX;
+
+
+type
+ THackComponent = class(TfrxComponent);
+
+procedure Get3Params(const s: String; var i: Integer;
+ var s1, s2, s3: String);
+var
+ c, d, e, oi, ci: Integer;
+begin
+ s1 := ''; s2 := ''; s3 := '';
+ c := 1; d := 1; e := 1; oi := i + 1; ci := 1;
+ repeat
+ Inc(i);
+ if s[i] = '''' then
+ if (d = 1) and (e = 1) then Inc(d) else d := 1;
+ if (d = 1) and (s[i] = '"') then
+ if e = 1 then Inc(e) else e := 1;
+ if (d = 1) and (e = 1) then
+ begin
+ if s[i] = '(' then
+ Inc(c) else
+ if s[i] = ')' then Dec(c);
+ if (s[i] = ',') and (c = 1) then
+ begin
+ if ci = 1 then
+ s1 := Copy(s, oi, i - oi) else
+ s2 := Copy(s, oi, i - oi);
+ oi := i + 1; Inc(ci);
+ end;
+ end;
+ until (c = 0) or (i >= Length(s));
+ case ci of
+ 1: s1 := Copy(s, oi, i - oi);
+ 2: s2 := Copy(s, oi, i - oi);
+ 3: s3 := Copy(s, oi, i - oi);
+ end;
+ Inc(i);
+end;
+
+
+{ TfrxAggregateItem }
+
+procedure TfrxAggregateItem.Calc;
+var
+ Value: Variant;
+ i: Integer;
+begin
+ if not FBand.Visible and not FCountInvisibleBands then Exit;
+
+ FReport.CurObject := FMemoName;
+ if FAggregateFunction <> agCount then
+ Value := FReport.Calc(FExpression) else
+ Value := Null;
+
+ if VarType(Value) = varBoolean then
+ if Value = True then
+ Value := 1;
+
+ { process vbands }
+ if FVColumn > 0 then
+ begin
+ if VarIsNull(FItemsArray) then
+ begin
+ FItemsArray := VarArrayCreate([0, 1000], varVariant);
+ FItemsCountArray := VarArrayCreate([0, 1000], varVariant);
+ for i := 0 to 1000 do
+ begin
+ FItemsArray[i] := Null;
+ FItemsCountArray[i] := 0;
+ end;
+ end;
+
+ if (FAggregateFunction <> agAvg) or (Value <> Null) then
+ FItemsCountArray[FVColumn] := FItemsCountArray[FVColumn] + 1;
+ if FItemsArray[FVColumn] = Null then
+ FItemsArray[FVColumn] := Value
+ else if Value <> Null then
+ case FAggregateFunction of
+ agSum, agAvg:
+ FItemsArray[FVColumn] := FItemsArray[FVColumn] + Value;
+ agMin:
+ if Value < FItemsArray[FVColumn] then
+ FItemsArray[FVColumn] := Value;
+ agMax:
+ if Value > FItemsArray[FVColumn] then
+ FItemsArray[FVColumn] := Value;
+ end;
+ end
+ else if FKeeping then
+ begin
+ if (FAggregateFunction <> agAvg) or (Value <> Null) then
+ Inc(FTempItemsCount);
+ if FTempItemsValue = Null then
+ FTempItemsValue := Value
+ else if Value <> Null then
+ case FAggregateFunction of
+ agSum, agAvg:
+ FTempItemsValue := FTempItemsValue + Value;
+ agMin:
+ if Value < FTempItemsValue then
+ FTempItemsValue := Value;
+ agMax:
+ if Value > FTempItemsValue then
+ FTempItemsValue := Value;
+ end;
+ end
+ else
+ begin
+ FLastCount := FItemsCount;
+ FLastValue := FItemsValue;
+ if (FAggregateFunction <> agAvg) or (Value <> Null) then
+ Inc(FItemsCount);
+ if FItemsValue = Null then
+ FItemsValue := Value
+ else if Value <> Null then
+ case FAggregateFunction of
+ agSum, agAvg:
+ FItemsValue := FItemsValue + Value;
+ agMin:
+ if Value < FItemsValue then
+ FItemsValue := Value;
+ agMax:
+ if Value > FItemsValue then
+ FItemsValue := Value;
+ end;
+ end;
+end;
+
+procedure TfrxAggregateItem.DeleteValue;
+begin
+ FItemsCount := FLastCount;
+ FItemsValue := FLastValue;
+end;
+
+procedure TfrxAggregateItem.Reset;
+begin
+ if FDontReset and (FItemsCount <> 0) then Exit;
+
+ FItemsCount := 0;
+ FItemsValue := Null;
+ FItemsArray := Null;
+ FItemsCountArray := Null;
+end;
+
+procedure TfrxAggregateItem.StartKeep;
+begin
+ if not FIsPageFooter or FKeeping then Exit;
+ FKeeping := True;
+
+ FTempItemsCount := 0;
+ FTempItemsValue := Null;
+end;
+
+procedure TfrxAggregateItem.EndKeep;
+begin
+ if not FIsPageFooter or not FKeeping then Exit;
+ FKeeping := False;
+
+ FItemsCount := FItemsCount + FTempItemsCount;
+ if FItemsValue = Null then
+ FItemsValue := FTempItemsValue
+ else if FTempItemsValue <> Null then
+ case FAggregateFunction of
+ agMin:
+ if FTempItemsValue < FItemsValue then
+ FItemsValue := FTempItemsValue;
+ agMax:
+ if FTempItemsValue > FItemsValue then
+ FItemsValue := FTempItemsValue;
+ else
+ FItemsValue := FItemsValue + FTempItemsValue;
+ end;
+end;
+
+function TfrxAggregateItem.Value: Variant;
+begin
+ Result := Null;
+ if not VarIsNull(FItemsArray) then
+ begin
+ case FAggregateFunction of
+ agSum, agMin, agMax:
+ Result := FItemsArray[FVColumn];
+ agAvg:
+ Result := FItemsArray[FVColumn] / FItemsCountArray[FVColumn];
+ agCount:
+ Result := FItemsCountArray[FVColumn];
+ end
+ end
+ else
+ case FAggregateFunction of
+ agSum, agMin, agMax:
+ Result := FItemsValue;
+ agAvg:
+ Result := FItemsValue / FItemsCount;
+ agCount:
+ Result := FItemsCount;
+ end;
+
+ if VarIsNull(Result) then
+ Result := 0;
+end;
+
+
+{ TfrxAggregateList }
+
+constructor TfrxAggregateList.Create(AReport: TfrxReport);
+begin
+ FList := TList.Create;
+ FReport := AReport;
+end;
+
+destructor TfrxAggregateList.Destroy;
+begin
+ Clear;
+ FList.Free;
+ inherited;
+end;
+
+procedure TfrxAggregateList.Clear;
+begin
+ while FList.Count > 0 do
+ begin
+ TObject(FList[0]).Free;
+ FList.Delete(0);
+ end;
+end;
+
+function TfrxAggregateList.GetItem(Index: Integer): TfrxAggregateItem;
+begin
+ Result := FList[Index];
+end;
+
+procedure TfrxAggregateList.ParseName(const ComplexName: String;
+ var Func: TfrxAggregateFunction; var Expr: String; var Band: TfrxDataBand;
+ var CountInvisible, DontReset: Boolean);
+var
+ i: Integer;
+ Name, Param1, Param2, Param3: String;
+begin
+ i := Pos('(', ComplexName);
+ Name := UpperCase(Trim(Copy(ComplexName, 1, i - 1)));
+ Get3Params(ComplexName, i, Param1, Param2, Param3);
+ Param1 := Trim(Param1);
+ Param2 := Trim(Param2);
+ Param3 := Trim(Param3);
+
+ if Name = 'SUM' then
+ Func := agSum
+ else if Name = 'MIN' then
+ Func := agMin
+ else if Name = 'MAX' then
+ Func := agMax
+ else if Name = 'AVG' then
+ Func := agAvg
+ else //if Name = 'COUNT' then
+ Func := agCount;
+
+ if Name <> 'COUNT' then
+ begin
+ Expr := Param1;
+ if Param2 <> '' then
+ Band := TfrxDataBand(FReport.FindObject(Param2)) else
+ Band := nil;
+ if Param3 <> '' then
+ i := StrToInt(Param3) else
+ i := 0;
+ end
+ else
+ begin
+ Expr := '';
+ Band := TfrxDataBand(FReport.FindObject(Param1));
+ if Param2 <> '' then
+ i := StrToInt(Param2) else
+ i := 0;
+ end;
+
+ CountInvisible := (i and 1) <> 0;
+ DontReset := (i and 2) <> 0;
+end;
+
+procedure TfrxAggregateList.FindAggregates(Memo: TfrxCustomMemoView;
+ DataBand: TfrxDataBand);
+const
+ Spaces = [#1..#32, '!', '#', '$', '%', '^', '&', '|', '+', '-', '*', '/',
+ '=', '.', ',', '[', ']', '0'..'9'];
+ IdentSpaces = Spaces - ['0'..'9'] + ['('];
+var
+ i, j: Integer;
+ s, s1, dc1, dc2: String;
+ Report: TfrxReport;
+
+ procedure FindIn(const s: String); forward;
+
+ procedure SkipString(const s: String; var i: Integer);
+ var
+ ch: Char;
+ begin
+ ch := s[i];
+ Inc(i);
+ while (i <= Length(s)) and (s[i] <> ch) do
+ Inc(i);
+ Inc(i);
+ end;
+
+ function Check(s: String): Boolean;
+ var
+ i: Integer;
+ ds: TfrxDataSet;
+ s1: String;
+ VarVal: Variant;
+ begin
+ Result := False;
+ if s = '' then Exit;
+
+ { searching in the variables }
+ i := Report.Variables.IndexOf(s);
+ if i <> -1 then
+ begin
+ VarVal := Report.Variables.Items[i].Value;
+ if VarIsNull(VarVal) then
+ s := ''
+ else
+ s := VarVal;
+ FindIn(s);
+ Result := True;
+ Exit;
+ end;
+
+ { maybe it's a dataset/field? }
+ Report.GetDataSetAndField(s, ds, s1);
+ if (ds <> nil) and (s1 <> '') then
+ Result := True;
+ end;
+
+ procedure AddAggregate(const ComplexName: String);
+ var
+ Item: TfrxAggregateItem;
+ begin
+ Item := TfrxAggregateItem.Create;
+ FList.Add(Item);
+
+ ParseName(ComplexName, Item.FAggregateFunction, Item.FExpression,
+ Item.FBand, Item.FCountInvisibleBands, Item.FDontReset);
+ if Item.FBand = nil then
+ Item.FBand := DataBand;
+
+ Item.FReport := FReport;
+ Item.FParentBand := TfrxBand(Memo.Parent);
+ if Item.FParentBand.Vertical and (THackComponent(Memo).FOriginalBand <> nil) and
+ (TfrxBand(THackComponent(Memo).FOriginalBand).BandNumber in [1, 3, 5, 13]) then
+ Item.FParentBand := TfrxBand(THackComponent(Memo).FOriginalBand);
+ Item.FIsPageFooter := Item.FParentBand is TfrxPageFooter;
+ Item.FOriginalName := Trim(ComplexName);
+ Item.FMemoName := Memo.Name;
+ Item.Reset;
+ end;
+
+ procedure FindIn(const s: String);
+ var
+ i, j: Integer;
+ s1, s2, s3, s4: String;
+ begin
+ if Check(s) then
+ Exit;
+
+ { this is an expression }
+ i := 1;
+ while i <= Length(s) do
+ begin
+ { skip non-significant chars }
+ while (i <= Length(s)) and (CharInSet(s[i], Spaces)) do
+ Inc(i);
+
+ case s[i] of
+ '<':
+ begin
+ FindIn(frxGetBrackedVariableW(s, '<', '>', i, j));
+ i := j;
+ end;
+
+ '''', '"':
+ SkipString(s, i);
+
+ '(':
+ begin
+ FindIn(frxGetBrackedVariableW(s, '(', ')', i, j));
+ if i = j then
+ Inc(i) else
+ i := j;
+ end;
+ else
+ begin
+ j := i;
+ while (i <= Length(s)) and not (CharInSet(s[i], IdentSpaces)) do
+ Inc(i);
+ s1 := UpperCase(Copy(s, j, i - j));
+
+ if (s1 = 'SUM') or (s1 = 'MIN') or (s1 = 'MAX') or
+ (s1 = 'AVG') or (s1 = 'COUNT') then
+ begin
+ if (i < Length(s)) and (s[i] = '(') then
+ begin
+ Get3Params(s, i, s2, s3, s4);
+ AddAggregate(Copy(s, j, i - j));
+ end;
+ end
+ else
+ Check(s1);
+ end;
+ end;
+ end;
+ end;
+
+begin
+ Report := Memo.Report;
+ if Memo.AllowExpressions then
+ begin
+ s := Memo.Text;
+ i := 1;
+ dc1 := Memo.ExpressionDelimiters;
+ dc2 := Copy(dc1, Pos(',', dc1) + 1, 255);
+ dc1 := Copy(dc1, 1, Pos(',', dc1) - 1);
+
+ repeat
+ while (i < Length(s)) and (Copy(s, i, Length(dc1)) <> dc1) do Inc(i);
+ s1 := frxGetBrackedVariableW(s, dc1, dc2, i, j);
+ if i <> j then
+ begin
+ FindIn(s1);
+ i := j;
+ j := 0;
+ end;
+ until i = j;
+ end;
+end;
+
+procedure TfrxAggregateList.AddItems(Page: TfrxReportPage);
+
+ procedure EnumObjects(ParentBand: TfrxBand; DataBand: TfrxDataBand);
+ var
+ i: Integer;
+ c: TfrxComponent;
+ begin
+ if ParentBand = nil then Exit;
+
+ for i := 0 to ParentBand.Objects.Count - 1 do
+ begin
+ c := ParentBand.Objects[i];
+ if c is TfrxCustomMemoView then
+ FindAggregates(TfrxCustomMemoView(c), DataBand);
+ end;
+
+ if ParentBand.Child <> nil then
+ EnumObjects(ParentBand.Child, DataBand);
+ end;
+
+ procedure EnumGroups(GroupHeader: TfrxGroupHeader; DataBand: TfrxDataBand);
+ var
+ i: Integer;
+ g: TfrxGroupHeader;
+ begin
+ if GroupHeader = nil then Exit;
+
+ for i := 0 to GroupHeader.FSubBands.Count - 1 do
+ begin
+ g := GroupHeader.FSubBands[i];
+ EnumObjects(g.FFooter, DataBand);
+ end;
+ end;
+
+ procedure EnumDataBands(List: TList);
+ var
+ i: Integer;
+ d: TfrxDataBand;
+ begin
+ for i := 0 to List.Count - 1 do
+ begin
+ d := List[i];
+ EnumObjects(d.FFooter, d);
+ EnumGroups(TfrxGroupHeader(d.FGroup), d);
+ EnumDataBands(d.FSubBands);
+ if d.Vertical then
+ EnumObjects(d, d);
+ end;
+ end;
+
+begin
+ EnumDataBands(Page.FSubBands);
+ EnumDataBands(Page.FVSubBands);
+ if Page.FSubBands.Count > 0 then
+ begin
+ EnumObjects(Page.FindBand(TfrxPageFooter), Page.FSubBands[0]);
+ EnumObjects(Page.FindBand(TfrxColumnFooter), Page.FSubBands[0]);
+ EnumObjects(Page.FindBand(TfrxReportSummary), Page.FSubBands[0]);
+ end;
+end;
+
+procedure TfrxAggregateList.AddValue(Band: TfrxBand; VColumn: Integer = 0);
+var
+ i: Integer;
+begin
+ for i := 0 to FList.Count - 1 do
+ if Items[i].FBand = Band then
+ begin
+ Items[i].FVColumn := VColumn;
+ Items[i].Calc;
+ end;
+end;
+
+procedure TfrxAggregateList.DeleteValue(Band: TfrxBand);
+var
+ i: Integer;
+begin
+ for i := 0 to FList.Count - 1 do
+ if Items[i].FBand = Band then
+ Items[i].DeleteValue;
+end;
+
+function TfrxAggregateList.GetValue(ParentBand: TfrxBand;
+ const ComplexName: String; VColumn: Integer = 0): Variant;
+var
+ i: Integer;
+begin
+ Result := Null;
+
+ for i := 0 to FList.Count - 1 do
+ if (Items[i].FParentBand = ParentBand) and
+ (frxCompareText(Items[i].FOriginalName, Trim(ComplexName)) = 0) then
+ begin
+ Items[i].FVColumn := VColumn;
+ Result := Items[i].Value;
+ break;
+ end;
+end;
+
+function TfrxAggregateList.GetValue(ParentBand: TfrxBand; VColumn: Integer;
+ const Name, Expression: String; Band: TfrxBand; Flags: Integer): Variant;
+var
+ i: Integer;
+ fn: TfrxAggregateFunction;
+begin
+ Result := Null;
+ if Name = 'SUM' then
+ fn := agSum
+ else if Name = 'AVG' then
+ fn := agAvg
+ else if Name = 'MIN' then
+ fn := agMin
+ else if Name = 'MAX' then
+ fn := agMax
+ else
+ fn := agCount;
+
+ for i := 0 to FList.Count - 1 do
+ if (Items[i].FParentBand = ParentBand) and
+ (Items[i].FAggregateFunction = fn) and
+ (frxCompareText(Items[i].FExpression, Trim(Expression)) = 0) and
+ ((Band = nil) or (Items[i].FBand = Band)) and
+ (Items[i].FCountInvisibleBands = ((Flags and 1) <> 0)) and
+ (Items[i].FDontReset = ((Flags and 2) <> 0)) then
+ begin
+ Items[i].FVColumn := VColumn;
+ Result := Items[i].Value;
+ break;
+ end;
+end;
+
+procedure TfrxAggregateList.Reset(ParentBand: TfrxBand);
+var
+ i: Integer;
+begin
+ for i := 0 to FList.Count - 1 do
+ if Items[i].FParentBand = ParentBand then
+ Items[i].Reset;
+end;
+
+procedure TfrxAggregateList.StartKeep;
+var
+ i: Integer;
+begin
+ for i := 0 to FList.Count - 1 do
+ Items[i].StartKeep;
+end;
+
+procedure TfrxAggregateList.EndKeep;
+var
+ i: Integer;
+begin
+ for i := 0 to FList.Count - 1 do
+ Items[i].EndKeep;
+end;
+
+procedure TfrxAggregateList.ClearValues;
+var
+ i: Integer;
+ SaveReset: Boolean;
+begin
+ for i := 0 to FList.Count - 1 do
+ begin
+ SaveReset := Items[i].FDontReset;
+ Items[i].FDontReset := False;
+ Items[i].Reset;
+ Items[i].FDontReset := SaveReset;
+ end;
+end;
+
+end.
+
diff --git a/LibD28/FMX.frxBarcod.pas b/LibD28/FMX.frxBarcod.pas
new file mode 100644
index 0000000..f62b76f
--- /dev/null
+++ b/LibD28/FMX.frxBarcod.pas
@@ -0,0 +1,2044 @@
+unit FMX.frxBarcod;
+
+{
+Adopted for FMX framework by Fast Reports in 2013.
+
+Barcode Component
+Version 1.25 (15.05.2003)
+Copyright 1998-2003 Andreas Schmidt and friends
+Adapted to FR: Alexander Tzyganenko
+
+for use with Delphi 1 - 7
+Delphi 1 not tested; better use Delphi 2 (or higher)
+
+Freeware
+Feel free to distribute the component as
+long as all files are unmodified and kept together.
+
+I'am not responsible for wrong barcodes.
+
+bug-reports, enhancements:
+mailto:shmia@bizerba.de or a_j_schmidt@rocketmail.com
+
+please tell me wich version you are using, when mailing me.
+
+
+get latest version from
+http://members.tripod.de/AJSchmidt/index.html
+http://mitglied.lycos.de/AJSchmidt/fbarcode.zip
+
+
+many thanx and geetings to
+Nikolay Simeonov, Wolfgang Koranda, Norbert Waas,
+Richard Hugues, Olivier Guilbaud, Berend Tober, Jan Tungli,
+Mauro Lemes, Norbert Kostka, Frank De Prins, Shane O'Dea,
+Daniele Teti, Ignacio Trivino, Samuel J. Comstock, Roberto Parola,
+Stefano Torricella and Mariusz Mialkon.
+
+i use tabs: 1 tab = 3 spaces
+
+
+History:
+----------------------------------------------------------------------
+Version 1.0:
+- initial release
+Version 1.1:
+- more comments
+- changed function Code_93Extended (now correct ?)
+Version 1.2:
+- Bugs (found by Nikolay Simeonov) removed
+Version 1.3:
+- EAN8/EAN13 added by Wolfgang Koranda (wkoranda@csi.com)
+Version 1.4:
+- Bug (found by Norbert Waas) removed
+ Component must save the Canvas-properties Font,Pen and Brush
+Version 1.5:
+- Bug (found by Richard Hugues) removed
+ Last line of barcode was 1 Pixel too wide
+Version 1.6:
+- new read-only property 'Width'
+Version 1.7
+- check for numeric barcode types
+- compatible with Delphi 1 (i hope)
+Version 1.8
+- add Color and ColorBar properties
+Version 1.9
+- Code 128 C added by Jan Tungli
+Version 1.10
+- Bug in Code 39 Character I removed
+Version 1.11 (06.07.1999)
+- additional Code Types
+ CodeUPC_A,
+ CodeUPC_E0,
+ CodeUPC_E1,
+ CodeUPC_Supp2,
+ CodeUPC_Supp5
+ by Jan Tungli
+Version 1.12 (13.07.1999)
+- improved ShowText property by Mauro Lemes
+ you must change your applications due changed interface of TBarcode.
+Version 1.13 (23.07.1999)
+- additional Code Types
+ CodeEAN128A,
+ CodeEAN128B,
+ CodeEAN128C
+ (support by Norbert Kostka)
+- new property 'CheckSumMethod'
+Version 1.14 (29.07.1999)
+- checksum for EAN128 by Norbert Kostka
+- bug fix for EAN128C
+Version 1.15 (23.09.1999)
+- bug fix for Code 39 with checksum by Frank De Prins
+Version 1.16 (10.11.1999)
+- width property is now writable (suggestion by Shane O'Dea)
+Version 1.17 (27.06.2000)
+- new OnChange property
+- renamed TBarcode to TAsBarcode to avoid name conflicts
+Version 1.18 (25.08.2000)
+- some speed improvements (Code 93 and Code 128)
+Version 1.19 (27.09.2000)
+ (thanks to Samuel J. Comstock)
+- origin of the barcode (left upper edge) is moved so that
+ the barcode stays always on the canvas
+- new (read only) properties 'CanvasWidth' and 'CanvasHeight' gives you
+ the size of the resulting image.
+- a wrapper class for Quick Reports is now available.
+Version 1.20 (13.09.2000)
+- Assign procedure added
+- support for scaling barcode to Printer (see Demo)
+Version 1.21 (19.07.2001)
+ (thanks to Roberto Parola)
+- new properties ShowTextFont and ShowTextPosition
+Version 1.22 (26.10.2001)
+- Code 128 Symbol #12 (=comma) fixed (thanks to Stefano Torricella)
+Version 1.23 (13.11.2002)
+- UPC_E0 and UPC_E1 stopcodes fixed (thanks to Duo Dreamer)
+Version 1.24 (04.12.2002)
+- Bugfix for Code93 Extended
+Version 1.25 (15.05.2003)
+- fixed a bug in procedure Assign (thanks to Mariusz Mialkon)
+
+Todo (missing features)
+-----------------------
+
+- more CheckSum Methods
+- user defined barcodes
+- checksum event (fired when the checksum is calculated)
+- rename the unit name (from 'barcode' to 'fbarcode') to avoid name conflicts
+- I'am working on PDF417 barcode (has anybody some technical information about PDF417
+ or a PDF417 reader ?)
+
+
+
+Known Bugs
+---------
+- Top and Left properties must be set at runtime.
+- comments not compatible with Delphi 1
+}
+
+
+
+interface
+
+{$I frx.inc}
+
+uses
+
+ System.SysUtils, System.Classes, System.Types, System.UITypes, System.UIConsts,
+ FMX.Types, FMX.Objects, FMX.Controls, FMX.Forms, FMX.Dialogs, System.Math
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+ , FMX.frxFMX
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+ TfrxBarcodeType =
+ (
+ bcCode_2_5_interleaved,
+ bcCode_2_5_industrial,
+ bcCode_2_5_matrix,
+ bcCode39,
+ bcCode39Extended,
+ bcCode128A,
+ bcCode128B,
+ bcCode128C,
+ bcCode93,
+ bcCode93Extended,
+ bcCodeMSI,
+ bcCodePostNet,
+ bcCodeCodabar,
+ bcCodeEAN8,
+ bcCodeEAN13,
+ bcCodeUPC_A,
+ bcCodeUPC_E0,
+ bcCodeUPC_E1,
+ bcCodeUPC_Supp2, { UPC 2 digit supplemental }
+ bcCodeUPC_Supp5, { UPC 5 digit supplemental }
+ bcCodeEAN128A,
+ bcCodeEAN128B,
+ bcCodeEAN128C
+ );
+
+
+ TfrxBarLineType = (white, black, black_half); {for internal use only}
+ { black_half means a black line with 2/5 height (used for PostNet) }
+
+
+ TfrxCheckSumMethod =
+ (
+ csmNone,
+ csmModulo10
+ );
+
+
+ TfrxBarcode = class(TComponent)
+ private
+ FAngle: Double;
+ FColor: TAlphaColor;
+ FFontColor: TAlphaColor;
+ FColorBar: TAlphaColor;
+ FCheckSum: Boolean;
+ FCheckSumMethod: TfrxCheckSumMethod;
+ FHeight: Single;
+ FLeft: Single;
+ FModul: Integer;
+ FRatio: Double;
+ FText: AnsiString;
+ FTop: Single;
+ FTyp: TfrxBarcodeType;
+ FFont: TFont;
+ FDrawArea: TRectF;
+ modules: array[0..3] of ShortInt;
+
+ procedure DoLines(data: AnsiString; Canvas: TCanvas; Zoom: Single);
+ procedure OneBarProps(code: AnsiChar; var Width: Single; var lt: TfrxBarLineType);
+ function SetLen(pI: Byte): AnsiString;
+ function Code_2_5_interleaved: AnsiString;
+ function Code_2_5_industrial: AnsiString;
+ function Code_2_5_matrix: AnsiString;
+ function Code_39: AnsiString;
+ function Code_39Extended: AnsiString;
+ function Code_128: AnsiString;
+ function Code_93: AnsiString;
+ function Code_93Extended: AnsiString;
+ function Code_MSI: AnsiString;
+ function Code_PostNet: AnsiString;
+ function Code_Codabar: AnsiString;
+ function Code_EAN8: AnsiString;
+ function Code_EAN13: AnsiString;
+ function Code_UPC_A: AnsiString;
+ function Code_UPC_E0: AnsiString;
+ function Code_UPC_E1: AnsiString;
+ function Code_Supp5: AnsiString;
+ function Code_Supp2: AnsiString;
+
+ procedure MakeModules;
+ function GetWidth : Single;
+ function DoCheckSumming(const data : AnsiString):AnsiString;
+ function MakeData : AnsiString;
+ public
+ constructor Create(Owner:TComponent); override;
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent);override;
+
+ procedure DrawBarcode(Canvas: TCanvas; ARect: TRect; ShowText: Boolean; AZoom: Single; IsPrinting: Boolean = False);
+ published
+ property Text : AnsiString read FText write FText;
+ property Modul : integer read FModul write FModul;
+ property Ratio : Double read FRatio write FRatio;
+ property Typ : TfrxBarcodeType read FTyp write FTyp;
+ property Checksum:boolean read FCheckSum write FCheckSum;
+ property CheckSumMethod:TfrxCheckSumMethod read FCheckSumMethod write FCheckSumMethod;
+ property Angle :double read FAngle write FAngle;
+ property Width : Single read GetWidth;
+ property Height: Single read FHeight write FHeight;
+ property Color: TAlphaColor read FColor write FColor;
+ property ColorBar: TAlphaColor read FColorBar write FColorBar;
+ property FontColor: TAlphaColor read FFontColor write FFontColor default claBlack;
+ property Font: TFont read FFont write FFont;
+ end;
+
+
+ TBCdata = packed record
+ Name:AnsiString; { Name of Barcode }
+ num :Boolean; { numeric data only }
+ end;
+
+const BCdata:array[bcCode_2_5_interleaved..bcCodeEAN128C] of TBCdata =
+ (
+ (Name:'2_5_interleaved'; num:True),
+ (Name:'2_5_industrial'; num:True),
+ (Name:'2_5_matrix'; num:True),
+ (Name:'Code39'; num:False),
+ (Name:'Code39 Extended'; num:False),
+ (Name:'Code128A'; num:False),
+ (Name:'Code128B'; num:False),
+ (Name:'Code128C'; num:False),
+ (Name:'Code93'; num:False),
+ (Name:'Code93 Extended'; num:False),
+ (Name:'MSI'; num:True),
+ (Name:'PostNet'; num:True),
+ (Name:'Codebar'; num:False),
+ (Name:'EAN8'; num:True),
+ (Name:'EAN13'; num:True),
+ (Name:'UPC_A'; num:True),
+ (Name:'UPC_E0'; num:True),
+ (Name:'UPC_E1'; num:True),
+ (Name:'UPC Supp2'; num:True),
+ (Name:'UPC Supp5'; num:True),
+ (Name:'EAN128A'; num:False),
+ (Name:'EAN128B'; num:False),
+ (Name:'EAN128C'; num:True)
+ );
+
+
+implementation
+
+function CheckSumModulo10(const data:AnsiString):AnsiString;
+ var i,fak,sum : Integer;
+begin
+ sum := 0;
+ fak := Length(data);
+ for i:=1 to Length(data) do
+ begin
+ if (fak mod 2) = 0 then
+ sum := sum + (StrToInt(String(data[i]))*1)
+ else
+ sum := sum + (StrToInt(String(data[i]))*3);
+ dec(fak);
+ end;
+ if (sum mod 10) = 0 then
+ result := data+'0'
+ else
+ result := data + AnsiString(IntToStr(10-(sum mod 10)));
+end;
+
+procedure Assert(Cond: Boolean; Text: String);
+begin
+ if not Cond then
+ raise Exception.Create(Text);
+end;
+
+{
+ converts a string from '321' to the internal representation '715'
+ i need this function because some pattern tables have a different
+ format :
+
+ '00111'
+ converts to '05161'
+}
+function Convert(const s:AnsiString):AnsiString;
+var
+ i, v : integer;
+begin
+ Result := s; { same Length as Input - string }
+ for i:=1 to Length(s) do
+ begin
+ v := ord(s[i]) - 1;
+
+ if odd(i) then
+ Inc(v, 5);
+ Result[i] := AnsiChar(Chr(v));
+ end;
+end;
+
+(*
+ * Berechne die Quersumme aus einer Zahl x
+ * z.B.: Quersumme von 1234 ist 10
+ *)
+function quersumme(x:integer):integer;
+var
+ sum:integer;
+begin
+ sum := 0;
+
+ while x > 0 do
+ begin
+ sum := sum + (x mod 10);
+ x := x div 10;
+ end;
+ result := sum;
+end;
+
+
+{
+ Rotate a Point by Angle 'alpha'
+}
+function Rotate2D(p:TPointF; alpha:double): TPointF;
+var
+ sinus, cosinus : Extended;
+begin
+ sinus := sin(alpha);
+ cosinus := cos(alpha);
+ result.x := Round(p.x*cosinus + p.y*sinus);
+ result.y := Round(-p.x*sinus + p.y*cosinus);
+end;
+
+{
+ Move Point "a" by Vector "b"
+}
+function Translate2D(a, b:TPointF): TPointF;
+begin
+ result.x := a.x + b.x;
+ result.y := a.y + b.y;
+end;
+
+
+{
+ Move the orgin so that when point is rotated by alpha, the rect
+ between point and orgin stays in the visible quadrant.
+}
+function TranslateQuad2D(const alpha :double; const orgin, point :TPointF): TPointF;
+var
+ alphacos: Extended;
+ alphasin: Extended;
+ moveby: TPointF;
+begin
+ alphasin := sin(alpha);
+ alphacos := cos(alpha);
+
+ if alphasin >= 0 then
+ begin
+ if alphacos >= 0 then
+ begin
+ // 1. Quadrant
+ moveby.x := 0;
+ moveby.y := Round(alphasin*point.x);
+ end
+ else
+ begin
+ // 2. Quadrant
+ moveby.x := -Round(alphacos*point.x);
+ moveby.y := Round(alphasin*point.x - alphacos*point.y);
+ end;
+ end
+ else
+ begin
+ if alphacos >= 0 then
+ begin
+ // 4. quadrant
+ moveby.x := -Round(alphasin*point.y);
+ moveby.y := 0;
+ end
+ else
+ begin
+ // 3. quadrant
+ moveby.x := -Round(alphacos*point.x) - Round(alphasin*point.y);
+ moveby.y := -Round(alphacos*point.y);
+ end;
+ end;
+ Result := Translate2D(orgin, moveby);
+end;
+
+
+constructor TfrxBarcode.Create(Owner:TComponent);
+begin
+ inherited Create(owner);
+ FAngle := 0.0;
+ FRatio := 2.0;
+ FModul := 1;
+ FTyp := bcCodeEAN13;
+ FCheckSum := FALSE;
+ FCheckSumMethod := csmModulo10;
+ FColor := claNull;
+ FColorBar := claBlack;
+ FFont := TFont.Create;
+ FFont.Family := 'Arial';
+ FFont.Size := 9;
+ FontColor := claBlack;
+end;
+
+
+procedure TfrxBarcode.Assign(Source: TPersistent);
+var
+ BSource : TfrxBarcode;
+begin
+ if Source is TfrxBarcode then
+ begin
+ BSource := TfrxBarcode(Source);
+ FHeight := BSource.FHeight;
+ FText := BSource.FText;
+ FTop := BSource.FTop;
+ FLeft := BSource.FLeft;
+ FModul := BSource.FModul;
+ FRatio := BSource.FRatio;
+ FTyp := BSource.FTyp;
+ FCheckSum := BSource.FCheckSum;
+ FAngle := BSource.FAngle;
+ FColor := BSource.FColor;
+ FColorBar := BSource.FColorBar;
+ FCheckSumMethod := BSource.FCheckSumMethod;
+ end;
+end;
+
+
+
+
+{
+calculate the width and the linetype of a sigle bar
+
+
+ Code Line-Color Width Height
+------------------------------------------------------------------
+ '0' white 100% full
+ '1' white 100%*Ratio full
+ '2' white 150%*Ratio full
+ '3' white 200%*Ratio full
+ '5' black 100% full
+ '6' black 100%*Ratio full
+ '7' black 150%*Ratio full
+ '8' black 200%*Ratio full
+ 'A' black 100% 2/5 (used for PostNet)
+ 'B' black 100%*Ratio 2/5 (used for PostNet)
+ 'C' black 150%*Ratio 2/5 (used for PostNet)
+ 'D' black 200%*Ratio 2/5 (used for PostNet)
+}
+procedure TfrxBarcode.OneBarProps(code:AnsiChar; var Width:Single; var lt:TfrxBarLineType);
+begin
+ case code of
+ '0': begin width := modules[0]; lt := white; end;
+ '1': begin width := modules[1]; lt := white; end;
+ '2': begin width := modules[2]; lt := white; end;
+ '3': begin width := modules[3]; lt := white; end;
+
+
+ '5': begin width := modules[0]; lt := black; end;
+ '6': begin width := modules[1]; lt := black; end;
+ '7': begin width := modules[2]; lt := black; end;
+ '8': begin width := modules[3]; lt := black; end;
+
+ 'A': begin width := modules[0]; lt := black_half; end;
+ 'B': begin width := modules[1]; lt := black_half; end;
+ 'C': begin width := modules[2]; lt := black_half; end;
+ 'D': begin width := modules[3]; lt := black_half; end;
+ else
+ begin
+ {something went wrong :-( }
+ {mistyped pattern table}
+ raise Exception.CreateFmt('%s: internal Error', [self.ClassName]);
+ end;
+ end;
+end;
+
+
+function TfrxBarcode.MakeData : AnsiString;
+var
+ i : integer;
+ S: AnsiString;
+begin
+ {calculate the with of the different lines (modules)}
+ MakeModules;
+
+
+ {numeric barcode type ?}
+ if BCdata[Typ].num then
+ begin
+ FText := AnsiString(Trim(String(FText))); {remove blanks}
+ S := FTEXT;
+ if Typ in [bcCodeEAN128A, bcCodeEAN128B, bcCodeEAN128C] then
+ repeat
+ i := Pos(AnsiString('&FNC1;'), S);
+ Delete(S, i, 6);
+ until (i = 0);
+ for i := 1 to Length(S) do
+ if (S[i] > '9') or (S[i] < '0') then
+ raise Exception.Create('Barcode must be numeric');
+ end;
+
+
+ {get the pattern of the barcode}
+ case Typ of
+ bcCode_2_5_interleaved: Result := Code_2_5_interleaved;
+ bcCode_2_5_industrial: Result := Code_2_5_industrial;
+ bcCode_2_5_matrix: Result := Code_2_5_matrix;
+ bcCode39: Result := Code_39;
+ bcCode39Extended: Result := Code_39Extended;
+ bcCode128A,
+ bcCode128B,
+ bcCode128C,
+ bcCodeEAN128A,
+ bcCodeEAN128B,
+ bcCodeEAN128C: Result := Code_128;
+ bcCode93: Result := Code_93;
+ bcCode93Extended: Result := Code_93Extended;
+ bcCodeMSI: Result := Code_MSI;
+ bcCodePostNet: Result := Code_PostNet;
+ bcCodeCodabar: Result := Code_Codabar;
+ bcCodeEAN8: Result := Code_EAN8;
+ bcCodeEAN13: Result := Code_EAN13;
+ bcCodeUPC_A: Result := Code_UPC_A;
+ bcCodeUPC_E0: Result := Code_UPC_E0;
+ bcCodeUPC_E1: Result := Code_UPC_E1;
+ bcCodeUPC_Supp2: Result := Code_Supp2;
+ bcCodeUPC_Supp5: Result := Code_Supp5;
+ else
+ raise Exception.CreateFmt('%s: wrong BarcodeType', [self.ClassName]);
+ end;
+
+{
+Showmessage(Format('Data <%s>', [Result]));
+}
+end;
+
+
+
+function TfrxBarcode.GetWidth: Single;
+var
+ data : AnsiString;
+ i : integer;
+ w : Single;
+ lt : TfrxBarLineType;
+begin
+ Result := 0;
+
+ {get barcode pattern}
+ data := MakeData;
+
+ for i:=1 to Length(data) do {examine the pattern string}
+ begin
+ OneBarProps(data[i], w, lt);
+ Result := Result + w;
+// Inc(Result, w);
+ end;
+end;
+
+function TfrxBarcode.DoCheckSumming(const data : AnsiString):AnsiString;
+begin
+ case FCheckSumMethod of
+
+ csmNone:
+ Result := data;
+ csmModulo10:
+ Result := CheckSumModulo10(data);
+
+ end;
+end;
+
+
+
+
+{
+////////////////////////////// EAN /////////////////////////////////////////
+}
+
+
+{
+////////////////////////////// EAN8 /////////////////////////////////////////
+}
+
+{Pattern for Barcode EAN Charset A}
+ {L1 S1 L2 S2}
+const tabelle_EAN_A:array['0'..'9'] of AnsiString =
+ (
+ ('2605'), { 0 }
+ ('1615'), { 1 }
+ ('1516'), { 2 }
+ ('0805'), { 3 }
+ ('0526'), { 4 }
+ ('0625'), { 5 }
+ ('0508'), { 6 }
+ ('0706'), { 7 }
+ ('0607'), { 8 }
+ ('2506') { 9 }
+ );
+
+{Pattern for Barcode EAN Charset C}
+ {S1 L1 S2 L2}
+const tabelle_EAN_C:array['0'..'9'] of AnsiString =
+ (
+ ('7150' ), { 0 }
+ ('6160' ), { 1 }
+ ('6061' ), { 2 }
+ ('5350' ), { 3 }
+ ('5071' ), { 4 }
+ ('5170' ), { 5 }
+ ('5053' ), { 6 }
+ ('5251' ), { 7 }
+ ('5152' ), { 8 }
+ ('7051' ) { 9 }
+ );
+
+
+function TfrxBarcode.Code_EAN8:AnsiString;
+var
+ i : integer;
+ tmp : AnsiString;
+begin
+ if FCheckSum then
+ begin
+ tmp := SetLen(7);
+ tmp := DoCheckSumming(copy(tmp,length(tmp)-6,7));
+ end
+ else
+ tmp := SetLen(8);
+
+ Assert(Length(tmp)=8, 'Invalid Text len (EAN8)');
+ result := '505'; {Startcode}
+
+ for i:=1 to 4 do
+ result := result + tabelle_EAN_A[tmp[i]] ;
+
+ result := result + '05050'; {Center Guard Pattern}
+
+ for i:=5 to 8 do
+ result := result + tabelle_EAN_C[tmp[i]] ;
+
+ result := result + '505'; {Stopcode}
+end;
+
+{////////////////////////////// EAN13 ///////////////////////////////////////}
+
+{Pattern for Barcode EAN Zeichensatz B}
+ {L1 S1 L2 S2}
+const tabelle_EAN_B:array['0'..'9'] of AnsiString =
+ (
+ ('0517'), { 0 }
+ ('0616'), { 1 }
+ ('1606'), { 2 }
+ ('0535'), { 3 }
+ ('1705'), { 4 }
+ ('0715'), { 5 }
+ ('3505'), { 6 }
+ ('1525'), { 7 }
+ ('2515'), { 8 }
+ ('1507') { 9 }
+ );
+
+{Zuordung der Paraitaetsfolgen fr EAN13}
+const tabelle_ParityEAN13:array[0..9, 1..6] of AnsiChar =
+ (
+ ('A', 'A', 'A', 'A', 'A', 'A'), { 0 }
+ ('A', 'A', 'B', 'A', 'B', 'B'), { 1 }
+ ('A', 'A', 'B', 'B', 'A', 'B'), { 2 }
+ ('A', 'A', 'B', 'B', 'B', 'A'), { 3 }
+ ('A', 'B', 'A', 'A', 'B', 'B'), { 4 }
+ ('A', 'B', 'B', 'A', 'A', 'B'), { 5 }
+ ('A', 'B', 'B', 'B', 'A', 'A'), { 6 }
+ ('A', 'B', 'A', 'B', 'A', 'B'), { 7 }
+ ('A', 'B', 'A', 'B', 'B', 'A'), { 8 }
+ ('A', 'B', 'B', 'A', 'B', 'A') { 9 }
+ );
+
+function TfrxBarcode.Code_EAN13:AnsiString;
+var
+ i, LK: integer;
+ tmp : AnsiString;
+begin
+ if Length(FText) <> 13 then
+ begin
+ FText := SetLen(13);
+ if FCheckSum then
+ tmp := DoCheckSumming(copy(FText,2,12));
+ if FCheckSum then
+ FText := tmp
+ else
+ tmp := FText;
+ end
+ else
+ tmp := FText;
+
+ Assert(Length(tmp) = 13, 'Invalid Text len (EAN13)');
+
+ LK := StrToInt(String(tmp[1]));
+ tmp := copy(tmp,2,12);
+
+ result := '505'; {Startcode}
+
+ for i:=1 to 6 do
+ begin
+ case tabelle_ParityEAN13[LK,i] of
+ 'A' : result := result + tabelle_EAN_A[tmp[i]];
+ 'B' : result := result + tabelle_EAN_B[tmp[i]] ;
+ 'C' : result := result + tabelle_EAN_C[tmp[i]] ;
+ end;
+ end;
+
+ result := result + '05050'; {Center Guard Pattern}
+
+ for i:=7 to 12 do
+ result := result + tabelle_EAN_C[tmp[i]] ;
+
+ result := result + '505'; {Stopcode}
+end;
+
+{Pattern for Barcode 2 of 5}
+const tabelle_2_5:array['0'..'9', 1..5] of AnsiChar =
+ (
+ ('0', '0', '1', '1', '0'), {'0'}
+ ('1', '0', '0', '0', '1'), {'1'}
+ ('0', '1', '0', '0', '1'), {'2'}
+ ('1', '1', '0', '0', '0'), {'3'}
+ ('0', '0', '1', '0', '1'), {'4'}
+ ('1', '0', '1', '0', '0'), {'5'}
+ ('0', '1', '1', '0', '0'), {'6'}
+ ('0', '0', '0', '1', '1'), {'7'}
+ ('1', '0', '0', '1', '0'), {'8'}
+ ('0', '1', '0', '1', '0') {'9'}
+ );
+
+function TfrxBarcode.Code_2_5_interleaved:AnsiString;
+var
+ i, j : integer;
+ c : AnsiChar;
+begin
+ result := '5050'; {Startcode}
+ if FCheckSum and (Length(FText) mod 2 <> 0) then
+ FText := DoCheckSumming(FText);
+
+ for i:=1 to Length(FText) div 2 do
+ begin
+ for j:= 1 to 5 do
+ begin
+ if tabelle_2_5[FText[i*2-1], j] = '1' then
+ c := '6'
+ else
+ c := '5';
+ result := result + c;
+ if tabelle_2_5[FText[i*2], j] = '1' then
+ c := '1'
+ else
+ c := '0';
+ result := result + c;
+ end;
+ end;
+
+ result := result + '605'; {Stopcode}
+end;
+
+
+function TfrxBarcode.Code_2_5_industrial:AnsiString;
+var
+ i, j: integer;
+begin
+// result := '606050'; {Startcode}
+ result := '55055050'; {Startcode}
+
+ for i:=1 to Length(FText) do
+ begin
+ for j:= 1 to 5 do
+ begin
+ if tabelle_2_5[FText[i], j] = '1' then
+ result := result + '60'
+ else
+ result := result + '50';
+ end;
+ end;
+
+// result := result + '605060'; {Stopcode}
+ result := result + '55050550'; {Stopcode}
+end;
+
+function TfrxBarcode.Code_2_5_matrix:AnsiString;
+var
+ i, j: integer;
+ c :AnsiChar;
+begin
+ result := '705050'; {Startcode}
+
+ for i:=1 to Length(FText) do
+ begin
+ for j:= 1 to 5 do
+ begin
+ if tabelle_2_5[FText[i], j] = '1' then
+ c := '1'
+ else
+ c := '0';
+
+ {Falls i ungerade ist dann mache Lcke zu Strich}
+ if odd(j) then
+ c := AnsiChar(chr(ord(c)+5));
+ result := result + c;
+ end;
+ result := result + '0'; {Lcke zwischen den Zeichen}
+ end;
+
+ result := result + '70505'; {Stopcode}
+end;
+
+
+function TfrxBarcode.Code_39:AnsiString;
+
+type TCode39 =
+ record
+ c : AnsiChar;
+ data : array[0..9] of AnsiChar;
+ chk: shortint;
+ end;
+
+const tabelle_39: array[0..43] of TCode39 = (
+ ( c:'0'; data:'505160605'; chk:0 ),
+ ( c:'1'; data:'605150506'; chk:1 ),
+ ( c:'2'; data:'506150506'; chk:2 ),
+ ( c:'3'; data:'606150505'; chk:3 ),
+ ( c:'4'; data:'505160506'; chk:4 ),
+ ( c:'5'; data:'605160505'; chk:5 ),
+ ( c:'6'; data:'506160505'; chk:6 ),
+ ( c:'7'; data:'505150606'; chk:7 ),
+ ( c:'8'; data:'605150605'; chk:8 ),
+ ( c:'9'; data:'506150605'; chk:9 ),
+ ( c:'A'; data:'605051506'; chk:10),
+ ( c:'B'; data:'506051506'; chk:11),
+ ( c:'C'; data:'606051505'; chk:12),
+ ( c:'D'; data:'505061506'; chk:13),
+ ( c:'E'; data:'605061505'; chk:14),
+ ( c:'F'; data:'506061505'; chk:15),
+ ( c:'G'; data:'505051606'; chk:16),
+ ( c:'H'; data:'605051605'; chk:17),
+ ( c:'I'; data:'506051605'; chk:18),
+ ( c:'J'; data:'505061605'; chk:19),
+ ( c:'K'; data:'605050516'; chk:20),
+ ( c:'L'; data:'506050516'; chk:21),
+ ( c:'M'; data:'606050515'; chk:22),
+ ( c:'N'; data:'505060516'; chk:23),
+ ( c:'O'; data:'605060515'; chk:24),
+ ( c:'P'; data:'506060515'; chk:25),
+ ( c:'Q'; data:'505050616'; chk:26),
+ ( c:'R'; data:'605050615'; chk:27),
+ ( c:'S'; data:'506050615'; chk:28),
+ ( c:'T'; data:'505060615'; chk:29),
+ ( c:'U'; data:'615050506'; chk:30),
+ ( c:'V'; data:'516050506'; chk:31),
+ ( c:'W'; data:'616050505'; chk:32),
+ ( c:'X'; data:'515060506'; chk:33),
+ ( c:'Y'; data:'615060505'; chk:34),
+ ( c:'Z'; data:'516060505'; chk:35),
+ ( c:'-'; data:'515050606'; chk:36),
+ ( c:'.'; data:'615050605'; chk:37),
+ ( c:' '; data:'516050605'; chk:38),
+ ( c:'*'; data:'515060605'; chk:0 ),
+ ( c:'$'; data:'515151505'; chk:39),
+ ( c:'/'; data:'515150515'; chk:40),
+ ( c:'+'; data:'515051515'; chk:41),
+ ( c:'%'; data:'505151515'; chk:42)
+ );
+
+
+function FindIdx(z: AnsiChar):integer;
+var
+ i:integer;
+begin
+ for i:=0 to High(tabelle_39) do
+ begin
+ if z = tabelle_39[i].c then
+ begin
+ result := i;
+ exit;
+ end;
+ end;
+ result := -1;
+end;
+
+var
+ i, idx : integer;
+ checksum:integer;
+
+begin
+ checksum := 0;
+ {Startcode}
+ result := tabelle_39[FindIdx('*')].data + '0';
+
+ for i:=1 to Length(FText) do
+ begin
+ idx := FindIdx(AnsiChar(FText[i]));
+ if idx < 0 then
+ continue;
+ result := result + tabelle_39[idx].data + '0';
+ Inc(checksum, tabelle_39[idx].chk);
+ end;
+
+ {Calculate Checksum Data}
+ if FCheckSum then
+ begin
+ checksum := checksum mod 43;
+ for i:=0 to High(tabelle_39) do
+ if checksum = tabelle_39[i].chk then
+ begin
+ result := result + tabelle_39[i].data + '0';
+ break;
+ end;
+ end;
+
+ {Stopcode}
+ result := result + tabelle_39[FindIdx('*')].data;
+end;
+
+function TfrxBarcode.Code_39Extended:AnsiString;
+
+const code39x : array[0..127] of AnsiString =
+ (
+ ('%U'), ('$A'), ('$B'), ('$C'), ('$D'), ('$E'), ('$F'), ('$G'),
+ ('$H'), ('$I'), ('$J'), ('$K'), ('$L'), ('$M'), ('$N'), ('$O'),
+ ('$P'), ('$Q'), ('$R'), ('$S'), ('$T'), ('$U'), ('$V'), ('$W'),
+ ('$X'), ('$Y'), ('$Z'), ('%A'), ('%B'), ('%C'), ('%D'), ('%E'),
+ (' '), ('/A'), ('/B'), ('/C'), ('/D'), ('/E'), ('/F'), ('/G'),
+ ('/H'), ('/I'), ('/J'), ('/K'), ('/L'), ('/M'), ('/N'), ('/O'),
+ ( '0'), ('1'), ('2'), ('3'), ('4'), ('5'), ('6'), ('7'),
+ ('8'), ('9'), ('/Z'), ('%F'), ('%G'), ('%H'), ('%I'), ('%J'),
+ ('%V'), ('A'), ('B'), ('C'), ('D'), ('E'), ('F'), ('G'),
+ ('H'), ('I'), ('J'), ('K'), ('L'), ('M'), ('N'), ('O'),
+ ('P'), ('Q'), ('R'), ('S'), ('T'), ('U'), ('V'), ('W'),
+ ('X'), ('Y'), ('Z'), ('%K'), ('%L'), ('%M'), ('%N'), ('%O'),
+ ('%W'), ('+A'), ('+B'), ('+C'), ('+D'), ('+E'), ('+F'), ('+G'),
+ ('+H'), ('+I'), ('+J'), ('+K'), ('+L'), ('+M'), ('+N'), ('+O'),
+ ('+P'), ('+Q'), ('+R'), ('+S'), ('+T'), ('+U'), ('+V'), ('+W'),
+ ('+X'), ('+Y'), ('+Z'), ('%P'), ('%Q'), ('%R'), ('%S'), ('%T')
+ );
+
+
+var
+ save:AnsiString;
+ i : integer;
+begin
+ save := FText;
+ FText := '';
+
+ for i:=1 to Length(save) do
+ begin
+ if ord(save[i]) <= 127 then
+ FText := FText + code39x[ord(save[i])];
+ end;
+ result := Code_39;
+ FText := save;
+end;
+
+
+
+{
+Code 128
+}
+function TfrxBarcode.Code_128:AnsiString;
+type TCode128 =
+ record
+ a, b : AnsiChar;
+ c : AnsiString;
+ data : AnsiString;
+ end;
+
+const tabelle_128: array[0..102] of TCode128 = (
+ ( a:' '; b:' '; c:'00'; data:'212222' ),
+ ( a:'!'; b:'!'; c:'01'; data:'222122' ),
+ ( a:'"'; b:'"'; c:'02'; data:'222221' ),
+ ( a:'#'; b:'#'; c:'03'; data:'121223' ),
+ ( a:'$'; b:'$'; c:'04'; data:'121322' ),
+ ( a:'%'; b:'%'; c:'05'; data:'131222' ),
+ ( a:'&'; b:'&'; c:'06'; data:'122213' ),
+ ( a:''''; b:''''; c:'07'; data:'122312' ),
+ ( a:'('; b:'('; c:'08'; data:'132212' ),
+ ( a:')'; b:')'; c:'09'; data:'221213' ),
+ ( a:'*'; b:'*'; c:'10'; data:'221312' ),
+ ( a:'+'; b:'+'; c:'11'; data:'231212' ),
+ ( a:','; b:','; c:'12'; data:'112232' ), {23.10.2001 Stefano Torricella}
+ ( a:'-'; b:'-'; c:'13'; data:'122132' ),
+ ( a:'.'; b:'.'; c:'14'; data:'122231' ),
+ ( a:'/'; b:'/'; c:'15'; data:'113222' ),
+ ( a:'0'; b:'0'; c:'16'; data:'123122' ),
+ ( a:'1'; b:'1'; c:'17'; data:'123221' ),
+ ( a:'2'; b:'2'; c:'18'; data:'223211' ),
+ ( a:'3'; b:'3'; c:'19'; data:'221132' ),
+ ( a:'4'; b:'4'; c:'20'; data:'221231' ),
+ ( a:'5'; b:'5'; c:'21'; data:'213212' ),
+ ( a:'6'; b:'6'; c:'22'; data:'223112' ),
+ ( a:'7'; b:'7'; c:'23'; data:'312131' ),
+ ( a:'8'; b:'8'; c:'24'; data:'311222' ),
+ ( a:'9'; b:'9'; c:'25'; data:'321122' ),
+ ( a:':'; b:':'; c:'26'; data:'321221' ),
+ ( a:';'; b:';'; c:'27'; data:'312212' ),
+ ( a:'<'; b:'<'; c:'28'; data:'322112' ),
+ ( a:'='; b:'='; c:'29'; data:'322211' ),
+ ( a:'>'; b:'>'; c:'30'; data:'212123' ),
+ ( a:'?'; b:'?'; c:'31'; data:'212321' ),
+ ( a:'@'; b:'@'; c:'32'; data:'232121' ),
+ ( a:'A'; b:'A'; c:'33'; data:'111323' ),
+ ( a:'B'; b:'B'; c:'34'; data:'131123' ),
+ ( a:'C'; b:'C'; c:'35'; data:'131321' ),
+ ( a:'D'; b:'D'; c:'36'; data:'112313' ),
+ ( a:'E'; b:'E'; c:'37'; data:'132113' ),
+ ( a:'F'; b:'F'; c:'38'; data:'132311' ),
+ ( a:'G'; b:'G'; c:'39'; data:'211313' ),
+ ( a:'H'; b:'H'; c:'40'; data:'231113' ),
+ ( a:'I'; b:'I'; c:'41'; data:'231311' ),
+ ( a:'J'; b:'J'; c:'42'; data:'112133' ),
+ ( a:'K'; b:'K'; c:'43'; data:'112331' ),
+ ( a:'L'; b:'L'; c:'44'; data:'132131' ),
+ ( a:'M'; b:'M'; c:'45'; data:'113123' ),
+ ( a:'N'; b:'N'; c:'46'; data:'113321' ),
+ ( a:'O'; b:'O'; c:'47'; data:'133121' ),
+ ( a:'P'; b:'P'; c:'48'; data:'313121' ),
+ ( a:'Q'; b:'Q'; c:'49'; data:'211331' ),
+ ( a:'R'; b:'R'; c:'50'; data:'231131' ),
+ ( a:'S'; b:'S'; c:'51'; data:'213113' ),
+ ( a:'T'; b:'T'; c:'52'; data:'213311' ),
+ ( a:'U'; b:'U'; c:'53'; data:'213131' ),
+ ( a:'V'; b:'V'; c:'54'; data:'311123' ),
+ ( a:'W'; b:'W'; c:'55'; data:'311321' ),
+ ( a:'X'; b:'X'; c:'56'; data:'331121' ),
+ ( a:'Y'; b:'Y'; c:'57'; data:'312113' ),
+ ( a:'Z'; b:'Z'; c:'58'; data:'312311' ),
+ ( a:'['; b:'['; c:'59'; data:'332111' ),
+ ( a:'\'; b:'\'; c:'60'; data:'314111' ),
+ ( a:']'; b:']'; c:'61'; data:'221411' ),
+ ( a:'^'; b:'^'; c:'62'; data:'431111' ),
+ ( a:'_'; b:'_'; c:'63'; data:'111224' ),
+ ( a:' '; b:'`'; c:'64'; data:'111422' ),
+ ( a:' '; b:'a'; c:'65'; data:'121124' ),
+ ( a:' '; b:'b'; c:'66'; data:'121421' ),
+ ( a:' '; b:'c'; c:'67'; data:'141122' ),
+ ( a:' '; b:'d'; c:'68'; data:'141221' ),
+ ( a:' '; b:'e'; c:'69'; data:'112214' ),
+ ( a:' '; b:'f'; c:'70'; data:'112412' ),
+ ( a:' '; b:'g'; c:'71'; data:'122114' ),
+ ( a:' '; b:'h'; c:'72'; data:'122411' ),
+ ( a:' '; b:'i'; c:'73'; data:'142112' ),
+ ( a:' '; b:'j'; c:'74'; data:'142211' ),
+ ( a:' '; b:'k'; c:'75'; data:'241211' ),
+ ( a:' '; b:'l'; c:'76'; data:'221114' ),
+ ( a:' '; b:'m'; c:'77'; data:'413111' ),
+ ( a:' '; b:'n'; c:'78'; data:'241112' ),
+ ( a:' '; b:'o'; c:'79'; data:'134111' ),
+ ( a:' '; b:'p'; c:'80'; data:'111242' ),
+ ( a:' '; b:'q'; c:'81'; data:'121142' ),
+ ( a:' '; b:'r'; c:'82'; data:'121241' ),
+ ( a:' '; b:'s'; c:'83'; data:'114212' ),
+ ( a:' '; b:'t'; c:'84'; data:'124112' ),
+ ( a:' '; b:'u'; c:'85'; data:'124211' ),
+ ( a:' '; b:'v'; c:'86'; data:'411212' ),
+ ( a:' '; b:'w'; c:'87'; data:'421112' ),
+ ( a:' '; b:'x'; c:'88'; data:'421211' ),
+ ( a:' '; b:'y'; c:'89'; data:'212141' ),
+ ( a:' '; b:'z'; c:'90'; data:'214121' ),
+ ( a:' '; b:'{'; c:'91'; data:'412121' ),
+ ( a:' '; b:'|'; c:'92'; data:'111143' ),
+ ( a:' '; b:'}'; c:'93'; data:'111341' ),
+ ( a:' '; b:'~'; c:'94'; data:'131141' ),
+ ( a:' '; b:' '; c:'95'; data:'114113' ),
+ ( a:' '; b:' '; c:'96'; data:'114311' ),
+ ( a:' '; b:' '; c:'97'; data:'411113' ),
+ ( a:' '; b:' '; c:'98'; data:'411311' ),
+ ( a:' '; b:' '; c:'99'; data:'113141' ),
+ ( a:' '; b:' '; c:' '; data:'114131' ),
+ ( a:' '; b:' '; c:' '; data:'311141' ),
+ ( a:' '; b:' '; c:' '; data:'411131' ) { FNC1 }
+ );
+
+StartA = '211412';
+StartB = '211214';
+StartC = '211232';
+Stop = '2331112';
+
+
+
+
+{find Code 128 Codeset A or B}
+function Find_Code128AB(c: AnsiChar):integer;
+var
+ i:integer;
+ v: AnsiChar;
+begin
+ for i:=0 to High(tabelle_128) do
+ begin
+ if FTyp = bcCode128A then
+ v := tabelle_128[i].a
+ else
+ v := tabelle_128[i].b;
+
+ if c = v then
+ begin
+ result := i;
+ exit;
+ end;
+ end;
+ result := -1;
+end;
+
+{ find Code 128 Codeset C }
+function Find_Code128C(c:AnsiString):integer;
+ var i:integer;
+ begin
+ for i:=0 to High(tabelle_128) do begin
+ if tabelle_128[i].c = c then begin
+ result := i;
+ exit;
+ end;
+ end;
+ result := -1;
+ end;
+
+
+
+var i, idx: integer;
+ startcode:AnsiString;
+ CheckSumCode: AnsiString;
+ checksum : integer;
+ codeword_pos : integer;
+
+begin
+ case FTyp of
+ bcCode128A, bcCodeEAN128A:
+ begin checksum := 103; startcode:= StartA; end;
+ bcCode128B, bcCodeEAN128B:
+ begin checksum := 104; startcode:= StartB; end;
+ bcCode128C, bcCodeEAN128C:
+ begin checksum := 105; startcode:= StartC; end;
+ else
+ raise Exception.CreateFmt('%s: wrong BarcodeType in Code_128', [self.ClassName]);
+ end;
+
+ result := startcode; {Startcode}
+ codeword_pos := 1;
+
+ case FTyp of
+ bcCodeEAN128A,
+ bcCodeEAN128B,
+ bcCodeEAN128C:
+ begin
+ {
+ special identifier
+ FNC1 = function code 1
+ for EAN 128 barcodes
+ }
+ result := result + tabelle_128[102].data;
+ Inc(checksum, 102*codeword_pos);
+ Inc(codeword_pos);
+ {
+ if there is no checksum at the end of the string
+ the EAN128 needs one (modulo 10)
+ }
+
+ if FCheckSum then
+ begin
+ CheckSumCode := FTEXT;
+ repeat
+ i := Pos(AnsiString('&FNC1;'), CheckSumCode);
+ Delete(CheckSumCode, i, 6);
+ until (i = 0);
+ CheckSumCode := DoCheckSumming(CheckSumCode);
+ FTEXT := FTEXT + CheckSumCode[Length(CheckSumCode)];
+ end;
+ end;
+ end;
+ i := 1;
+ if (FTyp = bcCode128C) or (FTyp = bccodeEAN128C) then
+ begin
+ if (Length(FText) mod 2<>0) then FText:='0'+FText;
+ while i <= Length(FText) do
+ if (FText[i] = '&') and (Copy(FText, i, 6) = '&FNC1;') then
+ begin
+ Inc(i, 6);
+ result := result + tabelle_128[102].data;
+ Inc(checksum, 102 *codeword_pos);
+ Inc(codeword_pos);
+ end
+ else
+ begin
+ idx:=Find_Code128C(copy(Ftext,i,2));
+ if idx < 0 then idx := Find_Code128C('00');
+ result := result + tabelle_128[idx].data;
+ Inc(checksum, idx*codeword_pos);
+ Inc(codeword_pos);
+ Inc(i,2);
+ end;
+ end
+ else
+ while i <= Length(FText) do
+ begin
+ if (FText[i] = '&') and (Copy(FText, i, 6) = '&FNC1;') then
+ begin
+ Inc(i, 6);
+ result := result + tabelle_128[102].data;
+ Inc(checksum, 102 *codeword_pos);
+ Inc(codeword_pos);
+ end
+ else
+ begin
+ idx := Find_Code128AB(AnsiChar(FText[i]));
+ if idx < 0 then
+ idx := Find_Code128AB(' ');
+ result := result + tabelle_128[idx].data;
+ Inc(checksum, idx*codeword_pos);
+ Inc(codeword_pos);
+ Inc(i)
+ end;
+ end;
+
+ checksum := checksum mod 103;
+ result := result + tabelle_128[checksum].data;
+
+ result := result + Stop; {Stopcode}
+ Result := Convert(Result);
+end;
+
+
+
+
+
+function TfrxBarcode.Code_93:AnsiString;
+type TCode93 =
+ record
+ c : AnsiChar;
+ data : array[0..5] of AnsiChar;
+ end;
+
+const tabelle_93: array[0..46] of TCode93 = (
+ ( c:'0'; data:'131112' ),
+ ( c:'1'; data:'111213' ),
+ ( c:'2'; data:'111312' ),
+ ( c:'3'; data:'111411' ),
+ ( c:'4'; data:'121113' ),
+ ( c:'5'; data:'121212' ),
+ ( c:'6'; data:'121311' ),
+ ( c:'7'; data:'111114' ),
+ ( c:'8'; data:'131211' ),
+ ( c:'9'; data:'141111' ),
+ ( c:'A'; data:'211113' ),
+ ( c:'B'; data:'211212' ),
+ ( c:'C'; data:'211311' ),
+ ( c:'D'; data:'221112' ),
+ ( c:'E'; data:'221211' ),
+ ( c:'F'; data:'231111' ),
+ ( c:'G'; data:'112113' ),
+ ( c:'H'; data:'112212' ),
+ ( c:'I'; data:'112311' ),
+ ( c:'J'; data:'122112' ),
+ ( c:'K'; data:'132111' ),
+ ( c:'L'; data:'111123' ),
+ ( c:'M'; data:'111222' ),
+ ( c:'N'; data:'111321' ),
+ ( c:'O'; data:'121122' ),
+ ( c:'P'; data:'131121' ),
+ ( c:'Q'; data:'212112' ),
+ ( c:'R'; data:'212211' ),
+ ( c:'S'; data:'211122' ),
+ ( c:'T'; data:'211221' ),
+ ( c:'U'; data:'221121' ),
+ ( c:'V'; data:'222111' ),
+ ( c:'W'; data:'112122' ),
+ ( c:'X'; data:'112221' ),
+ ( c:'Y'; data:'122121' ),
+ ( c:'Z'; data:'123111' ),
+ ( c:'-'; data:'121131' ),
+ ( c:'.'; data:'311112' ),
+ ( c:' '; data:'311211' ),
+ ( c:'$'; data:'321111' ),
+ ( c:'/'; data:'112131' ),
+ ( c:'+'; data:'113121' ),
+ ( c:'%'; data:'211131' ),
+ ( c:'['; data:'121221' ), {only used for Extended Code 93}
+ ( c:']'; data:'312111' ), {only used for Extended Code 93}
+ ( c:'{'; data:'311121' ), {only used for Extended Code 93}
+ ( c:'}'; data:'122211' ) {only used for Extended Code 93}
+ );
+
+
+{find Code 93}
+function Find_Code93(c: AnsiChar):integer;
+var
+ i:integer;
+begin
+ for i:=0 to High(tabelle_93) do
+ begin
+ if c = tabelle_93[i].c then
+ begin
+ result := i;
+ exit;
+ end;
+ end;
+ result := -1;
+end;
+
+
+
+
+var
+ i, idx : integer;
+ checkC, checkK, {Checksums}
+ weightC, weightK : integer;
+begin
+
+ result := '111141'; {Startcode}
+
+ for i:=1 to Length(FText) do
+ begin
+ idx := Find_Code93(AnsiChar(FText[i]));
+ if idx < 0 then
+ raise Exception.CreateFmt('%s:Code93 bad Data <%s>', [self.ClassName,FText]);
+ result := result + tabelle_93[idx].data;
+ end;
+
+ checkC := 0;
+ checkK := 0;
+
+ weightC := 1;
+ weightK := 2;
+
+ for i:=Length(FText) downto 1 do
+ begin
+ idx := Find_Code93(AnsiChar(FText[i]));
+
+ Inc(checkC, idx*weightC);
+ Inc(checkK, idx*weightK);
+
+ Inc(weightC);
+ if weightC > 20 then weightC := 1;
+ Inc(weightK);
+ if weightK > 15 then weightK := 1;
+ end;
+
+ Inc(checkK, checkC);
+
+ checkC := checkC mod 47;
+ checkK := checkK mod 47;
+
+ result := result + tabelle_93[checkC].data +
+ tabelle_93[checkK].data;
+
+ result := result + '1111411'; {Stopcode}
+ Result := Convert(Result);
+end;
+
+
+
+
+
+function TfrxBarcode.Code_93Extended:AnsiString;
+const code93x : array[0..127] of AnsiString =
+ (
+ (']U'), ('[A'), ('[B'), ('[C'), ('[D'), ('[E'), ('[F'), ('[G'),
+ ('[H'), ('[I'), ('[J'), ('[K'), ('[L'), ('[M'), ('[N'), ('[O'),
+ ('[P'), ('[Q'), ('[R'), ('[S'), ('[T'), ('[U'), ('[V'), ('[W'),
+ ('[X'), ('[Y'), ('[Z'), (']A'), (']B'), (']C'), (']D'), (']E'),
+ (' '), ('{A'), ('{B'), ('{C'), ('{D'), ('{E'), ('{F'), ('{G'),
+ ('{H'), ('{I'), ('{J'), ('{K'), ('{L'), ('{M'), ('{N'), ('{O'),
+ ( '0'), ('1'), ('2'), ('3'), ('4'), ('5'), ('6'), ('7'),
+ ('8'), ('9'), ('{Z'), (']F'), (']G'), (']H'), (']I'), (']J'),
+ (']V'), ('A'), ('B'), ('C'), ('D'), ('E'), ('F'), ('G'),
+ ('H'), ('I'), ('J'), ('K'), ('L'), ('M'), ('N'), ('O'),
+ ('P'), ('Q'), ('R'), ('S'), ('T'), ('U'), ('V'), ('W'),
+ ('X'), ('Y'), ('Z'), (']K'), (']L'), (']M'), (']N'), (']O'),
+ (']W'), ('}A'), ('}B'), ('}C'), ('}D'), ('}E'), ('}F'), ('}G'),
+ ('}H'), ('}I'), ('}J'), ('}K'), ('}L'), ('}M'), ('}N'), ('}O'),
+ ('}P'), ('}Q'), ('}R'), ('}S'), ('}T'), ('}U'), ('}V'), ('}W'),
+ ('}X'), ('}Y'), ('}Z'), (']P'), (']Q'), (']R'), (']S'), (']T')
+ );
+
+var
+ save : AnsiString;
+ i : integer;
+begin
+ {CharToOem(PChar(FText), save);}
+
+ save := FText;
+ FText := '';
+
+
+ for i:=1 to Length(save) do
+ begin
+ if ord(save[i]) <= 127 then
+ FText := FText + code93x[ord(save[i])];
+ end;
+
+ {Showmessage(Format('Text: <%s>', [FText]));}
+
+ result := Code_93;
+ FText := save;
+end;
+
+
+
+function TfrxBarcode.Code_MSI:AnsiString;
+const tabelle_MSI:array['0'..'9'] of AnsiString =
+ (
+ ( '51515151' ), {'0'}
+ ( '51515160' ), {'1'}
+ ( '51516051' ), {'2'}
+ ( '51516060' ), {'3'}
+ ( '51605151' ), {'4'}
+ ( '51605160' ), {'5'}
+ ( '51606051' ), {'6'}
+ ( '51606060' ), {'7'}
+ ( '60515151' ), {'8'}
+ ( '60515160' ) {'9'}
+ );
+
+var
+ i:integer;
+ check_even, check_odd, checksum:integer;
+begin
+ result := '60'; {Startcode}
+ check_even := 0;
+ check_odd := 0;
+
+ for i:=1 to Length(FText) do
+ begin
+ if odd(i-1) then
+ check_odd := check_odd*10+ord(FText[i])
+ else
+ check_even := check_even+ord(FText[i]);
+
+ result := result + tabelle_MSI[FText[i]];
+ end;
+
+ checksum := quersumme(check_odd*2) + check_even;
+
+ checksum := checksum mod 10;
+ if checksum > 0 then
+ checksum := 10-checksum;
+
+ result := result + tabelle_MSI[chr(ord('0')+checksum)];
+
+ result := result + '515'; {Stopcode}
+end;
+
+
+
+function TfrxBarcode.Code_PostNet:AnsiString;
+const tabelle_PostNet:array['0'..'9'] of AnsiString =
+ (
+ ( '5151A1A1A1' ), {'0'}
+ ( 'A1A1A15151' ), {'1'}
+ ( 'A1A151A151' ), {'2'}
+ ( 'A1A15151A1' ), {'3'}
+ ( 'A151A1A151' ), {'4'}
+ ( 'A151A151A1' ), {'5'}
+ ( 'A15151A1A1' ), {'6'}
+ ( '51A1A1A151' ), {'7'}
+ ( '51A1A151A1' ), {'8'}
+ ( '51A151A1A1' ) {'9'}
+ );
+var
+ i:integer;
+begin
+ result := '51';
+
+ for i:=1 to Length(FText) do
+ begin
+ result := result + tabelle_PostNet[FText[i]];
+ end;
+ result := result + '5';
+end;
+
+
+function TfrxBarcode.Code_Codabar:AnsiString;
+type TCodabar =
+ record
+ c : AnsiChar;
+ data : array[0..6] of AnsiChar;
+ end;
+
+const tabelle_cb: array[0..19] of TCodabar = (
+ ( c:'1'; data:'5050615' ),
+ ( c:'2'; data:'5051506' ),
+ ( c:'3'; data:'6150505' ),
+ ( c:'4'; data:'5060515' ),
+ ( c:'5'; data:'6050515' ),
+ ( c:'6'; data:'5150506' ),
+ ( c:'7'; data:'5150605' ),
+ ( c:'8'; data:'5160505' ),
+ ( c:'9'; data:'6051505' ),
+ ( c:'0'; data:'5050516' ),
+ ( c:'-'; data:'5051605' ),
+ ( c:'$'; data:'5061505' ),
+ ( c:':'; data:'6050606' ),
+ ( c:'/'; data:'6060506' ),
+ ( c:'.'; data:'6060605' ),
+ ( c:'+'; data:'5060606' ),
+ ( c:'A'; data:'5061515' ),
+ ( c:'B'; data:'5151506' ),
+ ( c:'C'; data:'5051516' ),
+ ( c:'D'; data:'5051615' )
+ );
+
+
+
+{find Codabar}
+function Find_Codabar(c: AnsiChar):integer;
+var
+ i:integer;
+begin
+ for i:=0 to High(tabelle_cb) do
+ begin
+ if c = tabelle_cb[i].c then
+ begin
+ result := i;
+ exit;
+ end;
+ end;
+ result := -1;
+end;
+
+var
+ i, idx : integer;
+begin
+ result := tabelle_cb[Find_Codabar('A')].data + '0';
+ for i:=1 to Length(FText) do
+ begin
+ idx := Find_Codabar(AnsiChar(FText[i]));
+ result := result + tabelle_cb[idx].data + '0';
+ end;
+ result := result + tabelle_cb[Find_Codabar('B')].data;
+end;
+
+
+
+{---------------}
+
+{Assist function}
+function TfrxBarcode.SetLen(pI:byte):AnsiString;
+begin
+ Result := StringOfChar(AnsiChar('0'), pI - Length(FText)) + FText;
+end;
+
+
+
+function TfrxBarcode.Code_UPC_A:AnsiString;
+var
+ i : integer;
+ tmp : AnsiString;
+begin
+ FText := SetLen(12);
+ if FCheckSum then tmp:=DoCheckSumming(copy(FText,1,11));
+ if FCheckSum then FText:=tmp else tmp:=FText;
+ result := '505'; {Startcode}
+ for i:=1 to 6 do
+ result := result + tabelle_EAN_A[tmp[i]];
+ result := result + '05050'; {Trennzeichen}
+ for i:=7 to 12 do
+ result := result + tabelle_EAN_C[tmp[i]];
+ result := result + '505'; {Stopcode}
+end;
+
+
+{UPC E Parity Pattern Table , Number System 0}
+const tabelle_UPC_E0:array['0'..'9', 1..6] of AnsiChar =
+ (
+ ('E', 'E', 'E', 'o', 'o', 'o' ), { 0 }
+ ('E', 'E', 'o', 'E', 'o', 'o' ), { 1 }
+ ('E', 'E', 'o', 'o', 'E', 'o' ), { 2 }
+ ('E', 'E', 'o', 'o', 'o', 'E' ), { 3 }
+ ('E', 'o', 'E', 'E', 'o', 'o' ), { 4 }
+ ('E', 'o', 'o', 'E', 'E', 'o' ), { 5 }
+ ('E', 'o', 'o', 'o', 'E', 'E' ), { 6 }
+ ('E', 'o', 'E', 'o', 'E', 'o' ), { 7 }
+ ('E', 'o', 'E', 'o', 'o', 'E' ), { 8 }
+ ('E', 'o', 'o', 'E', 'o', 'E' ) { 9 }
+ );
+
+function TfrxBarcode.Code_UPC_E0:AnsiString;
+var i,j : integer;
+ tmp : AnsiString;
+ c : AnsiChar;
+begin
+ FText := SetLen(7);
+ tmp:=DoCheckSumming(copy(FText,1,6));
+ c:=tmp[7];
+ if FCheckSum then FText:=tmp else tmp := FText;
+ result := '505'; {Startcode}
+ for i:=1 to 6 do
+ begin
+ if tabelle_UPC_E0[c,i]='E' then
+ begin
+ for j:= 1 to 4 do result := result + tabelle_EAN_C[tmp[i],5-j];
+ end
+ else
+ begin
+ result := result + tabelle_EAN_A[tmp[i]];
+ end;
+ end;
+ result := result + '050505'; {Stopcode}
+end;
+
+function TfrxBarcode.Code_UPC_E1:AnsiString;
+var i,j : integer;
+ tmp : AnsiString;
+ c : AnsiChar;
+begin
+ FText := SetLen(7);
+ tmp:=DoCheckSumming(copy(FText,1,6));
+ c:=tmp[7];
+ if FCheckSum then FText:=tmp else tmp := FText;
+ result := '505'; {Startcode}
+ for i:=1 to 6 do
+ begin
+ if tabelle_UPC_E0[c,i]='E' then
+ begin
+ result := result + tabelle_EAN_A[tmp[i]];
+ end
+ else
+ begin
+ for j:= 1 to 4 do result := result + tabelle_EAN_C[tmp[i],5-j];
+ end;
+ end;
+ result := result + '050505'; {Stopcode}
+end;
+
+{assist function}
+function getSupp(Nr : AnsiString) : AnsiString;
+var i,fak,sum : Integer;
+ tmp : AnsiString;
+begin
+ sum := 0;
+ tmp := copy(nr,1,Length(Nr)-1);
+ fak := Length(tmp);
+ for i:=1 to length(tmp) do
+ begin
+ if (fak mod 2) = 0 then
+ sum := sum + (StrToInt(String(tmp[i]))*9)
+ else
+ sum := sum + (StrToInt(String(tmp[i]))*3);
+ dec(fak);
+ end;
+ sum:=((sum mod 10) mod 10) mod 10;
+ result := tmp + AnsiString(IntToStr(sum));
+end;
+
+function TfrxBarcode.Code_Supp5:AnsiString;
+var i,j : integer;
+ tmp : AnsiString;
+ c : AnsiChar;
+begin
+ FText := SetLen(5);
+ tmp:=getSupp(copy(FText,1,5)+'0');
+ c:=tmp[6];
+ if FCheckSum then FText:=tmp else tmp := FText;
+ result := '506'; {Startcode}
+ for i:=1 to 5 do
+ begin
+ if tabelle_UPC_E0[c,(6-5)+i]='E' then
+ begin
+ for j:= 1 to 4 do result := result + tabelle_EAN_C[tmp[i],5-j];
+ end
+ else
+ begin
+ result := result + tabelle_EAN_A[tmp[i]];
+ end;
+ if i<5 then result:=result+'05'; { character delineator }
+ end;
+end;
+
+function TfrxBarcode.Code_Supp2:AnsiString;
+var i,j : integer;
+ tmp,mS : AnsiString;
+begin
+ FText := SetLen(2);
+ i := StrToInt(String(Ftext));
+ case i mod 4 of
+ 3: mS:='EE';
+ 2: mS:='Eo';
+ 1: mS:='oE';
+ 0: mS:='oo';
+ end;
+ tmp:=getSupp(copy(FText,1,5)+'0');
+
+ if FCheckSum then FText:=tmp else tmp := FText;
+ result := '506'; {Startcode}
+ for i:=1 to 2 do
+ begin
+ if mS[i]='E' then
+ begin
+ for j:= 1 to 4 do result := result + tabelle_EAN_C[tmp[i],5-j];
+ end
+ else
+ begin
+ result := result + tabelle_EAN_A[tmp[i]];
+ end;
+ if i<2 then result:=result+'05'; { character delineator }
+ end;
+end;
+
+{---------------}
+
+
+
+
+procedure TfrxBarcode.MakeModules;
+begin
+ case Typ of
+ bcCode_2_5_interleaved,
+ bcCode_2_5_industrial,
+ bcCode39,
+ bcCodeEAN8,
+ bcCodeEAN13,
+ bcCode39Extended,
+ bcCodeCodabar,
+ bcCodeUPC_A,
+ bcCodeUPC_E0,
+ bcCodeUPC_E1,
+ bcCodeUPC_Supp2,
+ bcCodeUPC_Supp5:
+
+ begin
+ if Ratio < 2.0 then Ratio := 2.0;
+ if Ratio > 3.0 then Ratio := 3.0;
+ end;
+
+ bcCode_2_5_matrix:
+ begin
+ if Ratio < 2.25 then Ratio := 2.25;
+ if Ratio > 3.0 then Ratio := 3.0;
+ end;
+ bcCode128A,
+ bcCode128B,
+ bcCode128C,
+ bcCode93,
+ bcCode93Extended,
+ bcCodeMSI,
+ bcCodePostNet: ;
+ end;
+
+
+ modules[0] := FModul;
+ modules[1] := Round(FModul*FRatio);
+ modules[2] := modules[1] * 3 div 2;
+ modules[3] := modules[1] * 2;
+end;
+
+
+{
+Draw the Barcode
+
+Parameter :
+'data' holds the pattern for a Barcode.
+A barcode begins always with a black line and
+ends with a black line.
+
+The white Lines builds the space between the black Lines.
+
+A black line must always followed by a white Line and vica versa.
+
+Examples:
+ '50505' // 3 thin black Lines with 2 thin white Lines
+ '606' // 2 fat black Lines with 1 thin white Line
+
+ '5605015' // Error
+
+
+data[] : see procedure OneBarProps
+
+}
+procedure TfrxBarcode.DoLines(data:AnsiString; Canvas:TCanvas; Zoom: Single);
+
+var i:integer;
+ lt : TfrxBarLineType;
+ xadd:Single;
+ awidth, aheight: Single;
+begin
+ xadd := 0;
+ with Canvas do begin
+
+
+ for i:=1 to Length(data) do {examine the pattern string}
+ begin
+
+ {
+ input: pattern code
+ output: Width and Linetype
+ }
+ OneBarProps(data[i], awidth, lt);
+
+ if (lt = black) or (lt = black_half) then
+ begin
+ Stroke.Color := FColorBar;
+ end
+ else
+ begin
+ Stroke.Color := FColor;
+ end;
+ Fill.Color := FColor;
+
+ if lt = black_half then
+ aheight := FHeight * 2 / 5
+ else
+ aheight := FHeight;
+
+ aheight := aheight * zoom - 2 * Zoom;
+ awidth := awidth * zoom;
+{$IFDEF Delphi25}
+ Stroke.Thickness := awidth;
+{$ELSE}
+ StrokeThickness := awidth;
+{$ENDIF}
+
+ if lt = black_half then
+ DrawLine(PointF(FDrawArea.Left + xadd + awidth / 2, FDrawArea.Bottom), PointF(FDrawArea.Left + xadd + awidth / 2, FDrawArea.Bottom - aheight), 1)
+ else if lt <> white then
+ DrawLine(PointF(FDrawArea.Left + xadd + awidth / 2, FDrawArea.Top + awidth / 2), PointF(FDrawArea.Left + xadd + awidth / 2, FDrawArea.Top + aheight - awidth / 2), 1);
+ xadd := xadd + awidth;
+ end;
+ end;
+end;
+
+procedure TfrxBarcode.DrawBarcode(Canvas: TCanvas; ARect: TRect; ShowText: Boolean; AZoom: Single; IsPrinting: Boolean = False);
+var
+ data : AnsiString;
+ BarWidth, e, TxtHeight: single;
+ i: Integer;
+ Zoom: Extended;
+ DrawText: AnsiString;
+ state: TCanvasSaveState;
+ m, OldM: TMatrix;
+
+ procedure TextOutR(x, y, w: Single; s: AnsiString);
+ var
+ aRight: Single;
+ sRect: TRectF;
+ begin
+ with Canvas do
+ begin
+
+ Fill.Color := FColor;
+
+ aRight := FDrawArea.Right;
+ if w > 0 then
+ aRight := FDrawArea.Left + w * AZoom + x * AZoom;
+
+ sRect := RectF(FDrawArea.Left + x * AZoom , FDrawArea.Bottom - TxtHeight * AZoom + y * AZoom , aRight, FDrawArea.Bottom);
+
+ FillRect(sRect, 0, 0, allCorners, 1);
+ Fill.Color := FontColor;
+ Stroke.Color := FontColor;
+
+ FillText(sRect, String(s), False, 1, [], TTextAlign.taCenter, TTextAlign.taLeading);
+ end;
+ end;
+
+ procedure OutText;
+// var
+// TxtWidth: Single;
+ begin
+ with Canvas do
+ begin
+ Canvas.Font.Assign(FFont);
+ if not IsPrinting then
+ if Zoom - AZoom > 0.1 then
+ Canvas.Font.Size := (FFont.Size * (Zoom - AZoom))
+ else
+ Canvas.Font.Size := (FFont.Size * AZoom);
+
+
+ case FTyp of
+ bcCodeEAN8: // 8 digits, 4+4
+ begin
+ TextOutR(3,0, 30, Copy(FText, 1, 4));
+ TextOutR(37, 0, 27, Copy(FText, 5, 4));
+ end;
+ bcCodeEAN13: // 13 digits, 1+6+6 or 12 digits, 6+6
+ begin
+ //if FText[1] <> '0' then
+ TextOutR(-6, 0, 4, Copy(FText, 1, 1));
+ TextOutR(3, 0, 44, Copy(FText, 2, 6));
+ TextOutR(51, 0, 41, Copy(FText, 8, 6));
+ end;
+ bcCodeUPC_A: // 12 digits, 1+5+5+1
+ begin
+ TextOutR(-6, 0, 4, Copy(FText, 1, 1));
+ TextOutR(11, 0, 34, Copy(FText, 2, 5));
+ TextOutR(50, 0, 34, Copy(FText, 7, 5));
+ TextOutR(BarWidth + 2, 0, 4, Copy(FText, 12, 1));
+ end;
+ bcCodeUPC_E0,
+ bcCodeUPC_E1: // 7 digits, 6+1
+ begin
+ TextOutR(3, 0, 44, Copy(FText, 1, 6));
+ TextOutR(BarWidth + 2, 0, 4, Copy(FText, 7, 1));
+ end;
+ bcCodeEAN128A,
+ bcCodeEAN128B,
+ bcCodeEAN128C,
+ bcCode128A,
+ bcCode128B,
+ bcCode128C:
+ begin
+ DrawText := FTEXT;
+ repeat
+ i := Pos(AnsiString('&FNC1;'), DrawText);
+ Delete(DrawText, i, 6);
+ until (i = 0);
+ //TxtWidth := TextWidth(String(DrawText));
+ TextOutR(0, 0, 0, DrawText);
+ end
+ else
+ begin
+ //TxtWidth := TextWidth(String(FText));
+ TextOutR(0, 0, 0, FText);
+ end;
+ end;
+
+ end;
+ end;
+
+begin
+ data := MakeData;
+ BarWidth := Width;
+ FLeft := 0;
+ FTop := 0;
+ TxtHeight := (Round(Font.Size * 96 / 72) + 4) ;
+
+ OldM := Canvas.Matrix;
+ State := Canvas.SaveState;
+
+ FDrawArea.Top := ARect.Top;
+ FDrawArea.Left := ARect.Left;
+ FDrawArea.Bottom := ARect.Bottom;
+ FDrawArea.Right := ARect.Right;
+
+ if (FAngle = 0) then
+ begin
+ Zoom := (ARect.Right - ARect.Left) / BarWidth ;
+ FHeight := (ARect.Bottom - ARect.Top)/ Zoom;
+ end
+ else
+ begin
+ m := CreateRotationMatrix(-DegToRad(FAngle));
+ m.m31 := OldM.m31 + ARect.Left + ARect.Width / 2;
+ m.m32 := OldM.m32 + ARect.Top + ARect.Height / 2;
+ Canvas.SetMatrix(m);
+
+ e := ARect.Width;
+ FDrawArea.Left := -ARect.Width / 2;
+ FDrawArea.Right := FDrawArea.Left + e;
+ e := ARect.Height;
+ FDrawArea.Top := -ARect.Height / 2;
+ FDrawArea.Bottom := FDrawArea.Top + e;
+
+ if ((FAngle >= 90) and (FAngle < 180)) or ((FAngle >= 270) and (FAngle < 360)) then
+ FDrawArea := RectF(FDrawArea.Top, FDrawArea.Left, FDrawArea.Bottom, FDrawArea.Right);
+
+ Zoom := (Arect.Bottom - Arect.Top) / BarWidth;
+ FHeight := Arect.Width / Zoom;
+
+ if(FAngle = 180) then
+ begin
+ Zoom := (ARect.Right - ARect.Left) / BarWidth ;
+ FHeight := (ARect.Bottom - ARect.Top)/ Zoom;
+ end;
+
+ end;
+
+ try
+ {$IFDEF DELPHI25}
+ Canvas.Stroke.Dash := TStrokeDash.sdSolid;
+ {$ELSE}
+ Canvas.StrokeDash := TStrokeDash.sdSolid;
+ {$ENDIF}
+ DoLines(data, Canvas, Zoom);
+ if ShowText then
+ OutText;
+ finally
+ Canvas.RestoreState(state);
+ Canvas.SetMatrix(OldM);
+ end;
+end;
+
+
+destructor TfrxBarcode.Destroy;
+begin
+ FFont.Free;
+ inherited;
+end;
+
+end.
diff --git a/LibD28/FMX.frxBarcode.pas b/LibD28/FMX.frxBarcode.pas
new file mode 100644
index 0000000..81dbd06
--- /dev/null
+++ b/LibD28/FMX.frxBarcode.pas
@@ -0,0 +1,302 @@
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ Barcode Add-in object }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxBarcode;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.Types, System.UIConsts, FMX.Types,
+ FMX.Objects, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Menus, FMX.frxBarcod,
+ FMX.frxClass, System.Variants
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxBarCodeObject = class(TComponent); // fake component
+
+
+ TfrxBarCodeView = class(TfrxView)
+ private
+ FBarCode: TfrxBarCode;
+ FBarType: TfrxBarcodeType;
+ FCalcCheckSum: Boolean;
+ FExpression: String;
+ FHAlign: TfrxHAlign;
+ FRotation: Integer;
+ FShowText: Boolean;
+ FText: String;
+ FWideBarRatio: Double;
+ FZoom: Double;
+ procedure BcFontChanged(Sender: TObject);
+ procedure SetRotation(const Value: Integer);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ procedure GetData; override;
+ class function GetDescription: String; override;
+ function GetRealBounds: TfrxRect; override;
+ property BarCode: TfrxBarCode read FBarCode;
+ published
+ property BarType: TfrxBarcodeType read FBarType write FBarType;
+ property BrushStyle;
+ property CalcCheckSum: Boolean read FCalcCheckSum write FCalcCheckSum default False;
+ property Color;
+ property Cursor;
+ property DataField;
+ property DataSet;
+ property DataSetName;
+ property Expression: String read FExpression write FExpression;
+ property Frame;
+ property HAlign: TfrxHAlign read FHAlign write FHAlign default haLeft;
+ property Rotation: Integer read FRotation write SetRotation;
+ property ShowText: Boolean read FShowText write FShowText default True;
+ property TagStr;
+ property Text: String read FText write FText;
+ property URL;
+ property WideBarRatio: Double read FWideBarRatio write FWideBarRatio;
+ property Zoom: Double read FZoom write FZoom;
+ property Font;
+ end;
+
+
+implementation
+
+uses
+{$IFNDEF NO_EDITORS}
+ FMX.frxBarcodeEditor,
+{$ENDIF}
+ FMX.frxBarcodeRTTI, FMX.frxDsgnIntf, FMX.frxRes, FMX.frxUtils, FMX.frxPrinter;
+
+const
+ cbDefaultText = '12345678';
+
+
+{ TfrxBarCodeView }
+
+constructor TfrxBarCodeView.Create(AOwner: TComponent);
+begin
+ inherited;
+ FBarCode := TfrxBarCode.Create(nil);
+ FBarType := bcCode39;
+ FShowText := True;
+ FZoom := 1;
+ FText := cbDefaultText;
+ FWideBarRatio := 2;
+ Font.Name := 'Arial';
+ Font.Size := 9;
+ Font.OnChange := BcFontChanged;
+end;
+
+destructor TfrxBarCodeView.Destroy;
+begin
+ FBarCode.Free;
+ inherited Destroy;
+end;
+
+class function TfrxBarCodeView.GetDescription: String;
+begin
+ Result := frxResources.Get('obBarC');
+end;
+
+procedure TfrxBarCodeView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+var
+ SaveWidth: Extended;
+ ErrorText: String;
+ DrawRectA: TRectF;
+ CorrL, CorrR: Integer;
+ OutRect: TRect;
+begin
+ FBarCode.Angle := FRotation;
+ Font.AssignToFont(FBarCode.Font);
+ FBarCode.Font.Size := FBarCode.Font.Size * FZoom;
+ FBarCode.FontColor := Font.Color;
+ FBarCode.Checksum := FCalcCheckSum;
+ FBarCode.Typ := FBarType;
+ FBarCode.Ratio := FWideBarRatio;
+ if Color = claNull then
+ FBarCode.Color := claWhite else
+ FBarCode.Color := Color;
+
+ SaveWidth := Width;
+
+ FBarCode.Text := AnsiString(FText);
+ ErrorText := '';
+ if FZoom < 0.0001 then
+ FZoom := 1;
+
+ { frame correction for some bacrode types }
+ if FBarCode.Typ in [bcCodeUPC_E0, bcCodeUPC_E1, bcCodeUPC_A] then
+ CorrR := 9
+ else
+ CorrR := 0;
+ if FBarCode.Typ in [bcCodeEAN13, bcCodeUPC_A] then
+ CorrL := 8
+ else
+ CorrL := 0;
+
+ try
+ if (FRotation = 0) or (FRotation = 180) then
+ Width := (FBarCode.Width + CorrL + CorrR) * FZoom
+ else
+ Height := (FBarCode.Width + CorrL + CorrR) * FZoom;
+ except
+ on e: Exception do
+ begin
+ FBarCode.Text := '12345678';
+ ErrorText := e.Message;
+ end;
+ end;
+
+ if FHAlign = haRight then
+ Left := Left + SaveWidth - Width
+ else if FHAlign = haCenter then
+ Left := Left + (SaveWidth - Width) / 2;
+
+ BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+
+ DrawBackground;
+ if (FRotation = 0) or (FRotation = 180) then
+ OutRect := Rect(FX + Round(CorrL * ScaleX) , FY, FX1 - Round(CorrR * ScaleX), FY1)
+ else
+ OutRect := Rect(FX, FY + Round(CorrL * ScaleX) , FX1, FY1 - Round(CorrR * ScaleX));
+ if ErrorText = '' then
+ FBarCode.DrawBarcode(Canvas, OutRect, FShowText, ScaleY, {$IFDEF DELPHI25}{$IFDEF MSWINDOWS}False{$ELSE}IsPrinting{$ENDIF}{$ELSE}IsPrinting{$ENDIF})
+ else
+ with Canvas do
+ begin
+ Font.Family := 'Arial';
+ Font.Size := Round(8 * ScaleY);
+ Fill.Color := claRed;
+ DrawRectA := RectF(FX + 2, FY + 2, FX1, FY1);
+ FillText(DrawRectA, ErrorText, True, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ end;
+ DrawFrame;
+end;
+
+procedure TfrxBarCodeView.GetData;
+begin
+ inherited;
+ if IsDataField then
+ FText := VarToStr(DataSet.Value[DataField])
+ else if FExpression <> '' then
+ FText := VarToStr(Report.Calc(FExpression));
+end;
+
+function TfrxBarCodeView.GetRealBounds: TfrxRect;
+var
+ extra1, extra2, txtWidth: Single;
+ bmp: TBitmap;
+begin
+ bmp := TBitmap.Create(1,1);
+ bmp.Canvas.BeginScene;
+ try
+ Draw(bmp.Canvas, 1, 1, 0, 0);
+
+ Result := inherited GetRealBounds;
+ extra1 := 0;
+ extra2 := 0;
+
+ if (FRotation = 0) or (FRotation = 180) then
+ begin
+ Font.AssignToCanvas(bmp.Canvas);
+ with bmp.Canvas do
+ begin
+ {Font.Name := 'Arial';
+ Font.Size := 9;
+ Font.Style := []; }
+ //Font.Assign(Self.Font);
+ txtWidth := TextWidth(String(FBarcode.Text));
+ if Width < txtWidth then
+ begin
+ extra1 := Round((txtWidth - Width) / 2) + 2;
+ extra2 := extra1;
+ end;
+ end;
+ end;
+ finally
+ bmp.Canvas.EndScene;
+ end;
+
+ if FBarType in [bcCodeEAN13, bcCodeUPC_A] then
+ extra1 := 8;
+ if FBarType in [bcCodeUPC_A, bcCodeUPC_E0, bcCodeUPC_E1] then
+ extra2 := 8;
+ case FRotation of
+ 0:
+ begin
+ Result.Left := Result.Left - extra1;
+ Result.Right := Result.Right + extra2;
+ end;
+ 90:
+ begin
+ Result.Bottom := Result.Bottom + extra1;
+ Result.Top := Result.Top - extra2;
+ end;
+ 180:
+ begin
+ Result.Left := Result.Left - extra2;
+ Result.Right := Result.Right + extra1;
+ end;
+ 270:
+ begin
+ Result.Bottom := Result.Bottom + extra2;
+ Result.Top := Result.Top - extra1;
+ end;
+ end;
+
+ bmp.Free;
+end;
+
+procedure TfrxBarCodeView.SetRotation(const Value: Integer);
+begin
+ case Round(Value) of
+ 0 .. 44: FRotation := 0;
+ 45 .. 135: FRotation := 90;
+ 136 .. 224: FRotation := 180;
+ 225 .. 315: FRotation := 270;
+ else
+ FRotation := 0;
+ end;
+end;
+
+procedure TfrxBarCodeView.BcFontChanged(Sender: TObject);
+begin
+ if Font.Size > 9 then Font.Size := 9;
+end;
+
+initialization
+ StartClassGroup(TfmxObject);
+ ActivateClassGroup(TfmxObject);
+ //GroupDescendentsWith(TfrxBarCodeView, TfmxObject);
+ GroupDescendentsWith(TfrxBarCodeObject, TfmxObject);
+ RegisterFmxClasses([TfrxBarCodeObject]);
+ frxObjects.RegisterObject1(TfrxBarCodeView, nil, '', '', 0, 123);
+
+finalization
+ frxObjects.UnRegister(TfrxBarCodeView);
+
+end.
diff --git a/LibD28/FMX.frxBarcode2DBase.pas b/LibD28/FMX.frxBarcode2DBase.pas
new file mode 100644
index 0000000..3916857
--- /dev/null
+++ b/LibD28/FMX.frxBarcode2DBase.pas
@@ -0,0 +1,468 @@
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ 2D Barcode Add-in object }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxBarcode2DBase;
+{$I frx.inc}
+
+interface
+
+uses
+ System.Classes,
+ System.SysUtils,
+ System.Types,
+ System.UITypes,
+ System.UIConsts,
+ System.Math,
+ FMX.Types,
+ FMX.Objects,
+ FMX.frxPrinter
+{$IFDEF DELPHI19}
+ , FMX.Graphics, FMX.frxFMX
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+
+ TfrxBarcode2DBase = class(TComponent)
+ protected
+ FImage: TBytes;
+ FHeight: Integer;
+ FWidth: Integer;
+ FPixelWidth: Integer;
+ FPixelHeight: Integer;
+ FShowText: boolean;
+ FRotation: Integer;
+ FText: String;
+ FZoom: Double;
+ FFontScaled: boolean;
+ FFont: TFont;
+ FColor: TAlphaColor;
+ FColorBar: TAlphaColor;
+ FFontColor: TAlphaColor;
+ FErrorText: String;
+ FQuiteZone: Integer;
+
+ procedure SetShowText(Value: boolean); virtual;
+ procedure SetRotation(Value: Integer); virtual;
+ procedure SetText(Value: String); virtual;
+ procedure SetZoom(Value: Double); virtual;
+ procedure SetFontScaled(Value: boolean); virtual;
+ procedure SetFont(Value: TFont); virtual;
+ procedure SetColor(Value: TAlphaColor); virtual;
+ procedure SetColorBar(Value: TAlphaColor); virtual;
+ procedure SetErrorText(Value: String); virtual;
+ function GetWidth: Integer; virtual;
+ function GetHeight: Integer; virtual;
+ public
+ constructor Create; reintroduce; virtual;
+ destructor Destroy; override;
+ procedure Assign(Source: TfrxBarcode2DBase); reintroduce; virtual;
+ function GetFooterHeight: Integer; virtual;
+ procedure Draw2DBarcode(var Canvas: TCanvas; scalex, scaley: extended;
+ x, y: Integer; IsPrinting: boolean = False); virtual;
+
+ property ShowText: boolean read FShowText write SetShowText;
+ property Rotation: Integer read FRotation write SetRotation;
+ property Text: String read FText write SetText;
+ property Zoom: Double read FZoom write SetZoom;
+ property FontScaled: boolean read FFontScaled write SetFontScaled;
+ property Font: TFont read FFont write SetFont;
+ property Color: TAlphaColor read FColor write SetColor;
+ property FontColor: TAlphaColor read FFontColor write FFontColor;
+ property ColorBar: TAlphaColor read FColorBar write SetColorBar;
+ property ErrorText: String read FErrorText write SetErrorText;
+ property Width: Integer read GetWidth;
+ property Height: Integer read GetHeight;
+ property PixelWidth: Integer read FPixelWidth write FPixelWidth;
+ property PixelHeight: Integer read FPixelHeight write FPixelHeight;
+ property QuiteZone: Integer read FQuiteZone write FQuiteZone;
+ end;
+
+const
+ cbDefaultText = '12345678';
+
+implementation
+
+constructor TfrxBarcode2DBase.Create;
+begin
+ FWidth := 0;
+ FHeight := 0;
+ FImage := nil;
+ FPixelWidth := 2;
+ FPixelHeight := 2;
+ FShowText := true;
+ FRotation := 0;
+ FText := cbDefaultText;
+ FZoom := 1;
+ FFontScaled := true;
+ FColor := claWhite;
+ FColorBar := claBlack;
+ FFontColor := claBlack;
+ FFont := TFont.Create;
+ FFont.Family := 'Arial';
+ FFont.Size := 9;
+ FQuiteZone := 3;
+end;
+
+procedure TfrxBarcode2DBase.Assign(Source: TfrxBarcode2DBase);
+begin
+ FShowText := Source.FShowText;
+ FRotation := Source.FRotation;
+ FText := Source.FText;
+ FZoom := Source.FZoom;
+ FPixelWidth := Source.FPixelWidth;
+ FPixelHeight := Source.FPixelHeight;
+ FFontScaled := Source.FFontScaled;
+ FFont.Assign(Source.FFont);
+ FColor := Source.FColor;
+ FColorBar := Source.FColorBar;
+ FErrorText := Source.FErrorText;
+ FQuiteZone := Source.FQuiteZone;
+end;
+
+procedure TfrxBarcode2DBase.SetShowText(Value: boolean);
+begin
+ FShowText := Value;
+end;
+
+procedure TfrxBarcode2DBase.SetRotation(Value: Integer);
+begin
+ FRotation := Value;
+end;
+
+procedure TfrxBarcode2DBase.SetText(Value: String);
+begin
+ if (FText <> Value) then
+ FText := Value;
+end;
+
+procedure TfrxBarcode2DBase.SetZoom(Value: Double);
+begin
+ FZoom := Value;
+end;
+
+procedure TfrxBarcode2DBase.SetFontScaled(Value: boolean);
+begin
+ FFontScaled := Value;
+end;
+
+procedure TfrxBarcode2DBase.SetFont(Value: TFont);
+begin
+ FFont.Assign(Value);
+end;
+
+procedure TfrxBarcode2DBase.SetColor(Value: TAlphaColor);
+begin
+ FColor := Value;
+end;
+
+procedure TfrxBarcode2DBase.SetColorBar(Value: TAlphaColor);
+begin
+ FColorBar := Value;
+end;
+
+procedure TfrxBarcode2DBase.SetErrorText(Value: String);
+begin
+ FErrorText := Value;
+end;
+
+function TfrxBarcode2DBase.GetFooterHeight: Integer;
+begin
+ result := Round(Font.Size * 96 / 72) * 2 div 4;
+end;
+
+function TfrxBarcode2DBase.GetWidth: Integer;
+begin
+ result := Round(FWidth * FPixelWidth + FQuiteZone * 2);
+end;
+
+function TfrxBarcode2DBase.GetHeight: Integer;
+begin
+ if FShowText then
+ result := Round(FHeight * FPixelHeight + Round(Font.Size * 96 / 72 * 2) / 4
+ + FQuiteZone * 2)
+ else
+ result := Round(FHeight * FPixelHeight + FQuiteZone * 2);
+end;
+
+destructor TfrxBarcode2DBase.Destroy;
+begin
+ FreeAndNil(FFont);
+ SetLength(FImage, 0);
+ inherited;
+end;
+
+procedure TfrxBarcode2DBase.Draw2DBarcode(var Canvas: TCanvas;
+ scalex, scaley: extended; x, y: Integer; IsPrinting: boolean = False);
+var
+ stride, p, k, j, b: Integer;
+ dx, dy, textLeftOffset, textSemiLength, footerHeight, saveFooter, paddingX,
+ paddingY, x1, y1, x2, y2, txtX, txtY, e: Single;
+ kx, ky, saveKX, saveKY: extended;
+// flag: boolean;
+ bmp: TBitmap;
+ r, TextRect: TRectF;
+ state: TCanvasSaveState;
+ m, OldM: TMatrix;
+
+begin
+ kx := scalex * Zoom;
+ ky := scaley * Zoom;
+ x1 := 0;
+ x2 := 0;
+ y1 := 0;
+ y2 := 0;
+ footerHeight := 0;
+ dy := Round(FHeight * PixelHeight * ky);
+ dx := Round(FWidth * PixelWidth * kx);
+ paddingX := Round(FQuiteZone * kx);
+ paddingY := Round(FQuiteZone * ky);
+
+ if ShowText then
+ begin
+ Canvas.Font.Assign(FFont);
+
+
+ // Canvas.Font.Size := Canvas.Font.Size * ScaleY;
+
+ textSemiLength := Canvas.TextWidth(Text) / 2;
+ footerHeight := (Round(Font.Size * 96 / 72) + 4) * Zoom * scaley;
+ // + Round(Font.Size * 96 / 72);
+ if not IsPrinting then
+ Canvas.Font.Size := (FFont.Size * Zoom * scaley);
+
+ case Round(Rotation) of
+ 0:
+ begin
+ x1 := x;
+ y1 := y + dy;
+ x2 := x + dx;
+ y2 := y + dy + footerHeight;
+ textLeftOffset := dx / 2 - textSemiLength;
+ if textLeftOffset < 0 then
+ textLeftOffset := 0;
+ txtX := x + textLeftOffset;
+ txtY := y + dy
+ end;
+ 90:
+ begin
+ x1 := x + dy;
+ x2 := x + dy + footerHeight;
+ y1 := y;
+ y2 := y + dx;
+ textLeftOffset := dx / 2 - textSemiLength;
+ if textLeftOffset < 0 then
+ textLeftOffset := 0;
+ txtX := x1;
+ txtY := y2 - textLeftOffset;
+ end;
+ 180:
+ begin
+ x1 := x;
+ x2 := x + dx;
+ y1 := y;
+ y2 := y + footerHeight;
+ textLeftOffset := dx / 2 - textSemiLength;
+ if textLeftOffset < 0 then
+ textLeftOffset := 0;
+ txtX := x + dx - textLeftOffset;
+ txtY := y + footerHeight;
+ end;
+ 270:
+ begin
+ x1 := x;
+ x2 := x + footerHeight;
+ y1 := y;
+ y2 := y + dx;
+ textLeftOffset := dx / 2 - textSemiLength;
+ if textLeftOffset < 0 then
+ textLeftOffset := 0;
+ txtX := x1 + footerHeight;
+ txtY := y1 + textLeftOffset;
+ end;
+
+ end;
+
+ OldM := Canvas.Matrix;
+ state := Canvas.SaveState;
+ try
+ TextRect := RectF(x1 + paddingX, y1 + paddingY, x2 + paddingX,
+ y2 + paddingY);
+ if FRotation > 0 then
+ begin
+ m := CreateRotationMatrix(-DegToRad(FRotation));
+ m.m31 := OldM.m31 + TextRect.Left + TextRect.Width / 2;
+ m.m32 := OldM.m32 + TextRect.Top + TextRect.Height / 2;
+ Canvas.SetMatrix(m);
+
+ e := TextRect.Width;
+ TextRect.Left := -TextRect.Width / 2;
+ TextRect.Right := TextRect.Left + e;
+ e := TextRect.Height;
+ TextRect.Top := -TextRect.Height / 2;
+ TextRect.Bottom := TextRect.Top + e;
+
+ if ((FRotation >= 90) and (FRotation < 180)) or
+ ((FRotation >= 270) and (FRotation < 360)) then
+ TextRect := RectF(TextRect.Top, TextRect.Left, TextRect.Bottom,
+ TextRect.Right);
+ end;
+ Canvas.Fill.Color := FFontColor;
+ Canvas.FillText(TextRect, Text, False, 1, [], TTextAlign.taCenter,
+ TTextAlign.taLeading);
+
+ finally
+ Canvas.RestoreState(state);
+ Canvas.SetMatrix(OldM);
+ end;
+
+ end;
+
+ stride := (FWidth + 7) div 8;
+
+ saveKX := 0;
+ bmp := nil;
+ if (kx < 1) or (ky < 1) then
+ begin
+ saveKX := kx;
+ saveKY := ky;
+ saveFooter := footerHeight;
+ kx := 1;
+ ky := 1;
+ footerHeight := 0;
+ bmp := TBitmap.Create(FWidth * PixelWidth, FHeight * PixelHeight);
+ if (Rotation = 90) or (Rotation = 270) then
+ begin
+ bmp.Height := FWidth * PixelWidth;
+ bmp.Width := FHeight * PixelHeight;
+ end;
+ dy := Round(FHeight * PixelHeight);
+ dx := Round(FWidth * PixelWidth);
+ bmp.Canvas.BeginScene();
+ end;
+ try
+
+ for k := 0 to FHeight - 1 do
+ begin
+ p := k * stride;
+ for j := 0 to FWidth - 1 do
+ begin
+ b := FImage[p + (j div 8)] and $FF;
+ b := b shl (j mod 8);
+
+ if (b and $80) = 0 then
+ begin
+ if (saveKX <> 0) then
+ bmp.Canvas.Fill.Color := claWhite
+ else
+ Canvas.Fill.Color := claWhite;
+ end
+ else
+ begin
+ if (saveKX <> 0) then
+ bmp.Canvas.Fill.Color := claBlack
+ else
+ Canvas.Fill.Color := claBlack;
+ end;
+
+ case Round(Rotation) of
+ 0:
+ begin
+ x1 := Round(x + j * PixelWidth * kx);
+ y1 := Round(y + k * PixelHeight * ky);
+ x2 := Round(x + j * PixelWidth * kx + PixelWidth * kx);
+ y2 := Round(y + k * PixelHeight * ky + PixelHeight * ky);
+ end;
+ 90:
+ begin
+ x1 := Round(x + k * PixelHeight * kx);
+ x2 := Round(x + k * PixelHeight * kx + PixelHeight * kx);
+ y1 := Round(y + dx - j * PixelWidth * ky);
+ y2 := Round(y + dx - j * PixelWidth * ky - PixelWidth * ky);
+ end;
+ 180:
+ begin
+ x1 := Round(x + dx - j * PixelWidth * kx);
+ x2 := Round(x + dx - j * PixelWidth * kx - PixelWidth * kx);
+ y1 := Round(y + footerHeight + dy - k * PixelHeight * ky);
+ y2 := Round(y + footerHeight + dy - k * PixelHeight * ky -
+ PixelHeight * ky);
+ end;
+ 270:
+ begin
+ x1 := Round(x + footerHeight + dy - k * PixelHeight * kx);
+ x2 := Round(x + footerHeight + dy - k * PixelHeight * kx -
+ PixelHeight * kx);
+ y1 := Round(y + j * PixelWidth * ky);
+ y2 := Round(y + j * PixelWidth * ky + PixelWidth * ky);
+ end;
+
+ end;
+
+ if (saveKX = 0) then
+ Canvas.FillRect(RectF(x1 + paddingX, y1 + paddingY, x2 + paddingX,
+ y2 + paddingY), 0, 0, allCorners, 1)
+ else
+ bmp.Canvas.FillRect(RectF(x1 - x + paddingX, y1 - y + paddingY,
+ x2 - x + paddingX, y2 - y + paddingY), 0, 0, allCorners, 1);
+
+ end
+ end;
+
+ if (saveKX <> 0) then
+ begin
+ bmp.Canvas.EndScene;
+ case Round(Rotation) of
+ 0:
+ begin
+ x1 := 0;
+ y1 := 0;
+ x2 := Round(FWidth * PixelWidth * saveKX);
+ y2 := Round(FHeight * PixelHeight * saveKY);
+ end;
+ 90:
+ begin
+ x1 := 0;
+ y1 := 0;
+ x2 := Round(FHeight * PixelHeight * saveKY);
+ y2 := Round(FWidth * PixelWidth * saveKX);
+ end;
+ 180:
+ begin
+ x1 := 0;
+ y1 := saveFooter;
+ x2 := Round(FWidth * PixelWidth * saveKX);
+ y2 := Round(FHeight * PixelHeight * saveKY);
+ end;
+ 270:
+ begin
+ x1 := saveFooter;
+ y1 := 0;
+ x2 := Round(FHeight * PixelHeight * saveKY);
+ y2 := Round(FWidth * PixelWidth * saveKX);
+ end;
+ end;
+ r := RectF(x, y, x + x1 + x2 + paddingX, y + y1 + y2 + paddingY);
+ Canvas.DrawBitmap(bmp, RectF(0, 0, bmp.Width, bmp.Height), r, 1, False);
+ end;
+ finally
+ if Assigned(bmp) then
+ FreeAndNil(bmp);
+ end;
+
+end;
+
+end.
diff --git a/LibD28/FMX.frxBarcode2DRTTI.pas b/LibD28/FMX.frxBarcode2DRTTI.pas
new file mode 100644
index 0000000..7ce3ff2
--- /dev/null
+++ b/LibD28/FMX.frxBarcode2DRTTI.pas
@@ -0,0 +1,68 @@
+{ ****************************************** }
+{ }
+{ FastReport v5.0 }
+{ Barcode RTTI }
+{ }
+{ Copyright (c) 1998-2014 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{ ****************************************** }
+
+unit FMX.frxBarcode2DRTTI;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, System.Types, System.SysUtils, FMX.Types, FMX.fs_iinterpreter, FMX.frxBarcodePDF417,
+ FMX.frxBarcodeDataMatrix, FMX.frxBarcodeQR, FMX.frxClassRTTI, FMX.frxBarcode2DView,
+ FMX.frxBarcodeProperties, System.Variants;
+
+type
+ TFunctions = class(TfsRTTIModule)
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+ { TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TfrxBarcode2DType', 'bcCodePDF417, bcCodeDataMatrix, bcCodeQR');
+ AddEnum('TQRCodeEncoding', 'qrAuto, qrNumeric, qrAlphanumeric, qrISO88591, qrUTF8NoBOM, qrUTF8BOM, qrShift_JIS');
+ AddEnum('TQRErrorLevels', 'ecL, ecM, ecQ, ecH');
+
+ AddEnum('DatamatrixEncoding', 'Auto, Ascii, C40, Txt, Base256, X12, Edifact');
+ AddEnum('DatamatrixSymbolSize', 'AutoSize, Size10x10, Size12x12, Size8x18, Size14x14, Size8x32, Size16x16, Size12x26,'
+ + ' Size18x18, Size20x20, Size12x36, Size22x22, Size16x36, Size24x24, Size26x26, Size16x48, Size32x32, Size36x36, Size40x40,'
+ + 'Size44x44, Size48x48, Size52x52, Size64x64, Size72x72, Size80x80, Size88x88, Size96x96, Size104x104, Size120x120, Size132x132, Size144x144');
+
+ AddEnum('PDF417ErrorCorrection', ' AutoCorr, Level0, Level1, Level2, Level3, Level4, Level5, Level6, Level7, Level8');
+ AddEnum('PDF417CompactionMode', 'AutoCompaction, TextComp, Numeric, Binary');
+
+ AddClass(TUniqueProp, 'TPersistent');
+ AddClass(TPDF417UniqueProperties, 'TUniqueProp');
+ AddClass(TDataMatrixUniqueProperties, 'TUniqueProp');
+ AddClass(TfrxQRProperties, 'TUniqueProp');
+
+ AddClass(TfrxBarcode2DView, 'TfrxView');
+ end;
+end;
+
+initialization
+
+fsRTTIModules.Add(TFunctions);
+
+finalization
+
+if fsRTTIModules <> nil then
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/FMX.frxBarcode2DView.pas b/LibD28/FMX.frxBarcode2DView.pas
new file mode 100644
index 0000000..56d0823
--- /dev/null
+++ b/LibD28/FMX.frxBarcode2DView.pas
@@ -0,0 +1,360 @@
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ 2D Barcode Add-in object }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+
+unit FMX.frxBarcode2DView;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, System.UIConsts,
+ System.Types, FMX.Controls, FMX.Types, FMX.Objects, FMX.Forms, FMX.Dialogs,
+ FMX.Menus, FMX.frxClass, FMX.frxdesgn, FMX.frxBarcodePDF417, FMX.frxBarcodeQR,
+ FMX.frxBarcodeDataMatrix, FMX.frxBarcode2DBase, FMX.frxBarcodeProperties,
+ System.Variants
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+type
+
+ TfrxBarcodeType =
+ (
+ bc_datamatrix,
+ bc_PDF417,
+ bcCodeQR
+ );
+
+{$I frxFMX_PlatformsAttribute.inc}
+ Tfrx2DBarCodeObject = class(TComponent); // fake component
+
+ TfrxBarcode2DView = class(TfrxView)
+ private
+ FBarCode: TfrxBarcode2DBase;
+ FBarType: TfrxBarcodeType;
+ FHAlign: TfrxHAlign;
+ FProp : TUniqueProp;
+ FExpression: String;
+ procedure SetZoom(z: Double);
+ function GetZoom : Double;
+ procedure SetRotation(Value : Integer);
+ function GetRotation: Integer;
+ procedure SetShowText(Value: Boolean);
+ function GetShowText: Boolean;
+ procedure SetText(Value: String);
+ function GetText: String;
+ procedure SetFontScaled(Value: Boolean);
+ function GetFontScaled: Boolean;
+ procedure SetErrorText(Value: String);
+ function GetErrorText: String;
+ procedure SetQuiteZone(Value: Integer);
+ function GetQuiteZone: Integer;
+ procedure SetProp (Value: TUniqueProp);
+ procedure SetBarType(Value: TfrxBarcodeType);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY : Extended); override;
+ class function GetDescription: String; override;
+ procedure GetData; override;
+ property BarCode: TfrxBarcode2DBase read FBarCode write FBarcode;
+ published
+ property Expression: String read FExpression write FExpression;
+ property BarType: TfrxBarcodeType read FBarType write SetBarType;
+ property BarProperties : TUniqueProp read FProp write SetProp;
+ property BrushStyle;
+ property Color;
+ property Cursor;
+ property DataField;
+ property DataSet;
+ property DataSetName;
+ property Frame;
+ property HAlign: TfrxHAlign read FHAlign write FHAlign default haLeft;
+ property Rotation: Integer read GetRotation write SetRotation;
+ property ShowText: Boolean read GetShowText write SetShowText;
+ property TagStr;
+ property Text: String read GetText write SetText;
+ property URL;
+ property Zoom: Double read GetZoom write SetZoom;
+ property Font;
+ property FontScaled: Boolean read GetFontScaled write SetFontScaled;
+ property ErrorText: String read GetErrorText write SetErrorText;
+ property QuiteZone: Integer read GetQuiteZone write SetQuiteZone;
+ end;
+
+implementation
+
+uses
+{$IFNDEF NO_EDITORS}
+// frxBarcodeEditor,
+{$ENDIF}
+ FMX.frxBarcode2DRTTI, FMX.frxDsgnIntf, FMX.frxRes, FMX.frxUtils;
+
+{ TfrxBarcode2DView }
+
+constructor TfrxBarcode2DView.Create(AOwner: TComponent);
+begin
+ inherited;
+ FBarCode := TfrxBarcodePDF417.Create;
+ FBarType := bc_PDF417;
+ Font.AssignToFont(FBarCode.Font);
+ Width := 0;
+ Height := 0;
+ FProp := TPDF417UniqueProperties.Create;
+ FProp.SetWhose(FBarcode);
+end;
+
+destructor TfrxBarcode2DView.Destroy;
+begin
+ FBarCode.Free;
+ FProp.free;
+ inherited Destroy;
+end;
+
+procedure TfrxBarcode2DView.SetProp (Value: TUniqueProp);
+begin
+ FProp.Assign(Value);
+end;
+
+procedure TfrxBarcode2DView.SetBarType(Value: TfrxBarcodeType);
+var
+ tmp: TfrxBarcode2DBase;
+ aReport: TfrxReport;
+begin
+ if FBarType = Value then exit;
+ tmp := TfrxBarcode2DBase.Create;
+ tmp.Assign(FBarcode);
+ try
+ if Value = bc_PDF417 then
+ begin
+ FBarType := Value;
+ FBarCode.Free;
+ FBarCode := TfrxBarcodePDF417.Create;
+ FBarcode.Assign(tmp);
+ FBarcode.PixelWidth := FBarcode.PixelHeight div 4;
+ if FBarcode.PixelWidth < 1 then FBarcode.PixelWidth := 1;
+ FProp.Free;
+ FProp := TPDF417UniqueProperties.create;
+ FProp.SetWhose(FBarCode);
+ end
+ else if Value = bc_datamatrix then
+ begin
+ FBarType := Value;
+ FBarCode.Free;
+ FBarCode := TfrxBarcodeDataMatrix.Create;
+ FBarCode.Assign(tmp);
+ FBarCode.PixelWidth := FBarCode.PixelHeight;
+ FProp.Free;
+ FProp := TDataMatrixUniqueProperties.Create;
+ FProp.SetWhose(FBarCode);
+ end
+ else if Value = bcCodeQR then
+ begin
+ FBarType := Value;
+ FBarCode.Free;
+ FBarCode := TfrxBarcodeQR.Create;
+ FProp.Free;
+ FProp := TfrxQRProperties.Create;
+ FProp.SetWhose(FBarCode);
+ end;
+ aReport := Self.Report;
+ if (aReport <> nil) and (aReport.Designer <> nil) then
+ aReport.Designer.UpdateInspector;
+ finally
+ tmp.Free;
+ end;
+end;
+
+procedure TfrxBarcode2DView.SetZoom(z: Double);
+begin
+ FBarcode.Zoom := z;
+end;
+
+function TfrxBarcode2DView.GetZoom: Double;
+begin
+ Result := FBarcode.Zoom;
+end;
+
+procedure TfrxBarcode2DView.SetRotation(Value: Integer);
+begin
+ FBarcode.Rotation := Value;
+end;
+
+function TfrxBarcode2DView.GetRotation: Integer;
+begin
+ Result := FBarcode.Rotation;
+end;
+
+procedure TfrxBarcode2DView.SetShowText(Value : Boolean);
+begin
+ FBarcode.ShowText := Value;
+end;
+
+function TfrxBarcode2DView.GetShowText : Boolean;
+begin
+ Result := FBarcode.ShowText;
+end;
+
+procedure TfrxBarcode2DView.SetText(Value: String);
+begin
+ FBarcode.Text := Value;
+end;
+
+function TfrxBarcode2DView.GetText: String;
+begin
+ Result := FBarcode.Text;
+end;
+
+procedure TfrxBarcode2DView.SetFontScaled(Value: Boolean);
+begin
+ FBarcode.FontScaled := Value;
+end;
+
+function TfrxBarcode2DView.GetFontScaled: Boolean;
+begin
+ Result := FBarcode.FontScaled;
+end;
+
+procedure TfrxBarcode2DView.SetErrorText(Value: String);
+begin
+ FBarcode.ErrorText := Value;
+end;
+
+function TfrxBarcode2DView.GetErrorText: String;
+begin
+ Result := FBarcode.ErrorText;
+end;
+
+procedure TfrxBarcode2DView.SetQuiteZone(Value : Integer);
+begin
+ FBarcode.QuiteZone := Value;
+end;
+
+function TfrxBarcode2DView.GetQuiteZone: Integer;
+begin
+ Result := FBarcode.QuiteZone;
+end;
+
+procedure TfrxBarcode2DView.GetData;
+begin
+ inherited;
+ if IsDataField then
+ FBarcode.Text := VarToStr(DataSet.Value[DataField])
+ else if FExpression <> '' then
+ FBarcode.Text := VarToStr(Report.Calc(FExpression));
+end;
+
+class function TfrxBarcode2DView.GetDescription: String;
+begin
+ Result := frxResources.Get('2D Barcode');
+end;
+
+procedure TfrxBarcode2DView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
+var
+ w, h, tmp: Extended;
+ scaledFontCorrX, scaledFontCorrY: Integer;
+ DrawRectA: TRectF;
+begin
+ case Round(Rotation) of
+ 0 .. 44: Rotation := 0;
+ 45 .. 135: Rotation := 90;
+ 136 .. 224: Rotation := 180;
+ 225 .. 315: Rotation := 270;
+ else
+ Rotation := 0;
+ end;
+
+ Font.AssignToFont(FBarCode.Font);
+ FBarCode.FontColor := Font.Color;
+
+ if Color = claNull then
+ FBarCode.Color := claWhite
+ else
+ FBarCode.Color := Color;
+
+ w := FBarCode.Width;
+ h := FBarCode.Height;
+
+
+
+ if FontScaled or (not ShowText) then
+ begin
+ scaledFontCorrX := 0;
+ scaledFontCorrY := 0;
+ end
+ else
+ begin
+ scaledFontCorrY := FBarCode.GetFooterHeight;
+ scaledFontCorrX := 0;
+ if (Rotation = 90) or (Rotation = 270) then
+ begin
+ scaledFontCorrX := FBarCode.GetFooterHeight;
+ scaledFontCorrY := 0;
+ end;
+ end;
+
+ if (Rotation = 90) or (Rotation = 270) then
+ begin
+ tmp := w;
+ w := h;
+ h := tmp;
+ end;
+
+ Height := (h - scaledFontCorrY) * Zoom + scaledFontCorrY;
+ Width := (w - scaledFontCorrX) * Zoom + scaledFontCorrX;
+ if Frame.DropShadow then
+ begin
+ Height := Height + round(Frame.ShadowWidth);
+ Width := Width + round(Frame.ShadowWidth);
+ end;
+
+ BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+
+ if FBarcode.ErrorText <> '' then
+ begin
+ with Canvas do
+ begin
+ Font.Family := 'Arial';
+ Font.Size := Round(8 * ScaleY);
+ Fill.Color := claRed;
+ Stroke.Color := claBlack;
+ DrawRectA := RectF(FX + 2, FY + 2, FX1, FY1);
+ FillText(DrawRectA, ErrorText, True, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ Exit;
+ end;
+ end;
+
+ DrawBackground;
+ FBarCode.Draw2DBarcode(Canvas, FScaleX, FScaleY, FX, FY, IsPrinting);
+ DrawFrame;
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxBarcode2DView, TFmxObject);
+ GroupDescendentsWith(Tfrx2DBarCodeObject, TFmxObject);
+ frxObjects.RegisterObject1(TfrxBarcode2DView, nil, '', '', 0, 123);
+
+finalization
+ frxObjects.Unregister(TfrxBarcode2DView);
+
+
+end.
diff --git a/LibD28/FMX.frxBarcodeDataMatrix.pas b/LibD28/FMX.frxBarcodeDataMatrix.pas
new file mode 100644
index 0000000..5fa176b
--- /dev/null
+++ b/LibD28/FMX.frxBarcodeDataMatrix.pas
@@ -0,0 +1,1308 @@
+//
+//
+//
+// Copyright 2007 by Paulo Soares.
+//
+// The contents of this file are subject to the Mozilla Public License Version 1.1
+// (the "License"); you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at http://www.mozilla.org/MPL/
+//
+// Software distributed under the License is distributed on an "AS IS" basis,
+// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+// for the specific language governing rights and limitations under the License.
+//
+// The Original Code is 'iText, a free JAVA-PDF library'.
+//
+// The Initial Developer of the Original Code is Bruno Lowagie. Portions created by
+// the Initial Developer are Copyright (C) 1999, 2000, 2001, 2002 by Bruno Lowagie.
+// All Rights Reserved.
+// Co-Developer of the code is Paulo Soares. Portions created by the Co-Developer
+// are Copyright (C) 2000, 2001, 2002 by Paulo Soares. All Rights Reserved.
+// Modifications: Alexander Tzyganenko
+//
+//
+//
+//
+//
+// TODO:
+// -
+// - frxBarcodeBase, ????????
+//
+//
+
+
+unit FMX.frxBarcodeDataMatrix;
+
+
+interface
+
+{$I frx.inc}
+
+uses System.SysUtils, System.Types, System.UITypes, System.StrUtils,
+ System.Classes, FMX.Objects, FMX.Types, FMX.Controls, FMX.Forms,
+ FMX.Dialogs, FMX.frxBarcode2DBase
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+type
+
+
+// Specifies the Datamatrix encoding. ///////////////////////////////////////////////////////////////////////
+
+DatamatrixEncoding =
+(
+ Auto,
+ Ascii,
+ C40,
+ Txt,
+ Base256,
+ X12,
+ Edifact
+);
+
+// Specifies the Datamatrix symbol size. /////////////////////////////////////////////////////////////////////
+
+DatamatrixSymbolSize =
+(
+ AutoSize,
+ Size10x10,
+ Size12x12,
+ Size8x18,
+ Size14x14,
+ Size8x32,
+ Size16x16,
+ Size12x26,
+ Size18x18,
+ Size20x20,
+ Size12x36,
+ Size22x22,
+ Size16x36,
+ Size24x24,
+ Size26x26,
+ Size16x48,
+ Size32x32,
+ Size36x36,
+ Size40x40,
+ Size44x44,
+ Size48x48,
+ Size52x52,
+ Size64x64,
+ Size72x72,
+ Size80x80,
+ Size88x88,
+ Size96x96,
+ Size104x104,
+ Size120x120,
+ Size132x132,
+ Size144x144
+);
+
+// ////////////////////////////////////////////////////////////////////////////////////////////////////
+//
+//
+// ////////////////////////////////////////////////////////////////////////////////////////////////////
+
+DmParams = record
+
+ height,
+ width,
+ heightSection,
+ widthSection,
+ dataSize,
+ dataBlock,
+ errorBlock : integer;
+
+end;
+
+const
+
+ dmSizes : array[Size10x10..Size144x144] of DmParams =
+ (
+ ( height: 10; width: 10; heightSection: 10; widthSection: 10; dataSize: 3; dataBlock: 3; errorBlock: 5 ),
+ ( height: 12; width: 12; heightSection: 12; widthSection: 12; dataSize: 5; dataBlock: 5; errorBlock: 7 ),
+ ( height: 8; width: 18; heightSection: 8; widthSection: 18; dataSize: 5; dataBlock: 5; errorBlock: 7 ),
+ ( height: 14; width: 14; heightSection: 14; widthSection: 14; dataSize: 8; dataBlock: 8; errorBlock:10 ),
+ ( height: 8; width: 32; heightSection: 8; widthSection: 16; dataSize:10; dataBlock:10; errorBlock:11 ),
+ ( height: 16; width: 16; heightSection: 16; widthSection: 16; dataSize:12; dataBlock:12; errorBlock:12 ),
+ ( height: 12; width: 26; heightSection: 12; widthSection: 26; dataSize:16; dataBlock:16; errorBlock:14 ),
+ ( height: 18; width: 18; heightSection: 18; widthSection: 18; dataSize:18; dataBlock:18; errorBlock:14 ),
+ ( height: 20; width: 20; heightSection: 20; widthSection: 20; dataSize:22; dataBlock:22; errorBlock:18 ),
+ ( height: 12; width: 36; heightSection: 12; widthSection: 18; dataSize:22; dataBlock:22; errorBlock:18 ),
+ ( height: 22; width: 22; heightSection: 22; widthSection: 22; dataSize:30; dataBlock:30; errorBlock:20 ),
+ ( height: 16; width: 36; heightSection: 16; widthSection: 18; dataSize:32; dataBlock:32; errorBlock:24 ),
+ ( height: 24; width: 24; heightSection: 24; widthSection: 24; dataSize:36; dataBlock:36; errorBlock:24 ),
+ ( height: 26; width: 26; heightSection: 26; widthSection: 26; dataSize:44; dataBlock:44; errorBlock:28 ),
+ ( height: 16; width: 48; heightSection: 16; widthSection: 24; dataSize:49; dataBlock:49; errorBlock:28 ),
+ ( height: 32; width: 32; heightSection: 16; widthSection: 16; dataSize:62; dataBlock:62; errorBlock:36 ),
+ ( height: 36; width: 36; heightSection: 18; widthSection: 18; dataSize:86; dataBlock:86; errorBlock:42 ),
+ ( height: 40; width: 40; heightSection: 20; widthSection: 20; dataSize:114; dataBlock:114; errorBlock: 48 ),
+ ( height: 44; width: 44; heightSection: 22; widthSection: 22; dataSize:144; dataBlock:144; errorBlock: 56 ),
+ ( height: 48; width: 48; heightSection: 24; widthSection: 24; dataSize:174; dataBlock:174; errorBlock: 68 ),
+ ( height: 52; width: 52; heightSection: 26; widthSection: 26; dataSize:204; dataBlock:102; errorBlock: 42 ),
+ ( height: 64; width: 64; heightSection: 16; widthSection: 16; dataSize:280; dataBlock:140; errorBlock: 56 ),
+ ( height: 72; width: 72; heightSection: 18; widthSection: 18; dataSize:368; dataBlock:92; errorBlock: 36 ),
+ ( height: 80; width: 80; heightSection: 20; widthSection: 20; dataSize:456; dataBlock:114; errorBlock: 48 ),
+ ( height: 88; width: 88; heightSection: 22; widthSection: 22; dataSize:576; dataBlock:144; errorBlock: 56 ),
+ ( height: 96; width: 96; heightSection: 24; widthSection: 24; dataSize:696; dataBlock:174; errorBlock: 68 ),
+ ( height:104; width:104; heightSection: 26; widthSection: 26; dataSize:816; dataBlock:136; errorBlock: 56 ),
+ ( height:120; width:120; heightSection: 20; widthSection: 20; dataSize:1050; dataBlock:175; errorBlock: 68 ),
+ ( height:132; width:132; heightSection: 22; widthSection: 22; dataSize:1304; dataBlock:163; errorBlock: 62 ),
+ ( height:144; width:144; heightSection: 24; widthSection: 24; dataSize:1558; dataBlock:156; errorBlock: 62 )
+);
+
+ log : array[0..255] of integer =
+ ( 0, 255, 1, 240, 2, 225, 241, 53, 3, 38, 226, 133, 242, 43, 54, 210,
+ 4, 195, 39, 114, 227, 106, 134, 28, 243, 140, 44, 23, 55, 118, 211, 234,
+ 5, 219, 196, 96, 40, 222, 115, 103, 228, 78, 107, 125, 135, 8, 29, 162,
+ 244, 186, 141, 180, 45, 99, 24, 49, 56, 13, 119, 153, 212, 199, 235, 91,
+ 6, 76, 220, 217, 197, 11, 97, 184, 41, 36, 223, 253, 116, 138, 104, 193,
+ 229, 86, 79, 171, 108, 165, 126, 145, 136, 34, 9, 74, 30, 32, 163, 84,
+ 245, 173, 187, 204, 142, 81, 181, 190, 46, 88, 100, 159, 25, 231, 50, 207,
+ 57, 147, 14, 67, 120, 128, 154, 248, 213, 167, 200, 63, 236, 110, 92, 176,
+ 7, 161, 77, 124, 221, 102, 218, 95, 198, 90, 12, 152, 98, 48, 185, 179,
+ 42, 209, 37, 132, 224, 52, 254, 239, 117, 233, 139, 22, 105, 27, 194, 113,
+ 230, 206, 87, 158, 80, 189, 172, 203, 109, 175, 166, 62, 127, 247, 146, 66,
+ 137, 192, 35, 252, 10, 183, 75, 216, 31, 83, 33, 73, 164, 144, 85, 170,
+ 246, 65, 174, 61, 188, 202, 205, 157, 143, 169, 82, 72, 182, 215, 191, 251,
+ 47, 178, 89, 151, 101, 94, 160, 123, 26, 112, 232, 21, 51, 238, 208, 131,
+ 58, 69, 148, 18, 15, 16, 68, 17, 121, 149, 129, 19, 155, 59, 249, 70,
+ 214, 250, 168, 71, 201, 156, 64, 60, 237, 130, 111, 20, 93, 122, 177, 150 );
+
+ alog : array[0..255] of integer =
+ ( 1, 2, 4, 8, 16, 32, 64, 128, 45, 90, 180, 69, 138, 57, 114, 228,
+ 229, 231, 227, 235, 251, 219, 155, 27, 54, 108, 216, 157, 23, 46, 92, 184,
+ 93, 186, 89, 178, 73, 146, 9, 18, 36, 72, 144, 13, 26, 52, 104, 208,
+ 141, 55, 110, 220, 149, 7, 14, 28, 56, 112, 224, 237, 247, 195, 171, 123,
+ 246, 193, 175, 115, 230, 225, 239, 243, 203, 187, 91, 182, 65, 130, 41, 82,
+ 164, 101, 202, 185, 95, 190, 81, 162, 105, 210, 137, 63, 126, 252, 213, 135,
+ 35, 70, 140, 53, 106, 212, 133, 39, 78, 156, 21, 42, 84, 168, 125, 250,
+ 217, 159, 19, 38, 76, 152, 29, 58, 116, 232, 253, 215, 131, 43, 86, 172,
+ 117, 234, 249, 223, 147, 11, 22, 44, 88, 176, 77, 154, 25, 50, 100, 200,
+ 189, 87, 174, 113, 226, 233, 255, 211, 139, 59, 118, 236, 245, 199, 163, 107,
+ 214, 129, 47, 94, 188, 85, 170, 121, 242, 201, 191, 83, 166, 97, 194, 169,
+ 127, 254, 209, 143, 51, 102, 204, 181, 71, 142, 49, 98, 196, 165, 103, 206,
+ 177, 79, 158, 17, 34, 68, 136, 61, 122, 244, 197, 167, 99, 198, 161, 111,
+ 222, 145, 15, 30, 60, 120, 240, 205, 183, 67, 134, 33, 66, 132, 37, 74,
+ 148, 5, 10, 20, 40, 80, 160, 109, 218, 153, 31, 62, 124, 248, 221, 151,
+ 3, 6, 12, 24, 48, 96, 192, 173, 119, 238, 241, 207, 179, 75, 150, 1 );
+ poly5 : array[0..4] of integer = ( 228, 48, 15, 111, 62 );
+ poly7 : array[0..6] of integer = ( 23, 68, 144, 134, 240, 92, 254 );
+ poly10 : array[0..9] of integer = ( 28, 24, 185, 166, 223, 248, 116, 255, 110, 61 );
+ poly11 : array[0..10] of integer = ( 175, 138, 205, 12, 194, 168, 39, 245, 60, 97, 120 );
+ poly12 : array[0..11] of integer = ( 41, 153, 158, 91, 61, 42, 142, 213, 97, 178, 100, 242 );
+ poly14 : array[0..13] of integer = ( 156, 97, 192, 252, 95, 9, 157, 119, 138, 45, 18, 186, 83, 185 );
+ poly18 : array[0..17] of integer = ( 83, 195, 100, 39, 188, 75, 66, 61, 241, 213, 109, 129, 94, 254, 225, 48, 90, 188 );
+ poly20 : array[0..19] of integer = ( 15, 195, 244, 9, 233, 71, 168, 2, 188, 160, 153, 145, 253, 79,
+ 108, 82, 27, 174, 186, 172 );
+ poly24 : array[0..23] of integer = ( 52, 190, 88, 205, 109, 39, 176, 21, 155, 197, 251, 223, 155, 21, 5, 172,
+ 254, 124, 12, 181, 184, 96, 50, 193 );
+ poly28 : array[0..27] of integer = ( 211, 231, 43, 97, 71, 96, 103, 174, 37, 151, 170, 53, 75, 34, 249, 121,
+ 17, 138, 110, 213, 141, 136, 120, 151, 233, 168, 93, 255 );
+ poly36 : array[0..35] of integer = ( 245, 127, 242, 218, 130, 250, 162, 181, 102, 120, 84, 179, 220, 251, 80, 182,
+ 229, 18, 2, 4, 68, 33, 101, 137, 95, 119, 115, 44, 175, 184, 59, 25,
+ 225, 98, 81, 112 );
+ poly42 : array[0..41] of integer = ( 77, 193, 137, 31, 19, 38, 22, 153, 247, 105, 122, 2, 245, 133, 242, 8,
+ 175, 95, 100, 9, 167, 105, 214, 111, 57, 121, 21, 1, 253, 57, 54, 101,
+ 248, 202, 69, 50, 150, 177, 226, 5, 9, 5 );
+ poly48 : array[0..47] of integer = ( 245, 132, 172, 223, 96, 32, 117, 22, 238, 133, 238, 231, 205, 188, 237, 87,
+ 191, 106, 16, 147, 118, 23, 37, 90, 170, 205, 131, 88, 120, 100, 66, 138,
+ 186, 240, 82, 44, 176, 87, 187, 147, 160, 175, 69, 213, 92, 253, 225, 19 );
+ poly56 : array[0..55] of integer = ( 175, 9, 223, 238, 12, 17, 220, 208, 100, 29, 175, 170, 230, 192, 215, 235,
+ 150, 159, 36, 223, 38, 200, 132, 54, 228, 146, 218, 234, 117, 203, 29, 232,
+ 144, 238, 22, 150, 201, 117, 62, 207, 164, 13, 137, 245, 127, 67, 247, 28,
+ 155, 43, 203, 107, 233, 53, 143, 46 );
+ poly62 : array[0..61] of integer = ( 242, 93, 169, 50, 144, 210, 39, 118, 202, 188, 201, 189, 143, 108, 196, 37,
+ 185, 112, 134, 230, 245, 63, 197, 190, 250, 106, 185, 221, 175, 64, 114, 71,
+ 161, 44, 147, 6, 27, 218, 51, 63, 87, 10, 40, 130, 188, 17, 163, 31,
+ 176, 170, 4, 107, 232, 7, 94, 166, 224, 124, 86, 47, 11, 204 );
+ poly68 : array[0..67] of integer = ( 220, 228, 173, 89, 251, 149, 159, 56, 89, 33, 147, 244, 154, 36, 73, 127,
+ 213, 136, 248, 180, 234, 197, 158, 177, 68, 122, 93, 213, 15, 160, 227, 236,
+ 66, 139, 153, 185, 202, 167, 179, 25, 220, 232, 96, 210, 231, 136, 223, 239,
+ 181, 241, 59, 52, 172, 25, 49, 232, 211, 189, 64, 54, 108, 153, 132, 63,
+ 96, 103, 82, 186 );
+
+ _x12 = #13 + '*> 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
+ cbDefaultText = '12345678';
+
+type
+
+ SizeF = record
+ height : Double;
+ width : Double;
+ end;
+
+ TInts = array of integer;
+
+// /////////////////////////////////////////////////////////////////////////
+// Generates the 2D Data Matrix barcode. /////////////////////////////////////////////////////////////////////////
+// /////////////////////////////////////////////////////////////////////////
+
+{$M+}
+TfrxBarcodeDataMatrix = class( TfrxBarcode2DBase )
+
+ private
+
+ FPlace : TInts;
+ FSymbolSize : DatamatrixSymbolSize;
+ FEncoding : DatamatrixEncoding;
+ FCodePage : integer;
+
+ procedure SetBit(x, y, xByte : integer);
+ procedure Generate(var text : string); overload;
+ procedure Generate( var text :TBytes; textOffset, textSize : integer); overload;
+ function GetEncodation(var Text : tbytes; textOffset, textSize : integer; var data : Tbytes;
+ dataOffset, dataSize : integer; firstMatch : boolean) : integer;
+
+ procedure Draw(var data : TBytes; dataSize : integer; const dm: DmParams);
+ procedure SetCodePage( cp : integer );
+ procedure SetEncoding( v : DatamatrixEncoding);
+ procedure Ecc200;
+ procedure SetSymbolSize( s : DatamatrixSymbolSize);
+ function GetPixelSize : integer;
+ procedure SetPixelSize(v : integer);
+ protected
+ procedure SetText(v : string); override;
+
+public
+
+ constructor Create; override;
+ destructor Destroy; override;
+ procedure Assign(src: TfrxBarcode2DBase);override;
+// procedure Draw2DBarcode(var g : TCanvas; scalex, scaley : extended; x, y : integer ); override;
+
+published
+
+
+ property SymbolSize : DatamatrixSymbolSize read FSymbolSize write SetSymbolSize;
+ property Encoding : DatamatrixEncoding read FEncoding write SetEncoding;
+ property CodePage : integer read FCodePage write SetCodePage;
+ property PixelSize : integer read GetPixelSize write SetPixelSize;
+
+end;
+
+
+procedure GenerateECC(var wd : TBytes; nd, datablock, nc : integer );
+
+
+implementation
+
+var
+ nrow, ncol : integer;
+
+
+constructor TfrxBarcodeDataMatrix.Create;
+
+begin
+
+ inherited;
+ FSymbolSize := AutoSize;
+ FEncoding := Auto;
+ FCodePage := 1251;
+ FPixelWidth := 3;
+ FWidth := 0;
+ FPixelHeight := 3;
+ FHeight := 0;
+
+ Generate(FText);
+
+end;
+
+destructor TfrxBarcodeDataMatrix.Destroy;
+begin
+ inherited;
+end;
+
+
+//
+
+procedure TfrxBarcodeDataMatrix.SetCodepage(cp : integer);
+begin
+
+ FCodepage := cp;
+ Generate(FText);
+
+end;
+
+
+procedure TfrxBarcodeDataMatrix.SetEncoding( v : DatamatrixEncoding);
+begin
+
+ FEncoding := v;
+ Generate(FText);
+
+end;
+
+procedure TfrxBarcodeDataMatrix.SetSymbolSize( s : DatamatrixSymbolSize );
+begin
+ FSymbolSize := s;
+ Generate(FText);
+
+end;
+
+function TfrxBarcodeDataMatrix.GetPixelSize : integer; begin result := FPixelWidth; end;
+procedure TfrxBarcodeDataMatrix.SetPixelSize(v : integer); begin FPixelWidth := v; FPixelHeight := v; end;
+
+
+
+
+procedure TfrxBarcodeDataMatrix.Assign(src: TfrxBarcode2DBase);
+var
+ BSource : TfrxBarcodeDataMatrix;
+begin
+ inherited;
+ if src is TfrxBarcodeDataMatrix then
+ begin
+ BSource := TfrxBarcodeDataMatrix( src );
+ FHeight := BSource.FHeight;
+ FSymbolSize := BSource.SymbolSize;
+ FEncoding := BSource.Encoding;
+ FCodePage := BSource.CodePage;
+ end;
+end;
+
+procedure TfrxBarcodeDataMatrix.SetText( v : string);
+begin
+ if( FText <> v) then
+ begin
+ FText := v;
+ Generate( FText );
+ end;
+end;
+
+procedure TfrxBarcodeDataMatrix.SetBit( x, y, xByte : integer);
+begin
+ FImage[y * xByte + x div 8] := FImage[y * xByte + x div 8] or ( 128 shr (x and 7) );
+end;
+
+
+procedure TfrxBarcodeDataMatrix.Draw(var data : tbytes; dataSize : integer; const dm: DmParams);
+var
+ k,i, j, p, x, y, xs, ys, z, xByte : integer;
+begin
+
+ xByte := (dm.width + 7) div 8;
+
+ for k:=0 to Length(FImage)-1 do
+ FImage[k] := 0;
+
+ //alignment patterns
+ //dotted horizontal line
+ i := 0;
+ while i < dm.height do
+ begin
+ j := 0;
+ while j < dm.width do
+ begin
+ SetBit(j, i, xByte);
+ inc(j,2);
+ end;
+ inc(i, dm.heightSection);
+ end;
+
+ //solid horizontal line
+ i := dm.heightSection - 1;
+ while i < dm.height do
+ begin
+ for j := 0 to dm.width-1 do
+ SetBit(j, i, xByte);
+
+ inc(i,dm.heightSection);
+ end;
+
+ //solid vertical line
+ i := 0;
+ while i < dm.width do
+ begin
+ for j:=0 to dm.height-1 do
+ SetBit(i, j, xByte);
+ inc(i, dm.widthSection);
+ end;
+
+ //dotted vertical line
+ i := dm.widthSection - 1;
+ while i < dm.width do
+ begin
+ j := 1;
+ while j < dm.height do
+ begin
+ SetBit(i, j, xByte);
+ inc(j,2);
+ end;
+ inc(i, dm.widthSection);
+ end;
+
+ p := 0;
+ ys := 0;
+ while ys < dm.height do
+ begin
+ for y := 1 to dm.heightSection - 2 do
+ begin
+ xs := 0;
+ while xs < dm.width do
+ begin
+ for x:=1 to dm.widthSection - 2 do
+ begin
+ z := FPlace[p];
+ inc(p);
+ if ( (z = 1) or ( (z > 1) and (( data[(z div 8) - 1] and $ff ) and (128 shr (z mod 8)) <> 0) ) ) then
+ SetBit(x + xs, y + ys, xByte);
+ end;
+ inc(xs, dm.widthSection);
+ end;
+ end;
+ inc(ys, dm.heightSection);
+ end;
+
+end;
+
+
+
+
+procedure MakePadding(var data : tbytes; position, count : integer);
+var
+ t : integer;
+begin
+ //already in ascii mode
+ if count > 0 then
+ begin
+ data[position] := 129;
+ inc(position);
+ dec(count);
+ while count > 0 do
+ begin
+ t := 129 + (((position + 1) * 149) mod 253) + 1;
+ if t > 254 then dec(t,254);
+ data[position] := byte(t);
+ inc(position);
+ dec(count);
+ end
+ end
+end;
+
+function IsDigit( c : integer ) : boolean;
+begin
+ result := false;
+ if ansichar(c) in ['0'..'9'] then result := true;
+end;
+
+
+function AsciiEncodation( var text : tbytes; textOffset, textLength : integer; var data : tbytes; dataOffset, dataLength : integer ) : integer;
+var
+ ptrIn, ptrOut,c : integer;
+
+begin
+
+ ptrIn := textOffset;
+ ptrOut := dataOffset;
+ inc(textLength, textOffset);
+ inc(dataLength, dataOffset);
+
+ while (ptrIn < textLength) do
+ begin
+ if (ptrOut >= dataLength) then
+ begin
+ result := -1;
+ exit;
+ end;
+
+ c := text[ptrIn] and $ff;
+ inc(ptrIn);
+
+ if IsDigit(c) and (ptrIn < textLength) and IsDigit( text[ptrIn] and $ff ) then
+ begin
+ data[ptrOut] := byte( (( c - integer('0')) * 10 + ( text[ptrIn] and $ff ) - integer('0') + 130));
+ inc(ptrIn);
+ inc(ptrOut);
+ end
+ else
+ if c > 127 then
+ begin
+ if ( ptrOut + 1 ) >= dataLength then
+ begin
+ result := -1;
+ exit;
+ end;
+ data[ptrOut] := byte(235);
+ inc(ptrOut);
+ data[ptrOut] := byte(c - 128 + 1);
+ inc(ptrOut);
+ end
+ else
+ begin
+ data[ptrOut] := byte(c + 1);
+ inc(ptrOut);
+ end
+ end;
+
+ result := ptrOut - dataOffset;
+end;
+
+function B256Encodation(var text : tbytes; textOffset, textLength : integer; var data : tbytes; dataOffset, dataLength : integer ) : integer;
+var
+ k, j, prn, tv, c : integer;
+
+begin
+
+ if textLength = 0 then begin result := 0; exit; end;
+ if (textLength < 250) and (textLength + 2 > dataLength) then begin result := -1; exit; end;
+ if (textLength >= 250) and (textLength + 3 > dataLength) then begin result := -1; exit; end;
+
+ data[dataOffset] := byte(231);
+ if textLength < 250 then
+ begin
+ data[dataOffset + 1] := byte(textLength);
+ k := 2;
+ end
+ else
+ begin
+ data[dataOffset + 1] := byte((textLength div 250) + 249);
+ data[dataOffset + 2] := byte( textLength mod 250 );
+ k := 3;
+ end;
+
+ for j := 0 to textLength-1 do
+ data[k + dataOffset + j] := byte(text[textOffset + j]);
+
+ inc(k, textLength + dataOffset);
+
+ for j := dataOffset + 1 to k-1 do
+ begin
+ c := data[j] and $ff;
+ prn := ((149 * (j + 1)) mod 255) + 1;
+ tv := c + prn;
+ if (tv > 255) then dec(tv, 256);
+ data[j] := byte(tv);
+ end;
+ result := k - dataOffset;
+end;
+
+
+
+function X12Encodation(var text: tbytes; textOffset, textLength : integer; var data : tbytes; dataOffset, dataLength : integer ) : integer;
+var
+ ptrIn, ptrOut, count, k, n, ci, i : integer;
+ c : byte;
+ x : array of byte;
+begin
+
+ if (textLength = 0) then begin result := 0; exit; end;
+ ptrOut := 0;
+ SetLength( x, textLength);
+
+ count := 0;
+ for ptrIn := 0 to textLength - 1 do
+ begin
+ i := Pos( char(text[ptrIn + textOffset]), _x12) - 1;
+ if (i >= 0) then
+ begin
+ x[ptrIn] := byte(i);
+ inc(count);
+ end
+ else
+ begin
+ x[ptrIn] := byte(100);
+ if (count >= 6) then
+ dec(count, (count div 3) * 3 );
+ for k := 0 to count-1 do
+ x[ptrIn - k - 1] := byte(100);
+ count := 0;
+ end
+ end;
+
+ ptrIn := textLength - 1;
+
+ if (count >= 6) then dec(count, (count div 3) * 3);
+ for k := 0 to count-1 do
+ x[ptrIn - k - 1] := byte(100);
+
+ ptrIn := 0;
+ while ptrIn < textLength do
+ begin
+ c := x[ptrIn];
+ if (ptrOut >= dataLength) then break;
+ if (c < 40) then
+ begin
+ if (ptrIn = 0) or ( (ptrIn > 0 ) and ( x[ptrIn - 1] > 40 ) ) then
+ begin
+ data[dataOffset + ptrOut] := byte(238);
+ inc(ptrOut);
+ end;
+
+ if (ptrOut + 2 > dataLength) then
+ break;
+ n := 1600 * x[ptrIn] + 40 * x[ptrIn + 1] + x[ptrIn + 2] + 1;
+ data[dataOffset + ptrOut] := byte(n div 256);
+ inc(ptrOut);
+ data[dataOffset + ptrOut] := byte(n);
+ inc(ptrOut);
+ inc(ptrIn, 2);
+ end
+ else
+ begin
+ if (ptrIn > 0) and (x[ptrIn - 1] < 40) then
+ begin
+ data[dataOffset + ptrOut] := byte(254);
+ inc(ptrOut);
+ end;
+ ci := text[ptrIn + textOffset] and $ff;
+ if (ci > 127) then
+ begin
+ data[dataOffset + ptrOut] := byte(235);
+ inc(ptrOut);
+ dec(ci, 128);
+ end;
+ if (ptrOut >= dataLength) then
+ break;
+ data[dataOffset + ptrOut] := byte(ci + 1);
+ inc(ptrOut);
+ end;
+ inc(ptrIn);
+ end;
+ c := 100;
+ if (textLength > 0) then
+ c := x[textLength - 1];
+ if (ptrIn <> textLength) or ( (c < 40 ) and (ptrOut >= dataLength)) then
+ begin
+ result := -1;
+ exit;
+ end;
+ if (c < 40) then
+ begin
+ data[dataOffset + ptrOut] := byte(254);
+ inc(ptrOut);
+ end;
+
+ result := ptrOut;
+
+end;
+
+
+function EdifactEncodation(var text: tbytes; textOffset, textLength: integer; var data: tbytes; dataOffset, dataLength: integer): integer;
+var
+ ptrIn, ptrOut, edi, pedi, c : integer;
+ Ascii : boolean;
+begin
+
+ if (textLength = 0) then begin result := 0; exit; end;
+ ptrOut := 0;
+ edi := 0;
+ pedi := 18;
+ Ascii := true;
+
+ for ptrIn := 0 to textLength-1 do
+ begin
+ c := text[ptrIn + textOffset] and $ff;
+ if ( ( (c and $e0) = $40 ) or ( (c and $e0) = $20) )
+ and
+ (char(c) <> '_' ) then
+ begin
+ if (Ascii) then
+ begin
+ if (ptrOut + 1 > dataLength) then break;
+ data[dataOffset + ptrOut] := byte(240);
+ inc(ptrOut);
+ Ascii := false;
+ end;
+ c := c and $3f;
+ edi := edi or (c shl pedi);
+ if (pedi = 0) then
+ begin
+ if (ptrOut + 3 > dataLength) then break;
+ data[dataOffset + ptrOut] := byte(edi shr 16); inc(ptrOut);
+ data[dataOffset + ptrOut] := byte(edi shr 8); inc(ptrOut);
+ data[dataOffset + ptrOut] := byte(edi); inc(ptrOut);
+ edi := 0;
+ pedi := 18;
+ end
+ else
+ dec(pedi,6);
+ end
+ else
+ begin
+ if (not Ascii) then
+ begin
+ edi := edi or ( (integer('_') and $3f) shl pedi);
+ if (ptrOut + (3 - ( pedi div 8 )) > dataLength) then break;
+ data[dataOffset + ptrOut] := byte(edi shr 16); inc(ptrOut);
+ if (pedi <= 12) then
+ begin
+ data[dataOffset + ptrOut] := byte(edi shr 8); inc(ptrOut);
+ end;
+ if (pedi <= 6) then
+ begin
+ data[dataOffset + ptrOut] := byte(edi); inc(ptrOut);
+ end;
+ Ascii := true;
+ pedi := 18;
+ edi := 0;
+ end;
+ if (c > 127) then
+ begin
+ if (ptrOut >= dataLength) then break;
+ data[dataOffset + ptrOut] := byte(235);
+ inc(ptrOut);
+ dec(c, 128);
+ end;
+ if (ptrOut >= dataLength) then break;
+ data[dataOffset + ptrOut] := byte(c + 1);
+ inc(ptrOut);
+ end;
+
+ end; // for
+
+ if ( ptrIn <> textLength) then begin result := -1; exit; end;
+ if (not Ascii) then
+ begin
+ edi := edi or ( (integer('_') and $3f) shl pedi );
+ if (ptrOut + (3 - (pedi div 8)) > dataLength) then begin result:= - 1; exit; end;
+ data[dataOffset + ptrOut] := byte(edi shr 16);
+ inc(ptrOut);
+ if ( pedi <= 12) then
+ begin
+ data[dataOffset + ptrOut] := byte(edi shr 8);
+ inc(ptrOut);
+ end;
+ if ( pedi <= 6 ) then
+ begin
+ data[dataOffset + ptrOut] := byte(edi);
+ inc(ptrOut);
+ end;
+ end;
+
+ result := ptrOut;
+
+end;
+
+function C40OrTextEncodation(var Text : tbytes; textOffset, textLength : integer; var data : tbytes; dataOffset, dataLength : integer;
+ C40 : boolean ) : integer;
+var
+
+ ptrIn, ptrOut, encPtr, last0, last1, i, a, c, idx : integer;
+ basic, shift2, shift3 : string;
+ enc : array of integer;
+
+begin
+
+ if (textLength = 0) then begin result := 0; exit; end;
+ ptrIn := 0;
+ ptrOut := 0;
+ if (C40) then
+ begin
+ data[dataOffset + ptrOut] := byte(230);
+ inc(ptrOut);
+ end
+ else
+ begin
+ data[dataOffset + ptrOut] := byte(239);
+ inc(ptrOut);
+ end;
+
+ shift2 := '!\"#$%&'+#39+'()*+,-./:;<=>?@[\\]^_';
+ if (C40) then
+ begin
+ basic := ' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
+ shift3 := '`abcdefghijklmnopqrstuvwxyz{|}~' + #127;
+ end
+ else
+ begin
+ basic := ' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
+ shift3 := '`abcdefghijklmnopqrstuvwxyz{|}~' + #127;
+ end;
+
+ SetLength( enc, textLength * 4 + 10);
+ encPtr := 0;
+ last0 := 0;
+ last1 := 0;
+
+ while (ptrIn < textLength) do
+ begin
+ if ((encPtr mod 3) = 0) then
+ begin
+ last0 := ptrIn;
+ last1 := encPtr;
+ end;
+ c := text[textOffset + ptrIn] and $ff;
+ inc(ptrIn);
+ if (c > 127) then
+ begin
+ dec(c, 128);
+ enc[encPtr] := 1; inc(encPtr);
+ enc[encPtr] := 30; inc(encPtr);
+ end;
+
+ idx := Pos( char(c), basic) - 1;
+ if (idx >= 0) then
+ begin
+ enc[encPtr] := idx + 3;
+ inc(encPtr);
+ end
+ else
+ if (c < 32) then
+ begin
+ enc[encPtr] := 0; inc(encPtr);
+ enc[encPtr] := c; inc(encPtr);
+ end
+ else
+ begin
+ idx := Pos( char(c), shift2) - 1;
+ if ( idx >= 0 ) then
+ begin
+ enc[encPtr] := 1; inc(encPtr);
+ enc[encPtr] := idx; inc(encPtr);
+ end
+ else
+ begin
+ idx := Pos( char(c), shift3) - 1;
+ if ( idx >= 0) then
+ begin
+ enc[encPtr] := 2; inc(encPtr);
+ enc[encPtr] := idx; inc(encPtr);
+ end
+ end;
+ end;
+ end;
+
+ if ((encPtr mod 3) <> 0) then
+ begin
+ ptrIn := last0;
+ encPtr := last1;
+ end;
+
+ if ( (encPtr div 3) * 2 > dataLength - 2) then
+ begin
+ result := - 1;
+ exit;
+ end;
+
+ i := 0;
+ while i < encPtr do
+ begin
+ a := 1600 * enc[i] + 40 * enc[i + 1] + enc[i + 2] + 1;
+ data[dataOffset + ptrOut] := byte(a div 256); inc(ptrOut);
+ data[dataOffset + ptrOut] := byte(a); inc(ptrOut);
+ inc(i, 3);
+ end;
+
+ data[ptrOut] := byte(254);
+ inc(ptrOut);
+ i := AsciiEncodation(Text, ptrIn, textLength - ptrIn, data, ptrOut, dataLength - ptrOut);
+ if (i < 0) then
+ result := i
+ else
+ result := ptrOut + i;
+end;
+
+function TfrxBarcodeDataMatrix.GetEncodation(var Text : tbytes; textOffset, textSize : integer; var data : tbytes;
+ dataOffset, dataSize : integer; firstMatch : boolean) : integer;
+var
+ e, j, k : integer;
+ e1 : array[0..5] of integer;
+
+begin
+
+ if (dataSize < 0) then
+ begin
+ result := -1;
+ exit;
+ end;
+
+ if ( FEncoding = Auto) then
+ begin
+ e1[0] := AsciiEncodation(text, textOffset, textSize, data, dataOffset, dataSize);
+ if firstMatch and ( e1[0] >= 0 ) then begin result := e1[0]; exit; end;
+ e1[1] := C40OrTextEncodation(text, textOffset, textSize, data, dataOffset, dataSize, false);
+ if firstMatch and ( e1[1] >= 0 ) then begin result := e1[1]; exit; end;
+ e1[2] := C40OrTextEncodation(text, textOffset, textSize, data, dataOffset, dataSize, true);
+ if firstMatch and ( e1[2] >= 0 ) then begin result := e1[2]; exit; end;
+ e1[3] := B256Encodation(text, textOffset, textSize, data, dataOffset, dataSize);
+ if firstMatch and ( e1[3] >= 0 ) then begin result := e1[3]; exit; end;
+ e1[4] := X12Encodation(text, textOffset, textSize, data, dataOffset, dataSize);
+ if firstMatch and ( e1[4] >= 0 ) then begin result := e1[4]; exit; end;
+ e1[5] := EdifactEncodation(text, textOffset, textSize, data, dataOffset, dataSize);
+ if firstMatch and ( e1[5] >= 0 ) then begin result := e1[5]; exit; end;
+ if (e1[0] < 0) and (e1[1] < 0) and (e1[2] < 0) and (e1[3] < 0) and (e1[4] < 0) and (e1[5] < 0) then
+ begin
+ result := -1;
+ exit;
+ end;
+
+ j := 0;
+ e := 99999;
+ for k := 0 to 5 do
+ if (e1[k] >= 0 ) and (e1[k] < e) then
+ begin
+ e := e1[k];
+ j := k;
+ end;
+
+ if (j = 0) then
+ e := AsciiEncodation(text, textOffset, textSize, data, dataOffset, dataSize)
+ else
+ if (j = 1) then
+ e := C40OrTextEncodation(text, textOffset, textSize, data, dataOffset, dataSize, false)
+ else
+ if (j = 2) then
+ e := C40OrTextEncodation(text, textOffset, textSize, data, dataOffset, dataSize, true)
+ else
+ if (j = 3) then
+ e := B256Encodation(text, textOffset, textSize, data, dataOffset, dataSize)
+ else
+ if (j = 4) then
+ e := X12Encodation(text, textOffset, textSize, data, dataOffset, dataSize);
+ result := e;
+ exit;
+ end;
+
+ case (FEncoding) of
+
+ Ascii: begin result := AsciiEncodation(text, textOffset, textSize, data, dataOffset, dataSize); exit; end;
+ C40: begin result := C40OrTextEncodation(text, textOffset, textSize, data, dataOffset, dataSize, true); exit; end;
+ Txt: begin result := C40OrTextEncodation(text, textOffset, textSize, data, dataOffset, dataSize, false); exit; end;
+ Base256: begin result := B256Encodation(text, textOffset, textSize, data, dataOffset, dataSize); exit; end;
+ X12: begin result := X12Encodation(text, textOffset, textSize, data, dataOffset, dataSize); exit; end;
+ Edifact: begin result := EdifactEncodation(text, textOffset, textSize, data, dataOffset, dataSize); exit; end;
+
+ end;
+ result := -1;
+
+end;
+
+function ReplaceControlCodes(var text: string) : string;
+begin
+ if Pos('&1;', text) = 1 then
+ begin
+ Delete(text,1,3);
+ text := #232 + text;
+ end;
+ result := ReplaceStr(text, '&1;', string(#29));
+end;
+
+procedure TfrxBarcodeDataMatrix.Generate(var text : string);
+var
+ t :TBytes;
+ e : TEncoding;
+begin
+
+ text := ReplaceControlCodes(text);
+ e := TEncoding.GetEncoding(CodePage);
+ try
+ t := e.GetBytes(text);
+ finally
+ e.Free;
+ end;
+ Generate(t, 0, Length(t));
+
+end;
+
+ procedure TfrxBarcodeDataMatrix.Generate(var text: TBytes; textOffset, textSize : integer);
+
+var
+ e, full, extCount : integer;
+ dm, last : DmParams;
+ data : TBytes;
+ k : DatamatrixSymbolSize;
+
+begin
+
+ ErrorText := '';
+ extCount := 0;
+ SetLength(data, 2500);
+ if ( Length(text) > 0) and ( text[0] = byte(232)) then
+ begin
+ data[0] := byte(232);
+ inc(textOffset);
+ dec(textSize);
+ extCount := 1;
+ end;
+
+ // ,
+ last := dmSizes[ High(dmSizes) ];
+ e := GetEncodation(text, textOffset, textSize, data, extCount, last.dataSize, false); // Auto,
+ // -1,
+
+try
+
+ if (e < 0) then
+ begin
+ raise Exception.Create('The text is too big.');
+ end;
+
+ inc(e, extCount); //
+
+ // ,
+ // E,
+
+ if FSymbolSize = AutoSize then
+ begin
+
+ for k := Size10x10 to High(dmSizes) do
+ if dmSizes[k].datasize >= e then
+ break;
+
+ dm := dmSizes[k];
+ FHeight := dm.height;
+ FWidth := dm.width;
+
+ end
+ else
+ begin
+
+ dm := dmSizes[FSymbolSize];
+ e := GetEncodation(text, textOffset, textSize, data, extCount, dm.dataSize, false);
+
+ if (e < 0) then
+ begin
+ raise Exception.Create(' The text is too big.');
+ end;
+
+ FHeight := dm.height;
+ FWidth := dm.width;
+ inc(e, extCount);
+
+ end;
+
+ SetLength(FImage, ((dm.width + 7) div 8) * dm.height );
+ MakePadding(data, e, dm.dataSize - e);
+ nrow := dm.height - ( (dm.height div dm.heightSection) * 2);
+ ncol := dm.width - ( ( dm.width div dm.widthSection ) * 2);
+ SetLength(FPlace, nrow * ncol);
+ Ecc200;
+
+ full := dm.dataSize + ((dm.dataSize + 2) div dm.dataBlock) * dm.errorBlock;
+ GenerateECC(data, dm.dataSize, dm.dataBlock, dm.errorBlock);
+ Draw(data, full, dm);
+
+ except
+ on e: Exception do
+ begin
+// FText := cbDefaultText;
+ ErrorText := e.Message;
+ end;
+ end;
+
+end;
+
+
+
+//* "ECC200" fills an nrow x ncol array with appropriate values for ECC200 */
+procedure TfrxBarcodeDataMatrix.Ecc200;
+
+//* "module" places "chr+bit" with appropriate wrapping within array[] */
+procedure Module( row, col, chr, bit : integer);
+begin
+ if (row < 0) then begin row := row + nrow; col := col + 4 - ((nrow + 4) mod 8); end;
+ if (col < 0) then begin col := col + ncol; row := row + 4 - ((ncol + 4) mod 8); end;
+ FPlace[row * ncol + col] := integer(8 * chr + bit);
+end;
+
+//* "utah" places the 8 bits of a utah-shaped symbol character in ECC200 */
+
+procedure Utah( row, col, chr : integer);
+begin
+ Module(row - 2, col - 2, chr, 0);
+ Module(row - 2, col - 1, chr, 1);
+ Module(row - 1, col - 2, chr, 2);
+ Module(row - 1, col - 1, chr, 3);
+ Module(row - 1, col, chr, 4);
+ Module(row, col - 2, chr, 5);
+ Module(row, col - 1, chr, 6);
+ Module(row, col, chr, 7);
+end;
+
+//* "cornerN" places 8 bits of the four special corner cases in ECC200 */
+procedure Corner1( chr : integer);
+begin
+ Module(nrow - 1, 0, chr, 0);
+ Module(nrow - 1, 1, chr, 1);
+ Module(nrow - 1, 2, chr, 2);
+ Module(0, ncol - 2, chr, 3);
+ Module(0, ncol - 1, chr, 4);
+ Module(1, ncol - 1, chr, 5);
+ Module(2, ncol - 1, chr, 6);
+ Module(3, ncol - 1, chr, 7);
+end;
+
+procedure Corner2( chr : integer);
+begin
+ Module(nrow - 3, 0, chr, 0);
+ Module(nrow - 2, 0, chr, 1);
+ Module(nrow - 1, 0, chr, 2);
+ Module(0, ncol - 4, chr, 3);
+ Module(0, ncol - 3, chr, 4);
+ Module(0, ncol - 2, chr, 5);
+ Module(0, ncol - 1, chr, 6);
+ Module(1, ncol - 1, chr, 7);
+end;
+
+procedure Corner3( chr : integer);
+begin
+ Module(nrow - 3, 0, chr, 0);
+ Module(nrow - 2, 0, chr, 1);
+ Module(nrow - 1, 0, chr, 2);
+ Module(0, ncol - 2, chr, 3);
+ Module(0, ncol - 1, chr, 4);
+ Module(1, ncol - 1, chr, 5);
+ Module(2, ncol - 1, chr, 6);
+ Module(3, ncol - 1, chr, 7);
+end;
+
+procedure Corner4( chr : integer);
+begin
+ Module(nrow - 1, 0, chr, 0);
+ Module(nrow - 1, ncol - 1, chr, 1);
+ Module(0, ncol - 3, chr, 2);
+ Module(0, ncol - 2, chr, 3);
+ Module(0, ncol - 1, chr, 4);
+ Module(1, ncol - 3, chr, 5);
+ Module(1, ncol - 2, chr, 6);
+ Module(1, ncol - 1, chr, 7);
+end;
+
+
+
+var
+
+ row, col, chr, k : integer;
+
+label l1,l2,l3;
+
+begin
+
+ //* First, fill the array[] with invalid entries */
+ for k := 0 to Length(FPlace) - 1 do
+ FPlace[k] := 0;
+ //* Starting in the correct location for character #1, bit 8,... */
+ chr := 1; row := 4; col := 0;
+l1://repeat
+ //* repeatedly first check for one of the special corner cases, then... */
+ if ((row = nrow) and (col = 0)) then begin Corner1(chr); inc(chr); end;
+ if ((row = nrow - 2) and (col = 0) and ( (ncol mod 4 ) <> 0)) then
+ begin Corner2(chr); inc(chr); end;
+ if ((row = nrow - 2) and (col = 0) and ( ( ncol mod 8 ) = 4)) then
+ begin Corner3(chr); inc(chr); end;
+ if ((row = nrow + 4) and (col = 2) and ( ( ncol mod 8 ) = 0)) then
+ begin Corner4(chr); inc(chr); end;
+ //* sweep upward diagonally, inserting successive characters,... */
+l2: //repeat
+
+ if ((row < nrow) and (col >= 0) and ( FPlace[row * ncol + col] = 0)) then
+
+ begin
+ Utah(row, col, chr);
+ inc(chr);
+ end;
+ dec(row, 2); inc(col, 2);
+ //until not((row >= 0) and (col < ncol));
+ if ((row >= 0) and (col < ncol)) then goto l2;
+ inc(row);
+ inc(col, 3);
+ //* & then sweep downward diagonally, inserting successive characters,... */
+l3: //repeat
+ if ((row >= 0) and (col < ncol) and (FPlace[row * ncol + col] = 0)) then
+ begin
+ Utah(row, col, chr);
+ inc(chr);
+ end;
+ inc(row,2);
+ dec(col, 2);
+ //until not ((row < nrow) and (col >= 0));
+ if((row < nrow) and (col >= 0)) then goto l3;
+ inc(row, 3);
+ inc( col, 1);
+ //* ... until the entire array is scanned */
+//until not ((row < nrow) or (col < ncol));
+ if(((row < nrow) or (col < ncol))) then goto l1;
+ //* Lastly, if the lower righthand corner is untouched, fill in fixed pattern */
+ if (FPlace[nrow * ncol - 1] = 0) then
+ begin
+ FPlace[nrow * ncol - 1] := 1;
+ FPlace[nrow * ncol - ncol - 2] := 1;
+ end
+end;
+
+procedure ReedSolomonBlock(var wd : TBytes; nd : integer; var ncout : TBytes; nc: integer; var c : TInts );
+var
+
+ i,j,k : integer;
+
+begin
+
+ for i := 0 to nc do
+ ncout[i] := 0;
+ for i := 0 to nd-1 do
+ begin
+ k := ( ncout[0] xor wd[i] ) and $ff;
+ for j := 0 to nc-1 do
+ begin
+ if( k = 0 ) then
+ ncout[j] := byte( ncout[j + 1] xor byte(0) )
+ else
+ ncout[j] := byte( ncout[j + 1]
+ xor (byte( alog[ (log[k] + log[ c[nc - j - 1] ] ) mod 255 ] )) );
+ end
+ end
+end;
+
+procedure GenerateECC(var wd : TBytes; nd, datablock, nc : integer );
+var
+
+ blocks, b, n, p : integer;
+ buf, ecc : TBytes;
+ c : Pointer;
+
+begin
+
+ blocks := (nd + 2) div datablock;
+ SetLength(buf, 256);
+ SetLength(ecc, 256);
+ c := nil;
+ case nc of
+ 5: c := @poly5;
+ 7: c := @poly7;
+ 10:c := @poly10;
+ 11:c := @poly11;
+ 12:c := @poly12;
+ 14:c := @poly14;
+ 18:c := @poly18;
+ 20:c := @poly20;
+ 24:c := @poly24;
+ 28:c := @poly28;
+ 36:c := @poly36;
+ 42:c := @poly42;
+ 48:c := @poly48;
+ 56:c := @poly56;
+ 62:c := @poly62;
+ 68:c := @poly68;
+ end;
+ for b := 0 to blocks-1 do
+ begin
+ p := 0;
+ n := b;
+ while n < nd do
+ begin
+ buf[p] := wd[n];
+ inc(p);
+ inc(n, blocks);
+ end;
+ ReedSolomonBlock(buf, p, ecc, nc, TInts(c));
+ p := 0;
+ n := b;
+ while n < nc * blocks do
+ begin
+ wd[nd + n] := ecc[p];
+ inc(p);
+ inc(n, blocks);
+ end;
+ end;
+end;
+
+
+initialization
+
+
+
+finalization
+
+
+end.
diff --git a/LibD28/FMX.frxBarcodeEditor.fmx b/LibD28/FMX.frxBarcodeEditor.fmx
new file mode 100644
index 0000000..6d5e01c
--- /dev/null
+++ b/LibD28/FMX.frxBarcodeEditor.fmx
@@ -0,0 +1,151 @@
+object frxBarcodeEditorForm: TfrxBarcodeEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Barcode editor'
+ ClientHeight = 255
+ ClientWidth = 539
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object CodeLbl: TLabel
+ Position.Point = '(8,8)'
+ Width = 185.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object TypeLbl: TLabel
+ Position.Point = '(8,52)'
+ Width = 201.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object ExamplePB: TPaintBox
+ Position.Point = '(276,12)'
+ Width = 253.000000000000000000
+ Height = 233.000000000000000000
+ OnPaint = ExamplePB2Paint
+ end
+ object CancelB: TButton
+ Position.Point = '(184,225)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 50
+ TabOrder = 3
+ ModalResult = 2
+ Cancel = True
+ end
+ object OkB: TButton
+ Position.Point = '(104,225)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 40
+ TabOrder = 4
+ ModalResult = 1
+ Default = True
+ end
+ object CodeE: TComboEdit
+ Cursor = crIBeam
+ Position.Point = '(8,24)'
+ Width = 253.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 260
+ TabOrder = 5
+ KeyboardType = vktDefault
+ OnChange = Rotation0RBClick
+ ItemHeight = 13.000000000000000000
+ ItemIndex = -1
+ ListBoxResource = 'combolistboxstyle'
+ Text = '0'
+ end
+ object TypeCB: TComboBox
+ Position.Point = '(8,68)'
+ Width = 253.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 261
+ TabOrder = 6
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ ListBoxResource = 'transparentlistboxstyle'
+ OnChange = Rotation0RBClick
+ end
+ object OptionsLbl: TGroupBox
+ Position.Point = '(8,100)'
+ Width = 253.000000000000000000
+ Height = 65.000000000000000000
+ TabOrder = 7
+ object ZoomLbl: TLabel
+ Position.Point = '(155,22)'
+ Width = 38.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object CalcCheckSumCB: TCheckBox
+ Position.Point = '(8,20)'
+ Width = 133.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 262
+ TabOrder = 1
+ OnChange = Rotation0RBClick
+ end
+ object ViewTextCB: TCheckBox
+ Position.Point = '(8,40)'
+ Width = 133.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 263
+ TabOrder = 2
+ OnChange = Rotation0RBClick
+ end
+ object ZoomE: TEdit
+ Position.Point = '(196,18)'
+ Width = 33.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 149
+ TabOrder = 3
+ KeyboardType = vktDefault
+ OnChange = Rotation0RBClick
+ Password = False
+ Text = '1'
+ end
+ end
+ object RotationLbl: TGroupBox
+ Position.Point = '(8,172)'
+ Width = 253.000000000000000000
+ Height = 45.000000000000000000
+ TabOrder = 8
+ object Rotation0RB: TRadioButton
+ Position.Point = '(8,20)'
+ Width = 37.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = Rotation0RBClick
+ HelpContext = 264
+ TabOrder = 0
+ end
+ object Rotation90RB: TRadioButton
+ Position.Point = '(72,20)'
+ Width = 37.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = Rotation0RBClick
+ HelpContext = 264
+ TabOrder = 1
+ end
+ object Rotation180RB: TRadioButton
+ Position.Point = '(136,20)'
+ Width = 45.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = Rotation0RBClick
+ HelpContext = 264
+ TabOrder = 2
+ end
+ object Rotation270RB: TRadioButton
+ Position.Point = '(200,20)'
+ Width = 45.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = Rotation0RBClick
+ HelpContext = 264
+ TabOrder = 3
+ end
+ end
+end
diff --git a/LibD28/FMX.frxBarcodeEditor.pas b/LibD28/FMX.frxBarcodeEditor.pas
new file mode 100644
index 0000000..9f875d6
--- /dev/null
+++ b/LibD28/FMX.frxBarcodeEditor.pas
@@ -0,0 +1,307 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ Barcode design editor }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxBarcodeEditor;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.Menus, FMX.frxClass, FMX.frxBarcode, FMX.frxCustomEditors, System.Types,
+ FMX.frxBarcod, FMX.frxCtrls, FMX.Edit, FMX.ListBox, FMX.Objects, FMX.Types
+, System.Variants, System.UITypes, System.UIConsts, FMX.frxBaseModalForm
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI21}
+ , FMX.ComboEdit
+{$ENDIF};
+
+
+type
+ TfrxBarcodeEditor = class(TfrxViewEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxBarcodeEditorForm = class(TfrxForm)
+ CancelB: TButton;
+ OkB: TButton;
+ CodeE: TComboEdit;
+ CodeLbl: TLabel;
+ TypeCB: TComboBox;
+ TypeLbl: TLabel;
+ ExamplePB: TPaintBox;
+ OptionsLbl: TGroupBox;
+ ZoomLbl: TLabel;
+ CalcCheckSumCB: TCheckBox;
+ ViewTextCB: TCheckBox;
+ ZoomE: TEdit;
+ RotationLbl: TGroupBox;
+ Rotation0RB: TRadioButton;
+ Rotation90RB: TRadioButton;
+ Rotation180RB: TRadioButton;
+ Rotation270RB: TRadioButton;
+ procedure ExprBtnClick(Sender: TObject);
+ procedure UpBClick(Sender: TObject);
+ procedure DownBClick(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure FormHide(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure ExamplePB2Paint(Sender: TObject; Canvas: TCanvas);
+ procedure Rotation0RBClick(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ { Private declarations }
+ FBarcode: TfrxBarcodeView;
+ public
+ { Public declarations }
+ property Barcode: TfrxBarcodeView read FBarcode write FBarcode;
+ end;
+
+
+implementation
+
+uses FMX.frxDsgnIntf, FMX.frxRes, FMX.frxUtils;
+
+
+{$R *.FMX}
+
+const
+ cbDefaultText = '12345678';
+
+
+{ TfrxBarcodeEditor }
+
+function TfrxBarcodeEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+function TfrxBarcodeEditor.Edit: Boolean;
+begin
+ with TfrxBarcodeEditorForm.Create(Designer) do
+ begin
+ Barcode := TfrxBarcodeView(Component);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ Self.Designer.PeekLastModalResult;
+ Free;
+ end;
+end;
+
+function TfrxBarcodeEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ i: Integer;
+ c: TfrxComponent;
+ v: TfrxBarcodeView;
+begin
+ Result := inherited Execute(Tag, Checked);
+ for i := 0 to Designer.SelectedObjects.Count - 1 do
+ begin
+ c := Designer.SelectedObjects[i];
+ if (c is TfrxBarcodeView) and not (rfDontModify in c.Restrictions) then
+ begin
+ v := TfrxBarcodeView(c);
+ if Tag = 1 then
+ v.CalcCheckSum := Checked
+ else if Tag = 2 then
+ v.ShowText := Checked;
+ Result := True;
+ end;
+ end;
+end;
+
+procedure TfrxBarcodeEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ v: TfrxBarcodeView;
+begin
+ v := TfrxBarcodeView(Component);
+ AddItem(frxResources.Get('bcCalcChecksum'), 1, v.CalcCheckSum);
+ AddItem(frxResources.Get('bcShowText'), 2, v.ShowText);
+ inherited;
+end;
+
+
+{ TfrxBarcodeEditorForm }
+
+procedure TfrxBarcodeEditorForm.FormShow(Sender: TObject);
+var
+ i: TfrxBarcodeType;
+begin
+{$IFDEF DELPHI23}
+ TypeCB.Clear;
+{$ELSE}
+ TypeCB.Items.Clear;
+{$ENDIF}
+ for i := bcCode_2_5_interleaved to bcCodeEAN128C do
+ TypeCB.Items.Add(frxResources.Get(String(bcData[i].Name)));
+
+ CodeE.Text := FBarcode.Expression;
+ TypeCB.ItemIndex := Integer(FBarcode.BarType);
+ CalcCheckSumCB.IsChecked := FBarcode.CalcCheckSum;
+ ViewTextCB.IsChecked := FBarcode.ShowText;
+ ZoomE.Text := FloatToStr(FBarcode.Zoom);
+
+ case FBarcode.Rotation of
+ 90: Rotation90RB.IsChecked := True;
+ 180: Rotation180RB.IsChecked := True;
+ 270: Rotation270RB.IsChecked := True;
+ else Rotation0RB.IsChecked := True;
+ end;
+
+ ExamplePB.Repaint;
+end;
+
+procedure TfrxBarcodeEditorForm.Rotation0RBClick(Sender: TObject);
+begin
+ ExamplePB.Repaint;
+end;
+
+procedure TfrxBarcodeEditorForm.FormHide(Sender: TObject);
+begin
+ if ModalResult = mrOk then
+ begin
+ FBarcode.Expression := CodeE.Text;
+ FBarcode.BarType := TfrxBarcodeType(TypeCB.ItemIndex);
+ FBarcode.CalcCheckSum := CalcCheckSumCB.IsChecked;
+ FBarcode.ShowText := ViewTextCB.IsChecked;
+ FBarcode.Zoom := frxStrToFloat(ZoomE.Text);
+
+ if Rotation90RB.IsChecked then
+ FBarcode.Rotation := 90
+ else if Rotation180RB.IsChecked then
+ FBarcode.Rotation := 180
+ else if Rotation270RB.IsChecked then
+ FBarcode.Rotation := 270
+ else
+ FBarcode.Rotation := 0;
+ end;
+end;
+
+procedure TfrxBarcodeEditorForm.ExprBtnClick(Sender: TObject);
+var
+ s: String;
+begin
+ s := TfrxCustomDesigner(Owner).InsertExpression(CodeE.Text);
+ if s <> '' then
+ CodeE.Text := s;
+end;
+
+procedure TfrxBarcodeEditorForm.UpBClick(Sender: TObject);
+var
+ i: Double;
+begin
+ i := frxStrToFloat(ZoomE.Text);
+ i := i + 0.1;
+ ZoomE.Text := FloatToStr(i);
+end;
+
+procedure TfrxBarcodeEditorForm.DownBClick(Sender: TObject);
+var
+ i: Double;
+begin
+ i := frxStrToFloat(ZoomE.Text);
+ i := i - 0.1;
+ if i <= 0 then i := 1;
+ ZoomE.Text := FloatToStr(i);
+end;
+
+procedure TfrxBarcodeEditorForm.ExamplePB2Paint(Sender: TObject;
+ Canvas: TCanvas);
+var
+ Barcode: TfrxBarcode;
+ dRect: TRect;
+begin
+ Barcode := TfrxBarcode.Create(Self);
+ Barcode.Typ := TfrxBarcodeType(TypeCB.ItemIndex);
+ Barcode.Text := '12345678';
+ Barcode.Ratio := 1;
+ if Rotation0RB.IsChecked then
+ Barcode.Angle := 0
+ else if Rotation90RB.IsChecked then
+ Barcode.Angle := 90
+ else if Rotation180RB.IsChecked then
+ Barcode.Angle := 180
+ else
+ Barcode.Angle := 270;
+ Barcode.CheckSum := CalcCheckSumCB.IsChecked;
+
+ with ExamplePB.Canvas do
+ begin
+ Fill.Color := claWhite;
+
+ if (Barcode.Angle = 0) or (Barcode.Angle = 180) then
+ dRect := Rect(40, 20, 40 + Round(Barcode.Width * 1.5), 200)
+ else
+ dRect := Rect(20, 40, 200, 40 + Round(Barcode.Width * 1.5));
+
+ Barcode.Color := claWhite;
+ Canvas.FillRect(RectF(0, 0, ExamplePB.Width, ExamplePB.Height), 0, 0, allCorners, 1);
+ Barcode.DrawBarcode(Canvas, dRect ,
+ ViewTextCB.IsChecked, 1.5);
+ end;
+
+ Barcode.Free;
+
+
+
+end;
+
+procedure TfrxBarcodeEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ FormHide(Self);
+end;
+
+procedure TfrxBarcodeEditorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(3500);
+ CodeLbl.Text := frxGet(3501);
+ TypeLbl.Text := frxGet(3502);
+ ZoomLbl.Text := frxGet(3503);
+ OptionsLbl.Text := frxGet(3504);
+ RotationLbl.Text := frxGet(3505);
+ CancelB.Text := frxGet(2);
+ OkB.Text := frxGet(1);
+ CalcCheckSumCB.Text := frxGet(3506);
+ ViewTextCB.Text := frxGet(3507);
+ Rotation0RB.Text := frxGet(3508);
+ Rotation90RB.Text := frxGet(3509);
+ Rotation180RB.Text := frxGet(3510);
+ Rotation270RB.Text := frxGet(3511);
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+end;
+
+
+procedure TfrxBarcodeEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = vkF1 then
+ frxResources.Help(Self);
+end;
+
+initialization
+ frxComponentEditors.Register(TfrxBarcodeView, TfrxBarcodeEditor);
+
+
+end.
diff --git a/LibD28/FMX.frxBarcodePDF417.pas b/LibD28/FMX.frxBarcodePDF417.pas
new file mode 100644
index 0000000..8eff92a
--- /dev/null
+++ b/LibD28/FMX.frxBarcodePDF417.pas
@@ -0,0 +1,1745 @@
+// Generates the 2D barcode PDF417. Supports dimensioning auto-sizing, fixed
+// and variable sizes, automatic and manual error levels, raw codeword input,
+// codeword size optimization and bitmap inversion.
+// Author: Paulo Soares (psoares@consiste.pt)
+// Modifications by Alexander Tzyganenko
+//
+
+
+
+
+unit FMX.frxBarcodePDF417;
+
+
+interface
+
+uses System.SysUtils, System.Types, System.UITypes, System.StrUtils, System.Classes,
+ FMX.Types, FMX.Objects, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ System.Generics.Collections, FMX.frxBarcode2DBase, FMX.frxPrinter
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+type
+
+ TInt = array of integer;
+ PInt = ^TInt;
+
+const
+
+ START_PATTERN = $1fea8;
+ STOP_PATTERN = $3fa29;
+ START_CODE_SIZE = 17;
+ STOP_SIZE = 18;
+ _MOD = 929;
+ ALPHA = $10000;
+ LOWER = $20000;
+ MIXED = $40000;
+ PUNCTUATION = $80000;
+ ISBYTE = $100000;
+ BYTESHIFT = 913;
+ PL = 25;
+ LL = 27;
+ _AS = 27;
+ ML = 28;
+ AL = 28;
+ PS = 29;
+ PAL = 29;
+ SPACE = 26;
+ TEXT_MODE = 900;
+ BYTE_MODE_6 = 924;
+ BYTE_MODE = 901;
+ NUMERIC_MODE = 902;
+ ABSOLUTE_MAX_TEXT_SIZE = 5420;
+ MAX_DATA_CODEWORDS = 926;
+ MACRO_SEGMENT_ID = 928;
+ MACRO_LAST_SEGMENT = 922;
+
+ MIXED_SET = '0123456789&'#13#9',:#-.$/+%*=^';
+ PUNCTUATION_SET = ';<>@[\]_`~!'#13#9',:'#10'-.$/"|*()?{}''';
+
+ CLUSTERS : array[0..2,0..928] of integer =
+ (
+ (
+ $1d5c0, $1eaf0, $1f57c, $1d4e0, $1ea78, $1f53e, $1a8c0, $1d470,
+ $1a860, $15040, $1a830, $15020, $1adc0, $1d6f0, $1eb7c, $1ace0,
+ $1d678, $1eb3e, $158c0, $1ac70, $15860, $15dc0, $1aef0, $1d77c,
+ $15ce0, $1ae78, $1d73e, $15c70, $1ae3c, $15ef0, $1af7c, $15e78,
+ $1af3e, $15f7c, $1f5fa, $1d2e0, $1e978, $1f4be, $1a4c0, $1d270,
+ $1e93c, $1a460, $1d238, $14840, $1a430, $1d21c, $14820, $1a418,
+ $14810, $1a6e0, $1d378, $1e9be, $14cc0, $1a670, $1d33c, $14c60,
+ $1a638, $1d31e, $14c30, $1a61c, $14ee0, $1a778, $1d3be, $14e70,
+ $1a73c, $14e38, $1a71e, $14f78, $1a7be, $14f3c, $14f1e, $1a2c0,
+ $1d170, $1e8bc, $1a260, $1d138, $1e89e, $14440, $1a230, $1d11c,
+ $14420, $1a218, $14410, $14408, $146c0, $1a370, $1d1bc, $14660,
+ $1a338, $1d19e, $14630, $1a31c, $14618, $1460c, $14770, $1a3bc,
+ $14738, $1a39e, $1471c, $147bc, $1a160, $1d0b8, $1e85e, $14240,
+ $1a130, $1d09c, $14220, $1a118, $1d08e, $14210, $1a10c, $14208,
+ $1a106, $14360, $1a1b8, $1d0de, $14330, $1a19c, $14318, $1a18e,
+ $1430c, $14306, $1a1de, $1438e, $14140, $1a0b0, $1d05c, $14120,
+ $1a098, $1d04e, $14110, $1a08c, $14108, $1a086, $14104, $141b0,
+ $14198, $1418c, $140a0, $1d02e, $1a04c, $1a046, $14082, $1cae0,
+ $1e578, $1f2be, $194c0, $1ca70, $1e53c, $19460, $1ca38, $1e51e,
+ $12840, $19430, $12820, $196e0, $1cb78, $1e5be, $12cc0, $19670,
+ $1cb3c, $12c60, $19638, $12c30, $12c18, $12ee0, $19778, $1cbbe,
+ $12e70, $1973c, $12e38, $12e1c, $12f78, $197be, $12f3c, $12fbe,
+ $1dac0, $1ed70, $1f6bc, $1da60, $1ed38, $1f69e, $1b440, $1da30,
+ $1ed1c, $1b420, $1da18, $1ed0e, $1b410, $1da0c, $192c0, $1c970,
+ $1e4bc, $1b6c0, $19260, $1c938, $1e49e, $1b660, $1db38, $1ed9e,
+ $16c40, $12420, $19218, $1c90e, $16c20, $1b618, $16c10, $126c0,
+ $19370, $1c9bc, $16ec0, $12660, $19338, $1c99e, $16e60, $1b738,
+ $1db9e, $16e30, $12618, $16e18, $12770, $193bc, $16f70, $12738,
+ $1939e, $16f38, $1b79e, $16f1c, $127bc, $16fbc, $1279e, $16f9e,
+ $1d960, $1ecb8, $1f65e, $1b240, $1d930, $1ec9c, $1b220, $1d918,
+ $1ec8e, $1b210, $1d90c, $1b208, $1b204, $19160, $1c8b8, $1e45e,
+ $1b360, $19130, $1c89c, $16640, $12220, $1d99c, $1c88e, $16620,
+ $12210, $1910c, $16610, $1b30c, $19106, $12204, $12360, $191b8,
+ $1c8de, $16760, $12330, $1919c, $16730, $1b39c, $1918e, $16718,
+ $1230c, $12306, $123b8, $191de, $167b8, $1239c, $1679c, $1238e,
+ $1678e, $167de, $1b140, $1d8b0, $1ec5c, $1b120, $1d898, $1ec4e,
+ $1b110, $1d88c, $1b108, $1d886, $1b104, $1b102, $12140, $190b0,
+ $1c85c, $16340, $12120, $19098, $1c84e, $16320, $1b198, $1d8ce,
+ $16310, $12108, $19086, $16308, $1b186, $16304, $121b0, $190dc,
+ $163b0, $12198, $190ce, $16398, $1b1ce, $1638c, $12186, $16386,
+ $163dc, $163ce, $1b0a0, $1d858, $1ec2e, $1b090, $1d84c, $1b088,
+ $1d846, $1b084, $1b082, $120a0, $19058, $1c82e, $161a0, $12090,
+ $1904c, $16190, $1b0cc, $19046, $16188, $12084, $16184, $12082,
+ $120d8, $161d8, $161cc, $161c6, $1d82c, $1d826, $1b042, $1902c,
+ $12048, $160c8, $160c4, $160c2, $18ac0, $1c570, $1e2bc, $18a60,
+ $1c538, $11440, $18a30, $1c51c, $11420, $18a18, $11410, $11408,
+ $116c0, $18b70, $1c5bc, $11660, $18b38, $1c59e, $11630, $18b1c,
+ $11618, $1160c, $11770, $18bbc, $11738, $18b9e, $1171c, $117bc,
+ $1179e, $1cd60, $1e6b8, $1f35e, $19a40, $1cd30, $1e69c, $19a20,
+ $1cd18, $1e68e, $19a10, $1cd0c, $19a08, $1cd06, $18960, $1c4b8,
+ $1e25e, $19b60, $18930, $1c49c, $13640, $11220, $1cd9c, $1c48e,
+ $13620, $19b18, $1890c, $13610, $11208, $13608, $11360, $189b8,
+ $1c4de, $13760, $11330, $1cdde, $13730, $19b9c, $1898e, $13718,
+ $1130c, $1370c, $113b8, $189de, $137b8, $1139c, $1379c, $1138e,
+ $113de, $137de, $1dd40, $1eeb0, $1f75c, $1dd20, $1ee98, $1f74e,
+ $1dd10, $1ee8c, $1dd08, $1ee86, $1dd04, $19940, $1ccb0, $1e65c,
+ $1bb40, $19920, $1eedc, $1e64e, $1bb20, $1dd98, $1eece, $1bb10,
+ $19908, $1cc86, $1bb08, $1dd86, $19902, $11140, $188b0, $1c45c,
+ $13340, $11120, $18898, $1c44e, $17740, $13320, $19998, $1ccce,
+ $17720, $1bb98, $1ddce, $18886, $17710, $13308, $19986, $17708,
+ $11102, $111b0, $188dc, $133b0, $11198, $188ce, $177b0, $13398,
+ $199ce, $17798, $1bbce, $11186, $13386, $111dc, $133dc, $111ce,
+ $177dc, $133ce, $1dca0, $1ee58, $1f72e, $1dc90, $1ee4c, $1dc88,
+ $1ee46, $1dc84, $1dc82, $198a0, $1cc58, $1e62e, $1b9a0, $19890,
+ $1ee6e, $1b990, $1dccc, $1cc46, $1b988, $19884, $1b984, $19882,
+ $1b982, $110a0, $18858, $1c42e, $131a0, $11090, $1884c, $173a0,
+ $13190, $198cc, $18846, $17390, $1b9cc, $11084, $17388, $13184,
+ $11082, $13182, $110d8, $1886e, $131d8, $110cc, $173d8, $131cc,
+ $110c6, $173cc, $131c6, $110ee, $173ee, $1dc50, $1ee2c, $1dc48,
+ $1ee26, $1dc44, $1dc42, $19850, $1cc2c, $1b8d0, $19848, $1cc26,
+ $1b8c8, $1dc66, $1b8c4, $19842, $1b8c2, $11050, $1882c, $130d0,
+ $11048, $18826, $171d0, $130c8, $19866, $171c8, $1b8e6, $11042,
+ $171c4, $130c2, $171c2, $130ec, $171ec, $171e6, $1ee16, $1dc22,
+ $1cc16, $19824, $19822, $11028, $13068, $170e8, $11022, $13062,
+ $18560, $10a40, $18530, $10a20, $18518, $1c28e, $10a10, $1850c,
+ $10a08, $18506, $10b60, $185b8, $1c2de, $10b30, $1859c, $10b18,
+ $1858e, $10b0c, $10b06, $10bb8, $185de, $10b9c, $10b8e, $10bde,
+ $18d40, $1c6b0, $1e35c, $18d20, $1c698, $18d10, $1c68c, $18d08,
+ $1c686, $18d04, $10940, $184b0, $1c25c, $11b40, $10920, $1c6dc,
+ $1c24e, $11b20, $18d98, $1c6ce, $11b10, $10908, $18486, $11b08,
+ $18d86, $10902, $109b0, $184dc, $11bb0, $10998, $184ce, $11b98,
+ $18dce, $11b8c, $10986, $109dc, $11bdc, $109ce, $11bce, $1cea0,
+ $1e758, $1f3ae, $1ce90, $1e74c, $1ce88, $1e746, $1ce84, $1ce82,
+ $18ca0, $1c658, $19da0, $18c90, $1c64c, $19d90, $1cecc, $1c646,
+ $19d88, $18c84, $19d84, $18c82, $19d82, $108a0, $18458, $119a0,
+ $10890, $1c66e, $13ba0, $11990, $18ccc, $18446, $13b90, $19dcc,
+ $10884, $13b88, $11984, $10882, $11982, $108d8, $1846e, $119d8,
+ $108cc, $13bd8, $119cc, $108c6, $13bcc, $119c6, $108ee, $119ee,
+ $13bee, $1ef50, $1f7ac, $1ef48, $1f7a6, $1ef44, $1ef42, $1ce50,
+ $1e72c, $1ded0, $1ef6c, $1e726, $1dec8, $1ef66, $1dec4, $1ce42,
+ $1dec2, $18c50, $1c62c, $19cd0, $18c48, $1c626, $1bdd0, $19cc8,
+ $1ce66, $1bdc8, $1dee6, $18c42, $1bdc4, $19cc2, $1bdc2, $10850,
+ $1842c, $118d0, $10848, $18426, $139d0, $118c8, $18c66, $17bd0,
+ $139c8, $19ce6, $10842, $17bc8, $1bde6, $118c2, $17bc4, $1086c,
+ $118ec, $10866, $139ec, $118e6, $17bec, $139e6, $17be6, $1ef28,
+ $1f796, $1ef24, $1ef22, $1ce28, $1e716, $1de68, $1ef36, $1de64,
+ $1ce22, $1de62, $18c28, $1c616, $19c68, $18c24, $1bce8, $19c64,
+ $18c22, $1bce4, $19c62, $1bce2, $10828, $18416, $11868, $18c36,
+ $138e8, $11864, $10822, $179e8, $138e4, $11862, $179e4, $138e2,
+ $179e2, $11876, $179f6, $1ef12, $1de34, $1de32, $19c34, $1bc74,
+ $1bc72, $11834, $13874, $178f4, $178f2, $10540, $10520, $18298,
+ $10510, $10508, $10504, $105b0, $10598, $1058c, $10586, $105dc,
+ $105ce, $186a0, $18690, $1c34c, $18688, $1c346, $18684, $18682,
+ $104a0, $18258, $10da0, $186d8, $1824c, $10d90, $186cc, $10d88,
+ $186c6, $10d84, $10482, $10d82, $104d8, $1826e, $10dd8, $186ee,
+ $10dcc, $104c6, $10dc6, $104ee, $10dee, $1c750, $1c748, $1c744,
+ $1c742, $18650, $18ed0, $1c76c, $1c326, $18ec8, $1c766, $18ec4,
+ $18642, $18ec2, $10450, $10cd0, $10448, $18226, $11dd0, $10cc8,
+ $10444, $11dc8, $10cc4, $10442, $11dc4, $10cc2, $1046c, $10cec,
+ $10466, $11dec, $10ce6, $11de6, $1e7a8, $1e7a4, $1e7a2, $1c728,
+ $1cf68, $1e7b6, $1cf64, $1c722, $1cf62, $18628, $1c316, $18e68,
+ $1c736, $19ee8, $18e64, $18622, $19ee4, $18e62, $19ee2, $10428,
+ $18216, $10c68, $18636, $11ce8, $10c64, $10422, $13de8, $11ce4,
+ $10c62, $13de4, $11ce2, $10436, $10c76, $11cf6, $13df6, $1f7d4,
+ $1f7d2, $1e794, $1efb4, $1e792, $1efb2, $1c714, $1cf34, $1c712,
+ $1df74, $1cf32, $1df72, $18614, $18e34, $18612, $19e74, $18e32,
+ $1bef4
+ ),
+ (
+ $1f560, $1fab8, $1ea40, $1f530, $1fa9c, $1ea20, $1f518, $1fa8e,
+ $1ea10, $1f50c, $1ea08, $1f506, $1ea04, $1eb60, $1f5b8, $1fade,
+ $1d640, $1eb30, $1f59c, $1d620, $1eb18, $1f58e, $1d610, $1eb0c,
+ $1d608, $1eb06, $1d604, $1d760, $1ebb8, $1f5de, $1ae40, $1d730,
+ $1eb9c, $1ae20, $1d718, $1eb8e, $1ae10, $1d70c, $1ae08, $1d706,
+ $1ae04, $1af60, $1d7b8, $1ebde, $15e40, $1af30, $1d79c, $15e20,
+ $1af18, $1d78e, $15e10, $1af0c, $15e08, $1af06, $15f60, $1afb8,
+ $1d7de, $15f30, $1af9c, $15f18, $1af8e, $15f0c, $15fb8, $1afde,
+ $15f9c, $15f8e, $1e940, $1f4b0, $1fa5c, $1e920, $1f498, $1fa4e,
+ $1e910, $1f48c, $1e908, $1f486, $1e904, $1e902, $1d340, $1e9b0,
+ $1f4dc, $1d320, $1e998, $1f4ce, $1d310, $1e98c, $1d308, $1e986,
+ $1d304, $1d302, $1a740, $1d3b0, $1e9dc, $1a720, $1d398, $1e9ce,
+ $1a710, $1d38c, $1a708, $1d386, $1a704, $1a702, $14f40, $1a7b0,
+ $1d3dc, $14f20, $1a798, $1d3ce, $14f10, $1a78c, $14f08, $1a786,
+ $14f04, $14fb0, $1a7dc, $14f98, $1a7ce, $14f8c, $14f86, $14fdc,
+ $14fce, $1e8a0, $1f458, $1fa2e, $1e890, $1f44c, $1e888, $1f446,
+ $1e884, $1e882, $1d1a0, $1e8d8, $1f46e, $1d190, $1e8cc, $1d188,
+ $1e8c6, $1d184, $1d182, $1a3a0, $1d1d8, $1e8ee, $1a390, $1d1cc,
+ $1a388, $1d1c6, $1a384, $1a382, $147a0, $1a3d8, $1d1ee, $14790,
+ $1a3cc, $14788, $1a3c6, $14784, $14782, $147d8, $1a3ee, $147cc,
+ $147c6, $147ee, $1e850, $1f42c, $1e848, $1f426, $1e844, $1e842,
+ $1d0d0, $1e86c, $1d0c8, $1e866, $1d0c4, $1d0c2, $1a1d0, $1d0ec,
+ $1a1c8, $1d0e6, $1a1c4, $1a1c2, $143d0, $1a1ec, $143c8, $1a1e6,
+ $143c4, $143c2, $143ec, $143e6, $1e828, $1f416, $1e824, $1e822,
+ $1d068, $1e836, $1d064, $1d062, $1a0e8, $1d076, $1a0e4, $1a0e2,
+ $141e8, $1a0f6, $141e4, $141e2, $1e814, $1e812, $1d034, $1d032,
+ $1a074, $1a072, $1e540, $1f2b0, $1f95c, $1e520, $1f298, $1f94e,
+ $1e510, $1f28c, $1e508, $1f286, $1e504, $1e502, $1cb40, $1e5b0,
+ $1f2dc, $1cb20, $1e598, $1f2ce, $1cb10, $1e58c, $1cb08, $1e586,
+ $1cb04, $1cb02, $19740, $1cbb0, $1e5dc, $19720, $1cb98, $1e5ce,
+ $19710, $1cb8c, $19708, $1cb86, $19704, $19702, $12f40, $197b0,
+ $1cbdc, $12f20, $19798, $1cbce, $12f10, $1978c, $12f08, $19786,
+ $12f04, $12fb0, $197dc, $12f98, $197ce, $12f8c, $12f86, $12fdc,
+ $12fce, $1f6a0, $1fb58, $16bf0, $1f690, $1fb4c, $169f8, $1f688,
+ $1fb46, $168fc, $1f684, $1f682, $1e4a0, $1f258, $1f92e, $1eda0,
+ $1e490, $1fb6e, $1ed90, $1f6cc, $1f246, $1ed88, $1e484, $1ed84,
+ $1e482, $1ed82, $1c9a0, $1e4d8, $1f26e, $1dba0, $1c990, $1e4cc,
+ $1db90, $1edcc, $1e4c6, $1db88, $1c984, $1db84, $1c982, $1db82,
+ $193a0, $1c9d8, $1e4ee, $1b7a0, $19390, $1c9cc, $1b790, $1dbcc,
+ $1c9c6, $1b788, $19384, $1b784, $19382, $1b782, $127a0, $193d8,
+ $1c9ee, $16fa0, $12790, $193cc, $16f90, $1b7cc, $193c6, $16f88,
+ $12784, $16f84, $12782, $127d8, $193ee, $16fd8, $127cc, $16fcc,
+ $127c6, $16fc6, $127ee, $1f650, $1fb2c, $165f8, $1f648, $1fb26,
+ $164fc, $1f644, $1647e, $1f642, $1e450, $1f22c, $1ecd0, $1e448,
+ $1f226, $1ecc8, $1f666, $1ecc4, $1e442, $1ecc2, $1c8d0, $1e46c,
+ $1d9d0, $1c8c8, $1e466, $1d9c8, $1ece6, $1d9c4, $1c8c2, $1d9c2,
+ $191d0, $1c8ec, $1b3d0, $191c8, $1c8e6, $1b3c8, $1d9e6, $1b3c4,
+ $191c2, $1b3c2, $123d0, $191ec, $167d0, $123c8, $191e6, $167c8,
+ $1b3e6, $167c4, $123c2, $167c2, $123ec, $167ec, $123e6, $167e6,
+ $1f628, $1fb16, $162fc, $1f624, $1627e, $1f622, $1e428, $1f216,
+ $1ec68, $1f636, $1ec64, $1e422, $1ec62, $1c868, $1e436, $1d8e8,
+ $1c864, $1d8e4, $1c862, $1d8e2, $190e8, $1c876, $1b1e8, $1d8f6,
+ $1b1e4, $190e2, $1b1e2, $121e8, $190f6, $163e8, $121e4, $163e4,
+ $121e2, $163e2, $121f6, $163f6, $1f614, $1617e, $1f612, $1e414,
+ $1ec34, $1e412, $1ec32, $1c834, $1d874, $1c832, $1d872, $19074,
+ $1b0f4, $19072, $1b0f2, $120f4, $161f4, $120f2, $161f2, $1f60a,
+ $1e40a, $1ec1a, $1c81a, $1d83a, $1903a, $1b07a, $1e2a0, $1f158,
+ $1f8ae, $1e290, $1f14c, $1e288, $1f146, $1e284, $1e282, $1c5a0,
+ $1e2d8, $1f16e, $1c590, $1e2cc, $1c588, $1e2c6, $1c584, $1c582,
+ $18ba0, $1c5d8, $1e2ee, $18b90, $1c5cc, $18b88, $1c5c6, $18b84,
+ $18b82, $117a0, $18bd8, $1c5ee, $11790, $18bcc, $11788, $18bc6,
+ $11784, $11782, $117d8, $18bee, $117cc, $117c6, $117ee, $1f350,
+ $1f9ac, $135f8, $1f348, $1f9a6, $134fc, $1f344, $1347e, $1f342,
+ $1e250, $1f12c, $1e6d0, $1e248, $1f126, $1e6c8, $1f366, $1e6c4,
+ $1e242, $1e6c2, $1c4d0, $1e26c, $1cdd0, $1c4c8, $1e266, $1cdc8,
+ $1e6e6, $1cdc4, $1c4c2, $1cdc2, $189d0, $1c4ec, $19bd0, $189c8,
+ $1c4e6, $19bc8, $1cde6, $19bc4, $189c2, $19bc2, $113d0, $189ec,
+ $137d0, $113c8, $189e6, $137c8, $19be6, $137c4, $113c2, $137c2,
+ $113ec, $137ec, $113e6, $137e6, $1fba8, $175f0, $1bafc, $1fba4,
+ $174f8, $1ba7e, $1fba2, $1747c, $1743e, $1f328, $1f996, $132fc,
+ $1f768, $1fbb6, $176fc, $1327e, $1f764, $1f322, $1767e, $1f762,
+ $1e228, $1f116, $1e668, $1e224, $1eee8, $1f776, $1e222, $1eee4,
+ $1e662, $1eee2, $1c468, $1e236, $1cce8, $1c464, $1dde8, $1cce4,
+ $1c462, $1dde4, $1cce2, $1dde2, $188e8, $1c476, $199e8, $188e4,
+ $1bbe8, $199e4, $188e2, $1bbe4, $199e2, $1bbe2, $111e8, $188f6,
+ $133e8, $111e4, $177e8, $133e4, $111e2, $177e4, $133e2, $177e2,
+ $111f6, $133f6, $1fb94, $172f8, $1b97e, $1fb92, $1727c, $1723e,
+ $1f314, $1317e, $1f734, $1f312, $1737e, $1f732, $1e214, $1e634,
+ $1e212, $1ee74, $1e632, $1ee72, $1c434, $1cc74, $1c432, $1dcf4,
+ $1cc72, $1dcf2, $18874, $198f4, $18872, $1b9f4, $198f2, $1b9f2,
+ $110f4, $131f4, $110f2, $173f4, $131f2, $173f2, $1fb8a, $1717c,
+ $1713e, $1f30a, $1f71a, $1e20a, $1e61a, $1ee3a, $1c41a, $1cc3a,
+ $1dc7a, $1883a, $1987a, $1b8fa, $1107a, $130fa, $171fa, $170be,
+ $1e150, $1f0ac, $1e148, $1f0a6, $1e144, $1e142, $1c2d0, $1e16c,
+ $1c2c8, $1e166, $1c2c4, $1c2c2, $185d0, $1c2ec, $185c8, $1c2e6,
+ $185c4, $185c2, $10bd0, $185ec, $10bc8, $185e6, $10bc4, $10bc2,
+ $10bec, $10be6, $1f1a8, $1f8d6, $11afc, $1f1a4, $11a7e, $1f1a2,
+ $1e128, $1f096, $1e368, $1e124, $1e364, $1e122, $1e362, $1c268,
+ $1e136, $1c6e8, $1c264, $1c6e4, $1c262, $1c6e2, $184e8, $1c276,
+ $18de8, $184e4, $18de4, $184e2, $18de2, $109e8, $184f6, $11be8,
+ $109e4, $11be4, $109e2, $11be2, $109f6, $11bf6, $1f9d4, $13af8,
+ $19d7e, $1f9d2, $13a7c, $13a3e, $1f194, $1197e, $1f3b4, $1f192,
+ $13b7e, $1f3b2, $1e114, $1e334, $1e112, $1e774, $1e332, $1e772,
+ $1c234, $1c674, $1c232, $1cef4, $1c672, $1cef2, $18474, $18cf4,
+ $18472, $19df4, $18cf2, $19df2, $108f4, $119f4, $108f2, $13bf4,
+ $119f2, $13bf2, $17af0, $1bd7c, $17a78, $1bd3e, $17a3c, $17a1e,
+ $1f9ca, $1397c, $1fbda, $17b7c, $1393e, $17b3e, $1f18a, $1f39a,
+ $1f7ba, $1e10a, $1e31a, $1e73a, $1ef7a, $1c21a, $1c63a, $1ce7a,
+ $1defa, $1843a, $18c7a, $19cfa, $1bdfa, $1087a, $118fa, $139fa,
+ $17978, $1bcbe, $1793c, $1791e, $138be, $179be, $178bc, $1789e,
+ $1785e, $1e0a8, $1e0a4, $1e0a2, $1c168, $1e0b6, $1c164, $1c162,
+ $182e8, $1c176, $182e4, $182e2, $105e8, $182f6, $105e4, $105e2,
+ $105f6, $1f0d4, $10d7e, $1f0d2, $1e094, $1e1b4, $1e092, $1e1b2,
+ $1c134, $1c374, $1c132, $1c372, $18274, $186f4, $18272, $186f2,
+ $104f4, $10df4, $104f2, $10df2, $1f8ea, $11d7c, $11d3e, $1f0ca,
+ $1f1da, $1e08a, $1e19a, $1e3ba, $1c11a, $1c33a, $1c77a, $1823a,
+ $1867a, $18efa, $1047a, $10cfa, $11dfa, $13d78, $19ebe, $13d3c,
+ $13d1e, $11cbe, $13dbe, $17d70, $1bebc, $17d38, $1be9e, $17d1c,
+ $17d0e, $13cbc, $17dbc, $13c9e, $17d9e, $17cb8, $1be5e, $17c9c,
+ $17c8e, $13c5e, $17cde, $17c5c, $17c4e, $17c2e, $1c0b4, $1c0b2,
+ $18174, $18172, $102f4, $102f2, $1e0da, $1c09a, $1c1ba, $1813a,
+ $1837a, $1027a, $106fa, $10ebe, $11ebc, $11e9e, $13eb8, $19f5e,
+ $13e9c, $13e8e, $11e5e, $13ede, $17eb0, $1bf5c, $17e98, $1bf4e,
+ $17e8c, $17e86, $13e5c, $17edc, $13e4e, $17ece, $17e58, $1bf2e,
+ $17e4c, $17e46, $13e2e, $17e6e, $17e2c, $17e26, $10f5e, $11f5c,
+ $11f4e, $13f58, $19fae, $13f4c, $13f46, $11f2e, $13f6e, $13f2c,
+ $13f26
+ ),
+ (
+ $1abe0, $1d5f8, $153c0, $1a9f0, $1d4fc, $151e0, $1a8f8, $1d47e,
+ $150f0, $1a87c, $15078, $1fad0, $15be0, $1adf8, $1fac8, $159f0,
+ $1acfc, $1fac4, $158f8, $1ac7e, $1fac2, $1587c, $1f5d0, $1faec,
+ $15df8, $1f5c8, $1fae6, $15cfc, $1f5c4, $15c7e, $1f5c2, $1ebd0,
+ $1f5ec, $1ebc8, $1f5e6, $1ebc4, $1ebc2, $1d7d0, $1ebec, $1d7c8,
+ $1ebe6, $1d7c4, $1d7c2, $1afd0, $1d7ec, $1afc8, $1d7e6, $1afc4,
+ $14bc0, $1a5f0, $1d2fc, $149e0, $1a4f8, $1d27e, $148f0, $1a47c,
+ $14878, $1a43e, $1483c, $1fa68, $14df0, $1a6fc, $1fa64, $14cf8,
+ $1a67e, $1fa62, $14c7c, $14c3e, $1f4e8, $1fa76, $14efc, $1f4e4,
+ $14e7e, $1f4e2, $1e9e8, $1f4f6, $1e9e4, $1e9e2, $1d3e8, $1e9f6,
+ $1d3e4, $1d3e2, $1a7e8, $1d3f6, $1a7e4, $1a7e2, $145e0, $1a2f8,
+ $1d17e, $144f0, $1a27c, $14478, $1a23e, $1443c, $1441e, $1fa34,
+ $146f8, $1a37e, $1fa32, $1467c, $1463e, $1f474, $1477e, $1f472,
+ $1e8f4, $1e8f2, $1d1f4, $1d1f2, $1a3f4, $1a3f2, $142f0, $1a17c,
+ $14278, $1a13e, $1423c, $1421e, $1fa1a, $1437c, $1433e, $1f43a,
+ $1e87a, $1d0fa, $14178, $1a0be, $1413c, $1411e, $141be, $140bc,
+ $1409e, $12bc0, $195f0, $1cafc, $129e0, $194f8, $1ca7e, $128f0,
+ $1947c, $12878, $1943e, $1283c, $1f968, $12df0, $196fc, $1f964,
+ $12cf8, $1967e, $1f962, $12c7c, $12c3e, $1f2e8, $1f976, $12efc,
+ $1f2e4, $12e7e, $1f2e2, $1e5e8, $1f2f6, $1e5e4, $1e5e2, $1cbe8,
+ $1e5f6, $1cbe4, $1cbe2, $197e8, $1cbf6, $197e4, $197e2, $1b5e0,
+ $1daf8, $1ed7e, $169c0, $1b4f0, $1da7c, $168e0, $1b478, $1da3e,
+ $16870, $1b43c, $16838, $1b41e, $1681c, $125e0, $192f8, $1c97e,
+ $16de0, $124f0, $1927c, $16cf0, $1b67c, $1923e, $16c78, $1243c,
+ $16c3c, $1241e, $16c1e, $1f934, $126f8, $1937e, $1fb74, $1f932,
+ $16ef8, $1267c, $1fb72, $16e7c, $1263e, $16e3e, $1f274, $1277e,
+ $1f6f4, $1f272, $16f7e, $1f6f2, $1e4f4, $1edf4, $1e4f2, $1edf2,
+ $1c9f4, $1dbf4, $1c9f2, $1dbf2, $193f4, $193f2, $165c0, $1b2f0,
+ $1d97c, $164e0, $1b278, $1d93e, $16470, $1b23c, $16438, $1b21e,
+ $1641c, $1640e, $122f0, $1917c, $166f0, $12278, $1913e, $16678,
+ $1b33e, $1663c, $1221e, $1661e, $1f91a, $1237c, $1fb3a, $1677c,
+ $1233e, $1673e, $1f23a, $1f67a, $1e47a, $1ecfa, $1c8fa, $1d9fa,
+ $191fa, $162e0, $1b178, $1d8be, $16270, $1b13c, $16238, $1b11e,
+ $1621c, $1620e, $12178, $190be, $16378, $1213c, $1633c, $1211e,
+ $1631e, $121be, $163be, $16170, $1b0bc, $16138, $1b09e, $1611c,
+ $1610e, $120bc, $161bc, $1209e, $1619e, $160b8, $1b05e, $1609c,
+ $1608e, $1205e, $160de, $1605c, $1604e, $115e0, $18af8, $1c57e,
+ $114f0, $18a7c, $11478, $18a3e, $1143c, $1141e, $1f8b4, $116f8,
+ $18b7e, $1f8b2, $1167c, $1163e, $1f174, $1177e, $1f172, $1e2f4,
+ $1e2f2, $1c5f4, $1c5f2, $18bf4, $18bf2, $135c0, $19af0, $1cd7c,
+ $134e0, $19a78, $1cd3e, $13470, $19a3c, $13438, $19a1e, $1341c,
+ $1340e, $112f0, $1897c, $136f0, $11278, $1893e, $13678, $19b3e,
+ $1363c, $1121e, $1361e, $1f89a, $1137c, $1f9ba, $1377c, $1133e,
+ $1373e, $1f13a, $1f37a, $1e27a, $1e6fa, $1c4fa, $1cdfa, $189fa,
+ $1bae0, $1dd78, $1eebe, $174c0, $1ba70, $1dd3c, $17460, $1ba38,
+ $1dd1e, $17430, $1ba1c, $17418, $1ba0e, $1740c, $132e0, $19978,
+ $1ccbe, $176e0, $13270, $1993c, $17670, $1bb3c, $1991e, $17638,
+ $1321c, $1761c, $1320e, $1760e, $11178, $188be, $13378, $1113c,
+ $17778, $1333c, $1111e, $1773c, $1331e, $1771e, $111be, $133be,
+ $177be, $172c0, $1b970, $1dcbc, $17260, $1b938, $1dc9e, $17230,
+ $1b91c, $17218, $1b90e, $1720c, $17206, $13170, $198bc, $17370,
+ $13138, $1989e, $17338, $1b99e, $1731c, $1310e, $1730e, $110bc,
+ $131bc, $1109e, $173bc, $1319e, $1739e, $17160, $1b8b8, $1dc5e,
+ $17130, $1b89c, $17118, $1b88e, $1710c, $17106, $130b8, $1985e,
+ $171b8, $1309c, $1719c, $1308e, $1718e, $1105e, $130de, $171de,
+ $170b0, $1b85c, $17098, $1b84e, $1708c, $17086, $1305c, $170dc,
+ $1304e, $170ce, $17058, $1b82e, $1704c, $17046, $1302e, $1706e,
+ $1702c, $17026, $10af0, $1857c, $10a78, $1853e, $10a3c, $10a1e,
+ $10b7c, $10b3e, $1f0ba, $1e17a, $1c2fa, $185fa, $11ae0, $18d78,
+ $1c6be, $11a70, $18d3c, $11a38, $18d1e, $11a1c, $11a0e, $10978,
+ $184be, $11b78, $1093c, $11b3c, $1091e, $11b1e, $109be, $11bbe,
+ $13ac0, $19d70, $1cebc, $13a60, $19d38, $1ce9e, $13a30, $19d1c,
+ $13a18, $19d0e, $13a0c, $13a06, $11970, $18cbc, $13b70, $11938,
+ $18c9e, $13b38, $1191c, $13b1c, $1190e, $13b0e, $108bc, $119bc,
+ $1089e, $13bbc, $1199e, $13b9e, $1bd60, $1deb8, $1ef5e, $17a40,
+ $1bd30, $1de9c, $17a20, $1bd18, $1de8e, $17a10, $1bd0c, $17a08,
+ $1bd06, $17a04, $13960, $19cb8, $1ce5e, $17b60, $13930, $19c9c,
+ $17b30, $1bd9c, $19c8e, $17b18, $1390c, $17b0c, $13906, $17b06,
+ $118b8, $18c5e, $139b8, $1189c, $17bb8, $1399c, $1188e, $17b9c,
+ $1398e, $17b8e, $1085e, $118de, $139de, $17bde, $17940, $1bcb0,
+ $1de5c, $17920, $1bc98, $1de4e, $17910, $1bc8c, $17908, $1bc86,
+ $17904, $17902, $138b0, $19c5c, $179b0, $13898, $19c4e, $17998,
+ $1bcce, $1798c, $13886, $17986, $1185c, $138dc, $1184e, $179dc,
+ $138ce, $179ce, $178a0, $1bc58, $1de2e, $17890, $1bc4c, $17888,
+ $1bc46, $17884, $17882, $13858, $19c2e, $178d8, $1384c, $178cc,
+ $13846, $178c6, $1182e, $1386e, $178ee, $17850, $1bc2c, $17848,
+ $1bc26, $17844, $17842, $1382c, $1786c, $13826, $17866, $17828,
+ $1bc16, $17824, $17822, $13816, $17836, $10578, $182be, $1053c,
+ $1051e, $105be, $10d70, $186bc, $10d38, $1869e, $10d1c, $10d0e,
+ $104bc, $10dbc, $1049e, $10d9e, $11d60, $18eb8, $1c75e, $11d30,
+ $18e9c, $11d18, $18e8e, $11d0c, $11d06, $10cb8, $1865e, $11db8,
+ $10c9c, $11d9c, $10c8e, $11d8e, $1045e, $10cde, $11dde, $13d40,
+ $19eb0, $1cf5c, $13d20, $19e98, $1cf4e, $13d10, $19e8c, $13d08,
+ $19e86, $13d04, $13d02, $11cb0, $18e5c, $13db0, $11c98, $18e4e,
+ $13d98, $19ece, $13d8c, $11c86, $13d86, $10c5c, $11cdc, $10c4e,
+ $13ddc, $11cce, $13dce, $1bea0, $1df58, $1efae, $1be90, $1df4c,
+ $1be88, $1df46, $1be84, $1be82, $13ca0, $19e58, $1cf2e, $17da0,
+ $13c90, $19e4c, $17d90, $1becc, $19e46, $17d88, $13c84, $17d84,
+ $13c82, $17d82, $11c58, $18e2e, $13cd8, $11c4c, $17dd8, $13ccc,
+ $11c46, $17dcc, $13cc6, $17dc6, $10c2e, $11c6e, $13cee, $17dee,
+ $1be50, $1df2c, $1be48, $1df26, $1be44, $1be42, $13c50, $19e2c,
+ $17cd0, $13c48, $19e26, $17cc8, $1be66, $17cc4, $13c42, $17cc2,
+ $11c2c, $13c6c, $11c26, $17cec, $13c66, $17ce6, $1be28, $1df16,
+ $1be24, $1be22, $13c28, $19e16, $17c68, $13c24, $17c64, $13c22,
+ $17c62, $11c16, $13c36, $17c76, $1be14, $1be12, $13c14, $17c34,
+ $13c12, $17c32, $102bc, $1029e, $106b8, $1835e, $1069c, $1068e,
+ $1025e, $106de, $10eb0, $1875c, $10e98, $1874e, $10e8c, $10e86,
+ $1065c, $10edc, $1064e, $10ece, $11ea0, $18f58, $1c7ae, $11e90,
+ $18f4c, $11e88, $18f46, $11e84, $11e82, $10e58, $1872e, $11ed8,
+ $18f6e, $11ecc, $10e46, $11ec6, $1062e, $10e6e, $11eee, $19f50,
+ $1cfac, $19f48, $1cfa6, $19f44, $19f42, $11e50, $18f2c, $13ed0,
+ $19f6c, $18f26, $13ec8, $11e44, $13ec4, $11e42, $13ec2, $10e2c,
+ $11e6c, $10e26, $13eec, $11e66, $13ee6, $1dfa8, $1efd6, $1dfa4,
+ $1dfa2, $19f28, $1cf96, $1bf68, $19f24, $1bf64, $19f22, $1bf62,
+ $11e28, $18f16, $13e68, $11e24, $17ee8, $13e64, $11e22, $17ee4,
+ $13e62, $17ee2, $10e16, $11e36, $13e76, $17ef6, $1df94, $1df92,
+ $19f14, $1bf34, $19f12, $1bf32, $11e14, $13e34, $11e12, $17e74,
+ $13e32, $17e72, $1df8a, $19f0a, $1bf1a, $11e0a, $13e1a, $17e3a,
+ $1035c, $1034e, $10758, $183ae, $1074c, $10746, $1032e, $1076e,
+ $10f50, $187ac, $10f48, $187a6, $10f44, $10f42, $1072c, $10f6c,
+ $10726, $10f66, $18fa8, $1c7d6, $18fa4, $18fa2, $10f28, $18796,
+ $11f68, $18fb6, $11f64, $10f22, $11f62, $10716, $10f36, $11f76,
+ $1cfd4, $1cfd2, $18f94, $19fb4, $18f92, $19fb2, $10f14, $11f34,
+ $10f12, $13f74, $11f32, $13f72, $1cfca, $18f8a, $19f9a, $10f0a,
+ $11f1a, $13f3a, $103ac, $103a6, $107a8, $183d6, $107a4, $107a2,
+ $10396, $107b6, $187d4, $187d2, $10794, $10fb4, $10792, $10fb2,
+ $1c7ea
+ ));
+
+ ERRLVL0 : array[0..1] of integer = ( 27, 917 );
+ ERRLVL1 : array[0..3] of integer = ( 522, 568, 723, 809 );
+ ERRLVL2 : array[0..7] of integer = ( 237, 308, 436, 284, 646, 653, 428, 379 );
+ ERRLVL3: array[0..15] of integer = ( 274, 562, 232, 755, 599, 524, 801, 132, 295, 116, 442, 428, 295, 42, 176, 65 );
+ ERRLVL4 : array[0..31] of integer = ( 361, 575, 922, 525, 176, 586, 640, 321, 536, 742, 677, 742, 687, 284, 193, 517,
+ 273, 494, 263, 147, 593, 800, 571, 320, 803, 133, 231, 390, 685, 330, 63, 410 );
+ ERRLVL5 : array[0..63] of integer = (
+ 539, 422, 6, 93, 862, 771, 453, 106, 610, 287, 107, 505, 733, 877, 381, 612,
+ 723, 476, 462, 172, 430, 609, 858, 822, 543, 376, 511, 400, 672, 762, 283, 184,
+ 440, 35, 519, 31, 460, 594, 225, 535, 517, 352, 605, 158, 651, 201, 488, 502,
+ 648, 733, 717, 83, 404, 97, 280, 771, 840, 629, 4, 381, 843, 623, 264, 543 );
+ ERRLVL6 : array[0..127] of integer = (
+ 521, 310, 864, 547, 858, 580, 296, 379, 53, 779, 897, 444, 400, 925, 749, 415,
+ 822, 93, 217, 208, 928, 244, 583, 620, 246, 148, 447, 631, 292, 908, 490, 704,
+ 516, 258, 457, 907, 594, 723, 674, 292, 272, 96, 684, 432, 686, 606, 860, 569,
+ 193, 219, 129, 186, 236, 287, 192, 775, 278, 173, 40, 379, 712, 463, 646, 776,
+ 171, 491, 297, 763, 156, 732, 95, 270, 447, 90, 507, 48, 228, 821, 808, 898,
+ 784, 663, 627, 378, 382, 262, 380, 602, 754, 336, 89, 614, 87, 432, 670, 616,
+ 157, 374, 242, 726, 600, 269, 375, 898, 845, 454, 354, 130, 814, 587, 804, 34,
+ 211, 330, 539, 297, 827, 865, 37, 517, 834, 315, 550, 86, 801, 4, 108, 539 );
+ ERRLVL7 : array[0..255] of integer = (
+ 524, 894, 75, 766, 882, 857, 74, 204, 82, 586, 708, 250, 905, 786, 138, 720,
+ 858, 194, 311, 913, 275, 190, 375, 850, 438, 733, 194, 280, 201, 280, 828, 757,
+ 710, 814, 919, 89, 68, 569, 11, 204, 796, 605, 540, 913, 801, 700, 799, 137,
+ 439, 418, 592, 668, 353, 859, 370, 694, 325, 240, 216, 257, 284, 549, 209, 884,
+ 315, 70, 329, 793, 490, 274, 877, 162, 749, 812, 684, 461, 334, 376, 849, 521,
+ 307, 291, 803, 712, 19, 358, 399, 908, 103, 511, 51, 8, 517, 225, 289, 470,
+ 637, 731, 66, 255, 917, 269, 463, 830, 730, 433, 848, 585, 136, 538, 906, 90,
+ 2, 290, 743, 199, 655, 903, 329, 49, 802, 580, 355, 588, 188, 462, 10, 134,
+ 628, 320, 479, 130, 739, 71, 263, 318, 374, 601, 192, 605, 142, 673, 687, 234,
+ 722, 384, 177, 752, 607, 640, 455, 193, 689, 707, 805, 641, 48, 60, 732, 621,
+ 895, 544, 261, 852, 655, 309, 697, 755, 756, 60, 231, 773, 434, 421, 726, 528,
+ 503, 118, 49, 795, 32, 144, 500, 238, 836, 394, 280, 566, 319, 9, 647, 550,
+ 73, 914, 342, 126, 32, 681, 331, 792, 620, 60, 609, 441, 180, 791, 893, 754,
+ 605, 383, 228, 749, 760, 213, 54, 297, 134, 54, 834, 299, 922, 191, 910, 532,
+ 609, 829, 189, 20, 167, 29, 872, 449, 83, 402, 41, 656, 505, 579, 481, 173,
+ 404, 251, 688, 95, 497, 555, 642, 543, 307, 159, 924, 558, 648, 55, 497, 10 );
+ ERRLVL8 : array[0..511] of integer = (
+ 352, 77, 373, 504, 35, 599, 428, 207, 409, 574, 118, 498, 285, 380, 350, 492,
+ 197, 265, 920, 155, 914, 299, 229, 643, 294, 871, 306, 88, 87, 193, 352, 781,
+ 846, 75, 327, 520, 435, 543, 203, 666, 249, 346, 781, 621, 640, 268, 794, 534,
+ 539, 781, 408, 390, 644, 102, 476, 499, 290, 632, 545, 37, 858, 916, 552, 41,
+ 542, 289, 122, 272, 383, 800, 485, 98, 752, 472, 761, 107, 784, 860, 658, 741,
+ 290, 204, 681, 407, 855, 85, 99, 62, 482, 180, 20, 297, 451, 593, 913, 142,
+ 808, 684, 287, 536, 561, 76, 653, 899, 729, 567, 744, 390, 513, 192, 516, 258,
+ 240, 518, 794, 395, 768, 848, 51, 610, 384, 168, 190, 826, 328, 596, 786, 303,
+ 570, 381, 415, 641, 156, 237, 151, 429, 531, 207, 676, 710, 89, 168, 304, 402,
+ 40, 708, 575, 162, 864, 229, 65, 861, 841, 512, 164, 477, 221, 92, 358, 785,
+ 288, 357, 850, 836, 827, 736, 707, 94, 8, 494, 114, 521, 2, 499, 851, 543,
+ 152, 729, 771, 95, 248, 361, 578, 323, 856, 797, 289, 51, 684, 466, 533, 820,
+ 669, 45, 902, 452, 167, 342, 244, 173, 35, 463, 651, 51, 699, 591, 452, 578,
+ 37, 124, 298, 332, 552, 43, 427, 119, 662, 777, 475, 850, 764, 364, 578, 911,
+ 283, 711, 472, 420, 245, 288, 594, 394, 511, 327, 589, 777, 699, 688, 43, 408,
+ 842, 383, 721, 521, 560, 644, 714, 559, 62, 145, 873, 663, 713, 159, 672, 729,
+ 624, 59, 193, 417, 158, 209, 563, 564, 343, 693, 109, 608, 563, 365, 181, 772,
+ 677, 310, 248, 353, 708, 410, 579, 870, 617, 841, 632, 860, 289, 536, 35, 777,
+ 618, 586, 424, 833, 77, 597, 346, 269, 757, 632, 695, 751, 331, 247, 184, 45,
+ 787, 680, 18, 66, 407, 369, 54, 492, 228, 613, 830, 922, 437, 519, 644, 905,
+ 789, 420, 305, 441, 207, 300, 892, 827, 141, 537, 381, 662, 513, 56, 252, 341,
+ 242, 797, 838, 837, 720, 224, 307, 631, 61, 87, 560, 310, 756, 665, 397, 808,
+ 851, 309, 473, 795, 378, 31, 647, 915, 459, 806, 590, 731, 425, 216, 548, 249,
+ 321, 881, 699, 535, 673, 782, 210, 815, 905, 303, 843, 922, 281, 73, 469, 791,
+ 660, 162, 498, 308, 155, 422, 907, 817, 187, 62, 16, 425, 535, 336, 286, 437,
+ 375, 273, 610, 296, 183, 923, 116, 667, 751, 353, 62, 366, 691, 379, 687, 842,
+ 37, 357, 720, 742, 330, 5, 39, 923, 311, 424, 242, 749, 321, 54, 669, 316,
+ 342, 299, 534, 105, 667, 488, 640, 672, 576, 540, 316, 486, 721, 610, 46, 656,
+ 447, 171, 616, 464, 190, 531, 297, 321, 762, 752, 533, 175, 134, 14, 381, 433,
+ 717, 45, 111, 20, 596, 284, 736, 138, 646, 411, 877, 669, 141, 919, 45, 780,
+ 407, 164, 332, 899, 165, 726, 600, 325, 498, 655, 357, 752, 768, 223, 849, 647,
+ 63, 310, 863, 251, 366, 304, 282, 738, 675, 410, 389, 244, 31, 121, 303, 263 );
+
+
+
+ ERROR_LEVEL : array[0..8] of PInt = ( @ERRLVL0, @ERRLVL1, @ERRLVL2, @ERRLVL3, @ERRLVL4, @ERRLVL5, @ERRLVL6, @ERRLVL7, @ERRLVL8 );
+
+
+type
+
+ /// Specifies the error correction level used for PDF417 barcode.
+ PDF417ErrorCorrection =
+ (
+ AutoCorr,
+ Level0,
+ Level1,
+ Level2,
+ Level3,
+ Level4,
+ Level5,
+ Level6,
+ Level7,
+ Level8
+ );
+
+ /// Specifies the compaction mode used for PDF417 barcode.
+ PDF417CompactionMode =
+ (
+ AutoCompaction,
+ TextComp,
+ Numeric,
+ Binary
+ );
+
+ Segment = class
+
+ public
+
+ _type : char;
+ _start,
+ _end : integer;
+
+ constructor Create( _t : char; _s, _e : integer);
+
+ end;
+
+
+ TSegmentList = class
+
+ public
+
+ list : TList;
+
+ constructor Create;
+ destructor Destroy; override;
+ procedure Add(_type: char; _start,_end : integer);
+ function Get(idx : integer) : Segment;
+ procedure Remove( idx : integer);
+ function Size : integer;
+
+ end;
+
+
+
+
+ ///
+ /// Generates the 2D PDF417 barcode.
+ ///
+ /// This example shows how to configure the BarcodeObject to display PDF417 barcode.
+ ///
+ /// BarcodeObject barcode;
+ /// ...
+ /// barcode.Barcode = new BarcodePDF417();
+ /// (barcode.Barcode as BarcodePDF417).CompactionMode = PDF417CompactionMode.Text;
+ ///
+ ///
+ TfrxBarcodePDF417 = class(TfrxBarcode2DBase)
+
+ private
+
+ codeColumns,
+ FRows,
+ FColumns : integer;
+ codewords : array[0 .. MAX_DATA_CODEWORDS + 1] of integer;
+ lenCodewords,
+ errorLevel : integer;
+ FErrorCorrection : PDF417ErrorCorrection;
+ FCompactionMode : PDF417CompactionMode;
+ bytes : TBytes;
+ FAspectRatio : Double;
+ FCodePage,
+ bitPtr,
+ cwPtr : integer;
+ segmentList : TSegmentList;
+
+ function CheckSegmentType( var segm : Segment; typ : char) : boolean;
+ function GetSegmentLength( var segm : Segment ) : integer;
+ procedure OutCodeword17( codeword : integer);
+ procedure OutCodeword18( codeword : integer);
+ procedure OutCodeword( codeword : integer );
+ procedure OutStopPattern;
+ procedure OutStartPattern;
+ procedure OutPaintCode;
+ procedure CalculateErrorCorrection(dest : integer);
+ function GetTextTypeAndValue( var input : TBytes; maxLength, idx : integer ) : integer; overload;
+ function GetTextTypeAndValue(maxLength, idx : integer) : integer; overload;
+ procedure TextCompaction(var input : TBytes; start, length : integer); overload;
+ procedure TextCompaction( start, length : integer); overload;
+ procedure BasicNumberCompaction(var input : TBytes; start, length : integer); overload;
+ procedure NumberCompaction(var input : TBytes; start,length : integer); overload;
+ procedure NumberCompaction( start, length : integer); overload;
+ procedure ByteCompaction6( start : integer );
+ procedure ByteCompaction( start, length : integer);
+ procedure BreakString;
+ procedure Assemble;
+ function MaxPossibleErrorLevel( remain: integer) : integer;
+ function GetMaxSquare : integer;
+ procedure PaintCode;
+ procedure Initialize;
+
+ procedure SetAspectRatio(v : Double);
+ procedure SetColumns(v : integer);
+ procedure SetRows(v : integer);
+ procedure SetErrorCorrection(v : PDF417ErrorCorrection);
+ procedure SetCodePage(v : integer);
+ procedure SetCompactionMode(v : PDF417CompactionMode);
+ protected
+ procedure SetText(v : string); override;
+ function CalcBounds : TSize;
+ public
+ procedure Assign( source : TfrxBarcode2DBase ); override;
+// procedure Draw2DBarcode(var g : TCanvas; scalex, scaley : extended; x, y : integer ); override;
+ constructor Create; override;
+ destructor Destroy; override;
+
+ published
+
+ /// Gets or sets the barcode aspect ratio.
+ /// A ratio or 0.5 will make the barcode width twice as large as the height.
+ property AspectRatio : Double read FAspectRatio write SetAspectRatio;
+ /// Gets or sets the number of barcode data columns.
+ /// To calculate the necessary number of columns and rows, set the
+ /// and properties to 0. In this case, the property
+ /// should be set to desired aspect ratio.
+ property Columns : integer read FColumns write SetColumns;
+ /// Gets or sets the number of barcode data rows.
+ /// To calculate the necessary number of columns and rows, set the
+ /// and properties to 0. In this case, the property
+ /// should be set to desired aspect ratio.
+ property Rows : integer read FRows write SetRows;
+ /// Gets or sets the error level correction used for the barcode.
+ // [DefaultValue(PDF417ErrorCorrection.Auto)]
+ property ErrorCorrection : PDF417ErrorCorrection read FErrorCorrection write SetErrorCorrection;
+ /// Gets or sets the code page used for text conversion.
+ /// Use this property to encode non-ASCII characters. For example, set this
+ /// property to 1251 to use Window CP1251.
+ /// [DefaultValue(437)]
+ property CodePage : integer read FCodePage write SetCodePage;
+ /// Gets or sets the compaction mode.
+ /// [DefaultValue(PDF417CompactionMode.Auto)]
+ property CompactionMode : PDF417CompactionMode read FCompactionMode write SetCompactionMode;
+ /// Gets or sets the size of the pixel.
+
+end;
+
+implementation
+
+
+procedure TfrxBarcodePDF417.SetText(v : string);
+begin
+ if( FText <> v) then
+ begin
+ FText := v;
+ Initialize;
+ end;
+end;
+procedure TfrxBarcodePDF417.SetAspectRatio(v : Double);
+begin
+ if v <> FAspectRatio then
+ begin
+ FAspectRatio := v;
+ Initialize;
+ end;
+end;
+procedure TfrxBarcodePDF417.SetColumns(v : integer);
+begin
+ if v <> FColumns then
+ begin
+ FColumns := v;
+ Initialize;
+ end;
+end;
+procedure TfrxBarcodePDF417.SetRows(v : integer);
+begin
+ if v <> FRows then
+ begin
+ FRows := v;
+ Initialize;
+ end;
+end;
+procedure TfrxBarcodePDF417.SetErrorCorrection(v : PDF417ErrorCorrection);
+begin
+ if v <> FErrorCorrection then
+ begin
+ FErrorCorrection := v;
+ Initialize;
+ end;
+end;
+
+procedure TfrxBarcodePDF417.SetCodePage(v : integer);
+begin
+ if v <> FCodePage then
+ begin
+ FCodePage := v;
+ Initialize;
+ end;
+end;
+procedure TfrxBarcodePDF417.SetCompactionMode(v : PDF417CompactionMode);
+begin
+ if v <> FCompactionMode then
+ begin
+ FCompactionMode := v;
+ Initialize;
+ end;
+end;
+
+procedure TfrxBarcodePDF417.Initialize;
+var
+ e: TEncoding;
+begin
+ if (text = '') then
+ SetLength(bytes, 0)
+ else
+ begin
+ e := TEncoding.GetEncoding(FCodePage);
+ try
+ bytes := e.GetBytes(text);
+ finally
+ e.Free;
+ end;
+ end;
+
+ codeColumns := FColumns;
+ FHeight := FRows;
+ fillChar(codewords[0], (MAX_DATA_CODEWORDS + 1) * sizeof(integer), 0);
+ PaintCode();
+end;
+
+/// Initializes a new instance of the class with default settings.
+constructor TfrxBarcodePDF417.Create;
+begin
+ inherited;
+ FImage := nil;
+ SetLength( bytes, 0);
+ setlength(FImage, 0);
+
+ FPixelwidth := 2;
+ FPixelHeight := 8;
+ FAspectRatio := 0.5;
+ FCodePage := 437;
+ Columns := 0;
+ Rows := 0;
+ FCompactionMode := AutoCompaction;
+ Initialize;
+ end;
+
+destructor TfrxBarcodePDF417.Destroy;
+begin
+ SetLength(bytes, 0);
+ inherited;
+end;
+
+
+function TfrxBarcodePDF417.CalcBounds : TSize;
+var
+ textAdd : integer;
+begin
+ if ( ShowText ) then textAdd := 18 else textAdd := 0;
+ result.width := FWidth * PixelWidth;
+ result.height := FHeight * PixelHeight + textAdd;
+end;
+
+procedure TfrxBarcodePDF417.Assign( source : TfrxBarcode2DBase );
+var
+ src : TfrxBarcodePDF417;
+begin
+ inherited;
+ if source is TfrxBarcodePDF417 then
+ begin
+ src := source as TfrxBarcodePDF417;
+
+ AspectRatio := src.AspectRatio;
+ Columns := src.Columns;
+ Rows := src.Rows;
+ CodePage := src.CodePage;
+ CompactionMode := src.CompactionMode;
+ ErrorCorrection := src.ErrorCorrection;
+ end;
+end;
+
+//** Paints the barcode. If no exception was thrown a valid barcode is available. */
+procedure TfrxBarcodePDF417.PaintCode;
+var
+ maxErr, lenErr, tot, pad : integer;
+ fixedColumn, skipRowColAdjust : boolean;
+ c, b, yHeight : extended;
+begin
+ if (bytes = nil) then
+ raise Exception.Create('Text cannot be null.');
+ if (Length(bytes) > ABSOLUTE_MAX_TEXT_SIZE) then
+ raise Exception.Create('The text is too big.');
+ segmentList := TSegmentList.Create;
+ BreakString;
+ Assemble;
+ FreeAndNil(segmentList);
+ codewords[0] := cwPtr;
+ lenCodewords := cwPtr;
+
+ // error correction level
+ maxErr := MaxPossibleErrorLevel(MAX_DATA_CODEWORDS + 2 - lenCodewords);
+ if (ErrorCorrection = AutoCorr ) then
+ begin
+ if (lenCodewords < 41) then
+ errorLevel := 2
+ else
+ if (lenCodewords < 161) then
+ errorLevel := 3
+ else
+ if (lenCodewords < 321) then
+ errorLevel := 4
+ else
+ errorLevel := 5;
+ end
+ else
+ errorLevel := integer(ord(ErrorCorrection) - 1);
+ if (errorLevel < 0) then
+ errorLevel := 0
+ else
+ if (errorLevel > maxErr) then
+ errorLevel := maxErr;
+
+ if (codeColumns < 1) then
+ codeColumns := 1
+ else
+ if (codeColumns > 30) then
+ codeColumns := 30;
+ if (FHeight < 3) then
+ FHeight := 3
+ else
+ if (FHeight > 90) then
+ FHeight := 90;
+ lenErr := 2 shl errorLevel;
+ fixedColumn := FRows = 0;
+ skipRowColAdjust := false;
+ tot := lenCodewords + lenErr;
+ if (FColumns <> 0) and (FRows <> 0) then
+ begin
+ tot := codeColumns * FHeight;
+ if (tot > MAX_DATA_CODEWORDS + 2) then
+ tot := GetMaxSquare;
+ if (tot < lenCodewords + lenErr) then
+ tot := lenCodewords + lenErr
+ else
+ skipRowColAdjust := true;
+ end
+ else
+ begin
+ fixedColumn := true;
+ if (FAspectRatio < 0.001) then
+ FAspectRatio := 0.001
+ else
+ if (FAspectRatio > 1000) then
+ FAspectRatio := 1000;
+ if PixelWidth = 0 then
+ yHeight := 3
+ else
+ yHeight := extended( PixelHeight / PixelWidth );
+ b := 73 * FAspectRatio - 4;
+ c := (-b + Sqrt(b * b + 4 * 17 * FAspectRatio * (lenCodewords + lenErr) * yHeight)) / (2 * 17 * FAspectRatio);
+ codeColumns := trunc(c + 0.5);
+ if (codeColumns < 1) then
+ codeColumns := 1
+ else
+ if (codeColumns > 30) then
+ codeColumns := 30;
+ end;
+
+ if not skipRowColAdjust then
+ begin
+ if (fixedColumn) then
+ begin
+ FHeight := (tot - 1) div codeColumns + 1;
+ if (FHeight < 3) then
+ FHeight := 3
+ else
+ if (FHeight > 90) then
+ begin
+ FHeight := 90;
+ codeColumns := (tot - 1) div 90 + 1;
+ end;
+ end
+
+ else
+ begin
+ codeColumns := (tot - 1) div FHeight + 1;
+ if (codeColumns > 30) then
+ begin
+ codeColumns := 30;
+ FHeight := (tot - 1) div 30 + 1;
+ end;
+ end;
+ tot := FHeight * codeColumns;
+ end;
+
+ if (tot > MAX_DATA_CODEWORDS + 2) then
+ tot := GetMaxSquare;
+ errorLevel := MaxPossibleErrorLevel(tot - lenCodewords);
+ lenErr := 2 shl errorLevel;
+ pad := tot - lenErr - lenCodewords;
+
+ cwPtr := lenCodewords;
+ while (pad <> 0) do
+ begin
+ dec(pad);
+ codewords[cwPtr] := TEXT_MODE;
+ inc(cwPtr);
+ end;
+
+ codewords[0] := cwPtr;
+ lenCodewords := cwPtr;
+ CalculateErrorCorrection(lenCodewords);
+ lenCodewords := tot;
+ OutPaintCode;
+end;
+
+
+function TfrxBarcodePDF417.GetMaxSquare : integer;
+begin
+ if (codeColumns > 21) then
+ begin
+ codeColumns := 29;
+ FHeight := 32;
+ end
+ else
+ begin
+ codeColumns := 16;
+ FHeight := 58;
+ end;
+ result := MAX_DATA_CODEWORDS + 2;
+end;
+
+function TfrxBarcodePDF417.MaxPossibleErrorLevel( remain: integer) : integer;
+var
+ level, size : integer;
+begin
+ level := 8;
+ size := 512;
+ while (level > 0) do
+ begin
+ if (remain >= size) then
+ begin
+ result := level;
+ exit;
+ end;
+ dec(level);
+ size := size shr 1;
+ end;
+ result := 0;
+end;
+
+procedure TfrxBarcodePDF417.Assemble;
+var
+
+ k : integer;
+ v : Segment;
+begin
+
+ if segmentList.Size = 0 then
+ exit;
+ cwPtr := 1;
+ for k := 0 to segmentList.Size-1 do
+ begin
+ v := segmentList.Get(k);
+ case v._type of
+
+ 'T': begin
+ if (k <> 0) then
+ begin
+ codewords[cwPtr] := TEXT_MODE; inc(cwPtr);
+ end;
+ TextCompaction(v._start, GetSegmentLength(v));
+ end;
+ 'N': begin
+ codewords[cwPtr] := NUMERIC_MODE; inc(cwPtr);
+ NumberCompaction(v._start, GetSegmentLength(v));
+ end;
+ 'B': begin
+ if (GetSegmentLength(v) mod 6) <> 0 then
+ begin
+ codewords[cwPtr] := BYTE_MODE;
+ inc(cwPtr);
+ end
+ else
+ begin
+ codewords[cwPtr] := BYTE_MODE_6;
+ inc(cwPtr);
+ end;
+ ByteCompaction(v._start, GetSegmentLength(v));
+ end;
+ end;
+ end;
+end;
+
+
+procedure TfrxBarcodePDF417.BreakString;
+var
+ textLength, lastP, startN, nd, k, j : integer;
+ c : char;
+ lastTxt, txt, redo : boolean;
+ v, vp, vn : Segment;
+begin
+
+ textLength := Length(bytes);
+ lastP := 0;
+ startN := 0;
+ nd := 0;
+
+ case CompactionMode of
+
+ TextComp: begin
+ segmentList.Add('T', 0, textLength);
+ exit;
+ end;
+
+ Numeric:
+ begin
+ segmentList.Add('N', 0, textLength);
+ exit;
+ end;
+
+ Binary:
+ begin
+ segmentList.Add('B', 0, textLength);
+ exit;
+ end;
+ end;
+
+ for k := 0 to textLength-1 do
+ begin
+ c := char((bytes[k] and $ff));
+ if (c >= '0') and (c <= '9') then
+ begin
+ if (nd = 0) then
+ startN := k;
+ inc(nd);
+ continue;
+ end;
+ if (nd >= 13) then
+ begin
+ if (lastP <> startN) then
+ begin
+ c := char((bytes[lastP] and $ff));
+ lastTxt := ((c >= ' ') and (c < #127)) or ( c = #13 ) or ( c = #10 ) or ( c = #9 );
+ for j := lastP to startN - 1 do
+ begin
+ c := char((bytes[j] and $ff));
+ txt := ((c >= ' ') and (c < #127)) or ( c = #13 ) or ( c = #10 ) or ( c = #9 );
+ if (txt <> lastTxt) then
+ begin
+ if lastTxt then
+ segmentList.Add('T', lastP, j)
+ else
+ segmentList.Add('B', lastP, j);
+ lastP := j;
+ lastTxt := txt;
+ end;
+ end;
+ if lastTxt then
+ segmentList.Add('T', lastP, startN)
+ else
+ segmentList.Add('B', lastP, startN);
+ end;
+ segmentList.Add('N', startN, k);
+ lastP := k;
+ end;
+ nd := 0;
+ end;
+ if (nd < 13) then
+ startN := textLength;
+ if (lastP <> startN) then
+ begin
+ c := char((bytes[lastP] and $ff));
+ lastTxt := ((c >= ' ') and (c < #127)) or (c = #10) or ( c = #13) or ( c = #9 );
+ for j := lastP to startN-1 do
+ begin
+ c := char((bytes[j] and $ff));
+ txt := ((c >= ' ') and (c < #127)) or ( c = #10 ) or ( c = #13 ) or ( c = #9 );
+ if (txt <> lastTxt) then
+ begin
+ if lastTxt then
+ segmentList.Add('T', lastP, j)
+ else
+ segmentList.Add('B', lastP, j);
+ lastP := j;
+ lastTxt := txt;
+ end;
+ end;
+ if lastTxt then
+ segmentList.Add('T', lastP, startN)
+ else
+ segmentList.Add('B', lastP, startN);
+ end;
+ if (nd >= 13) then
+ segmentList.Add('N', startN, textLength);
+ //optimize
+ //merge short binary
+ k := 0;
+ while k < segmentList.Size do
+ begin
+ v := segmentList.Get(k);
+ vp := segmentList.Get(k - 1);
+ vn := segmentList.Get(k + 1);
+ if ( CheckSegmentType(v, 'B') and ( GetSegmentLength(v) = 1) ) then
+ begin
+ if CheckSegmentType(vp, 'T') and CheckSegmentType(vn, 'T')
+ and (GetSegmentLength(vp) + GetSegmentLength(vn) >= 3) then
+ begin
+ vp._end := vn._end;
+ segmentList.Remove(k);
+ segmentList.Remove(k);
+ k := -1;
+ inc(k);
+ continue;
+ end;
+ end;
+ inc(k);
+ end;
+ //merge text sections
+ k := 0;
+ while k < segmentList.Size do
+ begin
+ v := segmentList.Get(k);
+ vp := segmentList.Get(k - 1);
+ vn := segmentList.Get(k + 1);
+ if CheckSegmentType(v, 'T') and (GetSegmentLength(v) >= 5) then
+ begin
+ redo := false;
+ if ( CheckSegmentType(vp, 'B') and (GetSegmentLength(vp) = 1)) or CheckSegmentType(vp, 'T') then
+ begin
+ redo := true;
+ v._start := vp._start;
+ segmentList.Remove(k - 1);
+ dec(k);
+ end;
+ if ( CheckSegmentType(vn, 'B') and (GetSegmentLength(vn) = 1)) or CheckSegmentType(vn, 'T') then
+ begin
+ redo := true;
+ v._end := vn._end;
+ segmentList.Remove(k + 1);
+ end;
+ if (redo) then
+ begin
+ k := -1;
+ inc(k);
+ continue;
+ end;
+ end;
+ inc(k);
+ end;
+ //merge binary sections
+ k := 0;
+ while k < segmentList.Size do
+ begin
+ v := segmentList.Get(k);
+ vp := segmentList.Get(k - 1);
+ vn := segmentList.Get(k + 1);
+ if CheckSegmentType(v, 'B') then
+ begin
+ redo := false;
+ if (CheckSegmentType(vp, 'T') and ( GetSegmentLength(vp) < 5 ) ) or CheckSegmentType(vp, 'B') then
+ begin
+ redo := true;
+ v._start := vp._start;
+ segmentList.Remove(k - 1);
+ dec(k);
+ end;
+ if ( CheckSegmentType(vn, 'T') and (GetSegmentLength(vn) < 5)) or CheckSegmentType(vn, 'B') then
+ begin
+ redo := true;
+ v._end := vn._end;
+ segmentList.Remove(k + 1);
+ end;
+ if (redo) then
+ begin
+ k := -1;
+ inc(k);
+ continue;
+ end;
+ end;
+ inc(k);
+ end;
+ // check if all numbers
+ v := segmentList.Get(0);
+ if (segmentList.Size = 1) and (v._type = 'T') and ( GetSegmentLength(v) >= 8 ) then
+ begin
+ for k := v._start to v._end-1 do
+ begin
+ c := char((bytes[k] and $ff));
+ if (c < '0') or ( c > '9') then
+ break;
+ end;
+ if (k = v._end) then
+ v._type := 'N';
+ end;
+end;
+
+procedure TfrxBarcodePDF417.ByteCompaction( start, length : integer);
+var
+ k,j, size : integer;
+begin
+ size := (length div 6) * 5 + (length mod 6);
+ if (size + cwPtr ) > MAX_DATA_CODEWORDS then
+ raise Exception.Create('The text is too big.');
+
+ inc(length,start);
+
+ k := start;
+ while k < length do
+ begin
+ size := length - k;
+ if size>=44 then size:=6;
+ if (size < 6) then
+ begin
+ for j := 0 to size-1 do
+ begin
+ codewords[cwPtr] := integer(bytes[k + j]) and $ff;
+ inc(cwPtr);
+ end;
+ end
+ else
+ begin
+ ByteCompaction6(k);
+ end;
+ inc(k, 6);
+ end;
+end;
+
+
+procedure TfrxBarcodePDF417.ByteCompaction6( start : integer );
+var
+ length, ret, retLast, ni, k : integer;
+begin
+ length := 6;
+ ret := cwPtr;
+ retLast := 4;
+ inc(cwPtr, retLast + 1);
+ for k := 0 to retLast do
+ codewords[ret + k] := 0;
+ inc( length, start );
+ for ni := start to length-1 do
+ begin
+ // multiply by 256
+ for k := retLast downto 0 do
+ codewords[ret + k] := codewords[ret + k] * 256;
+ // add the digit
+ inc(codewords[ret + retLast], integer(bytes[ni]) and $ff);
+ // propagate carry
+ for k := retLast downto 1 do
+ begin
+ inc(codewords[ret + k - 1], codewords[ret + k] div 900);
+ codewords[ret + k] := codewords[ret + k] mod 900;
+ end;
+ end;
+end;
+
+
+procedure TfrxBarcodePDF417.NumberCompaction( start, length : integer);
+begin
+ NumberCompaction(bytes, start, length);
+end;
+
+
+procedure TfrxBarcodePDF417.NumberCompaction(var input : TBytes; start,length : integer);
+var
+ full, size, k : integer;
+begin
+ full := (length div 44) * 15;
+ size := length mod 44;
+ if (size = 0) then
+ size := full
+ else
+ size := full + size div 3 + 1;
+ if (size + cwPtr > MAX_DATA_CODEWORDS) then
+ raise Exception.Create('The text is too big.');
+
+ inc(length, start);
+ k := start;
+ while( k < length ) do
+ begin
+ size := length - k;
+ if size > 44 then size := 44;
+ BasicNumberCompaction(input, k, size);
+ inc(k ,44);
+ end;
+end;
+
+procedure TfrxBarcodePDF417.BasicNumberCompaction(var input : TBytes; start, length : integer);
+var
+ ret, retLast, ni, k : integer;
+begin
+ ret := cwPtr;
+ retLast := length div 3;
+ inc(cwPtr, retLast + 1);
+ for k := 0 to retLast do
+ codewords[ret + k] := 0;
+
+ codewords[ret + retLast] := 1;
+ inc(length, start);
+ for ni := start to length-1 do
+ begin
+ // multiply by 10
+ for k := retLast downto 0 do
+ codewords[ret + k] := codewords[ret + k] * 10;
+ // add the digit
+ inc(codewords[ret + retLast], input[ni] - ord('0'));
+ // propagate carry
+ for k := retLast downto 1 do
+ begin
+ inc(codewords[ret + k - 1], codewords[ret + k] div 900);
+ codewords[ret + k] := codewords[ret + k] mod 900;
+ end;
+ end;
+end;
+
+procedure TfrxBarcodePDF417.TextCompaction( start, length : integer);
+begin
+ TextCompaction(bytes, start, length);
+end;
+
+procedure TfrxBarcodePDF417.TextCompaction(var input : TBytes; start, length : integer);
+var
+ dest : TInt;
+ mode, ptr, fullBytes, v, k, size
+ : integer;
+begin
+ SetLength( dest, ABSOLUTE_MAX_TEXT_SIZE * 2 );
+
+ FillChar(dest[0], sizeof(dest), 0);
+ mode := ALPHA;
+ ptr := 0; fullBytes := 0;
+ inc(length, start);
+ k := start;
+ while ( k < length) do
+ begin
+ v := GetTextTypeAndValue(input, length, k);
+ if ((v and mode) <> 0) then
+ begin
+ dest[ptr] := v and $ff;
+ inc(ptr);
+ inc(k);
+ continue;
+ end;
+ if ((v and ISBYTE) <> 0) then
+ begin
+ if ((ptr and 1) <> 0) then
+ begin
+ //add a padding word
+// dest[ptr] := PAL;
+ if mode and PUNCTUATION <> 0 then
+ dest[ptr] := PAL
+ else
+ dest[ptr] := PS;
+ inc(ptr);
+ if (mode and PUNCTUATION) <> 0 then mode := ALPHA;
+ end;
+ dest[ptr] := BYTESHIFT; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ inc(fullBytes, 2);
+ inc(k);
+ continue;
+ end;
+ case (mode) of
+ ALPHA: if ((v and LOWER) <> 0) then
+ begin
+ dest[ptr] := LL; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ mode := LOWER;
+ end
+ else
+ if ((v and MIXED) <> 0) then
+ begin
+ dest[ptr] := ML; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ mode := MIXED;
+ end
+ else
+ if ((GetTextTypeAndValue(input, length, k + 1)
+ and GetTextTypeAndValue(input, length, k + 2)
+ and PUNCTUATION) <> 0) then
+ begin
+ dest[ptr] := ML; inc(ptr);
+ dest[ptr] := PL; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ mode := PUNCTUATION;
+ end
+ else
+ begin
+ dest[ptr] := PS; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ end;
+ LOWER: if ((v and ALPHA) <> 0) then
+ begin
+ if ((GetTextTypeAndValue(length, k + 1)
+ and GetTextTypeAndValue(length, k + 2)
+ and ALPHA) <> 0) then
+ begin
+ dest[ptr] := ML; inc(ptr);
+ dest[ptr] := AL; inc(ptr);
+ mode := ALPHA;
+ end
+ else
+ begin
+ dest[ptr] := _AS; inc(ptr);
+ end;
+ dest[ptr] := v and $ff; inc(ptr);
+ end
+ else
+ if ((v and MIXED) <> 0) then
+ begin
+ dest[ptr] := ML; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ mode := MIXED;
+ end
+ else
+ if ((GetTextTypeAndValue(input, length, k + 1)
+ and GetTextTypeAndValue(input, length, k + 2)
+ and PUNCTUATION) <> 0) then
+ begin
+ dest[ptr] := ML; inc(ptr);
+ dest[ptr] := PL; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ mode := PUNCTUATION;
+ end
+ else
+ begin
+ dest[ptr] := PS; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ end;
+ MIXED: if ((v and LOWER) <> 0) then
+ begin
+ dest[ptr] := LL; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ mode := LOWER;
+ end
+ else
+ if ((v and ALPHA) <> 0) then
+ begin
+ dest[ptr] := AL; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ mode := ALPHA;
+ end
+ else
+ if ((GetTextTypeAndValue(input, length, k + 1)
+ and GetTextTypeAndValue(input, length, k + 2)
+ and PUNCTUATION) <> 0) then
+ begin
+ dest[ptr] := PL; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ mode := PUNCTUATION;
+ end
+ else
+ begin
+ dest[ptr] := PS; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ end;
+ PUNCTUATION: begin
+ dest[ptr] := PAL; inc(ptr);
+ mode := ALPHA;
+ dec(k);
+ end;
+ end; // case
+ inc(k);
+ end; // for
+ if ((ptr and 1) <> 0) then
+ begin
+ dest[ptr] := PS; inc(ptr);
+ end;
+ size := (ptr + fullBytes) div 2;
+ if (size + cwPtr > MAX_DATA_CODEWORDS) then
+ raise Exception.Create('The text is too big.');
+ length := ptr;
+ ptr := 0;
+ while (ptr < length) do
+ begin
+ v := dest[ptr]; inc(ptr);
+ if (v >= 30) then
+ begin
+ codewords[cwPtr] := v; inc(cwPtr);
+ codewords[cwPtr] := dest[ptr]; inc(cwPtr);
+ inc(ptr);
+ end
+ else
+ begin
+ codewords[cwPtr] := v * 30 + dest[ptr];
+ inc(cwPtr);
+ inc(ptr);
+ end;
+ end;
+end;
+
+function TfrxBarcodePDF417.GetTextTypeAndValue(maxLength, idx : integer) : integer;
+begin
+ result := GetTextTypeAndValue(bytes, maxLength, idx);
+end;
+
+
+function TfrxBarcodePDF417.GetTextTypeAndValue( var input : TBytes; maxLength, idx : integer ) : integer;
+var
+ c : char;
+ ms,ps : integer;
+begin
+
+ if (idx >= maxLength) then begin
+ result := 0;
+ exit;
+ end;
+ c := char(input[idx] and $ff);
+
+ if (c >= 'A') and (c <= 'Z') then begin
+ result := (ALPHA + ord(c) - ord('A'));
+ exit;
+ end;
+ if (c >= 'a') and (c <= 'z') then begin
+ result := (LOWER + ord(c) - ord('a'));
+ exit;
+ end;
+ if (c = ' ') then begin
+ result := (ALPHA + LOWER + MIXED + SPACE);
+ exit;
+ end;
+
+ ms := Pos(c,MIXED_SET) - 1;
+ ps := Pos(c,PUNCTUATION_SET) - 1;
+ if (ms < 0) and (ps < 0) then begin
+ result := (ISBYTE + (ord(c) and $ff));
+ exit;
+ end;
+ if (ms = ps) then begin
+ result := (MIXED + PUNCTUATION + ms);
+ exit;
+ end;
+ if (ms >= 0) then begin
+ result := (MIXED + ms);
+ exit;
+ end;
+ result := (PUNCTUATION + ps);
+
+end;
+
+procedure TfrxBarcodePDF417.CalculateErrorCorrection( dest : integer);
+var
+ A : TInt;
+ ALength,e,k,t1,t2,t3, LastE: integer;
+begin
+ if (errorLevel < 0) or ( errorLevel > 8) then
+ errorLevel := 0;
+
+ Alength := 2 shl errorLevel;
+ SetLength(A,Alength);
+ for k := 0 to Alength-1 do
+ A[k] := TInt(ERROR_LEVEL[errorLevel])[k];
+
+ for k := 0 to Alength-1 do
+ codewords[dest + k] := 0;
+ lastE := Alength - 1;
+ for k := 0 to lenCodewords-1 do
+ begin
+ t1 := codewords[k] + codewords[dest];
+ for e := 0 to lastE do
+ begin
+ t2 := (t1 * A[lastE - e]) mod _MOD;
+ t3 := _MOD - t2;
+ if e = LastE then
+ codewords[dest + e] := t3 mod _MOD
+ else
+ codewords[dest + e] := ((codewords[dest + e + 1]) + t3) mod _MOD;
+ end;
+ end;
+ for k := 0 to Alength- 1 do
+ codewords[dest + k] := (_MOD - codewords[dest + k]) mod _MOD;
+
+end;
+
+procedure TfrxBarcodePDF417.OutPaintCode;
+var
+ codePtr, lenBits, rowMod, edge, column, row : integer;
+ cluster : ^integer;
+
+begin
+ codePtr := 0;
+ FWidth := START_CODE_SIZE * (codeColumns + 3) + STOP_SIZE;
+ lenBits := ((FWidth - 1) div 8 + 1) * FHeight;
+ SetLength(FImage, lenBits);
+ FillChar(FImage[0],length(FImage),0);
+ for row := 0 to FHeight-1 do
+ begin
+ bitPtr := ((FWidth - 1) div 8 + 1) * 8 * row;
+ rowMod := row mod 3;
+ cluster := @CLUSTERS[rowMod];
+ OutStartPattern;
+ case (rowMod) of
+ 0: edge := 30 * (row div 3) + ((FHeight - 1) div 3);
+ 1: edge := 30 * (row div 3) + errorLevel * 3 + ((FHeight - 1) mod 3);
+ else
+ edge := 30 * (row div 3) + codeColumns - 1;
+ end;
+
+ OutCodeword(TInt(cluster)[edge]);
+
+ for column := 0 to codeColumns-1 do
+ begin
+ OutCodeword(TInt(cluster)[codewords[codePtr]]);
+ inc(codePtr);
+ end;
+
+ case rowMod of
+ 0: edge := 30 * (row div 3) + codeColumns - 1;
+ 1: edge := 30 * (row div 3) + ((FHeight - 1) div 3);
+ else
+ edge := 30 * (row div 3) + errorLevel * 3 + ((FHeight - 1) mod 3);
+ end;
+
+ OutCodeword(TInt(cluster)[edge]);
+ OutStopPattern;
+ end;
+
+end;
+
+
+procedure TfrxBarcodePDF417.OutStartPattern;
+begin
+ OutCodeword17(START_PATTERN);
+end;
+
+procedure TfrxBarcodePDF417.OutStopPattern;
+begin
+ OutCodeword18(STOP_PATTERN);
+end;
+
+procedure TfrxBarcodePDF417.OutCodeword( codeword : integer );
+begin
+ OutCodeword17(codeword);
+end;
+
+procedure TfrxBarcodePDF417.OutCodeword18( codeword : integer);
+var
+ bytePtr, bit : integer;
+begin
+ bytePtr := bitPtr div 8;
+ bit := bitPtr - bytePtr * 8;
+ FImage[bytePtr] := FImage[bytePtr] or (byte((codeword shr (10 + bit))));
+ inc(bytePtr);
+ FImage[bytePtr] := FImage[bytePtr] or (byte(codeword shr (2 + bit)));
+ inc(bytePtr);
+ codeword := codeword shl 8;
+ FImage[bytePtr] := FImage[bytePtr] or (byte((codeword shr (2 + bit))));
+ if (bit = 7) then
+ begin
+ inc(bytePtr);
+ FImage[bytePtr] := FImage[bytePtr] or $80;
+ end;
+ inc(bitPtr, 18);
+end;
+
+procedure TfrxBarcodePDF417.OutCodeword17( codeword : integer);
+var
+ bytePtr, bit : integer;
+
+begin
+ bytePtr := bitPtr div 8;
+ bit := bitPtr - bytePtr * 8;
+ FImage[bytePtr] := FImage[bytePtr] or ( byte((codeword shr (9 + bit))));
+ inc(bytePtr);
+ FImage[bytePtr] := FImage[bytePtr] or ( byte((codeword shr (1 + bit))));
+ inc(bytePtr);
+ codeword := codeword shl 8;
+ FImage[bytePtr] := FImage[bytePtr] or ( byte((codeword shr (1 + bit))));
+ inc(bitPtr, 17);
+end;
+
+function TfrxBarcodePDF417.GetSegmentLength(var segm : Segment ) : integer;
+begin
+ if (segm = nil) then
+ result := 0
+ else
+ result := segm._end - segm._start;
+end;
+
+function TfrxBarcodePDF417.CheckSegmentType(var segm : Segment; typ : char) : boolean;
+begin
+ if (segm = nil) then
+ result := false
+ else
+ result := segm._type = typ;
+end;
+
+
+
+constructor Segment.Create( _t : char; _s, _e : integer);
+begin
+ _type := _t;
+ _start := _s;
+ _end := _e;
+end;
+
+constructor TSegmentList.Create;
+begin
+ list := TList.Create;
+end;
+
+destructor TSegmentList.Destroy;
+var
+ i: Integer;
+begin
+ for i := 0 to list.Count - 1 do
+ Segment(List[i]).Free;
+ List.Free;
+end;
+
+procedure TSegmentList.Add(_type: char; _start,_end : integer);
+begin
+ list.Add(Segment.Create(_type, _start, _end));
+end;
+
+function TSegmentList.Get(idx : integer) : Segment;
+begin
+ if (idx < 0) or (idx >= list.Count) then
+ result := nil
+ else
+ result := list[idx];
+end;
+procedure TSegmentList.Remove( idx : integer);
+begin
+ if (idx < 0) or (idx >= list.Count) then
+ exit;
+ list.Delete(idx);
+end;
+
+function TSegmentList.Size : integer;
+begin
+ result := list.count;
+end;
+
+end.
+
+
+//16bfbc33f73bd4cb8424198d249c56b6
\ No newline at end of file
diff --git a/LibD28/FMX.frxBarcodeProperties.pas b/LibD28/FMX.frxBarcodeProperties.pas
new file mode 100644
index 0000000..ab38599
--- /dev/null
+++ b/LibD28/FMX.frxBarcodeProperties.pas
@@ -0,0 +1,325 @@
+unit FMX.frxBarcodeProperties;
+
+interface
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Types, FMX.Objects,
+ System.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Menus,
+ FMX.frxClass, FMX.frxdesgn, FMX.frxBarcodePDF417, FMX.frxBarcodeDataMatrix,
+ FMX.frxBarcode2DBase, FMX.DelphiZXingQRCode, FMX.frxBarcodeQR;
+
+type
+
+{$M+}
+ TUniqueProp = class (TPersistent)
+
+ private
+
+ FOnChange: TNotifyEvent;
+
+ public
+ FWhose : TObject;
+ procedure Changed;
+ procedure Assign(Source: TPersistent); override; abstract;
+ procedure SetWhose( w : TObject);
+
+ end;
+
+
+ TPDF417UniqueProperties = class( TUniqueProp )
+
+ private
+
+
+ function GetAspectRatio : Double;
+ function GetColumns : integer;
+ function GetRows : integer;
+ function GetErrorCorrection : PDF417ErrorCorrection;
+ function GetCodePage : integer;
+ function GetCompactionMode : PDF417CompactionMode;
+ function GetPixelWidth : integer;
+ function GetPixelHeight : integer;
+
+ procedure SetAspectRatio(v : Double);
+ procedure SetColumns(v : integer);
+ procedure SetRows(v : integer);
+ procedure SetErrorCorrection(v : PDF417ErrorCorrection);
+ procedure SetCodePage(v : integer);
+ procedure SetCompactionMode(v : PDF417CompactionMode);
+ procedure SetPixelWidth(v : integer);
+ procedure SetPixelHeight(v : integer);
+
+
+ public
+
+ procedure Assign(Source: TPersistent); override;
+
+ published
+
+ property AspectRatio : Double read GetAspectRatio write SetAspectRatio;
+ property Columns : integer read GetColumns write SetColumns;
+ property Rows : integer read GetRows write SetRows;
+ property ErrorCorrection : PDF417ErrorCorrection read GetErrorCorrection write SetErrorCorrection;
+ property CodePage : integer read GetCodePage write SetCodePage;
+ property CompactionMode : PDF417CompactionMode read GetCompactionMode write SetCompactionMode;
+ property PixelWidth : integer read GetPixelWidth write SetPixelWidth;
+ property PixelHeight : integer read GetPixelHeight write SetPixelHeight;
+
+ end;
+
+ TDataMatrixUniqueProperties = class( TUniqueProp )
+
+ private
+
+
+ function GetCodePage : integer;
+ function GetPixelSize : integer;
+ function GetSymbolSize : DatamatrixSymbolSize;
+ function GetEncoding : DatamatrixEncoding;
+
+ procedure SetCodePage(v : integer);
+ procedure SetPixelSize(v : integer);
+ procedure SetSymbolSize(v : DatamatrixSymbolSize);
+ procedure SetEncoding(v : DatamatrixEncoding);
+
+
+ public
+
+ procedure Assign(Source: TPersistent); override;
+
+ published
+
+ property CodePage : integer read GetCodePage write SetCodePage;
+ property PixelSize : integer read GetPixelSize write SetPixelSize;
+ property SymbolSize : DatamatrixSymbolSize read GetSymbolSize write SetSymbolSize;
+ property Encoding : DatamatrixEncoding read GetEncoding write SetEncoding;
+
+ end;
+
+ TfrxQRProperties = class( TUniqueProp )
+ private
+ function GetEncoding: TQRCodeEncoding;
+ function GetQuietZone: Integer;
+ function GetPixelSize : integer;
+ procedure SetPixelSize(v : integer);
+ procedure SetEncoding(const Value: TQRCodeEncoding);
+ procedure SetQuietZone(const Value: Integer);
+ function GetErrorLevels: TQRErrorLevels;
+ procedure SetErrorLevels(const Value: TQRErrorLevels);
+ function GetCodePage: Longint;
+ procedure SetCodePage(const Value: Longint);
+
+ public
+
+ procedure Assign(Source: TPersistent); override;
+
+ published
+
+ property Encoding: TQRCodeEncoding read GetEncoding write SetEncoding;
+ property QuietZone: Integer read GetQuietZone write SetQuietZone;
+ property ErrorLevels: TQRErrorLevels read GetErrorLevels write SetErrorLevels;
+ property PixelSize : integer read GetPixelSize write SetPixelSize;
+ property CodePage : Longint read GetCodePage write SetCodePage;
+
+ end;
+
+implementation
+
+procedure TUniqueProp.SetWhose( w : TObject);
+begin
+ FWhose := w;
+end;
+
+procedure TUniqueProp.Changed;
+begin
+ if @FOnChange <> nil then FOnChange(Self);
+end;
+
+procedure TPDF417UniqueProperties.Assign(Source: TPersistent);
+var
+ src : TPDF417UniqueProperties;
+begin
+ if Source is TPDF417UniqueProperties then
+ begin
+ src := TPDF417UniqueProperties(Source);
+ SetAspectRatio(src.AspectRatio);
+ SetColumns(src.Columns);
+ SetRows(src.Rows);
+ SetErrorCorrection(src.ErrorCorrection);
+ SetCodePage(src.Codepage);
+ SetCompactionMode(src.CompactionMode);
+ SetPixelWidth(src.PixelWidth);
+ SetPixelHeight(src.PixelHeight);
+ SetWhose(src.FWhose);
+ end
+ else
+ inherited;
+end;
+
+function TPDF417UniqueProperties.GetAspectRatio : Double;
+begin
+ result := TfrxBarcodePDF417(FWhose).AspectRatio;
+end;
+function TPDF417UniqueProperties.GetColumns : integer;
+begin
+ result := TfrxBarcodePDF417(FWhose).Columns;
+end;
+function TPDF417UniqueProperties.GetRows : integer;
+begin
+ result := TfrxBarcodePDF417(FWhose).Rows;
+end;
+function TPDF417UniqueProperties.GetErrorCorrection : PDF417ErrorCorrection;
+begin
+ result := TfrxBarcodePDF417(FWhose).ErrorCorrection;
+end;
+function TPDF417UniqueProperties.GetCodePage : integer;
+begin
+ result := TfrxBarcodePDF417(FWhose).CodePage;
+end;
+function TPDF417UniqueProperties.GetCompactionMode : PDF417CompactionMode;
+begin
+ result := TfrxBarcodePDF417(FWhose).CompactionMode;
+end;
+function TPDF417UniqueProperties.GetPixelHeight : integer;
+begin
+ result := TfrxBarcodePDF417(FWhose).PixelHeight;
+end;
+function TPDF417UniqueProperties.GetPixelWidth : integer;
+begin
+ result := TfrxBarcodePDF417(FWhose).PixelWidth;
+end;
+procedure TPDF417UniqueProperties.SetAspectRatio(v : Double);
+begin
+ TfrxBarcodePDF417(FWhose).AspectRatio := v;
+end;
+procedure TPDF417UniqueProperties.SetColumns(v : integer);
+begin
+ TfrxBarcodePDF417(FWhose).Columns := v;
+end;
+procedure TPDF417UniqueProperties.SetRows(v : integer);
+begin
+ TfrxBarcodePDF417(FWhose).Rows := v;
+end;
+procedure TPDF417UniqueProperties.SetErrorCorrection(v : PDF417ErrorCorrection);
+begin
+ TfrxBarcodePDF417(FWhose).ErrorCorrection := v;
+end;
+procedure TPDF417UniqueProperties.SetCodePage(v : integer);
+begin
+ TfrxBarcodePDF417(FWhose).CodePage := v;
+end;
+procedure TPDF417UniqueProperties.SetCompactionMode(v : PDF417CompactionMode);
+begin
+ TfrxBarcodePDF417(FWhose).CompactionMode := v;
+end;
+procedure TPDF417UniqueProperties.SetPixelWidth(v : integer);
+begin
+ TfrxBarcodePDF417(FWhose).PixelWidth := v;
+end;
+procedure TPDF417UniqueProperties.SetPixelHeight(v : integer);
+begin
+ TfrxBarcodePDF417(FWhose).PixelHeight := v;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////
+
+function TDataMatrixUniqueProperties.GetCodePage : integer;begin result := TfrxBarcodeDataMatrix(FWhose).CodePage; end;
+function TDataMatrixUniqueProperties.GetPixelSize : integer;begin result := TfrxBarcodeDataMatrix(FWhose).PixelSize; end;
+function TDataMatrixUniqueProperties.GetSymbolSize : DatamatrixSymbolSize;begin result := TfrxBarcodeDataMatrix(FWhose).SymbolSize; end;
+function TDataMatrixUniqueProperties.GetEncoding : DatamatrixEncoding;begin result := TfrxBarcodeDataMatrix(FWhose).Encoding; end;
+
+procedure TDataMatrixUniqueProperties.SetCodePage(v : integer);begin TfrxBarcodeDataMatrix(FWhose).CodePage := v;end;
+procedure TDataMatrixUniqueProperties.SetPixelSize(v : integer);
+begin
+ if v < 2 then v := 2; TfrxBarcodeDataMatrix(FWhose).PixelSize := v;end;
+procedure TDataMatrixUniqueProperties.SetSymbolSize(v : DatamatrixSymbolSize);begin TfrxBarcodeDataMatrix(FWhose).SymbolSize := v;end;
+procedure TDataMatrixUniqueProperties.SetEncoding(v : DatamatrixEncoding);begin TfrxBarcodeDataMatrix(FWhose).Encoding := v;end;
+
+procedure TDataMatrixUniqueProperties.Assign(Source: TPersistent);
+var
+ src : TDataMatrixUniqueProperties;
+begin
+ if Source is TDataMatrixUniqueProperties then
+ begin
+ src := TDataMatrixUniqueProperties(Source);
+ SetCodePage(src.CodePage);
+ SetPixelSize(src.PixelSize);
+ SetSymbolSize(src.SymbolSize);
+ SetEncoding(src.Encoding);
+ end
+ else
+ inherited;
+end;
+
+
+
+{ TfrxQRProperties }
+
+procedure TfrxQRProperties.Assign(Source: TPersistent);
+var
+ src : TfrxQRProperties;
+begin
+ if Source is TfrxQRProperties then
+ begin
+ src := TfrxQRProperties(Source);
+ SetEncoding(src.Encoding);
+ SetQuietZone(src.QuietZone);
+ SetErrorLevels(src.ErrorLevels);
+ SetCodePage(src.CodePage);
+ end
+ else
+ inherited;
+end;
+
+function TfrxQRProperties.GetCodePage: Longint;
+begin
+ Result := TfrxBarcodeQR(FWhose).Codepage;
+end;
+
+function TfrxQRProperties.GetEncoding: TQRCodeEncoding;
+begin
+ Result := TfrxBarcodeQR(FWhose).Encoding;
+end;
+
+function TfrxQRProperties.GetErrorLevels: TQRErrorLevels;
+begin
+ Result := TfrxBarcodeQR(FWhose).ErrorLevels;
+end;
+
+function TfrxQRProperties.GetQuietZone: Integer;
+begin
+ Result := TfrxBarcodeQR(FWhose).QuietZone;
+end;
+
+procedure TfrxQRProperties.SetCodePage(const Value: Longint);
+begin
+ TfrxBarcodeQR(FWhose).Codepage := Value;
+end;
+
+procedure TfrxQRProperties.SetEncoding(const Value: TQRCodeEncoding);
+begin
+ TfrxBarcodeQR(FWhose).Encoding := Value;
+end;
+
+procedure TfrxQRProperties.SetErrorLevels(const Value: TQRErrorLevels);
+begin
+ TfrxBarcodeQR(FWhose).ErrorLevels := Value;
+end;
+
+procedure TfrxQRProperties.SetQuietZone(const Value: Integer);
+begin
+ TfrxBarcodeQR(FWhose).QuietZone := Value;
+end;
+
+function TfrxQRProperties.GetPixelSize: integer;
+begin
+ result := TfrxBarcodeQR(FWhose).PixelSize;
+end;
+
+procedure TfrxQRProperties.SetPixelSize(v : integer);
+begin
+ if v < 2 then v := 2;
+ TfrxBarcodeQR(FWhose).PixelSize := v;
+end;
+
+end.
diff --git a/LibD28/FMX.frxBarcodeQR.pas b/LibD28/FMX.frxBarcodeQR.pas
new file mode 100644
index 0000000..b0ab659
--- /dev/null
+++ b/LibD28/FMX.frxBarcodeQR.pas
@@ -0,0 +1,171 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ QR code }
+{ }
+{ Copyright (c) 1998-2014 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxBarcodeQR;
+
+
+interface
+
+{$I frx.inc}
+
+uses System.SysUtils, System.Types, System.StrUtils, System.Classes, FMX.Types,
+ System.UITypes, FMX.Objects, FMX.frxBarcode2DBase, FMX.DelphiZXingQRCode;
+
+type
+ TfrxBarcodeQR = class( TfrxBarcode2DBase )
+ private
+ FDelphiZXingQRCode: TDelphiZXingQRCode;
+ procedure Generate();
+ function GetEncoding: TQRCodeEncoding;
+ function GetQuietZone: Integer;
+ procedure SetEncoding(const Value: TQRCodeEncoding);
+ procedure SetQuietZone(const Value: Integer);
+ function GetErrorLevels: TQRErrorLevels;
+ procedure SetErrorLevels(const Value: TQRErrorLevels);
+ function GetPixelSize : integer;
+ procedure SetPixelSize(v : integer);
+ function GetCodepage: Longint;
+ procedure SetCodepage(const Value: Longint);
+ protected
+ procedure SetText( v : string ); override;
+ public
+ constructor Create; override;
+ destructor Destroy; override;
+ procedure Assign(src: TfrxBarcode2DBase);override;
+ published
+ property Encoding: TQRCodeEncoding read GetEncoding write SetEncoding;
+ property QuietZone: Integer read GetQuietZone write SetQuietZone;
+ property ErrorLevels: TQRErrorLevels read GetErrorLevels write SetErrorLevels;
+ property PixelSize : integer read GetPixelSize write SetPixelSize;
+ property Codepage : Longint read GetCodepage write SetCodepage;
+ end;
+
+
+implementation
+
+
+{ TfrxBarcodeQR }
+
+procedure TfrxBarcodeQR.Assign(src: TfrxBarcode2DBase);
+var
+ BSource : TfrxBarcodeQR;
+begin
+ inherited;
+ if src is TfrxBarcodeQR then
+ begin
+ BSource := TfrxBarcodeQR( src );
+ FHeight := BSource.FHeight;
+ Encoding := BSource.Encoding;
+ QuietZone := BSource.QuietZone;
+ ErrorLevels := BSource.ErrorLevels;
+ end;
+end;
+
+constructor TfrxBarcodeQR.Create;
+begin
+ inherited;
+ FDelphiZXingQRCode := TDelphiZXingQRCode.Create;
+ FDelphiZXingQRCode.Data := FText;
+ PixelWidth := 4;
+ PixelHeight := 4;
+ QuietZone := 0;
+ Generate;
+end;
+
+destructor TfrxBarcodeQR.Destroy;
+begin
+ FDelphiZXingQRCode.Free;
+ inherited;
+end;
+
+procedure TfrxBarcodeQR.Generate;
+var
+ stride, x, y, lenBits: Integer;
+begin
+ FHeight := FDelphiZXingQRCode.Rows;
+ FWidth := FDelphiZXingQRCode.Columns;
+ lenBits := ((FWidth - 1) div 8 + 1) * FHeight;
+ SetLength(FImage, lenBits);
+ FillChar(FImage[0],length(FImage),0);
+ stride := (FWidth + 7) div 8;
+
+ for x := 0 to FHeight-1 do
+ begin
+ for y := 0 to FWidth-1 do
+ if FDelphiZXingQRCode.IsBlack[y, x] then
+ FImage[y * stride + x div 8] := FImage[y * stride + x div 8] or ( 128 shr (x and 7) );
+ end;
+end;
+
+function TfrxBarcodeQR.GetCodepage: Longint;
+begin
+ Result := FDelphiZXingQRCode.CodePage;
+end;
+
+function TfrxBarcodeQR.GetEncoding: TQRCodeEncoding;
+begin
+ Result := FDelphiZXingQRCode.Encoding;
+end;
+
+function TfrxBarcodeQR.GetErrorLevels: TQRErrorLevels;
+begin
+ Result := FDelphiZXingQRCode.ErrorLevels;
+end;
+
+function TfrxBarcodeQR.GetQuietZone: Integer;
+begin
+ Result := FDelphiZXingQRCode.QuietZone;
+end;
+
+procedure TfrxBarcodeQR.SetCodepage(const Value: Longint);
+begin
+ FDelphiZXingQRCode.CodePage := Value;
+end;
+
+procedure TfrxBarcodeQR.SetEncoding(const Value: TQRCodeEncoding);
+begin
+ FDelphiZXingQRCode.Encoding := Value;
+ Generate;
+end;
+
+procedure TfrxBarcodeQR.SetErrorLevels(const Value: TQRErrorLevels);
+begin
+ FDelphiZXingQRCode.ErrorLevels := Value;
+ Generate;
+end;
+
+procedure TfrxBarcodeQR.SetQuietZone(const Value: Integer);
+begin
+ FDelphiZXingQRCode.QuietZone := Value;
+ Generate;
+end;
+
+procedure TfrxBarcodeQR.SetText(v: string);
+begin
+ inherited;
+ FDelphiZXingQRCode.Data := v;
+ Generate;
+end;
+
+function TfrxBarcodeQR.GetPixelSize: integer;
+begin
+ result := FPixelWidth;
+end;
+
+procedure TfrxBarcodeQR.SetPixelSize(v : integer);
+begin
+ FPixelWidth := v;
+ FPixelHeight := v;
+end;
+
+
+end.
diff --git a/LibD28/FMX.frxBarcodeRTTI.pas b/LibD28/FMX.frxBarcodeRTTI.pas
new file mode 100644
index 0000000..246119a
--- /dev/null
+++ b/LibD28/FMX.frxBarcodeRTTI.pas
@@ -0,0 +1,57 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Barcode RTTI }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxBarcodeRTTI;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, System.SysUtils, FMX.Forms, FMX.fs_iinterpreter, FMX.frxBarcode,
+ FMX.frxClassRTTI, System.Variants, System.Types;
+
+type
+ TFunctions = class(TfsRTTIModule)
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TfrxBarcodeType', 'bcCode_2_5_interleaved, bcCode_2_5_industrial,' +
+ 'bcCode_2_5_matrix, bcCode39, bcCode39Extended, bcCode128A, bcCode128B,' +
+ 'bcCode128C, bcCode93, bcCode93Extended, bcCodeMSI, bcCodePostNet,' +
+ 'bcCodeCodabar, bcCodeEAN8, bcCodeEAN13, bcCodeUPC_A, bcCodeUPC_E0,' +
+ 'bcCodeUPC_E1, bcCodeUPC_Supp2, bcCodeUPC_Supp5, bcCodeEAN128A,' +
+ 'bcCodeEAN128B, bcCodeEAN128C');
+ AddClass(TfrxBarcodeView, 'TfrxView');
+ end;
+end;
+
+
+initialization
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
+
diff --git a/LibD28/FMX.frxBaseModalForm.pas b/LibD28/FMX.frxBaseModalForm.pas
new file mode 100644
index 0000000..558b6a9
--- /dev/null
+++ b/LibD28/FMX.frxBaseModalForm.pas
@@ -0,0 +1,219 @@
+unit FMX.frxBaseModalForm;
+
+interface
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
+ FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs
+{$IFDEF LINUX}
+ ,FMUX.Api
+{$ENDIF}
+{$IFDEF DELPHI18}
+{$IFDEF MACoS}
+ , Macapi.Foundation, FMX.Platform.Mac, Macapi.AppKit, Macapi.CocoaTypes
+{$ENDIF}
+{$ENDIF};
+{$IFDEF LINUX}
+ const RedHatScaleWidth: Double = 1.17;
+ const RedHatScaleHeight: Double = 1.22;
+
+ function ScaleWidthOrHeightForm(ALength: Integer; Scale : Double): Integer;
+ procedure BorderStyleSizeable(AForm: TForm);
+ function GnomeAndRedHat(): Boolean;
+ function InfoLinux() : TStringList;
+{$ENDIF}
+type
+ TfrxForm = class(TForm)
+ private
+ FSession: Pointer;
+ FFormClosed: Boolean;
+{$IFNDEF DELPHI26}
+{$IFDEF DELPHI18}
+{$IFDEF MACoS}
+ FNSWin: NSWindow;
+ FNSApp: NSApplication;
+{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+ protected
+ procedure DestroyHandle; override;
+{$IFNDEF DELPHI26}
+{$IFDEF DELPHI18}
+ procedure DoClose(var CloseAction: TCloseAction); override;
+{$ENDIF}
+{$ENDIF}
+ public
+ function CloseQuery: Boolean; override;
+ function ShowModal: TModalResult; overload;
+ procedure PeekLastModalResult;
+ procedure BeginSesssion;
+ procedure EndSession;
+ end;
+
+implementation
+
+{$IFDEF LINUX}
+function InfoLinux() : TStringList;
+var
+ FileInfoOSRelese : TFileStream;
+ Bytes : TBytes;
+begin
+ Result := TStringList.Create;
+ FileInfoOSRelese := TFileStream.Create('/usr/lib/os-release', fmOpenRead, fmShareDenyNone);
+ try
+ FileInfoOSRelese.Seek(Int64(0), soFromBeginning);
+ SetLength(Bytes, FileInfoOSRelese.Size);
+ FileInfoOSRelese.Read(Bytes[0], FileInfoOSRelese.Size);
+ Result.CommaText := TEncoding.ASCII.GetString(Bytes);
+ finally
+ FileInfoOSRelese.Free;
+ end;
+end;
+
+function ScaleWidthOrHeightForm(ALength: Integer; Scale : Double): Integer;
+begin
+ Result := Round(ALength * Scale)
+end;
+
+function GnomeAndRedHat: Boolean;
+var InfoLinuxList : TStringList;
+begin
+ InfoLinuxList := InfoLinux;
+ try
+ Result := (SameText(GetEnvironmentVariable('XDG_SESSION_DESKTOP'), 'gnome'))
+ and ((InfoLinuxList.Values['REDHAT_SUPPORT_PRODUCT'] <> '')
+ or (SameText(InfoLinuxList.Values['ID'],'debian')));
+ finally
+ InfoLinuxList.Free;
+ end;
+end;
+
+procedure BorderStyleSizeable(AForm: TForm);
+begin
+ if GnomeAndRedHat then
+ AForm.BorderStyle := TFmxFormBorderStyle.Sizeable;
+end;
+{$ENDIF}
+
+{ TfrxForm }
+
+procedure TfrxForm.BeginSesssion;
+// BUG with modal forms was fixed in 10.3.2 so holding of modal session is not needed
+{$IFNDEF DELPHI26}
+{$IFDEF DELPHI18}
+{$IFDEF MACoS}
+var
+ AutoReleasePool: NSAutoreleasePool;
+{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+begin
+{$IFNDEF DELPHI26}
+{$IFDEF DELPHI18}
+{$IFDEF MACoS}
+{$IFDEF DELPHI19}
+ HandleNeed;
+{$ENDIF}
+ AutoReleasePool := TNSAutoreleasePool.Alloc;
+ try
+ AutoReleasePool.init;
+ FNSApp := TNSApplication.Wrap(TNSApplication.OCClass.sharedApplication);
+ FNSWin := WindowHandleToPlatform(Self.Handle).Wnd;
+ if FNSWin <> nil then
+ begin
+ FNSWin.retain;
+ FSession := FNSApp.beginModalSessionForWindow(FNSWin);
+ end;
+ finally
+ AutoReleasePool.release;
+ end;
+{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+end;
+
+function TfrxForm.CloseQuery: Boolean;
+begin
+{$IFNDEF DELPHI26}
+{$IFDEF DELPHI18}
+{$IFDEF MACoS}
+ Result := True;
+ if FFormClosed then Exit;
+{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+ Result := inherited;
+end;
+
+procedure TfrxForm.DestroyHandle;
+begin
+ inherited;
+ EndSession;
+end;
+
+procedure TfrxForm.EndSession;
+begin
+{$IFNDEF DELPHI26}
+{$IFDEF DELPHI18}
+{$IFDEF MACoS}
+ if (FSession <> nil) and (FNSApp <> nil) then
+ begin
+ FNSApp.runModalSession(FSession);
+ FNSApp.endModalSession(FSession);
+ FNSWin.release;
+ FNSApp := nil;
+ end;
+{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+ FSession := nil;
+end;
+
+{$IFNDEF DELPHI26}
+{$IFDEF DELPHI18}
+procedure TfrxForm.DoClose(var CloseAction: TCloseAction);
+begin
+{$IFDEF MACoS}
+ if FFormClosed then Exit; // skip restart modal session from TPlatformCocoa.ShowWindowModal
+{$ENDIF}
+ inherited;
+{$IFDEF MACoS}
+ if ModalResult <> mrNone then
+ FFormClosed := True;
+ EndSession;
+ Application.HandleMessage;
+{$ENDIF}
+end;
+{$ENDIF}
+{$ENDIF}
+
+procedure TfrxForm.PeekLastModalResult;
+begin
+{$IFNDEF DELPHI26}
+{$IFDEF DELPHI18}
+{$IFDEF MACoS}
+ if (FSession <> nil) and (FNSApp <> nil) then
+ FNSApp.runModalSession(FSession);
+{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+end;
+
+function TfrxForm.ShowModal: TModalResult;
+
+begin
+ BeginSesssion;
+{$IFDEF LINUX}
+ if (BorderStyle = TFmxFormBorderStyle.Single) and GnomeAndRedHat then
+ begin
+ Width := ScaleWidthOrHeightForm(ClientWidth, RedHatScaleWidth);
+ Height := ScaleWidthOrHeightForm(ClientHeight, RedHatScaleHeight);
+ end;
+{$ENDIF}
+ FFormClosed := False;
+ Result := inherited;
+end;
+
+end.
diff --git a/LibD28/FMX.frxCanvas.Linux.pas b/LibD28/FMX.frxCanvas.Linux.pas
new file mode 100644
index 0000000..8c48d52
--- /dev/null
+++ b/LibD28/FMX.frxCanvas.Linux.pas
@@ -0,0 +1,76 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Linux canvas stub classes }
+{ }
+{ Copyright (c) 1998-2021 }
+{ by Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCanvas.Linux;
+
+interface
+{$I fmx.inc}
+{$I frx.inc}
+{$SCOPEDENUMS ON}
+
+uses
+ System.SysUtils, System.Classes, System.Types, System.Math.Vectors, System.UITypes, System.UIConsts, FMX.Types,
+ FMX.Graphics, FMX.TextLayout, FMX.Canvas.Linux;
+
+type
+ TfrxLinuxCanvas = class(TLinuxCanvas)
+ private
+ FPrinter: TObject;
+ protected
+ procedure DoSetMatrix(const M: TMatrix); override;
+ public
+ constructor CreateFromFrxPrinter(const APrinter: TObject);
+ end;
+
+implementation
+
+uses System.Math, FMX.Consts, FMX.frxFMX, FMX.frxPrinter, FMX.frxClass;
+
+
+{ TfrxLinuxCanvas }
+
+constructor TfrxLinuxCanvas.CreateFromFrxPrinter(const APrinter: TObject);
+begin
+ if APrinter is TfrxCustomPrinter then
+ FPrinter := APrinter;
+ inherited CreateFromPrinter(nil);
+end;
+
+procedure TfrxLinuxCanvas.DoSetMatrix(const M: TMatrix);
+var
+ LMatrix: TMatrix;
+ frxPrinter: TfrxCustomPrinter;
+begin
+
+ if FPrinter <> nil then
+ begin
+ { marging converts from MM by using DPI }
+ { scale converts based on PPI = 72 }
+ frxPrinter := TfrxCustomPrinter(FPrinter);
+ if frxPrinter.Orientation = TPrinterOrientation.poLandscape then
+ LMatrix := M * TMatrix.CreateRotation(DegToRad(90)) *
+ TMatrix.CreateTranslation(Height, 0) * TMatrix.CreateTranslation
+ (frxPrinter.LeftMargin * frxPrinter.DPI.X / frxDefDPIUnits,
+ frxPrinter.TopMargin * frxPrinter.DPI.Y / frxDefDPIUnits) * TMatrix.CreateScaling
+ (1 / (frxPrinter.DPI.X / frxDefPPIUnits), 1 / (frxPrinter.DPI.Y / frxDefPPIUnits))
+ else
+ LMatrix := M * TMatrix.CreateTranslation(frxPrinter.LeftMargin * fr01cm *
+ frxPrinter.DPI.X / frxDefDPIUnits, frxPrinter.TopMargin * fr01cm * frxPrinter.DPI.Y
+ / frxDefDPIUnits) * TMatrix.CreateScaling(1 / (frxPrinter.DPI.X / frxDefPPIUnits),
+ 1 / (frxPrinter.DPI.Y / frxDefPPIUnits));
+ end;
+ inherited DoSetMatrix(LMatrix);
+end;
+
+initialization
+ TTextLayoutManager.RegisterTextLayout(TLinuxTextLayout, TfrxLinuxCanvas);
+
+
+end.
diff --git a/LibD28/FMX.frxCanvas.Mac.pas b/LibD28/FMX.frxCanvas.Mac.pas
new file mode 100644
index 0000000..6843e1d
--- /dev/null
+++ b/LibD28/FMX.frxCanvas.Mac.pas
@@ -0,0 +1,166 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.8 }
+{ Canvas for printing bitmap }
+{ when using MetalAPI }
+{ }
+{ Copyright (c) 2021 }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCanvas.Mac;
+
+{$H+}
+
+interface
+
+uses
+ System.Types, System.Math.Vectors, System.UIConsts, System.Classes, System.SysUtils, System.Math, System.UITypes,
+ System.Character, System.Generics.Collections, Macapi.CocoaTypes, Macapi.CoreGraphics, Macapi.CoreFoundation,
+ Macapi.ImageIO, Macapi.CoreText, Macapi.Helpers, FMX.Types, FMX.Platform, FMX.Printer, FMX.Printer.Mac, FMX.Consts,
+ FMX.Forms, FMX.TextLayout, FMX.Surfaces, FMX.Graphics, FMX.Canvas.Mac;
+
+type
+
+ TfrxCanvasQuartz = class(TCanvasQuartz)
+ protected
+ procedure DoDrawBitmap(const ABitmap: TBitmap; const SrcRect, DstRect: TRectF;
+ const AOpacity: Single; const HighSpeed: Boolean = False); override;
+ public
+ constructor CreateFromPrinter(const APrinter: TAbstractPrinter); override;
+ end;
+
+implementation
+
+uses
+ Macapi.PrintCore;
+ var
+ GlobalColorSpace: CGColorSpaceRef;
+
+function ColorSpace: CGColorSpaceRef;
+begin
+ if GlobalColorSpace = nil then
+ GlobalColorSpace := CGColorSpaceCreateDeviceRGB;
+ Result := GlobalColorSpace;
+end;
+
+constructor TfrxCanvasQuartz.CreateFromPrinter(
+ const APrinter: TAbstractPrinter);
+begin
+ inherited;
+end;
+
+{ TfrxCanvasQuartz }
+
+procedure TfrxCanvasQuartz.DoDrawBitmap(const ABitmap: TBitmap;
+ const SrcRect, DstRect: TRectF; const AOpacity: Single;
+ const HighSpeed: Boolean);
+var
+ B: TObject;
+ pData, LContext: Pointer;
+ NewDestRect, SubRect: CGRect;
+ ImageRef, SubImageRef: CGImageRef;
+ Surf: TBitmapSurface;
+begin
+ if (Context = nil) or (ABitmap = nil) then Exit;
+ if ABitmap.HandleAllocated then
+ begin
+ B := TObject(ABitmap.Handle);
+ if (B is TQuartzBitmap) then
+ inherited DoDrawBitmap(ABitmap, SrcRect, DstRect, AOpacity, HighSpeed)
+ else
+ begin
+ Surf := TBitmapSurface.Create;
+ try
+ Surf.Assign(ABitmap);
+
+ if Surf.PixelFormat = TPixelFormat.RGBA then
+ LContext := CGBitmapContextCreate(Surf.Bits, Surf.Width, Surf.Height,
+ 8, Surf.Pitch, ColorSpace, kCGImageAlphaPremultipliedLast)
+ else
+ begin
+ LContext := CGBitmapContextCreate(nil, Surf.Width, Surf.Height, 8,
+ Surf.Pitch, ColorSpace, kCGImageAlphaPremultipliedLast);
+ pData := CGBitmapContextGetData(LContext);
+ ChangePixelFormat(Surf.Bits, pData, Surf.Width * Surf.Height,
+ Surf.PixelFormat, TPixelFormat.RGBA);
+ end;
+
+ if LContext <> nil then
+ begin
+ ImageRef := CGBitmapContextCreateImage(LContext);
+ if ImageRef <> nil then
+ try
+
+ NewDestRect := CGRectFromRect(DstRect);
+
+ if (SrcRect.Left = 0) and (SrcRect.Top = 0) and
+ (SrcRect.Right = ABitmap.Width) and
+ (SrcRect.Bottom = ABitmap.Height) then
+ begin
+ CGContextSaveGState(Context);
+ CGContextSetAlpha(Context, AOpacity);
+
+ if HighSpeed then
+ CGContextSetInterpolationQuality(Context,
+ kCGInterpolationNone)
+ else
+ CGContextSetInterpolationQuality(Context,
+ kCGInterpolationDefault);
+
+ NewDestRect.origin.y := -DstRect.Bottom;
+ CGContextScaleCTM(Context, 1, -1);
+
+ CGContextSetAllowsAntialiasing(Context, False);
+ CGContextDrawImage(Context, NewDestRect, ImageRef);
+ CGContextSetAllowsAntialiasing(Context, True);
+
+ CGContextRestoreGState(Context);
+ end
+ else
+ begin
+ SubRect := CGRectFromRect(SrcRect);
+
+ SubImageRef := CGImageCreateWithImageInRect(ImageRef, SubRect);
+ if SubImageRef <> nil then
+ begin
+ CGContextSaveGState(Context);
+ CGContextSetAlpha(Context, AOpacity);
+
+ if HighSpeed then
+ CGContextSetInterpolationQuality(Context,
+ kCGInterpolationNone)
+ else
+ CGContextSetInterpolationQuality(Context,
+ kCGInterpolationDefault);
+
+ NewDestRect.origin.y := -DstRect.Bottom;
+ CGContextScaleCTM(Context, 1, -1);
+
+ CGContextDrawImage(Context, NewDestRect, SubImageRef);
+ CGImageRelease(SubImageRef);
+
+ CGContextRestoreGState(Context);
+ end;
+ end;
+
+ finally
+ if ImageRef <> nil then
+ CGImageRelease(ImageRef);
+ if LContext <> nil then
+ CGContextRelease(LContext);
+ end;
+ end;
+ finally
+ Surf.Free;
+ end;
+ end;
+ end;
+end;
+
+initialization
+ TTextLayoutManager.RegisterTextLayout(TTextLayoutCT, TfrxCanvasQuartz);
+finalization
+
+end.
diff --git a/LibD28/FMX.frxChBox.pas b/LibD28/FMX.frxChBox.pas
new file mode 100644
index 0000000..12c8dec
--- /dev/null
+++ b/LibD28/FMX.frxChBox.pas
@@ -0,0 +1,249 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Checkbox Add-In Object }
+{ }
+{ Copyright (c) 1998-2014 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxChBox;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.Types, System.SysUtils, System.Classes, FMX.Objects, FMX.Controls, FMX.frxClass,
+ FMX.Types, FMX.TabControl, System.UIConsts, System.UITypes, System.Variants
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+ TfrxCheckStyle = (csCross, csCheck, csLineCross, csPlus);
+ TfrxUncheckStyle = (usEmpty, usCross, usLineCross, usMinus);
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxCheckBoxObject = class(TComponent) // fake component
+ end;
+
+ TfrxCheckBoxView = class(TfrxView)
+ private
+ FCheckColor: TAlphaColor;
+ FChecked: Boolean;
+ FCheckStyle: TfrxCheckStyle;
+ FUncheckStyle: TfrxUncheckStyle;
+ FExpression: String;
+ procedure DrawCheck(ARect: TRectF);
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ procedure GetData; override;
+ class function GetDescription: String; override;
+ published
+ property BrushStyle;
+ property CheckColor: TAlphaColor read FCheckColor write FCheckColor default claBlack;
+ property Checked: Boolean read FChecked write FChecked default True;
+ property CheckStyle: TfrxCheckStyle read FCheckStyle write FCheckStyle;
+ property Color;
+ property Cursor;
+ property DataField;
+ property DataSet;
+ property DataSetName;
+ property Expression: String read FExpression write FExpression;
+ property Frame;
+ property TagStr;
+ property UncheckStyle: TfrxUncheckStyle read FUncheckStyle write FUncheckStyle default usEmpty;
+ property URL;
+ end;
+
+implementation
+
+uses FMX.frxChBoxRTTI, FMX.frxDsgnIntf, FMX.frxRes;
+
+
+constructor TfrxCheckBoxView.Create(AOwner: TComponent);
+begin
+ inherited;
+ FChecked := True;
+ Height := fr01cm * 5;
+ Width := fr01cm * 5;
+ FCheckColor := claBlack;
+end;
+
+class function TfrxCheckBoxView.GetDescription: String;
+begin
+ Result := frxResources.Get('obChBox');
+end;
+
+procedure TfrxCheckBoxView.DrawCheck(ARect: TRectF);
+var
+ minVal, dx, dy: Double;
+begin
+ with FCanvas, ARect do
+ if FChecked then
+ begin
+ if FCheckStyle = csCheck then
+ begin
+ FCanvas.Stroke.Kind := TBrushKind.bkSolid;
+{$IFDEF Delphi25}
+ FCanvas.Stroke.Cap := TStrokeCap.scRound;
+{$ELSE}
+ FCanvas.StrokeCap := TStrokeCap.scRound;
+{$ENDIF}
+ FCanvas.Stroke.Color := FCheckColor;
+ minVal := (Bottom - Top);
+ if (minVal > (Right - Left)) then
+ minVal := (Right - Left);
+{$IFDEF Delphi25}
+ FCanvas.Stroke.Thickness := minVal/ 6;
+{$ELSE}
+ FCanvas.StrokeThickness := minVal/ 6;
+{$ENDIF}
+ dx := (Right - Left) / 2;
+ dy := (Bottom - Top) / 2;
+ DrawLine( PointF(Left + (dx - minVal / 4 + minVal / 20), Top + (dy + minVal / 6)), PointF(Right - (dx ), Bottom - minVal / 6 ), 1);
+ DrawLine( PointF(Left + dx, Bottom - minVal / 6), PointF(Right - (dx - minVal / 3), Top + (dy - minVal / 5)), 1);
+ end
+ else if FCheckStyle = csCross then
+ begin
+ FCanvas.Stroke.Kind := TBrushKind.bkSolid;
+{$IFDEF Delphi25}
+ FCanvas.Stroke.Cap := TStrokeCap.scRound;
+{$ELSE}
+ FCanvas.StrokeCap := TStrokeCap.scRound;
+{$ENDIF}
+ FCanvas.Stroke.Color := FCheckColor;
+ minVal := (Bottom - Top);
+ if (minVal > (Right - Left)) then
+ minVal := (Right - Left);
+{$IFDEF Delphi25}
+ FCanvas.Stroke.Thickness := minVal/ 6;
+{$ELSE}
+ FCanvas.StrokeThickness := minVal/ 6;
+{$ENDIF}
+ dx := (Right - Left) / 2;
+ dy := (Bottom - Top) / 2;
+ DrawLine( PointF(Left + (dx - minVal / 4 + minVal / 20), Top + (dy - minVal / 4)), PointF(Right - (dx - minVal / 4), Bottom - (dy - minVal / 4 )), 1);
+ DrawLine( PointF(Left + (dx - minVal / 4 + minVal / 16), Bottom - (dy - minVal / 4)), PointF(Right - (dx - minVal / 4), Top + (dy - minVal / 4)), 1);
+ end
+ else if FCheckStyle = csLineCross then
+ begin
+ FCanvas.Stroke.Kind := TBrushKind.bkSolid;
+ FCanvas.Stroke.Color := FCheckColor;
+{$IFDEF Delphi25}
+ FCanvas.Stroke.Thickness := FFrameWidth;
+{$ELSE}
+ FCanvas.StrokeThickness := FFrameWidth;
+{$ENDIF}
+
+ DrawLine( PointF(Left, Top), PointF(Right, Bottom), 1);
+ DrawLine( PointF(Left, Bottom), PointF(Right, Top), 1);
+ end
+ else if FCheckStyle = csPlus then
+ begin
+ FCanvas.Stroke.Kind := TBrushKind.bkSolid;
+ FCanvas.Stroke.Color := FCheckColor;
+{$IFDEF Delphi25}
+ FCanvas.Stroke.Thickness := FFrameWidth;
+{$ELSE}
+ FCanvas.StrokeThickness := FFrameWidth;
+{$ENDIF}
+ DrawLine( PointF(Left + 3, Top + (Bottom - Top) / 2), PointF(Right - 2, Top + (Bottom - Top) / 2), 1);
+ DrawLine( PointF(Left + (Right - Left) / 2, Top + 3), PointF(Left + (Right - Left) / 2, Bottom - 2), 1);
+ end
+ end
+ else
+ begin
+ if FUncheckStyle = usCross then
+ begin
+ FCanvas.Stroke.Kind := TBrushKind.bkSolid;
+{$IFDEF Delphi25}
+ FCanvas.Stroke.Cap := TStrokeCap.scRound;
+{$ELSE}
+ FCanvas.StrokeCap := TStrokeCap.scRound;
+{$ENDIF}
+ FCanvas.Stroke.Color := FCheckColor;
+ minVal := (Bottom - Top);
+ if (minVal > (Right - Left)) then
+ minVal := (Right - Left);
+{$IFDEF Delphi25}
+ FCanvas.Stroke.Thickness := minVal/ 6;
+{$ELSE}
+ FCanvas.StrokeThickness := minVal/ 6;
+{$ENDIF}
+ dx := (Right - Left) / 2;
+ dy := (Bottom - Top) / 2;
+ DrawLine( PointF(Left + (dx - minVal / 4 + minVal / 20), Top + (dy - minVal / 4)), PointF(Right - (dx - minVal / 4), Bottom - (dy - minVal / 4 )), 1);
+ DrawLine( PointF(Left + (dx - minVal / 4 + minVal / 16), Bottom - (dy - minVal / 4)), PointF(Right - (dx - minVal / 4), Top + (dy - minVal / 4)), 1);
+ end
+ else if FUncheckStyle = usLineCross then
+ begin
+ FCanvas.Stroke.Kind := TBrushKind.bkSolid;
+ FCanvas.Stroke.Color := FCheckColor;
+{$IFDEF Delphi25}
+ FCanvas.Stroke.Thickness := FFrameWidth;
+{$ELSE}
+ FCanvas.StrokeThickness := FFrameWidth;
+{$ENDIF}
+
+ DrawLine( PointF(Left, Top), PointF(Right, Bottom), 1);
+ DrawLine( PointF(Left, Bottom), PointF(Right, Top), 1);
+
+ end
+ else if FUncheckStyle = usMinus then
+ begin
+ FCanvas.Stroke.Kind := TBrushKind.bkSolid;
+ FCanvas.Stroke.Color := FCheckColor;
+ DrawLine(PointF(Left + 3, Top + (Bottom - Top) / 2), PointF(Right - 2, Top + (Bottom - Top) / 2), 1);
+ end
+ end;
+end;
+
+procedure TfrxCheckBoxView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+begin
+ BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+
+ DrawBackground;
+ DrawCheck(RectF(FX, FY, FX1, FY1));
+ DrawFrame;
+end;
+
+procedure TfrxCheckBoxView.GetData;
+var
+ v: Variant;
+begin
+ inherited;
+ if IsDataField then
+ begin
+ v := DataSet.Value[DataField];
+ if v = Null then
+ v := False;
+ FChecked := v;
+ end
+ else if FExpression <> '' then
+ FChecked := Report.Calc(FExpression);
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxCheckBoxObject, TFmxObject);
+ frxObjects.RegisterObject1(TfrxCheckBoxView, nil, '', '', 0, 116);
+
+finalization
+ frxObjects.UnRegister(TfrxCheckBoxView);
+
+
+end.
diff --git a/LibD28/FMX.frxChBoxRTTI.pas b/LibD28/FMX.frxChBoxRTTI.pas
new file mode 100644
index 0000000..90a656c
--- /dev/null
+++ b/LibD28/FMX.frxChBoxRTTI.pas
@@ -0,0 +1,53 @@
+
+{******************************************}
+{ }
+{ FastReport v2.0 }
+{ CheckBox RTTI }
+{ }
+{ Copyright (c) 1998-2014 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxChBoxRTTI;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, System.Types, System.SysUtils, FMX.Forms, FMX.fs_iinterpreter, FMX.frxChBox, FMX.frxClassRTTI, System.Variants;
+
+
+type
+ TFunctions = class(TfsRTTIModule)
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TfrxCheckStyle', 'csCross, csCheck, csLineCross, csPlus');
+ AddEnum('TfrxUncheckStyle', 'usEmpty, usCross, usLineCross, usMinus');
+ AddClass(TfrxCheckBoxView, 'TfrxView');
+ end;
+end;
+
+
+initialization
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
+
diff --git a/LibD28/FMX.frxChart.pas b/LibD28/FMX.frxChart.pas
new file mode 100644
index 0000000..59afbf3
--- /dev/null
+++ b/LibD28/FMX.frxChart.pas
@@ -0,0 +1,786 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ TeeChart Add-In Object }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxChart;
+
+interface
+
+{$I frx.inc}
+{$I tee.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.Types, FMX.Types, FMX.Menus, FMX.Controls,
+ FMX.frxClass, System.UIConsts,
+ FMXTee.Procs, FMXTee.Engine, FMXTee.Chart, FMXTee.Series, FMXTee.Canvas
+, System.Variants
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+ , FMX.frxFMX
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF};
+
+
+type
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxChartObject = class(TComponent); // fake component
+ TChartClass = class of TCustomChart;
+
+ TfrxSeriesDataType = (dtDBData, dtBandData, dtFixedData);
+ TfrxSeriesSortOrder = (soNone, soAscending, soDescending);
+ TfrxSeriesXType = (xtText, xtNumber, xtDate);
+ TSeriesClass = class of TChartSeries;
+ TfrxChartSeries = (csLine, csArea, csPoint, csBar, csHorizBar,
+ csPie, csGantt, csFastLine, csArrow, csBubble, csChartShape, csHorizArea,
+ csHorizLine, csPolar, csRadar, csPolarBar, csGauge, csSmith, csPyramid,
+ csDonut, csBezier, csCandle, csVolume, csPointFigure, csHistogram,
+ csHorizHistogram, csErrorBar, csError, csHighLow, csFunnel, csBox,
+ csHorizBox, csSurface, csContour, csWaterFall, csColorGrid, csVector3D,
+ csTower, csTriSurface, csPoint3D, csBubble3D, csMyPoint, csBarJoin, csBar3D);
+
+
+
+ TfrxSeriesItem = class(TCollectionItem)
+ private
+ FDataBand: TfrxDataBand;
+ FDataSet: TfrxDataSet;
+ FDataSetName: String;
+ FDataType: TfrxSeriesDataType;
+ FSortOrder: TfrxSeriesSortOrder;
+ FTopN: Integer;
+ FTopNCaption: String;
+ FSource1: String;
+ FSource2: String;
+ FSource3: String;
+ FSource4: String;
+ FSource5: String;
+ FSource6: String;
+ FXType: TfrxSeriesXType;
+ FValues1: String;
+ FValues2: String;
+ FValues3: String;
+ FValues4: String;
+ FValues5: String;
+ FValues6: String;
+ FIsDataChanged: Boolean;
+ procedure FillSeries(Series: TChartSeries);
+ procedure SetDataSet(const Value: TfrxDataSet);
+ procedure SetDataSetName(const Value: String);
+ function GetDataSetName: String;
+ procedure SetValues1(const Value: String);
+ procedure SetValues2(const Value: String);
+ procedure SetValues3(const Value: String);
+ procedure SetValues4(const Value: String);
+ procedure SetValues5(const Value: String);
+ procedure SetValues6(const Value: String);
+ published
+ property DataType: TfrxSeriesDataType read FDataType write FDataType;
+ property DataBand: TfrxDataBand read FDataBand write FDataBand;
+ property DataSet: TfrxDataSet read FDataSet write SetDataSet;
+ property DataSetName: String read GetDataSetName write SetDataSetName;
+ property SortOrder: TfrxSeriesSortOrder read FSortOrder write FSortOrder;
+ property TopN: Integer read FTopN write FTopN;
+ property TopNCaption: String read FTopNCaption write FTopNCaption;
+ property XType: TfrxSeriesXType read FXType write FXType;
+
+ { source expressions }
+ property Source1: String read FSource1 write FSource1;
+ property Source2: String read FSource2 write FSource2;
+ property Source3: String read FSource3 write FSource3;
+ property Source4: String read FSource4 write FSource4;
+ property Source5: String read FSource5 write FSource5;
+ property Source6: String read FSource6 write FSource6;
+
+ { ready values. For internal use only. }
+ property Values1: String read FValues1 write SetValues1;
+ property Values2: String read FValues2 write SetValues2;
+ property Values3: String read FValues3 write SetValues3;
+ property Values4: String read FValues4 write SetValues4;
+ property Values5: String read FValues5 write SetValues5;
+ property Values6: String read FValues6 write SetValues6;
+
+ { backward compatibility }
+ property XSource: String read FSource1 write FSource1;
+ property YSource: String read FSource2 write FSource2;
+ property XValues: String read FValues1 write SetValues1;
+ property YValues: String read FValues2 write SetValues2;
+ end;
+
+ TfrxSeriesData = class(TCollection)
+ private
+ FReport: TfrxReport;
+ function GetSeries(Index: Integer): TfrxSeriesItem;
+ public
+ constructor Create(Report: TfrxReport);
+ function Add: TfrxSeriesItem;
+ property Items[Index: Integer]: TfrxSeriesItem read GetSeries; default;
+ end;
+
+ TfrxChartView = class(TfrxView)
+ private
+ FChart: TCustomChart;
+ FSeriesData: TfrxSeriesData;
+ FIgnoreNulls: Boolean;
+ FNormalSize: TBitmap;
+ FBigSize: TBitmap;
+ procedure FillChart;
+ procedure ReadData(Stream: TStream);
+ procedure ReadData1(Reader: TReader);
+ procedure ReadData2(Reader: TReader);
+ procedure WriteData(Stream: TStream);
+ procedure WriteData1(Writer: TWriter);
+ procedure WriteData2(Writer: TWriter);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure CreateChart; virtual;
+ class function GetChartClass: TChartClass; virtual;
+ procedure SetWidth(Value: Double); override;
+ procedure SetHeight(Value: Double); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ procedure AfterPrint; override;
+ procedure GetData; override;
+ procedure BeforeStartReport; override;
+ procedure OnNotify(Sender: TObject); override;
+ procedure ClearSeries;
+ procedure AddSeries(Series: TfrxChartSeries);
+
+ property Chart: TCustomChart read FChart;
+ property SeriesData: TfrxSeriesData read FSeriesData;
+ published
+ property IgnoreNulls: Boolean read FIgnoreNulls write FIgnoreNulls default False;
+// property BrushStyle;
+ property Color;
+ property Cursor;
+ property Frame;
+ property TagStr;
+ property URL;
+ end;
+
+
+implementation
+
+uses
+ FMX.frxChartHelpers, FMX.frxChartRTTI,
+{$IFNDEF NO_EDITORS}
+ FMX.frxChartEditor,
+{$ENDIF}
+ FMX.frxDsgnIntf, FMX.frxUtils, FMX.frxRes, System.Math;
+
+
+{ TfrxSeriesItem }
+
+procedure TfrxSeriesItem.SetDataSet(const Value: TfrxDataSet);
+begin
+ FDataSet := Value;
+ if FDataSet = nil then
+ FDataSetName := '' else
+ FDataSetName := FDataSet.UserName;
+end;
+
+procedure TfrxSeriesItem.SetDataSetName(const Value: String);
+begin
+ FDataSetName := Value;
+ if FDataSetName = '' then
+ FDataSet := nil
+ else if TfrxSeriesData(Collection).FReport <> nil then
+ FDataSet := TfrxSeriesData(Collection).FReport.FindDataSet(FDataSet, FDataSetName);
+end;
+
+procedure TfrxSeriesItem.SetValues1(const Value: String);
+begin
+ FValues1 := Value;
+ FIsDataChanged := True;
+end;
+
+procedure TfrxSeriesItem.SetValues2(const Value: String);
+begin
+ FValues2 := Value;
+ FIsDataChanged := True;
+end;
+
+procedure TfrxSeriesItem.SetValues3(const Value: String);
+begin
+ FValues3 := Value;
+ FIsDataChanged := True;
+end;
+
+procedure TfrxSeriesItem.SetValues4(const Value: String);
+begin
+ FValues4 := Value;
+ FIsDataChanged := True;
+end;
+
+procedure TfrxSeriesItem.SetValues5(const Value: String);
+begin
+ FValues5 := Value;
+ FIsDataChanged := True;
+end;
+
+procedure TfrxSeriesItem.SetValues6(const Value: String);
+begin
+ FValues6 := Value;
+ FIsDataChanged := True;
+end;
+
+function TfrxSeriesItem.GetDataSetName: String;
+begin
+ if FDataSet = nil then
+ Result := FDataSetName else
+ Result := FDataSet.UserName;
+end;
+
+procedure TfrxSeriesItem.FillSeries(Series: TChartSeries);
+var
+ i: Integer;
+ sl1, sl2, sl3, sl4, sl5, sl6: TStringList;
+ v1, v2, v3, v4, v5, v6: String;
+ Helper: TfrxSeriesHelper;
+
+ procedure Sort;
+ var
+ i, idx, iStart, SortOrd: Integer;
+ d, mMax: Double;
+ s: String;
+ begin
+ if sl1.Count <> sl2.Count then exit;
+
+ {bug fix, stringList sort all negative values as string }
+ if FSortOrder = soAscending then SortOrd := 1
+ else SortOrd := -1;
+ iStart := 0;
+
+ while sl2.Count > iStart do
+ begin
+ idx := 0;
+ mMax := MaxDouble * SortOrd;
+ for i := iStart to sl2.Count - 1 do
+ begin
+ s := sl2[i];
+ if not frxIsValidFloat(s) then d := 0
+ else d := frxStrToFloat(s);
+ if d * SortOrd < mMax * SortOrd then
+ begin
+ mMax := d;
+ idx := i;
+ end;
+ end;
+ sl1.Move(idx,iStart);
+ sl2.Move(idx,iStart);
+ if idx < sl3.Count then sl3.Move(idx, iStart);
+ if idx < sl4.Count then sl4.Move(idx, iStart);
+ if idx < sl5.Count then sl5.Move(idx, iStart);
+ if idx < sl6.Count then sl6.Move(idx, iStart);
+ inc(iStart);
+ end;
+ end;
+
+ procedure MakeTopN;
+ var
+ i: Integer;
+ d: Double;
+ begin
+ if sl1.Count <> sl2.Count then exit;
+ { for future using
+ if FSortOrder <> soNone then Sort;}
+
+ FSortOrder := soDescending;
+ Sort;
+ d := 0;
+ for i := sl2.Count - 1 downto FTopN - 1 do
+ begin
+ d := d + frxStrToFloat(sl2[i]);
+ sl1.Delete(i);
+ sl2.Delete(i);
+ if i < sl3.Count then sl3.Delete(i);
+ if i < sl4.Count then sl4.Delete(i);
+ if i < sl5.Count then sl5.Delete(i);
+ if i < sl6.Count then sl6.Delete(i);
+ end;
+
+ sl1.Add(FTopNCaption);
+ sl2.Add(FloatToStr(d));
+ end;
+
+begin
+ sl1 := TStringList.Create;
+ sl2 := TStringList.Create;
+ sl3 := TStringList.Create;
+ sl4 := TStringList.Create;
+ sl5 := TStringList.Create;
+ sl6 := TStringList.Create;
+ Series.Clear;
+
+ v1 := FValues1;
+ if (v1 <> '') and (v1[1] = ';') then
+ Delete(v1, 1, 1);
+ v2 := FValues2;
+ if (v2 <> '') and (v2[1] = ';') then
+ Delete(v2, 1, 1);
+ v3 := FValues3;
+ if (v3 <> '') and (v3[1] = ';') then
+ Delete(v3, 1, 1);
+ v4 := FValues4;
+ if (v4 <> '') and (v4[1] = ';') then
+ Delete(v4, 1, 1);
+ v5 := FValues5;
+ if (v5 <> '') and (v5[1] = ';') then
+ Delete(v5, 1, 1);
+ v6 := FValues6;
+ if (v6 <> '') and (v6[1] = ';') then
+ Delete(v6, 1, 1);
+
+ frxSetCommaText(v1, sl1);
+ frxSetCommaText(v2, sl2);
+ frxSetCommaText(v3, sl3);
+ frxSetCommaText(v4, sl4);
+ frxSetCommaText(v5, sl5);
+ frxSetCommaText(v6, sl6);
+
+ Helper := frxFindSeriesHelper(Series);
+
+ try
+ if sl2.Count > 0 then
+ begin
+ if (FTopN > 0) and (FTopN < sl2.Count) then
+ MakeTopN
+ else if FSortOrder <> soNone then
+ Sort;
+
+ for i := 0 to sl2.Count - 1 do
+ begin
+ if i < sl1.Count then v1 := sl1[i] else v1 := '';
+ if i < sl2.Count then v2 := sl2[i] else v2 := '';
+ if i < sl3.Count then v3 := sl3[i] else v3 := '';
+ if i < sl4.Count then v4 := sl4[i] else v4 := '';
+ if i < sl5.Count then v5 := sl5[i] else v5 := '';
+ if i < sl6.Count then v6 := sl6[i] else v6 := '';
+ Helper.AddValues(Series, v1, v2, v3, v4, v5, v6, FXType);
+ end;
+ end;
+
+ finally
+ Helper.Free;
+ sl1.Free;
+ sl2.Free;
+ sl3.Free;
+ sl4.Free;
+ sl5.Free;
+ sl6.Free;
+ end;
+end;
+
+
+{ TfrxSeriesData }
+
+constructor TfrxSeriesData.Create(Report: TfrxReport);
+begin
+ inherited Create(TfrxSeriesItem);
+ FReport := Report;
+end;
+
+function TfrxSeriesData.Add: TfrxSeriesItem;
+begin
+ Result := TfrxSeriesItem(inherited Add);
+end;
+
+function TfrxSeriesData.GetSeries(Index: Integer): TfrxSeriesItem;
+begin
+ Result := TfrxSeriesItem(inherited Items[Index]);
+end;
+
+
+{ TfrxChartView }
+
+constructor TfrxChartView.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ CreateChart;
+ FNormalSize := TBitmap.Create(0, 0);
+ FBigSize := TBitmap.Create(0, 0);
+ FSeriesData := TfrxSeriesData.Create(Report);
+end;
+
+destructor TfrxChartView.Destroy;
+begin
+ FChart.Free;
+ FNormalSize.Free;
+ FBigSize.Free;
+ inherited Destroy;
+ FSeriesData.Free;
+end;
+
+class function TfrxChartView.GetDescription: String;
+begin
+ Result := frxResources.Get('obChart');
+end;
+
+procedure TfrxChartView.Notification(AComponent: TComponent; Operation: TOperation);
+var
+ i: Integer;
+begin
+ inherited;
+ if Operation = opRemove then
+ begin
+ for i := 0 to FSeriesData.Count - 1 do
+ if AComponent is TfrxDataSet then
+ begin
+ if FSeriesData[i].DataSet = AComponent then
+ FSeriesData[i].DataSet := nil;
+ end
+ else if AComponent is TfrxBand then
+ begin
+ if FSeriesData[i].DataBand = AComponent then
+ FSeriesData[i].DataBand := nil;
+ end;
+ end;
+end;
+
+class function TfrxChartView.GetChartClass: TChartClass;
+begin
+ Result := TChart;
+end;
+
+procedure TfrxChartView.CreateChart;
+begin
+ FChart := GetChartClass.Create(Self);
+ with FChart do
+ begin
+ Color := claWhite;
+ BevelInner := bvNone;
+ BevelOuter := bvNone;
+ Name := 'Chart';
+ Frame.Visible := False;
+ View3DOptions.Rotation := 0;
+ Title.Text.Text := '';
+ end;
+end;
+
+procedure TfrxChartView.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ Filer.DefineBinaryProperty('Chart', ReadData, WriteData, True);
+ Filer.DefineProperty('ChartElevation', ReadData1, WriteData1, True);
+ Filer.DefineProperty('SeriesData', ReadData2, WriteData2, True);
+end;
+
+procedure TfrxChartView.ReadData(Stream: TStream);
+begin
+ FChart.Free;
+ CreateChart;
+ Stream.ReadComponent(FChart);
+end;
+
+procedure TfrxChartView.WriteData(Stream: TStream);
+begin
+ Stream.WriteComponent(FChart);
+end;
+
+procedure TfrxChartView.ReadData1(Reader: TReader);
+begin
+ FChart.View3DOptions.Elevation := Reader.ReadInteger;
+end;
+
+procedure TfrxChartView.WriteData1(Writer: TWriter);
+begin
+ Writer.WriteInteger(FChart.View3DOptions.Elevation);
+end;
+
+procedure TfrxChartView.ReadData2(Reader: TReader);
+begin
+ frxReadCollection(FSeriesData, Reader, Self);
+end;
+
+procedure TfrxChartView.SetHeight(Value: Double);
+begin
+ inherited;
+ if FSeriesData.Count > 0 then
+ FSeriesData[0].FIsDataChanged := True;
+end;
+
+procedure TfrxChartView.SetWidth(Value: Double);
+begin
+ inherited;
+ if FSeriesData.Count > 0 then
+ FSeriesData[0].FIsDataChanged := True;
+end;
+
+procedure TfrxChartView.WriteData2(Writer: TWriter);
+begin
+ frxWriteCollection(FSeriesData, Writer, Self);
+end;
+
+procedure TfrxChartView.FillChart;
+var
+ i: Integer;
+begin
+ for i := 0 to FSeriesData.Count - 1 do
+ FSeriesData[i].FillSeries(FChart.Series[i]);
+end;
+
+procedure TfrxChartView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+var
+{$IFNDEF MSWINDOWS}
+ i: Integer;
+ IsDataChanged: Boolean;
+{$ELSE}
+ OffsetM, ScaleM: TMatrix;
+ state: TCanvasSaveState;
+ OldM: TMatrix;
+ MetaF: TBitmap;
+{$ENDIF}
+begin
+ BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+ DrawBackground;
+{$IFNDEF MSWINDOWS}
+ IsDataChanged := False;
+ for i := 0 to FSeriesData.Count - 1 do
+ begin
+ IsDataChanged := FSeriesData[i].FIsDataChanged;
+ FSeriesData[i].FIsDataChanged := False;
+ end;
+
+ if IsDataChanged then
+ begin
+ FillChart;
+ if Color = claNull then
+ FChart.Color := claWhite else
+ FChart.Color := Color;
+ FChart.BufferedDisplay := True;
+ FNormalSize := FChart.TeeCreateBitmap(claNull,RectF(0, 0, Width, Height), 0);
+ end;
+ Canvas.DrawBitmap(FNormalSize, RectF(0, 0, Width, Height), RectF(FX, FY, FX1, FY1), 1, True);
+{$ELSE}
+ FillChart;
+ if Color = claNull then
+ FChart.Color := claWhite else
+ FChart.Color := Color;
+ FChart.BufferedDisplay := True;
+{$IFDEF DELPHI17}
+ if IsPrinting then
+ begin
+ // todo printing in low res
+ // with actual DPI TeeChart doesnt fit labels and text correct
+ // should be :
+ //MetaF := FChart.TeeCreateBitmap(claNull, RectF(0, 0, Width * ScaleX, Height * ScaleY ), 96);
+ MetaF := FChart.TeeCreateBitmap(claNull, RectF(0, 0, Width, Height ), 96);
+ try
+ Canvas.BeginScene();
+ // should be :
+ //Canvas.DrawBitmap(MetaF, RectF(0, 0, Width * ScaleX, Height * ScaleY), RectF(FX, FY, FX1, FY1), 1, True);
+ Canvas.DrawBitmap(MetaF, RectF(0, 0, Width , Height), RectF(FX, FY, FX1, FY1), 1, True);
+ if Canvas.BeginSceneCount > 0 then
+ Canvas.EndScene;
+ finally
+ MetaF.Free;
+ end;
+ end
+ else begin
+ OldM := Canvas.Matrix;
+ State := Canvas.SaveState;
+ try
+ ScaleM := CreateScaleMatrix(ScaleX, ScaleY);
+ OffsetM := CreateTranslateMatrix(FX, FY);
+ OffsetM := MatrixMultiply(OldM, OffsetM);
+ OffsetM := MatrixMultiply(ScaleM, OffsetM);
+ Canvas.SetMatrix(OffsetM);
+ FChart.Draw (Canvas, RectF(0, 0, Width , Height));
+ finally
+ Canvas.RestoreState(state);
+ Canvas.SetMatrix(OldM);
+ end;
+ end;
+{$ELSE}
+ OldM := Canvas.Matrix;
+ State := Canvas.SaveState;
+ try
+ ScaleM := CreateScaleMatrix(ScaleX, ScaleY);
+ OffsetM := CreateTranslateMatrix(FX, FY);
+ OffsetM := MatrixMultiply(OldM, OffsetM);
+ OffsetM := MatrixMultiply(ScaleM, OffsetM);
+ Canvas.SetMatrix(OffsetM);
+ FChart.Draw (Canvas, RectF(0, 0, Width , Height));
+ finally
+ Canvas.RestoreState(state);
+ Canvas.SetMatrix(OldM);
+ end;
+{$ENDIF}
+{$ENDIF}
+ DrawFrame;
+end;
+
+procedure TfrxChartView.AfterPrint;
+var
+ i: Integer;
+begin
+ for i := 0 to FSeriesData.Count - 1 do
+ with FSeriesData[i] do
+ begin
+ Values1 := '';
+ Values2 := '';
+ Values3 := '';
+ Values4 := '';
+ Values5 := '';
+ Values6 := '';
+ end;
+end;
+
+procedure TfrxChartView.GetData;
+var
+ i: Integer;
+ function ConvertVarToStr(Val: Variant): String;
+ begin
+ if not FIgnoreNulls and VarIsNull(Val) then
+ Result := '0'
+ else
+ Result := VarToStr(Val)
+ end;
+begin
+ inherited;
+ for i := 0 to FSeriesData.Count - 1 do
+ with FSeriesData[i] do
+ if (DataType = dtDBData) and (DataSet <> nil) then
+ begin
+ Values1 := '';
+ Values2 := '';
+ Values3 := '';
+ Values4 := '';
+ Values5 := '';
+ Values6 := '';
+
+ DataSet.First;
+ while not DataSet.Eof do
+ begin
+ if Source1 <> '' then
+ Values1 := Values1 + ';' + VarToStr(Report.Calc(Source1));
+ if Source2 <> '' then
+ Values2 := Values2 + ';' + ConvertVarToStr(Report.Calc(Source2));
+ if Source3 <> '' then
+ Values3 := Values3 + ';' + ConvertVarToStr(Report.Calc(Source3));
+ if Source4 <> '' then
+ Values4 := Values4 + ';' + ConvertVarToStr(Report.Calc(Source4));
+ if Source5 <> '' then
+ Values5 := Values5 + ';' + ConvertVarToStr(Report.Calc(Source5));
+ if Source6 <> '' then
+ Values6 := Values6 + ';' + ConvertVarToStr(Report.Calc(Source6));
+ DataSet.Next;
+ end;
+ end
+ else if DataType = dtFixedData then
+ begin
+ Values1 := Source1;
+ Values2 := Source2;
+ Values3 := Source3;
+ Values4 := Source4;
+ Values5 := Source5;
+ Values6 := Source6;
+ end
+end;
+
+procedure TfrxChartView.BeforeStartReport;
+var
+ i: Integer;
+begin
+ for i := 0 to FSeriesData.Count - 1 do
+ with FSeriesData[i] do
+ begin
+ Values1 := '';
+ Values2 := '';
+ Values3 := '';
+ Values4 := '';
+ Values5 := '';
+ Values6 := '';
+ end;
+ Report.Engine.NotifyList.Add(Self);
+end;
+
+procedure TfrxChartView.OnNotify(Sender: TObject);
+var
+ i: Integer;
+ function ConvertVarToStr(Val: Variant): String;
+ begin
+ if FIgnoreNulls and VarIsNull(Val) then
+ Result := '0'
+ else
+ Result := VarToStr(Val)
+ end;
+begin
+ inherited;
+ for i := 0 to FSeriesData.Count - 1 do
+ with FSeriesData[i] do
+ if (DataType = dtBandData) and (DataBand = Sender) then
+ begin
+ Report.CurObject := Self.Name;
+ if Source1 <> '' then
+ Values1 := Values1 + ';' + VarToStr(Report.Calc(Source1));
+ if Source2 <> '' then
+ Values2 := Values2 + ';' + ConvertVarToStr(Report.Calc(Source2));
+ if Source3 <> '' then
+ Values3 := Values3 + ';' + ConvertVarToStr(Report.Calc(Source3));
+ if Source4 <> '' then
+ Values4 := Values4 + ';' + ConvertVarToStr(Report.Calc(Source4));
+ if Source5 <> '' then
+ Values5 := Values5 + ';' + ConvertVarToStr(Report.Calc(Source5));
+ if Source6 <> '' then
+ Values6 := Values6 + ';' + ConvertVarToStr(Report.Calc(Source6));
+ end;
+end;
+
+procedure TfrxChartView.AddSeries(Series: TfrxChartSeries);
+var
+ sc: TSeriesClass;
+ s: TChartSeries;
+ b: Boolean;
+begin
+ sc := frxChartSeries[NativeInt(Series)];
+ s := TChartSeries(sc.NewInstance);
+ s.Create(Chart);
+ Chart.AddSeries(s);
+ SeriesData.Add;
+
+ with Chart do
+ begin
+ b := not (s is TPieSeries);
+ View3DOptions.Orthogonal := b;
+ AxisVisible := b;
+ View3DWalls := b;
+ end;
+end;
+
+procedure TfrxChartView.ClearSeries;
+begin
+ FChart.Free;
+ CreateChart;
+ SeriesData.Clear;
+end;
+
+
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxChartObject, TFmxObject);
+ RegisterTeeStandardSeries;
+ frxObjects.RegisterObject1(TfrxChartView, nil, '', '', 0, 125);
+
+finalization
+ frxObjects.UnRegister(TfrxChartView);
+
+end.
diff --git a/LibD28/FMX.frxChartEditor.fmx b/LibD28/FMX.frxChartEditor.fmx
new file mode 100644
index 0000000..b6274c1
--- /dev/null
+++ b/LibD28/FMX.frxChartEditor.fmx
@@ -0,0 +1,365 @@
+object frxChartEditorForm: TfrxChartEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Chart Editor'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 444
+ ClientWidth = 527
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object HintL: TLabel
+ Position.Point = '(276,172)'
+ Width = 198.000000000000000000
+ Height = 61.000000000000000000
+ TabOrder = 0
+ end
+ object OkB: TButton
+ Position.Point = '(367,415)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = OkBClick
+ HelpContext = 40
+ TabOrder = 1
+ ModalResult = 1
+ end
+ object Panel1: TPanel
+ Position.Point = '(2,2)'
+ Width = 217.000000000000000000
+ Height = 439.000000000000000000
+ TabOrder = 2
+ object Panel2: TPanel
+ Align = alTop
+ Position.Point = '(0,127)'
+ Width = 217.000000000000000000
+ Height = 8.000000000000000000
+ TabOrder = 0
+ end
+ object InspSite: TPanel
+ Align = alClient
+ Position.Point = '(0,135)'
+ Width = 217.000000000000000000
+ Height = 304.000000000000000000
+ TabOrder = 1
+ end
+ object Panel3: TPanel
+ Align = alTop
+ Width = 217.000000000000000000
+ Height = 127.000000000000000000
+ TabOrder = 2
+ object TreePanel: TPanel
+ Align = alRight
+ Position.Point = '(187,0)'
+ Width = 30.000000000000000000
+ Height = 127.000000000000000000
+ TabOrder = 0
+ object AddB: TSpeedButton
+ Position.Point = '(4,4)'
+ Width = 23.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = AddBClick
+ Font.Size = 16.000000000000000000
+ Font.Style = [fsBold]
+ Text = '+'
+ end
+ object DeleteB: TSpeedButton
+ Position.Point = '(4,28)'
+ Width = 23.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = DeleteBClick
+ Font.Size = 16.000000000000000000
+ Font.Style = [fsBold]
+ Text = '-'
+ end
+ object EditB: TSpeedButton
+ Position.Point = '(4,100)'
+ Width = 23.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ OnClick = EditBClick
+ end
+ object UPB: TSpeedButton
+ Position.Point = '(4,52)'
+ Width = 23.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = UPBClick
+ end
+ object DownB: TSpeedButton
+ Position.Point = '(4,76)'
+ Width = 23.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = DownBClick
+ end
+ end
+ object ChartTree: TfrxTreeView
+ Align = alClient
+ Width = 187.000000000000000000
+ Height = 127.000000000000000000
+ OnClick = ChartTreeClick
+ TabOrder = 1
+ Editable = False
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 0
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 1
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 2
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 3
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+ end
+ end
+ object CancelB: TButton
+ Position.Point = '(447,415)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 3
+ ModalResult = 2
+ Cancel = True
+ end
+ object SourcePanel: TPanel
+ Position.Point = '(224,0)'
+ Width = 305.000000000000000000
+ Height = 407.000000000000000000
+ TabOrder = 4
+ object DataSourceGB: TGroupBox
+ Position.Point = '(8,0)'
+ Width = 293.000000000000000000
+ Height = 99.000000000000000000
+ TabOrder = 0
+ object DBSourceRB: TRadioButton
+ Position.Point = '(8,20)'
+ Width = 109.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = DBSourceRBClick
+ TabOrder = 0
+ end
+ object BandSourceRB: TRadioButton
+ Position.Point = '(8,44)'
+ Width = 109.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = DBSourceRBClick
+ TabOrder = 1
+ end
+ object FixedDataRB: TRadioButton
+ Position.Point = '(8,68)'
+ Width = 153.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = DBSourceRBClick
+ TabOrder = 2
+ end
+ object DatasetsCB: TComboBox
+ Tag = 2
+ Position.Point = '(120,21)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ OnClick = DatasetsCBClick
+ TabOrder = 3
+ ItemIndex = -1
+ OnChange = DatasetsCBClick
+ end
+ object DatabandsCB: TComboBox
+ Tag = 6
+ Position.Point = '(120,45)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ OnClick = DatabandsCBClick
+ TabOrder = 4
+ ItemIndex = -1
+ OnChange = DatabandsCBClick
+ end
+ end
+ object ValuesGB: TGroupBox
+ Position.Point = '(8,104)'
+ Width = 293.000000000000000000
+ Height = 171.000000000000000000
+ TabOrder = 1
+ object Values1L: TLabel
+ Position.Point = '(12,20)'
+ Width = 101.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object Values2L: TLabel
+ Position.Point = '(12,44)'
+ Width = 101.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object Values3L: TLabel
+ Position.Point = '(12,68)'
+ Width = 101.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 2
+ end
+ object Values4L: TLabel
+ Position.Point = '(12,92)'
+ Width = 101.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 3
+ end
+ object Values5L: TLabel
+ Position.Point = '(12,116)'
+ Width = 101.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 4
+ end
+ object Values6L: TLabel
+ Position.Point = '(12,140)'
+ Width = 101.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 5
+ end
+ object Values1CB: TComboEdit
+ Tag = 3
+ Position.Point = '(120,16)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 6
+ ItemIndex = -1
+ OnChange = DoClick
+ end
+ object Values2CB: TComboEdit
+ Tag = 3
+ Position.Point = '(120,40)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 7
+ ItemIndex = -1
+ OnChange = DoClick
+ end
+ object Values3CB: TComboEdit
+ Tag = 3
+ Position.Point = '(120,64)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 8
+ ItemIndex = -1
+ OnChange = DoClick
+ end
+ object Values4CB: TComboEdit
+ Tag = 3
+ Position.Point = '(120,88)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 9
+ ItemIndex = -1
+ OnChange = DoClick
+ end
+ object Values5CB: TComboEdit
+ Tag = 3
+ Position.Point = '(120,112)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 10
+ ItemIndex = -1
+ OnChange = DoClick
+ end
+ object Values6CB: TComboEdit
+ Tag = 3
+ Position.Point = '(120,136)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 11
+ ItemIndex = -1
+ OnChange = DoClick
+ end
+ end
+ object OptionsGB: TGroupBox
+ Position.Point = '(8,280)'
+ Width = 293.000000000000000000
+ Height = 123.000000000000000000
+ TabOrder = 2
+ object ShowTopLbl: TLabel
+ Position.Point = '(12,44)'
+ Width = 109.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object CaptionLbl: TLabel
+ Position.Point = '(12,68)'
+ Width = 93.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object SortLbl: TLabel
+ Position.Point = '(12,20)'
+ Width = 101.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 2
+ end
+ object XLbl: TLabel
+ Position.Point = '(12,92)'
+ Width = 101.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 3
+ end
+ object TopNE: TEdit
+ Tag = 12
+ Position.Point = '(235,43)'
+ Width = 33.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 4
+ KeyboardType = vktDefault
+ OnChange = DoClick
+ Password = False
+ Text = '0'
+ end
+ object TopNCaptionE: TEdit
+ Tag = 13
+ Position.Point = '(120,65)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 5
+ KeyboardType = vktDefault
+ OnChange = DoClick
+ Password = False
+ end
+ object SortCB: TComboBox
+ Tag = 14
+ Position.Point = '(120,16)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ OnClick = DoClick
+ TabOrder = 6
+ ItemIndex = -1
+ end
+ object XTypeCB: TComboBox
+ Tag = 15
+ Position.Point = '(120,90)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 7
+ ItemIndex = -1
+ OnChange = DoClick
+ end
+ end
+ end
+end
diff --git a/LibD28/FMX.frxChartEditor.pas b/LibD28/FMX.frxChartEditor.pas
new file mode 100644
index 0000000..b47b901
--- /dev/null
+++ b/LibD28/FMX.frxChartEditor.pas
@@ -0,0 +1,828 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Chart design editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxChartEditor;
+
+interface
+{$I frx.inc}
+{$I tee.inc}
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.Menus, FMX.ExtCtrls, FMX.frxClass, FMX.frxChart, FMX.frxCustomEditors,
+ FMX.frxCtrls, FMX.frxInsp, FMX.Edit, FMX.ListBox, FMX.Layouts, FMX.TreeView,
+ FMX.Types, FMXTee.Procs, FMXTee.Engine, FMXTee.Chart, FMXTee.Series, {$IFDEF TeeChartPro}FMXTee.Commander, FMXTee.Editor.EditorPanel,{$ENDIF}
+ System.Variants, FMX.frxFMX, FMXTee.Chart.GalleryPanel, FMX.frxBaseModalForm
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI21}
+ , FMX.ComboEdit, FMX.Controls.Presentation
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+ TfrxChartEditor = class(TfrxViewEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+{$IFDEF LINUX}
+ TfrxChartEditorForm = class(TfrxForm)
+{$ELSE}
+ TfrxChartEditorForm = class(TForm)
+{$ENDIF}
+ OkB: TButton;
+ Panel1: TPanel;
+ Panel2: TPanel;
+ CancelB: TButton;
+ SourcePanel: TPanel;
+ DataSourceGB: TGroupBox;
+ DBSourceRB: TRadioButton;
+ BandSourceRB: TRadioButton;
+ FixedDataRB: TRadioButton;
+ DatasetsCB: TComboBox;
+ DatabandsCB: TComboBox;
+ ValuesGB: TGroupBox;
+ Values1CB: TComboEdit;
+ Values1L: TLabel;
+ Values2L: TLabel;
+ Values2CB: TComboEdit;
+ Values3L: TLabel;
+ Values3CB: TComboEdit;
+ Values4L: TLabel;
+ Values4CB: TComboEdit;
+ OptionsGB: TGroupBox;
+ ShowTopLbl: TLabel;
+ CaptionLbl: TLabel;
+ SortLbl: TLabel;
+ XLbl: TLabel;
+ TopNE: TEdit;
+ TopNCaptionE: TEdit;
+ SortCB: TComboBox;
+ XTypeCB: TComboBox;
+ InspSite: TPanel;
+ Values5L: TLabel;
+ Values5CB: TComboEdit;
+ HintL: TLabel;
+ Values6L: TLabel;
+ Values6CB: TComboEdit;
+ Panel3: TPanel;
+ TreePanel: TPanel;
+ AddB: TSpeedButton;
+ DeleteB: TSpeedButton;
+ EditB: TSpeedButton;
+ UPB: TSpeedButton;
+ DownB: TSpeedButton;
+ ChartTree: TfrxTreeView;
+ procedure FormShow(Sender: TObject);
+ procedure ChartTreeClick(Sender: TObject);
+ procedure AddBClick(Sender: TObject);
+ procedure DeleteBClick(Sender: TObject);
+ procedure DoClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure UpDown1Click(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure DatasetsCBClick(Sender: TObject);
+ procedure DatabandsCBClick(Sender: TObject);
+ procedure DBSourceRBClick(Sender: TObject);
+ procedure OkBClick(Sender: TObject);
+ procedure EditBClick(Sender: TObject);
+ procedure ChartTreeEdited(Sender: TObject; Node: TfrxTreeViewItem;
+ var S: String);
+ procedure ChartTreeEditing(Sender: TObject; OldNode: TfrxTreeViewItem; NewNode: TfrxTreeViewItem);
+ procedure UPBClick(Sender: TObject);
+ procedure DownBClick(Sender: TObject);
+ private
+ { Private declarations }
+ FChart: TfrxChartView;
+ FCurSeries: TfrxSeriesItem;
+ FInspector: TfrxObjectInspector;
+ FModified: Boolean;
+ FReport: TfrxReport;
+ FUpdating: Boolean;
+ FValuesGBHeight: Single;
+ procedure FillDropDownLists(ds: TfrxDataset);
+ procedure SetCurSeries(const Value: TfrxSeriesItem);
+ procedure SetModified(const Value: Boolean);
+ procedure ShowSeriesData;
+ procedure UpdateSeriesData;
+ property Modified: Boolean read FModified write SetModified;
+ property CurSeries: TfrxSeriesItem read FCurSeries write SetCurSeries;
+ public
+ { Public declarations }
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ property Chart: TfrxChartView read FChart write FChart;
+ end;
+
+
+implementation
+
+uses FMX.frxDsgnIntf, FMX.frxUtils, FMX.frxRes, FMX.frxChartHelpers, FMX.frxChartGallery;
+//{$IFDEF DELPHI16}
+//{$IFDEF TeeChartPro}, VCLTee.TeeEdit{$IFNDEF TeeChart4}, VCLTee.TeeEditCha{$ENDIF} {$ENDIF};
+//{$ELSE}
+//{$IFDEF TeeChartPro}, TeeEdit{$IFNDEF TeeChart4}, TeeEditCha{$ENDIF} {$ENDIF};
+//{$ENDIF}
+
+{$R *.FMX}
+
+type
+ THackControl = class(TControl);
+
+
+{ TfrxChartEditor }
+
+function TfrxChartEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+function TfrxChartEditor.Edit: Boolean;
+begin
+ with TfrxChartEditorForm.Create(Designer) do
+ begin
+ Chart.Assign(TfrxChartView(Component));
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ Self.Designer.PeekLastModalResult;
+ if Result then
+ TfrxChartView(Component).Assign(Chart);
+ Free;
+ end;
+end;
+
+function TfrxChartEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ i: Integer;
+ c: TfrxComponent;
+ v: TfrxChartView;
+begin
+ Result := inherited Execute(Tag, Checked);
+ for i := 0 to Designer.SelectedObjects.Count - 1 do
+ begin
+ c := Designer.SelectedObjects[i];
+ if (c is TfrxChartView) and not (rfDontModify in c.Restrictions) then
+ begin
+ v := TfrxChartView(c);
+ if Tag = 1 then
+ v.Chart.View3D := Checked
+ else if Tag = 2 then
+ v.Chart.AxisVisible := Checked;
+ Result := True;
+ end;
+ end;
+end;
+
+procedure TfrxChartEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ v: TfrxChartView;
+begin
+ v := TfrxChartView(Component);
+ AddItem(frxResources.Get('ch3D'), 1, v.Chart.View3D);
+ AddItem(frxResources.Get('chAxis'), 2, v.Chart.AxisVisible);
+ inherited;
+end;
+
+
+{ TfrxChartEditorForm }
+
+constructor TfrxChartEditorForm.Create(AOwner: TComponent);
+var
+ bmp: TBitmap;
+begin
+ inherited;
+ FReport := TfrxCustomDesigner(AOwner).Report;
+ FChart := TfrxChartView.Create(FReport);
+ FInspector := TfrxObjectInspector.Create(Owner);
+ with FInspector do
+ begin
+ SplitterPos := InspSite.Width / 2;
+ Box.Parent := InspSite;
+ Box.Align := alClient;
+ end;
+
+ { add chart image }
+ bmp := TBitmap.Create(24, 24);
+ //frxResources.LoadImageFromResouce(
+ //ObjectImages.Draw(bmp.Canvas, 0, 0, 25);
+ //frxAssignImages(bmp, 24, 24, ChartImages);
+ bmp.Free;
+ FValuesGBHeight := ValuesGB.Height;
+{$IFDEF TeeChartPro}
+ EditB.Visible := True;
+{$ENDIF}
+end;
+
+destructor TfrxChartEditorForm.Destroy;
+begin
+ FChart.Free;
+ inherited;
+end;
+
+procedure TfrxChartEditorForm.FormShow(Sender: TObject);
+
+ procedure FillChartTree;
+ var
+ i: Integer;
+ n: TfrxTreeViewItem;
+ begin
+ for i := 0 to FChart.Chart.SeriesCount - 1 do
+ begin
+
+ n := ChartTree.AddItem(ChartTree.Items[0], GetGallerySeriesName(FChart.Chart.Series[i]) + ' - ' + FChart.Chart.Series[i].Name);
+
+ n.OpenImageIndex := 0;
+ n.CloseImageIndex := 0;
+ end;
+
+ ChartTree.ExpandAll;
+ ChartTree.Selected := ChartTree.Items[0];
+ end;
+
+ procedure FillBandsList;
+ var
+ i: Integer;
+ c: TfrxComponent;
+ begin
+ for i := 0 to FReport.Designer.Objects.Count - 1 do
+ begin
+ c := FReport.Designer.Objects[i];
+ if c is TfrxDataBand then
+ DatabandsCB.Items.Add(c.Name);
+ end;
+ end;
+
+begin
+ ChartTree.AddItem(ChartTree, 'Root');
+ FReport.GetDatasetList(DatasetsCB.Items);
+ FillBandsList;
+ FillChartTree;
+ CurSeries := nil;
+ //Constraints.MinWidth := Width;
+ //Constraints.MinHeight := Height;
+ //Constraints.MaxHeight := Height;
+end;
+
+procedure TfrxChartEditorForm.ShowSeriesData;
+var
+ Helper: TfrxSeriesHelper;
+ sl: TStrings;
+ NewHeight: Single;
+begin
+ FUpdating := True;
+
+ if FCurSeries <> nil then
+ with FCurSeries do
+ begin
+ if DataType = dtDBData then
+ DBSourceRB.IsChecked := True
+ else if DataType = dtBandData then
+ BandSourceRB.IsChecked := True
+ else if DataType = dtFixedData then
+ FixedDataRB.IsChecked := True;
+ if Values1CB.Count > 0 then
+ Values1CB.ItemIndex := Values1CB.Items.IndexOf(FCurSeries.Source1)
+ else
+ Values1CB.Text := FCurSeries.Source1;
+
+ if Values2CB.Count > 0 then
+ Values2CB.ItemIndex := Values2CB.Items.IndexOf(FCurSeries.Source2)
+ else
+ Values2CB.Text := FCurSeries.Source2;
+ if Values3CB.Count > 0 then
+ Values3CB.ItemIndex := Values3CB.Items.IndexOf(FCurSeries.Source3)
+ else
+ Values3CB.Text := FCurSeries.Source3;
+ if Values4CB.Count > 0 then
+ Values4CB.ItemIndex := Values4CB.Items.IndexOf(FCurSeries.Source4)
+ else
+ Values4CB.Text := FCurSeries.Source4;
+ if Values5CB.Count > 0 then
+ Values5CB.ItemIndex := Values5CB.Items.IndexOf(FCurSeries.Source5)
+ else
+ Values5CB.Text := FCurSeries.Source5;
+ if Values6CB.Count > 0 then
+ Values6CB.ItemIndex := Values6CB.Items.IndexOf(FCurSeries.Source6)
+ else
+ Values6CB.Text := FCurSeries.Source6;
+ Helper := frxFindSeriesHelper(FChart.Chart.Series[FCurSeries.Index]);
+ sl := TStringList.Create;
+ frxSetCommaText(Helper.GetParamNames, sl);
+
+ NewHeight := FValuesGBHeight;
+ Values2CB.Visible := sl.Count >= 2;
+ Values2L.Visible := sl.Count >= 2;
+ if not Values2CB.Visible then
+ NewHeight := NewHeight - (Values2CB.Height + 4);
+ Values3CB.Visible := sl.Count >= 3;
+ Values3L.Visible := sl.Count >= 3;
+ if not Values3CB.Visible then
+ NewHeight := NewHeight - (Values3CB.Height + 4);
+ Values4CB.Visible := sl.Count >= 4;
+ Values4L.Visible := sl.Count >= 4;
+ if not Values4CB.Visible then
+ NewHeight := NewHeight - (Values4CB.Height + 4);
+ Values5CB.Visible := sl.Count >= 5;
+ Values5L.Visible := sl.Count >= 5;
+ if not Values5CB.Visible then
+ NewHeight := NewHeight - (Values5CB.Height + 4);
+ Values6CB.Visible := sl.Count >= 6;
+ Values6L.Visible := sl.Count >= 6;
+ if not Values6CB.Visible then
+ NewHeight := NewHeight - (Values6CB.Height + 4);
+
+ ValuesGB.Height := NewHeight;
+ OptionsGB.Position.Y := ValuesGB.Position.Y + ValuesGB.Height + 8;
+
+ if sl.Count > 0 then
+ Values1L.Text := sl[0];
+ if sl.Count > 1 then
+ Values2L.Text := sl[1];
+ if sl.Count > 2 then
+ Values3L.Text := sl[2];
+ if sl.Count > 3 then
+ Values4L.Text := sl[3];
+ if sl.Count > 4 then
+ Values5L.Text := sl[4];
+ if sl.Count > 5 then
+ Values6L.Text := sl[5];
+
+ sl.Free;
+ Helper.Free;
+
+
+ if DataSet = nil then
+ DatasetsCB.ItemIndex := -1
+ else
+ begin
+ DatasetsCB.ItemIndex := DatasetsCB.Items.IndexOf(FReport.GetAlias(DataSet));
+ DatasetsCBClick(nil);
+ end;
+
+ if DataBand = nil then
+ DatabandsCB.ItemIndex := -1
+ else
+ begin
+ DatabandsCB.ItemIndex := DatabandsCB.Items.IndexOf(DataBand.Name);
+ DatabandsCBClick(nil);
+ end;
+
+ TopNE.Text := IntToStr(TopN);
+ TopNCaptionE.Text := TopNCaption;
+ SortCB.ItemIndex := Integer(SortOrder);
+ XTypeCB.ItemIndex := Integer(XType);
+ end;
+
+ FUpdating := False;
+end;
+
+procedure TfrxChartEditorForm.UpdateSeriesData;
+begin
+ if FCurSeries <> nil then
+ with FCurSeries do
+ begin
+ if DBSourceRB.IsChecked then
+ DataType := dtDBData
+ else if BandSourceRB.IsChecked then
+ DataType := dtBandData
+ else if FixedDataRB.IsChecked then
+ DataType := dtFixedData;
+
+ if DatabandsCB.ItemIndex <> -1 then
+ DataBand := TfrxDataBand(FReport.FindObject(DatabandsCB.Items[DatabandsCB.ItemIndex]))
+ else
+ DataBand := nil;
+ if DatasetsCB.ItemIndex <> -1 then
+ DataSet := FReport.GetDataSet(DatasetsCB.Items[DatasetsCB.ItemIndex])
+ else
+ DataSet := nil;
+
+// if Values1CB.Selected <> nil then
+// Source1 := Values1CB.Selected.Text;
+// if Values2CB.Selected <> nil then
+// Source2 := Values2CB.Selected.Text;
+// if Values3CB.Selected <> nil then
+// Source3 := Values3CB.Selected.Text;
+// if Values4CB.Selected <> nil then
+// Source4 := Values4CB.Selected.Text;
+// if Values5CB.Selected <> nil then
+// Source5 := Values5CB.Selected.Text;
+// if Values6CB.Selected <> nil then
+// Source6 := Values6CB.Selected.Text;
+
+
+ Source1 := Values1CB.Text;
+ Source2 := Values2CB.Text;
+ Source3 := Values3CB.Text;
+ Source4 := Values4CB.Text;
+ Source5 := Values5CB.Text;
+ Source6 := Values6CB.Text;
+
+ SortOrder := TfrxSeriesSortOrder(SortCB.ItemIndex);
+ TopN := StrToInt(TopNE.Text);
+ TopNCaption := TopNCaptionE.Text;
+ XType := TfrxSeriesXType(XTypeCB.ItemIndex);
+ end;
+
+ Modified := False;
+end;
+
+procedure TfrxChartEditorForm.SetCurSeries(const Value: TfrxSeriesItem);
+var
+ InspectObj: TPersistent;
+begin
+ if Modified then
+ UpdateSeriesData;
+ FCurSeries := Value;
+
+ if FCurSeries = nil then
+ InspectObj := FChart.Chart
+ else
+ begin
+ InspectObj := FChart.Chart.Series[FCurSeries.Index];
+ UPB.Enabled := FCurSeries.Index > 0;
+ DownB.Enabled := (FCurSeries.Index < FChart.Chart.SeriesCount) and (FChart.Chart.SeriesCount <> FCurSeries.Index + 1);
+ end;
+ FInspector.Inspect([InspectObj]);
+ SourcePanel.Visible := FCurSeries <> nil;
+ HintL.Visible := not SourcePanel.Visible;
+ DeleteB.Visible := FCurSeries <> nil;
+ UPB.Visible := (FCurSeries <> nil);
+ DownB.Visible := (FCurSeries <> nil);
+ ShowSeriesData;
+end;
+
+procedure TfrxChartEditorForm.SetModified(const Value: Boolean);
+begin
+ if not FUpdating then
+ FModified := Value;
+end;
+
+procedure TfrxChartEditorForm.FillDropDownLists(ds: TfrxDataset);
+var
+ l: TStringList;
+ i: Integer;
+begin
+ if ds = nil then
+ begin
+{$IFDEF DELPHI23}
+ Values1CB.Clear;
+ Values2CB.Clear;
+ Values3CB.Clear;
+ Values4CB.Clear;
+ Values5CB.Clear;
+ Values6CB.Clear;
+{$ELSE}
+ Values1CB.Items.Clear;
+ Values2CB.Items.Clear;
+ Values3CB.Items.Clear;
+ Values4CB.Items.Clear;
+ Values5CB.Items.Clear;
+ Values6CB.Items.Clear;
+{$ENDIF}
+ end
+ else
+ begin
+ l := TStringList.Create;
+ try
+ ds.GetFieldList(l);
+ for i := 0 to l.Count - 1 do
+ l[i] := FReport.GetAlias(ds) + '."' + l[i] + '"';
+
+ Values1CB.Items := l;
+ Values2CB.Items := l;
+ Values3CB.Items := l;
+ Values4CB.Items := l;
+ Values5CB.Items := l;
+ Values6CB.Items := l;
+ finally
+ l.Free;
+ end;
+ end;
+end;
+
+procedure TfrxChartEditorForm.ChartTreeClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ i := ChartTree.Selected.GlobalIndex - 1;
+ if i >= 0 then
+ CurSeries := FChart.SeriesData[i] else
+ CurSeries := nil;
+end;
+
+{$HINTS OFF}
+procedure TfrxChartEditorForm.AddBClick(Sender: TObject);
+var
+ s: TChartSeries;
+ n: TfrxTreeViewItem;
+ b: Boolean;
+ ind, i: Integer;
+ TeeGalleryForm: TfrxChartGalleryForm;
+//{$IFDEF Delphi11}
+// TeeGalleryForm: TTeeGalleryForm;
+ ChartSeriesClass : TChartSeriesClass;
+ TeeFunctionClass : TTeeFunctionClass;
+//{$ENDIF}
+begin
+ ind := 0;
+{$IFDEF TeeChartStd7}
+ s := CreateNewSeriesGallery(nil, nil, FChart.Chart, False, False, ind);
+{$ELSE}
+
+//{$IFDEF Delphi11}
+ s := nil;
+ TeeGalleryForm := TfrxChartGalleryForm.Create(nil);
+{$IFDEF LINUX}
+ // TeeGalleryForm.Width := ScaleWidthOrHeightForm(TeeGalleryForm.ClientWidth, True);
+ // TeeGalleryForm.Height := ScaleWidthOrHeightForm(TeeGalleryForm.ClientHeight, False);
+{$ENDIF}
+// TeeGalleryForm := TTeeGalleryForm.Create(nil);
+ TeeGalleryForm.Position := TFormPosition.poScreenCenter;
+ if TeeGalleryForm.ShowModal = mrOk then
+ begin
+ ChartSeriesClass := nil;
+ TeeFunctionClass := nil;
+ TeeGalleryForm.GetGallery.GetSeriesClass(ChartSeriesClass, TeeFunctionClass, ind);
+ s := CreateNewSeries(nil, FChart.Chart, ChartSeriesClass, TeeFunctionClass);
+ end;
+//{$ELSE}
+// s := CreateNewSeriesGallery(nil, nil, FChart.Chart, False, False{$IFNDEF TeeChart4}{$IFDEF TeeChartPro}, ind{$ENDIF}{$ENDIF});
+//{$ENDIF}
+
+{$ENDIF}
+ if s = nil then
+ Exit;
+ FChart.SeriesData.Add;
+
+ with FChart.Chart do
+ begin
+ b := not (s is TPieSeries);
+ View3DOptions.Orthogonal := b;
+ AxisVisible := b;
+ View3DWalls := b;
+ end;
+
+ n := ChartTree.AddItem(ChartTree.ItemByGlobalIndex(0), GetGallerySeriesName(s) + ' - ' + s.Name);
+
+ n.OpenImageIndex := 0;
+ n.CloseImageIndex := 0;
+
+ ChartTree.Selected := n;
+
+ TeeGalleryForm.Free;
+
+ ChartTreeClick(nil);
+end;
+{$HINTS ON}
+
+procedure TfrxChartEditorForm.DeleteBClick(Sender: TObject);
+var
+ s: TChartSeries;
+begin
+ s := FChart.Chart.Series[FCurSeries.Index];
+ s.Free;
+ FCurSeries.Free;
+ ChartTree.Selected.Free;
+
+ ChartTree.SetFocus;
+ ChartTree.Selected := ChartTree.Items[0];
+ ChartTreeClick(nil);
+end;
+
+procedure TfrxChartEditorForm.EditBClick(Sender: TObject);
+begin
+{$IFDEF TeeChartPro}
+ with TChartEditor.Create(nil) do
+ begin
+ //TChartEditor.Create(nil).Chart;
+ Chart := FChart.Chart;
+ //F//mxTee.Editor.EditorPanel.
+ if FCurSeries <> nil then
+ Series := FChart.Chart.Series[FCurSeries.Index];
+
+ // HideTabs := [cetGeneral, cetTitles, cetPaging, cetSeriesData, cetMain,
+ // cetExport, {$IFDEF TeeChart7}cetExportNative,{$ENDIF} cetPrintPreview];
+ // Tab := DefaultTab - [ceDataSource, ceHelp, ceClone, ceTitle, ceAdd];
+
+ Execute;
+ Free;
+ end;
+{$ENDIF}
+end;
+
+procedure TfrxChartEditorForm.DoClick(Sender: TObject);
+begin
+ if not FUpdating then
+ Modified := True;
+end;
+
+procedure TfrxChartEditorForm.UpDown1Click(Sender: TObject);
+begin
+ DoClick(Sender);
+end;
+
+procedure TfrxChartEditorForm.DatasetsCBClick(Sender: TObject);
+var
+ ds: TfrxDataSet;
+begin
+ if DatasetsCB.ItemIndex = -1 then Exit;
+
+ ds := FReport.GetDataSet(DatasetsCB.Items[DatasetsCB.ItemIndex]);
+ FillDropDownLists(ds);
+ DoClick(nil);
+end;
+
+procedure TfrxChartEditorForm.DatabandsCBClick(Sender: TObject);
+var
+ db: TfrxDataBand;
+ ds: TfrxDataSet;
+begin
+ if DatabandsCB.ItemIndex = -1 then Exit;
+ db := TfrxDataBand(FReport.FindObject(DatabandsCB.Items[DatabandsCB.ItemIndex]));
+ if db <> nil then
+ ds := db.DataSet
+ else
+ ds := nil;
+ FillDropDownLists(ds);
+ DoClick(nil);
+end;
+
+procedure TfrxChartEditorForm.DBSourceRBClick(Sender: TObject);
+begin
+ DatasetsCB.ItemIndex := -1;
+ DatabandsCB.ItemIndex := -1;
+ FillDropDownLists(nil);
+ DoClick(nil);
+end;
+
+procedure TfrxChartEditorForm.OkBClick(Sender: TObject);
+begin
+ FInspector.FormDeactivate(nil);
+ CurSeries := nil;
+end;
+
+procedure TfrxChartEditorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(4100);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ //AddB.Hint := frxGet(4101);
+ //DeleteB.Hint := frxGet(4102);
+ //EditB.Hint := frxGet(4103);
+ {$IFDEF LINUX}
+ AddB.StyledSettings:= AddB.StyledSettings - [TStyledSetting.FontColor];
+ AddB.FontColor := TAlphaColorrec.Black;
+ DeleteB.StyledSettings:= AddB.StyledSettings - [TStyledSetting.FontColor];
+ DeleteB.FontColor := TAlphaColorrec.Black;
+ UPB.StyledSettings:= AddB.StyledSettings - [TStyledSetting.FontColor];
+ UPB.FontColor := TAlphaColorrec.Black;
+ DownB.StyledSettings:= AddB.StyledSettings - [TStyledSetting.FontColor];
+ DownB.FontColor := TAlphaColorrec.Black;
+ {$ENDIF}
+ DatasourceGB.Text := frxGet(4107);
+ DBSourceRB.Text := frxGet(4106);
+ BandSourceRB.Text := frxGet(4104);
+ FixedDataRB.Text := frxGet(4105);
+
+ ValuesGB.Text := frxGet(4108);
+ HintL.Text := frxGet(4109);
+
+ OptionsGB.Text := frxGet(4114);
+ ShowTopLbl.Text := frxGet(4115);
+ CaptionLbl.Text := frxGet(4116);
+ SortLbl.Text := frxGet(4117);
+ XLbl.Text := frxGet(4126);
+{$IFDEF DELPHI23}
+ XTypeCB.Clear;
+{$ELSE}
+ XTypeCB.Items.Clear;
+{$ENDIF}
+ XTypeCB.Items.Add(frxResources.Get('chxtText'));
+ XTypeCB.Items.Add(frxResources.Get('chxtNumber'));
+ XTypeCB.Items.Add(frxResources.Get('chxtDate'));
+{$IFDEF DELPHI23}
+ SortCB.Clear;
+{$ELSE}
+ SortCB.Items.Clear;
+{$ENDIF}
+ SortCB.Items.Add(frxResources.Get('chsoNone'));
+ SortCB.Items.Add(frxResources.Get('chsoAscending'));
+ SortCB.Items.Add(frxResources.Get('chsoDescending'));
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxChartEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+procedure TfrxChartEditorForm.ChartTreeEdited(Sender: TObject; Node: TfrxTreeViewItem;
+ var S: String);
+var
+ Ser: TChartSeries;
+begin
+ if FCurSeries <> nil then
+ begin
+ Ser := FChart.Chart.Series[FCurSeries.Index];
+ Ser.Name := S;
+ S := GetGallerySeriesName(Ser) + ' - ' + Ser.Name;
+ end;
+end;
+
+procedure TfrxChartEditorForm.ChartTreeEditing(Sender: TObject; OldNode: TfrxTreeViewItem; NewNode: TfrxTreeViewItem);
+//var
+// FEditHandle: HWND;
+begin
+// if Node.Parent = nil then
+// begin
+// AllowEdit := False;
+// exit;
+// end;
+// FEditHandle := HWND( SendMessage(ChartTree.Handle, $110F, 0, 0) );
+// if (FCurSeries <> nil) and (FEditHandle <> 0) then
+// Windows.SetWindowText(FEditHandle, PChar(FChart.Chart.Series[FCurSeries.Index].Name));
+end;
+
+procedure TfrxChartEditorForm.UPBClick(Sender: TObject);
+//var
+// tNode: TTreeNode;
+// idx: Integer;
+begin
+// idx := FCurSeries.Index;
+// FChart.Chart.SeriesUp(FChart.Chart.Series[idx]);
+// FChart.SeriesData.Items[idx].Index := idx - 1;
+//
+// with ChartTree.Items.GetFirstNode do
+// begin
+// tNode := Item[idx - 1];
+// Item[idx].MoveTo(tNode, naInsert);
+// ChartTree.Selected := Item[idx - 1];
+// end;
+//
+// ChartTree.SetFocus;
+// ChartTreeClick(nil);
+end;
+
+procedure TfrxChartEditorForm.DownBClick(Sender: TObject);
+//var
+// tNode: TTreeNode;
+// idx: Integer;
+begin
+// idx := FCurSeries.Index;
+// FChart.Chart.SeriesDown(FChart.Chart.Series[idx]);
+// FChart.SeriesData.Items[idx].Index := idx + 1;
+//
+// with ChartTree.Items.GetFirstNode do
+// begin
+// if idx + 2 = Count then
+// Item[idx].MoveTo(ChartTree.Items.GetFirstNode, naAddChild)
+// else
+// begin
+// tNode := Item[idx + 2];
+// Item[idx].MoveTo(tNode, naInsert);
+// end;
+// ChartTree.Selected := Item[idx + 1];
+// end;
+//
+// ChartTree.SetFocus;
+// ChartTreeClick(nil);
+end;
+
+initialization
+ frxComponentEditors.Register(TfrxChartView, TfrxChartEditor);
+ frxHideProperties(TChart, 'Align;AllowPanning;AllowZoom;Anchors;AnimatedZoom;' +
+ 'AnimatedZoomSteps;AutoSize;BackImage;BackImageInside;BackImageMode;' +
+ 'BevelInner;BevelOuter;BevelWidth;BorderStyle;BorderWidth;ClipPoints;Color;' +
+ 'Constraints;Cursor;DragCursor;DragKind;DragMode;DockSite;Enabled;Foot;Frame;Height;' +
+ 'HelpContext;HelpType;HelpKeyword;Hint;Left;Locked;MarginBottom;MarginLeft;MarginRight;MarginTop;' +
+ 'MaxPointsPerPage;Name;Page;ParentColor;ParentShowHint;PopupMenu;PrintProportional;' +
+ 'ScaleLastPage;ScrollMouseButton;SeriesList;ShowHint;TabOrder;TabStop;Tag;Top;UseDockManager;' +
+ 'Visible;Width');
+ frxHideProperties(TChartSeries, 'ColorSource;Cursor;DataSource;Name;' +
+ 'ParentChart;Tag;XLabelsSource');
+ frxHideProperties(TfrxChartView, 'SeriesData;BrushStyle');
+
+
+end.
diff --git a/LibD28/FMX.frxChartGallery.fmx b/LibD28/FMX.frxChartGallery.fmx
new file mode 100644
index 0000000..4d95c9c
--- /dev/null
+++ b/LibD28/FMX.frxChartGallery.fmx
@@ -0,0 +1,35 @@
+object frxChartGalleryForm: TfrxChartGalleryForm
+ Left = 0
+ Top = 0
+ Caption = 'frxChartGalleryForm'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 400
+ ClientWidth = 600
+ Visible = False
+ OnCreate = FormCreate
+ StyleLookup = 'backgroundstyle'
+ object ToolBar1: TToolBar
+ Align = alBottom
+ Position.Point = '(0,352)'
+ Width = 600.000000000000000000
+ Height = 48.000000000000000000
+ TabOrder = 0
+ object Button1: TButton
+ Position.Point = '(400,16)'
+ Width = 80.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 0
+ ModalResult = 1
+ Text = 'Ok'
+ end
+ object Button2: TButton
+ Position.Point = '(496,16)'
+ Width = 80.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Text = 'Cancel'
+ end
+ end
+end
diff --git a/LibD28/FMX.frxChartGallery.pas b/LibD28/FMX.frxChartGallery.pas
new file mode 100644
index 0000000..dd3dab3
--- /dev/null
+++ b/LibD28/FMX.frxChartGallery.pas
@@ -0,0 +1,85 @@
+unit FMX.frxChartGallery;
+{$I frx.inc}
+{$I tee.inc}
+interface
+
+uses
+ System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
+ FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMXTee.Procs, FMXTee.Engine, FMXTee.Chart, FMXTee.Series,
+ FMX.frxFMX, FMXTee.Chart.GalleryPanel, FMXTee.Constants, FMX.TabControl
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+{$IFDEF LINUX}
+ TfrxChartGalleryForm = class(TfrxForm)
+{$ELSE}
+ TfrxChartGalleryForm = class(TForm)
+{$ENDIF}
+ ToolBar1: TToolBar;
+ Button1: TButton;
+ Button2: TButton;
+ procedure FormCreate(Sender: TObject);
+ private
+ FTeePanel: TChartGalleryPanel;
+ FTabs: TTabControl;
+ { Private declarations }
+ public
+ function GetGallery: TChartGalleryPanel;
+ { Public declarations }
+ end;
+
+
+implementation
+
+{$R *.fmx}
+procedure TfrxChartGalleryForm.FormCreate(Sender: TObject);
+var
+ tItem: TTabItem;
+ I: Integer;
+ SCGallary: array[0 .. 6] of String;
+begin
+ SCGallary[0] := TeeMsg_GalleryStandard;
+ SCGallary[1] := TeeMsg_GalleryExtended;
+ SCGallary[2] := '3D';
+ SCGallary[3] := 'Stats';
+ SCGallary[4] := 'Financial';
+ SCGallary[5] := 'Gauges';
+ SCGallary[6] := 'Other';
+ FTabs := TTabControl.Create(self);
+ FTabs.Parent := Self;
+ FTabs.Visible := True;
+ FTabs.Align := TAlignLayout.alClient;
+ FTabs.TabHeight := 20;
+
+ for I := 0 to High(SCGallary) do
+ begin
+ tItem := TTabItem.Create(FTabs);
+ tItem.Parent := FTabs;
+ tItem.Text := SCGallary[i];
+ FTabs.AddObject(tItem);
+ tItem.Align := TAlignLayout.alClient;
+
+ FTeePanel := TChartGalleryPanel.Create(tItem);
+ FTeePanel.Parent := tItem;
+ FTeePanel.Visible := True;
+ FTeePanel.Align := TAlignLayout.alClient;
+ FTeePanel.CreateGalleryPage(SCGallary[i]);
+ tItem.Tag := NativeInt(FTeePanel);
+ end;
+ FTabs.TabIndex := 0;
+end;
+
+function TfrxChartGalleryForm.GetGallery: TChartGalleryPanel;
+begin
+ Result := TChartGalleryPanel(FTabs.ActiveTab.Tag);
+end;
+
+end.
diff --git a/LibD28/FMX.frxChartHelpers.pas b/LibD28/FMX.frxChartHelpers.pas
new file mode 100644
index 0000000..10f5ac3
--- /dev/null
+++ b/LibD28/FMX.frxChartHelpers.pas
@@ -0,0 +1,573 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ TeeChart series helpers }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxChartHelpers;
+
+interface
+
+{$I frx.inc}
+{$I tee.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UIConsts, FMX.Types, FMX.Menus, FMX.Controls, FMX.frxChart,
+ FMXTee.Procs, FMXTee.Engine, FMXTee.Chart, FMXTee.Series, FMXTee.Canvas
+{$IFDEF TeeChartPro}
+, FMXTee.Series.Polar,
+{$IFNDEF TeeChart4}
+ FMXTee.Series.Smith, FMXTee.Series.Pyramid, FMXTee.Series.Donut, FMXTee.Series.Funnel, FMXTee.Series.BoxPlot, FMXTee.Series.TriSurface,{$ENDIF}
+ FMXTee.Series.Bezier, FMXTee.Series.OHLC, FMXTee.Series.Candle, FMXTee.Series.Error, FMXTee.Functions.Stats,
+ FMXTee.Series.Surface, FMXTee.Series.Point3D, FMXTee.Series.Bar3D
+{$IFDEF TeeChart7}
+, FMXTee.TeeGauges, FMXTee.TeePointFigure
+{$ENDIF}
+{$ENDIF}
+
+, System.Variants
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+
+type
+ TfrxSeriesHelper = class(TObject)
+ public
+ function GetParamNames: String; virtual; abstract;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); virtual; abstract;
+ end;
+
+ TfrxStdSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+ TfrxPieSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+{$IFDEF TeeChartPro}
+ TfrxPolarSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+ TfrxGaugeSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+ TfrxSmithSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+ TfrxCandleSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+ TfrxErrorSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+ TfrxHiLoSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+ TfrxFunnelSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+ TfrxSurfaceSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+ TfrxVector3DSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+ TfrxBubble3DSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+ TfrxBar3DSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+{$ENDIF}
+
+ TfrxSeriesHelperClass = class of TfrxSeriesHelper;
+
+
+const
+{$IFDEF TeeChartPro}
+ frxNumSeries = 38;
+{$ELSE}
+ frxNumSeries = 7;
+{$ENDIF}
+ frxChartSeries: array[0..frxNumSeries - 1] of TSeriesClass =
+ (TLineSeries, TAreaSeries, TPointSeries,
+ TBarSeries, THorizBarSeries, TPieSeries,
+ TFastLineSeries
+{$IFDEF TeeChartPro}
+ , {$IFDEF TeeChart7}THorizAreaSeries{$ELSE}nil{$ENDIF}, {$IFNDEF TeeChart4}THorizLineSeries{$ELSE}nil{$ENDIF}, TPolarSeries,
+ TRadarSeries, {$IFDEF TeeChart7}TPolarBarSeries{$ELSE}nil{$ENDIF}, {$IFDEF TeeChart7}TGaugeSeries{$ELSE}nil{$ENDIF},
+ {$IFNDEF TeeChart4}TSmithSeries, TPyramidSeries, TDonutSeries{$ELSE}nil, nil, nil{$ENDIF},
+ TBezierSeries, TCandleSeries, TVolumeSeries,
+ {$IFDEF TeeChart7}TPointFigureSeries{$ELSE}nil{$ENDIF}, {$IFNDEF TeeChart4}THistogramSeries{$ELSE}nil{$ENDIF}, {$IFDEF TeeChart7}THorizHistogramSeries{$ELSE}nil{$ENDIF},
+ TErrorBarSeries, TErrorSeries, {$IFNDEF TeeChart4}THighLowSeries{$ELSE}nil{$ENDIF},
+ {$IFNDEF TeeChart4}TFunnelSeries, TBoxSeries, THorizBoxSeries{$ELSE}nil, nil, nil{$ENDIF},
+ TSurfaceSeries, TContourSeries, {$IFNDEF TeeChart4}TWaterFallSeries,
+ TColorGridSeries{$ELSE}nil, nil{$ENDIF}, {$IFDEF TeeChart7}TVector3DSeries{$ELSE}nil{$ENDIF}, {$IFDEF TeeChart7}TTowerSeries{$ELSE}nil{$ENDIF},
+ {$IFNDEF TeeChart4}TTriSurfaceSeries{$ELSE}nil{$ENDIF}, TPoint3DSeries, {$IFDEF TeeChart7}TBubble3DSeries{$ELSE}nil{$ENDIF},
+ TBar3DSeries
+{$ENDIF}
+ );
+ frxSeriesHelpers: array[0..frxNumSeries - 1] of TfrxSeriesHelperClass =
+ (TfrxStdSeriesHelper, TfrxStdSeriesHelper, TfrxStdSeriesHelper,
+ TfrxStdSeriesHelper, TfrxStdSeriesHelper, TfrxPieSeriesHelper,
+ TfrxStdSeriesHelper
+{$IFDEF TeeChartPro}
+ , TfrxStdSeriesHelper, TfrxStdSeriesHelper, TfrxPolarSeriesHelper,
+ TfrxPolarSeriesHelper, TfrxPolarSeriesHelper, TfrxGaugeSeriesHelper,
+ TfrxSmithSeriesHelper, TfrxStdSeriesHelper, TfrxPieSeriesHelper,
+ TfrxStdSeriesHelper, TfrxCandleSeriesHelper, TfrxStdSeriesHelper,
+ TfrxCandleSeriesHelper, TfrxStdSeriesHelper, TfrxStdSeriesHelper,
+ TfrxErrorSeriesHelper, TfrxErrorSeriesHelper, TfrxHiLoSeriesHelper,
+ TfrxFunnelSeriesHelper, TfrxStdSeriesHelper, TfrxStdSeriesHelper,
+ TfrxSurfaceSeriesHelper, TfrxSurfaceSeriesHelper, TfrxSurfaceSeriesHelper,
+ TfrxSurfaceSeriesHelper, TfrxVector3DSeriesHelper, TfrxSurfaceSeriesHelper,
+ TfrxSurfaceSeriesHelper, TfrxSurfaceSeriesHelper, TfrxBubble3DSeriesHelper,
+ TfrxBar3DSeriesHelper
+{$ENDIF}
+ );
+
+
+function frxFindSeriesHelper(Series: TChartSeries): TfrxSeriesHelper;
+
+
+implementation
+
+uses FMX.frxDsgnIntf, FMX.frxUtils, FMX.frxRes;
+
+
+function CheckNulls(Value: String): Boolean;
+begin
+ Result := (UpperCase(Value) = 'NULL') or (Value = '');
+end;
+
+function frxFindSeriesHelper(Series: TChartSeries): TfrxSeriesHelper;
+var
+ i: Integer;
+begin
+ Result := nil;
+ for i := 0 to frxNumSeries - 1 do
+ if Series.ClassType = frxChartSeries[i] then
+ begin
+ Result := TfrxSeriesHelper(frxSeriesHelpers[i].NewInstance);
+ Result.Create;
+ break;
+ end;
+
+ if Result = nil then
+ Result := TfrxStdSeriesHelper.Create;
+end;
+
+{ TfrxStdSeriesHelper }
+
+procedure TfrxStdSeriesHelper.AddValues(Series: TChartSeries; const v1, v2,
+ v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+var
+ d: Double;
+ Color: TColor;
+ s: String;
+begin
+ d := 0;
+ Color := clTeeColor;
+ if v4 <> '' then
+ try
+ Color := StringToColor(v4);
+ except
+ end;
+ if CheckNulls(v2) then
+ begin
+ Series.AddNull(v1);
+ Exit;
+ end;
+ if Series.YValues.DateTime then
+ d := StrToDateTime(v2)
+ else if frxIsValidFloat(v2) then
+ d := frxStrToFloat(v2);
+ if v3 <> '' then
+ s := v3
+ else
+ s := v1;
+ case XType of
+ xtText:
+ Series.Add(d, v1, Color);
+ xtNumber:
+ Series.AddXY(frxStrToFloat(s), d, v1, Color);
+ xtDate:
+ Series.AddXY(StrToDateTime(s), d, v1, Color);
+ end;
+end;
+
+function TfrxStdSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Label;Y;X (optional);Color (optional)';
+end;
+
+
+{ TfrxPieSeriesHelper }
+
+procedure TfrxPieSeriesHelper.AddValues(Series: TChartSeries; const v1, v2,
+ v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+var
+ d: Double;
+ c: TColor;
+begin
+ if CheckNulls(v2) then
+ begin
+ Series.AddNull(v1);
+ Exit;
+ end;
+
+ if Series.YValues.DateTime then
+ d := StrToDateTime(v2)
+ else
+ d := frxStrToFloat(v2);
+
+ c := clTeeColor;
+ if v3 <> '' then
+ try
+ c := StringToColor(v3);
+ except
+ end;
+
+ Series.Add(d, v1, c);
+end;
+
+function TfrxPieSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Label;Pie;Color (optional)';
+end;
+
+
+{$IFDEF TeeChartPro}
+{ TfrxPolarSeriesHelper }
+
+procedure TfrxPolarSeriesHelper.AddValues(Series: TChartSeries; const v1,
+ v2, v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+var
+ Color: TColor;
+begin
+ if CheckNulls(v2) or CheckNulls(v3) then
+ begin
+ Series.AddNull(v1);
+ Exit;
+ end;
+ Color := clTeeColor;
+ if v4 <> '' then
+ try
+ Color := StringToColor(v4);
+ except
+ end;
+ Series.AddXY(frxStrToFloat(v2), frxStrToFloat(v3), v1, Color);
+end;
+
+function TfrxPolarSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Label;Angle;Value;Color (optional)';
+end;
+
+{ TfrxGaugeSeriesHelper }
+
+procedure TfrxGaugeSeriesHelper.AddValues(Series: TChartSeries; const v1,
+ v2, v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+var
+ Color: TColor;
+begin
+ if CheckNulls(v2) then
+ begin
+ Series.AddNull(v1);
+ Exit;
+ end;
+ Color := clTeeColor;
+ if v3 <> '' then
+ try
+ Color := StringToColor(v3);
+ except
+ end;
+ Series.Clear;
+ Series.Add(frxStrToFloat(v2), v1, Color);
+end;
+
+function TfrxGaugeSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Label (optional);Value;Color (optional)';
+end;
+
+
+{ TfrxSmithSeriesHelper }
+
+procedure TfrxSmithSeriesHelper.AddValues(Series: TChartSeries; const v1,
+ v2, v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+begin
+{$IFNDEF TeeChart4}
+ if CheckNulls(v2) or CheckNulls(v3) then
+ begin
+ Series.AddNull(v1);
+ Exit;
+ end;
+ TSmithSeries(Series).AddPoint(frxStrToFloat(v2), frxStrToFloat(v3), v1);
+{$ENDIF}
+end;
+
+function TfrxSmithSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Label;Resistance;Reactance';
+end;
+
+
+{ TfrxCandleSeriesHelper }
+
+procedure TfrxCandleSeriesHelper.AddValues(Series: TChartSeries; const v1,
+ v2, v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+begin
+ TOHLCSeries(Series).AddOHLC(StrToDateTime(v1),
+ frxStrToFloat(v2), frxStrToFloat(v3), frxStrToFloat(v4), frxStrToFloat(v5));
+end;
+
+function TfrxCandleSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Date;Open;High;Low;Close';
+end;
+
+
+{ TfrxErrorSeriesHelper }
+
+procedure TfrxErrorSeriesHelper.AddValues(Series: TChartSeries; const v1,
+ v2, v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+begin
+ if CheckNulls(v2) or CheckNulls(v3) or CheckNulls(v4) then
+ begin
+ Series.AddNull(v1);
+ Exit;
+ end;
+ TCustomErrorSeries(Series).AddErrorBar(frxStrToFloat(v2), frxStrToFloat(v3),
+ frxStrToFloat(v4), v1);
+end;
+
+function TfrxErrorSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Label;X;Y;Error';
+end;
+
+
+{ TfrxHiLoSeriesHelper }
+
+procedure TfrxHiLoSeriesHelper.AddValues(Series: TChartSeries; const v1,
+ v2, v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+begin
+{$IFNDEF TeeChart4}
+ if CheckNulls(v2) or CheckNulls(v3) or CheckNulls(v4) then
+ begin
+ Series.AddNull(v1);
+ Exit;
+ end;
+ THighLowSeries(Series).AddHighLow(frxStrToFloat(v2), frxStrToFloat(v3),
+ frxStrToFloat(v4), v1);
+{$ENDIF}
+end;
+
+function TfrxHiLoSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Label;X;High;Low';
+end;
+
+
+{ TfrxFunnelSeriesHelper }
+
+procedure TfrxFunnelSeriesHelper.AddValues(Series: TChartSeries; const v1,
+ v2, v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+{$IFNDEF TeeChart4}
+var
+ Color: TColor;
+{$ENDIF}
+begin
+{$IFNDEF TeeChart4}
+ if CheckNulls(v2) or CheckNulls(v3) then
+ begin
+ Series.AddNull(v1);
+ Exit;
+ end;
+ Color := clTeeColor;
+ if v4 <> '' then
+ try
+ Color := StringToColor(v4);
+ except
+ end;
+ TFunnelSeries(Series).AddSegment(frxStrToFloat(v2), frxStrToFloat(v3), v1, Color);
+{$ENDIF}
+end;
+
+function TfrxFunnelSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Label;Quote;Opportunity;Color (optional)';
+end;
+
+
+{ TfrxSurfaceSeriesHelper }
+
+procedure TfrxSurfaceSeriesHelper.AddValues(Series: TChartSeries; const v1,
+ v2, v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+var
+ Color: TColor;
+begin
+ if CheckNulls(v2) or CheckNulls(v3) or CheckNulls(v4) then
+ begin
+ Series.AddNull(v1);
+ Exit;
+ end;
+ Color := clTeeColor;
+ if v5 <> '' then
+ try
+ Color := StringToColor(v5);
+ except
+ end;
+{$IFDEF TeeChart4}
+ TCustom3DSeries(Series).AddXYZ(Round(frxStrToFloat(v2)), frxStrToFloat(v3),
+ Round(frxStrToFloat(v4)), v1, Color);
+{$ELSE}
+ TCustom3DSeries(Series).AddXYZ(frxStrToFloat(v2), frxStrToFloat(v3),
+ frxStrToFloat(v4), v1, Color);
+{$ENDIF}
+end;
+
+function TfrxSurfaceSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Label;X;Y;Z;Color (optional)';
+end;
+
+
+{ TfrxVector3DSeriesHelper }
+
+procedure TfrxVector3DSeriesHelper.AddValues(Series: TChartSeries;
+ const v1, v2, v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+begin
+{$IFDEF TeeChart7}
+ TVector3DSeries(Series).AddVector(frxStrToFloat(v1), frxStrToFloat(v2),
+ frxStrToFloat(v3), frxStrToFloat(v4), frxStrToFloat(v5), frxStrToFloat(v6));
+{$ENDIF}
+end;
+
+function TfrxVector3DSeriesHelper.GetParamNames: String;
+begin
+ Result := 'X1;Y1;Z1;X2;Y2;Z2';
+end;
+
+
+{ TfrxBubble3DSeriesHelper }
+
+procedure TfrxBubble3DSeriesHelper.AddValues(Series: TChartSeries;
+ const v1, v2, v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+{$IFDEF TeeChart7}
+var
+ Color: TColor;
+{$ENDIF}
+begin
+{$IFDEF TeeChart7}
+ if CheckNulls(v2) or CheckNulls(v3) or
+ CheckNulls(v4) or CheckNulls(v5) then
+ begin
+ Series.AddNull(v1);
+ Exit;
+ end;
+ Color := clTeeColor;
+ if v6 <> '' then
+ try
+ Color := StringToColor(v6);
+ except
+ end;
+ TBubble3DSeries(Series).AddBubble(frxStrToFloat(v2), frxStrToFloat(v3),
+ frxStrToFloat(v4), frxStrToFloat(v5), v1, Color);
+{$ENDIF}
+end;
+
+function TfrxBubble3DSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Label;X;Y;Z;Radius;Color (optional)';
+end;
+
+
+{ TfrxBar3DSeriesHelper }
+
+procedure TfrxBar3DSeriesHelper.AddValues(Series: TChartSeries; const v1,
+ v2, v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+var
+ Color: TColor;
+begin
+ if CheckNulls(v2) or CheckNulls(v3) or CheckNulls(v4) then
+ begin
+ Series.AddNull(v1);
+ Exit;
+ end;
+ Color := clTeeColor;
+ if v5 <> '' then
+ try
+ Color := StringToColor(v5);
+ except
+ end;
+ TBar3DSeries(Series).AddBar(frxStrToFloat(v2), frxStrToFloat(v3),
+ frxStrToFloat(v4), v1, Color);
+end;
+
+function TfrxBar3DSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Label;X;Y;Offset;Color (optional)';
+end;
+{$ENDIF}
+
+end.
diff --git a/LibD28/FMX.frxChartRTTI.pas b/LibD28/FMX.frxChartRTTI.pas
new file mode 100644
index 0000000..35602c1
--- /dev/null
+++ b/LibD28/FMX.frxChartRTTI.pas
@@ -0,0 +1,116 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Chart RTTI }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxChartRTTI;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, System.SysUtils, FMX.Forms, FMX.fs_iinterpreter, FMX.frxChart, FMX.fs_ichartrtti
+, System.Variants, System.Types, FMXTee.Engine;
+
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TfrxSeriesDataType', 'dtDBData, dtBandData, dtFixedData');
+ AddEnum('TfrxChartSeries', 'csLine, csArea, csPoint, csBar, csHorizBar, '+
+ 'csPie, csGantt, csFastLine, csArrow, csBubble, csChartShape, csHorizArea, '+
+ 'csHorizLine, csPolar, csRadar, csPolarBar, csGauge, csSmith, csPyramid, '+
+ 'csDonut, csBezier, csCandle, csVolume, csPointFigure, csHistogram, '+
+ 'csHorizHistogram, csErrorBar, csError, csHighLow, csFunnel, csBox, '+
+ 'csHorizBox, csSurface, csContour, csWaterFall, csColorGrid, csVector3D, '+
+ 'csTower, csTriSurface, csPoint3D, csBubble3D, csMyPoint, csBarJoin, csBar3D');
+ AddClass(TfrxSeriesItem, 'TPersistent');
+ with AddClass(TfrxSeriesData, 'TPersistent') do
+ begin
+ AddMethod('function Add: TfrxSeriesItem', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TfrxSeriesItem', CallMethod, True);
+ end;
+ with AddClass(TfrxChartView, 'TfrxView') do
+ begin
+ AddProperty('Chart', 'TChart', GetProp, nil);
+ AddIndexProperty('Series', 'Integer', 'TChartSeries', CallMethod, True);
+ AddProperty('SeriesData', 'TfrxSeriesData', GetProp, nil);
+ AddProperty('SeriesCount', 'Integer', GetProp, nil);
+ AddMethod('procedure AddSeries(ASeries:TfrxChartSeries)', CallMethod);
+ end;
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TfrxSeriesData then
+ begin
+ if MethodName = 'ADD' then
+ Result := frxInteger(TfrxSeriesData(Instance).Add)
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TfrxSeriesData(Instance).Items[Caller.Params[0]])
+ end
+ else if ClassType = TfrxChartView then
+ begin
+ if MethodName = 'SERIES.GET' then
+ Result := frxInteger(TfrxChartView(Instance).Chart.Series[Caller.Params[0]])
+ else
+ if MethodName = 'ADDSERIES' then
+ TfrxChartView(Instance).AddSeries(TfrxChartSeries(Caller.Params[0]));
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TfrxChartView then
+ begin
+ if PropName = 'CHART' then
+ Result := frxInteger(TfrxChartView(Instance).Chart)
+ else if PropName = 'SERIESCOUNT' then
+ Result:=TfrxChartView(Instance).Chart.SeriesCount
+ else if PropName = 'SERIESDATA' then
+ Result := frxInteger(TfrxChartView(Instance).SeriesData)
+ end
+end;
+
+
+initialization
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ if fsRTTIModules <> nil then
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/FMX.frxClass.pas b/LibD28/FMX.frxClass.pas
new file mode 100644
index 0000000..a355bfc
--- /dev/null
+++ b/LibD28/FMX.frxClass.pas
@@ -0,0 +1,10116 @@
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ Report classes }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxClass;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, System.WideStrings,
+ System.Types, System.SyncObjs, System.IniFiles, System.Variants, FMX.Platform,
+ FMX.Types, FMX.Printer, FMX.Forms, System.StrUtils, System.UIConsts,
+ FMX.frxVariables, FMX.frxXML, FMX.frxProgress,
+ FMX.fs_iinterpreter, FMX.frxUnicodeUtils, FMX.frxFMX, FMX.frxBaseModalForm
+{$IFDEF LINUX}
+ ,FMUX.Api
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.Controls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI22}
+ , FMX.ActnList
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+const
+ fr01cm: Double = 3.77953;
+ fr1cm: Double = 37.7953;
+ fr01in: Double = 9.6;
+ fr1in: Integer = 96;
+ fr1CharX: Double = 9.6;
+ fr1CharY: Integer = 17;
+ frxDefPPI: Integer = 96;
+
+type
+ TfrxReport = class;
+ TfrxPage = class;
+ TfrxReportPage = class;
+ TfrxDialogPage = class;
+ TfrxCustomEngine = class;
+ TfrxCustomDesigner = class;
+ TfrxCustomPreview = class;
+ TfrxCustomPreviewPages = class;
+ TfrxComponent = class;
+ TfrxReportComponent = class;
+ TfrxView = class;
+ TfrxStyleItem = class;
+ TfrxCustomExportFilter = class;
+ TfrxCustomCompressor = class;
+ TfrxCustomDatabase = class;
+ TfrxFrame = class;
+ TfrxDataSet = class;
+
+ TfrxNotifyEvent = type String;
+ TfrxCloseQueryEvent = type String;
+ TfrxKeyEvent = type String;
+ TfrxKeyPressEvent = type String;
+ TfrxMouseEvent = type String;
+ TfrxMouseMoveEvent = type String;
+ TfrxPreviewClickEvent = type String;
+ TfrxRunDialogsEvent = type String;
+
+ EDuplicateName = class(Exception);
+ EExportTerminated = class(TObject);
+
+ SYSINT = Integer;
+
+ TfrxComponentStyle = set of (csContainer, csPreviewVisible, csDefaultDiff);
+ TfrxStretchMode = (smDontStretch, smActualHeight, smMaxHeight);
+ TfrxShiftMode = (smDontShift, smAlways, smWhenOverlapped);
+ TfrxDuplexMode = (dmNone, dmVertical, dmHorizontal, dmSimplex);
+
+ TfrxAlign = (baNone, baLeft, baRight, baCenter, baWidth, baBottom, baClient);
+
+ TfrxFrameStyle = (fsSolid, fsDash, fsDot, fsDashDot, fsDashDotDot, fsDouble, fsAltDot, fsSquare);
+
+ TfrxFrameType = (ftLeft, ftRight, ftTop, ftBottom);
+ TfrxFrameTypes = set of TfrxFrameType;
+
+ TfrxFormatKind = (fkText, fkNumeric, fkDateTime, fkBoolean);
+
+ TfrxHAlign = (haLeft, haRight, haCenter, haBlock);
+ TfrxVAlign = (vaTop, vaBottom, vaCenter);
+
+ TfrxSilentMode = (simMessageBoxes, simSilent, simReThrow);
+ TfrxRestriction = (rfDontModify, rfDontSize, rfDontMove, rfDontDelete, rfDontEdit);
+ TfrxRestrictions = set of TfrxRestriction;
+
+ TfrxShapeKind = (skRectangle, skRoundRectangle, skEllipse, skTriangle,
+ skDiamond, skDiagonal1, skDiagonal2);
+
+ TfrxPreviewButton = (pbPrint, pbLoad, pbSave, pbExport, pbZoom, pbFullScreen,
+ pbOutline, pbThumbnails, pbPageSetup, pbEdit, pbNavigator, pbClose);
+ TfrxPreviewButtons = set of TfrxPreviewButton;
+ TfrxZoomMode = (zmDefault, zmWholePage, zmPageWidth, zmManyPages);
+ TfrxPrintPages = (ppAll, ppOdd, ppEven);
+ TfrxAddPageAction = (apWriteOver, apAdd);
+ TfrxRangeBegin = (rbFirst, rbCurrent);
+ TfrxRangeEnd = (reLast, reCurrent, reCount);
+ TfrxFieldType = (fftNumeric, fftString, fftBoolean);
+ TfrxProgressType = (ptRunning, ptExporting, ptPrinting);
+ TfrxPrintMode = (pmDefault, pmSplit, pmJoin, pmScale);
+ TfrxInheriteMode = (imDefault, imDelete, imRename);
+
+ frxInteger = NativeInt;
+
+ TfrxRect = packed record
+ Left, Top, Right, Bottom: Double;
+ end;
+
+ TfrxPoint = packed record
+ X, Y: Double;
+ end;
+
+ TfrxProgressEvent = procedure(Sender: TfrxReport;
+ ProgressType: TfrxProgressType; Progress: Integer) of object;
+ TfrxBeforePrintEvent = procedure(Sender: TfrxReportComponent) of object;
+ TfrxGetValueEvent = procedure(const VarName: String; var Value: Variant) of object;
+ TfrxNewGetValueEvent = procedure(Sender: TObject; const VarName: String; var Value: Variant) of object;
+ TfrxUserFunctionEvent = function(const MethodName: String;
+ var Params: Variant): Variant of object;
+ TfrxManualBuildEvent = procedure(Page: TfrxPage) of object;
+ TfrxClickObjectEvent = procedure(Sender: TfrxView;
+ Button: TMouseButton; Shift: TShiftState; var Modified: Boolean) of object;
+ TfrxMouseOverObjectEvent = procedure(Sender: TfrxView) of object;
+ TfrxCheckEOFEvent = procedure(Sender: TObject; var Eof: Boolean) of object;
+ TfrxRunDialogEvent = procedure(Page: TfrxDialogPage) of object;
+ TfrxEditConnectionEvent = function(const ConnString: String): String of object;
+ TfrxSetConnectionEvent = procedure(const ConnString: String) of object;
+ TfrxBeforeConnectEvent = procedure(Sender: TfrxCustomDatabase; var Connected: Boolean) of object;
+ TfrxAfterDisconnectEvent = procedure(Sender: TfrxCustomDatabase) of object;
+ TfrxPrintPageEvent = procedure(Page: TfrxReportPage; CopyNo: Integer) of object;
+ TfrxLoadTemplateEvent = procedure(Report: TfrxReport; const TemplateName: String) of object;
+
+{ Root classes }
+
+ TfrxComponent = class(TComponent)
+ private
+ FFont: TfrxFont;
+ FObjects: TList;
+ FAllObjects: TList;
+ FParent: TfrxComponent;
+ FLeft: Double;
+ FTop: Double;
+ FWidth: Double;
+ FHeight: Double;
+ FParentFont: Boolean;
+ FGroupIndex: Integer;
+ FIsDesigning: Boolean;
+ FIsLoading: Boolean;
+ FIsPrinting: Boolean;
+ FIsWriting: Boolean;
+ FRestrictions: TfrxRestrictions;
+ FVisible: Boolean;
+ FDescription: String;
+ FAncestor: Boolean;
+ FComponentStyle: TfrxComponentStyle;
+ function GetAbsTop: Double;
+ function GetPage: TfrxPage;
+ function GetReport: TfrxReport;
+ function IsFontStored: Boolean;
+ function GetAllObjects: TList;
+ function GetAbsLeft: Double;
+ function GetIsLoading: Boolean;
+ function GetIsAncestor: Boolean;
+ protected
+ FAliasName: String;
+ FBaseName: String;
+ FOriginalComponent: TfrxComponent;
+ FOriginalRect: TfrxRect;
+ FOriginalBand: TfrxComponent;
+ procedure SetParent(AParent: TfrxComponent); virtual;
+ procedure SetLeft(Value: Double); virtual;
+ procedure SetTop(Value: Double); virtual;
+ procedure SetWidth(Value: Double); virtual;
+ procedure SetHeight(Value: Double); virtual;
+ procedure SetName(const AName: TComponentName); override;
+ procedure SetFont(Value: TfrxFont); virtual;
+ procedure SetParentFont(const Value: Boolean); virtual;
+ procedure SetVisible(Value: Boolean); virtual;
+ procedure FontChanged(Sender: TObject); virtual;
+ function DiffFont(f1, f2: TfrxFont; const Add: String): String;
+ function InternalDiff(AComponent: TfrxComponent): String;
+ function GetContainerObjects: TList; virtual;
+
+ procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
+ function GetChildOwner: TComponent; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor DesignCreate(AOwner: TComponent; Flags: Word); virtual;
+ destructor Destroy; override;
+ class function GetDescription: String; virtual;
+ procedure AlignChildren; virtual;
+ procedure Assign(Source: TPersistent); override;
+ procedure AssignAll(Source: TfrxComponent; Streaming: Boolean = False);
+ procedure AddSourceObjects; virtual;
+ procedure BeforeStartReport; virtual;
+ procedure Clear; virtual;
+ procedure CreateUniqueName;
+ procedure LoadFromStream(Stream: TStream); virtual;
+ procedure SaveToStream(Stream: TStream; SaveChildren: Boolean = True;
+ SaveDefaultValues: Boolean = False; Streaming: Boolean = False); virtual;
+ procedure SetBounds(ALeft, ATop, AWidth, AHeight: Double);
+ procedure OnNotify(Sender: TObject); virtual;
+ procedure OnPaste; virtual;
+ function AllDiff(AComponent: TfrxComponent): String;
+ function Diff(AComponent: TfrxComponent): String; virtual;
+ function FindObject(const AName: String): TfrxComponent;
+ function ContainerAdd(Obj: TfrxComponent): Boolean; virtual;
+ function ContainerMouseDown(Sender: TObject; X, Y: Integer): Boolean; virtual;
+ procedure ContainerMouseMove(Sender: TObject; X, Y: Integer); virtual;
+ procedure ContainerMouseUp(Sender: TObject; X, Y: Integer); virtual;
+ function FindDataSet(DataSet: TfrxDataSet; const DSName: String): TfrxDataSet;
+
+ property Objects: TList read FObjects;
+ property AllObjects: TList read GetAllObjects;
+ property ContainerObjects: TList read GetContainerObjects;
+ property Parent: TfrxComponent read FParent write SetParent;
+ property Page: TfrxPage read GetPage;
+ property Report: TfrxReport read GetReport;
+ property IsAncestor: Boolean read GetIsAncestor;
+ property IsDesigning: Boolean read FIsDesigning write FIsDesigning;
+ property IsLoading: Boolean read GetIsLoading write FIsLoading;
+ property IsPrinting: Boolean read FIsPrinting write FIsPrinting;
+ property IsWriting: Boolean read FIsWriting write FIsWriting;
+ property BaseName: String read FBaseName;
+ property GroupIndex: Integer read FGroupIndex write FGroupIndex default 0;
+ property frComponentStyle: TfrxComponentStyle read FComponentStyle write FComponentStyle;
+
+ property Left: Double read FLeft write SetLeft;
+ property Top: Double read FTop write SetTop;
+ property Width: Double read FWidth write SetWidth;
+ property Height: Double read FHeight write SetHeight;
+ property AbsLeft: Double read GetAbsLeft;
+ property AbsTop: Double read GetAbsTop;
+
+ property Description: String read FDescription write FDescription;
+ property ParentFont: Boolean read FParentFont write SetParentFont default True;
+ property Restrictions: TfrxRestrictions read FRestrictions write FRestrictions default [];
+ property Visible: Boolean read FVisible write SetVisible default True;
+ property Font: TfrxFont read FFont write SetFont stored IsFontStored;
+ end;
+
+ TfrxReportComponent = class(TfrxComponent)
+ private
+ FOnAfterData: TfrxNotifyEvent;
+ FOnAfterPrint: TfrxNotifyEvent;
+ FOnBeforePrint: TfrxNotifyEvent;
+ FOnPreviewClick: TfrxPreviewClickEvent;
+ FOnPreviewDblClick: TfrxPreviewClickEvent;
+ public
+ FShiftAmount: Double;
+ FShiftChildren: TList;
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
+ virtual; abstract;
+ procedure BeforePrint; virtual;
+ procedure GetData; virtual;
+ procedure AfterPrint; virtual;
+ function GetComponentText: String; virtual;
+ function GetRealBounds: TfrxRect; virtual;
+ property OnAfterData: TfrxNotifyEvent read FOnAfterData write FOnAfterData;
+ property OnAfterPrint: TfrxNotifyEvent read FOnAfterPrint write FOnAfterPrint;
+ property OnBeforePrint: TfrxNotifyEvent read FOnBeforePrint write FOnBeforePrint;
+ property OnPreviewClick: TfrxPreviewClickEvent read FOnPreviewClick write FOnPreviewClick;
+ property OnPreviewDblClick: TfrxPreviewClickEvent read FOnPreviewDblClick write FOnPreviewDblClick;
+ published
+ property Description;
+ end;
+
+ TfrxDialogComponent = class(TfrxReportComponent)
+ private
+ FComponent: TComponent;
+ FImage : TBitmap;
+ FImageIsLoaded: Boolean;
+ procedure ReadLeft(Reader: TReader);
+ procedure ReadTop(Reader: TReader);
+ procedure WriteLeft(Writer: TWriter);
+ procedure WriteTop(Writer: TWriter);
+ protected
+ FImageIndex: Integer;
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ property Component: TComponent read FComponent write FComponent;
+ end;
+
+ TfrxDialogControl = class(TfrxReportComponent)
+ private
+ FControl: TControl;
+ FOnClick: TfrxNotifyEvent;
+ FOnDblClick: TfrxNotifyEvent;
+ FOnEnter: TfrxNotifyEvent;
+ FOnExit: TfrxNotifyEvent;
+ FOnKeyDown: TfrxKeyEvent;
+ FOnKeyPress: TfrxKeyPressEvent;
+ FOnKeyUp: TfrxKeyEvent;
+ FOnMouseDown: TfrxMouseEvent;
+ FOnMouseMove: TfrxMouseMoveEvent;
+ FOnMouseUp: TfrxMouseEvent;
+ FOnActivate: TNotifyEvent;
+ function GetEnabled: Boolean;
+ procedure DoOnClick(Sender: TObject);
+ procedure DoOnDblClick(Sender: TObject);
+ procedure DoOnEnter(Sender: TObject);
+ procedure DoOnExit(Sender: TObject);
+ procedure DoOnKeyDown(Sender: TObject; var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState);
+ procedure DoOnKeyUp(Sender: TObject; var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState);
+ procedure DoOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+ procedure DoOnMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
+ procedure DoOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+ procedure SetEnabled(const Value: Boolean);
+ function GetCaption: String;
+ procedure SetCaption(const Value: String);
+ function GetHint: String;
+ procedure SetHint(const Value: String);
+ function GetShowHint: Boolean;
+ procedure SetShowHint(const Value: Boolean);
+ function GetTabStop: Boolean;
+ procedure SetTabStop(const Value: Boolean);
+ protected
+ procedure SetLeft(Value: Double); override;
+ procedure SetTop(Value: Double); override;
+ procedure SetWidth(Value: Double); override;
+ procedure SetHeight(Value: Double); override;
+ procedure SetParentFont(const Value: Boolean); override;
+ procedure SetVisible(Value: Boolean); override;
+ procedure SetParent(AParent: TfrxComponent); override;
+ procedure FontChanged(Sender: TObject); override;
+ procedure InitControl(AControl: TControl);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+
+ property Caption: String read GetCaption write SetCaption;
+ property Control: TControl read FControl write FControl;
+ property TabStop: Boolean read GetTabStop write SetTabStop default True;
+ property OnClick: TfrxNotifyEvent read FOnClick write FOnClick;
+ property OnDblClick: TfrxNotifyEvent read FOnDblClick write FOnDblClick;
+ property OnEnter: TfrxNotifyEvent read FOnEnter write FOnEnter;
+ property OnExit: TfrxNotifyEvent read FOnExit write FOnExit;
+ property OnKeyDown: TfrxKeyEvent read FOnKeyDown write FOnKeyDown;
+ property OnKeyPress: TfrxKeyPressEvent read FOnKeyPress write FOnKeyPress;
+ property OnKeyUp: TfrxKeyEvent read FOnKeyUp write FOnKeyUp;
+ property OnMouseDown: TfrxMouseEvent read FOnMouseDown write FOnMouseDown;
+ property OnMouseMove: TfrxMouseMoveEvent read FOnMouseMove write FOnMouseMove;
+ property OnMouseUp: TfrxMouseEvent read FOnMouseUp write FOnMouseUp;
+ property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
+ published
+ property Left;
+ property Top;
+ property Width;
+ property Height;
+ property Font;
+ property GroupIndex;
+ property ParentFont;
+ property Enabled: Boolean read GetEnabled write SetEnabled default True;
+ property Hint: String read GetHint write SetHint;
+ property ShowHint: Boolean read GetShowHint write SetShowHint;
+ property Visible;
+ end;
+
+ TfrxDataSet = class(TfrxDialogComponent)
+ private
+ FCloseDataSource: Boolean;
+ FEnabled: Boolean;
+ FEof: Boolean;
+ FOpenDataSource: Boolean;
+ FRangeBegin: TfrxRangeBegin;
+ FRangeEnd: TfrxRangeEnd;
+ FRangeEndCount: Integer;
+ FReportRef: TfrxReport;
+ FUserName: String;
+ FOnCheckEOF: TfrxCheckEOFEvent;
+ FOnFirst: TNotifyEvent;
+ FOnNext: TNotifyEvent;
+ FOnPrior: TNotifyEvent;
+ FOnOpen: TNotifyEvent;
+ FOnClose: TNotifyEvent;
+ protected
+ FInitialized: Boolean;
+ FRecNo: Integer;
+ function GetDisplayText(Index: String): WideString; virtual;
+ function GetDisplayWidth(Index: String): Integer; virtual;
+ function GetFieldType(Index: String): TfrxFieldType; virtual;
+ function GetValue(Index: String): Variant; virtual;
+ procedure SetName(const NewName: TComponentName); override;
+ procedure SetUserName(const Value: String); virtual;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+
+ { Navigation methods }
+ procedure Initialize; virtual;
+ procedure Finalize; virtual;
+ procedure Open; virtual;
+ procedure Close; virtual;
+ procedure First; virtual;
+ procedure Next; virtual;
+ procedure Prior; virtual;
+ function Eof: Boolean; virtual;
+
+ { Data access }
+ function FieldsCount: Integer; virtual;
+ function HasField(const fName: String): Boolean;
+ function IsBlobField(const fName: String): Boolean; virtual;
+ function RecordCount: Integer; virtual;
+ procedure AssignBlobTo(const fName: String; Obj: TObject); virtual;
+ procedure GetFieldList(List: TStrings); virtual;
+ property DisplayText[Index: String]: WideString read GetDisplayText;
+ property DisplayWidth[Index: String]: Integer read GetDisplayWidth;
+ property FieldType[Index: String]: TfrxFieldType read GetFieldType;
+ property Value[Index: String]: Variant read GetValue;
+
+ property CloseDataSource: Boolean read FCloseDataSource write FCloseDataSource;
+ { OpenDataSource is kept for backward compatibility only }
+ property OpenDataSource: Boolean read FOpenDataSource write FOpenDataSource default True;
+ property RecNo: Integer read FRecNo;
+ property ReportRef: TfrxReport read FReportRef write FReportRef;
+ property OnClose: TNotifyEvent read FOnClose write FOnClose;
+ property OnOpen: TNotifyEvent read FOnOpen write FOnOpen;
+ published
+ property Enabled: Boolean read FEnabled write FEnabled default True;
+ property RangeBegin: TfrxRangeBegin read FRangeBegin write FRangeBegin default rbFirst;
+ property RangeEnd: TfrxRangeEnd read FRangeEnd write FRangeEnd default reLast;
+ property RangeEndCount: Integer read FRangeEndCount write FRangeEndCount default 0;
+ property UserName: String read FUserName write SetUserName;
+ property OnCheckEOF: TfrxCheckEOFEvent read FOnCheckEOF write FOnCheckEOF;
+ property OnFirst: TNotifyEvent read FOnFirst write FOnFirst;
+ property OnNext: TNotifyEvent read FOnNext write FOnNext;
+ property OnPrior: TNotifyEvent read FOnPrior write FOnPrior;
+ end;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxUserDataSet = class(TfrxDataset)
+ private
+ FFields: TStrings;
+ FOnGetValue: TfrxGetValueEvent;
+ FOnNewGetValue: TfrxNewGetValueEvent;
+ procedure SetFields(const Value: TStrings);
+ protected
+ function GetDisplayText(Index: String): WideString; override;
+ function GetValue(Index: String): Variant; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function FieldsCount: Integer; override;
+ procedure GetFieldList(List: TStrings); override;
+ published
+ property Fields: TStrings read FFields write SetFields;
+ property OnGetValue: TfrxGetValueEvent read FOnGetValue write FOnGetValue;
+ property OnNewGetValue: TfrxNewGetValueEvent read FOnNewGetValue write FOnNewGetValue;
+ end;
+
+ TfrxCustomDBDataSet = class(TfrxDataSet)
+ private
+ FAliases: TStrings;
+ FFields: TStringList;
+ procedure SetFieldAliases(const Value: TStrings);
+ protected
+ property Fields: TStringList read FFields;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function ConvertAlias(const fName: String): String;
+ function GetAlias(const fName: String): String;
+ function FieldsCount: Integer; override;
+ published
+ property CloseDataSource;
+ property FieldAliases: TStrings read FAliases write SetFieldAliases;
+ property OpenDataSource;
+ property OnClose;
+ property OnOpen;
+ end;
+
+ TfrxDBComponents = class(TComponent)
+ public
+ function GetDescription: String; virtual;
+ end;
+
+ TfrxCustomDatabase = class(TfrxDialogComponent)
+ protected
+ procedure BeforeConnect(var Value: Boolean);
+ procedure AfterDisconnect;
+ procedure SetConnected(Value: Boolean); virtual;
+ procedure SetDatabaseName(const Value: String); virtual;
+ procedure SetLoginPrompt(Value: Boolean); virtual;
+ procedure SetParams(Value: TStrings); virtual;
+ function GetConnected: Boolean; virtual;
+ function GetDatabaseName: String; virtual;
+ function GetLoginPrompt: Boolean; virtual;
+ function GetParams: TStrings; virtual;
+ public
+ function ToString: WideString; reintroduce; virtual;
+ procedure FromString(const Connection: WideString); virtual;
+ procedure SetLogin(const Login, Password: String); virtual;
+ property Connected: Boolean read GetConnected write SetConnected default False;
+ property DatabaseName: String read GetDatabaseName write SetDatabaseName;
+ property LoginPrompt: Boolean read GetLoginPrompt write SetLoginPrompt default True;
+ property Params: TStrings read GetParams write SetParams;
+ end;
+
+
+ TfrxComponentClass = class of TfrxComponent;
+
+{ Report Objects }
+
+ TfrxFrameLine = class(TPersistent)
+ private
+ FFrame: TfrxFrame;
+ FColor: TAlphaColor;
+ FStyle: TfrxFrameStyle;
+ FWidth: Double;
+ function IsColorStored: Boolean;
+ function IsStyleStored: Boolean;
+ function IsWidthStored: Boolean;
+ public
+ constructor Create(AFrame: TfrxFrame);
+ procedure Assign(Source: TPersistent); override;
+ function Diff(ALine: TfrxFrameLine; const LineName: String;
+ ColorChanged, StyleChanged, WidthChanged: Boolean): String;
+ published
+ property Color: TAlphaColor read FColor write FColor stored IsColorStored;
+ property Style: TfrxFrameStyle read FStyle write FStyle stored IsStyleStored;
+ property Width: Double read FWidth write FWidth stored IsWidthStored;
+ end;
+
+ TfrxFrame = class(TPersistent)
+ private
+ FLeftLine: TfrxFrameLine;
+ FTopLine: TfrxFrameLine;
+ FRightLine: TfrxFrameLine;
+ FBottomLine: TfrxFrameLine;
+ FColor: TAlphaColor;
+ FDropShadow: Boolean;
+ FShadowWidth: Double;
+ FShadowColor: TAlphaColor;
+ FStyle: TfrxFrameStyle;
+ FTyp: TfrxFrameTypes;
+ FWidth: Double;
+ function IsShadowWidthStored: Boolean;
+ function IsTypStored: Boolean;
+ function IsWidthStored: Boolean;
+ procedure SetBottomLine(const Value: TfrxFrameLine);
+ procedure SetLeftLine(const Value: TfrxFrameLine);
+ procedure SetRightLine(const Value: TfrxFrameLine);
+ procedure SetTopLine(const Value: TfrxFrameLine);
+ procedure SetColor(const Value: TAlphaColor);
+ procedure SetStyle(const Value: TfrxFrameStyle);
+ procedure SetWidth(const Value: Double);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ function Diff(AFrame: TfrxFrame): String;
+ published
+ property Color: TAlphaColor read FColor write SetColor default claBlack;
+ property DropShadow: Boolean read FDropShadow write FDropShadow default False;
+ property ShadowColor: TAlphaColor read FShadowColor write FShadowColor default claBlack;
+ property ShadowWidth: Double read FShadowWidth write FShadowWidth stored IsShadowWidthStored;
+ property Style: TfrxFrameStyle read FStyle write SetStyle default fsSolid;
+ property Typ: TfrxFrameTypes read FTyp write FTyp stored IsTypStored;
+ property Width: Double read FWidth write SetWidth stored IsWidthStored;
+ property LeftLine: TfrxFrameLine read FLeftLine write SetLeftLine;
+ property TopLine: TfrxFrameLine read FTopLine write SetTopLine;
+ property RightLine: TfrxFrameLine read FRightLine write SetRightLine;
+ property BottomLine: TfrxFrameLine read FBottomLine write SetBottomLine;
+ end;
+
+ TfrxView = class(TfrxReportComponent)
+ private
+ FAlign: TfrxAlign;
+ FColor: TAlphaColor;
+ FCursor: TCursor;
+ FDataField: String;
+ FDataSet: TfrxDataSet;
+ FDataSetName: String;
+ FFrame: TfrxFrame;
+ FPrintable: Boolean;
+ FShiftMode: TfrxShiftMode;
+ FTagStr: String;
+ FTempTag: String;
+ FTempURL: String;
+ FHint: String;
+ FHintIsActive: Boolean;
+ FShowHint: Boolean;
+ FURL: String;
+ FPlainText: Boolean;
+ FBrushStyle: TBrushKind;
+ procedure SetFrame(const Value: TfrxFrame);
+ procedure SetDataSet(const Value: TfrxDataSet);
+ procedure SetDataSetName(const Value: String);
+ function GetDataSetName: String;
+ protected
+ FX: Integer;
+ FY: Integer;
+ FX1: Integer;
+ FY1: Integer;
+ FDX: Integer;
+ FDY: Integer;
+ FFrameWidth: Double;
+ FScaleX: Double;
+ FScaleY: Double;
+ FOffsetX: Double;
+ FOffsetY: Double;
+ FCanvas: TCanvas;
+ FFastCanvas: TCanvas;
+ procedure BeginDraw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); virtual;
+ procedure DrawBackground; virtual;
+ procedure DrawFrame; virtual;
+ procedure ExpandVariables(var Expr: String);
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function Diff(AComponent: TfrxComponent): String; override;
+ function IsDataField: Boolean;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ procedure BeforePrint; override;
+ procedure GetData; override;
+ procedure AfterPrint; override;
+ procedure SetFastCanvas(aCanvas: TCanvas);
+ procedure GetVisibleRect(var aRect: TRectF); virtual;
+ property Color: TAlphaColor read FColor write FColor default claNull;
+ property DataField: String read FDataField write FDataField;
+ property DataSet: TfrxDataSet read FDataSet write SetDataSet;
+ property DataSetName: String read GetDataSetName write SetDataSetName;
+ property Frame: TfrxFrame read FFrame write SetFrame;
+ property PlainText: Boolean read FPlainText write FPlainText;
+ property Cursor: TCursor read FCursor write FCursor default crDefault;
+ property TagStr: String read FTagStr write FTagStr;
+ property URL: String read FURL write FURL;
+ property HintIsActive: Boolean read FHintIsActive write FHintIsActive;
+ property BrushStyle: TBrushKind read FBrushStyle write FBrushStyle;
+ published
+ property Align: TfrxAlign read FAlign write FAlign default baNone;
+ property Printable: Boolean read FPrintable write FPrintable default True;
+ property ShiftMode: TfrxShiftMode read FShiftMode write FShiftMode default smAlways;
+ property Left;
+ property Top;
+ property Width;
+ property Height;
+ property GroupIndex;
+ property Restrictions;
+ property Visible;
+ property OnAfterData;
+ property OnAfterPrint;
+ property OnBeforePrint;
+ property OnPreviewClick;
+ property OnPreviewDblClick;
+ property Hint: String read FHint write FHint;
+ property ShowHint: Boolean read FShowHint write FShowHint;
+ end;
+
+ TfrxStretcheable = class(TfrxView)
+ private
+ FStretchMode: TfrxStretchMode;
+ public
+ FSaveHeight: Double;
+ FSavedTop: Double;
+ constructor Create(AOwner: TComponent); override;
+ function CalcHeight: Double; virtual;
+ function DrawPart: Double; virtual;
+ procedure InitPart; virtual;
+ function HasNextDataPart: Boolean; virtual;
+ published
+ property StretchMode: TfrxStretchMode read FStretchMode write FStretchMode
+ default smDontStretch;
+ end;
+
+ TfrxHighlight = class(TPersistent)
+ private
+ FActive: Boolean;
+ FColor: TAlphaColor;
+ FCondition: String;
+ FFont: TfrxFont;
+ procedure SetFont(const Value: TfrxFont);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Active: Boolean read FActive write FActive default False;
+ property Font: TfrxFont read FFont write SetFont;
+ property Color: TAlphaColor read FColor write FColor default claNull;
+ property Condition: String read FCondition write FCondition;
+ end;
+
+ TfrxFormat = class(TPersistent)
+ private
+ FDecimalSeparator: String;
+ FThousandSeparator: String;
+ FFormatStr: String;
+ FKind: TfrxFormatKind;
+ public
+ procedure Assign(Source: TPersistent); override;
+ published
+ property DecimalSeparator: String read FDecimalSeparator write FDecimalSeparator;
+ property ThousandSeparator: String read FThousandSeparator write FThousandSeparator;
+ property FormatStr: String read FFormatStr write FFormatStr;
+ property Kind: TfrxFormatKind read FKind write FKind default fkText;
+ end;
+
+ TfrxCustomMemoView = class(TfrxStretcheable)
+ private
+ FAllowExpressions: Boolean;
+ FAllowHTMLTags: Boolean;
+ FAutoWidth: Boolean;
+ FCharSpacing: Double;
+ FClipped: Boolean;
+ FDisplayFormat: TfrxFormat;
+ FExpressionDelimiters: String;
+ FFlowTo: TfrxCustomMemoView;
+ FFirstParaBreak: Boolean;
+ FGapX: Double;
+ FGapY: Double;
+ FHAlign: TfrxHAlign;
+ FHideZeros: Boolean;
+ FHighlight: TfrxHighlight;
+ FLastParaBreak: Boolean;
+ FLineSpacing: Double;
+ FMemo: TWideStrings;
+ FParagraphGap: Double;
+ FPartMemo: WideString;
+ FRotation: Integer;
+ FRTLReading: Boolean;
+ FStyle: String;
+ FSuppressRepeated: Boolean;
+ FTempMemo: WideString;
+ FUnderlines: Boolean;
+ FVAlign: TfrxVAlign;
+ FValue: Variant;
+ FWordBreak: Boolean;
+ FWordWrap: Boolean;
+ FWysiwyg: Boolean;
+ FTextRenderer: TObject;
+ procedure SetMemo(const Value: TWideStrings);
+ procedure SetRotation(Value: Integer);
+ procedure SetText(const Value: WideString);
+ function AdjustCalcHeight: Double;
+ function AdjustCalcWidth: Double;
+ function GetText: WideString;
+ function IsExprDelimitersStored: Boolean;
+ function IsLineSpacingStored: Boolean;
+ function IsGapXStored: Boolean;
+ function IsGapYStored: Boolean;
+ function IsHighlightStored: Boolean;
+ function IsParagraphGapStored: Boolean;
+ procedure SetHighlight(const Value: TfrxHighlight);
+ procedure SetDisplayFormat(const Value: TfrxFormat);
+ procedure SetStyle(const Value: String);
+ function IsCharSpacingStored: Boolean;
+ procedure SetAllowHTMLTags(const Value: Boolean);
+ protected
+ FLastValue: Variant;
+ FTotalPages: Integer;
+ FCopyNo: Integer;
+ FTextRect: TRectF;
+ FPrintScale: Double;
+ function CalcAndFormat(const Expr: WideString): WideString;
+ procedure BeginDraw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ function IsAdvancedRendererNeeded: Boolean;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ function Diff(AComponent: TfrxComponent): String; override;
+ function CalcHeight: Double; override;
+ function CalcWidth: Double; virtual;
+ function DrawPart: Double; override;
+ function GetComponentText: String; override;
+ function FormatData(const Value: Variant; AFormat: TfrxFormat = nil): WideString;
+ procedure WrapText(WrapWords: Boolean; var aLineHeight: Single; WrapLines: TWideStrings; aBitmap: TBitmap = nil);
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ procedure BeforePrint; override;
+ procedure GetData; override;
+ procedure AfterPrint; override;
+ procedure InitPart; override;
+ procedure ApplyStyle(Style: TfrxStyleItem);
+ procedure ExtractMacros;
+ procedure ResetSuppress;
+ property Text: WideString read GetText write SetText;
+ property Value: Variant read FValue write FValue;
+ // analogue of Memo property
+ property Lines: TWideStrings read FMemo write SetMemo;
+
+ property AllowExpressions: Boolean read FAllowExpressions write FAllowExpressions default True;
+ property AllowHTMLTags: Boolean read FAllowHTMLTags write SetAllowHTMLTags default False;
+ property AutoWidth: Boolean read FAutoWidth write FAutoWidth default False;
+ property CharSpacing: Double read FCharSpacing write FCharSpacing stored IsCharSpacingStored;
+ property Clipped: Boolean read FClipped write FClipped default True;
+ property DisplayFormat: TfrxFormat read FDisplayFormat write SetDisplayFormat;
+ property ExpressionDelimiters: String read FExpressionDelimiters
+ write FExpressionDelimiters stored IsExprDelimitersStored;
+ property FlowTo: TfrxCustomMemoView read FFlowTo write FFlowTo;
+ property GapX: Double read FGapX write FGapX stored IsGapXStored;
+ property GapY: Double read FGapY write FGapY stored IsGapYStored;
+ property HAlign: TfrxHAlign read FHAlign write FHAlign default haLeft;
+ property HideZeros: Boolean read FHideZeros write FHideZeros default False;
+ property Highlight: TfrxHighlight read FHighlight write SetHighlight
+ stored IsHighlightStored;
+ property LineSpacing: Double read FLineSpacing write FLineSpacing stored IsLineSpacingStored;
+ property Memo: TWideStrings read FMemo write SetMemo;
+ property ParagraphGap: Double read FParagraphGap write FParagraphGap stored IsParagraphGapStored;
+ property Rotation: Integer read FRotation write SetRotation default 0;
+ property RTLReading: Boolean read FRTLReading write FRTLReading default False;
+ property Style: String read FStyle write SetStyle;
+ property SuppressRepeated: Boolean read FSuppressRepeated write FSuppressRepeated default False;
+ property Underlines: Boolean read FUnderlines write FUnderlines default False;
+ property WordBreak: Boolean read FWordBreak write FWordBreak default False;
+ property WordWrap: Boolean read FWordWrap write FWordWrap default True;
+ property Wysiwyg: Boolean read FWysiwyg write FWysiwyg default True;
+ property VAlign: TfrxVAlign read FVAlign write FVAlign default vaTop;
+ published
+ property FirstParaBreak: Boolean read FFirstParaBreak write FFirstParaBreak default False;
+ property LastParaBreak: Boolean read FLastParaBreak write FLastParaBreak default False;
+ property Cursor;
+ property TagStr;
+ property URL;
+ end;
+
+ TfrxMemoView = class(TfrxCustomMemoView)
+ published
+ property AutoWidth;
+ property AllowExpressions;
+ property AllowHTMLTags;
+ property CharSpacing;
+ property Clipped;
+ property Color;
+ property DataField;
+ property DataSet;
+ property DataSetName;
+ property DisplayFormat;
+ property ExpressionDelimiters;
+ property FlowTo;
+ property Font;
+ property Frame;
+ property GapX;
+ property GapY;
+ property HAlign;
+ property HideZeros;
+ property Highlight;
+ property LineSpacing;
+ property Memo;
+ property ParagraphGap;
+ property ParentFont;
+ property Rotation;
+ property RTLReading;
+ property Style;
+ property SuppressRepeated;
+ property Underlines;
+ property WordBreak;
+ property WordWrap;
+ property Wysiwyg;
+ property VAlign;
+ end;
+
+ TfrxSysMemoView = class(TfrxCustomMemoView)
+ public
+ class function GetDescription: String; override;
+ published
+ property AutoWidth;
+ property CharSpacing;
+ property Color;
+ property DisplayFormat;
+ property Font;
+ property Frame;
+ property GapX;
+ property GapY;
+ property HAlign;
+ property HideZeros;
+ property Highlight;
+ property Memo;
+ property ParentFont;
+ property Rotation;
+ property RTLReading;
+ property Style;
+ property SuppressRepeated;
+ property VAlign;
+ property WordWrap;
+ end;
+
+ TfrxCustomLineView = class(TfrxStretcheable)
+ private
+ FDiagonal: Boolean;
+ FArrowEnd: Boolean;
+ FArrowLength: Integer;
+ FArrowSolid: Boolean;
+ FArrowStart: Boolean;
+ FArrowWidth: Integer;
+ procedure DrawArrow(x1, y1, x2, y2: Extended);
+ procedure DrawDiagonalLine;
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor DesignCreate(AOwner: TComponent; Flags: Word); override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ procedure GetVisibleRect(var aRect: TRectF); override;
+ property ArrowEnd: Boolean read FArrowEnd write FArrowEnd default False;
+ property ArrowLength: Integer read FArrowLength write FArrowLength default 20;
+ property ArrowSolid: Boolean read FArrowSolid write FArrowSolid default False;
+ property ArrowStart: Boolean read FArrowStart write FArrowStart default False;
+ property ArrowWidth: Integer read FArrowWidth write FArrowWidth default 5;
+ property Diagonal: Boolean read FDiagonal write FDiagonal default False;
+ published
+ property TagStr;
+ end;
+
+ TfrxLineView = class(TfrxCustomLineView)
+ public
+ class function GetDescription: String; override;
+ published
+ property ArrowEnd;
+ property ArrowLength;
+ property ArrowSolid;
+ property ArrowStart;
+ property ArrowWidth;
+ property Frame;
+ property Diagonal;
+ end;
+
+ TfrxPictureView = class(TfrxView)
+ protected
+ procedure ReadVCLPicture(Stream: TStream);
+ private
+ FAutoSize: Boolean;
+ FCenter: Boolean;
+ FFileLink: String;
+ FImageIndex: Integer;
+ FIsImageIndexStored: Boolean;
+ FIsPictureStored: Boolean;
+ FKeepAspectRatio: Boolean;
+ FPicture: TBitmap;
+ FPictureChanged: Boolean;
+ FStretched: Boolean;
+ FHightQuality: Boolean;
+ FTransparent: Boolean;
+ FTransparentColor: TAlphaColor;
+ procedure SetPicture(const Value: TBitmap);
+ procedure PictureChanged(Sender: TObject);
+ procedure SetAutoSize(const Value: Boolean);
+ procedure SetTransparent(const Value: Boolean);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ function Diff(AComponent: TfrxComponent):String; override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ procedure GetData; override;
+ property IsImageIndexStored: Boolean read FIsImageIndexStored write FIsImageIndexStored;
+ property IsPictureStored: Boolean read FIsPictureStored write FIsPictureStored;
+ published
+ property Cursor;
+ property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
+ property Center: Boolean read FCenter write FCenter default False;
+ property DataField;
+ property DataSet;
+ property DataSetName;
+ property Frame;
+ property FileLink: String read FFileLink write FFileLink;
+ property ImageIndex: Integer read FImageIndex write FImageIndex stored FIsImageIndexStored;
+ property KeepAspectRatio: Boolean read FKeepAspectRatio write FKeepAspectRatio default True;
+ property Picture: TBitmap read FPicture write SetPicture stored FIsPictureStored;
+ property Stretched: Boolean read FStretched write FStretched default True;
+ property TagStr;
+ property URL;
+ property HightQuality: Boolean read FHightQuality write FHightQuality;
+ property Transparent: Boolean read FTransparent write SetTransparent;
+ property TransparentColor: TAlphaColor read FTransparentColor write FTransparentColor;
+ end;
+
+ TfrxShapeView = class(TfrxView)
+ private
+ FCurve: Integer;
+ FShape: TfrxShapeKind;
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor DesignCreate(AOwner: TComponent; Flags: Word); override;
+ function Diff(AComponent: TfrxComponent): String; override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ class function GetDescription: String; override;
+ procedure GetVisibleRect(var aRect: TRectF); override;
+ published
+ property Color;
+ property Cursor;
+ property Curve: Integer read FCurve write FCurve default 0;
+ property Frame;
+ property Shape: TfrxShapeKind read FShape write FShape default skRectangle;
+ property TagStr;
+ property URL;
+ end;
+
+ TfrxSubreport = class(TfrxView)
+ private
+ FPage: TfrxReportPage;
+ FPrintOnParent: Boolean;
+ procedure SetPage(const Value: TfrxReportPage);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ class function GetDescription: String; override;
+ published
+ property Page: TfrxReportPage read FPage write SetPage;
+ property PrintOnParent: Boolean read FPrintOnParent write FPrintOnParent
+ default False;
+ end;
+
+
+{ Bands }
+ TfrxChild = class;
+
+ TfrxBand = class(TfrxReportComponent)
+ private
+ FAllowSplit: Boolean;
+ FChild: TfrxChild;
+ FKeepChild: Boolean;
+ FOnAfterCalcHeight: TfrxNotifyEvent;
+ FOutlineText: String;
+ FOverflow: Boolean;
+ FStartNewPage: Boolean;
+ FStretched: Boolean;
+ FPrintChildIfInvisible: Boolean;
+ FVertical: Boolean;
+ function GetBandName: String;
+ procedure SetChild(Value: TfrxChild);
+ procedure SetVertical(const Value: Boolean);
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetLeft(Value: Double); override;
+ procedure SetTop(Value: Double); override;
+ procedure SetHeight(Value: Double); override;
+ public
+ FSubBands: TList; { list of subbands }
+ FHeader, FFooter, FGroup: TfrxBand; { h./f./g. bands }
+ FLineN: Integer; { used for Line# }
+ FLineThrough: Integer; { used for LineThrough# }
+ FOriginalObjectsCount: Integer; { used for TfrxSubReport.PrintOnParent }
+ FHasVBands: Boolean; { whether the band should show vbands }
+ FStretchedHeight: Double;
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function BandNumber: Integer;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ class function GetDescription: String; override;
+ property AllowSplit: Boolean read FAllowSplit write FAllowSplit default False;
+ property BandName: String read GetBandName;
+ property Child: TfrxChild read FChild write SetChild;
+ property KeepChild: Boolean read FKeepChild write FKeepChild default False;
+ property OutlineText: String read FOutlineText write FOutlineText;
+ property Overflow: Boolean read FOverflow write FOverflow;
+ property PrintChildIfInvisible: Boolean read FPrintChildIfInvisible
+ write FPrintChildIfInvisible default False;
+ property StartNewPage: Boolean read FStartNewPage write FStartNewPage default False;
+ property Stretched: Boolean read FStretched write FStretched default False;
+ published
+ property Font;
+ property Height;
+ property Left;
+ property ParentFont;
+ property Restrictions;
+ property Top;
+ property Vertical: Boolean read FVertical write SetVertical default False;
+ property Visible;
+ property Width;
+ property OnAfterCalcHeight: TfrxNotifyEvent read FOnAfterCalcHeight
+ write FOnAfterCalcHeight;
+ property OnAfterPrint;
+ property OnBeforePrint;
+ end;
+
+ TfrxBandClass = class of TfrxBand;
+
+ TfrxDataBand = class(TfrxBand)
+ private
+ FColumnGap: Double;
+ FColumnWidth: Double;
+ FColumns: Integer;
+ FCurColumn: Integer;
+ FDataSet: TfrxDataSet;
+ FDataSetName: String;
+ FFooterAfterEach: Boolean;
+ FKeepFooter: Boolean;
+ FKeepHeader: Boolean;
+ FKeepTogether: Boolean;
+ FPrintIfDetailEmpty: Boolean;
+ FRowCount: Integer;
+ FOnMasterDetail: TfrxNotifyEvent;
+ FVirtualDataSet: TfrxUserDataSet;
+ procedure SetCurColumn(Value: Integer);
+ procedure SetRowCount(const Value: Integer);
+ procedure SetDataSet(const Value: TfrxDataSet);
+ procedure SetDataSetName(const Value: String);
+ function GetDataSetName: String;
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ public
+ FMaxY: Double; { used for columns }
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ property CurColumn: Integer read FCurColumn write SetCurColumn;
+ property VirtualDataSet: TfrxUserDataSet read FVirtualDataSet;
+ published
+ property AllowSplit;
+ property Child;
+ property Columns: Integer read FColumns write FColumns default 0;
+ property ColumnWidth: Double read FColumnWidth write FColumnWidth;
+ property ColumnGap: Double read FColumnGap write FColumnGap;
+ property DataSet: TfrxDataSet read FDataSet write SetDataSet;
+ property DataSetName: String read GetDataSetName write SetDataSetName;
+ property FooterAfterEach: Boolean read FFooterAfterEach write FFooterAfterEach default False;
+ property KeepChild;
+ property KeepFooter: Boolean read FKeepFooter write FKeepFooter default False;
+ property KeepHeader: Boolean read FKeepHeader write FKeepHeader default False;
+ property KeepTogether: Boolean read FKeepTogether write FKeepTogether default False;
+ property OutlineText;
+ property PrintChildIfInvisible;
+ property PrintIfDetailEmpty: Boolean read FPrintIfDetailEmpty
+ write FPrintIfDetailEmpty default False;
+ property RowCount: Integer read FRowCount write SetRowCount;
+ property StartNewPage;
+ property Stretched;
+ property OnMasterDetail: TfrxNotifyEvent read FOnMasterDetail write FOnMasterDetail;
+ end;
+
+ TfrxHeader = class(TfrxBand)
+ private
+ FReprintOnNewPage: Boolean;
+ published
+ property AllowSplit;
+ property Child;
+ property KeepChild;
+ property PrintChildIfInvisible;
+ property ReprintOnNewPage: Boolean read FReprintOnNewPage write FReprintOnNewPage default False;
+ property StartNewPage;
+ property Stretched;
+ end;
+
+ TfrxFooter = class(TfrxBand)
+ private
+ public
+ published
+ property AllowSplit;
+ property Child;
+ property KeepChild;
+ property PrintChildIfInvisible;
+ property Stretched;
+ end;
+
+ TfrxMasterData = class(TfrxDataBand)
+ private
+ public
+ published
+ end;
+
+ TfrxDetailData = class(TfrxDataBand)
+ private
+ public
+ published
+ end;
+
+ TfrxSubdetailData = class(TfrxDataBand)
+ private
+ public
+ published
+ end;
+
+ TfrxDataBand4 = class(TfrxDataBand)
+ private
+ public
+ published
+ end;
+
+ TfrxDataBand5 = class(TfrxDataBand)
+ private
+ public
+ published
+ end;
+
+ TfrxDataBand6 = class(TfrxDataBand)
+ private
+ public
+ published
+ end;
+
+ TfrxPageHeader = class(TfrxBand)
+ private
+ FPrintOnFirstPage: Boolean;
+ public
+ constructor Create(AOwner: TComponent); override;
+ published
+ property Child;
+ property PrintChildIfInvisible;
+ property PrintOnFirstPage: Boolean read FPrintOnFirstPage write FPrintOnFirstPage default True;
+ property Stretched;
+ end;
+
+ TfrxPageFooter = class(TfrxBand)
+ private
+ FPrintOnFirstPage: Boolean;
+ FPrintOnLastPage: Boolean;
+ public
+ constructor Create(AOwner: TComponent); override;
+ published
+ property PrintOnFirstPage: Boolean read FPrintOnFirstPage write FPrintOnFirstPage default True;
+ property PrintOnLastPage: Boolean read FPrintOnLastPage write FPrintOnLastPage default True;
+ end;
+
+ TfrxColumnHeader = class(TfrxBand)
+ private
+ public
+ published
+ property Child;
+ property Stretched;
+ end;
+
+ TfrxColumnFooter = class(TfrxBand)
+ private
+ public
+ published
+ end;
+
+ TfrxGroupHeader = class(TfrxBand)
+ private
+ FCondition: String;
+ FDrillName: String; { used instead Tag property in drill down }
+ FDrillDown: Boolean;
+ FExpandDrillDown: Boolean;
+ FShowFooterIfDrillDown: Boolean;
+ FShowChildIfDrillDown: Boolean;
+ FKeepTogether: Boolean;
+ FReprintOnNewPage: Boolean;
+ FResetPageNumbers: Boolean;
+ public
+ FLastValue: Variant;
+ function Diff(AComponent: TfrxComponent): String; override;
+ published
+ property AllowSplit;
+ property Child;
+ property Condition: String read FCondition write FCondition;
+ property DrillDown: Boolean read FDrillDown write FDrillDown default False;
+ property ExpandDrillDown: Boolean read FExpandDrillDown write FExpandDrillDown default False;
+ property KeepChild;
+ property KeepTogether: Boolean read FKeepTogether write FKeepTogether default False;
+ property ReprintOnNewPage: Boolean read FReprintOnNewPage write FReprintOnNewPage default False;
+ property OutlineText;
+ property PrintChildIfInvisible;
+ property ResetPageNumbers: Boolean read FResetPageNumbers write FResetPageNumbers default False;
+ property ShowFooterIfDrillDown: Boolean read FShowFooterIfDrillDown
+ write FShowFooterIfDrillDown default False;
+ property ShowChildIfDrillDown: Boolean read FShowChildIfDrillDown
+ write FShowChildIfDrillDown default False;
+ property StartNewPage;
+ property Stretched;
+ property DrillName: String read FDrillName write FDrillName;
+ end;
+
+ TfrxGroupFooter = class(TfrxBand)
+ private
+ FHideIfSingleDataRecord: Boolean;
+ public
+ published
+ property AllowSplit;
+ property Child;
+ property HideIfSingleDataRecord: Boolean read FHideIfSingleDataRecord
+ write FHideIfSingleDataRecord default False;
+ property KeepChild;
+ property PrintChildIfInvisible;
+ property Stretched;
+ end;
+
+ TfrxReportTitle = class(TfrxBand)
+ private
+ public
+ published
+ property AllowSplit;
+ property Child;
+ property KeepChild;
+ property PrintChildIfInvisible;
+ property StartNewPage;
+ property Stretched;
+ end;
+
+ TfrxReportSummary = class(TfrxBand)
+ private
+ public
+ published
+ property AllowSplit;
+ property Child;
+ property KeepChild;
+ property PrintChildIfInvisible;
+ property StartNewPage;
+ property Stretched;
+ end;
+
+ TfrxChild = class(TfrxBand)
+ private
+ public
+ published
+ property AllowSplit;
+ property Child;
+ property KeepChild;
+ property PrintChildIfInvisible;
+ property StartNewPage;
+ property Stretched;
+ end;
+
+ TfrxOverlay = class(TfrxBand)
+ private
+ FPrintOnTop: Boolean;
+ public
+ published
+ property PrintOnTop: Boolean read FPrintOnTop write FPrintOnTop default False;
+ end;
+
+ TfrxNullBand = class(TfrxBand);
+
+
+{ Pages }
+
+ TfrxPage = class(TfrxComponent)
+ private
+ protected
+ public
+ published
+ property Font;
+ property Visible;
+ end;
+
+ TfrxReportPage = class(TfrxPage)
+ private
+ FBackPicture: TfrxPictureView;
+ FBin: Integer;
+ FBinOtherPages: Integer;
+ FBottomMargin: Double;
+ FColumns: Integer;
+ FColumnWidth: Double;
+ FColumnPositions: TStrings;
+ FDataSet: TfrxDataSet;
+ FDuplex: TfrxDuplexMode;
+ FEndlessHeight: Boolean;
+ FEndlessWidth: Boolean;
+ FHGuides: TStrings;
+ FLargeDesignHeight: Boolean;
+ FLeftMargin: Double;
+ FMirrorMargins: Boolean;
+ FOrientation: TPrinterOrientation;
+ FOutlineText: String;
+ FPrintIfEmpty: Boolean;
+ FPrintOnPreviousPage: Boolean;
+ FResetPageNumbers: Boolean;
+ FRightMargin: Double;
+ FSubReport: TfrxSubreport;
+ FTitleBeforeHeader: Boolean;
+ FTopMargin: Double;
+ FVGuides: TStrings;
+ FOnAfterPrint: TfrxNotifyEvent;
+ FOnBeforePrint: TfrxNotifyEvent;
+ FOnManualBuild: TfrxNotifyEvent;
+ FDataSetName: String;
+ FBackPictureVisible: Boolean;
+ FBackPicturePrintable: Boolean;
+ FPageCount: Integer;
+ procedure SetPageCount(const Value: Integer);
+ procedure SetColumns(const Value: Integer);
+ procedure SetOrientation(Value: TPrinterOrientation);
+ procedure SetHGuides(const Value: TStrings);
+ procedure SetVGuides(const Value: TStrings);
+ procedure SetColumnPositions(const Value: TStrings);
+ procedure SetFrame(const Value: TfrxFrame);
+ function GetFrame: TfrxFrame;
+ function GetColor: TAlphaColor;
+ procedure SetColor(const Value: TAlphaColor);
+ function GetBackPicture: TBitmap;
+ procedure SetBackPicture(const Value: TBitmap);
+ procedure SetDataSet(const Value: TfrxDataSet);
+ procedure SetDataSetName(const Value: String);
+ function GetDataSetName: String;
+ protected
+ FPaperHeight: Double;
+ FPaperSize: Integer;
+ FPaperWidth: Double;
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetPaperHeight(const Value: Double); virtual;
+ procedure SetPaperWidth(const Value: Double); virtual;
+ procedure SetPaperSize(const Value: Integer); virtual;
+ procedure UpdateDimensions;
+ public
+ FSubBands: TList; { list of master bands }
+ FVSubBands: TList; { list of vertical master bands }
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ function FindBand(Band: TfrxBandClass): TfrxBand;
+ function IsSubReport: Boolean;
+ procedure AlignChildren; override;
+ procedure ClearGuides;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
+ procedure SetDefaults; virtual;
+ procedure SetSizeAndDimensions(ASize: Integer; AWidth, AHeight: Double);
+ property SubReport: TfrxSubreport read FSubReport;
+ published
+ { paper }
+ property Orientation: TPrinterOrientation read FOrientation
+ write SetOrientation default poPortrait;
+ property PaperWidth: Double read FPaperWidth write SetPaperWidth;
+ property PaperHeight: Double read FPaperHeight write SetPaperHeight;
+ property PaperSize: Integer read FPaperSize write SetPaperSize;
+ { margins }
+ property LeftMargin: Double read FLeftMargin write FLeftMargin;
+ property RightMargin: Double read FRightMargin write FRightMargin;
+ property TopMargin: Double read FTopMargin write FTopMargin;
+ property BottomMargin: Double read FBottomMargin write FBottomMargin;
+ property MirrorMargins: Boolean read FMirrorMargins write FMirrorMargins
+ default False;
+ { columns }
+ property Columns: Integer read FColumns write SetColumns default 0;
+ property ColumnWidth: Double read FColumnWidth write FColumnWidth;
+ property ColumnPositions: TStrings read FColumnPositions write SetColumnPositions;
+ { bins }
+ property Bin: Integer read FBin write FBin default DMBIN_AUTO;
+ property BinOtherPages: Integer read FBinOtherPages write FBinOtherPages
+ default DMBIN_AUTO;
+ { other }
+ property BackPicture: TBitmap read GetBackPicture write SetBackPicture;
+ property BackPictureVisible: Boolean read FBackPictureVisible write FBackPictureVisible default True;
+ property BackPicturePrintable: Boolean read FBackPicturePrintable write FBackPicturePrintable default True;
+ property PageCount: Integer read FPageCount write SetPageCount default 1;
+ property Color: TAlphaColor read GetColor write SetColor default claNull;
+ property DataSet: TfrxDataSet read FDataSet write SetDataSet;
+ property DataSetName: String read GetDataSetName write SetDataSetName;
+ property Duplex: TfrxDuplexMode read FDuplex write FDuplex default dmNone;
+ property Frame: TfrxFrame read GetFrame write SetFrame;
+ property EndlessHeight: Boolean read FEndlessHeight write FEndlessHeight default False;
+ property EndlessWidth: Boolean read FEndlessWidth write FEndlessWidth default False;
+ property LargeDesignHeight: Boolean read FLargeDesignHeight
+ write FLargeDesignHeight default False;
+ property OutlineText: String read FOutlineText write FOutlineText;
+ property PrintIfEmpty: Boolean read FPrintIfEmpty write FPrintIfEmpty default True;
+ property PrintOnPreviousPage: Boolean read FPrintOnPreviousPage
+ write FPrintOnPreviousPage default False;
+ property ResetPageNumbers: Boolean read FResetPageNumbers
+ write FResetPageNumbers default False;
+ property TitleBeforeHeader: Boolean read FTitleBeforeHeader
+ write FTitleBeforeHeader default True;
+ property HGuides: TStrings read FHGuides write SetHGuides;
+ property VGuides: TStrings read FVGuides write SetVGuides;
+ property OnAfterPrint: TfrxNotifyEvent read FOnAfterPrint write FOnAfterPrint;
+ property OnBeforePrint: TfrxNotifyEvent read FOnBeforePrint write FOnBeforePrint;
+ property OnManualBuild: TfrxNotifyEvent read FOnManualBuild write FOnManualBuild;
+ end;
+
+ TfrxDialogPage = class(TfrxPage)
+ private
+ FBorderStyle: TfmxFormBorderStyle;
+ FCaption: String;
+ FColor: TAlphaColor;
+{$IFDEF LINUX}
+ FForm: TfrxForm;
+{$ELSE}
+ FForm: TForm;
+{$ENDIF}
+ FOnActivate: TfrxNotifyEvent;
+ FOnClick: TfrxNotifyEvent;
+ FOnDeactivate: TfrxNotifyEvent;
+ FOnHide: TfrxNotifyEvent;
+ FOnKeyDown: TfrxKeyEvent;
+ FOnKeyPress: TfrxKeyPressEvent;
+ FOnKeyUp: TfrxKeyEvent;
+ FOnResize: TfrxNotifyEvent;
+ FOnShow: TfrxNotifyEvent;
+ FOnCloseQuery: TfrxCloseQueryEvent;
+ FPosition: TFormPosition;
+ FWindowState: TWindowState;
+ FClientWidth: Double;
+ FClientHeight: Double;
+ procedure DoInitialize;
+ procedure DoOnActivate(Sender: TObject);
+ procedure DoOnCloseQuery(Sender: TObject; var CanClose: Boolean);
+ procedure DoOnDeactivate(Sender: TObject);
+ procedure DoOnResize(Sender: TObject);
+{$IFDEF DELPHI18}
+ procedure DoOnShow(Sender: TObject);
+{$ENDIF}
+ procedure DoModify(Sender: TObject);
+ procedure SetBorderStyle(const Value: TfmxFormBorderStyle);
+ procedure SetCaption(const Value: String);
+ procedure SetColor(const Value: TAlphaColor);
+ function GetModalResult: TModalResult;
+ procedure SetModalResult(const Value: TModalResult);
+ procedure SetPosition(const Value: TFormPosition);
+ protected
+ procedure SetLeft(Value: Double); override;
+ procedure SetTop(Value: Double); override;
+ procedure SetWidth(Value: Double); override;
+ procedure SetHeight(Value: Double); override;
+ procedure SetClientWidth(Value: Double);
+ procedure SetClientHeight(Value: Double);
+ function GetClientWidth: Double;
+ function GetClientHeight: Double;
+ procedure FontChanged(Sender: TObject); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ procedure Initialize;
+ procedure UpdateClientRect;
+ function ShowModal: TModalResult;
+{$IFDEF LINUX}
+ property DialogForm: TfrxForm read FForm;
+{$ELSE}
+ property DialogForm: TForm read FForm;
+{$ENDIF}
+ property ModalResult: TModalResult read GetModalResult write SetModalResult;
+ published
+ property BorderStyle: TfmxFormBorderStyle read FBorderStyle write SetBorderStyle default TfmxFormBorderStyle.bsSizeable;
+ property Caption: String read FCaption write SetCaption;
+ property Color: TAlphaColor read FColor write SetColor default claWhiteSmoke;
+ property Height;
+ property ClientHeight: Double read GetClientHeight write SetClientHeight;
+ property Left;
+ property Position: TFormPosition read FPosition write SetPosition default TFormPosition.poScreenCenter;
+ property Top;
+ property Width;
+ property ClientWidth: Double read GetClientWidth write SetClientWidth;
+ property WindowState: TWindowState read FWindowState write FWindowState default TWindowState.wsNormal;
+ property OnActivate: TfrxNotifyEvent read FOnActivate write FOnActivate;
+ property OnClick: TfrxNotifyEvent read FOnClick write FOnClick;
+ property OnCloseQuery: TfrxCloseQueryEvent read FOnCloseQuery write FOnCloseQuery;
+ property OnDeactivate: TfrxNotifyEvent read FOnDeactivate write FOnDeactivate;
+ property OnHide: TfrxNotifyEvent read FOnHide write FOnHide;
+ property OnKeyDown: TfrxKeyEvent read FOnKeyDown write FOnKeyDown;
+ property OnKeyPress: TfrxKeyPressEvent read FOnKeyPress write FOnKeyPress;
+ property OnKeyUp: TfrxKeyEvent read FOnKeyUp write FOnKeyUp;
+ property OnShow: TfrxNotifyEvent read FOnShow write FOnShow;
+ property OnResize: TfrxNotifyEvent read FOnResize write FOnResize;
+ end;
+
+ TfrxDataPage = class(TfrxPage)
+ private
+ protected
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ published
+ property Height;
+ property Left;
+ property Top;
+ property Width;
+ end;
+
+
+{ Report }
+
+ TfrxEngineOptions = class(TPersistent)
+ private
+ FConvertNulls: Boolean;
+ FDestroyForms: Boolean;
+ FDoublePass: Boolean;
+ FMaxMemSize: Integer;
+ FPrintIfEmpty: Boolean;
+ FReportThread: TThread;
+ FEnableThreadSafe: Boolean;
+ FSilentMode: TfrxSilentMode;
+ FTempDir: String;
+ FUseFileCache: Boolean;
+ FUseGlobalDataSetList: Boolean;
+ FIgnoreDevByZero: Boolean;
+
+ procedure SetSilentMode(Mode: Boolean);
+ function GetSilentMode: Boolean;
+ public
+ constructor Create;
+ procedure Assign(Source: TPersistent); override;
+ procedure Clear;
+ property ReportThread: TThread read FReportThread write FReportThread;
+ property DestroyForms: Boolean read FDestroyForms write FDestroyForms;
+ property EnableThreadSafe: Boolean read FEnableThreadSafe write FEnableThreadSafe;
+ property UseGlobalDataSetList: Boolean read FUseGlobalDataSetList write FUseGlobalDataSetList;
+ published
+ property ConvertNulls: Boolean read FConvertNulls write FConvertNulls default True;
+ property DoublePass: Boolean read FDoublePass write FDoublePass default False;
+ property MaxMemSize: Integer read FMaxMemSize write FMaxMemSize default 10;
+ property PrintIfEmpty: Boolean read FPrintIfEmpty write FPrintIfEmpty default True;
+ property SilentMode: Boolean read GetSilentMode write SetSilentMode default False;
+ property NewSilentMode: TfrxSilentMode read FSilentMode write FSilentMode default simMessageBoxes;
+ property TempDir: String read FTempDir write FTempDir;
+ property UseFileCache: Boolean read FUseFileCache write FUseFileCache default False;
+ property IgnoreDevByZero: Boolean read FIgnoreDevByZero write FIgnoreDevByZero default False;
+ end;
+
+ TfrxPrintOptions = class(TPersistent)
+ private
+ FCopies: Integer;
+ FCollate: Boolean;
+ FPageNumbers: String;
+ FPagesOnSheet: Integer;
+ FPrinter: String;
+ FPrintMode: TfrxPrintMode;
+ FPrintOnSheet: Integer;
+ FPrintPages: TfrxPrintPages;
+ FReverse: Boolean;
+ FShowDialog: Boolean;
+ FSwapPageSize: Boolean;
+ FPrnOutFileName: String;
+ FDuplex: TfrxDuplexMode;
+ FSplicingLine: Integer;
+ public
+ constructor Create;
+ procedure Assign(Source: TPersistent); override;
+ procedure Clear;
+ property PrnOutFileName: String read FPrnOutFileName write FPrnOutFileName;
+ property Duplex: TfrxDuplexMode read FDuplex write FDuplex;// set only after prepare report, need to store global duplex
+ property SplicingLine: Integer read FSplicingLine write FSplicingLine default 3;
+ published
+ property Copies: Integer read FCopies write FCopies default 1;
+ property Collate: Boolean read FCollate write FCollate default True;
+ property PageNumbers: String read FPageNumbers write FPageNumbers;
+ property Printer: String read FPrinter write FPrinter;
+ property PrintMode: TfrxPrintMode read FPrintMode write FPrintMode default pmDefault;
+ property PrintOnSheet: Integer read FPrintOnSheet write FPrintOnSheet;
+ property PrintPages: TfrxPrintPages read FPrintPages write FPrintPages default ppAll;
+ property Reverse: Boolean read FReverse write FReverse default False;
+ property ShowDialog: Boolean read FShowDialog write FShowDialog default True;
+ property SwapPageSize: Boolean read FSwapPageSize write FSwapPageSize stored False;// remove it
+ end;
+
+ TfrxPreviewOptions = class(TPersistent)
+ private
+ FAllowEdit: Boolean;
+ FButtons: TfrxPreviewButtons;
+ FDoubleBuffered: Boolean;
+ FMaximized: Boolean;
+ FMDIChild: Boolean;
+ FModal: Boolean;
+ FOutlineExpand: Boolean;
+ FOutlineVisible: Boolean;
+ FOutlineWidth: Integer;
+ FPagesInCache: Integer;
+ FShowCaptions: Boolean;
+ FThumbnailVisible: Boolean;
+ FZoom: Double;
+ FZoomMode: TfrxZoomMode;
+ FPictureCacheInFile: Boolean;
+ FRTLPreview: Boolean;
+ FPagesInPictureCache: Boolean;
+ FMaxPagePictureWidth: Integer;
+ FMaxPagePictureHeight: Integer;
+ public
+ constructor Create;
+ procedure Assign(Source: TPersistent); override;
+ procedure Clear;
+ property RTLPreview: Boolean read FRTLPreview write FRTLPreview;
+ property PagesInPictureCache: Boolean read FPagesInPictureCache write FPagesInPictureCache default False;
+ property MaxPagePictureWidth: Integer read FMaxPagePictureWidth write FMaxPagePictureWidth default 1600;
+ property MaxPagePictureHeight: Integer read FMaxPagePictureHeight write FMaxPagePictureHeight default 1200;
+ published
+ property AllowEdit: Boolean read FAllowEdit write FAllowEdit default True;
+ property Buttons: TfrxPreviewButtons read FButtons write FButtons;
+ property DoubleBuffered: Boolean read FDoubleBuffered write FDoubleBuffered default True;
+ property Maximized: Boolean read FMaximized write FMaximized default True;
+ property MDIChild: Boolean read FMDIChild write FMDIChild default False;
+ property Modal: Boolean read FModal write FModal default True;
+ property OutlineExpand: Boolean read FOutlineExpand write FOutlineExpand default True;
+ property OutlineVisible: Boolean read FOutlineVisible write FOutlineVisible default False;
+ property OutlineWidth: Integer read FOutlineWidth write FOutlineWidth default 120;
+ property PagesInCache: Integer read FPagesInCache write FPagesInCache default 50;
+ property ThumbnailVisible: Boolean read FThumbnailVisible write FThumbnailVisible default False;
+ property ShowCaptions: Boolean read FShowCaptions write FShowCaptions default False;
+ property Zoom: Double read FZoom write FZoom;
+ property ZoomMode: TfrxZoomMode read FZoomMode write FZoomMode default zmDefault;
+ property PictureCacheInFile: Boolean read FPictureCacheInFile write FPictureCacheInFile default False;
+ end;
+
+ TfrxReportOptions = class(TPersistent)
+ private
+ FAuthor: String;
+ FCompressed: Boolean;
+ FConnectionName: String;
+ FCreateDate: TDateTime;
+ FDescription: TStrings;
+ FInitString: String;
+ FName: String;
+ FLastChange: TDateTime;
+ FPassword: String;
+ FPicture: TBitmap;
+ FReport: TfrxReport;
+ FVersionBuild: String;
+ FVersionMajor: String;
+ FVersionMinor: String;
+ FVersionRelease: String;
+ FPrevPassword: String;
+ FHiddenPassword: String;
+ FInfo: Boolean;
+ FIsFMXReport: Boolean;
+ procedure SetDescription(const Value: TStrings);
+ procedure SetPicture(const Value: TBitmap);
+ public
+ constructor Create(AOwner: TComponent);
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ procedure Clear;
+ function CheckPassword: Boolean;
+ property PrevPassword: String write FPrevPassword;
+ property Info: Boolean read FInfo write FInfo;
+ property HiddenPassword: String read FHiddenPassword write FHiddenPassword;
+ published
+ property Author: String read FAuthor write FAuthor;
+ property Compressed: Boolean read FCompressed write FCompressed default False;
+ property CreateDate: TDateTime read FCreateDate write FCreateDate;
+ property Description: TStrings read FDescription write SetDescription;
+ property InitString: String read FInitString write FInitString;
+ property Name: String read FName write FName;
+ property LastChange: TDateTime read FLastChange write FLastChange;
+ property Password: String read FPassword write FPassword;
+ property Picture: TBitmap read FPicture write SetPicture;
+ property VersionBuild: String read FVersionBuild write FVersionBuild;
+ property VersionMajor: String read FVersionMajor write FVersionMajor;
+ property VersionMinor: String read FVersionMinor write FVersionMinor;
+ property VersionRelease: String read FVersionRelease write FVersionRelease;
+ property IsFMXReport: Boolean read FIsFMXReport write FIsFMXReport;
+ end;
+
+
+ TfrxExpressionCache = class(TObject)
+ private
+ FExpressions: TStringList;
+ FMainScript: TfsScript;
+ FScript: TfsScript;
+ FScriptLanguage: String;
+ procedure SetCaseSensitive(const Value: Boolean);
+ function GetCaseSensitive: Boolean;
+ public
+ constructor Create(AScript: TfsScript);
+ destructor Destroy; override;
+ procedure Clear;
+ function Calc(const Expression: String; var ErrorMsg: String;
+ AScript: TfsScript): Variant;
+ property CaseSensitive: Boolean read GetCaseSensitive write SetCaseSensitive;
+ end;
+
+ TfrxDataSetItem = class(TCollectionItem)
+ private
+ FDataSet: TfrxDataSet;
+ FDataSetName: String;
+ procedure SetDataSet(const Value: TfrxDataSet);
+ procedure SetDataSetName(const Value: String);
+ function GetDataSetName: String;
+ published
+ property DataSet: TfrxDataSet read FDataSet write SetDataSet;
+ property DataSetName: String read GetDataSetName write SetDataSetName;
+ end;
+
+ TfrxReportDataSets = class(TCollection)
+ private
+ FReport: TfrxReport;
+ function GetItem(Index: Integer): TfrxDataSetItem;
+ public
+ constructor Create(AReport: TfrxReport);
+ procedure Initialize;
+ procedure Finalize;
+ procedure Add(ds: TfrxDataSet);
+ function Find(ds: TfrxDataSet): TfrxDataSetItem; overload;
+ function Find(const Name: String): TfrxDataSetItem; overload;
+ procedure Delete(const Name: String); overload;
+ property Items[Index: Integer]: TfrxDataSetItem read GetItem; default;
+ end;
+
+ TfrxStyleItem = class(TCollectionItem)
+ private
+ FName: String;
+ FColor: TAlphaColor;
+ FFont: TfrxFont;
+ FFrame: TfrxFrame;
+ procedure SetFont(const Value: TfrxFont);
+ procedure SetFrame(const Value: TfrxFrame);
+ procedure SetName(const Value: String);
+ public
+ constructor Create(Collection: TCollection); override;
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ procedure CreateUniqueName;
+ published
+ property Name: String read FName write SetName;
+ property Color: TAlphaColor read FColor write FColor;
+ property Font: TfrxFont read FFont write SetFont;
+ property Frame: TfrxFrame read FFrame write SetFrame;
+ end;
+
+ TfrxStyles = class(TCollection)
+ private
+ FName: String;
+ FReport: TfrxReport;
+ function GetItem(Index: Integer): TfrxStyleItem;
+ public
+ constructor Create(AReport: TfrxReport);
+ function Add: TfrxStyleItem;
+ function Find(const Name: String): TfrxStyleItem;
+ procedure Apply;
+ procedure GetList(List: TStrings);
+ procedure LoadFromFile(const FileName: String);
+ procedure LoadFromStream(Stream: TStream);
+ procedure LoadFromXMLItem(Item: TfrxXMLItem; OldXMLFormat: Boolean = True);
+ procedure SaveToFile(const FileName: String);
+ procedure SaveToStream(Stream: TStream);
+ procedure SaveToXMLItem(Item: TfrxXMLItem);
+ property Items[Index: Integer]: TfrxStyleItem read GetItem; default;
+ property Name: String read FName write FName;
+ end;
+
+ TfrxStyleSheet = class(TObject)
+ private
+ FItems: TList;
+ function GetItems(Index: Integer): TfrxStyles;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Clear;
+ procedure Delete(Index: Integer);
+ procedure GetList(List: TStrings);
+ procedure LoadFromFile(const FileName: String);
+ procedure LoadFromStream(Stream: TStream);
+ procedure SaveToFile(const FileName: String);
+ procedure SaveToStream(Stream: TStream);
+ function Add: TfrxStyles;
+ function Count: Integer;
+ function Find(const Name: String): TfrxStyles;
+ function IndexOf(const Name: String): Integer;
+ property Items[Index: Integer]: TfrxStyles read GetItems; default;
+ end;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxReport = class(TfrxComponent)
+ private
+{$IFNDEF MSWINDOWS}
+{$IFDEF DELPHI17}
+ FRAppService: IFMXApplicationService;
+{$ENDIF}
+{$ENDIF}
+ FCurObject: String;
+ FDataSet: TfrxDataSet;
+ FDataSetName: String;
+ FDataSets: TfrxReportDatasets;
+ FDesigner: TfrxCustomDesigner;
+ FDotMatrixReport: Boolean;
+ FDrawText: Pointer;
+ FDrillState: TStrings;
+ FEnabledDataSets: TfrxReportDataSets;
+ FEngine: TfrxCustomEngine;
+ FEngineOptions: TfrxEngineOptions;
+ FErrors: TStrings;
+ FExpressionCache: TfrxExpressionCache;
+ FFileName: String;
+ FIniFile: String;
+ FLoadStream: TStream;
+ FLocalValue: TfsCustomVariable;
+ FSelfValue: TfsCustomVariable;
+ FModified: Boolean;
+ FOldStyleProgress: Boolean;
+ FParentForm: TForm;
+ FParentReport: String;
+ FParentReportObject: TfrxReport;
+ FPreviewPages: TfrxCustomPreviewPages;
+ FPreview: TfrxCustomPreview;
+ FPreviewForm: TForm;
+ FPreviewOptions: TfrxPreviewOptions;
+ FPrintOptions: TfrxPrintOptions;
+ FProgress: TfrxProgress;
+ FReloading: Boolean;
+ FReportOptions: TfrxReportOptions;
+ FScript: TfsScript;
+ FScriptLanguage: String;
+ FScriptText: TStrings;
+ FFakeScriptText: TStrings; {fake object}
+ FShowProgress: Boolean;
+ FStoreInDFM: Boolean;
+ FStyles: TfrxStyles;
+ FSysVariables: TStrings;
+ FTerminated: Boolean;
+ FTimer: TTimer;
+ FVariables: TfrxVariables;
+ FVersion: String;
+ FXMLSerializer: TObject;
+ FStreamLoaded: Boolean;
+ FDrawBitmap: TBitmap;
+
+ FOnAfterPrint: TfrxBeforePrintEvent;
+ FOnAfterPrintReport: TNotifyEvent;
+ FOnBeforeConnect: TfrxBeforeConnectEvent;
+ FOnAfterDisconnect: TfrxAfterDisconnectEvent;
+ FOnBeforePrint: TfrxBeforePrintEvent;
+ FOnBeginDoc: TNotifyEvent;
+ FOnClickObject: TfrxClickObjectEvent;
+ FOnDblClickObject: TfrxClickObjectEvent;
+ FOnEditConnection: TfrxEditConnectionEvent;
+ FOnEndDoc: TNotifyEvent;
+ FOnGetValue: TfrxGetValueEvent;
+ FOnNewGetValue: TfrxNewGetValueEvent;
+ FOnLoadTemplate: TfrxLoadTemplateEvent;
+ FOnManualBuild: TfrxManualBuildEvent;
+ FOnMouseOverObject: TfrxMouseOverObjectEvent;
+ FOnPreview: TNotifyEvent;
+ FOnPrintPage: TfrxPrintPageEvent;
+ FOnPrintReport: TNotifyEvent;
+ FOnProgressStart: TfrxProgressEvent;
+ FOnProgress: TfrxProgressEvent;
+ FOnProgressStop: TfrxProgressEvent;
+ FOnRunDialogs: TfrxRunDialogsEvent;
+ FOnSetConnection: TfrxSetConnectionEvent;
+ FOnStartReport: TfrxNotifyEvent;
+ FOnStopReport: TfrxNotifyEvent;
+ FOnUserFunction: TfrxUserFunctionEvent;
+ FOnClosePreview: TNotifyEvent;
+ FOnReportPrint: TfrxNotifyEvent;
+ FOnAfterScriptCompile: TNotifyEvent;
+
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; var Params: Variant): Variant;
+ function DoGetValue(const Expr: String; var Value: Variant): Boolean;
+ function GetScriptValue(Instance: TObject; ClassType: TClass;
+ const MethodName: String; var Params: Variant): Variant;
+ function SetScriptValue(Instance: TObject; ClassType: TClass;
+ const MethodName: String; var Params: Variant): Variant;
+ function DoUserFunction(Instance: TObject; ClassType: TClass;
+ const MethodName: String; var Params: Variant): Variant;
+ function GetDataSetName: String;
+ function GetLocalValue: Variant;
+ function GetSelfValue: TfrxView;
+ function GetPages(Index: Integer): TfrxPage;
+ function GetPagesCount: Integer;
+ function GetCaseSensitive: Boolean;
+ function GetScriptText: TStrings;
+ procedure AncestorNotFound(Reader: TReader; const ComponentName: string;
+ ComponentClass: TPersistentClass; var Component: TComponent);
+ procedure DoClear;
+ procedure DoGetAncestor(const Name: String; var Ancestor: TPersistent);
+ procedure DoLoadFromStream;
+ procedure OnTimer(Sender: TObject);
+ procedure ReadDatasets(Reader: TReader);
+ procedure ReadStyle(Reader: TReader);
+ procedure ReadVariables(Reader: TReader);
+ procedure SetDataSet(const Value: TfrxDataSet);
+ procedure SetDataSetName(const Value: String);
+ procedure SetEngineOptions(const Value: TfrxEngineOptions);
+ procedure SetSelfValue(const Value: TfrxView);
+ procedure SetLocalValue(const Value: Variant);
+ procedure SetParentReport(const Value: String);
+ procedure SetPreviewOptions(const Value: TfrxPreviewOptions);
+ procedure SetPrintOptions(const Value: TfrxPrintOptions);
+ procedure SetReportOptions(const Value: TfrxReportOptions);
+ procedure SetScriptText(const Value: TStrings);
+ procedure SetStyles(const Value: TfrxStyles);
+ procedure SetTerminated(const Value: Boolean);
+ procedure SetCaseSensitive(const Value: Boolean);
+ procedure WriteDatasets(Writer: TWriter);
+ procedure WriteStyle(Writer: TWriter);
+ procedure WriteVariables(Writer: TWriter);
+ procedure SetPreview(const Value: TfrxCustomPreview);
+ procedure SetVersion(const Value: String);
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Clear; override;
+ class function GetDescription: String; override;
+ function GetDrawBitmap: TBitmap;
+
+ { internal methods }
+ function Calc(const Expr: String; AScript: TfsScript = nil): Variant;
+ function DesignPreviewPage: Boolean;
+ function GetAlias(DataSet: TfrxDataSet): String;
+ function GetDataset(const Alias: String): TfrxDataset;
+ function GetIniFile: TCustomIniFile;
+ function GetApplicationFolder: String;
+ function PrepareScript: Boolean;
+ function InheritFromTemplate(const templName: String; InheriteMode: TfrxInheriteMode = imDefault): Boolean;
+ procedure DesignReport(IDesigner: IUnknown; Editor: TObject); overload;
+ procedure DoNotifyEvent(Obj: TObject; const EventName: String;
+ RunAlways: Boolean = False);
+ procedure DoParamEvent(const EventName: String; var Params: Variant;
+ RunAlways: Boolean = False);
+ procedure DoAfterPrint(c: TfrxReportComponent);
+ procedure DoBeforePrint(c: TfrxReportComponent);
+ procedure DoPreviewClick(v: TfrxView; Button: TMouseButton;
+ Shift: TShiftState; var Modified: Boolean; DblClick: Boolean = False);
+ procedure GetDatasetAndField(const ComplexName: String;
+ var Dataset: TfrxDataset; var Field: String);
+ procedure GetDataSetList(List: TStrings; OnlyDB: Boolean = False);
+ procedure GetActiveDataSetList(List: TStrings);
+ procedure InternalOnProgressStart(ProgressType: TfrxProgressType); virtual;
+ procedure InternalOnProgress(ProgressType: TfrxProgressType; Progress: Integer); virtual;
+ procedure InternalOnProgressStop(ProgressType: TfrxProgressType); virtual;
+ procedure SelectPrinter;
+ procedure SetProgressMessage(const Value: String; Ishint: Boolean = False);
+ procedure CheckDataPage;
+ procedure AppHandleMessage;
+
+ { public methods }
+ function LoadFromFile(const FileName: String;
+ ExceptionIfNotFound: Boolean = False): Boolean;
+ procedure LoadFromStream(Stream: TStream); override;
+ procedure SaveToFile(const FileName: String);
+ procedure SaveToStream(Stream: TStream; SaveChildren: Boolean = True;
+ SaveDefaultValues: Boolean = False; UseGetAncestor: Boolean = False); override;
+ procedure DesignReport(Modal: Boolean = True; MDIChild: Boolean = False); overload; stdcall;
+ function PrepareReport(ClearLastReport: Boolean = True): Boolean;
+ procedure ShowPreparedReport; stdcall;
+ procedure ShowReport(ClearLastReport: Boolean = True); stdcall;
+ procedure AddFunction(const FuncName: String; const Category: String = '';
+ const Description: String = '');
+ function Print: Boolean; stdcall;
+ function Export(Filter: TfrxCustomExportFilter): Boolean;
+
+ { internals }
+ property CurObject: String read FCurObject write FCurObject;
+ property DrillState: TStrings read FDrillState;
+ property LocalValue: Variant read GetLocalValue write SetLocalValue;
+ property SelfValue: TfrxView read GetSelfValue write SetSelfValue;
+ property PreviewForm: TForm read FPreviewForm;
+ property XMLSerializer: TObject read FXMLSerializer;
+ property Reloading: Boolean read FReloading write FReloading;
+
+ { public }
+ property DataSets: TfrxReportDataSets read FDataSets;
+ property Designer: TfrxCustomDesigner read FDesigner write FDesigner;
+ property EnabledDataSets: TfrxReportDataSets read FEnabledDataSets;
+ property Engine: TfrxCustomEngine read FEngine;
+ property Errors: TStrings read FErrors;
+ property FileName: String read FFileName write FFileName;
+ property Modified: Boolean read FModified write FModified;
+ property PreviewPages: TfrxCustomPreviewPages read FPreviewPages;
+ property Pages[Index: Integer]: TfrxPage read GetPages;
+ property PagesCount: Integer read GetPagesCount;
+ property Script: TfsScript read FScript;
+ property Styles: TfrxStyles read FStyles write SetStyles;
+ property Terminated: Boolean read FTerminated write SetTerminated;
+ property Variables: TfrxVariables read FVariables;
+ property CaseSensitiveExpressions: Boolean read GetCaseSensitive write SetCaseSensitive;
+
+ property OnEditConnection: TfrxEditConnectionEvent read FOnEditConnection write FOnEditConnection;
+ property OnSetConnection: TfrxSetConnectionEvent read FOnSetConnection write FOnSetConnection;
+ published
+ property Version: String read FVersion write SetVersion;
+ property ParentReport: String read FParentReport write SetParentReport;
+ property DataSet: TfrxDataSet read FDataSet write SetDataSet;
+ property DataSetName: String read GetDataSetName write SetDataSetName;
+ property DotMatrixReport: Boolean read FDotMatrixReport write FDotMatrixReport;
+ property EngineOptions: TfrxEngineOptions read FEngineOptions write SetEngineOptions;
+ property IniFile: String read FIniFile write FIniFile;
+ property OldStyleProgress: Boolean read FOldStyleProgress write FOldStyleProgress default True;
+ property Preview: TfrxCustomPreview read FPreview write SetPreview;
+ property PreviewOptions: TfrxPreviewOptions read FPreviewOptions write SetPreviewOptions;
+ property PrintOptions: TfrxPrintOptions read FPrintOptions write SetPrintOptions;
+ property ReportOptions: TfrxReportOptions read FReportOptions write SetReportOptions;
+ property ScriptLanguage: String read FScriptLanguage write FScriptLanguage;
+ property ScriptText: TStrings read GetScriptText write SetScriptText;
+ property ShowProgress: Boolean read FShowProgress write FShowProgress default True;
+ property StoreInDFM: Boolean read FStoreInDFM write FStoreInDFM default True;
+
+ property OnAfterPrint: TfrxBeforePrintEvent read FOnAfterPrint write FOnAfterPrint;
+ property OnBeforeConnect: TfrxBeforeConnectEvent read FOnBeforeConnect write FOnBeforeConnect;
+ property OnAfterDisconnect: TfrxAfterDisconnectEvent read FOnAfterDisconnect write FOnAfterDisconnect;
+ property OnBeforePrint: TfrxBeforePrintEvent read FOnBeforePrint write FOnBeforePrint;
+ property OnBeginDoc: TNotifyEvent read FOnBeginDoc write FOnBeginDoc;
+ property OnClickObject: TfrxClickObjectEvent read FOnClickObject write FOnClickObject;
+ property OnDblClickObject: TfrxClickObjectEvent read FOnDblClickObject write FOnDblClickObject;
+ property OnEndDoc: TNotifyEvent read FOnEndDoc write FOnEndDoc;
+ property OnGetValue: TfrxGetValueEvent read FOnGetValue write FOnGetValue;
+ property OnNewGetValue: TfrxNewGetValueEvent read FOnNewGetValue write FOnNewGetValue;
+ property OnManualBuild: TfrxManualBuildEvent read FOnManualBuild write FOnManualBuild;
+ property OnMouseOverObject: TfrxMouseOverObjectEvent read FOnMouseOverObject
+ write FOnMouseOverObject;
+ property OnPreview: TNotifyEvent read FOnPreview write FOnPreview;
+ property OnPrintPage: TfrxPrintPageEvent read FOnPrintPage write FOnPrintPage;
+ property OnPrintReport: TNotifyEvent read FOnPrintReport write FOnPrintReport;
+ property OnAfterPrintReport: TNotifyEvent read FOnAfterPrintReport write FOnAfterPrintReport;
+ property OnProgressStart: TfrxProgressEvent read FOnProgressStart write FOnProgressStart;
+ property OnProgress: TfrxProgressEvent read FOnProgress write FOnProgress;
+ property OnProgressStop: TfrxProgressEvent read FOnProgressStop write FOnProgressStop;
+ property OnRunDialogs: TfrxRunDialogsEvent read FOnRunDialogs write FOnRunDialogs;
+ property OnStartReport: TfrxNotifyEvent read FOnStartReport write FOnStartReport;
+ property OnStopReport: TfrxNotifyEvent read FOnStopReport write FOnStopReport;
+ property OnUserFunction: TfrxUserFunctionEvent read FOnUserFunction write FOnUserFunction;
+ property OnLoadTemplate: TfrxLoadTemplateEvent read FOnLoadTemplate write FOnLoadTemplate;
+ property OnClosePreview: TNotifyEvent read FOnClosePreview write FOnClosePreview;
+ property OnReportPrint: TfrxNotifyEvent read FOnReportPrint write FOnReportPrint;
+ property OnAfterScriptCompile: TNotifyEvent read FOnAfterScriptCompile write FOnAfterScriptCompile;
+ end;
+
+ TfrxCustomDesigner = class(TfrxForm)
+ private
+ FReport: TfrxReport;
+ FIsPreviewDesigner: Boolean;
+ FMemoFontName: String;
+ FMemoFontSize: Integer;
+ FUseObjectFont: Boolean;
+ FParentForm: TForm;
+ protected
+ FModified: Boolean;
+ FObjects: TList;
+ FPage: TfrxPage;
+ FSelectedObjects: TList;
+ procedure SetModified(const Value: Boolean); virtual;
+ procedure SetPage(const Value: TfrxPage); virtual;
+ function GetCode: TStrings; virtual; abstract;
+ public
+ constructor CreateDesigner(AOwner: TComponent; AReport: TfrxReport;
+ APreviewDesigner: Boolean = False);
+ destructor Destroy; override;
+ procedure FormShow(Sender: TObject); virtual; abstract;
+ function InsertExpression(const Expr: String): String; virtual; abstract;
+ procedure Lock; virtual; abstract;
+ procedure ReloadPages(Index: Integer); virtual; abstract;
+ procedure ReloadReport; virtual; abstract;
+ procedure UpdateDataTree; virtual; abstract;
+ procedure UpdatePage; virtual; abstract;
+ procedure UpdateInspector; virtual; abstract;
+ procedure Done; virtual; abstract;
+ procedure Init; virtual; abstract;
+ property IsPreviewDesigner: Boolean read FIsPreviewDesigner;
+ property Modified: Boolean read FModified write SetModified;
+ property Objects: TList read FObjects;
+ property Report: TfrxReport read FReport;
+ property SelectedObjects: TList read FSelectedObjects;
+ property Page: TfrxPage read FPage write SetPage;
+ property Code: TStrings read GetCode;
+ property UseObjectFont: Boolean read FUseObjectFont write FUseObjectFont;
+ property MemoFontName: String read FMemoFontName write FMemoFontName;
+ property MemoFontSize: Integer read FMemoFontSize write FMemoFontSize;
+ property ParentForm: TForm read FParentForm write FParentForm;
+ end;
+
+ TfrxDesignerClass = class of TfrxCustomDesigner;
+
+ TfrxCustomExportFilter = class(TComponent)
+ private
+ FCurPage: Boolean;
+ FExportNotPrintable: Boolean;
+ FName: String;
+ FNoRegister: Boolean;
+ FPageNumbers: String;
+ FReport: TfrxReport;
+ FShowDialog: Boolean;
+ FStream: TStream;
+ FUseFileCache: Boolean;
+ FDefaultPath: String;
+ FSlaveExport: Boolean;
+ FShowProgress: Boolean;
+ FDefaultExt: String;
+ FFilterDesc: String;
+ FSuppressPageHeadersFooters: Boolean;
+ FTitle: String;
+ FOverwritePrompt: Boolean;
+ FFIles: TStrings;
+ FOnBeginExport: TNotifyEvent;
+ FCreationTime: TDateTime;
+ FDataOnly: Boolean;
+ protected
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor CreateNoRegister;
+ destructor Destroy; override;
+ class function GetDescription: String; virtual;
+ function ShowModal: TModalResult; virtual;
+ function Start: Boolean; virtual;
+ procedure ExportObject(Obj: TfrxComponent); virtual; abstract;
+ procedure Finish; virtual;
+ procedure FinishPage(Page: TfrxReportPage; Index: Integer); virtual;
+ procedure StartPage(Page: TfrxReportPage; Index: Integer); virtual;
+
+ property CurPage: Boolean read FCurPage write FCurPage;
+ property PageNumbers: String read FPageNumbers write FPageNumbers;
+ property Report: TfrxReport read FReport write FReport;
+ property Stream: TStream read FStream write FStream;
+ property SlaveExport: Boolean read FSlaveExport write FSlaveExport;
+ property DefaultExt: String read FDefaultExt write FDefaultExt;
+ property FilterDesc: String read FFilterDesc write FFilterDesc;
+ property SuppressPageHeadersFooters: Boolean read FSuppressPageHeadersFooters
+ write FSuppressPageHeadersFooters;
+ property ExportTitle: String read FTitle write FTitle;
+ property Files: TStrings read FFiles write FFiles;
+ published
+ property ShowDialog: Boolean read FShowDialog write FShowDialog default True;
+ property FileName: String read FName write FName;
+ property ExportNotPrintable: Boolean read FExportNotPrintable write FExportNotPrintable default False;
+ property UseFileCache: Boolean read FUseFileCache write FUseFileCache;
+ property DefaultPath: String read FDefaultPath write FDefaultPath;
+ property ShowProgress: Boolean read FShowProgress write FShowProgress;
+ property OverwritePrompt: Boolean read FOverwritePrompt write FOverwritePrompt;
+ property CreationTime: TDateTime read FCreationTime write FCreationTime;
+ property DataOnly: Boolean read FDataOnly write FDataOnly;
+
+ property OnBeginExport: TNotifyEvent read FOnBeginExport write FOnBeginExport;
+ end;
+
+ TfrxCustomWizard = class(TComponent)
+ private
+ FDesigner: TfrxCustomDesigner;
+ FReport: TfrxReport;
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; virtual;
+ function Execute: Boolean; virtual; abstract;
+ property Designer: TfrxCustomDesigner read FDesigner;
+ property Report: TfrxReport read FReport;
+ end;
+
+ TfrxWizardClass = class of TfrxCustomWizard;
+
+ TfrxCustomEngine = class(TPersistent)
+ private
+ FCurColumn: Integer;
+ FCurVColumn: Integer;
+ FCurLine: Integer;
+ FCurLineThrough: Integer;
+ FCurX: Double;
+ FCurY: Double;
+ FFinalPass: Boolean;
+ FNotifyList: TList;
+ FPageHeight: Double;
+ FPageWidth: Double;
+ FPreviewPages: TfrxCustomPreviewPages;
+ FReport: TfrxReport;
+ FRunning: Boolean;
+ FStartDate: TDateTime;
+ FStartTime: TDateTime;
+ FTotalPages: Integer;
+ FOnRunDialog: TfrxRunDialogEvent;
+ FSecondScriptCall: Boolean;
+ function GetDoublePass: Boolean;
+ protected
+ function GetPageHeight: Double; virtual;
+ public
+ constructor Create(AReport: TfrxReport); virtual;
+ destructor Destroy; override;
+ procedure EndPage; virtual; abstract;
+ procedure BreakAllKeep; virtual;
+ procedure NewColumn; virtual; abstract;
+ procedure NewPage; virtual; abstract;
+ procedure ShowBand(Band: TfrxBand); overload; virtual; abstract;
+ procedure ShowBand(Band: TfrxBandClass); overload; virtual; abstract;
+ procedure ShowBandByName(const BandName: String);
+ procedure StopReport;
+ function HeaderHeight: Double; virtual; abstract;
+ function FooterHeight: Double; virtual; abstract;
+ function FreeSpace: Double; virtual; abstract;
+ function GetAggregateValue(const Name, Expression: String;
+ Band: TfrxBand; Flags: Integer): Variant; virtual; abstract;
+ function Run: Boolean; virtual; abstract;
+
+ property CurLine: Integer read FCurLine write FCurLine;
+ property CurLineThrough: Integer read FCurLineThrough write FCurLineThrough;
+ property NotifyList: TList read FNotifyList;
+ property PreviewPages: TfrxCustomPreviewPages read FPreviewPages;
+ property Report: TfrxReport read FReport;
+ property Running: Boolean read FRunning write FRunning;
+ property OnRunDialog: TfrxRunDialogEvent read FOnRunDialog write FOnRunDialog;
+ published
+ property CurColumn: Integer read FCurColumn write FCurColumn;
+ property CurVColumn: Integer read FCurVColumn write FCurVColumn;
+ property CurX: Double read FCurX write FCurX;
+ property CurY: Double read FCurY write FCurY;
+ property DoublePass: Boolean read GetDoublePass;
+ property FinalPass: Boolean read FFinalPass write FFinalPass;
+ property PageHeight: Double read GetPageHeight write FPageHeight;
+ property PageWidth: Double read FPageWidth write FPageWidth;
+ property StartDate: TDateTime read FStartDate write FStartDate;
+ property StartTime: TDateTime read FStartTime write FStartTime;
+ property TotalPages: Integer read FTotalPages write FTotalPages;
+ property SecondScriptCall: Boolean read FSecondScriptCall write FSecondScriptCall;
+ end;
+
+ TfrxCustomOutline = class(TPersistent)
+ private
+ FCurItem: TfrxXMLItem;
+ FPreviewPages: TfrxCustomPreviewPages;
+ protected
+ function GetCount: Integer; virtual; abstract;
+ public
+ constructor Create(APreviewPages: TfrxCustomPreviewPages); virtual;
+ procedure AddItem(const Text: String; Top: Integer); virtual; abstract;
+ procedure LevelDown(Index: Integer); virtual; abstract;
+ procedure LevelRoot; virtual; abstract;
+ procedure LevelUp; virtual; abstract;
+ procedure GetItem(Index: Integer; var Text: String;
+ var Page, Top: Integer); virtual; abstract;
+ procedure ShiftItems(From: TfrxXMLItem; NewTop: Integer); virtual; abstract;
+ function Engine: TfrxCustomEngine;
+ function GetCurPosition: TfrxXMLItem; virtual; abstract;
+ property Count: Integer read GetCount;
+ property CurItem: TfrxXMLItem read FCurItem write FCurItem;
+ property PreviewPages: TfrxCustomPreviewPages read FPreviewPages;
+ end;
+
+ TfrxCustomPreviewPages = class(TObject)
+ private
+ FAddPageAction: TfrxAddPageAction; { used in the cross-tab renderer }
+ FCurPage: Integer;
+ FCurPreviewPage: Integer;
+ FEngine: TfrxCustomEngine;
+ FFirstPage: Integer; { used in the composite reports }
+ FOutline: TfrxCustomOutline;
+ FReport: TfrxReport;
+ protected
+ function GetCount: Integer; virtual; abstract;
+ function GetPage(Index: Integer): TfrxReportPage; virtual; abstract;
+ function GetPageSize(Index: Integer): TPoint; virtual; abstract;
+ public
+ constructor Create(AReport: TfrxReport); virtual;
+ destructor Destroy; override;
+ procedure Clear; virtual; abstract;
+ procedure Initialize; virtual; abstract;
+
+ procedure AddObject(Obj: TfrxComponent); virtual; abstract;
+ procedure AddPage(Page: TfrxReportPage); virtual; abstract;
+ procedure AddSourcePage(Page: TfrxReportPage); virtual; abstract;
+ procedure AddToSourcePage(Obj: TfrxComponent); virtual; abstract;
+ procedure BeginPass; virtual; abstract;
+ procedure ClearFirstPassPages; virtual; abstract;
+ procedure CutObjects(APosition: Integer); virtual; abstract;
+ procedure Finish; virtual; abstract;
+ procedure IncLogicalPageNumber; virtual; abstract;
+ procedure ResetLogicalPageNumber; virtual; abstract;
+ procedure PasteObjects(X, Y: Extended); virtual; abstract;
+ procedure ShiftAnchors(From, NewTop: Integer); virtual; abstract;
+ procedure AddPicture(Picture: TfrxPictureView); virtual; abstract;
+ function BandExists(Band: TfrxBand): Boolean; virtual; abstract;
+ function GetCurPosition: Integer; virtual; abstract;
+ function GetAnchorCurPosition: Integer; virtual; abstract;
+ function GetLastY(ColumnPosition: Extended = 0): Extended; virtual; abstract;
+ function GetLogicalPageNo: Integer; virtual; abstract;
+ function GetLogicalTotalPages: Integer; virtual; abstract;
+
+ procedure AddEmptyPage(Index: Integer); virtual; abstract;
+ procedure DeletePage(Index: Integer); virtual; abstract;
+ procedure ModifyPage(Index: Integer; Page: TfrxReportPage); virtual; abstract;
+ procedure DrawPage(Index: Integer; Canvas: TCanvas; ScaleX, ScaleY,
+ OffsetX, OffsetY: Extended; WorkArea: TRectF); virtual; abstract;
+ procedure ObjectOver(Index: Integer; X, Y: Integer; Button: TMouseButton;
+ Shift: TShiftState; Scale, OffsetX, OffsetY: Extended;
+ Click: Boolean; var Cursor: TCursor; DBClick: Boolean = False); virtual; abstract;
+ procedure AddFrom(Report: TfrxReport); virtual; abstract;
+
+ procedure LoadFromStream(Stream: TStream;
+ AllowPartialLoading: Boolean = False); virtual; abstract;
+ procedure SaveToStream(Stream: TStream); virtual; abstract;
+ function LoadFromFile(const FileName: String;
+ ExceptionIfNotFound: Boolean = False): Boolean; virtual; abstract;
+ procedure SaveToFile(const FileName: String); virtual; abstract;
+ function Print: Boolean; virtual; abstract;
+ function Export(Filter: TfrxCustomExportFilter): Boolean; virtual; abstract;
+
+ property AddPageAction: TfrxAddPageAction read FAddPageAction write FAddPageAction;
+ property Count: Integer read GetCount;
+ property CurPage: Integer read FCurPage write FCurPage;
+ property CurPreviewPage: Integer read FCurPreviewPage write FCurPreviewPage;
+ property Engine: TfrxCustomEngine read FEngine;
+ property FirstPage: Integer read FFirstPage write FFirstPage;
+ property Outline: TfrxCustomOutline read FOutline;
+ property Page[Index: Integer]: TfrxReportPage read GetPage;
+ property PageSize[Index: Integer]: TPoint read GetPageSize;
+ property Report: TfrxReport read FReport;
+ end;
+
+ TfrxCustomPreview = class(TControl)
+ private
+ FPreviewPages: TfrxCustomPreviewPages;
+ FReport: TfrxReport;
+ FUseReportHints: Boolean;
+ public
+ function GetCanvas: TCanvas; virtual; abstract;
+ procedure Init; virtual; abstract;
+ procedure ShowHint(aRect: TRectF; Text: String); virtual; abstract;
+ procedure HideHint; virtual; abstract;
+ procedure ClearBackBuffer; virtual; abstract;
+ procedure Lock; virtual; abstract;
+ procedure Unlock; virtual; abstract;
+ procedure RefreshReport; virtual; abstract;
+ procedure InternalOnProgressStart(Sender: TfrxReport;
+ ProgressType: TfrxProgressType; Progress: Integer); virtual; abstract;
+ procedure InternalOnProgress(Sender: TfrxReport;
+ ProgressType: TfrxProgressType; Progress: Integer); virtual; abstract;
+ procedure InternalOnProgressStop(Sender: TfrxReport;
+ ProgressType: TfrxProgressType; Progress: Integer); virtual; abstract;
+
+ property PreviewPages: TfrxCustomPreviewPages read FPreviewPages write FPreviewPages;
+ property Report: TfrxReport read FReport write FReport;
+ property UseReportHints: Boolean read FUseReportHints write FUseReportHints;
+ end;
+
+ TfrxCompressorClass = class of TfrxCustomCompressor;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxCustomCompressor = class(TComponent)
+ private
+ FIsFR3File: Boolean;
+ FOldCompressor: TfrxCompressorClass;
+ FReport: TfrxReport;
+ FStream: TStream;
+ FTempFile: String;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function Decompress(Source: TStream): Boolean; virtual; abstract;
+ procedure Compress(Dest: TStream); virtual; abstract;
+ procedure CreateStream;
+ property IsFR3File: Boolean read FIsFR3File write FIsFR3File;
+ property Report: TfrxReport read FReport write FReport;
+ property Stream: TStream read FStream write FStream;
+ end;
+
+ TfrxCrypterClass = class of TfrxCustomCrypter;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxCustomCrypter = class(TComponent)
+ private
+ FStream: TStream;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function Decrypt(Source: TStream; const Key: AnsiString): Boolean; virtual; abstract;
+ procedure Crypt(Dest: TStream; const Key: AnsiString); virtual; abstract;
+ procedure CreateStream;
+ property Stream: TStream read FStream write FStream;
+ end;
+
+ TfrxLoadEvent = function(Sender: TfrxReport; Stream: TStream): Boolean of object;
+ TfrxAfterLoadEvent = procedure(Sender: TfrxReport) of object;
+ TfrxGetScriptValueEvent = function(var Params: Variant): Variant of object;
+
+ TfrxConverterEvents = class(TObject)
+ private
+ FOnGetValue: TfrxGetValueEvent;
+ FOnPrepareScript: TNotifyEvent;
+ FOnLoad: TfrxLoadEvent;
+ FOnAfterLoad: TfrxAfterLoadEvent;
+ FOnGetScriptValue: TfrxGetScriptValueEvent;
+ FFilter: String;
+ public
+ property OnGetValue: TfrxGetValueEvent read FOnGetValue write FOnGetValue;
+ property OnPrepareScript: TNotifyEvent read FOnPrepareScript write FOnPrepareScript;
+ property OnLoad: TfrxLoadEvent read FOnLoad write FOnLoad;
+ property OnAfterLoad: TfrxAfterLoadEvent read FOnAfterLoad write FOnAfterLoad;
+ property OnGetScriptValue: TfrxGetScriptValueEvent read FOnGetScriptValue write FOnGetScriptValue;
+ property Filter: String read FFilter write FFilter;
+ end;
+
+ TfrxGlobalDataSetList = class(TList)
+{$IFNDEF NO_CRITICAL_SECTION}
+ FCriticalSection: TCriticalSection;
+{$ENDIF}
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Lock;
+ procedure Unlock;
+ end;
+
+ TfrxCanvasClass = Class of TfrxFastCanvasLayer;
+
+function frxFindDataSet(DataSet: TfrxDataSet; const Name: String;
+ Owner: TComponent): TfrxDataSet;
+procedure frxGetDataSetList(List: TStrings);
+function frxCanvasClass(): TfrxCanvasClass;
+
+var
+ frxDesignerClass: TfrxDesignerClass;
+ frxDotMatrixExport: TfrxCustomExportFilter;
+ frxCompressorClass: TfrxCompressorClass;
+ frxCrypterClass: TfrxCrypterClass;
+ frxConverter: TfrxConverterEvents;
+{$IFNDEF NO_CRITICAL_SECTION}
+ frxCS: TCriticalSection;
+{$ENDIF}
+ frxGlobalVariables: TfrxVariables;
+const
+ FR_VERSION = {$I frxVersion.inc};
+ BND_COUNT = 18;
+ frxBands: array[0..BND_COUNT - 1] of TfrxComponentClass =
+ (TfrxReportTitle, TfrxReportSummary, TfrxPageHeader, TfrxPageFooter,
+ TfrxHeader, TfrxFooter, TfrxMasterData, TfrxDetailData, TfrxSubdetailData,
+ TfrxDataBand4, TfrxDataBand5, TfrxDataBand6, TfrxGroupHeader, TfrxGroupFooter,
+ TfrxChild, TfrxColumnHeader, TfrxColumnFooter, TfrxOverlay);
+
+implementation
+
+//{$R *.RES}
+
+uses
+ System.TypInfo, System.SysConst, System.Math,
+ FMX.frxEngine, FMX.frxPreviewPages, FMX.frxPreview, FMX.frxPrinter,
+ FMX.frxUtils, FMX.frxPassw, FMX.frxDialogForm,
+ FMX.frxXMLSerializer, FMX.frxAggregate, FMX.frxGraphicUtils, FMX.frxRes, FMX.frxDsgnIntf,
+ FMX.frxrcClass, FMX.frxClassRTTI, FMX.frxInheritError,
+ FMX.fs_ipascal, FMX.fs_icpp, FMX.fs_ibasic, FMX.fs_ijs, FMX.fs_iclassesrtti,
+ FMX.fs_igraphicsrtti, FMX.fs_iformsrtti, FMX.fs_idialogsrtti, FMX.fs_iinirtti,
+ FMX.frxDMPClass
+{$IFDEF DELPHI17}
+{$IFDEF MACOS}
+ , Macapi.Foundation, Macapi.AppKit
+{$ENDIF}
+{$ENDIF}
+{$IFDEF POSIX}
+ , Posix.Unistd
+{$ENDIF}
+;
+
+
+var
+ DatasetList: TfrxGlobalDataSetList;
+
+type
+ TByteSet = set of 0..7;
+ PByteSet = ^TByteSet;
+
+ THackControl = class(TControl);
+ THackPersistent = class(TPersistent);
+ THackThread = class(TThread);
+ TParentForm = class(TForm);
+
+function Round8(e: Extended): Extended;
+begin
+ Result := Round(e * 100000000) / 100000000;
+end;
+
+function frxFindDataSet(DataSet: TfrxDataSet; const Name: String;
+ Owner: TComponent): TfrxDataSet;
+var
+ i: Integer;
+ ds: TfrxDataSet;
+begin
+ Result := DataSet;
+ if Name = '' then
+ begin
+ Result := nil;
+ Exit;
+ end;
+ if Owner = nil then Exit;
+ DatasetList.Lock;
+ for i := 0 to DatasetList.Count - 1 do
+ begin
+ ds := DatasetList[i];
+ if frxCompareText(ds.UserName, Name) = 0 then
+ if not ((Owner is TfrxReport) and (ds.Owner is TfrxReport) and
+ (ds.Owner <> Owner)) then
+ begin
+ Result := DatasetList[i];
+ break;
+ end;
+ end;
+ DatasetList.Unlock;
+end;
+
+function frxCanvasClass(): TfrxCanvasClass;
+begin
+{$IFDEF DELPHI19}
+ {$IFDEF LINUX}
+ Result := nil;
+ {$ELSE}
+ {$IFDEF DELPHI27}
+ if GlobalUseMetal then
+ Result := nil
+ else
+ Result := TfrxFastCanvas;
+ {$ELSE}
+ Result := TfrxFastCanvas;
+ {$ENDIF}
+ {$ENDIF}
+{$ELSE}
+ Result := nil;
+{$ENDIF}
+end;
+
+procedure frxGetDataSetList(List: TStrings);
+var
+ i: Integer;
+ ds: TfrxDataSet;
+begin
+ DatasetList.Lock;
+ List.Clear;
+ for i := 0 to DatasetList.Count - 1 do
+ begin
+ ds := DatasetList[i];
+ if (ds <> nil) and (ds.UserName <> '') and ds.Enabled then
+ List.AddObject(ds.UserName, ds);
+ end;
+ DatasetList.Unlock;
+end;
+
+function FloatDiff(const Val1, Val2: Double): Boolean;
+begin
+ Result := Abs(Val1 - Val2) > 1e-4;
+end;
+
+function ShiftToByte(Value: TShiftState): Byte;
+begin
+ Result := Byte(PByteSet(@Value)^);
+end;
+
+
+{ TfrxDataset }
+
+constructor TfrxDataSet.Create(AOwner: TComponent);
+begin
+ inherited;
+ FEnabled := True;
+ FOpenDataSource := True;
+ FRangeBegin := rbFirst;
+ FRangeEnd := reLast;
+ DatasetList.Lock;
+ DatasetList.Add(Self);
+ DatasetList.Unlock;
+end;
+
+destructor TfrxDataSet.Destroy;
+begin
+ DatasetList.Lock;
+ DatasetList.Remove(Self);
+ inherited;
+ DatasetList.Unlock;
+end;
+
+procedure TfrxDataSet.SetName(const NewName: TComponentName);
+begin
+ inherited;
+ if NewName <> '' then
+ if (FUserName = '') or (FUserName = Name) then
+ UserName := NewName
+end;
+
+procedure TfrxDataSet.SetUserName(const Value: String);
+begin
+ if Trim(Value) = '' then
+ raise Exception.Create(frxResources.Get('prInvProp'));
+ FUserName := Value;
+end;
+
+procedure TfrxDataSet.Initialize;
+begin
+end;
+
+procedure TfrxDataSet.Finalize;
+begin
+end;
+
+procedure TfrxDataSet.Close;
+begin
+ if Assigned(FOnClose) then FOnClose(Self);
+end;
+
+procedure TfrxDataSet.Open;
+begin
+ if Assigned(FOnOpen) then FOnOpen(Self);
+end;
+
+procedure TfrxDataSet.First;
+begin
+ FRecNo := 0;
+ FEof := False;
+ if Assigned(FOnFirst) then
+ FOnFirst(Self);
+end;
+
+procedure TfrxDataSet.Next;
+begin
+ FEof := False;
+ Inc(FRecNo);
+ if not ((FRangeEnd = reCount) and (FRecNo >= FRangeEndCount)) then
+ begin
+ if Assigned(FOnNext) then
+ FOnNext(Self);
+ end
+ else
+ begin
+ FRecNo := FRangeEndCount - 1;
+ FEof := True;
+ end;
+end;
+
+procedure TfrxDataSet.Prior;
+begin
+ Dec(FRecNo);
+ if Assigned(FOnPrior) then
+ FOnPrior(Self);
+end;
+
+function TfrxDataSet.Eof: Boolean;
+begin
+ Result := False;
+ if FRangeEnd = reCount then
+ if (FRecNo >= FRangeEndCount) or FEof then
+ Result := True;
+ if Assigned(FOnCheckEOF) then
+ FOnCheckEOF(Self, Result);
+end;
+
+function TfrxDataSet.GetDisplayText(Index: String): WideString;
+begin
+ Result := '';
+end;
+
+function TfrxDataSet.GetDisplayWidth(Index: String): Integer;
+begin
+ Result := 10;
+end;
+
+procedure TfrxDataSet.GetFieldList(List: TStrings);
+begin
+ List.Clear;
+end;
+
+function TfrxDataSet.GetValue(Index: String): Variant;
+begin
+ Result := Null;
+end;
+
+function TfrxDataSet.HasField(const fName: String): Boolean;
+var
+ sl: TStringList;
+begin
+ sl := TStringList.Create;
+ GetFieldList(sl);
+ Result := sl.IndexOf(fName) <> -1;
+ sl.Free;
+end;
+
+procedure TfrxDataSet.AssignBlobTo(const fName: String; Obj: TObject);
+begin
+// empty method
+end;
+
+function TfrxDataSet.IsBlobField(const fName: String): Boolean;
+begin
+ Result := False;
+end;
+
+function TfrxDataSet.FieldsCount: Integer;
+begin
+ Result := 0;
+end;
+
+function TfrxDataSet.GetFieldType(Index: String): TfrxFieldType;
+begin
+ Result := fftNumeric;
+end;
+
+function TfrxDataSet.RecordCount: Integer;
+begin
+ if (RangeBegin = rbFirst) and (RangeEnd = reCount) then
+ Result := RangeEndCount
+ else
+ Result := 0;
+end;
+
+
+{ TfrxUserDataSet }
+
+constructor TfrxUserDataSet.Create(AOwner: TComponent);
+begin
+ inherited;
+ FFields := TStringList.Create;
+end;
+
+destructor TfrxUserDataSet.Destroy;
+begin
+ FFields.Free;
+ inherited;
+end;
+
+procedure TfrxUserDataSet.SetFields(const Value: TStrings);
+begin
+ FFields.Assign(Value);
+end;
+
+procedure TfrxUserDataSet.GetFieldList(List: TStrings);
+begin
+ List.Assign(FFields);
+end;
+
+function TfrxUserDataSet.FieldsCount: Integer;
+begin
+ Result := FFields.Count;
+end;
+
+function TfrxUserDataSet.GetDisplayText(Index: String): WideString;
+var
+ v: Variant;
+begin
+ Result := '';
+ if Assigned(FOnGetValue) then
+ begin
+ v := Null;
+ FOnGetValue(Index, v);
+ Result := VarToWideStr(v);
+ end;
+
+ if Assigned(FOnNewGetValue) then
+ begin
+ v := Null;
+ FOnNewGetValue(Self, Index, v);
+ Result := VarToWideStr(v);
+ end;
+end;
+
+function TfrxUserDataSet.GetValue(Index: String): Variant;
+begin
+ Result := Null;
+ if Assigned(FOnGetValue) then
+ FOnGetValue(Index, Result);
+ if Assigned(FOnNewGetValue) then
+ FOnNewGetValue(Self, Index, Result);
+end;
+
+
+{ TfrxCustomDBDataSet }
+
+constructor TfrxCustomDBDataset.Create(AOwner: TComponent);
+begin
+ FFields := TStringList.Create;
+ FFields.Sorted := True;
+ FFields.Duplicates := dupIgnore;
+ FAliases := TStringList.Create;
+ inherited;
+end;
+
+destructor TfrxCustomDBDataset.Destroy;
+begin
+ FFields.Free;
+ FAliases.Free;
+ inherited;
+end;
+
+procedure TfrxCustomDBDataset.SetFieldAliases(const Value: TStrings);
+begin
+ FAliases.Assign(Value);
+end;
+
+function TfrxCustomDBDataset.ConvertAlias(const fName: String): String;
+var
+ i: Integer;
+ s: String;
+begin
+ Result := fName;
+ for i := 0 to FAliases.Count - 1 do
+ begin
+ s := FAliases[i];
+ if frxCompareText(Copy(s, Pos('=', s) + 1, MaxInt), fName) = 0 then
+ begin
+ Result := FAliases.Names[i];
+ break;
+ end;
+ end;
+end;
+
+function TfrxCustomDBDataset.GetAlias(const fName: String): String;
+var
+ i: Integer;
+begin
+ Result := fName;
+ for i := 0 to FAliases.Count - 1 do
+ if frxCompareText(FAliases.Names[i], fName) = 0 then
+ begin
+ Result := FAliases[i];
+ Result := Copy(Result, Pos('=', Result) + 1, MaxInt);
+ break;
+ end;
+end;
+
+function TfrxCustomDBDataset.FieldsCount: Integer;
+var
+ sl: TStrings;
+begin
+ sl := TStringList.Create;
+ try
+ GetFieldList(sl);
+ finally
+ Result := sl.Count;
+ sl.Free;
+ end;
+end;
+
+{ TfrxDBComponents }
+
+function TfrxDBComponents.GetDescription: String;
+begin
+ Result := '';
+end;
+
+{ TfrxCustomDatabase }
+
+procedure TfrxCustomDatabase.BeforeConnect(var Value: Boolean);
+begin
+ if (Report <> nil) and Assigned(Report.OnBeforeConnect) then
+ Report.OnBeforeConnect(Self, Value);
+end;
+
+procedure TfrxCustomDatabase.AfterDisconnect;
+begin
+ if (Report <> nil) and Assigned(Report.OnAfterDisconnect) then
+ Report.OnAfterDisconnect(Self);
+end;
+
+function TfrxCustomDatabase.GetConnected: Boolean;
+begin
+ Result := False;
+end;
+
+function TfrxCustomDatabase.GetDatabaseName: String;
+begin
+ Result := '';
+end;
+
+function TfrxCustomDatabase.GetLoginPrompt: Boolean;
+begin
+ Result := False;
+end;
+
+function TfrxCustomDatabase.GetParams: TStrings;
+begin
+ Result := nil;
+end;
+
+procedure TfrxCustomDatabase.SetConnected(Value: Boolean);
+begin
+// empty
+end;
+
+procedure TfrxCustomDatabase.SetDatabaseName(const Value: String);
+begin
+// empty
+end;
+
+procedure TfrxCustomDatabase.FromString(const Connection: WideString);
+begin
+// empty
+end;
+
+function TfrxCustomDatabase.ToString: WideString;
+begin
+// empty
+ Result := '';
+end;
+
+
+procedure TfrxCustomDatabase.SetLogin(const Login, Password: String);
+begin
+// empty
+end;
+
+procedure TfrxCustomDatabase.SetLoginPrompt(Value: Boolean);
+begin
+// empty
+end;
+
+procedure TfrxCustomDatabase.SetParams(Value: TStrings);
+begin
+// empty
+end;
+
+
+{ TfrxComponent }
+
+constructor TfrxComponent.Create(AOwner: TComponent);
+begin
+ if AOwner is TfrxComponent then
+ inherited Create(TfrxComponent(AOwner).Report)
+ else
+ inherited Create(AOwner);
+
+ FComponentStyle := [csPreviewVisible];
+ FBaseName := ClassName;
+ Delete(FBaseName, Pos('Tfrx', FBaseName), 4);
+ Delete(FBaseName, Pos('View', FBaseName), 4);
+ FObjects := TList.Create;
+ FAllObjects := TList.Create;
+
+ FFont := TfrxFont.Create;
+ with FFont do
+ begin
+ Name := DefFontName;
+ Size := DefFontSize;
+ Color := claBlack;
+ OnChange := FontChanged;
+ end;
+
+ FVisible := True;
+ ParentFont := True;
+ if AOwner is TfrxComponent then
+ SetParent(TfrxComponent(AOwner));
+end;
+
+constructor TfrxComponent.DesignCreate(AOwner: TComponent; Flags: Word);
+begin
+ FIsDesigning := True;
+ Create(AOwner);
+end;
+
+destructor TfrxComponent.Destroy;
+begin
+ SetParent(nil);
+ Clear;
+ FFont.Free;
+ FObjects.Free;
+ FAllObjects.Free;
+ inherited;
+end;
+
+procedure TfrxComponent.Assign(Source: TPersistent);
+var
+ s: TMemoryStream;
+begin
+ if Source is TfrxComponent then
+ begin
+ s := TMemoryStream.Create;
+ try
+ TfrxComponent(Source).SaveToStream(s, False, True);
+ s.Position := 0;
+ LoadFromStream(s);
+ finally
+ s.Free;
+ end;
+ end;
+end;
+
+procedure TfrxComponent.AssignAll(Source: TfrxComponent; Streaming: Boolean = False);
+var
+ s: TMemoryStream;
+begin
+ s := TMemoryStream.Create;
+ try
+ Source.SaveToStream(s, True, True, Streaming);
+ s.Position := 0;
+ LoadFromStream(s);
+ finally
+ s.Free;
+ end;
+end;
+
+procedure TfrxComponent.LoadFromStream(Stream: TStream);
+var
+ Reader: TfrxXMLSerializer;
+begin
+ Clear;
+ Reader := TfrxXMLSerializer.Create(Stream);
+ if Report <> nil then
+ Report.FXMLSerializer := Reader;
+
+ try
+ Reader.Owner := Report;
+ if (Report <> nil) and Report.EngineOptions.EnableThreadSafe then
+ begin
+{$IFNDEF NO_CRITICAL_SECTION}
+ frxCS.Enter;
+{$ENDIF}
+ try
+ Reader.ReadRootComponent(Self, nil);
+ finally
+{$IFNDEF NO_CRITICAL_SECTION}
+ frxCS.Leave;
+{$ENDIF}
+ end;
+ end
+ else
+ Reader.ReadRootComponent(Self, nil);
+
+ if Report <> nil then
+ Report.Errors.AddStrings(Reader.Errors);
+
+ finally
+ Reader.Free;
+ if Report <> nil then
+ Report.FXMLSerializer := nil;
+ end;
+end;
+
+procedure TfrxComponent.SaveToStream(Stream: TStream; SaveChildren: Boolean = True;
+ SaveDefaultValues: Boolean = False; Streaming: Boolean = False);
+var
+ Writer: TfrxXMLSerializer;
+begin
+ Writer := TfrxXMLSerializer.Create(Stream);
+
+ try
+ Writer.Owner := Report;
+ Writer.SerializeDefaultValues := SaveDefaultValues;
+ if Self is TfrxReport then
+ Writer.OnGetAncestor := Report.DoGetAncestor;
+ Writer.WriteRootComponent(Self, SaveChildren, nil, Streaming);
+ finally
+ Writer.Free;
+ end;
+end;
+
+procedure TfrxComponent.Clear;
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ i := 0;
+ while i < FObjects.Count do
+ begin
+ c := FObjects[i];
+ if (csAncestor in c.ComponentState) then
+ begin
+ c.Clear;
+ Inc(i);
+ end
+ else
+ c.Free;
+ end;
+end;
+
+procedure TfrxComponent.SetParent(AParent: TfrxComponent);
+begin
+ if FParent <> AParent then
+ begin
+ if FParent <> nil then
+ FParent.FObjects.Remove(Self);
+ if AParent <> nil then
+ AParent.FObjects.Add(Self);
+ end;
+
+ FParent := AParent;
+ if FParent <> nil then
+ SetParentFont(FParentFont);
+end;
+
+procedure TfrxComponent.SetBounds(ALeft, ATop, AWidth, AHeight: Double);
+begin
+ Left := ALeft;
+ Top := ATop;
+ Width := AWidth;
+ Height := AHeight;
+end;
+
+function TfrxComponent.GetPage: TfrxPage;
+var
+ p: TfrxComponent;
+begin
+ if Self is TfrxPage then
+ begin
+ Result := TfrxPage(Self);
+ Exit;
+ end;
+
+ Result := nil;
+ p := Parent;
+ while p <> nil do
+ begin
+ if p is TfrxPage then
+ begin
+ Result := TfrxPage(p);
+ Exit;
+ end;
+ p := p.Parent;
+ end;
+end;
+
+function TfrxComponent.GetReport: TfrxReport;
+var
+ p: TfrxComponent;
+begin
+ if Self is TfrxReport then
+ begin
+ Result := TfrxReport(Self);
+ Exit;
+ end;
+
+ Result := nil;
+ p := Parent;
+ while p <> nil do
+ begin
+ if p is TfrxReport then
+ begin
+ Result := TfrxReport(p);
+ Exit;
+ end;
+ p := p.Parent;
+ end;
+end;
+
+function TfrxComponent.GetIsLoading: Boolean;
+begin
+ Result := FIsLoading or (csLoading in ComponentState);
+end;
+
+function TfrxComponent.GetAbsTop: Double;
+begin
+ if (Parent <> nil) and not (Parent is TfrxDialogPage) then
+ Result := Parent.AbsTop + Top else
+ Result := Top;
+end;
+
+function TfrxComponent.GetAbsLeft: Double;
+begin
+ if (Parent <> nil) and not (Parent is TfrxDialogPage) then
+ Result := Parent.AbsLeft + Left else
+ Result := Left;
+end;
+
+procedure TfrxComponent.SetLeft(Value: Double);
+begin
+ if not IsDesigning or not (rfDontMove in FRestrictions) then
+ FLeft := Value;
+end;
+
+procedure TfrxComponent.SetTop(Value: Double);
+begin
+ if not IsDesigning or not (rfDontMove in FRestrictions) then
+ FTop := Value;
+end;
+
+procedure TfrxComponent.SetWidth(Value: Double);
+begin
+ if not IsDesigning or not (rfDontSize in FRestrictions) then
+ FWidth := Value;
+end;
+
+procedure TfrxComponent.SetHeight(Value: Double);
+begin
+ if not IsDesigning or not (rfDontSize in FRestrictions) then
+ FHeight := Value;
+end;
+
+function TfrxComponent.IsFontStored: Boolean;
+begin
+ Result := not FParentFont;
+end;
+
+procedure TfrxComponent.SetFont(Value: TfrxFont);
+begin
+ FFont.Assign(Value);
+ FParentFont := False;
+end;
+
+procedure TfrxComponent.SetParentFont(const Value: Boolean);
+begin
+ if Value then
+ if Parent <> nil then
+ Font := Parent.Font;
+ FParentFont := Value;
+end;
+
+procedure TfrxComponent.SetVisible(Value: Boolean);
+begin
+ FVisible := Value;
+end;
+
+procedure TfrxComponent.FontChanged(Sender: TObject);
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ FParentFont := False;
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if c.ParentFont then
+ c.ParentFont := True;
+ end;
+end;
+
+function TfrxComponent.GetAllObjects: TList;
+
+ procedure EnumObjects(c: TfrxComponent);
+ var
+ i: Integer;
+ begin
+ if c <> Self then
+ FAllObjects.Add(c);
+ for i := 0 to c.FObjects.Count - 1 do
+ EnumObjects(c.FObjects[i]);
+ end;
+
+begin
+ FAllObjects.Clear;
+ EnumObjects(Self);
+ Result := FAllObjects;
+end;
+
+procedure TfrxComponent.SetName(const AName: TComponentName);
+var
+ c: TfrxComponent;
+begin
+ if CompareText(AName, Name) = 0 then Exit;
+
+ if (AName <> '') and (Report <> nil) then
+ begin
+ c := Report.FindObject(AName);
+ if (c <> nil) and (c <> Self) then
+ raise EDuplicateName.Create(frxResources.Get('prDupl'));
+ if IsAncestor and not((Self is TfrxReport) and (Name = '')) and not(csLoading in ComponentState) then
+ raise Exception.CreateFmt(frxResources.Get('clCantRen'), [Name]);
+ end;
+ inherited;
+end;
+
+procedure TfrxComponent.CreateUniqueName;
+var
+ i: Integer;
+ l: TList;
+ sl: TStringList;
+begin
+ sl := TfrxStringList.Create;
+ sl.Sorted := True;
+ sl.Duplicates := dupIgnore;
+
+ if Report <> nil then
+ l := Report.AllObjects else
+ l := Parent.AllObjects;
+ for i := 0 to l.Count - 1 do
+ sl.Add(TfrxComponent(l[i]).Name);
+
+ i := 1;
+ while sl.IndexOf(FBaseName + IntToStr(i)) <> -1 do
+ Inc(i);
+
+ Name := String(FBaseName) + IntToStr(i);
+ sl.Free;
+end;
+
+function TfrxComponent.Diff(AComponent: TfrxComponent): String;
+begin
+ Result := InternalDiff(AComponent);
+end;
+
+function TfrxComponent.DiffFont(f1, f2: TfrxFont; const Add: String): String;
+var
+ fs: Integer;
+begin
+ Result := '';
+
+ if f1.Name <> f2.Name then
+ Result := Result + Add + 'Font.Name="' + frxStrToXML(f1.Name) + '"';
+ if f1.Size <> f2.Size then
+ Result := Result + Add + 'Font.Size="' + FloatToStr(f1.Size) + '"';
+ if f1.Color <> f2.Color then
+ Result := Result + Add + 'Font.Color="' + IntToStr(Integer(f1.Color)) + '"';
+ if f1.Style <> f2.Style then
+ begin
+ fs := 0;
+ if fsBold in f1.Style then fs := 1;
+ if fsItalic in f1.Style then fs := fs or 2;
+ if fsUnderline in f1.Style then fs := fs or 4;
+ if fsStrikeout in f1.Style then fs := fs or 8;
+ Result := Result + Add + 'Font.Style="' + IntToStr(fs) + '"';
+ end;
+end;
+
+function TfrxComponent.InternalDiff(AComponent: TfrxComponent): String;
+begin
+ Result := '';
+
+ if FloatDiff(FLeft, AComponent.FLeft) then
+ Result := Result + ' l="' + FloatToStr(FLeft) + '"';
+ if (Self is TfrxBand) or FloatDiff(FTop, AComponent.FTop) then
+ Result := Result + ' t="' + FloatToStr(FTop) + '"';
+ if not ((Self is TfrxCustomMemoView) and TfrxCustomMemoView(Self).FAutoWidth) then
+ if FloatDiff(FWidth, AComponent.FWidth) then
+ Result := Result + ' w="' + FloatToStr(FWidth) + '"';
+ if FloatDiff(FHeight, AComponent.FHeight) then
+ Result := Result + ' h="' + FloatToStr(FHeight) + '"';
+ if FVisible <> AComponent.FVisible then
+ Result := Result + ' Visible="' + frxValueToXML(FVisible) + '"';
+ if not FParentFont then
+ Result := Result + DiffFont(FFont, AComponent.FFont, ' ');
+ if FParentFont <> AComponent.FParentFont then
+ Result := Result + ' ParentFont="' + frxValueToXML(FParentFont) + '"';
+ if Tag <> AComponent.Tag then
+ Result := Result + ' Tag="' + IntToStr(Tag) + '"';
+end;
+
+function TfrxComponent.AllDiff(AComponent: TfrxComponent): String;
+var
+ s: TStringStream;
+ Writer: TfrxXMLSerializer;
+ i: Integer;
+begin
+ s := TStringStream.Create('', TEncoding.UTF8);
+ Writer := TfrxXMLSerializer.Create(s);
+ Writer.Owner := Report;
+ Writer.WriteComponent(Self);
+ Writer.Free;
+
+ Result := s.DataString;
+ i := Pos(' ', Result);
+ if i <> 0 then
+ begin
+ Delete(Result, 1, i);
+ Delete(Result, Length(Result) - 1, 2);
+ end
+ else
+ Result := '';
+ if AComponent <> nil then
+ Result := Result + ' ' + InternalDiff(AComponent);
+ { cross bands and Keep mechanism fix }
+ if (Self is TfrxNullBand) then
+ begin
+ Result := Result + ' l="' + FloatToStr(FLeft) + '"';
+ Result := Result + ' t="' + FloatToStr(FTop) + '"';
+ end;
+
+ s.Free;
+end;
+
+procedure TfrxComponent.AddSourceObjects;
+begin
+// do nothing
+end;
+procedure TfrxComponent.AlignChildren;
+var
+ i: Integer;
+ c: TfrxComponent;
+ sl: TStringList;
+
+ procedure DoAlign(v: TfrxView; n, dir: Integer);
+ var
+ i: Integer;
+ c, c0: TfrxComponent;
+ begin
+ c0 := nil;
+ i := n;
+ while (i >= 0) and (i < sl.Count) do
+ begin
+ c := TfrxComponent(sl.Objects[i]);
+ if c <> v then
+ if (c.AbsTop < v.AbsTop + v.Height - 1e-4) and
+ (v.AbsTop < c.AbsTop + c.Height - 1e-4) then
+ begin
+ { special case for baWidth }
+ if (v.Align = baWidth) and
+ (((dir = 1) and (c.Left > v.Left)) or
+ ((dir = -1) and (c.Left + c.Width < v.Left + v.Width))) then
+ begin
+ Dec(i, dir);
+ continue;
+ end;
+ c0 := c;
+ break;
+ end;
+ Dec(i, dir);
+ end;
+
+ if (dir = 1) and (v.Align in [baLeft, baWidth]) then
+ if c0 = nil then
+ v.Left := 0 else
+ v.Left := c0.Left + c0.Width;
+
+ if v.Align = baRight then
+ if c0 = nil then
+ v.Left := Width - v.Width else
+ v.Left := c0.Left - v.Width;
+
+ if (dir = -1) and (v.Align = baWidth) then
+ if c0 = nil then
+ v.Width := Width - v.Left else
+ v.Width := c0.Left - v.Left;
+ end;
+
+begin
+ sl := TfrxStringList.Create;
+ sl.Sorted := True;
+ sl.Duplicates := dupAccept;
+
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if c is TfrxView then
+ if c.Left >= 0 then
+ sl.AddObject('1' + Format('%9.2f', [c.Left]), c)
+ else
+ sl.AddObject('0' + Format('%9.2f', [-c.Left]), c);
+ end;
+
+ { process baLeft }
+
+ for i := 0 to sl.Count - 1 do
+ begin
+ c := TfrxComponent(sl.Objects[i]);
+ if c is TfrxView then
+ if TfrxView(c).Align in [baLeft, baWidth] then
+ DoAlign(TfrxView(c), i, 1);
+ end;
+
+ { process baRight }
+
+ for i := sl.Count - 1 downto 0 do
+ begin
+ c := TfrxComponent(sl.Objects[i]);
+ if c is TfrxView then
+ if TfrxView(c).Align in [baRight, baWidth] then
+ DoAlign(TfrxView(c), i, -1);
+ end;
+
+ { process others }
+
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if c is TfrxView then
+ case TfrxView(c).Align of
+ baCenter:
+ c.Left := (Width - c.Width) / 2;
+
+ baBottom:
+ c.Top := Height - c.Height;
+
+ baClient:
+ begin
+ c.Left := 0;
+ c.Top := 0;
+ c.Width := Width;
+ c.Height := Height;
+ end;
+ end;
+ end;
+
+ sl.Free;
+end;
+
+function TfrxComponent.FindObject(const AName: String): TfrxComponent;
+var
+ i: Integer;
+ l: TList;
+begin
+ Result := nil;
+ l := AllObjects;
+ for i := 0 to l.Count - 1 do
+ if CompareText(AName, TfrxComponent(l[i]).Name) = 0 then
+ begin
+ Result := l[i];
+ break;
+ end;
+end;
+
+class function TfrxComponent.GetDescription: String;
+begin
+ Result := ClassName;
+end;
+
+function TfrxComponent.GetChildOwner: TComponent;
+begin
+ Result := Self;
+end;
+
+procedure TfrxComponent.GetChildren(Proc: TGetChildProc; Root: TComponent);
+var
+ i: Integer;
+begin
+ if (Self is TfrxReport) and not TfrxReport(Self).StoreInDFM then
+ Exit;
+ for i := 0 to FObjects.Count - 1 do
+ Proc(FObjects[i]);
+end;
+
+procedure TfrxComponent.BeforeStartReport;
+begin
+// do nothing
+end;
+
+procedure TfrxComponent.OnNotify(Sender: TObject);
+begin
+// do nothing
+end;
+
+procedure TfrxComponent.OnPaste;
+begin
+//
+end;
+
+function TfrxComponent.GetIsAncestor: Boolean;
+begin
+ Result := (csAncestor in ComponentState) or FAncestor;
+end;
+
+function TfrxComponent.FindDataSet(DataSet: TfrxDataSet; const DSName: String): TfrxDataSet;
+var
+ DSItem:TfrxDataSetItem;
+ AReport: TfrxReport;
+begin
+ Result := nil;
+ if Self is TfrxReport then
+ AReport := TfrxReport(Self)
+ else AReport := Report;
+ if (AReport <> nil) and not AReport.EngineOptions.UseGlobalDataSetList then
+ begin
+ DSItem := AReport.EnabledDataSets.Find(DSName);
+ if DSItem <> nil then Result := DSItem.FDataSet;
+ end
+ else
+ Result := frxFindDataSet(DataSet, DSName, AReport);
+end;
+
+function TfrxComponent.GetContainerObjects: TList;
+begin
+ Result := FObjects;
+end;
+
+function TfrxComponent.ContainerAdd(Obj: TfrxComponent): Boolean;
+begin
+ Result := False;
+end;
+
+function TfrxComponent.ContainerMouseDown(Sender: TObject; X, Y: Integer): Boolean;
+begin
+ Result := False;
+end;
+
+procedure TfrxComponent.ContainerMouseMove(Sender: TObject; X, Y: Integer);
+begin
+end;
+
+procedure TfrxComponent.ContainerMouseUp(Sender: TObject; X, Y: Integer);
+begin
+end;
+
+
+{ TfrxReportComponent }
+
+constructor TfrxReportComponent.Create(AOwner: TComponent);
+begin
+ inherited;
+ FShiftChildren := TList.Create;
+end;
+
+destructor TfrxReportComponent.Destroy;
+begin
+ FShiftChildren.Free;
+ inherited;
+end;
+
+procedure TfrxReportComponent.GetData;
+begin
+// do nothing
+end;
+
+procedure TfrxReportComponent.BeforePrint;
+begin
+ FOriginalRect := frxRect(Left, Top, Width, Height);
+end;
+
+procedure TfrxReportComponent.AfterPrint;
+begin
+ with FOriginalRect do
+ SetBounds(Left, Top, Right, Bottom);
+end;
+
+function TfrxReportComponent.GetComponentText: String;
+begin
+ Result := '';
+end;
+
+function TfrxReportComponent.GetRealBounds: TfrxRect;
+begin
+ Result := frxRect(AbsLeft, AbsTop, AbsLeft + Width, AbsTop + Height);
+end;
+
+
+{ TfrxDialogComponent }
+
+constructor TfrxDialogComponent.Create(AOwner: TComponent);
+begin
+ inherited;
+ frComponentStyle := frComponentStyle - [csPreviewVisible];
+ Width := 28;
+ Height := 28;
+ FImageIsLoaded := False;
+ FImage := TBitmap.Create(28, 28);
+end;
+
+destructor TfrxDialogComponent.Destroy;
+begin
+ if FComponent <> nil then
+ FComponent.Free;
+ FComponent := nil;
+ FImage.Free;
+ inherited;
+end;
+
+procedure TfrxDialogComponent.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ Filer.DefineProperty('pLeft', ReadLeft, WriteLeft, Report <> nil);
+ Filer.DefineProperty('pTop', ReadTop, WriteTop, Report <> nil);
+end;
+
+procedure TfrxDialogComponent.ReadLeft(Reader: TReader);
+begin
+ Left := Reader.ReadInteger;
+end;
+
+procedure TfrxDialogComponent.ReadTop(Reader: TReader);
+begin
+ Top := Reader.ReadInteger;
+end;
+
+procedure TfrxDialogComponent.WriteLeft(Writer: TWriter);
+begin
+ Writer.WriteInteger(Round(Left));
+end;
+
+procedure TfrxDialogComponent.WriteTop(Writer: TWriter);
+begin
+ Writer.WriteInteger(Round(Top));
+end;
+
+procedure TfrxDialogComponent.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+var
+ r: TRectF;
+ i: Integer;
+ w: Single;
+ Item: TfrxObjectItem;
+begin
+ Width := 28;
+ Height := 28;
+
+ r := RectF(Round(Left), Round(Top), Round(Left + 28), Round(Top + 28));
+ Canvas.Fill.Color := claWhitesmoke;
+ Canvas.FillRect(r, 0, 0, allCorners, 1);
+{$IFDEF DELPHI25}
+ Canvas.Stroke.Thickness := 1;
+{$ELSE}
+ Canvas.StrokeThickness := 1;
+{$ENDIF}
+ Canvas.Stroke.Color := claBlack;
+ Canvas.DrawRect(r, 0, 0, allCorners, 1);
+{$IFDEF DELPHI25}
+ Canvas.Stroke.Thickness := 1;
+{$ELSE}
+ Canvas.StrokeThickness := 1;
+{$ENDIF}
+ Canvas.Stroke.Color := claSilver;
+ Canvas.DrawRect(RectF(Round(Left + 1), Round(Top + 1), Round(Left + 27), Round(Top + 27)), 0, 0, allCorners, 1);
+
+ if not FImageIsLoaded then
+ for i := 0 to frxObjects.Count - 1 do
+ begin
+ Item := frxObjects[i];
+ if Item.ClassRef = ClassType then
+ begin
+ frxResources.LoadImageFromResouce(FImage, Item.ButtonImageIndex);
+ FImageIsLoaded := True;
+ break;
+ end;
+ end;
+
+ Canvas.DrawBitmap(FImage, RectF(0, 0, FImage.Width, FImage.Height), RectF(Round(Left + 4), Round(Top + 4), Round(Left + 25), Round(Top + 25)), 1, false);
+
+{$IFDEF LINUX}
+ Canvas.Font.Family := 'Liberation Mono';
+{$ELSE}
+ Canvas.Font.Family := 'Tahoma';
+{$ENDIF}
+ Canvas.Font.Size := 10;
+ Canvas.Fill.Color := claBlack;
+ Canvas.Font.Style := [];
+ w := Canvas.TextWidth(Name);
+// Canvas.Brush.Color := clWindow;
+ Canvas.FillText(RectF(r.Left - (w - 28) / 2, r.Bottom + 4, r.Left - (w - 28) / 2 + w, r.Bottom + 20), Name, false, 1, [], TTextAlign.taCenter, TTextAlign.taLeading);
+end;
+
+
+{ TfrxDialogControl }
+
+constructor TfrxDialogControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FBaseName := ClassName;
+ Delete(FBaseName, Pos('Tfrx', FBaseName), 4);
+ Delete(FBaseName, Pos('Control', FBaseName), 7);
+end;
+
+destructor TfrxDialogControl.Destroy;
+begin
+ inherited;
+ if FControl <> nil then
+ FControl.Free;
+ FControl := nil;
+end;
+
+procedure TfrxDialogControl.InitControl(AControl: TControl);
+begin
+ FControl := AControl;
+ with FControl do
+ begin
+ OnClick := DoOnClick;
+ OnDblClick := DoOnDblClick;
+ OnMouseDown := DoOnMouseDown;
+ OnMouseMove := DoOnMouseMove;
+ OnMouseUp := DoOnMouseUp;
+ OnEnter := DoOnEnter;
+ OnExit := DoOnExit;
+ OnKeyDown := DoOnKeyDown;
+ OnKeyUp := DoOnKeyUp;
+ end;
+ SetParent(Parent);
+end;
+
+procedure TfrxDialogControl.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+var
+ Sstate: TCanvasSaveState;
+ oldM: TMatrix;
+begin
+ Sstate := Canvas.SaveState;
+ oldM := Canvas.Matrix;
+ try
+{$IFDEF DELPHI22}
+ FControl.PrepareForPaint;
+{$ENDIF}
+ FControl.PaintTo(Canvas, RectF(oldM.m31 + AbsLeft, oldM.m32 + AbsTop, oldM.m31 + AbsLeft + Width, oldM.m32 + AbsTop + Height), nil);
+ finally
+ Canvas.SetMatrix(oldM);
+ Canvas.RestoreState(Sstate);
+ end;
+end;
+
+function TfrxDialogControl.GetCaption: String;
+{$IFDEF DELPHI22}
+var
+ aICaption: ICaption;
+{$ENDIF}
+begin
+{$IFDEF DELPHI22}
+ aICaption := FControl as ICaption;
+ if aICaption <> nil then
+ Result := aICaption.Text;
+{$ELSE}
+ if FControl is TTextControl then
+ Result := TTextControl(FControl).Text
+ else
+ Result := '';
+{$ENDIF}
+end;
+
+function TfrxDialogControl.GetEnabled: Boolean;
+begin
+ Result := FControl.Enabled;
+end;
+
+procedure TfrxDialogControl.SetLeft(Value: Double);
+begin
+ inherited;
+ FControl.Position.X := Round(Left);
+end;
+
+procedure TfrxDialogControl.SetTop(Value: Double);
+begin
+ inherited;
+ FControl.Position.Y := Round(Top);
+end;
+
+procedure TfrxDialogControl.SetWidth(Value: Double);
+begin
+ inherited;
+ FControl.Width := Round(Width);
+end;
+
+procedure TfrxDialogControl.SetHeight(Value: Double);
+begin
+ inherited;
+ FControl.Height := Round(Height);
+end;
+
+procedure TfrxDialogControl.SetVisible(Value: Boolean);
+begin
+ inherited;
+ FControl.Visible := Visible;
+end;
+
+procedure TfrxDialogControl.SetCaption(const Value: String);
+{$IFDEF DELPHI22}
+var
+ aICaption: ICaption;
+{$ENDIF}
+begin
+{$IFDEF DELPHI22}
+ aICaption := FControl as ICaption;
+ if aICaption <> nil then
+ aICaption.Text := Value;
+{$ELSE}
+ if FControl is TTextControl then
+ TTextControl(FControl).Text := Value;
+{$ENDIF}
+end;
+
+procedure TfrxDialogControl.SetEnabled(const Value: Boolean);
+begin
+ FControl.Enabled := Value;
+end;
+
+function TfrxDialogControl.GetHint: String;
+begin
+// todo
+ Result := '';//FControl.Hint;
+end;
+
+procedure TfrxDialogControl.SetHint(const Value: String);
+begin
+// FControl.Hint := Value;
+end;
+
+function TfrxDialogControl.GetShowHint: Boolean;
+begin
+ Result := False;//FControl.ShowHint;
+end;
+
+procedure TfrxDialogControl.SetShowHint(const Value: Boolean);
+begin
+// FControl.ShowHint := Value;
+end;
+
+function TfrxDialogControl.GetTabStop: Boolean;
+begin
+ Result := FControl.CanFocus;
+end;
+
+procedure TfrxDialogControl.SetTabStop(const Value: Boolean);
+begin
+ FControl.CanFocus := Value;
+end;
+
+procedure TfrxDialogControl.FontChanged(Sender: TObject);
+begin
+ inherited;
+ if FControl is TTextControl then
+ Font.AssignToFont(TTextControl(FControl).Font);
+end;
+
+procedure TfrxDialogControl.SetParentFont(const Value: Boolean);
+begin
+ inherited;
+// todo
+// if FControl <> nil then
+// THackControl(FControl).ParentFont := Value;
+end;
+
+procedure TfrxDialogControl.SetParent(AParent: TfrxComponent);
+begin
+ inherited;
+ if FControl <> nil then
+ if AParent is TfrxDialogControl then
+ FControl.Parent := TfrxDialogControl(AParent).Control
+ else if AParent is TfrxDialogPage then
+ FControl.Parent := TfrxDialogPage(AParent).DialogForm
+end;
+
+procedure TfrxDialogControl.DoOnClick(Sender: TObject);
+begin
+ if Report <> nil then
+ Report.DoNotifyEvent(Self, FOnClick, True);
+end;
+
+procedure TfrxDialogControl.DoOnDblClick(Sender: TObject);
+begin
+ if Report <> nil then
+ Report.DoNotifyEvent(Self, FOnDblClick, True);
+end;
+
+procedure TfrxDialogControl.DoOnEnter(Sender: TObject);
+begin
+ if Report <> nil then
+ Report.DoNotifyEvent(Self, FOnEnter, True);
+end;
+
+procedure TfrxDialogControl.DoOnExit(Sender: TObject);
+begin
+ if Report <> nil then
+ Report.DoNotifyEvent(Self, FOnExit, True);
+end;
+
+procedure TfrxDialogControl.DoOnKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: System.WideChar; Shift: TShiftState);
+var
+ v: Variant;
+begin
+ v := VarArrayOf([frxInteger(Self), Key, ShiftToByte(Shift)]);
+ if (Report <> nil) and (FOnKeyDown <> '') then
+ begin
+ Report.DoParamEvent(FOnKeyDown, v, True);
+ Key := v[1];
+ end;
+end;
+
+procedure TfrxDialogControl.DoOnKeyUp(Sender: TObject; var Key: Word;
+ var KeyChar: System.WideChar; Shift: TShiftState);
+var
+ v: Variant;
+begin
+ v := VarArrayOf([frxInteger(Self), Key, ShiftToByte(Shift)]);
+ if (Report <> nil) and (FOnKeyUp <> '') then
+ begin
+ Report.DoParamEvent(FOnKeyUp, v, True);
+ Key := v[1];
+ end;
+end;
+
+procedure TfrxDialogControl.DoOnMouseDown(Sender: TObject;
+ Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+var
+ v: Variant;
+begin
+ v := VarArrayOf([frxInteger(Self), Button, ShiftToByte(Shift), X, Y]);
+ if Report <> nil then
+ Report.DoParamEvent(FOnMouseDown, v, True);
+end;
+
+procedure TfrxDialogControl.DoOnMouseMove(Sender: TObject;
+ Shift: TShiftState; X, Y: Single);
+var
+ v: Variant;
+begin
+ if (Report <> nil) and (Hint <> '') and ShowHint then
+ begin
+ Report.SetProgressMessage(GetLongHint(Self.Hint), True);
+ end;
+ v := VarArrayOf([frxInteger(Self), ShiftToByte(Shift), X, Y]);
+ if Report <> nil then
+ Report.DoParamEvent(FOnMouseMove, v, True);
+end;
+
+procedure TfrxDialogControl.DoOnMouseUp(Sender: TObject;
+ Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+var
+ v: Variant;
+begin
+ v := VarArrayOf([frxInteger(Self), Button, ShiftToByte(Shift), X, Y]);
+ if Report <> nil then
+ Report.DoParamEvent(FOnMouseUp, v, True);
+end;
+
+
+{ TfrxFrameLine }
+
+constructor TfrxFrameLine.Create(AFrame: TfrxFrame);
+begin
+ FColor := claBlack;
+ FStyle := fsSolid;
+ FWidth := 1;
+ FFrame := AFrame;
+end;
+
+procedure TfrxFrameLine.Assign(Source: TPersistent);
+begin
+ if Source is TfrxFrameLine then
+ begin
+ FColor := TfrxFrameLine(Source).Color;
+ FStyle := TfrxFrameLine(Source).Style;
+ FWidth := TfrxFrameLine(Source).Width;
+ end;
+end;
+
+function TfrxFrameLine.IsColorStored: Boolean;
+begin
+ Result := FColor <> FFrame.Color;
+end;
+
+function TfrxFrameLine.IsStyleStored: Boolean;
+begin
+ Result := FStyle <> FFrame.Style;
+end;
+
+function TfrxFrameLine.IsWidthStored: Boolean;
+begin
+ Result := FWidth <> FFrame.Width;
+end;
+
+function TfrxFrameLine.Diff(ALine: TfrxFrameLine; const LineName: String;
+ ColorChanged, StyleChanged, WidthChanged: Boolean): String;
+begin
+ Result := '';
+
+ if (ColorChanged and IsColorStored) or (not ColorChanged and (FColor <> ALine.Color)) then
+ Result := Result + ' ' + LineName + '.Color="' + IntToStr(Integer(FColor)) + '"';
+ if (StyleChanged and IsStyleStored) or (not StyleChanged and (FStyle <> ALine.Style)) then
+ Result := Result + ' ' + LineName + '.Style="' + frxValueToXML(FStyle) + '"';
+ if (WidthChanged and IsWidthStored) or (not WidthChanged and FloatDiff(FWidth, ALine.Width)) then
+ Result := Result + ' ' + LineName + '.Width="' + FloatToStr(FWidth) + '"';
+end;
+
+
+{ TfrxFrame }
+
+constructor TfrxFrame.Create;
+begin
+ FColor := claBlack;
+ FShadowColor := claBlack;
+ FShadowWidth := 4;
+ FStyle := fsSolid;
+ FTyp := [];
+ FWidth := 1;
+
+ FLeftLine := TfrxFrameLine.Create(Self);
+ FTopLine := TfrxFrameLine.Create(Self);
+ FRightLine := TfrxFrameLine.Create(Self);
+ FBottomLine := TfrxFrameLine.Create(Self);
+end;
+
+destructor TfrxFrame.Destroy;
+begin
+ FLeftLine.Free;
+ FTopLine.Free;
+ FRightLine.Free;
+ FBottomLine.Free;
+ inherited;
+end;
+
+procedure TfrxFrame.Assign(Source: TPersistent);
+begin
+ if Source is TfrxFrame then
+ begin
+ FColor := TfrxFrame(Source).Color;
+ FDropShadow := TfrxFrame(Source).DropShadow;
+ FShadowColor := TfrxFrame(Source).ShadowColor;
+ FShadowWidth := TfrxFrame(Source).ShadowWidth;
+ FStyle := TfrxFrame(Source).Style;
+ FTyp := TfrxFrame(Source).Typ;
+ FWidth := TfrxFrame(Source).Width;
+
+ FLeftLine.Assign(TfrxFrame(Source).LeftLine);
+ FTopLine.Assign(TfrxFrame(Source).TopLine);
+ FRightLine.Assign(TfrxFrame(Source).RightLine);
+ FBottomLine.Assign(TfrxFrame(Source).BottomLine);
+ end;
+end;
+
+function TfrxFrame.IsShadowWidthStored: Boolean;
+begin
+ Result := FShadowWidth <> 4;
+end;
+
+function TfrxFrame.IsTypStored: Boolean;
+begin
+ Result := FTyp <> [];
+end;
+
+function TfrxFrame.IsWidthStored: Boolean;
+begin
+ Result := FWidth <> 1;
+end;
+
+procedure TfrxFrame.SetBottomLine(const Value: TfrxFrameLine);
+begin
+ FBottomLine.Assign(Value);
+end;
+
+procedure TfrxFrame.SetLeftLine(const Value: TfrxFrameLine);
+begin
+ FLeftLine.Assign(Value);
+end;
+
+procedure TfrxFrame.SetRightLine(const Value: TfrxFrameLine);
+begin
+ FRightLine.Assign(Value);
+end;
+
+procedure TfrxFrame.SetTopLine(const Value: TfrxFrameLine);
+begin
+ FTopLine.Assign(Value);
+end;
+
+procedure TfrxFrame.SetColor(const Value: TAlphaColor);
+begin
+ FColor := Value;
+ FLeftLine.Color := Value;
+ FTopLine.Color := Value;
+ FRightLine.Color := Value;
+ FBottomLine.Color := Value;
+end;
+
+procedure TfrxFrame.SetStyle(const Value: TfrxFrameStyle);
+begin
+ FStyle := Value;
+ FLeftLine.Style := Value;
+ FTopLine.Style := Value;
+ FRightLine.Style := Value;
+ FBottomLine.Style := Value;
+end;
+
+procedure TfrxFrame.SetWidth(const Value: Double);
+begin
+ FWidth := Value;
+ FLeftLine.Width := Value;
+ FTopLine.Width := Value;
+ FRightLine.Width := Value;
+ FBottomLine.Width := Value;
+end;
+
+function TfrxFrame.Diff(AFrame: TfrxFrame): String;
+var
+ i: Integer;
+ ColorChanged, StyleChanged, WidthChanged: Boolean;
+begin
+ Result := '';
+
+ ColorChanged := FColor <> AFrame.Color;
+ if ColorChanged then
+ Result := Result + ' Frame.Color="' + IntToStr(Integer(FColor)) + '"';
+ if FDropShadow <> AFrame.DropShadow then
+ Result := Result + ' Frame.DropShadow="' + frxValueToXML(FDropShadow) + '"';
+ if FShadowColor <> AFrame.ShadowColor then
+ Result := Result + ' Frame.ShadowColor="' + IntToStr(Integer(FShadowColor)) + '"';
+ if FloatDiff(FShadowWidth, AFrame.ShadowWidth) then
+ Result := Result + ' Frame.ShadowWidth="' + FloatToStr(FShadowWidth) + '"';
+ StyleChanged := FStyle <> AFrame.Style;
+ if StyleChanged then
+ Result := Result + ' Frame.Style="' + frxValueToXML(FStyle) + '"';
+ if FTyp <> AFrame.Typ then
+ begin
+ i := 0;
+ if ftLeft in FTyp then i := i or 1;
+ if ftRight in FTyp then i := i or 2;
+ if ftTop in FTyp then i := i or 4;
+ if ftBottom in FTyp then i := i or 8;
+ Result := Result + ' Frame.Typ="' + IntToStr(i) + '"';
+ end;
+ WidthChanged := FloatDiff(FWidth, AFrame.Width);
+ if WidthChanged then
+ Result := Result + ' Frame.Width="' + FloatToStr(FWidth) + '"';
+
+ Result := Result + FLeftLine.Diff(AFrame.LeftLine, 'Frame.LeftLine',
+ ColorChanged, StyleChanged, WidthChanged);
+ Result := Result + FTopLine.Diff(AFrame.TopLine, 'Frame.TopLine',
+ ColorChanged, StyleChanged, WidthChanged);
+ Result := Result + FRightLine.Diff(AFrame.RightLine, 'Frame.RightLine',
+ ColorChanged, StyleChanged, WidthChanged);
+ Result := Result + FBottomLine.Diff(AFrame.BottomLine, 'Frame.BottomLine',
+ ColorChanged, StyleChanged, WidthChanged);
+end;
+
+
+{ TfrxView }
+
+constructor TfrxView.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ frComponentStyle := frComponentStyle + [csDefaultDiff];
+ FAlign := baNone;
+ FColor := claNull;
+ FFrame := TfrxFrame.Create;
+ FShiftMode := smAlways;
+ FPrintable := True;
+ FPlainText := False;
+ FFastCanvas := nil;
+end;
+
+destructor TfrxView.Destroy;
+begin
+ FFrame.Free;
+ inherited;
+end;
+
+procedure TfrxView.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FDataSet) then
+ FDataSet := nil;
+end;
+
+procedure TfrxView.SetDataSet(const Value: TfrxDataSet);
+begin
+ FDataSet := Value;
+ if FDataSet = nil then
+ FDataSetName := '' else
+ FDataSetName := FDataSet.UserName;
+end;
+
+procedure TfrxView.SetDataSetName(const Value: String);
+begin
+ FDataSetName := Value;
+ FDataSet := FindDataSet(FDataSet, FDataSetName);
+end;
+
+function TfrxView.GetDataSetName: String;
+begin
+ if FDataSet = nil then
+ Result := FDataSetName else
+ Result := FDataSet.UserName;
+end;
+
+procedure TfrxView.GetVisibleRect(var aRect: TRectF);
+begin
+ aRect := RectF(0, 0, 0, 0);
+ if ftLeft in FFrame.Typ then
+ aRect.Left := FFrame.LeftLine.Width;
+ aRect.Left := AbsLeft - aRect.Left;
+ if ftTop in FFrame.Typ then
+ aRect.Top := FFrame.TopLine.Width;
+ aRect.Top := AbsTop - aRect.Top;
+ if ftRight in FFrame.Typ then
+ aRect.Right := FFrame.RightLine.Width;
+ aRect.Right := AbsLeft + Width + aRect.Right;
+ if ftBottom in FFrame.Typ then
+ aRect.Bottom := FFrame.BottomLine.Width;
+ aRect.Bottom := AbsTop + Height + aRect.Bottom;
+end;
+
+procedure TfrxView.SetFastCanvas(aCanvas: TCanvas);
+begin
+ FFastCanvas := aCanvas;
+end;
+
+procedure TfrxView.SetFrame(const Value: TfrxFrame);
+begin
+ FFrame.Assign(Value);
+end;
+
+procedure TfrxView.BeginDraw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
+begin
+ FCanvas := Canvas;
+ FScaleX := ScaleX;
+ FScaleY := ScaleY;
+ FOffsetX := OffsetX;
+ FOffsetY := OffsetY;
+ FX := Round(AbsLeft * ScaleX + OffsetX);
+ FY := Round(AbsTop * ScaleY + OffsetY);
+ FX1 := Round((AbsLeft + Width) * ScaleX + OffsetX);
+ FY1 := Round((AbsTop + Height) * ScaleY + OffsetY);
+
+ if Frame.DropShadow then
+ begin
+ FX1 := FX1 - Round(Frame.ShadowWidth * ScaleX);
+ FY1 := FY1 - Round(Frame.ShadowWidth * ScaleY);
+ end;
+
+ FDX := FX1 - FX;
+ FDY := FY1 - FY;
+ FFrameWidth := Frame.Width * ScaleX;
+end;
+
+procedure TfrxView.DrawBackground;
+begin
+ with FCanvas do
+ begin
+ if FColor <> claNull then
+ begin
+ Fill.Color := FColor;
+ Fill.Kind := TBrushKind.bkSolid;
+ FillRect(RectF(FX, FY, FX1, FY1), 0, 0, allCorners, 1);
+ end;
+ end;
+end;
+
+procedure TfrxView.DrawFrame;
+var
+ d: Integer;
+ add, add1: Extended;
+
+ procedure Line(x, y, x1, y1: Extended; Line: TfrxFrameLine; Typ: TfrxFrameType; gap1, gap2: Boolean);
+ var
+ g1, g2, g3, g4, fw: Integer;
+
+ procedure Line1(x, y, x1, y1: Extended);
+ begin
+ FCanvas.DrawLine(PointF(x, y), PointF(x1, y1), 1);
+ end;
+
+ begin
+ if Frame.Style <> fsDouble then
+ Line1(x, y, x1, y1)
+ else //if Frame.Style = fsDouble then
+ begin
+ fw := Round(Line.Width * FScaleX);
+ if gap1 then g1 := 0 else g1 := 1;
+ if gap2 then g2 := 0 else g2 := 1;
+
+ if Typ in [ftTop, ftBottom] then
+ begin
+ x := x + (fw * g1 div 2);
+ x1 := x1 - (fw * g2 div 2);
+ end
+ else
+ begin
+ y := y + (fw * g1 div 2);
+ y1 := y1 - (fw * g2 div 2);
+ end;
+
+ if gap1 then
+ g1 := fw else
+ g1 := 0;
+ if gap2 then
+ g2 := fw else
+ g2 := 0;
+ g3 := -g1;
+ g4 := -g2;
+
+ if Typ in [ftLeft, ftTop] then
+ begin
+ g1 := -g1;
+ g2 := -g2;
+ g3 := -g3;
+ g4 := -g4;
+ end;
+
+ if x = x1 then
+ Line1(x - fw, y + g1, x1 - fw, y1 - g2) else
+ Line1(x + g1, y - fw, x1 - g2, y1 - fw);
+ if Color <> claNull then
+ begin
+ FCanvas.Stroke.Color := Color;
+ Line1(x, y, x1, y1);
+ end;
+ FCanvas.Stroke.Color := Line.Color;
+ if x = x1 then
+ Line1(x + fw, y + g3, x1 + fw, y1 - g4) else
+ Line1(x + g3, y + fw, x1 - g4, y1 + fw);
+ end
+ end;
+
+ procedure SetPen(Line: TfrxFrameLine);
+ begin
+ with FCanvas do
+ begin
+ Stroke.Color := Line.Color;
+ if Line.Style in [fsSolid, fsDouble] then
+{$IFDEF DELPHI25}
+ begin
+ Stroke.Thickness := Round(Line.Width * FScaleX);
+ Stroke.Dash := TStrokeDash.sdSolid
+ end
+ else
+ begin
+ Stroke.Thickness := 1;
+ Stroke.Dash := TStrokeDash(Frame.Style);
+ end;
+{$ELSE}
+ begin
+ StrokeThickness := Round(Line.Width * FScaleX);
+ StrokeDash := TStrokeDash.sdSolid
+ end
+ else
+ begin
+ StrokeThickness := 1;
+ StrokeDash := TStrokeDash(Frame.Style);
+ end;
+{$ENDIF}
+ end;
+ end;
+
+begin
+ with FCanvas do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+
+ if Frame.DropShadow then
+ begin
+ Stroke.Color := Frame.ShadowColor;
+ d := Round(Frame.ShadowWidth * FScaleX);
+{$IFDEF DELPHI25}
+ Stroke.Dash := TStrokeDash.sdSolid;
+ Stroke.Thickness := d;
+{$ELSE}
+ StrokeDash := TStrokeDash.sdSolid;
+ StrokeThickness := d;
+{$ENDIF}
+ DrawLine(PointF(FX1 + d div 2, FY + d), PointF(FX1 + d div 2, FY1), 1);
+ d := Round(Frame.ShadowWidth * FScaleY);
+{$IFDEF DELPHI25}
+ Stroke.Thickness := d;
+{$ELSE}
+ StrokeThickness := d;
+{$ENDIF}
+ DrawLine(PointF(FX + d, FY1 + d div 2), PointF(FX1 + d, FY1 + d div 2), 1);
+ end;
+
+ if (Frame.Typ <> []) and (Frame.Color <> claNull) and (Frame.Width <> 0) then
+ begin
+ if ftLeft in Frame.Typ then
+ begin
+ SetPen(FFrame.LeftLine);
+{$IFNDEF DELPHI21}
+ add := StrokeThickness / 2;
+{$ELSE}
+{$IFDEF MACOS}
+{$IFDEF DELPHI25}
+ add := Stroke.Thickness / 2;
+{$ELSE}
+ add := StrokeThickness / 2;
+{$ENDIF}
+{$ELSE}
+ add := 0;
+{$ENDIF}
+{$ENDIF}
+ add1 := 0;
+{$IFDEF DELPHI25}
+ if (Trunc(Stroke.Thickness) mod 2) = 1 then
+{$ELSE}
+
+ if (Trunc(StrokeThickness) mod 2) = 1 then
+{$ENDIF}
+ add1 := 0.5;
+ Line(FX + add1, FY + add1 - add, FX + add1, FY1 + add1 + add, FFrame.LeftLine, ftLeft, ftTop in Frame.Typ, ftBottom in Frame.Typ);
+ end;
+ if ftRight in Frame.Typ then
+ begin
+ SetPen(FFrame.RightLine);
+{$IFNDEF DELPHI21}
+ add := StrokeThickness / 2;
+{$ELSE}
+{$IFDEF MACOS}
+{$IFDEF DELPHI25}
+ add := Stroke.Thickness / 2;
+{$ELSE}
+ add := StrokeThickness / 2;
+{$ENDIF}
+{$ELSE}
+ add := 0;
+{$ENDIF}
+{$ENDIF}
+ add1 := 0;
+{$IFDEF DELPHI25}
+ if (Trunc(Stroke.Thickness) mod 2) = 1 then
+{$ELSE}
+ if (Trunc(StrokeThickness) mod 2) = 1 then
+{$ENDIF}
+ add1 := 0.5;
+ Line(FX1 + add1, FY + add1 - add, FX1 + add1, FY1 + add1 + add, FFrame.RightLine, ftRight, ftTop in Frame.Typ, ftBottom in Frame.Typ);
+ end;
+ if ftTop in Frame.Typ then
+ begin
+ SetPen(FFrame.TopLine);
+ add1 := 0;
+{$IFDEF DELPHI25}
+ add := Stroke.Thickness / 2;
+ if (Trunc(Stroke.Thickness) mod 2) = 1 then
+{$ELSE}
+ add := StrokeThickness / 2;
+ if (Trunc(StrokeThickness) mod 2) = 1 then
+{$ENDIF}
+ add1 := 0.5;
+ Line(FX + add1 + add, FY + add1, FX1 + add1 - add, FY + add1, FFrame.TopLine, ftTop, ftLeft in Frame.Typ, ftRight in Frame.Typ);
+ end;
+ if ftBottom in Frame.Typ then
+ begin
+ SetPen(FFrame.BottomLine);
+ add1 := 0;
+{$IFDEF DELPHI25}
+ add := Stroke.Thickness / 2;
+ if (Trunc(Stroke.Thickness) mod 2) = 1 then
+{$ELSE}
+ add := StrokeThickness / 2;
+ if (Trunc(StrokeThickness) mod 2) = 1 then
+{$ENDIF}
+ add1 := 0.5;
+ Line(FX + add1 + add, FY1 + add1 , FX1 + add1 - add, FY1 + add1, FFrame.BottomLine, ftBottom, ftLeft in Frame.Typ, ftRight in Frame.Typ);
+ end;
+ end;
+ end;
+end;
+
+procedure TfrxView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
+begin
+ BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+ DrawBackground;
+ DrawFrame;
+end;
+
+function TfrxView.Diff(AComponent: TfrxComponent): String;
+var
+ v: TfrxView;
+begin
+ Result := inherited Diff(AComponent);
+ v := TfrxView(AComponent);
+
+ if FAlign <> v.FAlign then
+ Result := Result + ' Align="' + frxValueToXML(FAlign) + '"';
+ if FColor <> v.FColor then
+ Result := Result + ' Color="' + IntToStr(Integer(FColor)) + '"';
+ Result := Result + FFrame.Diff(v.FFrame);
+ if Cursor <> v.Cursor then
+ Result := Result + ' Cursor="' + frxValueToXML(Cursor) + '"';
+ if FPrintable <> v.FPrintable then
+ Result := Result + ' Printable="' + frxValueToXML(FPrintable) + '"';
+ if TagStr <> v.TagStr then
+ Result := Result + ' TagStr="' + frxStrToXML(TagStr) + '"';
+ if URL <> v.URL then
+ Result := Result + ' URL="' + frxStrToXML(URL) + '"';
+ if FHint <> v.Hint then
+ Result := Result + ' Hint="' + frxStrToXML(FHint) + '"';
+end;
+
+function TfrxView.IsDataField: Boolean;
+begin
+ Result := (DataSet <> nil) and (Length(DataField) <> 0);
+end;
+
+procedure TfrxView.BeforePrint;
+begin
+ inherited;
+ FTempTag := FTagStr;
+ FTempURL := FURL;
+ if Report <> nil then
+ begin
+ Report.SelfValue := Self;
+ end;
+end;
+
+procedure TfrxView.ExpandVariables(var Expr: String);
+var
+ i, j: Integer;
+ s: String;
+begin
+ i := 1;
+ repeat
+ while i < Length(Expr) do
+{ if isDBCSLeadByte(Byte(Expr[i])) then // if DBCS then skip 2 bytes
+ Inc(i, 2)
+ else }
+ if (Expr[i] <> '[') then
+ Inc(i)
+ else
+ break;
+ s := frxGetBrackedVariableW(Expr, '[', ']', i, j);
+ if i <> j then
+ begin
+ Delete(Expr, i, j - i + 1);
+ s := VarToStr(Report.Calc(s));
+ Insert(s, Expr, i);
+ Inc(i, Length(s));
+ j := 0;
+ end;
+ until i = j;
+end;
+
+procedure TfrxView.GetData;
+begin
+ if (FTagStr <> '') and (Pos('[', FTagStr) <> 0) then
+ ExpandVariables(FTagStr);
+ if (FURL <> '') and (Pos('[', FURL) <> 0) then
+ ExpandVariables(FURL);
+end;
+
+procedure TfrxView.AfterPrint;
+begin
+ inherited;
+ FTagStr := FTempTag;
+ FURL := FTempURL;
+end;
+
+
+{ TfrxShapeView }
+
+constructor TfrxShapeView.Create(AOwner: TComponent);
+begin
+ inherited;
+ frComponentStyle := frComponentStyle - [csDefaultDiff];
+end;
+
+constructor TfrxShapeView.DesignCreate(AOwner: TComponent; Flags: Word);
+begin
+ inherited;
+ FShape := TfrxShapeKind(Flags);
+end;
+
+procedure TfrxShapeView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+var
+ min: Integer;
+ poly: TPolygon;
+begin
+ BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+
+ with Canvas do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := Frame.Color;
+{$IFDEF DELPHI25}
+ Stroke.Thickness := FFrameWidth;
+ Stroke.Dash := TStrokeDash(Frame.Style);
+{$ELSE}
+ StrokeThickness := FFrameWidth;
+ StrokeDash := TStrokeDash(Frame.Style);
+{$ENDIF}
+
+ Fill.Kind := TBrushKind.bkSolid;
+ Fill.Color := FColor;
+
+ case FShape of
+ skRectangle:
+ begin
+ FillRect(RectF(FX, FY, FX1 + 1, FY1 + 1), 0, 0, allCorners, 1);
+ DrawRect(RectF(FX, FY, FX1 + 1, FY1 + 1), 0, 0, allCorners, 1);
+ end;
+
+ skRoundRectangle:
+ begin
+ if FDY < FDX then
+ min := FDY else
+ min := FDX;
+ if FCurve = 0 then
+ min := min div 4
+ else
+ min := Round(FCurve * FScaleX * 10);
+ FillRect(RectF(FX, FY, FX1 + 1, FY1 + 1), min, min, allCorners, 1);
+ DrawRect(RectF(FX, FY, FX1 + 1, FY1 + 1), min, min, allCorners, 1);
+ end;
+
+ skEllipse:
+ begin
+ FillEllipse(RectF(FX, FY, FX1 + 1, FY1 + 1), 1);
+ DrawEllipse(RectF(FX, FY, FX1 + 1, FY1 + 1), 1);
+ end;
+
+ skTriangle:
+ begin
+ SetLength(poly, 4);
+ poly[0] := PointF(FX1, FY1);
+ poly[1] := PointF(FX, FY1);
+ poly[2] := PointF(FX + FDX div 2, FY);
+ poly[3] := PointF(FX1, FY1);
+ FillPolygon(poly, 1);
+ DrawPolygon(poly, 1);
+ end;
+
+ skDiamond:
+ begin
+ SetLength(poly, 4);
+ poly[0] := PointF(FX + FDX div 2, FY);
+ poly[1] := PointF(FX1, FY + FDY div 2);
+ poly[2] := PointF(FX + FDX div 2, FY1);
+ poly[3] := PointF(FX, FY + FDY div 2);
+ FillPolygon(poly, 1);
+ DrawPolygon(poly, 1);
+ end;
+
+ skDiagonal1:
+ DrawLine(PointF(FX, FY1), PointF(FX1, FY), 1);
+
+ skDiagonal2:
+ DrawLine(PointF(FX, FY), PointF(FX1, FY1), 1);
+ end;
+ end;
+end;
+
+function TfrxShapeView.Diff(AComponent: TfrxComponent): String;
+begin
+ Result := inherited Diff(AComponent);
+
+ if FShape <> TfrxShapeView(AComponent).FShape then
+ Result := Result + ' Shape="' + frxValueToXML(FShape) + '"';
+end;
+
+class function TfrxShapeView.GetDescription: String;
+begin
+ Result := frxResources.Get('obShape');
+end;
+
+
+procedure TfrxShapeView.GetVisibleRect(var aRect: TRectF);
+begin
+ aRect := RectF(0, 0, 0, 0);
+ aRect.Left := AbsLeft - (Frame.Width + 1);
+ aRect.Top := AbsTop - (Frame.Width + 1);
+ aRect.Right := AbsLeft + Width + (Frame.Width + 1);
+ aRect.Bottom := AbsTop + Height + (Frame.Width + 1);
+end;
+{ TfrxHighlight }
+
+constructor TfrxHighlight.Create;
+begin
+ FColor := claNull;
+ FFont := TfrxFont.Create;
+ with FFont do
+ begin
+ Name := DefFontName;
+ Size := DefFontSize;
+ Color := claRed;
+ end;
+end;
+
+destructor TfrxHighlight.Destroy;
+begin
+ FFont.Free;
+ inherited;
+end;
+
+procedure TfrxHighlight.Assign(Source: TPersistent);
+begin
+ if Source is TfrxHighlight then
+ begin
+ FFont.Assign(TfrxHighlight(Source).Font);
+ FColor := TfrxHighlight(Source).Color;
+ FCondition := TfrxHighlight(Source).Condition;
+ end;
+end;
+
+procedure TfrxHighlight.SetFont(const Value: TfrxFont);
+begin
+ FFont.Assign(Value);
+end;
+
+
+{ TfrxFormat }
+
+procedure TfrxFormat.Assign(Source: TPersistent);
+begin
+ if Source is TfrxFormat then
+ begin
+ FDecimalSeparator := TfrxFormat(Source).DecimalSeparator;
+ FThousandSeparator := TfrxFormat(Source).ThousandSeparator;
+ FFormatStr := TfrxFormat(Source).FormatStr;
+ FKind := TfrxFormat(Source).Kind;
+ end;
+end;
+
+
+{ TfrxStretcheable }
+
+constructor TfrxStretcheable.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FStretchMode := smDontStretch;
+end;
+
+function TfrxStretcheable.CalcHeight: Double;
+begin
+ Result := Height;
+end;
+
+function TfrxStretcheable.DrawPart: Double;
+begin
+ Result := 0;
+end;
+
+procedure TfrxStretcheable.InitPart;
+begin
+//
+end;
+
+function TfrxStretcheable.HasNextDataPart: Boolean;
+begin
+ Result := False;
+end;
+
+
+{ TfrxCustomMemoView }
+
+constructor TfrxCustomMemoView.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ frComponentStyle := frComponentStyle - [csDefaultDiff];
+ FHighlight := TfrxHighlight.Create;
+ FDisplayFormat := TfrxFormat.Create;
+ FMemo := TfrxWideStrings.Create;
+ FAllowExpressions := True;
+ FClipped := True;
+ FExpressionDelimiters := '[,]';
+ FGapX := 2;
+ FGapY := 1;
+ FHAlign := haLeft;
+ FVAlign := vaTop;
+ FLineSpacing := 2;
+ ParentFont := True;
+ FWordWrap := True;
+ FWysiwyg := True;
+ FLastValue := Null;
+ FTextRenderer := nil;
+end;
+
+destructor TfrxCustomMemoView.Destroy;
+begin
+ FHighlight.Free;
+ FDisplayFormat.Free;
+ FMemo.Free;
+ inherited;
+end;
+
+class function TfrxCustomMemoView.GetDescription: String;
+begin
+ Result := frxResources.Get('obText');
+end;
+
+procedure TfrxCustomMemoView.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FFlowTo) then
+ FFlowTo := nil;
+end;
+
+function TfrxCustomMemoView.IsExprDelimitersStored: Boolean;
+begin
+ Result := FExpressionDelimiters <> '[,]';
+end;
+
+function TfrxCustomMemoView.IsLineSpacingStored: Boolean;
+begin
+ Result := FLineSpacing <> 2;
+end;
+
+function TfrxCustomMemoView.IsGapXStored: Boolean;
+begin
+ Result := FGapX <> 2;
+end;
+
+function TfrxCustomMemoView.IsGapYStored: Boolean;
+begin
+ Result := FGapY <> 1;
+end;
+
+function TfrxCustomMemoView.IsParagraphGapStored: Boolean;
+begin
+ Result := FParagraphGap <> 0;
+end;
+
+function TfrxCustomMemoView.IsAdvancedRendererNeeded: Boolean;
+begin
+ Result := (FHAlign = haBlock) or FAllowHTMLTags or (FLineSpacing <> 2);// or FWysiwyg;
+end;
+
+function TfrxCustomMemoView.IsCharSpacingStored: Boolean;
+begin
+ Result := FCharSpacing <> 0;
+end;
+
+function TfrxCustomMemoView.IsHighlightStored: Boolean;
+begin
+ Result := Trim(FHighlight.Condition) <> '';
+end;
+
+procedure TfrxCustomMemoView.SetRotation(Value: Integer);
+begin
+ FRotation := Value mod 360;
+end;
+
+procedure TfrxCustomMemoView.SetText(const Value: WideString);
+begin
+ FMemo.Text := Value;
+end;
+
+function TfrxCustomMemoView.GetText: WideString;
+begin
+ Result := FMemo.Text;
+end;
+
+procedure TfrxCustomMemoView.SetMemo(const Value: TWideStrings);
+begin
+ FMemo.Assign(Value);
+end;
+
+procedure TfrxCustomMemoView.SetHighlight(const Value: TfrxHighlight);
+begin
+ FHighlight.Assign(Value);
+end;
+
+procedure TfrxCustomMemoView.SetAllowHTMLTags(const Value: Boolean);
+begin
+ FAllowHTMLTags := Value;
+end;
+
+procedure TfrxCustomMemoView.SetDisplayFormat(const Value: TfrxFormat);
+begin
+ FDisplayFormat.Assign(Value);
+end;
+
+procedure TfrxCustomMemoView.SetStyle(const Value: String);
+begin
+ FStyle := Value;
+ if Report <> nil then
+ ApplyStyle(Report.Styles.Find(FStyle));
+end;
+
+function TfrxCustomMemoView.AdjustCalcHeight: Double;
+begin
+ Result := GapY * 2;
+ if ftTop in Frame.Typ then
+ Result := Result + (Frame.Width - 1) / 2;
+ if ftBottom in Frame.Typ then
+ Result := Result + Frame.Width / 2;
+ if Frame.DropShadow then
+ Result := Result + Frame.ShadowWidth;
+end;
+
+function TfrxCustomMemoView.AdjustCalcWidth: Double;
+begin
+ Result := GapX * 2 + 1;
+ if ftLeft in Frame.Typ then
+ Result := Result + Frame.Width / 2;
+ if ftRight in Frame.Typ then
+ Result := Result + Frame.Width / 2;
+ if Frame.DropShadow then
+ Result := Result + Frame.ShadowWidth;
+end;
+
+procedure TfrxCustomMemoView.BeginDraw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
+var
+ bx, by, bx1, by1, wx1, wx2, wy1, wy2, gx1, gy1: Single;
+begin
+ inherited BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+
+ wx1 := (Frame.Width * ScaleX - 1) / 2;
+ wx2 := Frame.Width * ScaleX / 2;
+ wy1 := (Frame.Width * ScaleY - 1) / 2;
+ wy2 := Frame.Width * ScaleY / 2;
+
+ bx := FX;
+ by := FY;
+ bx1 := FX1;
+ by1 := FY1;
+ if ftLeft in Frame.Typ then
+ bx := bx + wx1;
+ if ftRight in Frame.Typ then
+ bx1 := bx1 + wx2;
+ if ftTop in Frame.Typ then
+ by := by + wy1;
+ if ftBottom in Frame.Typ then
+ by1 := by1 + wy2;
+ gx1 := GapX * ScaleX;
+ gy1 := GapY * ScaleY;
+
+ FTextRect := RectF(bx + gx1, by + gy1, bx1 - gx1 - 1, by1 - gy1 - 1);
+end;
+
+function NormalizeText(const aText: String; bDeleteLineBreak: Boolean = true): String;
+begin
+ Result := ReplaceStr(aText, #13#10, System.sLineBreak);
+ if bDeleteLineBreak and EndsText(sLineBreak, aText) then
+ Delete(Result, Length(Result) - Length(sLineBreak) + 1, Length(sLineBreak));
+end;
+
+procedure TfrxCustomMemoView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+var
+ TextRenderer: TAdvancedTextRenderer;
+ SaveColor: TAlphaColor;
+ aFont: TfrxFont;
+ aText: String;
+{$IFNDEF DELPHI24}
+{$IFDEF DELPHI17}
+{$IFDEF MSWINDOWS}
+ oldh: Single;
+{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+ h, Sh, ALineHeight: Single;
+ state: TCanvasSaveState;
+ m, OldM: TMatrix;
+ e: Single;
+ TextCanvas: TCanvas;
+
+ procedure DrawUnderlines;
+ var
+ dy: Extended;
+ begin
+ with Canvas do
+ begin
+ Stroke.Color := Frame.Color;
+ Stroke.Kind := TBrushKind.bkSolid;
+ end;
+
+ //h := TextRenderer.LineHeight;
+ dy := FY + ALineHeight + (GapY - LineSpacing + 1) * ScaleY;
+ while dy < FY1 do
+ begin
+ Canvas.DrawLine(PointF(FX, Round(dy)), PointF(FX1, Round(dy)), 1);
+ dy := dy + ALineHeight;
+ end;
+ end;
+
+begin
+ SaveColor := FColor;
+ if Assigned(FFastCanvas) then
+ begin
+ TfrxFastCanvasLayer(FFastCanvas).Canvas := Canvas;
+ TextCanvas := FFastCanvas;
+ end
+ else
+ TextCanvas := Canvas;
+ ALineHeight := 0;
+ if FHighlight.Active then
+ begin
+ aFont := FHighlight.Font;
+ FColor := FHighlight.Color;
+ end
+ else
+ begin
+ aFont := FFont;
+ end;
+
+ inherited Draw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+ if not IsDesigning then
+ ExtractMacros
+ else if IsDataField then
+ FMemo.Text := '[' + DataSet.UserName + '."' + DataField + '"]';
+{$IFNDEF MSWINDOWS}
+ //if IsPrinting then
+ // FFont.PixelsPerInch := 96 * 1.5;
+{$ENDIF}
+
+{$IFDEF MSWINDOWS}
+ // aboid bug with right align draw of last line
+ // appears in D2D only
+ aText := NormalizeText(FMemo.Text, GlobalUseDirect2D);
+{$ELSE}
+ aText := NormalizeText(FMemo.Text);
+{$ENDIF}
+ sh := aFont.Height;
+ h := aFont.Height * FScaleY;
+{$IFNDEF DELPHI24}
+{$IFDEF DELPHI17}
+{$IFDEF MSWINDOWS}
+ oldh := aFont.Height;
+{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+{$IFNDEF DELPHI17}
+{$IFDEF MSWINDOWS}
+ if not IsPrinting then
+{$ENDIF}
+{$ENDIF}
+{$IFDEF DELPHI24}
+{$IFNDEF MSWINDOWS}
+ if not IsPrinting then
+{$ENDIF}
+{$ENDIF}
+{$IFNDEF DELPHI24}
+{$IFDEF DELPHI19}
+//{$IFNDEF MSWINDOWS}
+ if not IsPrinting then
+//{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+ aFont.Height := h;
+ ALineHeight := -h + FLineSpacing * FScaleY;
+ if IsAdvancedRendererNeeded then
+ begin
+ TextRenderer := TAdvancedTextRenderer.Create(TextCanvas, aText, aFont, FTextRect, FHAlign, FVAlign, ALineHeight, FRotation, FWordWrap, false, FAllowHTMLTags, false, ScaleX);
+ try
+ if FUnderlines and (FRotation = 0) then
+ DrawUnderlines;
+{$IFNDEF DELPHI24}
+{$IFDEF DELPHI17}
+{$IFDEF MSWINDOWS}
+ if IsPrinting then
+ aFont.Height := oldh;
+{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+ TextRenderer.Draw();
+ finally
+ TextRenderer.Free;
+ end;
+ end
+ else
+ begin
+ OldM := Canvas.Matrix;
+ State := Canvas.SaveState;
+
+ try
+ if FUnderlines and (FRotation = 0) then
+ DrawUnderlines;
+ Canvas.IntersectClipRect(FTextRect);
+
+ if FRotation <> 0 then
+ begin
+ m := CreateRotationMatrix(-DegToRad(FRotation));
+ m.m31 := OldM.m31 + FTextRect.Left + FTextRect.Width / 2;
+ m.m32 := OldM.m32 + FTextRect.Top + FTextRect.Height / 2;
+ Canvas.SetMatrix(m);
+
+ e := FTextRect.Width;
+ FTextRect.Left := -FTextRect.Width / 2;
+ FTextRect.Right := FTextRect.Left + e;
+ e := FTextRect.Height;
+ FTextRect.Top := -FTextRect.Height / 2;
+ FTextRect.Bottom := FTextRect.Top + e;
+
+ // rotate rect if angle is 90 or 270
+ if ((FRotation >= 90) and (FRotation < 180)) or ((FRotation >= 270) and (FRotation < 360)) then
+ FTextRect := RectF(FTextRect.Top, FTextRect.Left, FTextRect.Bottom, FTextRect.Right);
+ end;
+{$IFNDEF DELPHI24}
+{$IFDEF DELPHI17}
+{$IFDEF MSWINDOWS}
+ if IsPrinting then
+ aFont.Height := oldh;
+{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+ aFont.AssignToCanvas(Canvas);
+ TextCanvas.FillText(FTextRect, aText, FWordWrap, 1, [], frxHAlignToTextAlign(FHAlign), frxVAlignToTextAlign(FVAlign));
+
+ finally
+ Canvas.RestoreState(state);
+ Canvas.SetMatrix(OldM);
+ end;
+ end;
+{$IFNDEF MSWINDOWS}
+ if IsPrinting then
+ aFont.PixelsPerInch := 96;
+{$ENDIF}
+ aFont.Height := sh;
+ FColor := SaveColor;
+end;
+
+function TfrxCustomMemoView.CalcHeight: Double;
+var
+ TextRenderer: TAdvancedTextRenderer;
+ r: TRectF;
+ aText: String;
+ aFont: TfrxFont;
+ ALineHeight: Single;
+ TextCanvas: TCanvas;
+ FBmpCanvas: TBitmap;
+ bNeedFree: Boolean;
+begin
+ Result := 0;
+ aText := NormalizeText(FMemo.Text);
+ if aText = '' then
+ Exit;
+
+ if FHighlight.Active then
+ aFont := FHighlight.Font
+ else
+ aFont := FFont;
+ FBmpCanvas := nil;
+ bNeedFree := True;
+ if Report <> nil then
+ FBmpCanvas := Report.GetDrawBitmap;
+
+ if Assigned(FBmpCanvas) then
+ bNeedFree := False
+ else
+ FBmpCanvas := TBitmap.Create(1,1);
+
+ if Assigned(FFastCanvas) then
+ begin
+ TfrxFastCanvasLayer(FFastCanvas).Canvas := FBmpCanvas.Canvas;
+ TextCanvas := FFastCanvas;
+ end
+ else
+ TextCanvas := FBmpCanvas.Canvas;
+
+ TextCanvas.BeginScene();
+ try
+ BeginDraw(FBmpCanvas.Canvas, 1, 1, 0, 0);
+ r := RectF(0, 0, FTextRect.Width, 10000);
+ if IsAdvancedRendererNeeded then
+ begin
+ ALineHeight := -aFont.Height + FLineSpacing;
+ TextRenderer := TAdvancedTextRenderer.Create(TextCanvas, aText, aFont, r,
+ FHAlign, FVAlign, ALineHeight, FRotation, FWordWrap, False,
+ FAllowHTMLTags, False, 1);
+ try
+ Result := TextRenderer.CalcHeight() + 4 + AdjustCalcHeight;
+ finally
+ TextRenderer.Free;
+ end;
+ end
+ else
+ begin
+ aFont.AssignToCanvas(FBmpCanvas.Canvas);
+ TextCanvas.MeasureText(r, aText, FWordWrap, [],
+ frxHAlignToTextAlign(FHAlign), frxVAlignToTextAlign(FVAlign));
+ Result := r.Height + 4 + AdjustCalcHeight;
+ end;
+ finally
+ TextCanvas.EndScene;
+ if bNeedFree then
+ FBmpCanvas.Free;
+ end;
+end;
+
+function TfrxCustomMemoView.CalcWidth: Double;
+var
+ TextRenderer: TAdvancedTextRenderer;
+ r: TRectF;
+ aFont: TfrxFont;
+ aText: String;
+ TextCanvas: TCanvas;
+ addW: Single;
+ FBmpCanvas: TBitmap;
+ bNeedFree: Boolean;
+begin
+ Result := 0;
+ addW := 2;
+ aText := NormalizeText(FMemo.Text);
+ if aText = '' then
+ Exit;
+
+ if FHighlight.Active then
+ aFont := FHighlight.Font
+ else
+ aFont := FFont;
+ FBmpCanvas := nil;
+ bNeedFree := True;
+ if Report <> nil then
+ FBmpCanvas := Report.GetDrawBitmap;
+
+ if Assigned(FBmpCanvas) then
+ bNeedFree := False
+ else
+ FBmpCanvas := TBitmap.Create(1,1);
+ if Assigned(FFastCanvas) then
+ begin
+ TfrxFastCanvasLayer(FFastCanvas).Canvas := FBmpCanvas.Canvas;
+ TextCanvas := FFastCanvas;
+ end
+ else
+ TextCanvas := FBmpCanvas.Canvas;
+ if CompareText(FBmpCanvas.Canvas.ClassName, 'TCanvasD2D') = 0 then
+ addW := 4;
+ TextCanvas.BeginScene();
+ try
+ BeginDraw(FBmpCanvas.Canvas, 1, 1, 0, 0);
+ r := RectF(0, 0, 10000, 10000);
+ if IsAdvancedRendererNeeded then
+ begin
+ TextRenderer := TAdvancedTextRenderer.Create(TextCanvas, aText, aFont, r,
+ FHAlign, FVAlign, 0, FRotation, FWordWrap, False,
+ FAllowHTMLTags, False, 1);
+ try
+ Result := TextRenderer.CalcWidth() + TextRenderer.SpaceWidth + AdjustCalcWidth + addW;
+ finally
+ TextRenderer.Free;
+ end;
+ end
+ else
+ begin
+ aFont.AssignToCanvas(FBmpCanvas.Canvas);
+ TextCanvas.MeasureText(r, aText + ' ', FWordWrap, [],
+ TTextAlign.taLeading, TTextAlign.taLeading);
+ Result := r.Width + AdjustCalcWidth + addW;
+ end;
+ finally
+ TextCanvas.EndScene;
+ if bNeedFree then
+ FBmpCanvas.Free;
+ end;
+end;
+
+procedure TfrxCustomMemoView.InitPart;
+begin
+ FPartMemo := FMemo.Text;
+ FFirstParaBreak := False;
+ FLastParaBreak := False;
+end;
+
+function TfrxCustomMemoView.DrawPart: Double;
+var
+ TextRenderer: TAdvancedTextRenderer;
+ charsFit, nIndex, LWordIndex: Integer;
+ s2: String;
+ style: TStyleDescriptor;
+ aFont: TfrxFont;
+ TextCanvas: TCanvas;
+ r: TRectF;
+ PrevH: Double;
+ FBmpCanvas: TBitmap;
+ bNeedFree: Boolean;
+begin
+ if FHighlight.Active then
+ aFont := FHighlight.Font
+ else
+ aFont := FFont;
+
+ FBmpCanvas := nil;
+ bNeedFree := True;
+ if Report <> nil then
+ FBmpCanvas := Report.GetDrawBitmap;
+
+ if Assigned(FBmpCanvas) then
+ bNeedFree := False
+ else
+ FBmpCanvas := TBitmap.Create(1,1);
+ if Assigned(FFastCanvas) then
+ begin
+ TfrxFastCanvasLayer(FFastCanvas).Canvas := FBmpCanvas.Canvas;
+ TextCanvas := FFastCanvas;
+ end
+ else
+ TextCanvas := FBmpCanvas.Canvas;
+ TextCanvas.BeginScene;
+ BeginDraw(FBmpCanvas.Canvas, 1, 1, 0, 0);
+ try
+ if IsAdvancedRendererNeeded then
+ begin
+ TextRenderer := TAdvancedTextRenderer.Create(TextCanvas, FPartMemo, aFont,
+ FTextRect, FHAlign, FVAlign, -aFont.Height + FLineSpacing, FRotation,
+ FWordWrap, False, FAllowHTMLTags, False, 1);
+ try
+ Result := TextRenderer.CalcHeight(charsFit, Style);
+ if charsFit > 0 then
+ if (FPartMemo[charsFit]) <> #$0A then
+ charsFit := charsFit - 1;
+ FMemo.Text := Copy(FPartMemo, 1, charsFit);
+ Delete(FPartMemo, 1, charsFit);
+ if (FPartMemo = '') and (charsFit > 0) then
+ Result := 0
+ else if Result <> 0 then
+ Result := Height - Result;
+ finally
+ TextRenderer.Free;
+ end;
+ end
+ else
+ { text split for simple text output }
+ { we need that because we use simple height calculation }
+ { and for different fonts we can get different line spacing from advanced text render }
+ begin
+ s2 := '';
+ Result := 0;
+ Font.AssignToCanvas(FBmpCanvas.Canvas);
+ PrevH := 0;
+ LWordIndex := 1;
+ for nIndex := 1 to Length(FPartMemo) do
+ begin
+ r := RectF(0, 0, FTextRect.Width, 10000);
+ if (FPartMemo[nIndex] = #9) or (FPartMemo[nIndex] = ' ') or
+ (FPartMemo[nIndex] = #13) or (FPartMemo[nIndex] = #10) or
+ (nIndex = Length(FPartMemo)) then
+ begin
+ s2 := s2 + Copy(FPartMemo, LWordIndex, nIndex - LWordIndex);
+ //if s2 = '' then continue;
+
+ if (nIndex = Length(FPartMemo)) then
+ s2 := s2 + FPartMemo[nIndex];
+ TextCanvas.MeasureText(r, s2, FWordWrap, [],
+ frxHAlignToTextAlign(FHAlign), frxVAlignToTextAlign(FVAlign));
+
+ if (r.Height > Height) or (nIndex = Length(FPartMemo)) then
+ begin
+ { delete part only if text doesnt fit }
+ if (r.Height > Height) then
+ Delete(s2, Length(s2) - (nIndex - LWordIndex - 1), (nIndex - LWordIndex))
+ else
+ PrevH := r.Height;
+ { copy part that fit into bounds }
+ FMemo.Text := Copy(FPartMemo, 1, Length(s2));
+
+ { check if we have wrap at spec symbol and correct outbound text }
+ if (s2 <> '') and (Length(FPartMemo) > 1) then
+ begin
+ if (LWordIndex <= Length(FPartMemo)) and (FPartMemo[LWordIndex] = #13) then
+ Delete(FPartMemo, LWordIndex, Length(sLineBreak));
+ if (LWordIndex <= Length(FPartMemo)) and (FPartMemo[LWordIndex] = #10) then
+ Delete(FPartMemo, LWordIndex, 1);
+ if (LWordIndex <= Length(FPartMemo)) and (FPartMemo[LWordIndex] = ' ') then
+ Delete(FPartMemo, LWordIndex, 1);
+ end;
+ { correct outbound text }
+
+ Delete(FPartMemo, 1, Length(s2));
+ { return unused height }
+ if s2 = '' then
+ Result := Height
+ else if FPartMemo = '' then
+ Result := 0
+ else
+ Result := Height - PrevH;
+ break;
+ end;
+ { save current height we dont want to calculate it twice }
+ PrevH := r.Height;
+ LWordIndex := nIndex;
+ end;
+ end;
+ end;
+ finally
+ TextCanvas.EndScene;
+ if bNeedFree then
+ FBmpCanvas.Free;
+ end;
+end;
+
+function TfrxCustomMemoView.Diff(AComponent: TfrxComponent): String;
+var
+ m: TfrxCustomMemoView;
+ s: WideString;
+ c: Integer;
+begin
+ Result := inherited Diff(AComponent);
+ m := TfrxCustomMemoView(AComponent);
+
+ if FAutoWidth <> m.FAutoWidth then
+ Result := Result + ' AutoWidth="' + frxValueToXML(FAutoWidth) + '"';
+ if FloatDiff(FCharSpacing, m.FCharSpacing) then
+ Result := Result + ' CharSpacing="' + FloatToStr(FCharSpacing) + '"';
+ if FloatDiff(FGapX, m.FGapX) then
+ Result := Result + ' GapX="' + FloatToStr(FGapX) + '"';
+ if FloatDiff(FGapY, m.FGapY) then
+ Result := Result + ' GapY="' + FloatToStr(FGapY) + '"';
+ if FHAlign <> m.FHAlign then
+ Result := Result + ' HAlign="' + frxValueToXML(FHAlign) + '"';
+ if FHighlight.Active <> m.FHighlight.Active then
+ Result := Result + ' Highlight.Active="' + frxValueToXML(FHighlight.Active) + '"';
+ if FloatDiff(FLineSpacing, m.FLineSpacing) then
+ Result := Result + ' LineSpacing="' + FloatToStr(FLineSpacing) + '"';
+
+ c := FMemo.Count;
+ if c = 0 then
+ Result := Result + ' u=""'
+ else
+ begin
+ if c = 1 then
+ Result := Result + ' u="' + frxStrToXML(FMemo[0]) + '"'
+ else
+ begin
+ s := Text;
+ SetLength(s, Length(s) - 2);
+ Result := Result + ' u="' + frxStrToXML(s) + '"';
+ end;
+ end;
+
+ if FloatDiff(FParagraphGap, m.FParagraphGap) then
+ Result := Result + ' ParagraphGap="' + FloatToStr(FParagraphGap) + '"';
+ if FRotation <> m.FRotation then
+ Result := Result + ' Rotation="' + IntToStr(FRotation) + '"';
+ if FRTLReading <> m.FRTLReading then
+ Result := Result + ' RTLReading="' + frxValueToXML(FRTLReading) + '"';
+ if FUnderlines <> m.FUnderlines then
+ Result := Result + ' Underlines="' + frxValueToXML(FUnderlines) + '"';
+ if FVAlign <> m.FVAlign then
+ Result := Result + ' VAlign="' + frxValueToXML(FVAlign) + '"';
+ if FWordWrap <> m.FWordWrap then
+ Result := Result + ' WordWrap="' + frxValueToXML(FWordWrap) + '"';
+
+ { formatting }
+ if FDisplayFormat.FKind <> m.FDisplayFormat.FKind then
+ Result := Result + ' DisplayFormat.Kind="' + frxValueToXML(FDisplayFormat.FKind) + '"';
+ if FDisplayFormat.FDecimalSeparator <> m.FDisplayFormat.FDecimalSeparator then
+ Result := Result + ' DisplayFormat.DecimalSeparator="' + frxStrToXML(FDisplayFormat.FDecimalSeparator) + '"';
+ if FDisplayFormat.FThousandSeparator <> m.FDisplayFormat.FThousandSeparator then
+ Result := Result + ' DisplayFormat.ThousandSeparator="' + frxStrToXML(FDisplayFormat.FThousandSeparator) + '"';
+ if FDisplayFormat.FFormatStr <> m.FDisplayFormat.FFormatStr then
+ Result := Result + ' DisplayFormat.FormatStr="' + frxStrToXML(FDisplayFormat.FFormatStr) + '"';
+
+ if FFirstParaBreak then
+ Result := Result + ' FirstParaBreak="1"';
+ if FLastParaBreak then
+ Result := Result + ' LastParaBreak="1"';
+
+ FFirstParaBreak := FLastParaBreak;
+ FLastParaBreak := False;
+end;
+
+procedure TfrxCustomMemoView.BeforePrint;
+begin
+ inherited;
+ if not IsDataField then
+ FTempMemo := FMemo.Text;
+end;
+
+procedure TfrxCustomMemoView.AfterPrint;
+begin
+ if not IsDataField then
+ FMemo.Text := FTempMemo;
+ inherited;
+end;
+
+procedure TfrxCustomMemoView.GetData;
+var
+ i, j: Integer;
+ s, s1, s2, dc1, dc2: WideString;
+begin
+ inherited;
+ if IsDataField then
+ begin
+ if DataSet.IsBlobField(DataField) then
+ begin
+ DataSet.AssignBlobTo(DataField, FMemo);
+ end
+ else
+ begin
+ FValue := DataSet.Value[DataField];
+ if FDisplayFormat.Kind = fkText then
+ FMemo.Text := DataSet.DisplayText[DataField]
+ else
+ FMemo.Text := FormatData(FValue);
+ if FHideZeros and (TVarData(FValue).VType <> varString) and
+ (TVarData(FValue).VType <> varUString) and
+ (TVarData(FValue).VType <> varOleStr) and (FValue = 0) then
+ FMemo.Text := '';
+ end;
+ end
+ else if AllowExpressions then
+ begin
+ s := FMemo.Text;
+ i := 1;
+ dc1 := FExpressionDelimiters;
+ dc2 := Copy(dc1, Pos(',', dc1) + 1, 255);
+ dc1 := Copy(dc1, 1, Pos(',', dc1) - 1);
+
+ if Pos(dc1, s) <> 0 then
+ begin
+ repeat
+ while (i < Length(s)) and (Copy(s, i, Length(dc1)) <> dc1) do Inc(i);
+
+ s1 := frxGetBrackedVariableW(s, dc1, dc2, i, j);
+ if i <> j then
+ begin
+ Delete(s, i, j - i + 1);
+ s2 := CalcAndFormat(s1);
+ Insert(s2, s, i);
+ Inc(i, Length(s2));
+ j := 0;
+ end;
+ until i = j;
+
+ FMemo.Text := s;
+ end;
+ end;
+
+ Report.LocalValue := FValue;
+ FHighlight.Active := False;
+ if FHighlight.Condition <> '' then
+ FHighlight.Active := Report.Calc(FHighlight.Condition);
+
+ if FSuppressRepeated then
+ begin
+ if FLastValue = FMemo.Text then
+ FMemo.Text := '' else
+ FLastValue := FMemo.Text;
+ end;
+
+ if FFlowTo <> nil then
+ begin
+ InitPart;
+ DrawPart;
+ FFlowTo.Text := FPartMemo;
+ FFlowTo.AllowExpressions := False;
+ end;
+end;
+
+procedure TfrxCustomMemoView.ResetSuppress;
+begin
+ FLastValue := '';
+end;
+
+function TfrxCustomMemoView.CalcAndFormat(const Expr: WideString): WideString;
+var
+ i: Integer;
+ ExprStr, FormatStr: WideString;
+ Format: TfrxFormat;
+begin
+ Result := '';
+ Format := nil;
+ i := Pos(WideString(' #'), Expr);
+ if i <> 0 then
+ begin
+ ExprStr := Copy(Expr, 1, i - 1);
+ FormatStr := Copy(Expr, i + 2, Length(Expr) - i - 1);
+ if Pos(')', FormatStr) = 0 then
+ begin
+ Format := TfrxFormat.Create;
+
+ if CharInSet(FormatStr[1], [WideChar('N'), WideChar('n')]) then
+ begin
+ Format.Kind := fkNumeric;
+ for i := 1 to Length(FormatStr) do
+ if CharInSet(FormatStr[i], [WideChar(','), WideChar('.'), WideChar('-')]) then
+ begin
+ Format.DecimalSeparator := FormatStr[i];
+ FormatStr[i] := '.';
+ end;
+ end
+ else if CharInSet(FormatStr[1], [WideChar('D'), WideChar('T'), WideChar('d'), WideChar('t')]) then
+ Format.Kind := fkDateTime
+ else if CharInSet(FormatStr[1], [WideChar('B'), WideChar('b')]) then
+ Format.Kind := fkBoolean;
+
+ Format.FormatStr := Copy(FormatStr, 2, 255);
+ end
+ else
+ ExprStr := Expr;
+ end
+ else
+ ExprStr := Expr;
+
+ try
+ if CompareText(ExprStr, 'TOTALPAGES#') = 0 then
+ FValue := '[TotalPages#]'
+ else if CompareText(ExprStr, 'COPYNAME#') = 0 then
+ FValue := '[CopyName#]'
+ else
+ FValue := Report.Calc(ExprStr);
+ if FHideZeros and (TVarData(FValue).VType <> varString) and
+ (TVarData(FValue).VType <> varOleStr) and
+ (TVarData(FValue).VType <> varUString) and
+ (FValue = 0) then
+ Result := ''
+ else
+ Result := FormatData(FValue, Format);
+ finally
+ if Format <> nil then
+ Format.Free;
+ end;
+end;
+
+function TfrxCustomMemoView.FormatData(const Value: Variant;
+ AFormat: TfrxFormat = nil): WideString;
+var
+ i, DecSepPos: Integer;
+begin
+ DecSepPos := 0;
+ if AFormat = nil then
+ AFormat := FDisplayFormat;
+ if VarIsNull(Value) then
+ Result := ''
+ else if AFormat.Kind = fkText then
+ Result := VarToWideStr(Value)
+ else
+ try
+ case AFormat.Kind of
+ fkNumeric:
+ begin
+ if (Pos('#', AFormat.FormatStr) <> 0) or (Pos('0', AFormat.FormatStr) = 1) then
+ Result := FormatFloat(AFormat.FormatStr, Extended(Value))
+ else if (Pos('d', AFormat.FormatStr) <> 0) or (Pos('u', AFormat.FormatStr) <> 0) then
+ Result := Format(AFormat.FormatStr, [Integer(Value)])
+ else
+ Result := Format(AFormat.FormatStr, [Extended(Value)]);
+ if (Length(AFormat.DecimalSeparator) = 1) and
+ (FormatSettings.DecimalSeparator <> AFormat.DecimalSeparator[1]) then
+ for i := Length(Result) downto 1 do
+ if Result[i] = WideChar(FormatSettings.DecimalSeparator) then
+ begin
+ DecSepPos := i; // save dec seporator pos
+ break;
+ end;
+
+ if (Length(AFormat.ThousandSeparator) = 1) and
+ (FormatSettings.ThousandSeparator <> AFormat.ThousandSeparator[1]) then
+ for i := 1 to Length(Result) do
+ if Result[i] = WideChar(FormatSettings.ThousandSeparator) then
+ Result[i] := WideChar(AFormat.ThousandSeparator[1]);
+
+ if DecSepPos > 0 then // replace dec seporator
+ Result[DecSepPos] := WideChar(AFormat.DecimalSeparator[1]);
+ end;
+
+ fkDateTime:
+ Result := FormatDateTime(AFormat.FormatStr, Value);
+
+ fkBoolean:
+ if Value = True then
+ Result := Copy(AFormat.FormatStr, Pos(',', AFormat.FormatStr) + 1, 255) else
+ Result := Copy(AFormat.FormatStr, 1, Pos(',', AFormat.FormatStr) - 1);
+ else
+ Result := VarToWideStr(Value)
+ end;
+ except
+ Result := VarToWideStr(Value)
+ end;
+end;
+
+function TfrxCustomMemoView.GetComponentText: String;
+var
+ i: Integer;
+begin
+ Result := FMemo.Text;
+ if FAllowExpressions then { extract TOTALPAGES macro if any }
+ begin
+ i := Pos('[TOTALPAGES]', UpperCase(Result));
+ if i <> 0 then
+ begin
+ Delete(Result, i, 12);
+ Insert(IntToStr(FTotalPages), Result, i);
+ end;
+ end;
+end;
+
+procedure TfrxCustomMemoView.ApplyStyle(Style: TfrxStyleItem);
+begin
+ if Style <> nil then
+ begin
+ Color := Style.Color;
+ Font := Style.Font;
+ Frame := Style.Frame;
+ end;
+end;
+
+procedure TfrxCustomMemoView.WrapText(WrapWords: Boolean; var aLineHeight: Single; WrapLines: TWideStrings; aBitmap: TBitmap);
+
+const
+{$IFDEF MACOS}
+ AddTextWidth = 0.0;
+{$ELSE}
+ AddTextWidth = -2.0;
+{$ENDIF}
+{$IFDEF MACOS}
+ AddHeight = 1;
+{$ELSE}
+ AddHeight = 1.5;
+{$ENDIF}
+
+var
+ TextRenderer: TAdvancedTextRenderer;
+ paragraph: TParagraph;
+ s1, s2, s3: String;
+ nIndex, idx, idy, LWordIndex: Integer;
+ TextCanvas: TCanvas;
+ FBmpCanvas: TBitmap;
+ HasWords: Boolean;
+ aText: String;
+ aSpaceWidth: Single;
+
+ function SplitString(const sText: String): String;
+ var
+ Len, RemaingLen: Integer;
+ CurWidth: Integer;
+ begin
+ Result := sText;
+ Len := (length(Result) + 1) div 2;
+ RemaingLen := length(Result);
+ CurWidth := Round(TextCanvas.TextWidth(sText));
+ while (true) do
+ begin
+
+ if (CurWidth = Trunc(FTextRect.Width - AddTextWidth)) then
+ break
+ else if (Len = 0) then
+ begin
+ if TextCanvas.TextWidth(Copy(sText, 1, RemaingLen + 1)) + aSpaceWidth < Trunc(FTextRect.Width - AddTextWidth) then
+ Inc(Len)
+ else
+ break;
+ end;
+ if (CurWidth + aSpaceWidth> Trunc(FTextRect.Width - AddTextWidth)) then
+ begin
+ RemaingLen := RemaingLen - Len;
+ Result := Copy(Result, 1, RemaingLen);
+ end
+ else if (CurWidth + aSpaceWidth < Trunc(FTextRect.Width - AddTextWidth)) then
+ begin
+ RemaingLen := RemaingLen + Len;
+ Result := Copy(sText, 1, RemaingLen);
+
+ end;
+ Len := Len div 2;
+
+ CurWidth := Round(TextCanvas.TextWidth(Result));
+ end;
+ end;
+
+begin
+ if not Assigned(WrapLines) then Exit;
+ aText := NormalizeText(FMemo.Text);
+ if Assigned(aBitmap) then
+ FBmpCanvas := aBitmap
+ else
+ FBmpCanvas := TBitmap.Create(1,1);
+
+ if Assigned(FFastCanvas) then
+ begin
+ TfrxFastCanvasLayer(FFastCanvas).Canvas := FBmpCanvas.Canvas;
+ TextCanvas := FFastCanvas;
+ end
+ else
+ TextCanvas := FBmpCanvas.Canvas;
+ TextCanvas.BeginScene();
+ BeginDraw(FBmpCanvas.Canvas, 1, 1, 0, 0);
+ try
+ if IsAdvancedRendererNeeded then
+ begin
+ TextRenderer := TAdvancedTextRenderer.Create(TextCanvas, aText,
+ FFont, FTextRect, FHAlign, FVAlign, -Font.Height + FLineSpacing * 1, FRotation, FWordWrap, False,
+ FAllowHTMLTags, False, 1);
+ try
+ for idx := 0 to TextRenderer.Paragraphs.Count - 1 do
+ begin
+ paragraph := TextRenderer.Paragraphs[idx];
+ for idy := 0 to paragraph.Lines.Count - 1 do
+ WrapLines.Add(paragraph.Lines[idy].Text);
+ if paragraph.Lines.Count > 0 then
+ begin
+ { 1 - means paragraph start}
+ WrapLines.Objects[WrapLines.Count - paragraph.Lines.Count] := TObject(1);
+ { 2 - means paragraph end }
+ { 3 - both }
+ WrapLines.Objects[WrapLines.Count - 1] := TObject(Integer(WrapLines.Objects[WrapLines.Count - 1]) + 2);
+ end;
+ end;
+ finally
+ aLineHeight := TextRenderer.LineHeight;
+ TextRenderer.Free;
+ end;
+ end
+ else
+ begin
+ Font.AssignToCanvas(FBmpCanvas.Canvas);
+ aSpaceWidth := 0;
+
+ for idx := 0 to Memo.Count - 1 do
+ begin
+ s1 := Memo[idx];
+ if (s1 = '') or (s1 = ' ') or (s1 = #9) then
+ begin
+ WrapLines.Add('');
+ Continue;
+ end;
+ nIndex := 1;
+ s2 := '';
+ LWordIndex := 1;
+ HasWords := False;
+ while nIndex <= Length(s1) do
+ begin
+ if (s1[nIndex] = #9) or (s1[nIndex] = ' ') or (nIndex = Length(s1)) then
+ begin
+ s2 := s2 + Copy(s1, LWordIndex, nIndex - LWordIndex);
+ if (nIndex = Length(s1)) then
+ s2 := s2 + s1[nIndex];
+ if (TextCanvas.TextWidth(s2) {+ aSpaceWidth} > Trunc(FTextRect.Width - AddTextWidth)) then
+ begin
+ if not HasWords then
+ begin
+ s3 := SplitString(s2);
+ if (s3 = '') and (nIndex = Length(s1)) then
+ begin
+ s2 := '';
+ break;
+ end;
+ WrapLines.Add(s3);
+ nIndex := LWordIndex + Length(s3);
+ LWordIndex := LWordIndex + Length(s3);
+ end
+ else
+ begin
+ WrapLines.Add(Copy(s2, 1, Length(s2) - (nIndex - LWordIndex)));
+ Inc(LWordIndex);
+ nIndex := LWordIndex;
+ end;
+ HasWords := False;
+ s2 := '';
+ end
+ else
+ LWordIndex := nIndex;
+ if (s1[nIndex] = #9) or (s1[nIndex] = ' ') then
+ HasWords := True;
+ end;
+ Inc(nIndex);
+ end;
+ if s2 <> '' then
+ WrapLines.Add(s2);
+ end;
+ aLineHeight := Font.GetHeight(FBmpCanvas.Canvas) + AddHeight;
+ end;
+ finally
+ TextCanvas.EndScene;
+ if not Assigned(aBitmap) then
+ FBmpCanvas.Free;
+ end
+end;
+
+procedure TfrxCustomMemoView.ExtractMacros;
+var
+ s, s1: WideString;
+ i, j: Integer;
+begin
+ if FAllowExpressions then
+ begin
+ s := FMemo.Text;
+ i := Pos('[TOTALPAGES#]', UpperCase(s));
+ if i <> 0 then
+ begin
+ Delete(s, i, 13);
+ Insert(IntToStr(FTotalPages), s, i);
+ FMemo.Text := s;
+ end;
+ i := Pos('[COPYNAME#]', UpperCase(s));
+ if i <> 0 then
+ begin
+ j := frxGlobalVariables.IndexOf('CopyName' + IntToStr(FCopyNo));
+ if j <> -1 then
+ s1 := VarToStr(frxGlobalVariables.Items[j].Value)
+ else
+ s1 := '';
+ Delete(s, i, 11);
+ Insert(s1, s, i);
+ FMemo.Text := s;
+ end;
+ end;
+end;
+
+
+{ TfrxSysMemoView }
+
+class function TfrxSysMemoView.GetDescription: String;
+begin
+ Result := frxResources.Get('obSysText');
+end;
+
+
+{ TfrxCustomLineView }
+
+constructor TfrxCustomLineView.Create(AOwner: TComponent);
+begin
+ inherited;
+ frComponentStyle := frComponentStyle - [csDefaultDiff];
+ FArrowWidth := 5;
+ FArrowLength := 20;
+end;
+
+constructor TfrxCustomLineView.DesignCreate(AOwner: TComponent; Flags: Word);
+begin
+ inherited;
+ FDiagonal := Flags <> 0;
+ FArrowEnd := Flags in [2, 4];
+ FArrowStart := Flags in [3, 4];
+end;
+
+procedure TfrxCustomLineView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+begin
+ if not FDiagonal then
+ begin
+ if Width > Height then
+ begin
+ Height := 0;
+ Frame.Typ := [ftTop];
+ end
+ else
+ begin
+ Width := 0;
+ Frame.Typ := [ftLeft];
+ end;
+ end;
+
+ BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+ if not FDiagonal then
+ begin
+ DrawFrame;
+ if FArrowStart then
+ DrawArrow(FX1, FY1, FX, FY);
+ if FArrowEnd then
+ DrawArrow(FX, FY, FX1, FY1);
+ end
+ else
+ DrawDiagonalLine;
+end;
+
+procedure TfrxCustomLineView.DrawArrow(x1, y1, x2, y2: Extended);
+var
+ k1, a, b, c, D: Double;
+ xp, yp, x3, y3, x4, y4, wd, ld: Extended;
+ poly: TPolygon;
+begin
+ wd := FArrowWidth * FScaleX;
+ ld := FArrowLength * FScaleX;
+ if abs(x2 - x1) > 8 then
+ begin
+ k1 := (y2 - y1) / (x2 - x1);
+ a := Sqr(k1) + 1;
+ b := 2 * (k1 * ((x2 * y1 - x1 * y2) / (x2 - x1) - y2) - x2);
+ c := Sqr(x2) + Sqr(y2) - Sqr(ld) + Sqr((x2 * y1 - x1 * y2) / (x2 - x1)) -
+ 2 * y2 * (x2 * y1 - x1 * y2) / (x2 - x1);
+ D := Sqr(b) - 4 * a * c;
+ xp := (-b + Sqrt(D)) / (2 * a);
+ if (xp > x1) and (xp > x2) or (xp < x1) and (xp < x2) then
+ xp := (-b - Sqrt(D)) / (2 * a);
+ yp := xp * k1 + (x2 * y1 - x1 * y2) / (x2 - x1);
+ if y2 <> y1 then
+ begin
+ x3 := xp + wd * sin(ArcTan(k1));
+ y3 := yp - wd * cos(ArcTan(k1));
+ x4 := xp - wd * sin(ArcTan(k1));
+ y4 := yp + wd * cos(ArcTan(k1));
+ end
+ else
+ begin
+ x3 := xp;
+ y3 := yp - wd;
+ x4 := xp;
+ y4 := yp + wd;
+ end;
+ end
+ else
+ begin
+ xp := x2;
+ yp := y2 - ld;
+ if (yp > y1) and (yp > y2) or (yp < y1) and (yp < y2) then
+ yp := y2 + ld;
+ x3 := xp - wd;
+ y3 := yp;
+ x4 := xp + wd;
+ y4 := yp;
+ end;
+
+ SetLength(poly, 4);
+ poly[0] := PointF(Round(x2), Round(y2));
+ poly[1] := PointF(Round(x3), Round(y3));
+ poly[2] := PointF(Round(x4), Round(y4));
+ poly[3] := PointF(Round(x2), Round(y2));
+
+ if FArrowSolid then
+ begin
+ FCanvas.Fill.Kind := TBrushKind.bkSolid;
+ FCanvas.Fill.Color := Frame.Color;
+ FCanvas.FillPolygon(poly, 1);
+ end
+ else
+ begin
+ FCanvas.DrawPolygon(poly, 1);
+ end;
+end;
+
+procedure TfrxCustomLineView.DrawDiagonalLine;
+begin
+ if (Frame.Color = claNull) or (Frame.Width = 0) then exit;
+
+ with FCanvas do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := Frame.Color;
+{$IFDEF DELPHI25}
+ Stroke.Thickness := Round(FFrame.Width * FScaleX);
+ if Frame.Style <> fsDouble then
+ Stroke.Dash := TStrokeDash(Frame.Style) else
+ Stroke.Dash := TStrokeDash.sdSolid;
+{$ELSE}
+ StrokeThickness := Round(FFrame.Width * FScaleX);
+ if Frame.Style <> fsDouble then
+ StrokeDash := TStrokeDash(Frame.Style) else
+ StrokeDash := TStrokeDash.sdSolid;
+{$ENDIF}
+
+ DrawLine(PointF(FX, FY), PointF(FX1, FY1), 1);
+
+ if FArrowStart then
+ DrawArrow(FX1, FY1, FX, FY);
+ if FArrowEnd then
+ DrawArrow(FX, FY, FX1, FY1);
+ end;
+end;
+
+
+procedure TfrxCustomLineView.GetVisibleRect(var aRect: TRectF);
+var
+ xTemp, AddFrame: Single;
+begin
+ AddFrame := 1;
+ if FArrowStart or FArrowEnd then
+ AddFrame := AddFrame + FArrowWidth / 2;
+ aRect := RectF(AbsLeft, AbsTop, AbsLeft + Width, AbsTop + Height);
+ if aRect.Bottom < aRect.Top then
+ begin
+ xTemp := aRect.Bottom;
+ aRect.Bottom := aRect.Top;
+ aRect.Top := xTemp;
+ end;
+ if aRect.Right < aRect.Left then
+ begin
+ xTemp := aRect.Right;
+ aRect.Right := aRect.Left;
+ aRect.Left := xTemp;
+ end;
+
+ aRect.Left := aRect.Left - (Frame.Width + AddFrame);
+ aRect.Top := aRect.Top - (Frame.Width + AddFrame);
+ aRect.Right := aRect.Right + (Frame.Width + AddFrame);
+ aRect.Bottom := aRect.Bottom + (Frame.Width + AddFrame);
+end;
+
+{ TfrxLineView }
+
+class function TfrxLineView.GetDescription: String;
+begin
+ Result := frxResources.Get('obLine');
+end;
+
+
+{ TfrxPictureView }
+
+constructor TfrxPictureView.Create(AOwner: TComponent);
+begin
+ inherited;
+ frComponentStyle := frComponentStyle - [csDefaultDiff];
+ FPicture := TBitmap.Create(0, 0);
+ FPicture.OnChange := PictureChanged;
+ FKeepAspectRatio := True;
+ FStretched := True;
+ FColor := claWhite;
+ FTransparentColor := claWhite;
+ FIsPictureStored := True;
+end;
+
+procedure TfrxPictureView.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ Filer.DefineBinaryProperty('Data', ReadVCLPicture, nil, false);
+end;
+
+destructor TfrxPictureView.Destroy;
+begin
+ FPicture.Free;
+ inherited;
+end;
+
+class function TfrxPictureView.GetDescription: String;
+begin
+ Result := frxResources.Get('obPicture');
+end;
+
+procedure TfrxPictureView.SetPicture(const Value: TBitmap);
+begin
+ FPicture.Assign(Value);
+end;
+
+procedure TfrxPictureView.SetTransparent(const Value: Boolean);
+begin
+ FTransparent := Value;
+ if FTransparent then
+ FColor := claNull
+ else FColor := claWhite;
+end;
+
+procedure TfrxPictureView.SetAutoSize(const Value: Boolean);
+begin
+ FAutoSize := Value;
+ if FAutoSize and not (FPicture = nil) then
+ begin
+ FWidth := FPicture.Width;
+ FHeight := FPicture.Height;
+ end;
+end;
+
+procedure TfrxPictureView.PictureChanged(Sender: TObject);
+begin
+ AutoSize := FAutoSize;
+ FPictureChanged := True;
+end;
+
+procedure TfrxPictureView.ReadVCLPicture(Stream: TStream);
+var
+ LenName: Byte;
+begin
+ { skip VCL Image format }
+ Stream.Read(LenName, 1);
+ Stream.Position := 5 + LenName;
+ FPicture.LoadFromStream(Stream);
+end;
+
+procedure TfrxPictureView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
+var
+ r: TRectF;
+ kx, ky: Extended;
+ state: TCanvasSaveState;
+ OldM: TMatrix;
+{ rgn: HRGN;
+
+ procedure PrintGraphic(Canvas: TCanvas; DestRect: TRect; aGraph: TGraphic);
+ begin
+ frxDrawGraphic(Canvas, DestRect, aGraph, IsPrinting, HightQuality, FTransparent, FTransparentColor);
+ end;
+}
+begin
+ BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+
+ with Canvas do
+ begin
+
+ DrawBackground;
+
+ r := RectF(FX, FY, FX1, FY1);
+
+ if FPicture.IsEmpty then
+ begin
+{ if IsDesigning then
+ frxResources.ObjectImages.Draw(Canvas, FX + 1, FY + 2, 3);}
+ end
+ else
+ begin
+ if FStretched then
+ begin
+ if FKeepAspectRatio then
+ begin
+ kx := FDX / FPicture.Width;
+ ky := FDY / FPicture.Height;
+ if kx < ky then
+ r.Bottom := r.Top + Round(FPicture.Height * kx) else
+ r.Right := r.Left + Round(FPicture.Width * ky);
+
+ if FCenter then
+ OffsetRect(r, (FDX - (r.Right - r.Left)) / 2,
+ (FDY - (r.Bottom - r.Top)) / 2);
+ end;
+
+ Canvas.DrawBitmap(FPicture, RectF(0, 0, FPicture.Width, FPicture.Height), r, 1, not FHightQuality);
+
+ end
+ else
+ begin
+ if FCenter then
+ OffsetRect(r, (FDX - Round(ScaleX * FPicture.Width)) div 2,
+ (FDY - Round(ScaleY * FPicture.Height)) div 2);
+ r.Right := r.Left + Round(FPicture.Width * ScaleX);
+ r.Bottom := r.Top + Round(FPicture.Height * ScaleY);
+ OldM := Canvas.Matrix;
+ State := Canvas.SaveState;
+ try
+ Canvas.IntersectClipRect(REctF(FX, FY, FX1, FY1));
+ Canvas.DrawBitmap(FPicture, RectF(0, 0, FPicture.Width, FPicture.Height), r, 1, not FHightQuality);
+ finally
+ Canvas.RestoreState(state);
+ Canvas.SetMatrix(OldM);
+ end;
+ end;
+ end;
+ DrawFrame;
+ end;
+end;
+
+function TfrxPictureView.Diff(AComponent: TfrxComponent): String;
+begin
+ if FPictureChanged then
+ begin
+ Report.PreviewPages.AddPicture(Self);
+ FPictureChanged := False;
+ end;
+
+ Result := ' ' + inherited Diff(AComponent) + ' ImageIndex="' +
+ IntToStr(FImageIndex) + '"';
+ if Transparent then
+ Result := Result + ' Transparent="' + frxValueToXML(FTransparent) + '"';
+ if TransparentColor <> claWhite then
+ Result := Result + ' TransparentColor="' + intToStr(Integer(FTransparentColor)) + '"';
+end;
+
+ type
+ TGraphicHeader = record
+ Count: Word;
+ HType: Word;
+ Size: Int32;
+ end;
+procedure TfrxPictureView.GetData;
+var
+ m: TMemoryStream;
+ s: String;
+ ipos: Integer;
+ Header: TGraphicHeader;
+begin
+ inherited;
+ if FFileLink <> '' then
+ begin
+ s := FFileLink;
+ if Pos('[', s) <> 0 then
+ ExpandVariables(s);
+ if FileExists(s) then
+ FPicture.LoadFromFile(s)
+ else
+ FPicture.SetSize(0,0);
+ end
+ else if IsDataField and DataSet.IsBlobField(DataField) then
+ begin
+ m := TMemoryStream.Create;
+ try
+ DataSet.AssignBlobTo(DataField, m);
+ if m.Size >= SizeOf(TGraphicHeader) then
+ begin
+ ipos := m.Position;
+ m.Read(Header, SizeOf(Header));
+ if (Header.Count <> 1) or (Header.HType <> $0100) or
+ (Header.Size <> m.Size - SizeOf(Header)) then
+ m.Position := ipos;
+ end;
+ FPicture.LoadFromStream(m);
+ finally
+ m.Free;
+ end;
+ end;
+end;
+
+
+{ TfrxBand }
+
+constructor TfrxBand.Create(AOwner: TComponent);
+begin
+ inherited;
+ FSubBands := TList.Create;
+ FOriginalObjectsCount := -1;
+end;
+
+destructor TfrxBand.Destroy;
+begin
+ FSubBands.Free;
+ inherited;
+end;
+
+procedure TfrxBand.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FChild) then
+ FChild := nil;
+end;
+
+procedure TfrxBand.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
+begin
+end;
+
+function TfrxBand.GetBandName: String;
+begin
+ Result := ClassName;
+ Delete(Result, Pos('Tfrx', Result), 4);
+ Delete(Result, Pos('Band', Result), 4);
+end;
+
+function TfrxBand.BandNumber: Integer;
+var
+ i: Integer;
+begin
+ Result := 0;
+ for i := 0 to BND_COUNT - 1 do
+ if Self is frxBands[i] then
+ Result := i;
+end;
+
+class function TfrxBand.GetDescription: String;
+begin
+ Result := frxResources.Get('obBand');
+end;
+
+procedure TfrxBand.SetLeft(Value: Double);
+begin
+ if Parent is TfrxDMPPage then
+ Value := Round(Value / fr1CharX) * fr1CharX;
+ inherited;
+end;
+
+procedure TfrxBand.SetTop(Value: Double);
+begin
+ if Parent is TfrxDMPPage then
+ Value := Round(Value / fr1CharY) * fr1CharY;
+ inherited;
+end;
+
+procedure TfrxBand.SetVertical(const Value: Boolean);
+begin
+{$IFDEF RAD_ED}
+ FVertical := False;
+{$ELSE}
+ FVertical := Value;
+{$ENDIF}
+end;
+
+procedure TfrxBand.SetHeight(Value: Double);
+begin
+ if Parent is TfrxDMPPage then
+ Value := Round(Value / fr1CharY) * fr1CharY;
+ inherited;
+end;
+
+procedure TfrxBand.SetChild(Value: TfrxChild);
+var
+ b: TfrxBand;
+begin
+ b := Value;
+ while b <> nil do
+ begin
+ b := b.Child;
+ if b = Self then
+ raise Exception.Create(frxResources.Get('clCirRefNotAllow'));
+ end;
+ FChild := Value;
+end;
+
+
+{ TfrxDataBand }
+
+constructor TfrxDataBand.Create(AOwner: TComponent);
+begin
+ inherited;
+ FVirtualDataSet := TfrxUserDataSet.Create(nil);
+ FVirtualDataSet.RangeEnd := reCount;
+end;
+
+destructor TfrxDataBand.Destroy;
+begin
+ FVirtualDataSet.Free;
+ inherited;
+end;
+
+class function TfrxDataBand.GetDescription: String;
+begin
+ Result := frxResources.Get('obDataBand');
+end;
+
+procedure TfrxDataBand.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FDataSet) then
+ FDataSet := nil;
+end;
+
+procedure TfrxDataBand.SetCurColumn(Value: Integer);
+begin
+ if Value > FColumns then
+ Value := 1;
+ FCurColumn := Value;
+ if FCurColumn = 1 then
+ FMaxY := 0;
+ FLeft := (FCurColumn - 1) * (FColumnWidth + FColumnGap);
+end;
+
+procedure TfrxDataBand.SetDataSet(const Value: TfrxDataSet);
+begin
+ FDataSet := Value;
+ if FDataSet = nil then
+ FDataSetName := '' else
+ FDataSetName := FDataSet.UserName;
+end;
+
+procedure TfrxDataBand.SetDataSetName(const Value: String);
+begin
+ FDataSetName := Value;
+ FDataSet := FindDataSet(FDataSet, FDataSetName);
+end;
+
+function TfrxDataBand.GetDataSetName: String;
+begin
+ if FDataSet = nil then
+ Result := FDataSetName else
+ Result := FDataSet.UserName;
+end;
+
+procedure TfrxDataBand.SetRowCount(const Value: Integer);
+begin
+ FRowCount := Value;
+ FVirtualDataSet.RangeEndCount := Value;
+end;
+
+
+{ TfrxPageHeader }
+
+constructor TfrxPageHeader.Create(AOwner: TComponent);
+begin
+ inherited;
+ FPrintOnFirstPage := True;
+end;
+
+
+{ TfrxPageFooter }
+
+constructor TfrxPageFooter.Create(AOwner: TComponent);
+begin
+ inherited;
+ FPrintOnFirstPage := True;
+ FPrintOnLastPage := True;
+end;
+
+
+{ TfrxGroupHeader }
+
+function TfrxGroupHeader.Diff(AComponent: TfrxComponent): String;
+begin
+ Result := inherited Diff(AComponent);
+ if FDrillDown then
+ Result := Result + ' DrillName="' + FDrillName + '"';
+end;
+
+
+{ TfrxSubreport }
+
+constructor TfrxSubreport.Create(AOwner: TComponent);
+begin
+ inherited;
+ frComponentStyle := frComponentStyle - [csPreviewVisible];
+ FFrame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
+ FFont.Name := 'Tahoma';
+ FFont.Size := 8;
+ FColor := claSilver;
+end;
+
+destructor TfrxSubreport.Destroy;
+begin
+ if FPage <> nil then
+ FPage.FSubReport := nil;
+ inherited;
+end;
+
+procedure TfrxSubreport.SetPage(const Value: TfrxReportPage);
+begin
+ FPage := Value;
+ if FPage <> nil then
+ FPage.FSubReport := Self;
+end;
+
+procedure TfrxSubreport.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+begin
+ inherited;
+
+{ with Canvas do
+ begin
+ Font.Assign(FFont);
+ FillText(FX + 2, FY + 2, Name);
+ end;}
+end;
+
+class function TfrxSubreport.GetDescription: String;
+begin
+ Result := frxResources.Get('obSubRep');
+end;
+
+
+{ TfrxDialogPage }
+
+constructor TfrxDialogPage.Create(AOwner: TComponent);
+var
+ FSaveTag: Integer;
+begin
+ inherited;
+ FSaveTag := Tag;
+ if (Report <> nil) and Report.EngineOptions.EnableThreadSafe then
+ Tag := 318
+ else
+ Tag := 0;
+ FForm := TfrxDialogForm.Create(Self);
+ Tag := FSaveTag;
+{$IFDEF LINUX}
+ Font.Name := 'Liberation Mono';
+{$ELSE}
+ Font.Name := 'Tahoma';
+{$ENDIF}
+ Font.Size := 8;
+ BorderStyle := TfmxFormBorderStyle.bsSizeable;
+ Position := TFormPosition.poScreenCenter;
+ WindowState := TWindowState.wsNormal;
+ Color := claWhiteSmoke;
+ FClientWidth := 0;
+ FClientHeight := 0;
+end;
+
+destructor TfrxDialogPage.Destroy;
+begin
+{$IFNDEF NO_CRITICAL_SECTION}
+ frxCS.Enter;
+{$ENDIF}
+ try
+ inherited;
+ FForm.Free;
+ finally
+{$IFNDEF NO_CRITICAL_SECTION}
+ frxCS.Leave;
+{$ENDIF}
+ end;
+end;
+
+class function TfrxDialogPage.GetDescription: String;
+begin
+ Result := frxResources.Get('obDlgPage');
+end;
+
+procedure TfrxDialogPage.SetLeft(Value: Double);
+begin
+ inherited;
+ FForm.Left := Round(Value);
+end;
+
+procedure TfrxDialogPage.SetTop(Value: Double);
+begin
+ inherited;
+ FForm.Top := Round(Value);
+end;
+
+procedure TfrxDialogPage.SetWidth(Value: Double);
+begin
+ inherited;
+ if IsLoading and (FClientWidth <> 0) then Exit;
+ FForm.Width := Round(Value);
+ FClientWidth := FForm.ClientWidth;
+end;
+
+procedure TfrxDialogPage.SetHeight(Value: Double);
+begin
+ inherited;
+ if IsLoading and (FClientHeight <> 0) then Exit;
+ FForm.Height := Round(Value);
+ FClientHeight := FForm.ClientHeight;
+end;
+
+procedure TfrxDialogPage.SetClientWidth(Value: Double);
+begin
+ if IsLoading and (Value > Width) then Exit;
+ FForm.ClientWidth := Round(Value);
+ FClientWidth := Value;
+ inherited SetWidth(FForm.Width);
+end;
+
+procedure TfrxDialogPage.SetClientHeight(Value: Double);
+begin
+ if IsLoading and (Value > Height) then Exit;
+ FForm.ClientHeight := Round(Value);
+ FClientHeight := Value;
+ inherited SetHeight(FForm.Height);
+end;
+
+function TfrxDialogPage.GetClientWidth: Double;
+begin
+ Result := FForm.ClientWidth;
+end;
+
+function TfrxDialogPage.GetClientHeight: Double;
+begin
+ Result := FForm.ClientHeight;
+end;
+
+procedure TfrxDialogPage.SetBorderStyle(const Value: TfmxFormBorderStyle);
+begin
+ FBorderStyle := Value;
+end;
+
+procedure TfrxDialogPage.SetCaption(const Value: String);
+begin
+ FCaption := Value;
+ FForm.Caption := Value;
+end;
+
+procedure TfrxDialogPage.SetColor(const Value: TAlphaColor);
+begin
+ FColor := Value;
+ FForm.Fill.Color := Value;
+end;
+
+function TfrxDialogPage.GetModalResult: TModalResult;
+begin
+ Result := FForm.ModalResult;
+end;
+
+procedure TfrxDialogPage.SetModalResult(const Value: TModalResult);
+begin
+ FForm.ModalResult := Value;
+end;
+
+procedure TfrxDialogPage.SetPosition(const Value: TFormPosition);
+begin
+ FPosition := Value;
+ FForm.Position := FPosition;
+end;
+
+procedure TfrxDialogPage.FontChanged(Sender: TObject);
+begin
+ inherited;
+ //FForm.Font := Font;
+end;
+
+procedure TfrxDialogPage.DoInitialize;
+begin
+ // we need it to reset FBoundChanges
+ FForm.AfterConstruction;
+ if FForm.Visible then
+ FForm.Hide;
+ FForm.Position := FPosition;
+ FForm.WindowState := FWindowState;
+ FForm.OnActivate := DoOnActivate;
+ FForm.OnCloseQuery := DoOnCloseQuery;
+ FForm.OnDeactivate := DoOnDeactivate;
+ FForm.OnResize := DoOnResize;
+{$IFDEF DELPHI18}
+ FForm.OnShow := DoOnShow;
+{$ENDIF}
+end;
+
+procedure TfrxDialogPage.Initialize;
+begin
+ DoInitialize;
+end;
+
+function TfrxDialogPage.ShowModal: TModalResult;
+begin
+ Initialize;
+ FForm.BorderStyle := FBorderStyle;
+{$IFNDEF DELPHI19}
+ FForm.TopMost := False;
+ {$ENDIF}
+ try
+ TfrxDialogForm(FForm).OnModify := DoModify;
+{$IFDEF LINUX}
+ Result := TfrxDialogForm(FForm).ShowModal;
+{$ELSE}
+ Result := FForm.ShowModal;
+{$ENDIF}
+
+ finally
+{$IFNDEF DELPHI19}
+ FForm.TopMost := True;
+{$ENDIF}
+ end;
+end;
+
+type
+ THackCommonCustomForm = class(TCommonCustomForm);
+procedure TfrxDialogPage.UpdateClientRect;
+var
+ lForm: TfrxDialogForm;
+begin
+ lForm := TfrxDialogForm.Create(nil);
+ try
+ lForm.Top := 0;
+ lForm.Left := 0;
+ lForm.Width := FForm.Width;
+ lForm.Height := FForm.Height;
+ lForm.Show;
+ FClientHeight := lForm.ClientHeight;
+ FClientWidth := lForm.ClientWidth;
+ FForm.ClientHeight := Round(FClientHeight);
+ FForm.ClientWidth := Round(FClientWidth);
+ FForm.Hide;
+ finally
+ lForm.Close;
+ lForm.Free;
+ end;
+end;
+
+procedure TfrxDialogPage.DoModify(Sender: TObject);
+begin
+ FLeft := FForm.Left;
+ FTop := FForm.Top;
+ FWidth := FForm.Width;
+ FHeight := FForm.Height;
+end;
+
+procedure TfrxDialogPage.DoOnActivate(Sender: TObject);
+var
+ i: Integer;
+begin
+ DoModify(nil);
+ if Report <> nil then
+ Report.DoNotifyEvent(Sender, FOnActivate, True);
+ for i := 0 to AllObjects.Count - 1 do
+ begin
+ if (TObject(AllObjects[i]) is TfrxDialogControl) and
+ Assigned(TfrxDialogControl(AllObjects[i]).OnActivate) then
+ TfrxDialogControl(AllObjects[i]).OnActivate(Self);
+ end;
+end;
+
+procedure TfrxDialogPage.DoOnCloseQuery(Sender: TObject; var CanClose: Boolean);
+var
+ v: Variant;
+begin
+ v := VarArrayOf([frxInteger(Sender), CanClose]);
+ Report.DoParamEvent(FOnCloseQuery, v, True);
+ CanClose := v[1];
+end;
+
+procedure TfrxDialogPage.DoOnDeactivate(Sender: TObject);
+begin
+ Report.DoNotifyEvent(Sender, FOnDeactivate, True);
+end;
+
+procedure TfrxDialogPage.DoOnResize(Sender: TObject);
+begin
+ Report.DoNotifyEvent(Sender, FOnResize, True);
+end;
+
+{$IFDEF DELPHI18}
+procedure TfrxDialogPage.DoOnShow(Sender: TObject);
+begin
+ Report.DoNotifyEvent(Sender, FOnShow, True);
+end;
+{$ENDIF}
+
+{ TfrxReportPage }
+
+constructor TfrxReportPage.Create(AOwner: TComponent);
+begin
+ inherited;
+ FBackPicture := TfrxPictureView.Create(nil);
+ FBackPicture.Color := claNull;
+ FBackPicture.KeepAspectRatio := False;
+ FColumnPositions := TStringList.Create;
+ FOrientation := poPortrait;
+ PaperSize := DMPAPER_A4;
+ FBin := DMBIN_AUTO;
+ FBinOtherPages := DMBIN_AUTO;
+ FBaseName := 'Page';
+ FSubBands := TList.Create;
+ FVSubBands := TList.Create;
+ FHGuides := TStringList.Create;
+ FVGuides := TStringList.Create;
+ FPrintIfEmpty := True;
+ FTitleBeforeHeader := True;
+ FBackPictureVisible := True;
+ FBackPicturePrintable := True;
+ FPageCount := 1;
+end;
+
+destructor TfrxReportPage.Destroy;
+begin
+ FColumnPositions.Free;
+ FBackPicture.Free;
+ FSubBands.Free;
+ FVSubBands.Free;
+ FHGuides.Free;
+ FVGuides.Free;
+ if FSubReport <> nil then
+ FSubReport.FPage := nil;
+ inherited;
+end;
+
+class function TfrxReportPage.GetDescription: String;
+begin
+ Result := frxResources.Get('obRepPage');
+end;
+
+procedure TfrxReportPage.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FDataSet) then
+ FDataSet := nil;
+end;
+
+procedure TfrxReportPage.SetDataSet(const Value: TfrxDataSet);
+begin
+ FDataSet := Value;
+ if FDataSet = nil then
+ FDataSetName := '' else
+ FDataSetName := FDataSet.UserName;
+end;
+
+procedure TfrxReportPage.SetDataSetName(const Value: String);
+begin
+ FDataSetName := Value;
+ FDataSet := FindDataSet(FDataSet, FDataSetName);
+end;
+
+function TfrxReportPage.GetDataSetName: String;
+begin
+ if FDataSet = nil then
+ Result := FDataSetName else
+ Result := FDataSet.UserName;
+end;
+
+procedure TfrxReportPage.SetPaperHeight(const Value: Double);
+begin
+ FPaperHeight := Round8(Value);
+ FPaperSize := 256;
+ UpdateDimensions;
+end;
+
+procedure TfrxReportPage.SetPaperWidth(const Value: Double);
+begin
+ FPaperWidth := Round8(Value);
+ FPaperSize := 256;
+ UpdateDimensions;
+end;
+
+procedure TfrxReportPage.SetPaperSize(const Value: Integer);
+var
+ e: Extended;
+begin
+ FPaperSize := Value;
+ if FPaperSize < DMPAPER_USER then
+ begin
+ if frxGetPaperDimensions(FPaperSize, FPaperWidth, FPaperHeight) then
+ if FOrientation = poLandscape then
+ begin
+ e := FPaperWidth;
+ FPaperWidth := FPaperHeight;
+ FPaperHeight := e;
+ end;
+ UpdateDimensions;
+ end;
+end;
+
+procedure TfrxReportPage.SetSizeAndDimensions(ASize: Integer; AWidth,
+ AHeight: Double);
+begin
+ FPaperSize := ASize;
+ FPaperWidth := Round8(AWidth);
+ FPaperHeight := Round8(AHeight);
+ UpdateDimensions;
+end;
+
+procedure TfrxReportPage.SetColumns(const Value: Integer);
+begin
+ FColumns := Value;
+ FColumnPositions.Clear;
+ if FColumns <= 0 then exit;
+
+ FColumnWidth := (FPaperWidth - FLeftMargin - FRightMargin) / FColumns;
+ while FColumnPositions.Count < FColumns do
+ FColumnPositions.Add(FloatToStr(FColumnPositions.Count * FColumnWidth));
+end;
+
+procedure TfrxReportPage.SetPageCount(const Value: Integer);
+begin
+ if Value > 0 then
+ FPageCount := Value;
+end;
+
+procedure TfrxReportPage.SetOrientation(Value: TPrinterOrientation);
+var
+ e, m1, m2, m3, m4: Extended;
+begin
+ if FOrientation <> Value then
+ begin
+ e := FPaperWidth;
+ FPaperWidth := FPaperHeight;
+ FPaperHeight := e;
+
+ m1 := FLeftMargin;
+ m2 := FRightMargin;
+ m3 := FTopMargin;
+ m4 := FBottomMargin;
+
+ if Value = poLandscape then
+ begin
+ FLeftMargin := m3;
+ FRightMargin := m4;
+ FTopMargin := m2;
+ FBottomMargin := m1;
+ end
+ else
+ begin
+ FLeftMargin := m4;
+ FRightMargin := m3;
+ FTopMargin := m1;
+ FBottomMargin := m2;
+ end;
+ UpdateDimensions;
+ end;
+
+ FOrientation := Value;
+end;
+
+procedure TfrxReportPage.UpdateDimensions;
+begin
+ Width := Round(FPaperWidth * fr01cm);
+ Height := Round(FPaperHeight * fr01cm);
+end;
+
+procedure TfrxReportPage.ClearGuides;
+begin
+ FHGuides.Clear;
+ FVGuides.Clear;
+end;
+
+procedure TfrxReportPage.SetHGuides(const Value: TStrings);
+begin
+ FHGuides.Assign(Value);
+end;
+
+procedure TfrxReportPage.SetVGuides(const Value: TStrings);
+begin
+ FVGuides.Assign(Value);
+end;
+
+function TfrxReportPage.FindBand(Band: TfrxBandClass): TfrxBand;
+var
+ i: Integer;
+begin
+ Result := nil;
+ for i := 0 to FObjects.Count - 1 do
+ if TObject(FObjects[i]) is Band then
+ begin
+ Result := FObjects[i];
+ break;
+ end;
+end;
+
+function TfrxReportPage.IsSubReport: Boolean;
+begin
+ Result := SubReport <> nil;
+end;
+
+procedure TfrxReportPage.SetColumnPositions(const Value: TStrings);
+begin
+ FColumnPositions.Assign(Value);
+end;
+
+function TfrxReportPage.GetFrame: TfrxFrame;
+begin
+ Result := FBackPicture.Frame;
+end;
+
+procedure TfrxReportPage.SetFrame(const Value: TfrxFrame);
+begin
+ FBackPicture.Frame := Value;
+end;
+
+function TfrxReportPage.GetColor: TAlphaColor;
+begin
+ Result := FBackPicture.Color;
+end;
+
+procedure TfrxReportPage.SetColor(const Value: TAlphaColor);
+begin
+ FBackPicture.Color := Value;
+end;
+
+function TfrxReportPage.GetBackPicture: TBitmap;
+begin
+ Result := FBackPicture.Picture;
+end;
+
+procedure TfrxReportPage.SetBackPicture(const Value: TBitmap);
+begin
+ FBackPicture.Picture := Value;
+end;
+
+procedure TfrxReportPage.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+begin
+ FBackPicture.Width := (FPaperWidth - FLeftMargin - FRightMargin) * fr01cm;
+ FBackPicture.Height := (FPaperHeight - FTopMargin - FBottomMargin) * fr01cm;
+ if FBackPictureVisible and (not IsPrinting or FBackPicturePrintable) then
+ FBackPicture.Draw(Canvas, ScaleX, ScaleY,
+ OffsetX + FLeftMargin * fr01cm * ScaleX,
+ OffsetY + FTopMargin * fr01cm * ScaleY);
+end;
+
+procedure TfrxReportPage.SetDefaults;
+begin
+ FLeftMargin := 10;
+ FRightMargin := 10;
+ FTopMargin := 10;
+ FBottomMargin := 10;
+ FPaperSize := frxPrinters.Printer.DefPaper;
+ FPaperWidth := frxPrinters.Printer.DefPaperWidth;
+ FPaperHeight := frxPrinters.Printer.DefPaperHeight;
+ FOrientation := frxPrinters.Printer.DefOrientation;
+
+ UpdateDimensions;
+end;
+
+procedure TfrxReportPage.AlignChildren;
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ Width := (FPaperWidth - FLeftMargin - FRightMargin) * fr01cm;
+ Height := (FPaperHeight - FTopMargin - FBottomMargin) * fr01cm;
+ inherited;
+ for i := 0 to Objects.Count - 1 do
+ begin
+ c := Objects[i];
+ if c is TfrxBand then
+ begin
+ if TfrxBand(c).Vertical then
+ c.Height := (FPaperHeight - FTopMargin - FBottomMargin) * fr01cm - c.Top
+ else
+ if (Columns > 1) and not((c is TfrxNullBand) or (c is TfrxReportSummary) or
+ (c is TfrxPageHeader) or (c is TfrxPageFooter) or
+ (c is TfrxReportTitle) or (c is TfrxOverlay)) then
+ c.Width := ColumnWidth * fr01cm
+ else
+ c.Width := Width - c.Left;
+ c.AlignChildren;
+ end;
+ end;
+ UpdateDimensions;
+end;
+
+
+{ TfrxDataPage }
+
+constructor TfrxDataPage.Create(AOwner: TComponent);
+begin
+ inherited;
+ Width := 1000;
+ Height := 1000;
+end;
+
+class function TfrxDataPage.GetDescription: String;
+begin
+ Result := frxResources.Get('obDataPage');
+end;
+
+
+{ TfrxEngineOptions }
+
+constructor TfrxEngineOptions.Create;
+begin
+ Clear;
+ FMaxMemSize := 10;
+ FPrintIfEmpty := True;
+ FSilentMode := simMessageBoxes;
+ FEnableThreadSafe := False;
+ FTempDir := '';
+ FUseGlobalDataSetList := True;
+ FUseFileCache := False;
+ FDestroyForms := True;
+end;
+
+procedure TfrxEngineOptions.Assign(Source: TPersistent);
+begin
+ if Source is TfrxEngineOptions then
+ begin
+ FConvertNulls := TfrxEngineOptions(Source).ConvertNulls;
+ FDoublePass := TfrxEngineOptions(Source).DoublePass;
+ FMaxMemSize := TfrxEngineOptions(Source).MaxMemSize;
+ FPrintIfEmpty := TfrxEngineOptions(Source).PrintIfEmpty;
+ NewSilentMode := TfrxEngineOptions(Source).NewSilentMode;
+ FTempDir := TfrxEngineOptions(Source).TempDir;
+ FUseFileCache := TfrxEngineOptions(Source).UseFileCache;
+ FIgnoreDevByZero := TfrxEngineOptions(Source).IgnoreDevByZero;
+ end;
+end;
+
+procedure TfrxEngineOptions.Clear;
+begin
+ FConvertNulls := True;
+ FIgnoreDevByZero := False;
+ FDoublePass := False;
+end;
+
+procedure TfrxEngineOptions.SetSilentMode(Mode: Boolean);
+begin
+ if Mode = True then
+ FSilentMode := simSilent
+ else
+ FSilentMode := simMessageBoxes;
+end;
+
+function TfrxEngineOptions.GetSilentMode: Boolean;
+begin
+ if FSilentMode = simSilent then
+ Result := True
+ else
+ Result := False;
+end;
+
+
+{ TfrxPreviewOptions }
+
+constructor TfrxPreviewOptions.Create;
+begin
+ Clear;
+ FAllowEdit := True;
+ FButtons := [pbPrint, pbLoad, pbSave, pbExport, pbZoom, pbFullScreen,
+ pbOutline, pbThumbnails, pbPageSetup, pbEdit, pbNavigator, pbClose];
+ FDoubleBuffered := True;
+ FMaximized := True;
+ FMDIChild := False;
+ FModal := True;
+ FPagesInCache := 50;
+ FShowCaptions := False;
+ FZoom := 1;
+ FZoomMode := zmDefault;
+ FPictureCacheInFile := False;
+ FMaxPagePictureWidth := 1600;
+ FMaxPagePictureHeight := 1200;
+{$IFDEF DELPHI19}
+ FPagesInPictureCache := False;
+{$ELSE}
+ FPagesInPictureCache := True;
+{$ENDIF}
+end;
+
+procedure TfrxPreviewOptions.Assign(Source: TPersistent);
+begin
+ if Source is TfrxPreviewOptions then
+ begin
+ FAllowEdit := TfrxPreviewOptions(Source).AllowEdit;
+ FButtons := TfrxPreviewOptions(Source).Buttons;
+ FDoubleBuffered := TfrxPreviewOptions(Source).DoubleBuffered;
+ FMaximized := TfrxPreviewOptions(Source).Maximized;
+ FMDIChild := TfrxPreviewOptions(Source).MDIChild;
+ FModal := TfrxPreviewOptions(Source).Modal;
+ FOutlineExpand := TfrxPreviewOptions(Source).OutlineExpand;
+ FOutlineVisible := TfrxPreviewOptions(Source).OutlineVisible;
+ FOutlineWidth := TfrxPreviewOptions(Source).OutlineWidth;
+ FPagesInCache := TfrxPreviewOptions(Source).PagesInCache;
+ FShowCaptions := TfrxPreviewOptions(Source).ShowCaptions;
+ FThumbnailVisible := TfrxPreviewOptions(Source).ThumbnailVisible;
+ FZoom := TfrxPreviewOptions(Source).Zoom;
+ FZoomMode := TfrxPreviewOptions(Source).ZoomMode;
+ FPictureCacheInFile := TfrxPreviewOptions(Source).PictureCacheInFile;
+ FRTLPreview := TfrxPreviewOptions(Source).RTLPreview;
+ end;
+end;
+
+procedure TfrxPreviewOptions.Clear;
+begin
+ FOutlineExpand := True;
+ FOutlineVisible := False;
+ FOutlineWidth := 120;
+ FPagesInCache := 50;
+ FThumbnailVisible := False;
+end;
+
+
+{ TfrxPrintOptions }
+
+constructor TfrxPrintOptions.Create;
+begin
+ Clear;
+end;
+
+procedure TfrxPrintOptions.Assign(Source: TPersistent);
+begin
+ if Source is TfrxPrintOptions then
+ begin
+ FCopies := TfrxPrintOptions(Source).Copies;
+ FCollate := TfrxPrintOptions(Source).Collate;
+ FPageNumbers := TfrxPrintOptions(Source).PageNumbers;
+ FPrinter := TfrxPrintOptions(Source).Printer;
+ FPrintMode := TfrxPrintOptions(Source).PrintMode;
+ FPrintOnSheet := TfrxPrintOptions(Source).PrintOnSheet;
+ FPrintPages := TfrxPrintOptions(Source).PrintPages;
+ FReverse := TfrxPrintOptions(Source).Reverse;
+ FShowDialog := TfrxPrintOptions(Source).ShowDialog;
+ FSplicingLine := TfrxPrintOptions(Source).SplicingLine;
+ end;
+end;
+
+procedure TfrxPrintOptions.Clear;
+begin
+ FCopies := 1;
+ FCollate := True;
+ FPageNumbers := '';
+ FPagesOnSheet := 0;
+ FPrinter := frxResources.Get('prDefault');
+ FPrintMode := pmDefault;
+ FPrintOnSheet := 0;
+ FPrintPages := ppAll;
+ FReverse := False;
+ FShowDialog := True;
+ FSplicingLine := 3;
+ FDuplex := dmNone;
+end;
+
+
+{ TfrxReportOptions }
+
+constructor TfrxReportOptions.Create;
+begin
+ FDescription := TStringList.Create;
+ FPicture := TBitmap.Create(0, 0);
+ FCreateDate := Now;
+ FLastChange := Now;
+ FPrevPassword := '';
+ FInfo := False;
+ FIsFMXReport := True;
+end;
+
+destructor TfrxReportOptions.Destroy;
+begin
+ FDescription.Free;
+ FPicture.Free;
+ inherited;
+end;
+
+procedure TfrxReportOptions.Assign(Source: TPersistent);
+begin
+ if Source is TfrxReportOptions then
+ begin
+ FAuthor := TfrxReportOptions(Source).Author;
+ FCompressed := TfrxReportOptions(Source).Compressed;
+ FCreateDate := TfrxReportOptions(Source).CreateDate;
+ Description := TfrxReportOptions(Source).Description;
+ FInitString := TfrxReportOptions(Source).InitString;
+ FLastChange := TfrxReportOptions(Source).LastChange;
+ FName := TfrxReportOptions(Source).Name;
+ FPassword := TfrxReportOptions(Source).Password;
+ Picture := TfrxReportOptions(Source).Picture;
+ FVersionBuild := TfrxReportOptions(Source).VersionBuild;
+ FVersionMajor := TfrxReportOptions(Source).VersionMajor;
+ FVersionMinor := TfrxReportOptions(Source).VersionMinor;
+ FVersionRelease := TfrxReportOptions(Source).VersionRelease;
+ end;
+end;
+
+procedure TfrxReportOptions.Clear;
+begin
+ if not FInfo then
+ begin
+ FPicture.Free;
+ FAuthor := '';
+ FCompressed := False;
+ FCreateDate := Now;
+ FDescription.Clear;
+ FLastChange := Now;
+ FPicture := TBitmap.Create(0, 0);
+ FVersionBuild := '';
+ FVersionMajor := '';
+ FVersionMinor := '';
+ FVersionRelease := '';
+ end;
+ FConnectionName := '';
+ FInitString := '';
+ FName := '';
+ FPassword := '';
+ FPrevPassword := '';
+end;
+
+procedure TfrxReportOptions.SetDescription(const Value: TStrings);
+begin
+ FDescription.Assign(Value);
+end;
+
+procedure TfrxReportOptions.SetPicture(const Value: TBitmap);
+begin
+ FPicture.Assign(Value);
+end;
+
+function TfrxReportOptions.CheckPassword: Boolean;
+begin
+ Result := True;
+ if (FPassword <> '') and (FPassword <> FPrevPassword) and (FPassword <> HiddenPassword) then
+ with TfrxPasswordForm.Create(Application) do
+ begin
+ if (ShowModal <> mrOk) or (FPassword <> PasswordE.Text) then
+ begin
+ Result := False;
+ FReport.Errors.Add(frxResources.Get('Invalid password'));
+ frxCommonErrorHandler(FReport, frxResources.Get('clErrors') + #13#10 + FReport.Errors.Text);
+ end
+ else
+ FPrevPassword := FPassword;
+ Free;
+ end;
+end;
+
+
+{ TfrxDataSetItem }
+
+procedure TfrxDataSetItem.SetDataSet(const Value: TfrxDataSet);
+begin
+ FDataSet := Value;
+ if FDataSet = nil then
+ FDataSetName := '' else
+ FDataSetName := FDataSet.UserName;
+end;
+
+procedure TfrxDataSetItem.SetDataSetName(const Value: String);
+begin
+ FDataSetName := Value;
+ if FDataSetName = '' then
+ FDataSet := nil
+ else if TfrxReportDataSets(Collection).FReport <> nil then
+ FDataSet := TfrxReportDataSets(Collection).FReport.FindDataSet(FDataSet, FDataSetName);
+end;
+
+function TfrxDataSetItem.GetDataSetName: String;
+begin
+ if FDataSet = nil then
+ Result := FDataSetName else
+ Result := FDataSet.UserName;
+end;
+
+
+{ TfrxReportDatasets }
+
+constructor TfrxReportDatasets.Create(AReport: TfrxReport);
+begin
+ inherited Create(TfrxDatasetItem);
+ FReport := AReport;
+end;
+
+procedure TfrxReportDataSets.Initialize;
+var
+ i: Integer;
+begin
+ for i := 0 to Count - 1 do
+ if Items[i].DataSet <> nil then
+ begin
+ Items[i].DataSet.ReportRef := FReport;
+ Items[i].DataSet.Initialize;
+ end;
+end;
+
+procedure TfrxReportDataSets.Finalize;
+var
+ i: Integer;
+begin
+ for i := 0 to Count - 1 do
+ if Items[i].DataSet <> nil then
+ Items[i].DataSet.Finalize;
+end;
+
+procedure TfrxReportDatasets.Add(ds: TfrxDataSet);
+begin
+ TfrxDatasetItem(inherited Add).DataSet := ds;
+end;
+
+function TfrxReportDatasets.GetItem(Index: Integer): TfrxDatasetItem;
+begin
+ Result := TfrxDatasetItem(inherited Items[Index]);
+end;
+
+function TfrxReportDatasets.Find(ds: TfrxDataSet): TfrxDatasetItem;
+var
+ i: Integer;
+begin
+ Result := nil;
+ for i := 0 to Count - 1 do
+ if Items[i].DataSet = ds then
+ begin
+ Result := Items[i];
+ Exit;
+ end;
+end;
+
+function TfrxReportDatasets.Find(const Name: String): TfrxDatasetItem;
+var
+ i: Integer;
+begin
+ Result := nil;
+ for i := 0 to Count - 1 do
+ if Items[i].DataSet <> nil then
+ if CompareText(Items[i].DataSet.UserName, Name) = 0 then
+ begin
+ Result := Items[i];
+ Exit;
+ end;
+end;
+
+procedure TfrxReportDatasets.Delete(const Name: String);
+var
+ i: Integer;
+begin
+ for i := 0 to Count - 1 do
+ if Items[i].DataSet <> nil then
+ if CompareText(Items[i].DataSet.UserName, Name) = 0 then
+ begin
+ Items[i].Free;
+ Exit;
+ end;
+end;
+
+{ TfrxStyleItem }
+
+constructor TfrxStyleItem.Create(Collection: TCollection);
+begin
+ inherited;
+ FColor := claNull;
+ FFont := TfrxFont.Create;
+ with FFont do
+ begin
+ Name := DefFontName;
+ Size := DefFontSize;
+ end;
+ FFrame := TfrxFrame.Create;
+end;
+
+destructor TfrxStyleItem.Destroy;
+begin
+ FFont.Free;
+ FFrame.Free;
+ inherited;
+end;
+
+procedure TfrxStyleItem.Assign(Source: TPersistent);
+begin
+ if Source is TfrxStyleItem then
+ begin
+ FName := TfrxStyleItem(Source).Name;
+ FColor := TfrxStyleItem(Source).Color;
+ FFont.Assign(TfrxStyleItem(Source).Font);
+ FFrame.Assign(TfrxStyleItem(Source).Frame);
+ end;
+end;
+
+procedure TfrxStyleItem.SetFont(const Value: TfrxFont);
+begin
+ FFont.Assign(Value);
+end;
+
+procedure TfrxStyleItem.SetFrame(const Value: TfrxFrame);
+begin
+ FFrame.Assign(Value);
+end;
+
+procedure TfrxStyleItem.SetName(const Value: String);
+var
+ Item: TfrxStyleItem;
+begin
+ Item := TfrxStyles(Collection).Find(Value);
+ if (Item = nil) or (Item = Self) then
+ FName := Value else
+ raise Exception.Create(frxResources.Get('clDupName'));
+end;
+
+procedure TfrxStyleItem.CreateUniqueName;
+var
+ i: Integer;
+begin
+ i := 1;
+ while TfrxStyles(Collection).Find('Style' + IntToStr(i)) <> nil do
+ Inc(i);
+ Name := 'Style' + IntToStr(i);
+end;
+
+
+{ TfrxStyles }
+
+constructor TfrxStyles.Create(AReport: TfrxReport);
+begin
+ inherited Create(TfrxStyleItem);
+ FReport := AReport;
+end;
+
+function TfrxStyles.Add: TfrxStyleItem;
+begin
+ Result := TfrxStyleItem(inherited Add);
+end;
+
+function TfrxStyles.Find(const Name: String): TfrxStyleItem;
+var
+ i: Integer;
+begin
+ Result := nil;
+ for i := 0 to Count - 1 do
+ if frxCompareText(Items[i].Name, Name) = 0 then
+ begin
+ Result := Items[i];
+ break;
+ end;
+end;
+
+function TfrxStyles.GetItem(Index: Integer): TfrxStyleItem;
+begin
+ Result := TfrxStyleItem(inherited Items[Index]);
+end;
+
+procedure TfrxStyles.GetList(List: TStrings);
+var
+ i: Integer;
+begin
+ List.Clear;
+ for i := 0 to Count - 1 do
+ List.Add(Items[i].Name);
+end;
+
+procedure TfrxStyles.LoadFromXMLItem(Item: TfrxXMLItem; OldXMLFormat: Boolean);
+var
+ xs: TfrxXMLSerializer;
+ i: Integer;
+begin
+ Clear;
+ xs := TfrxXMLSerializer.Create(nil);
+ try
+ xs.OldFormat := OldXMLFormat;
+ Name := Item.Prop['Name'];
+ for i := 0 to Item.Count - 1 do
+ if CompareText(Item[i].Name, 'item') = 0 then
+ xs.XMLToObj(Item[i].Text, Add);
+ finally
+ xs.Free;
+ end;
+
+ Apply;
+end;
+
+procedure TfrxStyles.SaveToXMLItem(Item: TfrxXMLItem);
+var
+ xi: TfrxXMLItem;
+ xs: TfrxXMLSerializer;
+ i: Integer;
+begin
+ xs := TfrxXMLSerializer.Create(nil);
+ try
+ Item.Name := 'style';
+ Item.Prop['Name'] := Name;
+ for i := 0 to Count - 1 do
+ begin
+ xi := Item.Add;
+ xi.Name := 'item';
+ xi.Text := xs.ObjToXML(Items[i]);
+ end;
+ finally
+ xs.Free;
+ end;
+end;
+
+procedure TfrxStyles.LoadFromFile(const FileName: String);
+var
+ f: TFileStream;
+begin
+ f := TFileStream.Create(FileName, fmOpenRead);
+ try
+ LoadFromStream(f);
+ finally
+ f.Free;
+ end;
+end;
+
+procedure TfrxStyles.LoadFromStream(Stream: TStream);
+var
+ x: TfrxXMLDocument;
+begin
+ Clear;
+ x := TfrxXMLDocument.Create;
+ try
+ x.LoadFromStream(Stream);
+ if CompareText(x.Root.Name, 'style') = 0 then
+ LoadFromXMLItem(x.Root, x.OldVersion);
+ finally
+ x.Free;
+ end;
+end;
+
+procedure TfrxStyles.SaveToFile(const FileName: String);
+var
+ f: TFileStream;
+begin
+ f := TFileStream.Create(FileName, fmCreate);
+ try
+ SaveToStream(f);
+ finally
+ f.Free;
+ end;
+end;
+
+procedure TfrxStyles.SaveToStream(Stream: TStream);
+var
+ x: TfrxXMLDocument;
+begin
+ x := TfrxXMLDocument.Create;
+ x.AutoIndent := True;
+ try
+ x.Root.Name := 'style';
+ SaveToXMLItem(x.Root);
+ x.SaveToStream(Stream);
+ finally
+ x.Free;
+ end;
+end;
+
+procedure TfrxStyles.Apply;
+var
+ i: Integer;
+ l: TList;
+begin
+ if FReport <> nil then
+ begin
+ l := FReport.AllObjects;
+ for i := 0 to l.Count - 1 do
+ if TObject(l[i]) is TfrxCustomMemoView then
+ if Find(TfrxCustomMemoView(l[i]).Style) = nil then
+ TfrxCustomMemoView(l[i]).Style := ''
+ else
+ TfrxCustomMemoView(l[i]).Style := TfrxCustomMemoView(l[i]).Style;
+ end;
+end;
+
+
+{ TfrxStyleSheet }
+
+constructor TfrxStyleSheet.Create;
+begin
+ FItems := TList.Create;
+end;
+
+destructor TfrxStyleSheet.Destroy;
+begin
+ Clear;
+ FItems.Free;
+ inherited;
+end;
+
+procedure TfrxStyleSheet.Clear;
+begin
+ while Count > 0 do
+ Delete(0);
+end;
+
+procedure TfrxStyleSheet.Delete(Index: Integer);
+begin
+ Items[Index].Free;
+ FItems.Delete(Index);
+end;
+
+function TfrxStyleSheet.Add: TfrxStyles;
+begin
+ Result := TfrxStyles.Create(nil);
+ FItems.Add(Result);
+end;
+
+function TfrxStyleSheet.Count: Integer;
+begin
+ Result := FItems.Count;
+end;
+
+function TfrxStyleSheet.GetItems(Index: Integer): TfrxStyles;
+begin
+ Result := FItems[Index];
+end;
+
+function TfrxStyleSheet.Find(const Name: String): TfrxStyles;
+var
+ i: Integer;
+begin
+ Result := nil;
+ for i := 0 to Count - 1 do
+ if frxCompareText(Items[i].Name, Name) = 0 then
+ begin
+ Result := Items[i];
+ break;
+ end;
+end;
+
+function TfrxStyleSheet.IndexOf(const Name: String): Integer;
+var
+ i: Integer;
+begin
+ Result := -1;
+ for i := 0 to Count - 1 do
+ if frxCompareText(Items[i].Name, Name) = 0 then
+ begin
+ Result := i;
+ break;
+ end;
+end;
+
+procedure TfrxStyleSheet.GetList(List: TStrings);
+var
+ i: Integer;
+begin
+ List.Clear;
+ for i := 0 to Count - 1 do
+ List.Add(Items[i].Name);
+end;
+
+procedure TfrxStyleSheet.LoadFromFile(const FileName: String);
+var
+ f: TFileStream;
+begin
+ f := TFileStream.Create(FileName, fmOpenRead);
+ try
+ LoadFromStream(f);
+ finally
+ f.Free;
+ end;
+end;
+
+procedure TfrxStyleSheet.LoadFromStream(Stream: TStream);
+var
+ x: TfrxXMLDocument;
+ i: Integer;
+begin
+ Clear;
+ x := TfrxXMLDocument.Create;
+ try
+ x.LoadFromStream(Stream);
+ if CompareText(x.Root.Name, 'stylesheet') = 0 then
+ for i := 0 to x.Root.Count - 1 do
+ if CompareText(x.Root[i].Name, 'style') = 0 then
+ Add.LoadFromXMLItem(x.Root[i], x.OldVersion);
+ finally
+ x.Free;
+ end;
+end;
+
+procedure TfrxStyleSheet.SaveToFile(const FileName: String);
+var
+ f: TFileStream;
+begin
+ f := TFileStream.Create(FileName, fmCreate);
+ try
+ SaveToStream(f);
+ finally
+ f.Free;
+ end;
+end;
+
+procedure TfrxStyleSheet.SaveToStream(Stream: TStream);
+var
+ x: TfrxXMLDocument;
+ i: Integer;
+begin
+ x := TfrxXMLDocument.Create;
+ x.AutoIndent := True;
+ try
+ x.Root.Name := 'stylesheet';
+ for i := 0 to Count - 1 do
+ Items[i].SaveToXMLItem(x.Root.Add);
+
+ x.SaveToStream(Stream);
+ finally
+ x.Free;
+ end;
+end;
+
+
+{ TfrxReport }
+
+constructor TfrxReport.Create(AOwner: TComponent);
+begin
+ inherited;
+{$IFNDEF MSWINDOWS}
+{$IFDEF DELPHI17}
+ FRAppService := nil;
+{$ENDIF}
+{$ENDIF}
+ FVersion := FR_VERSION;
+ FDatasets := TfrxReportDatasets.Create(Self);
+ FVariables := TfrxVariables.Create;
+ FScript := TfsScript.Create(nil);
+ FScript.ExtendedCharset := True;
+ FScript.AddRTTI;
+
+ FTimer := TTimer.Create(nil);
+ FTimer.Interval := 50;
+ FTimer.Enabled := False;
+ FTimer.OnTimer := OnTimer;
+
+ FEngineOptions := TfrxEngineOptions.Create;
+ FPreviewOptions := TfrxPreviewOptions.Create;
+ FPrintOptions := TfrxPrintOptions.Create;
+ FReportOptions := TfrxReportOptions.Create(Self);
+ FReportOptions.FReport := Self;
+
+ FIniFile := '';
+ FScriptText := TStringList.Create;
+ FFakeScriptText := TStringList.Create;
+ FExpressionCache := TfrxExpressionCache.Create(FScript);
+ FErrors := TStringList.Create;
+ TStringList(FErrors).Sorted := True;
+ TStringList(FErrors).Duplicates := dupIgnore;
+ FStyles := TfrxStyles.Create(Self);
+ FSysVariables := TStringList.Create;
+ FEnabledDataSets := TfrxReportDataSets.Create(Self);
+ FShowProgress := True;
+ FStoreInDFM := True;
+ FOldStyleProgress := True;
+
+ FEngine := TfrxEngine.Create(Self);
+ FPreviewPages := TfrxPreviewPages.Create(Self);
+ FEngine.FPreviewPages := FPreviewPages;
+ FPreviewPages.FEngine := FEngine;
+ FDrillState := TStringList.Create;
+ FDrawBitmap := TBitmap.Create(1, 1);
+ Clear;
+end;
+
+destructor TfrxReport.Destroy;
+begin
+ inherited;
+ if FPreviewForm <> nil then
+ FPreviewForm.Close;
+ Preview := nil;
+ if FParentReportObject <> nil then
+ FParentReportObject.Free;
+ FDatasets.Free;
+ FEngineOptions.Free;
+ FPreviewOptions.Free;
+ FPrintOptions.Free;
+ FReportOptions.Free;
+ FExpressionCache.Free;
+ FScript.Free;
+ FScriptText.Free;
+ FFakeScriptText.Free;
+ FVariables.Free;
+ FEngine.Free;
+ FPreviewPages.Free;
+ FErrors.Free;
+ FStyles.Free;
+ FSysVariables.Free;
+ FEnabledDataSets.Free;
+ FTimer.Free;
+ TObject(FDrawText).Free;
+ FDrillState.Free;
+ FreeAndNil(FDrawBitmap);
+ if FParentForm <> nil then
+ FParentForm.Free;
+end;
+
+class function TfrxReport.GetDescription: String;
+begin
+ Result := frxResources.Get('obReport');
+end;
+
+function TfrxReport.GetDrawBitmap: TBitmap;
+begin
+ Result := FDrawBitmap;
+end;
+
+procedure TfrxReport.DoClear;
+begin
+ inherited Clear;
+ FDataSets.Clear;
+ FVariables.Clear;
+ FEngineOptions.Clear;
+ FPreviewOptions.Clear;
+ FPrintOptions.Clear;
+ FReportOptions.Clear;
+ FStyles.Clear;
+ FDataSet := nil;
+ FDataSetName := '';
+ FDotMatrixReport := False;
+ ParentReport := '';
+
+ FScriptLanguage := 'PascalScript';
+ with FScriptText do
+ begin
+ Clear;
+ Add('begin');
+ Add('');
+ Add('end.');
+ end;
+
+ with FSysVariables do
+ begin
+ Clear;
+ Add('Date');
+ Add('Time');
+ Add('Page');
+ Add('Page#');
+ Add('TotalPages');
+ Add('TotalPages#');
+ Add('Line');
+ Add('Line#');
+ Add('CopyName#');
+ end;
+
+ FOnRunDialogs := '';
+ FOnStartReport := '';
+ FOnStopReport := '';
+end;
+
+procedure TfrxReport.Clear;
+begin
+ DoClear;
+end;
+
+procedure TfrxReport.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if Operation = opRemove then
+ if AComponent is TfrxDataSet then
+ begin
+ if FDataSets.Find(TfrxDataSet(AComponent)) <> nil then
+ FDataSets.Find(TfrxDataSet(AComponent)).Free;
+ if FDataset = AComponent then
+ FDataset := nil;
+ if Designer <> nil then
+ Designer.UpdateDataTree;
+ end
+ else if AComponent is TfrxCustomPreview then
+ if FPreview = AComponent then
+ FPreview := nil;
+end;
+
+procedure TfrxReport.AncestorNotFound(Reader: TReader; const ComponentName: string;
+ ComponentClass: TPersistentClass; var Component: TComponent);
+begin
+ Component := FindObject(ComponentName);
+end;
+
+procedure TfrxReport.AppHandleMessage;
+{$IFDEF DELPHI17}
+{$IFNDEF MSWINDOWS}
+{$IFDEF MACOS}
+var
+ AutoReleasePool: NSAutoreleasePool;
+ NSApp: NSApplication;
+ TimeoutDate: NSDate;
+ LEvent: NSEvent;
+{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+begin
+ if not EngineOptions.EnableThreadSafe then
+ begin
+{$IFDEF DELPHI17}
+{$IFDEF MSWINDOWS}
+ Application.ProcessMessages;
+{$ELSE}
+{$IFDEF MACOS}
+
+{$IFDEF DELPHI27}
+ if GlobalUseMetal then Exit; // TODO: not implemented
+{$ENDIF}
+ // starts from XE5 ProcessMessages under mac has interval delay with 0.1 seconds
+ // and ProcessMessages cycle can't be used for synchronization anymore - cause very long delays
+ // reported to Embarcadero, but bug still present
+ AutoReleasePool := TNSAutoreleasePool.Alloc;
+ try
+ AutoReleasePool.init;
+ NSApp := TNSApplication.Wrap(TNSApplication.OCClass.sharedApplication);
+ TimeoutDate := TNSDate.Wrap(TNSDate.OCClass.dateWithTimeIntervalSinceNow(0));
+ LEvent := NSApp.nextEventMatchingMask(NSAnyEventMask, TimeoutDate, NSDefaultRunLoopMode, True);
+ if LEvent <> nil then
+ NSApp.sendEvent(LEvent);
+ finally
+ AutoReleasePool.release;
+ end;
+{$ENDIF}
+{$ENDIF}
+{$ELSE}
+ Application.ProcessMessages;
+{$ENDIF}
+ end;
+end;
+
+procedure TfrxReport.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ if (csWriting in ComponentState) and not FStoreInDFM then Exit;
+
+ Filer.DefineProperty('Datasets', ReadDatasets, WriteDatasets, True);
+ Filer.DefineProperty('Variables', ReadVariables, WriteVariables, True);
+ Filer.DefineProperty('Style', ReadStyle, WriteStyle, True);
+ if Filer is TReader then
+ TReader(Filer).OnAncestorNotFound := AncestorNotFound;
+end;
+
+procedure TfrxReport.ReadDatasets(Reader: TReader);
+begin
+ frxReadCollection(FDatasets, Reader, Self);
+end;
+
+procedure TfrxReport.ReadStyle(Reader: TReader);
+begin
+ frxReadCollection(FStyles, Reader, Self);
+end;
+
+procedure TfrxReport.ReadVariables(Reader: TReader);
+begin
+ frxReadCollection(FVariables, Reader, Self);
+end;
+
+procedure TfrxReport.WriteDatasets(Writer: TWriter);
+begin
+ frxWriteCollection(FDatasets, Writer, Self);
+end;
+
+procedure TfrxReport.WriteStyle(Writer: TWriter);
+begin
+ frxWriteCollection(FStyles, Writer, Self);
+end;
+
+procedure TfrxReport.WriteVariables(Writer: TWriter);
+begin
+ frxWriteCollection(FVariables, Writer, Self);
+end;
+
+function TfrxReport.GetPages(Index: Integer): TfrxPage;
+begin
+ Result := TfrxPage(Objects[Index]);
+end;
+
+function TfrxReport.GetPagesCount: Integer;
+begin
+ Result := Objects.Count;
+end;
+
+procedure TfrxReport.SetScriptText(const Value: TStrings);
+begin
+ FScriptText.Assign(Value);
+end;
+
+procedure TfrxReport.SetEngineOptions(const Value: TfrxEngineOptions);
+begin
+ FEngineOptions.Assign(Value);
+end;
+
+procedure TfrxReport.SetParentReport(const Value: String);
+var
+ i: Integer;
+ list: TList;
+ c: TfrxComponent;
+ fName, SaveFileName: String;
+ SaveXMLSerializer: TObject;
+begin
+ FParentReport := Value;
+ if FParentReportObject <> nil then
+ begin
+ FParentReportObject.Free;
+ FParentReportObject := nil;
+ end;
+ if Value = '' then
+ begin
+ list := AllObjects;
+ for i := 0 to list.Count - 1 do
+ begin
+ c := list[i];
+ c.FAncestor := False;
+ end;
+
+ FAncestor := False;
+ Exit;
+ end;
+
+ SaveFileName := FFileName;
+ SaveXMLSerializer := FXMLSerializer;
+ if Assigned(FOnLoadTemplate) then
+ FOnLoadTemplate(Self, Value)
+ else
+ begin
+ fName := Value;
+ { check relative path, exclude network path }
+ if (Length(fName) > 1) and (fName[2] <> ':')
+ and not ((fName[1] = '\') and (fName[2] = '\')) then
+ begin
+ fName := ExtractFilePath(SaveFileName) + Value;
+ if not FileExists(fName) then
+ fName := GetApplicationFolder + Value;
+ end;
+ LoadFromFile(fName);
+ end;
+
+ if FParentReportObject <> nil then
+ FParentReportObject.Free;
+ FParentReportObject := TfrxReport.Create(nil);
+ FParentReportObject.FileName := FFileName;
+ FParentReportObject.AssignAll(Self);
+ FFileName := SaveFileName;
+
+ for i := 0 to FParentReportObject.Objects.Count - 1 do
+ if TObject(FParentReportObject.Objects[i]) is TfrxReportPage then
+ TfrxReportPage(FParentReportObject.Objects[i]).PaperSize := 256;
+
+ { set ancestor flag for parent objects }
+ list := AllObjects;
+ for i := 0 to list.Count - 1 do
+ begin
+ c := list[i];
+ c.FAncestor := True;
+ end;
+
+ FAncestor := True;
+ FParentReport := Value;
+ FXMLSerializer := SaveXMLSerializer;
+end;
+
+function TfrxReport.InheritFromTemplate(const templName: String; InheriteMode: TfrxInheriteMode = imDefault): Boolean;
+var
+ tempReport: TfrxReport;
+ Ref: TObject;
+ i: Integer;
+ DS: TfrxDataSet;
+ lItem: TfrxFixupItem;
+ l, FixupList: TList;
+ c: TfrxComponent;
+ found, DeleteDuplicates: Boolean;
+ saveScript, OpenQuote, CloseQuote: String;
+ fn1, fn2: String;
+
+ procedure FixNames(OldName, NewName: String);
+ var
+ i: Integer;
+ begin
+ for i := 0 to FixupList.Count - 1 do
+ with TfrxFixupItem(FixupList[i]) do
+ begin
+ if Value = OldName then Value := NewName;
+ end;
+ end;
+
+ procedure EnumObjects(ToParent, FromParent: TfrxComponent);
+ var
+ xs: TfrxXMLSerializer;
+ s, OldName: String;
+ i: Integer;
+ cFrom, cTo, tObj: TfrxComponent;
+ cFromSubPage, cToSubPage: TfrxReportPage;
+ begin
+ xs := TfrxXMLSerializer.Create(nil);
+ { don't serialize ParentReport property! }
+ xs.SerializeDefaultValues := not (ToParent is TfrxReport);
+ if FromParent.Owner is TfrxComponent then
+ xs.Owner := TfrxComponent(FromParent.Owner);
+ s := xs.ObjToXML(FromParent);
+ if ToParent.Owner is TfrxComponent then
+ xs.Owner := TfrxComponent(ToParent.Owner);
+ xs.XMLToObj(s, ToParent);
+ xs.CopyFixupList(FixupList);
+ xs.Free;
+ i := 0;
+ while (i < FromParent.Objects.Count) do
+ begin
+ cFrom := FromParent.Objects[i];
+ cTo := Self.FindObject(cFrom.Name);
+ inc(i);
+
+ if (cTo <> nil) and not (cTo is TfrxPage) then
+ begin
+ { skip duplicate object }
+ if DeleteDuplicates then continue;
+ { set empty name for duplicate object, rename later }
+ OldName := cFrom.Name;
+ cFrom.Name := '';
+ cTo := nil;
+ end;
+
+ if cTo = nil then
+ begin
+ cTo := TfrxComponent(cFrom.NewInstance);
+ cTo.Create(ToParent);
+ if cFrom.Name = '' then
+ begin
+ cTo.CreateUniqueName;
+ tObj := tempReport.FindObject(cTo.Name);
+ if tObj <> nil then
+ begin
+ tObj.Name := '';
+ cFrom.Name := cTo.Name;
+ tObj.CreateUniqueName;
+ end
+ else cFrom.Name := cTo.Name;
+ FixNames(OldName, cTo.Name);
+ if cFrom is TfrxDataSet then
+ begin
+ TfrxDataSet(cFrom).UserName := cFrom.Name;
+ Self.DataSets.Add(TfrxDataSet(cTo));
+ end;
+ end
+ else
+ cTo.Name := cFrom.Name;
+
+ if cFrom is TfrxSubreport then
+ begin
+ cFromSubPage := TfrxSubreport(cFrom).Page;
+ TfrxSubreport(cTo).Page := TfrxReportPage.Create(Self);
+ cToSubPage := TfrxSubreport(cTo).Page;
+ cToSubPage.Assign(cFromSubPage);
+ cToSubPage.CreateUniqueName;
+ EnumObjects(cToSubPage, cFromSubPage);
+ tempReport.Objects.Remove(cFromSubPage);
+ end
+ end;
+ EnumObjects(cTo, cFrom);
+ end;
+ end;
+
+begin
+ Result := True;
+
+ if (Length(FileName) > 1) and ((FileName[1] = '.') or (FileName[1] = '\')) then
+ fn1 := ExpandFileName(FileName)
+ else
+ fn1 := FileName;
+
+ if (Length(templName) > 1) and ((templName[1] = '.') or (templName[1] = '\')) then
+ fn2 := ExpandFileName(templName)
+ else
+ fn2 := templName;
+
+ if fn1 = fn2 then
+ begin
+ Result := False;
+ Exit;
+ end;
+
+ tempReport := TfrxReport.Create(nil);
+ FixupList := TList.Create;
+ tempReport.AssignAll(Self);
+ { load the template }
+ ParentReport := ExtractRelativePath(ExtractFilePath(FileName), templName);
+ { find duplicate objects }
+ found := False;
+ l := tempReport.AllObjects;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if not (c is TfrxPage) and (FindObject(c.Name) <> nil) then
+ begin
+ found := True;
+ break;
+ end;
+ end;
+
+ deleteDuplicates := False;
+ if (found) and (InheriteMode = imDefault) then
+ begin
+ with TfrxInheritErrorForm.Create(nil) do
+ begin
+ Result := ShowModal = mrOk;
+ if Result then
+ deleteDuplicates := DeleteRB.IsChecked;
+ Free;
+ end;
+ end
+ else
+ deleteDuplicates := (InheriteMode = imDelete);
+
+ if Result then
+ begin
+ saveScript := ScriptText.Text;
+ EnumObjects(Self, tempReport);
+
+ if (Script.SyntaxType = 'C++Script') or (Script.SyntaxType = 'JScript') then
+ begin
+ OpenQuote := '/*';
+ CloseQuote := '*/';
+ end
+ else if (Script.SyntaxType = 'BasicScript') then
+ begin
+ OpenQuote := '/\';
+ CloseQuote := '/\';
+ end
+ else if (Script.SyntaxType = 'PascalScript') then
+ begin
+ OpenQuote := '{';
+ CloseQuote := '}';
+ end;
+
+ ScriptText.Add(OpenQuote);
+ ScriptText.Add('**********Script from parent report**********');
+ ScriptText.Text := ScriptText.Text + saveScript;
+ ScriptText.Add(CloseQuote);
+
+ { fixup datasets }
+ for i := 0 to Self.DataSets.Count - 1 do
+ begin
+ DS := Self.FindDataSet(nil, DataSets[i].DataSetName);
+ DataSets[i].DataSet := DS;
+ end;
+
+ { fixup properties}
+ while FixupList.Count > 0 do
+ begin
+ lItem := TfrxFixupItem(FixupList[0]);
+ Ref := Self.FindObject(lItem.Value);
+ if Ref = nil then
+ Ref := frxFindComponent(Self, lItem.Value);
+ if Ref <> nil then
+ SetOrdProp(lItem.Obj, lItem.PropInfo, frxInteger(Ref));
+ lItem.Free;
+ FixupList.Delete(0);
+ end;
+ end
+ else
+ AssignAll(tempReport);
+
+ FixupList.Free;
+ tempReport.Free;
+end;
+
+procedure TfrxReport.SetPreviewOptions(const Value: TfrxPreviewOptions);
+begin
+ FPreviewOptions.Assign(Value);
+end;
+
+procedure TfrxReport.SetPrintOptions(const Value: TfrxPrintOptions);
+begin
+ FPrintOptions.Assign(Value);
+end;
+
+procedure TfrxReport.SetReportOptions(const Value: TfrxReportOptions);
+begin
+ FReportOptions.Assign(Value);
+end;
+
+procedure TfrxReport.SetStyles(const Value: TfrxStyles);
+begin
+ if Value <> nil then
+ begin
+ FStyles.Assign(Value);
+ FStyles.Apply;
+ end
+ else
+ FStyles.Clear;
+end;
+
+procedure TfrxReport.SetDataSet(const Value: TfrxDataSet);
+begin
+ FDataSet := Value;
+ if FDataSet = nil then
+ FDataSetName := '' else
+ FDataSetName := FDataSet.UserName;
+end;
+
+procedure TfrxReport.SetDataSetName(const Value: String);
+begin
+ FDataSetName := Value;
+ FDataSet := FindDataSet(FDataSet, FDataSetName);
+end;
+
+function TfrxReport.GetDataSetName: String;
+begin
+ if FDataSet = nil then
+ Result := FDataSetName else
+ Result := FDataSet.UserName;
+end;
+
+function TfrxReport.Calc(const Expr: String; AScript: TfsScript = nil): Variant;
+var
+ ErrorMsg: String;
+ CalledFromScript: Boolean;
+begin
+ CalledFromScript := False;
+ if frxInteger(AScript) = 1 then
+ begin
+ AScript := FScript;
+ CalledFromScript := True;
+ end;
+ if AScript = nil then
+ AScript := FScript;
+ if not DoGetValue(Expr, Result) then
+ begin
+ Result := FExpressionCache.Calc(Expr, ErrorMsg, AScript);
+ if (ErrorMsg <> '') and
+ not ((ErrorMsg = SZeroDivide) and FEngineOptions.IgnoreDevByZero) then
+ begin
+ if not CalledFromScript then
+ begin
+ if FCurObject <> '' then
+ ErrorMsg := FCurObject + ': ' + ErrorMsg;
+ FErrors.Add(ErrorMsg);
+ end
+ else ErrorMsg := frxResources.Get('clErrorInExp') + ErrorMsg;
+ raise Exception.Create(ErrorMsg);
+ end;
+ end;
+end;
+
+function TfrxReport.GetAlias(DataSet: TfrxDataSet): String;
+var
+ ds: TfrxDataSetItem;
+begin
+ if DataSet = nil then
+ begin
+ Result := '';
+ Exit;
+ end;
+
+ ds := DataSets.Find(DataSet);
+ if ds <> nil then
+ Result := ds.DataSet.UserName else
+ Result := frxResources.Get('clDSNotIncl');
+end;
+
+function TfrxReport.GetDataset(const Alias: String): TfrxDataset;
+var
+ ds: TfrxDataSetItem;
+begin
+ ds := DataSets.Find(Alias);
+ if ds <> nil then
+ Result := ds.DataSet else
+ Result := nil;
+end;
+
+procedure TfrxReport.GetDatasetAndField(const ComplexName: String;
+ var DataSet: TfrxDataSet; var Field: String);
+var
+ i: Integer;
+ s: String;
+begin
+ DataSet := nil;
+ Field := '';
+
+ { ComplexName has format: dataset name."field name"
+ Spaces are allowed in both parts of the complex name }
+ i := Pos('."', ComplexName);
+ if i <> 0 then
+ begin
+ s := Copy(ComplexName, 1, i - 1); { dataset name }
+ DataSet := GetDataSet(s);
+ Field := Copy(ComplexName, i + 2, Length(ComplexName) - i - 2);
+ end;
+end;
+
+procedure TfrxReport.GetDataSetList(List: TStrings; OnlyDB: Boolean = False);
+var
+ i: Integer;
+begin
+ List.Clear;
+ for i := 0 to DataSets.Count - 1 do
+ if Datasets[i].DataSet <> nil then
+ if not OnlyDB or not (DataSets[i].DataSet is TfrxUserDataSet) then
+ List.AddObject(DataSets[i].DataSet.UserName, DataSets[i].DataSet);
+end;
+
+procedure TfrxReport.GetActiveDataSetList(List: TStrings);
+var
+ i: Integer;
+ ds: TfrxDataSet;
+begin
+ if EngineOptions.FUseGlobalDataSetList then
+ frxGetDataSetList(List)
+ else
+ begin
+ List.Clear;
+ for i := 0 to EnabledDataSets.Count - 1 do
+ begin
+ ds := EnabledDataSets[i].DataSet;
+ if ds <> nil then
+ List.AddObject(ds.UserName, ds);
+ end;
+ end;
+end;
+
+procedure TfrxReport.DoLoadFromStream;
+var
+ SaveLeftTop: Longint;
+ Loaded: Boolean;
+begin
+ SaveLeftTop := DesignInfo;
+ Loaded := False;
+ if Assigned(frxConverter.OnLoad) then
+ Loaded := frxConverter.OnLoad(Self, FLoadStream);
+ if not Loaded then
+ inherited LoadFromStream(FLoadStream);
+ if Assigned(frxConverter.OnAfterLoad) then
+ frxConverter.OnAfterLoad(Self);
+ DesignInfo := SaveLeftTop;
+end;
+
+procedure TfrxReport.CheckDataPage;
+var
+ i, x: Integer;
+ l: TList;
+ hasDataPage, hasDataObjects: Boolean;
+ p: TfrxDataPage;
+ c: TfrxComponent;
+begin
+ { check if report has datapage and datacomponents }
+ hasDataPage := False;
+ hasDataObjects := False;
+ l := AllObjects;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if c is TfrxDataPage then
+ hasDataPage := True;
+ if c is TfrxDialogComponent then
+ hasDataObjects := True;
+ end;
+
+ if not hasDataPage then
+ begin
+ { create the datapage }
+ p := TfrxDataPage.Create(Self);
+ if FindObject('Data') = nil then
+ p.Name := 'Data'
+ else
+ p.CreateUniqueName;
+
+ { make it the first page }
+ Objects.Delete(Objects.Count - 1);
+ Objects.Insert(0, p);
+
+ { move existing datacomponents to this page }
+ if hasDataObjects then
+ begin
+ x := 60;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if c is TfrxDialogComponent then
+ begin
+ c.Parent := p;
+ c.Left := x;
+ c.Top := 20;
+ Inc(x, 64);
+ end;
+ end;
+ end;
+ end;
+end;
+
+procedure TfrxReport.LoadFromStream(Stream: TStream);
+var
+ Compressor: TfrxCustomCompressor;
+ Crypter: TfrxCustomCrypter;
+ SaveEngineOptions: TfrxEngineOptions;
+ SavePreviewOptions: TfrxPreviewOptions;
+ SaveConvertNulls: Boolean;
+ SaveIgnoreDevByZero: Boolean;
+ SaveDoublePass: Boolean;
+ SaveOutlineVisible, SaveOutlineExpand: Boolean;
+ SaveOutlineWidth, SavePagesInCache: Integer;
+ SaveIni: String;
+ SavePreview: TfrxCustomPreview;
+ SaveOldStyleProgress, SaveShowProgress, SaveStoreInDFM: Boolean;
+ Crypted, SaveThumbnailVisible: Boolean;
+
+ function DecodePwd(const s: String): String;
+ var
+ i: Integer;
+ begin
+ Result := '';
+ for i := 1 to Length(s) do
+ Result := Result + Chr(Ord(s[i]) + 10);
+ end;
+
+begin
+ FErrors.Clear;
+
+ Compressor := nil;
+ if frxCompressorClass <> nil then
+ begin
+ Compressor := TfrxCustomCompressor(frxCompressorClass.NewInstance);
+ Compressor.Create(nil);
+ Compressor.Report := Self;
+ Compressor.IsFR3File := True;
+ try
+ Compressor.CreateStream;
+ if Compressor.Decompress(Stream) then
+ Stream := Compressor.Stream;
+ except
+ Compressor.Free;
+ FErrors.Add(frxResources.Get('clDecompressError'));
+ frxCommonErrorHandler(Self, frxResources.Get('clErrors') + #13#10 + FErrors.Text);
+ Exit;
+ end;
+ end;
+
+ ReportOptions.Password := ReportOptions.HiddenPassword;
+ Crypter := nil;
+ Crypted := False;
+ if frxCrypterClass <> nil then
+ begin
+ Crypter := TfrxCustomCrypter(frxCrypterClass.NewInstance);
+ Crypter.Create(nil);
+ try
+ Crypter.CreateStream;
+ Crypted := Crypter.Decrypt(Stream, AnsiString(ReportOptions.Password));
+ if Crypted then
+ Stream := Crypter.Stream;
+ except
+ Crypter.Free;
+ FErrors.Add(frxResources.Get('clDecryptError'));
+ frxCommonErrorHandler(Self, frxResources.Get('clErrors') + #13#10 + FErrors.Text);
+ Exit;
+ end;
+ end;
+
+ SaveEngineOptions := TfrxEngineOptions.Create;
+ SaveEngineOptions.Assign(FEngineOptions);
+ SavePreviewOptions := TfrxPreviewOptions.Create;
+ SavePreviewOptions.Assign(FPreviewOptions);
+ SaveIni := FIniFile;
+ SavePreview := FPreview;
+ SaveOldStyleProgress := FOldStyleProgress;
+ SaveShowProgress := FShowProgress;
+ SaveStoreInDFM := FStoreInDFM;
+ FStreamLoaded := True;
+ try
+ FLoadStream := Stream;
+ try
+ DoLoadFromStream;
+ except
+ on E: Exception do
+ begin
+ FStreamLoaded := False;
+ if (E is TfrxInvalidXMLException) and Crypted then
+ FErrors.Add('Invalid password')
+ else
+ FErrors.Add(E.Message)
+ end;
+ end;
+ finally
+ if Compressor <> nil then
+ Compressor.Free;
+ if Crypter <> nil then
+ Crypter.Free;
+
+ CheckDataPage;
+
+ SaveConvertNulls := FEngineOptions.ConvertNulls;
+ SaveIgnoreDevByZero := FEngineOptions.IgnoreDevByZero;
+ SaveDoublePass := FEngineOptions.DoublePass;
+ FEngineOptions.Assign(SaveEngineOptions);
+ FEngineOptions.ConvertNulls := SaveConvertNulls;
+ FEngineOptions.IgnoreDevByZero := SaveIgnoreDevByZero;
+ FEngineOptions.DoublePass := SaveDoublePass;
+ SaveEngineOptions.Free;
+
+ SaveOutlineVisible := FPreviewOptions.OutlineVisible;
+ SaveOutlineWidth := FPreviewOptions.OutlineWidth;
+ SaveOutlineExpand := FPreviewOptions.OutlineExpand;
+ SavePagesInCache := FPreviewOptions.PagesInCache;
+ SaveThumbnailVisible := FPreviewOptions.ThumbnailVisible;
+ FPreviewOptions.Assign(SavePreviewOptions);
+ FPreviewOptions.OutlineVisible := SaveOutlineVisible;
+ FPreviewOptions.OutlineWidth := SaveOutlineWidth;
+ FPreviewOptions.OutlineExpand := SaveOutlineExpand;
+ FPreviewOptions.PagesInCache := SavePagesInCache;
+ FPreviewOptions.ThumbnailVisible := SaveThumbnailVisible;
+ SavePreviewOptions.Free;
+ FIniFile := SaveIni;
+ FPreview := SavePreview;
+ FOldStyleProgress := SaveOldStyleProgress;
+ FShowProgress := SaveShowProgress;
+ FStoreInDFM := SaveStoreInDFM;
+ if not Crypted then
+ ReportOptions.Password := DecodePwd(ReportOptions.Password);
+
+ if ReportOptions.Info or ((not FReloading) and
+ (not FEngineOptions.EnableThreadSafe) and
+ (not Crypted and not FReportOptions.CheckPassword)) then
+
+ Clear
+ else if (FErrors.Count > 0) then
+ frxCommonErrorHandler(Self, frxResources.Get('clErrors') + #13#10 + FErrors.Text);
+ end;
+end;
+
+procedure TfrxReport.SaveToStream(Stream: TStream; SaveChildren: Boolean = True;
+ SaveDefaultValues: Boolean = False; UseGetAncestor: Boolean = False);
+var
+ Compressor: TfrxCustomCompressor;
+ Crypter: TfrxCustomCrypter;
+ StreamTo: TStream;
+ SavePwd: String;
+ SavePreview: TfrxCustomPreview;
+
+ function EncodePwd(const s: String): String;
+ var
+ i: Integer;
+ begin
+ Result := '';
+ for i := 1 to Length(s) do
+ Result := Result + Chr(Ord(s[i]) - 10);
+ end;
+
+begin
+ StreamTo := Stream;
+
+ Compressor := nil;
+ if FReportOptions.Compressed and (frxCompressorClass <> nil) then
+ begin
+ Compressor := TfrxCustomCompressor(frxCompressorClass.NewInstance);
+ Compressor.Create(nil);
+ Compressor.Report := Self;
+ Compressor.IsFR3File := True;
+ Compressor.CreateStream;
+ StreamTo := Compressor.Stream;
+ end;
+
+ Crypter := nil;
+ if (FReportOptions.Password <> '') and (frxCrypterClass <> nil) then
+ begin
+ Crypter := TfrxCustomCrypter(frxCrypterClass.NewInstance);
+ Crypter.Create(nil);
+ Crypter.CreateStream;
+ StreamTo := Crypter.Stream;
+ end;
+
+ SavePwd := ReportOptions.Password;
+ ReportOptions.PrevPassword := SavePwd;
+ if Crypter = nil then
+ ReportOptions.Password := EncodePwd(SavePwd);
+ SavePreview := FPreview;
+ FPreview := nil;
+
+ try
+ inherited SaveToStream(StreamTo, SaveChildren, SaveDefaultValues);
+ finally
+ FPreview := SavePreview;
+ ReportOptions.Password := SavePwd;
+ { crypt }
+ if Crypter <> nil then
+ begin
+ try
+ if Compressor <> nil then
+ Crypter.Crypt(Compressor.Stream, UTF8Encode(ReportOptions.Password))
+ else
+ Crypter.Crypt(Stream, UTF8Encode(ReportOptions.Password));
+ finally
+ Crypter.Free;
+ end;
+ end;
+ { compress }
+ if Compressor <> nil then
+ begin
+ try
+ Compressor.Compress(Stream);
+ finally
+ Compressor.Free;
+ end;
+ end;
+ end;
+end;
+
+function TfrxReport.LoadFromFile(const FileName: String;
+ ExceptionIfNotFound: Boolean = False): Boolean;
+var
+ f: TFileStream;
+begin
+ Clear;
+ FFileName := '';
+ Result := FileExists(FileName);
+ if Result or ExceptionIfNotFound then
+ begin
+ f := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ try
+ FFileName := FileName;
+ LoadFromStream(f);
+
+ finally
+ f.Free;
+ end;
+ end;
+end;
+
+procedure TfrxReport.SaveToFile(const FileName: String);
+var
+ f: TFileStream;
+begin
+ //fix up ParentReport property
+ if (Length(FParentReport) > 1) and (FParentReport[2] = ':') then
+ FParentReport := ExtractRelativePath(ExtractFilePath(FileName), FParentReport);
+ f := TFileStream.Create(FileName, fmCreate);
+ try
+ SaveToStream(f);
+ finally
+ f.Free;
+ end;
+end;
+
+function TfrxReport.GetIniFile: TCustomIniFile;
+var
+ fileName: String;
+begin
+ fileName := FIniFile;
+ if fileName = '' then
+ fileName := GetHomePath + PathDelim + 'FastReportFMX.config';
+ Result := TIniFile.Create(fileName);
+end;
+
+function TfrxReport.GetApplicationFolder: String;
+begin
+ if csDesigning in ComponentState then
+ Result := GetCurrentDir + '\'
+ else
+ Result := GetAppPath;
+end;
+
+procedure TfrxReport.SelectPrinter;
+begin
+ if frxPrinters.IndexOf(FPrintOptions.Printer) <> -1 then
+ frxPrinters.PrinterIndex := frxPrinters.IndexOf(FPrintOptions.Printer);
+end;
+
+procedure TfrxReport.DoNotifyEvent(Obj: TObject; const EventName: String;
+ RunAlways: Boolean = False);
+begin
+{$IFNDEF FR_VER_BASIC}
+ if FEngine.Running or RunAlways then
+ if EventName <> '' then
+ begin
+ FScript.CallFunction(EventName, VarArrayOf([frxInteger(Obj)]));
+ end;
+{$ENDIF}
+end;
+
+procedure TfrxReport.DoParamEvent(const EventName: String; var Params: Variant;
+ RunAlways: Boolean = False);
+begin
+{$IFNDEF FR_VER_BASIC}
+ if FEngine.Running or RunAlways then
+ if EventName <> '' then
+ FScript.CallFunction1(EventName, Params);
+{$ENDIF}
+end;
+
+procedure TfrxReport.DoBeforePrint(c: TfrxReportComponent);
+begin
+ if Assigned(FOnBeforePrint) then
+ FOnBeforePrint(c);
+ DoNotifyEvent(c, c.OnBeforePrint);
+end;
+
+procedure TfrxReport.DoAfterPrint(c: TfrxReportComponent);
+begin
+ if Assigned(FOnAfterPrint) then
+ FOnAfterPrint(c);
+ DoNotifyEvent(c, c.OnAfterPrint);
+end;
+
+procedure TfrxReport.DoPreviewClick(v: TfrxView; Button: TMouseButton;
+ Shift: TShiftState; var Modified: Boolean; DblClick: Boolean);
+var
+ arr: Variant;
+begin
+ arr := VarArrayOf([frxInteger(v), Button, ShiftToByte(Shift), Modified]);
+ if DblClick then
+ DoParamEvent(v.OnPreviewDblClick, arr, True)
+ else
+ DoParamEvent(v.OnPreviewClick, arr, True);
+ Modified := arr[3];
+ if DblClick then
+ begin
+ if Assigned(FOnDblClickObject) then
+ FOnDblClickObject(v, Button, Shift, Modified)
+ end
+ else
+ if Assigned(FOnClickObject) then
+ FOnClickObject(v, Button, Shift, Modified);
+end;
+
+procedure TfrxReport.DoGetAncestor(const Name: String; var Ancestor: TPersistent);
+begin
+ if FParentReportObject <> nil then
+ begin
+ if Name = Self.Name then
+ Ancestor := FParentReportObject
+ else
+ Ancestor := FParentReportObject.FindObject(Name);
+ end;
+end;
+
+function TfrxReport.DoGetValue(const Expr: String; var Value: Variant): Boolean;
+var
+ i: Integer;
+ ds: TfrxDataSet;
+ fld: String;
+ val: Variant;
+ v: TfsCustomVariable;
+begin
+ Result := False;
+ Value := Null;
+
+ { maybe it's a dataset/field? }
+ GetDataSetAndField(Expr, ds, fld);
+ if (ds <> nil) and (fld <> '') then
+ begin
+ Value := ds.Value[fld];
+ if FEngineOptions.ConvertNulls and (Value = Null) then
+ case ds.FieldType[fld] of
+ fftNumeric:
+ Value := 0;
+ fftString:
+ Value := '';
+ fftBoolean:
+ Value := False;
+ end;
+ Result := True;
+ Exit;
+ end;
+
+ { searching in the sys variables }
+ i := FSysVariables.IndexOf(Expr);
+ if i <> -1 then
+ begin
+ case i of
+ 0: Value := FEngine.StartDate; { Date }
+ 1: Value := FEngine.StartTime; { Time }
+ 2: Value := FPreviewPages.GetLogicalPageNo; { Page }
+ 3: Value := FPreviewPages.CurPage + 1; { Page# }
+ 4: Value := FPreviewPages.GetLogicalTotalPages; { TotalPages }
+ 5: Value := FEngine.TotalPages; { TotalPages# }
+ 6: Value := FEngine.CurLine; { Line }
+ 7: Value := FEngine.CurLineThrough; { Line# }
+ 8: Value := frxGlobalVariables['CopyName0'];
+ end;
+ Result := True;
+ Exit;
+ end;
+
+ { value supplied by OnGetValue event }
+ TVarData(val).VType := varEmpty;
+ if Assigned(FOnGetValue) then
+ FOnGetValue(Expr, val);
+ if Assigned(FOnNewGetValue) then
+ FOnNewGetValue(Self, Expr, val);
+ if TVarData(val).VType <> varEmpty then
+ begin
+ Value := val;
+ Result := True;
+ Exit;
+ end;
+
+ { searching in the variables }
+ i := FVariables.IndexOf(Expr);
+ if i <> -1 then
+ begin
+ val := FVariables.Items[i].Value;
+ if (TVarData(val).VType = varString) or (TVarData(val).VType = varOleStr) or (TVarData(val).VType = varUString) then
+ begin
+ if (Pos(#13#10, VarToStr(val)) <> 0) or (Pos(System.sLineBreak, VarToStr(val)) <> 0) or
+ (Pos(#13, VarToStr(val)) <> 0) or (Pos(#10, VarToStr(val)) <> 0) then
+ Value := val
+ else
+ Value := Calc(val);
+ end
+ else
+ Value := val;
+ Result := True;
+ Exit;
+ end;
+
+ { searching in the global variables }
+ i := frxGlobalVariables.IndexOf(Expr);
+ if i <> -1 then
+ begin
+ Value := frxGlobalVariables.Items[i].Value;
+ Result := True;
+ Exit;
+ end;
+
+ { searching in the script }
+ v := FScript.FindLocal(Expr);
+ if (v <> nil) and
+ not ((v is TfsProcVariable) or (v is TfsMethodHelper)) then
+ begin
+ Value := v.Value;
+ Result := True;
+ Exit;
+ end;
+end;
+
+function TfrxReport.GetScriptValue(Instance: TObject; ClassType: TClass;
+ const MethodName: String; var Params: Variant): Variant;
+var
+ i: Integer;
+ s: String;
+begin
+ if not DoGetValue(Params[0], Result) then
+ begin
+ { checking aggregate functions }
+ s := VarToStr(Params[0]);
+ i := Pos('(', s);
+ if i <> 0 then
+ begin
+ s := UpperCase(Trim(Copy(s, 1, i - 1)));
+ if (s = 'SUM') or (s = 'MIN') or (s = 'MAX') or
+ (s = 'AVG') or (s = 'COUNT') then
+ begin
+ Result := Calc(Params[0]);
+ Exit;
+ end;
+ end;
+
+ FErrors.Add(frxResources.Get('clUnknownVar') + ' ' + VarToStr(Params[0]));
+ end;
+end;
+
+function TfrxReport.SetScriptValue(Instance: TObject; ClassType: TClass;
+ const MethodName: String; var Params: Variant): Variant;
+begin
+ FVariables[Params[0]] := Params[1];
+end;
+
+function TfrxReport.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; var Params: Variant): Variant;
+var
+ p1, p2, p3: Variant;
+begin
+ if MethodName = 'IIF' then
+ begin
+ p1 := Params[0];
+ p2 := Params[1];
+ p3 := Params[2];
+ try
+ if Calc(p1, FScript.ProgRunning) = True then
+ Result := Calc(p2, FScript.ProgRunning) else
+ Result := Calc(p3, FScript.ProgRunning);
+ except
+ end;
+ end
+ else if (MethodName = 'SUM') or (MethodName = 'AVG') or
+ (MethodName = 'MIN') or (MethodName = 'MAX') then
+ begin
+ p2 := Params[1];
+ if Trim(VarToStr(p2)) = '' then
+ p2 := 0
+ else
+ p2 := Calc(p2, FScript.ProgRunning);
+ p3 := Params[2];
+ if Trim(VarToStr(p3)) = '' then
+ p3 := 0
+ else
+ p3 := Calc(p3, FScript.ProgRunning);
+ Result := FEngine.GetAggregateValue(MethodName, Params[0],
+ TfrxBand(frxInteger(p2)), p3);
+ end
+ else if MethodName = 'COUNT' then
+ begin
+ p1 := Params[0];
+ if Trim(VarToStr(p1)) = '' then
+ p1 := 0
+ else
+ p1 := Calc(p1, FScript.ProgRunning);
+ p2 := Params[1];
+ if Trim(VarToStr(p2)) = '' then
+ p2 := 0
+ else
+ p2 := Calc(p2, FScript.ProgRunning);
+ Result := FEngine.GetAggregateValue(MethodName, '',
+ TfrxBand(frxInteger(p1)), p2);
+ end
+end;
+
+function TfrxReport.DoUserFunction(Instance: TObject; ClassType: TClass;
+ const MethodName: String; var Params: Variant): Variant;
+begin
+ if Assigned(FOnUserFunction) then
+ Result := FOnUserFunction(MethodName, Params);
+end;
+
+function TfrxReport.PrepareScript: Boolean;
+var
+ i: Integer;
+ l: TList;
+ c: TfrxComponent;
+begin
+ FExpressionCache.Clear;
+ FExpressionCache.FScriptLanguage := FScriptLanguage;
+ FEngine.NotifyList.Clear;
+
+ FScript.ClearItems(Self);
+ FScript.AddedBy := Self;
+ FScript.MainProg := True;
+ try
+ l := AllObjects;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ c.IsDesigning := False;
+ c.BeforeStartReport;
+ if c is TfrxPictureView then
+ TfrxPictureView(c).FPictureChanged := True;
+ FScript.AddObject(c.Name, c);
+ end;
+
+ FScript.AddObject('Report', Self);
+ FScript.AddObject('Engine', FEngine);
+ FScript.AddObject('Outline', FPreviewPages.Outline);
+ FScript.AddVariable('Value', 'Variant', Null);
+ FScript.AddVariable('Self', 'TfrxView', Null);
+ FScript.AddMethod('function Get(Name: String): Variant', GetScriptValue);
+ FScript.AddMethod('procedure Set(Name: String; Value: Variant)', SetScriptValue);
+ FScript.AddMethod('macrofunction IIF(Expr: Boolean; TrueValue, FalseValue: Variant): Variant',
+ CallMethod);
+ FScript.AddMethod('macrofunction SUM(Expr: Variant; Band: Variant = 0; Flags: Integer = 0): Variant',
+ CallMethod);
+ FScript.AddMethod('macrofunction AVG(Expr: Variant; Band: Variant = 0; Flags: Integer = 0): Variant',
+ CallMethod);
+ FScript.AddMethod('macrofunction MIN(Expr: Variant; Band: Variant = 0; Flags: Integer = 0): Variant',
+ CallMethod);
+ FScript.AddMethod('macrofunction MAX(Expr: Variant; Band: Variant = 0; Flags: Integer = 0): Variant',
+ CallMethod);
+ FScript.AddMethod('macrofunction COUNT(Band: Variant = 0; Flags: Integer = 0): Variant',
+ CallMethod);
+
+ FLocalValue := FScript.Find('Value');
+ FSelfValue := FScript.Find('Self');
+ FScript.Lines := FScriptText;
+ FScript.SyntaxType := FScriptLanguage;
+ {$IFNDEF FR_VER_BASIC}
+ Result := FScript.Compile;
+ if not Result then
+ FErrors.Add(Format(frxResources.Get('clScrError'),
+ [FScript.ErrorPos, FScript.ErrorMsg]));
+ {$ELSE}
+ Result := True;
+ {$ENDIF}
+ finally
+ FScript.AddedBy := nil;
+ end;
+end;
+
+function TfrxReport.PrepareReport(ClearLastReport: Boolean = True): Boolean;
+var
+ TempStream: TStream;
+ ErrorsText: String;
+ ErrorMessage: String;
+ SavePwd: String;
+ SaveSplisLine: Integer;
+ TmpFile: String;
+ EngineRun: Boolean;
+
+ function CheckDatasets: Boolean;
+ var
+ i: Integer;
+ begin
+ for i := 0 to FDataSets.Count - 1 do
+ if FDatasets[i].DataSet = nil then
+ FErrors.Add(Format(frxResources.Get('clDSNotExist'), [FDatasets[i].DataSetName]));
+ Result := FErrors.Count = 0;
+ end;
+
+begin
+ if ClearLastReport then
+ PreviewPages.Clear;
+ SaveSplisLine := 0;
+ FErrors.Clear;
+ FTerminated := False;
+ Result := False;
+ EngineRun := False;
+
+ if CheckDatasets then
+ begin
+ TempStream := nil;
+ SavePwd := ReportOptions.Password;
+
+ { save the report state }
+ if FEngineOptions.DestroyForms then
+ begin
+ if EngineOptions.UseFileCache then
+ begin
+ TmpFile := frxCreateTempFile(EngineOptions.TempDir);
+ TempStream := TFileStream.Create(TmpFile, fmCreate);
+ end
+ else TempStream := TMemoryStream.Create;
+
+ ReportOptions.Password := '';
+ SaveSplisLine := PrintOptions.SplicingLine;
+ SaveToStream(TempStream);
+ end;
+
+ try
+ if Assigned(FOnBeginDoc) then
+ FOnBeginDoc(Self);
+ if PrepareScript then
+ begin
+{$IFNDEF FR_VER_BASIC}
+ if Assigned(FOnAfterScriptCompile) then FOnAfterScriptCompile(Self);
+ if FScript.Statement.Count > 0 then
+ FScript.Execute;
+{$ENDIF}
+ if not Terminated then
+ EngineRun := FEngine.Run;
+ if EngineRun then
+ begin
+ if Assigned(FOnEndDoc) then
+ FOnEndDoc(Self);
+ Result := True
+ end
+ else if FPreviewForm <> nil then
+ FPreviewForm.Close;
+ end;
+ except
+ on e: Exception do
+ FErrors.Add(e.Message);
+ end;
+
+ if FEngineOptions.DestroyForms then
+ begin
+ ErrorsText := FErrors.Text;
+ TempStream.Position := 0;
+ FReloading := True;
+ try
+// if FEngineOptions.ReportThread = nil then
+ LoadFromStream(TempStream);
+ finally
+ FReloading := False;
+ ReportOptions.Password := SavePwd;
+ PrintOptions.SplicingLine := SaveSplisLine;
+ end;
+ TempStream.Free;
+ if EngineOptions.UseFileCache then
+ DeleteFile(TmpFile);
+ FErrors.Text := ErrorsText;
+ end;
+ end;
+
+ if FErrors.Text <> '' then
+ begin
+ Result := False;
+ ErrorMessage := frxResources.Get('clErrors') + #13#10 + FErrors.Text;
+ frxCommonErrorHandler(Self, ErrorMessage);
+ end;
+end;
+
+procedure TfrxReport.ShowPreparedReport;
+begin
+ FPreviewForm := nil;
+ if FPreview <> nil then
+ begin
+ FPreview.FReport := Self;
+ FPreview.FPreviewPages := FPreviewPages;
+ FPreview.Init;
+ end
+ else
+ begin
+ FPreviewForm := TfrxPreviewForm.Create(Application);
+ with TfrxPreviewForm(FPreviewForm) do
+ begin
+ Preview.FReport := Self;
+ Preview.FPreviewPages := FPreviewPages;
+ FPreview := Preview;
+ Preview.Workspace.DoubleBuffered := PreviewOptions.DoubleBuffered
+{$IFDEF DELPHI27}
+ and not GlobalUseMetal;
+{$ENDIF};
+ Init;
+ if Assigned(FOnPreview) then
+ FOnPreview(Self);
+ if PreviewOptions.Maximized then
+ Position := TFormPosition.poDesigned;
+ if FPreviewOptions.Modal then
+ begin
+ ShowModal;
+ Free;
+ FPreviewForm := nil;
+ end
+ else
+ begin
+ FreeOnClose := True;
+ Show;
+ end;
+ end;
+ end;
+end;
+
+procedure TfrxReport.ShowReport(ClearLastReport: Boolean = True);
+begin
+ if ClearLastReport then
+ PreviewPages.Clear;
+
+ if FOldStyleProgress then
+ begin
+ if PrepareReport(False) then
+ ShowPreparedReport;
+ end
+ else
+ begin
+ FTimer.Enabled := True;
+ ShowPreparedReport;
+ end;
+end;
+
+procedure TfrxReport.OnTimer(Sender: TObject);
+begin
+ FTimer.Enabled := False;
+ PrepareReport(False);
+end;
+
+{$HINTS OFF}
+
+{$UNDEF FR_RUN_DESIGNER}
+
+{$IFDEF FR_LITE}
+ {$DEFINE FR_RUN_DESIGNER}
+{$ENDIF}
+
+{$IFNDEF FR_VER_BASIC}
+ {$DEFINE FR_RUN_DESIGNER}
+{$ENDIF}
+
+procedure TfrxReport.DesignReport(Modal: Boolean = True; MDIChild: Boolean = False);
+var
+ l: TList;
+ i: Integer;
+ c: TfrxComponent;
+begin
+{$IFDEF FR_RUN_DESIGNER}
+ if FDesigner <> nil then Exit;
+ if frxDesignerClass <> nil then
+ begin
+ FScript.ClearItems(Self);
+ l := AllObjects;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if c is TfrxCustomDBDataset then
+ c.BeforeStartReport;
+ end;
+
+ FModified := False;
+ FDesigner := TfrxCustomDesigner(frxDesignerClass.NewInstance);
+ FDesigner.CreateDesigner(nil, Self);
+ FDesigner.FormShow(FDesigner);
+ if Modal then
+ begin
+ FDesigner.ShowModal;
+ FDesigner.Free;
+ AppHandleMessage;
+ FDesigner := nil;
+ end
+ else
+ begin
+ FDesigner.Show;
+ end;
+ end;
+{$ENDIF}
+end;
+{$HINTS ON}
+
+procedure TfrxReport.DesignReport(IDesigner: IUnknown; Editor: TObject);
+var
+ l: TList;
+ i: Integer;
+ c: TfrxComponent;
+begin
+ if FDesigner <> nil then
+ begin
+ FDesigner.Activate;
+ Exit;
+ end;
+ if (IDesigner = nil) or (Editor.ClassName <> 'TfrxReportEditor') then Exit;
+
+ l := AllObjects;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if c is TfrxCustomDBDataset then
+ c.BeforeStartReport;
+ end;
+
+ FDesigner := TfrxCustomDesigner(frxDesignerClass.NewInstance);
+ FDesigner.CreateDesigner(nil, Self);
+ FDesigner.FormShow(FDesigner);
+ FDesigner.ShowModal;
+ FreeAndNil(FDesigner);
+end;
+
+{$HINTS OFF}
+function TfrxReport.DesignPreviewPage: Boolean;
+begin
+ Result := False;
+{$IFNDEF FR_VER_BASIC}
+ if FDesigner <> nil then
+ begin
+ FDesigner.Activate;
+ Exit;
+ end;
+ if frxDesignerClass <> nil then
+ begin
+ FDesigner := TfrxCustomDesigner(frxDesignerClass.NewInstance);
+ FDesigner.CreateDesigner(nil, Self, True);
+ FDesigner.FormShow(FDesigner);
+ FDesigner.ShowModal;
+ Result := FModified;
+ FreeAndNil(FDesigner);
+ end;
+{$ENDIF}
+end;
+{$HINTS ON}
+
+function TfrxReport.Export(Filter: TfrxCustomExportFilter): Boolean;
+begin
+ Result := FPreviewPages.Export(Filter);
+end;
+
+function TfrxReport.Print: Boolean;
+begin
+ Result := FPreviewPages.Print;
+end;
+
+procedure TfrxReport.AddFunction(const FuncName: String;
+ const Category: String = ''; const Description: String = '');
+begin
+ FScript.AddedBy := nil;
+ FScript.AddMethod(FuncName, DoUserFunction, Category, Description);
+end;
+
+function TfrxReport.GetLocalValue: Variant;
+begin
+ Result := FLocalValue.Value;
+end;
+
+function TfrxReport.GetSelfValue: TfrxView;
+begin
+ Result := TfrxView(frxInteger(FSelfValue.Value));
+end;
+
+procedure TfrxReport.SetLocalValue(const Value: Variant);
+begin
+ FLocalValue.Value := Value;
+end;
+
+procedure TfrxReport.SetSelfValue(const Value: TfrxView);
+begin
+ FSelfValue.Value := frxInteger(Value);
+end;
+
+procedure TfrxReport.SetTerminated(const Value: Boolean);
+begin
+ FTerminated := Value;
+ if Value then
+ FScript.Terminate;
+end;
+
+procedure TfrxReport.SetPreview(const Value: TfrxCustomPreview);
+begin
+ if (FPreview <> nil) and (Value = nil) then
+ begin
+ FPreview.FReport := nil;
+ FPreview.FPreviewPages := nil;
+ FPreviewForm := nil;
+ end;
+
+ FPreview := Value;
+
+ if FPreview <> nil then
+ begin
+ FPreview.FReport := Self;
+ FPreview.FPreviewPages := FPreviewPages;
+ if not (csDesigning in FPreview.ComponentState) then
+ FPreview.Init;
+ end;
+end;
+
+function TfrxReport.GetCaseSensitive: Boolean;
+begin
+ Result := FExpressionCache.CaseSensitive;
+end;
+
+function TfrxReport.GetScriptText: TStrings;
+begin
+ if (csWriting in ComponentState) and not FStoreInDFM then
+ Result := FFakeScriptText
+ else Result := FScriptText;
+end;
+
+procedure TfrxReport.SetCaseSensitive(const Value: Boolean);
+begin
+ FExpressionCache.CaseSensitive := Value;
+end;
+
+procedure TfrxReport.InternalOnProgressStart(ProgressType: TfrxProgressType);
+begin
+ if (FEngineOptions.EnableThreadSafe) then Exit; //(FEngineOptions.ReportThread <> nil) or
+
+ if Assigned(FOnProgressStart) then
+ FOnProgressStart(Self, ProgressType, 0);
+
+ if OldStyleProgress or (ProgressType <> ptRunning) then
+ begin
+ if FShowProgress then
+ begin
+ if FProgress <> nil then
+ FProgress.Free;
+ FProgress := TfrxProgress.Create(nil);
+ FProgress.Execute(0, '', True, False);
+{$IFDEF LINUX}
+ if GnomeAndRedHat then
+ FProgress.Visible := False;
+{$ENDIF}
+
+ end;
+ end;
+
+ if (FPreview <> nil) and (ProgressType = ptRunning) then
+ FPreview.InternalOnProgressStart(Self, ProgressType, 0);
+ AppHandleMessage;
+end;
+
+procedure TfrxReport.InternalOnProgress(ProgressType: TfrxProgressType;
+ Progress: Integer);
+begin
+ if FEngineOptions.EnableThreadSafe then Exit;
+
+ if Assigned(FOnProgress) then
+ FOnProgress(Self, ProgressType, Progress);
+
+ if OldStyleProgress or (ProgressType <> ptRunning) then
+ begin
+ if FShowProgress then
+ begin
+ case ProgressType of
+ ptRunning:
+ if not Engine.FinalPass then
+ FProgress.Message := Format(frxResources.Get('prRunningFirst'), [Progress])
+ else
+ FProgress.Message := Format(frxResources.Get('prRunning'), [Progress]);
+ ptPrinting:
+ FProgress.Message := Format(frxResources.Get('prPrinting'), [Progress]);
+ ptExporting:
+ FProgress.Message := Format(frxResources.Get('prExporting'), [Progress]);
+ end;
+ if FProgress.Terminated then
+ Terminated := True;
+ end;
+ end;
+
+ if (FPreview <> nil) and (ProgressType = ptRunning) then
+ FPreview.InternalOnProgress(Self, ProgressType, Progress - 1);
+ AppHandleMessage;
+end;
+
+procedure TfrxReport.InternalOnProgressStop(ProgressType: TfrxProgressType);
+begin
+ if FEngineOptions.EnableThreadSafe then Exit;
+
+ if Assigned(FOnProgressStop) then
+ FOnProgressStop(Self, ProgressType, 0);
+
+ if OldStyleProgress or (ProgressType <> ptRunning) then
+ begin
+ if FShowProgress then
+ begin
+ FProgress.Free;
+ FProgress := nil;
+ end;
+ end;
+
+ if (FPreview <> nil) and (ProgressType = ptRunning) then
+ FPreview.InternalOnProgressStop(Self, ProgressType, 0);
+ AppHandleMessage;
+end;
+
+procedure TfrxReport.SetProgressMessage(const Value: String; IsHint: Boolean);
+begin
+ if FEngineOptions.EnableThreadSafe then Exit;
+
+ if OldStyleProgress and Engine.Running then
+ begin
+ if FShowProgress then
+ FProgress.Message := Value
+ end;
+
+ if FPreviewForm <> nil then
+ TfrxPreviewForm(FPreviewForm).SetMessageText(Value, IsHint);
+ AppHandleMessage;
+end;
+
+procedure TfrxReport.SetVersion(const Value: String);
+begin
+ FVersion := FR_VERSION;
+end;
+
+
+{ TfrxCustomDesigner }
+
+constructor TfrxCustomDesigner.CreateDesigner(AOwner: TComponent;
+ AReport: TfrxReport; APreviewDesigner: Boolean);
+begin
+ inherited Create(AOwner);
+ FReport := AReport;
+ FIsPreviewDesigner := APreviewDesigner;
+ FObjects := TList.Create;
+ FSelectedObjects := TList.Create;
+end;
+
+destructor TfrxCustomDesigner.Destroy;
+begin
+ FObjects.Free;
+ FSelectedObjects.Free;
+ inherited;
+end;
+
+procedure TfrxCustomDesigner.SetModified(const Value: Boolean);
+begin
+ FModified := Value;
+ if Value then
+ FReport.Modified := True;
+end;
+
+procedure TfrxCustomDesigner.SetPage(const Value: TfrxPage);
+begin
+ FPage := Value;
+end;
+
+
+{ TfrxCustomEngine }
+
+procedure TfrxCustomEngine.BreakAllKeep;
+begin
+// do nothing
+end;
+
+constructor TfrxCustomEngine.Create(AReport: TfrxReport);
+begin
+ FReport := AReport;
+ FNotifyList := TList.Create;
+end;
+
+destructor TfrxCustomEngine.Destroy;
+begin
+ FNotifyList.Free;
+ inherited;
+end;
+
+function TfrxCustomEngine.GetDoublePass: Boolean;
+begin
+ Result := FReport.EngineOptions.DoublePass;
+end;
+
+procedure TfrxCustomEngine.ShowBandByName(const BandName: String);
+begin
+ ShowBand(TfrxBand(Report.FindObject(BandName)));
+end;
+
+procedure TfrxCustomEngine.StopReport;
+begin
+ Report.Terminated := True;
+end;
+
+function TfrxCustomEngine.GetPageHeight: Double;
+begin
+ Result := FPageHeight;
+end;
+
+
+{ TfrxCustomOutline }
+
+constructor TfrxCustomOutline.Create(APreviewPages: TfrxCustomPreviewPages);
+begin
+ FPreviewPages := APreviewPages;
+end;
+
+function TfrxCustomOutline.Engine: TfrxCustomEngine;
+begin
+ Result := FPreviewPages.Engine;
+end;
+
+{ TfrxCustomPreviewPages }
+
+constructor TfrxCustomPreviewPages.Create(AReport: TfrxReport);
+begin
+ FReport := AReport;
+ FOutline := TfrxOutline.Create(Self);
+end;
+
+destructor TfrxCustomPreviewPages.Destroy;
+begin
+ FOutline.Free;
+ inherited;
+end;
+
+
+{ TfrxExpressionCache }
+
+constructor TfrxExpressionCache.Create(AScript: TfsScript);
+begin
+ FExpressions := TStringList.Create;
+ FExpressions.Sorted := True;
+ FScript := TfsScript.Create(nil);
+ FScript.ExtendedCharset := True;
+ FMainScript := AScript;
+end;
+
+destructor TfrxExpressionCache.Destroy;
+begin
+ FExpressions.Free;
+ FScript.Free;
+ inherited;
+end;
+
+procedure TfrxExpressionCache.Clear;
+begin
+ FExpressions.Clear;
+ FScript.Clear;
+end;
+
+function TfrxExpressionCache.Calc(const Expression: String;
+ var ErrorMsg: String; AScript: TfsScript): Variant;
+var
+ i: Integer;
+ v: TfsProcVariable;
+ Compiled: Boolean;
+begin
+ ErrorMsg := '';
+ FScript.Parent := AScript;
+ i := FExpressions.IndexOf(Expression);
+ if i = -1 then
+ begin
+ i := FExpressions.Count;
+ FScript.SyntaxType := FScriptLanguage;
+ if CompareText(FScriptLanguage, 'PascalScript') = 0 then
+ FScript.Lines.Text := 'function fr3f' + IntToStr(i) + ': Variant; begin ' +
+ 'Result := ' + Expression + ' end; begin end.'
+ else if CompareText(FScriptLanguage, 'C++Script') = 0 then
+ FScript.Lines.Text := 'Variant fr3f' + IntToStr(i) + '() { ' +
+ 'return ' + Expression + '; } {}'
+ else if CompareText(FScriptLanguage, 'BasicScript') = 0 then
+ FScript.Lines.Text := 'function fr3f' + IntToStr(i) + #13#10 +
+ 'return ' + Expression + #13#10 + 'end function'
+ else if CompareText(FScriptLanguage, 'JScript') = 0 then
+ FScript.Lines.Text := 'function fr3f' + IntToStr(i) + '() { ' +
+ 'return ' + Expression + '; }';
+
+ Compiled := FScript.Compile;
+ v := TfsProcVariable(FScript.Find('fr3f' + IntToStr(i)));
+
+ if not Compiled then
+ begin
+ if v <> nil then
+ begin
+ v.Free;
+ FScript.Remove(v);
+ end;
+ ErrorMsg := frxResources.Get('clExprError') + ' ''' + Expression + ''': ' +
+ FScript.ErrorMsg;
+ Result := Null;
+ Exit;
+ end;
+
+ FExpressions.AddObject(Expression, v);
+ end
+ else
+ v := TfsProcVariable(FExpressions.Objects[i]);
+ FMainScript.MainProg := False;
+ try
+ try
+ Result := v.Value;
+ except
+ on e: Exception do
+ ErrorMsg := e.Message;
+ end;
+ finally
+ FMainScript.MainProg := True;
+ end;
+end;
+
+function TfrxExpressionCache.GetCaseSensitive: Boolean;
+begin
+ Result := FExpressions.CaseSensitive;
+end;
+
+procedure TfrxExpressionCache.SetCaseSensitive(const Value: Boolean);
+begin
+ FExpressions.CaseSensitive := Value;
+end;
+
+
+{ TfrxCustomExportFilter }
+
+constructor TfrxCustomExportFilter.Create(AOwner: TComponent);
+begin
+ inherited;
+ if not FNoRegister then
+ frxExportFilters.Register(Self);
+ FShowDialog := True;
+ FUseFileCache := True;
+ FDefaultPath := '';
+ FShowProgress := True;
+ FSlaveExport := False;
+ FOverwritePrompt := False;
+ FFiles := nil;
+end;
+
+constructor TfrxCustomExportFilter.CreateNoRegister;
+begin
+ FNoRegister := True;
+ Create(nil);
+end;
+
+destructor TfrxCustomExportFilter.Destroy;
+begin
+ if not FNoRegister then
+ frxExportFilters.Unregister(Self);
+ if FFiles <> nil then
+ FFiles.Free;
+ inherited;
+end;
+
+class function TfrxCustomExportFilter.GetDescription: String;
+begin
+ Result := '';
+end;
+
+procedure TfrxCustomExportFilter.Finish;
+begin
+//
+end;
+
+procedure TfrxCustomExportFilter.FinishPage(Page: TfrxReportPage;
+ Index: Integer);
+begin
+//
+end;
+
+function TfrxCustomExportFilter.ShowModal: TModalResult;
+begin
+ Result := mrOk;
+end;
+
+function TfrxCustomExportFilter.Start: Boolean;
+begin
+ Result := True;
+end;
+
+procedure TfrxCustomExportFilter.StartPage(Page: TfrxReportPage;
+ Index: Integer);
+begin
+//
+end;
+
+
+{ TfrxCustomWizard }
+
+constructor TfrxCustomWizard.Create(AOwner: TComponent);
+begin
+ inherited;
+ FDesigner := TfrxCustomDesigner(AOwner);
+ FReport := FDesigner.Report;
+end;
+
+class function TfrxCustomWizard.GetDescription: String;
+begin
+ Result := '';
+end;
+
+
+{ TfrxCustomCompressor }
+
+constructor TfrxCustomCompressor.Create(AOwner: TComponent);
+begin
+ inherited;
+ FOldCompressor := frxCompressorClass;
+ frxCompressorClass := TfrxCompressorClass(ClassType);
+end;
+
+destructor TfrxCustomCompressor.Destroy;
+begin
+ frxCompressorClass := FOldCompressor;
+ if FStream <> nil then
+ FStream.Free;
+ if FTempFile <> '' then
+ DeleteFile(FTempFile);
+ inherited;
+end;
+
+procedure TfrxCustomCompressor.CreateStream;
+begin
+ if FIsFR3File or not FReport.EngineOptions.UseFileCache then
+ FStream := TMemoryStream.Create
+ else
+ begin
+ FTempFile := frxCreateTempFile(FReport.EngineOptions.TempDir);
+ FStream := TFileStream.Create(FTempFile, fmCreate);
+ end;
+end;
+
+
+{ TfrxCustomCrypter }
+
+constructor TfrxCustomCrypter.Create(AOwner: TComponent);
+begin
+ inherited;
+ frxCrypterClass := TfrxCrypterClass(ClassType);
+end;
+
+destructor TfrxCustomCrypter.Destroy;
+begin
+ if FStream <> nil then
+ FStream.Free;
+ inherited;
+end;
+
+procedure TfrxCustomCrypter.CreateStream;
+begin
+ FStream := TMemoryStream.Create;
+end;
+
+
+{ TfrxGlobalDataSetList }
+
+constructor TfrxGlobalDataSetList.Create;
+begin
+{$IFNDEF NO_CRITICAL_SECTION}
+ FCriticalSection := TCriticalSection.Create;
+{$ENDIF}
+ inherited;
+end;
+
+destructor TfrxGlobalDataSetList.Destroy;
+begin
+{$IFNDEF NO_CRITICAL_SECTION}
+ FCriticalSection.Free;
+ FCriticalSection := nil;
+{$ENDIF}
+ inherited;
+end;
+
+procedure TfrxGlobalDataSetList.Lock;
+begin
+{$IFNDEF NO_CRITICAL_SECTION}
+ if FCriticalSection <> nil then
+ FCriticalSection.Enter;
+{$ENDIF}
+end;
+
+procedure TfrxGlobalDataSetList.Unlock;
+begin
+{$IFNDEF NO_CRITICAL_SECTION}
+ if FCriticalSection <> nil then
+ FCriticalSection.Leave;
+{$ENDIF}
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxComponent, TFmxObject);
+ GroupDescendentsWith(TfrxDBComponents, TFmxObject);
+ GroupDescendentsWith(TfrxCustomCrypter, TFmxObject);
+ GroupDescendentsWith(TfrxCustomCompressor, TFmxObject);
+ GroupDescendentsWith(TfrxCustomExportFilter, TFmxObject);
+ GroupDescendentsWith(TfrxCustomWizard, TFmxObject);
+ GroupDescendentsWith(TfrxFrame, TFmxObject);
+ GroupDescendentsWith(TfrxHighlight, TFmxObject);
+ GroupDescendentsWith(TfrxStyleItem, TFmxObject);
+{$IFNDEF DELPHI19}
+ GlobalUseDirect2D := False;
+{$ENDIF}
+{$IFNDEF NO_CRITICAL_SECTION}
+ frxCS := TCriticalSection.Create;
+{$ENDIF}
+ frxConverter := TfrxConverterEvents.Create;
+ DatasetList := TfrxGlobalDataSetList.Create;
+ frxGlobalVariables := TfrxVariables.Create;
+
+ RegisterFmxClasses([
+ TfrxChild, TfrxColumnFooter, TfrxColumnHeader, TfrxCustomMemoView, TfrxMasterData,
+ TfrxDetailData, TfrxSubDetailData, TfrxDataBand4, TfrxDataBand5, TfrxDataBand6,
+ TfrxDialogPage, TfrxFooter, TfrxFrame, TfrxGroupFooter, TfrxGroupHeader,
+ TfrxHeader, TfrxHighlight, TfrxLineView, TfrxMemoView, TfrxOverlay, TfrxPageFooter,
+ TfrxPageHeader, TfrxPictureView, TfrxReport, TfrxReportPage, TfrxReportSummary,
+ TfrxReportTitle, TfrxShapeView, TfrxSubreport, TfrxSysMemoView, TfrxStyleItem,
+ TfrxNullBand, TfrxCustomLineView, TfrxDataPage]);
+
+
+ frxResources.UpdateFSResources;
+
+
+finalization
+{$IFNDEF NO_CRITICAL_SECTION}
+ frxCS.Free;
+{$ENDIF}
+ frxGlobalVariables.Free;
+ DatasetList.Free;
+ frxConverter.Free;
+end.
diff --git a/LibD28/FMX.frxClass.res b/LibD28/FMX.frxClass.res
new file mode 100644
index 0000000..d097bbf
Binary files /dev/null and b/LibD28/FMX.frxClass.res differ
diff --git a/LibD28/FMX.frxClassRTTI.pas b/LibD28/FMX.frxClassRTTI.pas
new file mode 100644
index 0000000..a117078
--- /dev/null
+++ b/LibD28/FMX.frxClassRTTI.pas
@@ -0,0 +1,611 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Publish all classes defined in }
+{ frxClass }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxClassRTTI;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+implementation
+
+uses
+ System.SysUtils, System.Classes, System.Variants, System.WideStrings,
+ FMX.Types, System.UIConsts, System.Types,
+ FMX.fs_iinterpreter, FMX.frxClass, FMX.frxCtrls,
+ FMX.frxPreviewPages, FMX.frxEngine, FMX.frxDMPClass, FMX.frxVariables, FMX.fs_iformsrtti,
+ FMX.frxUnicodeUtils, FMX.frxFMX
+{$IFDEF DELPHI18}
+ ,FMX.Controls
+{$ENDIF};
+
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddConst('fr01cm', 'Extended', fr01cm);
+ AddConst('fr1cm', 'Extended', fr1cm);
+ AddConst('fr01in', 'Extended', fr01in);
+ AddConst('fr1in', 'Extended', fr1in);
+ AddConst('fr1CharX', 'Extended', fr1CharX);
+ AddConst('fr1CharY', 'Extended', fr1CharY);
+ AddConst('clTransparent', 'Integer', claNull);
+ AddEnum('TfrxStretchMode', 'smDontStretch, smActualHeight, smMaxHeight');
+ AddEnum('TfrxShiftMode', 'smDontShift, smAlways, smWhenOverlapped');
+ AddEnum('TfrxDuplexMode', 'dmNone, dmVertical, dmHorizontal, dmSimplex');
+ AddEnum('TfrxAlign', 'baNone, baLeft, baRight, baCenter, baWidth, baBottom');
+ AddEnum('TfrxFrameStyle', 'fsSolid, fsDash, fsDot, fsDashDot, fsDashDotDot, fsDouble');
+ AddEnumSet('TfrxFrameTypes', 'ftLeft, ftRight, ftTop, ftBottom');
+ AddEnum('TfrxHAlign', 'haLeft, haRight, haCenter, haBlock');
+ AddEnum('TfrxVAlign', 'vaTop, vaBottom, vaCenter');
+ AddEnumSet('TfrxRestrictions', 'rfDontModify, rfDontSize, rfDontMove, rfDontDelete');
+ AddEnum('TfrxShapeKind', 'skRectangle, skRoundRectangle, skEllipse, skTriangle, skDiamond, skDiagonal1, skDiagonal2');
+ AddEnumSet('TfrxPreviewButtons', 'pbPrint, pbLoad, pbSave, pbExport, ' +
+ 'pbZoom, pbFind, pbTree, pbPageSetup, pbRefresh, pbTools, pbEdit, pbNavigator, pbExportQuick');
+ AddEnum('TfrxZoomMode', 'zmDefault, zmWholePage, zmPageWidth, zmManyPages');
+ AddEnum('TfrxPrintPages', 'ppAll, ppOdd, ppEven');
+ AddEnumSet('TfrxDMPFontStyles', 'fsxBold, fsxItalic, fsxUnderline, fsxSuperScript, ' +
+ 'fsxSubScript, fsxCondensed, fsxWide, fsx12cpi, fsx15cpi');
+ AddEnum('TfrxRangeBegin', 'rbFirst, rbCurrent');
+ AddEnum('TfrxRangeEnd', 'reLast, reCurrent, reCount');
+ AddEnum('TfrxFieldType', 'fftNumeric, fftString, fftBoolean');
+ AddEnum('TfrxFormatKind', 'fkText, fkNumeric, fkDateTime, fkBoolean');
+
+ if FindClass('TPersistent') <> nil then
+ with AddClass(TWideStrings, 'TPersistent') do
+ begin
+ AddConstructor('constructor Create', CallMethod);
+ AddMethod('function Add(const S: string): Integer', CallMethod);
+ AddMethod('function AddObject(const S: string; AObject: TObject): Integer', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure Delete(Index: Integer)', CallMethod);
+ AddMethod('function IndexOf(const S: string): Integer', CallMethod);
+ AddMethod('procedure Insert(Index: Integer; const S: string)', CallMethod);
+ AddMethod('procedure LoadFromFile(const FileName: string)', CallMethod);
+ AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure SaveToFile(const FileName: string)', CallMethod);
+ AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
+
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddIndexProperty('Objects', 'Integer', 'TObject', CallMethod);
+ AddDefaultProperty('Strings', 'Integer', 'string', CallMethod);
+ AddProperty('Text', 'string', GetProp, SetProp);
+ end;
+
+ with AddClass(TfrxDataSet, 'TComponent') do
+ begin
+ AddMethod('procedure Open', CallMethod);
+ AddMethod('procedure Close', CallMethod);
+ AddMethod('procedure First', CallMethod);
+ AddMethod('procedure Next', CallMethod);
+ AddMethod('procedure Prior', CallMethod);
+ AddMethod('function Eof: Boolean', CallMethod);
+ AddMethod('function FieldsCount: Integer', CallMethod);
+ AddMethod('function HasField(const fName: String): Boolean', CallMethod);
+ AddMethod('function IsBlobField(const fName: String): Boolean', CallMethod);
+ AddMethod('function RecordCount: Integer', CallMethod);
+ AddMethod('procedure GetFieldList(List: TStrings)', CallMethod);
+ AddProperty('RecNo', 'Integer', GetProp, nil);
+ AddIndexProperty('DisplayText', 'String', 'String', CallMethod, True);
+ AddIndexProperty('DisplayWidth', 'String', 'Integer', CallMethod, True);
+ AddIndexProperty('FieldType', 'String', 'TfrxFieldType', CallMethod, True);
+ AddIndexProperty('Value', 'String', 'Variant', CallMethod, True);
+ end;
+ AddClass(TfrxUserDataSet, 'TfrxDataSet');
+ AddClass(TfrxCustomDBDataSet, 'TfrxDataSet');
+ AddClass(TfrxFont, 'TPersistent');
+
+ with AddClass(TfrxComponent, 'TComponent') do
+ begin
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('function FindObject(s: String): TfrxComponent', CallMethod);
+ AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure SaveToStream(Stream: TStream; SaveChildren: Boolean = True)', CallMethod);
+ AddMethod('procedure SetBounds(ALeft, ATop, AWidth, AHeight: Double)', CallMethod);
+ AddProperty('Objects', 'TList', GetProp, nil);
+ AddProperty('AllObjects', 'TList', GetProp, nil);
+ AddProperty('Parent', 'TfrxComponent', GetProp, SetProp);
+ AddProperty('Page', 'TfrxPage', GetProp, nil);
+ AddProperty('AbsLeft', 'Double', GetProp, nil);
+ AddProperty('AbsTop', 'Double', GetProp, nil);
+ end;
+ AddClass(TfrxReportComponent, 'TfrxComponent');
+ AddClass(TfrxDialogComponent, 'TfrxReportComponent');
+ with AddClass(TfrxDialogControl, 'TfrxReportComponent') do
+ AddMethod('procedure SetFocus', CallMethod);
+ AddClass(TfrxFrameLine, 'TPersistent');
+ AddClass(TfrxFrame, 'TPersistent');
+ with AddClass(TfrxView, 'TfrxReportComponent') do
+ AddProperty('TagStr', 'String', GetProp, SetProp);
+ AddClass(TfrxShapeView, 'TfrxView');
+ with AddClass(TfrxStretcheable, 'TfrxView') do
+ AddMethod('function CalcHeight: Double', CallMethod);
+ AddClass(TfrxHighlight, 'TPersistent');
+ AddClass(TfrxFormat, 'TPersistent');
+ with AddClass(TfrxCustomMemoView, 'TfrxStretcheable') do
+ begin
+ AddMethod('function CalcWidth: Double', CallMethod);
+ AddProperty('Text', 'String', GetProp, SetProp);
+ AddProperty('Lines', 'TWideStrings', GetProp, SetProp);
+ AddProperty('Value', 'Variant', GetProp, nil);
+ end;
+ AddClass(TfrxMemoView, 'TfrxCustomMemoView');
+ AddClass(TfrxSysMemoView, 'TfrxCustomMemoView');
+ AddClass(TfrxDMPMemoView, 'TfrxCustomMemoView');
+ AddClass(TfrxCustomLineView, 'TfrxStretcheable');
+ AddClass(TfrxLineView, 'TfrxCustomLineView');
+ AddClass(TfrxDMPLineView, 'TfrxCustomLineView');
+ AddClass(TfrxDMPCommand, 'TfrxView');
+ with AddClass(TfrxPictureView, 'TfrxView') do
+ AddMethod('procedure LoadFromFile(filename: String)', CallMethod);
+ AddClass(TfrxSubreport, 'TfrxView');
+ with AddClass(TfrxBand, 'TfrxReportComponent') do
+ AddProperty('Overflow', 'Boolean', GetProp, nil);
+ AddClass(TfrxDataBand, 'TfrxBand');
+ AddClass(TfrxHeader, 'TfrxBand');
+ AddClass(TfrxFooter, 'TfrxBand');
+ AddClass(TfrxMasterData, 'TfrxDataBand');
+ AddClass(TfrxDetailData, 'TfrxDataBand');
+ AddClass(TfrxSubDetailData, 'TfrxDataBand');
+ AddClass(TfrxDataBand4, 'TfrxDataBand');
+ AddClass(TfrxDataBand5, 'TfrxDataBand');
+ AddClass(TfrxDataBand6, 'TfrxDataBand');
+ AddClass(TfrxPageHeader, 'TfrxBand');
+ AddClass(TfrxPageFooter, 'TfrxBand');
+ AddClass(TfrxColumnHeader, 'TfrxBand');
+ AddClass(TfrxColumnFooter, 'TfrxBand');
+ AddClass(TfrxGroupHeader, 'TfrxBand');
+ AddClass(TfrxGroupFooter, 'TfrxBand');
+ AddClass(TfrxReportTitle, 'TfrxBand');
+ AddClass(TfrxReportSummary, 'TfrxBand');
+ AddClass(TfrxChild, 'TfrxBand');
+ AddClass(TfrxOverlay, 'TfrxBand');
+ AddClass(TfrxPage, 'TfrxComponent');
+ AddClass(TfrxReportPage, 'TfrxPage');
+ with AddClass(TfrxDialogPage, 'TfrxPage') do
+ begin
+ AddMethod('function ShowModal: Integer', CallMethod);
+ AddProperty('ModalResult', 'Integer', GetProp, SetProp);
+ end;
+ AddClass(TfrxDMPPage, 'TfrxReportPage');
+ AddClass(TfrxDataPage, 'TfrxPage');
+ with AddClass(TfrxEngineOptions, 'TPersistent') do
+ begin
+ AddProperty('DestroyForms', 'Boolean', GetProp, SetProp);
+ end;
+ AddClass(TfrxPrintOptions, 'TPersistent');
+ AddClass(TfrxPreviewOptions, 'TPersistent');
+ AddClass(TfrxReportOptions, 'TPersistent');
+ AddClass(TfrxVariable, 'TCollectionItem');
+ with AddClass(TfrxVariables, 'TCollection') do
+ begin
+ AddConstructor('constructor Create', CallMethod);
+ AddDefaultProperty('Variables', 'String', 'Variant', CallMethod);
+ end;
+ AddClass(TfrxStyleItem,'TCollectionItem');
+ with AddClass(TfrxStyles, 'TCollection') do
+ begin
+ AddConstructor('constructor Create(AReport: TfrxReport)', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TfrxStyleItem', CallMethod);
+ AddMethod('function Add: TfrxStyleItem', CallMethod);
+ AddMethod('function Find(const Name: String): TfrxStyleItem', CallMethod);
+ AddMethod('procedure Apply', CallMethod);
+ AddMethod('procedure GetList(List: TStrings)', CallMethod);
+ AddMethod('procedure LoadFromFile(const FileName: String)', CallMethod);
+ AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure SaveToFile(const FileName: String)', CallMethod);
+ AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
+ end;
+ with AddClass(TfrxArray, 'TCollection') do
+ begin
+ AddConstructor('constructor Create', CallMethod);
+ AddDefaultProperty('Variables', 'Variant', 'Variant', CallMethod);
+ end;
+ AddObject('frxGlobalVariables', frxGlobalVariables);
+ with AddClass(TfrxReport, 'TfrxComponent') do
+ begin
+ AddMethod('function Calc(const Expr: String): Variant', CallMethod);
+ AddMethod('function GetDataset(const Alias: String): TfrxDataset', CallMethod);
+ AddMethod('function LoadFromFile(const FileName: String): Boolean', CallMethod);
+ AddMethod('procedure SaveToFile(const FileName: String)', CallMethod);
+ AddMethod('procedure ShowReport', CallMethod);
+ AddProperty('Terminated', 'Boolean', GetProp, SetProp);
+ AddProperty('Variables', 'TfrxVariables', GetProp, nil);
+ AddProperty('Styles', 'TfrxStyles', GetProp, nil);
+ end;
+ with AddClass(TfrxCustomEngine, 'TPersistent') do
+ begin
+ AddMethod('procedure AddAnchor(const Text: String)', CallMethod);
+ AddMethod('procedure NewPage', CallMethod);
+ AddMethod('procedure NewColumn', CallMethod);
+ AddMethod('procedure ShowBand(Band: TfrxBand)', CallMethod);
+ AddMethod('procedure StopReport', CallMethod);
+ AddMethod('function FreeSpace: Double', CallMethod);
+ AddMethod('function GetAnchorPage(const Text: String): Integer', CallMethod);
+ end;
+ AddClass(TfrxEngine, 'TfrxCustomEngine');
+ with AddClass(TfrxCustomOutline, 'TPersistent') do
+ begin
+ AddMethod('procedure AddItem(const Text: String)', CallMethod);
+ AddMethod('procedure LevelRoot', CallMethod);
+ AddMethod('procedure LevelUp', CallMethod);
+ end;
+ AddClass(TfrxOutline, 'TfrxCustomOutline');
+
+ AddMethod('function DayOf(Date: TDateTime): Integer', CallMethod, 'ctDate');
+ AddMethod('function MonthOf(Date: TDateTime): Integer', CallMethod, 'ctDate');
+ AddMethod('function YearOf(Date: TDateTime): Integer', CallMethod, 'ctDate');
+
+ { note: these functions don't have implementation here. They are implemented
+ in the frxClass.pas unit }
+ AddMethod('function IIF(Expr: Boolean; TrueValue, FalseValue: Variant): Variant',
+ CallMethod, 'ctOther');
+ AddMethod('function SUM(Expr: Variant; Band: Variant = 0; Flags: Integer = 0): Variant',
+ CallMethod, 'ctAggregate');
+ AddMethod('function AVG(Expr: Variant; Band: Variant = 0; Flags: Integer = 0): Variant',
+ CallMethod, 'ctAggregate');
+ AddMethod('function MIN(Expr: Variant; Band: Variant = 0; Flags: Integer = 0): Variant',
+ CallMethod, 'ctAggregate');
+ AddMethod('function MAX(Expr: Variant; Band: Variant = 0; Flags: Integer = 0): Variant',
+ CallMethod, 'ctAggregate');
+ AddMethod('function COUNT(Band: Variant = 0; Flags: Integer = 0): Variant',
+ CallMethod, 'ctAggregate');
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ _TfrxDataSet: TfrxDataSet;
+ _TStrings: TWideStrings;
+begin
+ Result := 0;
+ if ClassType = TWideStrings then
+ begin
+ _TStrings := TWideStrings(Instance);
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TWideStringList.Create)
+ else if MethodName = 'ADD' then
+ Result := _TStrings.Add(Caller.Params[0])
+ else if MethodName = 'ADDOBJECT' then
+ Result := _TStrings.AddObject(Caller.Params[0], TObject(frxInteger(Caller.Params[1])))
+ else if MethodName = 'CLEAR' then
+ _TStrings.Clear
+ else if MethodName = 'DELETE' then
+ _TStrings.Delete(Caller.Params[0])
+ else if MethodName = 'INDEXOF' then
+ Result := _TStrings.IndexOf(Caller.Params[0])
+ else if MethodName = 'INSERT' then
+ _TStrings.Insert(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'LOADFROMFILE' then
+ _TStrings.LoadFromFile(Caller.Params[0], TEncoding.Unicode)
+ else if MethodName = 'LOADFROMSTREAM' then
+ _TStrings.LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVETOFILE' then
+ _TStrings.SaveToFile(Caller.Params[0])
+ else if MethodName = 'SAVETOSTREAM' then
+ _TStrings.SaveToStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'OBJECTS.GET' then
+ Result := frxInteger(_TStrings.Objects[Caller.Params[0]])
+ else if MethodName = 'OBJECTS.SET' then
+ _TStrings.Objects[Caller.Params[0]] := TObject(frxInteger(Caller.Params[1]))
+ else if MethodName = 'STRINGS.GET' then
+ Result := _TStrings.Strings[Caller.Params[0]]
+ else if MethodName = 'STRINGS.SET' then
+ _TStrings.Strings[Caller.Params[0]] := Caller.Params[1]
+ end
+ else if ClassType = TfrxDataSet then
+ begin
+ _TfrxDataSet := TfrxDataSet(Instance);
+ if MethodName = 'OPEN' then
+ _TfrxDataSet.Open
+ else if MethodName = 'CLOSE' then
+ _TfrxDataSet.Close
+ else if MethodName = 'FIRST' then
+ _TfrxDataSet.First
+ else if MethodName = 'NEXT' then
+ _TfrxDataSet.Next
+ else if MethodName = 'PRIOR' then
+ _TfrxDataSet.Prior
+ else if MethodName = 'EOF' then
+ Result := _TfrxDataSet.Eof
+ else if MethodName = 'FIELDSCOUNT' then
+ Result := _TfrxDataSet.FieldsCount
+ else if MethodName = 'RECORDCOUNT' then
+ Result := _TfrxDataSet.RecordCount
+ else if MethodName = 'HASFIELD' then
+ Result := _TfrxDataSet.HasField(Caller.Params[0])
+ else if MethodName = 'ISBLOBFIELD' then
+ Result := _TfrxDataSet.IsBlobField(Caller.Params[0])
+ else if MethodName = 'GETFIELDLIST' then
+ _TfrxDataSet.GetFieldList(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'DISPLAYTEXT.GET' then
+ Result := _TfrxDataSet.DisplayText[Caller.Params[0]]
+ else if MethodName = 'DISPLAYWIDTH.GET' then
+ Result := _TfrxDataSet.DisplayWidth[Caller.Params[0]]
+ else if MethodName = 'FIELDTYPE.GET' then
+ Result := _TfrxDataSet.FieldType[Caller.Params[0]]
+ else if MethodName = 'VALUE.GET' then
+ Result := _TfrxDataSet.Value[Caller.Params[0]]
+ end
+ else if ClassType = TfrxComponent then
+ begin
+ if MethodName = 'CLEAR' then
+ TfrxComponent(Instance).Clear
+ else if MethodName = 'FINDOBJECT' then
+ Result := frxInteger(TfrxComponent(Instance).FindObject(Caller.Params[0]))
+ else if MethodName = 'LOADFROMSTREAM' then
+ TfrxComponent(Instance).LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVETOSTREAM' then
+ TfrxComponent(Instance).SaveToStream(TStream(frxInteger(Caller.Params[0])), Caller.Params[1])
+ else if MethodName = 'SETBOUNDS' then
+ TfrxComponent(Instance).SetBounds(Caller.Params[0], Caller.Params[1], Caller.Params[2], Caller.Params[3])
+ end
+ else if ClassType = TfrxDialogControl then
+ begin
+ if MethodName = 'SETFOCUS' then
+ if TfrxDialogControl(Instance).Control is TControl then
+ TControl(TfrxDialogControl(Instance).Control).SetFocus;
+ end
+ else if ClassType = TfrxStretcheable then
+ begin
+ if MethodName = 'CALCHEIGHT' then
+ Result := TfrxStretcheable(Instance).CalcHeight
+ end
+ else if ClassType = TfrxCustomMemoView then
+ begin
+ if MethodName = 'CALCWIDTH' then
+ Result := TfrxCustomMemoView(Instance).CalcWidth
+ end
+ else if ClassType = TfrxPictureView then
+ begin
+ if MethodName = 'LOADFROMFILE' then
+ TfrxPictureView(Instance).Picture.LoadFromFile(Caller.Params[0])
+ end
+ else if ClassType = TfrxDialogPage then
+ begin
+ if MethodName = 'SHOWMODAL' then
+ Result := TfrxDialogPage(Instance).ShowModal
+ end
+ else if ClassType = TfrxVariables then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TfrxVariables(Instance).Create)
+ else if MethodName = 'VARIABLES.GET' then
+ Result := TfrxVariables(Instance).Variables[Caller.Params[0]]
+ else if MethodName = 'VARIABLES.SET' then
+ TfrxVariables(Instance).Variables[Caller.Params[0]] := Caller.Params[1]
+ end
+ else if ClassType = TfrxArray then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TfrxArray(Instance).Create)
+ else if MethodName = 'VARIABLES.GET' then
+ Result := TfrxArray(Instance).Variables[Caller.Params[0]]
+ else if MethodName = 'VARIABLES.SET' then
+ TfrxArray(Instance).Variables[Caller.Params[0]] := Caller.Params[1]
+ end
+ else if ClassType = TfrxReport then
+ begin
+ if MethodName = 'CALC' then
+ Result := TfrxReport(Instance).Calc(Caller.Params[0], TfsScript(1))
+ else if MethodName = 'GETDATASET' then
+ Result := frxInteger(TfrxReport(Instance).GetDataset(Caller.Params[0]))
+ else if MethodName = 'LOADFROMFILE' then
+ Result := TfrxReport(Instance).LoadFromFile(Caller.Params[0])
+ else if MethodName = 'SAVETOFILE' then
+ TfrxReport(Instance).SaveToFile(Caller.Params[0])
+ else if MethodName = 'SHOWREPORT' then
+ TfrxReport(Instance).ShowReport
+ end
+ else if ClassType = TfrxCustomEngine then
+ begin
+ if MethodName = 'ADDANCHOR' then
+ TfrxPreviewPages(TfrxCustomEngine(Instance).PreviewPages).AddAnchor(Caller.Params[0])
+ else if MethodName = 'GETANCHORPAGE' then
+ Result := TfrxPreviewPages(TfrxCustomEngine(Instance).PreviewPages).GetAnchorPage(Caller.Params[0])
+ else if MethodName = 'NEWPAGE' then
+ TfrxCustomEngine(Instance).NewPage
+ else if MethodName = 'NEWCOLUMN' then
+ TfrxCustomEngine(Instance).NewColumn
+ else if MethodName = 'FREESPACE' then
+ Result := TfrxCustomEngine(Instance).FreeSpace
+ else if MethodName = 'SHOWBAND' then
+ TfrxCustomEngine(Instance).ShowBand(TfrxBand(frxInteger(Caller.Params[0])))
+ else if MethodName = 'STOPREPORT' then
+ TfrxCustomEngine(Instance).StopReport
+ end
+ else if ClassType = TfrxCustomOutline then
+ begin
+ if MethodName = 'ADDITEM' then
+ TfrxCustomOutline(Instance).AddItem(Caller.Params[0],
+ Round(TfrxCustomOutline(Instance).Engine.CurY))
+ else if MethodName = 'LEVELROOT' then
+ TfrxCustomOutline(Instance).LevelRoot
+ else if MethodName = 'LEVELUP' then
+ TfrxCustomOutline(Instance).LevelUp
+ end
+ else if ClassType = TfrxStyles then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TfrxStyles(Instance).Create(TfrxReport(frxInteger(Caller.Params[0]))))
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TfrxStyles(Instance).Items[Caller.Params[0]])
+ else if MethodName = 'ADD' then
+ Result := frxInteger(TfrxStyles(Instance).Add)
+ else if MethodName = 'FIND' then
+ Result := frxInteger(TfrxStyles(Instance).Find(Caller.Params[0]))
+ else if MethodName = 'APPLY' then
+ TfrxStyles(Instance).Apply
+ else if MethodName = 'GETLIST' then
+ TfrxStyles(Instance).GetList(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LOADFROMFILE' then
+ TfrxStyles(Instance).LoadFromFile(Caller.Params[0])
+ else if MethodName = 'LOADFROMSTREAM' then
+ TfrxStyles(Instance).LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVETOFILE' then
+ TfrxStyles(Instance).SaveToFile(Caller.Params[0])
+ else if MethodName = 'SAVETOSTREAM' then
+ TfrxStyles(Instance).SaveToStream(TStream(frxInteger(Caller.Params[0])))
+ end
+ else if MethodName = 'DAYOF' then
+ Result := StrToInt(FormatDateTime('d', Caller.Params[0]))
+ else if MethodName = 'MONTHOF' then
+ Result := StrToInt(FormatDateTime('m', Caller.Params[0]))
+ else if MethodName = 'YEAROF' then
+ Result := StrToInt(FormatDateTime('yyyy', Caller.Params[0]))
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TWideStrings then
+ begin
+ if PropName = 'COUNT' then
+ Result := TWideStrings(Instance).Count
+ else if PropName = 'TEXT' then
+ Result := TWideStrings(Instance).Text
+ end
+ else if ClassType = TfrxDataSet then
+ begin
+ if PropName = 'RECNO' then
+ Result := TfrxDataSet(Instance).RecNo
+ end
+ else if ClassType = TfrxComponent then
+ begin
+ if PropName = 'OBJECTS' then
+ Result := frxInteger(TfrxComponent(Instance).Objects)
+ else if PropName = 'ALLOBJECTS' then
+ Result := frxInteger(TfrxComponent(Instance).AllObjects)
+ else if PropName = 'PARENT' then
+ Result := frxInteger(TfrxComponent(Instance).Parent)
+ else if PropName = 'PAGE' then
+ Result := frxInteger(TfrxComponent(Instance).Page)
+ else if PropName = 'ABSLEFT' then
+ Result := TfrxComponent(Instance).AbsLeft
+ else if PropName = 'ABSTOP' then
+ Result := TfrxComponent(Instance).AbsTop
+ end
+ else if ClassType = TfrxView then
+ begin
+ if PropName = 'TAGSTR' then
+ Result := TfrxView(Instance).TagStr
+ end
+ else if ClassType = TfrxCustomMemoView then
+ begin
+ if PropName = 'TEXT' then
+ Result := TfrxMemoView(Instance).Text
+ else if PropName = 'LINES' then
+ Result := frxInteger(TfrxMemoView(Instance).Memo)
+ else if PropName = 'VALUE' then
+ Result := TfrxMemoView(Instance).Value
+ end
+ else if ClassType = TfrxBand then
+ begin
+ if PropName = 'OVERFLOW' then
+ Result := TfrxBand(Instance).Overflow
+ end
+ else if ClassType = TfrxDialogPage then
+ begin
+ if PropName = 'MODALRESULT' then
+ Result := TfrxDialogPage(Instance).ModalResult
+ end
+ else if ClassType = TfrxReport then
+ begin
+ if PropName = 'TERMINATED' then
+ Result := TfrxReport(Instance).Terminated
+ else if PropName = 'VARIABLES' then
+ Result := frxInteger(TfrxReport(Instance).Variables)
+ else if PropName = 'STYLES' then
+ Result := frxInteger(TfrxReport(Instance).Styles)
+ end
+ else if ClassType = TfrxEngineOptions then
+ begin
+ if PropName = 'DESTROYFORMS' then
+ Result := TfrxEngineOptions(Instance).DestroyForms
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TWideStrings then
+ begin
+ if PropName = 'TEXT' then
+ TWideStrings(Instance).Text := Value
+ end
+ else if ClassType = TfrxComponent then
+ begin
+ if PropName = 'PARENT' then
+ TfrxComponent(Instance).Parent := TfrxComponent(frxInteger(Value))
+ end
+ else if ClassType = TfrxView then
+ begin
+ if PropName = 'TAGSTR' then
+ TfrxView(Instance).TagStr := Value
+ end
+ else if ClassType = TfrxCustomMemoView then
+ begin
+ if PropName = 'TEXT' then
+ TfrxMemoView(Instance).Text := Value
+ else if PropName = 'LINES' then
+ TfrxMemoView(Instance).Memo.Assign(TStrings(frxInteger(Value)));
+ end
+ else if ClassType = TfrxDialogPage then
+ begin
+ if PropName = 'MODALRESULT' then
+ TfrxDialogPage(Instance).ModalResult := Value
+ end
+ else if ClassType = TfrxReport then
+ begin
+ if PropName = 'TERMINATED' then
+ TfrxReport(Instance).Terminated := Value
+ end
+ else if ClassType = TfrxEngineOptions then
+ begin
+ if PropName = 'DESTROYFORMS' then
+ TfrxEngineOptions(Instance).DestroyForms := Value
+ end
+end;
+
+
+initialization
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ if fsRTTIModules <> nil then
+ fsRTTIModules.Remove(TFunctions);
+
+end.
+
diff --git a/LibD28/FMX.frxCmapTableClass.pas b/LibD28/FMX.frxCmapTableClass.pas
new file mode 100644
index 0000000..76f9b92
--- /dev/null
+++ b/LibD28/FMX.frxCmapTableClass.pas
@@ -0,0 +1,275 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Font parser }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Aleksey Mandrykin, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCmapTableClass;
+interface
+
+uses System.SysUtils, FMX.TTFHelpers, FMX.frxTrueTypeTable;
+
+
+ type // Nested Types
+ EncodingFormats = (ByteEncoding=0, HighByteMapping=2, SegmentMapping=4, TrimmedTable=6);
+ TSmallintArray = array of Smallint;
+ TWordArray = array of Word;
+
+ TSegmentMapping = packed record
+ public segCountX2: Word;
+ public searchRange: Word;
+ public entrySelector: Word;
+ public rangeShift: Word;
+ end;
+
+ Table_CMAP = packed record
+ public TableVersion: Word;
+ public NumSubTables: Word;
+ end;
+
+ Table_Encode = packed record
+ public
+ Format: Word;
+ Length: Word;
+ Version: Word;
+ end;
+
+ Table_ByteEncodingSubTable = packed record
+ public
+ Format: Word;
+ Length: Word;
+ language: Word;
+ GlyphIndexArray: Array[0 .. 255] of Byte;
+ end;
+
+ Table_SUBMAP = packed record
+ public Platform: Word;
+ public EncodingID: Word;
+ public TableOffset: Cardinal;
+ end;
+
+
+ TCmapSubTableTable = class(TObject);
+ TCmapByteEncodingSubTable = class(TCmapSubTableTable)
+ private
+ FGlyphIndexArray: Array[0 .. 255] of Byte;
+ public
+ function GetGlyphIndex(ch: Byte): Word;
+ end;
+
+ TMappingTable = packed record
+ public
+ EndCount: TWordArray;
+ GlyphIndexArray: TWordArray;
+ idDelta: TSmallintArray;
+ idRangeOffset: TWordArray;
+ StartCount: TWordArray;
+ segment_count: Integer;
+ end;
+
+ CmapTableClass = class(TrueTypeTable)
+ // Fields
+ private
+ FByteEncodingSubTable: TCmapByteEncodingSubTable;
+ FWinCmap: TMappingTable;
+ FMacCmap: TMappingTable;
+ // Methods
+ function InternalGlyphIndex(CMapTable:TMappingTable; ch: Word): Word;
+ public
+ constructor Create(src: TrueTypeTable);
+ destructor Destroy; override;
+ public function GetGlyphIndex(ch: Word): Word;
+ private function LoadCmapSegment(segment_ptr: Pointer; segment_count: Integer): TWordArray;
+ public procedure LoadCmapTable(font: Pointer);
+ strict private function LoadSignedCmapSegment(segment_ptr: Pointer; segment_count: Integer): TSmallintArray;
+end;
+
+implementation
+
+// Methods
+constructor CmapTableClass.Create(src: TrueTypeTable);
+begin
+ inherited Create(src);
+ FWinCmap.segment_count := 0;
+ FMacCmap.segment_count := 0;
+ FWinCmap.StartCount := nil;
+ FMacCmap.StartCount := nil;
+ FWinCmap.EndCount := nil;
+ FMacCmap.EndCount := nil;
+end;
+
+destructor CmapTableClass.Destroy;
+begin
+ FreeAndNil(FByteEncodingSubTable);
+ inherited;
+end;
+
+function CmapTableClass.GetGlyphIndex(ch: Word): Word;
+begin
+{$IFDEF MACOS}
+ Result := InternalGlyphIndex(FMacCmap, ch);
+ if Result = 0 then
+ Result := InternalGlyphIndex(FWinCmap, ch);
+{$ELSE}
+ Result := InternalGlyphIndex(FWinCmap, ch);
+ if Result = 0 then
+ Result := InternalGlyphIndex(FMacCmap, ch);
+{$ENDIF}
+ if Assigned(FByteEncodingSubTable) and (Result = 0) then
+ Result := FByteEncodingSubTable.GetGlyphIndex(Byte(ch));
+end;
+
+function CmapTableClass.InternalGlyphIndex(CMapTable: TMappingTable;
+ ch: Word): Word;
+var
+ i,j: Integer;
+begin
+ Result := 0;
+ i := 0;
+ while ((i < CMapTable.segment_count)) do
+ begin
+ if (CMapTable.EndCount[i] >= ch) then
+ begin
+ if (CMapTable.StartCount[i] > ch) then
+ exit;
+ if (CMapTable.idRangeOffset[i] = 0) then
+ begin
+ Result := Word((ch + CMapTable.idDelta[i]) mod $10000);
+ exit
+ end;
+ j := Word(((CMapTable.idRangeOffset[i] div 2) +
+ (ch - CMapTable.StartCount[i])) - (CMapTable.segment_count - i));
+ Result := CMapTable.GlyphIndexArray[j];
+ exit;
+ end;
+ inc(i)
+ end;
+end;
+
+function CmapTableClass.LoadCmapSegment(segment_ptr: Pointer; segment_count: Integer): TWordArray;
+ var
+ i: Integer;
+ ptr: ^Word;
+ begin
+ ptr := segment_ptr;
+ SetLength(Result, segment_count);
+ i := 0;
+ while ((i < segment_count)) do
+ begin
+ Result[i] := TTF_Helpers.SwapUInt16(ptr^);
+ Inc(i);
+ Inc(ptr);
+ end;
+ end;
+
+ procedure CmapTableClass.LoadCmapTable(font: Pointer);
+ var
+ encode_ptr: ^Table_Encode;
+ encode: Table_Encode;
+ cmap: ^Table_CMAP;
+ j, i, subtables_count: Integer;
+ submap: Table_SUBMAP;
+ submap_ptr: ^Table_SUBMAP;
+ ByteEncodingSubTable: ^Table_ByteEncodingSubTable;
+ segment: TSegmentMapping;
+ segment_ptr: ^TSegmentMapping;
+ index_array_size: Cardinal;
+ CurCmap: ^TMappingTable;
+ begin
+ cmap := TTF_Helpers.Increment( font, self.entry.offset );
+ subtables_count := TTF_Helpers.SwapUInt16(cmap.NumSubTables);
+ submap_ptr := TTF_Helpers.Increment(cmap, SizeOf(Table_CMAP));
+ j := 0;
+ while ((j < subtables_count)) do
+ begin
+// submap := submap_ptr;
+ submap.Platform := TTF_Helpers.SwapUInt16(submap_ptr.Platform);
+ submap.EncodingID := TTF_Helpers.SwapUInt16(submap_ptr.EncodingID);
+ submap.TableOffset := TTF_Helpers.SwapUInt32(submap_ptr.TableOffset);
+ submap_ptr := TTF_Helpers.Increment(submap_ptr, SizeOf(Table_SUBMAP));
+ if ((submap.Platform in [1, 3]) and (submap.EncodingID in [0, 1])) then
+ begin
+ case submap.Platform of
+ 1: CurCmap := @FMacCmap;
+ else
+ CurCmap := @FWinCmap;
+ end;
+ encode_ptr := TTF_Helpers.Increment(cmap, submap.TableOffset);
+// encode := encode_ptr;
+ encode.Format := TTF_Helpers.SwapUInt16(encode_ptr.Format);
+ encode.Length := TTF_Helpers.SwapUInt16(encode_ptr.Length);
+ encode.Version := TTF_Helpers.SwapUInt16(encode_ptr.Version);
+ case encode.Format of
+ 0:
+ begin
+ if FByteEncodingSubTable = nil then
+ FByteEncodingSubTable := TCmapByteEncodingSubTable.Create;
+ ByteEncodingSubTable := (Pointer(encode_ptr));
+ for i := 0 to 255 do
+ FByteEncodingSubTable.FGlyphIndexArray[i] := ByteEncodingSubTable.GlyphIndexArray[i];
+ end;
+ 4:
+ begin
+ segment_ptr := TTF_Helpers.Increment(encode_ptr, SizeOf(Table_Encode));
+// segment := encode_ptr;
+ segment.segCountX2 := TTF_Helpers.SwapUInt16(segment_ptr.segCountX2);
+ segment.searchRange := TTF_Helpers.SwapUInt16(segment_ptr.searchRange);
+ segment.entrySelector := TTF_Helpers.SwapUInt16(segment_ptr.entrySelector);
+ segment.rangeShift := TTF_Helpers.SwapUInt16(segment_ptr.rangeShift);
+ CurCmap^.segment_count := (segment.segCountX2 div 2);
+
+ encode_ptr := TTF_Helpers.Increment(segment_ptr, SizeOf(TSegmentMapping));
+ CurCmap^.endCount := self.LoadCmapSegment(encode_ptr, CurCmap^.segment_count);
+ encode_ptr := TTF_Helpers.Increment(encode_ptr, (segment.segCountX2 + 2));
+ CurCmap^.startCount := self.LoadCmapSegment(encode_ptr, CurCmap^.segment_count);
+ encode_ptr := TTF_Helpers.Increment(encode_ptr, segment.segCountX2);
+ CurCmap^.idDelta := self.LoadSignedCmapSegment(encode_ptr, CurCmap^.segment_count);
+ encode_ptr := TTF_Helpers.Increment(encode_ptr, segment.segCountX2);
+ CurCmap^.idRangeOffset := self.LoadCmapSegment(encode_ptr, CurCmap^.segment_count);
+
+ index_array_size := Cardinal((8 + (4 * CurCmap^.segment_count)) * 2);
+ index_array_size := ((inherited length - index_array_size) div 2);
+ encode_ptr := TTF_Helpers.Increment(encode_ptr, segment.segCountX2);
+
+ CurCmap^.GlyphIndexArray := self.LoadCmapSegment(encode_ptr, index_array_size);
+ end;
+ end
+ end;
+ inc(j);
+ continue;
+ ;
+
+ end
+ end;
+
+ function CmapTableClass.LoadSignedCmapSegment(segment_ptr: Pointer; segment_count: Integer ): TSmallintArray;
+ var
+ i: Integer;
+ p : PWord;
+ begin
+ SetLength(Result, segment_count);
+ p := segment_ptr;
+ i := 0;
+ while ((i < segment_count)) do
+ begin
+ {$R-}
+ Result[i] := TTF_Helpers.SwapInt16(p^);
+ {$R+}
+ inc(i);
+ inc(p);
+ end;
+ end;
+
+{ TCmapByteEncodingSubTable }
+
+function TCmapByteEncodingSubTable.GetGlyphIndex(ch: Byte): Word;
+begin
+ Result := FGlyphIndexArray[ch];
+end;
+
+end.
diff --git a/LibD28/FMX.frxCodeUtils.pas b/LibD28/FMX.frxCodeUtils.pas
new file mode 100644
index 0000000..835e0b4
--- /dev/null
+++ b/LibD28/FMX.frxCodeUtils.pas
@@ -0,0 +1,271 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Code window utils }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCodeUtils;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.Classes, System.SysUtils, System.TypInfo, System.Variants;
+
+
+procedure frxGetEventHandlersList(Code: TStrings; const Language: String;
+ EventType: PTypeInfo; List: TStrings);
+function frxLocateEventHandler(Code: TStrings; const Language,
+ EventName: String): Integer;
+function frxLocateMainProc(Code: TStrings; const Language: String): Integer;
+function frxAddEvent(Code: TStrings; const Language: String;
+ EventType: PTypeInfo; const EventName: String): Integer;
+procedure frxEmptyCode(Code: TStrings; const Language: String);
+procedure frxAddCodeRes;
+
+implementation
+
+uses FMX.frxRes;
+
+procedure frxAddCodeRes;
+begin
+ with frxResources do
+ begin
+ Add('PascalScript',
+ 'proc="procedure" begin="begin" end="end;" lastend="end."'
+ + ' openquote="{" closequote="}"');
+ Add('C++Script',
+ 'proc="void" begin="{" end="}" lastend="}"'
+ + ' openquote="/*" closequote="*/"');
+ Add('BasicScript',
+ 'proc="sub" begin="" end="end sub" lastend=""'
+ + ' openquote="/\" closequote="/\"');
+ Add('JScript',
+ 'proc="function" begin="{" end="}" lastend=""'
+ + ' openquote="/*" closequote="*/"');
+
+ Add('TfrxNotifyEvent',
+ 'PascalScript=(Sender: TfrxComponent);' + #13#10 +
+ 'C++Script=(TfrxComponent Sender)' + #13#10 +
+ 'BasicScript=(Sender)' + #13#10 +
+ 'JScript=(Sender)');
+ Add('TfrxCloseQueryEvent',
+ 'PascalScript=(Sender: TfrxComponent; var CanClose: Boolean);' + #13#10 +
+ 'C++Script=(TfrxComponent Sender, bool &CanClose)' + #13#10 +
+ 'BasicScript=(Sender, byref CanClose)' + #13#10 +
+ 'JScript=(Sender, &CanClose)');
+ Add('TfrxKeyEvent',
+ 'PascalScript=(Sender: TfrxComponent; var Key: Word; Shift: Integer);' + #13#10 +
+ 'C++Script=(TfrxComponent Sender, word &Key, int Shift)' + #13#10 +
+ 'BasicScript=(Sender, byref Key, Shift)' + #13#10 +
+ 'JScript=(Sender, &Key, Shift)');
+ Add('TfrxKeyPressEvent',
+ 'PascalScript=(Sender: TfrxComponent; var Key: Char);' + #13#10 +
+ 'C++Script=(TfrxComponent Sender, char &Key)' + #13#10 +
+ 'BasicScript=(Sender, byref Key)' + #13#10 +
+ 'JScript=(Sender, &Key)');
+ Add('TfrxMouseEvent',
+ 'PascalScript=(Sender: TfrxComponent; Button: TMouseButton; Shift: Integer; X, Y: Integer);' + #13#10 +
+ 'C++Script=(TfrxComponent Sender, TMouseButton Button, int Shift, int X, int Y)' + #13#10 +
+ 'BasicScript=(Sender, Button, Shift, X, Y)' + #13#10 +
+ 'JScript=(Sender, Button, Shift, X, Y)');
+ Add('TfrxMouseMoveEvent',
+ 'PascalScript=(Sender: TfrxComponent; Shift: Integer; X, Y: Integer);' + #13#10 +
+ 'C++Script=(TfrxComponent Sender, int Shift, int X, int Y)' + #13#10 +
+ 'BasicScript=(Sender, Shift, X, Y)' + #13#10 +
+ 'JScript=(Sender, Shift, X, Y)');
+ Add('TfrxPreviewClickEvent',
+ 'PascalScript=(Sender: TfrxView; Button: TMouseButton; Shift: Integer; var Modified: Boolean);' + #13#10 +
+ 'C++Script=(TfrxView Sender, TMouseButton Button, int Shift, bool &Modified)' + #13#10 +
+ 'BasicScript=(Sender, Button, Shift, byref Modified)' + #13#10 +
+ 'JScript=(Sender, Button, Shift, &Modified)');
+ Add('TfrxRunDialogsEvent',
+ 'PascalScript=(var Result: Boolean);' + #13#10 +
+ 'C++Script=(bool &Result)' + #13#10 +
+ 'BasicScript=(byref Result)' + #13#10 +
+ 'JScript=(&Result)');
+ end;
+end;
+
+function GetLangParam(const Language, Param: String): String;
+var
+ s: String;
+ i: Integer;
+begin
+ Result := '';
+ s := frxResources.Get(Language);
+ if s = Language then Exit;
+
+ i := Pos(AnsiUppercase(Param) + '="', AnsiUppercase(s));
+ if (i <> 0) and ((i = 1) or (s[i - 1] = ' ')) then
+ begin
+ Result := Copy(s, i + Length(Param + '="'), MaxInt);
+ Result := Copy(Result, 1, Pos('"', Result) - 1);
+ end;
+end;
+
+function GetEventParams(EventType: PTypeInfo; const Language: String): String;
+var
+ s: String;
+ sl: TStringList;
+begin
+ Result := '';
+ s := frxResources.Get(String(EventType.Name));
+ if s = String(EventType.Name) then Exit;
+
+ sl := TStringList.Create;
+ sl.Text := s;
+ Result := sl.Values[Language];
+ sl.Free;
+end;
+
+procedure frxGetEventHandlersList(Code: TStrings; const Language: String;
+ EventType: PTypeInfo; List: TStrings);
+var
+ i, InComment: Integer;
+ s, EventName, EventWord, EventParams, OpenQuote, CloseQuote: String;
+begin
+ List.Clear;
+ EventParams := GetEventParams(EventType, Language);
+ EventWord := AnsiUppercase(GetLangParam(Language, 'proc'));
+ OpenQuote := GetLangParam(Language, 'openquote');
+ CloseQuote := GetLangParam(Language, 'closequote');
+ InComment := 0;
+
+ for i := 0 to Code.Count - 1 do
+ begin
+ s := Code[i];
+ if Pos(CloseQuote, Code[i]) <> 0 then
+ Dec(InComment);
+ if Pos(OpenQuote, Code[i]) <> 0 then
+ Inc(InComment);
+ if (Pos(EventWord, AnsiUppercase(s)) = 1) and (InComment = 0) then
+ begin
+ { delete the "procedure" word }
+ Delete(s, 1, Length(EventWord));
+ { extract the event name and params }
+ EventName := Trim(Copy(s, 1, Pos('(', s) - 1));
+ s := Trim(Copy(s, Pos('(', s), 255));
+ { compare the params }
+ if AnsiCompareText(s, EventParams) = 0 then
+ List.Add(EventName);
+ end;
+ end;
+end;
+
+function frxLocateEventHandler(Code: TStrings; const Language,
+ EventName: String): Integer;
+var
+ i, InComment: Integer;
+ s, OpenQuote, CloseQuote: String;
+begin
+ Result := -1;
+ OpenQuote := GetLangParam(Language, 'openquote');
+ CloseQuote := GetLangParam(Language, 'closequote');
+ InComment := 0;
+ s := UpperCase(GetLangParam(Language, 'proc') + ' ' + EventName + '(');
+
+ for i := 0 to Code.Count - 1 do
+ begin
+ if Pos(CloseQuote, Code[i]) <> 0 then
+ Dec(InComment);
+ if Pos(OpenQuote, Code[i]) <> 0 then
+ Inc(InComment);
+ if (Pos(s, UpperCase(Code[i])) = 1) and (InComment = 0) then
+ begin
+ Result := i;
+ break;
+ end;
+ end;
+end;
+
+function frxLocateMainProc(Code: TStrings; const Language: String): Integer;
+var
+ i, endCount, InComment: Integer;
+ s, BeginStr, EndStr: String;
+ OpenQuote, CloseQuote: String;
+begin
+ Result := -1;
+
+ BeginStr := GetLangParam(Language, 'begin');
+ EndStr := GetLangParam(Language, 'lastend');
+ OpenQuote := GetLangParam(Language, 'openquote');
+ CloseQuote := GetLangParam(Language, 'closequote');
+
+ if EndStr = '' then
+ begin
+ Result := Code.Count - 1;
+ Exit;
+ end;
+
+ i := Code.Count - 1;
+ InComment := 0;
+ while i >= 0 do
+ begin
+ s := AnsiUpperCase(Code[i]);
+ Dec(i);
+ if Pos(CloseQuote, s) <> 0 then
+ Inc(InComment);
+ if Pos(OpenQuote, s) <> 0 then
+ Dec(InComment);
+
+ if (Pos(AnsiUpperCase(EndStr), s) <> 0) and (InComment = 0) then
+ break;
+ end;
+
+ if i < 0 then Exit;
+
+ EndStr := GetLangParam(Language, 'end');
+ endCount := 1;
+ while (i >= 0) and (endCount <> 0) do
+ begin
+ s := AnsiUpperCase(Code[i]);
+ if Pos(AnsiUpperCase(EndStr), s) <> 0 then
+ Inc(endCount);
+ if Pos(AnsiUpperCase(BeginStr), s) <> 0 then
+ Dec(endCount);
+ Dec(i);
+ end;
+
+ Result := i + 1;
+end;
+
+function frxAddEvent(Code: TStrings; const Language: String;
+ EventType: PTypeInfo; const EventName: String): Integer;
+var
+ MainProcIndex: Integer;
+begin
+ Result := -1;
+ MainProcIndex := frxLocateMainProc(Code, Language);
+ if MainProcIndex = -1 then Exit;
+
+ Code.Insert(MainProcIndex, GetLangParam(Language, 'proc') + ' ' + EventName +
+ GetEventParams(EventType, Language));
+ Code.Insert(MainProcIndex + 1, GetLangParam(Language, 'begin'));
+ Code.Insert(MainProcIndex + 2, '');
+ Code.Insert(MainProcIndex + 3, GetLangParam(Language, 'end'));
+ Code.Insert(MainProcIndex + 4, '');
+ Result := MainProcIndex + 3;
+end;
+
+procedure frxEmptyCode(Code: TStrings; const Language: String);
+begin
+ Code.Clear;
+ if GetLangParam(Language, 'lastend') <> '' then
+ begin
+ Code.Add(GetLangParam(Language, 'begin'));
+ Code.Add('');
+ Code.Add(GetLangParam(Language, 'lastend'));
+ end;
+end;
+
+
+
+end.
diff --git a/LibD28/FMX.frxConnWizard.fmx b/LibD28/FMX.frxConnWizard.fmx
new file mode 100644
index 0000000..b80197b
--- /dev/null
+++ b/LibD28/FMX.frxConnWizard.fmx
@@ -0,0 +1,249 @@
+object frxConnectionWizardForm: TfrxConnectionWizardForm
+ Left = 0
+ Top = 0
+ BorderIcons = [biSystemMenu]
+ BorderStyle = bsSingle
+ Caption = 'Connection Wizard'
+ ClientHeight = 307
+ ClientWidth = 300
+ Position = poScreenCenter
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ OnClose = FormClose
+ object OKB: TButton
+ Default = True
+ DisableFocusEffect = False
+ Height = 25.000000000000000000
+ ModalResult = 1
+ Position.X = 140.000000000000000000
+ Position.Y = 276.000000000000000000
+ Width = 75.000000000000000000
+ OnClick = OKBClick
+ end
+ object CancelB: TButton
+ DisableFocusEffect = False
+ Height = 25.000000000000000000
+ ModalResult = 2
+ Position.X = 220.000000000000000000
+ Position.Y = 276.000000000000000000
+ Width = 75.000000000000000000
+ end
+ object PageControl1: TTabControl
+ Height = 265.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 4.000000000000000000
+ TabIndex = 0
+ Width = 293.000000000000000000
+ object ConnTS: TTabItem
+ WordWrap = False
+ Height = 24.000000000000000000
+ Position.X = 1.000000000000000000
+ Text = 'ConnTS'
+ Width = 57.000000000000000000
+ object ConnL1: TLabel
+ Height = 13.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 4.000000000000000000
+ Width = 205.000000000000000000
+ end
+ object DBL: TLabel
+ Height = 13.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 60.000000000000000000
+ Width = 269.000000000000000000
+ end
+ object LoginL: TLabel
+ Height = 13.000000000000000000
+ Position.X = 20.000000000000000000
+ Position.Y = 164.000000000000000000
+ Width = 93.000000000000000000
+ end
+ object PasswordL: TLabel
+ Height = 13.000000000000000000
+ Position.X = 20.000000000000000000
+ Position.Y = 188.000000000000000000
+ Width = 93.000000000000000000
+ end
+ object ChooseB: TSpeedButton
+ Height = 22.000000000000000000
+ Position.X = 256.000000000000000000
+ Position.Y = 80.000000000000000000
+ Text = '...'
+ Width = 23.000000000000000000
+ OnClick = ChooseBClick
+ end
+ object ConnCB: TComboBox
+ DisableFocusEffect = False
+ Height = 21.000000000000000000
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ ListBoxResource = 'transparentlistboxstyle'
+ Position.X = 16.000000000000000000
+ Position.Y = 24.000000000000000000
+ TabOrder = 0
+ Width = 157.000000000000000000
+ OnClick = ConnCBClick
+ end
+ object DatabaseE: TEdit
+ TabOrder = 1
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ Password = False
+ Position.X = 16.000000000000000000
+ Position.Y = 80.000000000000000000
+ Width = 237.000000000000000000
+ Height = 21.000000000000000000
+ end
+ object LoginE: TEdit
+ TabOrder = 2
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ Password = False
+ Position.X = 116.000000000000000000
+ Position.Y = 160.000000000000000000
+ Width = 121.000000000000000000
+ Height = 21.000000000000000000
+ end
+ object PasswordE: TEdit
+ TabOrder = 3
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ Password = False
+ Position.X = 116.000000000000000000
+ Position.Y = 184.000000000000000000
+ Width = 121.000000000000000000
+ Height = 21.000000000000000000
+ end
+ object PromptRB: TRadioButton
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ IsChecked = True
+ Position.X = 4.000000000000000000
+ Position.Y = 116.000000000000000000
+ TabOrder = 4
+ Width = 245.000000000000000000
+ end
+ object LoginRB: TRadioButton
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 136.000000000000000000
+ TabOrder = 5
+ Width = 245.000000000000000000
+ end
+ end
+ object TableTS: TTabItem
+ WordWrap = False
+ Height = 24.000000000000000000
+ Text = 'TableTS'
+ Width = 58.000000000000000000
+ object ConnL2: TLabel
+ Height = 13.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 4.000000000000000000
+ Width = 205.000000000000000000
+ end
+ object TableL: TLabel
+ Height = 13.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 60.000000000000000000
+ Width = 189.000000000000000000
+ end
+ object ConnCB1: TComboBox
+ DisableFocusEffect = False
+ Height = 21.000000000000000000
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ ListBoxResource = 'transparentlistboxstyle'
+ Position.X = 16.000000000000000000
+ Position.Y = 24.000000000000000000
+ TabOrder = 0
+ Width = 157.000000000000000000
+ OnClick = ConnCB1Click
+ end
+ object TableCB: TComboBox
+ DisableFocusEffect = False
+ Height = 21.000000000000000000
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ ListBoxResource = 'transparentlistboxstyle'
+ Position.X = 16.000000000000000000
+ Position.Y = 80.000000000000000000
+ TabOrder = 1
+ Width = 157.000000000000000000
+ end
+ object FilterCB: TCheckBox
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 116.000000000000000000
+ TabOrder = 2
+ Width = 225.000000000000000000
+ end
+ object FilterE: TEdit
+ TabOrder = 3
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ Password = False
+ Position.X = 16.000000000000000000
+ Position.Y = 140.000000000000000000
+ Width = 157.000000000000000000
+ Height = 21.000000000000000000
+ end
+ end
+ object QueryTS: TTabItem
+ WordWrap = False
+ Height = 24.000000000000000000
+ Text = 'QueryTS'
+ Width = 61.000000000000000000
+ object ConnL3: TLabel
+ Height = 13.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 4.000000000000000000
+ Width = 173.000000000000000000
+ end
+ object QueryL: TLabel
+ Height = 13.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 60.000000000000000000
+ Width = 75.000000000000000000
+ end
+ object ConnCB2: TComboBox
+ DisableFocusEffect = False
+ Height = 21.000000000000000000
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ ListBoxResource = 'transparentlistboxstyle'
+ Position.X = 16.000000000000000000
+ Position.Y = 24.000000000000000000
+ TabOrder = 0
+ Width = 157.000000000000000000
+ OnClick = ConnCB2Click
+ end
+ object ToolBar1: TToolBar
+ Align = alNone
+ Height = 29.000000000000000000
+ Position.X = 232.000000000000000000
+ Position.Y = 48.000000000000000000
+ TabOrder = 1
+ Width = 53.000000000000000000
+ object BuildSQLB: TfrxToolButton
+ Height = 24.000000000000000000
+ Position.X = 3.000000000000000000
+ Position.Y = 4.000000000000000000
+ Text = 'BuildSQLB'
+ Width = 24.000000000000000000
+ Hint = ''
+ end
+ object ParamsB: TfrxToolButton
+ Height = 24.000000000000000000
+ Position.X = 27.000000000000000000
+ Position.Y = 4.000000000000000000
+ Text = 'ParamsB'
+ Width = 24.000000000000000000
+ Hint = ''
+ end
+ end
+ end
+ end
+end
diff --git a/LibD28/FMX.frxConnWizard.pas b/LibD28/FMX.frxConnWizard.pas
new file mode 100644
index 0000000..9b4a4b9
--- /dev/null
+++ b/LibD28/FMX.frxConnWizard.pas
@@ -0,0 +1,551 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ DB Connection wizard }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxConnWizard;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Controls, FMX.Forms,
+ FMX.Dialogs, FMX.frxFMX, System.UITypes, System.UIConsts,
+ FMX.frxClass, FMX.fs_SynMemo, FMX.frxCustomDB, FMX.Types,
+ System.Variants, FMX.TabControl, FMX.Edit, FMX.ListBox
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF QBUILDER}
+, FMX.fqbClass
+{$ENDIF};
+
+type
+ TfrxDBConnWizard = class(TfrxCustomWizard)
+ private
+ FDatabase: TfrxCustomDatabase;
+ public
+ class function GetDescription: String; override;
+ function Execute: Boolean; override;
+ property Database: TfrxCustomDatabase read FDatabase write FDatabase;
+ end;
+
+ TfrxDBTableWizard = class(TfrxCustomWizard)
+ public
+ class function GetDescription: String; override;
+ function Execute: Boolean; override;
+ end;
+
+ TfrxDBQueryWizard = class(TfrxCustomWizard)
+ public
+ class function GetDescription: String; override;
+ function Execute: Boolean; override;
+ end;
+
+ TfrxConnectionWizardForm = class(TForm)
+ OKB: TButton;
+ CancelB: TButton;
+ PageControl1: TTabControl;
+ ConnTS: TTabItem;
+ TableTS: TTabItem;
+ ConnL1: TLabel;
+ DBL: TLabel;
+ LoginL: TLabel;
+ PasswordL: TLabel;
+ ChooseB: TSpeedButton;
+ ConnCB: TComboBox;
+ DatabaseE: TEdit;
+ LoginE: TEdit;
+ PasswordE: TEdit;
+ PromptRB: TRadioButton;
+ LoginRB: TRadioButton;
+ ConnL2: TLabel;
+ ConnCB1: TComboBox;
+ TableL: TLabel;
+ TableCB: TComboBox;
+ FilterCB: TCheckBox;
+ FilterE: TEdit;
+ QueryTS: TTabItem;
+ ConnL3: TLabel;
+ ConnCB2: TComboBox;
+ QueryL: TLabel;
+ ToolBar1: TToolBar;
+ BuildSQLB: TfrxToolButton;
+ ParamsB: TfrxToolButton;
+ procedure FormCreate(Sender: TObject);
+ procedure ChooseBClick(Sender: TObject);
+ procedure ConnCBClick(Sender: TObject);
+ procedure FormHide(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure ConnCB1Click(Sender: TObject);
+ procedure ConnCB2Click(Sender: TObject);
+ procedure BuildSQLBClick(Sender: TObject);
+ procedure ParamsBClick(Sender: TObject);
+ procedure OKBClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ FComponent: TfrxComponent;
+ FDatabase: TfrxCustomDatabase;
+ FDesigner: TfrxCustomDesigner;
+ FItem: Integer;
+ FItemIndex: Integer;
+ FMemo: TfsSyntaxMemo;
+ FOldItem: Integer;
+ FPage: TfrxPage;
+ FQuery: TfrxCustomQuery;
+ FReport: TfrxReport;
+ FTable: TfrxCustomTable;
+ public
+ { Public declarations }
+ end;
+
+
+implementation
+
+
+{$R *.FMX}
+{$R *.res}
+
+uses FMX.frxUtils, FMX.frxDsgnIntf, FMX.frxRes, FMX.frxEditQueryParams, FMX.frxBaseModalForm;
+
+const
+ dbiConnection = 0;
+ dbiTable = 1;
+ dbiQuery = 2;
+
+
+{ TfrxDBConnWizard }
+
+class function TfrxDBConnWizard.GetDescription: String;
+begin
+ Result := frxResources.Get('wzDBConn');
+end;
+
+function TfrxDBConnWizard.Execute: Boolean;
+begin
+ with TfrxConnectionWizardForm.Create(Owner) do
+ begin
+ FDesigner := Self.Designer;
+ FReport := Report;
+ FItem := dbiConnection;
+ FDatabase := Self.FDatabase;
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ FDesigner.PeekLastModalResult;
+ Free;
+ end;
+end;
+
+
+{ TfrxDBTableWizard }
+
+class function TfrxDBTableWizard.GetDescription: String;
+begin
+ Result := frxResources.Get('wzDBTable');
+end;
+
+function TfrxDBTableWizard.Execute: Boolean;
+begin
+ with TfrxConnectionWizardForm.Create(Owner) do
+ begin
+ FDesigner := Self.Designer;
+ FReport := Report;
+ FItem := dbiTable;
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ FDesigner.PeekLastModalResult;
+ Free;
+ end;
+end;
+
+
+{ TfrxDBQueryWizard }
+
+class function TfrxDBQueryWizard.GetDescription: String;
+begin
+ Result := frxResources.Get('wzDBQuery');
+end;
+
+function TfrxDBQueryWizard.Execute: Boolean;
+begin
+ with TfrxConnectionWizardForm.Create(Owner) do
+ begin
+ FDesigner := Self.Designer;
+ FReport := Report;
+ FItem := dbiQuery;
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ FDesigner.PeekLastModalResult;
+ Free;
+ end;
+end;
+
+
+{ TfrxConnectionWizardForm }
+
+procedure TfrxConnectionWizardForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ FormHide(Self);
+end;
+
+procedure TfrxConnectionWizardForm.FormCreate(Sender: TObject);
+var
+ i: Integer;
+begin
+ Caption := frxGet(5700);
+ OKB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ ConnTS.Text := frxGet(5701);
+ ConnL1.Text := frxGet(5702);
+ ConnL2.Text := ConnL1.Text;
+ ConnL3.Text := ConnL1.Text;
+ DBL.Text := frxGet(5703);
+ LoginL.Text := frxGet(5704);
+ PasswordL.Text := frxGet(5705);
+ PromptRB.Text := frxGet(5706);
+ LoginRB.Text := frxGet(5707);
+ TableTS.Text := frxGet(5708);
+ TableL.Text := frxGet(5709);
+ FilterCB.Text := frxGet(5710);
+ QueryTS.Text := frxGet(5711);
+ QueryL.Text := frxGet(5712);
+ BuildSQLB.Hint := frxGet(5713);
+ ParamsB.Hint := frxGet(5714);
+
+ //Toolbar1.Images := frxResources.MainButtonImages;
+
+ frxResources.LoadImageFromResouce(BuildSQLB.Bitmap, 5, 8);
+ frxResources.LoadImageFromResouce(ParamsB.Bitmap, 5, 6);
+
+ FOldItem := dbiConnection;
+ FMemo := TfsSyntaxMemo.Create(Self);
+ with FMemo do
+ begin
+ Parent := QueryTS;
+ SetBounds(16, 80, 265, 153);
+ SyntaxType := stSQL;
+ ShowGutter := False;
+ Fill.Color := claWhite;
+
+{$I frxEditSQL.inc}
+ end;
+
+{$IFNDEF QBUILDER}
+ BuildSQLB.Visible := False;
+{$ENDIF}
+
+ ConnCB1.Items.Add(frxResources.Get('prNotAssigned'));
+ ConnCB2.Items.Add(frxResources.Get('prNotAssigned'));
+ for i := 0 to frxObjects.Count - 1 do
+ if frxObjects[i].ClassRef <> nil then
+ if frxObjects[i].ClassRef.InheritsFrom(TfrxCustomDatabase) then
+ ConnCB.Items.AddObject(frxObjects[i].ClassRef.GetDescription, Pointer(i))
+ else if frxObjects[i].ClassRef.InheritsFrom(TfrxCustomTable) then
+ ConnCB1.Items.AddObject(frxObjects[i].ClassRef.GetDescription, Pointer(i))
+ else if frxObjects[i].ClassRef.InheritsFrom(TfrxCustomQuery) then
+ ConnCB2.Items.AddObject(frxObjects[i].ClassRef.GetDescription, Pointer(i));
+
+// if UseRightToLeftAlignment then
+// FlipChildren(True);
+end;
+
+procedure TfrxConnectionWizardForm.FormShow(Sender: TObject);
+var
+ i: Integer;
+begin
+ FPage := FReport.Pages[0];
+
+ if FItem = dbiConnection then
+ begin
+ PageControl1.ActiveTab := ConnTS;
+ ConnTS.Visible := True;
+ TableTS.Visible := False;
+ QueryTS.Visible := False;
+ if FDatabase <> nil then
+ begin
+ for i := 0 to ConnCB.Items.Count - 1 do
+ if frxObjects[frxInteger(ConnCB.Items.Objects[i])].ClassRef = FDatabase.ClassType then
+ begin
+ ConnCB.ItemIndex := i;
+ break;
+ end;
+ ConnCB.Enabled := False;
+ DatabaseE.Text := FDatabase.DatabaseName;
+ end
+ else
+ begin
+ if (FItem <> dbiConnection) and (ConnCB.Items.Count > 1) then
+ ConnCB.ItemIndex := 1
+ else
+ ConnCB.ItemIndex := 0;
+ ConnCBClick(nil);
+ end;
+ end
+ else if FItem = dbiTable then
+ begin
+ PageControl1.ActiveTab := TableTS;
+ ConnTS.Visible := False;
+ TableTS.Visible := True;
+ QueryTS.Visible := False;
+ if FItemIndex <> 0 then
+ ConnCB1.ItemIndex := FItemIndex
+ else if ConnCB1.Items.Count > 1 then
+ ConnCB1.ItemIndex := 1
+ else
+ ConnCB1.ItemIndex := 0;
+ ConnCB1Click(nil);
+ end
+ else if FItem = dbiQuery then
+ begin
+ PageControl1.ActiveTab := QueryTS;
+ ConnTS.Visible := False;
+ TableTS.Visible := False;
+ QueryTS.Visible := True;
+ if FItemIndex <> 0 then
+ ConnCB2.ItemIndex := FItemIndex
+ else if ConnCB2.Items.Count > 1 then
+ ConnCB2.ItemIndex := 1
+ else
+ ConnCB2.ItemIndex := 0;
+ ConnCB2Click(nil);
+ end;
+end;
+
+procedure TfrxConnectionWizardForm.FormHide(Sender: TObject);
+begin
+ if FItem = dbiConnection then
+ begin
+ FComponent := FDatabase;
+ if ConnCB.Enabled = False then
+ FComponent := nil;
+ end
+ else if FItem = dbiTable then
+ FComponent := FTable
+ else if FItem = dbiQuery then
+ FComponent := FQuery;
+
+ if FComponent <> nil then
+ if ModalResult = mrCancel then
+ FComponent.Free
+ else
+ begin
+ FComponent.CreateUniqueName;
+ FDesigner.ReloadReport;
+ end;
+end;
+
+procedure TfrxConnectionWizardForm.OKBClick(Sender: TObject);
+begin
+ if FItem = dbiConnection then
+ begin
+ if FDatabase = nil then Exit;
+ FDatabase.DatabaseName := DatabaseE.Text;
+ if PromptRB.IsChecked then
+ FDatabase.LoginPrompt := True
+ else
+ begin
+ FDatabase.LoginPrompt := False;
+ FDatabase.SetLogin(LoginE.Text, PasswordE.Text);
+ end;
+ FComponent := FDatabase;
+ if ConnCB.Items.Count > ConnCB.ItemIndex + 1 then
+ FItemIndex := ConnCB.ItemIndex + 1;
+ end
+ else if FItem = dbiTable then
+ begin
+ if FTable = nil then Exit;
+ if TableCB.Selected <> nil then
+ FTable.TableName := TableCB.Selected.Text;
+ FTable.Filter := FilterE.Text;
+ FTable.Filtered := FilterCB.IsChecked;
+ FComponent := FTable;
+ end
+ else if FItem = dbiQuery then
+ begin
+ if FQuery = nil then Exit;
+ FQuery.SQL.Assign(FMemo.Lines);
+ FComponent := FQuery;
+ end;
+
+ if FOldItem <> dbiConnection then
+ begin
+ FComponent.CreateUniqueName;
+ FItem := FOldItem;
+ FOldItem := dbiConnection;
+ ModalResult := mrNone;
+ FormShow(nil);
+ end;
+end;
+
+procedure TfrxConnectionWizardForm.ConnCBClick(Sender: TObject);
+var
+ ClassRef: TClass;
+begin
+ if FDatabase <> nil then
+ begin
+ FDatabase.Free;
+ FDatabase := nil;
+ end;
+ ClassRef := frxObjects[frxInteger(ConnCB.Items.Objects[ConnCB.ItemIndex])].ClassRef;
+ FDatabase := TfrxCustomDatabase(ClassRef.NewInstance);
+ FDatabase.Create(FPage);
+ FDatabase.SetBounds((FPage.Objects.Count - 1) * 100 + 30, 20, 32, 32);
+end;
+
+procedure TfrxConnectionWizardForm.ConnCB1Click(Sender: TObject);
+var
+ i: Integer;
+ ClassRef: TClass;
+ propList: TfrxPropertyList;
+begin
+ if FTable <> nil then
+ begin
+ FTable.Free;
+ FTable := nil;
+ end;
+ if ConnCB1.ItemIndex = 0 then Exit;
+
+ ClassRef := frxObjects[frxInteger(ConnCB1.Items.Objects[ConnCB1.ItemIndex])].ClassRef;
+ FTable := TfrxCustomTable(ClassRef.NewInstance);
+ FTable.DesignCreate(FPage, 0);
+ FTable.SetBounds((FPage.Objects.Count - 1) * 100 + 30, 20, 32, 32);
+
+ propList := TfrxPropertyList.Create(nil);
+ propList.Component := FTable;
+ for i := 0 to propList.Count - 1 do
+ if propList[i].Editor.GetName = 'TableName' then
+ begin
+ propList[i].Editor.GetValues;
+ TableCB.Items := propList[i].Editor.Values;
+ end;
+ propList.Free;
+
+ if not FTable.DBConnected then
+ begin
+ FTable.Free;
+ FTable := nil;
+ FOldItem := FItem;
+ FItem := dbiConnection;
+ FItemIndex := ConnCB1.ItemIndex;
+ FormShow(nil);
+ end;
+end;
+
+procedure TfrxConnectionWizardForm.ConnCB2Click(Sender: TObject);
+var
+ ClassRef: TClass;
+begin
+ if FQuery <> nil then
+ begin
+ FQuery.Free;
+ FQuery := nil;
+ end;
+ if ConnCB2.ItemIndex = 0 then Exit;
+
+ ClassRef := frxObjects[frxInteger(ConnCB2.Items.Objects[ConnCB2.ItemIndex])].ClassRef;
+ FQuery := TfrxCustomQuery(ClassRef.NewInstance);
+ FQuery.DesignCreate(FPage, 0);
+ FQuery.SetBounds((FPage.Objects.Count - 1) * 100 + 30, 20, 32, 32);
+
+ if not FQuery.DBConnected then
+ begin
+ FQuery.Free;
+ FQuery := nil;
+ FOldItem := FItem;
+ FItem := dbiConnection;
+ FItemIndex := ConnCB2.ItemIndex;
+ FormShow(nil);
+ end;
+end;
+
+procedure TfrxConnectionWizardForm.ChooseBClick(Sender: TObject);
+var
+ i: Integer;
+ propList: TfrxPropertyList;
+begin
+ propList := TfrxPropertyList.Create(nil);
+ propList.Component := FDatabase;
+ for i := 0 to propList.Count - 1 do
+ if (CompareText(propList[i].Editor.GetName, 'DatabaseName') = 0) or
+ (CompareText(propList[i].Editor.GetName, 'ConnectionName') = 0) then
+ begin
+ propList[i].Editor.Edit;
+ DatabaseE.Text := FDatabase.DatabaseName;
+ break;
+ end;
+ propList.Free;
+
+ DatabaseE.SetFocus;
+end;
+
+procedure TfrxConnectionWizardForm.BuildSQLBClick(Sender: TObject);
+{$IFDEF QBUILDER}
+var
+ fqbDialog: TfqbDialog;
+{$ENDIF}
+begin
+{$IFDEF QBUILDER}
+ if FQuery = nil then Exit;
+ fqbDialog := TfqbDialog.Create(nil);
+ try
+ fqbDialog.Engine := FQuery.QBEngine;
+ fqbDialog.SchemaInsideSQL := False;
+ fqbDialog.SQL := FMemo.Lines.Text;
+ fqbDialog.SQLSchema := FQuery.SQLSchema;
+
+ if fqbDialog.Execute then
+ begin
+ FMemo.Lines.Text := fqbDialog.SQL;
+ FQuery.SQLSchema := fqbDialog.SQLSchema;
+ end;
+ finally
+ fqbDialog.Free;
+ end;
+{$ENDIF}
+end;
+
+procedure TfrxConnectionWizardForm.ParamsBClick(Sender: TObject);
+begin
+ if FQuery <> nil then
+ begin
+ FQuery.SQL.Assign(FMemo.Lines);
+ if FQuery.Params.Count <> 0 then
+ with TfrxParamsEditorForm.Create(FDesigner) do
+ begin
+ Params := FQuery.Params;
+ FormShow(Self);
+ if ShowModal = mrOk then
+ FQuery.UpdateParams;
+ Free;
+ end;
+ end;
+end;
+
+procedure TfrxConnectionWizardForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VK_F1 then
+ frxResources.Help(Self);
+end;
+
+
+initialization
+ frxWizards.Register1(TfrxDBConnWizard, 2);
+ frxWizards.Register1(TfrxDBTableWizard, 3);
+ frxWizards.Register1(TfrxDBQueryWizard, 4);
+
+finalization
+ frxWizards.Unregister(TfrxDBConnWizard);
+ frxWizards.Unregister(TfrxDBTableWizard);
+ frxWizards.Unregister(TfrxDBQueryWizard);
+
+end.
diff --git a/LibD28/FMX.frxConnWizard.res b/LibD28/FMX.frxConnWizard.res
new file mode 100644
index 0000000..bc19066
Binary files /dev/null and b/LibD28/FMX.frxConnWizard.res differ
diff --git a/LibD28/FMX.frxCross.pas b/LibD28/FMX.frxCross.pas
new file mode 100644
index 0000000..cc9f8ca
--- /dev/null
+++ b/LibD28/FMX.frxCross.pas
@@ -0,0 +1,4377 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Cross object }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCross;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Controls, System.UITypes, System.UIConsts, System.Types, FMX.Types, FMX.Forms,
+ FMX.frxClass, System.Variants
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxCrossObject = class(TComponent); // fake component
+
+ TfrxPrintCellEvent = type String;
+ TfrxPrintHeaderEvent = type String;
+ TfrxCalcWidthEvent = type String;
+ TfrxCalcHeightEvent = type String;
+ TfrxOnPrintCellEvent = procedure (Memo: TfrxCustomMemoView;
+ RowIndex, ColumnIndex, CellIndex: Integer;
+ const RowValues, ColumnValues, Value: Variant) of object;
+ TfrxOnPrintHeaderEvent = procedure (Memo: TfrxCustomMemoView;
+ const HeaderIndexes, HeaderValues, Value: Variant) of object;
+ TfrxOnCalcWidthEvent = procedure (ColumnIndex: Integer;
+ const ColumnValues: Variant; var Width: Extended) of object;
+ TfrxOnCalcHeightEvent = procedure (RowIndex: Integer;
+ const RowValues: Variant; var Height: Extended) of object;
+
+ { the record represents one cell of cross matrix }
+ PfrCrossCell = ^TfrxCrossCell;
+ TfrxCrossCell = packed record
+ Value: Variant;
+ Count: Integer;
+ Next: PfrCrossCell; { pointer to the next value in the same cell }
+ end;
+
+ TfrxCrossSortOrder = (soAscending, soDescending, soNone, soGrouping);
+ TfrxCrossFunction = (cfNone, cfSum, cfMin, cfMax, cfAvg, cfCount);
+ TfrxVariantArray = array of Variant;
+ TfrxSortArray = array [0..31] of TfrxCrossSortOrder;
+
+ { the base class for column/row item. Contains Indexes array that
+ identifies a column/row }
+ TfrxIndexItem = class(TCollectionItem)
+ private
+ FIndexes: TfrxVariantArray;
+ public
+ destructor Destroy; override;
+ property Indexes: TfrxVariantArray read FIndexes write FIndexes;
+ end;
+
+ { the base collection for column/row items. Contains methods for working
+ with Indexes and sorting them }
+ TfrxIndexCollection = class(TCollection)
+ private
+ FIndexesCount: Integer;
+ FSortOrder: TfrxSortArray;
+ function GetItems(Index: Integer): TfrxIndexItem;
+ public
+ function Find(const Indexes: array of Variant; var Index: Integer): Boolean;
+ function InsertItem(Index: Integer; const Indexes: array of Variant): TfrxIndexItem; virtual;
+ property Items[Index: Integer]: TfrxIndexItem read GetItems; default;
+ end;
+
+ { the class representing a single row item }
+ TfrxCrossRow = class(TfrxIndexItem)
+ private
+ FCellLevels: Integer;
+ FCells: TList;
+ procedure CreateCell(Index: Integer);
+ public
+ constructor Create(Collection: TCollection); override;
+ destructor Destroy; override;
+ function GetCell(Index: Integer): PfrCrossCell;
+ function GetCellValue(Index1, Index2: Integer): Variant;
+ procedure SetCellValue(Index1, Index2: Integer; const Value: Variant);
+ end;
+
+ { the class representing row items }
+ TfrxCrossRows = class(TfrxIndexCollection)
+ private
+ FCellLevels: Integer;
+ function GetItems(Index: Integer): TfrxCrossRow;
+ public
+ constructor Create;
+ function InsertItem(Index: Integer; const Indexes: array of Variant): TfrxIndexItem; override;
+ function Row(const Indexes: array of Variant): TfrxCrossRow;
+ property Items[Index: Integer]: TfrxCrossRow read GetItems; default;
+ end;
+
+ { the class representing a single column item }
+ TfrxCrossColumn = class(TfrxIndexItem)
+ private
+ FCellIndex: Integer;
+ public
+ property CellIndex: Integer read FCellIndex write FCellIndex;
+ end;
+
+ { the class representing column items }
+ TfrxCrossColumns = class(TfrxIndexCollection)
+ private
+ function GetItems(Index: Integer): TfrxCrossColumn;
+ public
+ constructor Create;
+ function Column(const Indexes: array of Variant): TfrxCrossColumn;
+ function InsertItem(Index: Integer; const Indexes: array of Variant): TfrxIndexItem; override;
+ property Items[Index: Integer]: TfrxCrossColumn read GetItems; default;
+ end;
+
+ { TfrxCrossHeader represents one cell of a cross header. The cell has a value,
+ position, size and list of subcells }
+ TfrxCrossHeader = class(TObject)
+ private
+ FBounds: TfrxRect; { bounds of the cell }
+ FMemos: TList;
+ FTotalMemos: TList;
+ FCounts: TfrxVariantArray;
+ FCellIndex: Integer; { help to determine cell index for cell header }
+ FCellLevels: Integer;
+ FFuncValues: TfrxVariantArray;
+ FHasCellHeaders: Boolean; { top level item only }
+ FIndex: Integer; { index of the item }
+ FIsCellHeader: Boolean;
+ FIsIndex: Boolean; { used in IndexItems to determine if item is index }
+ FIsTotal: Boolean; { is this cell a total cell }
+ FItems: TList; { subcells }
+ FLevelsCount: Integer; { number of header levels }
+ FMemo: TfrxCustomMemoView; { memo for this cell }
+ FNoLevels: Boolean; { true if no items in row/column header }
+ FParent: TfrxCrossHeader; { parent of the cell }
+ FSize: TfrxPoint;
+ FTotalIndex: Integer; { will help to choose which header memo to use }
+ FValue: Variant; { value (text) of the cell }
+ FVisible: Boolean; { visibility of the cell }
+
+ function AddCellHeader(Memos: TList; Index, CellIndex: Integer): TfrxCrossHeader;
+ function AddChild(Memo: TfrxCustomMemoView): TfrxCrossHeader;
+ procedure AddFuncValues(const Values, Counts: array of Variant;
+ const CellFunctions: array of TfrxCrossFunction);
+ procedure AddValues(const Values: array of Variant; Unsorted: Boolean);
+ procedure Reset(const CellFunctions: array of TfrxCrossFunction);
+
+ function GetCount: Integer;
+ function GetItems(Index: Integer): TfrxCrossHeader;
+ function GetLevel: Integer;
+ function GetHeight: Double;
+ function GetWidth: Double;
+ public
+ constructor Create(CellLevels: Integer);
+ destructor Destroy; override;
+ procedure CalcBounds; virtual; abstract;
+ procedure CalcSizes(MaxWidth, MinWidth: Integer; AutoSize: Boolean); virtual; abstract;
+
+ function AllItems: TList;
+ function Find(Value: Variant): Integer;
+ function GetIndexes: Variant;
+ function GetValues: Variant;
+ function TerminalItems: TList;
+ function IndexItems: TList;
+
+ property Bounds: TfrxRect read FBounds write FBounds;
+ property Count: Integer read GetCount;
+ property HasCellHeaders: Boolean read FHasCellHeaders write FHasCellHeaders;
+ property Height: Double read GetHeight;
+ property IsTotal: Boolean read FIsTotal;
+ property Items[Index: Integer]: TfrxCrossHeader read GetItems; default;
+ property Level: Integer read GetLevel;
+ property Memo: TfrxCustomMemoView read FMemo;
+ property Parent: TfrxCrossHeader read FParent;
+ property Value: Variant read FValue write FValue;
+ property Visible: Boolean read FVisible write FVisible;
+ property Width: Double read GetWidth;
+ end;
+
+ { the cross columns }
+ TfrxCrossColumnHeader = class(TfrxCrossHeader)
+ private
+ FCorner: TfrxCrossHeader;
+ public
+ procedure CalcBounds; override;
+ procedure CalcSizes(MaxWidth, MinWidth: Integer; AutoSize: Boolean); override;
+ end;
+
+ { the cross rows }
+ TfrxCrossRowHeader = class(TfrxCrossHeader)
+ private
+ FCorner: TfrxCrossHeader;
+ public
+ procedure CalcBounds; override;
+ procedure CalcSizes(MaxWidth, MinWidth: Integer; AutoSize: Boolean); override;
+ end;
+
+ { the cross corner }
+ TfrxCrossCorner = class(TfrxCrossColumnHeader)
+ end;
+
+
+ { cutted bands }
+ TfrxCutBandItem = class(TCollectionItem)
+ public
+ Band: TfrxBand;
+ FromIndex: Integer;
+ ToIndex: Integer;
+ destructor Destroy; override;
+ end;
+
+ TfrxCutBands = class(TCollection)
+ private
+ function GetItems(Index: Integer): TfrxCutBandItem;
+ public
+ constructor Create;
+ procedure Add(ABand: TfrxBand; AFromIndex, AToIndex: Integer);
+ property Items[Index: Integer]: TfrxCutBandItem read GetItems; default;
+ end;
+
+ { design-time grid resize support }
+ TfrxGridLineItem = class(TCollectionItem)
+ public
+ Coord: Double;
+ Objects: TList;
+ constructor Create(Collection: TCollection); override;
+ destructor Destroy; override;
+ end;
+
+ TfrxGridLines = class(TCollection)
+ private
+ function GetItems(Index: Integer): TfrxGridLineItem;
+ public
+ constructor Create;
+ procedure Add(AObj: TObject; ACoord: Double);
+ property Items[Index: Integer]: TfrxGridLineItem read GetItems; default;
+ end;
+
+
+ { custom cross object }
+ TfrxCustomCrossView = class(TfrxView)
+ private
+ FAddHeight: Double;
+ FAddWidth: Double;
+ FAllowDuplicates: Boolean;
+ FAutoSize: Boolean;
+ FBorder: Boolean;
+ FCellFields: TStrings;
+ FCellFunctions: array[0..31] of TfrxCrossFunction;
+ FCellLevels: Integer;
+ FClearBeforePrint: Boolean;
+ FColumnBands: TfrxCutBands;
+ FColumnFields: TStrings;
+ FColumnHeader: TfrxCrossColumnHeader;
+ FColumnLevels: Integer;
+ FColumns: TfrxCrossColumns;
+ FColumnSort: TfrxSortArray;
+ FCorner: TfrxCrossCorner;
+ FDefHeight: Integer;
+ FDotMatrix: Boolean;
+ FDownThenAcross: Boolean;
+ FFirstMousePos: TPoint;
+ FGapX: Integer;
+ FGapY: Integer;
+ FGridUsed: TfrxGridLines;
+ FGridX: TfrxGridLines;
+ FGridY: TfrxGridLines;
+ FJoinEqualCells: Boolean;
+ FKeepTogether: Boolean;
+ FLastMousePos: TPoint;
+ FMaxWidth: Integer;
+ FMinWidth: Integer;
+ FMouseDown: Boolean;
+ FMovingObjects: Integer;
+ FNextCross: TfrxCustomCrossView;
+ FNextCrossGap: Double;
+ FNoColumns: Boolean;
+ FNoRows: Boolean;
+ FPlainCells: Boolean;
+ FRepeatHeaders: Boolean;
+ FRowBands: TfrxCutBands;
+ FRowFields: TStrings;
+ FRowHeader: TfrxCrossRowHeader;
+ FRowLevels: Integer;
+ FRows: TfrxCrossRows;
+ FRowSort: TfrxSortArray;
+ FShowColumnHeader: Boolean;
+ FShowColumnTotal: Boolean;
+ FShowCorner: Boolean;
+ FShowRowHeader: Boolean;
+ FShowRowTotal: Boolean;
+ FShowTitle: Boolean;
+ FSuppressNullRecords: Boolean;
+ FKeepRowsTogether: Boolean;
+
+ FOnCalcHeight: TfrxCalcHeightEvent; { script event }
+ FOnCalcWidth: TfrxCalcWidthEvent; { script event }
+ FOnPrintCell: TfrxPrintCellEvent; { script event }
+ FOnPrintColumnHeader: TfrxPrintHeaderEvent; { script event }
+ FOnPrintRowHeader: TfrxPrintHeaderEvent; { script event }
+ FOnBeforeCalcHeight: TfrxOnCalcHeightEvent; { Delphi event }
+ FOnBeforeCalcWidth: TfrxOnCalcWidthEvent; { Delphi event }
+ FOnBeforePrintCell: TfrxOnPrintCellEvent; { Delphi event }
+ FOnBeforePrintColumnHeader: TfrxOnPrintHeaderEvent; { Delphi event }
+ FOnBeforePrintRowHeader: TfrxOnPrintHeaderEvent; { Delphi event }
+
+ procedure CalcBounds(addWidth, addHeight: Extended);
+ procedure CalcTotal(Header: TfrxCrossHeader; Source: TfrxIndexCollection);
+ procedure CalcTotals;
+ procedure CreateHeader(Header: TfrxCrossHeader; Source: TfrxIndexCollection;
+ Totals: TList; TotalVisible: Boolean);
+ procedure CreateHeaders;
+ procedure BuildColumnBands;
+ procedure BuildRowBands;
+ procedure ClearMatrix;
+ procedure ClearMemos;
+ procedure CreateCellHeaderMemos(NewCount: Integer);
+ procedure CreateCellMemos(NewCount: Integer);
+ procedure CreateColumnMemos(NewCount: Integer);
+ procedure CreateCornerMemos(NewCount: Integer);
+ procedure CreateRowMemos(NewCount: Integer);
+ procedure CorrectDMPBounds(Memo: TfrxCustomMemoView);
+ procedure DoCalcHeight(Row: Integer; var Height: Extended);
+ procedure DoCalcWidth(Column: Integer; var Width: Extended);
+ procedure DoOnCell(Memo: TfrxCustomMemoView; Row, Column, Cell: Integer;
+ const Value: Variant);
+ procedure DoOnColumnHeader(Memo: TfrxCustomMemoView; Header: TfrxCrossHeader);
+ procedure DoOnRowHeader(Memo: TfrxCustomMemoView; Header: TfrxCrossHeader);
+ procedure InitMatrix;
+ procedure InitMemos(AddToScript: Boolean);
+ procedure ReadMemos(Stream: TStream);
+ procedure RenderMatrix;
+ procedure SetCellFields(const Value: TStrings);
+ procedure SetCellFunctions(Index: Integer; const Value: TfrxCrossFunction);
+ procedure SetColumnFields(const Value: TStrings);
+ procedure SetColumnSort(Index: Integer; Value: TfrxCrossSortOrder);
+ procedure SetDotMatrix(const Value: Boolean);
+ procedure SetRowFields(const Value: TStrings);
+ procedure SetRowSort(Index: Integer; Value: TfrxCrossSortOrder);
+ procedure SetupOriginalComponent(Obj1, Obj2: TfrxComponent);
+ procedure UpdateVisibility;
+ procedure WriteMemos(Stream: TStream);
+ function CreateMemo(Parent: TfrxComponent): TfrxCustomMemoView;
+ function GetCellFunctions(Index: Integer): TfrxCrossFunction;
+ function GetCellHeaderMemos(Index: Integer): TfrxCustomMemoView;
+ function GetCellMemos(Index: Integer): TfrxCustomMemoView;
+ function GetColumnMemos(Index: Integer): TfrxCustomMemoView;
+ function GetColumnSort(Index: Integer): TfrxCrossSortOrder;
+ function GetColumnTotalMemos(Index: Integer): TfrxCustomMemoView;
+ function GetCornerMemos(Index: Integer): TfrxCustomMemoView;
+ function GetRowMemos(Index: Integer): TfrxCustomMemoView;
+ function GetRowSort(Index: Integer): TfrxCrossSortOrder;
+ function GetRowTotalMemos(Index: Integer): TfrxCustomMemoView;
+ protected
+ FAllMemos: TList;
+ FCellMemos: TList;
+ FCellHeaderMemos: TList;
+ FColumnMemos: TList;
+ FColumnTotalMemos: TList;
+ FCornerMemos: TList;
+ FRowMemos: TList;
+ FRowTotalMemos: TList;
+ procedure DefineProperties(Filer: TFiler); override;
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetCellLevels(const Value: Integer); virtual;
+ procedure SetColumnLevels(const Value: Integer); virtual;
+ procedure SetRowLevels(const Value: Integer); virtual;
+ function GetContainerObjects: TList; override;
+ function GetNestedObjects: TList;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ procedure BeforePrint; override;
+ procedure BeforeStartReport; override;
+ procedure GetData; override;
+ procedure AddSourceObjects; override;
+ function ContainerAdd(Obj: TfrxComponent): Boolean; override;
+ function ContainerMouseDown(Sender: TObject; X, Y: Integer): Boolean; override;
+ procedure ContainerMouseMove(Sender: TObject; X, Y: Integer); override;
+ procedure ContainerMouseUp(Sender: TObject; X, Y: Integer); override;
+
+ procedure AddValue(const Rows, Columns, Cells: array of Variant);
+ procedure ApplyStyle(Style: TfrxStyles);
+ procedure BeginMatrix;
+ procedure EndMatrix;
+ procedure FillMatrix; virtual;
+ procedure GetStyle(Style: TfrxStyles);
+
+ function ColCount: Integer;
+ function DrawCross(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended): TfrxPoint;
+ function GetColumnIndexes(AColumn: Integer): Variant;
+ function GetRowIndexes(ARow: Integer): Variant;
+ function GetValue(ARow, AColumn, ACell: Integer): Variant;
+ function IsCrossValid: Boolean; virtual;
+ function IsGrandTotalColumn(Index: Integer): Boolean;
+ function IsGrandTotalRow(Index: Integer): Boolean;
+ function IsTotalColumn(Index: Integer): Boolean;
+ function IsTotalRow(Index: Integer): Boolean;
+ function RowCount: Integer;
+ function RowHeaderWidth: Double;
+ function ColumnHeaderHeight: Double;
+
+ property ColumnHeader: TfrxCrossColumnHeader read FColumnHeader;
+ property RowHeader: TfrxCrossRowHeader read FRowHeader;
+ property Corner: TfrxCrossCorner read FCorner;
+ property NoColumns: Boolean read FNoColumns;
+ property NoRows: Boolean read FNoRows;
+
+ property CellFields: TStrings read FCellFields write SetCellFields;
+ property CellFunctions[Index: Integer]: TfrxCrossFunction read GetCellFunctions
+ write SetCellFunctions;
+ property CellMemos[Index: Integer]: TfrxCustomMemoView read GetCellMemos;
+ property CellHeaderMemos[Index: Integer]: TfrxCustomMemoView read GetCellHeaderMemos;
+ property ClearBeforePrint: Boolean read FClearBeforePrint write FClearBeforePrint;
+ property ColumnFields: TStrings read FColumnFields write SetColumnFields;
+ property ColumnMemos[Index: Integer]: TfrxCustomMemoView read GetColumnMemos;
+ property ColumnSort[Index: Integer]: TfrxCrossSortOrder read GetColumnSort
+ write SetColumnSort;
+ property ColumnTotalMemos[Index: Integer]: TfrxCustomMemoView read GetColumnTotalMemos;
+ property CornerMemos[Index: Integer]: TfrxCustomMemoView read GetCornerMemos;
+ property DotMatrix: Boolean read FDotMatrix;
+ property RowFields: TStrings read FRowFields write SetRowFields;
+ property RowMemos[Index: Integer]: TfrxCustomMemoView read GetRowMemos;
+ property RowSort[Index: Integer]: TfrxCrossSortOrder read GetRowSort
+ write SetRowSort;
+ property RowTotalMemos[Index: Integer]: TfrxCustomMemoView read GetRowTotalMemos;
+ property OnBeforeCalcHeight: TfrxOnCalcHeightEvent
+ read FOnBeforeCalcHeight write FOnBeforeCalcHeight;
+ property OnBeforeCalcWidth: TfrxOnCalcWidthEvent
+ read FOnBeforeCalcWidth write FOnBeforeCalcWidth;
+ property OnBeforePrintCell: TfrxOnPrintCellEvent
+ read FOnBeforePrintCell write FOnBeforePrintCell;
+ property OnBeforePrintColumnHeader: TfrxOnPrintHeaderEvent
+ read FOnBeforePrintColumnHeader write FOnBeforePrintColumnHeader;
+ property OnBeforePrintRowHeader: TfrxOnPrintHeaderEvent
+ read FOnBeforePrintRowHeader write FOnBeforePrintRowHeader;
+ published
+ property AddHeight: Double read FAddHeight write FAddHeight;
+ property AddWidth: Double read FAddWidth write FAddWidth;
+ property AllowDuplicates: Boolean read FAllowDuplicates write FAllowDuplicates default True;
+ property AutoSize: Boolean read FAutoSize write FAutoSize default True;
+ property Border: Boolean read FBorder write FBorder default True;
+ property CellLevels: Integer read FCellLevels write SetCellLevels default 1;
+ property ColumnLevels: Integer read FColumnLevels write SetColumnLevels default 1;
+ property DefHeight: Integer read FDefHeight write FDefHeight default 0;
+ property DownThenAcross: Boolean read FDownThenAcross write FDownThenAcross;
+ property GapX: Integer read FGapX write FGapX default 3;
+ property GapY: Integer read FGapY write FGapY default 3;
+ property JoinEqualCells: Boolean read FJoinEqualCells write FJoinEqualCells default False;
+ property KeepTogether: Boolean read FKeepTogether write FKeepTogether default False;
+ property KeepRowsTogether: Boolean read FKeepRowsTogether write FKeepRowsTogether default False;
+ property MaxWidth: Integer read FMaxWidth write FMaxWidth default 200;
+ property MinWidth: Integer read FMinWidth write FMinWidth default 0;
+ property NextCross: TfrxCustomCrossView read FNextCross write FNextCross;
+ property NextCrossGap: Double read FNextCrossGap write FNextCrossGap;
+ property PlainCells: Boolean read FPlainCells write FPlainCells default False;
+ property RepeatHeaders: Boolean read FRepeatHeaders write FRepeatHeaders default True;
+ property RowLevels: Integer read FRowLevels write SetRowLevels default 1;
+ property ShowColumnHeader: Boolean read FShowColumnHeader write FShowColumnHeader default True;
+ property ShowColumnTotal: Boolean read FShowColumnTotal write FShowColumnTotal default True;
+ property ShowCorner: Boolean read FShowCorner write FShowCorner default True;
+ property ShowRowHeader: Boolean read FShowRowHeader write FShowRowHeader default True;
+ property ShowRowTotal: Boolean read FShowRowTotal write FShowRowTotal default True;
+ property ShowTitle: Boolean read FShowTitle write FShowTitle default True;
+ property SuppressNullRecords: Boolean read FSuppressNullRecords write FSuppressNullRecords default True;
+ property OnCalcHeight: TfrxCalcHeightEvent read FOnCalcHeight write FOnCalcHeight;
+ property OnCalcWidth: TfrxCalcWidthEvent read FOnCalcWidth write FOnCalcWidth;
+ property OnPrintCell: TfrxPrintCellEvent read FOnPrintCell write FOnPrintCell;
+ property OnPrintColumnHeader: TfrxPrintHeaderEvent
+ read FOnPrintColumnHeader write FOnPrintColumnHeader;
+ property OnPrintRowHeader: TfrxPrintHeaderEvent
+ read FOnPrintRowHeader write FOnPrintRowHeader;
+ end;
+
+ TfrxCrossView = class(TfrxCustomCrossView)
+ protected
+ procedure SetCellLevels(const Value: Integer); override;
+ procedure SetColumnLevels(const Value: Integer); override;
+ procedure SetRowLevels(const Value: Integer); override;
+ public
+ class function GetDescription: String; override;
+ function IsCrossValid: Boolean; override;
+ published
+ end;
+
+ TfrxDBCrossView = class(TfrxCustomCrossView)
+ private
+ public
+ class function GetDescription: String; override;
+ function IsCrossValid: Boolean; override;
+ procedure FillMatrix; override;
+ published
+ property CellFields;
+ property ColumnFields;
+ property DataSet;
+ property DataSetName;
+ property RowFields;
+ end;
+
+
+implementation
+
+uses
+{$IFNDEF NO_EDITORS}
+ FMX.frxCrossEditor,
+{$ENDIF}
+ FMX.frxCrossRTTI, FMX.frxDsgnIntf, FMX.frxXML, FMX.frxUtils, FMX.frxXMLSerializer, FMX.frxRes,
+ FMX.frxDMPClass, FMX.frxVariables, FMX.frxUnicodeUtils;
+
+type
+ THackComponent = class(TfrxComponent);
+ THackMemoView = class(TfrxCustomMemoView);
+
+
+function CalcSize(m: TfrxCustomMemoView): TfrxPoint;
+var
+ e, SaveHeight: Extended;
+begin
+ SaveHeight := m.Height;
+ m.Height := 10000;
+
+ Result.X := m.CalcWidth;
+ Result.Y := m.CalcHeight;
+
+ if m is TfrxDMPMemoView then
+ begin
+ Result.X := Result.X + fr1CharX;
+ Result.Y := Result.Y + fr1CharY;
+ end;
+
+ if (m.Rotation = 90) or (m.Rotation = 270) then
+ begin
+ e := Result.X;
+ Result.X := Result.Y;
+ Result.Y := e;
+ end;
+
+ m.Height := SaveHeight;
+end;
+
+
+{ TfrxIndexItem }
+
+destructor TfrxIndexItem.Destroy;
+begin
+ FIndexes := nil;
+ inherited;
+end;
+
+
+{ TfrxIndexCollection }
+
+function TfrxIndexCollection.GetItems(Index: Integer): TfrxIndexItem;
+begin
+ Result := TfrxIndexItem(inherited Items[Index]);
+end;
+
+function TfrxIndexCollection.Find(const Indexes: array of Variant;
+ var Index: Integer): Boolean;
+var
+ i, i0, i1, c: Integer;
+ Item: TfrxIndexItem;
+
+{compare function returns > 2 to keep equal columns/rows together without sorting}
+ function Compare: Integer;
+ var
+ i: Integer;
+ begin
+ Result := 1;
+ for i := 0 to FIndexesCount - 1 do
+ if Item.Indexes[i] = Indexes[i] then
+ begin
+ if (VarType(Indexes[i]) = varString) or (VarType(Indexes[i]) = varOleStr)
+ or (VarType(Indexes[i]) = varUString) then
+ if VarToWideStr(Item.Indexes[i]) = VarToWideStr(Indexes[i]) then
+ Result := 0
+ else
+ begin
+ Result := -1;
+ break;
+ end
+ else
+ Result := 0;
+ end
+ else if (Result = 0) and (FSortOrder[0] = {soNone} soGrouping) then
+ begin
+ Result := i + 2;
+ break;
+ end
+ else if VarIsNull(Indexes[i]) then
+ begin
+ if FSortOrder[i] = soAscending then
+ Result := 1 else
+ Result := -1;
+ break;
+ end
+ else if VarIsNull(Item.Indexes[i]) then
+ begin
+ if FSortOrder[i] = soAscending then
+ Result := -1 else
+ Result := 1;
+ break;
+ end
+ else if Item.Indexes[i] > Indexes[i] then
+ begin
+ if FSortOrder[i] = soAscending then
+ Result := 1 else
+ Result := -1;
+ break;
+ end
+ else if Item.Indexes[i] < Indexes[i] then
+ begin
+ if FSortOrder[i] = soAscending then
+ Result := -1 else
+ Result := 1;
+ break;
+ end;
+ end;
+
+begin
+ Result := False;
+ if FSortOrder[0] in [soNone, soGrouping] then
+ begin
+ i0 := 0;
+ Index := Count;
+ for i := 0 to Count - 1 do
+ begin
+ Item := TfrxIndexItem(Items[i]);
+ c := Compare;
+ if c = 0 then
+ begin
+ Result := True;
+ Index := i;
+ Exit;
+ end else if (c > 2) and (i0 <= c) then {place same colums together}
+ begin
+ Index := i + 1;
+ i0 := c;
+ end;
+ end;
+ Exit;
+ end;
+
+ { quick find }
+ i0 := 0;
+ i1 := Count - 1;
+
+ while i0 <= i1 do
+ begin
+ i := (i0 + i1) div 2;
+ Item := TfrxIndexItem(Items[i]);
+ c := Compare;
+
+ if c < 0 then
+ i0 := i + 1
+ else
+ begin
+ i1 := i - 1;
+ if c = 0 then
+ begin
+ Result := True;
+ i0 := i;
+ end;
+ end;
+ end;
+
+ Index := i0;
+end;
+
+function TfrxIndexCollection.InsertItem(Index: Integer;
+ const Indexes: array of Variant): TfrxIndexItem;
+var
+ i: Integer;
+begin
+ if Index < Count then
+ Result := TfrxIndexItem(Insert(Index)) else
+ Result := TfrxIndexItem(Add);
+ SetLength(Result.FIndexes, FIndexesCount);
+ for i := 0 to FIndexesCount - 1 do
+ Result.FIndexes[i] := Indexes[i];
+end;
+
+
+{ TfrxCrossRow }
+
+constructor TfrxCrossRow.Create;
+begin
+ inherited;
+ FCells := TList.Create;
+end;
+
+destructor TfrxCrossRow.Destroy;
+var
+ i: Integer;
+ c, c1: PfrCrossCell;
+begin
+ for i := 0 to FCells.Count - 1 do
+ begin
+ c := FCells[i];
+ while c <> nil do
+ begin
+ c1 := c;
+ c := c.Next;
+ VarClear(c1.Value);
+ Dispose(c1);
+ end;
+ end;
+
+ FCells.Free;
+ inherited;
+end;
+
+procedure TfrxCrossRow.CreateCell(Index: Integer);
+var
+ i: Integer;
+ c, c1: PfrCrossCell;
+begin
+ while Index >= FCells.Count do
+ begin
+ c1 := nil;
+ for i := 0 to FCellLevels - 1 do
+ begin
+ New(c);
+ c.Value := Null;
+ c.Count := 1;
+ c.Next := nil;
+ if c1 <> nil then
+ c1.Next := c else
+ FCells.Add(c);
+ c1 := c;
+ end;
+ end;
+end;
+
+function TfrxCrossRow.GetCellValue(Index1, Index2: Integer): Variant;
+var
+ c: PfrCrossCell;
+begin
+ Result := Null;
+ if (Index1 < 0) or (Index1 >= FCells.Count) then Exit;
+
+ c := FCells[Index1];
+ while (c <> nil) and (Index2 > 0) do
+ begin
+ c := c.Next;
+ Dec(Index2);
+ end;
+
+ if c <> nil then
+ Result := c.Value;
+end;
+
+procedure TfrxCrossRow.SetCellValue(Index1, Index2: Integer; const Value: Variant);
+var
+ c: PfrCrossCell;
+begin
+ if Index1 < 0 then Exit;
+ if Index1 >= FCells.Count then
+ CreateCell(Index1);
+
+ c := FCells[Index1];
+ while (c <> nil) and (Index2 > 0) do
+ begin
+ c := c.Next;
+ Dec(Index2);
+ end;
+ if c <> nil then
+ if c.Value = Null then
+ c.Value := Value else
+ c.Value := c.Value + Value;
+end;
+
+function TfrxCrossRow.GetCell(Index: Integer): PfrCrossCell;
+begin
+ Result := nil;
+ if Index < 0 then Exit;
+
+ if Index >= FCells.Count then
+ CreateCell(Index);
+
+ Result := FCells[Index];
+end;
+
+
+{ TfrxCrossRows }
+
+constructor TfrxCrossRows.Create;
+begin
+ inherited Create(TfrxCrossRow);
+end;
+
+function TfrxCrossRows.GetItems(Index: Integer): TfrxCrossRow;
+begin
+ Result := TfrxCrossRow(inherited Items[Index]);
+end;
+
+function TfrxCrossRows.InsertItem(Index: Integer;
+ const Indexes: array of Variant): TfrxIndexItem;
+begin
+ Result := inherited InsertItem(Index, Indexes);
+ TfrxCrossRow(Result).FCellLevels := FCellLevels;
+end;
+
+function TfrxCrossRows.Row(const Indexes: array of Variant): TfrxCrossRow;
+var
+ i: Integer;
+begin
+ if Find(Indexes, i) then
+ Result := Items[i] else
+ Result := TfrxCrossRow(InsertItem(i, Indexes));
+end;
+
+
+{ TfrxCrossColumns }
+
+constructor TfrxCrossColumns.Create;
+begin
+ inherited Create(TfrxCrossColumn);
+end;
+
+function TfrxCrossColumns.GetItems(Index: Integer): TfrxCrossColumn;
+begin
+ Result := TfrxCrossColumn(inherited Items[Index]);
+end;
+
+function TfrxCrossColumns.Column(const Indexes: array of Variant): TfrxCrossColumn;
+var
+ i: Integer;
+begin
+ if Find(Indexes, i) then
+ Result := Items[i] else
+ Result := TfrxCrossColumn(InsertItem(i, Indexes));
+end;
+
+function TfrxCrossColumns.InsertItem(Index: Integer;
+ const Indexes: array of Variant): TfrxIndexItem;
+begin
+ Result := inherited InsertItem(Index, Indexes);
+ TfrxCrossColumn(Result).FCellIndex := Count - 1;
+end;
+
+
+{ TfrxCrossHeader }
+
+constructor TfrxCrossHeader.Create(CellLevels: Integer);
+begin
+ FItems := TList.Create;
+ FCellLevels := CellLevels;
+ FValue := Null;
+ FVisible := True;
+
+ SetLength(FFuncValues, FCellLevels);
+ SetLength(FCounts, FCellLevels);
+end;
+
+destructor TfrxCrossHeader.Destroy;
+begin
+ FFuncValues := nil;
+ FCounts := nil;
+
+ while FItems.Count > 0 do
+ begin
+ TfrxCrossHeader(FItems[0]).Free;
+ FItems.Delete(0);
+ end;
+
+ FItems.Free;
+ inherited;
+end;
+
+function TfrxCrossHeader.GetItems(Index: Integer): TfrxCrossHeader;
+begin
+ Result := TfrxCrossHeader(FItems[Index]);
+end;
+
+function TfrxCrossHeader.GetCount: Integer;
+begin
+ Result := FItems.Count;
+end;
+
+function TfrxCrossHeader.GetLevel: Integer;
+var
+ h: TfrxCrossHeader;
+begin
+ Result := -2;
+ h := Self;
+
+ while h <> nil do
+ begin
+ h := h.Parent;
+ Inc(Result);
+ end;
+end;
+
+function TfrxCrossHeader.Find(Value: Variant): Integer;
+var
+ i: Integer;
+begin
+ { find the cell containing the given value }
+ Result := -1;
+ for i := 0 to Count - 1 do
+ if VarToWideStr(Items[i].Value) = VarToWideStr(Value) then
+ begin
+ Result := i;
+ Exit;
+ end;
+end;
+
+function TfrxCrossHeader.AddChild(Memo: TfrxCustomMemoView): TfrxCrossHeader;
+begin
+ Result := TfrxCrossHeader(NewInstance);
+ Result.Create(FCellLevels);
+ { link it to the parent }
+ FItems.Add(Result);
+ Result.FParent := Self;
+
+ Result.FLevelsCount := FLevelsCount;
+ Result.FMemo := Memo;
+ Result.FValue := Memo.Text;
+end;
+
+function TfrxCrossHeader.AddCellHeader(Memos: TList; Index, CellIndex: Integer): TfrxCrossHeader;
+begin
+ Result := TfrxCrossHeader(NewInstance);
+ Result.Create(FCellLevels);
+ { link it to the parent }
+ FItems.Add(Result);
+ Result.FParent := Self;
+
+ Result.FIndex := Index;
+ Result.FCellIndex := CellIndex;
+ Result.FLevelsCount := FLevelsCount;
+ Result.FIsTotal := FIsTotal;
+ Result.FTotalIndex := FTotalIndex;
+ Result.FMemo := Memos[FTotalIndex * FCellLevels + CellIndex];
+ Result.FValue := Result.FMemo.Text;
+ Result.FIsCellHeader := True;
+end;
+
+procedure TfrxCrossHeader.AddValues(const Values: array of Variant; Unsorted: Boolean);
+var
+ i, j: Integer;
+ Header, Header1: TfrxCrossHeader;
+ v: Variant;
+ s: String;
+begin
+ { create the header tree. For example, subsequent calls
+ AddValues([1998,1]);
+ AddValues([1998,2]);
+ AddValues([1999,1]);
+ will create the header
+ 1998 | 1999
+ --+--+-----
+ 1 |2 | 1 }
+
+
+ Header := Self;
+
+ for i := Low(Values) to High(Values) do
+ begin
+ {unsorted mode join same cells only for consecutive values}
+ if Unsorted then
+ begin
+ j := Header.Count;
+ if (j > 0) and
+ (VarToWideStr(Header.Items[Header.Count - 1].Value) = VarToWideStr(Values[i])) then
+ dec(j)
+ else j := -1;
+ end
+ else j := Header.Find(Values[i]);
+ if j <> -1 then
+ Header := Header.Items[j] { find existing item... }
+ else
+ begin
+ { ...or create new one }
+ Header1 := TfrxCrossHeader(NewInstance);
+ Header1.Create(FCellLevels);
+ Header1.FLevelsCount := FLevelsCount;
+ { link it to the parent }
+ Header.FItems.Add(Header1);
+ Header1.FParent := Header;
+
+ v := Values[i];
+ s := VarToStr(v);
+ { this is subtotal item }
+ if Pos('@@@', s) = 1 then
+ begin
+ { remove @@@ }
+ s := Copy(s, 4, Length(s) - 5);
+ v := s;
+ Header1.FIsTotal := True;
+ Header1.FMemo := FTotalMemos[i];
+ Header1.FTotalIndex := FLevelsCount - i;
+ end
+ else
+ Header1.FMemo := FMemos[i];
+
+ Header1.FValue := v;
+ Header := Header1;
+
+ if Header.FIsTotal then break;
+ end;
+ end;
+end;
+
+procedure TfrxCrossHeader.Reset(const CellFunctions: array of TfrxCrossFunction);
+var
+ i: Integer;
+ h: TfrxCrossHeader;
+begin
+ { reset aggregate values for this cell and all its parent cells }
+ h := Self;
+
+ while h <> nil do
+ begin
+ for i := 0 to FCellLevels - 1 do
+ begin
+ case CellFunctions[i] of
+ cfNone, cfMin, cfMax:
+ h.FFuncValues[i] := Null;
+
+ cfSum, cfAvg, cfCount:
+ h.FFuncValues[i] := 0;
+ end;
+
+ h.FCounts[i] := 0;
+ end;
+
+ h := h.Parent;
+ end;
+end;
+
+procedure TfrxCrossHeader.AddFuncValues(const Values, Counts: array of Variant;
+ const CellFunctions: array of TfrxCrossFunction);
+var
+ i: Integer;
+ h: TfrxCrossHeader;
+begin
+ { add aggregate values for this cell and all its parent cells }
+ h := Self;
+
+ while h <> nil do
+ begin
+ for i := 0 to FCellLevels - 1 do
+ if Values[i] <> Null then
+ case CellFunctions[i] of
+ cfNone:;
+
+ cfSum:
+ h.FFuncValues[i] := h.FFuncValues[i] + Values[i];
+
+ cfMin:
+ if (h.FFuncValues[i] = Null) or (Values[i] < h.FFuncValues[i]) then
+ h.FFuncValues[i] := Values[i];
+
+ cfMax:
+ if (h.FFuncValues[i] = Null) or (Values[i] > h.FFuncValues[i]) then
+ h.FFuncValues[i] := Values[i];
+
+ cfAvg:
+ begin
+ h.FFuncValues[i] := h.FFuncValues[i] + Values[i];
+ h.FCounts[i] := h.FCounts[i] + Counts[i];
+ end;
+
+ cfCount:
+ h.FFuncValues[i] := h.FFuncValues[i] + Values[i];// + Counts[i];
+ end;
+
+ h := h.Parent;
+ end;
+end;
+
+function TfrxCrossHeader.AllItems: TList;
+
+ procedure EnumItems(Item: TfrxCrossHeader);
+ var
+ i: Integer;
+ begin
+ if Item.Memo <> nil then
+ Result.Add(Item);
+ for i := 0 to Item.Count - 1 do
+ EnumItems(Item[i]);
+ end;
+
+begin
+ { list all items in the header }
+ Result := TList.Create;
+ EnumItems(Self);
+end;
+
+function TfrxCrossHeader.TerminalItems: TList;
+var
+ i: Integer;
+ Item: TfrxCrossHeader;
+begin
+ { list all terminal items in the header }
+ Result := AllItems;
+ i := 0;
+ while i < Result.Count do
+ begin
+ Item := Result[i];
+ if Item.Count = 0 then
+ Inc(i)
+ else
+ Result.Delete(i);
+ end;
+end;
+
+function TfrxCrossHeader.IndexItems: TList;
+var
+ i: Integer;
+ Item: TfrxCrossHeader;
+begin
+ { list all terminal items in the header }
+ Result := AllItems;
+ i := 0;
+ while i < Result.Count do
+ begin
+ Item := Result[i];
+ if Item.FIsIndex then
+ Inc(i)
+ else
+ Result.Delete(i);
+ end;
+end;
+
+function TfrxCrossHeader.GetIndexes: Variant;
+var
+ ar: array of Variant;
+ i, n: Integer;
+ h, h1: TfrxCrossHeader;
+begin
+ SetLength(ar, FLevelsCount + 1);
+ n := 0;
+ h := Parent;
+ h1 := Self;
+ while h <> nil do
+ begin
+ ar[n] := h.FItems.IndexOf(h1);
+ Inc(n);
+ h1 := h;
+ h := h.Parent;
+ end;
+
+ Result := VarArrayCreate([0, FLevelsCount - 1], varVariant);
+ for i := 0 to FLevelsCount - 1 do
+ if i < n then
+ Result[i] := ar[n - i - 1] else
+ Result[i] := Null;
+ ar := nil;
+end;
+
+function TfrxCrossHeader.GetValues: Variant;
+var
+ ar: array of Variant;
+ i, n: Integer;
+ h: TfrxCrossHeader;
+begin
+ SetLength(ar, FLevelsCount + 1);
+ n := 0;
+ h := Self;
+ while h.Parent <> nil do
+ begin
+ ar[n] := h.Value;
+ Inc(n);
+ h := h.Parent;
+ end;
+
+ Result := VarArrayCreate([0, FLevelsCount - 1], varVariant);
+ for i := 0 to FLevelsCount - 1 do
+ if i < n then
+ Result[i] := ar[n - i - 1] else
+ Result[i] := Null;
+ ar := nil;
+end;
+
+function TfrxCrossHeader.GetHeight: Double;
+var
+ Items: TList;
+begin
+ Items := TerminalItems;
+
+ if (Items.Count > 0) and FVisible then
+ Result := TfrxCrossHeader(Items[Items.Count - 1]).Bounds.Top +
+ TfrxCrossHeader(Items[Items.Count - 1]).Bounds.Bottom
+ else
+ Result := 0;
+
+ Items.Free;
+end;
+
+function TfrxCrossHeader.GetWidth: Double;
+var
+ Items: TList;
+begin
+ Items := TerminalItems;
+
+ if (Items.Count > 0) and FVisible then
+ Result := TfrxCrossHeader(Items[Items.Count - 1]).Bounds.Left +
+ TfrxCrossHeader(Items[Items.Count - 1]).Bounds.Right
+ else
+ Result := 0;
+
+ Items.Free;
+end;
+
+
+{ TfrxCrossColumnHeader }
+
+procedure TfrxCrossColumnHeader.CalcBounds;
+var
+ i, j, l: Integer;
+ h, hAvg: Extended;
+ Items: TList;
+ Item: TfrxCrossHeader;
+ LevelHeights: array of Extended;
+
+ function DoAdjust(Item: TfrxCrossHeader): Extended;
+ var
+ i: Integer;
+ Width: Extended;
+ begin
+ if Item.Count = 0 then
+ begin
+ Result := Item.FSize.X;
+ Exit;
+ end;
+
+ Width := 0;
+ for i := 0 to Item.Count - 1 do
+ Width := Width + DoAdjust(Item[i]);
+
+ if Item.FSize.X < Width then
+ Item.FSize.X := Width
+ else
+ begin
+ Item[Item.Count - 1].FSize.X := Item[Item.Count - 1].FSize.X + Item.FSize.X - Width;
+ DoAdjust(Item[Item.Count - 1]);
+ end;
+
+ Result := Item.FSize.X;
+ end;
+
+ procedure FillBounds(Item: TfrxCrossHeader; Offset: TfrxPoint);
+ var
+ i, j, l: Integer;
+ h: Extended;
+ begin
+ l := Item.Level;
+ if l <> -1 then
+ h := LevelHeights[l] else
+ h := Item.FSize.Y;
+
+ if Item.FIsCellHeader then
+ h := LevelHeights[FLevelsCount]
+ else if Item.IsTotal then
+ for j := l + 1 to FLevelsCount - 1 do
+ h := h + LevelHeights[j];
+
+ Item.FBounds := frxRect(Offset.X, Offset.Y, Item.FSize.X, h);
+ Offset.Y := Offset.Y + h;
+
+ for i := 0 to Item.Count - 1 do
+ begin
+ FillBounds(Item[i], Offset);
+ Offset.X := Offset.X + Item[i].FSize.X;
+ end;
+ end;
+
+begin
+ DoAdjust(Self);
+
+ SetLength(LevelHeights, FLevelsCount + 1);
+
+ Items := AllItems;
+
+// calculate height of each row
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ l := Item.Level;
+
+ // cell headers always adjust the last level height
+ if Item.FIsCellHeader then
+ l := FLevelsCount
+ // don't count total elemens unless they are on last level.
+ // such elements will be adjusted later
+ else if Item.IsTotal then
+ if l <> FLevelsCount - 1 then continue;
+
+ if l >= 0 then
+ if Item.FSize.Y > LevelHeights[l] then
+ LevelHeights[l] := Item.FSize.Y;
+ end;
+
+ if FNoLevels then
+ LevelHeights[0] := 0;
+
+// adjust level height - count totals that not on the last level
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ l := Item.Level;
+
+ if Item.IsTotal and (l < FLevelsCount - 1) then
+ begin
+ h := 0;
+ for j := l to FLevelsCount - 1 do
+ h := h + LevelHeights[j];
+
+ if Item.FSize.Y > h then
+ LevelHeights[FLevelsCount - 1] := LevelHeights[FLevelsCount - 1] + Item.FSize.Y - h;
+ end;
+ end;
+
+ { syncronize height of CornerMemos[0] and [1] }
+ if FCorner <> nil then
+ begin
+ if not FMemo.Visible then
+ FSize.Y := 0;
+ if not FCorner.FMemo.Visible then
+ FCorner.FSize.Y := 0;
+ h := FSize.Y;
+ if FCorner.FSize.Y > h then
+ h := FCorner.FSize.Y;
+ FSize.Y := h;
+ if not FNoLevels then
+ FCorner.FSize.Y := h;
+ end;
+
+// FillBounds(Self, frxPoint(0, 0));
+
+ { update height of CornerMemos[2..n] }
+ if FCorner <> nil then
+ begin
+ h := 0;
+ l := FLevelsCount - 1;
+ if HasCellHeaders then
+ Inc(l);
+ for i := 0 to l do
+ h := h + LevelHeights[i];
+ if FNoLevels then
+ h := h + FSize.Y;
+
+ for i := 0 to FCorner.Count - 1 do
+ if FCorner[i].FSize.Y > h then
+ begin
+ if l = 0 then
+ TfrxCrossHeader(Items[0]).FSize.Y := FCorner[i].FSize.Y
+ else
+ begin
+ hAvg := (FCorner[i].FSize.Y - h) / (l + 1);
+ for j := 0 to l do
+ LevelHeights[j] := LevelHeights[j] + hAvg; {normalize columns height}
+ end;
+ end
+ else FCorner[i].FSize.Y := h;
+ end;
+
+ FillBounds(Self, frxPoint(0, 0));
+ Items.Free;
+ LevelHeights := nil;
+
+end;
+
+procedure TfrxCrossColumnHeader.CalcSizes(MaxWidth, MinWidth: Integer; AutoSize: Boolean);
+var
+ i: Integer;
+ Items: TList;
+ Item: TfrxCrossHeader;
+ s: WideString;
+ m: TfrxCustomMemoView;
+begin
+ Items := AllItems;
+
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ m := Item.FMemo;
+ if m <> nil then
+ begin
+ if AutoSize or (((m.Width = 0) or (m.Height = 0)) and m.Visible) then
+ begin
+ m.Width := MaxWidth;
+ s := m.Text;
+ m.Text := m.FormatData(Item.Value);
+ if m.Lines.Count = 0 then
+ m.Text := ' ';
+ Item.FSize := CalcSize(m);
+ m.Text := s;
+ end
+ else
+ begin
+ if (Item.Count = 0) or (Item.Count = 1) then
+ Item.FSize.X := m.Width;
+ if not Item.IsTotal then
+ Item.FSize.Y := m.Height;
+ end;
+
+ if Item.FSize.X < MinWidth then
+ Item.FSize.X := MinWidth;
+ if Item.FSize.X > MaxWidth then
+ Item.FSize.X := MaxWidth;
+ end;
+ end;
+
+ Items.Free;
+end;
+
+
+{ TfrxCrossRowHeader }
+
+procedure TfrxCrossRowHeader.CalcBounds;
+var
+ i, j, l: Integer;
+ w: Extended;
+ Items: TList;
+ Item: TfrxCrossHeader;
+ LevelWidths: array of Extended;
+
+ function DoAdjust(Item: TfrxCrossHeader): Extended;
+ var
+ i: Integer;
+ Height: Extended;
+ begin
+ if Item.Count = 0 then
+ begin
+ Result := Item.FSize.Y;
+ Exit;
+ end;
+
+ Height := 0;
+ for i := 0 to Item.Count - 1 do
+ Height := Height + DoAdjust(Item[i]);
+
+ if Item.FSize.Y < Height then
+ Item.FSize.Y := Height
+ else
+ begin
+ Item[Item.Count - 1].FSize.Y := Item[Item.Count - 1].FSize.Y + Item.FSize.Y - Height;
+ DoAdjust(Item[Item.Count - 1]);
+ end;
+
+ Result := Item.FSize.Y;
+ end;
+
+ procedure FillBounds(Item: TfrxCrossHeader; Offset: TfrxPoint);
+ var
+ i, j, l: Integer;
+ w: Extended;
+ begin
+ l := Item.Level;
+ if l <> -1 then
+ w := LevelWidths[l] else
+ w := Item.FSize.X;
+
+ if Item.FIsCellHeader then
+ w := LevelWidths[FLevelsCount]
+ else if Item.IsTotal then
+ for j := l + 1 to FLevelsCount - 1 do
+ w := w + LevelWidths[j];
+
+ Item.FBounds := frxRect(Offset.X, Offset.Y, w, Item.FSize.Y);
+ Offset.X := Offset.X + w;
+
+ for i := 0 to Item.Count - 1 do
+ begin
+ FillBounds(Item[i], Offset);
+ Offset.Y := Offset.Y + Item[i].FSize.Y;
+ end;
+ end;
+
+begin
+ DoAdjust(Self);
+
+ SetLength(LevelWidths, FLevelsCount + 1);
+
+ Items := AllItems;
+
+// calculate maxwidth of each row
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ l := Item.Level;
+
+ // cell headers always adjust the last level width
+ if Item.FIsCellHeader then
+ l := FLevelsCount
+ // don't count total elemens unless they are on last level.
+ // such elements will be adjusted later
+ else if Item.IsTotal then
+ if l <> FLevelsCount - 1 then continue;
+
+ if l >= 0 then
+ if Item.FSize.X > LevelWidths[l] then
+ LevelWidths[l] := Item.FSize.X;
+ end;
+
+// adjust totals
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ l := Item.Level;
+
+ if Item.IsTotal and (l < FLevelsCount - 1) then
+ begin
+ w := 0;
+ for j := l to FLevelsCount - 1 do
+ w := w + LevelWidths[j];
+
+ if Item.FSize.X > w then
+ LevelWidths[FLevelsCount - 1] := LevelWidths[FLevelsCount - 1] + Item.FSize.X - w;
+ end;
+ end;
+
+// adjust corner
+ for i := 0 to FCorner.Count - 1 do
+ if FCorner[i].FSize.X > LevelWidths[i] then
+ LevelWidths[i] := FCorner[i].FSize.X
+ else
+ FCorner[i].FSize.X := LevelWidths[i];
+
+ FillBounds(Self, frxPoint(0, 0));
+
+ Items.Free;
+ LevelWidths := nil;
+end;
+
+procedure TfrxCrossRowHeader.CalcSizes(MaxWidth, MinWidth: Integer; AutoSize: Boolean);
+var
+ i: Integer;
+ Items: TList;
+ Item: TfrxCrossHeader;
+ s: WideString;
+ m: TfrxCustomMemoView;
+begin
+ Items := AllItems;
+
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ m := Item.FMemo;
+ if m <> nil then
+ begin
+ if AutoSize or (((m.Width = 0) or (m.Height = 0)) and m.Visible) then
+ begin
+ m.Width := MaxWidth;
+ s := m.Text;
+ m.Text := m.FormatData(Item.Value);
+ if m.Lines.Count = 0 then
+ m.Text := ' ';
+ Item.FSize := CalcSize(m);
+ m.Text := s;
+ end
+ else
+ begin
+ if Item.Count = 0 then
+ Item.FSize.Y := m.Height;
+ if not Item.IsTotal then
+ Item.FSize.X := m.Width;
+ end;
+
+ if Item.FSize.X < MinWidth then
+ Item.FSize.X := MinWidth;
+ if Item.FSize.X > MaxWidth then
+ Item.FSize.X := MaxWidth;
+ end;
+ end;
+
+ Items.Free;
+end;
+
+
+{ TfrxCutBandItem }
+
+destructor TfrxCutBandItem.Destroy;
+begin
+ Band.Free;
+ inherited;
+end;
+
+
+{ TfrxCutBands }
+
+constructor TfrxCutBands.Create;
+begin
+ inherited Create(TfrxCutBandItem);
+end;
+
+procedure TfrxCutBands.Add(ABand: TfrxBand; AFromIndex, AToIndex: Integer);
+begin
+ with TfrxCutBandItem(inherited Add) do
+ begin
+ Band := ABand;
+ FromIndex := AFromIndex;
+ ToIndex := AToIndex;
+ end;
+end;
+
+function TfrxCutBands.GetItems(Index: Integer): TfrxCutBandItem;
+begin
+ Result := TfrxCutBandItem(inherited Items[Index]);
+end;
+
+
+{ TfrxGridLineItem }
+
+constructor TfrxGridLineItem.Create(Collection: TCollection);
+begin
+ inherited;
+ Objects := TList.Create;
+end;
+
+destructor TfrxGridLineItem.Destroy;
+begin
+ Objects.Free;
+ inherited;
+end;
+
+
+{ TfrxGridLines }
+
+constructor TfrxGridLines.Create;
+begin
+ inherited Create(TfrxGridLineItem);
+end;
+
+procedure TfrxGridLines.Add(AObj: TObject; ACoord: Double);
+var
+ i: Integer;
+ Item: TfrxGridLineItem;
+begin
+ Item := nil;
+ for i := 0 to Count - 1 do
+ if Abs(Items[i].Coord - ACoord) < 1 then
+ begin
+ Item := Items[i];
+ break;
+ end;
+
+ if Item = nil then
+ Item := TfrxGridLineItem(inherited Add);
+
+ Item.Coord := ACoord;
+ Item.Objects.Add(AObj);
+end;
+
+function TfrxGridLines.GetItems(Index: Integer): TfrxGridLineItem;
+begin
+ Result := TfrxGridLineItem(inherited Items[Index]);
+end;
+
+
+{ TfrxCustomCrossView }
+
+constructor TfrxCustomCrossView.Create(AOwner: TComponent);
+var
+ i: Integer;
+begin
+ inherited;
+ Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
+ Color := claWhite;
+ frComponentStyle := frComponentStyle - [csPreviewVisible] + [csContainer];
+
+ FAllMemos := TList.Create;
+ FCellMemos := TList.Create;
+ FCellHeaderMemos := TList.Create;
+ FColumnMemos := TList.Create;
+ FColumnTotalMemos := TList.Create;
+ FCornerMemos := TList.Create;
+ FRowMemos := TList.Create;
+ FRowTotalMemos := TList.Create;
+
+ FCellFields := TStringList.Create;
+ FColumnFields := TStringList.Create;
+ FRowFields := TStringList.Create;
+ FColumnBands := TfrxCutBands.Create;
+ FRowBands := TfrxCutBands.Create;
+
+ FGridX := TfrxGridLines.Create;
+ FGridY := TfrxGridLines.Create;
+
+ FAutoSize := True;
+ FBorder := True;
+ FGapX := 3;
+ FGapY := 3;
+ FMaxWidth := 200;
+ FRepeatHeaders := True;
+ FShowColumnHeader := True;
+ FShowColumnTotal := True;
+ FShowRowHeader := True;
+ FShowRowTotal := True;
+ FShowCorner := True;
+ FShowTitle := True;
+ FAllowDuplicates := True;
+ FClearBeforePrint := True;
+ FSuppressNullRecords := True;
+
+ SetDotMatrix(Page is TfrxDMPPage);
+ CreateCornerMemos(3);
+ CellLevels := 1;
+ ColumnLevels := 1;
+ RowLevels := 1;
+
+ for i := 0 to 31 do
+ begin
+ FCellFunctions[i] := cfSum;
+ FColumnSort[i] := soAscending;
+ FRowSort[i] := soAscending;
+ end;
+end;
+
+destructor TfrxCustomCrossView.Destroy;
+begin
+ ClearMemos;
+ FAllMemos.Free;
+ FCellMemos.Free;
+ FCellHeaderMemos.Free;
+ FColumnMemos.Free;
+ FColumnTotalMemos.Free;
+ FCornerMemos.Free;
+ FRowMemos.Free;
+ FRowTotalMemos.Free;
+
+ FCellFields.Free;
+ FColumnFields.Free;
+ FRowFields.Free;
+
+ FColumnBands.Free;
+ FRowBands.Free;
+ FGridX.Free;
+ FGridY.Free;
+
+ ClearMatrix;
+ inherited;
+end;
+
+function TfrxCustomCrossView.GetCellFunctions(Index: Integer): TfrxCrossFunction;
+begin
+ Result := FCellFunctions[Index];
+end;
+
+function TfrxCustomCrossView.GetCellMemos(Index: Integer): TfrxCustomMemoView;
+begin
+ Result := FCellMemos[Index];
+end;
+
+function TfrxCustomCrossView.GetCellHeaderMemos(Index: Integer): TfrxCustomMemoView;
+begin
+ Result := FCellHeaderMemos[Index];
+end;
+
+function TfrxCustomCrossView.GetColumnMemos(Index: Integer): TfrxCustomMemoView;
+begin
+ Result := FColumnMemos[Index];
+end;
+
+function TfrxCustomCrossView.GetColumnTotalMemos(Index: Integer): TfrxCustomMemoView;
+begin
+ Result := FColumnTotalMemos[Index];
+end;
+
+function TfrxCustomCrossView.GetCornerMemos(Index: Integer): TfrxCustomMemoView;
+begin
+ Result := FCornerMemos[Index];
+end;
+
+function TfrxCustomCrossView.GetRowMemos(Index: Integer): TfrxCustomMemoView;
+begin
+ Result := FRowMemos[Index];
+end;
+
+function TfrxCustomCrossView.GetRowTotalMemos(Index: Integer): TfrxCustomMemoView;
+begin
+ Result := FRowTotalMemos[Index];
+end;
+
+function TfrxCustomCrossView.GetColumnSort(Index: Integer): TfrxCrossSortOrder;
+begin
+ Result := FColumnSort[Index];
+end;
+
+function TfrxCustomCrossView.GetRowSort(Index: Integer): TfrxCrossSortOrder;
+begin
+ Result := FRowSort[Index];
+end;
+
+procedure TfrxCustomCrossView.SetCellFunctions(Index: Integer;
+ const Value: TfrxCrossFunction);
+begin
+ FCellFunctions[Index] := Value;
+end;
+
+procedure TfrxCustomCrossView.SetColumnSort(Index: Integer; Value: TfrxCrossSortOrder);
+begin
+ FColumnSort[Index] := Value;
+end;
+
+procedure TfrxCustomCrossView.SetRowSort(Index: Integer; Value: TfrxCrossSortOrder);
+begin
+ FRowSort[Index] := Value;
+end;
+
+function TfrxCustomCrossView.ColCount: Integer;
+begin
+ Result := FColumns.Count;
+end;
+
+function TfrxCustomCrossView.RowCount: Integer;
+begin
+ Result := FRows.Count;
+end;
+
+function TfrxCustomCrossView.IsGrandTotalColumn(Index: Integer): Boolean;
+begin
+ Result := Index = FColumns.Count - 1;
+end;
+
+function TfrxCustomCrossView.IsGrandTotalRow(Index: Integer): Boolean;
+begin
+ Result := Index = FRows.Count - 1;
+end;
+
+function TfrxCustomCrossView.IsTotalColumn(Index: Integer): Boolean;
+var
+ i: Integer;
+begin
+ Result := False;
+
+ for i := 0 to FColumns.FIndexesCount - 1 do
+ if VarToStr(FColumns[Index].Indexes[i]) = '@@@' then
+ Result := True;
+end;
+
+function TfrxCustomCrossView.IsTotalRow(Index: Integer): Boolean;
+var
+ i: Integer;
+begin
+ Result := False;
+
+ for i := 0 to FRows.FIndexesCount - 1 do
+ if VarToStr(FRows[Index].Indexes[i]) = '@@@' then
+ Result := True;
+end;
+
+function TfrxCustomCrossView.GetColumnIndexes(AColumn: Integer): Variant;
+begin
+ Result := FColumns[AColumn].Indexes;
+end;
+
+function TfrxCustomCrossView.GetRowIndexes(ARow: Integer): Variant;
+begin
+ Result := FRows[ARow].Indexes;
+end;
+
+procedure TfrxCustomCrossView.SetCellFields(const Value: TStrings);
+begin
+ FCellFields.Assign(Value);
+end;
+
+procedure TfrxCustomCrossView.SetColumnFields(const Value: TStrings);
+begin
+ FColumnFields.Assign(Value);
+end;
+
+procedure TfrxCustomCrossView.SetRowFields(const Value: TStrings);
+begin
+ FRowFields.Assign(Value);
+end;
+
+procedure TfrxCustomCrossView.SetCellLevels(const Value: Integer);
+var
+ max: Integer;
+begin
+ FCellLevels := Value;
+ CreateCellMemos(FCellLevels * (FRowLevels + 1) * (FColumnLevels + 1));
+ max := FRowLevels;
+ if FColumnLevels > max then
+ max := FColumnLevels;
+ CreateCellHeaderMemos(FCellLevels * (max + 1));
+end;
+
+procedure TfrxCustomCrossView.SetColumnLevels(const Value: Integer);
+var
+ max, lvl: Integer;
+begin
+ FColumnLevels := Value;
+ lvl := FColumnLevels;
+ if lvl = 0 then
+ lvl := 1;
+ CreateColumnMemos(lvl);
+ CreateCellMemos(FCellLevels * (FRowLevels + 1) * (FColumnLevels + 1));
+ max := FRowLevels;
+ if FColumnLevels > max then
+ max := FColumnLevels;
+ CreateCellHeaderMemos(FCellLevels * (max + 1));
+end;
+
+procedure TfrxCustomCrossView.SetRowLevels(const Value: Integer);
+var
+ max, lvl: Integer;
+begin
+ FRowLevels := Value;
+ lvl := FRowLevels;
+ if lvl = 0 then
+ lvl := 1;
+ CreateRowMemos(lvl);
+ CreateCornerMemos(FRowLevels + 3);
+ CreateCellMemos(FCellLevels * (FRowLevels + 1) * (FColumnLevels + 1));
+ max := FRowLevels;
+ if FColumnLevels > max then
+ max := FColumnLevels;
+ CreateCellHeaderMemos(FCellLevels * (max + 1));
+end;
+
+procedure TfrxCustomCrossView.SetDotMatrix(const Value: Boolean);
+begin
+ FDotMatrix := Value;
+ if FDotMatrix then
+ begin
+ FGapX := 0;
+ FGapY := 0;
+ end;
+end;
+
+function TfrxCustomCrossView.IsCrossValid: Boolean;
+begin
+ Result := True;
+end;
+
+function TfrxCustomCrossView.ColumnHeaderHeight: Double;
+begin
+ Result := ColumnHeader.Height;
+end;
+
+function TfrxCustomCrossView.RowHeaderWidth: Double;
+begin
+ Result := RowHeader.Width;
+ if FNoRows then
+ Result := 0;
+end;
+
+procedure TfrxCustomCrossView.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FNextCross) then
+ FNextCross := nil;
+end;
+
+procedure TfrxCustomCrossView.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ Filer.DefineBinaryProperty('Memos', ReadMemos, WriteMemos, True);
+end;
+
+procedure TfrxCustomCrossView.ReadMemos(Stream: TStream);
+var
+ x: TfrxXMLDocument;
+ i: Integer;
+
+ procedure GetItem(m: TfrxCustomMemoView; const Name: String; Index: Integer);
+ var
+ xs: TfrxXMLSerializer;
+ Item: TfrxXMLItem;
+ begin
+ Item := x.Root.FindItem(Name);
+ if Index >= Item.Count then Exit;
+ Item := Item[Index];
+
+ xs := TfrxXMLSerializer.Create(nil);
+ xs.OldFormat := x.OldVersion;
+ m.Color := claNull;
+ m.Frame.Color := claBlack;
+ m.Frame.Width := 1;
+ m.Frame.Typ := [];
+ m.Font.Style := [];
+ m.HAlign := haLeft;
+ m.VAlign := vaTop;
+ xs.ReadRootComponent(m, Item);
+ xs.Free;
+ end;
+
+ function GetItem1(const Name: String; Index: Integer): TfrxCrossFunction;
+ var
+ Item: TfrxXMLItem;
+ begin
+ Result := cfNone;
+ Item := x.Root.FindItem(Name);
+ if Index >= Item.Count then Exit;
+ Item := Item[Index];
+ Result := TfrxCrossFunction(StrToInt(Item.Text));
+ end;
+
+ function GetItem2(const Name: String; Index: Integer): TfrxCrossSortOrder;
+ var
+ Item: TfrxXMLItem;
+ begin
+ Result := soAscending;
+ Item := x.Root.FindItem(Name);
+ if Index >= Item.Count then Exit;
+ Item := Item[Index];
+ Result := TfrxCrossSortOrder(StrToInt(Item.Text));
+ end;
+
+begin
+ x := TfrxXMLDocument.Create;
+
+ try
+ x.LoadFromStream(Stream);
+
+ for i := 0 to FCellLevels - 1 do
+ CellFunctions[i] := GetItem1('cellfunctions', i);
+
+ for i := 0 to FCellHeaderMemos.Count - 1 do
+ GetItem(CellHeaderMemos[i], 'cellheadermemos', i);
+
+ for i := 0 to FCellMemos.Count - 1 do
+ GetItem(CellMemos[i], 'cellmemos', i);
+
+ for i := 0 to FColumnMemos.Count - 1 do
+ begin
+ GetItem(ColumnMemos[i], 'columnmemos', i);
+ GetItem(ColumnTotalMemos[i], 'columntotalmemos', i);
+ ColumnSort[i] := GetItem2('columnsort', i);
+ end;
+
+ for i := 0 to FRowMemos.Count - 1 do
+ begin
+ GetItem(RowMemos[i], 'rowmemos', i);
+ GetItem(RowTotalMemos[i], 'rowtotalmemos', i);
+ RowSort[i] := GetItem2('rowsort', i);
+ end;
+
+ for i := 0 to FCornerMemos.Count - 1 do
+ GetItem(CornerMemos[i], 'cornermemos', i);
+
+ finally
+ x.Free;
+ end;
+end;
+
+procedure TfrxCustomCrossView.WriteMemos(Stream: TStream);
+var
+ x: TfrxXMLDocument;
+ i: Integer;
+
+ procedure AddItem(m: TfrxCustomMemoView; const Name: String);
+ var
+ xs: TfrxXMLSerializer;
+ begin
+ xs := TfrxXMLSerializer.Create(nil);
+ xs.WriteRootComponent(m, True, x.Root.FindItem(Name).Add);
+ xs.Free;
+ end;
+
+ procedure AddItem1(f: TfrxCrossFunction; const Name: String);
+ var
+ Item: TfrxXMLItem;
+ begin
+ Item := x.Root.FindItem(Name);
+ Item := Item.Add;
+ Item.Name := 'item';
+ Item.Text := IntToStr(Integer(f));
+ end;
+
+ procedure AddItem2(f: TfrxCrossSortOrder; const Name: String);
+ var
+ Item: TfrxXMLItem;
+ begin
+ Item := x.Root.FindItem(Name);
+ Item := Item.Add;
+ Item.Name := 'item';
+ Item.Text := IntToStr(Integer(f));
+ end;
+
+begin
+ x := TfrxXMLDocument.Create;
+ x.Root.Name := 'cross';
+
+ try
+ x.Root.Add.Name := 'cellmemos';
+ x.Root.Add.Name := 'cellheadermemos';
+ x.Root.Add.Name := 'columnmemos';
+ x.Root.Add.Name := 'columntotalmemos';
+ x.Root.Add.Name := 'cornermemos';
+ x.Root.Add.Name := 'rowmemos';
+ x.Root.Add.Name := 'rowtotalmemos';
+ x.Root.Add.Name := 'cellfunctions';
+ x.Root.Add.Name := 'columnsort';
+ x.Root.Add.Name := 'rowsort';
+
+ for i := 0 to FCellLevels - 1 do
+ AddItem1(CellFunctions[i], 'cellfunctions');
+
+ for i := 0 to FCellHeaderMemos.Count - 1 do
+ AddItem(CellHeaderMemos[i], 'cellheadermemos');
+
+ for i := 0 to FCellMemos.Count - 1 do
+ AddItem(CellMemos[i], 'cellmemos');
+
+ for i := 0 to FColumnMemos.Count - 1 {FColumnLevels - 1} do
+ begin
+ AddItem(ColumnMemos[i], 'columnmemos');
+ AddItem(ColumnTotalMemos[i], 'columntotalmemos');
+ AddItem2(ColumnSort[i], 'columnsort');
+ end;
+
+ for i := 0 to FRowMemos.Count - 1 {FRowLevels - 1} do
+ begin
+ AddItem(RowMemos[i], 'rowmemos');
+ AddItem(RowTotalMemos[i], 'rowtotalmemos');
+ AddItem2(RowSort[i], 'rowsort');
+ end;
+
+ for i := 0 to FCornerMemos.Count - 1 do
+ AddItem(CornerMemos[i], 'cornermemos');
+
+ x.SaveToStream(Stream);
+ finally
+ x.Free;
+ end;
+end;
+
+procedure TfrxCustomCrossView.CreateCellHeaderMemos(NewCount: Integer);
+var
+ i: Integer;
+ m: TfrxCustomMemoView;
+begin
+ for i := FCellHeaderMemos.Count to NewCount - 1 do
+ begin
+ m := CreateMemo(nil);
+ FCellHeaderMemos.Add(m);
+ m.Restrictions := [rfDontDelete];
+ m.VAlign := vaCenter;
+ m.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
+ m.AllowExpressions := False;
+ end;
+end;
+
+procedure TfrxCustomCrossView.CreateCellMemos(NewCount: Integer);
+var
+ i: Integer;
+ m: TfrxCustomMemoView;
+begin
+ for i := FCellMemos.Count to NewCount - 1 do
+ begin
+ m := CreateMemo(nil);
+ FCellMemos.Add(m);
+ m.Restrictions := [rfDontDelete];
+ m.HAlign := haRight;
+ m.VAlign := vaCenter;
+ m.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
+ m.AllowExpressions := False;
+ end;
+end;
+
+procedure TfrxCustomCrossView.CreateColumnMemos(NewCount: Integer);
+var
+ i: Integer;
+ m: TfrxCustomMemoView;
+begin
+ for i := FColumnMemos.Count to NewCount - 1 do
+ begin
+ m := CreateMemo(nil);
+ FColumnMemos.Add(m);
+ m.Restrictions := [rfDontDelete, rfDontEdit];
+ m.HAlign := haCenter;
+ m.VAlign := vaCenter;
+ m.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
+ m.AllowExpressions := False;
+
+ m := CreateMemo(nil);
+ FColumnTotalMemos.Add(m);
+ m.Restrictions := [rfDontDelete];
+ if i = 0 then
+ m.Text := 'Grand Total'
+ else
+ m.Text := 'Total';
+ m.Font.Style := [TFontStyle.fsBold];
+ m.HAlign := haCenter;
+ m.VAlign := vaCenter;
+ m.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
+ end;
+end;
+
+procedure TfrxCustomCrossView.CreateRowMemos(NewCount: Integer);
+var
+ i: Integer;
+ m: TfrxCustomMemoView;
+begin
+ for i := FRowMemos.Count to NewCount - 1 do
+ begin
+ m := CreateMemo(nil);
+ FRowMemos.Add(m);
+ m.Restrictions := [rfDontDelete, rfDontEdit];
+ m.HAlign := haCenter;
+ m.VAlign := vaCenter;
+ m.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
+ m.AllowExpressions := False;
+
+ m := CreateMemo(nil);
+ FRowTotalMemos.Add(m);
+ m.Restrictions := [rfDontDelete];
+ if i = 0 then
+ m.Text := 'Grand Total'
+ else
+ m.Text := 'Total';
+ m.Font.Style := [TFontStyle.fsBold];
+ m.HAlign := haCenter;
+ m.VAlign := vaCenter;
+ m.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
+ end;
+end;
+
+procedure TfrxCustomCrossView.CreateCornerMemos(NewCount: Integer);
+var
+ i: Integer;
+ m: TfrxCustomMemoView;
+begin
+ for i := FCornerMemos.Count to NewCount - 1 do
+ begin
+ m := CreateMemo(nil);
+ FCornerMemos.Add(m);
+ m.Restrictions := [rfDontDelete];
+ m.HAlign := haCenter;
+ m.VAlign := vaCenter;
+ m.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
+ m.AllowExpressions := False;
+ end;
+end;
+
+procedure TfrxCustomCrossView.ClearMemos;
+begin
+ while FCellHeaderMemos.Count > 0 do
+ begin
+ CellHeaderMemos[0].Free;
+ FCellHeaderMemos.Delete(0);
+ end;
+ while FCellMemos.Count > 0 do
+ begin
+ CellMemos[0].Free;
+ FCellMemos.Delete(0);
+ end;
+ while FColumnMemos.Count > 0 do
+ begin
+ ColumnMemos[0].Free;
+ FColumnMemos.Delete(0);
+ ColumnTotalMemos[0].Free;
+ FColumnTotalMemos.Delete(0);
+ end;
+ while FRowMemos.Count > 0 do
+ begin
+ RowMemos[0].Free;
+ FRowMemos.Delete(0);
+ RowTotalMemos[0].Free;
+ FRowTotalMemos.Delete(0);
+ end;
+ while FCornerMemos.Count > 0 do
+ begin
+ CornerMemos[0].Free;
+ FCornerMemos.Delete(0);
+ end;
+end;
+
+procedure TfrxCustomCrossView.InitMatrix;
+var
+ ColL, RowL: Integer;
+begin
+ ClearMatrix;
+
+ RowL := FRowLevels;
+ FNoRows := FRowLevels = 0;
+ if FNoRows then
+ RowL := 1;
+ ColL := FColumnLevels;
+ FNoColumns := FColumnLevels = 0;
+ if FNoColumns then
+ ColL := 1;
+
+ FRows := TfrxCrossRows.Create;
+ FRows.FIndexesCount := RowL;
+ FRows.FSortOrder := FRowSort;
+ FRows.FCellLevels := FCellLevels;
+
+ FColumns := TfrxCrossColumns.Create;
+ FColumns.FIndexesCount := ColL;
+ FColumns.FSortOrder := FColumnSort;
+
+ FCorner := TfrxCrossCorner.Create(1);
+ FCorner.FMemo := CornerMemos[0];
+ FCorner.Value := CornerMemos[0].Text;
+ FCorner.FLevelsCount := 1;
+
+ FRowHeader := TfrxCrossRowHeader.Create(FCellLevels);
+ FRowHeader.FMemos := FRowMemos;
+ FRowHeader.FTotalMemos := FRowTotalMemos;
+ FRowHeader.FLevelsCount := RowL;
+ FRowHeader.HasCellHeaders := (FCellLevels > 1) and not FPlainCells;
+ FRowHeader.FCorner := FCorner;
+ FRowHeader.FNoLevels := FNoRows;
+
+ FColumnHeader := TfrxCrossColumnHeader.Create(FCellLevels);
+ FColumnHeader.FMemos := FColumnMemos;
+ FColumnHeader.FTotalMemos := FColumnTotalMemos;
+ FColumnHeader.FMemo := CornerMemos[1];
+ FColumnHeader.Value := CornerMemos[1].Text;
+ FColumnHeader.FLevelsCount := ColL;
+ FColumnHeader.HasCellHeaders := (FCellLevels > 1) and FPlainCells;
+ FColumnHeader.FCorner := FCorner;
+ FColumnHeader.FNoLevels := FNoColumns;
+end;
+
+function TfrxCustomCrossView.GetNestedObjects: TList;
+var
+ i: Integer;
+ NestedObjects: TList;
+
+ procedure DoNested(Memo: TfrxCustomMemoView);
+ var
+ i: Integer;
+ c: TfrxComponent;
+ begin
+ for i := 0 to Memo.Objects.Count - 1 do
+ begin
+ c := Memo.Objects[i];
+ NestedObjects.Add(c);
+ end;
+ end;
+
+begin
+ NestedObjects := TList.Create;
+
+ for i := 0 to FCellHeaderMemos.Count - 1 do
+ DoNested(CellHeaderMemos[i]);
+
+ for i := 0 to FCellMemos.Count - 1 do
+ DoNested(CellMemos[i]);
+
+ for i := 0 to FColumnMemos.Count - 1 do
+ begin
+ DoNested(ColumnMemos[i]);
+ DoNested(ColumnTotalMemos[i]);
+ end;
+
+ for i := 0 to FRowMemos.Count - 1 do
+ begin
+ DoNested(RowMemos[i]);
+ DoNested(RowTotalMemos[i]);
+ end;
+
+ for i := 0 to FCornerMemos.Count - 1 do
+ DoNested(CornerMemos[i]);
+
+ Result := NestedObjects;
+end;
+
+procedure TfrxCustomCrossView.InitMemos(AddToScript: Boolean);
+var
+ i: Integer;
+ m: TfrxCustomMemoView;
+ NestedObjects: TList;
+begin
+ for i := 0 to FCellHeaderMemos.Count - 1 do
+ begin
+ m := CellHeaderMemos[i];
+ m.GapX := FGapX;
+ m.GapY := FGapY;
+ m.Visible := True;
+ m.Name := Name + 'CellHeader' + IntToStr(i);
+ if AddToScript then
+ Report.Script.AddObject(m.Name, m);
+ end;
+
+ for i := 0 to FCellMemos.Count - 1 do
+ begin
+ m := CellMemos[i];
+ m.GapX := FGapX;
+ m.GapY := FGapY;
+ m.Name := Name + 'Cell' + IntToStr(i);
+ if AddToScript then
+ Report.Script.AddObject(m.Name, m);
+ end;
+
+ for i := 0 to FColumnMemos.Count - 1 do
+ begin
+ m := ColumnMemos[i];
+ m.GapX := FGapX;
+ m.GapY := FGapY;
+ m.Visible := True;
+ m.Name := Name + 'Column' + IntToStr(i);
+ if AddToScript then
+ Report.Script.AddObject(m.Name, m);
+
+ m := ColumnTotalMemos[i];
+ m.GapX := FGapX;
+ m.GapY := FGapY;
+ m.AllowExpressions := False;
+ m.Name := Name + 'ColumnTotal' + IntToStr(i);
+ if AddToScript then
+ Report.Script.AddObject(m.Name, m);
+ end;
+
+ for i := 0 to FRowMemos.Count - 1 do
+ begin
+ m := RowMemos[i];
+ m.GapX := FGapX;
+ m.GapY := FGapY;
+ m.Visible := true;
+ m.Name := Name + 'Row' + IntToStr(i);
+ if AddToScript then
+ Report.Script.AddObject(m.Name, m);
+
+ m := RowTotalMemos[i];
+ m.GapX := FGapX;
+ m.GapY := FGapY;
+ m.AllowExpressions := False;
+ m.Name := Name + 'RowTotal' + IntToStr(i);
+ if AddToScript then
+ Report.Script.AddObject(m.Name, m);
+ end;
+
+ for i := 0 to FCornerMemos.Count - 1 do
+ begin
+ m := CornerMemos[i];
+ m.GapX := FGapX;
+ m.GapY := FGapY;
+ if i > 2 then
+ m.Visible := True;
+ m.Name := Name + 'Corner' + IntToStr(i);
+ if AddToScript then
+ Report.Script.AddObject(m.Name, m);
+ end;
+
+ NestedObjects := GetNestedObjects;
+
+ for i := 0 to NestedObjects.Count - 1 do
+ begin
+ m := NestedObjects[i];
+ m.Name := Name + 'Object' + IntToStr(m.Tag);
+ if AddToScript then
+ Report.Script.AddObject(m.Name, m);
+ end;
+
+ NestedObjects.Free;
+end;
+
+procedure TfrxCustomCrossView.ClearMatrix;
+begin
+ FRows.Free;
+ FRows := nil;
+ FColumns.Free;
+ FColumns := nil;
+ FCorner.Free;
+ FCorner := nil;
+ FRowHeader.Free;
+ FRowHeader := nil;
+ FColumnHeader.Free;
+ FColumnHeader := nil;
+end;
+
+procedure TfrxCustomCrossView.AddValue(const Rows, Columns, Cells: array of Variant);
+var
+ i: Integer;
+ Row: TfrxCrossRow;
+ Column: TfrxCrossColumn;
+ Cell: PfrCrossCell;
+ Value, v: Variant;
+ isNull: Boolean;
+begin
+ if not IsCrossValid then
+ raise Exception.Create('Cross-tab is not valid');
+ if FRows = nil then Exit;
+
+ { check for all nulls }
+ isNull := True;
+ for i := Low(Rows) to High(Rows) do
+ if not VarIsNull(Rows[i]) then
+ isNull := False;
+ if isNull then
+ begin
+ for i := Low(Columns) to High(Columns) do
+ if not VarIsNull(Columns[i]) then
+ isNull := False;
+ if isNull then
+ begin
+ for i := Low(Cells) to High(Cells) do
+ if not VarIsNull(Cells[i]) then
+ isNull := False;
+ end;
+ end;
+
+ if isNull and FSuppressNullRecords then Exit;
+
+ if FNoColumns then
+ Column := FColumns.Column([Null]) else
+ Column := FColumns.Column(Columns);
+ if FNoRows then
+ Row := FRows.Row([Null]) else
+ Row := FRows.Row(Rows);
+
+ Cell := Row.GetCell(Column.CellIndex);
+
+ for i := 0 to FCellLevels - 1 do
+ begin
+ Value := Cell.Value;
+ v := Cells[i];
+
+ if FCellFunctions[i] = cfCount then
+ begin
+ if v = Null then
+ v := 0
+ else
+ v := 1;
+ end;
+
+ if Value = Null then
+ Cell.Value := v
+ else if (TVarData(Value).VType = varString) or (TVarData(Value).VType = varOleStr) or (TVarData(Value).VType = varUString) then
+ begin
+ if FAllowDuplicates or
+ (Pos(#13#10 + v + #13#10, #13#10 + Cell.Value + #13#10) = 0) then
+ Cell.Value := Value + #13#10 + v
+ end
+ else
+ Cell.Value := Value + v;
+
+ Cell := Cell.Next;
+ end;
+end;
+
+function TfrxCustomCrossView.GetValue(ARow, AColumn, ACell: Integer): Variant;
+var
+ Row: TfrxCrossRow;
+ Column: TfrxCrossColumn;
+ Cell: PfrCrossCell;
+begin
+ Result := Null;
+ Column := FColumns[AColumn];
+ Row := FRows[ARow];
+ Cell := Row.GetCell(Column.CellIndex);
+
+ while (Cell <> nil) and (ACell > 0) do
+ begin
+ Cell := Cell.Next;
+ Dec(ACell);
+ end;
+
+ if Cell <> nil then
+ Result := Cell.Value;
+end;
+
+procedure TfrxCustomCrossView.CreateHeader(Header: TfrxCrossHeader;
+ Source: TfrxIndexCollection; Totals: TList; TotalVisible: Boolean);
+var
+ i, j, IndexesCount: Integer;
+ LastValues, CurValues: TfrxVariantArray;
+ Unsorted: Boolean;
+
+ function ExpandVariable(s: String; const Value: Variant): String;
+ var
+ i: Integer;
+ begin
+ { expand the [Value] macro if any (eg. if total memo contains
+ the text: 'Total of [Value]' }
+ i := Pos('[VALUE]', AnsiUppercase(s));
+ if i <> 0 then
+ begin
+ Delete(s, i, 7);
+ Insert(VarToStr(Value), s, i);
+ end;
+ Result := s;
+ end;
+
+ procedure AddTotals;
+ var
+ j, k: Integer;
+ begin
+ for j := 0 to IndexesCount - 1 do
+ { if value changed... }
+ if LastValues[j] <> CurValues[j] then
+ begin
+ { ...create subtotals for all down-level values }
+ for k := IndexesCount - 1 downto j + 1 do
+ if TfrxCustomMemoView(Totals[k]).Visible then
+ begin
+ { '@@@' means that this is subtotal cell }
+ LastValues[k] := '@@@' +
+ ExpandVariable(TfrxCustomMemoView(Totals[k]).Text, LastValues[k - 1]);
+ { create header cells... }
+ Header.AddValues(LastValues, Unsorted);
+ LastValues[k] := '@@@';
+ { ...and row/column item }
+ Source.InsertItem(i, LastValues);
+ Inc(i);
+ end;
+ break;
+ end;
+ end;
+
+begin
+ if Source.Count = 0 then Exit;
+ Unsorted := (Source.FSortOrder[0] = soNone);
+ IndexesCount := Source.FIndexesCount;
+ { copy first indexes to lastvalues }
+ LastValues := Copy(Source.Items[0].Indexes, 0, IndexesCount);
+ i := 0;
+
+ while i < Source.Count do
+ begin
+ { copy current indexes to curvalues }
+ CurValues := Copy(Source.Items[i].Indexes, 0, IndexesCount);
+ { if lastvalues <> curvalues, make a subtotal item }
+ AddTotals;
+ { add header cells }
+ Header.AddValues(CurValues, Unsorted);
+
+ LastValues := CurValues;
+ Inc(i);
+ end;
+
+ { create last subtotal item }
+ CurValues := Copy(Source.Items[0].Indexes, 0, IndexesCount);
+ for j := 0 to IndexesCount - 1 do
+ CurValues[j] := Null;
+ AddTotals;
+
+ { create grand total }
+ if TotalVisible and TfrxCustomMemoView(Totals[0]).Visible then
+ begin
+ LastValues[0] := '@@@' + TfrxCustomMemoView(Totals[0]).Text;
+ Header.AddValues(LastValues, Unsorted);
+ LastValues[0] := '@@@';
+ Source.InsertItem(i, LastValues);
+ end;
+end;
+
+procedure TfrxCustomCrossView.CreateHeaders;
+var
+ i: Integer;
+begin
+ CreateHeader(FColumnHeader, FColumns, FColumnTotalMemos, not FNoColumns);
+ CreateHeader(FRowHeader, FRows, FRowTotalMemos, not FNoRows);
+
+ { add corner elements }
+ for i := 0 to FRowLevels - 1 do
+ FCorner.AddChild(FCornerMemos[3 + i]);
+ if FRowHeader.HasCellHeaders then
+ FCorner.AddChild(FCornerMemos[2]);
+end;
+
+procedure TfrxCustomCrossView.CalcTotal(Header: TfrxCrossHeader;
+ Source: TfrxIndexCollection);
+var
+ i, j: Integer;
+ Items: TList;
+ Values, Counts: TfrxVariantArray;
+ Item: TfrxCrossHeader;
+ p: PfrCrossCell;
+ FinalPass: Boolean;
+
+ procedure CellToArrays(p: PfrCrossCell);
+ var
+ i: Integer;
+ begin
+ for i := 0 to FCellLevels - 1 do
+ begin
+ Values[i] := p.Value;
+ Counts[i] := p.Count;
+
+ if (FCellFunctions[i] = cfAvg) and FinalPass and (p.Count <> 0) then
+ p.Value := p.Value / p.Count;
+
+ p := p.Next;
+ end;
+ end;
+
+ procedure ArraysToCell(p: PfrCrossCell);
+ var
+ i: Integer;
+ begin
+ for i := 0 to FCellLevels - 1 do
+ begin
+ p.Value := Item.FFuncValues[i];
+ p.Count := Item.FCounts[i];
+
+ if (FCellFunctions[i] = cfAvg) and FinalPass then
+ if p.Count <> 0 then
+ p.Value := p.Value / p.Count else
+ p.Value := 0;
+
+ if (FCellFunctions[i] = cfCount) and not FinalPass then
+ p.Count := p.Value;
+
+ p := p.Next;
+ end;
+ end;
+
+begin
+ Items := Header.TerminalItems;
+ SetLength(Values, FCellLevels);
+ SetLength(Counts, FCellLevels);
+ FinalPass := Source = FColumns;
+
+ { scan the matrix }
+ for i := 0 to Source.Count - 1 do
+ begin
+ for j := 0 to Items.Count - 1 do
+ TfrxCrossHeader(Items[j]).Reset(FCellFunctions);
+
+ for j := 0 to Items.Count - 1 do
+ begin
+ Item := Items[j];
+ if Source = FRows then
+ p := FRows[i].GetCell(FColumns[j].CellIndex) else
+ p := FRows[j].GetCell(FColumns[i].CellIndex);
+
+ if not Item.IsTotal then
+ begin
+ { convert cell values to Values and Counts arrays }
+ CellToArrays(p);
+ { accumulate values in the header items }
+ Item.AddFuncValues(Values, Counts, FCellFunctions);
+ end
+ else
+ begin
+ { get the accumulated values from the item's parent }
+ Item := Item.Parent;
+ { and convert it to the cell }
+ ArraysToCell(p);
+ end;
+ end;
+ end;
+
+ Items.Free;
+ Values := nil;
+ Counts := nil;
+end;
+
+procedure TfrxCustomCrossView.CalcTotals;
+begin
+ { scan the matrix from left to right, then from top to bottom }
+ CalcTotal(FColumnHeader, FRows);
+ { final pass, scan the matrix from top to bottom, then from left to right }
+ CalcTotal(FRowHeader, FColumns);
+end;
+
+procedure TfrxCustomCrossView.CalcBounds;
+var
+ i, j, k: Integer;
+ ColumnItems, RowItems: TList;
+ ColumnItem, RowItem: TfrxCrossHeader;
+ Cell: PfrCrossCell;
+ m: TfrxCustomMemoView;
+ NewHeight: Extended;
+ Size: TfrxPoint;
+
+ procedure DoCalc(const Value: Variant);
+ var
+ i, r: Integer;
+ s: WideString;
+ Width, NewWidth: Extended;
+ WidthChanged: Boolean;
+ begin
+ s := m.Text;
+ m.Text := m.FormatData(Value, CellMemos[k].DisplayFormat);
+ r := m.Rotation;
+ m.Rotation := 0;
+
+ Width := FMaxWidth;
+ NewWidth := Width;
+ DoCalcWidth(j, NewWidth);
+ m.Width := NewWidth;
+ WidthChanged := NewWidth <> Width;
+
+ Size := CalcSize(m);
+ Size.X := Size.X + FAddWidth;
+ Size.Y := Size.Y + FAddHeight;
+ if Size.X > FMaxWidth then
+ Size.X := FMaxWidth;
+ if Size.X < FMinWidth then
+ Size.X := FMinWidth;
+ if WidthChanged then
+ begin
+ Size.X := NewWidth;
+ ColumnItem.FSize.X := Size.X;
+ for i := 0 to ColumnItem.Count - 1 do
+ ColumnItem[i].FSize.X := NewWidth;
+ end;
+ if FDefHeight <> 0 then
+ Size.Y := FDefHeight;
+ if NewWidth = 0 then
+ Size.Y := 0;
+
+ m.Rotation := r;
+ m.Text := s;
+ end;
+
+begin
+ ColumnItems := FColumnHeader.TerminalItems;
+ RowItems := FRowHeader.TerminalItems;
+
+ { create cell headers }
+ if FCellLevels > 1 then
+ if FPlainCells then
+ begin
+ for i := 0 to ColumnItems.Count - 1 do
+ begin
+ ColumnItem := ColumnItems[i];
+ for j := 0 to FCellLevels - 1 do
+ ColumnItem.AddCellHeader(FCellHeaderMemos, i, j);
+ end;
+ end
+ else
+ begin
+ for i := 0 to RowItems.Count - 1 do
+ begin
+ RowItem := RowItems[i];
+ for j := 0 to FCellLevels - 1 do
+ RowItem.AddCellHeader(FCellHeaderMemos, i, j);
+ end;
+ end;
+
+ { calculate the widths of columns and the heights of rows }
+ FColumnHeader.CalcSizes(FMaxWidth, FMinWidth, FAutoSize);
+ FRowHeader.CalcSizes(FMaxWidth, FMinWidth, FAutoSize);
+ FCorner.CalcSizes(FMaxWidth, FMinWidth, FAutoSize);
+
+ { scanning the matrix cells and update calculated widths and heights }
+ for i := 0 to RowItems.Count - 1 do
+ begin
+ RowItem := RowItems[i];
+ RowItem.FIsIndex := True;
+ RowItem.FIndex := i;
+
+ for j := 0 to ColumnItems.Count - 1 do
+ begin
+ ColumnItem := ColumnItems[j];
+ ColumnItem.FIsIndex := True;
+ ColumnItem.FIndex := j;
+ if not FAutoSize then continue;
+
+ Cell := FRows[i].GetCell(FColumns[j].CellIndex);
+
+ for k := 0 to FCellLevels - 1 do
+ begin
+ m := CellMemos[ColumnItem.FTotalIndex * ((FRowLevels + 1) * FCellLevels) +
+ RowItem.FTotalIndex * FCellLevels + k];
+
+ DoCalc(Cell.Value);
+
+ if FCellLevels > 1 then
+ if FPlainCells then
+ begin
+ if ColumnItem[k].FSize.X < Size.X then
+ ColumnItem[k].FSize.X := Size.X;
+ if RowItem.FSize.Y < Size.Y then
+ RowItem.FSize.Y := Size.Y;
+ end
+ else
+ begin
+ if RowItem[k].FSize.Y < Size.Y then
+ RowItem[k].FSize.Y := Size.Y;
+ if ColumnItem.FSize.X < Size.X then
+ ColumnItem.FSize.X := Size.X;
+ end
+ else
+ begin
+ if RowItem.FSize.Y < Size.Y then
+ RowItem.FSize.Y := Size.Y;
+ if ColumnItem.FSize.X < Size.X then
+ ColumnItem.FSize.X := Size.X;
+ end;
+
+ Cell := Cell.Next;
+ end;
+ end;
+
+ NewHeight := RowItem.FSize.Y;
+ DoCalcHeight(i, NewHeight);
+ RowItem.FSize.Y := NewHeight;
+ end;
+
+ { calculate the positions and sizes of the header cells }
+ FCorner.CalcBounds;
+ FColumnHeader.CalcBounds;
+ FRowHeader.CalcBounds;
+ { recalc corner again - it may be adjusted in rowheader }
+ FCorner.CalcBounds;
+
+ ColumnItems.Free;
+ RowItems.Free;
+end;
+
+function TfrxCustomCrossView.CreateMemo(Parent: TfrxComponent): TfrxCustomMemoView;
+begin
+ if FDotMatrix then
+ Result := TfrxDMPMemoView.Create(Parent)
+ else
+ Result := TfrxMemoView.Create(Parent);
+end;
+
+procedure TfrxCustomCrossView.CorrectDMPBounds(Memo: TfrxCustomMemoView);
+begin
+ if Memo is TfrxDMPMemoView then
+ begin
+ Memo.Left := Memo.Left + fr1CharX;
+ Memo.Top := Memo.Top + fr1CharY;
+ Memo.Width := Memo.Width - fr1CharX;
+ Memo.Height := Memo.Height - fr1CharY;
+ end;
+end;
+
+function TfrxCustomCrossView.GetContainerObjects: TList;
+begin
+ Result := FAllMemos;
+end;
+
+function TfrxCustomCrossView.ContainerAdd(Obj: TfrxComponent): Boolean;
+var
+ i, j, n: Integer;
+ c: TfrxComponent;
+ Offset: TfrxPoint;
+ NestedObjects: TList;
+ Found: Boolean;
+begin
+ Result := False;
+ if (Obj is TfrxCustomCrossView) or (Obj is TfrxSubreport) then Exit;
+
+ Offset := frxPoint(20, 20);
+ if FDotMatrix then
+ Offset := frxPoint(fr1CharX * 2, fr1CharY);
+ { call DrawCross to calc visible memos and their bounds }
+ DrawCross(nil, FScaleX, FScaleY, AbsLeft + Offset.X, AbsTop + Offset.Y);
+
+ { find parent memo for added object }
+ for i := 0 to FAllMemos.Count - 1 do
+ begin
+ c := FAllMemos[i];
+ if (Obj.Left >= c.Left) and (Obj.Top >= c.Top) and
+ (Obj.Left <= c.Left + c.Width) and
+ (Obj.Top <= c.Top + c.Height) then
+ begin
+ Obj.Left := Obj.Left - c.Left;
+ Obj.Top := Obj.Top - c.Top;
+ Obj.Owner.RemoveComponent(Obj);
+ Obj.Parent := c;
+
+ { create unique tag for it - it will be used for name creation }
+ NestedObjects := GetNestedObjects;
+ n := 0;
+ while True do
+ begin
+ Inc(n);
+ Found := False;
+ for j := 0 to NestedObjects.Count - 1 do
+ if TfrxComponent(NestedObjects[j]).Tag = n then
+ begin
+ Found := True;
+ break;
+ end;
+ if not Found then
+ begin
+ Obj.Tag := n;
+ Obj.Name := Name + 'Object' + IntToStr(n);
+ break;
+ end;
+ end;
+
+ NestedObjects.Free;
+ Result := True;
+ break;
+ end;
+ end;
+end;
+
+function TfrxCustomCrossView.ContainerMouseDown(Sender: TObject; X, Y: Integer): Boolean;
+var
+ i, j: Integer;
+ c: TfrxComponent;
+ Offset: TfrxPoint;
+begin
+ Offset := frxPoint(20, 20);
+ if FDotMatrix then
+ Offset := frxPoint(fr1CharX * 2, fr1CharY);
+ DrawCross(nil, FScaleX, FScaleY, AbsLeft + Offset.X, AbsTop + Offset.Y);
+ FGridUsed := nil;
+ FFirstMousePos := Point(X, Y);
+ FLastMousePos := Point(X, Y);
+ Result := False;
+
+ for i := 0 to FGridX.Count - 1 do
+ for j := 0 to FGridX[i].Objects.Count - 1 do
+ begin
+ c := FGridX[i].Objects[j];
+ if (Abs(c.AbsLeft + c.Width - X / FScaleX) < 2) and
+ (Y / FScaleY >= c.AbsTop) and (Y / FScaleY <= c.AbsTop + c.Height) then
+ begin
+ FGridUsed := FGridX;
+ FMovingObjects := i;
+ Result := True;
+ break;
+ end;
+ end;
+
+ for i := 0 to FGridY.Count - 1 do
+ for j := 0 to FGridY[i].Objects.Count - 1 do
+ begin
+ c := FGridY[i].Objects[j];
+ if (Abs(c.AbsTop + c.Height - Y / FScaleY) < 2) and
+ (X / FScaleX >= c.AbsLeft) and (X / FScaleX <= c.AbsLeft + c.Width) then
+ begin
+ FGridUsed := FGridY;
+ FMovingObjects := i;
+ Result := True;
+ break;
+ end;
+ end;
+
+ FMouseDown := Result;
+end;
+
+procedure TfrxCustomCrossView.ContainerMouseMove(Sender: TObject; X, Y: Integer);
+var
+ i, j: Integer;
+ c: TfrxComponent;
+ Offset: TfrxPoint;
+begin
+//todo designer
+ if (FScaleX = 0) or (FScaleY = 0) then Exit;
+
+ if not FMouseDown then
+ begin
+ Offset := frxPoint(20, 20);
+ if FDotMatrix then
+ Offset := frxPoint(fr1CharX * 2, fr1CharY);
+ DrawCross(nil, FScaleX, FScaleY, AbsLeft + Offset.X, AbsTop + Offset.Y);
+
+ for i := 0 to FGridX.Count - 1 do
+ for j := 0 to FGridX[i].Objects.Count - 1 do
+ begin
+ c := FGridX[i].Objects[j];
+ if (Abs(c.AbsLeft + c.Width - X / FScaleX) < 2) and
+ (Y / FScaleY >= c.AbsTop) and (Y / FScaleY <= c.AbsTop + c.Height) then
+ begin
+ TControl(Sender).Cursor := crHSplit;
+ break;
+ end;
+ end;
+
+ for i := 0 to FGridY.Count - 1 do
+ for j := 0 to FGridY[i].Objects.Count - 1 do
+ begin
+ c := FGridY[i].Objects[j];
+ if (Abs(c.AbsTop + c.Height - Y / FScaleY) < 2) and
+ (X / FScaleX >= c.AbsLeft) and (X / FScaleX <= c.AbsLeft + c.Width) then
+ begin
+ TControl(Sender).Cursor := crVSplit;
+ break;
+ end;
+ end;
+ end
+ else
+ begin
+ if FGridUsed = FGridX then
+ begin
+ for i := 0 to FGridX[FMovingObjects].Objects.Count - 1 do
+ begin
+ c := FGridX[FMovingObjects].Objects[i];
+ c.Width := c.Width + (X - FLastMousePos.X);
+ end;
+ end
+ else if FGridUsed = FGridY then
+ begin
+ for i := 0 to FGridY[FMovingObjects].Objects.Count - 1 do
+ begin
+ c := FGridY[FMovingObjects].Objects[i];
+ c.Height := c.Height + (Y - FLastMousePos.Y);
+ end;
+ end;
+ FLastMousePos := Point(X, Y);
+ end;
+end;
+
+procedure TfrxCustomCrossView.ContainerMouseUp(Sender: TObject; X, Y: Integer);
+begin
+ FMouseDown := False;
+ if FAutoSize and ((Abs(X - FFirstMousePos.X) > 5) or (Abs(Y - FFirstMousePos.Y) > 5)) then
+ frxInfoMsg(frxResources.Get('crResize'));
+end;
+
+function TfrxCustomCrossView.DrawCross(Canvas: TCanvas; ScaleX, ScaleY,
+ OffsetX, OffsetY: Extended): TfrxPoint;
+
+ procedure FillMatrix;
+ var
+ i: Integer;
+ RowValues, ColumnValues, CellValues: array of Variant;
+ begin
+ BeginMatrix;
+ InitMemos(False);
+ SetLength(RowValues, RowLevels);
+ SetLength(ColumnValues, ColumnLevels);
+ SetLength(CellValues, CellLevels);
+
+ for i := 0 to RowLevels - 1 do
+ RowValues[i] := '[' + RowFields[i] + ']';
+ for i := 0 to ColumnLevels - 1 do
+ ColumnValues[i] := '[' + ColumnFields[i] + ']';
+ for i := 0 to CellLevels - 1 do
+ CellValues[i] := 0;
+ AddValue(RowValues, ColumnValues, CellValues);
+
+ RowValues := nil;
+ ColumnValues := nil;
+ CellValues := nil;
+ EndMatrix;
+ end;
+
+ procedure DrawLine2(x, y, dx, dy: Extended);
+ begin
+ Canvas.DrawLine(PointF(Round(x * ScaleX), Round(y * ScaleY)), PointF(Round((x + dx) * ScaleX), Round((y + dy) * ScaleY)), 1);
+ end;
+
+ procedure DrawScriptSign(c: TfrxReportComponent);
+ begin
+ if (Canvas <> nil) and (c.OnBeforePrint <> '') then
+ with c, Canvas do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := claRed;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+
+ DrawLine2(AbsLeft + 2, AbsTop + 1, 0, 7);
+ DrawLine2(AbsLeft + 3, AbsTop + 2, 0, 5);
+ DrawLine2(AbsLeft + 4, AbsTop + 3, 0, 3);
+ DrawLine2(AbsLeft + 5, AbsTop + 4, 0, 1);
+ end;
+ end;
+
+ procedure DrawObj(Obj: TfrxReportComponent; Child: Boolean = False);
+ var
+ i: Integer;
+ begin
+ { don't let a child move outside parent }
+ if Child then
+ begin
+ if Obj.Left < 0 then
+ Obj.Left := 0;
+ if Obj.Left + Obj.Width > Obj.Parent.Width then
+ Obj.Left := Obj.Parent.Width - Obj.Width;
+ if Obj.Top < 0 then
+ Obj.Top := 0;
+ if Obj.Top + Obj.Height > Obj.Parent.Height then
+ Obj.Top := Obj.Parent.Height - Obj.Height;
+ end;
+
+ if Canvas <> nil then
+ Obj.Draw(Canvas, ScaleX, ScaleY, 0, 0);
+ DrawScriptSign(Obj);
+ if not Child then
+ begin
+ FGridX.Add(Obj, Obj.AbsLeft + Obj.Width);
+ FGridY.Add(Obj, Obj.AbsTop + Obj.Height);
+ end;
+ FAllMemos.Add(Obj);
+ for i := 0 to Obj.Objects.Count - 1 do
+ DrawObj(Obj.Objects[i], True);
+ end;
+
+ procedure DrawHeader(Header: TfrxCrossHeader; p: TfrxPoint);
+ var
+ i: Integer;
+ Items: TList;
+ Item: TfrxCrossHeader;
+ r: TfrxRect;
+ m: TfrxCustomMemoView;
+ SaveWidth, SaveHeight: Extended; // for dot-matrix
+ s: WideString;
+ begin
+ Items := Header.AllItems;
+
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ m := Item.Memo;
+ r := Item.Bounds;
+
+ s := m.Text;
+ m.Text := VarToWideStr(Item.Value);
+ m.SetBounds(r.Left + p.X, r.Top + p.Y, r.Right, r.Bottom);
+ SaveWidth := m.Width;
+ SaveHeight := m.Height;
+ CorrectDMPBounds(m);
+ if m.Left + m.Width > Result.X then
+ Result.X := m.Left + m.Width;
+ if m.Top + m.Height > Result.Y then
+ Result.Y := m.Top + m.Height;
+
+ if m.Visible then
+ DrawObj(m);
+
+ m.Text := s;
+ if m is TfrxDMPMemoView then
+ TfrxDMPMemoView(m).SetBoundsDirect(m.Left - fr1CharX / 2,
+ m.Top - fr1CharY / 2, SaveWidth, SaveHeight);
+ end;
+
+ Items.Free;
+ end;
+
+ procedure DrawCell(p: TfrxPoint);
+ var
+ i, j, CellIndex: Integer;
+ Cell: Variant;
+ ColumnItems, RowItems: TList;
+ ColumnItem, RowItem: TfrxCrossHeader;
+ m: TfrxCustomMemoView;
+ SaveWidth, SaveHeight: Extended; // for dot-matrix
+ begin
+ ColumnItems := ColumnHeader.TerminalItems;
+ RowItems := RowHeader.TerminalItems;
+
+ for i := 0 to RowItems.Count - 1 do
+ begin
+ RowItem := RowItems[i];
+ for j := 0 to ColumnItems.Count - 1 do
+ begin
+ ColumnItem := ColumnItems[j];
+
+ if FCellLevels > 1 then
+ if FPlainCells then
+ begin
+ CellIndex := ColumnItem.FCellIndex;
+ Cell := GetValue(i, ColumnItem.FIndex, CellIndex);
+ end
+ else
+ begin
+ CellIndex := RowItem.FCellIndex;
+ Cell := GetValue(RowItem.FIndex, j, CellIndex);
+ end
+ else
+ begin
+ CellIndex := 0;
+ Cell := GetValue(i, j, 0);
+ end;
+
+ m := CellMemos[ColumnItem.FTotalIndex * ((FRowLevels + 1) * FCellLevels) +
+ RowItem.FTotalIndex * FCellLevels + CellIndex];
+ m.Visible := True;
+ m.Restrictions := [rfDontDelete, rfDontEdit];
+ m.Text := m.FormatData(Cell, CellMemos[CellIndex].DisplayFormat);
+ m.SetBounds(ColumnItem.Bounds.Left, RowItem.Bounds.Top,
+ ColumnItem.Bounds.Right, RowItem.Bounds.Bottom);
+ m.Left := m.Left + p.X;
+ m.Top := m.Top + p.Y;
+ SaveWidth := m.Width;
+ SaveHeight := m.Height;
+ CorrectDMPBounds(m);
+ if m.Left + m.Width > Result.X then
+ Result.X := m.Left + m.Width;
+ if m.Top + m.Height > Result.Y then
+ Result.Y := m.Top + m.Height;
+
+ DrawObj(m);
+ if m is TfrxDMPMemoView then
+ TfrxDMPMemoView(m).SetBoundsDirect(m.Left - fr1CharX / 2,
+ m.Top - fr1CharY / 2, SaveWidth, SaveHeight);
+ end;
+ end;
+
+ ColumnItems.Free;
+ RowItems.Free;
+ end;
+
+begin
+ Result := frxPoint(0, 0);
+ FGridX.Clear;
+ FGridY.Clear;
+ FAllMemos.Clear;
+
+ if IsCrossValid then
+ begin
+ FillMatrix;
+ if Corner.Visible then
+ DrawHeader(Corner, frxPoint(OffsetX, OffsetY));
+ if ColumnHeader.Visible then
+ DrawHeader(ColumnHeader, frxPoint(OffsetX + RowHeaderWidth, OffsetY));
+ if RowHeader.Visible then
+ DrawHeader(RowHeader, frxPoint(OffsetX, OffsetY + ColumnHeaderHeight));
+ DrawCell(frxPoint(OffsetX + RowHeaderWidth, OffsetY + ColumnHeaderHeight));
+ end;
+
+ Result.X := Result.X - OffsetX;
+ Result.Y := Result.Y - OffsetY;
+end;
+
+procedure TfrxCustomCrossView.Draw(Canvas: TCanvas; ScaleX, ScaleY,
+ OffsetX, OffsetY: Extended);
+var
+ size, Offset: TfrxPoint;
+begin
+ size := DrawCross(nil, ScaleX, ScaleY, AbsLeft, AbsTop);
+ if (size.X > 0) and (size.Y > 0) then
+ begin
+ Width := size.X + 40;
+ Height := size.Y + 40;
+ end;
+
+ Color := claWhite;
+ Frame.Style := fsDot;
+ inherited;
+
+ Offset := frxPoint(20, 20);
+ if FDotMatrix then
+ Offset := frxPoint(fr1CharX * 2, fr1CharY);
+ DrawCross(Canvas, ScaleX, ScaleY, AbsLeft + Offset.X, AbsTop + Offset.Y);
+{ if Self is TfrxDBCrossView then
+ img := 49
+ else
+ img := 42;
+ frxResources.ObjectImages.Draw(Canvas, FX + 2, FY + 2, img);}
+end;
+
+procedure TfrxCustomCrossView.ApplyStyle(Style: TfrxStyles);
+var
+ i: Integer;
+ s: String;
+begin
+ for i := 0 to FCellHeaderMemos.Count - 1 do
+ CellHeaderMemos[i].ApplyStyle(Style.Find('cellheader'));
+
+ for i := 0 to FCellMemos.Count - 1 do
+ CellMemos[i].ApplyStyle(Style.Find('cell'));
+
+ for i := 0 to FColumnMemos.Count - 1 do
+ begin
+ ColumnMemos[i].ApplyStyle(Style.Find('column'));
+ if i = 0 then
+ s := 'colgrand'
+ else
+ s := 'coltotal';
+ ColumnTotalMemos[i].ApplyStyle(Style.Find(s));
+ end;
+
+ for i := 0 to FRowMemos.Count - 1 do
+ begin
+ RowMemos[i].ApplyStyle(Style.Find('row'));
+ if i = 0 then
+ s := 'rowgrand'
+ else
+ s := 'rowtotal';
+ RowTotalMemos[i].ApplyStyle(Style.Find(s));
+ end;
+
+ for i := 0 to FCornerMemos.Count - 1 do
+ CornerMemos[i].ApplyStyle(Style.Find('corner'));
+end;
+
+procedure TfrxCustomCrossView.GetStyle(Style: TfrxStyles);
+
+ procedure DoStyle(m: TfrxCustomMemoView; const s: String);
+ var
+ stItem: TfrxStyleItem;
+ begin
+ stItem := Style.Find(s);
+ if stItem = nil then
+ stItem := Style.Add;
+ stItem.Name := s;
+ stItem.Color := m.Color;
+ stItem.Font := m.Font;
+ stItem.Frame := m.Frame;
+ end;
+
+begin
+ if FCellHeaderMemos.Count > 0 then
+ DoStyle(CellHeaderMemos[0], 'cellheader');
+
+ if FCellMemos.Count > 0 then
+ DoStyle(CellMemos[0], 'cell');
+
+ if FColumnMemos.Count > 0 then
+ begin
+ DoStyle(ColumnMemos[0], 'column');
+ DoStyle(ColumnTotalMemos[0], 'colgrand');
+ if FColumnTotalMemos.Count > 1 then
+ DoStyle(ColumnTotalMemos[1], 'coltotal');
+ end;
+
+ if FRowMemos.Count > 0 then
+ begin
+ DoStyle(RowMemos[0], 'row');
+ DoStyle(RowTotalMemos[0], 'rowgrand');
+ if FRowTotalMemos.Count > 1 then
+ DoStyle(RowTotalMemos[1], 'rowtotal');
+ end;
+
+ if FCornerMemos.Count > 0 then
+ DoStyle(CornerMemos[0], 'corner');
+end;
+
+procedure TfrxCustomCrossView.UpdateVisibility;
+begin
+ Corner.Visible := FShowCorner and not FNoRows
+ and FShowColumnHeader and FShowRowHeader;
+ CornerMemos[0].Visible := Corner.Visible and not FNoColumns and FShowTitle;
+ CornerMemos[2].Visible := Corner.Visible and (FCellLevels > 1) and not FPlainCells;
+
+ ColumnHeader.Visible := FShowColumnHeader;
+ if FColumnTotalMemos.Count > 0 then
+ ColumnTotalMemos[0].Visible := FShowColumnTotal and not FNoColumns;
+ CornerMemos[1].Visible := FShowTitle and ColumnHeader.Visible;
+ ColumnMemos[0].Visible := ColumnHeader.Visible and not FNoColumns;
+
+ RowHeader.Visible := not FNoRows and FShowRowHeader;
+ if FRowTotalMemos.Count > 0 then
+ RowTotalMemos[0].Visible := FShowRowTotal and not FNoRows;
+end;
+
+procedure TfrxCustomCrossView.BeginMatrix;
+begin
+ InitMatrix;
+ UpdateVisibility;
+end;
+
+procedure TfrxCustomCrossView.EndMatrix;
+begin
+ CreateHeaders;
+ CalcTotals;
+ CalcBounds(FAddWidth, FAddHeight);
+end;
+
+procedure TfrxCustomCrossView.FillMatrix;
+begin
+end;
+
+procedure TfrxCustomCrossView.DoCalcHeight(Row: Integer; var Height: Extended);
+var
+ v: Variant;
+begin
+ if FOnCalcHeight <> '' then
+ begin
+ v := VarArrayOf([Row, GetRowIndexes(Row), Height]);
+ if Report <> nil then
+ Report.DoParamEvent(FOnCalcHeight, v);
+ Height := v[2];
+ end;
+ if Assigned(FOnBeforeCalcHeight) then
+ FOnBeforeCalcHeight(Row, GetRowIndexes(Row), Height);
+end;
+
+procedure TfrxCustomCrossView.DoCalcWidth(Column: Integer; var Width: Extended);
+var
+ v: Variant;
+begin
+ if FOnCalcWidth <> '' then
+ begin
+ v := VarArrayOf([Column, GetColumnIndexes(Column), Width]);
+ if Report <> nil then
+ Report.DoParamEvent(FOnCalcWidth, v);
+ Width := v[2];
+ end;
+ if Assigned(FOnBeforeCalcWidth) then
+ FOnBeforeCalcWidth(Column, GetColumnIndexes(Column), Width);
+end;
+
+procedure TfrxCustomCrossView.DoOnCell(Memo: TfrxCustomMemoView;
+ Row, Column, Cell: Integer; const Value: Variant);
+var
+ v: Variant;
+begin
+ if FOnPrintCell <> '' then
+ begin
+ v := VarArrayOf([frxInteger(Memo), Row, Column, Cell, GetRowIndexes(Row),
+ GetColumnIndexes(Column), Value]);
+ if Report <> nil then
+ Report.DoParamEvent(FOnPrintCell, v);
+ end;
+ if Assigned(FOnBeforePrintCell) then
+ FOnBeforePrintCell(Memo, Row, Column, Cell, GetRowIndexes(Row),
+ GetColumnIndexes(Column), Value);
+end;
+
+procedure TfrxCustomCrossView.DoOnColumnHeader(Memo: TfrxCustomMemoView;
+ Header: TfrxCrossHeader);
+var
+ v: Variant;
+begin
+ if FOnPrintColumnHeader <> '' then
+ begin
+ v := VarArrayOf([frxInteger(Memo), Header.GetIndexes, Header.GetValues, Header.Value]);
+ if Report <> nil then
+ Report.DoParamEvent(FOnPrintColumnHeader, v);
+ end;
+ if Assigned(FOnBeforePrintColumnHeader) then
+ FOnBeforePrintColumnHeader(Memo, Header.GetIndexes, Header.GetValues, Header.Value);
+end;
+
+procedure TfrxCustomCrossView.DoOnRowHeader(Memo: TfrxCustomMemoView;
+ Header: TfrxCrossHeader);
+var
+ v: Variant;
+begin
+ if FOnPrintRowHeader <> '' then
+ begin
+ v := VarArrayOf([frxInteger(Memo), Header.GetIndexes, Header.GetValues, Header.Value]);
+ if Report <> nil then
+ Report.DoParamEvent(FOnPrintRowHeader, v);
+ end;
+ if Assigned(FOnBeforePrintRowHeader) then
+ FOnBeforePrintRowHeader(Memo, Header.GetIndexes, Header.GetValues, Header.Value);
+end;
+
+procedure TfrxCustomCrossView.BeforeStartReport;
+begin
+ inherited;
+ InitMemos(True);
+end;
+
+procedure TfrxCustomCrossView.BeforePrint;
+begin
+ inherited;
+ if FClearBeforePrint then
+ BeginMatrix;
+end;
+
+procedure TfrxCustomCrossView.GetData;
+begin
+ inherited;
+ Report.SetProgressMessage(frxResources.Get('crFillMx'));
+ if IsCrossValid then
+ FillMatrix;
+ Report.SetProgressMessage(frxResources.Get('crBuildMx'));
+ EndMatrix;
+ RenderMatrix;
+end;
+
+procedure TfrxCustomCrossView.RenderMatrix;
+var
+ i, j, Page, SavePage: Integer;
+ CurY, FirstCurY, SaveCurY, AddWidth, MaxX: Extended;
+ Band: TfrxBand;
+ ColumnItems: TList;
+ RowItems: TList;
+ VarRowIndex, VarColumnIndex: TfrxVariable;
+
+ function GetCellBand(RowIndex, ColumnIndex: Integer): TfrxBand;
+ var
+ i, iFrom, iTo, j: Integer;
+ Cell: Variant;
+ CellIndex: Integer;
+ ColumnItem, RowItem: TfrxCrossHeader;
+ m, Memo: TfrxCustomMemoView;
+ LeftMargin, TopMargin: Extended;
+ SameMemos: array[0..31] of TfrxCustomMemoView;
+ c, c1: TfrxReportComponent;
+ begin
+ RowItem := RowItems[RowIndex];
+
+ Result := TfrxNullBand.Create(Report);
+ Result.Height := RowItem.Bounds.Bottom;
+
+ iFrom := FColumnBands[ColumnIndex].FromIndex;
+ iTo := FColumnBands[ColumnIndex].ToIndex;
+ LeftMargin := TfrxCrossHeader(ColumnItems[iFrom]).Bounds.Left;
+ TopMargin := RowItem.Bounds.Top;
+
+ for i := 0 to CellLevels - 1 do
+ SameMemos[i] := nil;
+
+ for i := iFrom to iTo do
+ begin
+ ColumnItem := ColumnItems[i];
+
+ if FCellLevels > 1 then
+ if FPlainCells then
+ begin
+ CellIndex := ColumnItem.FCellIndex;
+ Cell := GetValue(RowIndex, ColumnItem.FIndex, CellIndex);
+ end
+ else
+ begin
+ CellIndex := RowItem.FCellIndex;
+ Cell := GetValue(RowItem.FIndex, i, CellIndex);
+ end
+ else
+ begin
+ CellIndex := 0;
+ Cell := GetValue(RowIndex, i, 0);
+ end;
+
+ m := CellMemos[ColumnItem.FTotalIndex * ((FRowLevels + 1) * FCellLevels) +
+ RowItem.FTotalIndex * FCellLevels + CellIndex];
+ Memo := CreateMemo(Result);
+ Memo.Assign(m);
+ SetupOriginalComponent(Memo, m);
+ if Cell <> Null then
+ THackMemoView(Memo).Value := Cell
+ else
+ THackMemoView(Memo).Value := 0;
+
+ if THackMemoView(Memo).HideZeros and (TVarData(THackMemoView(Memo).Value).VType <> varString)
+ and (TVarData(THackMemoView(Memo).Value).VType <> varUString) and
+ (TVarData(THackMemoView(Memo).Value).VType <> varOleStr) and (THackMemoView(Memo).Value = 0) then
+ Memo.Text := ''
+ else
+ Memo.Text := Memo.FormatData(Cell, CellMemos[CellIndex].DisplayFormat);
+
+ Memo.Rotation := 0;
+ Memo.SetBounds(ColumnItem.Bounds.Left - LeftMargin + AddWidth,
+ RowItem.Bounds.Top - TopMargin,
+ ColumnItem.Bounds.Right,
+ RowItem.Bounds.Bottom);
+ CorrectDMPBounds(Memo);
+ if Memo.AbsLeft + Memo.Width > MaxX then
+ MaxX := Memo.AbsLeft + Memo.Width;
+ Memo.Visible := (Memo.Width <> 0) and (Memo.Height <> 0);
+ DoOnCell(Memo, RowItem.FIndex, ColumnItem.FIndex, CellIndex, Cell);
+
+ if FBorder then
+ begin
+ if FPlainCells then
+ begin
+ if RowIndex = 0 then
+ Memo.Frame.Typ := Memo.Frame.Typ + [ftTop];
+ if (i = 0) and (CellIndex = 0) then
+ Memo.Frame.Typ := Memo.Frame.Typ + [ftLeft];
+ if (i = ColumnItems.Count - 1) and (CellIndex = CellLevels - 1) then
+ Memo.Frame.Typ := Memo.Frame.Typ + [ftRight];
+ if RowIndex = RowItems.Count - 1 then
+ Memo.Frame.Typ := Memo.Frame.Typ + [ftBottom];
+ end
+ else
+ begin
+ if (RowIndex = 0) and (CellIndex = 0) then
+ Memo.Frame.Typ := Memo.Frame.Typ + [ftTop];
+ if i = 0 then
+ Memo.Frame.Typ := Memo.Frame.Typ + [ftLeft];
+ if i = ColumnItems.Count - 1 then
+ Memo.Frame.Typ := Memo.Frame.Typ + [ftRight];
+ if (RowIndex = RowItems.Count - 1) and (CellIndex = CellLevels - 1) then
+ Memo.Frame.Typ := Memo.Frame.Typ + [ftBottom];
+ end;
+ end;
+
+ { check if previous memo has the same value and JoinEqualCells is True }
+ if JoinEqualCells then
+ if RowItem.IsTotal or ColumnItem.IsTotal then
+ SameMemos[CellIndex] := nil
+ else if (SameMemos[CellIndex] = nil) or RowItem.IsTotal or ColumnItem.IsTotal or
+ (THackMemoView(SameMemos[CellIndex]).Value <> THackMemoView(Memo).Value) then
+ SameMemos[CellIndex] := Memo
+ else
+ begin
+ SameMemos[CellIndex].Width := SameMemos[CellIndex].Width + Memo.Width;
+ SameMemos[CellIndex].HAlign := haCenter;
+ Memo.Free;
+ Memo := SameMemos[CellIndex];
+ end;
+
+ VarRowIndex.Value := RowIndex;
+ VarColumnIndex.Value := i;
+ Report.LocalValue := THackMemoView(Memo).Value;
+ Report.CurObject := Memo.Name;
+ Report.DoBeforePrint(Memo);
+
+ { process memo children if any }
+ for j := 0 to m.Objects.Count - 1 do
+ begin
+ c := m.Objects[j];
+ c1 := TfrxReportComponent(c.NewInstance);
+ c1.Create(Result);
+ c1.Assign(c);
+ c1.Left := c1.Left + Memo.Left;
+ c1.Top := c1.Top + Memo.Top;
+ Report.CurObject := c.Name;
+ Report.DoBeforePrint(c1);
+ end;
+ end;
+ end;
+
+ procedure DrawCorner(Offset: TfrxPoint);
+ var
+ i: Integer;
+ Items: TList;
+ Item: TfrxCrossHeader;
+ r: TfrxRect;
+ m: TfrxCustomMemoView;
+ begin
+ if not FShowRowHeader or not FShowColumnHeader or FNoRows or not FShowCorner then Exit;
+
+ Items := Corner.AllItems;
+
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ m := Item.Memo;
+ r := Item.Bounds;
+ m.BeforePrint;
+ m.Text := VarToWideStr(Item.Value);
+ m.SetBounds(r.Left + Offset.X, r.Top + Offset.Y, r.Right, r.Bottom);
+ CorrectDMPBounds(m);
+ Report.PreviewPages.AddObject(m);
+ m.AfterPrint;
+ end;
+
+ Items.Free;
+ end;
+
+ procedure DoPagination(i, j: Integer);
+ var
+ k, kFrom, kTo: Integer;
+ begin
+ if ShowColumnHeader and (FRepeatHeaders or (i = 0)) then
+ begin
+ Band := FColumnBands[j].Band;
+ Band.Top := CurY;
+ Report.Engine.ShowBand(Band);
+ end;
+
+ if ShowRowHeader and (FRepeatHeaders or (j = 0)) and not FNoRows then
+ begin
+ Band := FRowBands[i].Band;
+ if j = 0 then
+ Band.Left := Left
+ else
+ Band.Left := 0;
+ Band.Top := Band.Top + CurY;
+ Report.Engine.ShowBand(Band);
+ Band.Top := Band.Top - CurY;
+
+ if ShowColumnHeader and (FRepeatHeaders or (i = 0)) then
+ DrawCorner(frxPoint(Band.Left, Band.Top + CurY - ColumnHeaderHeight));
+ end;
+
+ if FRepeatHeaders or (i = 0) then
+ Report.Engine.CurY := CurY + ColumnHeaderHeight else
+ Report.Engine.CurY := CurY;
+ if FRepeatHeaders or (j = 0) then
+ begin
+ AddWidth := RowHeaderWidth;
+ if j = 0 then
+ AddWidth := AddWidth + Left;
+ end
+ else
+ AddWidth := 0;
+
+ kFrom := FRowBands[i].FromIndex;
+ kTo := FRowBands[i].ToIndex;
+
+ for k := kFrom to kTo do
+ begin
+ Band := GetCellBand(k, j);
+ Band.Top := Report.Engine.CurY;
+ Report.Engine.ShowBand(Band);
+ Band.Free;
+ end;
+ end;
+
+begin
+ { chek if cross header doesn't fit on the free space}
+ if ColumnHeaderHeight >= Report.Engine.FreeSpace then
+ Report.Engine.NewPage;
+ BuildColumnBands;
+ BuildRowBands;
+
+ ColumnItems := ColumnHeader.TerminalItems;
+ RowItems := RowHeader.TerminalItems;
+ SavePage := Report.PreviewPages.CurPage;
+ Page := SavePage;
+ SaveCurY := Report.Engine.CurY;
+ CurY := SaveCurY;
+ MaxX := 0;
+
+ frxGlobalVariables['RowIndex'] := 0;
+ frxGlobalVariables['ColumnIndex'] := 0;
+ VarRowIndex := frxGlobalVariables.Items[frxGlobalVariables.IndexOf('RowIndex')];
+ VarColumnIndex := frxGlobalVariables.Items[frxGlobalVariables.IndexOf('ColumnIndex')];
+
+ if FDownThenAcross then
+ begin
+ FirstCurY := Report.Engine.CurY;
+ for i := 0 to FColumnBands.Count - 1 do
+ begin
+ for j := 0 to FRowBands.Count - 1 do
+ begin
+ Report.PreviewPages.CurPage := Page + j;
+ DoPagination(j, i);
+ if j <> FRowBands.Count - 1 then
+ begin
+ Report.Engine.BreakAllKeep;
+ Report.Engine.NewPage;
+ CurY := Report.Engine.CurY;
+ end;
+ end;
+
+ if i <> FColumnBands.Count - 1 then
+ Report.Engine.NewPage;
+ CurY := FirstCurY;
+ Inc(Page, FRowBands.Count);
+
+ Report.AppHandleMessage;
+ if Report.Terminated then break;
+ end
+ end
+ else
+ for i := 0 to FRowBands.Count - 1 do
+ begin
+ for j := 0 to FColumnBands.Count - 1 do
+ begin
+ Report.PreviewPages.CurPage := Page + j;
+ MaxX := 0;
+ DoPagination(i, j);
+ if j <> FColumnBands.Count - 1 then
+ begin
+ Report.PreviewPages.AddPageAction := apWriteOver;
+ Report.Engine.NewPage;
+ end
+ else if NextCross <> nil then
+ NextCross.Left := MaxX + NextCrossGap;
+ end;
+
+ if i <> FRowBands.Count - 1 then
+ begin
+ Report.PreviewPages.AddPageAction := apAdd;
+ Report.Engine.BreakAllKeep;
+ Report.Engine.NewPage;
+ Page := Report.PreviewPages.CurPage;
+ end
+ else
+ Inc(Page, FColumnBands.Count);
+ CurY := Report.Engine.CurY;
+
+ Report.AppHandleMessage;
+ if Report.Terminated then break;
+ end;
+
+ if Parent is TfrxBand then
+ CurY := CurY - Height;
+ { print last page footers }
+ if FColumnBands.Count > 1 then
+ Report.Engine.EndPage;
+
+ if NextCross <> nil then
+ begin
+ { position to last column, first row page }
+ Report.PreviewPages.CurPage := SavePage + FColumnBands.Count - 1;
+ Report.PreviewPages.AddPageAction := apAdd;
+ Report.Engine.CurY := SaveCurY;
+ end
+ else
+ begin
+ { position to last row, first column page }
+ Report.PreviewPages.CurPage := Page - FColumnBands.Count;
+ Report.PreviewPages.AddPageAction := apAdd;
+ Report.Engine.CurY := CurY;
+ end;
+
+ ColumnItems.Free;
+ RowItems.Free;
+ FColumnBands.Clear;
+ FRowBands.Clear;
+end;
+
+procedure TfrxCustomCrossView.AddSourceObjects;
+var
+ i: Integer;
+begin
+ for i := 0 to FCellHeaderMemos.Count - 1 do
+ Report.PreviewPages.AddToSourcePage(CellHeaderMemos[i]);
+ for i := 0 to FCellMemos.Count - 1 do
+ Report.PreviewPages.AddToSourcePage(CellMemos[i]);
+ for i := 0 to FColumnMemos.Count - 1 do
+ begin
+ Report.PreviewPages.AddToSourcePage(ColumnMemos[i]);
+ Report.PreviewPages.AddToSourcePage(ColumnTotalMemos[i]);
+ end;
+ for i := 0 to FCornerMemos.Count - 1 do
+ Report.PreviewPages.AddToSourcePage(CornerMemos[i]);
+ for i := 0 to FRowMemos.Count - 1 do
+ begin
+ Report.PreviewPages.AddToSourcePage(RowMemos[i]);
+ Report.PreviewPages.AddToSourcePage(RowTotalMemos[i]);
+ end;
+end;
+
+procedure TfrxCustomCrossView.SetupOriginalComponent(Obj1, Obj2: TfrxComponent);
+begin
+ THackComponent(Obj1).FOriginalComponent := THackComponent(Obj2).FOriginalComponent;
+ THackComponent(Obj1).FAliasName := THackComponent(Obj2).FAliasName;
+end;
+
+procedure TfrxCustomCrossView.BuildColumnBands;
+var
+ i, j, LeftIndex, RightIndex: Integer;
+ Items: TList;
+ Item: TfrxCrossHeader;
+ Memo: TfrxCustomMemoView;
+ LargeBand: TfrxNullBand;
+ CurWidth, AddWidth, LeftMargin, RightMargin: Extended;
+ c: TfrxReportComponent;
+
+ procedure CreateBand;
+ var
+ i: Integer;
+ Band: TfrxNullBand;
+ Memo, CutMemo: TfrxCustomMemoView;
+ CutSize: Extended;
+ begin
+ Band := TfrxNullBand.Create(Report);
+ Band.Left := AddWidth;
+
+ { move in-bounds memos to the new band }
+ i := 0;
+ while i < LargeBand.Objects.Count do
+ begin
+ Memo := LargeBand.Objects[i];
+ if Memo.Left < RightMargin then
+ begin
+ if Memo.Left + Memo.Width <= RightMargin + 5 then
+ begin
+ Memo.Parent := Band;
+ Memo.Visible := Memo.Width > 0;
+ Dec(i);
+ end
+ else { cut off the memo }
+ begin
+ CutSize := RightMargin - Memo.Left;
+ CutMemo := CreateMemo(Band);
+ CutMemo.AssignAll(Memo);
+ CutMemo.Width := CutSize;
+ //if CutMemo.CalcWidth > CutSize then
+ //CutMemo.Text := '';
+
+ SetupOriginalComponent(CutMemo, Memo);
+ Memo.Width := Memo.Width - CutSize;
+ Memo.Left := Memo.Left + CutSize;
+ if Memo is TfrxDMPMemoView then
+ begin
+ Memo.Left := Memo.Left + fr1CharX;
+ Memo.Width := Memo.Width - fr1CharX;
+ end;
+ CutMemo.Frame.Typ := CutMemo.Frame.Typ - [ftRight];
+ Memo.Frame.Typ := Memo.Frame.Typ - [ftLeft];
+
+ //if Memo.CalcWidth > Memo.Width then
+ //Memo.Text := '';
+ Memo := CutMemo;
+ end;
+
+ Memo.Left := Memo.Left - LeftMargin;
+ end;
+ Inc(i);
+ end;
+
+ FColumnBands.Add(Band, LeftIndex, RightIndex);
+ end;
+
+begin
+ FColumnBands.Clear;
+ { create one large band }
+ LargeBand := TfrxNullBand.Create(nil);
+ Items := ColumnHeader.AllItems;
+
+ { add memos to band }
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ if (i = 0) and not FShowTitle then continue;
+ Memo := CreateMemo(LargeBand);
+ Memo.AssignAll(Item.Memo);
+ SetupOriginalComponent(Memo, Item.Memo);
+ Memo.Text := Memo.FormatData(Item.Value);
+ Memo.Highlight.Condition := '';
+ with Item.Bounds do
+ Memo.SetBounds(Left, Top, Right, Bottom);
+ CorrectDMPBounds(Memo);
+ Memo.Visible := (Memo.Width <> 0) and (Memo.Height <> 0);
+ DoOnColumnHeader(Memo, Item);
+
+ Report.LocalValue := Item.Value;
+ Report.CurObject := Memo.Name;
+ Report.DoBeforePrint(Memo);
+
+ { process memo children if any }
+ for j := 0 to Memo.Objects.Count - 1 do
+ begin
+ c := Memo.Objects[j];
+ Report.CurObject := c.Name;
+ Report.DoBeforePrint(c);
+ end;
+ end;
+
+ Items.Free;
+
+ { cut it to small bands for each page }
+ Items := ColumnHeader.TerminalItems;
+ AddWidth := RowHeaderWidth;
+ CurWidth := Report.Engine.PageWidth - AddWidth;
+ LeftMargin := -Left;
+ RightMargin := LeftMargin + CurWidth;
+ LeftIndex := 0;
+ RightIndex := Items.Count - 1;
+
+ if not TfrxReportPage(Page).EndlessWidth then
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ { find right terminal item }
+ if Item.Bounds.Left + Item.Bounds.Right - LeftMargin > CurWidth then
+ begin
+ RightMargin := Item.Bounds.Left;
+ RightIndex := i - 1;
+ CreateBand;
+ LeftMargin := RightMargin;
+ if FRepeatHeaders then
+ AddWidth := RowHeaderWidth else
+ AddWidth := 0;
+ CurWidth := Report.Engine.PageWidth - AddWidth;
+ RightMargin := LeftMargin + CurWidth;
+ LeftIndex := RightIndex + 1;
+ RightIndex := Items.Count - 1;
+ end;
+ end;
+
+ if TfrxReportPage(Page).EndlessWidth then
+ begin
+ Item := Items[Items.Count - 1];
+ CurWidth := Item.Bounds.Left + Item.Bounds.Right - LeftMargin + AddWidth;
+ if Report.Engine.PageWidth < CurWidth then
+ Report.Engine.PageWidth := CurWidth;
+ RightMargin := 1e+6;
+ end;
+
+ { add last band }
+ CreateBand;
+
+ LargeBand.Free;
+ Items.Free;
+end;
+
+procedure TfrxCustomCrossView.BuildRowBands;
+var
+ i, j, TopIndex, BottomIndex: Integer;
+ Items: TList;
+ Item, HParent: TfrxCrossHeader;
+ Memo: TfrxCustomMemoView;
+ LargeBand: TfrxNullBand;
+ MaxHeight, CurHeight, AddHeight, TopMargin, BottomMargin: Extended;
+ c: TfrxReportComponent;
+
+ procedure CreateBand;
+ var
+ i: Integer;
+ Band: TfrxNullBand;
+ Memo, CutMemo: TfrxCustomMemoView;
+ CutSize: Extended;
+ begin
+ Band := TfrxNullBand.Create(Report);
+ Band.Top := AddHeight;
+
+ { move in-bounds memos to the new band }
+ i := 0;
+ while i < LargeBand.Objects.Count do
+ begin
+ Memo := LargeBand.Objects[i];
+ if Memo.Top < BottomMargin then
+ begin
+ if Memo.Top + Memo.Height <= BottomMargin + 5 then
+ begin
+ Memo.Parent := Band;
+ Dec(i);
+ end
+ else { cut off the memo }
+ begin
+ CutSize := BottomMargin - Memo.Top;
+ CutMemo := CreateMemo(Band);
+ CutMemo.AssignAll(Memo);
+ CutMemo.Height := CutSize;
+ SetupOriginalComponent(CutMemo, Memo);
+ Memo.Height := Memo.Height - CutSize;
+ Memo.Top := Memo.Top + CutSize;
+ if Memo is TfrxDMPMemoView then
+ begin
+ Memo.Top := Memo.Top + fr1CharY;
+ Memo.Height := Memo.Height - fr1CharY;
+ end;
+ CutMemo.Frame.Typ := CutMemo.Frame.Typ - [ftBottom];
+ Memo.Frame.Typ := Memo.Frame.Typ - [ftTop];
+ Memo := CutMemo;
+ end;
+
+ Memo.Top := Memo.Top - TopMargin;
+ end;
+ Inc(i);
+ end;
+
+ FRowBands.Add(Band, TopIndex, BottomIndex);
+ end;
+
+begin
+ FRowBands.Clear;
+ LargeBand := TfrxNullBand.Create(nil);
+ Items := RowHeader.AllItems;
+ MaxHeight := 0;
+ HParent := nil;
+
+ { create one large band }
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ Memo := CreateMemo(LargeBand);
+ Memo.AssignAll(Item.Memo);
+ SetupOriginalComponent(Memo, Item.Memo);
+ Memo.Text := Memo.FormatData(Item.Value);
+ Memo.Highlight.Condition := '';
+ with Item.Bounds do
+ Memo.SetBounds(Left, Top, Right, Bottom);
+ CorrectDMPBounds(Memo);
+ Memo.Visible := (Memo.Width <> 0) and (Memo.Height <> 0);
+ DoOnRowHeader(Memo, Item);
+ if Item.Bounds.Top + Item.Bounds.Bottom > MaxHeight then
+ MaxHeight := Item.Bounds.Top + Item.Bounds.Bottom;
+
+ Report.LocalValue := Item.Value;
+ Report.CurObject := Memo.Name;
+ Report.DoBeforePrint(Memo);
+
+ { process memo children if any }
+ for j := 0 to Memo.Objects.Count - 1 do
+ begin
+ c := Memo.Objects[j];
+ Report.CurObject := c.Name;
+ Report.DoBeforePrint(c);
+ end;
+ end;
+
+ Items.Free;
+
+ { cut it to small bands for each page }
+ Items := RowHeader.TerminalItems;
+ AddHeight := ColumnHeaderHeight;
+ CurHeight := Report.Engine.FreeSpace - AddHeight;
+ if (MaxHeight > CurHeight) and KeepTogether then
+ begin
+ Report.Engine.NewPage;
+ AddHeight := ColumnHeaderHeight;
+ CurHeight := Report.Engine.FreeSpace - AddHeight;
+ end;
+
+ TopMargin := 0;
+ BottomMargin := TopMargin + CurHeight;
+ TopIndex := 0;
+ BottomIndex := Items.Count - 1;
+
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ { find right terminal item }
+
+ { keep rows by top parent }
+ if FKeepRowsTogether then
+ begin
+ HParent := Item.Parent;
+ while (HParent.Parent <> nil) do
+ begin
+ if (HParent.Parent.Parent = nil) then
+ Break;
+ HParent := HParent.Parent;
+ end;
+ end;
+
+ if ((HParent <> nil) and (CurHeight > HParent.Bounds.Bottom)
+ and (CurHeight - (HParent.Bounds.Top - TopMargin) < HParent.Bounds.Bottom))
+ or (Item.Bounds.Top + Item.Bounds.Bottom - TopMargin > CurHeight) then
+ begin
+ BottomMargin := Item.Bounds.Top;
+ BottomIndex := i - 1;
+ CreateBand;
+ TopMargin := BottomMargin;
+ if FRepeatHeaders then
+ AddHeight := ColumnHeaderHeight else
+ AddHeight := 0;
+ if (Parent is TfrxDataBand) and (TfrxDataBand(Parent).FHeader is TfrxHeader)
+ and TfrxHeader(TfrxDataBand(Parent).FHeader).ReprintOnNewPage then
+ CurHeight := Report.Engine.PageHeight - Report.Engine.CurY -
+ Report.Engine.FooterHeight - AddHeight
+ else
+ CurHeight := Report.Engine.PageHeight - Report.Engine.HeaderHeight -
+ Report.Engine.FooterHeight - AddHeight;
+ BottomMargin := TopMargin + CurHeight;
+ TopIndex := BottomIndex + 1;
+ BottomIndex := Items.Count - 1;
+ end;
+ end;
+
+ CreateBand;
+
+ LargeBand.Free;
+ Items.Free;
+end;
+
+
+{ TfrxCrossView }
+
+class function TfrxCrossView.GetDescription: String;
+begin
+ Result := frxResources.Get('obCross');
+end;
+
+function TfrxCrossView.IsCrossValid: Boolean;
+begin
+ Result := (FCellLevels > 0) and (FRowLevels >= 0) and (FColumnLevels >= 0);
+end;
+
+procedure TfrxCrossView.SetCellLevels(const Value: Integer);
+var
+ i: Integer;
+begin
+ inherited;
+ FCellFields.Clear;
+ if Value = 1 then
+ FCellFields.Add('Cell')
+ else
+ for i := 0 to Value - 1 do
+ FCellFields.Add('Cell' + IntToStr(i + 1));
+end;
+
+procedure TfrxCrossView.SetColumnLevels(const Value: Integer);
+var
+ i: Integer;
+begin
+ inherited;
+ FColumnFields.Clear;
+ if Value = 1 then
+ FColumnFields.Add('Column')
+ else
+ for i := 0 to Value - 1 do
+ FColumnFields.Add('Column' + IntToStr(i + 1));
+end;
+
+procedure TfrxCrossView.SetRowLevels(const Value: Integer);
+var
+ i: Integer;
+begin
+ inherited;
+ FRowFields.Clear;
+ if Value = 1 then
+ FRowFields.Add('Row')
+ else
+ for i := 0 to Value - 1 do
+ FRowFields.Add('Row' + IntToStr(i + 1));
+end;
+
+
+{ TfrxDBCrossView }
+
+class function TfrxDBCrossView.GetDescription: String;
+begin
+ Result := frxResources.Get('obDBCross');
+end;
+
+function TfrxDBCrossView.IsCrossValid: Boolean;
+begin
+ Result := (DataSet <> nil) and (FCellLevels > 0) and
+ (FRowFields.Count = FRowLevels) and (FColumnFields.Count = FColumnLevels) and
+ (FCellFields.Count = FCellLevels);
+end;
+
+procedure TfrxDBCrossView.FillMatrix;
+var
+ i: Integer;
+ RowValues, ColumnValues, CellValues: array of Variant;
+ sl: TStringList;
+begin
+ SetLength(RowValues, FRowLevels);
+ SetLength(ColumnValues, FColumnLevels);
+ SetLength(CellValues, FCellLevels);
+
+ sl := TStringList.Create;
+ try
+ DataSet.Open;
+ DataSet.GetFieldList(sl);
+ sl.Sorted := True;
+
+ DataSet.First;
+ while not DataSet.Eof do
+ begin
+ if Report.Terminated then Exit;
+ for i := 0 to FRowLevels - 1 do
+ begin
+ if sl.IndexOf(FRowFields[i]) <> -1 then
+ RowValues[i] := DataSet.Value[FRowFields[i]]
+ else
+ RowValues[i] := Report.Calc(FRowFields[i])
+ end;
+ for i := 0 to FColumnLevels - 1 do
+ begin
+ if sl.IndexOf(FColumnFields[i]) <> -1 then
+ ColumnValues[i] := DataSet.Value[FColumnFields[i]]
+ else
+ ColumnValues[i] := Report.Calc(FColumnFields[i])
+ end;
+ for i := 0 to FCellLevels - 1 do
+ begin
+ if sl.IndexOf(FCellFields[i]) <> -1 then
+ CellValues[i] := DataSet.Value[FCellFields[i]]
+ else
+ CellValues[i] := Report.Calc(FCellFields[i])
+ end;
+ AddValue(RowValues, ColumnValues, CellValues);
+ DataSet.Next;
+ end;
+ finally
+ sl.Free;
+ end;
+
+ RowValues := nil;
+ ColumnValues := nil;
+ CellValues := nil;
+end;
+
+{$IFNDEF RAD_ED}
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxCrossObject, TFmxObject);
+ frxObjects.RegisterObject1(TfrxCrossView, nil, '', '', 0, 142, [ctReport, ctDMP]);
+ frxObjects.RegisterObject1(TfrxDBCrossView, nil, '', '', 0, 149, [ctReport, ctDMP]);
+ frxResources.Add('TfrxPrintCellEvent',
+ 'PascalScript=(Memo: TfrxMemoView; RowIndex, ColumnIndex, CellIndex: Integer; RowValues, ColumnValues, Value: Variant);' + #13#10 +
+ 'C++Script=(TfrxMemoView Memo, int RowIndex, int ColumnIndex, int CellIndex, variant RowValues, variant ColumnValues, variant Value)' + #13#10 +
+ 'BasicScript=(Memo, RowIndex, ColumnIndex, CellIndex, RowValues, ColumnValues, Value)' + #13#10 +
+ 'JScript=(Memo, RowIndex, ColumnIndex, CellIndex, RowValues, ColumnValues, Value)');
+ frxResources.Add('TfrxPrintHeaderEvent',
+ 'PascalScript=(Memo: TfrxMemoView; HeaderIndexes, HeaderValues, Value: Variant);' + #13#10 +
+ 'C++Script=(TfrxMemoView Memo, variant HeaderIndexes, variant HeaderValues, variant Value)' + #13#10 +
+ 'BasicScript=(Memo, HeaderIndexes, HeaderValues, Value)' + #13#10 +
+ 'JScript=(Memo, HeaderIndexes, HeaderValues, Value)');
+ frxResources.Add('TfrxCalcWidthEvent',
+ 'PascalScript=(ColumnIndex: Integer; ColumnValues: Variant; var Width: Extended);' + #13#10 +
+ 'C++Script=(int ColumnIndex, variant ColumnValues, float &Width)' + #13#10 +
+ 'BasicScript=(ColumnIndex, ColumnValues, byref Width)' + #13#10 +
+ 'JScript=(ColumnIndex, ColumnValues, &Width)');
+ frxResources.Add('TfrxCalcHeightEvent',
+ 'PascalScript=(RowIndex: Integer; RowValues: Variant; var Height: Extended);' + #13#10 +
+ 'C++Script=(int RowIndex, variant RowValues, float &Height)' + #13#10 +
+ 'BasicScript=(RowIndex, RowValues, byref Height)' + #13#10 +
+ 'JScript=(RowIndex, RowValues, &Height)');
+
+finalization
+ frxObjects.UnRegister(TfrxCrossView);
+ frxObjects.UnRegister(TfrxDBCrossView);
+{$ENDIF}
+
+
+end.
diff --git a/LibD28/FMX.frxCrossEditor.fmx b/LibD28/FMX.frxCrossEditor.fmx
new file mode 100644
index 0000000..2fb03e9
--- /dev/null
+++ b/LibD28/FMX.frxCrossEditor.fmx
@@ -0,0 +1,342 @@
+object frxCrossEditorForm: TfrxCrossEditorForm
+ Left = 0
+ Top = 0
+ BorderIcons = [biSystemMenu, biMinimize]
+ BorderStyle = bsSingle
+ Caption = 'Cross-tab Editor'
+ ClientHeight = 535
+ ClientWidth = 703
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ ActiveControl = OkB
+ StyleLookup = 'backgroundstyle'
+ object DatasetL: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 165.000000000000000000
+ Height = 205.000000000000000000
+ Visible = False
+ TabOrder = 0
+ object DatasetCB: TComboBox
+ Position.Point = '(12,20)'
+ Width = 141.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 0
+ ItemIndex = -1
+ ItemHeight = 16.000000000000000000
+ OnChange = DatasetCBClick
+ end
+ object FieldsLB: TfrxListBox
+ DragMode = dmAutomatic
+ Position.Point = '(12,48)'
+ Width = 141.000000000000000000
+ Height = 145.000000000000000000
+ OnDragOver = LBDragOver
+ OnDragDrop = LBDragDrop
+ OnClick = LBClick
+ TabOrder = 1
+ AutoHide = False
+ DisableMouseWheel = True
+ AllowDrag = True
+ ItemHeight = 16.000000000000000000
+ end
+ end
+ object DimensionsL: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 165.000000000000000000
+ Height = 205.000000000000000000
+ Visible = False
+ TabOrder = 1
+ object RowsL: TLabel
+ Position.Point = '(12,20)'
+ Width = 66.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object ColumnsL: TLabel
+ Position.Point = '(12,48)'
+ Width = 66.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object CellsL: TLabel
+ Position.Point = '(12,76)'
+ Width = 66.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 2
+ end
+ object RowsE: TEdit
+ Position.Point = '(100,16)'
+ Width = 33.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 3
+ KeyboardType = vktDefault
+ OnChange = DimensionsChange
+ Password = False
+ Text = '0'
+ end
+ object ColumnsE: TEdit
+ Tag = 1
+ Position.Point = '(100,44)'
+ Width = 33.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 4
+ KeyboardType = vktDefault
+ OnChange = DimensionsChange
+ Password = False
+ Text = '0'
+ end
+ object CellsE: TEdit
+ Tag = 2
+ Position.Point = '(100,72)'
+ Width = 33.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 5
+ KeyboardType = vktDefault
+ OnChange = DimensionsChange
+ Password = False
+ Text = '1'
+ end
+ end
+ object StructureL: TGroupBox
+ Position.Point = '(176,4)'
+ Width = 521.000000000000000000
+ Height = 205.000000000000000000
+ TabOrder = 2
+ object Shape1: TLine
+ Position.Point = '(12,104)'
+ Width = 497.000000000000000000
+ Height = 1.000000000000000000
+ end
+ object Shape2: TLine
+ Position.Point = '(260,16)'
+ Width = 1.000000000000000000
+ Height = 177.000000000000000000
+ end
+ object SwapB: TSpeedButton
+ Position.Point = '(226,70)'
+ Width = 27.000000000000000000
+ Height = 26.000000000000000000
+ OnClick = SwapBClick
+ Text = '<->'
+ end
+ object ColumnsLB: TfrxListBox
+ DragMode = dmAutomatic
+ Position.Point = '(268,16)'
+ Width = 241.000000000000000000
+ Height = 81.000000000000000000
+ OnDragEnter = RowsLBDragEnter
+ OnDragLeave = RowsLBDragLeave
+ OnDragOver = LBDragOver
+ OnDragDrop = LBDragDrop
+ OnClick = LBClick
+ OnDblClick = LBDblClick
+ OnMouseDown = LBMouseDown
+ TabOrder = 4
+ AutoHide = False
+ MouseTracking = True
+ AllowDrag = True
+ ItemHeight = 16.000000000000000000
+ ShowButtons = False
+ end
+ object CellsLB: TfrxListBox
+ DragMode = dmAutomatic
+ Position.Point = '(268,112)'
+ Width = 241.000000000000000000
+ Height = 81.000000000000000000
+ OnDragEnter = RowsLBDragEnter
+ OnDragLeave = RowsLBDragLeave
+ OnDragOver = LBDragOver
+ OnDragDrop = LBDragDrop
+ OnClick = LBClick
+ OnDblClick = LBDblClick
+ TabOrder = 5
+ AutoHide = False
+ MouseTracking = True
+ AllowDrag = True
+ ItemHeight = 16.000000000000000000
+ ShowButtons = False
+ end
+ object RowsLB: TfrxListBox
+ DragMode = dmAutomatic
+ Position.Point = '(12,112)'
+ Width = 241.000000000000000000
+ Height = 81.000000000000000000
+ OnDragEnter = RowsLBDragEnter
+ OnDragLeave = RowsLBDragLeave
+ OnDragOver = LBDragOver
+ OnDragDrop = LBDragDrop
+ OnClick = LBClick
+ OnDblClick = LBDblClick
+ OnMouseDown = LBMouseDown
+ TabOrder = 3
+ AutoHide = False
+ MouseTracking = True
+ AllowDrag = True
+ ItemHeight = 16.000000000000000000
+ ShowButtons = False
+ end
+ end
+ object OptionsL: TGroupBox
+ Position.Point = '(4,216)'
+ Width = 693.000000000000000000
+ Height = 281.000000000000000000
+ TabOrder = 3
+ object RowHeaderCB: TCheckBox
+ Position.Point = '(440,76)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 0
+ OnChange = CBClick
+ end
+ object ColumnHeaderCB: TCheckBox
+ Position.Point = '(440,56)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 1
+ OnChange = CBClick
+ end
+ object RowTotalCB: TCheckBox
+ Position.Point = '(440,116)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 2
+ OnChange = CBClick
+ end
+ object ColumnTotalCB: TCheckBox
+ Position.Point = '(440,96)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 3
+ OnChange = CBClick
+ end
+ object TitleCB: TCheckBox
+ Position.Point = '(440,16)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 4
+ OnChange = CBClick
+ end
+ object CornerCB: TCheckBox
+ Position.Point = '(440,36)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 5
+ OnChange = CBClick
+ end
+ object AutoSizeCB: TCheckBox
+ Position.Point = '(440,152)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 6
+ OnChange = CBClick
+ end
+ object BorderCB: TCheckBox
+ Position.Point = '(440,172)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 7
+ OnChange = CBClick
+ end
+ object DownAcrossCB: TCheckBox
+ Position.Point = '(440,192)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 8
+ OnChange = CBClick
+ end
+ object PlainCB: TCheckBox
+ Position.Point = '(440,232)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 9
+ OnChange = CBClick
+ end
+ object JoinCB: TCheckBox
+ Position.Point = '(440,252)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 10
+ OnChange = CBClick
+ end
+ object Box: TScrollBox
+ Position.Point = '(12,16)'
+ Width = 413.000000000000000000
+ Height = 253.000000000000000000
+ TabOrder = 11
+ object PaintBox: TPaintBox
+ Position.Point = '(16,24)'
+ Width = 393.000000000000000000
+ Height = 225.000000000000000000
+ OnPaint = PaintBoxPaint
+ end
+ object ToolBar: TToolBar
+ Width = 413.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 1
+ object StyleB: TfrxToolButton
+ Position.Point = '(16,0)'
+ Width = 89.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 0
+ end
+ end
+ end
+ object RepeatCB: TCheckBox
+ Position.Point = '(440,212)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 12
+ OnChange = CBClick
+ end
+ end
+ object OkB: TButton
+ Position.Point = '(540,504)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 4
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(620,504)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 5
+ ModalResult = 2
+ Cancel = True
+ end
+ object FuncPopup: TPopupMenu
+ end
+ object SortPopup: TPopupMenu
+ end
+ object StylePopup: TPopupMenu
+ object Sep1: TMenuItem
+ Width = 50.000000000000000000
+ Height = 50.000000000000000000
+ TabOrder = 0
+ ShortCut = 0
+ end
+ object SaveStyleMI: TMenuItem
+ Width = 50.000000000000000000
+ Height = 50.000000000000000000
+ OnClick = SaveStyleMIClick
+ TabOrder = 1
+ ShortCut = 0
+ end
+ end
+end
diff --git a/LibD28/FMX.frxCrossEditor.pas b/LibD28/FMX.frxCrossEditor.pas
new file mode 100644
index 0000000..66d56ec
--- /dev/null
+++ b/LibD28/FMX.frxCrossEditor.pas
@@ -0,0 +1,1029 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Cross editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCrossEditor;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, System.UIConsts, System.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.Types, FMX.Objects, FMX.Edit, FMX.ListBox, FMX.Layouts, FMX.Menus, FMX.ExtCtrls,
+ FMX.frxCross, FMX.frxClass, FMX.frxCtrls, FMX.frxCustomEditors, System.Variants,
+ FMX.frxFMX
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+ TfrxCrossEditor = class(TfrxViewEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ end;
+
+{$IFDEF LINUX}
+ TfrxCrossEditorForm = class(TfrxForm)
+{$ELSE}
+ TfrxCrossEditorForm = class(TForm)
+{$ENDIF}
+ FuncPopup: TPopupMenu;
+ SortPopup: TPopupMenu;
+ DatasetL: TGroupBox;
+ DatasetCB: TComboBox;
+ FieldsLB: TfrxListBox;
+ DimensionsL: TGroupBox;
+ RowsL: TLabel;
+ RowsE: TEdit;
+ ColumnsL: TLabel;
+ ColumnsE: TEdit;
+ CellsL: TLabel;
+ CellsE: TEdit;
+ StructureL: TGroupBox;
+ Shape1: TLine;
+ Shape2: TLine;
+ SwapB: TSpeedButton;
+ RowsLB: TfrxListBox;
+ ColumnsLB: TfrxListBox;
+ CellsLB: TfrxListBox;
+ OptionsL: TGroupBox;
+ RowHeaderCB: TCheckBox;
+ ColumnHeaderCB: TCheckBox;
+ RowTotalCB: TCheckBox;
+ ColumnTotalCB: TCheckBox;
+ TitleCB: TCheckBox;
+ CornerCB: TCheckBox;
+ AutoSizeCB: TCheckBox;
+ BorderCB: TCheckBox;
+ DownAcrossCB: TCheckBox;
+ PlainCB: TCheckBox;
+ JoinCB: TCheckBox;
+ Box: TScrollBox;
+ PaintBox: TPaintBox;
+ OkB: TButton;
+ CancelB: TButton;
+ RepeatCB: TCheckBox;
+ StylePopup: TPopupMenu;
+ Sep1: TMenuItem;
+ SaveStyleMI: TMenuItem;
+ ToolBar: TToolBar;
+ StyleB: TfrxToolButton;
+ procedure FormCreate(Sender: TObject);
+ procedure CancelBClick(Sender: TObject);
+ procedure OkBClick(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure DatasetCBClick(Sender: TObject);
+// procedure DatasetCBDrawItem(Control: TWinControl; Index: Integer;
+// ARect: TRect; State: TOwnerDrawState);
+// procedure FieldsLBDrawItem(Control: TWinControl; Index: Integer;
+// ARect: TRect; State: TOwnerDrawState);
+// procedure LBDrawItem(Control: TWinControl; Index: Integer;
+// ARect: TRect; State: TOwnerDrawState);
+// procedure CellsLBDrawItem(Control: TWinControl; Index: Integer;
+// ARect: TRect; State: TOwnerDrawState);
+ procedure LBDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+ procedure LBDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+ procedure LBMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+ procedure LBClick(Sender: TObject);
+ procedure CBClick(Sender: TObject);
+ procedure FuncMIClick(Sender: TObject);
+ procedure SortMIClick(Sender: TObject);
+ procedure SwapBClick(Sender: TObject);
+ procedure DimensionsChange(Sender: TObject);
+ procedure LBDblClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure PaintBoxPaint(Sender: TObject; Canvas: TCanvas);
+ procedure SaveStyleMIClick(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure RowsLBDragEnter(Sender: TObject; const Data: TDragObject;
+ const Point: TPointF);
+ procedure RowsLBDragLeave(Sender: TObject);
+ procedure StyleBClick(Sender: TObject);
+ private
+ FCross: TfrxCustomCrossView;
+ FCurList: TfrxListBox;
+ FSortMenuList: TList;
+ FFuncMenuList: TList;
+ FFuncNames: array[TfrxCrossFunction] of String;
+ FImages: TfrxImageList;
+ FSortNames: array[TfrxCrossSortOrder] of String;
+ FStyleSheet: TfrxStyleSheet;
+ FTempCross: TfrxDBCrossView;
+ FUpdating: Boolean;
+ FItemAdded: Boolean;
+ procedure ReflectChanges(ChangesFrom: TObject; UpdateText: Boolean = True);
+ procedure CreateStyleMenu;
+ procedure StyleClick(Sender: TObject);
+ procedure UpdateCheckBoxes(aListBox: TfrxListBox);
+ procedure LBButtonClick(Sender: TObject; aButton: TObject; aItem: TfrxListBoxItem);
+ procedure LBCheckChange(Sender: TObject);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ property Cross: TfrxCustomCrossView read FCross write FCross;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses
+ FMX.frxDsgnIntf, FMX.frxEditFormat, FMX.frxEditHighlight, FMX.frxEditMemo,
+ FMX.frxEditFrame, FMX.frxDesgnCtrls, FMX.frxRes, FMX.frxUtils, FMX.frxXML;
+
+const
+ CrossStyles =
+'' +
+'' +
+ '' +
+ '' +
+ '' +
+ '' +
+ '' +
+ '' +
+ '' +
+ '' +
+ '' +
+ '' +
+'';
+
+type
+ THackControl = class(TControl);
+ THackListBoxItem = class(TfrxListBoxItem);
+
+
+{ TfrxCrossEditor }
+
+function TfrxCrossEditor.Edit: Boolean;
+begin
+ with TfrxCrossEditorForm.Create(Designer) do
+ begin
+ Cross := TfrxCustomCrossView(Component);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ Free;
+ end;
+end;
+
+function TfrxCrossEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+
+{ TfrxCrossEditorForm }
+
+
+constructor TfrxCrossEditorForm.Create(AOwner: TComponent);
+var
+ TempStream: TStringStream;
+begin
+ inherited;
+ FSortMenuList := TList.Create;
+ FFuncMenuList := TList.Create;
+ FStyleSheet := TfrxStyleSheet.Create;
+ if FileExists(ExtractFilePath(ParamStr(0)) + 'crossstyles.xml') then
+ FStyleSheet.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'crossstyles.xml')
+ else
+ begin
+ TempStream := TStringStream.Create(CrossStyles, TEncoding.UTF8);
+ FStyleSheet.LoadFromStream(TempStream);
+ TempStream.Free;
+ end;
+
+ FImages := TfrxImageList.Create(nil);
+ FTempCross := TfrxDBCrossView.Create(nil);
+ FFuncNames[cfNone] := frxResources.Get('crNone');
+ FFuncNames[cfSum] := frxResources.Get('crSum');
+ FFuncNames[cfMin] := frxResources.Get('crMin');
+ FFuncNames[cfMax] := frxResources.Get('crMax');
+ FFuncNames[cfAvg] := frxResources.Get('crAvg');
+ FFuncNames[cfCount] := frxResources.Get('crCount');
+ FSortNames[soAscending] := frxResources.Get('crAsc');
+ FSortNames[soDescending] := frxResources.Get('crDesc');
+ FSortNames[soNone] := frxResources.Get('crNone');
+ FSortNames[soGrouping] := frxResources.Get('crGroup');
+end;
+
+destructor TfrxCrossEditorForm.Destroy;
+begin
+ FImages.Free;
+ FStyleSheet.Free;
+ FTempCross.Free;
+ FSortMenuList.Free;
+ FFuncMenuList.Free;
+ inherited;
+end;
+
+procedure TfrxCrossEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ if ModalResult = mrCancel then
+ FCross.Assign(FTempCross);
+end;
+
+procedure TfrxCrossEditorForm.FormCreate(Sender: TObject);
+var
+ i: Integer;
+ m: TMenuItem;
+begin
+ CellsLB.ShowCheckboxes := False;
+ CellsLB.ShowButtons := True;
+ RowsLB.ShowCheckboxes := True;
+ RowsLB.ShowButtons := True;
+ ColumnsLB.ShowCheckboxes := True;
+ ColumnsLB.ShowButtons := True;
+
+{$IFDEF DELPHI18}
+ ColumnsLB.DragMode := TDragMode.dmManual;
+ RowsLB.DragMode := TDragMode.dmManual;
+ CellsLB.DragMode := TDragMode.dmManual;
+ FieldsLB.DragMode := TDragMode.dmManual;
+
+ CellsLB.ManualDragAndDrop := True;
+ RowsLB.ManualDragAndDrop := True;
+ ColumnsLB.ManualDragAndDrop := True;
+ FieldsLB.ManualDragAndDrop := True;
+{$ENDIF}
+ // compatibility XE2- XE6
+ for i := 0 to 3 do
+ begin
+ m := TMenuItem.Create(SortPopup);
+ case i of
+ 0: m.Text := frxGet(4328);
+ 1: m.Text := frxGet(4329);
+ 2: m.Text := frxGet(4330);
+ 3: m.Text := frxGet(4331);
+ end;
+ m.OnClick := SortMIClick;
+ m.Tag := i;
+ SortPopup.AddObject(m);
+ FSortMenuList.Add(Pointer(m));
+ end;
+
+ for i := 0 to 5 do
+ begin
+ m := TMenuItem.Create(FuncPopup);
+ case i of
+ 0: m.Text := frxGet(4322);
+ 1: m.Text := frxGet(4323);
+ 2: m.Text := frxGet(4324);
+ 3: m.Text := frxGet(4325);
+ 4: m.Text := frxGet(4326);
+ 5: m.Text := frxGet(4327);
+ end;
+ m.OnClick := FuncMIClick;
+ m.Tag := i;
+ FuncPopup.AddObject(m);
+ FFuncMenuList.Add(Pointer(m));
+ end;
+
+ Caption := frxGet(4300);
+ DatasetL.Text := frxGet(4301);
+ DimensionsL.Text := frxGet(4302);
+ RowsL.Text := frxGet(4303);
+ ColumnsL.Text := frxGet(4304);
+ CellsL.Text := frxGet(4305);
+ StructureL.Text := frxGet(4306);
+ RowHeaderCB.Text := frxGet(4307);
+ ColumnHeaderCB.Text := frxGet(4308);
+ RowTotalCB.Text := frxGet(4309);
+ ColumnTotalCB.Text := frxGet(4310);
+ //SwapB.Hint := frxGet(4311);
+
+
+ TitleCB.Text := frxGet(4314);
+ CornerCB.Text := frxGet(4315);
+ AutoSizeCB.Text := frxGet(4317);
+ BorderCB.Text := frxGet(4318);
+ DownAcrossCB.Text := frxGet(4319);
+ RepeatCB.Text := frxGet(4316);
+ PlainCB.Text := frxGet(4320);
+ JoinCB.Text := frxGet(4321);
+ StyleB.Text := frxGet(4312);
+ StyleB.OnClick := StyleBClick;
+ SaveStyleMI.Text := frxGet(4313);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ FItemAdded := False;
+ CreateStyleMenu;
+
+ CellsLB.CheckBoxText := frxResources.Get('crSubtotal');
+ RowsLB.CheckBoxText := frxResources.Get('crSubtotal');
+ ColumnsLB.CheckBoxText := frxResources.Get('crSubtotal');
+
+ CellsLB.ButtonText := 'Func';
+ CellsLB.OnButtonClick := LBButtonClick;
+ RowsLB.ButtonText := 'A-Z';
+ RowsLB.OnButtonClick := LBButtonClick;
+ RowsLB.OnChangeCheck := LBCheckChange;
+ ColumnsLB.ButtonText := 'A-Z';
+ ColumnsLB.OnButtonClick := LBButtonClick;
+ ColumnsLB.OnChangeCheck := LBCheckChange;
+
+end;
+
+procedure TfrxCrossEditorForm.FormShow(Sender: TObject);
+
+ procedure SelectDataset;
+ begin
+ DatasetCB.ItemIndex := DatasetCB.Items.IndexOfObject(FCross.DataSet);
+ if DatasetCB.ItemIndex = -1 then
+ DatasetCB.ItemIndex := 0;
+ DatasetCBClick(nil);
+ end;
+
+ procedure SelectFields;
+ var
+ i: Integer;
+ Item: TfrxListBoxItem;
+ begin
+ for i := 0 to FCross.RowFields.Count - 1 do
+ begin
+ Item := RowsLB.ListItems[RowsLB.Count - 1] as TfrxListBoxItem;
+ if Item <> nil then
+ begin
+ Item.CheckVisible := True;
+ Item.IsChecked := FCross.RowTotalMemos[THackListBoxItem(Item).Index + 1].Visible;
+ end;
+ RowsLB.Items.Add(FCross.RowFields[i]);
+ end;
+
+ for i := 0 to FCross.ColumnFields.Count - 1 do
+ begin
+ Item := ColumnsLB.ListItems[ColumnsLB.Count - 1] as TfrxListBoxItem;
+ if Item <> nil then
+ begin
+ Item.CheckVisible := True;
+ Item.IsChecked := FCross.ColumnTotalMemos[THackListBoxItem(Item).Index + 1].Visible;
+ end;
+ ColumnsLB.Items.Add(FCross.ColumnFields[i]);
+ end;
+
+ CellsLB.Items := FCross.CellFields;
+ end;
+
+begin
+ FUpdating := True;
+ FTempCross.Assign(FCross);
+ FCross.Report.GetDataSetList(DatasetCB.Items);
+ SelectDataset;
+ SelectFields;
+
+
+
+ if FCross is TfrxCrossView then
+ begin
+
+ SwapB.Visible := False;
+ DimensionsL.Visible := True;
+ RowsE.Text := IntToStr(FCross.RowLevels);
+ ColumnsE.Text := IntToStr(FCross.ColumnLevels);
+ CellsE.Text := IntToStr(FCross.CellLevels);
+ end
+ else
+ DatasetL.Visible := True;
+
+ TitleCB.IsChecked := FCross.ShowTitle;
+ CornerCB.IsChecked := FCross.ShowCorner;
+ ColumnHeaderCB.IsChecked := FCross.ShowColumnHeader;
+ RowHeaderCB.IsChecked := FCross.ShowRowHeader;
+ ColumnTotalCB.IsChecked := FCross.ShowColumnTotal;
+ RowTotalCB.IsChecked := FCross.ShowRowTotal;
+
+ AutoSizeCB.IsChecked := FCross.AutoSize;
+ BorderCB.IsChecked := FCross.Border;
+ DownAcrossCB.IsChecked := FCross.DownThenAcross;
+ RepeatCB.IsChecked := FCross.RepeatHeaders;
+ PlainCB.IsChecked := FCross.PlainCells;
+ JoinCB.IsChecked := FCross.JoinEqualCells;
+
+ StyleB.Visible := not FCross.DotMatrix;
+
+ FUpdating := False;
+end;
+
+
+procedure TfrxCrossEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+procedure TfrxCrossEditorForm.CreateStyleMenu;
+var
+ i: Integer;
+ sl: TStringList;
+ m: TMenuItem;
+ b: TBitmap;
+ Style: TfrxStyles;
+begin
+ sl := TStringList.Create;
+ FStyleSheet.GetList(sl);
+
+ FImages.Clear;
+ b := TBitmap.Create(16, 16);
+
+ //frxResources.MainButtonImages.Draw(b.Canvas, 0, 0, 2);
+ //FImages.Add(b, nil);
+
+ { create thumbnail images for each style }
+ for i := 0 to sl.Count - 1 do
+ begin
+ Style := FStyleSheet[i];
+ with b.Canvas do
+ begin
+ Fill.Color := Style.Find('column').Color;
+ if Fill.Color = claNull then
+ Fill.Color := claWhite;
+ FillRect(RectF(0, 0, 16, 8), 1, 1, AllCorners, 1, TCornerType.ctBevel);
+ Fill.Color := Style.Find('cell').Color;
+ if Fill.Color = claNull then
+ Fill.Color := claWhite;
+ FillRect(RectF(0, 8, 16, 16), 1, 1, AllCorners, 1, TCornerType.ctBevel);
+ Stroke.Color := claSilver;
+ Fill.Kind := TBrushKind.bkNone;
+ DrawRect(RectF(0, 0, 16, 16), 1, 1, AllCorners, 1, TCornerType.ctBevel);
+ end;
+ //FImages.Add(b, nil);
+ end;
+
+ //while StylePopup.Items[0] <> Sep1 do
+ // StylePopup.Items[0].Free;
+
+ for i := sl.Count - 1 downto 0 do
+ begin
+ m := TMenuItem.Create(StylePopup);
+ m.Text := sl[i];
+ //m.ImageIndex := i + 1;
+ m.OnClick := StyleClick;
+ StylePopup.AddObject(m);
+ //StylePopup.Items.Insert(0, m);
+ end;
+
+ b.Free;
+ sl.Free;
+end;
+
+procedure TfrxCrossEditorForm.ReflectChanges(ChangesFrom: TObject; UpdateText: Boolean);
+var
+ i, j: Integer;
+ s: String;
+begin
+ if (DatasetCB.ItemIndex = -1) or (DatasetCB.Items.Count = 0) then
+ FCross.DataSet := nil else
+ FCross.DataSet := TfrxCustomDBDataSet(DatasetCB.Items.Objects[DatasetCB.ItemIndex]);
+ if FCross is TfrxDBCrossView then
+ begin
+ FCross.RowFields := RowsLB.Items;
+ FCross.ColumnFields := ColumnsLB.Items;
+ FCross.CellFields := CellsLB.Items;
+ end;
+ FCross.RowLevels := FCross.RowFields.Count;
+ FCross.ColumnLevels := FCross.ColumnFields.Count;
+ FCross.CellLevels := FCross.CellFields.Count;
+
+ if ChangesFrom = nil then // change all
+ begin
+ if FCross.CellLevels = 1 then
+ if UpdateText then
+ FCross.CornerMemos[0].Text := FCross.CellFields[0]
+ else
+ begin
+ FCross.CornerMemos[0].Text := '';
+ FCross.CornerMemos[2].Text := 'Data';
+ end;
+
+ if UpdateText then
+ for i := 0 to FCross.RowLevels do
+ for j := 0 to FCross.CellLevels - 1 do
+ FCross.CellHeaderMemos[i * FCross.CellLevels + j].Text := FCross.CellFields[j];
+
+ s := '';
+ for i := 0 to FCross.ColumnLevels - 1 do
+ s := s + FCross.ColumnFields[i] + ', ';
+ if s <> '' then
+ SetLength(s, Length(s) - 2);
+ if UpdateText then
+ FCross.CornerMemos[1].Text := s;
+
+ if UpdateText then
+ for i := 0 to FCross.RowLevels - 1 do
+ FCross.CornerMemos[i + 3].Text := FCross.RowFields[i];
+ end
+ else if (ChangesFrom = RowsLB) or (ChangesFrom = RowsE) then
+ begin
+ if UpdateText then
+ for i := 0 to FCross.RowLevels do
+ for j := 0 to FCross.CellLevels - 1 do
+ FCross.CellHeaderMemos[i * FCross.CellLevels + j].Text := FCross.CellFields[j];
+
+ if UpdateText then
+ for i := 0 to FCross.RowLevels - 1 do
+ FCross.CornerMemos[i + 3].Text := FCross.RowFields[i];
+ end
+ else if (ChangesFrom = ColumnsLB) or (ChangesFrom = ColumnsE) then
+ begin
+ s := '';
+ for i := 0 to FCross.ColumnLevels - 1 do
+ s := s + FCross.ColumnFields[i] + ', ';
+ if s <> '' then
+ SetLength(s, Length(s) - 2);
+ if UpdateText then
+ FCross.CornerMemos[1].Text := s;
+ end
+ else if (ChangesFrom = CellsLB) or (ChangesFrom = CellsE) then
+ begin
+ if FCross.CellLevels = 1 then
+ if UpdateText then
+ FCross.CornerMemos[0].Text := FCross.CellFields[0]
+ else
+ begin
+ FCross.CornerMemos[0].Text := '';
+ FCross.CornerMemos[2].Text := 'Data';
+ end;
+
+ if UpdateText then
+ for i := 0 to FCross.RowLevels do
+ for j := 0 to FCross.CellLevels - 1 do
+ FCross.CellHeaderMemos[i * FCross.CellLevels + j].Text := FCross.CellFields[j];
+ end;
+ PaintBox.InvalidateRect(PaintBox.BoundsRect);
+// PaintBoxPaint(nil, PaintBox.Canvas);
+end;
+
+procedure TfrxCrossEditorForm.RowsLBDragEnter(Sender: TObject;
+ const Data: TDragObject; const Point: TPointF);
+begin
+ if (Data.Source is TfrxListBox) and (TfrxListBox(Sender).Count = 0) then
+ begin
+ FItemAdded := True;
+ TfrxListBox(Sender).Items.Add('');// add fake item
+ end;
+ TfrxListBox(Sender).ItemIndex := 0;
+end;
+
+procedure TfrxCrossEditorForm.RowsLBDragLeave(Sender: TObject);
+begin
+ if FItemAdded then
+ begin
+ TfrxListBox(Sender).Items.Delete(0);
+ FItemAdded := False;
+ end;
+end;
+
+procedure TfrxCrossEditorForm.DatasetCBClick(Sender: TObject);
+var
+ ds: TfrxCustomDBDataSet;
+begin
+ if (DatasetCB.ItemIndex = -1) or (DatasetCB.Items.Count = 0) then Exit;
+ ds := TfrxCustomDBDataSet(DatasetCB.Items.Objects[DatasetCB.ItemIndex]);
+ ds.GetFieldList(FieldsLB.Items);
+ RowsLB.Clear;
+ ColumnsLB.Clear;
+ CellsLB.Clear;
+ if (Sender <> nil) and not FUpdating then
+ ReflectChanges(nil);
+end;
+
+procedure TfrxCrossEditorForm.LBDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+{$IFDEF DELPHI20}
+var
+ Accept: Boolean;
+{$ENDIF}
+begin
+ Accept := (Data.Source is TfrxListBox) and (TfrxListBox(Data.Source).Items.Count > 0);
+ if not Accept then
+ Accept := (Data.Source is TListBoxItem);
+{$IFDEF DELPHI20}
+ if Accept then
+ Operation := TDragOperation.Copy;
+{$ENDIF}
+end;
+
+procedure TfrxCrossEditorForm.UpdateCheckBoxes(aListBox: TfrxListBox);
+var
+ i: Integer;
+ item2: TfrxListBoxItem;
+begin
+ FUpdating := True;
+ if aListBox.ShowCheckboxes then
+ for i := 0 to aListBox.Items.Count - 1 do
+ begin
+ item2 := aListBox.ListItems[i] as TfrxListBoxItem;
+ if item2 <> nil then
+ begin
+ item2.CheckVisible := (aListBox.Items.Count - 1 <> i);
+ if item2.CheckVisible then
+ if aListBox = ColumnsLB then
+ item2.IsChecked := FCross.ColumnTotalMemos[i].Visible
+ else if aListBox = RowsLB then
+ item2.IsChecked := FCross.RowTotalMemos[i].Visible;
+ end;
+ end;
+ FUpdating := False;
+end;
+
+procedure TfrxCrossEditorForm.LBDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+var
+ s: String;
+ i: Integer;
+ item: TListBoxItem;
+ SourceLB, SenderLB: TfrxListBox;
+begin
+ SourceLB := nil;
+//there are two ways to drag an item select and drag list box or drag item
+ if Data.Source is TfrxListBoxItem then
+ SourceLB := TfrxListBox(THackListBoxItem(Data.Source).ListBox)
+ else if Data.Source is TfrxListBox then
+ SourceLB := TfrxListBox(Data.Source);
+ if SourceLB = nil then Exit;
+ SenderLB := TfrxListBox(Sender);
+ if FItemAdded then
+ begin
+ TfrxListBox(Sender).Items.Delete(0);
+ FItemAdded := False;
+ end;
+ if (SourceLB.ItemIndex = -1) or (SourceLB.Count = 0) then Exit;
+ if (Data.Source = Sender) and (Data.Source <> FieldsLB) then
+ begin
+ item := SourceLB.ItemByPoint(Point.X, Point.Y);
+ i := -1;
+ if item <> nil then i := item.Index;
+
+ if i = -1 then
+ i := SourceLB.Items.Count - 1;
+ SourceLB.Items.Exchange(SourceLB.ItemIndex, i);
+ end
+ else if SourceLB <> Sender then
+ begin
+ s := SourceLB.Items[SourceLB.ItemIndex];
+ if SourceLB <> FieldsLB then
+ SourceLB.Items.Delete(SourceLB.Items.IndexOf(s));
+ if Sender <> FieldsLB then
+ SenderLB.Items.Add(s);
+ end;
+
+
+ UpdateCheckBoxes(SourceLB);
+ UpdateCheckBoxes(SenderLB);
+ ReflectChanges(Data.Source);
+ ReflectChanges(Sender);
+end;
+
+procedure TfrxCrossEditorForm.LBButtonClick(Sender, aButton: TObject;
+ aItem: TfrxListBoxItem);
+var
+ sort: TfrxCrossSortOrder;
+ f: TfrxCrossFunction;
+ i: Integer;
+ pt: TPointF;
+ m : TMenuItem;
+ //Button: TButton;
+begin
+ FCurList := TfrxListBox(Sender);
+ //Button := aButton as TButton;
+ if (Sender = RowsLB) or (Sender = ColumnsLB) then
+ begin
+ if Sender = RowsLB then
+ sort := FCross.RowSort[THackListBoxItem(aItem).Index] else
+ sort := FCross.ColumnSort[THackListBoxItem(aItem).Index];
+
+ for i := 0 to FSortMenuList.Count - 1 do
+ begin
+ m := TMenuItem(FSortMenuList[i]);
+ if m.Tag = Integer(sort) then
+ m.IsChecked := True
+ else
+ m.IsChecked := False;
+ end;
+ pt := aItem.LocalToAbsolute(PointF(aItem.Position.X + aItem.Width, 0));
+ pt := Self.ClientToScreen(pt);
+ SortPopup.Popup(pt.X, pt.Y);
+ end
+ else if (Sender = CellsLB) then
+ begin
+ if CellsLB.ItemIndex = -1 then Exit;
+ f := FCross.CellFunctions[CellsLB.ItemIndex];
+ for i := 0 to FFuncMenuList.Count - 1 do
+ begin
+ m := TMenuItem(FFuncMenuList[i]);
+ if m.Tag = Integer(f) then
+ m.IsChecked := True
+ else
+ m.IsChecked := False;
+ end;
+ pt := aItem.LocalToAbsolute(PointF(aItem.Position.X + aItem.Width, 0));
+ pt := Self.ClientToScreen(pt);
+ FuncPopup.Popup(pt.X, pt.Y);
+ end;
+end;
+
+procedure TfrxCrossEditorForm.LBCheckChange(Sender: TObject);
+var
+ FCurItem: TfrxListBoxItem;
+ Memo: TfrxCustomMemoView;
+begin
+
+ FCurItem := Sender as TfrxListBoxItem;
+ if (FCurItem = nil) or FUpdating then Exit;
+ FCurList := TfrxListBox(THackListBoxItem(FCurItem).ListBox);
+ if THackListBoxItem(FCurItem).ListBox = RowsLB then
+ Memo := FCross.RowTotalMemos[THackListBoxItem(FCurItem).Index + 1] else
+ Memo := FCross.ColumnTotalMemos[THackListBoxItem(FCurItem).Index + 1];
+ Memo.Visible := FCurItem.IsChecked;
+ PaintBox.InvalidateRect(PaintBox.BoundsRect);
+end;
+
+procedure TfrxCrossEditorForm.LBClick(Sender: TObject);
+begin
+ if Sender <> FieldsLB then
+ FieldsLB.ItemIndex := -1;
+ if Sender <> RowsLB then
+ RowsLB.ItemIndex := -1;
+ if Sender <> ColumnsLB then
+ ColumnsLB.ItemIndex := -1;
+ if Sender <> CellsLB then
+ CellsLB.ItemIndex := -1;
+end;
+
+procedure TfrxCrossEditorForm.LBDblClick(Sender: TObject);
+var
+ lb: TfrxListBox;
+ s: String;
+begin
+ lb := TfrxListBox(Sender);
+ if lb.ItemIndex = -1 then
+ exit;
+ s := Cross.Report.Designer.InsertExpression(lb.Items[lb.ItemIndex]);
+ if s <> '' then
+ begin
+ lb.Items[lb.ItemIndex] := s;
+ ReflectChanges(Sender);
+ end;
+end;
+
+procedure TfrxCrossEditorForm.CancelBClick(Sender: TObject);
+begin
+ ModalResult := mrCancel;
+end;
+
+procedure TfrxCrossEditorForm.OkBClick(Sender: TObject);
+begin
+ ModalResult := mrOk;
+end;
+
+procedure TfrxCrossEditorForm.LBMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+begin
+ FCurList := TfrxListBox(Sender);
+ FCurList.Repaint;
+ ReflectChanges(Sender, False);
+end;
+
+procedure TfrxCrossEditorForm.CBClick(Sender: TObject);
+begin
+ if FUpdating then Exit;
+
+ FCross.ShowTitle := TitleCB.IsChecked;
+ FCross.ShowCorner := CornerCB.IsChecked;
+ FCross.ShowColumnHeader := ColumnHeaderCB.IsChecked;
+ FCross.ShowRowHeader := RowHeaderCB.IsChecked;
+ FCross.ShowColumnTotal := ColumnTotalCB.IsChecked;
+ FCross.ShowRowTotal := RowTotalCB.IsChecked;
+
+ FCross.AutoSize := AutoSizeCB.IsChecked;
+ FCross.Border := BorderCB.IsChecked;
+ FCross.DownThenAcross := DownAcrossCB.IsChecked;
+ FCross.RepeatHeaders := RepeatCB.IsChecked;
+ FCross.PlainCells := PlainCB.IsChecked;
+ FCross.JoinEqualCells := JoinCB.IsChecked;
+ ReflectChanges(Sender, False);
+end;
+
+procedure TfrxCrossEditorForm.DimensionsChange(Sender: TObject);
+begin
+ if FUpdating then Exit;
+
+ case TControl(Sender).Tag of
+ 0: FCross.RowLevels := StrToInt(RowsE.Text);
+ 1: FCross.ColumnLevels := StrToInt(ColumnsE.Text);
+ 2: FCross.CellLevels := StrToInt(CellsE.Text);
+ end;
+
+ RowsLB.Items := FCross.RowFields;
+ ColumnsLB.Items := FCross.ColumnFields;
+ CellsLB.Items := FCross.CellFields;
+
+ ReflectChanges(Sender);
+end;
+
+procedure TfrxCrossEditorForm.FuncMIClick(Sender: TObject);
+begin
+ if CellsLB.ItemIndex = -1 then Exit;
+ FCross.CellFunctions[CellsLB.ItemIndex] := TfrxCrossFunction(TControl(Sender).Tag);
+ CellsLB.Repaint;
+ THackControl(CellsLB).DragEnd;
+end;
+
+
+procedure TfrxCrossEditorForm.SortMIClick(Sender: TObject);
+begin
+ if FCurList.ItemIndex = -1 then Exit;
+ if FCurList = ColumnsLB then
+ FCross.ColumnSort[FCurList.ItemIndex] := TfrxCrossSortOrder(TControl(Sender).Tag) else
+ FCross.RowSort[FCurList.ItemIndex] := TfrxCrossSortOrder(TControl(Sender).Tag);
+ FCurList.Repaint;
+ THackControl(FCurList).DragEnd;
+end;
+
+procedure TfrxCrossEditorForm.SwapBClick(Sender: TObject);
+var
+ sl: TStrings;
+begin
+ sl := TStringList.Create;
+ sl.Assign(RowsLB.Items);
+ FUpdating := True;
+ RowsLB.Items := ColumnsLB.Items;
+ ColumnsLB.Items := sl;
+ sl.Free;
+ FUpdating := False;
+ UpdateCheckBoxes(RowsLB);
+ UpdateCheckBoxes(ColumnsLB);
+ ReflectChanges(nil);
+ RowsLB.Repaint;
+ ColumnsLB.Repaint;
+end;
+
+procedure TfrxCrossEditorForm.StyleBClick(Sender: TObject);
+var
+ pt: TPointF;
+begin
+ pt := PaintBox.LocalToAbsolute(PointF(StyleB.Position.X, StyleB.Position.Y + ToolBar.Height));
+ StylePopup.Popup(Self.Left + pt.X, Self.Top + pt.Y );
+end;
+
+procedure TfrxCrossEditorForm.StyleClick(Sender: TObject);
+var
+ Style: TfrxStyles;
+begin
+ Style := FStyleSheet.Find(TMenuItem(Sender).Text);
+ if Style <> nil then
+ FCross.ApplyStyle(Style);
+ PaintBox.InvalidateRect(PaintBox.BoundsRect);
+end;
+
+procedure TfrxCrossEditorForm.SaveStyleMIClick(Sender: TObject);
+var
+ s: String;
+ Style: TfrxStyles;
+begin
+ s := '';
+ s := InputBox(frxGet(4313), frxResources.Get('crStName'), s);
+ if s <> '' then
+ begin
+ Style := FStyleSheet.Find(s);
+ if Style = nil then
+ Style := FStyleSheet.Add;
+ Style.Name := s;
+ FCross.GetStyle(Style);
+ FStyleSheet.SaveToFile(ExtractFilePath(ParamStr(0)) + 'crossstyles.xml');
+ CreateStyleMenu;
+ end;
+end;
+
+procedure TfrxCrossEditorForm.PaintBoxPaint(Sender: TObject; Canvas: TCanvas);
+begin
+ with Canvas do
+ begin
+ Fill.Color := claWhite;
+ FillRect(RectF(0, 0, PaintBox.Width, PaintBox.Height), 1, 1, AllCorners, 1, TCornerType.ctBevel);
+ end;
+ FCross.DrawCross(PaintBox.Canvas, 1, 1, 0, 0);
+end;
+
+
+initialization
+ frxComponentEditors.Register(TfrxCrossView, TfrxCrossEditor);
+ frxComponentEditors.Register(TfrxDBCrossView, TfrxCrossEditor);
+
+end.
diff --git a/LibD28/FMX.frxCrossRTTI.pas b/LibD28/FMX.frxCrossRTTI.pas
new file mode 100644
index 0000000..eab9fde
--- /dev/null
+++ b/LibD28/FMX.frxCrossRTTI.pas
@@ -0,0 +1,140 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Cross-tab RTTI }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCrossRTTI;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, System.SysUtils, FMX.Forms, FMX.fs_iinterpreter, FMX.frxCross, FMX.frxClassRTTI,
+ System.Variants, System.Types;
+
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TfrxCrossFunction', 'cfNone, cfSum, cfMin, cfMax, cfAvg, cfCount');
+ with AddClass(TfrxCustomCrossView, 'TfrxView') do
+ begin
+ AddMethod('procedure AddValue(Rows, Columns, Cells: array)', CallMethod);
+ AddMethod('procedure BeginMatrix', CallMethod);
+ AddMethod('function ColCount: Integer', CallMethod);
+ AddMethod('function RowCount: Integer', CallMethod);
+ AddMethod('function IsGrandTotalColumn(Index: Integer): Boolean', CallMethod);
+ AddMethod('function IsGrandTotalRow(Index: Integer): Boolean', CallMethod);
+ AddMethod('function IsTotalColumn(Index: Integer): Boolean', CallMethod);
+ AddMethod('function IsTotalRow(Index: Integer): Boolean', CallMethod);
+ AddProperty('ClearBeforePrint', 'Boolean', GetProp, SetProp);
+ AddIndexProperty('CellFunctions', 'Integer', 'TfrxCrossFunction', CallMethod);
+ end;
+
+ AddClass(TfrxCrossView, 'TfrxCustomCrossView');
+ AddClass(TfrxDBCrossView, 'TfrxCustomCrossView');
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ ar: array[0..2] of array of Variant;
+ _TfrxCustomCrossView: TfrxCustomCrossView;
+
+ procedure ConvertVariantToArray(v: Variant; Index: Integer);
+ var
+ i: Integer;
+ begin
+ SetLength(ar[Index], VarArrayHighBound(v, 1) + 1);
+ for i := 0 to VarArrayHighBound(v, 1) do
+ ar[Index][i] := v[i];
+ end;
+
+begin
+ Result := 0;
+ _TfrxCustomCrossView := TfrxCustomCrossView(Instance);
+
+ if MethodName = 'ADDVALUE' then
+ begin
+ ConvertVariantToArray(Caller.Params[0], 0);
+ ConvertVariantToArray(Caller.Params[1], 1);
+ ConvertVariantToArray(Caller.Params[2], 2);
+ _TfrxCustomCrossView.AddValue(ar[0], ar[1], ar[2]);
+ ar[0] := nil;
+ ar[1] := nil;
+ ar[2] := nil;
+ end
+ else if MethodName = 'BEGINMATRIX' then
+ _TfrxCustomCrossView.BeginMatrix
+ else if MethodName = 'COLCOUNT' then
+ Result := _TfrxCustomCrossView.ColCount
+ else if MethodName = 'ROWCOUNT' then
+ Result := _TfrxCustomCrossView.RowCount
+ else if MethodName = 'ISGRANDTOTALCOLUMN' then
+ Result := _TfrxCustomCrossView.IsGrandTotalColumn(Caller.Params[0])
+ else if MethodName = 'ISGRANDTOTALROW' then
+ Result := _TfrxCustomCrossView.IsGrandTotalRow(Caller.Params[0])
+ else if MethodName = 'ISTOTALCOLUMN' then
+ Result := _TfrxCustomCrossView.IsTotalColumn(Caller.Params[0])
+ else if MethodName = 'ISTOTALROW' then
+ Result := _TfrxCustomCrossView.IsTotalRow(Caller.Params[0])
+ else if MethodName = 'CELLFUNCTIONS.GET' then
+ Result := _TfrxCustomCrossView.CellFunctions[Caller.Params[0]]
+ else if MethodName = 'CELLFUNCTIONS.SET' then
+ _TfrxCustomCrossView.CellFunctions[Caller.Params[0]] := TfrxCrossFunction(Caller.Params[1])
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if PropName = 'CLEARBEFOREPRINT' then
+ Result := TfrxCustomCrossView(Instance).ClearBeforePrint
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if PropName = 'CLEARBEFOREPRINT' then
+ TfrxCustomCrossView(Instance).ClearBeforePrint := Value;
+end;
+
+
+initialization
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ if fsRTTIModules <> nil then
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/FMX.frxCrypto.pas b/LibD28/FMX.frxCrypto.pas
new file mode 100644
index 0000000..86be489
--- /dev/null
+++ b/LibD28/FMX.frxCrypto.pas
@@ -0,0 +1,1456 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Cryptography }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Anton Khayrudinov }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCrypto;
+
+{ Disable overflow checking.
+ Cryptography operates in finite fields
+ and integer oveflow is meaningless for it. }
+
+{$Q-}
+
+interface
+
+uses
+ System.SysUtils,
+ System.Classes;
+
+type
+
+ { RC4 cipher }
+
+ TCryptoRC4 = class
+ private
+ FS: array[0..255] of Byte;
+ FI, FJ: Byte;
+ public
+
+ { Initializes the RC4 cipher with a specified key }
+
+ procedure Init(const Key; Len: LongInt);
+
+ { Encrypts a data block "in place".
+ The RC4 cipher generates a crypto stream (based on the password),
+ that is combined with the original data with XOR operation.
+ If Data is nil, the crypto stream is generated but is written
+ nowhere. }
+
+ procedure Encrypt(Data: Pointer; Size: LongInt);
+ end;
+
+ { AES cipher. FIPS 197. }
+
+ TCryptoAESMatrix = array[0..15] of Byte; // matrix 4x4
+ TCryptoAESSBox = array[0..255] of Byte;
+ TCryptoAESDiffuseRow = array[0..3] of Byte;
+
+ TCryptoAES = class
+ private
+ FNr: Integer;
+ FW: array of TCryptoAESMatrix;
+
+ class procedure InitSBox;
+ class function Mul8(a, b: Integer): Integer;
+ protected
+ class procedure MatrixToData(out Data; const a: TCryptoAESMatrix);
+ class procedure DataToMatrix(out a: TCryptoAESMatrix; const Data);
+
+ procedure Sum(var a: TCryptoAESMatrix; const b, c: TCryptoAESMatrix);
+ procedure Mov(var a: TCryptoAESMatrix; const b: TCryptoAESMatrix);
+ procedure Zero(var a: TCryptoAESMatrix);
+
+ procedure Apply(var a: TCryptoAESMatrix; const Box: TCryptoAESSBox);
+ procedure Rotate(var a: TCryptoAESMatrix; Dir: Integer);
+ procedure Diffuse(var a: TCryptoAESMatrix; const DiffuseRow: TCryptoAESDiffuseRow);
+ procedure ExpandKey(const Key: array of Byte);
+
+ procedure Encrypt(var a: TCryptoAESMatrix); overload; virtual;
+ procedure Decrypt(var a: TCryptoAESMatrix); overload; virtual;
+ public
+
+ { Key length can be 16, 24 or 32 bytes }
+
+ constructor Create(const Key: array of Byte);
+
+ { Encrypts/decrypts a 16-byte block }
+
+ procedure Encrypt(var Output; const Input); overload; virtual;
+ procedure Decrypt(var Output; const Input); overload; virtual;
+ end;
+
+ ECryptoAESException = class(Exception);
+ ECryptoAESInvalidKeyLength = class(ECryptoAESException);
+ ECryptoAESInvalidBlockSize = class(ECryptoAESException);
+
+ { AES CBC mode }
+
+ TCryptoAES_CBC = class(TCryptoAES)
+ private
+ FC: TCryptoAESMatrix;
+ protected
+ procedure Encrypt(var a: TCryptoAESMatrix); override;
+ procedure Decrypt(var a: TCryptoAESMatrix); override;
+ public
+
+ { IV has 16 bytes }
+
+ constructor Create(const Key: array of Byte; const IV);
+ end;
+
+ { lag-r CMWC random number generator with base 2**32 }
+
+ TCryptoCMWC = class
+ private
+ FMultiplier: LongWord;
+ FSeed: array of LongWord;
+ FCarry: LongWord;
+ FNext: LongInt;
+ public
+ constructor Create(a: Cardinal = 3636507990; r: Cardinal = 1359);
+ function Next: LongWord;
+ end;
+
+ { Hash-function interface.
+ Typical use of a hash function is following:
+
+ h := TCryptoHash.Create('SHA1');
+ h.Push(@Message, Length(Message));
+ h.GetDigest(@Digest);
+ h.Free;
+
+ If several digests are computed with one TCryptoHash
+ instance (in order to save resources), then the following
+ way can be used:
+
+ h := TCryptoHash.Create('SHA1');
+
+ h.Reset; // optional
+ h.Push(@Message1, Length(Message1));
+ h.GetDigest(@Digest1);
+
+ h.Reset; // mandatory
+ h.Push(@Message2, Length(Message2));
+ h.GetDigest(@Digest2);
+
+ h.Reset; // mandatory
+ h.Push(@Message2, Length(Message2));
+ h.GetDigest(@Digest2);
+
+ h.Free;
+
+ Message can be sent by parts:
+
+ h := TCryptoHash.Create('SHA1');
+ h.Push(@MessagePart1, Length(MessagePart1));
+ h.Push(@MessagePart2, Length(MessagePart2));
+ h.Push(@MessagePart3, Length(MessagePart3));
+ h.GetDigest(@Digest);
+ h.Free; }
+
+ TCryptoHash = class
+ private
+ FChunk: array of Byte;
+ FLength: Integer;
+ protected
+ constructor Create(ChunkSize: Integer); overload;
+
+ procedure Process(const Chunk: array of Byte); virtual; abstract;
+ procedure Finish(LengthSize: Integer; Straight: Boolean); virtual;
+ public
+
+ { Creates an instance of a hash function.
+ Acceptable names are:
+
+ MD5
+ SHA1
+ Whirlpool
+ Jenkins
+
+ If the name is not recognised, nil is returned. }
+
+ class function Create(const Name: string): TCryptoHash; overload;
+
+ { Calculates a hash of a text. Note that different hash functions
+ produce digests of different lengths. }
+
+ class procedure Hash(const Name: string; var Digest; DigestSize: Integer;
+ const Data; Size: Integer); overload;
+ class procedure Hash(const Name: string; var Digest; DigestSize: Integer;
+ const s: AnsiString); overload;
+
+ { Resets the state of the hash function.
+ This method must be called if more than one digest
+ is computed with one TCryptoHash instance. }
+
+ procedure Reset; virtual;
+
+ { Sends a piece of message to the hash function }
+
+ procedure Push(b: Byte); overload;
+ procedure Push(const Data; Size: Integer); overload;
+ procedure Push(Stream: TStream); overload;
+
+ { Returns message digest. This function should not be called several times in a row. }
+
+ procedure GetDigest(out Digest; Size: Integer); virtual; abstract;
+
+ { Returns size of the digest in bytes }
+
+ function DigestSize: Integer; virtual; abstract;
+
+ { Block hashes compute read a message by chunks of fixed size.
+ It's most efficient to send a message to a hash function by chunks
+ of this size. }
+
+ function ChunkSize: Integer;
+ end;
+
+ ECryptoHash = class(Exception);
+
+ ECryptoHashUnknown = class(ECryptoHash)
+ public
+ constructor Create(Name: string);
+ end;
+
+ { MD5 hash. RFC 1321. Digest length: 16 bytes. }
+
+ TCryptoMD5 = class(TCryptoHash)
+ private
+ FState: array[0..3] of Integer;
+
+ class procedure InitSinTable;
+ procedure InitState;
+ protected
+ procedure Process(const Chunk: array of Byte); override;
+ public
+ constructor Create;
+
+ procedure GetDigest(out Digest; Size: Integer); override;
+ procedure Reset; override;
+ function DigestSize: Integer; override;
+ end;
+
+ { SHA1 hash. RFC 3174. Digest length: 20 bytes. }
+
+ TCryptoSHA1 = class(TCryptoHash)
+ private
+ FState: array[0..4] of Integer;
+
+ procedure InitState;
+ protected
+ procedure Process(const Chunk: array of Byte); override;
+ public
+ constructor Create;
+
+ procedure GetDigest(out Digest; Size: Integer); override;
+ procedure Reset; override;
+ function DigestSize: Integer; override;
+ end;
+
+ { Whirlpool hash. ISO/IEC 10118-3. Digest length: 64 bytes. }
+
+ TCryptoWhirlpoolMatrix = array[0..7, 0..7] of Byte;
+
+ TCryptoWhirlpool = class(TCryptoHash)
+ private
+ FState: TCryptoWhirlpoolMatrix;
+
+ procedure ApplySBox(var a: TCryptoWhirlpoolMatrix);
+ procedure Rotate(var a: TCryptoWhirlpoolMatrix);
+ procedure Diffuse(var a: TCryptoWhirlpoolMatrix);
+ procedure Transform(var a: TCryptoWhirlpoolMatrix; const b: TCryptoWhirlpoolMatrix);
+
+ procedure InitState;
+
+ procedure Sum(var a: TCryptoWhirlpoolMatrix; const b, c: TCryptoWhirlpoolMatrix);
+ procedure Encrypt(var w: TCryptoWhirlpoolMatrix; const a, b: TCryptoWhirlpoolMatrix);
+ protected
+ procedure Process(const Chunk: array of Byte); override;
+ private
+ class procedure InitSBox;
+ class procedure InitMul8;
+
+ class function Mul4(a, b: Integer): Integer;
+ class function Mul8(a, b: Integer): Integer;
+ class function Mul8NoCache(a, b: Integer): Integer;
+ public
+ constructor Create;
+
+ procedure GetDigest(out Digest; Size: Integer); override;
+ procedure Reset; override;
+ function DigestSize: Integer; override;
+ end;
+
+ { This is a modification of the Jenkins hash.
+ It's noncryptographic, but fast. }
+
+ TCryptoJenkins = class(TCryptoHash)
+ private
+ FState: Cardinal;
+ protected
+ procedure Finish(LengthSize: Integer; Straight: Boolean); override;
+ procedure Process(const Chunk: array of Byte); override;
+ public
+ constructor Create;
+
+ procedure GetDigest(out Digest; Size: Integer); override;
+ procedure Reset; override;
+ function DigestSize: Integer; override;
+ end;
+
+implementation
+
+uses
+ System.Math;
+
+{ Delphi4 doesn't allow to put these variables as
+ static class fields of corresponding classes. }
+
+var
+ AESSBox, AESIBox: TCryptoAESSBox;
+ MD5SinTable: array[1..64] of Integer;
+ WhirlpoolSBox: array[0..255] of Byte;
+ WhirlpoolMul8: array[1..9, 0..255] of Byte;
+
+{ Returns N bytes from Base + Offset }
+
+function GetNBytesAt(const Base; Offset, N: Integer): Integer;
+begin
+ Assert(SizeOf(Result) >= N);
+ Result := 0;
+ Move(Pointer(NativeInt(@Base) + Offset)^, Result, N);
+end;
+
+procedure SetNBytesAt(var Base; Offset, N, Value: Integer);
+begin
+ Assert(SizeOf(Value) >= N);
+ Move(Value, Pointer(NativeInt(@Base) + Offset)^, N);
+end;
+
+function Min(a, b: Integer): Integer;
+begin
+ if a < b then
+ Result := a
+ else
+ Result := b
+end;
+
+{ Rotates a 32-bit integer by n bits left }
+
+function RotLeft(a, n: Integer): Integer;
+var
+ p, q: Integer;
+begin
+ p := Integer(Cardinal(a) shr (32 - n));
+ q := a and ((Cardinal(1) shl (32 - n)) - 1);
+
+ Result := (q shl n) xor p;
+end;
+
+{ Swap bytes of a 32-bit integer }
+
+function ByteSwap(x: Integer): Integer;
+var
+ b: array[0..3] of Byte;
+ i: Integer;
+begin
+ for i := 0 to 3 do
+ begin
+ b[i] := x and $ff;
+ x := x shr 8;
+ end;
+
+ Result := 0;
+
+ for i := 0 to 3 do
+ Result := (Result shl 8) xor b[i];
+end;
+
+{ TCryptoCMWC }
+
+constructor TCryptoCMWC.Create(a, r: Cardinal);
+var
+ t: Extended;
+ i: LongInt;
+ h: array[0..15] of Byte;
+begin
+ FMultiplier := a;
+ SetLength(FSeed, r);
+
+ { Initialise the first r seed values with some data }
+
+ t := Time;
+ TCryptoHash.Hash('MD5', h, Length(h), t, SizeOf(t));
+
+ for i := 0 to Length(FSeed) - 1 do
+ begin
+ FSeed[i] := 0;
+ Move(h[(i mod 4)*4], FSeed[i], 4);
+ end;
+end;
+
+function TCryptoCMWC.Next: LongWord;
+const
+ Mask: Cardinal = $ffffffff;
+var
+ q: UInt64;
+begin
+ q := UInt64(FMultiplier)*FSeed[FNext] + FCarry;
+
+ FSeed[FNext] := q and Mask;
+ FCarry := (q shr 32) and Mask;
+ Result := FSeed[FNext];
+
+ Inc(FNext);
+
+ if FNext = Length(FSeed) then
+ FNext := 0;
+end;
+
+{ TCryptoRC4 }
+
+procedure TCryptoRC4.Init(const Key; Len: LongInt);
+var
+ i, j, k: Byte;
+ b: Byte;
+begin
+ for i := 0 to 255 do
+ FS[i] := i;
+
+ j := 0;
+ k := 0;
+
+ for i := 0 to 255 do
+ begin
+ j := (Integer(j) + GetNBytesAt(Key, k, 1) + FS[i]) and $ff;
+ k := k + 1;
+
+ if k = len then
+ k := 0;
+
+ b := FS[i];
+ FS[i] := FS[j];
+ FS[j] := b;
+ end;
+
+ FI := 0;
+ FJ := 0;
+end;
+
+procedure TCryptoRC4.Encrypt(Data: Pointer; Size: LongInt);
+var
+ i: Integer;
+ s, h: Byte;
+begin
+ for i := 0 to Size - 1 do
+ begin
+ Inc(FI);
+ Inc(FJ, FS[FI]);
+
+ s := FS[FJ];
+ FS[FJ] := FS[FI];
+ FS[FI] := s;
+
+ if Data <> nil then
+ begin
+ h := FS[(FS[FI] + FS[FJ]) and $ff];
+ SetNBytesAt(Data^, i, 1, GetNBytesAt(Data^, i, 1) xor h);
+ end;
+ end;
+end;
+
+{ TCryptoHash }
+
+function TCryptoHash.ChunkSize: Integer;
+begin
+ Result := Length(FChunk);
+end;
+
+class function TCryptoHash.Create(const Name: string): TCryptoHash;
+begin
+ if Name = 'MD5' then
+ Result := TCryptoMD5.Create
+
+ else if Name = 'SHA1' then
+ Result := TCryptoSHA1.Create
+
+ else if Name = 'Whirlpool' then
+ Result := TCryptoWhirlpool.Create
+
+ else if Name = 'Jenkins' then
+ Result := TCryptoJenkins.Create
+
+ else
+ Result := nil
+end;
+
+class procedure TCryptoHash.Hash(const Name: string; var Digest; DigestSize: Integer;
+ const Data; Size: Integer);
+var
+ h: TCryptoHash;
+begin
+ h := Create(Name);
+
+ if h = nil then
+ raise ECryptoHashUnknown.Create(Name);
+
+ try
+ h.Push(Data, Size);
+ h.GetDigest(Digest, DigestSize);
+ finally
+ h.Free;
+ end;
+end;
+
+constructor TCryptoHash.Create(ChunkSize: Integer);
+begin
+ SetLength(FChunk, ChunkSize);
+end;
+
+class procedure TCryptoHash.Hash(const Name: string; var Digest; DigestSize: Integer;
+ const s: AnsiString);
+begin
+ if s = '' then
+ Hash(Name, Digest, DigestSize, nil^, 0)
+ else
+ Hash(Name, Digest, DigestSize, s[1], Length(s))
+end;
+
+procedure TCryptoHash.Push(b: Byte);
+begin
+ FChunk[FLength mod Length(FChunk)] := b;
+ Inc(FLength);
+
+ if FLength mod Length(FChunk) = 0 then
+ Process(FChunk);
+end;
+
+procedure TCryptoHash.Push(const Data; Size: Integer);
+var
+ Used, n: Integer;
+ Offset: Integer;
+begin
+ { The following code is equal to:
+
+ for n := 0 to Size - 1 do
+ Push(PByte(Integer(Data) + n)^) }
+
+ Used := FLength mod ChunkSize;
+ Inc(FLength, Size);
+ Offset := 0;
+
+ while Size > 0 do
+ begin
+ n := Min(Size, ChunkSize - Used);
+ Move(Pointer(NativeInt(@Data) + Offset)^, FChunk[Used], n);
+
+ Inc(Offset, n);
+ Inc(Used, n);
+ Dec(Size, n);
+
+ if Used = ChunkSize then
+ begin
+ Process(FChunk);
+ Used := 0;
+ end;
+ end;
+end;
+
+procedure TCryptoHash.Reset;
+begin
+ FLength := 0;
+end;
+
+procedure TCryptoHash.Finish(LengthSize: Integer; Straight: Boolean);
+var
+ i, n, cn: Integer;
+begin
+ cn := Length(FChunk);
+ n := FLength*8;
+ Push($80);
+
+ while FLength mod cn <> cn - LengthSize do
+ Push(0);
+
+ if Straight then
+ for i := cn - LengthSize to cn - 1 do
+ begin
+ FChunk[i] := n and $ff;
+ n := n shr 8;
+ end
+ else
+ for i := cn - 1 downto cn - LengthSize do
+ begin
+ FChunk[i] := n and $ff;
+ n := n shr 8;
+ end;
+
+ Process(FChunk);
+end;
+
+procedure TCryptoHash.Push(Stream: TStream);
+var
+ Buffer: array of Byte;
+ n: Integer;
+begin
+ Stream.Position := 0;
+ SetLength(Buffer, ChunkSize);
+
+ n := Stream.Read(Buffer[0], Length(Buffer));
+
+ while n > 0 do
+ begin
+ Push(Buffer[0], n);
+ n := Stream.Read(Buffer[0], Length(Buffer));
+ end;
+end;
+
+{ TCryptoMD5 }
+
+constructor TCryptoMD5.Create;
+begin
+ inherited Create(64);
+ InitState;
+end;
+
+procedure TCryptoMD5.InitState;
+begin
+ FState[0] := ByteSwap(Integer($01234567));
+ FState[1] := ByteSwap(Integer($89abcdef));
+ FState[2] := ByteSwap(Integer($fedcba98));
+ FState[3] := ByteSwap(Integer($76543210));
+end;
+
+class procedure TCryptoMD5.InitSinTable;
+
+ function AbsSin(x: Extended): Extended;
+ begin
+ Result := Sin(x);
+
+ if Result < 0 then
+ Result := -Result;
+ end;
+
+var
+ i: Integer;
+begin
+ for i := 1 to 64 do
+ MD5SinTable[i] := Floor($100000000*AbsSin(i))
+end;
+
+procedure TCryptoMD5.Process(const Chunk: array of Byte);
+
+ function X(i: Integer): Integer;
+ begin
+ Result := GetNBytesAt(Chunk[4*i], 0, 4)
+ end;
+
+ function F(i, x, y, z: Integer): Integer;
+ begin
+ case i of
+ 00..15: Result := x and y or not x and z;
+ 16..31: Result := x and z or y and not z;
+ 32..47: Result := x xor y xor z;
+ 48..63: Result := y xor (x or not z);
+
+ else Result := 0;
+ end;
+ end;
+
+const
+ G: array[0..63, 0..1] of Integer =
+ (
+ { Round 1 }
+
+ ( 0, 7),
+ ( 1, 12),
+ ( 2, 17),
+ ( 3, 22),
+ ( 4, 7),
+ ( 5, 12),
+ ( 6, 17),
+ ( 7, 22),
+ ( 8, 7),
+ ( 9, 12),
+ (10, 17),
+ (11, 22),
+ (12, 7),
+ (13, 12),
+ (14, 17),
+ (15, 22),
+
+ { Round 2 }
+
+
+ ( 1, 5),
+ ( 6, 9),
+ (11, 14),
+ ( 0, 20),
+ ( 5, 5),
+ (10, 9),
+ (15, 14),
+ ( 4, 20),
+ ( 9, 5),
+ (14, 9),
+ ( 3, 14),
+ ( 8, 20),
+ (13, 5),
+ ( 2, 9),
+ ( 7, 14),
+ (12, 20),
+
+ { Round 3 }
+
+ ( 5, 4),
+ ( 8, 11),
+ (11, 16),
+ (14, 23),
+ ( 1, 4),
+ ( 4, 11),
+ ( 7, 16),
+ (10, 23),
+ (13, 4),
+ ( 0, 11),
+ ( 3, 16),
+ ( 6, 23),
+ ( 9, 4),
+ (12, 11),
+ (15, 16),
+ ( 2, 23),
+
+ { Round 4 }
+
+ ( 0, 6),
+ ( 7, 10),
+ (14, 15),
+ ( 5, 21),
+ (12, 6),
+ ( 3, 10),
+ (10, 15),
+ ( 1, 21),
+ ( 8, 6),
+ (15, 10),
+ ( 6, 15),
+ (13, 21),
+ ( 4, 6),
+ (11, 10),
+ ( 2, 15),
+ ( 9, 21)
+ );
+var
+ i, j, k: Integer;
+ W, R: array[0..3] of Integer;
+begin
+ for j := 0 to 3 do
+ W[j] := FState[j];
+
+ for i := 0 to 63 do
+ begin
+ for j := 0 to 3 do
+ R[j] := W[(j - i mod 16) and 3];
+
+ k := R[0] + X(G[i, 0]) + MD5SinTable[i + 1] + F(i, R[1], R[2], R[3]);
+ W[(0 - i mod 16) and 3] := R[1] + RotLeft(k, G[i, 1]);
+ end;
+
+ for j := 0 to 3 do
+ Inc(FState[j], W[j]);
+end;
+
+procedure TCryptoMD5.Reset;
+begin
+ inherited;
+ InitState;
+end;
+
+function TCryptoMD5.DigestSize: Integer;
+begin
+ Result := 16;
+end;
+
+procedure TCryptoMD5.GetDigest(out Digest; Size: Integer);
+begin
+ Assert(Size = DigestSize);
+ Finish(8, True);
+ Move(FState, Digest, Size);
+end;
+
+{ TCryptoSHA1 }
+
+constructor TCryptoSHA1.Create;
+begin
+ inherited Create(64);
+ InitState;
+end;
+
+function TCryptoSHA1.DigestSize: Integer;
+begin
+ Result := 20;
+end;
+
+procedure TCryptoSHA1.GetDigest(out Digest; Size: Integer);
+var
+ i: Integer;
+begin
+ Assert(Size = DigestSize);
+ Finish(8, False);
+
+ for i := 0 to 4 do
+ SetNBytesAt(Digest, i*4, 4, ByteSwap(FState[i]));
+end;
+
+procedure TCryptoSHA1.InitState;
+begin
+ FState[0] := ByteSwap(Integer($01234567));
+ FState[1] := ByteSwap(Integer($89abcdef));
+ FState[2] := ByteSwap(Integer($fedcba98));
+ FState[3] := ByteSwap(Integer($76543210));
+ FState[4] := ByteSwap(Integer($f0e1d2c3));
+end;
+
+procedure TCryptoSHA1.Process(const Chunk: array of Byte);
+
+ function K(i: Integer): Integer;
+ begin
+ case i of
+ 00..19: Result := Integer($5a827999);
+ 20..39: Result := Integer($6ed9eba1);
+ 40..59: Result := Integer($8f1bbcdc);
+ 60..79: Result := Integer($ca62c1d6);
+
+ else Result := 0
+ end
+ end;
+
+ function F(t, b, c, d: Integer): Integer;
+ begin
+ case t of
+ 00..19: Result := b and c or not b and d;
+ 20..39: Result := b xor c xor d;
+ 40..59: Result := b and c or b and d or c and d;
+ 60..79: Result := b xor c xor d;
+
+ else Result := 0
+ end
+ end;
+
+var
+ H: array[0..4] of Integer;
+
+ procedure Shuffle(t: Integer);
+ begin
+ H[4] := H[3];
+ H[3] := H[2];
+ H[2] := H[1];
+ H[1] := H[0];
+ H[0] := t;
+
+ H[2] := RotLeft(H[2], 30);
+ end;
+
+var
+ i, j: Integer;
+ W: array[0..79] of Integer;
+begin
+ for i := 0 to 15 do
+ W[i] := ByteSwap(GetNBytesAt(Chunk[i*4], 0, 4));
+
+ for i := 16 to 79 do
+ W[i] := RotLeft(W[i - 3] xor W[i - 8] xor W[i - 14] xor W[i - 16], 1);
+
+ for j := 0 to 4 do
+ H[j] := FState[j];
+
+ for i := 0 to 79 do
+ Shuffle(RotLeft(H[0], 5) + F(i, H[1], H[2], H[3]) + H[4] + W[i] + K(i));
+
+ for j := 0 to 4 do
+ Inc(FState[j], H[j]);
+end;
+
+procedure TCryptoSHA1.Reset;
+begin
+ inherited;
+ InitState;
+end;
+
+{ TCryptoWhirlpool }
+
+class procedure TCryptoWhirlpool.InitSBox;
+const
+ R: array[0..15] of Byte = (7, 12, 11, 13, 14, 4, 9, 15, 6, 3, 8, 10, 2, 5, 1, 0);
+var
+ s, u, v, a: Integer;
+ E, I: array[0..15] of Byte;
+begin
+ E[0] := 1;
+ E[15] := 0;
+
+ for s := 1 to 14 do
+ E[s] := Mul4($b, E[s - 1]);
+
+ for s := 0 to 15 do
+ I[E[s]] := s;
+
+ for s := 0 to 255 do
+ begin
+ u := s shr 4;
+ v := s and $f;
+
+ a := R[E[u] xor I[v]];
+ u := E[E[u] xor a];
+ v := I[I[v] xor a];
+
+ WhirlpoolSBox[s] := (u shl 4) xor v;
+ end;
+end;
+
+class function TCryptoWhirlpool.Mul4(a, b: Integer): Integer;
+begin
+ Result := 0;
+
+ while b <> 0 do
+ begin
+ if b and 1 = 1 then
+ Result := Result xor a;
+
+ b := b shr 1;
+ a := a shl 1;
+
+ if a and $10 <> 0 then
+ a := a xor $13;
+ end;
+end;
+
+class function TCryptoWhirlpool.Mul8(a, b: Integer): Integer;
+begin
+ { If an exception happens here, then Whirlpool is incorrectly initialised.
+ Before using Whirlpool, its Mul8 cache must be filled in for all values
+ in the diffuse row. }
+
+ Result := WhirlpoolMul8[a, b]
+end;
+
+class procedure TCryptoWhirlpool.InitMul8;
+var
+ a, b: Integer;
+begin
+ for a := 1 to 9 do
+ for b := 0 to 255 do
+ WhirlpoolMul8[a, b] := Mul8NoCache(a, b);
+end;
+
+class function TCryptoWhirlpool.Mul8NoCache(a, b: Integer): Integer;
+begin
+ Result := 0;
+
+ while b <> 0 do
+ begin
+ if b and 1 = 1 then
+ Result := Result xor a;
+
+ b := b shr 1;
+ a := a shl 1;
+
+ if a and $100 <> 0 then
+ a := a xor $11d;
+ end;
+end;
+
+procedure TCryptoWhirlpool.ApplySBox(var a: TCryptoWhirlpoolMatrix);
+var
+ i, j: Integer;
+begin
+ for i := 0 to 7 do
+ for j := 0 to 7 do
+ a[i, j] := WhirlpoolSBox[a[i, j]]
+end;
+
+procedure TCryptoWhirlpool.Rotate(var a: TCryptoWhirlpoolMatrix);
+var
+ i, j: Integer;
+ Col: array[0..7] of Byte;
+begin
+ for j := 0 to 7 do
+ begin
+ for i := 0 to 7 do
+ Col[i] := a[(i - j) and 7, j];
+
+ for i := 0 to 7 do
+ a[i, j] := Col[i];
+ end;
+end;
+
+procedure TCryptoWhirlpool.Sum(var a: TCryptoWhirlpoolMatrix; const b, c: TCryptoWhirlpoolMatrix);
+var
+ i, j: Integer;
+begin
+ for i := 0 to 7 do
+ for j := 0 to 7 do
+ a[i, j] := b[i, j] xor c[i, j];
+end;
+
+procedure TCryptoWhirlpool.Diffuse(var a: TCryptoWhirlpoolMatrix);
+const
+ DiffuseRow: array[0..7] of Byte = (1, 1, 4, 1, 8, 5, 2, 9);
+var
+ i, j, k: Integer;
+ Row: array[0..7] of Byte;
+begin
+ for i := 0 to 7 do
+ begin
+ for j := 0 to 7 do
+ Row[j] := 0;
+
+ for j := 0 to 7 do
+ for k := 0 to 7 do
+ Row[j] := Row[j] xor Mul8(DiffuseRow[(j - k) and 7], a[i, k]);
+
+ for j := 0 to 7 do
+ a[i, j] := Row[j];
+ end;
+end;
+
+function TCryptoWhirlpool.DigestSize: Integer;
+begin
+ Result := 64;
+end;
+
+procedure TCryptoWhirlpool.Encrypt(var w: TCryptoWhirlpoolMatrix; const a, b: TCryptoWhirlpoolMatrix);
+var
+ c, k: TCryptoWhirlpoolMatrix;
+ i, r: Integer;
+begin
+ Sum(w, a, b);
+ Sum(c, c, c);
+ Sum(k, a, c);
+
+ for r := 1 to 10 do
+ begin
+ for i := 0 to 7 do
+ c[0, i] := WhirlpoolSBox[8*(r - 1) + i];
+
+ Transform(k, c);
+ Transform(w, k);
+ end;
+end;
+
+procedure TCryptoWhirlpool.Transform(var a: TCryptoWhirlpoolMatrix; const b: TCryptoWhirlpoolMatrix);
+begin
+ ApplySBox(a);
+ Rotate(a);
+ Diffuse(a);
+ Sum(a, a, b);
+end;
+
+procedure TCryptoWhirlpool.InitState;
+begin
+ Sum(FState, FState, FState);
+end;
+
+procedure TCryptoWhirlpool.GetDigest(out Digest; Size: Integer);
+var
+ i: Integer;
+begin
+ Assert(Size = DigestSize);
+ Finish(32, False);
+
+ for i := 0 to 7 do
+ Move(FState[i, 0], Pointer(NativeInt(@Digest) + i*8)^, 8);
+end;
+
+procedure TCryptoWhirlpool.Reset;
+begin
+ inherited;
+ InitState;
+end;
+
+procedure TCryptoWhirlpool.Process(const Chunk: array of Byte);
+var
+ i, j: Integer;
+ b, w: TCryptoWhirlpoolMatrix;
+begin
+ for i := 0 to 7 do
+ for j := 0 to 7 do
+ b[i, j] := Chunk[i*8 + j];
+
+ Encrypt(w, FState, b);
+
+ Sum(FState, FState, w);
+ Sum(FState, FState, b);
+end;
+
+constructor TCryptoWhirlpool.Create;
+begin
+ inherited Create(64);
+ InitState;
+end;
+
+{ TCryptoAES }
+
+class procedure TCryptoAES.InitSBox;
+
+ function XorBits(b: Byte): Byte;
+ var
+ i: Integer;
+ begin
+ Result := 0;
+
+ for i := 0 to 7 do
+ Result := Result xor ((b shr i) and 1);
+ end;
+
+var
+ i, b: Integer;
+ m, r, q: Byte;
+begin
+ for b := 0 to 255 do
+ begin
+ m := $f8;
+ r := 0;
+
+ { Find qb = 1 }
+
+ if b = 0 then
+ q := 0
+ else
+ for q := 1 to 255 do
+ if Mul8(b, q) = 1 then
+ Break;
+
+ for i := 0 to 7 do
+ begin
+ r := (r shl 1) xor XorBits(q and m);
+ m := (m shr 1) xor Byte(m shl 7);
+ end;
+
+ AESSBox[b] := r xor $63;
+ AESIBox[AESSBox[b]] := b;
+ end;
+end;
+
+class function TCryptoAES.Mul8(a, b: Integer): Integer;
+begin
+ Result := 0;
+
+ while b <> 0 do
+ begin
+ if b and 1 <> 0 then
+ Result := Result xor a;
+
+ b := b shr 1;
+ a := a shl 1;
+
+ if a and $100 <> 0 then
+ a := a xor $11b;
+ end;
+end;
+
+procedure TCryptoAES.Apply(var a: TCryptoAESMatrix; const Box: TCryptoAESSBox);
+var
+ i: Integer;
+begin
+ for i := 0 to 15 do
+ a[i] := Box[a[i]]
+end;
+
+procedure TCryptoAES.Diffuse(var a: TCryptoAESMatrix; const DiffuseRow: TCryptoAESDiffuseRow);
+var
+ i, j, k: Integer;
+ Col: array[0..3] of Byte;
+begin
+ for j := 0 to 3 do
+ begin
+ for i := 0 to 3 do
+ Col[i] := 0;
+
+ for i := 0 to 3 do
+ for k := 0 to 3 do
+ Col[i] := Col[i] xor Mul8(DiffuseRow[(k - i) and 3], a[k*4 + j]);
+
+ for i := 0 to 3 do
+ a[i*4 + j] := Col[i];
+ end;
+end;
+
+procedure TCryptoAES.ExpandKey(const Key: array of Byte);
+var
+ i, j, Nk: Integer;
+ c: Byte; // 2^(i/Nk - 1) in GF(2^8)
+ a: array of array[0..3] of Byte;
+ t: array[0..3] of Byte;
+begin
+ Nk := Length(Key) div 4;
+ SetLength(a, 4*(FNr + 1));
+
+ for i := 0 to Nk - 1 do
+ for j := 0 to 3 do
+ a[i][j] := Key[i*4 + j];
+
+ c := 1;
+
+ for i := Nk to 4*(FNr + 1) - 1 do
+ begin
+ for j := 0 to 3 do
+ t[j] := a[i - 1][j];
+
+ if i mod Nk = 0 then
+ begin
+ for j := 0 to 3 do
+ t[j] := AESSBox[a[i - 1][(j + 1) and 3]];
+
+ t[0] := t[0] xor c;
+ c := Mul8(c, 2);
+ end;
+
+ if (i mod Nk = 4) and (Nk > 6) then
+ for j := 0 to 3 do
+ t[j] := AESSBox[a[i - 1][j]];
+
+ for j := 0 to 3 do
+ a[i][j] := t[j] xor a[i - Nk][j];
+ end;
+
+ SetLength(FW, FNr + 1);
+
+ for i := 0 to 4*(FNr + 1) - 1 do
+ for j := 0 to 3 do
+ FW[i div 4][j*4 + i mod 4] := a[i][j]
+end;
+
+procedure TCryptoAES.Rotate(var a: TCryptoAESMatrix; Dir: Integer);
+var
+ i, j: Integer;
+ r: array[0..3] of Byte;
+begin
+ for i := 0 to 3 do
+ begin
+ for j := 0 to 3 do
+ r[j] := a[i*4 + (j - Dir*i) mod 4];
+
+ for j := 0 to 3 do
+ a[i*4 + j] := r[j];
+ end;
+end;
+
+procedure TCryptoAES.Sum(var a: TCryptoAESMatrix; const b, c: TCryptoAESMatrix);
+var
+ i: Integer;
+begin
+ for i := 0 to 15 do
+ a[i] := b[i] xor c[i]
+end;
+
+procedure TCryptoAES.Mov(var a: TCryptoAESMatrix; const b: TCryptoAESMatrix);
+var
+ i: Integer;
+begin
+ for i := 0 to 15 do
+ a[i] := b[i]
+end;
+
+procedure TCryptoAES.Zero(var a: TCryptoAESMatrix);
+var
+ i: Integer;
+begin
+ for i := 0 to 15 do
+ a[i] := 0
+end;
+
+procedure TCryptoAES.Encrypt(var a: TCryptoAESMatrix);
+const
+ R: TCryptoAESDiffuseRow = (2, 3, 1, 1);
+var
+ i: Integer;
+begin
+ Sum(a, a, FW[0]);
+
+ for i := 1 to FNr - 1 do
+ begin
+ Apply(a, AESSBox);
+ Rotate(a, -1);
+ Diffuse(a, R);
+ Sum(a, a, FW[i]);
+ end;
+
+ Apply(a, AESSBox);
+ Rotate(a, -1);
+ Sum(a, a, FW[FNr]);
+end;
+
+procedure TCryptoAES.Decrypt(var a: TCryptoAESMatrix);
+const
+ R: TCryptoAESDiffuseRow = ($e, $b, $d, 9);
+var
+ i: Integer;
+begin
+ Sum(a, a, FW[FNr]);
+
+ for i := FNr - 1 downto 1 do
+ begin
+ Rotate(a, +1);
+ Apply(a, AESIBox);
+ Sum(a, a, FW[i]);
+ Diffuse(a, R);
+ end;
+
+ Rotate(a, +1);
+ Apply(a, AESIBox);
+ Sum(a, a, FW[0]);
+end;
+
+class procedure TCryptoAES.MatrixToData(out Data; const a: TCryptoAESMatrix);
+var
+ i, j: Integer;
+begin
+ for i := 0 to 3 do
+ for j := 0 to 3 do
+ SetNBytesAt(Data, j*4 + i, 1, a[i*4 + j])
+end;
+
+class procedure TCryptoAES.DataToMatrix(out a: TCryptoAESMatrix; const Data);
+var
+ i, j: Integer;
+begin
+ for i := 0 to 3 do
+ for j := 0 to 3 do
+ a[i*4 + j] := GetNBytesAt(Data, j*4 + i, 1)
+end;
+
+procedure TCryptoAES.Decrypt(var Output; const Input);
+var
+ a: TCryptoAESMatrix;
+begin
+ DataToMatrix(a, Input);
+ Decrypt(a);
+ MatrixToData(Output, a);
+end;
+
+procedure TCryptoAES.Encrypt(var Output; const Input);
+var
+ a: TCryptoAESMatrix;
+begin
+ DataToMatrix(a, Input);
+ Encrypt(a);
+ MatrixToData(Output, a);
+end;
+
+constructor TCryptoAES.Create(const Key: array of Byte);
+begin
+ case Length(Key) of
+ 4*4: FNr := 10;
+ 4*6: FNr := 12;
+ 4*8: FNr := 14;
+ else raise ECryptoAESInvalidKeyLength.CreateFmt('AES-%d is undefined',
+ [Length(Key)*8]);
+ end;
+
+ ExpandKey(Key);
+end;
+
+{ TCryptoAES_CBC }
+
+constructor TCryptoAES_CBC.Create(const Key: array of Byte; const IV);
+begin
+ inherited Create(Key);
+ DataToMatrix(FC, IV);
+end;
+
+procedure TCryptoAES_CBC.Encrypt(var a: TCryptoAESMatrix);
+begin
+ Sum(a, a, FC);
+ inherited Encrypt(a);
+ Mov(FC, a);
+end;
+
+procedure TCryptoAES_CBC.Decrypt(var a: TCryptoAESMatrix);
+var
+ s: TCryptoAESMatrix;
+begin
+ Mov(s, FC);
+ Mov(FC, a);
+ inherited Decrypt(a);
+ Sum(a, a, s);
+end;
+
+{ ECryptoHashUnknown }
+
+constructor ECryptoHashUnknown.Create(Name: string);
+begin
+ CreateFmt('Hash function %s is unknown', [Name]);
+end;
+
+{ TCryptoJenkins }
+
+constructor TCryptoJenkins.Create;
+begin
+ inherited Create(64)
+end;
+
+function TCryptoJenkins.DigestSize: Integer;
+begin
+ Result := 4
+end;
+
+procedure TCryptoJenkins.Finish(LengthSize: Integer; Straight: Boolean);
+var
+ h: Cardinal;
+begin
+ inherited;
+
+ h := FState;
+
+ h := h + (h shl 3);
+ h := h xor (h shr 11);
+ h := h + (h shl 15);
+
+ FState := h;
+end;
+
+procedure TCryptoJenkins.GetDigest(out Digest; Size: Integer);
+begin
+ Assert(Size = DigestSize);
+ Finish(ChunkSize div 2, True);
+ Move(FState, Digest, Size);
+end;
+
+procedure TCryptoJenkins.Process(const Chunk: array of Byte);
+var
+ h: Cardinal;
+ i: Integer;
+begin
+ h := FState;
+
+ for i := 0 to ChunkSize - 1 do
+ begin
+ h := h + Chunk[i];
+ h := h + (h shl 10);
+ h := h xor (h shr 6);
+ end;
+
+ FState := h;
+end;
+
+procedure TCryptoJenkins.Reset;
+begin
+ inherited;
+ FState := 0;
+end;
+
+initialization
+
+TCryptoMD5.InitSinTable;
+TCryptoWhirlpool.InitSBox;
+TCryptoWhirlpool.InitMul8;
+TCryptoAES.InitSBox;
+
+end.
diff --git a/LibD28/FMX.frxCtrls.pas b/LibD28/FMX.frxCtrls.pas
new file mode 100644
index 0000000..55296ad
--- /dev/null
+++ b/LibD28/FMX.frxCtrls.pas
@@ -0,0 +1,435 @@
+{***************************************************}
+{ }
+{ FastReport v4.0 }
+{ Tool controls }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{***************************************************}
+
+unit FMX.frxCtrls;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.Types, System.UITypes, FMX.Types, FMX.Controls, FMX.ListBox,
+ FMX.Forms, FMX.Edit, System.UIConsts, FMX.Objects, FMX.Layouts
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI21}
+ , FMX.Controls.Presentation
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+ TfrxScrollWin = class(TStyledControl)
+ private
+ FHScrollBar: TScrollBar;
+ FVScrollBar: TScrollBar;
+ FContent: TContent;
+ procedure SetHorzRange(Value: Single);
+ procedure SetHorzPosition(Value: Single);
+ procedure SetVertRange(Value: Single);
+ procedure SetVertPosition(Value: Single);
+ procedure CheckScrollBars;
+ procedure UpdateScrollBars;
+ function HScrollBar: TScrollBar;
+ function VScrollBar: TScrollBar;
+ function GetHorzPosition: Single;
+ function GetVertPosition: Single;
+ function GetHorzRange: Single;
+ function GetVertRange: Single;
+ protected
+ procedure ApplyStyle; override;
+ procedure FreeStyle; override;
+ procedure KeyDown(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState); override;
+ procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override;
+ procedure OnHScrollChange(Sender: TObject); virtual;
+ procedure OnVScrollChange(Sender: TObject); virtual;
+ procedure DoContentPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF); virtual;
+ function GetContentCanvas: TCanvas;
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure Resize; override;
+ function GetClientRect: TRectF;
+ property HorzRange: Single read GetHorzRange write SetHorzRange;
+ property HorzPosition: Single read GetHorzPosition write SetHorzPosition;
+ property VertRange: Single read GetVertRange write SetVertRange;
+ property VertPosition: Single read GetVertPosition write SetVertPosition;
+ end;
+
+
+ TfrxSplitter = class(TSplitter)
+ private
+ FOnMove: TNotifyEvent;
+ public
+ procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
+ property OnMove: TNotifyEvent read FOnMove write FOnMove;
+ end;
+
+ TfrxEditWithButton = class(TEdit)
+ private
+{$IFDEF DELPHI21}
+ FButton: TEditButton;
+{$ELSE}
+ FButton: TSpeedButton;
+{$ENDIF}
+ FOnButtonClick: TNotifyEvent;
+ procedure DoButtonClick(Sender: TObject);
+ protected
+{$IFDEF DELPHI21}
+ function DefinePresentationName: string; override;
+{$ENDIF}
+ procedure ApplyStyle; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ published
+ property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
+ end;
+
+ TfrxEditButton = class(TSpeedButton)
+ private
+ procedure DoContentPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
+ protected
+ procedure ApplyStyle; override;
+ end;
+
+
+implementation
+
+function Min(A, B: Single): Single;
+begin
+ if A < B then Result := A
+ else Result := B;
+end;
+
+constructor TfrxScrollWin.Create(AOwner: TComponent);
+begin
+ inherited;
+ CanFocus := True;
+{$IFDEF Delphi18}
+ StyleLookup := 'scrollboxstyle';
+{$ELSE}
+ FStyleLookup := 'scrollboxstyle';
+{$ENDIF}
+ ClipChildren := True;
+{$IFNDEF Delphi17}
+ CanClip := True;
+{$ENDIF}
+ ClipParent := True;
+end;
+
+procedure TfrxScrollWin.ApplyStyle;
+var
+ B: TFmxObject;
+begin
+ inherited;
+ if (FVScrollBar = nil) or (FHScrollBar = nil) then
+ begin
+ B := FindStyleResource('vscrollbar');
+ if (B <> nil) and (B is TScrollBar) then
+ begin
+ FVScrollBar := TScrollBar(B);
+ FVScrollBar.OnChange := OnVScrollChange;
+ end;
+ B := FindStyleResource('hscrollbar');
+ if (B <> nil) and (B is TScrollBar) then
+ begin
+ FHScrollBar := TScrollBar(B);
+ FHScrollBar.OnChange := OnHScrollChange;
+ end;
+ B := FindStyleResource('sizegrip');
+ if (B <> nil) and (B is TControl) then
+ (B as TControl).Visible := False;
+ end;
+ B := FindStyleResource('content');
+ if (B <> nil) and (B is TControl) then
+ begin
+ FContent := TContent(B);
+ FContent.OnPaint := DoContentPaint;
+ FContent.BringToFront;
+ FContent.ClipChildren := True;
+ FContent.ClipParent := True;
+{$IFNDEF Delphi17}
+ FContent.CanClip := True;
+{$ENDIF}
+ end;
+end;
+
+procedure TfrxScrollWin.CheckScrollBars;
+begin
+ if (FHScrollBar = nil) or (FVScrollBar = nil) then
+ ApplyStyleLookup;
+end;
+
+function TfrxScrollWin.GetClientRect: TRectF;
+begin
+ if FContent <> nil then
+ Result := FContent.ClipRect
+ else
+ Result := RectF(0, 0, 0, 0);
+end;
+
+function TfrxScrollWin.GetContentCanvas: TCanvas;
+begin
+ Result := nil;
+ if (FContent <> nil) and (FContent.Canvas <> nil) then
+ Result := FContent.Canvas;
+end;
+
+function TfrxScrollWin.GetHorzPosition: Single;
+begin
+ Result := HScrollBar.Value;
+end;
+
+function TfrxScrollWin.GetHorzRange: Single;
+begin
+ Result := HScrollBar.Max;
+end;
+
+function TfrxScrollWin.GetVertPosition: Single;
+begin
+ Result := VScrollBar.Value;
+end;
+
+function TfrxScrollWin.GetVertRange: Single;
+begin
+ Result := VScrollBar.Max;
+end;
+
+function TfrxScrollWin.HScrollBar: TScrollBar;
+begin
+ CheckScrollBars;
+ Result := FHScrollBar;
+end;
+
+function TfrxScrollWin.VScrollBar: TScrollBar;
+begin
+ CheckScrollBars;
+ Result := FVScrollBar;
+end;
+
+procedure TfrxScrollWin.SetHorzPosition(Value: Single);
+begin
+ HScrollBar.Value := Value;
+end;
+
+procedure TfrxScrollWin.SetHorzRange(Value: Single);
+begin
+ HScrollBar.Max := Value;
+ UpdateScrollBars;
+end;
+
+procedure TfrxScrollWin.SetVertPosition(Value: Single);
+begin
+ VScrollBar.Value := Value;
+end;
+
+procedure TfrxScrollWin.SetVertRange(Value: Single);
+begin
+ VScrollBar.Max := Value;
+ UpdateScrollBars;
+end;
+
+procedure TfrxScrollWin.UpdateScrollbars;
+begin
+ if HorzRange > BoundsRect.Width then
+ begin
+ HScrollBar.Visible := True;
+ HScrollBar.SmallChange := BoundsRect.Width / 5;
+ HorzPosition := HorzPosition;
+ HScrollBar.ViewportSize := BoundsRect.Width;
+ end
+ else
+ begin
+ HScrollBar.Visible := False;
+ end;
+
+ if VertRange > BoundsRect.Height then
+ begin
+ VScrollBar.Visible := True;
+ VScrollBar.SmallChange := BoundsRect.Height / 5;
+ VertPosition := VertPosition;
+ VScrollBar.ViewportSize := BoundsRect.Height;
+ end
+ else
+ begin
+ VScrollBar.Visible := False;
+ end;
+
+ if HScrollBar.Visible and VScrollBar.Visible then
+ HScrollBar.Padding.Right := VScrollBar.Width
+ else
+ HScrollBar.Padding.Right := 0;
+end;
+
+procedure TfrxScrollWin.Resize;
+begin
+ if FContent <> nil then
+ begin
+ //FContent.SetBounds(Left, Top, Width, Height);
+{$IFNDEF Delphi17}
+ FContent.Realign;
+{$ENDIF}
+ end;
+// XE3 bug?
+// UpdateScrollBars;
+ inherited;
+end;
+
+procedure TfrxScrollWin.MouseWheel(Shift: TShiftState; WheelDelta: Integer;
+ var Handled: Boolean);
+begin
+ inherited;
+ VertPosition := VertPosition - WheelDelta;
+ Handled := True;
+end;
+
+procedure TfrxScrollWin.KeyDown(var Key: Word; var KeyChar: System.WideChar;
+ Shift: TShiftState);
+begin
+ inherited;
+ case Key of
+ vkHome:
+ VertPosition := 0;
+ vkEnd:
+ VertPosition := VertRange;
+ vkUp:
+ VertPosition := VertPosition - VScrollBar.SmallChange;
+ vkDown:
+ VertPosition := VertPosition + VScrollBar.SmallChange;
+ vkLeft:
+ HorzPosition := HorzPosition - HScrollBar.SmallChange;
+ vkRight:
+ HorzPosition := HorzPosition + HScrollBar.SmallChange;
+ vkPrior:
+ VertPosition := VertPosition - VScrollBar.ViewportSize;
+ vkNext:
+ VertPosition := VertPosition + VScrollBar.ViewportSize;
+ end;
+end;
+
+procedure TfrxScrollWin.DoContentPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
+begin
+end;
+
+procedure TfrxScrollWin.FreeStyle;
+begin
+ inherited;
+ { Need to clear style objects }
+ FVScrollBar := nil;
+ FHScrollBar := nil;
+end;
+
+procedure TfrxScrollWin.OnHScrollChange(Sender: TObject);
+begin
+end;
+
+procedure TfrxScrollWin.OnVScrollChange(Sender: TObject);
+begin
+end;
+
+{ TfrxSplitter }
+
+procedure TfrxSplitter.MouseMove(Shift: TShiftState; X, Y: Single);
+begin
+ inherited;
+{$IFDEF DELPHI21}
+ if Pressed and Assigned(FOnMove) then
+{$ELSE}
+ if FPressed and Assigned(FOnMove) then
+{$ENDIF}
+ FOnMove(Self);
+end;
+
+
+{ TfrxEditWithButton }
+
+procedure TfrxEditButton.ApplyStyle;
+var
+ C: TFmxObject;
+begin
+ inherited;
+ C := FindStyleResource('text');
+ if Assigned(C) and (C is TText) then
+ begin
+ TText(C).OnPaint := DoContentPaint;
+ end;
+end;
+
+procedure TfrxEditButton.DoContentPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
+var
+ i, dx, dy: Integer;
+begin
+ Canvas.Fill.Kind := TBrushKind.bkSolid;
+ Canvas.Fill.Color := claGray;
+ dx := Round(ARect.Width / 2) - 6;
+ dy := Round(ARect.Height / 2) - 1;
+ for i := 0 to 2 do
+ Canvas.FillRect(RectF(ARect.Left + dx + i * 5, ARect.Top + dy, ARect.Left + 2 + dx + i * 5, ARect.Top + 2 + dy), 0, 0, allCorners, 1);
+end;
+
+constructor TfrxEditWithButton.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+{$IFDEF DELPHI21}
+ FButton := TEditButton.Create(Self);
+ FButton.Text := '..';
+ ButtonsContent.AddObject(FButton);
+{$ELSE}
+ FButton := TfrxEditButton.Create(Self);
+ FButton.Parent := Self;
+{$ENDIF}
+ FButton.Width := 22;
+ FButton.Height := 22;
+ FButton.Align := TAlignLayout.alFitRight;
+ FButton.OnClick := DoButtonClick;
+end;
+
+procedure TfrxEditWithButton.ApplyStyle;
+var
+ C: TFmxObject;
+begin
+ inherited;
+ C := FindStyleResource('content');
+ if Assigned(C) and (C is TLayout) then
+ begin
+ TLayout(C).Padding.Right := FButton.Width + 2;
+ end;
+end;
+
+procedure TfrxEditWithButton.DoButtonClick(Sender: TObject);
+begin
+ if Assigned(FOnButtonClick) then
+ FOnButtonClick(Self);
+end;
+
+{$IFDEF DELPHI21}
+function TfrxEditWithButton.DefinePresentationName: String;
+begin
+ Result := TEDIT.ClassName;
+ if (Length(Result) > 1) and (Result[1] = 'T') then
+ Delete(Result, 1, 1);
+ Result := Result + '-' + GetPresentationSuffix;
+end;
+{$ENDIF}
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxSplitter, TFmxObject);
+ GroupDescendentsWith(TfrxEditWithButton, TFmxObject);
+ RegisterFmxClasses([TfrxSplitter, TfrxEditWithButton]);
+
+end.
diff --git a/LibD28/FMX.frxCustomDB.pas b/LibD28/FMX.frxCustomDB.pas
new file mode 100644
index 0000000..3788db6
--- /dev/null
+++ b/LibD28/FMX.frxCustomDB.pas
@@ -0,0 +1,833 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ Custom TDataSet-based classes }
+{ for enduser DB components }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCustomDB;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.Classes, System.SysUtils, Data.DB, FMX.frxClass, FMX.frxDBSet,
+ FMX.ListBox, System.Variants, System.Types, FMX.Types
+{$IFDEF QBUILDER}
+, FMX.fqbClass
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+
+type
+ TfrxCustomDataset = class(TfrxDBDataSet)
+ private
+ FDBConnected: Boolean;
+ FDataSource: TDataSource;
+ FMaster: TfrxDBDataSet;
+ FMasterFields: String;
+ procedure SetActive(Value: Boolean);
+ procedure SetFilter(const Value: String);
+ procedure SetFiltered(Value: Boolean);
+ function GetActive: Boolean;
+ function GetFields: TFields;
+ function GetFilter: String;
+ function GetFiltered: Boolean;
+ procedure InternalSetMaster(const Value: TfrxDBDataSet);
+ procedure InternalSetMasterFields(const Value: String);
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetParent(AParent: TfrxComponent); override;
+ procedure SetUserName(const Value: String); override;
+ procedure SetMaster(const Value: TDataSource); virtual;
+ procedure SetMasterFields(const Value: String); virtual;
+ property DataSet;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure OnPaste; override;
+ property DBConnected: Boolean read FDBConnected write FDBConnected;
+ property Fields: TFields read GetFields;
+ property MasterFields: String read FMasterFields write InternalSetMasterFields;
+ property Active: Boolean read GetActive write SetActive default False;
+ published
+ property Filter: String read GetFilter write SetFilter;
+ property Filtered: Boolean read GetFiltered write SetFiltered default False;
+ property Master: TfrxDBDataset read FMaster write InternalSetMaster;
+ end;
+
+ TfrxCustomTable = class(TfrxCustomDataset)
+ protected
+ function GetIndexFieldNames: String; virtual;
+ function GetIndexName: String; virtual;
+ function GetTableName: String; virtual;
+ procedure SetIndexFieldNames(const Value: String); virtual;
+ procedure SetIndexName(const Value: String); virtual;
+ procedure SetTableName(const Value: String); virtual;
+ property DataSet;
+ published
+ property MasterFields;
+ property TableName: String read GetTableName write SetTableName;
+ property IndexName: String read GetIndexName write SetIndexName;
+ property IndexFieldNames: String read GetIndexFieldNames write SetIndexFieldNames;
+ end;
+
+ TfrxParamItem = class(TCollectionItem)
+ private
+ FDataType: TFieldType;
+ FExpression: String;
+ FName: String;
+ FValue: Variant;
+ public
+ procedure Assign(Source: TPersistent); override;
+ property Value: Variant read FValue write FValue;
+ published
+ property Name: String read FName write FName;
+ property DataType: TFieldType read FDataType write FDataType;
+ property Expression: String read FExpression write FExpression;
+ end;
+
+ TfrxParams = class(TCollection)
+ private
+ FIgnoreDuplicates: Boolean;
+ function GetParam(Index: Integer): TfrxParamItem;
+ public
+ constructor Create;
+ function Add: TfrxParamItem;
+ function Find(const Name: String): TfrxParamItem;
+ function IndexOf(const Name: String): Integer;
+ procedure UpdateParams(const SQL: String);
+ property Items[Index: Integer]: TfrxParamItem read GetParam; default;
+ property IgnoreDuplicates: Boolean read FIgnoreDuplicates write FIgnoreDuplicates;
+ end;
+
+
+ TfrxCustomQuery = class(TfrxCustomDataset)
+ private
+ FParams: TfrxParams;
+ FSaveOnBeforeOpen: TDataSetNotifyEvent;
+ FSaveOnChange: TNotifyEvent;
+ FSQLSchema: String;
+ procedure ReadData(Reader: TReader);
+ procedure SetParams(Value: TfrxParams);
+ procedure WriteData(Writer: TWriter);
+ function GetIgnoreDupParams: Boolean;
+ procedure SetIgnoreDupParams(const Value: Boolean);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ procedure OnBeforeOpen(DataSet: TDataSet); virtual;
+ procedure OnChangeSQL(Sender: TObject); virtual;
+ procedure SetSQL(Value: TStrings); virtual;
+ function GetSQL: TStrings; virtual;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure UpdateParams; virtual;
+ function ParamByName(const Value: String): TfrxParamItem;
+{$IFDEF QBUILDER}
+ function QBEngine: TfqbEngine; virtual;
+{$ENDIF}
+ published
+ property IgnoreDupParams: Boolean read GetIgnoreDupParams write SetIgnoreDupParams;
+ property Params: TfrxParams read FParams write SetParams;
+ property SQL: TStrings read GetSQL write SetSQL;
+ property SQLSchema: String read FSQLSchema write FSQLSchema;
+ end;
+
+ { emulates work of DBLookupComboBox in VCL, for back compatibility only }
+ TfrxDBLookupComboBox = class(TfrxDialogControl)
+ private
+ FDataSet: TfrxDBDataSet;
+ FDataSetName: String;
+ FComboBox: TComboBox;
+ FAutoOpenDataSet: Boolean;
+ FIsFilled: Boolean;
+ FListField: String;
+ FKeyField: String;
+ FValue: Variant;
+ function GetDataSetName: String;
+ function GetKeyField: String;
+ function GetKeyValue: Variant;
+ function GetListField: String;
+ function GetText: String;
+ procedure SetDataSet(const Value: TfrxDBDataSet);
+ procedure SetDataSetName(const Value: String);
+ procedure SetKeyField(Value: String);
+ procedure SetKeyValue(const Value: Variant);
+ procedure SetListField(Value: String);
+ procedure UpdateDataSet;
+ procedure OnOpenDS(Sender: TObject);
+ function GetDropDownWidth: Integer;
+ procedure SetDropDownWidth(const Value: Integer);
+ function GetDropDownRows: Integer;
+ procedure SetDropDownRows(const Value: Integer);
+ procedure DoOnChange(Sender: TObject);
+ procedure FillWithData;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ procedure BeforeStartReport; override;
+ property ComboBox: TComboBox read FComboBox;
+ property KeyValue: Variant read GetKeyValue write FValue;
+ property Text: String read GetText;
+ procedure PaintControl(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
+ published
+ property AutoOpenDataSet: Boolean read FAutoOpenDataSet write FAutoOpenDataSet default False;
+ property DataSet: TfrxDBDataset read FDataSet write SetDataSet;
+ property DataSetName: String read GetDataSetName write SetDataSetName;
+ property ListField: String read GetListField write SetListField;
+ property KeyField: String read GetKeyField write SetKeyField;
+ property DropDownWidth: Integer read GetDropDownWidth write SetDropDownWidth;
+ property DropDownRows: Integer read GetDropDownRows write SetDropDownRows;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+
+procedure frxParamsToTParams(Query: TfrxCustomQuery; Params: TParams);
+
+
+implementation
+
+uses
+{$IFNDEF NO_EDITORS}
+ FMX.frxCustomDBEditor,
+{$ENDIF}
+ FMX.frxCustomDBRTTI, FMX.frxDsgnIntf, FMX.frxUtils, FMX.frxRes;
+
+
+{ TfrxParamItem }
+
+procedure TfrxParamItem.Assign(Source: TPersistent);
+begin
+ if Source is TfrxParamItem then
+ begin
+ FName := TfrxParamItem(Source).Name;
+ FDataType := TfrxParamItem(Source).DataType;
+ FExpression := TfrxParamItem(Source).Expression;
+ FValue := TfrxParamItem(Source).Value;
+ end;
+end;
+
+{ TfrxParams }
+
+constructor TfrxParams.Create;
+begin
+ inherited Create(TfrxParamItem);
+ FIgnoreDuplicates := False;
+end;
+
+function TfrxParams.Add: TfrxParamItem;
+begin
+ Result := TfrxParamItem(inherited Add);
+end;
+
+function TfrxParams.GetParam(Index: Integer): TfrxParamItem;
+begin
+ Result := TfrxParamItem(inherited Items[Index]);
+end;
+
+function TfrxParams.Find(const Name: String): TfrxParamItem;
+var
+ i: Integer;
+begin
+ i := IndexOf(Name);
+ if i <> -1 then
+ Result := Items[i] else
+ Result := nil;
+end;
+
+function TfrxParams.IndexOf(const Name: String): Integer;
+var
+ i: Integer;
+begin
+ Result := -1;
+ for i := 0 to Count - 1 do
+ if CompareText(Items[i].Name, Name) = 0 then
+ begin
+ Result := i;
+ break;
+ end;
+end;
+
+procedure TfrxParams.UpdateParams(const SQL: String);
+var
+ i, j: Integer;
+ QParams: TParams;
+ NewParams: TfrxParams;
+begin
+ { parse query params }
+ QParams := TParams.Create;
+ QParams.ParseSQL(SQL, True);
+
+ { create new TfrxParams object and copy all params to it }
+ NewParams := TfrxParams.Create;
+ for i := 0 to QParams.Count - 1 do
+ if not ((NewParams.IndexOf(QParams[i].Name) <> -1) and FIgnoreDuplicates) then
+ with NewParams.Add do
+ begin
+ Name := QParams[i].Name;
+ j := IndexOf(Name);
+ if j <> -1 then
+ begin
+ DataType := Items[j].DataType;
+ Value := Items[j].Value;
+ Expression := Items[j].Expression;
+ end;
+ end;
+ Assign(NewParams);
+ QParams.Free;
+ NewParams.Free;
+end;
+
+{ TfrxCustomDataset }
+
+constructor TfrxCustomDataset.Create(AOwner: TComponent);
+begin
+ Component := Dataset;
+ inherited;
+ CloseDataSource := True;
+ FDataSource := TDataSource.Create(nil);
+ SetMaster(FDataSource);
+end;
+
+destructor TfrxCustomDataset.Destroy;
+begin
+ FDataSource.Free;
+ inherited;
+end;
+
+procedure TfrxCustomDataset.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited;
+ if Operation = opRemove then
+ if AComponent = FMaster then
+ Master := nil
+end;
+
+procedure TfrxCustomDataset.SetParent(AParent: TfrxComponent);
+begin
+ inherited;
+ if (AParent <> nil) and (Report <> nil) then
+ begin
+ if IsDesigning and (Report.DataSets.Find(Self) = nil) then
+ begin
+ Report.DataSets.Add(Self);
+ if Report.Designer <> nil then
+ Report.Designer.UpdateDataTree;
+ end;
+ end;
+end;
+
+procedure TfrxCustomDataset.SetUserName(const Value: String);
+begin
+ inherited;
+ if (Report <> nil) and (Report.Designer <> nil) then
+ Report.Designer.UpdateDataTree;
+end;
+
+procedure TfrxCustomDataset.OnPaste;
+var
+ i: Integer;
+ sl: TStringList;
+begin
+ if Report = nil then Exit;
+
+ if Report.DataSets.Find(Self) = nil then
+ Report.DataSets.Add(Self);
+
+ sl := TStringList.Create;
+
+ Report.GetDatasetList(sl);
+ for i := 0 to sl.Count - 1 do
+ if (sl.Objects[i] <> Self) and (CompareText(sl[i], UserName) = 0) then
+ begin
+ if Name <> '' then
+ UserName := Name;
+ break;
+ end;
+ sl.Free;
+
+ Report.Designer.UpdateDataTree;
+end;
+
+procedure TfrxCustomDataset.SetActive(Value: Boolean);
+begin
+ Dataset.Active := Value;
+end;
+
+procedure TfrxCustomDataset.SetFilter(const Value: String);
+begin
+ Dataset.Filter := Value;
+end;
+
+function TfrxCustomDataset.GetActive: Boolean;
+begin
+ Result := Dataset.Active;
+end;
+
+function TfrxCustomDataset.GetFields: TFields;
+begin
+ Result := Dataset.Fields;
+end;
+
+function TfrxCustomDataset.GetFilter: String;
+begin
+ Result := Dataset.Filter;
+end;
+
+function TfrxCustomDataset.GetFiltered: Boolean;
+begin
+ Result := Dataset.Filtered;
+end;
+
+procedure TfrxCustomDataset.SetFiltered(Value: Boolean);
+begin
+ Dataset.Filtered := Value;
+end;
+
+procedure TfrxCustomDataset.InternalSetMaster(const Value: TfrxDBDataSet);
+begin
+ FMaster := Value;
+ if FMaster <> nil then
+ FDataSource.DataSet := FMaster.GetDataSet
+ else
+ FDataSource.DataSet := nil;
+end;
+
+procedure TfrxCustomDataset.InternalSetMasterFields(const Value: String);
+var
+ sl: TStringList;
+ s: String;
+ i: Integer;
+
+ function ConvertAlias(const s: String): String;
+ begin
+ if FMaster <> nil then
+ Result := FMaster.ConvertAlias(s)
+ else
+ Result := s;
+ end;
+
+begin
+ FMasterFields := Value;
+
+ sl := TStringList.Create;
+ frxSetCommaText(Value, sl);
+ s := '';
+ for i := 0 to sl.Count - 1 do
+ s := s + ConvertAlias(sl.Values[sl.Names[i]]) + ';';
+ s := Copy(s, 1, Length(s) - 1);
+
+ SetMasterFields(s);
+
+ s := '';
+ for i := 0 to sl.Count - 1 do
+ s := s + ConvertAlias(sl.Names[i]) + ';';
+ s := Copy(s, 1, Length(s) - 1);
+
+ if Self is TfrxCustomTable then
+ TfrxCustomTable(Self).SetIndexFieldNames(s);
+
+ sl.Free;
+end;
+
+procedure TfrxCustomDataset.SetMaster(const Value: TDataSource);
+begin
+// do nothing
+end;
+
+procedure TfrxCustomDataset.SetMasterFields(const Value: String);
+begin
+// do nothing
+end;
+
+
+{ TfrxCustomTable }
+
+function TfrxCustomTable.GetIndexFieldNames: String;
+begin
+ Result := '';
+end;
+
+function TfrxCustomTable.GetIndexName: String;
+begin
+ Result := '';
+end;
+
+function TfrxCustomTable.GetTableName: String;
+begin
+ Result := '';
+end;
+
+procedure TfrxCustomTable.SetIndexFieldNames(const Value: String);
+begin
+// do nothing
+end;
+
+procedure TfrxCustomTable.SetIndexName(const Value: String);
+begin
+// do nothing
+end;
+
+procedure TfrxCustomTable.SetTableName(const Value: String);
+begin
+// do nothing
+end;
+
+
+{ TfrxCustomQuery }
+
+constructor TfrxCustomQuery.Create(AOwner: TComponent);
+begin
+ inherited;
+ FParams := TfrxParams.Create;
+ FSaveOnBeforeOpen := DataSet.BeforeOpen;
+ DataSet.BeforeOpen := OnBeforeOpen;
+ FSaveOnChange := TStringList(SQL).OnChange;
+ TStringList(SQL).OnChange := OnChangeSQL;
+end;
+
+destructor TfrxCustomQuery.Destroy;
+begin
+ FParams.Free;
+ inherited;
+end;
+
+procedure TfrxCustomQuery.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ Filer.DefineProperty('Parameters', ReadData, WriteData, True);
+end;
+
+procedure TfrxCustomQuery.ReadData(Reader: TReader);
+begin
+ frxReadCollection(FParams, Reader, Self);
+ UpdateParams;
+end;
+
+procedure TfrxCustomQuery.WriteData(Writer: TWriter);
+begin
+ frxWriteCollection(FParams, Writer, Self);
+end;
+
+procedure TfrxCustomQuery.OnBeforeOpen(DataSet: TDataSet);
+begin
+ UpdateParams;
+ if Assigned(FSaveOnBeforeOpen) then
+ FSaveOnBeforeOpen(DataSet);
+end;
+
+procedure TfrxCustomQuery.OnChangeSQL(Sender: TObject);
+begin
+ if Assigned(FSaveOnChange) then
+ FSaveOnChange(Sender);
+ FParams.UpdateParams(SQL.Text);
+end;
+
+procedure TfrxCustomQuery.SetParams(Value: TfrxParams);
+begin
+ FParams.Assign(Value);
+end;
+
+function TfrxCustomQuery.ParamByName(const Value: String): TfrxParamItem;
+begin
+ Result := FParams.Find(Value);
+ if Result = nil then
+ raise Exception.Create('Parameter "' + Value + '" not found');
+end;
+
+procedure TfrxCustomQuery.SetSQL(Value: TStrings);
+begin
+//
+end;
+
+function TfrxCustomQuery.GetSQL: TStrings;
+begin
+ Result := nil;
+end;
+
+procedure TfrxCustomQuery.UpdateParams;
+begin
+//
+end;
+
+{$IFDEF QBUILDER}
+function TfrxCustomQuery.QBEngine: TfqbEngine;
+begin
+ Result := nil;
+end;
+{$ENDIF}
+
+
+{ frxParamsToTParams }
+
+procedure frxParamsToTParams(Query: TfrxCustomQuery; Params: TParams);
+var
+ i: Integer;
+ Item: TfrxParamItem;
+begin
+ for i := 0 to Params.Count - 1 do
+ if Query.Params.IndexOf(Params[i].Name) <> -1 then
+ begin
+ Item := Query.Params[Query.Params.IndexOf(Params[i].Name)];
+ Params[i].Clear;
+ Params[i].DataType := Item.DataType;
+ { Bound should be True in design mode }
+ if not (Query.IsLoading or Query.IsDesigning) then
+ Params[i].Bound := False
+ else
+ begin
+ if Item.Expression <> '' then
+ Params[i].Value := 0;
+ Params[i].Bound := True;
+ end;
+
+ if Trim(Item.Expression) <> '' then
+ if not (Query.IsLoading or Query.IsDesigning) then
+ if Query.Report <> nil then
+ begin
+ Query.Report.CurObject := Query.Name;
+ Item.Value := Query.Report.Calc(Item.Expression);
+ end;
+ if not VarIsEmpty(Item.Value) then
+ begin
+ Params[i].Bound := True;
+ if Params[i].DataType in [ftDate, ftTime, ftDateTime] then
+ Params[i].Value := Item.Value
+ else
+ Params[i].Text := VarToStr(Item.Value);
+ end;
+
+ end;
+end;
+
+function TfrxCustomQuery.GetIgnoreDupParams: Boolean;
+begin
+ Result := FParams.FIgnoreDuplicates;
+end;
+
+procedure TfrxCustomQuery.SetIgnoreDupParams(const Value: Boolean);
+begin
+ FParams.FIgnoreDuplicates := Value;
+ FParams.UpdateParams(SQL.Text);
+end;
+
+{ TfrxDBLookupComboBox }
+
+constructor TfrxDBLookupComboBox.Create(AOwner: TComponent);
+begin
+ inherited;
+ FComboBox := TComboBox.Create(nil);
+ InitControl(FComboBox);
+ Width := 145;
+ Height := 21;
+ FComboBox.OnPainting := PaintControl;
+ FIsFilled := False;
+ FComboBox.OnChange := DoOnChange;
+// FDBLookupComboBox.ListSource := FDataSource;
+end;
+
+destructor TfrxDBLookupComboBox.Destroy;
+begin
+ inherited;
+end;
+
+procedure TfrxDBLookupComboBox.DoOnChange(Sender: TObject);
+begin
+ if (FDataSet <> nil) and FDataSet.HasField(FListField) and (FComboBox.Selected <> nil) then
+ begin
+ FDataSet.DataSet.Locate(FDataSet.ConvertAlias(FListField), FComboBox.Selected.Text, []);
+ if(FDataSet.HasField(FKeyField)) then
+ begin
+ FValue := FDataSet.Value[FKeyField];
+ end;
+ end;
+
+end;
+
+procedure TfrxDBLookupComboBox.FillWithData;
+begin
+ if not FIsFilled then
+ begin
+ if FDataSet = nil then Exit;
+ if not FDataSet.HasField(FListField) then Exit;
+ FDataSet.First;
+{$IFDEF DELPHI23}
+ FComboBox.Clear;
+{$ELSE}
+ FComboBox.Items.Clear;
+{$ENDIF}
+ FComboBox.BeginUpdate;
+ try
+ while not FDataSet.Eof do
+ begin
+ FComboBox.Items.Add(FDataSet.Value[FListField]);
+ FDataSet.Next;
+ end;
+ finally
+ FComboBox.EndUpdate;
+ end;
+ if FComboBox.Items.Count > 0 then
+ FComboBox.ListItems[0].IsSelected := True;
+ FIsFilled := True;
+ end;
+end;
+
+class function TfrxDBLookupComboBox.GetDescription: String;
+begin
+ Result := frxResources.Get('obDBLookup');
+end;
+
+function TfrxDBLookupComboBox.GetDataSetName: String;
+begin
+ if FDataSet = nil then
+ Result := FDataSetName else
+ Result := FDataSet.UserName;
+end;
+
+function TfrxDBLookupComboBox.GetKeyField: String;
+begin
+ Result := FKeyField;
+end;
+
+function TfrxDBLookupComboBox.GetKeyValue: Variant;
+begin
+ Result := FValue;
+end;
+
+function TfrxDBLookupComboBox.GetListField: String;
+begin
+ Result := FListField;
+ FDataSet := TfrxDBDataSet(Report.GetDataset(FDataSetName));
+end;
+
+function TfrxDBLookupComboBox.GetText: String;
+begin
+ if FComboBox.Selected <> nil then
+ Result := FComboBox.Selected.Text;
+end;
+
+procedure TfrxDBLookupComboBox.SetDataSet(const Value: TfrxDBDataSet);
+begin
+ FDataSet := Value;
+ if FDataSet = nil then
+ FDataSetName := '' else
+ FDataSetName := FDataSet.UserName;
+ UpdateDataSet;
+end;
+
+procedure TfrxDBLookupComboBox.SetDataSetName(const Value: String);
+begin
+ FDataSetName := Value;
+ FDataSet := TfrxDBDataSet(FindDataSet(FDataSet, FDataSetName));
+ UpdateDataSet;
+end;
+
+procedure TfrxDBLookupComboBox.SetKeyField(Value: String);
+begin
+ FKeyField := Value;
+ if FListField = '' then
+ FListField := FKeyField;
+end;
+
+procedure TfrxDBLookupComboBox.SetKeyValue(const Value: Variant);
+var
+ i: Integer;
+begin
+ if (FDataSet <> nil) and FDataSet.HasField(FKeyField) and FDataSet.HasField(FListField) then
+ begin
+ FillWithData;
+ FDataSet.DataSet.Locate(FDataSet.ConvertAlias(FKeyField), Value, []);
+ i := FComboBox.Items.IndexOf(FDataSet.Value[FListField]);
+ if i > 0 then
+ begin
+ FValue := Value;
+ FComboBox.ListItems[i].IsSelected := True;
+ FComboBox.ItemIndex := i;
+ end;
+ end;
+end;
+
+procedure TfrxDBLookupComboBox.SetListField(Value: String);
+begin
+ FListField := Value;
+ FIsFilled := False;
+end;
+
+procedure TfrxDBLookupComboBox.UpdateDataSet;
+begin
+ FIsFilled := False;
+end;
+
+procedure TfrxDBLookupComboBox.BeforeStartReport;
+begin
+ SetListField(FListField);
+ SetKeyField(FKeyField);
+ Self.OnActivate := OnOpenDS;
+end;
+
+
+procedure TfrxDBLookupComboBox.OnOpenDS(Sender: TObject);
+begin
+ UpdateDataSet;
+ if (FDataSet <> nil) and (FAutoOpenDataSet) then
+ FDataSet.Open;
+ FIsFilled := False;
+ FillWithData;
+ SetKeyValue(FValue);
+end;
+
+procedure TfrxDBLookupComboBox.PaintControl(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF);
+begin
+ FillWithData;
+end;
+
+function TfrxDBLookupComboBox.GetDropDownWidth: Integer;
+begin
+ Result := 0;
+end;
+
+procedure TfrxDBLookupComboBox.SetDropDownWidth(const Value: Integer);
+begin
+ //FDBLookupComboBox.DropDownWidth := Value;
+end;
+
+function TfrxDBLookupComboBox.GetDropDownRows: Integer;
+begin
+ Result := FComboBox.DropDownCount;
+end;
+
+procedure TfrxDBLookupComboBox.SetDropDownRows(const Value: Integer);
+begin
+ FComboBox.DropDownCount := Value;;
+end;
+
+initialization
+ frxObjects.RegisterObject1(TfrxDBLookupComboBox, nil, '', '', 0, 119);
+
+finalization
+ frxObjects.UnRegister(TfrxDBLookupComboBox);
+
+
+end.
diff --git a/LibD28/FMX.frxCustomDBEditor.pas b/LibD28/FMX.frxCustomDBEditor.pas
new file mode 100644
index 0000000..b7bc14b
--- /dev/null
+++ b/LibD28/FMX.frxCustomDBEditor.pas
@@ -0,0 +1,355 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ Enduser DB components design editors }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCustomDBEditor;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, System.SysUtils, System.UITypes, FMX.Forms, FMX.Controls, FMX.frxClass, FMX.frxCustomDB,
+ FMX.frxDsgnIntf, FMX.frxEditMD, FMX.frxEditAliases, FMX.frxEditQueryParams, FMX.frxEditSQL,
+ FMX.frxDBSet, FMX.frxRes, FMX.frxConnWizard, System.Variants
+{$IFDEF QBUILDER}
+, FMX.fqbClass
+{$ENDIF};
+
+type
+ TfrxCustomDatabaseEditor = class(TfrxComponentEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ end;
+
+ TfrxCustomDataSetEditor = class(TfrxComponentEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ end;
+
+ TfrxCustomQueryEditor = class(TfrxComponentEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ end;
+
+ TfrxFieldAliasesProperty = class(TfrxClassProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+ TfrxDataSetProperty = class(TfrxComponentProperty)
+ public
+ function GetValue: String; override;
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ procedure SetValue(const AValue: String); override;
+ end;
+
+ TfrxDataFieldProperty = class(TfrxPropertyEditor)
+ public
+ function GetValue: String; override;
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ procedure SetValue(const AValue: String); override;
+ end;
+
+ TfrxMasterFieldsProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+ TfrxSQLProperty = class(TfrxClassProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+ TfrxParamsProperty = class(TfrxClassProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+
+{ TfrxCustomDatabaseEditor }
+
+function TfrxCustomDatabaseEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+function TfrxCustomDatabaseEditor.Edit: Boolean;
+var
+ i: Integer;
+ wiz: TfrxCustomWizard;
+begin
+ Result := False;
+ for i := 0 to frxWizards.Count - 1 do
+ if frxWizards[i].ClassRef = TfrxDBConnWizard then
+ begin
+ wiz := TfrxCustomWizard(frxWizards[i].ClassRef.NewInstance);
+ wiz.Create(Designer);
+ try
+ TfrxDBConnWizard(wiz).Database := TfrxCustomDatabase(Component);
+ Result := wiz.Execute;
+ finally
+ wiz.Free;
+ end;
+ break;
+ end;
+end;
+
+
+{ TfrxCustomDataSetEditor }
+
+function TfrxCustomDataSetEditor.Edit: Boolean;
+begin
+ with TfrxAliasesEditorForm.Create(Application) do
+ begin
+ DataSet := TfrxCustomDataSet(Component);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ Self.Designer.UpdateDataTree;
+ Free;
+ end;
+end;
+
+function TfrxCustomDataSetEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+
+{ TfrxCustomQueryEditor }
+
+function TfrxCustomQueryEditor.Edit: Boolean;
+begin
+ with TfrxSQLEditorForm.Create(Designer) do
+ begin
+ Query := TfrxCustomQuery(Component);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ Self.Designer.UpdateDataTree;
+ Free;
+ end;
+end;
+
+function TfrxCustomQueryEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+
+{ TfrxFieldAliasesProperty }
+
+function TfrxFieldAliasesProperty.Edit: Boolean;
+begin
+ with TfrxAliasesEditorForm.Create(Application) do
+ begin
+ DataSet := TfrxCustomDataSet(Component);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ Self.Designer.UpdateDataTree;
+ Free;
+ end;
+end;
+
+function TfrxFieldAliasesProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog, paReadOnly];
+end;
+
+
+{ TfrxDataSetProperty }
+
+function TfrxDataSetProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList];
+end;
+
+function TfrxDataSetProperty.GetValue: String;
+var
+ ds: TfrxDataSet;
+begin
+ ds := TfrxDataSet(GetOrdValue);
+ if ds <> nil then
+ Result := frComponent.Report.GetAlias(ds) else
+ Result := frxResources.Get('prNotAssigned');
+end;
+
+procedure TfrxDataSetProperty.GetValues;
+var
+ i: Integer;
+begin
+ frComponent.Report.GetDataSetList(Values, True);
+ if Component is TfrxDataSet then
+ begin
+ i := Values.IndexOf(TfrxDataSet(Component).UserName);
+ if i <> -1 then
+ Values.Delete(i);
+ end;
+end;
+
+procedure TfrxDataSetProperty.SetValue(const AValue: String);
+var
+ ds: TfrxDataSet;
+begin
+ if AValue = '' then
+ SetOrdValue(0)
+ else
+ begin
+ ds := frComponent.Report.GetDataSet(AValue);
+ if ds <> nil then
+ SetOrdValue(frxInteger(ds)) else
+ raise Exception.Create(frxResources.Get('prInvProp'));
+ end;
+end;
+
+
+{ TfrxDataFieldProperty }
+
+function TfrxDataFieldProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList];
+end;
+
+function TfrxDataFieldProperty.GetValue: String;
+begin
+ Result := GetStrValue;
+end;
+
+procedure TfrxDataFieldProperty.SetValue(const AValue: String);
+begin
+ SetStrValue(AValue);
+end;
+
+procedure TfrxDataFieldProperty.GetValues;
+var
+ ds: TfrxDataSet;
+begin
+ inherited;
+ ds := TfrxDBLookupComboBox(Component).DataSet;
+ if ds <> nil then
+ ds.GetFieldList(Values);
+end;
+
+
+{ TfrxMasterFieldsProperty }
+
+function TfrxMasterFieldsProperty.Edit: Boolean;
+var
+ ds: TfrxCustomDataSet;
+begin
+ Result := False;
+ ds := TfrxCustomDataSet(Component);
+ if ds.Master <> nil then
+ with TfrxMDEditorForm.Create(Application) do
+ begin
+ DataSet := ds;
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ Free;
+ end;
+end;
+
+function TfrxMasterFieldsProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog, paReadOnly];
+end;
+
+
+{ TfrxSQLProperty }
+
+function TfrxSQLProperty.Edit: Boolean;
+begin
+ with TfrxSQLEditorForm.Create(Designer) do
+ begin
+ Query := TfrxCustomQuery(Component);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ Self.Designer.UpdateDataTree;
+ Free;
+ end;
+end;
+
+function TfrxSQLProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog, paReadOnly];
+end;
+
+
+{ TfrxParamsProperty }
+
+function TfrxParamsProperty.Edit: Boolean;
+var
+ q: TfrxCustomQuery;
+begin
+ Result := False;
+ q := TfrxCustomQuery(Component);
+ if q.Params.Count <> 0 then
+ with TfrxParamsEditorForm.Create(Designer) do
+ begin
+ Params := q.Params;
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ begin
+ q.UpdateParams;
+ Self.Designer.UpdateDataTree;
+ end;
+ Free;
+ end;
+end;
+
+function TfrxParamsProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog, paReadOnly];
+end;
+
+
+initialization
+ frxComponentEditors.Register(TfrxCustomDatabase, TfrxCustomDatabaseEditor);
+ frxComponentEditors.Register(TfrxCustomDataSet, TfrxCustomDataSetEditor);
+ frxComponentEditors.Register(TfrxCustomQuery, TfrxCustomQueryEditor);
+ frxPropertyEditors.Register(TypeInfo(TStrings), TfrxCustomDataSet, 'FieldAliases',
+ TfrxFieldAliasesProperty);
+ frxPropertyEditors.Register(TypeInfo(TfrxCustomDBDataSet), TfrxCustomDataSet,
+ 'Master', TfrxDataSetProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxCustomDataSet, 'MasterFields',
+ TfrxMasterFieldsProperty);
+ frxPropertyEditors.Register(TypeInfo(TStrings), TfrxCustomQuery, 'SQL',
+ TfrxSQLProperty);
+ frxPropertyEditors.Register(TypeInfo(TfrxParams), TfrxCustomQuery, 'Params',
+ TfrxParamsProperty);
+
+ frxPropertyEditors.Register(TypeInfo(TfrxDBDataSet), TfrxDBLookupComboBox,
+ 'DataSet', TfrxDataSetProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxDBLookupComboBox,
+ 'KeyField', TfrxDataFieldProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxDBLookupComboBox,
+ 'ListField', TfrxDataFieldProperty);
+
+ frxHideProperties(TfrxCustomDataset, 'DataSet;DataSource;Enabled;OpenDataSource;Tag');
+ frxHideProperties(TfrxCustomQuery, 'SQLSchema');
+ frxHideProperties(TfrxDBLookupComboBox, 'DataSetName');
+
+end.
diff --git a/LibD28/FMX.frxCustomDBRTTI.pas b/LibD28/FMX.frxCustomDBRTTI.pas
new file mode 100644
index 0000000..23f2891
--- /dev/null
+++ b/LibD28/FMX.frxCustomDBRTTI.pas
@@ -0,0 +1,182 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ DB components RTTI }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCustomDBRTTI;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, System.SysUtils, System.Types, FMX.Forms, Data.DB, FMX.fs_iinterpreter, FMX.frxClass, FMX.frxCustomDB,
+ FMX.frxDBSet, FMX.fs_idbrtti
+, System.Variants;
+
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ with AddClass(TfrxDBDataset, 'TfrxCustomDBDataSet') do
+ begin
+ AddMethod('function Locate(const KeyFields: string; const KeyValues: Variant;' +
+ 'Options: TLocateOptions): Boolean', CallMethod);
+ AddMethod('function IsEmpty: Boolean', CallMethod);
+ AddMethod('function RecordCount: Integer', CallMethod);
+ end;
+ AddClass(TfrxCustomDatabase, 'TfrxComponent');
+ with AddClass(TfrxCustomDataset, 'TfrxDBDataSet') do
+ begin
+ AddMethod('procedure Last', CallMethod);
+ AddMethod('function FieldByName(Name: String): TField', CallMethod);
+ AddProperty('DataSet', 'TDataSet', GetProp, nil);
+ AddProperty('Active', 'Boolean', GetProp, SetProp);
+ AddProperty('Fields', 'TFields', GetProp, nil);
+ end;
+ AddClass(TfrxCustomTable, 'TfrxCustomDataset');
+ with AddClass(TfrxParamItem, 'TCollectionItem') do
+ AddProperty('Value', 'Variant', GetProp, SetProp);
+ with AddClass(TfrxParams, 'TCollection') do
+ begin
+ AddMethod('function IndexOf(Name: String): Integer', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TfrxParamItem', CallMethod, True);
+ end;
+ with AddClass(TfrxCustomQuery, 'TfrxCustomDataset') do
+ AddMethod('function ParamByName(Name: string): TfrxParamItem', CallMethod);
+ with AddClass(TfrxDBLookupComboBox, 'TfrxDialogControl') do
+ begin
+ AddProperty('KeyValue', 'Variant', GetProp, SetProp);
+ AddProperty('Text', 'String', GetProp, nil);
+ end;
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+
+ function IntToLocateOptions(i: Integer): TLocateOptions;
+ begin
+ Result := [];
+ if (i and 1) <> 0 then
+ Result := Result + [loCaseInsensitive];
+ if (i and 2) <> 0 then
+ Result := Result + [loPartialKey];
+ end;
+
+begin
+ Result := 0;
+
+ if ClassType = TfrxParams then
+ begin
+ if MethodName = 'INDEXOF' then
+ Result := TfrxParams(Instance).IndexOf(Caller.Params[0])
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TfrxParams(Instance).Items[Caller.Params[0]])
+ end
+ else if ClassType = TfrxDBDataset then
+ begin
+ if MethodName = 'LOCATE' then
+ Result := TfrxDBDataSet(Instance).GetDataSet.Locate(Caller.Params[0], Caller.Params[1], IntToLocateOptions(Caller.Params[2]))
+ else if MethodName = 'ISEMPTY' then
+ Result := TfrxDBDataSet(Instance).GetDataSet.IsEmpty
+ else if MethodName = 'RECORDCOUNT' then
+ Result := TfrxDBDataSet(Instance).GetDataSet.RecordCount
+ end
+ else if ClassType = TfrxCustomDataSet then
+ begin
+ if MethodName = 'LAST' then
+ TfrxCustomDataSet(Instance).GetDataSet.Last
+ else if MethodName = 'FIELDBYNAME' then
+ Result := frxInteger(TfrxCustomDataset(Instance).GetDataSet.FieldByName(Caller.Params[0]))
+ end
+ else if ClassType = TfrxCustomQuery then
+ begin
+ if MethodName = 'PARAMBYNAME' then
+ Result := frxInteger(TfrxCustomQuery(Instance).ParamByName(Caller.Params[0]))
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TfrxCustomDataset then
+ begin
+ if PropName = 'DATASET' then
+ Result := frxInteger(TfrxCustomDataset(Instance).DataSet)
+ else if PropName = 'ACTIVE' then
+ Result := TfrxCustomDataset(Instance).Active
+ else if PropName = 'FIELDS' then
+ Result := frxInteger(TfrxCustomDataset(Instance).Fields)
+ end
+ else if ClassType = TfrxParamItem then
+ begin
+ if PropName = 'VALUE' then
+ Result := TfrxParamItem(Instance).Value
+ end
+ else if ClassType = TfrxDBLookupComboBox then
+ begin
+ if PropName = 'KEYVALUE' then
+ Result := TfrxDBLookupComboBox(Instance).KeyValue
+ else if PropName = 'TEXT' then
+ Result := TfrxDBLookupComboBox(Instance).Text
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TfrxCustomDataset then
+ begin
+ if PropName = 'ACTIVE' then
+ TfrxCustomDataset(Instance).Active := Value;
+ end
+ else if ClassType = TfrxParamItem then
+ begin
+ if PropName = 'VALUE' then
+ TfrxParamItem(Instance).Value := Value
+ end
+ else if ClassType = TfrxDBLookupComboBox then
+ begin
+ if PropName = 'KEYVALUE' then
+ TfrxDBLookupComboBox(Instance).KeyValue := Value
+ end
+end;
+
+
+initialization
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/FMX.frxCustomEditors.pas b/LibD28/FMX.frxCustomEditors.pas
new file mode 100644
index 0000000..db73432
--- /dev/null
+++ b/LibD28/FMX.frxCustomEditors.pas
@@ -0,0 +1,174 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Property editors for Designer }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCustomEditors;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.Classes, System.SysUtils, System.UITypes, System.Types, FMX.Types, FMX.Controls, FMX.Forms, FMX.Menus,
+ FMX.Dialogs, FMX.frxClass, FMX.frxDMPClass, FMX.frxDsgnIntf
+, System.Variants;
+
+
+type
+ TfrxViewEditor = class(TfrxComponentEditor)
+ public
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxCustomMemoEditor = class(TfrxViewEditor)
+ public
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+
+implementation
+
+uses FMX.frxEditMemo, FMX.frxEditFormat, FMX.frxRes;
+
+
+{ TfrxViewEditor }
+
+function TfrxViewEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ i: Integer;
+ c: TfrxComponent;
+ v: TfrxView;
+begin
+ Result := False;
+ for i := 0 to Designer.SelectedObjects.Count - 1 do
+ begin
+ c := Designer.SelectedObjects[i];
+ if (c is TfrxView) and not (rfDontModify in c.Restrictions) and (Tag in [50..53]) then
+ begin
+ v := TfrxView(c);
+ case Tag of
+ 50: if Checked then
+ v.ShiftMode := smAlways else
+ v.ShiftMode := smDontShift;
+ 51: if Checked then
+ v.ShiftMode := smWhenOverlapped else
+ v.ShiftMode := smDontShift;
+ 52: v.Visible := Checked;
+ 53: v.Printable := Checked;
+ end;
+
+ Result := True;
+ end;
+ end;
+end;
+
+procedure TfrxViewEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ v: TfrxView;
+begin
+ inherited;
+ v := TfrxView(Component);
+
+ AddItem(frxResources.Get('mvShift'), 50, v.ShiftMode = smAlways);
+ AddItem(frxResources.Get('mvShiftOver'), 51, v.ShiftMode = smWhenOverlapped);
+ AddItem(frxResources.Get('mvVisible'), 52, v.Visible);
+ AddItem(frxResources.Get('mvPrintable'), 53, v.Printable);
+end;
+
+
+{ TfrxCustomMemoEditor }
+
+function TfrxCustomMemoEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ i: Integer;
+ c: TfrxComponent;
+ m: TfrxCustomMemoView;
+ DisplayFormat: TfrxFormat;
+
+ function EditFormat: Boolean;
+ begin
+ with TfrxFormatEditorForm.Create(Designer) do
+ begin
+ Format.Assign(TfrxCustomMemoView(Component).DisplayFormat);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ DisplayFormat.Assign(Format);
+ Free;
+ end;
+ end;
+
+begin
+ Result := inherited Execute(Tag, Checked);
+
+ DisplayFormat := TfrxFormat.Create;
+ try
+ if Tag = 1 then
+ if not EditFormat then Exit;
+
+ for i := 0 to Designer.SelectedObjects.Count - 1 do
+ begin
+ c := Designer.SelectedObjects[i];
+ if (c is TfrxCustomMemoView) and not (rfDontModify in c.Restrictions) then
+ begin
+ m := TfrxCustomMemoView(c);
+ case Tag of
+ 1: m.DisplayFormat := DisplayFormat;
+ 2: m.Memo.Clear;
+ 3: m.AutoWidth := Checked;
+ 4: m.WordWrap := Checked;
+ 5: m.SuppressRepeated := Checked;
+ 6: m.HideZeros := Checked;
+ 7: m.AllowExpressions := Checked;
+ 8: m.AllowHTMLTags := Checked;
+ 40: if Checked then
+ m.StretchMode := smActualHeight else
+ m.StretchMode := smDontStretch;
+ 41: if Checked then
+ m.StretchMode := smMaxHeight else
+ m.StretchMode := smDontStretch;
+ end;
+
+ Result := True;
+ end;
+ end;
+ finally
+ DisplayFormat.Free;
+ end;
+end;
+
+procedure TfrxCustomMemoEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ m: TfrxCustomMemoView;
+begin
+ inherited;
+ m := TfrxCustomMemoView(Component);
+
+ AddItem(frxResources.Get('mvFormat'), 1);
+ AddItem(frxResources.Get('mvClear'), 2);
+ AddItem('-', -1);
+ AddItem(frxResources.Get('mvAutoWidth'), 3, m.AutoWidth);
+ AddItem(frxResources.Get('mvWWrap'), 4, m.WordWrap);
+ AddItem(frxResources.Get('mvSuppress'), 5, m.SuppressRepeated);
+ AddItem(frxResources.Get('mvHideZ'), 6, m.HideZeros);
+ AddItem(frxResources.Get('mvExpr'), 7, m.AllowExpressions);
+ if not (m is TfrxDMPMemoView) then
+ AddItem(frxResources.Get('mvHTML'), 8, m.AllowHTMLTags);
+ AddItem('-', -1);
+ AddItem(frxResources.Get('mvStretch'), 40, m.StretchMode = smActualHeight);
+ AddItem(frxResources.Get('mvStretchToMax'), 41, m.StretchMode = smMaxHeight);
+
+end;
+
+
+end.
diff --git a/LibD28/FMX.frxDBSet.pas b/LibD28/FMX.frxDBSet.pas
new file mode 100644
index 0000000..5037ab1
--- /dev/null
+++ b/LibD28/FMX.frxDBSet.pas
@@ -0,0 +1,473 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ DB dataset }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDBSet;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.frxClass, Data.DB, System.Variants, System.WideStrings;
+
+
+type
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxDBDataset = class(TfrxCustomDBDataset)
+ private
+ FBookmark: TBookmark;
+ FDataSet: TDataSet;
+ FDataSource: TDataSource;
+ FDS: TDataSet;
+ FEof: Boolean;
+ FBCDToCurrency: Boolean;
+ FSaveOpenEvent: TDatasetNotifyEvent;
+ FSaveCloseEvent: TDatasetNotifyEvent;
+ procedure BeforeClose(Sender: TDataSet);
+ procedure AfterOpen(Sender: TDataset);
+ procedure SetDataSet(Value: TDataSet);
+ procedure SetDataSource(Value: TDataSource);
+ function DataSetActive: Boolean;
+ function IsDataSetStored: Boolean;
+ protected
+ function GetDisplayText(Index: String): WideString; override;
+ function GetDisplayWidth(Index: String): Integer; override;
+ function GetFieldType(Index: String): TfrxFieldType; override;
+ function GetValue(Index: String): Variant; override;
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ public
+ procedure Initialize; override;
+ procedure Finalize; override;
+ procedure First; override;
+ procedure Next; override;
+ procedure Prior; override;
+ procedure Open; override;
+ procedure Close; override;
+ function Eof: Boolean; override;
+
+ function GetDataSet: TDataSet;
+ function IsBlobField(const fName: String): Boolean; override;
+ function RecordCount: Integer; override;
+ procedure AssignBlobTo(const fName: String; Obj: TObject); override;
+ procedure GetFieldList(List: TStrings); override;
+ published
+ property DataSet: TDataSet read FDataSet write SetDataSet stored IsDataSetStored;
+ property DataSource: TDataSource read FDataSource write SetDataSource stored IsDataSetStored;
+ property BCDToCurrency: Boolean read FBCDToCurrency write FBCDToCurrency;
+ end;
+
+
+implementation
+
+uses FMX.frxUtils, FMX.frxRes, FMX.frxUnicodeUtils;
+
+type
+ EDSError = class(Exception);
+
+
+{ TfrxDBDataset }
+
+procedure TfrxDBDataset.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if Operation = opRemove then
+ if AComponent = FDataSource then
+ DataSource := nil
+ else if AComponent = FDataSet then
+ DataSet := nil
+end;
+
+procedure TfrxDBDataset.SetDataSet(Value: TDataSet);
+begin
+ FDataSet := Value;
+ if Value <> nil then
+ FDataSource := nil;
+ FDS := GetDataSet;
+end;
+
+procedure TfrxDBDataset.SetDataSource(Value: TDataSource);
+begin
+ FDataSource := Value;
+ if Value <> nil then
+ FDataSet := nil;
+ FDS := GetDataSet;
+end;
+
+function TfrxDBDataset.DataSetActive: Boolean;
+begin
+ Result := (FDS <> nil) and FDS.Active;
+end;
+
+function TfrxDBDataset.GetDataset: TDataSet;
+begin
+ if FDataSet <> nil then
+ Result := FDataSet
+ else if (FDataSource <> nil) and (FDataSource.DataSet <> nil) then
+ Result := FDataSource.DataSet
+ else
+ Result := nil;
+end;
+
+function TfrxDBDataset.IsDataSetStored: Boolean;
+begin
+ Result := Report = nil;
+end;
+
+procedure TfrxDBDataset.Initialize;
+begin
+ FDS := GetDataSet;
+ if FDS = nil then
+ raise Exception.Create(Format(frxResources.Get('dbNotConn'), [Name]));
+
+ FSaveOpenEvent := FDS.AfterOpen;
+ FDS.AfterOpen := AfterOpen;
+ FSaveCloseEvent := FDS.BeforeClose;
+ FDS.BeforeClose := BeforeClose;
+ FEof := False;
+ FInitialized := False;
+end;
+
+procedure TfrxDBDataset.Finalize;
+begin
+ if FDS = nil then Exit;
+ if FBookMark <> nil then
+ begin
+ FDS.GotoBookmark(FBookmark);
+ FDS.FreeBookmark(FBookmark);
+ end;
+ FBookMark := nil;
+
+ if CloseDataSource then
+ Close;
+ FDS.AfterOpen := FSaveOpenEvent;
+ FDS.BeforeClose := FSaveCloseEvent;
+ FSaveOpenEvent := nil;
+ FSaveCloseEvent := nil;
+ FInitialized := False;
+end;
+
+procedure TfrxDBDataSet.Open;
+begin
+ if FInitialized then
+ Exit;
+
+ FInitialized := True;
+ FDS.Open;
+ AfterOpen(nil);
+ if (RangeBegin = rbCurrent) or (RangeEnd = reCurrent) then
+ FBookmark := FDS.GetBookmark else
+ FBookmark := nil;
+
+ inherited;
+end;
+
+procedure TfrxDBDataSet.Close;
+begin
+ inherited;
+ BeforeClose(nil);
+ FDS.Close;
+end;
+
+procedure TfrxDBDataset.AfterOpen(Sender: TDataset);
+var
+ i: Integer;
+begin
+ GetFieldList(Fields);
+ for i := 0 to Fields.Count - 1 do
+ Fields.Objects[i] := FDS.FindField(ConvertAlias(Fields[i]));
+
+ if Assigned(FSaveOpenEvent) and (Sender <> nil) then
+ FSaveOpenEvent(Sender);
+end;
+
+procedure TfrxDBDataset.BeforeClose(Sender: TDataSet);
+begin
+ if Assigned(FSaveCloseEvent) and (Sender <> nil) then
+ FSaveCloseEvent(Sender);
+
+ if FBookMark <> nil then
+ FDS.FreeBookmark(FBookmark);
+ FBookMark := nil;
+
+ FInitialized := False;
+end;
+
+procedure TfrxDBDataSet.First;
+begin
+ if not FInitialized then
+ Open;
+ if RangeBegin = rbFirst then
+ FDS.First else
+ FDS.GotoBookmark(FBookmark);
+ FEof := False;
+ inherited First;
+end;
+
+procedure TfrxDBDataSet.Next;
+var
+ b: TBookmark;
+begin
+ if not FInitialized then
+ Open;
+ FEof := False;
+ if RangeEnd = reCurrent then
+ begin
+ b := FDS.GetBookmark;
+ if FDS.CompareBookmarks(b, FBookmark) = 0 then
+ FEof := True;
+ FDS.FreeBookmark(b);
+ if FEof then
+ Exit;
+ end;
+ FDS.Next;
+ inherited Next;
+end;
+
+procedure TfrxDBDataSet.Prior;
+begin
+ if not FInitialized then
+ Open;
+ FDS.Prior;
+ inherited Prior;
+end;
+
+function TfrxDBDataSet.Eof: Boolean;
+begin
+ if not FInitialized then
+ Open;
+ Result := inherited Eof or FDS.Eof or FEof;
+end;
+
+function TfrxDBDataset.GetDisplayText(Index: String): WideString;
+var
+ i: Integer;
+ s: WideString;
+begin
+ s := '';
+ if not FInitialized then
+ Open;
+ if DataSetActive then
+ if Fields.Count = 0 then
+ s := FDS.FieldByName(Index).DisplayText
+ else
+ begin
+ i := Fields.IndexOf(Index);
+ if i <> -1 then
+ begin
+ if TField(Fields.Objects[i]) is TWideStringField then
+ s := VarToWideStr(TField(Fields.Objects[i]).Value)
+ else
+ s := TField(Fields.Objects[i]).DisplayText;
+ end
+ else
+ begin
+ s := frxResources.Get('dbFldNotFound') + ' ' + UserName + '."' +
+ Index + '"';
+ ReportRef.Errors.Add(ReportRef.CurObject + ': ' + s);
+ end;
+ end
+ else
+ s := UserName + '."' + Index + '"';
+ Result := s;
+end;
+
+function TfrxDBDataset.GetValue(Index: String): Variant;
+var
+ i: Integer;
+ v: Variant;
+begin
+ if not FInitialized then
+ Open;
+ i := Fields.IndexOf(Index);
+ if i <> -1 then
+ begin
+ if TField(Fields.Objects[i]) is TFMTBCDField then
+ begin
+ if TField(Fields.Objects[i]).IsNull then
+ v := Null
+ else if BCDToCurrency then
+ v := TField(Fields.Objects[i]).AsCurrency
+ else
+ v := TField(Fields.Objects[i]).AsFloat
+ end
+ else
+ if TField(Fields.Objects[i]) is TLargeIntField then
+ begin
+ { TLargeIntField.AsVariant converts value to vt_decimal variant type
+ which is not supported by Delphi }
+ if TField(Fields.Objects[i]).IsNull then
+ v := Null
+ else
+ v := TLargeIntField(Fields.Objects[i]).AsLargeInt
+ end
+ else if TField(Fields.Objects[i]) is TSQLTimeStampField then
+ begin
+ if TField(Fields.Objects[i]).IsNull then
+ v := Null
+ else
+ v := TSQLTimeStampField(Fields.Objects[i]).AsDateTime;
+ end
+ else
+ if Fields.Objects[i] is TBlobField then
+ begin
+ if (TBlobField(Fields.Objects[i]).BlobType
+ in [ftWideString, ftWideMemo, ftFixedWideChar]) then
+ v := TField(Fields.Objects[i]).AsWideString
+ else v := TField(Fields.Objects[i]).AsString
+ end
+ else
+ v := TField(Fields.Objects[i]).Value
+ end
+ else
+ begin
+ v := Null;
+ ReportRef.Errors.Add(ReportRef.CurObject + ': ' +
+ frxResources.Get('dbFldNotFound') + ' ' + UserName + '."' + Index + '"');
+ end;
+ Result := v;
+end;
+
+function TfrxDBDataset.GetDisplayWidth(Index: String): Integer;
+var
+ f: TField;
+ fDef: TFieldDef;
+begin
+ Result := 10;
+ Index := ConvertAlias(Index);
+ f := FDS.FindField(Index);
+ if f <> nil then
+ Result := f.DisplayWidth
+ else
+ begin
+ try
+ if not FDS.FieldDefs.Updated then
+ FDS.FieldDefs.Update;
+ except
+ end;
+ fDef := FDS.FieldDefs.Find(Index);
+ if fDef <> nil then
+ case fDef.DataType of
+ ftString, ftWideString: Result := fDef.Size;
+ ftLargeInt: Result := 15;
+ ftDateTime: Result := 20;
+ end;
+ end;
+end;
+
+function TfrxDBDataset.GetFieldType(Index: String): TfrxFieldType;
+var
+ f: TField;
+begin
+ Result := fftNumeric;
+ f := FDS.FindField(ConvertAlias(Index));
+ if f <> nil then
+ case f.DataType of
+ ftString, ftWideString, ftMemo:
+ Result := fftString;
+ ftBoolean:
+ Result := fftBoolean;
+ end;
+end;
+
+procedure TfrxDBDataset.AssignBlobTo(const fName: String; Obj: TObject);
+var
+ Field: TField;
+ BlobStream: TStream;
+ sl: TStringList;
+begin
+ if not FInitialized then
+ Open;
+ Field := TField(Fields.Objects[Fields.IndexOf(fName)]);
+ if (Field <> nil) and Field.IsBlob then
+// if Field is TBlobField then
+ begin
+ if Obj is TfrxWideStrings then
+ begin
+ BlobStream := TMemoryStream.Create;
+ sl := TStringList.Create;
+ try
+ TBlobField(Field).SaveToStream(BlobStream);
+ BlobStream.Position := 0;
+ if Field is TWideMemoField then
+ TfrxWideStrings(Obj).LoadFromWStream(BlobStream)
+ else if Field is TMemoField then
+ TfrxWideStrings(Obj).Text := Field.AsWideString;
+ finally
+ BlobStream.Free;
+ sl.Free;
+ end;
+ end
+ else if Obj is TStream then
+ begin
+ if (Field is TWideMemoField) and (Obj is TStringStream) then
+ TStringStream(Obj).WriteString(TWideMemoField(Field).AsWideString)
+ else
+ TBlobField(Field).SaveToStream(TStream(Obj));
+ TStream(Obj).Position := 0;
+ end;
+ end;
+end;
+
+procedure TfrxDBDataset.GetFieldList(List: TStrings);
+var
+ i: Integer;
+begin
+ List.Clear;
+ if FieldAliases.Count = 0 then
+ begin
+ try
+ if FDS <> nil then
+ begin
+ FDS.GetFieldNames(List);
+ List.BeginUpdate;
+ for i := 0 to FDS.AggFields.Count - 1 do
+ List.Add(FDS.AggFields[i].FieldName);
+ List.EndUpdate;
+ end;
+ except
+ end;
+ end
+ else
+ begin
+ for i := 0 to FieldAliases.Count - 1 do
+ if Pos('-', FieldAliases.Names[i]) <> 1 then
+ List.Add(FieldAliases.Values[FieldAliases.Names[i]]);
+ end;
+end;
+
+function TfrxDBDataset.IsBlobField(const fName: String): Boolean;
+var
+ Field: TField;
+ i: Integer;
+begin
+ if not FInitialized then
+ Open;
+ Result := False;
+ i := Fields.IndexOf(fName);
+ if i <> -1 then
+ begin
+ Field := TField(Fields.Objects[i]);
+ Result := (Field <> nil) and Field.IsBlob;
+ end;
+end;
+
+function TfrxDBDataset.RecordCount: Integer;
+begin
+ if not FInitialized then
+ Open;
+ Result := FDS.RecordCount;
+end;
+
+end.
+
diff --git a/LibD28/FMX.frxDBXComponents.pas b/LibD28/FMX.frxDBXComponents.pas
new file mode 100644
index 0000000..32a8c13
--- /dev/null
+++ b/LibD28/FMX.frxDBXComponents.pas
@@ -0,0 +1,654 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ DBX enduser components }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDBXComponents;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.Classes, FMX.frxClass, FMX.frxCustomDB, Data.DB, Data.DBCommonTypes,
+ Data.SqlExpr, Datasnap.Provider, Datasnap.DBClient, System.Variants, FMX.Types
+{$IFDEF QBUILDER}
+, FMX.fqbClass
+{$ENDIF};
+
+
+type
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxDBXDataset = class(TCustomClientDataset)
+ private
+ FDataSet: TDataSet;
+ FProvider: TDataSetProvider;
+ procedure SetDataset(const Value: TDataset);
+ protected
+ procedure OpenCursor(InfoQuery: Boolean); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ property Dataset: TDataset read FDataset write SetDataset;
+ end;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxDBXComponents = class(TfrxDBComponents)
+ private
+ FDefaultDatabase: TSQLConnection;
+ FOldComponents: TfrxDBXComponents;
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetDefaultDatabase(Value: TSQLConnection);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function GetDescription: String; override;
+ published
+ property DefaultDatabase: TSQLConnection read FDefaultDatabase write SetDefaultDatabase;
+ end;
+
+ TfrxDBXDatabase = class(TfrxCustomDatabase)
+ private
+ FDatabase: TSQLConnection;
+ FStrings: TStrings;
+ FLock: Boolean;
+ function GetDriverName: String;
+ function GetGetDriverFunc: String;
+ function GetLibraryName: String;
+ function GetVendorLib: String;
+ procedure SetDriverName(const Value: String);
+ procedure SetGetDriverFunc(const Value: String);
+ procedure SetLibraryName(const Value: String);
+ procedure SetVendorLib(const Value: String);
+ procedure OnChange(Sender: TObject);
+ protected
+ procedure SetConnected(Value: Boolean); override;
+ procedure SetDatabaseName(const Value: String); override;
+ procedure SetLoginPrompt(Value: Boolean); override;
+ procedure SetParams(Value: TStrings); override;
+ function GetConnected: Boolean; override;
+ function GetDatabaseName: String; override;
+ function GetLoginPrompt: Boolean; override;
+ function GetParams: TStrings; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ property Database: TSQLConnection read FDatabase;
+ published
+ property ConnectionName: String read GetDatabaseName write SetDatabaseName;
+ property DriverName: String read GetDriverName write SetDriverName;
+ property GetDriverFunc: String read GetGetDriverFunc write SetGetDriverFunc;
+ property LibraryName: String read GetLibraryName write SetLibraryName;
+ property LoginPrompt;
+ property Params;
+ property VendorLib: String read GetVendorLib write SetVendorLib;
+ property Connected;
+ end;
+
+ TfrxDBXTable = class(TfrxCustomTable)
+ private
+ FDatabase: TfrxDBXDatabase;
+ FTable: TSQLTable;
+ procedure SetDatabase(const Value: TfrxDBXDatabase);
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetMaster(const Value: TDataSource); override;
+ procedure SetMasterFields(const Value: String); override;
+ procedure SetIndexName(const Value: String); override;
+ procedure SetIndexFieldNames(const Value: String); override;
+ procedure SetTableName(const Value: String); override;
+ function GetIndexName: String; override;
+ function GetIndexFieldNames: String; override;
+ function GetTableName: String; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor DesignCreate(AOwner: TComponent; Flags: Word); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ procedure BeforeStartReport; override;
+ property Table: TSQLTable read FTable;
+ published
+ property Database: TfrxDBXDatabase read FDatabase write SetDatabase;
+ end;
+
+ TfrxDBXQuery = class(TfrxCustomQuery)
+ private
+ FDatabase: TfrxDBXDatabase;
+ FQuery: TSQLQuery;
+ FStrings: TStrings;
+ FLock: Boolean;
+ procedure SetDatabase(const Value: TfrxDBXDatabase);
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetMaster(const Value: TDataSource); override;
+ procedure SetSQL(Value: TStrings); override;
+ function GetSQL: TStrings; override;
+ procedure OnChangeSQL(Sender: TObject); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor DesignCreate(AOwner: TComponent; Flags: Word); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ procedure BeforeStartReport; override;
+ procedure UpdateParams; override;
+{$IFDEF QBUILDER}
+ function QBEngine: TfqbEngine; override;
+{$ENDIF}
+ property Query: TSQLQuery read FQuery;
+ published
+ property Database: TfrxDBXDatabase read FDatabase write SetDatabase;
+ end;
+
+{$IFDEF QBUILDER}
+ TfrxEngineDBX = class(TfqbEngine)
+ private
+ FQuery: TSQLQuery;
+ FDBXDataset: TfrxDBXDataset;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure ReadTableList(ATableList: TStrings); override;
+ procedure ReadFieldList(const ATableName: string; var AFieldList: TfqbFieldList); override;
+ function ResultDataSet: TDataSet; override;
+ procedure SetSQL(const Value: string); override;
+ end;
+{$ENDIF}
+
+var
+ DBXComponents: TfrxDBXComponents;
+
+
+implementation
+
+uses
+ FMX.frxDBXRTTI,
+{$IFNDEF NO_EDITORS}
+ FMX.frxDBXEditor,
+{$ENDIF}
+ FMX.frxDsgnIntf, FMX.frxRes;
+
+type
+ THackSQLConnection = class(TSQLConnection);
+
+
+{ TfrxDBXDataset }
+
+constructor TfrxDBXDataset.Create(AOwner: TComponent);
+begin
+ inherited;
+ FProvider := TDatasetProvider.Create(nil);
+end;
+
+destructor TfrxDBXDataset.Destroy;
+begin
+ FProvider.Free;
+ inherited;
+end;
+
+procedure TfrxDBXDataset.OpenCursor(InfoQuery: Boolean);
+begin
+ SetProvider(FProvider);
+ inherited;
+end;
+
+procedure TfrxDBXDataset.SetDataset(const Value: TDataset);
+begin
+ FDataset := Value;
+ FProvider.Dataset := FDataset;
+end;
+
+
+{ TfrxDBXComponents }
+
+constructor TfrxDBXComponents.Create(AOwner: TComponent);
+begin
+ inherited;
+ FOldComponents := DBXComponents;
+ DBXComponents := Self;
+end;
+
+destructor TfrxDBXComponents.Destroy;
+begin
+ if DBXComponents = Self then
+ DBXComponents := FOldComponents;
+ inherited;
+end;
+
+function TfrxDBXComponents.GetDescription: String;
+begin
+ Result := 'DBX';
+end;
+
+procedure TfrxDBXComponents.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited;
+ if (AComponent = FDefaultDatabase) and (Operation = opRemove) then
+ FDefaultDatabase := nil;
+end;
+
+procedure TfrxDBXComponents.SetDefaultDatabase(Value: TSQLConnection);
+begin
+ if (Value <> nil) then
+ Value.FreeNotification(Self);
+
+ if FDefaultDatabase <> nil then
+ FDefaultDatabase.RemoveFreeNotification(Self);
+
+ FDefaultDatabase := Value;
+end;
+
+
+{ TfrxDBXDatabase }
+
+constructor TfrxDBXDatabase.Create(AOwner: TComponent);
+begin
+ inherited;
+ FStrings := TStringList.Create;
+ TStringList(FStrings).OnChange := OnChange;
+ FDatabase := TSQLConnection.Create(nil);
+// set ComponentState := csDesigning to obtain Params automatically
+ THackSQLConnection(FDataBase).SetDesigning(True, False);
+ Component := FDatabase;
+end;
+
+destructor TfrxDBXDatabase.Destroy;
+begin
+ FStrings.Free;
+ inherited;
+end;
+
+class function TfrxDBXDatabase.GetDescription: String;
+begin
+ Result := frxResources.Get('obDBXDB');
+end;
+
+function TfrxDBXDatabase.GetConnected: Boolean;
+begin
+ Result := FDatabase.Connected;
+end;
+
+function TfrxDBXDatabase.GetDatabaseName: String;
+begin
+ Result := FDatabase.ConnectionName;
+end;
+
+function TfrxDBXDatabase.GetDriverName: String;
+begin
+ Result := FDatabase.DriverName;
+end;
+
+function TfrxDBXDatabase.GetGetDriverFunc: String;
+begin
+ Result := FDatabase.GetDriverFunc;
+end;
+
+function TfrxDBXDatabase.GetLibraryName: String;
+begin
+ Result := FDatabase.LibraryName;
+end;
+
+function TfrxDBXDatabase.GetLoginPrompt: Boolean;
+begin
+ Result := FDatabase.LoginPrompt;
+end;
+
+function TfrxDBXDatabase.GetParams: TStrings;
+begin
+ FLock := True;
+ FStrings.Assign(FDatabase.Params);
+ FLock := False;
+ Result := FStrings;
+end;
+
+function TfrxDBXDatabase.GetVendorLib: String;
+begin
+ Result := FDatabase.VendorLib;
+end;
+
+procedure TfrxDBXDatabase.SetConnected(Value: Boolean);
+begin
+ BeforeConnect(Value);
+ FDatabase.Connected := Value;
+end;
+
+procedure TfrxDBXDatabase.SetDatabaseName(const Value: String);
+begin
+ FDatabase.ConnectionName := Value;
+end;
+
+procedure TfrxDBXDatabase.SetDriverName(const Value: String);
+begin
+ FDatabase.DriverName := Value;
+end;
+
+procedure TfrxDBXDatabase.SetGetDriverFunc(const Value: String);
+begin
+ FDatabase.GetDriverFunc := Value;
+end;
+
+procedure TfrxDBXDatabase.SetLibraryName(const Value: String);
+begin
+ FDatabase.LibraryName := Value;
+end;
+
+procedure TfrxDBXDatabase.SetLoginPrompt(Value: Boolean);
+begin
+ FDatabase.LoginPrompt := Value;
+end;
+
+procedure TfrxDBXDatabase.SetParams(Value: TStrings);
+begin
+ FStrings.Assign(Value);
+end;
+
+procedure TfrxDBXDatabase.SetVendorLib(const Value: String);
+begin
+ FDatabase.VendorLib := Value;
+end;
+
+procedure TfrxDBXDatabase.OnChange(Sender: TObject);
+begin
+ if not FLock then
+ FDatabase.Params.Assign(FStrings);
+end;
+
+
+{ TfrxDBXTable }
+
+constructor TfrxDBXTable.Create(AOwner: TComponent);
+begin
+ FTable := TSQLTable.Create(nil);
+ DataSet := FTable;
+ SetDatabase(nil);
+ inherited;
+end;
+
+destructor TfrxDBXTable.Destroy;
+begin
+ inherited;
+end;
+
+constructor TfrxDBXTable.DesignCreate(AOwner: TComponent; Flags: Word);
+var
+ i: Integer;
+ l: TList;
+begin
+ inherited;
+ l := Report.AllObjects;
+ for i := 0 to l.Count - 1 do
+ if TObject(l[i]) is TfrxDBXDatabase then
+ begin
+ SetDatabase(TfrxDBXDatabase(l[i]));
+ break;
+ end;
+end;
+
+class function TfrxDBXTable.GetDescription: String;
+begin
+ Result := frxResources.Get('obDBXTb');
+end;
+
+procedure TfrxDBXTable.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FDatabase) then
+ SetDatabase(nil);
+end;
+
+procedure TfrxDBXTable.SetDatabase(const Value: TfrxDBXDatabase);
+begin
+ FDatabase := Value;
+ if Value <> nil then
+ FTable.SQLConnection := Value.Database
+ else if DBXComponents <> nil then
+ FTable.SQLConnection := DBXComponents.DefaultDatabase
+ else
+ FTable.SQLConnection := nil;
+ DBConnected := FTable.SQLConnection <> nil;
+end;
+
+function TfrxDBXTable.GetIndexName: String;
+begin
+ Result := FTable.IndexName;
+end;
+
+function TfrxDBXTable.GetIndexFieldNames: String;
+begin
+ Result := FTable.IndexFieldNames;
+end;
+
+function TfrxDBXTable.GetTableName: String;
+begin
+ Result := FTable.TableName;
+end;
+
+procedure TfrxDBXTable.SetIndexName(const Value: String);
+begin
+ FTable.IndexName := Value;
+end;
+
+procedure TfrxDBXTable.SetIndexFieldNames(const Value: String);
+begin
+ FTable.IndexFieldNames := Value;
+end;
+
+procedure TfrxDBXTable.SetTableName(const Value: String);
+begin
+ FTable.TableName := Value;
+end;
+
+procedure TfrxDBXTable.SetMaster(const Value: TDataSource);
+begin
+ FTable.MasterSource := Value;
+end;
+
+procedure TfrxDBXTable.SetMasterFields(const Value: String);
+begin
+ FTable.MasterFields := Value;
+end;
+
+procedure TfrxDBXTable.BeforeStartReport;
+begin
+ SetDatabase(FDatabase);
+end;
+
+
+{ TfrxDBXQuery }
+
+constructor TfrxDBXQuery.Create(AOwner: TComponent);
+begin
+ FStrings := TStringList.Create;
+ FQuery := TSQLQuery.Create(nil);
+ DataSet := FQuery;
+ SetDatabase(nil);
+ inherited;
+end;
+
+destructor TfrxDBXQuery.Destroy;
+begin
+ FStrings.Free;
+ inherited;
+end;
+
+constructor TfrxDBXQuery.DesignCreate(AOwner: TComponent; Flags: Word);
+var
+ i: Integer;
+ l: TList;
+begin
+ inherited;
+ l := Report.AllObjects;
+ for i := 0 to l.Count - 1 do
+ if TObject(l[i]) is TfrxDBXDatabase then
+ begin
+ SetDatabase(TfrxDBXDatabase(l[i]));
+ break;
+ end;
+end;
+
+class function TfrxDBXQuery.GetDescription: String;
+begin
+ Result := frxResources.Get('obDBXQ');
+end;
+
+procedure TfrxDBXQuery.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FDatabase) then
+ SetDatabase(nil);
+end;
+
+procedure TfrxDBXQuery.SetDatabase(const Value: TfrxDBXDatabase);
+begin
+ FDatabase := Value;
+ if Value <> nil then
+ FQuery.SQLConnection := Value.Database
+ else if DBXComponents <> nil then
+ FQuery.SQLConnection := DBXComponents.DefaultDatabase
+ else
+ FQuery.SQLConnection := nil;
+ DBConnected := FQuery.SQLConnection <> nil;
+end;
+
+function TfrxDBXQuery.GetSQL: TStrings;
+begin
+ FLock := True;
+ FStrings.Assign(FQuery.SQL);
+ FLock := False;
+ Result := FStrings;
+end;
+
+procedure TfrxDBXQuery.SetSQL(Value: TStrings);
+begin
+ FQuery.SQL.Assign(Value);
+ FStrings.Assign(Value);
+end;
+
+procedure TfrxDBXQuery.SetMaster(const Value: TDataSource);
+begin
+ FQuery.DataSource := Value;
+end;
+
+procedure TfrxDBXQuery.UpdateParams;
+begin
+ FQuery.SQL.Assign(FStrings);
+ frxParamsToTParams(Self, FQuery.Params);
+end;
+
+procedure TfrxDBXQuery.BeforeStartReport;
+begin
+ SetDatabase(FDatabase);
+end;
+
+procedure TfrxDBXQuery.OnChangeSQL(Sender: TObject);
+begin
+ if not FLock then
+ begin
+ FQuery.SQL.Assign(FStrings);
+ inherited;
+ end;
+end;
+
+{$IFDEF QBUILDER}
+function TfrxDBXQuery.QBEngine: TfqbEngine;
+begin
+ Result := TfrxEngineDBX.Create(nil);
+ TfrxEngineDBX(Result).FQuery.SQLConnection := FQuery.SQLConnection;
+end;
+{$ENDIF}
+
+
+{$IFDEF QBUILDER}
+constructor TfrxEngineDBX.Create(AOwner: TComponent);
+begin
+ inherited;
+ FQuery := TSQLQuery.Create(nil);
+ FDBXDataset := TfrxDBXDataset.Create(nil);
+ FDBXDataset.Dataset := FQuery;
+end;
+
+destructor TfrxEngineDBX.Destroy;
+begin
+ FQuery.Free;
+ FDBXDataset.Free;
+ inherited;
+end;
+
+procedure TfrxEngineDBX.ReadFieldList(const ATableName: string;
+ var AFieldList: TfqbFieldList);
+var
+ TempTable: TSQLTable;
+ Fields: TFieldDefs;
+ i: Integer;
+ tmpField: TfqbField;
+begin
+ AFieldList.Clear;
+ TempTable := TSQLTable.Create(Self);
+ TempTable.SQLConnection := FQuery.SQLConnection;
+ TempTable.TableName := ATableName;
+ Fields := TempTable.FieldDefs;
+ try
+ try
+ TempTable.Active := True;
+ tmpField:= TfqbField(AFieldList.Add);
+ tmpField.FieldName := '*';
+ for i := 0 to Fields.Count - 1 do
+ begin
+ tmpField := TfqbField(AFieldList.Add);
+ tmpField.FieldName := Fields.Items[i].Name;
+ tmpField.FieldType := Ord(Fields.Items[i].DataType)
+ end;
+ except
+ end;
+ finally
+ TempTable.Free;
+ end;
+end;
+
+procedure TfrxEngineDBX.ReadTableList(ATableList: TStrings);
+begin
+ ATableList.Clear;
+ FQuery.SQLConnection.GetTableNames(ATableList, ShowSystemTables);
+end;
+
+function TfrxEngineDBX.ResultDataSet: TDataSet;
+begin
+ Result := FDBXDataset;
+end;
+
+procedure TfrxEngineDBX.SetSQL(const Value: string);
+begin
+ FQuery.SQL.Text := Value;
+end;
+{$ENDIF}
+
+
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxDBXDataBase, TFmxObject);
+ GroupDescendentsWith(TfrxDBXTable, TFmxObject);
+ GroupDescendentsWith(TfrxDBXQuery, TFmxObject);
+ frxObjects.RegisterObject1(TfrxDBXDataBase, nil, '', {$IFDEF DB_CAT}'DATABASES'{$ELSE}''{$ENDIF}, 0, 246);
+ frxObjects.RegisterObject1(TfrxDBXTable, nil, '', {$IFDEF DB_CAT}'TABLES'{$ELSE}''{$ENDIF}, 0, 247);
+ frxObjects.RegisterObject1(TfrxDBXQuery, nil, '', {$IFDEF DB_CAT}'QUERIES'{$ELSE}''{$ENDIF}, 0, 248);
+
+finalization
+ frxObjects.UnRegister(TfrxDBXDataBase);
+ frxObjects.UnRegister(TfrxDBXTable);
+ frxObjects.UnRegister(TfrxDBXQuery);
+
+
+end.
\ No newline at end of file
diff --git a/LibD28/FMX.frxDBXEditor.pas b/LibD28/FMX.frxDBXEditor.pas
new file mode 100644
index 0000000..cb7640d
--- /dev/null
+++ b/LibD28/FMX.frxDBXEditor.pas
@@ -0,0 +1,167 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ DBX components design editors }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDBXEditor;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, System.SysUtils, FMX.Forms, FMX.Dialogs, FMX.frxDBXComponents, FMX.frxCustomDB,
+ FMX.frxDsgnIntf, FMX.frxRes, Data.DBCommonTypes, Data.SqlExpr, System.Variants;
+
+
+type
+ TfrxConnectionNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ end;
+
+ TfrxDriverNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ end;
+
+ TfrxDatabaseProperty = class(TfrxComponentProperty)
+ public
+ function GetValue: String; override;
+ end;
+
+ TfrxTableNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxIndexNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ end;
+
+
+{ TfrxConnectionNameProperty }
+
+function TfrxConnectionNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList];
+end;
+
+procedure TfrxConnectionNameProperty.GetValues;
+begin
+ inherited;
+ GetConnectionNames(Values);
+end;
+
+
+{ TfrxDriverNameProperty }
+
+function TfrxDriverNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList];
+end;
+
+procedure TfrxDriverNameProperty.GetValues;
+begin
+ inherited;
+ GetDriverNames(Values);
+end;
+
+
+{ TfrxDatabaseProperty }
+
+function TfrxDatabaseProperty.GetValue: String;
+var
+ db: TfrxDBXDatabase;
+begin
+ db := TfrxDBXDatabase(GetOrdValue);
+ if db = nil then
+ begin
+ if (DBXComponents <> nil) and (DBXComponents.DefaultDatabase <> nil) then
+ Result := DBXComponents.DefaultDatabase.Name
+ else
+ Result := frxResources.Get('prNotAssigned');
+ end
+ else
+ Result := inherited GetValue;
+end;
+
+
+{ TfrxTableNameProperty }
+
+function TfrxTableNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paSortList];
+end;
+
+procedure TfrxTableNameProperty.GetValues;
+begin
+ inherited;
+ with TfrxDBXTable(Component).Table do
+ if SQLConnection <> nil then
+ SQLConnection.GetTableNames(Values, False);
+end;
+
+procedure TfrxTableNameProperty.SetValue(const Value: String);
+begin
+ inherited;
+ Designer.UpdateDataTree;
+end;
+
+
+{ TfrxIndexProperty }
+
+function TfrxIndexNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList];
+end;
+
+procedure TfrxIndexNameProperty.GetValues;
+var
+ i: Integer;
+begin
+ inherited;
+ try
+ with TfrxDBXTable(Component).Table do
+ if (TableName <> '') and (IndexDefs <> nil) then
+ begin
+ IndexDefs.Update;
+ for i := 0 to IndexDefs.Count - 1 do
+ if IndexDefs[i].Name <> '' then
+ Values.Add(IndexDefs[i].Name);
+ end;
+ except
+ end;
+end;
+
+
+initialization
+ frxPropertyEditors.Register(TypeInfo(String), TfrxDBXDataBase, 'ConnectionName',
+ TfrxConnectionNameProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxDBXDataBase, 'DriverName',
+ TfrxDriverNameProperty);
+ frxPropertyEditors.Register(TypeInfo(TfrxDBXDatabase), TfrxDBXTable, 'Database',
+ TfrxDatabaseProperty);
+ frxPropertyEditors.Register(TypeInfo(TfrxDBXDatabase), TfrxDBXQuery, 'Database',
+ TfrxDatabaseProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxDBXTable, 'TableName',
+ TfrxTableNameProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxDBXTable, 'IndexName',
+ TfrxIndexNameProperty);
+
+end.
diff --git a/LibD28/FMX.frxDBXRTTI.pas b/LibD28/FMX.frxDBXRTTI.pas
new file mode 100644
index 0000000..c068bb9
--- /dev/null
+++ b/LibD28/FMX.frxDBXRTTI.pas
@@ -0,0 +1,68 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ DBX components RTTI }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDBXRTTI;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, FMX.fs_iinterpreter, FMX.frxDBXComponents, System.Variants;
+
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddClass(TfrxDBXDatabase, 'TfrxCustomDatabase');
+ AddClass(TfrxDBXTable, 'TfrxCustomTable');
+ with AddClass(TfrxDBXQuery, 'TfrxCustomQuery') do
+ AddMethod('procedure ExecSQL', CallMethod);
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TfrxDBXQuery then
+ begin
+ if MethodName = 'EXECSQL' then
+ TfrxDBXQuery(Instance).Query.ExecSQL
+ end
+end;
+
+
+initialization
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/FMX.frxDCtrl.pas b/LibD28/FMX.frxDCtrl.pas
new file mode 100644
index 0000000..88e823e
--- /dev/null
+++ b/LibD28/FMX.frxDCtrl.pas
@@ -0,0 +1,1635 @@
+
+{******************************************}
+{ }
+{ FastReport v2.4 - Dialog designer }
+{ Standard Dialog controls }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDCtrl;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UiTypes, FMX.Types, FMX.Controls, FMX.ExtCtrls, FMX.Objects,
+ FMX.Forms, FMX.Menus, FMX.Dialogs, FMX.frxClass, System.Variants, FMX.Edit, FMX.Memo, FMX.ListBox, FMX.frxFMX
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics, FMX.DateTimeCtrls
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxDialogControls = class(TComponent) // fake component
+ end;
+{$IFDEF DELPHI21}
+ TCalendarBox = class(TDateEdit);
+{$ENDIF}
+ TfrxLabelControl = class(TfrxDialogControl)
+ private
+ FLabel: TLabel;
+ function GetAlignment: TTextAlign;
+ function GetAutoSize: Boolean;
+ function GetWordWrap: Boolean;
+ procedure SetAlignment(const Value: TTextAlign);
+ procedure SetAutoSize(const Value: Boolean);
+ procedure SetWordWrap(const Value: Boolean);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ procedure BeforeStartReport; override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ property LabelCtl: TLabel read FLabel;
+ published
+ property Alignment: TTextAlign read GetAlignment write SetAlignment
+ default TTextAlign.taLeading;
+ property AutoSize: Boolean read GetAutoSize write SetAutoSize default True;
+ property Caption;
+ property WordWrap: Boolean read GetWordWrap write SetWordWrap default False;
+
+ property OnClick;
+ property OnDblClick;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfrxCustomEditControl = class(TfrxDialogControl)
+ private
+ FOnChange: TfrxNotifyEvent;
+ function GetMaxLength: Integer;
+ function GetPasswordChar: Char;
+ function GetReadOnly: Boolean;
+ function GetText: String;
+ procedure DoOnChange(Sender: TObject);
+ procedure SetMaxLength(const Value: Integer);
+ procedure SetPasswordChar(const Value: Char);
+ procedure SetReadOnly(const Value: Boolean);
+ procedure SetText(const Value: String);
+ protected
+ FCustomEdit: TControl;
+ public
+ constructor Create(AOwner: TComponent); override;
+ property MaxLength: Integer read GetMaxLength write SetMaxLength;
+ property PasswordChar: Char read GetPasswordChar write SetPasswordChar;
+ property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
+ property Text: String read GetText write SetText;
+ property OnChange: TfrxNotifyEvent read FOnChange write FOnChange;
+ end;
+
+ TfrxEditControl = class(TfrxCustomEditControl)
+ private
+ FEdit: TEdit;
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property Edit: TEdit read FEdit;
+ published
+ property MaxLength;
+ property PasswordChar;
+ property ReadOnly;
+ property TabStop;
+ property Text;
+ property OnChange;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfrxMemoControl = class(TfrxDialogControl)
+ private
+ FMemo: TMemo;
+ FOnChange: TfrxNotifyEvent;
+ function GetLines: TStrings;
+ procedure SetLines(const Value: TStrings);
+ function GetShowScrollBars: Boolean;
+ function GetWordWrap: Boolean;
+ procedure SetShowScrollBars(const Value: Boolean);
+ procedure SetWordWrap(const Value: Boolean);
+ procedure DoOnChange(Sender: TObject);
+ function GetMaxLength: Integer;
+ function GetReadOnly: Boolean;
+ procedure SetMaxLength(const Value: Integer);
+ procedure SetReadOnly(const Value: Boolean);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property Memo: TMemo read FMemo;
+ published
+ property Lines: TStrings read GetLines write SetLines;
+ property MaxLength: Integer read GetMaxLength write SetMaxLength;
+ property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
+ property ShowScrollBars: Boolean read GetShowScrollBars write SetShowScrollBars default False;
+ property TabStop;
+ property WordWrap: Boolean read GetWordWrap write SetWordWrap default True;
+ property OnChange: TfrxNotifyEvent read FOnChange write FOnChange;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfrxButtonControl = class(TfrxDialogControl)
+ private
+ FButton: TButton;
+ function GetCancel: Boolean;
+ function GetDefault: Boolean;
+ function GetModalResult: TModalResult;
+ procedure SetCancel(const Value: Boolean);
+ procedure SetDefault(const Value: Boolean);
+ procedure SetModalResult(const Value: TModalResult);
+ function GetWordWrap: Boolean;
+ procedure SetWordWrap(const Value: Boolean);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property Button: TButton read FButton;
+ published
+ property Cancel: Boolean read GetCancel write SetCancel default False;
+ property Caption;
+ property Default: Boolean read GetDefault write SetDefault default False;
+ property ModalResult: TModalResult read GetModalResult write SetModalResult default mrNone;
+ property WordWrap: Boolean read GetWordWrap write SetWordWrap default False;
+ property TabStop;
+ property OnClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfrxCheckBoxControl = class(TfrxDialogControl)
+ private
+ FCheckBox: TCheckBox;
+ FOnChange: TfrxNotifyEvent;
+ function GetChecked: Boolean;
+ procedure SetChecked(const Value: Boolean);
+ function GetWordWrap: Boolean;
+ procedure SetWordWrap(const Value: Boolean);
+ procedure DoOnChange(Sender: TObject);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property CheckBox: TCheckBox read FCheckBox;
+ published
+ property Caption;
+ property Checked: Boolean read GetChecked write SetChecked default False;
+ property TabStop;
+ property WordWrap: Boolean read GetWordWrap write SetWordWrap default False;
+ property OnChange: TfrxNotifyEvent read FOnChange write FOnChange;
+ property OnClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfrxRadioButtonControl = class(TfrxDialogControl)
+ private
+ FRadioButton: TRadioButton;
+ FOnChange: TfrxNotifyEvent;
+ function GetChecked: Boolean;
+ procedure SetChecked(const Value: Boolean);
+ function GetWordWrap: Boolean;
+ procedure SetWordWrap(const Value: Boolean);
+ procedure DoOnChange(Sender: TObject);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property RadioButton: TRadioButton read FRadioButton;
+ published
+ property Caption;
+ property Checked: Boolean read GetChecked write SetChecked default False;
+ property TabStop;
+ property WordWrap: Boolean read GetWordWrap write SetWordWrap default False;
+ property OnChange: TfrxNotifyEvent read FOnChange write FOnChange;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfrxListBoxControl = class(TfrxDialogControl)
+ private
+ FListBox: TListBox;
+ function GetItems: TStrings;
+ procedure SetItems(const Value: TStrings);
+ function GetItemIndex: Integer;
+ procedure SetItemIndex(const Value: Integer);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ property ListBox: TListBox read FListBox;
+ property ItemIndex: Integer read GetItemIndex write SetItemIndex;
+ published
+ property Items: TStrings read GetItems write SetItems;
+ property TabStop;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfrxComboBoxControl = class(TfrxDialogControl)
+ private
+ FComboBox: TComboBox;
+ FOnChange: TfrxNotifyEvent;
+ function GetItemIndex: Integer;
+ function GetItems: TStrings;
+ //function GetStyle: TComboBoxStyle;
+ function GetText: String;
+ procedure DoOnChange(Sender: TObject);
+ procedure SetItemIndex(const Value: Integer);
+ procedure SetItems(const Value: TStrings);
+ //procedure SetStyle(const Value: TComboBoxStyle);
+ procedure SetText(const Value: String);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property ComboBox: TComboBox read FComboBox;
+ published
+ //property Color;
+ property Items: TStrings read GetItems write SetItems;
+ //property Style: TComboBoxStyle read GetStyle write SetStyle default csDropDown;
+ property TabStop;
+ property Text: String read GetText write SetText;
+ property ItemIndex: Integer read GetItemIndex write SetItemIndex;
+ property OnChange: TfrxNotifyEvent read FOnChange write FOnChange;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ end;
+
+ TfrxPanelControl = class(TfrxDialogControl)
+ private
+ FPanel: TPanel;
+ function GetAlignment: TAlignment;
+ //function GetBevelInner: TPanelBevel;
+ //function GetBevelOuter: TPanelBevel;
+ function GetBevelWidth: Integer;
+ procedure SetAlignment(const Value: TAlignment);
+ //procedure SetBevelInner(const Value: TPanelBevel);
+ //procedure SetBevelOuter(const Value: TPanelBevel);
+ procedure SetBevelWidth(const Value: Integer);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property Panel: TPanel read FPanel;
+ published
+ property Alignment: TAlignment read GetAlignment write SetAlignment default TAlignment.taCenter;
+ //property BevelInner: TPanelBevel read GetBevelInner write SetBevelInner default bvNone;
+ //property BevelOuter: TPanelBevel read GetBevelOuter write SetBevelOuter default bvRaised;
+ property BevelWidth: Integer read GetBevelWidth write SetBevelWidth default 1;
+ property Caption;
+ //property Color;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfrxGroupBoxControl = class(TfrxDialogControl)
+ private
+ FGroupBox: TGroupBox;
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property GroupBox: TGroupBox read FGroupBox;
+ published
+ property Caption;
+ //property Color;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfrxDateEditControl = class(TfrxDialogControl)
+ private
+ FDateEdit: TCalendarBox;
+ FOnChange: TfrxNotifyEvent;
+ FWeekNumbers: Boolean;
+ function GetDate: TDate;
+ function GetTime: TTime;
+ //function GetDateFormat: TDTDateFormat;
+ //function GetKind: TDateTimeKind;
+ procedure SetDate(const Value: TDate);
+ procedure SetTime(const Value: TTime);
+ //procedure SetDateFormat(const Value: TDTDateFormat);
+ //procedure SetKind(const Value: TDateTimeKind);
+ protected
+ // remove
+ procedure DoOnChange(Sender: TObject);
+ procedure DropDown(Sender: TObject);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property DateEdit: TCalendarBox read FDateEdit;
+ published
+ //property Color;
+ property Date: TDate read GetDate write SetDate;
+ //property DateFormat: TDTDateFormat read GetDateFormat write SetDateFormat
+ // default dfShort;
+ //property Kind: TDateTimeKind read GetKind write SetKind default dtkDate;
+ property TabStop;
+ property Time: TTime read GetTime write SetTime;
+ property WeekNumbers: Boolean read FWeekNumbers write FWeekNumbers;
+ property OnChange: TfrxNotifyEvent read FOnChange write FOnChange;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ end;
+
+ TfrxImageControl = class(TfrxDialogControl)
+ private
+ FImage: TImage;
+ function GetAutoSize: Boolean;
+ function GetCenter: Boolean;
+ function GetPicture: TBitmap;
+ function GetStretch: Boolean;
+ procedure SetAutoSize(const Value: Boolean);
+ procedure SetCenter(const Value: Boolean);
+ procedure SetPicture(const Value: TBitmap);
+ procedure SetStretch(const Value: Boolean);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property Image: TImage read FImage;
+ published
+ property AutoSize: Boolean read GetAutoSize write SetAutoSize default False;
+ property Center: Boolean read GetCenter write SetCenter default False;
+ property Picture: TBitmap read GetPicture write SetPicture;
+ property Stretch: Boolean read GetStretch write SetStretch default False;
+ property OnClick;
+ property OnDblClick;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfrxBevelControl = class(TfrxDialogControl)
+ private
+ FBevel: TPanel;
+ //function GetBevelShape: TBevelShape;
+ //function GetBevelStyle: TBevelStyle;
+ //procedure SetBevelShape(const Value: TBevelShape);
+ //procedure SetBevelStyle(const Value: TBevelStyle);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property Bevel: TPanel read FBevel;
+ published
+ //property Shape: TBevelShape read GetBevelShape write SetBevelShape default bsBox;
+ //property Style: TBevelStyle read GetBevelStyle write SetBevelStyle default bsLowered;
+ end;
+
+ TfrxBitBtnControl = class(TfrxDialogControl)
+ private
+ FBitBtn: TfrxToolButton;
+ function GetGlyph: TBitmap;
+ //function GetKind: TBitBtnKind;
+ //function GetLayout: TButtonLayout;
+ function GetMargin: Integer;
+ function GetModalResult: TModalResult;
+ function GetSpacing: Integer;
+ procedure SetGlyph(const Value: TBitmap);
+ //procedure SetKind(const Value: TBitBtnKind);
+ //procedure SetLayout(const Value: TButtonLayout);
+ procedure SetMargin(const Value: Integer);
+ procedure SetModalResult(const Value: TModalResult);
+ procedure SetSpacing(const Value: Integer);
+ function GetNumGlyphs: Integer;
+ procedure SetNumGlyphs(const Value: Integer);
+ function GetWordWrap: Boolean;
+ procedure SetWordWrap(const Value: Boolean);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property BitBtn: TfrxToolButton read FBitBtn;
+ published
+ property Glyph: TBitmap read GetGlyph write SetGlyph;
+ //property Kind: TBitBtnKind read GetKind write SetKind default bkCustom;
+ property Caption; // should be after Kind prop
+ //property Layout: TButtonLayout read GetLayout write SetLayout default blGlyphLeft;
+ property Margin: Integer read GetMargin write SetMargin default -1;
+ property ModalResult: TModalResult read GetModalResult write SetModalResult default mrNone;
+ property NumGlyphs: Integer read GetNumGlyphs write SetNumGlyphs default 1;
+ property Spacing: Integer read GetSpacing write SetSpacing default 4;
+ property WordWrap: Boolean read GetWordWrap write SetWordWrap default False;
+ property TabStop;
+ property OnClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+{
+ TfrxSpeedButtonControl = class(TfrxDialogControl)
+ private
+ FSpeedButton: TSpeedButton;
+ function GetAllowAllUp: Boolean;
+ function GetDown: Boolean;
+ function GetFlat: Boolean;
+ function GetGlyph: TBitmap;
+ function GetGroupIndex: Integer;
+ //function GetLayout: TButtonLayout;
+ function GetMargin: Integer;
+ function GetSpacing: Integer;
+ procedure SetAllowAllUp(const Value: Boolean);
+ procedure SetDown(const Value: Boolean);
+ procedure SetFlat(const Value: Boolean);
+ procedure SetGlyph(const Value: TBitmap);
+ procedure SetGroupIndex(const Value: Integer);
+ //procedure SetLayout(const Value: TButtonLayout);
+ procedure SetMargin(const Value: Integer);
+ procedure SetSpacing(const Value: Integer);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property SpeedButton: TSpeedButton read FSpeedButton;
+ published
+ property AllowAllUp: Boolean read GetAllowAllUp write SetAllowAllUp default False;
+ property Caption;
+ property Down: Boolean read GetDown write SetDown default False;
+ property Flat: Boolean read GetFlat write SetFlat default False;
+ property Glyph: TBitmap read GetGlyph write SetGlyph;
+ property GroupIndex: Integer read GetGroupIndex write SetGroupIndex;
+ //property Layout: TButtonLayout read GetLayout write SetLayout default blGlyphLeft;
+ property Margin: Integer read GetMargin write SetMargin default -1;
+ property Spacing: Integer read GetSpacing write SetSpacing default 4;
+ property OnClick;
+ property OnDblClick;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+}
+ {TfrxMaskEditControl = class(TfrxCustomEditControl)
+ private
+ FMaskEdit: TMaskEdit;
+ function GetEditMask: String;
+ procedure SetEditMask(const Value: String);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property MaskEdit: TMaskEdit read FMaskEdit;
+ published
+ property Color;
+ property EditMask: String read GetEditMask write SetEditMask;
+ property MaxLength;
+ property ReadOnly;
+ property TabStop;
+ property Text;
+ property OnChange;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end; }
+
+ {TfrxCheckListBoxControl = class(TfrxDialogControl)
+ private
+ FCheckListBox: TCheckListBox;
+ function GetAllowGrayed: Boolean;
+ function GetItems: TStrings;
+ function GetSorted: Boolean;
+ function GetChecked(Index: Integer): Boolean;
+ function GetState(Index: Integer): TCheckBoxState;
+ procedure SetAllowGrayed(const Value: Boolean);
+ procedure SetItems(const Value: TStrings);
+ procedure SetSorted(const Value: Boolean);
+ procedure SetChecked(Index: Integer; const Value: Boolean);
+ procedure SetState(Index: Integer; const Value: TCheckBoxState);
+ function GetItemIndex: Integer;
+ procedure SetItemIndex(const Value: Integer);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property CheckListBox: TCheckListBox read FCheckListBox;
+ property Checked[Index: Integer]: Boolean read GetChecked write SetChecked;
+ property ItemIndex: Integer read GetItemIndex write SetItemIndex;
+ property State[Index: Integer]: TCheckBoxState read GetState write SetState;
+ published
+ property AllowGrayed: Boolean read GetAllowGrayed write SetAllowGrayed default False;
+ property Color;
+ property Items: TStrings read GetItems write SetItems;
+ property Sorted: Boolean read GetSorted write SetSorted default False;
+ property TabStop;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end; }
+
+
+
+implementation
+
+uses FMX.frxDCtrlRTTI, FMX.frxUtils, FMX.frxDsgnIntf, FMX.frxRes;
+
+type
+ THackCustomEdit = class(TCustomEdit);
+
+
+{ TfrxLabelControl }
+
+constructor TfrxLabelControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FLabel := TLabel.Create(nil);
+ InitControl(FLabel);
+end;
+
+class function TfrxLabelControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obLabel');
+end;
+
+procedure TfrxLabelControl.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+begin
+ if FLabel.AutoSize then
+ begin
+ Width := FLabel.Width;
+ Height := FLabel.Height;
+ end
+ else
+ begin
+ FLabel.Width := Round(Width);
+ FLabel.Height := Round(Height);
+ end;
+ inherited;
+end;
+
+function TfrxLabelControl.GetAlignment: TTextAlign;
+begin
+ Result := FLabel.TextAlign;
+end;
+
+function TfrxLabelControl.GetAutoSize: Boolean;
+begin
+ Result := FLabel.AutoSize;
+end;
+
+function TfrxLabelControl.GetWordWrap: Boolean;
+begin
+ Result := FLabel.WordWrap;
+end;
+
+procedure TfrxLabelControl.SetAlignment(const Value: TTextAlign);
+begin
+ FLabel.TextAlign := Value;
+end;
+
+procedure TfrxLabelControl.SetAutoSize(const Value: Boolean);
+begin
+ FLabel.AutoSize := Value;
+end;
+
+procedure TfrxLabelControl.SetWordWrap(const Value: Boolean);
+begin
+ FLabel.WordWrap := Value;
+end;
+
+procedure TfrxLabelControl.BeforeStartReport;
+begin
+ if not FLabel.AutoSize then
+ begin
+ FLabel.Width := Round(Width);
+ FLabel.Height := Round(Height);
+ end;
+end;
+
+
+{ TfrxCustomEditControl }
+
+constructor TfrxCustomEditControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ THackCustomEdit(FCustomEdit).OnChange := DoOnChange;
+ InitControl(FCustomEdit);
+end;
+
+function TfrxCustomEditControl.GetMaxLength: Integer;
+begin
+ Result := THackCustomEdit(FCustomEdit).MaxLength;
+end;
+
+function TfrxCustomEditControl.GetPasswordChar: Char;
+begin
+ Result := '-';// THackCustomEdit(FCustomEdit).PasswordChar;
+end;
+
+function TfrxCustomEditControl.GetReadOnly: Boolean;
+begin
+ Result := THackCustomEdit(FCustomEdit).ReadOnly;
+end;
+
+function TfrxCustomEditControl.GetText: String;
+begin
+ Result := THackCustomEdit(FCustomEdit).Text;
+end;
+
+procedure TfrxCustomEditControl.SetMaxLength(const Value: Integer);
+begin
+ THackCustomEdit(FCustomEdit).MaxLength := Value;
+end;
+
+procedure TfrxCustomEditControl.SetPasswordChar(const Value: Char);
+begin
+ //THackCustomEdit(FCustomEdit).PasswordChar := Value;
+end;
+
+procedure TfrxCustomEditControl.SetReadOnly(const Value: Boolean);
+begin
+ THackCustomEdit(FCustomEdit).ReadOnly := Value;
+end;
+
+procedure TfrxCustomEditControl.SetText(const Value: String);
+begin
+ THackCustomEdit(FCustomEdit).Text := Value;
+end;
+
+procedure TfrxCustomEditControl.DoOnChange(Sender: TObject);
+begin
+ if Report <> nil then
+ Report.DoNotifyEvent(Self, FOnChange, True);
+end;
+
+
+{ TfrxEditControl }
+
+constructor TfrxEditControl.Create(AOwner: TComponent);
+begin
+ FEdit := TEdit.Create(nil);
+ FCustomEdit := FEdit;
+ inherited;
+
+ Width := 121;
+ Height := 21;
+end;
+
+class function TfrxEditControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obEdit');
+end;
+
+
+{ TfrxMemoControl }
+
+constructor TfrxMemoControl.Create(AOwner: TComponent);
+begin
+ FMemo := TMemo.Create(nil);
+ //FCustomEdit := FMemo;
+ inherited;
+ InitControl(FMemo);
+ Width := 185;
+ Height := 89;
+ FMemo.OnChange := DoOnChange;
+end;
+
+procedure TfrxMemoControl.DoOnChange(Sender: TObject);
+begin
+ if Report <> nil then
+ Report.DoNotifyEvent(Self, FOnChange, True);
+end;
+
+class function TfrxMemoControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obMemoC');
+end;
+
+function TfrxMemoControl.GetLines: TStrings;
+begin
+ Result := FMemo.Lines;
+end;
+
+function TfrxMemoControl.GetMaxLength: Integer;
+begin
+ Result := FMemo.MaxLength;
+end;
+
+function TfrxMemoControl.GetReadOnly: Boolean;
+begin
+ Result := FMemo.ReadOnly;
+end;
+
+function TfrxMemoControl.GetShowScrollBars: Boolean;
+begin
+ Result := FMemo.ShowScrollBars;
+end;
+
+function TfrxMemoControl.GetWordWrap: Boolean;
+begin
+ Result := FMemo.WordWrap;
+end;
+
+procedure TfrxMemoControl.SetLines(const Value: TStrings);
+begin
+ FMemo.Lines := Value;
+end;
+
+procedure TfrxMemoControl.SetMaxLength(const Value: Integer);
+begin
+ FMemo.MaxLength := Value;
+end;
+
+procedure TfrxMemoControl.SetReadOnly(const Value: Boolean);
+begin
+ FMemo.ReadOnly := Value;
+end;
+
+procedure TfrxMemoControl.SetShowScrollBars(const Value: boolean);
+begin
+ FMemo.ShowScrollBars := Value;
+end;
+
+procedure TfrxMemoControl.SetWordWrap(const Value: Boolean);
+begin
+ FMemo.WordWrap := Value;
+end;
+
+
+{ TfrxButtonControl }
+
+constructor TfrxButtonControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FButton := TButton.Create(nil);
+ InitControl(FButton);
+
+ Width := 75;
+ Height := 25;
+end;
+
+class function TfrxButtonControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obButton');
+end;
+
+function TfrxButtonControl.GetCancel: Boolean;
+begin
+ Result := FButton.Cancel;
+end;
+
+function TfrxButtonControl.GetDefault: Boolean;
+begin
+ Result := FButton.Default;
+end;
+
+function TfrxButtonControl.GetModalResult: TModalResult;
+begin
+ Result := FButton.ModalResult;
+end;
+
+procedure TfrxButtonControl.SetCancel(const Value: Boolean);
+begin
+ FButton.Cancel := Value;
+end;
+
+procedure TfrxButtonControl.SetDefault(const Value: Boolean);
+begin
+ FButton.Default := Value;
+end;
+
+procedure TfrxButtonControl.SetModalResult(const Value: TModalResult);
+begin
+ FButton.ModalResult := Value;
+end;
+
+function TfrxButtonControl.GetWordWrap: Boolean;
+begin
+ Result := FButton.WordWrap;
+end;
+
+procedure TfrxButtonControl.SetWordWrap(const Value: Boolean);
+begin
+ FButton.WordWrap := Value;
+end;
+
+{ TfrxCheckBoxControl }
+
+constructor TfrxCheckBoxControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FCheckBox := TCheckBox.Create(nil);
+ FCheckBox.OnChange := DoOnChange;
+ InitControl(FCheckBox);
+
+ Width := 97;
+ Height := 17;
+end;
+
+class function TfrxCheckBoxControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obChBoxC');
+end;
+
+function TfrxCheckBoxControl.GetChecked: Boolean;
+begin
+ Result := FCheckBox.IsChecked;
+end;
+
+procedure TfrxCheckBoxControl.SetChecked(const Value: Boolean);
+begin
+ FCheckBox.IsChecked := Value;
+end;
+
+function TfrxCheckBoxControl.GetWordWrap: Boolean;
+begin
+ Result := FCheckBox.WordWrap;
+end;
+
+procedure TfrxCheckBoxControl.SetWordWrap(const Value: Boolean);
+begin
+ FCheckBox.WordWrap := Value;
+end;
+
+procedure TfrxCheckBoxControl.DoOnChange(Sender: TObject);
+begin
+ if Report <> nil then
+ Report.DoNotifyEvent(Self, FOnChange, True);
+end;
+
+{ TfrxRadioButtonControl }
+
+constructor TfrxRadioButtonControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FRadioButton := TRadioButton.Create(nil);
+ FRadioButton.OnChange := DoOnChange;
+ InitControl(FRadioButton);
+
+ Width := 113;
+ Height := 17;
+end;
+
+class function TfrxRadioButtonControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obRButton');
+end;
+
+function TfrxRadioButtonControl.GetChecked: Boolean;
+begin
+ Result := FRadioButton.IsChecked;
+end;
+
+procedure TfrxRadioButtonControl.SetChecked(const Value: Boolean);
+begin
+ FRadioButton.IsChecked := Value;
+end;
+
+function TfrxRadioButtonControl.GetWordWrap: Boolean;
+begin
+ Result := FRadioButton.WordWrap;
+end;
+
+procedure TfrxRadioButtonControl.SetWordWrap(const Value: Boolean);
+begin
+ FRadioButton.WordWrap := Value;
+end;
+
+procedure TfrxRadioButtonControl.DoOnChange(Sender: TObject);
+begin
+ if Report <> nil then
+ Report.DoNotifyEvent(Self, FOnChange, True);
+end;
+
+
+{ TfrxListBoxControl }
+
+constructor TfrxListBoxControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FListBox := TListBox.Create(AOwner);
+ InitControl(FListBox);
+ Width := 121;
+ Height := 97;
+end;
+
+destructor TfrxListBoxControl.Destroy;
+begin
+ inherited;
+end;
+
+class function TfrxListBoxControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obLBox');
+end;
+
+function TfrxListBoxControl.GetItems: TStrings;
+begin
+ Result := FListBox.Items;
+end;
+
+function TfrxListBoxControl.GetItemIndex: Integer;
+begin
+ Result := FListBox.ItemIndex;
+end;
+
+procedure TfrxListBoxControl.SetItems(const Value: TStrings);
+begin
+ FListBox.Items := Value;
+end;
+
+procedure TfrxListBoxControl.SetItemIndex(const Value: Integer);
+begin
+ FListBox.ItemIndex := Value;
+end;
+
+
+{ TfrxComboBoxControl }
+
+constructor TfrxComboBoxControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FComboBox := TComboBox.Create(nil);
+ FComboBox.OnChange := DoOnChange;
+ InitControl(FComboBox);
+
+ Width := 145;
+ Height := 21;
+end;
+
+class function TfrxComboBoxControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obCBox');
+end;
+
+function TfrxComboBoxControl.GetItems: TStrings;
+begin
+ Result := FComboBox.Items;
+end;
+
+function TfrxComboBoxControl.GetItemIndex: Integer;
+begin
+ Result := FComboBox.ItemIndex;
+end;
+
+{function TfrxComboBoxControl.GetStyle: TComboBoxStyle;
+begin
+ Result := FComboBox.Style;
+end; }
+
+function TfrxComboBoxControl.GetText: String;
+begin
+ Result := FComboBox.Items.Text;
+end;
+
+procedure TfrxComboBoxControl.SetItems(const Value: TStrings);
+begin
+ FComboBox.Items := Value;
+end;
+
+procedure TfrxComboBoxControl.SetItemIndex(const Value: Integer);
+begin
+ FComboBox.ItemIndex := Value;
+end;
+
+{procedure TfrxComboBoxControl.SetStyle(const Value: TComboBoxStyle);
+begin
+ FComboBox.Style := Value;
+end; }
+
+procedure TfrxComboBoxControl.SetText(const Value: String);
+begin
+ FComboBox.Items.Text := Value;
+end;
+
+procedure TfrxComboBoxControl.DoOnChange(Sender: TObject);
+begin
+ if Report <> nil then
+ Report.DoNotifyEvent(Self, FOnChange, True);
+end;
+
+
+{ TfrxDateEditControl }
+
+constructor TfrxDateEditControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FDateEdit := TCalendarBox.Create(nil);
+ //FDateEdit.OnChange := DoOnChange;
+ //FDateEdit.OnDropDown := DropDown;
+ InitControl(FDateEdit);
+
+ Width := 145;
+ Height := 21;
+end;
+
+class function TfrxDateEditControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obDateEdit');
+end;
+
+function TfrxDateEditControl.GetDate: TDate;
+begin
+ Result := FDateEdit.Date;
+end;
+
+function TfrxDateEditControl.GetTime: TTime;
+begin
+ Result := Now;
+end;
+
+{function TfrxDateEditControl.GetDateFormat: TDTDateFormat;
+begin
+ Result := FDateEdit.DateFormat;
+end;
+
+function TfrxDateEditControl.GetKind: TDateTimeKind;
+begin
+ Result := FDateEdit.Kind;
+end; }
+
+procedure TfrxDateEditControl.SetDate(const Value: TDate);
+begin
+ FDateEdit.Date := Value;
+end;
+
+procedure TfrxDateEditControl.SetTime(const Value: TTime);
+begin
+ //FDateEdit.Time := Value;
+end;
+{
+procedure TfrxDateEditControl.SetDateFormat(const Value: TDTDateFormat);
+begin
+ FDateEdit.DateFormat := Value;
+end;
+
+procedure TfrxDateEditControl.SetKind(const Value: TDateTimeKind);
+begin
+ FDateEdit.Kind := Value;
+end; }
+
+procedure TfrxDateEditControl.DoOnChange(Sender: TObject);
+begin
+ if Report <> nil then
+ Report.DoNotifyEvent(Self, FOnChange, True);
+end;
+
+
+procedure TfrxDateEditControl.DropDown(Sender: TObject);
+begin
+//
+end;
+
+{ TfrxImageControl }
+
+constructor TfrxImageControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FImage := TImage.Create(nil);
+ InitControl(FImage);
+
+ Width := 100;
+ Height := 100;
+end;
+
+class function TfrxImageControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obImageC');
+end;
+
+function TfrxImageControl.GetAutoSize: Boolean;
+begin
+ Result := False;
+end;
+
+function TfrxImageControl.GetCenter: Boolean;
+begin
+ Result := False;
+end;
+
+function TfrxImageControl.GetPicture: TBitmap;
+begin
+ Result := FImage.Bitmap;
+end;
+
+function TfrxImageControl.GetStretch: Boolean;
+begin
+ Result := False;
+end;
+
+procedure TfrxImageControl.SetAutoSize(const Value: Boolean);
+begin
+ //FImage.AutoSize := Value;
+end;
+
+procedure TfrxImageControl.SetCenter(const Value: Boolean);
+begin
+ //FImage.Center := Value;
+end;
+
+procedure TfrxImageControl.SetPicture(const Value: TBitmap);
+begin
+ FImage.Bitmap.Assign(Value);
+end;
+
+procedure TfrxImageControl.SetStretch(const Value: Boolean);
+begin
+ //FImage.Stretch := Value;
+end;
+
+
+{ TfrxBevelControl }
+
+constructor TfrxBevelControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FBevel := TPanel.Create(nil);
+ InitControl(FBevel);
+
+ Width := 50;
+ Height := 50;
+end;
+
+class function TfrxBevelControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obBevel');
+end;
+
+{function TfrxBevelControl.GetBevelShape: TBevelShape;
+begin
+ Result := FBevel.Shape;
+end;
+
+function TfrxBevelControl.GetBevelStyle: TBevelStyle;
+begin
+ Result := FBevel.Style;
+end;
+
+procedure TfrxBevelControl.SetBevelShape(const Value: TBevelShape);
+begin
+ FBevel.Shape := Value;
+end;
+
+procedure TfrxBevelControl.SetBevelStyle(const Value: TBevelStyle);
+begin
+ FBevel.Style := Value;
+end; }
+
+
+{ TfrxPanelControl }
+
+constructor TfrxPanelControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FPanel := TPanel.Create(nil);
+ InitControl(FPanel);
+ Width := 185;
+ Height := 41;
+end;
+
+class function TfrxPanelControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obPanel');
+end;
+
+function TfrxPanelControl.GetAlignment: TAlignment;
+begin
+ Result := TAlignment.taRightJustify;
+end;
+
+
+function TfrxPanelControl.GetBevelWidth: Integer;
+begin
+ Result := 0;
+end;
+
+procedure TfrxPanelControl.SetAlignment(const Value: TAlignment);
+begin
+ //FPanel.Alignment := Value;
+end;
+
+
+
+procedure TfrxPanelControl.SetBevelWidth(const Value: Integer);
+begin
+ //FPanel.BevelWidth := Value;
+end;
+
+
+{ TfrxGroupBoxControl }
+
+constructor TfrxGroupBoxControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FGroupBox := TGroupBox.Create(nil);
+ InitControl(FGroupBox);
+
+ Width := 185;
+ Height := 105;
+end;
+
+class function TfrxGroupBoxControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obGrBox');
+end;
+
+
+{ TfrxBitBtnControl }
+
+constructor TfrxBitBtnControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FBitBtn := TfrxToolButton.Create(nil);
+ InitControl(FBitBtn);
+
+ Width := 75;
+ Height := 25;
+end;
+
+class function TfrxBitBtnControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obBBtn');
+end;
+
+function TfrxBitBtnControl.GetGlyph: TBitmap;
+begin
+ Result := FBitBtn.Bitmap;
+end;
+
+{function TfrxBitBtnControl.GetKind: TBitBtnKind;
+begin
+ Result := FBitBtn.Kind;
+end;
+
+function TfrxBitBtnControl.GetLayout: TButtonLayout;
+begin
+ Result := FBitBtn.Layout;
+end; }
+
+function TfrxBitBtnControl.GetMargin: Integer;
+begin
+ Result := 0;
+end;
+
+function TfrxBitBtnControl.GetModalResult: TModalResult;
+begin
+ Result := FBitBtn.ModalResult;
+end;
+
+function TfrxBitBtnControl.GetNumGlyphs: Integer;
+begin
+ Result := 0;
+end;
+
+function TfrxBitBtnControl.GetSpacing: Integer;
+begin
+ Result := 0;
+end;
+
+function TfrxBitBtnControl.GetWordWrap: Boolean;
+begin
+ Result := FBitBtn.WordWrap;
+end;
+
+procedure TfrxBitBtnControl.SetGlyph(const Value: TBitmap);
+begin
+ //FBitBtn.Glyph := Value;
+end;
+
+{procedure TfrxBitBtnControl.SetKind(const Value: TBitBtnKind);
+begin
+ FBitBtn.Kind := Value;
+end;
+
+procedure TfrxBitBtnControl.SetLayout(const Value: TButtonLayout);
+begin
+ FBitBtn.Layout := Value;
+end; }
+
+procedure TfrxBitBtnControl.SetMargin(const Value: Integer);
+begin
+ //FBitBtn.Margin := Value;
+end;
+
+procedure TfrxBitBtnControl.SetModalResult(const Value: TModalResult);
+begin
+ FBitBtn.ModalResult := Value;
+end;
+
+procedure TfrxBitBtnControl.SetNumGlyphs(const Value: Integer);
+begin
+ //FBitBtn.NumGlyphs := Value;
+end;
+
+procedure TfrxBitBtnControl.SetSpacing(const Value: Integer);
+begin
+ //FBitBtn.Spacing := Value;
+end;
+
+procedure TfrxBitBtnControl.SetWordWrap(const Value: Boolean);
+begin
+ FBitBtn.WordWrap := Value;
+end;
+
+{ TfrxSpeedButtonControl }
+{
+constructor TfrxSpeedButtonControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FSpeedButton := TSpeedButton.Create(nil);
+ InitControl(FSpeedButton);
+
+ Width := 22;
+ Height := 22;
+end;
+
+class function TfrxSpeedButtonControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obSBtn');
+end;
+
+function TfrxSpeedButtonControl.GetAllowAllUp: Boolean;
+begin
+ //Result := FSpeedButton.AllowAllUp;
+end;
+
+function TfrxSpeedButtonControl.GetDown: Boolean;
+begin
+ // Result := FSpeedButton.Down;
+end;
+
+function TfrxSpeedButtonControl.GetFlat: Boolean;
+begin
+ //Result := FSpeedButton.Flat;
+end;
+
+function TfrxSpeedButtonControl.GetGlyph: TBitmap;
+begin
+ // Result := FSpeedButton.Glyph;
+end;
+
+function TfrxSpeedButtonControl.GetGroupIndex: Integer;
+begin
+ //Result := FSpeedButton.GroupIndex;
+end;
+
+//function TfrxSpeedButtonControl.GetLayout: TButtonLayout;
+//begin
+// //Result := FSpeedButton.Layout;
+//end;
+
+function TfrxSpeedButtonControl.GetMargin: Integer;
+begin
+ //Result := FSpeedButton.Margin;
+end;
+
+function TfrxSpeedButtonControl.GetSpacing: Integer;
+begin
+ //Result := FSpeedButton.Spacing;
+end;
+
+procedure TfrxSpeedButtonControl.SetAllowAllUp(const Value: Boolean);
+begin
+ // FSpeedButton.AllowAllUp := Value;
+end;
+
+procedure TfrxSpeedButtonControl.SetDown(const Value: Boolean);
+begin
+ //FSpeedButton.Down := Value;
+end;
+
+procedure TfrxSpeedButtonControl.SetFlat(const Value: Boolean);
+begin
+ //FSpeedButton.Flat := Value;
+end;
+
+procedure TfrxSpeedButtonControl.SetGlyph(const Value: TBitmap);
+begin
+ //FSpeedButton.Glyph := Value;
+end;
+
+procedure TfrxSpeedButtonControl.SetGroupIndex(const Value: Integer);
+begin
+ //FSpeedButton.GroupIndex := Value;
+end;
+
+//procedure TfrxSpeedButtonControl.SetLayout(const Value: TButtonLayout);
+//begin
+// FSpeedButton.Layout := Value;
+//end;
+
+procedure TfrxSpeedButtonControl.SetMargin(const Value: Integer);
+begin
+ //FSpeedButton.Margin := Value;
+end;
+
+procedure TfrxSpeedButtonControl.SetSpacing(const Value: Integer);
+begin
+ //FSpeedButton.Spacing := Value;
+end;
+}
+
+{ TfrxMaskEditControl }
+ {
+constructor TfrxMaskEditControl.Create(AOwner: TComponent);
+begin
+ FMaskEdit := TMaskEdit.Create(nil);
+ FCustomEdit := FMaskEdit;
+ inherited;
+
+ Width := 121;
+ Height := 21;
+end;
+
+class function TfrxMaskEditControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obMEdit');
+end;
+
+function TfrxMaskEditControl.GetEditMask: String;
+begin
+ Result := FMaskEdit.EditMask;
+end;
+
+procedure TfrxMaskEditControl.SetEditMask(const Value: String);
+begin
+ FMaskEdit.EditMask := Value;
+end;
+
+ }
+{ TfrxCheckListBoxControl }
+ {
+constructor TfrxCheckListBoxControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FCheckListBox := TCheckListBox.Create(nil);
+ InitControl(FCheckListBox);
+
+ Width := 121;
+ Height := 97;
+end;
+
+class function TfrxCheckListBoxControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obChLB');
+end;
+
+function TfrxCheckListBoxControl.GetAllowGrayed: Boolean;
+begin
+ Result := FCheckListBox.AllowGrayed;
+end;
+
+function TfrxCheckListBoxControl.GetItems: TStrings;
+begin
+ Result := FCheckListBox.Items;
+end;
+
+function TfrxCheckListBoxControl.GetSorted: Boolean;
+begin
+ Result := FCheckListBox.Sorted;
+end;
+
+function TfrxCheckListBoxControl.GetChecked(Index: Integer): Boolean;
+begin
+ Result := FCheckListBox.Checked[Index];
+end;
+
+function TfrxCheckListBoxControl.GetState(Index: Integer): TCheckBoxState;
+begin
+ Result := FCheckListBox.State[Index];
+end;
+
+procedure TfrxCheckListBoxControl.SetAllowGrayed(const Value: Boolean);
+begin
+ FCheckListBox.AllowGrayed := Value;
+end;
+
+procedure TfrxCheckListBoxControl.SetItems(const Value: TStrings);
+begin
+ FCheckListBox.Items := Value;
+end;
+
+procedure TfrxCheckListBoxControl.SetSorted(const Value: Boolean);
+begin
+ FCheckListBox.Sorted := Value;
+end;
+
+procedure TfrxCheckListBoxControl.SetChecked(Index: Integer; const Value: Boolean);
+begin
+ FCheckListBox.Checked[Index] := Value;
+end;
+
+procedure TfrxCheckListBoxControl.SetState(Index: Integer; const Value: TCheckBoxState);
+begin
+ FCheckListBox.State[Index] := Value;
+end;
+
+function TfrxCheckListBoxControl.GetItemIndex: Integer;
+begin
+ Result := FCheckListBox.ItemIndex;
+end;
+
+procedure TfrxCheckListBoxControl.SetItemIndex(const Value: Integer);
+begin
+ FCheckListBox.ItemIndex := Value;
+end;
+ }
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxDialogControls, TFmxObject);
+ frxObjects.RegisterObject1(TfrxLabelControl, nil, '', '', 0, 112);
+ frxObjects.RegisterObject1(TfrxEditControl, nil, '', '', 0, 113);
+ frxObjects.RegisterObject1(TfrxMemoControl, nil, '', '', 0, 114);
+ frxObjects.RegisterObject1(TfrxButtonControl, nil, '', '', 0, 115);
+ frxObjects.RegisterObject1(TfrxCheckBoxControl, nil, '', '', 0, 116);
+ frxObjects.RegisterObject1(TfrxRadioButtonControl, nil, '', '', 0, 117);
+ frxObjects.RegisterObject1(TfrxListBoxControl, nil, '', '', 0, 118);
+ frxObjects.RegisterObject1(TfrxComboBoxControl, nil, '', '', 0, 119);
+ frxObjects.RegisterObject1(TfrxPanelControl, nil, '', '', 0, 144);
+ frxObjects.RegisterObject1(TfrxGroupBoxControl, nil, '', '', 0, 143);
+
+ frxObjects.RegisterObject1(TfrxDateEditControl, nil, '', '', 0, 145);
+ frxObjects.RegisterObject1(TfrxImageControl, nil, '', '', 0, 103);
+ //frxObjects.RegisterObject1(TfrxBevelControl, nil, '', '', 0, 33);
+ //frxObjects.RegisterObject1(TfrxBitBtnControl, nil, '', '', 0, 115);
+ //frxObjects.RegisterObject1(TfrxSpeedButtonControl, nil, '', '', 0, 115);
+{ frxObjects.RegisterObject1(TfrxMaskEditControl, nil, '', '', 0, 47);
+ frxObjects.RegisterObject1(TfrxCheckListBoxControl, nil, '', '', 0, 48); }
+
+
+
+end.
diff --git a/LibD28/FMX.frxDCtrlRTTI.pas b/LibD28/FMX.frxDCtrlRTTI.pas
new file mode 100644
index 0000000..bdb19d2
--- /dev/null
+++ b/LibD28/FMX.frxDCtrlRTTI.pas
@@ -0,0 +1,130 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Dialog controls RTTI }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDCtrlRTTI;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, System.SysUtils, FMX.Forms, FMX.fs_iinterpreter, FMX.fs_iformsrtti,
+ FMX.frxDCtrl, FMX.frxClassRTTI, System.Variants, System.Types;
+
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+// function CallMethod(Instance: TObject; ClassType: TClass;
+// const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddClass(TfrxLabelControl, 'TfrxDialogControl');
+ AddClass(TfrxEditControl, 'TfrxDialogControl');
+ AddClass(TfrxMemoControl, 'TfrxDialogControl');
+ AddClass(TfrxButtonControl, 'TfrxDialogControl');
+ AddClass(TfrxCheckBoxControl, 'TfrxDialogControl');
+ AddClass(TfrxRadioButtonControl, 'TfrxDialogControl');
+ with AddClass(TfrxListBoxControl, 'TfrxDialogControl') do
+ AddProperty('ItemIndex', 'Integer', GetProp, SetProp);
+ AddClass(TfrxComboBoxControl, 'TfrxDialogControl');
+ AddClass(TfrxDateEditControl, 'TfrxDialogControl');
+ AddClass(TfrxImageControl, 'TfrxDialogControl');
+ AddClass(TfrxBevelControl, 'TfrxDialogControl');
+ AddClass(TfrxPanelControl, 'TfrxDialogControl');
+ AddClass(TfrxGroupBoxControl, 'TfrxDialogControl');
+ AddClass(TfrxBitBtnControl, 'TfrxDialogControl');
+// AddClass(TfrxSpeedButtonControl, 'TfrxDialogControl');
+ //AddClass(TfrxMaskEditControl, 'TfrxDialogControl');
+ {with AddClass(TfrxCheckListBoxControl, 'TfrxDialogControl') do
+ begin
+ AddIndexProperty('Checked', 'Integer', 'Boolean', CallMethod);
+ AddIndexProperty('State', 'Integer', 'TCheckBoxState', CallMethod);
+ AddProperty('ItemIndex', 'Integer', GetProp, SetProp);
+ end; }
+ end;
+end;
+
+//function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+// const MethodName: String; Caller: TfsMethodHelper): Variant;
+//begin
+// Result := 0;
+//
+// {if ClassType = TfrxCheckListBoxControl then
+// begin
+// if MethodName = 'CHECKED.GET' then
+// Result := TfrxCheckListBoxControl(Instance).Checked[Caller.Params[0]]
+// else if MethodName = 'CHECKED.SET' then
+// TfrxCheckListBoxControl(Instance).Checked[Caller.Params[0]] := Caller.Params[1]
+// else if MethodName = 'STATE.GET' then
+// Result := TfrxCheckListBoxControl(Instance).State[Caller.Params[0]]
+// else if MethodName = 'STATE.SET' then
+// TfrxCheckListBoxControl(Instance).State[Caller.Params[0]] := Caller.Params[1]
+// end }
+//end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TfrxListBoxControl then
+ begin
+ if PropName = 'ITEMINDEX' then
+ Result := TfrxListBoxControl(Instance).ItemIndex
+ end
+ { else if ClassType = TfrxCheckListBoxControl then
+ begin
+ if PropName = 'ITEMINDEX' then
+ Result := TfrxCheckListBoxControl(Instance).ItemIndex
+ end }
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TfrxListBoxControl then
+ begin
+ if PropName = 'ITEMINDEX' then
+ TfrxListBoxControl(Instance).ItemIndex := Value;
+ end
+ {else if ClassType = TfrxCheckListBoxControl then
+ begin
+ if PropName = 'ITEMINDEX' then
+ TfrxCheckListBoxControl(Instance).ItemIndex := Value;
+ end }
+end;
+
+
+initialization
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/FMX.frxDMPClass.pas b/LibD28/FMX.frxDMPClass.pas
new file mode 100644
index 0000000..525d192
--- /dev/null
+++ b/LibD28/FMX.frxDMPClass.pas
@@ -0,0 +1,491 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ DotMatrix printers stuff }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDMPClass;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Types, System.Variants,
+ FMX.frxClass;
+
+
+type
+ TfrxDMPFontStyle = (fsxBold, fsxItalic, fsxUnderline, fsxSuperScript,
+ fsxSubScript, fsxCondensed, fsxWide, fsx12cpi, fsx15cpi);
+ TfrxDMPFontStyles = set of TfrxDMPFontStyle;
+
+ TfrxDMPMemoView = class(TfrxCustomMemoView)
+ private
+ FFontStyle: TfrxDMPFontStyles;
+ FTruncOutboundText: Boolean;
+ procedure SetFontStyle(const Value: TfrxDMPFontStyles);
+ function IsFontStyleStored: Boolean;
+ protected
+ procedure DrawFrame; override;
+ procedure SetLeft(Value: Double); override;
+ procedure SetTop(Value: Double); override;
+ procedure SetWidth(Value: Double); override;
+ procedure SetHeight(Value: Double); override;
+ procedure SetParentFont(const Value: Boolean); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ procedure ResetFontOptions;
+ procedure SetBoundsDirect(ALeft, ATop, AWidth, AHeight: Double);
+ function CalcHeight: Double; override;
+ function CalcWidth: Double; override;
+ function Diff(AComponent: TfrxComponent): String; override;
+ function GetoutBoundText: String;
+ published
+ property AutoWidth;
+ property AllowExpressions;
+ property DataField;
+ property DataSet;
+ property DataSetName;
+ property DisplayFormat;
+ property ExpressionDelimiters;
+ property FlowTo;
+ property FontStyle: TfrxDMPFontStyles read FFontStyle write SetFontStyle
+ stored IsFontStyleStored;
+ property Frame;
+ property HAlign;
+ property HideZeros;
+ property Memo;
+ property ParentFont;
+ property RTLReading;
+ property SuppressRepeated;
+ property WordWrap;
+ property TruncOutboundText: Boolean read FTruncOutboundText write FTruncOutboundText;
+ property VAlign;
+ end;
+
+ TfrxDMPLineView = class(TfrxCustomLineView)
+ private
+ FFontStyle: TfrxDMPFontStyles;
+ procedure SetFontStyle(const Value: TfrxDMPFontStyles);
+ function IsFontStyleStored: Boolean;
+ protected
+ procedure SetLeft(Value: Double); override;
+ procedure SetTop(Value: Double); override;
+ procedure SetWidth(Value: Double); override;
+ procedure SetParentFont(const Value: Boolean); override;
+ public
+ class function GetDescription: String; override;
+ function Diff(AComponent: TfrxComponent): String; override;
+ published
+ property FontStyle: TfrxDMPFontStyles read FFontStyle write SetFontStyle
+ stored IsFontStyleStored;
+ property ParentFont;
+ end;
+
+ TfrxDMPCommand = class(TfrxView)
+ private
+ FCommand: String;
+ protected
+ procedure SetLeft(Value: Double); override;
+ procedure SetTop(Value: Double); override;
+ public
+ class function GetDescription: String; override;
+ function Diff(AComponent: TfrxComponent): String; override;
+ function ToChr: String;
+ published
+ property Command: String read FCommand write FCommand;
+ end;
+
+ TfrxDMPPage = class(TfrxReportPage)
+ private
+ FFontStyle: TfrxDMPFontStyles;
+ procedure SetFontStyle(const Value: TfrxDMPFontStyles);
+ protected
+ procedure SetPaperHeight(const Value: Double); override;
+ procedure SetPaperWidth(const Value: Double); override;
+ procedure SetPaperSize(const Value: Integer); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure SetDefaults; override;
+ procedure ResetFontOptions;
+ published
+ property FontStyle: TfrxDMPFontStyles read FFontStyle write SetFontStyle;
+ end;
+
+
+implementation
+
+uses
+ FMX.frxRes, FMX.frxDsgnIntf, FMX.frxXML, FMX.frxFMX;
+
+
+function DiffFontStyle(f: TfrxDMPFontStyles): String;
+var
+ fs: Integer;
+begin
+ fs := 0;
+ if fsxBold in f then fs := 1;
+ if fsxItalic in f then fs := fs or 2;
+ if fsxUnderline in f then fs := fs or 4;
+ if fsxSuperScript in f then fs := fs or 8;
+ if fsxSubScript in f then fs := fs or 16;
+ if fsxCondensed in f then fs := fs or 32;
+ if fsxWide in f then fs := fs or 64;
+ if fsx12cpi in f then fs := fs or 128;
+ if fsx15cpi in f then fs := fs or 256;
+ Result := ' FontStyle="' + String(IntToStr(fs)) + '"';
+end;
+
+
+{ TfrxDMPMemoView }
+
+constructor TfrxDMPMemoView.Create(AOwner: TComponent);
+begin
+ inherited;
+ ResetFontOptions;
+end;
+
+class function TfrxDMPMemoView.GetDescription: String;
+begin
+ Result := frxResources.Get('obDMPText');
+end;
+
+procedure TfrxDMPMemoView.ResetFontOptions;
+begin
+ Font.OnChange := nil;
+ Font.Name := 'Courier New';
+ Font.Size := 12;
+ Font.Style := [];
+ if fsxBold in FFontStyle then
+ Font.Style := Font.Style + [fsBold];
+ if fsxItalic in FFontStyle then
+ Font.Style := Font.Style + [fsItalic];
+ if fsxUnderline in FFontStyle then
+ Font.Style := Font.Style + [fsUnderline];
+ CharSpacing := 0;
+ LineSpacing := 1;
+ GapX := 0;
+ GapY := 0;
+end;
+
+procedure TfrxDMPMemoView.SetHeight(Value: Double);
+begin
+ Value := Round(Value / fr1CharY) * fr1CharY;
+ inherited;
+end;
+
+procedure TfrxDMPMemoView.SetLeft(Value: Double);
+begin
+ if Align = baRight then
+ Value := Trunc(Value / fr1CharX) * fr1CharX else
+ Value := Round(Value / fr1CharX) * fr1CharX;
+ inherited;
+end;
+
+procedure TfrxDMPMemoView.SetTop(Value: Double);
+begin
+ Value := Round(Value / fr1CharY) * fr1CharY;
+ inherited;
+end;
+
+procedure TfrxDMPMemoView.SetWidth(Value: Double);
+begin
+ Value := Round(Value / fr1CharX) * fr1CharX;
+ inherited;
+end;
+
+procedure TfrxDMPMemoView.SetFontStyle(const Value: TfrxDMPFontStyles);
+begin
+ FFontStyle := Value;
+ ParentFont := False;
+ ResetFontOptions;
+end;
+
+procedure TfrxDMPMemoView.SetParentFont(const Value: Boolean);
+begin
+ inherited;
+ if Value then
+ if Page is TfrxDMPPage then
+ FFontStyle := TfrxDMPPage(Page).FontStyle;
+end;
+
+function TfrxDMPMemoView.IsFontStyleStored: Boolean;
+begin
+ Result := not ParentFont;
+end;
+
+procedure TfrxDMPMemoView.DrawFrame;
+begin
+ FX := Round((AbsLeft - fr1CharX / 2) * FScaleX + FOffsetX);
+ FY := Round((AbsTop - fr1CharY / 2) * FScaleY + FOffsetY);
+ FX1 := Round((AbsLeft + Width + fr1CharX / 2) * FScaleX + FOffsetX);
+ FY1 := Round((AbsTop + Height + fr1CharY / 2) * FScaleY + FOffsetY);
+ inherited;
+end;
+
+function TfrxDMPMemoView.CalcHeight: Double;
+begin
+ Result := inherited CalcHeight;
+ Result := Round(Result / fr1CharY) * fr1CharY;
+end;
+
+function TfrxDMPMemoView.CalcWidth: Double;
+begin
+ Result := inherited CalcWidth;
+ Result := Round(Result / fr1CharX) * fr1CharX;
+end;
+
+function TfrxDMPMemoView.Diff(AComponent: TfrxComponent): String;
+var
+ m: TfrxDMPMemoView;
+begin
+ Result := inherited Diff(AComponent);
+ m := TfrxDMPMemoView(AComponent);
+ if FFontStyle <> m.FontStyle then
+ Result := Result + DiffFontStyle(FFontStyle);
+end;
+
+procedure TfrxDMPMemoView.SetBoundsDirect(ALeft, ATop, AWidth, AHeight: Double);
+begin
+ inherited SetLeft(ALeft);
+ inherited SetTop(ATop);
+ inherited SetWidth(AWidth);
+ inherited SetHeight(AHeight);
+end;
+
+function TfrxDMPMemoView.GetoutBoundText: String;
+var
+ idx, mH: Integer;
+begin
+ Result := '';
+ mH := Round(Height/fr1CharY);
+ for idx := 0 to Memo.Count - 1 do
+ if mH >= idx + 1 then
+ begin
+ Result := Result + Copy(Memo.Strings[idx], 1, Round(Width/fr1CharX)) + #13#10;
+ end;
+end;
+
+{ TfrxDMPLineView }
+
+class function TfrxDMPLineView.GetDescription: String;
+begin
+ Result := frxResources.Get('obDMPLine');
+end;
+
+procedure TfrxDMPLineView.SetLeft(Value: Double);
+begin
+ if Value < 0 then
+ Value := Trunc(Value / fr1CharX) * fr1CharX - fr1CharX / 2
+ else if Align = baRight then
+ Value := Round(Value / fr1CharX) * fr1CharX - fr1CharX / 2
+ else
+ Value := Trunc(Value / fr1CharX) * fr1CharX + fr1CharX / 2;
+ inherited;
+end;
+
+procedure TfrxDMPLineView.SetTop(Value: Double);
+begin
+ Value := Trunc(Value / fr1CharY) * fr1CharY + fr1CharY / 2;
+ inherited;
+end;
+
+procedure TfrxDMPLineView.SetWidth(Value: Double);
+begin
+ if Align = baWidth then
+ Value := Trunc(Value / fr1CharX) * fr1CharX
+ else
+ Value := Round(Value / fr1CharX) * fr1CharX;
+ inherited;
+end;
+
+procedure TfrxDMPLineView.SetFontStyle(const Value: TfrxDMPFontStyles);
+begin
+ FFontStyle := Value;
+ ParentFont := False;
+end;
+
+procedure TfrxDMPLineView.SetParentFont(const Value: Boolean);
+begin
+ inherited;
+ if Value then
+ if Page is TfrxDMPPage then
+ FFontStyle := TfrxDMPPage(Page).FontStyle;
+end;
+
+function TfrxDMPLineView.IsFontStyleStored: Boolean;
+begin
+ Result := not ParentFont;
+end;
+
+function TfrxDMPLineView.Diff(AComponent: TfrxComponent): String;
+var
+ l: TfrxDMPLineView;
+begin
+ Result := inherited Diff(AComponent);
+ l := TfrxDMPLineView(AComponent);
+ if FFontStyle <> l.FontStyle then
+ Result := Result + DiffFontStyle(FFontStyle);
+end;
+
+
+{ TfrxDMPCommand }
+
+class function TfrxDMPCommand.GetDescription: String;
+begin
+ Result := frxResources.Get('obDMPCmd');
+end;
+
+procedure TfrxDMPCommand.SetLeft(Value: Double);
+begin
+ Value := Round(Value / fr1CharX) * fr1CharX;
+ inherited;
+end;
+
+procedure TfrxDMPCommand.SetTop(Value: Double);
+begin
+ Value := Round(Value / fr1CharY) * fr1CharY;
+ inherited;
+end;
+
+function TfrxDMPCommand.Diff(AComponent: TfrxComponent): String;
+begin
+ Result := inherited Diff(AComponent);
+ if FCommand <> TfrxDMPCommand(AComponent).Command then
+ Result := Result + frxStrToXML(FCommand);
+end;
+
+function TfrxDMPCommand.ToChr: String;
+var
+ i: Integer;
+ s, s1: String;
+begin
+ Result := '';
+ s := FCommand;
+ s1 := '';
+ if Pos('#', s) = 1 then
+ begin
+ s := s + '#';
+ for i := 2 to Length(s) do
+ if s[i] = '#' then
+ begin
+ Result := Result + Chr(StrToInt(s1));
+ s1 := '';
+ end
+ else
+ s1 := s1 + s[i];
+ end
+ else
+ begin
+ for i := 1 to Length(s) do
+ begin
+ s1 := s1 + s[i];
+ if i mod 2 = 0 then
+ begin
+ Result := Result + Chr(StrToInt('$' + s1));
+ s1 := '';
+ end;
+ end;
+ end;
+end;
+
+
+{ TfrxDMPPage }
+
+constructor TfrxDMPPage.Create(AOwner: TComponent);
+begin
+ inherited;
+ ResetFontOptions;
+end;
+
+procedure TfrxDMPPage.ResetFontOptions;
+begin
+ Font.OnChange := nil;
+ Font.Name := 'Courier New';
+ Font.Size := 12;
+ Font.Style := [];
+ if fsxBold in FFontStyle then
+ Font.Style := Font.Style + [fsBold];
+ if fsxItalic in FFontStyle then
+ Font.Style := Font.Style + [fsItalic];
+ if fsxUnderline in FFontStyle then
+ Font.Style := Font.Style + [fsUnderline];
+end;
+
+procedure TfrxDMPPage.SetDefaults;
+begin
+ inherited;
+ LeftMargin := fr1CharX / fr01cm;
+ RightMargin := fr1CharX / fr01cm;
+ TopMargin := fr1CharY / fr01cm;
+ BottomMargin := fr1CharY / fr01cm;
+ FPaperWidth := Trunc(FPaperWidth * fr01cm / fr1CharX) * fr1CharX / fr01cm;
+ FPaperHeight := Trunc(FPaperHeight * fr01cm / fr1CharY) * fr1CharY / fr01cm;
+ UpdateDimensions;
+end;
+
+procedure TfrxDMPPage.SetFontStyle(const Value: TfrxDMPFontStyles);
+var
+ i: Integer;
+ l: TList;
+ c: TfrxComponent;
+begin
+ FFontStyle := Value;
+ ResetFontOptions;
+
+ l := AllObjects;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if c.ParentFont then
+ c.ParentFont := True;
+ end;
+end;
+
+procedure TfrxDMPPage.SetPaperHeight(const Value: Double);
+begin
+ inherited;
+ FPaperHeight := Round(FPaperHeight * fr01cm / fr1CharY) * fr1CharY / fr01cm;
+ UpdateDimensions;
+end;
+
+procedure TfrxDMPPage.SetPaperSize(const Value: Integer);
+begin
+ inherited;
+ FPaperWidth := Round(FPaperWidth * fr01cm / fr1CharX) * fr1CharX / fr01cm;
+ FPaperHeight := Round(FPaperHeight * fr01cm / fr1CharY) * fr1CharY / fr01cm;
+ UpdateDimensions;
+end;
+
+procedure TfrxDMPPage.SetPaperWidth(const Value: Double);
+begin
+ inherited;
+ FPaperWidth := Round(FPaperWidth * fr01cm / fr1CharX) * fr1CharX / fr01cm;
+ UpdateDimensions;
+end;
+
+
+initialization
+ RegisterFmxClasses([TfrxDMPPage]);
+ frxObjects.RegisterObject1(TfrxDMPMemoView, nil, '', '', 0, 2, [ctDMP]);
+ frxObjects.RegisterObject1(TfrxDMPLineView, nil, '', '', 0, 5, [ctDMP]);
+ frxObjects.RegisterObject1(TfrxDMPCommand, nil, '', '', 0, 21, [ctDMP]);
+
+finalization
+ UnRegisterClasses([TfrxDMPPage]);
+ frxObjects.UnRegister(TfrxDMPMemoView);
+ frxObjects.UnRegister(TfrxDMPLineView);
+ frxObjects.UnRegister(TfrxDMPCommand);
+
+
+end.
+
diff --git a/LibD28/FMX.frxDataTree.fmx b/LibD28/FMX.frxDataTree.fmx
new file mode 100644
index 0000000..4cab187
--- /dev/null
+++ b/LibD28/FMX.frxDataTree.fmx
@@ -0,0 +1,131 @@
+object frxDataTreeForm: TfrxDataTreeForm
+ Left = 0
+ Top = 0
+ Caption = 'Data Fields'
+ BorderStyle = bsNone
+ BorderIcons = []
+ ClientHeight = 697
+ ClientWidth = 254
+ Transparency = True
+ Visible = False
+ OnResize = FormResize
+ StyleLookup = 'backgroundstyle'
+ object MainDataPanel: TPanel
+ Align = alClient
+ Width = 254.000000000000000000
+ Height = 697.000000000000000000
+ OnDragEnd = MainDataPanelDragEnd
+ OnResize = FormResize
+ TabOrder = 0
+ object ClassesPn: TPanel
+ Position.Point = '(54,64)'
+ Width = 185.000000000000000000
+ Height = 261.000000000000000000
+ Visible = False
+ TabOrder = 0
+ end
+ object DataPn: TPanel
+ Position.Point = '(10,12)'
+ Width = 181.000000000000000000
+ Height = 301.000000000000000000
+ TabOrder = 1
+ object CBPanel: TPanel
+ Align = alBottom
+ Position.Point = '(0,248)'
+ Width = 181.000000000000000000
+ Height = 53.000000000000000000
+ Visible = False
+ TabOrder = 0
+ object InsFieldCB: TCheckBox
+ Position.Point = '(0,4)'
+ Width = 145.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 0
+ IsChecked = True
+ end
+ object InsCaptionCB: TCheckBox
+ Position.Point = '(0,20)'
+ Width = 145.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ object SortCB: TCheckBox
+ Position.Point = '(0,36)'
+ Width = 145.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = SortCBClick
+ TabOrder = 2
+ end
+ end
+ object NoDataL: TLabel
+ Position.Point = '(8,8)'
+ Width = 101.000000000000000000
+ Height = 41.000000000000000000
+ OnDblClick = DataTreeDblClick
+ TabOrder = 1
+ VertTextAlign = taLeading
+ end
+ end
+ object FunctionsPn: TPanel
+ Position.Point = '(38,44)'
+ Width = 185.000000000000000000
+ Height = 265.000000000000000000
+ Visible = False
+ TabOrder = 2
+ object Splitter1: TSplitter
+ Align = alBottom
+ Cursor = crVSplit
+ Position.Point = '(0,166)'
+ Width = 185.000000000000000000
+ Height = 3.000000000000000000
+ TabOrder = 0
+ MinSize = 20.000000000000000000
+ end
+ object HintPanel: TScrollBox
+ Align = alBottom
+ Position.Point = '(0,169)'
+ Width = 185.000000000000000000
+ Height = 96.000000000000000000
+ TabOrder = 1
+ object FunctionDescL: TLabel
+ Align = alClient
+ Position.Point = '(0,42)'
+ Width = 185.000000000000000000
+ Height = 54.000000000000000000
+ TabOrder = 0
+ end
+ object FunctionNameL: TLabel
+ Align = alTop
+ Width = 185.000000000000000000
+ Height = 42.000000000000000000
+ TabOrder = 1
+ Font.Style = [fsBold]
+ end
+ end
+ end
+ object VariablesPn: TPanel
+ Position.Point = '(22,28)'
+ Width = 185.000000000000000000
+ Height = 269.000000000000000000
+ Visible = False
+ TabOrder = 3
+ end
+ object Rectangle1: TRectangle
+ Align = alTop
+ Width = 254.000000000000000000
+ Height = 18.000000000000000000
+ Margins.Rect = '(2,1,0,0)'
+ Stroke.Kind = bkNone
+ object Label1: TLabel
+ Align = alClient
+ Position.Point = '(2,1)'
+ Width = 252.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 0
+ AutoSize = True
+ Text = 'Label1'
+ WordWrap = False
+ end
+ end
+ end
+end
diff --git a/LibD28/FMX.frxDataTree.pas b/LibD28/FMX.frxDataTree.pas
new file mode 100644
index 0000000..6d8b2f0
--- /dev/null
+++ b/LibD28/FMX.frxDataTree.pas
@@ -0,0 +1,765 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Data Tree tool window }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDataTree;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UiTypes, System.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.fs_xml, FMX.Types, FMX.Layouts, FMX.TreeView, FMX.frxFMX, FMX.TabControl
+, System.Variants, FMX.Objects
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+ TfrxDataTreeForm = class(TForm)
+ MainDataPanel: TPanel;
+ ClassesPn: TPanel;
+ DataPn: TPanel;
+ CBPanel: TPanel;
+ InsFieldCB: TCheckBox;
+ InsCaptionCB: TCheckBox;
+ SortCB: TCheckBox;
+ NoDataL: TLabel;
+ FunctionsPn: TPanel;
+ Splitter1: TSplitter;
+ HintPanel: TScrollBox;
+ FunctionDescL: TLabel;
+ FunctionNameL: TLabel;
+ VariablesPn: TPanel;
+ Rectangle1: TRectangle;
+ Label1: TLabel;
+ procedure FormResize(Sender: TObject);
+ //procedure DataTreeCustomDrawItem(Sender: TCustomTreeView;
+ // Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
+ procedure FunctionsTreeChange(Sender: TObject);
+ procedure DataTreeDblClick(Sender: TObject);
+ //procedure ClassesTreeExpanding(Sender: TObject; Node: TTreeNode;
+ // var AllowExpansion: Boolean);
+ //procedure ClassesTreeCustomDrawItem(Sender: TCustomTreeView;
+ // Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
+ procedure SortCBClick(Sender: TObject);
+ procedure MainDataPanelDragEnd(Sender: TObject);
+ private
+ { Private declarations }
+ FXML: TfsXMLDocument;
+ FReport: TfrxReport;
+ FUpdating: Boolean;
+ FFirstTime: Boolean;
+ DataTree: TfrxTreeView;
+ VariablesTree: TfrxTreeView;
+ FunctionsTree: TfrxTreeView;
+ ClassesTree: TfrxTreeView;
+ FTabs: TTabControl;
+
+ procedure FillClassesTree;
+ procedure FillDataTree;
+ procedure FillFunctionsTree;
+ procedure FillVariablesTree;
+ procedure TabsChange(Sender: TObject);
+ function GetCollapsedNodes: String;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure SetLastPosition(p: TPoint);
+ procedure ShowTab(Index: Integer);
+ procedure UpdateItems;
+ procedure UpdateSelection;
+ procedure UpdateSize;
+ function GetActivePage: Integer;
+ function GetFieldName: String;
+ function GetLastPosition: TPoint;
+ function IsDataField: Boolean;
+ property Report: TfrxReport read FReport write FReport;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.fs_iinterpreter, FMX.fs_itools, FMX.frxRes;
+
+type
+ THackTreeView = class(TCustomTreeView);
+
+var
+ CollapsedNodes: String;
+
+
+procedure SetImageIndex(Node: TfrxTreeViewItem; Index: Integer);
+begin
+ Node.OpenImageIndex := Index;
+ Node.CloseImageIndex := Index;
+end;
+
+
+{ TfrxDataTreeForm }
+
+constructor TfrxDataTreeForm.Create(AOwner: TComponent);
+var
+ aTabItem: TTabItem;
+begin
+ inherited;
+ //FImages := frxResources.MainButtonImages;
+ DataTree := TfrxTreeView.Create(Self);
+
+ DataTree.Parent := DataPn;
+ DataTree.Align := TAlignLayout.alClient;
+ DataTree.OnDblClick := DataTreeDblClick;
+{$IFDEF DELPHI18}
+ DataTree.DragMode := TDragMode.dmManual;
+ DataPn.Margins.Top := Rectangle1.Height;
+ DataTree.ManualDragAndDrop := True;
+{$ELSE}
+ DataTree.DragMode := TDragMode.dmAutomatic;
+{$ENDIF}
+ DataTree.SetImages(frxResources.Images);
+ DataTree.AutoCapture := False;
+
+ VariablesTree := TfrxTreeView.Create(Self);
+ VariablesTree.Parent := VariablesPn;
+ VariablesTree.Align := TAlignLayout.alClient;
+ VariablesTree.OnDblClick := DataTreeDblClick;
+{$IFDEF DELPHI18}
+ VariablesTree.DragMode := TDragMode.dmManual;
+ VariablesTree.Margins.Top := Rectangle1.Height;
+ VariablesTree.ManualDragAndDrop := True;
+{$ELSE}
+ VariablesTree.DragMode := TDragMode.dmAutomatic;
+{$ENDIF}
+ VariablesTree.SetImages(frxResources.Images);
+ VariablesTree.AutoCapture := False;
+
+ FunctionsTree := TfrxTreeView.Create(Self);
+ FunctionsTree.Parent := FunctionsPn;
+ FunctionsTree.Align := TAlignLayout.alClient;
+ FunctionsTree.OnDblClick := DataTreeDblClick;
+ FunctionsTree.OnChange := FunctionsTreeChange;
+{$IFDEF DELPHI18}
+ FunctionsTree.DragMode := TDragMode.dmManual;
+ FunctionsTree.Margins.Top := Rectangle1.Height;
+ FunctionsTree.ManualDragAndDrop := True;
+{$ELSE}
+ FunctionsTree.DragMode := TDragMode.dmAutomatic;
+{$ENDIF}
+ FunctionsTree.SetImages(frxResources.Images);
+ FunctionsTree.AutoCapture := False;
+
+ ClassesTree := TfrxTreeView.Create(Self);
+ ClassesTree.Parent := ClassesPn;
+ ClassesTree.Align := TAlignLayout.alClient;
+ ClassesTree.OnDblClick := DataTreeDblClick;
+{$IFDEF DELPHI18}
+ ClassesTree.DragMode := TDragMode.dmManual;
+ ClassesTree.Margins.Top := Rectangle1.Height;
+ ClassesTree.ManualDragAndDrop := True;
+{$ELSE}
+ ClassesTree.DragMode := TDragMode.dmAutomatic;
+{$ENDIF}
+ ClassesTree.SetImages(frxResources.Images);
+ ClassesTree.AutoCapture := False;
+
+ FXML := TfsXMLDocument.Create;
+ FFirstTime := True;
+
+ FTabs := TTabControl.Create(Self);
+ FTabs.Parent := MainDataPanel;
+{$IFDEF Delphi17}
+ FTabs.TabHeight := 21;
+{$ENDIF}
+ FTabs.SetBounds(0, 0, 40, 20);
+ FTabs.Align := TAlignLayout.alTop;
+ MainDataPanel.StyleLookup := 'backgroundstyle';
+ CBPanel.StyleLookup := 'backgroundstyle';
+
+ Label1.Text := frxGet(2100);
+
+ aTabItem := TTabItem.Create(FTabs);
+ aTabItem.TagObject := DataPn;
+ aTabItem.Text := frxGet(2101);
+ FTabs.AddObject(aTabItem);
+
+ aTabItem := TTabItem.Create(FTabs);
+ aTabItem.TagObject := VariablesPn;
+ aTabItem.Text := frxGet(2102);
+ FTabs.AddObject(aTabItem);
+
+ aTabItem := TTabItem.Create(FTabs);
+ aTabItem.TagObject := FunctionsPn;
+ aTabItem.Text := frxGet(2103);
+ FTabs.AddObject(aTabItem);
+
+ aTabItem := TTabItem.Create(FTabs);
+ aTabItem.TagObject := ClassesPn;
+ aTabItem.Text := frxGet(2106);
+ FTabs.AddObject(aTabItem);
+
+ FTabs.TabIndex := 0;
+ InsFieldCB.Text := frxGet(2104);
+ InsCaptionCB.Text := frxGet(2105);
+ SortCB.Text := frxGet(6004);
+ FTabs.OnChange := TabsChange;
+
+end;
+
+destructor TfrxDataTreeForm.Destroy;
+begin
+ if Owner is TfrxCustomDesigner then
+ CollapsedNodes := GetCollapsedNodes;
+ FUpdating := True;
+ FXML.Free;
+ inherited;
+end;
+
+procedure TfrxDataTreeForm.FillDataTree;
+var
+ ds: TfrxDataSet;
+ DatasetsList, FieldsList: TStrings;
+ i, j: Integer;
+ Root, Node1, Node2: TfrxTreeViewItem;
+ s, Collapsed: String;
+
+begin
+ DatasetsList := TStringList.Create;
+ FieldsList := TStringList.Create;
+ TStringList(FieldsList).Sorted := SortCB.IsChecked;
+ TStringList(DatasetsList).Sorted := SortCB.IsChecked;
+
+ FReport.GetDataSetList(DatasetsList);
+
+ try
+ if FFirstTime then
+ Collapsed := CollapsedNodes
+ else
+ Collapsed := GetCollapsedNodes;
+
+ DataTree.BeginUpdate;
+ DataTree.Clear;
+ if DatasetsList.Count = 0 then
+ begin
+ NoDataL.Text := frxResources.Get('dtNoData') + #13#10#13#10 +
+ frxResources.Get('dtNoData1');
+ NoDataL.BringToFront;
+ NoDataL.Visible := True;
+ end
+ else
+ begin
+ NoDataL.Visible := False;
+ s := frxResources.Get('dtData');
+
+ Root := DataTree.AddItem(DataTree, s);// DataTree.Items.AddChild(nil, s);
+ SetImageIndex(Root, 72);
+
+ for i := 0 to DatasetsList.Count - 1 do
+ begin
+ if DatasetsList.Objects[i] is TfrxDataset then
+ ds := TfrxDataSet(DatasetsList.Objects[i])
+ else ds := nil;
+ if ds = nil then continue;
+ try
+ ds.GetFieldList(FieldsList);
+ except
+ end;
+
+ Node1 := DataTree.AddItem(Root, FReport.GetAlias(ds));//DataTree.Items.AddChild(Root, FReport.GetAlias(ds));
+ Node1.Data := ds;
+ SetImageIndex(Node1, 72);
+
+ for j := 0 to FieldsList.Count - 1 do
+ begin
+ Node2 := DataTree.AddItem(Node1, FieldsList[j]);//DataTree.Items.AddChild(Node1, FieldsList[j]);
+ Node2.Data := ds;
+ SetImageIndex(Node2, 54);
+ end;
+ end;
+ DataTree.Items[0].IsExpanded := True;
+ for i := 0 to DataTree.Items[0].Count - 1 do
+ begin
+ s := DataTree.Items[0][i].Text;
+ if Pos(s + ',', Collapsed) = 0 then
+ DataTree.Items[0][i].IsExpanded := True;
+ end;
+ end;
+ finally
+ DataTree.EndUpdate;
+ DatasetsList.Free;
+ FieldsList.Free;
+ end;
+end;
+
+procedure TfrxDataTreeForm.FillVariablesTree;
+var
+ CategoriesList, VariablesList: TStrings;
+ i: Integer;
+ Root, Node: TfrxTreeViewItem;
+
+ procedure AddVariables(Node: TfrxTreeViewItem);
+ var
+ i: Integer;
+ Node1: TfrxTreeViewItem;
+ begin
+ for i := 0 to VariablesList.Count - 1 do
+ begin
+ Node1 := VariablesTree.AddItem(Node, VariablesList[i]);
+ SetImageIndex(Node1, 224);
+ end;
+ end;
+
+ procedure AddSystemVariables;
+ var
+ SysNode: TfrxTreeViewItem;
+
+ procedure AddNode(const s: String);
+ var
+ Node: TfrxTreeViewItem;
+ begin
+ Node := VariablesTree.AddItem(SysNode, s);
+ SetImageIndex(Node, 224);
+ end;
+
+ begin
+ SysNode := VariablesTree.AddItem(Root, frxResources.Get('dtSysVar'));
+ SetImageIndex(SysNode, 66);
+
+ AddNode('Date');
+ AddNode('Time');
+ AddNode('Page');
+ AddNode('Page#');
+ AddNode('TotalPages');
+ AddNode('TotalPages#');
+ AddNode('Line');
+ AddNode('Line#');
+ AddNode('CopyName#');
+ end;
+
+begin
+ CategoriesList := TStringList.Create;
+ VariablesList := TStringList.Create;
+ FReport.Variables.GetCategoriesList(CategoriesList);
+
+ VariablesTree.BeginUpdate;
+ VariablesTree.Clear;
+ Root := VariablesTree.AddItem(VariablesTree, frxResources.Get('dtVar'));
+ SetImageIndex(Root, 66);
+
+ for i := 0 to CategoriesList.Count - 1 do
+ begin
+ FReport.Variables.GetVariablesList(CategoriesList[i], VariablesList);
+ Node := VariablesTree.AddItem(Root, CategoriesList[i]);
+ SetImageIndex(Node, 66);
+ AddVariables(Node);
+ end;
+
+ if CategoriesList.Count = 0 then
+ begin
+ FReport.Variables.GetVariablesList('', VariablesList);
+ AddVariables(Root);
+ end;
+
+ AddSystemVariables;
+
+ VariablesTree.ExpandAll;
+ //VariablesTree.TopItem := Root;
+ VariablesTree.EndUpdate;
+ CategoriesList.Free;
+ VariablesList.Free;
+end;
+
+procedure TfrxDataTreeForm.FillFunctionsTree;
+
+ procedure AddFunctions(xi: TfsXMLItem; Root: TfrxTreeViewItem);
+ var
+ i: Integer;
+ Node: TfrxTreeViewItem;
+ s: String;
+ begin
+ s := xi.Prop['text'];
+ if xi.Count = 0 then
+ s := Copy(s, Pos(' ', s) + 1, 255) else { function }
+ s := frxResources.Get(s); { category }
+
+ if CompareText(s, 'hidden') = 0 then Exit;
+ if Root = nil then
+ Node := FunctionsTree.AddItem(FunctionsTree, s)
+ else
+ Node := FunctionsTree.AddItem(Root, s);
+ if xi.Count = 0 then
+ Node.Data := xi;
+ if Root = nil then
+ Node.Text := frxResources.Get('dtFunc');
+ if xi.Count = 0 then
+ SetImageIndex(Node, 52) else
+ SetImageIndex(Node, 66);
+
+ for i := 0 to xi.Count - 1 do
+ AddFunctions(xi[i], Node);
+ end;
+
+begin
+ FUpdating := True;
+
+ FunctionsTree.BeginUpdate;
+ FunctionsTree.Clear;
+ AddFunctions(FXML.Root.FindItem('Functions'), nil);
+
+ FunctionsTree.ExpandAll;
+ //FunctionsTree.TopItem := FunctionsTree.Items[0];
+ FunctionsTree.EndUpdate;
+ FUpdating := False;
+end;
+
+procedure TfrxDataTreeForm.FillClassesTree;
+
+ procedure AddClasses(xi: TfsXMLItem; Root: TfrxTreeViewItem);
+ var
+ i: Integer;
+ Node: TfrxTreeViewItem;
+ s: String;
+ begin
+ s := xi.Prop['text'];
+
+
+
+
+ if Root = nil then
+ begin
+ Node := ClassesTree.AddItem(ClassesTree, s);
+ Node.Text := frxResources.Get('2106');
+ SetImageIndex(Node, 66);
+ end
+ else
+ begin
+ Node := ClassesTree.AddItem(Root, s);
+ SetImageIndex(Node, 78);
+ end;
+ Node.Data := xi;
+
+ if Root = nil then
+ begin
+ for i := 0 to xi.Count - 1 do
+ AddClasses(xi[i], Node);
+ end
+ else
+ ClassesTree.AddItem(Node, 'more...'); // do not localize
+ end;
+
+begin
+ FUpdating := True;
+
+ ClassesTree.BeginUpdate;
+ ClassesTree.Clear;
+ AddClasses(FXML.Root.FindItem('Classes'), nil);
+
+ //ClassesTree.TopItem := ClassesTree.Items[0];
+ //ClassesTree.TopItem.Expand(False);
+ ClassesTree.EndUpdate;
+ FUpdating := False;
+end;
+
+function TfrxDataTreeForm.GetCollapsedNodes: String;
+var
+ i: Integer;
+ s: String;
+begin
+ Result := '';
+ if DataTree.Count > 0 then
+ for i := 0 to DataTree.Count - 1 do
+ begin
+ if DataTree.Items[i] is TTreeViewItem then
+ begin
+ s := DataTree.Items[i].Text;
+ if not DataTree.Items[i].ISExpanded then
+ Result := Result + s + ',';
+ end;
+ end;
+end;
+
+function TfrxDataTreeForm.GetFieldName: String;
+var
+ i, n: Integer;
+ s: String;
+ Node: TfrxTreeViewItem;
+begin
+ Result := '';
+ if FTabs.TabIndex = 0 then // data
+ begin
+ Node := TfrxTreeViewItem(DataTree.Selected);
+ if (Node <> nil) and (Node.Count = 0) and (Node.Data <> nil) then
+ Result := '<' + FReport.GetAlias(TfrxDataSet(Node.Data)) +
+ '."' + Node.Text + '"' + '>';
+ end
+ else if FTabs.TabIndex = 1 then // variables
+ begin
+ Node := TfrxTreeViewItem(VariablesTree.Selected);
+ if (Node <> nil) and (Node.Count = 0) then
+ if Node.Data <> nil then
+ Result := Node.Text else
+ Result := '<' + Node.Text + '>';
+ end
+ else if FTabs.TabIndex = 2 then // functions
+ begin
+ if (FunctionsTree.Selected <> nil) and (FunctionsTree.Selected.Count = 0) then
+ begin
+ s := FunctionsTree.Selected.Text;
+ if Pos('(', s) <> 0 then
+ n := 1 else
+ n := 0;
+ for i := 1 to Length(s) do
+ if CharInSet(s[i], [',', ';']) then
+ Inc(n);
+
+ if n = 0 then
+ s := Copy(s, 1, Pos(':', s) - 1)
+ else
+ begin
+ s := Copy(s, 1, Pos('(', s));
+ for i := 1 to n - 1 do
+ s := s + ',';
+ s := s + ')';
+ end;
+ Result := s;
+ end;
+ end;
+end;
+
+function TfrxDataTreeForm.IsDataField: Boolean;
+begin
+ Result := FTabs.TabIndex = 0;
+end;
+
+procedure TfrxDataTreeForm.MainDataPanelDragEnd(Sender: TObject);
+begin
+ShowMessage('');
+end;
+
+procedure TfrxDataTreeForm.UpdateItems;
+begin
+// XE3 bug - reset TCustomTreeView.FHoveredItem
+ //THackTreeView(DataTree).MouseMove([], -1, -1);
+ //THackTreeView(VariablesTree).MouseMove([], -1, -1);
+ //THackTreeView(FunctionsTree).MouseMove([], -1, -1);
+ //THackTreeView(ClassesTree).MouseMove([], -1, -1);
+
+ FillDataTree;
+ FillVariablesTree;
+ FFirstTime := False;
+end;
+
+procedure TfrxDataTreeForm.FormResize(Sender: TObject);
+begin
+ UpdateSize;
+end;
+
+{procedure TfrxDataTreeForm.DataTreeCustomDrawItem(Sender: TCustomTreeView;
+ Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
+begin
+ if Node.Count <> 0 then
+ Sender.Canvas.Font.Style := [fsBold];
+end;
+
+procedure TfrxDataTreeForm.ClassesTreeCustomDrawItem(Sender: TCustomTreeView;
+ Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
+begin
+ if Node.Level = 0 then
+ Sender.Canvas.Font.Style := [fsBold];
+end;}
+
+procedure TfrxDataTreeForm.FunctionsTreeChange(Sender: TObject);
+var
+ xi: TfsXMLItem;
+ Node: TfrxTreeViewItem;
+begin
+ if FUpdating then Exit;
+ Node := TfrxTreeViewItem(FunctionsTree.Selected);
+ if (Node = nil) or (Node.Data = nil) then
+ begin
+ FunctionNameL.Text := '';
+ FunctionDescL.Text := '';
+ Exit;
+ end
+ else
+ begin
+ xi := TfsXMLItem(Node.Data);
+ FunctionNameL.Text := xi.Prop['text'];
+ FunctionDescL.Text := frxResources.Get(xi.Prop['description']);
+ FunctionNameL.AutoSize := True;
+ end;
+end;
+
+procedure TfrxDataTreeForm.DataTreeDblClick(Sender: TObject);
+begin
+ if Assigned(MainDataPanel.OnDblClick) then
+ MainDataPanel.OnDblClick(Sender);
+end;
+
+//procedure TfrxDataTreeForm.ClassesTreeExpanding(Sender: TObject;
+// Node: TfrxTreeViewItem; var AllowExpansion: Boolean);
+//var
+// i: Integer;
+// xi: TfsXMLItem;
+// s: String;
+// n: TfrxTreeViewItem;
+//begin
+// if (Node.Level = 1) and (Node.Data <> nil) then
+// begin
+// FUpdating := True;
+// ClassesTree.BeginUpdate;
+//
+// Node.;
+// xi := TfsXMLItem(Node.Data);
+// Node.Data := nil;
+//
+// for i := 0 to xi.Count - 1 do
+// begin
+// s := xi[i].Prop['text'];
+// n := ClassesTree.Items.AddChild(Node, s);
+// if Pos('property', s) = 1 then
+// SetImageIndex(n, 73)
+// else if Pos('event', s) = 1 then
+// SetImageIndex(n, 79)
+// else
+// SetImageIndex(n, 74);
+// end;
+//
+// ClassesTree.Items.EndUpdate;
+// FUpdating := False;
+// end;
+//end;
+
+function TfrxDataTreeForm.GetLastPosition: TPoint;
+var
+ Item: TTreeViewItem;
+begin
+ Result.X := FTabs.TabIndex;
+ Result.Y := 0;
+ Item := nil;
+ case Result.X of
+ 0: Item := DataTree.Items[0];
+ 1: Item := VariablesTree.Items[0];
+ 2: Item := FunctionsTree.Items[0];
+ 3: Item := ClassesTree.Items[0];
+ end;
+ if Item <> nil then
+ Result.Y := Item.GlobalIndex;
+end;
+
+procedure TfrxDataTreeForm.SetLastPosition(p: TPoint);
+begin
+ ShowTab(p.X);
+ case p.X of
+ 0: if DataTree.Count > 0 then DataTree.Selected := DataTree.Items[p.Y];
+ 1: if VariablesTree.Count > 0 then VariablesTree.Selected := VariablesTree.Items[p.Y];
+ 2: if FunctionsTree.Count > 0 then FunctionsTree.Selected := FunctionsTree.Items[p.Y];
+ 3: if ClassesTree.Count > 0 then ClassesTree.Selected := ClassesTree.Items[p.Y];
+ end;
+end;
+
+procedure TfrxDataTreeForm.TabsChange(Sender: TObject);
+begin
+ ShowTab(FTabs.TabIndex);
+end;
+
+procedure TfrxDataTreeForm.ShowTab(Index: Integer);
+var
+ i: Integer;
+begin
+ if (Index < 0) or (Index > FTabs.TabCount - 1) then Exit;
+ FTabs.TabIndex := Index;
+ for i := 0 to FTabs.TabCount - 1 do
+ TControl(FTabs.Tabs[i].TagObject).Visible := i = Index;
+
+ if FXML.Root.Count = 0 then
+ begin
+ FReport.Script.AddRTTI;
+ GenerateXMLContents(FReport.Script, FXML.Root);
+ end;
+
+ if (Index = 2) and (FunctionsTree.Count < 2) then
+ FillFunctionsTree;
+ if (Index = 3) and (ClassesTree.Count < 2) then
+ FillClassesTree;
+end;
+
+
+
+procedure TfrxDataTreeForm.UpdateSize;
+var
+ Y: Integer;
+begin
+ if FTabs = nil then Exit;
+
+ with FTabs.Parent do
+ begin
+ //if Screen.PixelsPerInch > 96 then
+ // Y := 26
+ //else
+ Y := 21;
+ FTabs.SetBounds(0, Rectangle1.Height, MainDataPanel.Width, Y);
+ Y := Round(FTabs.Position.Y + FTabs.Height);
+ DataPn.SetBounds(0, Y, MainDataPanel.Width, MainDataPanel.Height - Y);
+ VariablesPn.SetBounds(0, Y, MainDataPanel.Width, MainDataPanel.Height - Y+1);
+ FunctionsPn.SetBounds(0, Y, MainDataPanel.Width, MainDataPanel.Height - Y+1);
+ ClassesPn.SetBounds(0, Y, MainDataPanel.Width, MainDataPanel.Height - Y+1);
+ NoDataL.SetBounds(10, {$IFDEF DELPHI18}20{$ELSE}10{$ENDIF}, MainDataPanel.Width - 20, MainDataPanel.Height - Y);
+ end;
+ InsCaptionCB.Width := DataPn.Width;
+ SortCB.Width := DataPn.Width;
+ InsFieldCB.Width := DataPn.Width;
+ CBPanel.Width := DataPn.Width;
+ FunctionNameL.AutoSize := False;
+ FunctionNameL.AutoSize := True;
+end;
+
+function TfrxDataTreeForm.GetActivePage: Integer;
+begin
+ Result := FTabs.TabIndex;
+end;
+
+procedure TfrxDataTreeForm.UpdateSelection;
+var
+ i: Integer;
+begin
+ if GetActivePage = 0 then
+ begin
+ DataTree.Selected := nil;
+ if (Report.Designer.SelectedObjects.Count = 1) and
+ (TObject(Report.Designer.SelectedObjects[0]) is TfrxDataset) then
+ begin
+ if (DataTree.Count > 0) then
+ for i := 0 to DataTree.Items[0].Count - 1 do
+ if TfrxTreeViewItem(DataTree.Items[0].Items[i]).Data = Report.Designer.SelectedObjects[0] then
+ begin
+ DataTree.Selected := DataTree.Items[0].Items[i];
+ break;
+ end;
+ end;
+ end;
+end;
+
+procedure TfrxDataTreeForm.SortCBClick(Sender: TObject);
+begin
+ FillDataTree;
+end;
+
+end.
diff --git a/LibD28/FMX.frxDesgn.fmx b/LibD28/FMX.frxDesgn.fmx
new file mode 100644
index 0000000..d9271a3
--- /dev/null
+++ b/LibD28/FMX.frxDesgn.fmx
@@ -0,0 +1,1811 @@
+object frxDesignerForm: TfrxDesignerForm
+ Left = 0
+ Top = 0
+ Caption = 'Designer'
+ ClientHeight = 610
+ ClientWidth = 988
+ StyleBook = StyleBook1
+ OnActivate = FormActivate
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnCloseQuery = FormCloseQuery
+ OnKeyDown = FormKeyDown
+ OnMouseWheel = FormMouseWheel
+ OnResize = FormResize
+ object StatusBar: TStatusBar
+ Height = 19.000000000000000000
+ Position.Y = 591.000000000000000000
+ ShowSizeGrip = True
+ Width = 988.000000000000000000
+ OnDblClick = StatusBarDblClick
+ OnMouseDown = StatusBarMouseDown
+ end
+ object ObjectsTB1: TToolBar
+ Align = alLeft
+ Height = 513.000000000000000000
+ Position.Y = 78.000000000000000000
+ Width = 27.000000000000000000
+ end
+ object PagePopup: TPopupMenu
+ Left = 760
+ Top = 104
+ end
+ object MainMenu: TMenuBar
+ Align = alMostTop
+ Height = 24.000000000000000000
+ Width = 988.000000000000000000
+ object FileMenu: TMenuItem
+ Height = 24.000000000000000000
+ StyleLookup = 'menubaritemstyle'
+ Width = 16.000000000000000000
+ object NewMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 1
+ Width = 50.000000000000000000
+ OnClick = NewItemCmdExecute
+ end
+ object NewReportMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 1
+ Width = 50.000000000000000000
+ OnClick = NewReportCmdExecute
+ end
+ object NewPageMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 1
+ Width = 50.000000000000000000
+ OnClick = NewPageCmdExecute
+ end
+ object NewDialogMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 1
+ Width = 50.000000000000000000
+ OnClick = NewDialogCmdExecute
+ end
+ object OpenMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 2
+ Width = 50.000000000000000000
+ OnClick = OpenCmdExecute
+ end
+ object SaveMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 2
+ Width = 50.000000000000000000
+ OnClick = SaveCmdExecute
+ end
+ object SaveAsMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 2
+ Width = 50.000000000000000000
+ OnClick = SaveAsCmdExecute
+ end
+ object PreviewMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 3
+ Width = 50.000000000000000000
+ OnClick = PreviewCmdExecute
+ end
+ object PageSettingsMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 3
+ Width = 50.000000000000000000
+ OnClick = PageSettingsCmdExecute
+ end
+ object ExitMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 3
+ Width = 50.000000000000000000
+ OnClick = ExitCmdExecute
+ end
+ end
+ object EditMenu: TMenuItem
+ Height = 24.000000000000000000
+ Position.X = 16.000000000000000000
+ StyleLookup = 'menubaritemstyle'
+ Width = 16.000000000000000000
+ object UndoMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 4
+ Width = 50.000000000000000000
+ OnClick = UndoCmdExecute
+ end
+ object RedoMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 4
+ Width = 50.000000000000000000
+ OnClick = RedoCmdExecute
+ end
+ object CutMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = CutCmdExecute
+ end
+ object CopyMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = CopyCmdExecute
+ end
+ object PasteMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = PasteCmdExecute
+ end
+ object DeleteMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = DeleteCmdExecute
+ end
+ object DeletePageMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = DeletePageCmdExecute
+ end
+ object SelectAllMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = SelectAllCmdExecute
+ end
+ object GroupMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 7
+ Width = 50.000000000000000000
+ OnClick = GroupCmdExecute
+ end
+ object UngroupMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 7
+ Width = 50.000000000000000000
+ OnClick = UngroupCmdExecute
+ end
+ object EditMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 7
+ Width = 50.000000000000000000
+ OnClick = EditCmdExecute
+ end
+ object N2: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 7
+ Width = 50.000000000000000000
+ end
+ object FindMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 8
+ Width = 50.000000000000000000
+ OnClick = FindCmdExecute
+ end
+ object ReplaceMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 8
+ Width = 50.000000000000000000
+ OnClick = ReplaceCmdExecute
+ end
+ object FindNextMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 8
+ Width = 50.000000000000000000
+ OnClick = FindNextCmdExecute
+ end
+ object BringtoFrontMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 9
+ Width = 50.000000000000000000
+ OnClick = BringToFrontCmdExecute
+ end
+ object SendtoBackMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 9
+ Width = 50.000000000000000000
+ OnClick = SendToBackCmdExecute
+ end
+ end
+ object ReportMenu: TMenuItem
+ Height = 24.000000000000000000
+ Position.X = 32.000000000000000000
+ StyleLookup = 'menubaritemstyle'
+ Width = 16.000000000000000000
+ object ReportDataMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = ReportDataCmdExecute
+ end
+ object VariablesMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = VariablesCmdExecute
+ end
+ object ReportStylesMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = ReportStylesCmdExecute
+ end
+ object ReportSettingsMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = ReportOptionsCmdExecute
+ end
+ end
+ object ViewMenu: TMenuItem
+ Height = 24.000000000000000000
+ Position.X = 48.000000000000000000
+ StyleLookup = 'menubaritemstyle'
+ Width = 16.000000000000000000
+ object ShowRulersMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ AutoCheck = True
+ Width = 50.000000000000000000
+ OnClick = ShowRulersCmdExecute
+ end
+ object ShowGuidesMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ AutoCheck = True
+ Width = 50.000000000000000000
+ OnClick = ShowGuidesCmdExecute
+ end
+ object DeleteGuidesMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = DeleteGuidesCmdExecute
+ end
+ object OptionsMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = OptionsCmdExecute
+ end
+ end
+ object HelpMenu: TMenuItem
+ Height = 24.000000000000000000
+ Position.X = 64.000000000000000000
+ StyleLookup = 'menubaritemstyle'
+ Width = 16.000000000000000000
+ object AboutMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = AboutCmdExecute
+ end
+ end
+ end
+ object OpenDialog: TOpenDialog
+ Left = 304
+ Top = 104
+ end
+ object SaveDialog: TSaveDialog
+ Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing]
+ Left = 264
+ Top = 104
+ end
+ object TabPopup: TPopupMenu
+ Left = 832
+ Top = 120
+ object NewPageMI1: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = NewPageCmdExecute
+ TabOrder = 0
+ ShortCut = 0
+ end
+ object NewDialogMI1: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = NewDialogCmdExecute
+ TabOrder = 1
+ ShortCut = 0
+ end
+ object DeletePageMI1: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = DeletePageCmdExecute
+ TabOrder = 2
+ ShortCut = 0
+ end
+ object PageSettingsMI1: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = PageSettingsCmdExecute
+ TabOrder = 3
+ ShortCut = 0
+ end
+ end
+ object BandsPopup: TPopupMenu
+ Left = 936
+ Top = 208
+ object ReportTitleMI: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object ReportSummaryMI: TMenuItem
+ Tag = 1
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object PageHeaderMI: TMenuItem
+ Tag = 2
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object PageFooterMI: TMenuItem
+ Tag = 3
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object HeaderMI: TMenuItem
+ Tag = 4
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object FooterMI: TMenuItem
+ Tag = 5
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object MasterDataMI: TMenuItem
+ Tag = 6
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object DetailDataMI: TMenuItem
+ Tag = 7
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object SubdetailDataMI: TMenuItem
+ Tag = 8
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object Data4levelMI: TMenuItem
+ Tag = 9
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object Data5levelMI: TMenuItem
+ Tag = 10
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object Data6levelMI: TMenuItem
+ Tag = 11
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object GroupHeaderMI: TMenuItem
+ Tag = 12
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object GroupFooterMI: TMenuItem
+ Tag = 13
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object ChildMI: TMenuItem
+ Tag = 14
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object ColumnHeaderMI: TMenuItem
+ Tag = 15
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object ColumnFooterMI: TMenuItem
+ Tag = 16
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object OverlayMI: TMenuItem
+ Tag = 17
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object N3: TMenuItem
+ Height = 50.000000000000000000
+ Text = '-'
+ Width = 50.000000000000000000
+ end
+ object VerticalbandsMI: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ object HeaderMI1: TMenuItem
+ Tag = 104
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object FooterMI1: TMenuItem
+ Tag = 105
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object MasterDataMI1: TMenuItem
+ Tag = 106
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object DetailDataMI1: TMenuItem
+ Tag = 107
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object SubdetailDataMI1: TMenuItem
+ Tag = 108
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object GroupHeaderMI1: TMenuItem
+ Tag = 112
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object GroupFooterMI1: TMenuItem
+ Tag = 113
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object ChildMI1: TMenuItem
+ Tag = 114
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ end
+ end
+ object Timer: TTimer
+ Enabled = False
+ OnTimer = TimerTimer
+ Left = 488
+ Top = 96
+ end
+ object RotationPopup: TPopupMenu
+ Left = 632
+ Top = 96
+ object R0MI: TMenuItem
+ Tag = 30
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object R45MI: TMenuItem
+ Tag = 30
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object R90MI: TMenuItem
+ Tag = 30
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object R180MI: TMenuItem
+ Tag = 30
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object R270MI: TMenuItem
+ Tag = 30
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ end
+ object OpenScriptDialog: TOpenDialog
+ Left = 392
+ Top = 104
+ end
+ object SaveScriptDialog: TSaveDialog
+ Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing]
+ Left = 344
+ Top = 104
+ end
+ object ObjectsPopup: TPopupMenu
+ Left = 880
+ Top = 176
+ end
+ object DMPPopup: TPopupMenu
+ Left = 928
+ Top = 120
+ object BoldMI: TMenuItem
+ Tag = 34
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object ItalicMI: TMenuItem
+ Tag = 35
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object UnderlineMI: TMenuItem
+ Tag = 36
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object SuperScriptMI: TMenuItem
+ Tag = 37
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object SubScriptMI: TMenuItem
+ Tag = 38
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object CondensedMI: TMenuItem
+ Tag = 39
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object WideMI: TMenuItem
+ Tag = 40
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object N12cpiMI: TMenuItem
+ Tag = 41
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object N15cpiMI: TMenuItem
+ Tag = 42
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ end
+ object BackPanel: TPanel
+ Align = alClient
+ Height = 513.000000000000000000
+ Position.X = 27.000000000000000000
+ Position.Y = 78.000000000000000000
+ Width = 961.000000000000000000
+ object ScrollBoxPanel: TPanel
+ Height = 297.000000000000000000
+ Position.X = 65.000000000000000000
+ Position.Y = 95.000000000000000000
+ Width = 297.000000000000000000
+ object ScrollBox: TfrxScrollBox
+ Align = alClient
+ Height = 274.000000000000000000
+ Position.X = 23.000000000000000000
+ Position.Y = 23.000000000000000000
+ StyleLookup = 'ScrollBoxStyle1'
+ Width = 274.000000000000000000
+ OnResize = ScrollBoxResize
+ OnPositionChanged = ScrollBoxResize
+ end
+ object LeftRuler: TfrxRuler
+ Align = alLeft
+ Cursor = crHandPoint
+ DragMode = dmAutomatic
+ Height = 274.000000000000000000
+ Position.Y = 23.000000000000000000
+ Scale = 1.000000000000000000
+ StyleLookup = 'backgroundstyle'
+ Width = 23.000000000000000000
+ OnDragOver = TopRulerDragOver
+ Offset = 0
+ Start = 0
+ Units = ruCM
+ RulerSize = 0
+ end
+ object TopRuler: TfrxRuler
+ Align = alTop
+ Cursor = crHandPoint
+ DragMode = dmAutomatic
+ Height = 23.000000000000000000
+ Scale = 1.000000000000000000
+ StyleLookup = 'backgroundstyle'
+ Width = 297.000000000000000000
+ OnDragOver = TopRulerDragOver
+ Offset = 22
+ Start = 0
+ Units = ruCM
+ RulerSize = 0
+ end
+ end
+ object CodePanel: TPanel
+ Height = 289.000000000000000000
+ Position.X = 394.000000000000000000
+ Position.Y = 98.000000000000000000
+ Width = 377.000000000000000000
+ object CodeTB: TToolBar
+ Height = 25.000000000000000000
+ Width = 377.000000000000000000
+ object OpenScriptB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 169.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = OpenScriptBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object SaveScriptB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 192.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = SaveScriptBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object RunScriptB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 223.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = RunScriptBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object RunToCursorB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 246.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = RunToCursorBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object StepScriptB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 269.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = RunScriptBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object StopScriptB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 292.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = StopScriptBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object EvaluateB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 315.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = EvaluateBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object BreakPointB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 338.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = BreakPointBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object LangCB: TComboEdit
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 48.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 100.000000000000000000
+ Height = 20.000000000000000000
+ OnChange = LangCBClick
+ end
+ end
+ end
+ object TabPanel: TPanel
+ Align = alTop
+ Height = 24.000000000000000000
+ Width = 961.000000000000000000
+ end
+ object RightDockTB: TToolBar
+ Align = alRight
+ Height = 489.000000000000000000
+ Position.X = 816.000000000000000000
+ Position.Y = 24.000000000000000000
+ Width = 145.000000000000000000
+ OnResize = RightDockTBResize
+ end
+ object Splitter1: TSplitter
+ Align = alRight
+ Cursor = crHSplit
+ Height = 489.000000000000000000
+ MinSize = 20.000000000000000000
+ Position.X = 811.000000000000000000
+ Position.Y = 24.000000000000000000
+ Width = 5.000000000000000000
+ end
+ object LeftDockTB: TToolBar
+ Align = alLeft
+ Height = 489.000000000000000000
+ Position.Y = 24.000000000000000000
+ Width = 177.000000000000000000
+ OnResize = LeftDockTBResize
+ end
+ object Splitter2: TSplitter
+ Align = alLeft
+ Cursor = crHSplit
+ Height = 489.000000000000000000
+ MinSize = 20.000000000000000000
+ Position.X = 177.000000000000000000
+ Position.Y = 24.000000000000000000
+ Width = 5.000000000000000000
+ end
+ end
+ object TopToolBox: TToolBar
+ Align = alMostTop
+ Height = 54.000000000000000000
+ Position.Y = 24.000000000000000000
+ TabOrder = 3
+ Width = 988.000000000000000000
+ object AlignTB: TToolBar
+ Align = alNone
+ Height = 27.000000000000000000
+ Position.X = 526.000000000000000000
+ Width = 318.000000000000000000
+ object Grip1: TfrxToolGrip
+ Position.X = 4.000000000000000000
+ Position.Y = 6.000000000000000000
+ Width = 4.000000000000000000
+ Height = 14.000000000000000000
+ end
+ object AlignLeftsB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 8.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignLeftsBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 0
+ end
+ object AlignHorzCentersB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 31.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignHorzCentersBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 1
+ end
+ object AlignRightsB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 54.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignRightsBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 2
+ end
+ object Sep7: TfrxToolSeparator
+ Position.X = 80.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object AlignTopsB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 85.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignTopsBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 3
+ end
+ object AlignVertCentersB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 109.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignVertCentersBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 4
+ end
+ object AlignBottomsB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 131.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignBottomsBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 5
+ end
+ object Sep8: TfrxToolSeparator
+ Position.X = 157.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object SpaceHorzB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 162.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = SpaceHorzBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 6
+ end
+ object SpaceVertB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 185.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = SpaceVertBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 7
+ end
+ object Sep9: TfrxToolSeparator
+ Position.X = 211.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object CenterHorzB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 216.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = CenterHorzBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 8
+ end
+ object CenterVertB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 239.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = CenterVertBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 9
+ end
+ object Sep10: TfrxToolSeparator
+ Position.X = 265.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object SameWidthB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 270.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = SameWidthBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 10
+ end
+ object SameHeightB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 293.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = SameHeightBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 11
+ end
+ end
+ object ExtraToolsTB: TToolBar
+ Align = alNone
+ Height = 27.000000000000000000
+ Position.X = 877.000000000000000000
+ Visible = False
+ Width = 19.000000000000000000
+ end
+ object FrameTB: TToolBar
+ Align = alNone
+ Height = 27.000000000000000000
+ Position.X = 639.000000000000000000
+ Position.Y = 27.000000000000000000
+ Width = 308.000000000000000000
+ object Grip2: TfrxToolGrip
+ Position.X = 4.000000000000000000
+ Position.Y = 6.000000000000000000
+ Width = 4.000000000000000000
+ Height = 14.000000000000000000
+ end
+ object FrameTopB: TfrxToolButton
+ Tag = 20
+ Height = 22.000000000000000000
+ Position.X = 8.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 0
+ end
+ object FrameBottomB: TfrxToolButton
+ Tag = 21
+ Height = 22.000000000000000000
+ Position.X = 31.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 1
+ end
+ object FrameLeftB: TfrxToolButton
+ Tag = 22
+ Height = 22.000000000000000000
+ Position.X = 54.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 2
+ end
+ object FrameRightB: TfrxToolButton
+ Tag = 23
+ Height = 22.000000000000000000
+ Position.X = 77.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 3
+ end
+ object Sep14: TfrxToolSeparator
+ Position.X = 103.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object FrameAllB: TfrxToolButton
+ Tag = 24
+ Height = 22.000000000000000000
+ Position.X = 108.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 4
+ end
+ object FrameNoB: TfrxToolButton
+ Tag = 25
+ Height = 22.000000000000000000
+ Position.X = 131.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 21.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 5
+ end
+ object ShadowB: TfrxToolButton
+ Tag = 32
+ Height = 22.000000000000000000
+ Position.X = 154.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 6
+ end
+ object Sep15: TfrxToolSeparator
+ Position.X = 180.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object FillColorB: TfrxToolButton
+ Tag = 26
+ Height = 22.000000000000000000
+ Position.X = 185.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = FontColorBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 7
+ end
+ object FrameColorB: TfrxToolButton
+ Tag = 27
+ Height = 22.000000000000000000
+ Position.X = 208.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = FontColorBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 8
+ end
+ object FrameStyleB: TfrxToolButton
+ Tag = 28
+ Height = 22.000000000000000000
+ Position.X = 231.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = FrameStyleBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 9
+ end
+ object FrameWidthCB: TComboEdit
+ Tag = 29
+ TabOrder = 10
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ Items.Strings = (
+ '0,1'
+ '0,5'
+ '1'
+ '1,5'
+ '2'
+ '3'
+ '4'
+ '5'
+ '6'
+ '7'
+ '8'
+ '9'
+ '10')
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 256.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 49.000000000000000000
+ Height = 20.000000000000000000
+ OnChange = ToolButtonClick
+ OnKeyDown = FrameWidthCBKeyDown
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ end
+ end
+ object StandardTB: TToolBar
+ Align = alNone
+ Height = 27.000000000000000000
+ Width = 526.000000000000000000
+ object Grip3: TfrxToolGrip
+ Position.X = 4.000000000000000000
+ Position.Y = 6.000000000000000000
+ Width = 4.000000000000000000
+ Height = 14.000000000000000000
+ end
+ object NewB: TfrxToolButton
+ Tag = 40
+ Height = 22.000000000000000000
+ Position.X = 8.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = NewReportCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 0
+ end
+ object OpenB: TfrxToolButton
+ Tag = 41
+ Height = 22.000000000000000000
+ Position.X = 31.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = OpenCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 1
+ end
+ object SaveB: TfrxToolButton
+ Tag = 42
+ Height = 22.000000000000000000
+ Position.X = 54.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = SaveCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 2
+ end
+ object PreviewB: TfrxToolButton
+ Tag = 43
+ Height = 22.000000000000000000
+ Position.X = 77.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = PreviewCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 3
+ end
+ object Sep1: TfrxToolSeparator
+ Position.X = 103.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object NewPageB: TfrxToolButton
+ Tag = 52
+ Height = 22.000000000000000000
+ Position.X = 108.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = NewPageCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 4
+ end
+ object NewDialogB: TfrxToolButton
+ Tag = 70
+ Height = 22.000000000000000000
+ Position.X = 131.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = NewDialogCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 5
+ end
+ object DeletePageB: TfrxToolButton
+ Tag = 53
+ Height = 22.000000000000000000
+ Position.X = 154.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = DeletePageCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 6
+ end
+ object PageSettingsB: TfrxToolButton
+ Tag = 54
+ Height = 22.000000000000000000
+ Position.X = 177.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = PageSettingsCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 7
+ end
+ object Sep2: TfrxToolSeparator
+ Position.X = 203.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object CutB: TfrxToolButton
+ Tag = 44
+ Height = 22.000000000000000000
+ Position.X = 208.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = CutCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 9
+ end
+ object CopyB: TfrxToolButton
+ Tag = 45
+ Height = 22.000000000000000000
+ Position.X = 231.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = CopyCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 10
+ end
+ object PasteB: TfrxToolButton
+ Tag = 46
+ Height = 22.000000000000000000
+ Position.X = 254.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = PasteCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 11
+ end
+ object Sep4: TfrxToolSeparator
+ Position.X = 280.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object UndoB: TfrxToolButton
+ Tag = 47
+ Height = 22.000000000000000000
+ Position.X = 285.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = UndoCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 12
+ end
+ object RedoB: TfrxToolButton
+ Tag = 48
+ Height = 22.000000000000000000
+ Position.X = 308.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = RedoCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 13
+ end
+ object Sep5: TfrxToolSeparator
+ Position.X = 334.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object GroupB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 339.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = GroupCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 14
+ end
+ object UngroupB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 362.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = UngroupCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 15
+ end
+ object Sep6: TfrxToolSeparator
+ Position.X = 388.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object ShowGridB: TfrxToolButton
+ Tag = 55
+ Height = 22.000000000000000000
+ Position.X = 393.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ShowGridBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 16
+ end
+ object AlignToGridB: TfrxToolButton
+ Tag = 56
+ Height = 22.000000000000000000
+ Position.X = 416.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = AlignToGridBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 17
+ end
+ object SetToGridB: TfrxToolButton
+ Tag = 31
+ Height = 22.000000000000000000
+ Position.X = 439.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 18
+ end
+ object ScaleCB: TComboEdit
+ TabOrder = 19
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 465.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 59.000000000000000000
+ Height = 20.000000000000000000
+ OnClick = ScaleCBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ end
+ end
+ object TextTB: TToolBar
+ Align = alNone
+ Height = 27.000000000000000000
+ Position.Y = 27.000000000000000000
+ Width = 639.000000000000000000
+ object Grip4: TfrxToolGrip
+ Position.X = 4.000000000000000000
+ Position.Y = 6.000000000000000000
+ Width = 4.000000000000000000
+ Height = 14.000000000000000000
+ end
+ object StyleCB: TComboEdit
+ Tag = 33
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 8.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 97.000000000000000000
+ Height = 20.000000000000000000
+ OnChange = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ end
+ object FontNameCB: TComboEdit
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 107.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 138.000000000000000000
+ Height = 20.000000000000000000
+ OnChange = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ end
+ object FontSizeCB: TComboEdit
+ Tag = 1
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ Items.Strings = (
+ '5'
+ '6'
+ '7'
+ '8'
+ '9'
+ '10'
+ '11'
+ '12'
+ '14'
+ '16'
+ '18'
+ '20'
+ '22'
+ '24'
+ '26'
+ '28'
+ '36'
+ '48'
+ '72')
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 247.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 43.000000000000000000
+ Height = 20.000000000000000000
+ OnChange = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ end
+ object BoldB: TfrxToolButton
+ Tag = 2
+ Height = 22.000000000000000000
+ Position.X = 293.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 0
+ end
+ object ItalicB: TfrxToolButton
+ Tag = 3
+ Height = 22.000000000000000000
+ Position.X = 316.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 1
+ end
+ object UnderlineB: TfrxToolButton
+ Tag = 4
+ Height = 22.000000000000000000
+ Position.X = 339.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 2
+ end
+ object Sep11: TfrxToolSeparator
+ Position.X = 365.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object FontB: TfrxToolButton
+ Tag = 43
+ Height = 22.000000000000000000
+ Position.X = 370.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 3
+ end
+ object FontColorB: TfrxToolButton
+ Tag = 5
+ Height = 22.000000000000000000
+ Position.X = 393.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = FontColorBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 4
+ end
+ object HighlightB: TfrxToolButton
+ Tag = 6
+ Height = 22.000000000000000000
+ Position.X = 416.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = HighlightBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 5
+ end
+ object RotateB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 439.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = RotateBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 6
+ end
+ object Sep12: TfrxToolSeparator
+ Position.X = 465.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object TextAlignLeftB: TfrxToolButton
+ Tag = 7
+ Height = 22.000000000000000000
+ Position.X = 470.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 7
+ end
+ object TextAlignCenterB: TfrxToolButton
+ Tag = 8
+ Height = 22.000000000000000000
+ Position.X = 493.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 8
+ end
+ object TextAlignRightB: TfrxToolButton
+ Tag = 9
+ Height = 22.000000000000000000
+ Position.X = 516.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 9
+ end
+ object TextAlignBlockB: TfrxToolButton
+ Tag = 10
+ Height = 22.000000000000000000
+ Position.X = 539.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 10
+ end
+ object Sep13: TfrxToolSeparator
+ Position.X = 565.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object TextAlignTopB: TfrxToolButton
+ Tag = 11
+ Height = 22.000000000000000000
+ Position.X = 570.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 11
+ end
+ object TextAlignMiddleB: TfrxToolButton
+ Tag = 12
+ Height = 22.000000000000000000
+ Position.X = 593.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 12
+ end
+ object TextAlignBottomB: TfrxToolButton
+ Tag = 13
+ Height = 22.000000000000000000
+ Position.X = 616.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 13
+ end
+ end
+ end
+ object StyleBook1: TStyleBook
+ Resource.Strings = (
+ 'object _1: TLayout'
+ ' Align = alClient'
+ ' Height = 715.000000000000000000'
+ ' Position.Y = 33.000000000000000000'
+ ' Width = 1162.000000000000000000'
+ ' object TLayout'
+ ' StyleName = '#39'TabControl1Style1'#39
+ ' DesignVisible = False'
+ ' Height = 101.000000000000000000'
+ ' Position.X = 278.000000000000000000'
+ ' Position.Y = 289.000000000000000000'
+ ' Width = 142.000000000000000000'
+ ' object TRectangle'
+ ' Align = alContents'
+ ' Fill.Color = claWhite'
+ ' Height = 101.000000000000000000'
+ ' HitTest = False'
+ ' Sides = [sdTop, sdLeft, sdRight]'
+ ' Stroke.Color = xFF8E8E8E'
+ ' Width = 142.000000000000000000'
+ ' end'
+ ' end'
+ ' object TCalloutRectangle'
+ ' StyleName = '#39'HintPanelStyle1'#39
+ ' Fill.Color = claBeige'
+ ' Height = 50.000000000000000000'
+ ' HitTest = False'
+ ' Position.X = 556.000000000000000000'
+ ' Position.Y = 332.000000000000000000'
+ ' Stroke.Color = xFF979797'
+ ' Width = 50.000000000000000000'
+ ' CalloutWidth = 23.000000000000000000'
+ ' CalloutLength = 11.000000000000000000'
+ ' end'
+ 'end')
+ Left = 32
+ Top = 120
+ end
+ object HintPanel: TCalloutPanel
+ Height = 57.000000000000000000
+ Margins.Top = 11.000000000000000000
+ Position.X = 520.000000000000000000
+ Position.Y = 400.000000000000000000
+ StyleLookup = 'HintPanelStyle1'
+ Visible = False
+ Width = 97.000000000000000000
+ CalloutWidth = 23.000000000000000000
+ CalloutLength = 11.000000000000000000
+ object Label1: TLabel
+ Align = alClient
+ Height = 46.000000000000000000
+ Position.Y = 11.000000000000000000
+ Text = 'Label1'
+ TextAlign = taCenter
+ Width = 97.000000000000000000
+ end
+ end
+end
diff --git a/LibD28/FMX.frxDesgn.pas b/LibD28/FMX.frxDesgn.pas
new file mode 100644
index 0000000..22c91bd
--- /dev/null
+++ b/LibD28/FMX.frxDesgn.pas
@@ -0,0 +1,5696 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Designer }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDesgn;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, System.Types, FMX.Types, FMX.Objects, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.Menus, FMX.frxClass, FMX.frxCtrls, FMX.frxDesgnCtrls, FMX.frxDesgnWorkspace,
+ FMX.frxInsp, FMX.frxDialogForm, FMX.frxDataTree, FMX.frxReportTree, FMX.fs_SynMemo,
+ FMX.fs_iinterpreter, FMX.Printer, FMX.frxWatchForm, FMX.frxPictureCache, System.Variants,
+ FMX.TabControl, FMX.frxFMX, FMX.Layouts, FMX.Edit, System.UIConsts
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI21}
+ , FMX.ComboEdit, FMX.Controls.Presentation
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+ TfrxDesignerUnits = (duCM, duInches, duPixels, duChars);
+ TfrxLoadReportEvent = function(Report: TfrxReport): Boolean of object;
+ TfrxLoadRecentReportEvent = function(Report: TfrxReport; FileName: String): Boolean of object;
+ TfrxSaveReportEvent = function(Report: TfrxReport; SaveAs: Boolean): Boolean of object;
+ TfrxGetTemplateListEvent = procedure(List: TStrings) of object;
+ TfrxDesignerRestriction =
+ (drDontInsertObject, drDontDeletePage, drDontCreatePage, drDontChangePageOptions,
+ drDontCreateReport, drDontLoadReport, drDontSaveReport,
+ drDontPreviewReport, drDontEditVariables, drDontChangeReportOptions,
+ drDontEditReportData, drDontShowRecentFiles, drDontEditReportScript, drDontEditInternalDatasets);
+ TfrxDesignerRestrictions = set of TfrxDesignerRestriction;
+ TSampleFormat = class;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxDesigner = class(TComponent)
+ private
+ FCloseQuery: Boolean;
+ FDefaultScriptLanguage: String;
+ FDefaultFont: TfrxFont;
+ FDefaultLeftMargin: Double;
+ FDefaultBottomMargin: Double;
+ FDefaultRightMargin: Double;
+ FDefaultTopMargin: Double;
+ FDefaultPaperSize: Integer;
+ FDefaultOrientation: TPrinterOrientation;
+ FOpenDir: String;
+ FSaveDir: String;
+ FTemplatesExt: String;
+ FTemplateDir: String;
+ FStandalone: Boolean;
+ FRestrictions: TfrxDesignerRestrictions;
+ FRTLLanguage: Boolean;
+ FMemoParentFont: Boolean;
+ FOnLoadReport: TfrxLoadReportEvent;
+ FOnLoadRecentReport: TfrxLoadRecentReportEvent;
+ FOnSaveReport: TfrxSaveReportEvent;
+ FOnShow: TNotifyEvent;
+ FOnInsertObject: TNotifyEvent;
+ FOnGetTemplateList: TfrxGetTemplateListEvent;
+ FOnShowStartupScreen: TNotifyEvent;
+ procedure SetDefaultFont(const Value: TfrxFont);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ published
+ property CloseQuery: Boolean read FCloseQuery write FCloseQuery default True;
+ property DefaultScriptLanguage: String read FDefaultScriptLanguage write FDefaultScriptLanguage;
+ property DefaultFont: TfrxFont read FDefaultFont write SetDefaultFont;
+ property DefaultLeftMargin: Double read FDefaultLeftMargin write FDefaultLeftMargin;
+ property DefaultRightMargin: Double read FDefaultRightMargin write FDefaultRightMargin;
+ property DefaultTopMargin: Double read FDefaultTopMargin write FDefaultTopMargin;
+ property DefaultBottomMargin: Double read FDefaultBottomMargin write FDefaultBottomMargin;
+ property DefaultPaperSize: Integer read FDefaultPaperSize write FDefaultPaperSize;
+ property DefaultOrientation: TPrinterOrientation read FDefaultOrientation write FDefaultOrientation;
+ property OpenDir: String read FOpenDir write FOpenDir;
+ property SaveDir: String read FSaveDir write FSaveDir;
+ property TemplatesExt: String read FTemplatesExt write FTemplatesExt;
+ property TemplateDir: String read FTemplateDir write FTemplateDir;
+ property Standalone: Boolean read FStandalone write FStandalone default False;
+ property Restrictions: TfrxDesignerRestrictions read FRestrictions write FRestrictions;
+ property RTLLanguage: Boolean read FRTLLanguage write FRTLLanguage;
+ property MemoParentFont: Boolean read FMemoParentFont write FMemoParentFont;
+ property OnLoadReport: TfrxLoadReportEvent read FOnLoadReport write FOnLoadReport;
+ property OnLoadRecentReport: TfrxLoadRecentReportEvent read FOnLoadRecentReport write FOnLoadRecentReport;
+ property OnSaveReport: TfrxSaveReportEvent read FOnSaveReport write FOnSaveReport;
+ property OnShow: TNotifyEvent read FOnShow write FOnShow;
+ property OnInsertObject: TNotifyEvent read FOnInsertObject write FOnInsertObject;
+ property OnShowStartupScreen: TNotifyEvent read FOnShowStartupScreen write FOnShowStartupScreen;
+ property OnGetTemplateList: TfrxGetTemplateListEvent read FOnGetTemplateList write FOnGetTemplateList;
+ end;
+
+ TfrxDesignerForm = class(TfrxCustomDesigner)
+ StatusBar: TStatusBar;
+ PagePopup: TPopupMenu;
+ MainMenu: TMenuBar;
+ FileMenu: TMenuItem;
+ EditMenu: TMenuItem;
+ ViewMenu: TMenuItem;
+ OptionsMI: TMenuItem;
+ HelpMenu: TMenuItem;
+ AboutMI: TMenuItem;
+ OpenDialog: TOpenDialog;
+ SaveDialog: TSaveDialog;
+ TabPopup: TPopupMenu;
+ NewPageMI1: TMenuItem;
+ NewDialogMI1: TMenuItem;
+ DeletePageMI1: TMenuItem;
+ PageSettingsMI1: TMenuItem;
+ NewMI: TMenuItem;
+ NewReportMI: TMenuItem;
+ NewPageMI: TMenuItem;
+ NewDialogMI: TMenuItem;
+ OpenMI: TMenuItem;
+ SaveMI: TMenuItem;
+ SaveAsMI: TMenuItem;
+ VariablesMI: TMenuItem;
+ PreviewMI: TMenuItem;
+ ExitMI: TMenuItem;
+ UndoMI: TMenuItem;
+ RedoMI: TMenuItem;
+ CutMI: TMenuItem;
+ CopyMI: TMenuItem;
+ PasteMI: TMenuItem;
+ DeleteMI: TMenuItem;
+ DeletePageMI: TMenuItem;
+ SelectAllMI: TMenuItem;
+ BringtoFrontMI: TMenuItem;
+ SendtoBackMI: TMenuItem;
+ EditMI: TMenuItem;
+ ObjectsTB1: TToolBar;
+ BandsPopup: TPopupMenu;
+ ReportTitleMI: TMenuItem;
+ ReportSummaryMI: TMenuItem;
+ PageHeaderMI: TMenuItem;
+ PageFooterMI: TMenuItem;
+ HeaderMI: TMenuItem;
+ FooterMI: TMenuItem;
+ MasterDataMI: TMenuItem;
+ DetailDataMI: TMenuItem;
+ SubdetailDataMI: TMenuItem;
+ GroupHeaderMI: TMenuItem;
+ GroupFooterMI: TMenuItem;
+ ColumnHeaderMI: TMenuItem;
+ ColumnFooterMI: TMenuItem;
+ ChildMI: TMenuItem;
+ PageSettingsMI: TMenuItem;
+ Timer: TTimer;
+ ReportSettingsMI: TMenuItem;
+ Data4levelMI: TMenuItem;
+ Data5levelMI: TMenuItem;
+ Data6levelMI: TMenuItem;
+ ShowGuidesMI: TMenuItem;
+ ShowRulersMI: TMenuItem;
+ DeleteGuidesMI: TMenuItem;
+ RotationPopup: TPopupMenu;
+ R0MI: TMenuItem;
+ R45MI: TMenuItem;
+ R90MI: TMenuItem;
+ R180MI: TMenuItem;
+ R270MI: TMenuItem;
+ ReportMenu: TMenuItem;
+ ReportDataMI: TMenuItem;
+ OpenScriptDialog: TOpenDialog;
+ SaveScriptDialog: TSaveDialog;
+ ObjectsPopup: TPopupMenu;
+ OverlayMI: TMenuItem;
+ ReportStylesMI: TMenuItem;
+ N2: TMenuItem;
+ FindMI: TMenuItem;
+ FindNextMI: TMenuItem;
+ ReplaceMI: TMenuItem;
+ DMPPopup: TPopupMenu;
+ BoldMI: TMenuItem;
+ ItalicMI: TMenuItem;
+ UnderlineMI: TMenuItem;
+ SuperScriptMI: TMenuItem;
+ SubScriptMI: TMenuItem;
+ CondensedMI: TMenuItem;
+ WideMI: TMenuItem;
+ N12cpiMI: TMenuItem;
+ N15cpiMI: TMenuItem;
+ VerticalbandsMI: TMenuItem;
+ HeaderMI1: TMenuItem;
+ FooterMI1: TMenuItem;
+ MasterDataMI1: TMenuItem;
+ DetailDataMI1: TMenuItem;
+ SubdetailDataMI1: TMenuItem;
+ GroupHeaderMI1: TMenuItem;
+ GroupFooterMI1: TMenuItem;
+ ChildMI1: TMenuItem;
+ N3: TMenuItem;
+ GroupMI: TMenuItem;
+ UngroupMI: TMenuItem;
+ BackPanel: TPanel;
+ ScrollBoxPanel: TPanel;
+ ScrollBox: TfrxScrollBox;
+ LeftRuler: TfrxRuler;
+ TopRuler: TfrxRuler;
+ CodePanel: TPanel;
+ CodeTB: TToolBar;
+ OpenScriptB: TfrxToolButton;
+ SaveScriptB: TfrxToolButton;
+ RunScriptB: TfrxToolButton;
+ RunToCursorB: TfrxToolButton;
+ StepScriptB: TfrxToolButton;
+ StopScriptB: TfrxToolButton;
+ EvaluateB: TfrxToolButton;
+ BreakPointB: TfrxToolButton;
+ TabPanel: TPanel;
+ TopToolBox: TToolBar;
+ AlignTB: TToolBar;
+ AlignLeftsB: TfrxToolButton;
+ AlignHorzCentersB: TfrxToolButton;
+ AlignRightsB: TfrxToolButton;
+ AlignTopsB: TfrxToolButton;
+ AlignVertCentersB: TfrxToolButton;
+ AlignBottomsB: TfrxToolButton;
+ SpaceHorzB: TfrxToolButton;
+ SpaceVertB: TfrxToolButton;
+ CenterHorzB: TfrxToolButton;
+ CenterVertB: TfrxToolButton;
+ SameWidthB: TfrxToolButton;
+ SameHeightB: TfrxToolButton;
+ ExtraToolsTB: TToolBar;
+ FrameTB: TToolBar;
+ FrameTopB: TfrxToolButton;
+ FrameBottomB: TfrxToolButton;
+ FrameLeftB: TfrxToolButton;
+ FrameRightB: TfrxToolButton;
+ FrameAllB: TfrxToolButton;
+ FrameNoB: TfrxToolButton;
+ ShadowB: TfrxToolButton;
+ FillColorB: TfrxToolButton;
+ FrameColorB: TfrxToolButton;
+ FrameStyleB: TfrxToolButton;
+ StandardTB: TToolBar;
+ NewB: TfrxToolButton;
+ OpenB: TfrxToolButton;
+ SaveB: TfrxToolButton;
+ PreviewB: TfrxToolButton;
+ NewPageB: TfrxToolButton;
+ NewDialogB: TfrxToolButton;
+ DeletePageB: TfrxToolButton;
+ PageSettingsB: TfrxToolButton;
+ CutB: TfrxToolButton;
+ CopyB: TfrxToolButton;
+ PasteB: TfrxToolButton;
+ UndoB: TfrxToolButton;
+ RedoB: TfrxToolButton;
+ GroupB: TfrxToolButton;
+ UngroupB: TfrxToolButton;
+ ShowGridB: TfrxToolButton;
+ AlignToGridB: TfrxToolButton;
+ SetToGridB: TfrxToolButton;
+ TextTB: TToolBar;
+ BoldB: TfrxToolButton;
+ ItalicB: TfrxToolButton;
+ UnderlineB: TfrxToolButton;
+ FontB: TfrxToolButton;
+ FontColorB: TfrxToolButton;
+ HighlightB: TfrxToolButton;
+ RotateB: TfrxToolButton;
+ TextAlignLeftB: TfrxToolButton;
+ TextAlignCenterB: TfrxToolButton;
+ TextAlignRightB: TfrxToolButton;
+ TextAlignBlockB: TfrxToolButton;
+ TextAlignTopB: TfrxToolButton;
+ TextAlignMiddleB: TfrxToolButton;
+ TextAlignBottomB: TfrxToolButton;
+ ScaleCB: TComboEdit;
+ LangCB: TComboEdit;
+ FrameWidthCB: TComboEdit;
+ FontNameCB: TComboEdit;
+ StyleCB: TComboEdit;
+ FontSizeCB: TComboEdit;
+ RightDockTB: TToolBar;
+ Splitter1: TSplitter;
+ LeftDockTB: TToolBar;
+ Splitter2: TSplitter;
+ StyleBook1: TStyleBook;
+ Sep1: TfrxToolSeparator;
+ Sep2: TfrxToolSeparator;
+ Sep4: TfrxToolSeparator;
+ Sep5: TfrxToolSeparator;
+ Sep6: TfrxToolSeparator;
+ Sep7: TfrxToolSeparator;
+ Sep8: TfrxToolSeparator;
+ Sep9: TfrxToolSeparator;
+ Sep10: TfrxToolSeparator;
+ Sep11: TfrxToolSeparator;
+ Sep12: TfrxToolSeparator;
+ Sep13: TfrxToolSeparator;
+ Sep14: TfrxToolSeparator;
+ Grip1: TfrxToolGrip;
+ Grip2: TfrxToolGrip;
+ Grip3: TfrxToolGrip;
+ Grip4: TfrxToolGrip;
+ HintPanel: TCalloutPanel;
+ Label1: TLabel;
+ procedure ExitCmdExecute(Sender: TObject);
+ procedure ObjectsButtonClick(Sender: TObject);
+// procedure StatusBarDrawPanel(StatusBar: TStatusBar;
+// Panel: TStatusPanel; const ARect: TRect);
+ procedure ScrollBoxMouseWheelUp(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
+ procedure ScrollBoxMouseWheelDown(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
+ procedure ScrollBoxResize(Sender: TObject);
+ procedure ScaleCBClick(Sender: TObject);
+ procedure ShowGridBClick(Sender: TObject);
+ procedure AlignToGridBClick(Sender: TObject);
+ procedure StatusBarDblClick(Sender: TObject);
+ procedure StatusBarMouseDown(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Single);
+ procedure InsertBandClick(Sender: TObject);
+ procedure BandsPopupPopup(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure NewReportCmdExecute(Sender: TObject);
+ procedure ToolButtonClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FontColorBClick(Sender: TObject);
+ procedure FrameStyleBClick(Sender: TObject);
+ procedure TabChange(Sender: TObject);
+ procedure UndoCmdExecute(Sender: TObject);
+ procedure RedoCmdExecute(Sender: TObject);
+ procedure CutCmdExecute(Sender: TObject);
+ procedure CopyCmdExecute(Sender: TObject);
+ procedure PasteCmdExecute(Sender: TObject);
+ procedure TimerTimer(Sender: TObject);
+ procedure DeletePageCmdExecute(Sender: TObject);
+ procedure NewDialogCmdExecute(Sender: TObject);
+ procedure NewPageCmdExecute(Sender: TObject);
+ procedure SaveCmdExecute(Sender: TObject);
+ procedure SaveAsCmdExecute(Sender: TObject);
+ procedure OpenCmdExecute(Sender: TObject);
+ procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+ procedure DeleteCmdExecute(Sender: TObject);
+ procedure SelectAllCmdExecute(Sender: TObject);
+ procedure EditCmdExecute(Sender: TObject);
+ procedure TabChanging(Sender: TObject; var AllowChange: Boolean);
+ procedure PageSettingsCmdExecute(Sender: TObject);
+ procedure TopRulerDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+ procedure AlignLeftsBClick(Sender: TObject);
+ procedure AlignRightsBClick(Sender: TObject);
+ procedure AlignTopsBClick(Sender: TObject);
+ procedure AlignBottomsBClick(Sender: TObject);
+ procedure AlignHorzCentersBClick(Sender: TObject);
+ procedure AlignVertCentersBClick(Sender: TObject);
+ procedure CenterHorzBClick(Sender: TObject);
+ procedure CenterVertBClick(Sender: TObject);
+ procedure SpaceHorzBClick(Sender: TObject);
+ procedure SpaceVertBClick(Sender: TObject);
+ procedure SelectToolBClick(Sender: TObject);
+ procedure RotateBClick(Sender: TObject);
+ procedure PagePopupPopup(Sender: TObject; X, Y: Single);
+ procedure BringToFrontCmdExecute(Sender: TObject);
+ procedure SendToBackCmdExecute(Sender: TObject);
+ procedure LangCBClick(Sender: TObject);
+ procedure OpenScriptBClick(Sender: TObject);
+ procedure SaveScriptBClick(Sender: TObject);
+ procedure CodeWindowDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+ procedure CodeWindowDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+ procedure VariablesCmdExecute(Sender: TObject);
+ procedure ObjectBandBClick(Sender: TObject);
+ procedure PreviewCmdExecute(Sender: TObject);
+ procedure HighlightBClick(Sender: TObject);
+ procedure TabMouseDown(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Single);
+ procedure TabMouseMove(Sender: TObject; Shift: TShiftState; X,
+ Y: Single);
+ procedure TabMouseUp(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Single);
+ procedure TabDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+ procedure TabDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+ procedure TabDragEnd(Sender: TObject);
+ procedure TabMouseLeave(Sender: TObject);
+ procedure SameWidthBClick(Sender: TObject);
+ procedure SameHeightBClick(Sender: TObject);
+ procedure NewItemCmdExecute(Sender: TObject);
+ procedure TabOrderMIClick(Sender: TObject);
+ procedure RunScriptBClick(Sender: TObject);
+ procedure StopScriptBClick(Sender: TObject);
+ procedure EvaluateBClick(Sender: TObject);
+ procedure GroupCmdExecute(Sender: TObject);
+ procedure UngroupCmdExecute(Sender: TObject);
+ procedure LangSelectClick(Sender: TObject);
+ procedure BreakPointBClick(Sender: TObject);
+ procedure RunToCursorBClick(Sender: TObject);
+ procedure TabSetChange(Sender: TObject; NewTab: Integer;
+ var AllowChange: Boolean);
+ procedure FormShow(Sender: TObject); override;
+ procedure AddChildMIClick(Sender: TObject);
+ procedure FindCmdExecute(Sender: TObject);
+ procedure ReplaceCmdExecute(Sender: TObject);
+ procedure FindNextCmdExecute(Sender: TObject);
+ procedure ReportDataCmdExecute(Sender: TObject);
+ procedure ReportStylesCmdExecute(Sender: TObject);
+ procedure ReportOptionsCmdExecute(Sender: TObject);
+ procedure ShowRulersCmdExecute(Sender: TObject);
+ procedure ShowGuidesCmdExecute(Sender: TObject);
+ procedure DeleteGuidesCmdExecute(Sender: TObject);
+ procedure OptionsCmdExecute(Sender: TObject);
+ procedure HelpContentsCmdExecute(Sender: TObject);
+ procedure AboutCmdExecute(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
+ procedure RightDockTBResize(Sender: TObject);
+ procedure FormResize(Sender: TObject);
+ procedure LeftDockTBResize(Sender: TObject);
+ procedure FormActivate(Sender: TObject);
+ procedure FrameWidthCBKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: Char; Shift: TShiftState);
+ procedure NewPageBMouseEnter(Sender: TObject);
+ procedure NewPageBMouseLeave(Sender: TObject);
+ procedure FontBClick(Sender: TObject);
+ private
+ { Private declarations }
+ ObjectSelectB: TfrxToolButton;
+ ObjectBandB: TfrxToolButton;
+
+ FClipboard: TfrxClipboard;
+ FCodeWindow: TfsSyntaxMemo;
+ FColor: TColor;
+ FCoord1: String;
+ FCoord2: String;
+ FCoord3: String;
+ FDialogForm: TfrxDialogForm;
+ FEditAfterInsert: Boolean;
+ FDataTree: TfrxDataTreeForm;
+ FDropFields: Boolean;
+ FGridAlign: Boolean;
+ FGridSize1: Double;
+ FGridSize2: Double;
+ FGridSize3: Double;
+ FGridSize4: Double;
+ FInspector: TfrxObjectInspector;
+ FLineStyle: TfrxFrameStyle;
+ FLocalizedOI: Boolean;
+ FLockSelectionChanged: Boolean;
+ FModifiedBy: TObject;
+ FMouseDown: Boolean;
+ FDragTabItem: TTabItem;
+ FMouseTabDX: Single;
+ FOldDesignerComp: TfrxDesigner;
+ FOldUnits: TfrxDesignerUnits;
+ FPagePositions: TStrings;
+ FPictureCache: TfrxPictureCache;
+ FRecentFiles: TStringList;
+// FRecentMenuIndex: Integer;
+ FReportTree: TfrxReportTreeForm;
+ FSampleFormat: TSampleFormat;
+ FScale: Double;
+ FScriptFirstTime: Boolean;
+ FScriptRunning: Boolean;
+ FScriptStep: Boolean;
+ FScriptStopped: Boolean;
+ FSearchCase: Boolean;
+ FSearchIndex: Integer;
+ FSearchReplace: Boolean;
+ FSearchReplaceText: String;
+ FSearchText: String;
+ FShowGrid: Boolean;
+ FShowGuides: Boolean;
+ FShowRulers: Boolean;
+ FShowStartup: Boolean;
+ FTabs: TTabControl;
+ FUndoBuffer: TfrxUndoBuffer;
+ FUnits: TfrxDesignerUnits;
+ FUnitsDblClicked: Boolean;
+ FUpdatingControls: Boolean;
+ FWatchList: TfrxWatchForm;
+ FWorkspace: TfrxDesignerWorkspace;
+ FTemplatePath: String;
+ FTemplateExt: String;
+ Splitter3: TSplitter;
+ FColorSelector: TfrxColorSelector;
+ FLineSelector: TfrxLineSelector;
+ procedure CreateColorSelector(Sender: TfrxToolButton);
+ procedure CreateExtraToolbar;
+ procedure CreateToolWindows;
+ procedure CreateObjectsToolbar;
+ procedure CreateWorkspace;
+ procedure FindOrReplace(replace: Boolean);
+ procedure FindText;
+ procedure OnCodeChanged(Sender: TObject);
+// procedure OnCodeCompletion(const Name: String; List: TStrings);
+ procedure OnColorChanged(Sender: TObject);
+ procedure OnComponentMenuClick(Sender: TObject);
+ procedure OnChangePosition(Sender: TObject);
+// procedure OnDataTreeDblClick(Sender: TObject);
+ procedure OnEditObject(Sender: TObject);
+// procedure OnExtraToolClick(Sender: TObject);
+ procedure OnInsertObject(Sender: TObject);
+ procedure OnModify(Sender: TObject);
+ procedure OnNotifyPosition(ARect: TfrxRect);
+ procedure OnRunLine(Sender: TfsScript; const UnitName, SourcePos: String);
+ procedure OnSelectionChanged(Sender: TObject);
+ procedure OnStyleChanged(Sender: TObject);
+ procedure OpenRecentFile(Sender: TObject);
+ procedure ReadButtonImages;
+ procedure ReloadObjects;
+ procedure RestorePagePosition;
+ procedure SavePagePosition;
+ procedure SaveState;
+ procedure SetScale(Value: Double);
+ procedure SetGridAlign(const Value: Boolean);
+ procedure SetShowGrid(const Value: Boolean);
+ procedure SetShowRulers(const Value: Boolean);
+ procedure SetUnits(const Value: TfrxDesignerUnits);
+ procedure SwitchToolbar;
+ procedure UpdateCaption;
+ procedure UpdateControls;
+ procedure UpdatePageDimensions;
+ procedure UpdateRecentFiles(NewFile: String);
+ procedure UpdateStyles;
+ procedure UpdateSyntaxType;
+ procedure UpdateWatches;
+ function AskSave: Word;
+ function GetPageIndex: Integer;
+ function GetReportName: String;
+ procedure SetShowGuides(const Value: Boolean);
+ procedure Localize;
+ procedure CreateLangMenu;
+ procedure SetGridSize1(const Value: Double);
+ procedure SetGridSize2(const Value: Double);
+ procedure SetGridSize3(const Value: Double);
+ procedure SetGridSize4(const Value: Double);
+ protected
+ procedure SetModified(const Value: Boolean); override;
+ procedure SetPage(const Value: TfrxPage); override;
+ function GetCode: TStrings; override;
+ public
+ { Public declarations }
+ procedure Init; override;
+ procedure Done; override;
+ function CheckOp(Op: TfrxDesignerRestriction): Boolean;
+ function InsertExpression(const Expr: String): String; override;
+ procedure LoadFile(FileName: String; UseOnLoadEvent: Boolean);
+ procedure Lock; override;
+ procedure ReloadPages(Index: Integer); override;
+ procedure ReloadReport; override;
+ procedure RestoreState(RestoreDefault: Boolean = False;
+ RestoreMainForm: Boolean = False);
+ function SaveFile(SaveAs: Boolean; UseOnSaveEvent: Boolean): Boolean;
+ procedure SetReportDefaults;
+ procedure SwitchToCodeWindow;
+ procedure UpdateDataTree; override;
+ procedure UpdatePage; override;
+ procedure UpdateInspector; override;
+ function GetDefaultObjectSize: TfrxPoint;
+ function mmToUnits(mm: Extended; X: Boolean = True): Extended;
+ function UnitsTomm(mm: Extended; X: Boolean = True): Extended;
+ procedure GetTemplateList(List: TStrings);
+
+ property CodeWindow: TfsSyntaxMemo read FCodeWindow;
+ property DataTree: TfrxDataTreeForm read FDataTree;
+ property DropFields: Boolean read FDropFields write FDropFields;
+ property EditAfterInsert: Boolean read FEditAfterInsert write FEditAfterInsert;
+ property GridAlign: Boolean read FGridAlign write SetGridAlign;
+ property GridSize1: Double read FGridSize1 write SetGridSize1;
+ property GridSize2: Double read FGridSize2 write SetGridSize2;
+ property GridSize3: Double read FGridSize3 write SetGridSize3;
+ property GridSize4: Double read FGridSize4 write SetGridSize4;
+ property Inspector: TfrxObjectInspector read FInspector;
+ property PictureCache: TfrxPictureCache read FPictureCache;
+ property RecentFiles: TStringList read FRecentFiles;
+ property ReportTree: TfrxReportTreeForm read FReportTree;
+ property SampleFormat: TSampleFormat read FSampleFormat;
+ property Scale: Double read FScale write SetScale;
+ property ShowGrid: Boolean read FShowGrid write SetShowGrid;
+ property ShowGuides: Boolean read FShowGuides write SetShowGuides;
+ property ShowRulers: Boolean read FShowRulers write SetShowRulers;
+ property ShowStartup: Boolean read FShowStartup write FShowStartup;
+ property Units: TfrxDesignerUnits read FUnits write SetUnits;
+ property Workspace: TfrxDesignerWorkspace read FWorkspace;
+ property TemplatePath: String read FTemplatePath write FTemplatePath;
+ end;
+
+ TSampleFormat = class(TObject)
+ private
+ FMemo: TfrxCustomMemoView;
+ procedure Clear;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure ApplySample(Memo: TfrxCustomMemoView);
+ procedure SetAsSample(Memo: TfrxCustomMemoView);
+ property Memo: TfrxCustomMemoView read FMemo;
+ end;
+
+ TfrxCustomSavePlugin = class(TObject)
+ public
+ FileFilter: String;
+ procedure Save(Report: TfrxReport; const FileName: String); virtual; abstract;
+ end;
+
+var
+ frxDesignerComp: TfrxDesigner;
+ frxSavePlugin: TfrxCustomSavePlugin;
+
+implementation
+{$IFDEF DELPHI23}
+{$R FMX.frxDesgn_D23.FMX}
+{$ELSE}
+{$R *.FMX}
+{$ENDIF}
+{$R *.RES}
+
+uses
+ System.TypInfo, System.IniFiles,
+ FMX.frxDsgnIntf, FMX.frxUtils, FMX.frxDesgnWorkspace1,
+ FMX.frxDesgnEditors, FMX.frxEditOptions, FMX.frxEditReport, FMX.frxEditPage, FMX.frxAbout,
+ FMX.fs_itools, FMX.frxXML, FMX.frxEditReportData, FMX.frxEditVar, FMX.frxEditExpr,
+ FMX.frxEditHighlight, FMX.frxEditStyle, {FMX.frxNewItem, FMX.frxStdWizard,} FMX.frxFontForm,
+ FMX.frxEditTabOrder, FMX.frxCodeUtils, FMX.frxRes, FMX.frxrcDesgn, FMX.frxDMPClass, FMX.TreeView, FMX.Platform,
+ FMX.frxEvaluateForm, FMX.frxSearchDialog, {FMX.frxConnEditor,} FMX.fs_xml, FMX.frxVariables, FMX.frxBaseModalForm;
+
+
+ Type THackControl = class(TControl);
+
+{ TSampleFormat }
+
+constructor TSampleFormat.Create;
+begin
+ Clear;
+end;
+
+destructor TSampleFormat.Destroy;
+begin
+ FMemo.Free;
+ inherited;
+end;
+
+procedure TSampleFormat.Clear;
+begin
+ if FMemo <> nil then
+ FMemo.Free;
+ FMemo := TfrxMemoView.Create(nil);
+ if frxDesignerComp <> nil then
+ begin
+ FMemo.Font := frxDesignerComp.DefaultFont;
+ FMemo.RTLReading := frxDesignerComp.RTLLanguage;
+ FMemo.ParentFont := frxDesignerComp.MemoParentFont;
+ end;
+end;
+
+procedure TSampleFormat.ApplySample(Memo: TfrxCustomMemoView);
+begin
+ Memo.Color := FMemo.Color;
+ if not (Memo is TfrxDMPMemoView) then
+ Memo.Font := FMemo.Font;
+ Memo.Frame.Assign(FMemo.Frame);
+ Memo.HAlign := FMemo.HAlign;
+ Memo.VAlign := FMemo.VAlign;
+ Memo.RTLReading := FMemo.RTLReading;
+ Memo.ParentFont := FMemo.ParentFont;
+end;
+
+procedure TSampleFormat.SetAsSample(Memo: TfrxCustomMemoView);
+begin
+ FMemo.Color := Memo.Color;
+ if not (Memo is TfrxDMPMemoView) then
+ FMemo.Font := Memo.Font;
+ FMemo.Frame.Assign(Memo.Frame);
+ FMemo.HAlign := Memo.HAlign;
+ FMemo.VAlign := Memo.VAlign;
+ FMemo.RTLReading := Memo.RTLReading;
+ Memo.ParentFont := FMemo.ParentFont;
+end;
+
+
+{ TfrxDesigner }
+
+constructor TfrxDesigner.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+
+ FCloseQuery := True;
+ FDefaultFont := TfrxFont.Create;
+ with FDefaultFont do
+ begin
+ {$IFDEF LINUX}
+ Name := 'Liberation Sans';
+ {$ELSE}
+ Name := 'Arial';
+ {$ENDIF}
+ end;
+ FDefaultScriptLanguage := 'PascalScript';
+ FTemplatesExt := 'fr3';
+ FDefaultLeftMargin := 10;
+ FDefaultBottomMargin := 10;
+ FDefaultRightMargin := 10;
+ FDefaultTopMargin := 10;
+ FDefaultPaperSize := DMPAPER_A4;
+ FDefaultOrientation := poPortrait;
+ frxDesignerComp := Self;
+end;
+
+destructor TfrxDesigner.Destroy;
+begin
+ FDefaultFont.Free;
+ frxDesignerComp := nil;
+ inherited Destroy;
+end;
+
+procedure TfrxDesigner.SetDefaultFont(const Value: TfrxFont);
+begin
+ FDefaultFont.Assign(Value);
+end;
+
+
+{ TfrxDesignerForm }
+
+{ Form events }
+{------------------------------------------------------------------------------}
+
+procedure TfrxDesignerForm.FormShow(Sender: TObject);
+begin
+ ReadButtonImages;
+ CreateObjectsToolbar;
+ CreateWorkspace;
+ CreateToolWindows;
+ Init;
+ CreateExtraToolbar;
+
+ Localize;
+ CreateLangMenu;
+
+ with ScaleCB.Items do
+ begin
+ Clear;
+ Add('25%');
+ Add('50%');
+ Add('75%');
+ Add('100%');
+ Add('150%');
+ Add('200%');
+ Add(frxResources.Get('zmPageWidth'));
+ Add(frxResources.Get('zmWholePage'));
+ end;
+
+// if Screen.PixelsPerInch > 96 then
+// begin
+// StyleCB.Font.Height := -11;
+// FontNameCB.Font.Height := -11;
+// FontSizeCB.Font.Height := -11;
+// ScaleCB.Font.Height := -11;
+// FrameWidthCB.Font.Height := -11;
+// LangL.Font.Height := -11;
+// LangCB.Font.Height := -11;
+// end;
+ R45MI.HelpContext := 45;
+ R90MI.HelpContext := 90;
+ R180MI.HelpContext := 180;
+ R270MI.HelpContext := 270;
+ FontSizeCB.DropDownCount := FontSizeCB.Items.Count;
+
+ RestoreState;
+ ReloadReport;
+ RestoreState(False, True);
+
+ if frxDesignerComp <> nil then
+ begin
+ FTemplatePath := frxDesignerComp.FTemplateDir;
+ if Assigned(frxDesignerComp.FOnShow) then
+ frxDesignerComp.FOnShow(Self);
+ end;
+ if FTemplatePath = '' then
+ FTemplatePath := Report.GetApplicationFolder;
+ FileMenu.Visible := True;
+ OpenMI.Visible := True;
+ if (csDesigning in Report.ComponentState) then
+ BorderIcons := BorderIcons - [TBorderIcon.biMinimize];
+
+{$IFDEF LINUX}
+ ScaleCB.Width := 66;
+ FontSizeCB.Width := 46;
+{$ENDIF}
+end;
+
+procedure TfrxDesignerForm.FormActivate(Sender: TObject);
+begin
+ FDataTree.FormResize(Self);
+ FInspector.FormResize(Self);
+{$IFNDEF DELPHI20}
+ MainMenu.UpdateStyle;
+{$ENDIF}
+ FileMenu.Visible := True;
+ OpenMI.Visible := True;
+end;
+
+procedure TfrxDesignerForm.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+ SaveState;
+ BeginUpdate;
+ Done;
+ Report.Modified := Modified;
+ if not (TFmxFormState.fsModal in FormState) then
+ begin
+ Report.Designer := nil;
+ Action := TCloseAction.caFree;
+ end;
+end;
+
+procedure TfrxDesignerForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+var
+ w: Word;
+begin
+ FInspector.FormDeactivate(nil);
+ if FScriptRunning then
+ begin
+ CanClose := False;
+ Exit;
+ end;
+ CanClose := True;
+ Report.ScriptText := CodeWindow.Lines;
+
+ if (frxDesignerComp <> nil) and not frxDesignerComp.CloseQuery then
+ Exit;
+
+ if Modified and not (csDesigning in Report.ComponentState) and CheckOp(drDontSaveReport) then
+ begin
+ w := AskSave;
+
+ if IsPreviewDesigner then
+ begin
+ if w = mrNo then
+ Modified := False
+ end
+ else if w = mrYes then
+ if not SaveFile(False, True) then
+ CanClose := False;
+
+ if not IsPreviewDesigner then
+ begin
+ if w = mrNo then
+ Modified := False
+ else
+ Modified := True;
+ end;
+
+ if w = mrCancel then
+ CanClose := False;
+ end;
+end;
+
+procedure TfrxDesignerForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = vkReturn then
+ if ActiveControl = FontSizeCB then
+ ToolButtonClick(FontSizeCB)
+ else if ActiveControl = ScaleCB then
+ ScaleCBClick(Self);
+
+ if (Page <> nil) and (FWorkspace.IsFocused) then
+ begin
+ if Key = vkInsert then
+ if Shift = [ssShift] then
+ begin
+ PasteCmdExecute(nil);
+ Key := 0;
+ end
+ else if Shift = [ssCtrl] then
+ begin
+ CopyCmdExecute(nil);
+ Key := 0;
+ end;
+
+ if Key = vkDelete then
+ if Shift = [ssShift] then
+ begin
+ CutCmdExecute(nil);
+ Key := 0;
+ end;
+
+ if (Shift = [ssCtrl]) or (Shift = [ssCommand]) then
+ if Key = Ord('C') then
+ begin
+ CopyCmdExecute(nil);
+ Key := 0;
+ end
+ else if Key = Ord('V') then
+ begin
+ PasteCmdExecute(nil);
+ Key := 0;
+ end
+ else if Key = Ord('X') then
+ begin
+ CutCmdExecute(nil);
+ Key := 0;
+ end;
+ end;
+
+ if (Key = Ord('E')) and (Shift = [ssCtrl]) then
+ Page := nil;
+
+ if ((Key = vkF4) or (Key = vkF5)) and (Shift = []) and (Page = nil) then
+ begin
+ if Key = vkF4 then
+ RunToCursorBClick(nil)
+ else
+ BreakPointBClick(nil);
+ end
+ else if (Key = vkF2) and (Shift = [ssCtrl]) then
+ StopScriptBClick(StopScriptB)
+ else if (Key = vkF7) and (Shift = [ssCtrl]) and (Page = nil) then
+ EvaluateBClick(EvaluateB)
+ else if Key = vkF9 then
+ RunScriptBClick(RunScriptB)
+ else if ((Key = vkF7) or (Key = vkF8)) and (Page = nil) then
+ RunScriptBClick(StepScriptB);
+end;
+
+procedure TfrxDesignerForm.RightDockTBResize(Sender: TObject);
+begin
+ if FDataTree <> nil then
+ FDataTree.UpdateSize;
+end;
+
+{ Get/Set methods }
+{------------------------------------------------------------------------------}
+
+function TfrxDesignerForm.GetDefaultObjectSize: TfrxPoint;
+begin
+ case FUnits of
+ duCM: Result := frxPoint(fr1cm * 2.5, fr1cm * 0.5);
+ duInches: Result := frxPoint(fr1in, fr1in * 0.2);
+ duPixels: Result := frxPoint(80, 16);
+ duChars: Result := frxPoint(fr1CharX * 10, fr1CharY);
+ end;
+end;
+
+function TfrxDesignerForm.GetCode: TStrings;
+begin
+ Result := CodeWindow.Lines;
+end;
+
+procedure TfrxDesignerForm.SetGridAlign(const Value: Boolean);
+begin
+ FGridAlign := Value;
+ AlignToGridB.IsPressed := FGridAlign;
+ FWorkspace.GridAlign := FGridAlign;
+end;
+
+procedure TfrxDesignerForm.SetModified(const Value: Boolean);
+var
+ i: Integer;
+begin
+ inherited;
+ Report.ScriptText := CodeWindow.Lines;
+ if IsPreviewDesigner then
+ FUndoBuffer.AddUndo(FPage)
+ else
+ FUndoBuffer.AddUndo(Report);
+ FUndoBuffer.ClearRedo;
+ SaveMI.Visible := Modified;
+ SaveB.Enabled := Modified;
+// SaveCmd.Enabled := Modified;
+
+ if FModifiedBy <> Self then
+ UpdateControls;
+
+ if FModifiedBy = FInspector then
+ if (FSelectedObjects[0] = FPage) {or
+ (TObject(FSelectedObjects[0]) is TfrxSubreport)} then
+ begin
+ FLockSelectionChanged := True;
+ try
+ i := Report.Objects.IndexOf(FPage);
+ if i >= 0 then
+ ReloadPages(i);
+ finally
+ FLockSelectionChanged := False;
+ end;
+ end;
+
+ if FModifiedBy <> FWorkspace then
+ begin
+ FWorkspace.UpdateView;
+ FWorkspace.AdjustBands;
+ end;
+
+ if FModifiedBy <> FInspector then
+ FInspector.UpdateProperties;
+
+ FReportTree.UpdateItems;
+ FModifiedBy := nil;
+end;
+
+procedure TfrxDesignerForm.SetPage(const Value: TfrxPage);
+begin
+ inherited;
+
+ FTabs.TabIndex := Report.Objects.IndexOf(FPage) + 1;
+ ScrollBoxPanel.Visible := FPage <> nil;
+ CodePanel.Visible := FPage = nil;
+
+ SwitchToolbar;
+ UpdateControls;
+
+ if FPage = nil then
+ begin
+ CodeWindow.SetFocus;
+ Exit;
+ end
+ else if FPage is TfrxReportPage then
+ begin
+ with FWorkspace do
+ begin
+ Parent := ScrollBox;
+ Align := TAlignLayout.alNone;
+ Color := claWhite;
+ Scale := Self.Scale;
+ end;
+
+ if FPage is TfrxDMPPage then
+ Units := duChars else
+ Units := FOldUnits;
+ UpdatePageDimensions;
+ if Visible then
+ ScrollBox.SetFocus;
+ end
+ else if FPage is TfrxDialogPage then
+ begin
+ FDialogForm := TfrxDialogForm(TfrxDialogPage(FPage).DialogForm);
+ Units := duPixels;
+ with FWorkspace do
+ begin
+ FWorkspace.Parent := ScrollBox;
+ Align := TAlignLayout.alNone;
+ GridType := gtDialog;
+ GridX := FGridSize4;
+ GridY := FGridSize4;
+ Color := TfrxDialogPage(FPage).Color;
+ Scale := 1;
+ end;
+
+ UpdatePageDimensions;
+ if Visible then
+ ScrollBox.SetFocus;
+ end
+ else if FPage is TfrxDataPage then
+ begin
+ Units := duPixels;
+ with FWorkspace do
+ begin
+ Parent := ScrollBox;
+ Align := TAlignLayout.alNone;
+ Color := claWhite;
+ Scale := 1;
+ GridType := gtNone;
+ GridX := FGridSize4;
+ GridY := FGridSize4;
+ end;
+
+ UpdatePageDimensions;
+ if Visible then
+ ScrollBox.SetFocus;
+ end
+ else
+ begin
+ Report.Errors.Add('Page object is not page');
+ end;
+
+ ReloadObjects;
+ RestorePagePosition;
+end;
+
+procedure TfrxDesignerForm.SetScale(Value: Double);
+begin
+ //ScrollBox.AutoScroll := False;
+ if Value = 0 then
+ Value := 1;
+ if Value > 20 then
+ Value := 20;
+ FScale := Value;
+ TopRuler.Scale := Value;
+ LeftRuler.Scale := Value;
+ FWorkspace.Scale := Value;
+ ScaleCB.OnChange := nil;
+ ScaleCB.Text := IntToStr(Round(FScale * 100)) + '%';
+ ScaleCB.OnChange := ScaleCBClick;
+ UpdatePageDimensions;
+ //ScrollBox.AutoScroll := True;
+end;
+
+procedure TfrxDesignerForm.SetShowGrid(const Value: Boolean);
+begin
+ FShowGrid := Value;
+ ShowGridB.IsPressed := FShowGrid;
+ FWorkspace.ShowGrid := FShowGrid;
+end;
+
+procedure TfrxDesignerForm.SetShowRulers(const Value: Boolean);
+begin
+ FShowRulers := Value;
+ TopRuler.Visible := FShowRulers;
+ LeftRuler.Visible := FShowRulers;
+ ShowRulersMI.IsChecked := FShowRulers;
+// ShowRulersCmd.Checked := FShowRulers;
+end;
+
+procedure TfrxDesignerForm.SetShowGuides(const Value: Boolean);
+begin
+ FShowGuides := Value;
+ TDesignerWorkspace(FWorkspace).ShowGuides := FShowGuides;
+ ShowGuidesMI.IsChecked := FShowGuides;
+end;
+
+procedure TfrxDesignerForm.SetUnits(const Value: TfrxDesignerUnits);
+var
+ s: String;
+ gType: TfrxGridType;
+ gSizeX, gSizeY: Extended;
+begin
+ FUnits := Value;
+ s := '';
+ if FUnits = duCM then
+ begin
+ s := frxResources.Get('dsCm');
+ gType := gt1cm;
+ gSizeX := FGridSize1 * fr1cm;
+ gSizeY := gSizeX;
+ end
+ else if FUnits = duInches then
+ begin
+ s := frxResources.Get('dsInch');
+ gType := gt1in;
+ gSizeX := FGridSize2 * fr1in;
+ gSizeY := gSizeX;
+ end
+ else if FUnits = duPixels then
+ begin
+ s := frxResources.Get('dsPix');
+ gType := gt1pt;
+ gSizeX := FGridSize3;
+ gSizeY := gSizeX;
+ end
+ else {if FUnits = duChars then}
+ begin
+ s := frxResources.Get('dsChars');
+ gType := gtChar;
+ gSizeX := fr1CharX;
+ gSizeY := fr1CharY;
+ end;
+
+ //StatusBar.Panels[0].Text := s;
+ TopRuler.Units := TfrxRulerUnits(FUnits);
+ LeftRuler.Units := TfrxRulerUnits(FUnits);
+
+ with FWorkspace do
+ begin
+ GridType := gType;
+ GridX := gSizeX;
+ GridY := gSizeY;
+ AdjustBands;
+ end;
+
+ if FSelectedObjects.Count <> 0 then
+ OnSelectionChanged(Self);
+end;
+
+
+{ Service methods }
+{------------------------------------------------------------------------------}
+
+procedure TfrxDesignerForm.Init;
+var
+ i: Integer;
+begin
+ Label1.WordWrap := True;
+ FPictureCache := TfrxPictureCache.Create;
+ FScale := 1;
+ ScrollBoxPanel.Align := alClient;
+ ScrollBox.ShowScrollBars := true;
+{$IFNDEF MSWINDOWS}
+ {$IFDEF DELPHI18}
+ ScrollBox.AutoHide := false;
+ {$ENDIF}
+{$ENDIF}
+{$IFDEF DELPHI19}
+ ScrollBox.AniCalculations.AutoShowing := false;
+{$ENDIF}
+ CodePanel.Align := alClient;
+ ScrollBoxPanel.StyleLookup := 'backgroundstyle';
+ BackPanel.StyleLookup := 'backgroundstyle';
+ TabPanel.StyleLookup := 'backgroundstyle';
+ RightDockTB.StyleLookup := 'backgroundstyle';
+ LeftDockTB.StyleLookup := 'backgroundstyle';
+
+// if Screen.PixelsPerInch > 96 then
+// begin
+// StatusBar.Panels[0].Width := 100;
+// StatusBar.Panels[1].Width := 280;
+// StatusBar.Height := 24;
+// end;
+
+
+ LangCB.OnChange := nil;
+ fsGetLanguageList(LangCB.Items);
+ LangCB.OnChange := LangCBClick;
+ frxAddCodeRes;
+
+ FUndoBuffer := TfrxUndoBuffer.Create;
+ FUndoBuffer.PictureCache := FPictureCache;
+
+ FClipboard := TfrxClipboard.Create(Self);
+ FClipboard.PictureCache := FPictureCache;
+ Timer.Enabled := True;
+
+ FRecentFiles := TStringList.Create;
+// FRecentMenuIndex := FileMenu.IndexOf(SepMI4);
+ FSampleFormat := TSampleFormat.Create;
+ FPagePositions := TStringList.Create;
+ for i := 1 to 256 do
+ FPagePositions.Add('');
+
+ if IsPreviewDesigner then
+ begin
+ FOldDesignerComp := frxDesignerComp;
+ TfrxDesigner.Create(nil);
+ frxDesignerComp.Restrictions := [drDontDeletePage, drDontCreatePage,
+ drDontCreateReport, drDontLoadReport, drDontPreviewReport,
+ drDontEditVariables, drDontChangeReportOptions];
+ if FOldDesignerComp <> nil then
+ frxDesignerComp.Restrictions := frxDesignerComp.Restrictions + FOldDesignerComp.Restrictions;
+
+ ObjectBandB.Enabled := False;
+ end;
+{$IFDEF LINUX}
+
+{$ELSE}
+ Report.SelectPrinter;
+{$ENDIF}
+
+ FontNameCB.BeginUpdate;
+ FontNameCB.Clear;
+ FillFontsList(FontNameCB.Items);
+{ for i := 0 to FontNameCB.ListBox.Count - 1 do
+ begin
+ FontNameCB.ListBox.ListItems[i].Font.Family := FontNameCB.Items[i];
+ FontNameCB.ListBox.ListItems[i].Font.Size := 14;
+ end;}
+
+ FontNameCB.EndUpdate;
+
+ NewMI.Visible := False;
+
+{$IFDEF FR_VER_BASIC}
+ NewDialogMI1.Enabled := False;
+ NewDialogMI.Enabled := False;
+ NewDialogB.Enabled := False;
+{$ENDIF}
+
+ NewReportMI.Enabled := CheckOp(drDontCreateReport);
+ NewMI.Enabled := CheckOp(drDontCreateReport);
+ NewPageMI.Enabled := CheckOp(drDontCreatePage);
+ NewDialogMI1.Enabled := NewDialogMI1.Enabled and CheckOp(drDontCreatePage);
+ SaveAsMI.Enabled := CheckOp(drDontSaveReport);
+ OpenMI.Enabled := CheckOp(drDontLoadReport);
+ ReportSettingsMI.Enabled := CheckOp(drDontChangeReportOptions);
+ ReportStylesMI.Enabled := CheckOp(drDontChangeReportOptions);
+ ReportDataMI.Enabled := CheckOp(drDontEditReportData);
+ VariablesMI.Enabled := CheckOp(drDontEditVariables);
+ PreviewMI.Enabled := CheckOp(drDontPreviewReport);
+end;
+
+procedure TfrxDesignerForm.Done;
+begin
+ if IsPreviewDesigner then
+ begin
+ frxDesignerComp.Free;
+ frxDesignerComp := FOldDesignerComp;
+ end;
+
+ FPictureCache.Free;
+ FUndoBuffer.Free;
+ FClipboard.Free;
+ FRecentFiles.Free;
+ FSampleFormat.Free;
+ FPagePositions.Free;
+end;
+
+procedure TfrxDesignerForm.ReadButtonImages;
+begin
+end;
+
+procedure TfrxDesignerForm.CreateToolWindows;
+begin
+ FInspector := TfrxObjectInspector.Create(Self);
+ with FInspector do
+ begin
+ OnModify := Self.OnModify;
+ OnSelectionChanged := Self.OnSelectionChanged;
+ FInspector.MainPanel.Parent := LeftDockTB;
+ FInspector.Visible := False;
+ SelectedObjects := FSelectedObjects;
+ end;
+
+ FDataTree := TfrxDataTreeForm.Create(Self);
+ with FDataTree do
+ begin
+ Report := Self.Report;
+ CBPanel.Visible := True;
+ FDataTree.MainDataPanel.Parent := RightDockTB;
+ end;
+ UpdateDataTree;
+
+ Splitter3 := TSplitter.Create(Self);
+ Splitter3.Align := TAlignLayout.alTop;
+ Splitter3.Height := 5;
+ Splitter3.MinSize := 100;
+ Splitter3.Parent := LeftDockTB;
+
+ FReportTree := TfrxReportTreeForm.Create(Self);
+ FReportTree.OnSelectionChanged := OnSelectionChanged;
+ FReportTree.MainPanel.Parent := LeftDockTB;
+ FReportTree.MainPanel.Align := TAlignLayout.alMostTop;
+ FReportTree.MainPanel.Height := Round(LeftDockTB.Height / 2);
+
+ FWatchList := TfrxWatchForm.Create(Self);
+ FWatchList.Script := Report.Script;
+end;
+
+procedure TfrxDesignerForm.CreateWorkspace;
+begin
+ FWorkspace := TDesignerWorkspace.Create(Self);
+ with FWorkspace do
+ begin
+ Parent := ScrollBox;
+ OnNotifyPosition := Self.OnNotifyPosition;
+ OnInsert := OnInsertObject;
+ OnEdit := OnEditObject;
+ OnModify := Self.OnModify;
+ OnSelectionChanged := Self.OnSelectionChanged;
+ OnPopup := PagePopupPopup;
+ Objects := FObjects;
+ SelectedObjects := FSelectedObjects;
+ end;
+
+ FCodeWindow := TfsSyntaxMemo.Create(Self);
+ with FCodeWindow do
+ begin
+ Parent := CodePanel;
+ Align := alClient;
+ Lines := Report.ScriptText;
+ //Color := claWhite;
+ OnChange := OnCodeChanged;
+ //OnChangePos := OnChangePosition;
+ OnDragOver := CodeWindowDragOver;
+ OnDragDrop := CodeWindowDragDrop;
+ //OnCodeCompletion := Self.OnCodeCompletion;
+ end;
+
+
+ FTabs := TTabControl.Create(Self);
+ FTabs.OnChange := TabChange;
+ //FTabs.OnChanging := TabChanging;
+ FTabs.Parent := TabPanel;
+ FTabs.TabHeight := 20;
+ TabPanel.Margins.Top := 3;
+ FTabs.Align := TAlignLayout.alTop;
+ FTabs.Height := TabPanel.Height - TabPanel.Margins.Top;
+ FTabs.StyleLookup := 'TabControl1Style1';
+ ScrollBoxPanel.Margins.Top := 2;
+ FMouseTabDX := 0;
+end;
+
+procedure TfrxDesignerForm.CreateObjectsToolbar;
+var
+ i: Integer;
+ ObjCount: Integer;
+ Item: TfrxObjectItem;
+
+ function HasButtons(Item: TfrxObjectItem): Boolean;
+ var
+ i: Integer;
+ Item1: TfrxObjectItem;
+ begin
+ Result := False;
+ for i := 0 to frxObjects.Count - 1 do
+ begin
+ Item1 := frxObjects[i];
+ if (Item1.ClassRef <> nil) and (Item1.CategoryName = Item.CategoryName) then
+ Result := True;
+ end;
+ end;
+
+ procedure CreateButton(Index: Integer; Item: TfrxObjectItem);
+ var
+ b: TfrxToolButton;
+ s: String;
+ begin
+ b := TfrxToolButton.Create(Self);
+ b.Parent := ObjectsTB1;
+ frxResources.LoadImageFromResouce(b.Bitmap, Item.ButtonImageIndex);
+ b.SetBounds(0, 30, 30, 30);
+ b.Align := TAlignLayout.alTop;
+ s := Item.ButtonHint;
+ if s = '' then
+ begin
+ if Item.ClassRef <> nil then
+ s := Item.ClassRef.GetDescription;
+ end
+ else
+ s := frxResources.Get(s);
+ b.Hint := s;
+ b.OnMouseEnter := NewPageBMouseEnter;
+ b.OnMouseLeave := NewPageBMouseLeave;
+ b.Tag := Index;
+ if Item.ClassRef = nil then { category }
+ if not HasButtons(Item) then
+ begin
+ b.Free;
+ Exit;
+ end;
+ b.OnClick := ObjectsButtonClick;
+ end;
+
+begin
+ ObjectSelectB := TfrxToolButton.Create(Self);
+ with ObjectSelectB do
+ begin
+ Parent := ObjectsTB1;
+ StaysPressed := True;
+ Down := True;
+ Align := TAlignLayout.alTop;
+ Height := 30;
+ frxResources.LoadImageFromResouce(Bitmap, 10, 0);
+ OnClick := SelectToolBClick;
+ end;
+
+ ObjectBandB := TfrxToolButton.Create(Self);
+ with ObjectBandB do
+ begin
+ Parent := ObjectsTB1;
+ Tag := 1000;
+ Align := TAlignLayout.alTop;
+ Height := 30;
+ frxResources.LoadImageFromResouce(Bitmap, 21, 8);
+ OnClick := ObjectBandBClick;
+ end;
+
+ ObjCount := frxObjects.Count - 1;
+
+ { add category buttons }
+ for i := ObjCount downto 0 do
+ begin
+ Item := frxObjects[i];
+{ if (Item.ButtonBmp <> nil) and (Item.ButtonImageIndex = -1) then
+ begin
+ frxResources.SetObjectImages(Item.ButtonBmp);
+ Item.ButtonImageIndex := frxResources.ObjectImages.Count - 1;
+ end;}
+ if Item.ClassRef = nil then
+ CreateButton(i, Item);
+ end;
+
+ { add object buttons }
+ for i := ObjCount downto 0 do
+ begin
+ Item := frxObjects[i];
+{ if (Item.ButtonBmp <> nil) and (Item.ButtonImageIndex = -1) then
+ begin
+ frxResources.SetObjectImages(Item.ButtonBmp);
+ Item.ButtonImageIndex := frxResources.ObjectImages.Count - 1;
+ end;}
+
+ if (Item.ClassRef <> nil) and (Item.CategoryName = '') then
+ CreateButton(i, Item);
+ end;
+end;
+
+procedure TfrxDesignerForm.CreateExtraToolbar;
+//var
+// i: Integer;
+// Item: TfrxWizardItem;
+// b: TfrxToolButton;
+begin
+{ for i := 0 to frxWizards.Count - 1 do
+ begin
+ Item := frxWizards[i];
+ if Item.IsToolbarWizard then
+ begin
+ b := TfrxToolButton.Create(Self);
+ with b do
+ begin
+ Tag := i;
+ if (Item.ButtonBmp <> nil) and (Item.ButtonImageIndex = -1) then
+ begin
+ frxResources.SetButtonImages(Item.ButtonBmp);
+ Item.ButtonImageIndex := frxResources.MainButtonImages.Count - 1;
+ end;
+ //ImageIndex := Item.ButtonImageIndex;
+ Hint := Item.ClassRef.GetDescription;
+ SetBounds(1000, 0, 22, 22);
+ Parent := ExtraToolsTB;
+ end;
+ b.OnClick := OnExtraToolClick;
+ end;
+ end;
+
+ ExtraToolsTB.Height := 27;
+ ExtraToolsTB.Width := 27;}
+end;
+
+procedure TfrxDesignerForm.ReloadReport;
+var
+ i: Integer;
+ l: TList;
+ c: TfrxComponent;
+ p: TfrxPage;
+ isDMP: Boolean;
+begin
+ if Report.PagesCount = 0 then
+ begin
+ isDMP := Report.DotMatrixReport;
+ p := TfrxDataPage.Create(Report);
+ p.Name := 'Data';
+ if isDMP then
+ p := TfrxDMPPage.Create(Report)
+ else
+ begin
+ p := TfrxReportPage.Create(Report);
+ TfrxReportPage(p).SetDefaults;
+ end;
+ p.Name := 'Page1';
+ end;
+
+ if not IsPreviewDesigner then
+ Report.CheckDataPage;
+ LangCB.OnChange := nil;
+ LangCB.ItemIndex := LangCB.Items.IndexOf(Report.ScriptLanguage);
+ LangCB.OnChange := LangCBClick;
+ CodeWindow.Lines := Report.ScriptText;
+ UpdateSyntaxType;
+ ReloadPages(-2);
+ UpdateRecentFiles(Report.FileName);
+ UpdateCaption;
+ UpdateStyles;
+
+ FPictureCache.Clear;
+ l := Report.AllObjects;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if c is TfrxPictureView then
+ FPictureCache.AddPicture(TfrxPictureView(c));
+ end;
+
+ FUndoBuffer.ClearUndo;
+ Modified := False;
+end;
+
+procedure TfrxDesignerForm.ReloadPages(Index: Integer);
+var
+ i: Integer;
+ c: TfrxPage;
+ s: String;
+ tItem: TTabItem;
+begin
+{$IFDEF Delphi20}
+ FTabs.BeginUpdate;
+{$ENDIF}
+ while FTabs.TabCount > 0 do
+{$IFNDEF Delphi17}
+ FTabs.RemoveObject(FTabs.Tabs[FTabs.TabCount - 1]);
+{$ELSE}
+ FTabs.Tabs[0].Free;
+{$ENDIF}
+{$IFDEF Delphi20}
+ FTabs.TabIndex := -1;
+{$ENDIF}
+ tItem := TTabItem.Create(FTabs);
+ tItem.Text := frxResources.Get('dsCode');
+ FTabs.AddObject(tItem);
+ FTabs.OnMouseLeave := TabMouseLeave;
+ FTabs.OnDragEnd := TabDragEnd;
+
+ for i := 0 to Report.PagesCount - 1 do
+ begin
+ c := Report.Pages[i];
+ c.IsDesigning := True;
+ if (c is TfrxReportPage) and (TfrxReportPage(c).Subreport <> nil) then
+ s := TfrxReportPage(c).Subreport.Name
+ else if c is TfrxDataPage then
+ s := frxResources.Get('dsData')
+ else if c.Name = '' then
+ s := frxResources.Get('dsPage') + IntToStr(i + 1) else
+ s := c.Name;
+ tItem := TTabItem.Create(FTabs);
+ tItem.Tag := i;
+ tItem.Text := s;
+ FTabs.AddObject(tItem);
+ tItem.OnDragDrop := TabDragDrop;
+ tItem.OnDragOver := TabDragOver;
+ tItem.OnMouseDown := TabMouseDown;
+ tItem.OnMouseMove := TabMouseMove;
+ tItem.OnMouseUp := TabMouseUp;
+ tItem.OnDragEnd := TabDragEnd;
+ end;
+{$IFDEF Delphi20}
+ FTabs.EndUpdate;
+{$ENDIF}
+ if Index = -1 then
+ Page := nil
+ else if Index = -2 then
+ begin
+ for i := 0 to Report.PagesCount - 1 do
+ begin
+ c := Report.Pages[i];
+ if not (c is TfrxDataPage) then
+ begin
+ Page := c;
+ break;
+ end;
+ end;
+ end
+ else if Index < Report.PagesCount then
+ Page := Report.Pages[Index] else
+ Page := Report.Pages[0];
+end;
+
+procedure TfrxDesignerForm.ReloadObjects;
+var
+ i: Integer;
+begin
+ FObjects.Clear;
+ FSelectedObjects.Clear;
+
+ for i := 0 to FPage.AllObjects.Count - 1 do
+ FObjects.Add(FPage.AllObjects[i]);
+
+ FObjects.Add(Report);
+ FObjects.Add(FPage);
+ FSelectedObjects.Add(FPage);
+ FWorkspace.Page := FPage;
+ FWorkspace.EnableUpdate;
+ FWorkspace.AdjustBands;
+
+ FInspector.EnableUpdate;
+
+ UpdateDataTree;
+ FReportTree.UpdateItems;
+ OnSelectionChanged(Self);
+end;
+
+procedure TfrxDesignerForm.SetReportDefaults;
+begin
+ if frxDesignerComp <> nil then
+ begin
+ Report.ScriptLanguage := frxDesignerComp.DefaultScriptLanguage;
+ frxEmptyCode(CodeWindow.Lines, Report.ScriptLanguage);
+ UpdateSyntaxType;
+ LangCB.OnChange := nil;
+ LangCB.ItemIndex := LangCB.Items.IndexOf(Report.ScriptLanguage);
+ LangCB.OnChange := LangCBClick;
+
+ with TfrxReportPage(Report.Pages[1]) do
+ begin
+ LeftMargin := frxDesignerComp.DefaultLeftMargin;
+ BottomMargin := frxDesignerComp.DefaultBottomMargin;
+ RightMargin := frxDesignerComp.DefaultRightMargin;
+ TopMargin := frxDesignerComp.DefaultTopMargin;
+ PaperSize := frxDesignerComp.DefaultPaperSize;
+ Orientation := frxDesignerComp.DefaultOrientation;
+ end;
+ end
+ else
+ begin
+ Report.ScriptLanguage := 'PascalScript';
+ frxEmptyCode(CodeWindow.Lines, Report.ScriptLanguage);
+ UpdateSyntaxType;
+ LangCB.OnChange := nil;
+ LangCB.ItemIndex := LangCB.Items.IndexOf(Report.ScriptLanguage);
+ LangCB.OnChange := LangCBClick;
+
+ TfrxReportPage(Report.Pages[1]).SetDefaults;
+ end;
+ Report.ScriptText.Text := CodeWindow.Lines.Text;
+end;
+
+procedure TfrxDesignerForm.UpdatePageDimensions;
+var
+ h: Extended;
+begin
+ if FPage is TfrxReportPage then
+ begin
+ with FPage as TfrxReportPage do
+ begin
+{$IFDEF DELPHI18}
+ ScrollBox.ViewportPosition := PointF(0, 0);
+{$ELSE}
+ ScrollBox.HScrollBar.Value := 0;
+ ScrollBox.VScrollBar.Value := 0;
+{$ENDIF}
+
+ FWorkspace.Origin := Point(10, 10);
+ h := PaperHeight;
+ if LargeDesignHeight then
+ h := h * 5;
+ FWorkspace.SetPageDimensions(
+ Round(PaperWidth * 96 / 25.4),
+ Round(h * 96 / 25.4),
+ Rect(Round(LeftMargin * 96 / 25.4), Round(TopMargin * 96 / 25.4),
+ Round(RightMargin * 96 / 25.4), Round(BottomMargin * 96 / 25.4)));
+ end;
+ end
+ else if FPage is TfrxDialogPage then
+ begin
+ with FPage as TfrxDialogPage do
+ begin
+{$IFDEF DELPHI18}
+ ScrollBox.ViewportPosition := PointF(0, 0);
+{$ELSE}
+ ScrollBox.HScrollBar.Value := 0;
+ ScrollBox.VScrollBar.Value := 0;
+{$ENDIF}
+
+ FWorkspace.Origin := Point(10, 10);
+ TfrxDialogPage(FPage).UpdateClientRect;
+ FWorkspace.SetPageDimensions(Round(ClientWidth), Round(ClientHeight), Rect(0, 0, 0, 0));
+ end;
+ end
+ else if FPage is TfrxDataPage then
+ begin
+{$IFDEF DELPHI18}
+ ScrollBox.ViewportPosition := PointF(0, 0);
+{$ELSE}
+ ScrollBox.HScrollBar.Value := 0;
+ ScrollBox.VScrollBar.Value := 0;
+{$ENDIF}
+
+ FWorkspace.Origin := Point(0, 0);
+ FWorkspace.SetPageDimensions(
+ Round(FPage.Width),
+ Round(FPage.Height),
+ Rect(0, 0, 0, 0));
+ end;
+
+ ScrollBoxResize(nil);
+end;
+
+procedure TfrxDesignerForm.UpdateControls;
+
+const WidthsArr: array[0..12] of Extended = (0.1, 0.5, 1, 1.5, 2, 3, 4, 5, 6, 7, 8, 9, 10);
+
+var
+ c: TfrxComponent;
+ p1, p2, p3: PPropInfo;
+ Count, i: Integer;
+ FontEnabled, AlignEnabled, IsReportPage: Boolean;
+ Frame1Enabled, Frame2Enabled, Frame3Enabled, ObjSelected, DMPEnabled: Boolean;
+ s: String;
+ Frame: TfrxFrame;
+ DMPFontStyle: TfrxDMPFontStyles;
+
+ procedure SetEnabled(cAr: array of TControl; Enabled: Boolean);
+ var
+ i: Integer;
+ begin
+ for i := 0 to High(cAr) do
+ begin
+ cAr[i].Enabled := Enabled;
+ if (cAr[i] is TfrxToolButton) and not Enabled then
+ TfrxToolButton(cAr[i]).IsPressed := False;
+ end;
+ end;
+
+ procedure ButtonUp(cAr: array of TfrxToolButton);
+ var
+ i: Integer;
+ begin
+ for i := 0 to High(cAr) do
+ cAr[i].IsPressed := False;
+ end;
+
+begin
+ FUpdatingControls := True;
+
+ Count := FSelectedObjects.Count;
+ if Count > 0 then
+ begin
+ c := FSelectedObjects[0];
+ p1 := GetPropInfo(PTypeInfo(c.ClassInfo), 'Font');
+ p2 := GetPropInfo(PTypeInfo(c.ClassInfo), 'Frame');
+ p3 := GetPropInfo(PTypeInfo(c.ClassInfo), 'Color');
+ end
+ else
+ begin
+ c := nil;
+ p1 := nil;
+ p2 := nil;
+ p3 := nil;
+ end;
+
+ if Count = 1 then
+ begin
+ FontNameCB.Text := c.Font.Name;
+ FontSizeCB.Text := IntToStr(Round(c.Font.Size));
+
+ BoldB.IsPressed := fsBold in c.Font.Style;
+ ItalicB.IsPressed := fsItalic in c.Font.Style;
+ UnderlineB.IsPressed := fsUnderline in c.Font.Style;
+
+ if c is TfrxCustomMemoView then
+ with TfrxCustomMemoView(c) do
+ begin
+ TextAlignLeftB.IsPressed := HAlign = haLeft;
+ TextAlignCenterB.IsPressed := HAlign = haCenter;
+ TextAlignRightB.IsPressed := HAlign = haRight;
+ TextAlignBlockB.IsPressed := HAlign = haBlock;
+
+ TextAlignTopB.IsPressed := VAlign = vaTop;
+ TextAlignMiddleB.IsPressed := VAlign = vaCenter;
+ TextAlignBottomB.IsPressed := VAlign = vaBottom;
+ if not (c is TfrxDMPMemoView) then
+ if Style = '' then
+ StyleCB.Text := StyleCB.Items[0] else
+ StyleCB.Text := Style;
+ end;
+
+ Frame := nil;
+ if c is TfrxView then
+ Frame := TfrxView(c).Frame
+ else if c is TfrxReportPage then
+ Frame := TfrxReportPage(c).Frame;
+ FrameWidthCB.BeginUpdate;
+{$IFDEF DELPHI23}
+ FrameWidthCB.Clear;
+{$ELSE}
+ FrameWidthCB.Items.Clear;
+{$ENDIF}
+ for i := 0 to 12 do
+ FrameWidthCB.Items.Add(FloatToStr(WidthsArr[i]));
+ FrameWidthCB.EndUpdate;
+ if Frame <> nil then
+ with Frame do
+ begin
+ FrameTopB.IsPressed := ftTop in Typ;
+ FrameBottomB.IsPressed := ftBottom in Typ;
+ FrameLeftB.IsPressed := ftLeft in Typ;
+ FrameRightB.IsPressed := ftRight in Typ;
+ ShadowB.IsPressed := DropShadow;
+
+ FrameWidthCB.Text := FloatToStr(Width);
+ end;
+ end
+ else
+ begin
+ FontNameCB.Text := '';
+ FontSizeCB.Text := '';
+ FrameWidthCB.Text := '';
+
+ ButtonUp([BoldB, ItalicB, UnderlineB, TextAlignLeftB, TextAlignCenterB,
+ TextAlignRightB, TextAlignBlockB, TextAlignTopB, TextAlignMiddleB,
+ TextAlignBottomB, FrameTopB, FrameBottomB, FrameLeftB,
+ FrameRightB, ShadowB]);
+ end;
+
+ FontEnabled := (p1 <> nil) and not (c is TfrxDMPPage) and (FPage <> nil);
+ AlignEnabled := (c is TfrxCustomMemoView) and (FPage <> nil);
+ Frame1Enabled := (p2 <> nil) and not (c is TfrxLineView) and
+ not (c is TfrxShapeView) and not (c is TfrxDMPPage) and (FPage <> nil);
+ Frame2Enabled := (p2 <> nil) and not (c is TfrxDMPPage) and (FPage <> nil);
+ Frame3Enabled := (p3 <> nil) and not (c is TfrxDMPPage) and (FPage <> nil);
+ IsReportPage := FPage is TfrxReportPage;
+ ObjSelected := (Count <> 0) and (FPage <> nil) and (FSelectedObjects[0] <> FPage);
+ DMPEnabled := (c is TfrxDMPMemoView) or (c is TfrxDMPLineView) or
+ (c is TfrxDMPCommand) or (c is TfrxDMPPage);
+
+ SetEnabled([FontNameCB, FontSizeCB, BoldB, ItalicB, UnderlineB, FontColorB],
+ (FontEnabled or (Count > 1)) and not (FPage is TfrxDMPPage));
+ SetEnabled([FontB], (FontEnabled or DMPEnabled or (Count > 1)));
+ SetEnabled([TextAlignLeftB, TextAlignCenterB, TextAlignRightB,
+ TextAlignBlockB, TextAlignTopB, TextAlignMiddleB, TextAlignBottomB],
+ AlignEnabled or (Count > 1));
+ SetEnabled([StyleCB, HighlightB, RotateB],
+ (AlignEnabled or (Count > 1)) and not (FPage is TfrxDMPPage));
+ SetEnabled([FrameTopB, FrameBottomB, FrameLeftB, FrameRightB, FrameAllB,
+ FrameNoB, ShadowB], Frame1Enabled or (Count > 1));
+ SetEnabled([FrameColorB, FrameStyleB, FrameWidthCB],
+ (Frame2Enabled or (Count > 1)) and not (FPage is TfrxDMPPage));
+ SetEnabled([FillColorB], Frame3Enabled and not (FPage is TfrxDMPPage));
+ if Report.DotMatrixReport then
+ begin
+ //FontB.DropDownMenu := DMPPopup;
+ FontB.OnClick := nil;
+ end
+ else
+ begin
+ //FontB.DropDownMenu := nil;
+ FontB.OnClick := FontBClick;
+ end;
+
+ DMPFontStyle := [];
+ if c is TfrxDMPMemoView then
+ DMPFontStyle := TfrxDMPMemoView(c).FontStyle;
+ if c is TfrxDMPLineView then
+ DMPFontStyle := TfrxDMPLineView(c).FontStyle;
+ if c is TfrxDMPPage then
+ DMPFontStyle := TfrxDMPPage(c).FontStyle;
+
+ BoldMI.IsChecked := fsxBold in DMPFontStyle;
+ ItalicMI.IsChecked := fsxItalic in DMPFontStyle;
+ UnderlineMI.IsChecked := fsxUnderline in DMPFontStyle;
+ SuperScriptMI.IsChecked := fsxSuperScript in DMPFontStyle;
+ SubScriptMI.IsChecked := fsxSubScript in DMPFontStyle;
+ CondensedMI.IsChecked := fsxCondensed in DMPFontStyle;
+ WideMI.IsChecked := fsxWide in DMPFontStyle;
+ N12cpiMI.IsChecked := fsx12cpi in DMPFontStyle;
+ N15cpiMI.IsChecked := fsx15cpi in DMPFontStyle;
+
+ UndoB.Enabled := (FUndoBuffer.UndoCount > 1);
+ RedoB.Enabled := (FUndoBuffer.RedoCount > 0) and (FPage <> nil);
+ CutB.Enabled := ((Count <> 0) and (FSelectedObjects[0] <> FPage)) or (FPage = nil);
+ CopyB.Enabled := CutB.Enabled;
+ TimerTimer(nil);
+
+ PageSettingsB.Enabled := IsReportPage and CheckOp(drDontChangePageOptions);
+ DeletePageB.Enabled := (Report.PagesCount > 2) and (FPage <> nil) and
+ not (FPage is TfrxDataPage) and CheckOp(drDontDeletePage) and
+ not Page.IsAncestor;
+ SaveB.Enabled := Modified and CheckOp(drDontSaveReport);
+ DeleteMI.Enabled := ObjSelected;
+ SelectAllMI.Enabled := (FObjects.Count > 2) or (FPage = nil);
+ EditMI.Enabled := (Count = 1) and (FPage <> nil);
+ SetToGridB.Enabled := ObjSelected;
+ BringtoFrontMI.Enabled := ObjSelected;
+ SendtoBackMI.Enabled := ObjSelected;
+ GroupB.Enabled := ObjSelected and (FSelectedObjects[0] <> Report);
+ UngroupB.Enabled := GroupB.Enabled;
+ ScaleCB.Enabled := IsReportPage;
+
+ if Count <> 1 then
+ s := ''
+ else
+ begin
+ s := c.Name;
+ if c is TfrxView then
+ if TfrxView(c).IsDataField then
+ s := s + ': ' + Report.GetAlias(TfrxView(c).DataSet) + '."' + TfrxView(c).DataField + '"'
+ else if c is TfrxCustomMemoView then
+ s := s + ': ' + Copy(TfrxCustomMemoView(c).Text, 1, 128);
+ if c is TfrxDataBand then
+ if TfrxDataBand(c).DataSet <> nil then
+ s := s + ': ' + Report.GetAlias(TfrxDataBand(c).DataSet);
+ if c is TfrxGroupHeader then
+ s := s + ': ' + TfrxGroupHeader(c).Condition
+ end;
+
+ //StatusBar.Panels[2].Text := s;
+
+ FUpdatingControls := False;
+end;
+
+procedure TfrxDesignerForm.UpdateDataTree;
+begin
+ FDataTree.UpdateItems;
+end;
+
+procedure TfrxDesignerForm.UpdateInspector;
+begin
+ FInspector.UpdateProperties;
+end;
+
+procedure TfrxDesignerForm.UpdateStyles;
+begin
+ Report.Styles.GetList(StyleCB.Items);
+ StyleCB.Items.Insert(0, frxResources.Get('dsNoStyle'));
+end;
+
+procedure TfrxDesignerForm.UpdateSyntaxType;
+begin
+ //CodeWindow.SyntaxType := Report.ScriptLanguage;
+ if CompareText(Report.ScriptLanguage, 'PascalScript') = 0 then
+ begin
+ CodeWindow.SyntaxType := TSyntaxType.stPascal;
+ OpenScriptDialog.FilterIndex := 1;
+ OpenScriptDialog.DefaultExt := 'pas';
+ SaveScriptDialog.FilterIndex := 1;
+ SaveScriptDialog.DefaultExt := 'pas';
+ end
+ else if CompareText(Report.ScriptLanguage, 'C++Script') = 0 then
+ begin
+ CodeWindow.SyntaxType := TSyntaxType.stCpp;
+ OpenScriptDialog.FilterIndex := 2;
+ OpenScriptDialog.DefaultExt := 'cpp';
+ SaveScriptDialog.FilterIndex := 2;
+ SaveScriptDialog.DefaultExt := 'cpp';
+ end
+ else if CompareText(Report.ScriptLanguage, 'JScript') = 0 then
+ begin
+ CodeWindow.SyntaxType := TSyntaxType.stJs;
+ OpenScriptDialog.FilterIndex := 3;
+ OpenScriptDialog.DefaultExt := 'js';
+ SaveScriptDialog.FilterIndex := 3;
+ SaveScriptDialog.DefaultExt := 'js';
+ end
+ else if CompareText(Report.ScriptLanguage, 'BasicScript') = 0 then
+ begin
+ CodeWindow.SyntaxType := TSyntaxType.stVB;
+ OpenScriptDialog.FilterIndex := 4;
+ OpenScriptDialog.DefaultExt := 'vb';
+ SaveScriptDialog.FilterIndex := 4;
+ SaveScriptDialog.DefaultExt := 'vb';
+ end
+ else
+ begin
+ OpenScriptDialog.FilterIndex := 5;
+ OpenScriptDialog.DefaultExt := '';
+ SaveScriptDialog.FilterIndex := 5;
+ SaveScriptDialog.DefaultExt := '';
+ end
+end;
+
+procedure TfrxDesignerForm.FindOrReplace(replace: Boolean);
+begin
+ with TfrxSearchDialog.Create(Application) do
+ begin
+ FSearchReplace := replace;
+ //if FSearchReplace then
+ // ReplacePanel.Show;
+ if Page <> nil then
+ TopCB.Enabled := False;
+ if ShowModal = mrOk then
+ begin
+ FSearchText := TextE.Text;
+ FSearchReplaceText := ReplaceE.Text;
+ FSearchCase := CaseCB.IsChecked;
+ FSearchIndex := 0;
+ //if (Page = nil) and not TopCB.IsChecked then
+ // FSearchIndex := CodeWindow.GetPlainPos;
+ FindNextMI.Enabled := True;
+ FindText;
+ end;
+ Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.Lock;
+begin
+ FObjects.Clear;
+ FSelectedObjects.Clear;
+ FWorkspace.DisableUpdate;
+ FInspector.DisableUpdate;
+end;
+
+procedure TfrxDesignerForm.CreateColorSelector(Sender: TfrxToolButton);
+var
+ AColor: TAlphaColor;
+ i: Integer;
+begin
+ AColor := claBlack;
+ for i := 0 to SelectedObjects.Count - 1 do
+ if TObject(SelectedObjects[i]) is TfrxView then
+ begin
+ if Sender = FontColorB then
+ AColor := TfrxView(SelectedObjects[i]).Font.Color
+ else if Sender = FrameColorB then
+ AColor := TfrxView(SelectedObjects[i]).Frame.Color
+ else
+ AColor := TfrxView(SelectedObjects[i]).Color;
+ break;
+ end;
+
+ if FColorSelector = nil then
+ begin
+ FColorSelector := TfrxColorSelector.Create(Self);
+ FColorSelector.Parent := Self;
+ FColorSelector.OnColorChanged := Self.OnColorChanged;
+ end;
+
+ with FColorSelector do
+ begin
+ Color := AColor;
+ BtnCaption := frxResources.Get('dsColorOth');
+ Popup(Sender);
+ end;
+end;
+
+procedure TfrxDesignerForm.SwitchToCodeWindow;
+begin
+ Page := nil;
+end;
+
+function TfrxDesignerForm.AskSave: Word;
+begin
+ if IsPreviewDesigner then
+ Result := frxConfirmMsg(frxResources.Get('dsSavePreviewChanges'), [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo, TMsgDlgBtn.mbCancel])
+ else
+ Result := frxConfirmMsg(frxResources.Get('dsSaveChangesTo') + ' ' +
+ GetReportName + '?', [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo, TMsgDlgBtn.mbCancel]);
+end;
+
+function TfrxDesignerForm.CheckOp(Op: TfrxDesignerRestriction): Boolean;
+begin
+ Result := True;
+ if (frxDesignerComp <> nil) and (Op in frxDesignerComp.Restrictions) then
+ Result := False;
+end;
+
+function TfrxDesignerForm.GetPageIndex: Integer;
+begin
+ Result := Report.Objects.IndexOf(FPage);
+end;
+
+function TfrxDesignerForm.GetReportName: String;
+begin
+ if Report.FileName = '' then
+ Result := 'Untitled.'+ FTemplateExt else
+ Result := ExtractFileName(Report.FileName);
+end;
+
+procedure TfrxDesignerForm.LoadFile(FileName: String; UseOnLoadEvent: Boolean);
+var
+ SaveSilentMode: Boolean;
+
+ function SaveCurrentFile: Boolean;
+ var
+ w: Word;
+ begin
+ Result := True;
+ if Modified then
+ begin
+ w := AskSave;
+ if w = mrYes then
+ SaveFile(False, UseOnLoadEvent)
+ else if w = mrCancel then
+ Result := False;
+ end;
+ end;
+
+ procedure EmptyReport;
+ var
+ p: TfrxPage;
+ begin
+ Report.Clear;
+ p := TfrxDataPage.Create(Report);
+ p.Name := 'Data';
+ p := TfrxReportPage.Create(Report);
+ p.Name := 'Page1';
+ end;
+
+ procedure Error;
+ begin
+ frxErrorMsg(frxResources.Get('dsCantLoad'));
+ end;
+
+begin
+ SaveSilentMode := Report.EngineOptions.SilentMode;
+ Report.EngineOptions.SilentMode := False;
+
+ if FileName <> '' then // call from recent filelist
+ begin
+ if SaveCurrentFile then
+ begin
+ Lock;
+ if UseOnLoadEvent and (frxDesignerComp <> nil) and
+ Assigned(frxDesignerComp.FOnLoadRecentReport) then
+ begin
+ if frxDesignerComp.FOnLoadRecentReport(Report, FileName) then
+ ReloadReport else
+ ReloadPages(-2);
+ end
+ else
+ begin
+ try
+ if not Report.LoadFromFile(FileName) then
+ Error;
+ except
+ EmptyReport;
+ end;
+ end;
+ end;
+ Report.EngineOptions.SilentMode := SaveSilentMode;
+ ReloadReport;
+ Exit;
+ end;
+
+ if UseOnLoadEvent then
+ if (frxDesignerComp <> nil) and Assigned(frxDesignerComp.FOnLoadReport) then
+ begin
+ Lock;
+ if frxDesignerComp.FOnLoadReport(Report) then
+ ReloadReport else
+ ReloadPages(-2);
+ Report.EngineOptions.SilentMode := SaveSilentMode;
+ Exit;
+ end;
+
+ if frxDesignerComp <> nil then
+ OpenDialog.InitialDir := frxDesignerComp.OpenDir;
+ if OpenDialog.Execute then
+ begin
+ if SaveCurrentFile then
+ begin
+ Lock;
+ if not Report.LoadFromFile(OpenDialog.FileName) then
+ begin
+ Error;
+ EmptyReport;
+ end;
+ end;
+ Report.EngineOptions.SilentMode := SaveSilentMode;
+ ReloadReport;
+ end;
+ PeekLastModalResult;
+end;
+
+function TfrxDesignerForm.SaveFile(SaveAs: Boolean; UseOnSaveEvent: Boolean): Boolean;
+var
+ Saved: Boolean;
+ FilterCount: Integer;
+begin
+ Result := True;
+ Report.ScriptText := CodeWindow.Lines;
+ Report.ReportOptions.LastChange := Now;
+
+ if UseOnSaveEvent then
+ if (frxDesignerComp <> nil) and Assigned(frxDesignerComp.FOnSaveReport) then
+ begin
+ if frxDesignerComp.FOnSaveReport(Report, SaveAs) then
+ begin
+ UpdateRecentFiles(Report.FileName);
+ UpdateCaption;
+ Modified := False;
+ end;
+ Exit;
+ end;
+
+ Saved := True;
+ if SaveAs or (Report.FileName = '') then
+ begin
+ SaveDialog.DefaultExt := FTemplateExt;
+ SaveDialog.Filter := frxResources.Get('dsRepFilter');
+ FilterCount := 1;
+ if frxCompressorClass <> nil then
+ begin
+ SaveDialog.Filter := SaveDialog.Filter + '|' + frxResources.Get('dsComprRepFilter');
+ Inc(FilterCount);
+ end;
+ if frxSavePlugin <> nil then
+ begin
+ SaveDialog.Filter := SaveDialog.Filter + '|' + frxSavePlugin.FileFilter;
+ Inc(FilterCount);
+ end;
+
+ if Report.ReportOptions.Compressed and (frxCompressorClass <> nil) then
+ SaveDialog.FilterIndex := 2 else
+ SaveDialog.FilterIndex := 1;
+ if frxDesignerComp <> nil then
+ SaveDialog.InitialDir := frxDesignerComp.SaveDir;
+
+ Saved := SaveDialog.Execute;
+ PeekLastModalResult;
+ if Saved then
+ begin
+ if (frxSavePlugin <> nil) and (SaveDialog.FilterIndex = FilterCount) then
+ frxSavePlugin.Save(Report, SaveDialog.FileName)
+ else
+ begin
+ Report.ReportOptions.Compressed := SaveDialog.FilterIndex = 2;
+ Report.FileName := SaveDialog.FileName;
+ Report.SaveToFile(Report.FileName);
+ end;
+ end
+ end
+ else
+ Report.SaveToFile(Report.FileName);
+
+ UpdateRecentFiles(Report.FileName);
+ UpdateCaption;
+ if Saved then
+ Modified := False;
+ Result := Saved;
+end;
+
+procedure TfrxDesignerForm.UpdateCaption;
+begin
+ Caption := 'FastReport - ' + GetReportName;
+end;
+
+procedure TfrxDesignerForm.UpdateRecentFiles(NewFile: String);
+var
+ i: Integer;
+ m: TMenuItem;
+begin
+ if NewFile <> '' then
+ begin
+ if FRecentFiles.IndexOf(NewFile) <> -1 then
+ FRecentFiles.Delete(FRecentFiles.IndexOf(NewFile));
+ FRecentFiles.Add(NewFile);
+ while FRecentFiles.Count > 8 do
+ FRecentFiles.Delete(0);
+ end;
+
+ //SepMI11.Visible := FRecentFiles.Count <> 0;
+
+// for i := FileMenu.Count - 1 downto 0 do
+// begin
+// m := FileMenu.Items[i];
+// if m.Tag = 100 then
+// m.Free;
+// end;
+
+ if CheckOp(drDontShowRecentFiles) then
+ for i := FRecentFiles.Count - 1 downto 0 do
+ begin
+ m := TMenuItem.Create(FileMenu);
+ m.Text := FRecentFiles[i];
+ m.OnClick := OpenRecentFile;
+ m.Tag := 100;
+ //FileMenu.Insert(FileMenu.IndexOf(SepMI4), m);
+ end;
+end;
+
+procedure TfrxDesignerForm.SwitchToolbar;
+var
+ i: Integer;
+ Item: TfrxObjectItem;
+ b: TfrxToolButton;
+ Category: TfrxObjectCategories;
+ IsToolandBand: Boolean;
+
+ function GetCategory(Category: Integer): TfrxObjectCategories;
+ var
+ i: Integer;
+ Item: TfrxObjectItem;
+ begin
+ Result := [];
+ for i := 0 to frxObjects.Count - 1 do
+ begin
+ Item := frxObjects[i];
+ if (Item.ClassRef <> nil) and
+ (Item.CategoryName = frxObjects[Category].CategoryName) then
+ begin
+ Result := Item.Category;
+ break;
+ end;
+ end;
+ end;
+
+begin
+ ObjectSelectB.IsPressed := True;
+ SelectToolBClick(nil);
+
+ for i := ObjectsTB1.ChildrenCount - 1 downto 0 do
+ begin
+ b := TfrxToolButton(ObjectsTB1.Children[i]);
+
+ if b <> ObjectSelectB then
+ begin
+ IsToolandBand := False;
+ Category := [];
+
+ if b.Tag = 1000 then { tools and band }
+ IsToolandBand := True
+ else { object or category }
+ begin
+ Item := frxObjects[b.Tag];
+ if Item.ClassRef <> nil then { object }
+ Category := Item.Category
+ else
+ Category := GetCategory(b.Tag);
+ end;
+
+ if FPage is TfrxDialogPage then
+ b.Visible := ctDialog in Category
+ else if FPage is TfrxDMPPage then
+ b.Visible := (ctDMP in Category) or IsToolandBand
+ else if FPage is TfrxReportPage then
+ b.Visible := (ctReport in Category) or IsToolandBand
+ else if FPage is TfrxDataPage then
+ b.Visible := ctData in Category
+ else if FPage = nil then
+ b.Visible := False;
+ end;
+ end;
+end;
+
+function TfrxDesignerForm.mmToUnits(mm: Extended; X: Boolean = True): Extended;
+begin
+ Result := 0;
+ case FUnits of
+ duCM:
+ Result := mm / 10;
+ duInches:
+ Result := mm / 25.4;
+ duPixels:
+ Result := mm * 96 / 25.4;
+ duChars:
+ if X then
+ Result := Round(mm * fr01cm / fr1CharX) else
+ Result := Round(mm * fr01cm / fr1CharY);
+ end;
+end;
+
+function TfrxDesignerForm.UnitsTomm(mm: Extended; X: Boolean = True): Extended;
+begin
+ Result := 0;
+ case FUnits of
+ duCM:
+ Result := mm * 10;
+ duInches:
+ Result := mm * 25.4;
+ duPixels:
+ Result := mm / 96 * 25.4;
+ duChars:
+ if X then
+ Result := Round(mm) * fr1CharX / fr01cm else
+ Result := Round(mm) * fr1CharY / fr01cm;
+ end;
+end;
+
+function TfrxDesignerForm.InsertExpression(const Expr: String): String;
+begin
+ with TfrxExprEditorForm.Create(Self) do
+ begin
+ ExprMemo.Text := Expr;
+ if ShowModal = mrOk then
+ Result := ExprMemo.Text else
+ Result := '';
+ Free;
+ end
+end;
+
+procedure TfrxDesignerForm.UpdatePage;
+begin
+ FWorkspace.Repaint;
+end;
+
+procedure TfrxDesignerForm.FindText;
+var
+ i: Integer;
+ c: TfrxComponent;
+ s: String;
+ Found, FoundOne: Boolean;
+ Flags: TReplaceFlags;
+ ReplaceAll: Boolean;
+
+ function AskReplace: Boolean;
+ var
+ i: Integer;
+ begin
+ if not ReplaceAll then
+ i := MessageDlg(Format(frxResources.Get('dsReplace'), [FSearchText]),
+ TMsgDlgType.mtConfirmation, [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo, TMsgDlgBtn.mbCancel, TMsgDlgBtn.mbAll], 0)
+ else
+ i := mrAll;
+ Result := i in [mrYes, mrAll];
+ ReplaceAll := i = mrAll;
+
+{ Result := Application.MessageBox(
+ PChar(Format(frxResources.Get('dsReplace'), [FSearchText])),
+ PChar(frxResources.Get('mbConfirm')), mb_IconQuestion + mb_YesNo) = mrYes;}
+ end;
+
+begin
+ ReplaceAll := False;
+ FoundOne := False;
+
+ repeat
+ Found := False;
+ if FPage <> nil then
+ begin
+ c := nil;
+ for i := FSearchIndex to Objects.Count - 1 do
+ begin
+ c := Objects[i];
+ if c is TfrxCustomMemoView then
+ begin
+ s := TfrxCustomMemoView(c).Text;
+ if FSearchCase then
+ begin
+ if Pos(FSearchText, s) <> 0 then
+ Found := True;
+ end
+ else if Pos(AnsiUpperCase(FSearchText), AnsiUpperCase(s)) <> 0 then
+ Found := True;
+ end;
+ if Found then break;
+ end;
+
+ if Found then
+ begin
+ FSearchIndex := i + 1;
+ SelectedObjects.Clear;
+ SelectedObjects.Add(c);
+ OnSelectionChanged(Self);
+ if FSearchReplace then
+ if AskReplace then
+ begin
+ Flags := [rfReplaceAll];
+ if not FSearchCase then
+ Flags := Flags + [rfIgnoreCase];
+ TfrxCustomMemoView(c).Text := StringReplace(s, FSearchText,
+ FSearchReplaceText, Flags);
+ Modified := True;
+ end;
+ end;
+ end
+ else
+ begin
+ Found := CodeWindow.Find(FSearchText);//, FSearchCase, FSearchIndex);
+ if FSearchReplace then
+ if Found and AskReplace then
+ begin
+ CodeWindow.SelText := FSearchReplaceText;
+ Modified := True;
+ end;
+ end;
+
+ if Found then
+ FoundOne := True;
+ until not ReplaceAll or not Found;
+
+ if not FoundOne then
+ frxInfoMsg(Format(frxResources.Get('dsTextNotFound'), [FSearchText]));
+end;
+
+procedure TfrxDesignerForm.RestorePagePosition;
+var
+ pt: TPoint;
+begin
+ if (FTabs.TabIndex > 0) and (FTabs.TabIndex < 255) then
+ begin
+ pt := fsPosToPoint(FPagePositions[FTabs.TabIndex]);
+{$IFDEF DELPHI18}
+ ScrollBox.ViewportPosition := PointF(pt.X, pt.Y);
+{$ELSE}
+ ScrollBox.VScrollBar.Value := pt.X;
+ ScrollBox.HScrollBar.Value := pt.Y;
+{$ENDIF}
+ end;
+end;
+
+procedure TfrxDesignerForm.SavePagePosition;
+begin
+ if (FTabs.TabIndex > 0) and (FTabs.TabIndex < 255) then
+{$IFDEF DELPHI18}
+ FPagePositions[FTabs.TabIndex] := IntToStr(Round(ScrollBox.ViewportPosition.X)) +
+ ':' + IntToStr(Round(ScrollBox.ViewportPosition.Y));
+{$ELSE}
+ FPagePositions[FTabs.TabIndex] := IntToStr(Round(ScrollBox.HScrollBar.Value)) +
+ ':' + IntToStr(Round(ScrollBox.VScrollBar.Value));
+{$ENDIF}
+
+end;
+
+
+{ Workspace/Inspector event handlers }
+{------------------------------------------------------------------------------}
+
+procedure TfrxDesignerForm.OnModify(Sender: TObject);
+begin
+ FModifiedBy := Sender;
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.OnSelectionChanged(Sender: TObject);
+var
+ c: TfrxComponent;
+begin
+ if FLockSelectionChanged then Exit;
+ if Sender = FReportTree then
+ begin
+ c := SelectedObjects[0];
+ if (c <> Report) and (Page <> nil) then
+ if c.Page <> Page then
+ begin
+ Page := c.Page;
+ SelectedObjects[0] := c;
+ FReportTree.UpdateSelection;
+ end;
+ end
+ else
+ FReportTree.UpdateSelection;
+
+ if Sender <> FWorkspace then
+ FWorkspace.UpdateView;
+
+ if Sender <> FInspector then
+ begin
+ FInspector.Objects := FObjects;
+ FInspector.UpdateProperties;
+ end;
+
+ FDataTree.UpdateSelection;
+ UpdateControls;
+end;
+
+procedure TfrxDesignerForm.OnEditObject(Sender: TObject);
+var
+ ed: TfrxComponentEditor;
+begin
+ if FSelectedObjects[0] <> nil then
+ if rfDontEdit in TfrxComponent(FSelectedObjects[0]).Restrictions then
+ Exit;
+
+ ed := frxComponentEditors.GetComponentEditor(FSelectedObjects[0], Self, nil);
+ if (ed <> nil) and ed.HasEditor then
+ if ed.Edit then
+ begin
+ Modified := True;
+ if FSelectedObjects[0] = FPage then
+ UpdatePageDimensions;
+ end;
+ ed.Free;
+end;
+
+procedure TfrxDesignerForm.OnInsertObject(Sender: TObject);
+var
+ c: TfrxComponent;
+ SaveLeft, SaveTop, SaveWidth, SaveHeight: Extended;
+
+ function CheckContainers(Obj: TfrxComponent): Boolean;
+ var
+ i: Integer;
+ c: TfrxComponent;
+ begin
+ Result := False;
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if (c <> Obj) and (csContainer in c.frComponentStyle) then
+ if (Obj.Left >= c.AbsLeft) and (Obj.Top >= c.AbsTop) and
+ (Obj.Left + Obj.Width <= c.AbsLeft + c.Width) and
+ (Obj.Top + Obj.Height <= c.AbsTop + c.Height) then
+ begin
+ Result := c.ContainerAdd(Obj);
+ break;
+ end;
+ end;
+ end;
+
+begin
+ if (not CheckOp(drDontInsertObject) or (FWorkspace.Insertion.Top < 0)) then
+ begin
+ FWorkspace.SetInsertion(nil, 0, 0, 0);
+ ObjectSelectB.IsPressed := True;
+ Exit;
+ end;
+
+ with FWorkspace.Insertion do
+ begin
+ if (ComponentClass = nil) or ((Width = 0) and (Height = 0)) then Exit;
+
+ SaveLeft := Left;
+ SaveTop := Top;
+ SaveWidth := Width;
+ SaveHeight := Height;
+ c := TfrxComponent(ComponentClass.NewInstance);
+ c.DesignCreate(FPage, Flags);
+ c.SetBounds(SaveLeft, SaveTop, SaveWidth, SaveHeight);
+ c.CreateUniqueName;
+ if c is TfrxCustomLineView then
+ FWorkspace.SetInsertion(ComponentClass, 0, 0, Flags)
+ else
+ begin
+ FWorkspace.SetInsertion(nil, 0, 0, 0);
+ ObjectSelectB.IsPressed := True;
+ end;
+
+ if c is TfrxCustomMemoView then
+ begin
+ FSampleFormat.ApplySample(TfrxCustomMemoView(c));
+ if FPage is TfrxDataPage then
+ TfrxCustomMemoView(c).Wysiwyg := False;
+ end;
+
+ if not CheckContainers(c) then
+ FObjects.Add(c);
+ FSelectedObjects.Clear;
+ FSelectedObjects.Add(c);
+
+ if (frxDesignerComp <> nil) and Assigned(frxDesignerComp.FOnInsertObject) then
+ frxDesignerComp.FOnInsertObject(c);
+
+ if c is TfrxSubreport then
+ begin
+ NewPageCmdExecute(Self);
+ TfrxSubreport(c).Page := TfrxReportPage(Report.Pages[Report.PagesCount - 1]);
+ ReloadPages(Report.PagesCount - 1);
+ end
+ else
+ begin
+ Modified := True;
+ if EditAfterInsert and not
+ ((c is TfrxDialogControl) or (c is TfrxDialogComponent)) then
+ OnEditObject(Self);
+ end;
+
+ FWorkspace.BringToFront;
+ end;
+end;
+
+procedure TfrxDesignerForm.OnNotifyPosition(ARect: TfrxRect);
+var
+ dx, dy: Extended;
+begin
+ with ARect do
+ begin
+ if FUnits = duCM then
+ begin
+ dx := 1 / 96 * 2.54;
+ dy := dx;
+ end
+ else if FUnits = duChars then
+ begin
+ dx := 1 / fr1CharX;
+ dy := 1 / fr1CharY;
+ end
+ else if FUnits = duPixels then
+ begin
+ dx := 1;
+ dy := dx;
+ end
+ else
+ begin
+ dx := 1 / 96;
+ dy := dx;
+ end;
+
+ Left := Left * dx;
+ Top := Top * dy;
+ if FWorkspace.Mode <> dmScale then
+ begin
+ Right := Right * dx;
+ Bottom := Bottom * dy;
+ end;
+
+ if FUnits = duChars then
+ begin
+ Left := Trunc(Left);
+ Top := Trunc(Top);
+ Right := Trunc(Right);
+ Bottom := Trunc(Bottom);
+ end;
+
+
+ FCoord1 := '';
+ FCoord2 := '';
+ FCoord3 := '';
+ if (not FWorkspace.IsMouseDown) and (FWorkspace.Mode <> dmInsertObject) then
+ if (FSelectedObjects.Count > 0) and (FSelectedObjects[0] = FPage) then
+ FCoord1 := Format('%f; %f', [Left, Top])
+ else
+ begin
+ FCoord1 := Format('%f; %f', [Left, Top]);
+ FCoord2 := Format('%f; %f', [Right, Bottom]);
+ end
+ else
+ case FWorkspace.Mode of
+ dmMove, dmSize, dmSizeBand, dmInsertObject, dmInsertLine:
+ begin
+ FCoord1 := Format('%f; %f', [Left, Top]);
+ FCoord2 := Format('%f; %f', [Right, Bottom]);
+ end;
+
+ dmScale:
+ begin
+ FCoord1 := Format('%f; %f', [Left, Top]);
+ FCoord3 := Format('%s%f; %s%f', ['%', Right * 100, '%', Bottom * 100]);
+ end;
+ end;
+ end;
+
+ LeftRuler.RulePosition := ARect.Top;
+ TopRuler.RulePosition := ARect.Left;
+
+ if FPage = nil then
+ OnChangePosition(Self);
+
+// StatusBar.Repaint;
+end;
+
+
+{ Toolbar buttons' events }
+{------------------------------------------------------------------------------}
+
+procedure TfrxDesignerForm.SelectToolBClick(Sender: TObject);
+begin
+ if Sender is TfrxToolButton then
+ TfrxToolButton(Sender).IsPressed := True;
+
+ FWorkspace.SetInsertion(nil, 0, 0, 0);
+end;
+
+procedure TfrxDesignerForm.ObjectBandBClick(Sender: TObject);
+var
+ pt: TPointF;
+begin
+ pt := Self.ClientToScreen(PointF(TControl(Sender).AbsoluteRect.Right, TControl(Sender).AbsoluteRect.Top));
+ BandsPopup.Popup(pt.X, pt.Y);
+end;
+
+procedure TfrxDesignerForm.ObjectsButtonClick(Sender: TObject);
+var
+ i: Integer;
+ Obj, Item: TfrxObjectItem;
+ c: TfrxComponent;
+ dx, dy: Extended;
+ m: TMenuItem;
+ pt: TPointF;
+ s: String;
+begin
+ SelectToolBClick(Sender);
+ if Page = nil then Exit;
+ Obj := frxObjects[TComponent(Sender).Tag];
+
+ if Obj.ClassRef = nil then { it's a category }
+ begin
+{$IFDEF Delphi17}
+ ObjectsPopup.Clear;
+{$ELSE}
+ while ObjectsPopup.ChildrenCount > 0 do
+ ObjectsPopup.Children[0].Free;
+{$ENDIF}
+ for i := 0 to frxObjects.Count - 1 do
+ begin
+ Item := frxObjects[i];
+ if (Item.ClassRef <> nil) and (Item.CategoryName = Obj.CategoryName) then
+ begin
+ if FPage is TfrxDMPPage then
+ if not ((Item.ClassRef.ClassName = 'TfrxCrossView') or
+ (Item.ClassRef.ClassName = 'TfrxDBCrossView') or
+ (Item.ClassRef.InheritsFrom(TfrxDialogComponent))) then continue;
+
+ m := TMenuItem.Create(ObjectsPopup);
+ m.Parent := ObjectsPopup;
+ frxResources.LoadImageFromResouce(m.Bitmap, Item.ButtonImageIndex);
+ s := Item.ButtonHint;
+ if s = '' then
+ s := Item.ClassRef.GetDescription else
+ s := frxResources.Get(s);
+ m.Text := s;
+ m.OnClick := ObjectsButtonClick;
+ m.Tag := i;
+ end;
+ end;
+
+ pt := Self.ClientToScreen(PointF(TControl(Sender).AbsoluteRect.Right, TControl(Sender).AbsoluteRect.Top));
+ ObjectsPopup.Popup(pt.X, pt.Y);
+ end
+ else { it's a simple object }
+ begin
+ c := TfrxComponent(Obj.ClassRef.NewInstance);
+ try
+ c.Create(FPage);
+ except
+ Exit;
+ end;
+ dx := c.Width;
+ dy := c.Height;
+ c.Free;
+
+ if (dx = 0) and (dy = 0) then
+ begin
+ dx := GetDefaultObjectSize.X;
+ dy := GetDefaultObjectSize.Y;
+ end;
+
+ FWorkspace.SetInsertion(Obj.ClassRef, dx, dy, Obj.Flags);
+ end;
+end;
+
+{procedure TfrxDesignerForm.OnExtraToolClick(Sender: TObject);
+var
+ w: TfrxCustomWizard;
+ Item: TfrxWizardItem;
+begin
+ Item := frxWizards[TfrxToolButton(Sender).Tag];
+ w := TfrxCustomWizard(Item.ClassRef.NewInstance);
+ w.Create(Self);
+ if w.Execute then
+ Modified := True;
+ w.Free;
+end;}
+
+procedure TfrxDesignerForm.InsertBandClick(Sender: TObject);
+var
+ i: Integer;
+ Band: TfrxBand;
+ Size: Extended;
+
+ function FindFreeSpace: Extended;
+ var
+ i: Integer;
+ b: TfrxComponent;
+ begin
+ Result := 0;
+ for i := 0 to FPage.Objects.Count - 1 do
+ begin
+ b := FPage.Objects[i];
+ if (b is TfrxBand) and not TfrxBand(b).Vertical then
+ if b.Top + b.Height > Result then
+ Result := b.Top + b.Height;
+ end;
+
+ Result := Round((Result + Workspace.BandHeader + 4) / Workspace.GridY) * Workspace.GridY;
+ Result := Round(Result * 100000000) / 100000000;
+ end;
+
+begin
+ if Page = nil then Exit;
+
+ i := (Sender as TMenuItem).Tag;
+
+ Band := TfrxBand(frxBands[i mod 100].NewInstance);
+ Band.Create(FPage);
+ Band.CreateUniqueName;
+{$IFNDEF RAD_ED}
+ if i >= 100 then
+ Band.Vertical := True;
+{$ENDIF}
+
+ if not Band.Vertical then
+ if Workspace.FreeBandsPlacement then
+ Band.Top := FindFreeSpace else
+ Band.Top := 10000;
+
+ Size := 0;
+ case FUnits of
+ duCM: Size := fr01cm * 6;
+ duInches: Size := fr01in * 3;
+ duPixels: Size := 20;
+ duChars: Size := fr1CharY;
+ end;
+
+ if not Band.Vertical then
+ Band.Height := Size
+ else
+ begin
+ Band.Left := Size;
+ Band.Width := Size;
+ end;
+
+ FObjects.Add(Band);
+ FSelectedObjects.Clear;
+ FSelectedObjects.Add(Band);
+ Modified := True;
+ OnSelectionChanged(Self);
+
+ ObjectSelectB.IsPressed := True;
+ SelectToolBClick(Sender);
+
+ if EditAfterInsert then
+ OnEditObject(Self);
+end;
+
+procedure TfrxDesignerForm.ToolButtonClick(Sender: TObject);
+var
+ i, cbIdx: Integer;
+ c: TfrxComponent;
+ wasModified: Boolean;
+ gx, gy: Extended;
+ TheFont: TfrxFont;
+
+ procedure EditFont;
+ begin
+// with TFontDialog.Create(Application) do
+// begin
+// Font := TfrxComponent(FSelectedObjects[0]).Font;
+// Options := Options + [fdForceFontExist];
+// if Execute then
+// begin
+// TheFont := TFont.Create;
+// TheFont.Assign(Font);
+// end;
+// Free;
+// end;
+ end;
+
+ procedure SetFontStyle(c: TfrxComponent; fStyle: TFontStyle; Include: Boolean);
+ begin
+ with c.Font do
+ if Include then
+ Style := Style + [fStyle] else
+ Style := Style - [fStyle];
+ end;
+
+ procedure SetFrameType(c: TfrxComponent; fType: TfrxFrameType; Include: Boolean);
+ var
+ f: TfrxFrame;
+ begin
+ if c is TfrxView then
+ f := TfrxView(c).Frame
+ else if c is TfrxReportPage then
+ f := TfrxReportPage(c).Frame else
+ Exit;
+
+ with f do
+ if Include then
+ Typ := Typ + [fType] else
+ Typ := Typ - [fType];
+ end;
+
+ procedure SetDMPFontStyle(c: TfrxComponent; fStyle: TfrxDMPFontStyle;
+ Include: Boolean);
+ var
+ Style: TfrxDMPFontStyles;
+ begin
+ Style := [];
+ if c is TfrxDMPMemoView then
+ Style := TfrxDMPMemoView(c).FontStyle;
+ if c is TfrxDMPLineView then
+ Style := TfrxDMPLineView(c).FontStyle;
+ if c is TfrxDMPPage then
+ Style := TfrxDMPPage(c).FontStyle;
+ if not Include then
+ Style := Style + [fStyle] else
+ Style := Style - [fStyle];
+ if c is TfrxDMPMemoView then
+ TfrxDMPMemoView(c).FontStyle := Style;
+ if c is TfrxDMPLineView then
+ TfrxDMPLineView(c).FontStyle := Style;
+ if c is TfrxDMPPage then
+ TfrxDMPPage(c).FontStyle := Style;
+ end;
+
+begin
+ if FUpdatingControls then Exit;
+
+ TheFont := nil;
+ wasModified := False;
+ if TComponent(Sender).Tag = 43 then
+ EditFont;
+
+ for i := 0 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if rfDontModify in c.Restrictions then continue;
+
+ case TComponent(Sender).Tag of
+
+ 0:
+ begin
+ // OSX is a case sensetive to font names
+ cbIdx := FontNameCB.Items.IndexOf(FontNameCB.Text);
+ if(cbIdx <> -1) then
+ c.Font.Name := FontNameCB.Items[cbIdx];
+ end;
+
+ 1: c.Font.Size := StrToInt(FontSizeCB.Text);
+
+ 2: SetFontStyle(c, fsBold, BoldB.IsPressed);
+
+ 3: SetFontStyle(c, fsItalic, ItalicB.IsPressed);
+
+ 4: SetFontStyle(c, fsUnderline, UnderlineB.IsPressed);
+
+ 5: c.Font.Color := FColor;
+
+ 6:;
+
+ 7:
+ if c is TfrxCustomMemoView then
+ TfrxCustomMemoView(c).HAlign := haLeft;
+ 8:
+ if c is TfrxCustomMemoView then
+ TfrxCustomMemoView(c).HAlign := haCenter;
+ 9:
+ if c is TfrxCustomMemoView then
+ TfrxCustomMemoView(c).HAlign := haRight;
+ 10:
+ if c is TfrxCustomMemoView then
+ TfrxCustomMemoView(c).HAlign := haBlock;
+ 11:
+ if c is TfrxCustomMemoView then
+ TfrxCustomMemoView(c).VAlign := vaTop;
+ 12:
+ if c is TfrxCustomMemoView then
+ TfrxCustomMemoView(c).VAlign := vaCenter;
+ 13:
+ if c is TfrxCustomMemoView then
+ TfrxCustomMemoView(c).VAlign := vaBottom;
+
+ 20: SetFrameType(c, ftTop, FrameTopB.IsPressed);
+
+ 21: SetFrameType(c, ftBottom, FrameBottomB.IsPressed);
+
+ 22: SetFrameType(c, ftLeft, FrameLeftB.IsPressed);
+
+ 23: SetFrameType(c, ftRight, FrameRightB.IsPressed);
+
+ 24: begin
+ SetFrameType(c, ftTop, True);
+ SetFrameType(c, ftBottom, True);
+ SetFrameType(c, ftLeft, True);
+ SetFrameType(c, ftRight, True);
+ end;
+
+ 25: begin
+ SetFrameType(c, ftTop, False);
+ SetFrameType(c, ftBottom, False);
+ SetFrameType(c, ftLeft, False);
+ SetFrameType(c, ftRight, False);
+ end;
+
+ 26: if c is TfrxView then
+ TfrxView(c).Color := FColor
+ else if c is TfrxReportPage then
+ TfrxReportPage(c).Color := FColor
+ else if c is TfrxDialogPage then
+ begin
+ TfrxDialogPage(c).Color := FColor;
+ FWorkspace.Color := FColor;
+ end;
+ //else if c is TfrxDialogControl then
+ //TfrxDialogControl(c).Color := FColor;
+
+ 27: if c is TfrxView then
+ TfrxView(c).Frame.Color := FColor
+ else if c is TfrxReportPage then
+ TfrxReportPage(c).Frame.Color := FColor;
+
+ 28: if c is TfrxView then
+ TfrxView(c).Frame.Style := FLineStyle
+ else if c is TfrxReportPage then
+ TfrxReportPage(c).Frame.Style := FLineStyle;
+
+ 29:
+ begin
+ if FrameWidthCB.Text = '' then exit;
+ if c is TfrxView then
+ TfrxView(c).Frame.Width := frxStrToFloat(FrameWidthCB.Text)
+ else if c is TfrxReportPage then
+ TfrxReportPage(c).Frame.Width := frxStrToFloat(FrameWidthCB.Text);
+ end;
+
+ 30: if c is TfrxCustomMemoView then
+ TfrxCustomMemoView(c).Rotation := TMenuItem(Sender).HelpContext;
+
+ 31:
+ begin
+ gx := FWorkspace.GridX;
+ gy := FWorkspace.GridY;
+ c.Left := Round(c.Left / gx) * gx;
+ c.Top := Round(c.Top / gy) * gy;
+ c.Width := Round(c.Width / gx) * gx;
+ c.Height := Round(c.Height / gy) * gy;
+ if c.Width = 0 then
+ c.Width := gx;
+ if c.Height = 0 then
+ c.Height := gy;
+ end;
+
+ 32: if c is TfrxView then
+ TfrxView(c).Frame.DropShadow := ShadowB.IsPressed
+ else if c is TfrxReportPage then
+ TfrxReportPage(c).Frame.DropShadow := ShadowB.IsPressed;
+
+ 33: if c is TfrxCustomMemoView then
+ if StyleCB.ItemIndex = 0 then
+ TfrxCustomMemoView(c).Style := '' else
+ TfrxCustomMemoView(c).Style := StyleCB.Text;
+
+ 34: SetDMPFontStyle(c, fsxBold, BoldMI.IsChecked);
+
+ 35: SetDMPFontStyle(c, fsxItalic, ItalicMI.IsChecked);
+
+ 36: SetDMPFontStyle(c, fsxUnderline, UnderlineMI.IsChecked);
+
+ 37: SetDMPFontStyle(c, fsxSuperScript, SuperScriptMI.IsChecked);
+
+ 38: SetDMPFontStyle(c, fsxSubScript, SubScriptMI.IsChecked);
+
+ 39: SetDMPFontStyle(c, fsxCondensed, CondensedMI.IsChecked);
+
+ 40: SetDMPFontStyle(c, fsxWide, WideMI.IsChecked);
+
+ 41: SetDMPFontStyle(c, fsx12cpi, N12cpiMI.IsChecked);
+
+ 42: SetDMPFontStyle(c, fsx15cpi, N15cpiMI.IsChecked);
+
+ 43: if TheFont <> nil then
+ c.Font := TheFont;
+ end;
+
+ if TComponent(Sender).Tag in [0..5, 20..29, 32] then
+ if c is TfrxCustomMemoView then
+ begin
+ TfrxCustomMemoView(c).Style := '';
+ StyleCB.Text := StyleCB.Items[0];
+ end;
+
+ if c is TfrxCustomMemoView then
+ FSampleFormat.SetAsSample(TfrxCustomMemoView(c));
+ wasModified := True;
+ end;
+
+ if TheFont <> nil then
+ TheFont.Free;
+
+ if not TComponent(Sender).Tag in [1] then
+ ScrollBox.SetFocus;
+
+ if wasModified then
+ begin
+ FModifiedBy := Self;
+ Modified := True;
+
+ if TComponent(Sender).Tag in [7..13, 24, 25, 34..43] then
+ UpdateControls;
+ end;
+end;
+
+procedure TfrxDesignerForm.FontBClick(Sender: TObject);
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ with TfrxFontForm.Create(nil) do
+ begin
+ if FSelectedObjects.Count > 0 then
+ begin
+ c := FSelectedObjects[0];
+ FontS.Assign(c.Font);
+ end;
+ FormActivate(Sender);
+ if ShowModal = mrOk then
+ begin
+ for i := 0 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if rfDontModify in c.Restrictions then continue;
+ c.Font.Assign(FontS);
+ end;
+ FModifiedBy := Self;
+ Modified := True;
+ end;
+ Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.FontColorBClick(Sender: TObject);
+begin
+ CreateColorSelector(Sender as TfrxToolButton);
+end;
+
+procedure TfrxDesignerForm.FrameStyleBClick(Sender: TObject);
+begin
+ if FLineSelector = nil then
+ begin
+ FLineSelector := TfrxLineSelector.Create(Self);
+ FLineSelector.Parent := Self;
+ FLineSelector.OnStyleChanged := Self.OnStyleChanged;
+ end;
+
+ FLineSelector.Popup(TControl(Sender));
+end;
+
+procedure TfrxDesignerForm.ScaleCBClick(Sender: TObject);
+var
+ s: String;
+ dx, dy: Integer;
+begin
+ if ScaleCB.ItemIndex = 6 then
+ s := IntToStr(Round((ScrollBox.Width - 40) / (TfrxReportPage(FPage).PaperWidth * 96 / 25.4) * 100))
+ else if ScaleCB.ItemIndex = 7 then
+ begin
+ dx := Round(TfrxReportPage(FPage).PaperWidth * 96 / 25.4);
+ dy := Round(TfrxReportPage(FPage).PaperHeight * 96 / 25.4);
+ if (ScrollBox.Width - 20) / dx < (ScrollBox.Height - 20) / dy then
+ s := IntToStr(Round((ScrollBox.Width - 20) / dx * 100)) else
+ s := IntToStr(Round((ScrollBox.Height - 20) / dy * 100));
+ end
+ else
+ s := ScaleCB.Text;
+
+ if Pos('%', s) <> 0 then
+ s[Pos('%', s)] := ' ';
+ while Pos(' ', s) <> 0 do
+ Delete(s, Pos(' ', s), 1);
+
+ if s <> '' then
+ begin
+ Scale := frxStrToFloat(s) / 100;
+ ScaleCB.OnChange := nil;
+ ScaleCB.Text := s + '%';
+ ScaleCB.OnChange := ScaleCBClick;
+ ScrollBox.SetFocus;
+ end;
+end;
+
+procedure TfrxDesignerForm.ShowGridBClick(Sender: TObject);
+begin
+ ShowGrid := ShowGridB.IsPressed;
+end;
+
+procedure TfrxDesignerForm.AlignToGridBClick(Sender: TObject);
+begin
+ GridAlign := AlignToGridB.IsPressed;
+end;
+
+procedure TfrxDesignerForm.LangCBClick(Sender: TObject);
+begin
+ LangCB.OnChange := nil;
+ if frxConfirmMsg(frxResources.Get('dsClearScript'), [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo]) <> mrYes then
+ begin
+ LangCB.ItemIndex := LangCB.Items.IndexOf(Report.ScriptLanguage);
+ Exit;
+ end;
+
+ Report.ScriptLanguage := LangCB.Text;
+ frxEmptyCode(CodeWindow.Lines, Report.ScriptLanguage);
+
+ UpdateSyntaxType;
+ Modified := True;
+ CodeWindow.SetFocus;
+ LangCB.OnChange := LangCBClick;
+end;
+
+procedure TfrxDesignerForm.OpenScriptBClick(Sender: TObject);
+begin
+ with OpenScriptDialog do
+ if Execute then
+ begin
+ CodeWindow.Lines.LoadFromFile(FileName);
+ Modified := True;
+ end;
+end;
+
+procedure TfrxDesignerForm.SaveScriptBClick(Sender: TObject);
+begin
+ with SaveScriptDialog do
+ if Execute then
+ CodeWindow.Lines.SaveToFile(FileName);
+end;
+
+procedure TfrxDesignerForm.HighlightBClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ with TfrxHighlightEditorForm.Create(Self) do
+ begin
+ MemoView := SelectedObjects[0];
+ FormShow(Self);
+ if ShowModal = mrOk then
+ begin
+ for i := 1 to SelectedObjects.Count - 1 do
+ if TObject(SelectedObjects[i]) is TfrxMemoView then
+ TfrxMemoView(SelectedObjects[i]).Highlight.Assign(MemoView.Highlight);
+
+ Modified := True;
+ end;
+ Free;
+ end;
+end;
+
+
+{ Controls' event handlers }
+{------------------------------------------------------------------------------}
+
+procedure TfrxDesignerForm.OnCodeChanged(Sender: TObject);
+begin
+ if FPage = nil then
+ begin
+ FModified := True;
+ SaveB.Enabled := CheckOp(drDontSaveReport);
+ UndoB.Enabled := True;
+ end;
+end;
+
+procedure TfrxDesignerForm.OnChangePosition(Sender: TObject);
+begin
+ if FPage = nil then
+ begin
+ FCoord1 := Format('%d; %d', [CodeWindow.GetPos.Y, CodeWindow.GetPos.X]);
+ FCoord2 := '';
+ FCoord3 := '';
+ end;
+ StatusBar.Repaint;
+end;
+
+procedure TfrxDesignerForm.OnColorChanged(Sender: TObject);
+begin
+ with TfrxColorSelector(Sender) do
+ begin
+ FColor := Color;
+ ToolButtonClick(TfrxColorSelector(Sender));
+ end;
+end;
+
+procedure TfrxDesignerForm.OnStyleChanged(Sender: TObject);
+begin
+ with TfrxLineSelector(Sender) do
+ begin
+ FLineStyle := TfrxFrameStyle(Style);
+ ToolButtonClick(TfrxLineSelector(Sender));
+ end;
+end;
+
+procedure TfrxDesignerForm.ScrollBoxMouseWheelUp(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
+begin
+{$IFDEF DELPHI18}
+ with ScrollBox.ViewportPosition do
+ ScrollBox.ViewportPosition := PointF(X, Y - 16)
+{$ELSE}
+ with ScrollBox.VScrollBar do
+ Value := Value - 16;
+{$ENDIF}
+end;
+
+procedure TfrxDesignerForm.ScrollBoxMouseWheelDown(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
+begin
+{$IFDEF DELPHI18}
+ with ScrollBox.ViewportPosition do
+ ScrollBox.ViewportPosition := PointF(X, Y + 16)
+{$ELSE}
+ with ScrollBox.VScrollBar do
+ Value := Value + 16;
+{$ENDIF}
+end;
+
+procedure TfrxDesignerForm.ScrollBoxResize(Sender: TObject);
+var
+ ofs, st: Single;
+begin
+ if FWorkspace = nil then Exit;
+{$IFDEF DELPHI18}
+ ofs := ScrollBox.Position.X + 2 + FWorkspace.Position.X - ScrollBox.ViewportPosition.X;
+{$ELSE}
+ ofs := ScrollBox.Position.X + 2 + FWorkspace.Position.X - ScrollBox.HScrollBar.Value;
+{$ENDIF}
+ st := 0;
+ if ofs < ScrollBox.Position.X + 2 then
+ begin
+ st := ScrollBox.Position.X + 2 - ofs;
+ ofs := ScrollBox.Position.X + 2;
+ end;
+
+ TopRuler.Offset := Round(ofs);
+ TopRuler.Start := Round(st);
+
+
+{$IFDEF DELPHI18}
+ ofs := 2 + FWorkspace.Position.Y - ScrollBox.ViewportPosition.Y;
+{$ELSE}
+ ofs := 2 + FWorkspace.Position.Y - ScrollBox.VScrollBar.Value;
+{$ENDIF}
+ st := 0;
+ if ofs < 2 then
+ begin
+ st := 2 - ofs;
+ ofs := 2;
+ end;
+
+ LeftRuler.Offset := Round(ofs);
+ LeftRuler.Start := Round(st);
+end;
+
+procedure TfrxDesignerForm.StatusBarMouseDown(Sender: TObject;
+ Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+begin
+ //FUnitsDblClicked := X < StatusBar.Panels[0].Width;
+end;
+
+procedure TfrxDesignerForm.StatusBarDblClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ if FUnitsDblClicked and not
+ ((FWorkspace.GridType = gtDialog) or (FWorkspace.GridType = gtChar)) then
+ begin
+ i := Integer(FUnits);
+ Inc(i);
+ if i > 2 then
+ i := 0;
+ Units := TfrxDesignerUnits(i);
+ FOldUnits := FUnits;
+ end;
+end;
+
+//procedure TfrxDesignerForm.StatusBarDrawPanel(StatusBar: TStatusBar;
+// Panel: TStatusPanel; const ARect: TRect);
+//begin
+// with StatusBar.Canvas do
+// begin
+// FillRect(ARect);
+//
+// if FCoord1 <> '' then
+// begin
+// frxResources.MainButtonImages.Draw(StatusBar.Canvas, ARect.Left + 2, ARect.Top - 1, 62);
+// TextOut(ARect.Left + 20, ARect.Top + 1, FCoord1);
+// end;
+//
+// if FCoord2 <> '' then
+// begin
+// frxResources.MainButtonImages.Draw(StatusBar.Canvas, ARect.Left + 110, ARect.Top - 1, 63);
+// TextOut(ARect.Left + 130, ARect.Top + 1, FCoord2);
+// end;
+//
+// if FCoord3 <> '' then
+// TextOut(ARect.Left + 110, ARect.Top + 1, FCoord3);
+// end;
+//end;
+
+procedure TfrxDesignerForm.TimerTimer(Sender: TObject);
+begin
+ PasteB.Enabled := FClipboard.PasteAvailable or (FPage = nil);
+end;
+
+procedure TfrxDesignerForm.BandsPopupPopup(Sender: TObject);
+
+ function FindBand(Band: TfrxComponentClass): TfrxBand;
+ var
+ i: Integer;
+ begin
+ Result := nil;
+ if FPage = nil then Exit;
+ for i := 0 to FPage.Objects.Count - 1 do
+ if TObject(FPage.Objects[i]) is Band then
+ Result := FPage.Objects[i];
+ end;
+
+begin
+ ReportTitleMI.Enabled := FindBand(TfrxReportTitle) = nil;
+ ReportSummaryMI.Enabled := FindBand(TfrxReportSummary) = nil;
+ PageHeaderMI.Enabled := FindBand(TfrxPageHeader) = nil;
+ PageFooterMI.Enabled := FindBand(TfrxPageFooter) = nil;
+ ColumnHeaderMI.Enabled := FindBand(TfrxColumnHeader) = nil;
+ ColumnFooterMI.Enabled := FindBand(TfrxColumnFooter) = nil;
+end;
+
+procedure TfrxDesignerForm.TopRulerDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+{$IFDEF DELPHI20}
+var
+ Accept: Boolean;
+{$ENDIF}
+begin
+ Accept := Data.Source is TfrxDesignerWorkspace;
+ {$IFDEF DELPHI20}
+ if Accept then
+ Operation := TDragOperation.Copy;
+{$ENDIF}
+end;
+
+procedure TfrxDesignerForm.PagePopupPopup(Sender: TObject; X, Y: Single);
+var
+ ed: TfrxComponentEditor;
+ pt: TPointF;
+ // m: TMenuItem;
+ EditMI1, AddChildMI, CutMI1, CopyMI1, PasteMI1, DeleteMI1, SelectAllMI1,
+ BringtoFrontMI1, SendtoBackMI1, TabOrderMI, SepMI: TMenuItem;
+begin
+{$IFDEF Delphi17}
+ PagePopup.Clear;
+{$ELSE}
+ while PagePopup.ChildrenCount > 0 do
+ PagePopup.Children[0].Free;
+{$ENDIF}
+
+ EditMI1 := TMenuItem.Create(PagePopup);
+ EditMI1.Parent := PagePopup;
+ EditMI1.Text := frxGet(2415);
+ EditMI1.OnClick := EditCmdExecute;
+
+ if (TObject(FSelectedObjects[0]) is TfrxBand) and
+ not (TObject(FSelectedObjects[0]) is TfrxColumnFooter) and
+ not (TObject(FSelectedObjects[0]) is TfrxOverlay) then
+ begin
+ AddChildMI := TMenuItem.Create(PagePopup);
+ AddChildMI.Text := frxGet(2478);
+ AddChildMI.OnClick := AddChildMIClick;
+ AddChildMI.Parent := PagePopup;
+ end;
+
+
+ ed := frxComponentEditors.GetComponentEditor(FSelectedObjects[0], Self, PagePopup);
+ if ed <> nil then
+ begin
+ EditMI1.Enabled := ed.HasEditor;
+
+ ed.GetMenuItems(OnComponentMenuClick);
+ ed.Free;
+ end
+ else
+ begin
+ EditMI1.Enabled := False;
+ end;
+
+ SepMI := TMenuItem.Create(PagePopup);
+ SepMI.Text := '-';
+ SepMI.Parent := PagePopup;
+
+ CutMI1 := TMenuItem.Create(PagePopup);
+ CutMI1.Text := frxGet(2407);
+ CutMI1.OnClick := CutCmdExecute;
+ CutMI1.Parent := PagePopup;
+ frxResources.LoadImageFromResouce(CutMI1.Bitmap, 0, 5);
+
+ CopyMI1 := TMenuItem.Create(PagePopup);
+ CopyMI1.Text := frxGet(2408);
+ CopyMI1.OnClick := CopyCmdExecute;
+ CopyMI1.Parent := PagePopup;
+ frxResources.LoadImageFromResouce(CopyMI1.Bitmap, 0, 6);
+
+ PasteMI1 := TMenuItem.Create(PagePopup);
+ PasteMI1.Text := frxGet(2409);
+ PasteMI1.OnClick := PasteCmdExecute;
+ PasteMI1.Parent := PagePopup;
+ frxResources.LoadImageFromResouce(PasteMI1.Bitmap, 0, 7);
+
+ DeleteMI1 := TMenuItem.Create(PagePopup);
+ DeleteMI1.Text := frxGet(2412);
+ DeleteMI1.OnClick := DeleteCmdExecute;
+ DeleteMI1.Parent := PagePopup;
+ frxResources.LoadImageFromResouce(DeleteMI1.Bitmap, 5, 1);
+
+ SelectAllMI1 := TMenuItem.Create(PagePopup);
+ SelectAllMI1.Text := frxGet(2414);
+ SelectAllMI1.OnClick := SelectAllCmdExecute;
+ SelectAllMI1.Parent := PagePopup;
+
+ BringtoFrontMI1 := TMenuItem.Create(PagePopup);
+ BringtoFrontMI1.Text := frxGet(2416);
+ BringtoFrontMI1.OnClick := BringToFrontCmdExecute;
+ BringtoFrontMI1.Parent := PagePopup;
+ frxResources.LoadImageFromResouce(BringtoFrontMI1.Bitmap, 1, 4);
+
+ SendtoBackMI1 := TMenuItem.Create(PagePopup);
+ SendtoBackMI1.Text := frxGet(2417);
+ SendtoBackMI1.OnClick := SendToBackCmdExecute;
+ SendtoBackMI1.Parent := PagePopup;
+ frxResources.LoadImageFromResouce(SendtoBackMI1.Bitmap, 1, 5);
+
+ if FPage is TfrxDialogPage then
+ begin
+ TabOrderMI := TMenuItem.Create(PagePopup);
+ TabOrderMI.Text := frxGet(2404);
+ TabOrderMI.OnClick := TabOrderMIClick;
+ TabOrderMI.Parent := PagePopup;
+ end;
+
+ pt := Self.ClientToScreen(PointF((Sender as TControl).AbsoluteRect.Left + X, (Sender as TControl).AbsoluteRect.Top + Y));
+ PagePopup.Popup(pt.X, pt.Y);
+ //p.Free;
+end;
+
+procedure TfrxDesignerForm.CodeWindowDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+{$IFDEF DELPHI20}
+var
+ Accept: Boolean;
+{$ENDIF}
+begin
+ Accept := (Data.Source is TTreeView) and (TTreeView(Data.Source).Owner = FDataTree) and
+ (FDataTree.GetFieldName <> '');
+ {$IFDEF DELPHI20}
+ if Accept then
+ Operation := TDragOperation.Copy;
+{$ENDIF}
+end;
+
+procedure TfrxDesignerForm.CodeWindowDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+begin
+ CodeWindow.SelText := FDataTree.GetFieldName;
+ CodeWindow.SetFocus;
+end;
+
+{procedure TfrxDesignerForm.OnDataTreeDblClick(Sender: TObject);
+begin
+ if Page = nil then
+ begin
+ CodeWindow.SelText := FDataTree.GetFieldName;
+ CodeWindow.SetFocus;
+ end
+ else if (FDataTree.GetActivePage = 0) and
+ (Report.DataSets.Count = 0) then
+ ReportDataCmdExecute(Self);
+end;}
+
+procedure TfrxDesignerForm.TabChanging(Sender: TObject; var AllowChange: Boolean);
+begin
+ if IsPreviewDesigner or FScriptRunning then
+ AllowChange := False;
+
+ if (FTabs.TabIndex = 0) and CodeWindow.Modified then
+ begin
+ Modified := True;
+ CodeWindow.Modified := False;
+ end;
+
+ SavePagePosition;
+end;
+
+procedure TfrxDesignerForm.TabSetChange(Sender: TObject; NewTab: Integer;
+ var AllowChange: Boolean);
+begin
+ TabChanging(nil, AllowChange);
+end;
+
+procedure TfrxDesignerForm.TabChange(Sender: TObject);
+begin
+ if FTabs.TabIndex = -1 then Exit;
+
+ if (FTabs.TabIndex = 0) then
+{$IFDEF FR_VER_BASIC}
+ FTabs.TabIndex := 1 else
+{$ELSE}
+ begin
+ if CheckOp(drDontEditReportScript) then Page := nil
+ else FTabs.TabIndex := 1
+ end else
+{$ENDIF}
+ if (FTabs.TabIndex = 1) and not CheckOp(drDontEditInternalDatasets) then
+ FTabs.TabIndex := 2
+ else Page := Report.Pages[FTabs.TabIndex - 1];
+end;
+
+procedure TfrxDesignerForm.TabMouseDown(Sender: TObject;
+ Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+
+begin
+ FMouseTabDX := X;
+ FMouseDown := True;
+end;
+
+procedure TfrxDesignerForm.TabMouseLeave(Sender: TObject);
+var
+ i: Integer;
+begin
+ FMouseDown := False;
+ if FDragTabItem = nil then Exit;
+ if Sender is TTabControl then
+ begin
+ for i := 0 to FTabs.TabCount - 1 do
+ begin
+ FMouseDown := FTabs.Tabs[i].IsMouseOver;
+ if FMouseDown then break;
+ end;
+ end;
+ if Sender is TTabItem then
+ FMouseDown := FTabs.IsMouseOver;
+ if not FMouseDown then
+ THackControl(FDragTabItem).DragEnd;
+end;
+
+procedure TfrxDesignerForm.TabMouseUp(Sender: TObject;
+ Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+var
+ pt: TPointF;
+begin
+ FMouseDown := False;
+ if (Button = mbRight) and (Sender is TTabItem) then
+ begin
+ pt := Self.ClientToScreen(TTabItem(Sender).LocalToAbsolute(PointF(X, Y)));
+ TabPopup.Popup(pt.X, pt.Y);
+ end
+ else if (Button = mbLeft) and Assigned(FDragTabItem) then
+ THackControl(FDragTabItem).DragEnd;
+end;
+
+procedure TfrxDesignerForm.TabMouseMove(Sender: TObject;
+ Shift: TShiftState; X, Y: Single);
+var
+ s: TBitmap;
+ TabItem: TTabItem;
+begin
+ if FMouseDown and (Sender is TTabItem) then
+ begin
+ FMouseTabDX := X - FMouseTabDX;
+ if Abs(FMouseTabDX) > 3 then
+ begin
+ TabItem := TTabItem(Sender);
+ S := TabItem.MakeScreenshot;
+ try
+ TabItem.Root.BeginInternalDrag(TabItem, s);
+ FDragTabItem := TabItem;
+ finally
+ FreeAndNil(S);
+ end;
+ end;
+ end;
+end;
+
+procedure TfrxDesignerForm.TabDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+{$IFDEF DELPHI20}
+var
+ Accept: Boolean;
+{$ENDIF}
+begin
+ { regular page marked with Tag = 1 }
+ Accept := (Data.Source is Sender.ClassType) and (Data.Source is TComponent)
+ and (TComponent(Data.Source).Tag > 0);
+ if Accept then
+ begin
+{$IFDEF DELPHI20}
+ Operation := TDragOperation.Copy;
+{$ENDIF}
+ end;
+end;
+
+
+procedure TfrxDesignerForm.TabDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+begin
+ FMouseDown := False;
+ FTabs.BeginUpdate;
+ if (Data.Source is TTabItem) and (Sender is TTabItem) and (TTabItem(Sender).Tag > 0) and (TTabItem(Data.Source).Tag > 0) then
+ begin
+ Report.Objects.Move(TTabItem(Data.Source).Index - 1, TTabItem(Sender).Index - 1);
+ TTabItem(Data.Source).Index := TTabItem(Sender).Index;
+ Modified := True;
+ THackControl(Sender).DragEnd;
+ end;
+ FTabs.EndUpdate;
+end;
+
+
+procedure TfrxDesignerForm.TabDragEnd(Sender: TObject);
+begin
+ FDragTabItem := nil;
+ FMouseDown := False;
+end;
+
+{ Menu commands }
+{------------------------------------------------------------------------------}
+
+procedure TfrxDesignerForm.ExitCmdExecute(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure TfrxDesignerForm.UndoCmdExecute(Sender: TObject);
+var
+ i: Integer;
+ SaveX, SaveY: Single;
+ TmpPage: TfrxReportPage;
+begin
+ if FPage = nil then
+ begin
+ CodeWindow.Undo;
+ Exit;
+ end;
+ Lock;
+ Report.ScriptText := CodeWindow.Lines;
+{$IFDEF DELPHI18}
+ SaveY := ScrollBox.ViewportPosition.Y;
+ SaveX := ScrollBox.ViewportPosition.X;
+{$ELSE}
+ SaveY := ScrollBox.VScrollBar.Value;
+ SaveX := ScrollBox.HScrollBar.Value;
+{$ENDIF}
+ if IsPreviewDesigner then
+ begin
+ i := 1;
+ if FPage is TfrxDMPPage then
+ TmpPage := TfrxDMPPage.Create(nil)
+ else
+ TmpPage := TfrxReportPage.Create(nil);
+
+ FUndoBuffer.AddRedo(FPage);
+ FPage.Free;
+ FUndoBuffer.GetUndo(TmpPage);
+ TmpPage.Parent := Report;
+ FPage := TmpPage;
+ end
+ else
+ begin
+ i := GetPageIndex;
+ FUndoBuffer.AddRedo(Report);
+ FUndoBuffer.GetUndo(Report);
+ CodeWindow.Lines := Report.ScriptText;
+ end;
+
+ ReloadPages(i);
+{$IFDEF DELPHI18}
+ ScrollBox.ViewportPosition := PointF(Savex, SaveY);
+{$ELSE}
+ ScrollBox.VScrollBar.Value := SaveY;
+ ScrollBox.HScrollBar.Value := SaveX;
+{$ENDIF}
+ if not Modified then
+ SaveB.Enabled := True;
+end;
+
+procedure TfrxDesignerForm.RedoCmdExecute(Sender: TObject);
+var
+ i: Integer;
+ SaveX, SaveY: Single;
+ TmpPage: TfrxReportPage;
+begin
+ Lock;
+{$IFDEF DELPHI18}
+ SaveY := ScrollBox.ViewportPosition.Y;
+ SaveX := ScrollBox.ViewportPosition.X;
+{$ELSE}
+ SaveY := ScrollBox.VScrollBar.Value;
+ SaveX := ScrollBox.HScrollBar.Value;
+{$ENDIF}
+ if IsPreviewDesigner then
+ begin
+ i := 1;
+ if FPage is TfrxDMPPage then
+ TmpPage := TfrxDMPPage.Create(nil)
+ else
+ TmpPage := TfrxReportPage.Create(nil);
+
+ FUndoBuffer.GetRedo(TmpPage);
+ FUndoBuffer.AddUndo(TmpPage);
+ FPage.Free;
+ TmpPage.Parent := Report;
+ FPage := TmpPage;
+ end
+ else
+ begin
+ i := GetPageIndex;
+ Report.Reloading := True;
+ FUndoBuffer.GetRedo(Report);
+ Report.Reloading := False;
+ FUndoBuffer.AddUndo(Report);
+ CodeWindow.Lines := Report.ScriptText;
+ end;
+
+ ReloadPages(i);
+{$IFDEF DELPHI18}
+ ScrollBox.ViewportPosition := PointF(Savex, SaveY);
+{$ELSE}
+ ScrollBox.VScrollBar.Value := SaveY;
+ ScrollBox.HScrollBar.Value := SaveX;
+{$ENDIF}
+end;
+
+procedure TfrxDesignerForm.CutCmdExecute(Sender: TObject);
+begin
+ if FPage = nil then
+ begin
+ CodeWindow.CutToClipboard;
+ Exit;
+ end;
+
+ FClipboard.Copy;
+ FWorkspace.DeleteObjects;
+ FInspector.Objects := FObjects;
+
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.CopyCmdExecute(Sender: TObject);
+begin
+ if FPage = nil then
+ begin
+ CodeWindow.CopyToClipboard;
+ Exit;
+ end;
+
+ FClipboard.Copy;
+ TimerTimer(nil);
+end;
+
+procedure TfrxDesignerForm.PasteCmdExecute(Sender: TObject);
+begin
+ if FPage = nil then
+ begin
+ CodeWindow.PasteFromClipboard;
+ Exit;
+ end;
+
+ FClipboard.Paste;
+ FWorkspace.BringToFront;
+ FInspector.Objects := FObjects;
+ FInspector.UpdateProperties;
+
+ if TfrxComponent(FSelectedObjects[0]) is TfrxDialogComponent then
+ Modified := True
+ else if FSelectedObjects[0] <> FPage then
+ TDesignerWorkspace(FWorkspace).SimulateMove;
+end;
+
+procedure TfrxDesignerForm.GroupCmdExecute(Sender: TObject);
+begin
+ FWorkspace.GroupObjects;
+end;
+
+procedure TfrxDesignerForm.UngroupCmdExecute(Sender: TObject);
+begin
+ FWorkspace.UngroupObjects;
+end;
+
+procedure TfrxDesignerForm.DeletePageCmdExecute(Sender: TObject);
+begin
+ if not CheckOp(drDontDeletePage) then Exit;
+
+ Lock;
+ if (FPage is TfrxReportPage) and (TfrxReportPage(FPage).Subreport <> nil) then
+ TfrxReportPage(FPage).Subreport.Free;
+
+ FPage.Free;
+ ReloadPages(-2);
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.NewPageBMouseEnter(Sender: TObject);
+var
+ p, r: TRectF;
+ s: String;
+begin
+ if (Sender is TControl) then
+ begin
+
+ if Sender is TfrxToolButton then
+ s:= TfrxToolButton(Sender).Hint
+ else
+ s := TControl(Sender).TagString;
+ p := TControl(Sender).AbsoluteRect;
+
+ r := RectF(0, 0, 300, 1000);
+ if Label1.Canvas <> nil then
+ begin
+ Label1.Canvas.MeasureText(r, s, True, [], TTextAlign.taCenter, TTextAlign.taCenter);
+ HintPanel.Width := r.Width + 12;
+ HintPanel.Height := r.Height + HintPanel.CalloutLength + 10;
+ end;
+
+
+ if (p.Left + TControl(Sender).Width/2 > HintPanel.Width/2) then
+ begin
+ HintPanel.CalloutPosition := TCalloutPosition.cpTop;
+ HintPanel.Position.X := p.Left + TControl(Sender).Width/2 - HintPanel.Width/2;
+ HintPanel.Position.Y := p.Top + TControl(Sender).Height;
+{$IFDEF DELPHI18}
+ Label1.Margins.Left := 0;
+ Label1.Margins.Top := 0;
+{$ELSE}
+ Label1.Padding.Left := 0;
+ Label1.Padding.Top := 0;
+{$ENDIF}
+ end
+ else
+ begin
+ HintPanel.CalloutPosition := TCalloutPosition.cpLeft;
+ HintPanel.Position.X := p.Left + TControl(Sender).Width;
+ HintPanel.Position.Y := p.Top - HintPanel.Height/2 + TControl(Sender).Height/2;
+ HintPanel.Width := HintPanel.Width + HintPanel.CalloutLength;
+{$IFDEF DELPHI18}
+ Label1.Margins.Left := HintPanel.CalloutLength / 2;
+ Label1.Margins.Top := HintPanel.CalloutLength / 2;
+{$ELSE}
+ Label1.Padding.Left := HintPanel.CalloutLength;
+ Label1.Padding.Top := -HintPanel.CalloutLength;
+{$ENDIF}
+ end;
+ HintPanel.Visible := True;
+ Label1.Text := s;
+end;
+
+end;
+
+procedure TfrxDesignerForm.NewPageBMouseLeave(Sender: TObject);
+begin
+HintPanel.Visible := False;
+end;
+
+procedure TfrxDesignerForm.NewPageCmdExecute(Sender: TObject);
+begin
+ if not CheckOp(drDontCreatePage) then Exit;
+
+ Lock;
+ if Report.DotMatrixReport then
+ FPage := TfrxDMPPage.Create(Report)
+ else
+ FPage := TfrxReportPage.Create(Report);
+ FPage.CreateUniqueName;
+ TfrxReportPage(FPage).SetDefaults;
+ ReloadPages(Report.PagesCount - 1);
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.NewDialogCmdExecute(Sender: TObject);
+begin
+ if not CheckOp(drDontCreatePage) then Exit;
+
+ Lock;
+ FPage := TfrxDialogPage.Create(Report);
+ FPage.CreateUniqueName;
+ FPage.SetBounds(265, 150, 300, 200);
+ if frxDesignerComp <> nil then
+ FPage.Font.Assign(frxDesignerComp.DefaultFont);
+ ReloadPages(Report.PagesCount - 1);
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.NewReportCmdExecute(Sender: TObject);
+var
+ dp: TfrxDataPage;
+ p: TfrxReportPage;
+ b: TfrxBand;
+ m: TfrxMemoView;
+ h, t: Extended;
+ w: Word;
+begin
+ if not CheckOp(drDontCreateReport) then Exit;
+
+ if Modified then
+ begin
+ w := AskSave;
+ if w = mrYes then
+ SaveCmdExecute(Self)
+ else if w = mrCancel then
+ Exit;
+ end;
+
+ t := FWorkspace.BandHeader;
+ h := 0;
+ case FUnits of
+ duCM: h := fr01cm * 6;
+ duInches: h := fr01in * 3;
+ duPixels: h := 20;
+ duChars: h := fr1CharY;
+ end;
+
+ ObjectSelectB.IsPressed := True;
+ SelectToolBClick(Self);
+
+ Lock;
+ Report.Clear;
+ Report.FileName := '';
+
+ dp := TfrxDataPage.Create(Report);
+ dp.Name := 'Data';
+
+ p := TfrxReportPage.Create(Report);
+ p.Name := 'Page1';
+ SetReportDefaults;
+
+ b := TfrxReportTitle.Create(p);
+ b.Name := 'ReportTitle1';
+ b.Top := t;
+ b.Height := h;
+
+ b := TfrxMasterData.Create(p);
+ b.Name := 'MasterData1';
+ b.Height := h;
+ b.Top := t * 2 + h * 2;
+
+ b := TfrxPageFooter.Create(p);
+ b.Name := 'PageFooter1';
+ b.Height := h;
+ b.Top := t * 3 + h * 4;
+
+ m := TfrxMemoView.Create(b);
+ m.Name := 'Memo1';
+ m.SetBounds((p.PaperWidth - p.LeftMargin - p.RightMargin - 20) * fr01cm, 0,
+ 2 * fr1cm, 5 * fr01cm);
+ m.HAlign := haRight;
+ m.Memo.Text := '[Page#]';
+
+ ReloadPages(-2);
+ UpdateCaption;
+ Modified := False;
+end;
+
+procedure TfrxDesignerForm.SaveCmdExecute(Sender: TObject);
+begin
+ FInspector.ItemIndex := FInspector.ItemIndex;
+ if CheckOp(drDontSaveReport) then
+ SaveFile(False, Sender = Self);
+end;
+
+procedure TfrxDesignerForm.SaveAsCmdExecute(Sender: TObject);
+begin
+ FInspector.ItemIndex := FInspector.ItemIndex;
+ if CheckOp(drDontSaveReport) then
+ SaveFile(True, Sender = Self);
+end;
+
+procedure TfrxDesignerForm.OpenCmdExecute(Sender: TObject);
+begin
+ if CheckOp(drDontLoadReport) then
+ LoadFile('', Sender = Self);
+end;
+
+procedure TfrxDesignerForm.OpenRecentFile(Sender: TObject);
+begin
+ if CheckOp(drDontLoadReport) then
+ LoadFile(TMenuItem(Sender).Text, True);
+end;
+
+procedure TfrxDesignerForm.DeleteCmdExecute(Sender: TObject);
+begin
+ FWorkspace.DeleteObjects;
+end;
+
+procedure TfrxDesignerForm.SelectAllCmdExecute(Sender: TObject);
+var
+ i: Integer;
+ Parent: TfrxComponent;
+begin
+ if Page = nil then
+ begin
+ //CodeWindow.SelectAll;
+ Exit;
+ end;
+
+ Parent := FPage;
+ if FSelectedObjects.Count = 1 then
+ if TfrxComponent(FSelectedObjects[0]) is TfrxBand then
+ Parent := FSelectedObjects[0]
+ else if TfrxComponent(FSelectedObjects[0]).Parent is TfrxBand then
+ Parent := TfrxComponent(FSelectedObjects[0]).Parent;
+
+ if Parent.Objects.Count <> 0 then
+ FSelectedObjects.Clear;
+ for i := 0 to Parent.Objects.Count - 1 do
+ FSelectedObjects.Add(Parent.Objects[i]);
+ OnSelectionChanged(Self);
+end;
+
+procedure TfrxDesignerForm.EditCmdExecute(Sender: TObject);
+begin
+ FWorkspace.EditObject;
+end;
+
+procedure TfrxDesignerForm.BringToFrontCmdExecute(Sender: TObject);
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ for i := 0 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if c.Parent <> nil then
+ if (c is TfrxReportComponent) and not (rfDontMove in c.Restrictions) then
+ begin
+ c.Parent.Objects.Remove(c);
+ c.Parent.Objects.Add(c);
+ end;
+ end;
+
+ ReloadObjects;
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.SendToBackCmdExecute(Sender: TObject);
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ for i := 0 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if c.Parent <> nil then
+ if (c is TfrxReportComponent) and not (rfDontMove in c.Restrictions) then
+ begin
+ c.Parent.Objects.Remove(c);
+ c.Parent.Objects.Insert(0, c);
+ end;
+ end;
+
+ ReloadObjects;
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.TabOrderMIClick(Sender: TObject);
+begin
+ with TfrxTabOrderEditorForm.Create(Self) do
+ begin
+ if ShowModal = mrOk then
+ Modified := True;
+ ReloadObjects;
+ Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.PageSettingsCmdExecute(Sender: TObject);
+begin
+ if CheckOp(drDontChangePageOptions) then
+ if (FPage is TfrxReportPage) and (TfrxReportPage(FPage).Subreport = nil) then
+ with TfrxPageEditorForm.Create(Self) do
+ begin
+ if ShowModal = mrOk then
+ begin
+ Modified := True;
+ UpdatePageDimensions;
+ end;
+ Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.OnComponentMenuClick(Sender: TObject);
+var
+ ed: TfrxComponentEditor;
+begin
+ ed := frxComponentEditors.GetComponentEditor(FSelectedObjects[0], Self, nil);
+ if ed <> nil then
+ begin
+ if ed.Execute(TMenuItem(Sender).Tag, not TMenuItem(Sender).IsChecked) then
+ Modified := True;
+ ed.Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.ReportDataCmdExecute(Sender: TObject);
+begin
+ if CheckOp(drDontEditReportData) then
+ with TfrxReportDataForm.Create(Self) do
+ begin
+ Report := Self.Report;
+ FormShow(Self);
+ if ShowModal = mrOk then
+ begin
+ Modified := True;
+ UpdateDataTree;
+ end;
+ Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.ReportStylesCmdExecute(Sender: TObject);
+begin
+ if CheckOp(drDontChangeReportOptions) then
+ with TfrxStyleEditorForm.Create(Self) do
+ begin
+ FormShow(Self);
+ if ShowModal = mrOk then
+ begin
+ Modified := True;
+ UpdateStyles;
+ Report.Styles.Apply;
+ end;
+ Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.ReportOptionsCmdExecute(Sender: TObject);
+{$IFNDEF DELPHI21}
+var
+ i: Integer;
+{$ENDIF}
+begin
+ if CheckOp(drDontChangeReportOptions) then
+ with TfrxReportEditorForm.Create(Self) do
+ begin
+ if ShowModal = mrOk then
+ begin
+ { reload printer fonts }
+ FontNameCB.BeginUpdate;
+ FontNameCB.Clear;
+ FillFontsList(FontNameCB.Items);
+{$IFNDEF DELPHI21}
+ for i := 0 to FontNameCB.ListBox.Count - 1 do
+ FontNameCB.ListBox.ListItems[i].Font.Family := FontNameCB.Items[i];
+{$ENDIF}
+ FontNameCB.EndUpdate;
+ Modified := True;
+ end;
+ Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.VariablesCmdExecute(Sender: TObject);
+begin
+ if CheckOp(drDontEditVariables) then
+ with TfrxVarEditorForm.Create(Self) do
+ begin
+ if ShowModal = mrOk then
+ begin
+ Modified := True;
+ UpdateDataTree;
+ end;
+ Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.PreviewCmdExecute(Sender: TObject);
+var
+ Preview: TfrxCustomPreview;
+ pt: TPoint;
+ SavePageNo: Integer;
+ SaveModalPreview: Boolean;
+ SaveDestroyForms: Boolean;
+ SaveMDIChild: Boolean;
+ SaveVariables: TfrxVariables;
+begin
+ FInspector.ItemIndex := FInspector.ItemIndex;
+ if not CheckOp(drDontPreviewReport) then Exit;
+
+ if FScriptStopped then
+ begin
+ RunScriptBClick(RunScriptB);
+ Exit;
+ end;
+
+ SavePagePosition;
+ Report.ScriptText := CodeWindow.Lines;
+ if not Report.PrepareScript then
+ begin
+ pt := fsPosToPoint(Report.Script.ErrorPos);
+ SwitchToCodeWindow;
+ FCodeWindow.SetPos(pt.X, pt.Y);
+ FCodeWindow.ShowMessage(Report.Script.ErrorMsg);
+ Exit;
+ end;
+
+ SavePageNo := GetPageIndex;
+ SaveModalPreview := Report.PreviewOptions.Modal;
+ SaveDestroyForms := Report.EngineOptions.DestroyForms;
+ SaveMDIChild := Report.PreviewOptions.MDIChild;
+ SaveVariables := TfrxVariables.Create;
+ SaveVariables.Assign(Report.Variables);
+
+ FUndoBuffer.AddUndo(Report);
+
+ Preview := Report.Preview;
+ try
+ Report.Preview := nil;
+ Report.PreviewOptions.Modal := True;
+ Report.EngineOptions.DestroyForms := False;
+ Report.PreviewOptions.MDIChild := False;
+ FWatchList.ScriptRunning := True;
+ Report.ShowReport;
+ except
+ end;
+
+ FWatchList.ScriptRunning := False;
+ Lock;
+ FUndoBuffer.GetUndo(Report);
+
+ Report.Script.ClearItems(Report);
+ Report.Preview := Preview;
+ Report.PreviewOptions.Modal := SaveModalPreview;
+ Report.EngineOptions.DestroyForms := SaveDestroyForms;
+ Report.PreviewOptions.MDIChild := SaveMDIChild;
+ Report.Variables.Assign(SaveVariables);
+ SaveVariables.Free;
+
+ if SavePageNo <> -1 then
+ ReloadPages(SavePageNo)
+ else
+ begin
+ ReloadPages(-2);
+ Page := nil;
+ end;
+
+ UpdateWatches;
+end;
+
+procedure TfrxDesignerForm.NewItemCmdExecute(Sender: TObject);
+begin
+// if CheckOp(drDontCreateReport) then
+// with TfrxNewItemForm.Create(Self) do
+// begin
+// ShowModal;
+// Free;
+// end;
+end;
+
+procedure TfrxDesignerForm.FindCmdExecute(Sender: TObject);
+begin
+ FindOrReplace(False);
+end;
+
+procedure TfrxDesignerForm.ReplaceCmdExecute(Sender: TObject);
+begin
+ FindOrReplace(True);
+end;
+
+procedure TfrxDesignerForm.FindNextCmdExecute(Sender: TObject);
+begin
+ FindText;
+end;
+
+procedure TfrxDesignerForm.FrameWidthCBKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: Char; Shift: TShiftState);
+begin
+ if not CharInSet(KeyChar, [#30 .. #39]) then
+ begin
+ Key := 0;
+ KeyChar := #0;
+ end;
+end;
+
+procedure TfrxDesignerForm.RotateBClick(Sender: TObject);
+var
+ pt: TPointF;
+begin
+ pt := Self.ClientToScreen(PointF(RotateB.AbsoluteRect.Left, RotateB.AbsoluteRect.Bottom));
+ RotationPopup.Popup(pt.X, pt.Y);
+end;
+
+procedure TfrxDesignerForm.ShowRulersCmdExecute(Sender: TObject);
+begin
+ ShowRulersMI.IsChecked := not ShowRulersMI.IsChecked;
+ ShowRulers := ShowRulersMI.IsChecked;
+end;
+
+procedure TfrxDesignerForm.ShowGuidesCmdExecute(Sender: TObject);
+begin
+ ShowGuidesMI.IsChecked := not ShowGuidesMI.IsChecked;
+ ShowGuides := ShowGuidesMI.IsChecked;
+end;
+
+procedure TfrxDesignerForm.DeleteGuidesCmdExecute(Sender: TObject);
+begin
+ if FPage is TfrxReportPage then
+ begin
+ TfrxReportPage(FPage).ClearGuides;
+ FWorkspace.Repaint;
+ Modified := True;
+ end;
+end;
+
+procedure TfrxDesignerForm.OptionsCmdExecute(Sender: TObject);
+var
+ u: TfrxDesignerUnits;
+begin
+ u := FUnits;
+
+ with TfrxOptionsEditor.Create(Self) do
+ begin
+ ShowModal;
+ Free;
+ end;
+
+ if u <> FUnits then
+ FOldUnits := FUnits;
+
+ if FWorkspace.GridType = gtDialog then
+ begin
+ FWorkspace.GridX := FGridSize4;
+ FWorkspace.GridY := FGridSize4;
+ end;
+
+ FWorkspace.UpdateView;
+ CodeWindow.Repaint;
+end;
+
+procedure TfrxDesignerForm.HelpContentsCmdExecute(Sender: TObject);
+var
+ tempC: TfrxDialogComponent;
+begin
+ if Page = nil then
+ frxResources.Help(FCodeWindow)
+ else if Page is TfrxDialogPage then
+ frxResources.Help(Page)
+ else if TObject(SelectedObjects[0]) is TfrxDialogComponent then
+ begin
+ tempC := TfrxDialogComponent.Create(nil);
+ frxResources.Help(tempC);
+ tempC.Free;
+ end
+ else
+ frxResources.Help(Self);
+end;
+
+procedure TfrxDesignerForm.AboutCmdExecute(Sender: TObject);
+begin
+ with TfrxAboutForm.Create(Self) do
+ begin
+ ShowModal;
+ Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.AddChildMIClick(Sender: TObject);
+var
+ b, bc: TfrxBand;
+begin
+ b := FSelectedObjects[0];
+ bc := b.Child;
+ InsertBandClick(ChildMI);
+ b.Child := FSelectedObjects[0];
+ b.Child.Child := TfrxChild(bc);
+ Modified := True;
+end;
+
+
+{ Debugging }
+{------------------------------------------------------------------------------}
+
+procedure TfrxDesignerForm.RunScriptBClick(Sender: TObject);
+begin
+ if FScriptRunning then
+ begin
+ FScriptStep := Sender = StepScriptB;
+ //if (Sender = RunScriptB) and (CodeWindow.BreakPoints.Count = 0) then
+ // Report.Script.OnRunLine := nil;
+ FScriptStopped := False;
+ Exit;
+ end;
+
+ //if (Sender = RunScriptB) and (CodeWindow.BreakPoints.Count = 0) then
+ // Report.Script.OnRunLine := nil
+ //else
+ Report.Script.OnRunLine := OnRunLine;
+
+ try
+ FScriptRunning := True;
+ FScriptFirstTime := True;
+ PreviewCmdExecute(Self);
+ finally
+ FScriptRunning := False;
+ Report.Script.OnRunLine := nil;
+ //CodeWindow.DeleteF4BreakPoints;
+ //CodeWindow.ActiveLine := -1;
+ end;
+end;
+
+procedure TfrxDesignerForm.StopScriptBClick(Sender: TObject);
+begin
+ Report.Script.OnRunLine := nil;
+ Report.Script.Terminate;
+ Report.Terminated := True;
+ FScriptStopped := False;
+end;
+
+procedure TfrxDesignerForm.EvaluateBClick(Sender: TObject);
+begin
+ with TfrxEvaluateForm.Create(Self) do
+ begin
+ Script := Report.Script;
+ if CodeWindow.SelText <> '' then
+ ExpressionE.Text := CodeWindow.SelText;
+ ShowModal;
+ Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.BreakPointBClick(Sender: TObject);
+begin
+ //CodeWindow.ToggleBreakPoint(CodeWindow.GetPos.Y, '');
+end;
+
+procedure TfrxDesignerForm.RunToCursorBClick(Sender: TObject);
+begin
+ //CodeWindow.AddBreakPoint(CodeWindow.GetPos.Y, 'F4');
+ RunScriptBClick(nil);
+end;
+
+procedure TfrxDesignerForm.OnRunLine(Sender: TfsScript; const UnitName,
+ SourcePos: String);
+//var
+// p: TPoint;
+// SaveActiveForm: TForm;
+// Condition: String;
+//
+// procedure CreateLineMarks;
+// var
+//
+// i: Integer;
+// begin
+// for i := 0 to Report.Script.Lines.Count - 1 do
+// CodeWindow.RunLine[i + 1] := Report.Script.IsExecutableLine(i + 1);
+// end;
+
+begin
+// p := fsPosToPoint(SourcePos);
+// if not FScriptStep and (CodeWindow.BreakPoints.Count > 0) then
+// if not CodeWindow.IsBreakPoint(p.Y) then
+// Exit;
+//
+// Condition := CodeWindow.GetBreakPointCondition(p.Y);
+// { F4 - run to line, remove the breakpoint }
+// if Condition = 'F4' then
+// CodeWindow.DeleteBreakPoint(p.Y);
+//
+// if FScriptFirstTime then
+// CreateLineMarks;
+// FScriptFirstTime := False;
+//
+// SaveActiveForm := Screen.ActiveForm;
+//
+// if ParentForm <> nil then
+// begin
+// EnableWindow(ParentForm.Handle, True);
+////{$IFDEF Delphi9}
+// ParentForm.Enabled := True;
+////{$ENDIF}
+// ParentForm.SetFocus;
+// end
+// else
+// begin
+// EnableWindow(Handle, True);
+////{$IFDEF Delphi9}
+// Enabled := True;
+////{$ENDIF}
+// SetFocus;
+// end;
+//
+// {switch to code Tab}
+// if FTabs.TabIndex <> 0 then
+// SetPage(nil);
+//
+// CodeWindow.ActiveLine := p.Y;
+// CodeWindow.SetPos(p.X, p.Y);
+// UpdateWatches;
+//
+// FScriptStopped := True;
+// while FScriptStopped do
+// Application.ProcessMessages;
+//
+// if SaveActiveForm <> nil then
+// SaveActiveForm.SetFocus;
+end;
+
+
+{ Alignment palette }
+{------------------------------------------------------------------------------}
+
+procedure TfrxDesignerForm.AlignLeftsBClick(Sender: TObject);
+var
+ i: Integer;
+ c0, c: TfrxComponent;
+begin
+ if FSelectedObjects.Count < 2 then Exit;
+
+ c0 := FSelectedObjects[0];
+ for i := 1 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if not (rfDontMove in c.Restrictions) then
+ c.Left := c0.Left;
+ end;
+
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.AlignRightsBClick(Sender: TObject);
+var
+ i: Integer;
+ c0, c: TfrxComponent;
+begin
+ if FSelectedObjects.Count < 2 then Exit;
+
+ c0 := FSelectedObjects[0];
+ for i := 1 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if not (rfDontMove in c.Restrictions) then
+ c.Left := c0.Left + c0.Width - c.Width;
+ end;
+
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.AlignTopsBClick(Sender: TObject);
+var
+ i: Integer;
+ c0, c: TfrxComponent;
+begin
+ if FSelectedObjects.Count < 2 then Exit;
+
+ c0 := FSelectedObjects[0];
+ for i := 1 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if not (rfDontMove in c.Restrictions) then
+ if Abs(c.Top - c.AbsTop) < 1e-4 then
+ c.Top := c0.AbsTop
+ else
+ c.Top := c0.AbsTop - c.AbsTop + c.Top;
+ end;
+
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.AlignBottomsBClick(Sender: TObject);
+var
+ i: Integer;
+ c0, c: TfrxComponent;
+begin
+ if FSelectedObjects.Count < 2 then Exit;
+
+ c0 := FSelectedObjects[0];
+ for i := 1 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if not (rfDontMove in c.Restrictions) then
+ if Abs(c.Top - c.AbsTop) < 1e-4 then
+ c.Top := c0.AbsTop + c0.Height - c.Height
+ else
+ c.Top := c0.AbsTop - c.AbsTop + c.Top + c0.Height - c.Height;
+ end;
+
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.AlignHorzCentersBClick(Sender: TObject);
+var
+ i: Integer;
+ c0, c: TfrxComponent;
+begin
+ if FSelectedObjects.Count < 2 then Exit;
+
+ c0 := FSelectedObjects[0];
+ for i := 1 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if not (rfDontMove in c.Restrictions) then
+ c.Left := c0.Left + c0.Width / 2 - c.Width / 2;
+ end;
+
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.AlignVertCentersBClick(Sender: TObject);
+var
+ i: Integer;
+ c0, c: TfrxComponent;
+begin
+ if FSelectedObjects.Count < 2 then Exit;
+
+ c0 := FSelectedObjects[0];
+ for i := 1 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if not (rfDontMove in c.Restrictions) then
+ c.Top := c0.Top + c0.Height / 2 - c.Height / 2;
+ end;
+
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.CenterHorzBClick(Sender: TObject);
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ if FSelectedObjects.Count < 1 then Exit;
+
+ for i := 0 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if not (rfDontMove in c.Restrictions) and (c is TfrxView) then
+ if c.Parent is TfrxBand then
+ c.Left := (c.Parent.Width - c.Width) / 2 else
+ c.Left := (FWorkspace.Width / Scale - c.Width) / 2;
+ end;
+
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.CenterVertBClick(Sender: TObject);
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ if FSelectedObjects.Count < 1 then Exit;
+
+ for i := 0 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if not (rfDontMove in c.Restrictions) and (c is TfrxView) then
+ if c.Parent is TfrxBand then
+ c.Top := (c.Parent.Height - c.Height) / 2 else
+ c.Top := (FWorkspace.Height / Scale - c.Height) / 2;
+ end;
+
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.SpaceHorzBClick(Sender: TObject);
+var
+ i: Integer;
+ c: TfrxComponent;
+ sl: TStringList;
+ dx: Extended;
+begin
+ if FSelectedObjects.Count < 3 then Exit;
+
+ sl := TfrxStringList.Create;
+ sl.Sorted := True;
+ sl.Duplicates := dupAccept;
+
+ for i := 0 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ sl.AddObject(Format('%4.4d', [Round(c.Left)]), c);
+ end;
+
+ dx := (TfrxComponent(sl.Objects[sl.Count - 1]).Left -
+ TfrxComponent(sl.Objects[0]).Left) / (sl.Count - 1);
+
+ for i := 1 to sl.Count - 2 do
+ begin
+ c := TfrxComponent(sl.Objects[i]);
+ if not (rfDontMove in c.Restrictions) then
+ c.Left := TfrxComponent(sl.Objects[i - 1]).Left + dx;
+ end;
+
+ sl.Free;
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.SpaceVertBClick(Sender: TObject);
+var
+ i: Integer;
+ c: TfrxComponent;
+ sl: TStringList;
+ dy: Extended;
+begin
+ if FSelectedObjects.Count < 3 then Exit;
+
+ sl := TfrxStringList.Create;
+ sl.Sorted := True;
+ sl.Duplicates := dupAccept;
+
+ for i := 0 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ sl.AddObject(Format('%4.4d', [Round(c.Top)]), c);
+ end;
+
+ dy := (TfrxComponent(sl.Objects[sl.Count - 1]).Top -
+ TfrxComponent(sl.Objects[0]).Top) / (sl.Count - 1);
+
+ for i := 1 to sl.Count - 2 do
+ begin
+ c := TfrxComponent(sl.Objects[i]);
+ if not (rfDontMove in c.Restrictions) then
+ c.Top := TfrxComponent(sl.Objects[i - 1]).Top + dy;
+ end;
+
+ sl.Free;
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.SameWidthBClick(Sender: TObject);
+var
+ i: Integer;
+ c0, c: TfrxComponent;
+begin
+ if FSelectedObjects.Count < 2 then Exit;
+
+ c0 := FSelectedObjects[0];
+ for i := 1 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if not (rfDontSize in c.Restrictions) then
+ c.Width := c0.Width;
+ end;
+
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.SameHeightBClick(Sender: TObject);
+var
+ i: Integer;
+ c0, c: TfrxComponent;
+begin
+ if FSelectedObjects.Count < 2 then Exit;
+
+ c0 := FSelectedObjects[0];
+ for i := 1 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if not (rfDontSize in c.Restrictions) then
+ c.Height := c0.Height;
+ end;
+
+ Modified := True;
+end;
+
+
+{ Save/restore state }
+{------------------------------------------------------------------------------}
+
+procedure TfrxDesignerForm.SaveState;
+var
+ Ini: TCustomIniFile;
+ Nm: String;
+begin
+ if IsPreviewDesigner then Exit;
+
+ Ini := Report.GetIniFile;
+
+ try
+ if Ini is TIniFile then
+ begin
+ Nm := ExtractFilePath(Ini.FileName);
+ if not DirectoryExists(Nm) then
+ if not CreateDir(Nm) then
+ begin
+ Ini.Free;
+ Exit;
+ end;
+ end;
+
+ Nm := 'TfrxDesignerForm';
+ Ini.WriteInteger('TfrxObjectInspector', 'SplitPos', Round(FInspector.SplitterPos));
+ Ini.WriteInteger('TfrxObjectInspector', 'Split1Pos', Round(FInspector.Splitter1Pos));
+ Ini.WriteInteger(Nm, 'LeftDockSize', Round(LeftDockTB.Width));
+ Ini.WriteInteger(Nm, 'RightDockSize', Round(RightDockTB.Width));
+ Ini.WriteInteger(Nm, 'LeftDockSplit', Round(FReportTree.MainPanel.Height));
+ Ini.WriteFloat(Nm, 'Scale', FScale);
+ Ini.WriteBool(Nm, 'ShowGrid', FShowGrid);
+ Ini.WriteBool(Nm, 'GridAlign', FGridAlign);
+ Ini.WriteBool(Nm, 'ShowRulers', FShowRulers);
+ Ini.WriteBool(Nm, 'ShowGuides', FShowGuides);
+ Ini.WriteFloat(Nm, 'Grid1', FGridSize1);
+ Ini.WriteFloat(Nm, 'Grid2', FGridSize2);
+ Ini.WriteFloat(Nm, 'Grid3', FGridSize3);
+ Ini.WriteFloat(Nm, 'Grid4', FGridSize4);
+ FUnits := FOldUnits;
+ Ini.WriteInteger(Nm, 'Units', Integer(FUnits));
+// Ini.WriteString(Nm, 'ScriptFontName', CodeWindow.Font.Name);
+// Ini.WriteInteger(Nm, 'ScriptFontSize', CodeWindow.Font.Size);
+ Ini.WriteString(Nm, 'MemoFontName', MemoFontName);
+ Ini.WriteInteger(Nm, 'MemoFontSize', MemoFontSize);
+ Ini.WriteBool(Nm, 'UseObjectFont', UseObjectFont);
+ Ini.WriteBool(Nm, 'EditAfterInsert', FEditAfterInsert);
+ Ini.WriteBool(Nm, 'LocalizedOI', FLocalizedOI);
+ {$IFDEF LINUX}
+
+ {$ELSE}
+ Ini.WriteString(Nm, 'RecentFiles', '"'+FRecentFiles.CommaText+'"');
+ {$ENDIF}
+ Ini.WriteBool(Nm, 'FreeBands', FWorkspace.FreeBandsPlacement);
+ Ini.WriteInteger(Nm, 'BandsGap', FWorkspace.GapBetweenBands);
+ Ini.WriteBool(Nm, 'ShowBandCaptions', FWorkspace.ShowBandCaptions);
+ Ini.WriteBool(Nm, 'DropFields', FDropFields);
+ Ini.WriteString(Nm, 'WatchList', FWatchList.Watches.Text);
+
+ frxSaveFormPosition(Ini, Self);
+ finally
+ Ini.Free;
+ end;
+
+end;
+
+procedure TfrxDesignerForm.RestoreState(RestoreDefault: Boolean = False;
+ RestoreMainForm: Boolean = False);
+var
+ Ini: TCustomIniFile;
+ Nm: String;
+
+ function Def(Value, DefValue: Extended): Extended;
+ begin
+ if Value = 0 then
+ Result := DefValue else
+ Result := Value;
+ end;
+
+ procedure DoRestore;
+ begin
+ if not RestoreMainForm then
+ begin
+ FInspector.SplitterPos := Ini.ReadInteger('TfrxObjectInspector',
+ 'SplitPos', FInspector.Width div 2);
+ if FInspector.SplitterPos > FInspector.Width - 10 then
+ FInspector.SplitterPos := FInspector.Width div 2;
+ FInspector.Splitter1Pos := Ini.ReadInteger('TfrxObjectInspector',
+ 'Split1Pos', 65);
+ if (FInspector.Splitter1Pos < 10) or (FInspector.Splitter1Pos > FInspector.Height - 20) then
+ FInspector.Splitter1Pos := 65;
+ LeftDockTB.Width := Ini.ReadInteger(Nm, 'LeftDockSize', 200);
+ RightDockTB.Width := Ini.ReadInteger(Nm, 'RightDockSize', 150);
+ FReportTree.MainPanel.Height := Ini.ReadInteger(Nm, 'LeftDockSplit', 150);
+ Scale := Ini.ReadFloat(Nm, 'Scale', 1);
+ ShowGrid := Ini.ReadBool(Nm, 'ShowGrid', True);
+ GridAlign := Ini.ReadBool(Nm, 'GridAlign', True);
+ ShowRulers := Ini.ReadBool(Nm, 'ShowRulers', True);
+ ShowGuides := Ini.ReadBool(Nm, 'ShowGuides', True);
+ FGridSize1 := Def(Ini.ReadFloat(Nm, 'Grid1', 0), 0.1);
+ FGridSize2 := Def(Ini.ReadFloat(Nm, 'Grid2', 0), 0.1);
+ FGridSize3 := Def(Ini.ReadFloat(Nm, 'Grid3', 0), 4);
+ FGridSize4 := Def(Ini.ReadFloat(Nm, 'Grid4', 0), 4);
+ Units := TfrxDesignerUnits(Ini.ReadInteger(Nm, 'Units', 0));
+ FOldUnits := FUnits;
+
+// CodeWindow.Font.Name := Ini.ReadString(Nm, 'ScriptFontName', 'Courier New');
+// CodeWindow.Font.Size := Ini.ReadInteger(Nm, 'ScriptFontSize', 10);
+
+ {$IFDEF LINUX}
+ MemoFontName := Ini.ReadString(Nm, 'MemoFontName', 'Liberation Sans');
+ {$ELSE}
+ MemoFontName := Ini.ReadString(Nm, 'MemoFontName', 'Arial');
+ {$ENDIF}
+ MemoFontSize := Ini.ReadInteger(Nm, 'MemoFontSize', 10);
+ UseObjectFont := Ini.ReadBool(Nm, 'UseObjectFont', True);
+ FEditAfterInsert := Ini.ReadBool(Nm, 'EditAfterInsert', False);
+ FRecentFiles.CommaText := Ini.ReadString(Nm, 'RecentFiles', '');
+ FWorkspace.FreeBandsPlacement := Ini.ReadBool(Nm, 'FreeBands', False);
+ FWorkspace.GapBetweenBands := Ini.ReadInteger(Nm, 'BandsGap', 4);
+ FWorkspace.ShowBandCaptions := Ini.ReadBool(Nm, 'ShowBandCaptions', True);
+ FDropFields := Ini.ReadBool(Nm, 'DropFields', True);
+ FWatchList.Watches.Text := Ini.ReadString(Nm, 'WatchList', '');
+ FWatchList.UpdateWatches;
+
+ end
+ else
+ frxRestoreFormPosition(Ini, Self);
+ end;
+
+ procedure ReadDefIni;
+ begin
+ Scale := 1;
+ ShowGrid := True;
+ GridAlign := True;
+ ShowRulers := True;
+ ShowGuides := True;
+ FGridSize1 := 0.1;
+ FGridSize2 := 0.1;
+ FGridSize3 := 4;
+ FGridSize4 := 4;
+ Units := TfrxDesignerUnits(0);
+ FWorkspace.ShowBandCaptions := true;
+ FOldUnits := FUnits;
+ end;
+
+begin
+ Ini := Report.GetIniFile;
+ Nm := 'TfrxDesignerForm';
+ try
+ if RestoreDefault or (Ini.ReadFloat(Nm, 'Scale', 0) = 0) then
+ ReadDefIni
+ else
+ begin
+ try
+ DoRestore;
+ except
+ ReadDefIni;
+ end
+ end;
+ finally
+ Ini.Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.Localize;
+begin
+ OpenScriptB.Hint := frxGet(2300);
+ SaveScriptB.Hint := frxGet(2301);
+ RunScriptB.Hint := frxGet(2302);
+ StepScriptB.Hint := frxGet(2303);
+ StopScriptB.Hint := frxGet(2304);
+ EvaluateB.Hint := frxGet(2305);
+ //LangCB.Text := frxGet(2306);
+ AlignLeftsB.Hint := frxGet(2308);
+ AlignHorzCentersB.Hint := frxGet(2309);
+ AlignRightsB.Hint := frxGet(2310);
+ AlignTopsB.Hint := frxGet(2311);
+ AlignVertCentersB.Hint := frxGet(2312);
+ AlignBottomsB.Hint := frxGet(2313);
+ SpaceHorzB.Hint := frxGet(2314);
+ SpaceVertB.Hint := frxGet(2315);
+ CenterHorzB.Hint := frxGet(2316);
+ CenterVertB.Hint := frxGet(2317);
+ SameWidthB.Hint := frxGet(2318);
+ SameHeightB.Hint := frxGet(2319);
+ StyleCB.TagString := frxGet(2321);
+ FontNameCB.TagString := frxGet(2322);
+ FontSizeCB.TagString := frxGet(2323);
+ BoldB.Hint := frxGet(2324);
+ ItalicB.Hint := frxGet(2325);
+ UnderlineB.Hint := frxGet(2326);
+ FontColorB.Hint := frxGet(2327);
+ HighlightB.Hint := frxGet(2328);
+ RotateB.Hint := frxGet(2329);
+ TextAlignLeftB.Hint := frxGet(2330);
+ TextAlignCenterB.Hint := frxGet(2331);
+ TextAlignRightB.Hint := frxGet(2332);
+ TextAlignBlockB.Hint := frxGet(2333);
+ TextAlignTopB.Hint := frxGet(2334);
+ TextAlignMiddleB.Hint := frxGet(2335);
+ TextAlignBottomB.Hint := frxGet(2336);
+ FrameTopB.Hint := frxGet(2338);
+ FrameBottomB.Hint := frxGet(2339);
+ FrameLeftB.Hint := frxGet(2340);
+ FrameRightB.Hint := frxGet(2341);
+ FrameAllB.Hint := frxGet(2342);
+ FrameNoB.Hint := frxGet(2343);
+ ShadowB.Hint := frxGet(2344);
+ FillColorB.Hint := frxGet(2345);
+ FrameColorB.Hint := frxGet(2346);
+ FrameStyleB.Hint := frxGet(2347);
+ FrameWidthCB.TagString := frxGet(2348);
+ NewB.Hint := frxGet(2350);
+ OpenB.Hint := frxGet(2351);
+ SaveB.Hint := frxGet(2352);
+ PreviewB.Hint := frxGet(2353);
+ NewPageB.Hint := frxGet(2354);
+ NewDialogB.Hint := frxGet(2355);
+ DeletePageB.Hint := frxGet(2356);
+ PageSettingsB.Hint := frxGet(2357);
+ CutB.Hint := frxGet(2359);
+ CopyB.Hint := frxGet(2360);
+ PasteB.Hint := frxGet(2361);
+ UndoB.Hint := frxGet(2363);
+ RedoB.Hint := frxGet(2364);
+ GroupB.Hint := frxGet(2365);
+ UngroupB.Hint := frxGet(2366);
+ ShowGridB.Hint := frxGet(2367);
+ AlignToGridB.Hint := frxGet(2368);
+ SetToGridB.Hint := frxGet(2369);
+ ScaleCB.TagString := frxGet(2370);
+
+ ObjectSelectB.Hint := frxGet(2372);
+ ObjectBandB.Hint := frxGet(2377);
+ FileMenu.Text := frxGet(2378);
+ EditMenu.Text := frxGet(2379);
+ FindMI.Text := frxGet(2380);
+ FindNextMI.Text := frxGet(2381);
+ ReplaceMI.Text := frxGet(2382);
+ ReportMenu.Text := frxGet(2383);
+ ReportDataMI.Text := frxGet(2384);
+ ReportSettingsMI.Text := frxGet(2385);
+ ReportStylesMI.Text := frxGet(2386);
+ ViewMenu.Text := frxGet(2387);
+ ShowRulersMI.Text := frxGet(2397);
+ ShowGuidesMI.Text := frxGet(2398);
+ DeleteGuidesMI.Text := frxGet(2399);
+ OptionsMI.Text := frxGet(2400);
+ HelpMenu.Text := frxGet(2401);
+
+ AboutMI.Text := frxGet(2403);
+//
+ UndoMI.Text := frxGet(2405);
+ RedoMI.Text := frxGet(2406);
+ CutMI.Text := frxGet(2407);
+ CopyMI.Text := frxGet(2408);
+ PasteMI.Text := frxGet(2409);
+ GroupMI.Text := frxGet(2410);
+ UngroupMI.Text := frxGet(2411);
+ DeleteMI.Text := frxGet(2412);
+ DeletePageMI.Text := frxGet(2413);
+ DeletePageMI1.Text := frxGet(2413);
+ SelectAllMI.Text := frxGet(2414);
+ EditMI.Text := frxGet(2415);
+ BringtoFrontMI.Text := frxGet(2416);
+ SendtoBackMI.Text := frxGet(2417);
+ NewMI.Text := frxGet(2418);
+ NewReportMI.Text := frxGet(2419);
+ NewPageMI1.Text := frxGet(2420);
+ NewPageMI.Text := frxGet(2420);
+ NewDialogMI1.Text := frxGet(2421);
+ NewDialogMI.Text := frxGet(2421);
+ OpenMI.Text := frxGet(2422);
+ SaveMI.Text := frxGet(2423);
+ SaveAsMI.Text := frxGet(2424);
+ VariablesMI.Text := frxGet(2425);
+ PageSettingsMI1.Text := frxGet(2426);
+ PageSettingsMI.Text := frxGet(2426);
+ PreviewMI.Text := frxGet(2427);
+ ExitMI.Text := frxGet(2428);
+ ReportTitleMI.Text := frxGet(2429);
+ ReportSummaryMI.Text := frxGet(2430);
+ PageHeaderMI.Text := frxGet(2431);
+ PageFooterMI.Text := frxGet(2432);
+ HeaderMI.Text := frxGet(2433);
+ FooterMI.Text := frxGet(2434);
+ MasterDataMI.Text := frxGet(2435);
+ DetailDataMI.Text := frxGet(2436);
+ SubdetailDataMI.Text := frxGet(2437);
+ Data4levelMI.Text := frxGet(2438);
+ Data5levelMI.Text := frxGet(2439);
+ Data6levelMI.Text := frxGet(2440);
+ GroupHeaderMI.Text := frxGet(2441);
+ GroupFooterMI.Text := frxGet(2442);
+ ChildMI.Text := frxGet(2443);
+ ColumnHeaderMI.Text := frxGet(2444);
+ ColumnFooterMI.Text := frxGet(2445);
+ OverlayMI.Text := frxGet(2446);
+ VerticalbandsMI.Text := frxGet(2447);
+ HeaderMI1.Text := frxGet(2448);
+ FooterMI1.Text := frxGet(2449);
+ MasterDataMI1.Text := frxGet(2450);
+ DetailDataMI1.Text := frxGet(2451);
+ SubdetailDataMI1.Text := frxGet(2452);
+ GroupHeaderMI1.Text := frxGet(2453);
+ GroupFooterMI1.Text := frxGet(2454);
+ ChildMI1.Text := frxGet(2455);
+ R0MI.Text := frxGet(2456);
+ R45MI.Text := frxGet(2457);
+ R90MI.Text := frxGet(2458);
+ R180MI.Text := frxGet(2459);
+ R270MI.Text := frxGet(2460);
+ FontB.Hint := frxGet(2461);
+ BoldMI.Text := frxGet(2462);
+ ItalicMI.Text := frxGet(2463);
+ UnderlineMI.Text := frxGet(2464);
+ SuperScriptMI.Text := frxGet(2465);
+ SubScriptMI.Text := frxGet(2466);
+ CondensedMI.Text := frxGet(2467);
+ WideMI.Text := frxGet(2468);
+ N12cpiMI.Text := frxGet(2469);
+ N15cpiMI.Text := frxGet(2470);
+ OpenDialog.Filter := frxGet(2471);
+ OpenDialog.Options := OpenDialog.Options + [TOpenOption.ofNoChangeDir];
+ SaveDialog.Options := SaveDialog.Options + [TOpenOption.ofNoChangeDir];
+ OpenScriptDialog.Options := OpenScriptDialog.Options + [TOpenOption.ofNoChangeDir];
+ SaveScriptDialog.Options := SaveScriptDialog.Options + [TOpenOption.ofNoChangeDir];
+ OpenScriptDialog.Filter := frxGet(2472);
+ SaveScriptDialog.Filter := frxGet(2473);
+ BreakPointB.Hint := frxGet(2476);
+ RunToCursorB.Hint := frxGet(2477);
+
+
+ frxResources.LoadImageFromResouce(NewB.Bitmap, 0, 0);
+ frxResources.LoadImageFromResouce(NewReportMI.Bitmap, 0, 0);
+ frxResources.LoadImageFromResouce(OpenB.Bitmap, 0, 1);
+ frxResources.LoadImageFromResouce(OpenMI.Bitmap, 0, 1);
+ frxResources.LoadImageFromResouce(SaveB.Bitmap, 0, 2);
+ frxResources.LoadImageFromResouce(SaveMI.Bitmap, 0, 2);
+ frxResources.LoadImageFromResouce(SaveAsMI.Bitmap, 0, 2);
+ frxResources.LoadImageFromResouce(PreviewB.Bitmap, 0, 3);
+ frxResources.LoadImageFromResouce(PreviewMI.Bitmap, 0, 3);
+ frxResources.LoadImageFromResouce(NewDialogB.Bitmap, 0, 4);
+ frxResources.LoadImageFromResouce(NewDialogMI1.Bitmap, 0, 4);
+ frxResources.LoadImageFromResouce(NewDialogMI.Bitmap, 0, 4);
+ frxResources.LoadImageFromResouce(NewPageB.Bitmap, 1, 0);
+ frxResources.LoadImageFromResouce(NewPageMI1.Bitmap, 1, 0);
+ frxResources.LoadImageFromResouce(NewPageMI.Bitmap, 1, 0);
+
+ frxResources.LoadImageFromResouce(DeletePageB.Bitmap, 1, 2);
+ frxResources.LoadImageFromResouce(DeletePageMI1.Bitmap, 1, 2);
+ frxResources.LoadImageFromResouce(DeletePageMI.Bitmap, 1, 2);
+
+ frxResources.LoadImageFromResouce(PageSettingsB.Bitmap, 1, 3);
+ frxResources.LoadImageFromResouce(PageSettingsMI.Bitmap, 1, 3);
+ frxResources.LoadImageFromResouce(PageSettingsMI1.Bitmap, 1, 3);
+ frxResources.LoadImageFromResouce(CutB.Bitmap, 0, 5);
+ frxResources.LoadImageFromResouce(CutMI.Bitmap, 0, 5);
+ frxResources.LoadImageFromResouce(CopyB.Bitmap, 0, 6);
+ frxResources.LoadImageFromResouce(CopyMI.Bitmap, 0, 6);
+ frxResources.LoadImageFromResouce(PasteB.Bitmap, 0, 7);
+ frxResources.LoadImageFromResouce(PasteMI.Bitmap, 0, 7);
+
+ frxResources.LoadImageFromResouce(UndoB.Bitmap, 0, 8);
+ frxResources.LoadImageFromResouce(UndoMI.Bitmap, 0, 8);
+ frxResources.LoadImageFromResouce(RedoB.Bitmap, 0, 9);
+ frxResources.LoadImageFromResouce(RedoMI.Bitmap, 0, 9);
+ frxResources.LoadImageFromResouce(GroupB.Bitmap, 1, 7);
+ frxResources.LoadImageFromResouce(GroupMI.Bitmap, 1, 7);
+ frxResources.LoadImageFromResouce(UngroupB.Bitmap, 1, 6);
+ frxResources.LoadImageFromResouce(UngroupMI.Bitmap, 1, 6);
+ frxResources.LoadImageFromResouce(ShowGridB.Bitmap, 12, 7);
+ frxResources.LoadImageFromResouce(AlignToGridB.Bitmap, 9, 8);
+ frxResources.LoadImageFromResouce(SetToGridB.Bitmap, 5, 7);
+ frxResources.LoadImageFromResouce(AlignLeftsB.Bitmap, 4, 1);
+ frxResources.LoadImageFromResouce(AlignHorzCentersB.Bitmap, 4, 7);
+ frxResources.LoadImageFromResouce(AlignRightsB.Bitmap, 4, 5);
+ frxResources.LoadImageFromResouce(AlignTopsB.Bitmap, 4, 6);
+ frxResources.LoadImageFromResouce(AlignVertCentersB.Bitmap, 4, 2);
+ frxResources.LoadImageFromResouce(AlignBottomsB.Bitmap, 5, 0);
+
+ frxResources.LoadImageFromResouce(SpaceHorzB.Bitmap, 4, 4);
+ frxResources.LoadImageFromResouce(SpaceVertB.Bitmap, 4, 9);
+ frxResources.LoadImageFromResouce(CenterHorzB.Bitmap, 4, 3);
+ frxResources.LoadImageFromResouce(CenterVertB.Bitmap, 4, 9);
+ frxResources.LoadImageFromResouce(SameWidthB.Bitmap, 8, 3);
+ frxResources.LoadImageFromResouce(SameHeightB.Bitmap, 8, 4);
+
+
+ frxResources.LoadImageFromResouce(BoldB.Bitmap, 2, 0);
+ frxResources.LoadImageFromResouce(ItalicB.Bitmap, 2, 1);
+ frxResources.LoadImageFromResouce(UnderlineB.Bitmap, 2, 2);
+ frxResources.LoadImageFromResouce(FontB.Bitmap, 5, 9);
+ frxResources.LoadImageFromResouce(FontColorB.Bitmap, 2, 3);
+ frxResources.LoadImageFromResouce(HighlightB.Bitmap, 2, 4);
+ frxResources.LoadImageFromResouce(RotateB.Bitmap, 6, 4);
+
+ frxResources.LoadImageFromResouce(TextAlignLeftB.Bitmap, 2, 5);
+ frxResources.LoadImageFromResouce(TextAlignCenterB.Bitmap, 2, 6);
+ frxResources.LoadImageFromResouce(TextAlignRightB.Bitmap, 2, 7);
+ frxResources.LoadImageFromResouce(TextAlignBlockB.Bitmap, 2, 8);
+
+ frxResources.LoadImageFromResouce(TextAlignTopB.Bitmap, 2, 9);
+ frxResources.LoadImageFromResouce(TextAlignMiddleB.Bitmap, 3, 0);
+ frxResources.LoadImageFromResouce(TextAlignBottomB.Bitmap, 3, 1);
+
+ frxResources.LoadImageFromResouce(FrameTopB.Bitmap, 3, 2);
+ frxResources.LoadImageFromResouce(FrameBottomB.Bitmap, 3, 3);
+ frxResources.LoadImageFromResouce(FrameRightB.Bitmap, 3, 5);
+ frxResources.LoadImageFromResouce(FrameLeftB.Bitmap, 3, 4);
+ frxResources.LoadImageFromResouce(FrameNoB.Bitmap, 3, 7);
+ frxResources.LoadImageFromResouce(FrameAllB.Bitmap, 3, 6);
+ frxResources.LoadImageFromResouce(ShadowB.Bitmap, 4, 0);
+ frxResources.LoadImageFromResouce(FillColorB.Bitmap, 3, 8);
+ frxResources.LoadImageFromResouce(FrameColorB.Bitmap, 3, 9);
+ frxResources.LoadImageFromResouce(FrameStyleB.Bitmap, 7, 1);
+
+ frxResources.LoadImageFromResouce(DeleteMI.Bitmap, 5, 1);
+ frxResources.LoadImageFromResouce(FindMI.Bitmap, 18, 1);
+
+ frxResources.LoadImageFromResouce(BringtoFrontMI.Bitmap, 1, 4);
+ frxResources.LoadImageFromResouce(SendtoBackMI.Bitmap, 1, 5);
+
+ frxResources.LoadImageFromResouce(ReportDataMI.Bitmap, 5, 3);
+ frxResources.LoadImageFromResouce(ReportSettingsMI.Bitmap, 4, 0);
+ frxResources.LoadImageFromResouce(ReportStylesMI.Bitmap, 8, 7);
+ frxResources.LoadImageFromResouce(VariablesMI.Bitmap, 11, 3);
+end;
+
+procedure TfrxDesignerForm.CreateLangMenu;
+//var
+// m, t: TMenuItem;
+// i: Integer;
+// reg: TRegistry;
+// current: String;
+begin
+// current := '';
+// reg := TRegistry.Create;
+// try
+// reg.RootKey := HKEY_CURRENT_USER;
+// if reg.OpenKey('\Software\Fast Reports\Resources', false) then
+// current := reg.ReadString('Language');
+// finally
+// reg.Free;
+// end;
+// if frxResources.Languages.Count > 0 then
+// begin
+// m := TMenuItem.Create(ViewMenu);
+// m.Caption := '-';
+// ViewMenu.Add(m);
+// m := TMenuItem.Create(ViewMenu);
+// m.Caption := frxGet(2475);
+// ViewMenu.Add(m);
+// for i := 0 to frxResources.Languages.Count - 1 do
+// begin
+// t := TMenuItem.Create(m);
+// t.Caption := frxResources.Languages[i];
+// t.RadioItem := True;
+// t.OnClick := LangSelectClick;
+// if UpperCase(t.Caption) = UpperCase(current) then
+// t.Checked := True;
+// m.Add(t);
+// end;
+// end;
+end;
+
+procedure TfrxDesignerForm.LangSelectClick(Sender: TObject);
+//var
+// m: TMenuItem;
+// reg: TRegistry;
+begin
+// m := Sender as TMenuItem;
+// m.Checked := True;
+// frxResources.LoadFromFile(GetAppPath + m.Caption + '.frc');
+// Localize;
+// reg := TRegistry.Create;
+// try
+// reg.RootKey := HKEY_CURRENT_USER;
+// if reg.OpenKey('\Software\Fast Reports\Resources', false) then
+// reg.WriteString('Language', m.Caption);
+// finally
+// reg.Free;
+// end;
+end;
+
+procedure TfrxDesignerForm.LeftDockTBResize(Sender: TObject);
+begin
+ if FInspector <> nil then
+ FInspector.DoResize;
+end;
+
+{procedure TfrxDesignerForm.OnCodeCompletion(const Name: String; List: TStrings);
+var
+ obj: TPersistent;
+ xd: TfsXMLDocument;
+ i, j: Integer;
+ sl, members: TStringList;
+ s: String;
+ clName: String;
+ clVar: TfsClassVariable;
+ clMethod: TfsCustomHelper;
+ cl: TClass;
+ l: TList;
+begin
+ members := TStringList.Create;
+ frxSetCommaText(Name, members, '.');
+ if members.Count = 0 then
+ begin
+ List.Clear;
+ l := Report.AllObjects;
+ for i := 0 to l.Count - 1 do
+ List.AddObject(TfrxComponent(l[i]).Name + ' : ' + TfrxComponent(l[i]).ClassName, nil);
+
+ members.Free;
+ Exit;
+ end;
+
+ for i := 0 to members.Count - 1 do
+ members[i] := Trim(members[i]);
+
+ if CompareText('Report', members[0]) = 0 then
+ obj := Report
+ else if CompareText('Engine', members[0]) = 0 then
+ obj := Report.Engine
+ else if CompareText('Outline', members[0]) = 0 then
+ obj := Report.PreviewPages.Outline
+ else
+ obj := Report.FindObject(members[0]);
+
+ clName := '';
+ if obj <> nil then
+ clName := obj.ClassName;
+
+ i := 1;
+ while (clName <> '') and (i < members.Count) do
+ begin
+ clVar := Report.Script.FindClass(clName);
+ clName := '';
+ if clVar <> nil then
+ begin
+ clMethod := clVar.Find(members[i]);
+ if clMethod <> nil then
+ clName := clMethod.TypeName;
+ Inc(i);
+ end;
+ end;
+
+ if clName <> '' then
+ begin
+ clVar := Report.Script.FindClass(clName);
+ if clVar <> nil then
+ begin
+ cl := Report.Script.FindClass(clName).ClassRef;
+
+ xd := TfsXMLDocument.Create;
+ GenerateMembers(Report.Script, cl, xd.Root);
+ sl := TStringList.Create;
+ sl.Sorted := True;
+ sl.Duplicates := dupIgnore;
+ for i := 0 to xd.Root.Count - 1 do
+ begin
+ s := xd.Root[i].Prop['text'];
+ j := 0;
+ if Pos('property', s) = 1 then
+ begin
+ Delete(s, 1, 9);
+ j := 1;
+ end;
+ if Pos('index property', s) = 1 then
+ begin
+ Delete(s, 1, 15);
+ j := 1;
+ end;
+ if Pos('procedure', s) = 1 then
+ begin
+ Delete(s, 1, 10);
+ j := 2;
+ end;
+ if Pos('function', s) = 1 then
+ begin
+ Delete(s, 1, 9);
+ j := 3;
+ end;
+
+ sl.AddObject(s, TObject(j));
+ end;
+ List.Assign(sl);
+ sl.Free;
+ xd.Free;
+ end;
+ end;
+end;
+}
+procedure TfrxDesignerForm.FormCreate(Sender: TObject);
+begin
+ FGridSize4 := fr01cm;
+ //FormShow(Sender);
+
+{$IFDEF RAD_ED}
+ VerticalbandsMI.Visible := False;
+ VerticalbandsMI.Enabled := False;
+{$ENDIF}
+ if frxDesignerComp <> nil then
+ begin
+ if (Length(frxDesignerComp.FTemplatesExt) > 1) and
+ (frxDesignerComp.FTemplatesExt[1] = '.') then
+ Delete(frxDesignerComp.FTemplatesExt, 1, 1);
+ FTemplateExt := frxDesignerComp.FTemplatesExt;
+ end
+ else
+ FTemplateExt := 'fr3'
+end;
+
+
+procedure TfrxDesignerForm.GetTemplateList(List: TStrings);
+var
+ sr: TSearchRec;
+ dir, DefExt: String;
+
+ function NormalDir(const DirName: string): string;
+ begin
+ Result := DirName;
+ if (Result <> '') and
+ not (CharInSet(Result[Length(Result)], [':', '\'])) then
+ begin
+ if (Length(Result) = 1) and (CharInSet(UpCase(Result[1]),['A'..'Z'])) then
+ Result := Result + ':\'
+ else Result := Result + '\';
+ end;
+ end;
+
+begin
+ List.Clear;
+ DefExt := FTemplateExt;
+
+ if (frxDesignerComp <> nil) and Assigned(frxDesignerComp.OnGetTemplateList) then
+ frxDesignerComp.OnGetTemplateList(List)
+ else
+ begin
+ dir := FTemplatePath;
+ if (Trim(dir) = '') or (Trim(dir) = '.') then
+ if csDesigning in ComponentState then
+ dir := GetCurrentDir
+ else
+ dir := ExtractFilePath(ParamStr(0));
+ dir := NormalDir(dir);
+ if FindFirst(dir + '*.' + DefExt, faAnyFile, sr) = 0 then
+ begin
+ repeat
+ List.Add(dir + sr.Name);
+ until FindNext(sr) <> 0;
+ FindClose(sr);
+ end;
+ end;
+end;
+
+
+procedure TfrxDesignerForm.SetGridSize1(const Value: Double);
+begin
+ if Value > 0 then
+ FGridSize1 := Value;
+end;
+
+procedure TfrxDesignerForm.SetGridSize2(const Value: Double);
+begin
+ if Value > 0 then
+ FGridSize2 := Value;
+end;
+
+procedure TfrxDesignerForm.SetGridSize3(const Value: Double);
+begin
+ if Value > 0 then
+ FGridSize3 := Value;
+end;
+
+procedure TfrxDesignerForm.SetGridSize4(const Value: Double);
+begin
+ if Value > 0 then
+ FGridSize4 := Value;
+end;
+
+procedure TfrxDesignerForm.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
+begin
+ if ssCtrl in Shift then
+ begin
+ Scale := Scale + Round(WheelDelta / Abs(WheelDelta)) / 20;
+ if Scale < 0.3 then
+ Scale := 0.3;
+ ScaleCB.Text := frxFloatToStr(Round(Scale * 100)) + '%';
+ ScrollBox.SetFocus;
+ end;
+end;
+
+procedure TfrxDesignerForm.FormResize(Sender: TObject);
+begin
+ RightDockTBResize(Self);
+end;
+
+procedure TfrxDesignerForm.UpdateWatches;
+var
+ ErrCount: Integer;
+begin
+ ErrCount := Report.Errors.Count;
+ FWatchList.UpdateWatches;
+ ErrCount := Report.Errors.Count - ErrCount;
+ while (ErrCount <> 0) do
+ begin
+ Report.Errors.Delete(Report.Errors.Count - 1);
+ dec(ErrCount);
+ end;
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxDesigner, TFmxObject);
+ frxDesignerClass := TfrxDesignerForm;
+
+end.
diff --git a/LibD28/FMX.frxDesgn.res b/LibD28/FMX.frxDesgn.res
new file mode 100644
index 0000000..21ecd30
Binary files /dev/null and b/LibD28/FMX.frxDesgn.res differ
diff --git a/LibD28/FMX.frxDesgnCtrls.pas b/LibD28/FMX.frxDesgnCtrls.pas
new file mode 100644
index 0000000..17d22ad
--- /dev/null
+++ b/LibD28/FMX.frxDesgnCtrls.pas
@@ -0,0 +1,1298 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Designer controls }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDesgnCtrls;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.Types, System.UITypes, FMX.Objects, FMX.Types,
+ FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Layouts, FMX.frxClass, FMX.frxPictureCache,
+ System.Variants, FMX.TabControl, System.UIConsts
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+ TfrxRulerUnits = (ruCM, ruInches, ruPixels, ruChars);
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxRuler = class(TPanel)
+ private
+ FOffset: Integer;
+ FScale: Double;
+ FStart: Integer;
+ FUnits: TfrxRulerUnits;
+ FPosition: Double;
+ FRulerSize: Integer;
+ FBitmap: TBitmap;
+ FNeedRedraw: Boolean;
+ FBackgroundColor: TAlphaColor;
+ procedure SetOffset(const Value: Integer);
+ procedure SetScale(const Value: Double);
+ procedure SetStart(const Value: Integer);
+ procedure SetUnits(const Value: TfrxRulerUnits);
+ procedure SetPosition(const Value: Double);
+ procedure SetRulerSize(const Value: Integer);
+ protected
+ procedure DoContentPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF); virtual;
+ procedure DrawRuler;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure ApplyStyle; override;
+ published
+ property Offset: Integer read FOffset write SetOffset;
+ property Scale: Double read FScale write SetScale;
+ property Start: Integer read FStart write SetStart;
+ property Units: TfrxRulerUnits read FUnits write SetUnits default ruPixels;
+ property RulePosition: Double read FPosition write SetPosition;
+ property RulerSize: Integer read FRulerSize write SetRulerSize;
+ end;
+
+ TfrxScrollBox = class(TScrollBox)
+ private
+ FContent: TContent;
+ FOnPositionChanged: TNotifyEvent;
+ protected
+ procedure ApplyStyle; override;
+ procedure DoContentPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF); virtual;
+ procedure DialogKey(var Key: Word; Shift: TShiftState); override;
+ procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
+ procedure KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
+{$IFDEF DELPHI18}
+ procedure HScrollChange; override;
+ procedure VScrollChange; override;
+{$ELSE}
+ procedure HScrollChange(Sender: TObject); override;
+ procedure VScrollChange(Sender: TObject); override;
+{$ENDIF}
+{$IFDEF DELPHI18}
+// public
+// property HScrollBar;
+// property VScrollBar;
+{$ENDIF}
+ published
+ property OnPositionChanged: TNotifyEvent read FOnPositionChanged write FOnPositionChanged;
+ end;
+
+ TfrxTabControl = class(TTabControl)
+ protected
+ procedure ApplyStyle; override;
+ end;
+
+ TfrxCustomSelector = class(TPopup)
+ protected
+ FMouseOver: Boolean;
+ FX, FY: Single;
+ procedure DrawEdge(X, Y: Single); virtual; abstract;
+ procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
+ procedure DoMouseEnter; override;
+ procedure DoMouseLeave; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure Popup(AControl: TControl); reintroduce; overload;
+ end;
+
+ TfrxColorSelector = class(TfrxCustomSelector)
+ private
+ FColor: TColor;
+ FOnColorChanged: TNotifyEvent;
+ FBtnCaption: String;
+ protected
+ procedure DrawEdge(X, Y: Single); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Single); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure DoPaint; override;
+ property Color: TColor read FColor write FColor;
+ property OnColorChanged: TNotifyEvent read FOnColorChanged write FOnColorChanged;
+ property BtnCaption: String read FBtnCaption write FBtnCaption;
+ end;
+
+ TfrxLineSelector = class(TfrxCustomSelector)
+ private
+ FStyle: Byte;
+ FOnStyleChanged: TNotifyEvent;
+ protected
+ procedure DrawEdge(X, Y: Single); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Single); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure DoPaint; override;
+ property Style: Byte read FStyle;
+ property OnStyleChanged: TNotifyEvent read FOnStyleChanged write FOnStyleChanged;
+ end;
+
+ TfrxUndoBuffer = class(TObject)
+ private
+ FPictureCache: TfrxPictureCache;
+ FRedo: TList;
+ FUndo: TList;
+ function GetRedoCount: Integer;
+ function GetUndoCount: Integer;
+ procedure SetPictureFlag(ReportComponent: TfrxComponent; Flag: Boolean);
+ procedure SetPictures(ReportComponent: TfrxComponent);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure AddUndo(ReportComponent: TfrxComponent);
+ procedure AddRedo(ReportComponent: TfrxComponent);
+ procedure GetUndo(ReportComponent: TfrxComponent);
+ procedure GetRedo(ReportComponent: TfrxComponent);
+ procedure ClearUndo;
+ procedure ClearRedo;
+ property UndoCount: Integer read GetUndoCount;
+ property RedoCount: Integer read GetRedoCount;
+ property PictureCache: TfrxPictureCache read FPictureCache write FPictureCache;
+ end;
+
+ TfrxClipboard = class(TObject)
+ private
+ FDesigner: TfrxCustomDesigner;
+ FPictureCache: TfrxPictureCache;
+ function GetPasteAvailable: Boolean;
+ public
+ constructor Create(ADesigner: TfrxCustomDesigner);
+ procedure Copy;
+ procedure Paste;
+ property PasteAvailable: Boolean read GetPasteAvailable;
+ property PictureCache: TfrxPictureCache read FPictureCache write FPictureCache;
+ end;
+
+implementation
+
+uses
+ System.Math, FMX.frxDMPClass, FMX.frxDsgnIntf, FMX.frxCtrls, FMX.frxXMLSerializer, FMX.Platform,
+ FMX.frxUtils, FMX.frxXML, FMX.frxFMX;
+
+const
+ Colors: array[0..47] of TAlphaColor =
+ (claNull, claWhite, claBlack, claMaroon, claGreen, claOlive, claNavy, claPurple,
+ claGray, claSilver, claTeal, claRed, claLime, claYellow, claBlue, claFuchsia,
+ $FFCCCCCC, $FFE4E4E4, claAqua, $FF00CCFF, $FF00CC98, $FF98FFFF, $FFFFCC00, $FFFF98CC,
+ $FFD8D8D8, $FFF0F0F0, $FFFFFFDC, $FFCAE4FF, $FFCCFFCC, $FFCCFFFF, $FFFFF4CC, $FFCC98FF,
+ claGray, $FF46DAFF, $FF9BEBFF, $FF00A47B, $FFFDBD97, $FFFED3BA, $FF6ACFFF, $FFFFF4CC,
+ claGray, claGray, claGray, claGray, claGray, claGray, claGray, claGray);
+
+
+
+{ TfrxRuler }
+
+procedure TfrxRuler.ApplyStyle;
+var
+ StyleObject: TFmxObject;
+begin
+ inherited;
+ StyleObject := GetStyleObject;
+ try
+ if StyleObject is TRectangle then
+ FBackgroundColor := TRectangle(StyleObject).Fill.Color
+ finally
+ StyleObject.Free;
+ end;
+end;
+
+constructor TfrxRuler.Create(AOwner: TComponent);
+begin
+ inherited;
+ FScale := 1;
+ OnPaint := DoContentPaint;
+ StyleLookup := 'backgroundstyle';
+ FBackgroundColor := $FFF5F5F5;
+ FBitmap := TBitmap.Create(1, 1);
+ FNeedRedraw := True;
+end;
+
+destructor TfrxRuler.Destroy;
+begin
+ FBitmap.Free;
+ inherited;
+end;
+
+procedure TfrxRuler.DoContentPaint(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF);
+var
+ SaveState: TCanvasSaveState;
+
+ procedure Line(x, y, dx, dy: Integer);
+ begin
+ Canvas.DrawLine(PointF(x + 0.5, y + 0.5), PointF(x + dx + 0.5, y + dy + 0.5), 1);
+ end;
+
+ procedure DrawLines;
+ var
+ i, dx: Single;
+ ofs: Integer;
+ begin
+ with Canvas do
+ begin
+ Stroke.Color := claBlack;
+ Stroke.Kind := TBrushKind.bkSolid;
+ Fill.Kind := TBrushKind.bkNone;
+
+ if FUnits = ruCM then
+ dx := fr01cm * FScale
+ else if FUnits = ruInches then
+ dx := fr01in * FScale
+ else if FUnits = ruChars then
+ begin
+ if Align = TAlignLayout.alLeft then
+ dx := fr1CharY * FScale / 10 else
+ dx := fr1CharX * FScale / 10
+ end
+ else
+ dx := FScale;
+
+ ofs := FOffset - FStart;
+ if FUnits = ruChars then
+ begin
+ if Align = TAlignLayout.alLeft then
+ Inc(ofs, Round(fr1CharY * FScale / 2)) else
+ Inc(ofs, Round(fr1CharX * FScale / 2))
+ end;
+ i := FPosition * dx;
+ if FUnits <> ruPixels then
+ i := i * 10;
+ if ofs + i >= FOffset then
+ if Align = TAlignLayout.alLeft then
+ Line(3, ofs + Round(i), 13, 0) else
+ Line(ofs + Round(i), 3, 0, 13);
+ end;
+ end;
+
+begin
+ if FNeedRedraw then
+ begin
+ FNeedRedraw := False;
+ DrawRuler;
+ end;
+
+ SaveState := Canvas.SaveState;
+ try
+ Canvas.IntersectClipRect(ARect);
+ Canvas.DrawBitmap(FBitmap, RectF(0, 0, FBitmap.Width, FBitmap.Height), ARect, 1);
+ DrawLines;
+ finally
+ Canvas.RestoreState(SaveState);
+ end;
+end;
+
+procedure TfrxRuler.DrawRuler;
+var
+ sz: Single;
+ SaveStateA, SaveStateB: TCanvasSaveState;
+ RMatrix, OldM: TMatrix;
+
+
+ procedure Line(x, y, dx, dy: Integer);
+ begin
+ FBitmap.Canvas.DrawLine(PointF(x + 0.5, y + 0.5), PointF(x + dx + 0.5, y + dy + 0.5), 1);
+ end;
+
+ procedure DrawLines;
+ var
+ i, dx, maxi, maxw, tx, ty: Single;
+ i1, h, w, w5, w10, ofs: Integer;
+ s: String;
+ begin
+ with FBitmap.Canvas do
+ begin
+ Stroke.Color := claBlack;
+ Stroke.Kind := TBrushKind.bkSolid;
+ Fill.Kind := TBrushKind.bkNone;
+ w5 := 5;
+ w10 := 10;
+ if FUnits = ruCM then
+ dx := fr01cm * FScale
+ else if FUnits = ruInches then
+ dx := fr01in * FScale
+ else if FUnits = ruChars then
+ begin
+ if Align = TAlignLayout.alLeft then
+ dx := fr1CharY * FScale / 10 else
+ dx := fr1CharX * FScale / 10
+ end
+ else
+ begin
+ dx := FScale;
+ w5 := 50;
+ w10 := 100;
+ end;
+
+ if FRulerSize = 0 then
+ begin
+ if Align = TAlignLayout.alLeft then
+ maxi := Height + FStart else
+ maxi := Self.Width + FStart;
+ end
+ else
+ maxi := FRulerSize;
+
+ if FUnits = ruPixels then
+ s := IntToStr(FStart + Round(maxi / dx)) else
+ s := IntToStr((FStart + Round(maxi / dx)) div 10);
+
+ maxw := TextWidth(s);
+ ofs := FOffset - FStart;
+ if FUnits = ruChars then
+ begin
+ if Align = TAlignLayout.alLeft then
+ Inc(ofs, Round(fr1CharY * FScale / 2)) else
+ Inc(ofs, Round(fr1CharX * FScale / 2))
+ end;
+
+ i := 0;
+ i1 := 0;
+ while i < maxi do
+ begin
+ h := 0;
+ if i1 = 0 then
+ h := 0
+ else if i1 mod w10 = 0 then
+ h := 6
+ else if i1 mod w5 = 0 then
+ h := 4
+ else if FUnits <> ruPixels then
+ h := 2;
+
+ if (h = 2) and (dx * w10 < 41) then
+ h := 0;
+ if (h = 4) and (dx * w10 < 21) then
+ h := 0;
+
+ w := 0;
+ if h = 6 then
+ begin
+ if maxw > dx * w10 * 1.5 then
+ w := w10 * 4
+ else if maxw > dx * w10 * 0.7 then
+ w := w10 * 2
+ else
+ w := w10;
+ end;
+
+ if FUnits = ruPixels then
+ s := IntToStr(i1) else
+ s := IntToStr(i1 div 10);
+ Fill.Color := claBlack;
+ Fill.Kind := TBrushKind.bkSolid;
+ if (w <> 0) and (i1 mod w = 0) and (ofs + i >= FOffset) then
+ begin
+ if Align = TAlignLayout.alLeft then
+ begin
+ tx := -(ofs + i - TextWidth(s) / 2 + 6);
+ ty := Self.Width - FBitmap.Canvas.TextHeight(s) - 8;
+ SaveStateB := SaveState;
+
+ SetMatrix(RMatrix);
+ end
+ else
+ begin
+ tx := ofs + Round(i) - TextWidth(s) / 2 + 1;
+ ty := 5;
+ end;
+
+ FillText(RectF(tx, ty, tx + 100, ty + 100), s, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ if Align = TAlignLayout.alLeft then
+ RestoreState(SaveStateB);
+ end
+ else if (h <> 0) and (ofs + i >= FOffset) then
+ if Align = TAlignLayout.alLeft then
+ Line(3 + (13 - h) div 2, ofs + Round(i), h, 0) else
+ Line(ofs + Round(i), 3 + (13 - h) div 2, 0, h);
+
+ i := i + dx;
+ Inc(i1);
+ end;
+ end;
+ end;
+
+begin
+ FBitmap.SetSize(Round(Self.Width), Round(Self.Height));
+ FBitmap.Canvas.BeginScene();
+ SaveStateA := FBitmap.Canvas.SaveState;
+ try
+ with FBitmap.Canvas do
+ begin
+ Fill.Kind := TBrushKind.bkSolid;
+ Fill.Color := FBackgroundColor;
+ FillRect(RectF(0, 0, FBitmap.Width, FBitmap.Height), 1, 1, AllCorners, 1);
+ Fill.Color := claWhite;
+
+ {$IFDEF LINUX}
+ Font.Family := 'Liberation Sans';
+ {$ELSE}
+ Font.Family := 'Arial';
+ {$ENDIF}
+ Font.Size := 8;
+ if Align = TAlignLayout.alLeft then
+ begin
+ if FRulerSize = 0 then
+ sz := Self.Height
+ else
+ sz := FRulerSize + FOffset;
+ FillRect(RectF(3, FOffset, Self.Width - 5, sz), 1, 1, AllCorners, 1);
+ RMatrix := CreateRotationMatrix(-DegToRad(90));
+ //RMatrix.m31 := Self.GetAbsoluteRect.Left;
+ //RMatrix.m32 := Self.GetAbsoluteRect.Top;
+ RMatrix := MatrixMultiply(RMatrix, Matrix);
+ OldM := Matrix;
+ end
+ else
+ begin
+ if FRulerSize = 0 then
+ sz := Self.Width
+ else
+ sz := FRulerSize + FOffset;
+ FillRect(RectF(FOffset, 3, sz, Self.Height - 5), 1, 1, AllCorners, 1);
+ end;
+ end;
+ DrawLines;
+ finally
+ FBitmap.Canvas.RestoreState(SaveStateA);
+ FBitmap.Canvas.EndScene;
+ end;
+end;
+
+procedure TfrxRuler.SetOffset(const Value: Integer);
+begin
+ FOffset := Value;
+ FNeedRedraw := True;
+ Repaint;
+end;
+
+procedure TfrxRuler.SetPosition(const Value: Double);
+begin
+ FPosition := Value;
+ Repaint;
+end;
+
+procedure TfrxRuler.SetScale(const Value: Double);
+begin
+ FScale := Value;
+ FNeedRedraw := True;
+ Repaint;
+end;
+
+procedure TfrxRuler.SetStart(const Value: Integer);
+begin
+ FStart := Value;
+ FNeedRedraw := True;
+ Repaint;
+end;
+
+procedure TfrxRuler.SetUnits(const Value: TfrxRulerUnits);
+begin
+ FUnits := Value;
+ FNeedRedraw := True;
+ Repaint;
+end;
+
+procedure TfrxRuler.SetRulerSize(const Value: Integer);
+begin
+ FRulerSize := Value;
+ FNeedRedraw := True;
+ Repaint;
+end;
+
+
+{ TfrxScrollBox }
+
+procedure TfrxScrollBox.ApplyStyle;
+var
+ B: TFmxObject;
+begin
+ inherited;
+ B := FindStyleResource('content');
+ if (B <> nil) and (B is TControl) then
+ begin
+ FContent := TContent(B);
+ FContent.OnPaint := DoContentPaint;
+ end;
+end;
+
+procedure TfrxScrollBox.DialogKey(var Key: Word; Shift: TShiftState);
+begin
+ inherited;
+end;
+
+procedure TfrxScrollBox.DoContentPaint(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF);
+begin
+ Canvas.Fill.Kind := TBrushKind.bkSolid;
+ Canvas.Fill.Color := $FFE0E0E0;
+ Canvas.FillRect(ARect, 1, 1, AllCorners, 1, TCornerType.ctBevel);
+end;
+
+procedure TfrxScrollBox.KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+//var
+// i: Integer;
+begin
+ inherited;
+ {for i := 0 to ControlCount - 1 do
+ if Controls[i] is TWinControl then
+ THackControl(Controls[i]).KeyDown(Key, Shift);}
+end;
+
+//procedure TfrxScrollBox.KeyPress(var Key: Char);
+//var
+// i: Integer;
+//begin
+// inherited;
+// for i := 0 to ControlCount - 1 do
+// if Controls[i] is TWinControl then
+// THackControl(Controls[i]).KeyPress(Key);
+//end;
+
+procedure TfrxScrollBox.KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+//var
+// i: Integer;
+begin
+ inherited;
+ {for i := 0 to ControlCount - 1 do
+ if Controls[i] is TWinControl then
+ THackControl(Controls[i]).KeyUp(Key, Shift);}
+end;
+
+{$IFDEF DELPHI18}
+procedure TfrxScrollBox.HScrollChange;
+{$ELSE}
+procedure TfrxScrollBox.HScrollChange(Sender: TObject);
+{$ENDIF}
+begin
+ inherited;
+ if Assigned(FOnPositionChanged) then
+ FOnPositionChanged(Self);
+end;
+
+{$IFDEF DELPHI18}
+procedure TfrxScrollBox.VScrollChange;
+{$ELSE}
+procedure TfrxScrollBox.VScrollChange(Sender: TObject);
+{$ENDIF}
+begin
+ inherited;
+ if Assigned(FOnPositionChanged) then
+ FOnPositionChanged(Self);
+end;
+
+
+
+{ TfrxCustomSelector }
+
+constructor TfrxCustomSelector.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ StyleLookup := 'panelstyle';
+end;
+
+procedure TfrxCustomSelector.Popup(AControl: TControl);
+begin
+ Tag := AControl.Tag;
+ PlacementTarget := AControl;
+ Popup;
+end;
+
+procedure TfrxCustomSelector.DoMouseEnter;
+begin
+ FMouseOver := True;
+ Repaint;
+end;
+
+procedure TfrxCustomSelector.DoMouseLeave;
+begin
+ FMouseOver := False;
+ Repaint;
+end;
+
+procedure TfrxCustomSelector.MouseMove(Shift: TShiftState; X, Y: Single);
+begin
+ inherited;
+ FX := X;
+ FY := Y;
+ Repaint;
+end;
+
+
+
+{ TfrxColorSelector }
+
+constructor TfrxColorSelector.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ Width := 155;
+ Height := 143;
+ FBtnCaption := 'Other...';
+end;
+
+procedure TfrxColorSelector.DrawEdge(X, Y: Single);
+var
+ r: TRectF;
+begin
+ X := Trunc((X - 5) / 18);
+ if X >= 8 then
+ X := 7;
+ Y := Trunc((Y - 5) / 18);
+
+ if Y < 6 then
+ r := RectF(X * 18 + 5.5, Y * 18 + 5.5, X * 18 + 23.5, Y * 18 + 23.5) else
+ r := RectF(5.5, 113.5, Width - 5.5, Height - 5.5);
+
+ with Canvas do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := $FFC56A31;
+
+ DrawRect(r, 0, 0, AllCorners, 1);
+ InflateRect(r, -1, -1);
+ Stroke.Color := $FFE8E6E2;
+
+ DrawRect(r, 0, 0, AllCorners, 1);
+ InflateRect(r, -1, -1);
+
+ DrawRect(r, 0, 0, AllCorners, 1);
+ end;
+end;
+
+procedure TfrxColorSelector.MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Single);
+//var
+ //cd: TColorDialog;
+
+ procedure AddCustomColor;
+ var
+ i: Integer;
+ Found: Boolean;
+ Empty: Integer;
+ begin
+ Found := False;
+ Empty := 0;
+ for i := 0 to 47 do
+ begin
+ if Colors[i] = Cardinal(FColor) then
+ Found := True;
+ if (i > 37) and (Colors[i] = claGray) and (Empty = 0) then
+ Empty := i;
+ end;
+
+ if Found then exit;
+
+ if Empty = 0 then
+ begin
+ for i := 40 to 46 do
+ Colors[i] := Colors[i + 1];
+ Empty := 47;
+ end;
+ Colors[Empty] := FColor
+ end;
+
+begin
+ X := Trunc((X - 5) / 18);
+ if X >= 8 then
+ X := 7;
+ Y := Trunc((Y - 5) / 18);
+
+ if Y < 6 then
+ FColor := Colors[Round(X + Y * 8)]
+ else
+ begin
+ //TForm(Parent).AutoSize := False;
+ //Parent.Height := 0;
+ //cd := TColorDialog.Create(Self);
+ //cd.Options := [cdFullOpen];
+ //cd.Color := FColor;
+ //if cd.Execute then
+ // FColor := cd.Color else
+ // Exit;
+ // todo color selector form
+ AddCustomColor;
+ end;
+
+ ClosePopup;
+ if Assigned(FOnColorChanged) then
+ FOnColorChanged(Self);
+end;
+
+procedure TfrxColorSelector.DoPaint;
+var
+ i, j: Integer;
+ s: String;
+ r: TRectF;
+begin
+ inherited;
+
+ with Canvas do
+ begin
+ Fill.Kind := TBrushKind.bkSolid;
+ Stroke.Kind := TBrushKind.bkSolid;
+ for j := 0 to 5 do
+ for i := 0 to 7 do
+ begin
+ if (i = 0) and (j = 0) then
+ Fill.Color := claWhite else
+ Fill.Color := Colors[i + j * 8];
+ Stroke.Color := claGray;
+ r := RectF(i * 18 + 8.5, j * 18 + 8.5, i * 18 + 20.5, j * 18 + 20.5);
+ FillRect(r, 0, 0, AllCorners, 1);
+ DrawRect(r, 0, 0, AllCorners, 1);
+ if (i = 0) and (j = 0) then
+ begin
+ DrawLine(PointF(i * 18 + 10.5, j * 18 + 10.5), PointF(i * 18 + 18.5, j * 18 + 18.5), 1);
+ DrawLine(PointF(i * 18 + 18.5, j * 18 + 10.5), PointF(i * 18 + 10.5, j * 18 + 18.5), 1);
+ end;
+ end;
+
+ Stroke.Color := claGray;
+ Fill.Color := claGray;
+ s := FBtnCaption;
+
+{$IFDEF LINUX}
+ DrawRect(RectF(8.5, 116.5, Width - 20, Height - 20), 0, 0, AllCorners, 1);
+ FillText(RectF(8.5, 116.5, Width - 20, Height - 20), s, False, 1, [], TTextAlign.taCenter, TTextAlign.taCenter)
+{$ELSE}
+ DrawRect(RectF(8.5, 116.5, Width - 8.5, Height - 8.5), 0, 0, AllCorners, 1);
+ FillText(RectF(10, 116, Width - 10, Height - 8), s, False, 1, [], TTextAlign.taCenter, TTextAlign.taCenter)
+{$ENDIF}
+ end;
+
+ if FMouseOver then
+ DrawEdge(FX, FY);
+end;
+
+
+{ TfrxLineSelector }
+
+constructor TfrxLineSelector.Create(AOwner: TComponent);
+begin
+ inherited;
+ Width := 98;
+ Height := 106;
+end;
+
+procedure TfrxLineSelector.DrawEdge(X, Y: Single);
+var
+ r: TRectF;
+begin
+ Y := Trunc((Y - 5) / 16);
+ if Y > 5 then
+ Y := 5;
+
+ r := RectF(5.5, Y * 16 + 5.5, Width - 6.5, Y * 16 + 19.5);
+ with Canvas do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := claGray;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ DrawRect(r, 0, 0, AllCorners, 1);
+ end;
+end;
+
+procedure TfrxLineSelector.MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Single);
+begin
+ Y := Trunc((Y - 5) / 16);
+ if Y > 5 then
+ Y := 5;
+
+ FStyle := Round(Y);
+
+ ClosePopup;
+ if Assigned(FOnStyleChanged) then
+ FOnStyleChanged(Self);
+end;
+
+procedure TfrxLineSelector.DoPaint;
+var
+ i: Integer;
+
+ procedure DrawLine(Y, Style: Integer);
+ begin
+ if Style = 5 then
+ begin
+ Style := 0;
+ DrawLine(Y - 2, Style);
+ Inc(Y, 2);
+ end;
+
+ with Canvas do
+ begin
+ Stroke.Color := claBlack;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 2;
+ Stroke.Dash := TStrokeDash(Style);
+{$ELSE}
+ StrokeDash := TStrokeDash(Style);
+ StrokeThickness := 2;
+{$ENDIF}
+ DrawLine(PointF(7, Y), PointF(Self.Width - 8, Y), 1);
+ end;
+ end;
+
+begin
+ inherited;
+ for i := 0 to 5 do
+ DrawLine(12 + i * 16, i);
+ if FMouseOver then
+ DrawEdge(FX, FY);
+end;
+
+
+{ TfrxUndoBuffer }
+
+constructor TfrxUndoBuffer.Create;
+begin
+ FRedo := TList.Create;
+ FUndo := TList.Create;
+end;
+
+destructor TfrxUndoBuffer.Destroy;
+begin
+ ClearUndo;
+ ClearRedo;
+ FUndo.Free;
+ FRedo.Free;
+ inherited;
+end;
+
+procedure TfrxUndoBuffer.AddUndo(ReportComponent: TfrxComponent);
+var
+ m: TMemoryStream;
+begin
+ m := TMemoryStream.Create;
+ FUndo.Add(m);
+ SetPictureFlag(ReportComponent, False);
+ try
+ ReportComponent.SaveToStream(m);
+ finally
+ SetPictureFlag(ReportComponent, True);
+ end;
+end;
+
+procedure TfrxUndoBuffer.AddRedo(ReportComponent: TfrxComponent);
+var
+ m: TMemoryStream;
+begin
+ m := TMemoryStream.Create;
+ FRedo.Add(m);
+ SetPictureFlag(ReportComponent, False);
+ try
+ ReportComponent.SaveToStream(m);
+ finally
+ SetPictureFlag(ReportComponent, True);
+ end;
+end;
+
+procedure TfrxUndoBuffer.GetUndo(ReportComponent: TfrxComponent);
+var
+ m: TMemoryStream;
+ IsReport: Boolean;
+begin
+ IsReport := False;
+ if ReportComponent is TfrxReport then
+ isReport := True;
+ m := FUndo[FUndo.Count - 2];
+ m.Position := 0;
+ if IsReport then
+ TfrxReport(ReportComponent).Reloading := True;
+ try
+ ReportComponent.LoadFromStream(m);
+ finally
+ if IsReport then
+ TfrxReport(ReportComponent).Reloading := False;
+ end;
+ SetPictures(ReportComponent);
+
+ m := FUndo[FUndo.Count - 1];
+ m.Free;
+ FUndo.Delete(FUndo.Count - 1);
+end;
+
+procedure TfrxUndoBuffer.GetRedo(ReportComponent: TfrxComponent);
+var
+ m: TMemoryStream;
+ IsReport: Boolean;
+begin
+ IsReport := False;
+ if ReportComponent is TfrxReport then
+ isReport := True;
+ m := FRedo[FRedo.Count - 1];
+ m.Position := 0;
+ if IsReport then
+ TfrxReport(ReportComponent).Reloading := True;
+ try
+ ReportComponent.LoadFromStream(m);
+ finally
+ if IsReport then
+ TfrxReport(ReportComponent).Reloading := False;
+ end;
+ SetPictures(ReportComponent);
+
+ m.Free;
+ FRedo.Delete(FRedo.Count - 1);
+end;
+
+procedure TfrxUndoBuffer.ClearUndo;
+begin
+ while FUndo.Count > 0 do
+ begin
+ TMemoryStream(FUndo[0]).Free;
+ FUndo.Delete(0);
+ end;
+end;
+
+procedure TfrxUndoBuffer.ClearRedo;
+begin
+ while FRedo.Count > 0 do
+ begin
+ TMemoryStream(FRedo[0]).Free;
+ FRedo.Delete(0);
+ end;
+end;
+
+function TfrxUndoBuffer.GetRedoCount: Integer;
+begin
+ Result := FRedo.Count;
+end;
+
+function TfrxUndoBuffer.GetUndoCount: Integer;
+begin
+ Result := FUndo.Count;
+end;
+
+procedure TfrxUndoBuffer.SetPictureFlag(ReportComponent: TfrxComponent; Flag: Boolean);
+var
+ i: Integer;
+ l: TList;
+ c: TfrxComponent;
+begin
+ l := ReportComponent.AllObjects;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if c is TfrxPictureView then
+ begin
+ TfrxPictureView(c).IsPictureStored := Flag;
+ TfrxPictureView(c).IsImageIndexStored := not Flag;
+ end;
+ end;
+end;
+
+procedure TfrxUndoBuffer.SetPictures(ReportComponent: TfrxComponent);
+var
+ i: Integer;
+ l: TList;
+ c: TfrxComponent;
+begin
+ l := ReportComponent.AllObjects;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if c is TfrxPictureView then
+ FPictureCache.GetPicture(TfrxPictureView(c));
+ end;
+end;
+
+
+{ TfrxClipboard }
+
+constructor TfrxClipboard.Create(ADesigner: TfrxCustomDesigner);
+begin
+ FDesigner := ADesigner;
+end;
+
+procedure TfrxClipboard.Copy;
+var
+ c, c1: TfrxComponent;
+ i, j: Integer;
+ text: String;
+ minX, minY: Extended;
+ List: TList;
+ Flag: Boolean;
+
+ procedure Write(c: TfrxComponent);
+ var
+ c1: TfrxComponent;
+ Writer: TfrxXMLSerializer;
+ begin
+ c1 := TfrxComponent(c.NewInstance);
+ c1.Create(FDesigner.Page);
+
+ if c is TfrxPictureView then
+ begin
+ TfrxPictureView(c).IsPictureStored := False;
+ TfrxPictureView(c).IsImageIndexStored := True;
+ end;
+
+ try
+ c1.Assign(c);
+ finally
+ if c is TfrxPictureView then
+ begin
+ TfrxPictureView(c).IsPictureStored := True;
+ TfrxPictureView(c).IsImageIndexStored := False;
+ TfrxPictureView(c1).IsImageIndexStored := True;
+ end;
+ end;
+
+ c1.Left := c1.Left - minX;
+ c1.Top := c.AbsTop - minY;
+
+ Writer := TfrxXMLSerializer.Create(nil);
+ Writer.Owner := c1.Report;
+ text := text + '<' + c1.ClassName + ' Name="' + c.Name + '"' + Writer.ObjToXML(c1) + '/>';
+ Writer.Free;
+
+ c1.Free;
+ end;
+
+begin
+ text := '#FR3 clipboard#' + #10#13;
+
+ minX := 100000;
+ minY := 100000;
+ for i := 0 to FDesigner.SelectedObjects.Count - 1 do
+ begin
+ c := FDesigner.SelectedObjects[i];
+ if c.AbsLeft < minX then
+ minX := c.AbsLeft;
+ if c.AbsTop < minY then
+ minY := c.AbsTop;
+ end;
+
+ List := FDesigner.Page.AllObjects;
+ for i := 0 to List.Count - 1 do
+ begin
+ c := List[i];
+ if FDesigner.SelectedObjects.IndexOf(c) <> -1 then
+ begin
+ Write(c);
+ if c is TfrxBand then
+ begin
+ Flag := False;
+ for j := 0 to c.Objects.Count - 1 do
+ begin
+ c1 := c.Objects[j];
+ if FDesigner.SelectedObjects.IndexOf(c1) <> -1 then
+ Flag := True;
+ end;
+
+ if not Flag then
+ for j := 0 to c.Objects.Count - 1 do
+ Write(c.Objects[j]);
+ end;
+ end;
+ end;
+
+ SetClipboard(text);
+end;
+
+function TfrxClipboard.GetPasteAvailable: Boolean;
+var
+ cb: Variant;
+begin
+ Result := False;
+ try
+ cb := GetClipboard;
+ if cb <> null then
+ Result := (Pos('#FR3 clipboard#', cb) = 1);
+ except
+ Result := False;
+ end;
+end;
+
+procedure TfrxClipboard.Paste;
+var
+ c: TfrxComponent;
+ sl: TStrings;
+ s: TStream;
+ List: TList;
+ NewCompName: string;
+ NewComp: TfrxComponent;
+
+ function ReadComponent_(AReader: TfrxXMLSerializer; Root: TfrxComponent): TfrxComponent;
+ var
+ rd: TfrxXMLReader;
+ RootItem: TfrxXMLItem;
+ begin
+ rd := TfrxXMLReader.Create(AReader.Stream);
+ RootItem := TfrxXMLItem.Create;
+
+ try
+ rd.ReadRootItem(RootItem, False);
+ Result := AReader.ReadComponentStr(Root, RootItem.Name + ' ' + RootItem.Text);
+
+ NewCompName := RootItem.Prop['Name'];
+ finally
+ rd.Free;
+ RootItem.Free;
+ end;
+ end;
+
+ function ReadComponent: TfrxComponent;
+ var
+ Reader: TfrxXMLSerializer;
+ begin
+ Reader := TfrxXMLSerializer.Create(s);
+ Result := ReadComponent_(Reader, FDesigner.Report);
+ Reader.Free;
+ end;
+
+ function FindBand(Band: TfrxComponent): Boolean;
+ var
+ i: Integer;
+ begin
+ Result := False;
+ for i := 0 to FDesigner.Page.Objects.Count - 1 do
+ if (FDesigner.Page.Objects[i] <> Band) and
+ (TObject(FDesigner.Page.Objects[i]) is Band.ClassType) then
+ Result := True;
+ end;
+
+ function CanInsert(c: TfrxComponent): Boolean;
+ begin
+ Result := True;
+ if (c is TfrxDialogControl) and (FDesigner.Page is TfrxReportPage) then
+ Result := False;
+ if not (c is TfrxDialogComponent) and not (c is TfrxDialogControl) and
+ (FDesigner.Page is TfrxDialogPage) then
+ Result := False;
+ if ((c is TfrxDMPMemoView) or (c is TfrxDMPLineView) or (c is TfrxDMPCommand)) and
+ not (FDesigner.Page is TfrxDMPPage) then
+ Result := False;
+ if not ((c is TfrxBand) or (c is TfrxDMPMemoView) or (c is TfrxDMPLineView) or
+ (c is TfrxDMPCommand)) and (FDesigner.Page is TfrxDMPPage) then
+ Result := False;
+ if not ((c is TfrxCustomLineView) or (c is TfrxCustomMemoView) or
+ (c is TfrxShapeView) or (c is TfrxDialogComponent)) and
+ (FDesigner.Page is TfrxDataPage) then
+ Result := False;
+ end;
+
+ procedure FindParent(c: TfrxComponent);
+ var
+ i: Integer;
+ Found: Boolean;
+ c1: TfrxComponent;
+ begin
+ Found := False;
+ if not (c is TfrxBand) then
+ for i := List.Count - 1 downto 0 do
+ begin
+ c1 := List[i];
+ if c1 is TfrxBand then
+ if (c.Top >= c1.Top) and (c.Top < c1.Top + c1.Height) then
+ begin
+ c.Parent := c1;
+ c.Top := c.Top - c1.Top;
+ Found := True;
+ break;
+ end;
+ end;
+ if not Found then
+ c.Parent := FDesigner.Page;
+ end;
+
+begin
+ FDesigner.SelectedObjects.Clear;
+
+ sl := TStringList.Create;
+ sl.Text := GetClipboard;
+ sl.Delete(0);
+
+ s := TMemoryStream.Create;
+ sl.SaveToStream(s, TEncoding.UTF8);
+ sl.Free;
+ s.Position := 0;
+
+ List := TList.Create;
+
+ while s.Position < s.Size do
+ begin
+ c := ReadComponent;
+ if c = nil then break;
+
+ if (((c is TfrxReportTitle) or (c is TfrxReportSummary) or
+ (c is TfrxPageHeader) or (c is TfrxPageFooter) or
+ (c is TfrxColumnHeader) or (c is TfrxColumnFooter)) and FindBand(c)) or
+ not CanInsert(c) then
+ c.Free
+ else
+ begin
+ if c is TfrxPictureView then
+ FPictureCache.GetPicture(TfrxPictureView(c));
+ List.Add(c);
+ FindParent(c);
+ if FDesigner.IsPreviewDesigner then
+ NewComp := FDesigner.Report.FindObject(NewCompName) as TfrxComponent
+ else
+ NewComp := FDesigner.Report.FindComponent(NewCompName) as TfrxComponent;
+ if ((NewComp <> nil) and (NewComp <> c)) or (NewCompName = '') then
+ c.CreateUniqueName
+ else
+ c.Name := NewCompName;
+ c.GroupIndex := 0;
+ FDesigner.Objects.Add(c);
+ if c.Parent = FDesigner.Page then
+ FDesigner.SelectedObjects.Add(c);
+ c.OnPaste;
+ end;
+ end;
+
+ if FDesigner.SelectedObjects.Count = 0 then
+ FDesigner.SelectedObjects.Add(FDesigner.Page);
+
+ List.Free;
+ s.Free;
+end;
+
+
+{ TfrxTabControl }
+
+procedure TfrxTabControl.ApplyStyle;
+var
+ B: TFmxObject;
+begin
+ inherited;
+ B := FindStyleResource('rectangle');
+ if (B <> nil) and (B is TRectangle) then
+ TRectangle(B).Sides := [];
+end;
+
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxRuler, TFmxObject);
+ GroupDescendentsWith(TfrxScrollBox, TFmxObject);
+ RegisterFmxClasses([TfrxRuler, TfrxScrollBox]);
+
+end.
diff --git a/LibD28/FMX.frxDesgnEditors.pas b/LibD28/FMX.frxDesgnEditors.pas
new file mode 100644
index 0000000..d948139
--- /dev/null
+++ b/LibD28/FMX.frxDesgnEditors.pas
@@ -0,0 +1,1557 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Property editors for Designer }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDesgnEditors;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, System.SysUtils, System.UITypes, System.Types, System.UIConsts,
+ FMX.Types, FMX.Objects, FMX.Controls, FMX.Forms, FMX.Menus,
+ FMX.Dialogs, FMX.frxClass, FMX.frxDMPClass, FMX.frxDesgn, FMX.frxDsgnIntf, FMX.frxUtils,
+ FMX.frxCtrls, FMX.frxCustomEditors, FMX.frxEditPage, FMX.frxEditMemo,
+ FMX.frxEditDataBand, FMX.frxEditStrings, FMX.frxEditFormat, FMX.frxEditGroup, FMX.frxEditSysMemo,
+ FMX.frxCodeUtils, FMX.frxEditPicture, FMX.frxEditFrame, FMX.frxRes,
+ FMX.frxUnicodeUtils, FMX.frxPrinter, System.Variants, System.WideStrings, FMX.ListBox
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+
+type
+ { Component editors }
+
+ TfrxPageEditor = class(TfrxComponentEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ end;
+
+ TfrxMemoEditor = class(TfrxCustomMemoEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ end;
+
+ TfrxSysMemoEditor = class(TfrxCustomMemoEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ end;
+
+ TfrxLineEditor = class(TfrxViewEditor)
+ public
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxPictureEditor = class(TfrxViewEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxBandEditor = class(TfrxComponentEditor)
+ public
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxDataBandEditor = class(TfrxBandEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxHeaderEditor = class(TfrxBandEditor)
+ public
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxPageHeaderEditor = class(TfrxBandEditor)
+ public
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxPageFooterEditor = class(TfrxComponentEditor)
+ public
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxGroupHeaderEditor = class(TfrxBandEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxColumnHeaderEditor = class(TfrxBandEditor)
+ public
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxColumnFooterEditor = class(TfrxBandEditor)
+ public
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxOverlayEditor = class(TfrxBandEditor)
+ public
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+
+ TfrxDialogControlEditor = class(TfrxComponentEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ end;
+
+ TfrxSubreportEditor = class(TfrxComponentEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ { Property editors }
+
+ TfrxMemoProperty = class(TfrxClassProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+ TfrxFrameProperty = class(TfrxClassProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+ TfrxPictureProperty = class(TfrxClassProperty)
+ public
+ function GetValue: String; override;
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+ TfrxBitmapProperty = class(TfrxClassProperty)
+ public
+ function GetValue: String; override;
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+ TfrxDataSetProperty = class(TfrxPropertyEditor)
+ public
+ function GetValue: String; override;
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxDataFieldProperty = class(TfrxPropertyEditor)
+ public
+ function GetValue: String; override;
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxEventProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ procedure GetValues; override;
+ end;
+
+ TfrxLocSizeXProperty = class(TfrxFloatProperty)
+ protected
+ FRatio: Extended;
+ public
+ constructor Create(Designer: TfrxCustomDesigner); override;
+ function GetValue: String; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxLocSizeYProperty = class(TfrxLocSizeXProperty)
+ public
+ constructor Create(Designer: TfrxCustomDesigner); override;
+ end;
+
+ TfrxPaperXProperty = class(TfrxFloatProperty)
+ protected
+ FRatio: Extended;
+ public
+ constructor Create(Designer: TfrxCustomDesigner); override;
+ function GetValue: String; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxPaperYProperty = class(TfrxPaperXProperty)
+ public
+ constructor Create(Designer: TfrxCustomDesigner); override;
+ end;
+
+ TfrxStringsProperty = class(TfrxClassProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+ TfrxBrushProperty = class(TfrxEnumProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure OnDrawLBItem(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF); override;
+ procedure OnDrawItem(Canvas: TCanvas; ARect: TRectF); override;
+ end;
+
+ TfrxFrameStyleProperty = class(TfrxEnumProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function GetExtraLBSize: Integer; override;
+ procedure OnDrawLBItem(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF); override;
+ procedure OnDrawItem(Canvas: TCanvas; ARect: TRectF); override;
+ end;
+
+ TfrxDisplayFormatProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+ TfrxBooleanProperty = class(TfrxEnumProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure OnDrawLBItem(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF); override;
+ procedure OnDrawItem(Canvas: TCanvas; ARect: TRectF); override;
+ end;
+
+ TfrxPrinterProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ end;
+
+ TfrxPaperProperty = class(TfrxIntegerProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ function GetValue: String; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxStyleProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ end;
+
+
+
+{ TfrxPageEditor }
+
+function TfrxPageEditor.Edit: Boolean;
+begin
+ Result := False;
+ if (Component is TfrxReportPage) and
+ (TfrxReportPage(Component).Subreport = nil) then
+ with TfrxPageEditorForm.Create(Designer) do
+ begin
+ Result := ShowModal = mrOk;
+ Free;
+ end;
+end;
+
+function TfrxPageEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+
+{ TfrxMemoEditor }
+
+function TfrxMemoEditor.Edit: Boolean;
+begin
+ with TfrxMemoEditorForm.Create(Designer) do
+ begin
+ MemoView := TfrxMemoView(Component);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ begin
+ MemoView.Text := Text;
+ MemoView.DataField := '';
+ end;
+ Free;
+ end;
+end;
+
+function TfrxMemoEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+
+{ TfrxSysMemoEditor }
+
+function TfrxSysMemoEditor.Edit: Boolean;
+begin
+ with TfrxSysMemoEditorForm.Create(Designer) do
+ begin
+ Text := TfrxSysMemoView(Component).Text;
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ TfrxSysMemoView(Component).Text := Text;
+ Free;
+ end;
+end;
+
+function TfrxSysMemoEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+
+{ TfrxLineEditor }
+
+function TfrxLineEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ i: Integer;
+ c: TfrxComponent;
+ l: TfrxCustomLineView;
+begin
+ Result := inherited Execute(Tag, Checked);
+
+ for i := 0 to Designer.SelectedObjects.Count - 1 do
+ begin
+ c := Designer.SelectedObjects[i];
+ if (c is TfrxCustomLineView) and not (rfDontModify in c.Restrictions) then
+ begin
+ l := TfrxCustomLineView(c);
+ case Tag of
+ 0: l.Diagonal := Checked;
+ 1: if Checked then
+ l.StretchMode := smMaxHeight else
+ l.StretchMode := smDontStretch;
+ end;
+
+ Result := True;
+ end;
+ end;
+end;
+
+procedure TfrxLineEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ l: TfrxCustomLineView;
+begin
+ inherited;
+ l := TfrxCustomLineView(Component);
+
+ if l is TfrxLineView then
+ AddItem(frxResources.Get('lvDiagonal'), 0, l.Diagonal);
+ AddItem(frxResources.Get('mvStretch'), 1, l.StretchMode = smMaxHeight);
+
+ inherited;
+end;
+
+
+{ TfrxPictureEditor }
+
+function TfrxPictureEditor.Edit: Boolean;
+begin
+ with TfrxPictureEditorForm.Create(Designer) do
+ begin
+ Image.Bitmap.Assign(TfrxPictureView(Component).Picture);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ begin
+ TfrxPictureView(Component).Picture.Assign(Image.Bitmap);
+ TfrxDesignerForm(Self.Designer).PictureCache.AddPicture(TfrxPictureView(Component));
+ end;
+ Free;
+ end;
+end;
+
+function TfrxPictureEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+function TfrxPictureEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ i: Integer;
+ c: TfrxComponent;
+ p: TfrxPictureView;
+begin
+ Result := inherited Execute(Tag, Checked);
+
+ for i := 0 to Designer.SelectedObjects.Count - 1 do
+ begin
+ c := Designer.SelectedObjects[i];
+ if (c is TfrxPictureView) and not (rfDontModify in c.Restrictions) then
+ begin
+ p := TfrxPictureView(c);
+ case Tag of
+ 0: p.AutoSize := Checked;
+ 1: p.Stretched := Checked;
+ 2: p.Center := Checked;
+ 3: p.KeepAspectRatio := Checked;
+ end;
+
+ Result := True;
+ end;
+ end;
+end;
+
+procedure TfrxPictureEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ p: TfrxPictureView;
+begin
+ inherited;
+ p := TfrxPictureView(Component);
+
+ AddItem(frxResources.Get('pvAutoSize'), 0, p.AutoSize);
+ AddItem(frxResources.Get('mvStretch'), 1, p.Stretched);
+ AddItem(frxResources.Get('pvCenter'), 2, p.Center);
+ AddItem(frxResources.Get('pvAspect'), 3, p.KeepAspectRatio);
+ AddItem('-', -1);
+
+ inherited;
+end;
+
+
+{ TfrxBandEditor }
+
+function TfrxBandEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ b: TfrxBand;
+begin
+ Result := False;
+
+ b := Designer.SelectedObjects[0];
+ if not (rfDontModify in b.Restrictions) then
+ begin
+ case Tag of
+ 10: b.Stretched := Checked;
+ 11: b.AllowSplit := Checked;
+ 12: b.KeepChild := Checked;
+ 13: b.PrintChildIfInvisible := Checked;
+ 14: b.StartNewPage := Checked;
+ end;
+ Result := True;
+ end;
+end;
+
+procedure TfrxBandEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ b: TfrxBand;
+begin
+ inherited;
+ if Designer.SelectedObjects.Count > 1 then Exit;
+ b := TfrxBand(Component);
+
+ if not b.Vertical then
+ begin
+ AddItem(frxResources.Get('mvStretch'), 10, b.Stretched);
+ if not (b.BandNumber in [2,3,15,16]) then
+ AddItem(frxResources.Get('bvSplit'), 11, b.AllowSplit);
+ if not (b.BandNumber in [2,15]) then
+ AddItem(frxResources.Get('bvKeepChild'), 12, b.KeepChild);
+ end;
+ AddItem(frxResources.Get('bvPrintChild'), 13, b.PrintChildIfInvisible);
+ if not (b.BandNumber in [2,3,5,13,15,16]) then
+ AddItem(frxResources.Get('bvStartPage'), 14, b.StartNewPage);
+end;
+
+
+{ TfrxDataBandEditor }
+
+function TfrxDataBandEditor.Edit: Boolean;
+begin
+ with TfrxDataBandEditorForm.Create(Designer) do
+ begin
+ DataBand := TfrxDataBand(Component);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ Free;
+ end;
+end;
+
+function TfrxDataBandEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+function TfrxDataBandEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ b: TfrxDataBand;
+begin
+ Result := inherited Execute(Tag, Checked);
+
+ b := Designer.SelectedObjects[0];
+ if not (rfDontModify in b.Restrictions) then
+ begin
+ case Tag of
+ 0: b.PrintIfDetailEmpty := Checked;
+ 1: b.FooterAfterEach := Checked;
+ 2: b.KeepTogether := Checked;
+ 3: b.KeepFooter := Checked;
+ 4: b.KeepHeader := Checked;
+ end;
+ Result := True;
+ end;
+end;
+
+procedure TfrxDataBandEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ b: TfrxDataBand;
+begin
+ inherited;
+ if Designer.SelectedObjects.Count > 1 then Exit;
+ b := TfrxDataBand(Component);
+
+ AddItem(frxResources.Get('bvPrintIfEmpty'), 0, b.PrintIfDetailEmpty);
+ AddItem(frxResources.Get('bvFooterAfterEach'), 1, b.FooterAfterEach);
+ if not b.Vertical then
+ begin
+ AddItem(frxResources.Get('bvKeepDetail'), 2, b.KeepTogether);
+ AddItem(frxResources.Get('bvKeepFooter'), 3, b.KeepFooter);
+ AddItem(frxResources.Get('bvKeepHeader'), 4, b.KeepHeader);
+ end;
+end;
+
+
+{ TfrxHeaderEditor }
+
+function TfrxHeaderEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ b: TfrxHeader;
+begin
+ Result := inherited Execute(Tag, Checked);
+
+ b := Designer.SelectedObjects[0];
+ if not (rfDontModify in b.Restrictions) then
+ begin
+ if Tag = 0 then
+ b.ReprintOnNewPage := Checked;
+ Result := True;
+ end;
+end;
+
+procedure TfrxHeaderEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ b: TfrxHeader;
+begin
+ inherited;
+ if Designer.SelectedObjects.Count > 1 then Exit;
+ b := TfrxHeader(Component);
+
+ AddItem(frxResources.Get('bvReprint'), 0, b.ReprintOnNewPage);
+end;
+
+
+{ TfrxPageHeaderEditor }
+
+function TfrxPageHeaderEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ b: TfrxPageHeader;
+begin
+ Result := inherited Execute(Tag, Checked);
+
+ b := Designer.SelectedObjects[0];
+ if not (rfDontModify in b.Restrictions) then
+ begin
+ if Tag = 0 then
+ b.PrintOnFirstPage := Checked;
+ Result := True;
+ end;
+end;
+
+procedure TfrxPageHeaderEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ b: TfrxPageHeader;
+begin
+ inherited;
+ if Designer.SelectedObjects.Count > 1 then Exit;
+ b := TfrxPageHeader(Component);
+
+ AddItem(frxResources.Get('bvOnFirst'), 0, b.PrintOnFirstPage);
+end;
+
+
+{ TfrxPageFooterEditor }
+
+function TfrxPageFooterEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ b: TfrxPageFooter;
+begin
+ Result := False;
+
+ b := Designer.SelectedObjects[0];
+ if not (rfDontModify in b.Restrictions) then
+ begin
+ case Tag of
+ 0: b.PrintOnFirstPage := Checked;
+ 1: b.PrintOnLastPage := Checked;
+ end;
+ Result := True;
+ end;
+end;
+
+procedure TfrxPageFooterEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ b: TfrxPageFooter;
+begin
+ inherited;
+ if Designer.SelectedObjects.Count > 1 then Exit;
+ b := TfrxPageFooter(Component);
+
+ AddItem(frxResources.Get('bvOnFirst'), 0, b.PrintOnFirstPage);
+ AddItem(frxResources.Get('bvOnLast'), 1, b.PrintOnLastPage);
+end;
+
+
+{ TfrxGroupHeaderEditor }
+
+function TfrxGroupHeaderEditor.Edit: Boolean;
+begin
+ with TfrxGroupEditorForm.Create(Designer) do
+ begin
+ GroupHeader := TfrxGroupHeader(Component);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ Free;
+ end;
+end;
+
+function TfrxGroupHeaderEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+function TfrxGroupHeaderEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ b: TfrxGroupHeader;
+begin
+ Result := inherited Execute(Tag, Checked);
+
+ b := Designer.SelectedObjects[0];
+ if not (rfDontModify in b.Restrictions) then
+ begin
+ if Tag = 0 then
+ b.KeepTogether := Checked
+ else if Tag = 1 then
+ b.ReprintOnNewPage := Checked
+ else if Tag = 2 then
+ b.DrillDown := Checked
+ else if Tag = 3 then
+ begin
+ b.ResetPageNumbers := Checked;
+ if Checked then
+ b.StartNewPage := True;
+ end;
+ Result := True;
+ end;
+end;
+
+procedure TfrxGroupHeaderEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ b: TfrxGroupHeader;
+begin
+ inherited;
+ if Designer.SelectedObjects.Count > 1 then Exit;
+ b := TfrxGroupHeader(Component);
+
+ AddItem(frxResources.Get('bvKeepGroup'), 0, b.KeepTogether);
+ AddItem(frxResources.Get('bvReprint'), 1, b.ReprintOnNewPage);
+ AddItem(frxResources.Get('bvDrillDown'), 2, b.DrillDown);
+ AddItem(frxResources.Get('bvResetPageNo'), 3, b.ResetPageNumbers);
+end;
+
+
+{ TfrxDialogControlEditor }
+
+function TfrxDialogControlEditor.Edit: Boolean;
+var
+ i: Integer;
+ c: TfrxDialogControl;
+ s: String;
+begin
+ c := TfrxDialogControl(Component);
+ if c.OnClick = '' then
+ begin
+ s := c.Name + 'OnClick';
+ c.OnClick := s;
+ i := frxLocateEventHandler(Designer.Code, Designer.Report.ScriptLanguage, s);
+ if i = -1 then
+ i := frxAddEvent(Designer.Code, Designer.Report.ScriptLanguage,
+ TypeInfo(TfrxNotifyEvent), s) else
+ Inc(i, 3);
+
+ TfrxDesignerForm(Designer).SwitchToCodeWindow;
+ TfrxDesignerForm(Designer).CodeWindow.UpdateView;
+ TfrxDesignerForm(Designer).CodeWindow.SetPos(3, i);
+ Result := True;
+ end
+ else
+ begin
+ i := frxLocateEventHandler(Designer.Code, Designer.Report.ScriptLanguage,
+ c.OnClick);
+
+ TfrxDesignerForm(Designer).SwitchToCodeWindow;
+ TfrxDesignerForm(Designer).CodeWindow.SetPos(1, i + 3);
+ Result := False;
+ end;
+end;
+
+function TfrxDialogControlEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+
+{ TfrxSubreportEditor }
+
+function TfrxSubreportEditor.Edit: Boolean;
+var
+ s: TfrxSubreport;
+begin
+ Result := False;
+ s := TfrxSubreport(Component);
+ if s.Page <> nil then
+ Designer.Page := s.Page;
+end;
+
+function TfrxSubreportEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ s: TfrxSubreport;
+begin
+ Result := inherited Execute(Tag, Checked);
+
+ s := TfrxSubreport(Component);
+ if not (rfDontModify in s.Restrictions) then
+ begin
+ if Tag = 0 then
+ s.PrintOnParent := Checked;
+ Result := True;
+ end;
+end;
+
+procedure TfrxSubreportEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+begin
+ inherited;
+ AddItem(frxResources.Get('srParent'), 0, TfrxSubreport(Component).PrintOnParent);
+end;
+
+function TfrxSubreportEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+
+{ TfrxMemoProperty }
+
+function TfrxMemoProperty.Edit: Boolean;
+begin
+ with TfrxMemoEditorForm.Create(Designer) do
+ begin
+ MemoView := TfrxMemoView(Component);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ MemoView.Text := Memo.Text;
+ Free;
+ end;
+end;
+
+function TfrxMemoProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog, paReadOnly];
+end;
+
+
+{ TfrxFrameProperty }
+
+function TfrxFrameProperty.Edit: Boolean;
+begin
+ with TfrxFrameEditorForm.Create(Designer) do
+ begin
+ Frame.Assign(TfrxFrame(GetOrdValue));
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ TfrxFrame(GetOrdValue).Assign(Frame);
+ Free;
+ end;
+end;
+
+function TfrxFrameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paDialog, paReadOnly];
+end;
+
+
+{ TfrxPictureProperty }
+
+function TfrxPictureProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog, paReadOnly];
+end;
+
+function TfrxPictureProperty.Edit: Boolean;
+var
+ Pict: TBitmap;
+begin
+ with TfrxPictureEditorForm.Create(Designer) do
+ begin
+ Pict := TBitmap(GetOrdValue);
+ Image.Bitmap.Assign(Pict);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ Pict.Assign(Image.Bitmap);
+ Free;
+ end;
+end;
+
+function TfrxPictureProperty.GetValue: String;
+var
+ Pict: TBitmap;
+begin
+ Pict := TBitmap(GetOrdValue);
+ if Pict.IsEmpty then
+ Result := frxResources.Get('prNotAssigned') else
+ Result := frxResources.Get('prPict');
+end;
+
+
+{ TfrxBitmapProperty }
+
+function TfrxBitmapProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog, paReadOnly];
+end;
+
+function TfrxBitmapProperty.Edit: Boolean;
+var
+ Bmp: TBitmap;
+begin
+ with TfrxPictureEditorForm.Create(Designer) do
+ begin
+ Bmp := TBitmap(GetOrdValue);
+ Image.Bitmap.Assign(Bmp);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ Bmp.Assign(Image.Bitmap);
+ Free;
+ end;
+end;
+
+function TfrxBitmapProperty.GetValue: String;
+begin
+ Result := frxResources.Get('prPict');
+end;
+
+
+{ TfrxDataSetProperty }
+
+function TfrxDataSetProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList];
+end;
+
+function TfrxDataSetProperty.GetValue: String;
+var
+ ds: TfrxDataSet;
+begin
+ ds := TfrxDataSet(GetOrdValue);
+ if (ds <> nil) and (frComponent.Report <> nil) then
+ Result := frComponent.Report.GetAlias(ds) else
+ Result := frxResources.Get('prNotAssigned');
+end;
+
+procedure TfrxDataSetProperty.GetValues;
+begin
+ if frComponent.Report = nil then Exit;
+ frComponent.Report.GetDataSetList(Values);
+ if Component is TfrxDataSet then
+ Values.Delete(Values.IndexOf(TfrxDataSet(Component).UserName));
+end;
+
+procedure TfrxDataSetProperty.SetValue(const Value: String);
+var
+ ds: TfrxDataSet;
+begin
+ if Value = '' then
+ SetOrdValue(0)
+ else
+ begin
+ ds := frComponent.Report.GetDataSet(Value);
+ if ds <> nil then
+ SetOrdValue(frxInteger(ds)) else
+ raise Exception.Create(frxResources.Get('prInvProp'));
+
+ if Component is TfrxCustomMemoView then
+ with TfrxCustomMemoView(Component) do
+ if IsDataField then
+ Text := '[' + DataSet.UserName + '."' + DataField + '"]';
+ end;
+end;
+
+
+{ TfrxDataFieldProperty }
+
+function TfrxDataFieldProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList];
+end;
+
+function TfrxDataFieldProperty.GetValue: String;
+begin
+ Result := GetStrValue;
+end;
+
+procedure TfrxDataFieldProperty.SetValue(const Value: String);
+begin
+ SetStrValue(Value);
+ if Component is TfrxCustomMemoView then
+ with TfrxCustomMemoView(Component) do
+ if IsDataField then
+ Text := '[' + DataSet.UserName + '."' + DataField + '"]';
+end;
+
+procedure TfrxDataFieldProperty.GetValues;
+var
+ ds: TfrxDataSet;
+begin
+ inherited;
+ ds := TfrxView(Component).DataSet;
+ if ds <> nil then
+ ds.GetFieldList(Values);
+end;
+
+
+{ TfrxLocSizeXProperty }
+
+constructor TfrxLocSizeXProperty.Create(Designer: TfrxCustomDesigner);
+begin
+ inherited;
+ FRatio := fr1CharX;
+end;
+
+function TfrxLocSizeXProperty.GetValue: String;
+var
+ e: Extended;
+begin
+ e := GetFloatValue;
+ case TfrxDesignerForm(Designer).Units of
+ duCM: e := e / 96 * 2.54;
+ duInches: e := e / 96;
+ duChars: e := e / FRatio;
+ end;
+
+ if e = Int(e) then
+ Result := FloatToStr(e) else
+ Result := Format('%f', [e]);
+end;
+
+procedure TfrxLocSizeXProperty.SetValue(const Value: String);
+var
+ e: Extended;
+begin
+ e := frxStrToFloat(Value);
+ case TfrxDesignerForm(Designer).Units of
+ duCM: e := e * 96 / 2.54;
+ duInches: e := e * 96;
+ duChars: e := e * FRatio;
+ end;
+
+ SetFloatValue(e);
+end;
+
+
+{ TfrxLocSizeYProperty }
+
+constructor TfrxLocSizeYProperty.Create(Designer: TfrxCustomDesigner);
+begin
+ inherited;
+ FRatio := fr1CharY;
+end;
+
+
+{ TfrxPaperXProperty }
+
+constructor TfrxPaperXProperty.Create(Designer: TfrxCustomDesigner);
+begin
+ inherited;
+ FRatio := fr1CharX;
+end;
+
+function TfrxPaperXProperty.GetValue: String;
+var
+ e: Extended;
+begin
+ e := GetFloatValue;
+ case TfrxDesignerForm(Designer).Units of
+ duCM: e := e / 10;
+ duInches: e := e / 25.4;
+ duPixels: e := e * 96 / 25.4;
+ duChars: e := e * 96 / 25.4 / FRatio;
+ end;
+
+ if e = Int(e) then
+ Result := FloatToStr(e) else
+ Result := Format('%f', [e]);
+end;
+
+procedure TfrxPaperXProperty.SetValue(const Value: String);
+var
+ e: Extended;
+begin
+ e := frxStrToFloat(Value);
+ case TfrxDesignerForm(Designer).Units of
+ duCM: e := e * 10;
+ duInches: e := e * 25.4;
+ duPixels: e := e * 25.4 / 96;
+ duChars: e := e * 25.4 / 96 * FRatio;
+ end;
+
+ SetFloatValue(e);
+end;
+
+
+{ TfrxPaperYProperty }
+
+constructor TfrxPaperYProperty.Create(Designer: TfrxCustomDesigner);
+begin
+ inherited;
+ FRatio := fr1CharY;
+end;
+
+
+{ TfrxEventProperty }
+
+function TfrxEventProperty.Edit: Boolean;
+var
+ i: Integer;
+begin
+ if not TfrxDesignerForm(Designer).CheckOp(drDontEditReportScript) then
+ begin
+ Result := False;
+ Exit;
+ end;
+ if Value = '' then
+ begin
+ Value := frComponent.Name + GetName;
+ i := frxLocateEventHandler(Designer.Code, Designer.Report.ScriptLanguage,
+ Value);
+ if i = -1 then
+ i := frxAddEvent(Designer.Code, Designer.Report.ScriptLanguage,
+ PropInfo.PropType^, Value) else
+ Inc(i, 3);
+
+ if i = -1 then
+ begin
+ Value := '';
+ raise Exception.Create(frxResources.Get('dsCantFindProc'));
+ end;
+
+ TfrxDesignerForm(Designer).SwitchToCodeWindow;
+ TfrxDesignerForm(Designer).CodeWindow.UpdateView;
+ TfrxDesignerForm(Designer).CodeWindow.SetPos(3, i);
+ Result := True;
+ end
+ else
+ begin
+ i := frxLocateEventHandler(Designer.Code, Designer.Report.ScriptLanguage,
+ Value);
+
+ TfrxDesignerForm(Designer).SwitchToCodeWindow;
+ TfrxDesignerForm(Designer).CodeWindow.SetPos(1, i + 3);
+ Result := False;
+ end;
+end;
+
+function TfrxEventProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList];
+end;
+
+procedure TfrxEventProperty.GetValues;
+begin
+ inherited;
+ frxGetEventHandlersList(Designer.Code, Designer.Report.ScriptLanguage,
+ PropInfo.PropType^, Values);
+end;
+
+
+{ TfrxStringsProperty }
+
+function TfrxStringsProperty.Edit: Boolean;
+var
+ l: TStrings;
+begin
+ with TfrxStringsEditorForm.Create(Designer) do
+ begin
+ l := TStrings(GetOrdValue);
+ Memo.Lines.Assign(l);
+ Result := ShowModal = mrOk;
+ if Result then
+ l.Assign(Memo.Lines);
+ Free;
+ end;
+end;
+
+function TfrxStringsProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog, paReadOnly];
+end;
+
+
+{ TfrxBrushProperty }
+
+function TfrxBrushProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paOwnerDraw];
+end;
+
+procedure TfrxBrushProperty.OnDrawLBItem(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF);
+begin
+ inherited;
+// with TListBox(Control), TListBox(Control).Canvas do
+// begin
+// Brush.Style := TBrushStyle(Index);
+// Brush.Color := clBlack;
+// Rectangle(ARect.Left + 2, ARect.Top + 2, ARect.Left + (ARect.Bottom - ARect.Top - 2), ARect.Bottom - 2);
+// end;
+end;
+
+procedure TfrxBrushProperty.OnDrawItem(Canvas: TCanvas; ARect: TRectF);
+begin
+ inherited;
+// with Canvas do
+// begin
+// Brush.Style := TBrushStyle(GetOrdValue);
+// Brush.Color := clBlack;
+// Rectangle(ARect.Left, ARect.Top + 1, ARect.Left + (ARect.Bottom - ARect.Top - 5), ARect.Bottom - 4);
+// end;
+end;
+
+
+{ TfrxFrameStyleProperty }
+
+function TfrxFrameStyleProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paOwnerDraw];
+end;
+
+procedure HLine(Canvas: TCanvas; X, Y, DX: Integer);
+var
+ i: Integer;
+begin
+ with Canvas do
+ begin
+ Stroke.Color := claBlack;
+ if Stroke.Kind = TBrushKind.bkNone then
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+ for i := 0 to 1 do
+ DrawLine(PointF(X, Y - 2 + i * 2), PointF(X + DX, Y - 2 + i * 2), 1);
+ end
+ else
+ for i := 0 to 1 do
+ DrawLine(PointF(X, Y - 1 + i), PointF(X + DX, Y - 1 + i), 1);
+ end;
+end;
+
+procedure TfrxFrameStyleProperty.OnDrawLBItem(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF);
+begin
+// with TListBox(Control), TListBox(Control).Canvas do
+// begin
+// FillRect(ARect);
+// TextOut(ARect.Left + 40, ARect.Top + 1, TListBox(Control).Items[Index]);
+//
+// Pen.Color := clGray;
+// Brush.Color := clWhite;
+// Rectangle(ARect.Left + 2, ARect.Top + 2, ARect.Left + 36, ARect.Bottom - 2);
+//
+// Pen.Style := TPenStyle(Index);
+// HLine(TListBox(Control).Canvas, ARect.Left + 3, ARect.Top + (ARect.Bottom - ARect.Top) div 2, 32);
+// Pen.Style := psSolid;
+// end;
+end;
+
+procedure TfrxFrameStyleProperty.OnDrawItem(Canvas: TCanvas; ARect: TRectF);
+begin
+// with Canvas do
+// begin
+// TextOut(ARect.Left + 38, ARect.Top, Value);
+//
+// Pen.Color := clGray;
+// Brush.Color := clWhite;
+// Rectangle(ARect.Left, ARect.Top + 1, ARect.Left + 34, ARect.Bottom - 4);
+//
+// Pen.Color := clBlack;
+// Pen.Style := TPenStyle(GetOrdValue);
+// HLine(Canvas, ARect.Left + 1, ARect.Top + (ARect.Bottom - ARect.Top) div 2 - 1, 32);
+// Pen.Style := psSolid;
+// end;
+end;
+
+function TfrxFrameStyleProperty.GetExtraLBSize: Integer;
+begin
+ Result := 36;
+end;
+
+
+{ TfrxDisplayFormatProperty }
+
+function TfrxDisplayFormatProperty.Edit: Boolean;
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ with TfrxFormatEditorForm.Create(Designer) do
+ begin
+ Format.Assign(TfrxCustomMemoView(Component).DisplayFormat);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ for i := 0 to Self.Designer.SelectedObjects.Count - 1 do
+ begin
+ c := Self.Designer.SelectedObjects[i];
+ if (c is TfrxCustomMemoView) and not (rfDontModify in c.Restrictions) then
+ TfrxCustomMemoView(c).DisplayFormat := Format;
+ end;
+ Free;
+ end;
+end;
+
+function TfrxDisplayFormatProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog, paMultiSelect, paReadOnly];
+end;
+
+
+{ TfrxBooleanProperty }
+
+function TfrxBooleanProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paOwnerDraw];
+end;
+
+procedure TfrxBooleanProperty.OnDrawItem(Canvas: TCanvas; ARect: TRectF);
+var
+ add, i: Integer;
+begin
+ inherited;
+ with Canvas do
+ begin
+ Stroke.Color := claDimGray;
+ DrawRect(RectF(Round(ARect.Left) + 0.5, Round(ARect.Top) + 1.5, Round(ARect.Left + (ARect.Bottom - ARect.Top - 5)) - 0.5, Round(ARect.Bottom) - 4.5),
+ 0, 0, allCorners, 1);
+ Stroke.Color := claBlack;
+// if Screen.PixelsPerInch > 96 then
+// add := 2
+// else
+ add := 0;
+ if Boolean(GetOrdValue) = True then
+ begin
+ for i := 0 to 2 do
+ begin
+ DrawLine(PointF(Round(ARect.Left) + 2.5 + add, Round(ARect.Top) + 5.5 + add + i), PointF(Round(ARect.Left) + 4.5 + add, Round(ARect.Top) + 7.5 + add + i), 1);
+ DrawLine(PointF(Round(ARect.Left) + 4.5 + add, Round(ARect.Top) + 7.5 + add + i), PointF(Round(ARect.Left) + 8.5 + add, Round(ARect.Top) + 3.5 + add + i), 1);
+ end;
+ end;
+ end;
+end;
+
+procedure TfrxBooleanProperty.OnDrawLBItem(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF);
+var
+ add, i: Integer;
+begin
+ inherited;
+ with Canvas do
+ begin
+ Fill.Color := claWhite;
+ Fill.Kind := TBrushKind.bkSolid;
+ FillRect(RectF(ARect.Left + 2, ARect.Top + 2, ARect.Left + (ARect.Bottom - ARect.Top - 2), ARect.Bottom - 2),
+ 0, 0, allCorners, 1);
+ Stroke.Color := claDimGray;
+ Stroke.Kind := TBrushKind.bkSolid;
+ DrawRect(RectF(Round(ARect.Left) + 3.5, Round(ARect.Top) + 3.5, Round(ARect.Left + (ARect.Bottom - ARect.Top - 2)) - 0.5, Round(ARect.Bottom) - 2.5),
+ 0, 0, allCorners, 1);
+ Stroke.Color := claBlack;
+// if Screen.PixelsPerInch > 96 then
+// add := 2
+// else
+ add := 0;
+ if TListBoxItem(Sender).Text = 'True' then
+ begin
+ for i := 0 to 2 do
+ begin
+ DrawLine(PointF(Round(ARect.Left) + 5.5 + add, Round(ARect.Top) + 7.5 + add + i), PointF(Round(ARect.Left) + 7.5 + add, Round(ARect.Top) + 9.5 + add + i), 1);
+ DrawLine(PointF(Round(ARect.Left) + 7.5 + add, Round(ARect.Top) + 9.5 + add + i), PointF(Round(ARect.Left) + 11.5 + add, Round(ARect.Top) + 5.5 + add + i), 1);
+ end;
+ end;
+ end;
+end;
+
+
+{ TfrxPrinterProperty }
+
+function TfrxPrinterProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paValueList];
+end;
+
+procedure TfrxPrinterProperty.GetValues;
+begin
+ inherited;
+ Values.Assign(frxPrinters.Printers);
+ Values.Insert(0, frxResources.Get('prDefault'));
+end;
+
+
+{ TfrxPaperProperty }
+
+function TfrxPaperProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paValueList];
+end;
+
+function TfrxPaperProperty.GetValue: String;
+var
+ i: Integer;
+begin
+//{$IFDEF LINUX}
+ // Result := 'A4';
+//{$ELSE}
+ i := frxPrinters.Printer.PaperIndex(GetOrdValue);
+ if i = -1 then
+ i := frxPrinters.Printer.PaperIndex(256);
+ Result := frxPrinters.Printer.Papers[i];
+//{$ENDIF}
+end;
+
+procedure TfrxPaperProperty.GetValues;
+begin
+ inherited;
+ Values.Assign(frxPrinters.Printer.Papers);
+end;
+
+procedure TfrxPaperProperty.SetValue(const Value: String);
+begin
+ SetOrdValue(frxPrinters.Printer.PaperNameToNumber(Value));
+end;
+
+
+{ TfrxStyleProperty }
+
+function TfrxStyleProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paValueList, paMultiSelect];
+end;
+
+procedure TfrxStyleProperty.GetValues;
+begin
+ inherited;
+ Designer.Report.Styles.GetList(Values);
+end;
+
+
+{ TfrxColumnFooterEditor }
+
+function TfrxColumnFooterEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+begin
+// do nothing
+ Result := False;
+end;
+
+procedure TfrxColumnFooterEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+begin
+// do nothing
+end;
+
+{ TfrxColumnHeaderEditor }
+
+function TfrxColumnHeaderEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ b: TfrxBand;
+begin
+ Result := False;
+ b := Designer.SelectedObjects[0];
+ if not (rfDontModify in b.Restrictions) then
+ begin
+ case Tag of
+ 10: b.Stretched := Checked;
+ end;
+ Result := True;
+ end;
+end;
+
+procedure TfrxColumnHeaderEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ b: TfrxBand;
+begin
+ if Designer.SelectedObjects.Count > 1 then Exit;
+ inherited;
+ b := TfrxBand(Component);
+ AddItem(frxResources.Get('mvStretch'), 10, b.Stretched);
+end;
+
+{ TfrxOverlayEditor }
+
+function TfrxOverlayEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+begin
+ //do nothhing
+ Result := False;
+end;
+
+procedure TfrxOverlayEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+begin
+ //do nothhing
+end;
+
+initialization
+ frxObjects.RegisterObject1(TfrxMemoView, nil, '', '', 0, 102, [ctReport, ctData]);
+ frxObjects.RegisterObject1(TfrxPictureView, nil, '', '', 0, 103);
+ frxObjects.RegisterObject1(TfrxSubreport, nil, '', '', 0, 104, [ctReport, ctDMP]);
+ frxObjects.RegisterObject1(TfrxSysMemoView, nil, '', '', 0, 132);
+ frxObjects.RegisterCategory('Draw', nil, 'obCatDraw', 106);
+ frxObjects.RegisterCategory('Other', nil, 'obCatOther', 179);
+ {$IFDEF DB_CAT}
+ frxObjects.RegisterCategory('DATABASES',nil,'obDataBases',53);
+ frxObjects.RegisterCategory('TABLES',nil,'obTables',54);
+ frxObjects.RegisterCategory('QUERIES',nil,'obQueries',56);
+ {$ENDIF}
+ frxObjects.RegisterObject1(TfrxLineView, nil, '', 'Draw', 0, 105, [ctReport, ctData]);
+ frxObjects.RegisterObject1(TfrxLineView, nil, 'obDiagLine', 'Draw', 1, 107);
+ frxObjects.RegisterObject1(TfrxLineView, nil, 'obDiagLine', 'Draw', 2, 150);
+ frxObjects.RegisterObject1(TfrxLineView, nil, 'obDiagLine', 'Draw', 3, 151);
+ frxObjects.RegisterObject1(TfrxLineView, nil, 'obDiagLine', 'Draw', 4, 152);
+ frxObjects.RegisterObject1(TfrxShapeView, nil, 'obRect', 'Draw', 0, 108);
+ frxObjects.RegisterObject1(TfrxShapeView, nil, 'obRoundRect', 'Draw', 1, 109);
+ frxObjects.RegisterObject1(TfrxShapeView, nil, 'obEllipse', 'Draw', 2, 110);
+ frxObjects.RegisterObject1(TfrxShapeView, nil, 'obTrian', 'Draw', 3, 111);
+ frxObjects.RegisterObject1(TfrxShapeView, nil, 'obDiamond', 'Draw', 4, 131);
+
+ frxComponentEditors.Register(TfrxReportPage, TfrxPageEditor);
+ frxComponentEditors.Register(TfrxView, TfrxViewEditor);
+ frxComponentEditors.Register(TfrxMemoView, TfrxMemoEditor);
+ frxComponentEditors.Register(TfrxSysMemoView, TfrxSysMemoEditor);
+ frxComponentEditors.Register(TfrxDMPMemoView, TfrxMemoEditor);
+ frxComponentEditors.Register(TfrxLineView, TfrxLineEditor);
+ frxComponentEditors.Register(TfrxDMPLineView, TfrxLineEditor);
+ frxComponentEditors.Register(TfrxPictureView, TfrxPictureEditor);
+ frxComponentEditors.Register(TfrxBand, TfrxBandEditor);
+ frxComponentEditors.Register(TfrxDataBand, TfrxDataBandEditor);
+ frxComponentEditors.Register(TfrxHeader, TfrxHeaderEditor);
+ frxComponentEditors.Register(TfrxPageHeader, TfrxPageHeaderEditor);
+ frxComponentEditors.Register(TfrxPageFooter, TfrxPageFooterEditor);
+ frxComponentEditors.Register(TfrxGroupHeader, TfrxGroupHeaderEditor);
+ frxComponentEditors.Register(TfrxColumnHeader, TfrxColumnHeaderEditor);
+ frxComponentEditors.Register(TfrxColumnFooter, TfrxColumnFooterEditor);
+ frxComponentEditors.Register(TfrxOverlay, TfrxOverlayEditor);
+ frxComponentEditors.Register(TfrxDialogControl, TfrxDialogControlEditor);
+ frxComponentEditors.Register(TfrxSubreport, TfrxSubreportEditor);
+
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxComponent, 'Left', TfrxLocSizeXProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxComponent, 'Top', TfrxLocSizeYProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxComponent, 'Width', TfrxLocSizeXProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxComponent, 'Height', TfrxLocSizeYProperty);
+
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxReportPage, 'PaperWidth', TfrxPaperXProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxReportPage, 'PaperHeight', TfrxPaperYProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxReportPage, 'LeftMargin', TfrxPaperXProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxReportPage, 'RightMargin', TfrxPaperXProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxReportPage, 'TopMargin', TfrxPaperYProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxReportPage, 'BottomMargin', TfrxPaperYProperty);
+ frxPropertyEditors.Register(TypeInfo(Integer), TfrxReportPage, 'PaperSize', TfrxPaperProperty);
+
+ frxPropertyEditors.RegisterEventEditor(TfrxEventProperty);
+
+ frxPropertyEditors.Register(TypeInfo(Boolean), nil, '', TfrxBooleanProperty);
+ frxPropertyEditors.Register(TypeInfo(TfrxFrame), nil, '', TfrxFrameProperty);
+ frxPropertyEditors.Register(TypeInfo(TBitmap), nil, '', TfrxPictureProperty);
+ frxPropertyEditors.Register(TypeInfo(TBitmap), nil, '', TfrxBitmapProperty);
+ frxPropertyEditors.Register(TypeInfo(TfrxDataSet), nil, '', TfrxDataSetProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxView, 'DataField', TfrxDataFieldProperty);
+ frxPropertyEditors.Register(TypeInfo(TStrings), nil, '', TfrxStringsProperty);
+ frxPropertyEditors.Register(TypeInfo(TWideStrings), TfrxCustomMemoView, 'Memo', TfrxMemoProperty);
+ frxPropertyEditors.Register(TypeInfo(TBrushKind), nil, '', TfrxBrushProperty);
+ frxPropertyEditors.Register(TypeInfo(TfrxFrameStyle), nil, '', TfrxFrameStyleProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxMemoView, 'DisplayFormat', TfrxDisplayFormatProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxDMPMemoView, 'DisplayFormat', TfrxDisplayFormatProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxMemoView, 'Style', TfrxStyleProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxDataBand, 'ColumnWidth', TfrxLocSizeXProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxDataBand, 'ColumnGap', TfrxLocSizeXProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxPrintOptions, 'Printer', TfrxPrinterProperty);
+ frxPropertyEditors.Register(TypeInfo(Integer), TfrxPrintOptions, 'PrintOnSheet', TfrxPaperProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), nil, 'NextCrossGap', TfrxLocSizeXProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), nil, 'AddWidth', TfrxLocSizeXProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), nil, 'AddHeight', TfrxLocSizeYProperty);
+
+ frxHideProperties(TfrxReport, 'DefaultLanguage;IniFile;Name;Preview;ScriptLanguage;ScriptText;Tag;Variables;DataSetName;DotMatrixReport;OldStyleProgress;ShowProgress;StoreInDFM;ParentReport');
+ frxHideProperties(TfrxEngineOptions, 'NewSilentMode;MaxMemSize;PrintIfEmpty;SilentMode;TempDir;UseFileCache');
+ frxHideProperties(TfrxPreviewOptions, 'AllowEdit;Buttons;DoubleBuffered;Maximized;MDIChild;Modal;ShowCaptions;Zoom;ZoomMode');
+ frxHideProperties(TfrxReportOptions, 'CreateDate;LastChange;Compressed;Password');
+ frxHideProperties(TfrxReportPage, 'Bin;BinOtherPages;ColumnWidth;ColumnPositions;DataSetName;HGuides;VGuides');
+ frxHideProperties(TfrxDialogPage, 'Font');
+ frxHideProperties(TfrxDMPPage, 'BackPicture;Color;Font;Frame');
+ frxHideProperties(TfrxReportComponent, 'GroupIndex');
+ frxHideProperties(TfrxView, 'DataSetName');
+ frxHideProperties(TfrxBand, 'Vertical');
+ frxHideProperties(TfrxDataBand, 'DataSetName');
+ frxHideProperties(TfrxGroupHeader, 'DrillName');
+ frxHideProperties(TFont, 'Height;Pitch');
+ frxHideProperties(TfrxHighlight, 'Active');
+ frxHideProperties(TfrxPictureView, 'ImageIndex');
+ frxHideProperties(TfrxSubreport, 'Page');
+ frxHideProperties(TfrxDataPage, 'Left;Tag;Top;Visible');
+ frxHideProperties(TfrxCustomMemoView, 'FirstParaBreak;LastParaBreak');
+
+
+end.
diff --git a/LibD28/FMX.frxDesgnWorkspace.pas b/LibD28/FMX.frxDesgnWorkspace.pas
new file mode 100644
index 0000000..081671e
--- /dev/null
+++ b/LibD28/FMX.frxDesgnWorkspace.pas
@@ -0,0 +1,3102 @@
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Common designer workspace }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDesgnWorkspace;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.Types, System.UITypes, FMX.Platform, FMX.Controls, FMX.Objects, FMX.Types, FMX.Forms,
+ FMX.Dialogs, FMX.ExtCtrls, FMX.Memo, FMX.frxClass, System.Variants, System.UIConsts
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+ TfrxDesignMode = (dmSelect, dmInsert, dmDrag);
+ TfrxDesignMode1 = (dmNone, dmMove, dmSize, dmSizeBand, dmScale,
+ dmSelectionRect, dmInsertObject, dmInsertLine,
+ dmMoveGuide, dmContainer);
+ TfrxGridType = (gt1pt, gt1cm, gt1in, gtDialog, gtChar, gtNone);
+ TfrxCursorType = (ct0, ct1, ct2, ct3, ct4, ct5, ct6, ct7, ct8, ct9, ct10);
+ TfrxNotifyPositionEvent = procedure (ARect: TfrxRect) of object;
+ TfrxPopupEvent = procedure(Sender: TObject; X, Y: Single) of object;
+
+ TfrxInsertion = packed record
+ ComponentClass: TfrxComponentClass;
+ Left: Extended;
+ Top: Extended;
+ Width: Extended;
+ Height: Extended;
+ OriginalWidth: Extended;
+ OriginalHeight: Extended;
+ Flags: Word;
+ end;
+
+ TfrxDesignerWorkspace = class(TPanel)
+ protected
+ FBandHeader: Extended;
+ FCanvas: TCanvas;
+ FColor: TAlphaColor;
+ FCT: TfrxCursorType;
+ FDblClicked: Boolean;
+ FDisableUpdate: Boolean;
+ FFreeBandsPlacement: Boolean;
+ FGapBetweenBands: Integer;
+ FGridAlign: Boolean;
+ FGridLCD: Boolean;
+ FGridType: TfrxGridType;
+ FGridX: Extended;
+ FGridY: Extended;
+ FInplaceMemo: TMemo;
+ FInplaceObject: TfrxCustomMemoView;
+ FInsertion: TfrxInsertion;
+ FLastMousePointX: Extended;
+ FLastMousePointY: Extended;
+ FMargins: TRect;
+ FMarginsPanel: TPanel;
+ FMode: TfrxDesignMode;
+ FMode1: TfrxDesignMode1;
+ FModifyFlag: Boolean;
+ FMouseDown: Boolean;
+ FObjects: TList;
+ FOffsetX: Extended;
+ FOffsetY: Extended;
+ FPage: TfrxPage;
+ FPageHeight: Integer;
+ FPageWidth: Integer;
+ FScale: Extended;
+ FScaleRect: TfrxRect;
+ FScaleRect1: TfrxRect;
+ FSelectedObjects: TList;
+ FSavedAlign: TList;
+ FSelectionRect: TfrxRect;
+ FShowBandCaptions: Boolean;
+ FShowEdges: Boolean;
+ FShowGrid: Boolean;
+ FSizedBand: TfrxBand;
+ FOnModify: TNotifyEvent;
+ FOnEdit: TNotifyEvent;
+ FOnInsert: TNotifyEvent;
+ FOnNotifyPosition: TfrxNotifyPositionEvent;
+ FOnSelectionChanged: TNotifyEvent;
+ FDrawSelection: Boolean;
+ FDrawInsertion: Boolean;
+ FOnPopup: TfrxPopupEvent;
+ FFastCanvas: TCanvas;
+ FParentForm: TFmxObject;
+ procedure DoModify;
+ procedure AdjustBandHeight(Bnd: TfrxBand);
+ procedure CheckGuides(var kx, ky: Extended; var Result: Boolean); virtual;
+ procedure DoNudge(dx, dy: Extended; Smooth: Boolean);
+ procedure DoSize(dx, dy: Extended);
+ procedure DoStick(dx, dy: Integer);
+ procedure DoTab;
+ procedure DrawBackground;
+ procedure DrawCross;
+ procedure DrawInsertionRect;
+ procedure DrawObjects; virtual;
+ procedure DrawSelectionRect;
+ procedure FindNearest(dx, dy: Integer);
+ procedure MouseLeave;
+ procedure NormalizeCoord(c: TfrxComponent);
+ procedure NormalizeRect(var R: TfrxRect);
+ procedure SelectionChanged;
+ procedure SetScale(Value: Extended);
+ procedure SetShowBandCaptions(const Value: Boolean);
+ procedure UpdateBandHeader;
+ procedure DblClick; override;
+ procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
+ procedure KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
+ procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
+
+ // debug
+ procedure PrepareShiftTree(Band: TfrxBand);
+
+ procedure SetColor(const Value: TAlphaColor);
+ procedure SetGridType(const Value: TfrxGridType);
+ procedure SetOrigin(const Value: TPoint);
+ procedure SetParent(const Value: TFmxObject); override;
+ procedure SetShowGrid(const Value: Boolean);
+ function GetOrigin: TPoint;
+ function GetRightBottomObject: TfrxComponent;
+ function GetSelectionBounds: TfrxRect;
+ function ListsEqual(List1, List2: TList): Boolean;
+ function SelectedCount: Integer;
+ procedure DoDraw(ACanvas: TCanvas); virtual;
+ procedure DoDeactivate;{$IFDEF Delphi19} override;{$ENDIF}
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure DoPaint; override;
+ procedure AdjustBands(AttachObjects: Boolean = True);
+ procedure DeleteObjects; virtual;
+ procedure DisableUpdate;
+ procedure EnableUpdate;
+ procedure EditObject; virtual;
+ procedure GroupObjects;
+ procedure UngroupObjects;
+ procedure SetInsertion(AClass: TfrxComponentClass;
+ AWidth, AHeight: Extended; AFlag: Word); virtual;
+ procedure SetPageDimensions(AWidth, AHeight: Integer; AMargins: TRect);
+ procedure UpdateView;
+
+ property BandHeader: Extended read FBandHeader write FBandHeader;
+ property Color: TAlphaColor read FColor write SetColor;
+ property FastCanvas: TCanvas read FFastCanvas;
+ property FreeBandsPlacement: Boolean read FFreeBandsPlacement write FFreeBandsPlacement;
+ property GapBetweenBands: Integer read FGapBetweenBands write FGapBetweenBands;
+ property GridAlign: Boolean read FGridAlign write FGridAlign;
+ property GridLCD: Boolean read FGridLCD write FGridLCD;
+ property GridType: TfrxGridType read FGridType write SetGridType;
+ property GridX: Extended read FGridX write FGridX;
+ property GridY: Extended read FGridY write FGridY;
+ property Insertion: TfrxInsertion read FInsertion;
+ property IsMouseDown: Boolean read FMouseDown;
+ property Mode: TfrxDesignMode1 read FMode1;
+ property Objects: TList read FObjects write FObjects;
+ property OffsetX: Extended read FOffsetX write FOffsetX;
+ property OffsetY: Extended read FOffsetY write FOffsetY;
+ property Origin: TPoint read GetOrigin write SetOrigin;
+ property Page: TfrxPage read FPage write FPage;
+ property Scale: Extended read FScale write SetScale;
+ property SelectedObjects: TList read FSelectedObjects write FSelectedObjects;
+ property ShowBandCaptions: Boolean read FShowBandCaptions write SetShowBandCaptions;
+ property ShowEdges: Boolean read FShowEdges write FShowEdges;
+ property ShowGrid: Boolean read FShowGrid write SetShowGrid;
+ property OnModify: TNotifyEvent read FOnModify write FOnModify;
+ property OnEdit: TNotifyEvent read FOnEdit write FOnEdit;
+ property OnInsert: TNotifyEvent read FOnInsert write FOnInsert;
+ property OnNotifyPosition: TfrxNotifyPositionEvent read FOnNotifyPosition write
+ FOnNotifyPosition;
+ property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged write
+ FOnSelectionChanged;
+ property OnPopup: TfrxPopupEvent read FOnPopup write FOnPopup;
+ end;
+
+
+implementation
+
+uses FMX.frxRes, FMX.frxDMPClass, FMX.frxUtils, FMX.frxCtrls, FMX.frxFMX;
+
+const
+ DefFontName = 'Tahoma';
+
+
+type
+ TMarginsPanel = class(TPanel)
+ private
+ FColor: TAlphaColor;
+ protected
+ FWorkspace: TfrxDesignerWorkspace;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
+ procedure MouseMove(Shift: TShiftState; x, y: Single); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; x, y: Single); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure DoPaint; override;
+ property Color: TAlphaColor read FColor write FColor default claWhite;
+ end;
+
+ THackComponent = class(TfrxComponent);
+
+
+{ TMarginsPanel }
+
+constructor TMarginsPanel.Create(AOwner: TComponent);
+begin
+ inherited;
+ Color := claWhite;
+ StyleLookup := 'backgroundstyle';
+end;
+
+procedure TMarginsPanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+begin
+ inherited;
+ FWorkspace.MouseDown(Button, Shift, X - (FWorkspace.Left - Left),
+ Y - (FWorkspace.Top - Top));
+end;
+
+procedure TMarginsPanel.MouseMove(Shift: TShiftState; x, y: Single);
+begin
+ inherited;
+
+ if FWorkspace.FMode = dmSelect then
+ FWorkspace.MouseMove(Shift, X - (FWorkspace.Left - Left),
+ Y - (FWorkspace.Top - Top)) else
+ FWorkspace.MouseLeave;
+ Cursor := FWorkspace.Cursor;
+end;
+
+procedure TMarginsPanel.MouseUp(Button: TMouseButton; Shift: TShiftState; x, y: Single);
+begin
+ inherited;
+ FWorkspace.MouseUp(Button, Shift, X - (FWorkspace.Left - Left),
+ Y - (FWorkspace.Top - Top));
+end;
+
+procedure TMarginsPanel.DoPaint;
+var
+ r: TRectF;
+ poly: TPolygon;
+ Sstate: TCanvasSaveState;
+ oldM: TMatrix;
+begin
+ Sstate := Canvas.SaveState;
+ oldM := Canvas.Matrix;
+ try
+ Canvas.SetMatrix(CreateTranslateMatrix(AbsoluteRect.Left, AbsoluteRect.Top));
+
+ with Canvas do
+ begin
+ Fill.Color := Color;
+ Fill.Kind := TBrushKind.bkSolid;
+ Stroke.Color := $FF505050;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ Stroke.Kind := TBrushKind.bkSolid;
+
+ FillRect(RectF(0, 0, Self.Width - 1, Self.Height - 1), 1, 1, AllCorners, 1);
+ SetLength(poly, 4);
+ poly[0] := PointF(1, Self.Height - 1);
+ poly[1] := PointF(Self.Width - 1, Self.Height - 1);
+ poly[2] := PointF(Self.Width - 1, 1);
+ poly[3] := PointF(1, 1);
+ DrawPolygon(poly, 1);
+
+ Stroke.Color := claSilver;
+ with FWorkspace, FWorkspace.FMargins do
+ r := RectF(Round(Left * FScale) + 0.5, Round(Top * FScale) + 0.5,
+ Self.Width - Round(Right * FScale) + 1.5,
+ Self.Height - Round(Bottom * FScale) + 1.5);
+ SetLength(poly, 5);
+
+ poly[0] := PointF(r.Left - 1, r.Top - 1);
+ poly[1] := PointF(r.Left - 1, r.Bottom);
+ poly[2] := PointF(r.Right, r.Bottom);
+ poly[3] := PointF(r.Right, r.Top - 1);
+ poly[4] := PointF(r.Left - 1, r.Top - 1);
+{$IFDEF Delphi25}
+ Stroke.Dash := TStrokeDash.sdDash;
+{$ELSE}
+ StrokeDash := TStrokeDash.sdDash;
+{$ENDIF}
+ DrawPolygon(poly, 1);
+ end;
+ finally
+ Canvas.SetMatrix(oldM);
+ Canvas.RestoreState(sstate);
+ end;
+end;
+
+
+{ TfrxDesignerWorkspace }
+
+constructor TfrxDesignerWorkspace.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FSavedAlign := TList.Create;
+ FDrawSelection := False;
+ FMarginsPanel := TMarginsPanel.Create(AOwner);
+ TMarginsPanel(FMarginsPanel).FWorkspace := Self;
+
+ FBandHeader := fr01cm * 5;
+ FColor := claWhite;
+ FGridAlign := True;
+ FGridType := gt1cm;
+ FGridX := fr01cm;
+ FGridY := fr01cm;
+ FMode := dmSelect;
+ FMode1 := dmNone;
+ FScale := 1;
+ FShowGrid := True;
+ FShowEdges := True;
+ FGridLCD := True;
+ StyleLookup := 'backgroundstyle';
+ CanFocus := True;
+ AutoCapture := True;
+ FFastCanvas := nil;
+ FParentForm := nil;
+ if frxCanvasClass <> nil then
+ FFastCanvas := frxCanvasClass.Create;
+end;
+
+destructor TfrxDesignerWorkspace.Destroy;
+begin
+ FSavedAlign.Free;
+ FreeAndNil(FFastCanvas);
+ inherited;
+end;
+
+procedure TfrxDesignerWorkspace.SetParent(const Value: TFmxObject);
+begin
+ if not (csDestroying in ComponentState) then
+ FMarginsPanel.Parent := Value;
+ inherited;
+ FParentForm := nil;
+end;
+
+procedure TfrxDesignerWorkspace.DisableUpdate;
+begin
+ FDisableUpdate := True;
+ FMode := dmSelect;
+ FMode1 := dmNone;
+end;
+
+procedure TfrxDesignerWorkspace.EnableUpdate;
+begin
+ FDisableUpdate := False;
+end;
+
+procedure TfrxDesignerWorkspace.UpdateView;
+var
+ NotifyRect: TfrxRect;
+begin
+ Repaint;
+ if SelectedCount = 0 then
+ NotifyRect := frxRect(0, 0, 0, 0) else
+ NotifyRect := GetSelectionBounds;
+ if Assigned(FOnNotifyPosition) then
+ FOnNotifyPosition(NotifyRect);
+end;
+
+procedure TfrxDesignerWorkspace.SetInsertion(AClass: TfrxComponentClass;
+ AWidth, AHeight: Extended; AFlag: Word);
+begin
+ with FInsertion do
+ begin
+ ComponentClass := AClass;
+ Width := AWidth;
+ Height := AHeight;
+ OriginalWidth := AWidth;
+ OriginalHeight := AHeight;
+ Flags := AFlag;
+ end;
+
+ FMode := dmInsert;
+ if AClass = nil then
+ begin
+ Cursor := crDefault;
+ FMode := dmSelect;
+ FMode1 := dmNone;
+ end
+ else if AClass.InheritsFrom(TfrxCustomLineView) then
+ begin
+ FMode1 := dmInsertLine;
+ if FGridType = gtChar then
+ begin
+ FInsertion.Left := - FGridX / 2;
+ FInsertion.Top := - FGridY / 2;
+ end
+ else
+ begin
+ FInsertion.Left := - FGridX;
+ FInsertion.Top := - FGridY;
+ end;
+ end
+ else
+ begin
+ Cursor := crCross;
+ FMode1 := dmInsertObject;
+ FInsertion.Left := -1000 * FGridX;
+ FInsertion.Top := -1000 * FGridY;
+ end;
+end;
+
+procedure TfrxDesignerWorkspace.SetScale(Value: Extended);
+begin
+ FScale := Value;
+ FMarginsPanel.Width := Round(FPageWidth * FScale);
+ FMarginsPanel.Height := Round(FPageHeight * FScale);
+
+ SetBounds(FMarginsPanel.Position.X + Round(FMargins.Left * FScale),
+ FMarginsPanel.Position.Y + Round(FMargins.Top * FScale),
+ FMarginsPanel.Width - Round((FMargins.Left + FMargins.Right - 1) * FScale),
+ FMarginsPanel.Height - Round((FMargins.Top + FMargins.Bottom - 1) * FScale));
+
+ FMarginsPanel.Repaint;
+ Repaint;
+end;
+
+procedure TfrxDesignerWorkspace.SetPageDimensions(AWidth, AHeight: Integer;
+ AMargins: TRect);
+begin
+ FPageWidth := AWidth;
+ FPageHeight := AHeight;
+ FMargins := AMargins;
+ SetScale(FScale);
+ AdjustBands;
+ Resize;
+{$IFNDEF Delphi17}
+ if Parent is TControl then
+ TControl(Parent).Realign;
+{$ENDIF}
+end;
+
+procedure TfrxDesignerWorkspace.SetShowGrid(const Value: Boolean);
+begin
+ FShowGrid := Value;
+ Repaint;
+end;
+
+procedure TfrxDesignerWorkspace.UpdateBandHeader;
+begin
+ case FGridType of
+ gt1pt, gtDialog:
+ FBandHeader := 16;
+ gt1cm:
+ FBandHeader := fr01cm * 5;
+ gt1in:
+ FBandHeader := fr01in * 2;
+ gtChar:
+ FBandHeader := fr1CharY;
+ end;
+
+ if not FShowBandCaptions then
+ FBandHeader := 0;
+end;
+
+procedure TfrxDesignerWorkspace.SetGridType(const Value: TfrxGridType);
+begin
+ FGridType := Value;
+ UpdateBandHeader;
+ if FSelectedObjects.Count <> 0 then
+ MouseMove([], 0, 0);
+ AdjustBands;
+ Repaint;
+end;
+
+procedure TfrxDesignerWorkspace.SetShowBandCaptions(const Value: Boolean);
+begin
+ FShowBandCaptions := Value;
+ UpdateBandHeader;
+ AdjustBands;
+ Repaint;
+end;
+
+function TfrxDesignerWorkspace.GetOrigin: TPoint;
+begin
+ Result.X := Round(FMarginsPanel.Position.X);
+ Result.Y := Round(FMarginsPanel.Position.Y);
+end;
+
+procedure TfrxDesignerWorkspace.SetOrigin(const Value: TPoint);
+begin
+ FMarginsPanel.Position.X := Value.X;
+ FMarginsPanel.Position.Y := Value.Y;
+end;
+
+procedure TfrxDesignerWorkspace.SetColor(const Value: TAlphaColor);
+begin
+ FColor := Value;
+end;
+
+procedure TfrxDesignerWorkspace.DoDeactivate;
+begin
+ inherited;
+ if FMouseDown then
+ MouseUp(TMouseButton.mbLeft, [], FLastMousePointX * FScale, FLastMousePointY * FScale);
+end;
+
+procedure TfrxDesignerWorkspace.DoDraw(ACanvas: TCanvas);
+begin
+ ACanvas.Fill.Color := FColor;
+ ACanvas.Fill.Kind := TBrushKind.bkSolid;
+ DrawBackground;
+ if not FDisableUpdate then
+ begin
+ if (FPage <> nil) and (FPage is TfrxReportPage) then
+ TfrxReportPage(FPage).Draw(ACanvas, FScale, FScale,
+ -FMargins.Left * FScale, -FMargins.Top * FScale);
+ DrawObjects;
+ end;
+ DrawSelectionRect;
+ DrawInsertionRect;
+ DrawCross;
+end;
+
+procedure TfrxDesignerWorkspace.DoModify;
+begin
+ if FModifyFlag then
+ if Assigned(FOnModify) then
+ FOnModify(Self);
+ FModifyFlag := False;
+end;
+
+procedure TfrxDesignerWorkspace.SelectionChanged;
+var
+ i, j: Integer;
+ c, c1: TfrxComponent;
+begin
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if (c is TfrxReportComponent) and (c.GroupIndex <> 0) then
+ for j := 0 to FObjects.Count - 1 do
+ begin
+ c1 := FObjects[j];
+ if (c1 is TfrxReportComponent) and (c1.GroupIndex = c.GroupIndex) then
+ begin
+ if FSelectedObjects.IndexOf(c1) = -1 then
+ FSelectedObjects.Add(c1);
+ end;
+ end;
+ end;
+
+ if Assigned(FOnSelectionChanged) then
+ FOnSelectionChanged(Self);
+ Repaint;
+end;
+
+function TfrxDesignerWorkspace.GetSelectionBounds: TfrxRect;
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ if SelectedCount = 1 then
+ begin
+ with TfrxComponent(FSelectedObjects[0]) do
+ Result := frxRect(Left, Top, Width, Height);
+ Exit;
+ end;
+
+ Result := frxRect(1e10, 1e10, -1e10, -1e10);
+
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+
+ if c.AbsLeft < Result.Left then
+ Result.Left := c.AbsLeft;
+ if c.AbsTop < Result.Top then
+ Result.Top := c.AbsTop;
+ if c.AbsLeft + c.Width > Result.Right then
+ Result.Right := c.AbsLeft + c.Width;
+ if c.AbsTop + c.Height > Result.Bottom then
+ Result.Bottom := c.AbsTop + c.Height;
+ end;
+
+ with Result do
+ Result := frxRect(Left, Top, Right - Left, Bottom - Top);
+end;
+
+function TfrxDesignerWorkspace.GetRightBottomObject: TfrxComponent;
+var
+ i: Integer;
+ c: TfrxComponent;
+ maxx, maxy: Extended;
+begin
+ maxx := 0;
+ maxy := 0;
+ Result := nil;
+
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if (c.AbsLeft + c.Width > maxx) or
+ ((c.AbsLeft + c.Width = maxx) and (c.AbsTop + c.Height > maxy)) then
+ begin
+ maxx := c.AbsLeft + c.Width;
+ maxy := c.AbsTop + c.Height;
+ Result := c;
+ end;
+ end;
+end;
+
+function TfrxDesignerWorkspace.SelectedCount: Integer;
+begin
+ Result := FSelectedObjects.Count;
+ if (Result = 1) and
+ ((FSelectedObjects[0] = FPage) or (TObject(FSelectedObjects[0]) is TfrxReport)) then
+ Result := 0;
+end;
+
+procedure TfrxDesignerWorkspace.DoPaint;
+var
+ Sstate: TCanvasSaveState;
+ oldM: TMatrix;
+begin
+ FCanvas := Canvas;
+ Sstate := FCanvas.SaveState;
+ oldM := FCanvas.Matrix;
+ try
+ FCanvas.SetMatrix(CreateTranslateMatrix(AbsoluteRect.Left, AbsoluteRect.Top));
+ DoDraw(FCanvas);
+ finally
+ FCanvas.SetMatrix(oldM);
+ FCanvas.RestoreState(Sstate);
+ end;
+ FCanvas := nil;
+end;
+
+procedure TfrxDesignerWorkspace.DrawObjects;
+var
+ i: Integer;
+ c: TfrxComponent;
+
+ procedure DrawPoint(x, y: Extended);
+ var
+ i, w: Integer;
+ begin
+ if FScale > 1.7 then
+ w := 7
+ else if FScale < 0.7 then
+ w := 3 else
+ w := 5;
+ for i := 0 to w - 1 do
+ begin
+ FCanvas.DrawLine(
+ PointF(Round(x * FScale - w div 2) + 0.5, Round(y * FScale - w div 2 + i) + 0.5),
+ PointF(Round(x * FScale + w div 2) + 0.5, Round(y * FScale - w div 2 + i) + 0.5), 1);
+ end;
+ end;
+
+ procedure DrawLineA(x, y, dx, dy: Extended);
+ begin
+ FCanvas.DrawLine(PointF(Round(x * FScale) + 0.5, Round(y * FScale) + 0.5),
+ PointF(Round((x + dx) * FScale) + 0.5, Round((y + dy) * FScale) + 0.5), 1);
+ end;
+
+ procedure DrawSqares(c: TfrxComponent);
+ var
+ px, py: Extended;
+ begin
+ with c, FCanvas do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ Stroke.Color := claBlack;
+ px := AbsLeft + c.Width / 2;
+ py := AbsTop + c.Height / 2;
+
+ DrawPoint(AbsLeft, AbsTop);
+ if not (c is TfrxCustomLineView) then
+ begin
+ DrawPoint(AbsLeft + c.Width, AbsTop);
+ DrawPoint(AbsLeft, AbsTop + c.Height);
+ end;
+ if (SelectedCount > 1) and (c = GetRightBottomObject) then
+ Stroke.Color := claTeal;
+ DrawPoint(AbsLeft + c.Width, AbsTop + c.Height);
+
+ Stroke.Color := claBlack;
+ if (SelectedCount = 1) and not (c is TfrxCustomLineView) then
+ begin
+ DrawPoint(px, AbsTop); DrawPoint(px, AbsTop + c.Height);
+ DrawPoint(AbsLeft, py); DrawPoint(AbsLeft + c.Width, py);
+ end;
+ end;
+ end;
+
+ procedure DrawDialogPageSquares;
+ begin
+ with FCanvas, TfrxDialogPage(FPage) do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ Stroke.Color := claBlack;
+
+ DrawPoint(ClientWidth - 2, ClientHeight - 2);
+ DrawPoint(ClientWidth - 2, ClientHeight / 2 - 1);
+ DrawPoint(ClientWidth / 2 - 1, ClientHeight - 2);
+ end;
+ end;
+
+ procedure DrawScriptSign(c: TfrxReportComponent);
+ var
+ NeedDraw: Boolean;
+ Offs: Extended;
+ begin
+ NeedDraw := False;
+ Offs := 0;
+ if c is TfrxReportComponent then
+ with c do
+ if (OnBeforePrint <> '') or (OnAfterPrint <> '') or
+ (OnAfterData <> '') or (OnPreviewClick <> '') then
+ NeedDraw := True;
+ if c is TfrxDialogControl then
+ with TfrxDialogControl(c) do
+ if (OnClick <> '') or (OnDblClick <> '') or
+ (OnEnter <> '') or (OnExit <> '') or
+ (OnKeyDown <> '') or (OnKeyPress <> '') or
+ (OnKeyUp <> '') or (OnMouseDown <> '') or
+ (OnMouseMove <> '') or (OnMouseUp <> '') then
+ NeedDraw := True;
+ if c is TfrxBand then
+ with TfrxBand(c) do
+ begin
+ if (OnAfterCalcHeight <> '') then
+ NeedDraw := True;
+ if not Vertical then
+ Offs := -FBandHeader + 2;
+ end;
+
+ if NeedDraw then
+ with c, FCanvas do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := claRed;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ DrawLineA(AbsLeft + 2, AbsTop + Offs + 1, 0, 7);
+ DrawLineA(AbsLeft + 3, AbsTop + Offs + 2, 0, 5);
+ DrawLineA(AbsLeft + 4, AbsTop + Offs + 3, 0, 3);
+ DrawLineA(AbsLeft + 5, AbsTop + Offs + 4, 0, 1);
+ end;
+ end;
+
+ procedure DrawObject(c: TfrxReportComponent);
+ var
+ s: String;
+ i, x: Integer;
+ y, w: Single;
+ d: TfrxDataBand;
+ MatrixR: TMatrix;
+ StateSave: TCanvasSaveState;
+ bName: String;
+ begin
+ c.IsDesigning := True;
+ if c is TfrxView then
+ TfrxView(c).SetFastCanvas(FFastCanvas);
+ c.Draw(FCanvas, FScale, FScale, FOffsetX, FOffsetY);
+ if c is TfrxBand then
+ with c as TfrxBand, FCanvas do
+ begin
+ if Vertical then
+ begin
+ Top := 0;
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := claGray;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ Fill.Kind := TBrushKind.bkSolid;
+ x := Round((Left - FBandHeader) * FScale);
+ DrawRect(RectF(x, 0, Round((Left + c.Width) * FScale) + 1, Round((c.Height) * FScale)), 1, 1, AllCorners, 1, TCornerType.ctBevel);
+
+ if FShowBandCaptions then
+ begin
+ Fill.Kind := TBrushKind.bkSolid;
+ if c is TfrxDataBand then
+ Fill.Color := $FFEEBB00 else
+ Fill.Color := claGray;
+ FillRect(RectF(x + 1, 1, Round(Left * FScale), Round(c.Height * FScale)), 1, 1, AllCorners, 1, TCornerType.ctBevel);
+ end;
+
+ Font.Family := DefFontName;
+ Font.Size := Round(8 * FScale);
+ Font.Style := [];
+ MatrixR := CreateRotationMatrix(90);
+ StateSave := SaveState;
+ y := TextWidth(Name) + 4;
+ FillText(RectF(x + 2, y, 20, y * 2), Name, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ Font.Style := [TFontStyle.fsBold];
+ bName := frxResources.Get(BandName);
+ FillText(RectF(x + 2, y + TextWidth(bName + ': ') + 2, 20, (y + TextWidth(bName + ': ') + 2) * 2), bName + ': ', False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ RestoreState(StateSave);
+ end
+ else
+ begin
+ Left := 0;
+ //if (Page is TfrxReportPage) and (TfrxReportPage(Page).Columns > 1) then
+ //if BandNumber in [4..16] then
+ //Width := TfrxReportPage(Page).ColumnWidth * fr01cm;
+ //todo
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := claGray;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ Fill.Kind := TBrushKind.bkNone;
+ y := Round((Top - FBandHeader) * FScale);
+ DrawRect(RectF(0.5, y + 0.5, Round(c.Width * FScale) + 0.5, Round((c.Top + c.Height) * FScale) + 0.5), 1, 1, AllCorners, 1);
+
+ if FShowBandCaptions then
+ begin
+ Fill.Kind := TBrushKind.bkSolid;
+ if c is TfrxDataBand then
+ Fill.Color := $FFE0A730
+ else
+ Fill.Color := claLightgray;
+ FillRect(RectF(1, y + 1, Round(c.Width * FScale), Round(c.Top * FScale)), 1, 1, AllCorners, 1, TCornerType.ctBevel);
+ end;
+
+ Font.Family := DefFontName;
+ Font.Size := Round(10 * FScale);
+ Font.Style := [TFontStyle.fsBold];
+ bName := frxResources.Get(BandName);
+ Fill.Kind := TBrushKind.bkSolid;
+ Fill.Color := claBlack;
+ FillText(RectF(6, y + 2, c.Width, y + 22), bName, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+
+ w := TextWidth(bName);
+ Font.Style := [];
+ FillText(RectF(6 + w, y + 2, c.Width, y + 22), ': ' + Name, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+
+ if c is TfrxDataBand then
+ begin
+ d := TfrxDataBand(c);
+
+ if FShowBandCaptions then
+ begin
+ if (d.DataSet <> nil) and (c.Report <> nil) then
+ s := c.Report.GetAlias(d.DataSet)
+ else if d.RowCount <> 0 then
+ s := IntToStr(d.RowCount)
+ else
+ s := '';
+ w := TextWidth(s);
+ //if FScale > 0.7 then
+ // frxResources.MainButtonImages.Draw(FCanvas,
+ // Round(Width * FScale - w - 24), Round(y + 2 * FScale), 53);
+ if s <> '' then
+ FillText(RectF(c.Width * FScale - w - 3, y + 3, c.Width, (y + 3) * 2), s, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ end;
+
+ if d.Columns > 1 then
+ begin
+{$IFDEF Delphi25}
+ Stroke.Dash := TStrokeDash.sdDot;
+{$ELSE}
+ StrokeDash := TStrokeDash.sdDot;
+{$ENDIF}
+ Stroke.Color := claBlack;
+ Fill.Kind := TBrushKind.bkNone;
+ for i := 1 to d.Columns do
+ DrawRect(RectF((i - 1) * (d.ColumnWidth + d.ColumnGap) * FScale, Top * FScale, ((i - 1) * (d.ColumnWidth + d.ColumnGap) + d.ColumnWidth) * FScale, (Top + c.Height) * FScale), 1, 1, AllCorners, 1, TCornerType.ctBevel);
+ end;
+ end;
+ if c is TfrxGroupHeader then
+ begin
+ s := TfrxGroupHeader(c).Condition;
+ if s <> '' then
+ if FShowBandCaptions then
+ FillText(RectF(c.Width * FScale - TextWidth(s) - 3, y + 3, 20, (c.Width * FScale - TextWidth(s) - 3) * 2), s, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ end;
+ end
+ end
+ else if not (c is TfrxCustomLineView) and not (c is TfrxDialogComponent) and
+ not (c is TfrxDialogControl) then
+ with c, FCanvas do
+ if FShowEdges and not (FPage is TfrxDataPage) and (c is TfrxView) and
+ (TfrxView(c).Frame.Typ <> [ftLeft, ftRight, ftTop, ftBottom]) then
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := claBlack;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ DrawLineA(AbsLeft, AbsTop + 3, 0, -3);
+ DrawLineA(AbsLeft, AbsTop, 4, 0);
+ DrawLineA(AbsLeft, AbsTop + c.Height - 3, 0, 3);
+ DrawLineA(AbsLeft, AbsTop + c.Height, 4, 0);
+ DrawLineA(AbsLeft + c.Width - 3, AbsTop, 3, 0);
+ DrawLineA(AbsLeft + c.Width, AbsTop, 0, 4);
+ DrawLineA(AbsLeft + c.Width - 3, AbsTop + c.Height, 3, 0);
+ DrawLineA(AbsLeft + c.Width, AbsTop + c.Height, 0, -4);
+ end;
+ if c is TfrxView then
+ TfrxView(c).SetFastCanvas(nil);
+ DrawScriptSign(c);
+
+{ if c.IsAncestor then
+ frxResources.MainButtonImages.Draw(FCanvas,
+ Round((c.AbsLeft + 2) * FScale), Round((c.AbsTop + 1) * FScale), 99);}
+ end;
+
+ // debug
+ procedure DrawShiftTree(c: TfrxReportComponent);
+ var
+ i: Integer;
+ c1: TfrxReportComponent;
+ begin
+ for i := 0 to c.FShiftChildren.Count - 1 do
+ begin
+ c1 := c.FShiftChildren[i];
+ with FCanvas do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := claRed;
+ //Pen.Mode := pmCopy;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ if c is TfrxBand then
+ DrawLine(PointF(c.AbsLeft + c.Width / 2, c.AbsTop), PointF(c1.AbsLeft + c1.Width / 2, c1.AbsTop), 1)
+ else
+ DrawLine(PointF(c.AbsLeft + c.Width / 2, c.AbsTop + c.Height), PointF(c1.AbsLeft + c1.Width / 2, c1.AbsTop), 1);
+ end;
+ DrawShiftTree(c1);
+ end;
+ end;
+
+
+begin
+ if Assigned(FFastCanvas)then
+ begin
+ TfrxFastCanvasLayer(FFastCanvas).UpdateHandle(Parent);
+ TfrxFastCanvasLayer(FFastCanvas).Canvas := Canvas;
+ end;
+ { update aligned objects }
+ if Page is TfrxReportPage then
+ Page.AlignChildren;
+
+ { draw objects }
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if c is TfrxReportComponent then
+ DrawObject(TfrxReportComponent(c));
+ end;
+
+ // debug
+{ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if c is TfrxBand then
+ begin
+ PrepareShiftTree(TfrxBand(c));
+ DrawShiftTree(TfrxReportComponent(c));
+ end;
+ end;}
+
+
+ { draw selection }
+ for i := 0 to SelectedCount - 1 do
+ if not FMouseDown then
+ DrawSqares(FSelectedObjects[i]);
+ if (FSelectedObjects.Count = 1) and (TObject(FSelectedObjects[0]) is TfrxDialogPage) then
+ DrawDialogPageSquares;
+end;
+
+procedure TfrxDesignerWorkspace.DrawBackground;
+
+ procedure Line(x, y, x1, y1: Extended);
+ begin
+ FCanvas.DrawLine(PointF(x, y), PointF(x1, y1), 1);
+ end;
+
+ procedure DrawPoints;
+ var
+ GridBmp: TBitmap;
+{$IFDEF Delphi17}
+ map: TBitmapData;
+{$ENDIF}
+ i: Extended;
+ c: TAlphaColor;
+ dx, dy: Extended;
+ begin
+ if FGridType = gtDialog then
+ c := claBlack else
+ c := claGray;
+ dx := FGridX * FScale;
+ dy := FGridY * FScale;
+ if (dx > 2) and (dy > 2) then
+ begin
+ GridBmp := TBitmap.Create(Round(Width), 1);
+
+ GridBmp.Canvas.BeginScene();
+ GridBmp.Canvas.Stroke.Color := FColor;
+ GridBmp.Canvas.DrawLine(PointF(0, 0), PointF(Width, 0), 1);
+
+{$IFDEF Delphi17}
+ if GridBmp.Map(TMapAccess.maReadWrite, map) then
+ begin
+ i := 0;
+ while i < Width do
+ begin
+ map.SetPixel(Round(i), 0, c);
+ i := i + dx;
+ end;
+ GridBmp.UnMap(map);
+ end;
+{$ELSE}
+ i := 0;
+ while i < Width do
+ begin
+ GridBmp.Pixels[Round(i), 0] := c;
+ i := i + dx;
+ end;
+{$ENDIF}
+
+ GridBmp.Canvas.EndScene;
+ i := 0;
+ while i < Height do
+ begin
+ FCanvas.DrawBitmap(GridBmp, RectF(0, 0, Width, 1), RectF(0, i, Width, i + 1), 1, True);
+ i := i + dy;
+ end;
+
+ GridBmp.Free;
+ end;
+ end;
+
+ procedure DrawMM;
+ var
+ i, dx, maxi: Extended;
+ i1: Integer;
+ Color5, Color10: TAlphaColor;
+ SState: TCanvasSaveState;
+ begin
+ if FGridLCD then
+ begin
+ Color5 := $FFF2F2F2;
+ Color10 := $FFE2E2E2;
+ end
+ else
+ begin
+ Color5 := $FFF8F8F8;
+ Color10 := $FFE8E8E8;
+ end;
+
+ with FCanvas do
+ begin
+ SState := SaveState;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ Stroke.Kind := TBrushKind.bkSolid;
+ Canvas.IntersectClipRect(RectF(0,0,(Self.FPageWidth - (FMargins.Left + FMargins.Right)) * FScale, (Self.FPageHeight - (FMargins.Top + FMargins.Bottom)) * FScale));
+ if FGridType = gt1cm then
+ dx := fr01cm * FScale else
+ dx := fr01in * FScale;
+
+ if Self.Width > Self.Height then
+ maxi := Self.FPageWidth * FScale else
+ maxi := Self.FPageHeight * FScale;
+
+ i := 0;
+ i1 := 0;
+ while i < maxi do
+ begin
+ if i1 mod 10 = 0 then
+ Stroke.Color := Color10
+ else if i1 mod 5 = 0 then
+ Stroke.Color := Color5
+ else if FGridType = gt1in then
+ Stroke.Color := Color5
+ else
+ Stroke.Color := claWhite;
+ if Stroke.Color <> claWhite then
+ begin
+ if Self.Width >= Round(i) then
+ Line(Round(i) + 0.5, 0, Round(i) + 0.5, Round(Self.FPageHeight) * FScale);
+ if Self.Height >= Round(i) then
+ Line(0, Round(i) + 0.5, Round(Self.FPageWidth) * FScale, Round(i) + 0.5);
+ end;
+ i := i + dx;
+ Inc(i1);
+ end;
+ RestoreState(SState);
+ end;
+ end;
+
+begin
+ FCanvas.Fill.Color := FColor;
+ FCanvas.Fill.Kind := TBrushKind.bkSolid;
+ FCanvas.FillRect(RectF(0, 0, Width, Height), 1, 1, AllCorners, 1, TCornerType.ctBevel);
+
+ if FShowGrid then
+ case FGridType of
+ gt1pt, gtDialog, gtChar:
+ DrawPoints;
+ gt1cm, gt1in:
+ DrawMM;
+ end;
+end;
+
+procedure TfrxDesignerWorkspace.DrawSelectionRect;
+var
+ sLeft, sTop, sRight, sBottom: Single;
+begin
+ if not FDrawSelection then Exit;
+
+ with Canvas do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := claBlack;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+ Stroke.Dash := TStrokeDash.sdDot;
+{$ELSE}
+ StrokeThickness := 1;
+ StrokeDash := TStrokeDash.sdDot;
+{$ENDIF}
+ Fill.Kind := TBrushKind.bkNone;
+ with FSelectionRect do
+ begin
+ sLeft := Left;
+ sRight := Right;
+ sTop := Top;
+ sBottom := Bottom;
+ if Right < Left then
+ begin
+ sLeft := Right;
+ sRight := Left;
+ end;
+ if Bottom < Top then
+ begin
+ sTop := Bottom;
+ sBottom := Top;
+ end;
+ end;
+
+ DrawRect(RectF(Round(sLeft) + 0.5, Round(sTop) + 0.5, Round(sRight) + 0.5, Round(sBottom) + 0.5), 1, 1, AllCorners, 0.5);
+ Fill.Kind := TBrushKind.bkSolid;
+ end;
+end;
+
+procedure TfrxDesignerWorkspace.DrawInsertionRect;
+var
+ R: TfrxRect;
+begin
+ if not FDrawInsertion then Exit;
+
+ with Canvas do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := claBlack;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+ Stroke.Dash := TStrokeDash.sdDot;
+{$ELSE}
+ StrokeThickness := 1;
+ StrokeDash := TStrokeDash.sdDot;
+{$ENDIF}
+ with FInsertion do
+ R := frxRect(Left, Top, Left + FInsertion.Width, Top + FInsertion.Height);
+ NormalizeRect(R);
+ DrawRect(RectF(Round(R.Left * FScale) + 0.5, Round(R.Top * FScale) + 0.5, Round(R.Right * FScale) + 0.5, Round(R.Bottom * FScale) + 0.5), 1, 1, AllCorners, 1);
+ end;
+end;
+
+procedure TfrxDesignerWorkspace.DrawCross;
+var
+ x, y: Extended;
+begin
+ if FMode1 <> dmInsertLine then
+ Exit;
+
+ with FInsertion do
+ if FMouseDown then
+ begin
+ if Flags <> 0 then
+ begin
+ x := (Left + Width) * FScale;
+ y := (Top + Height) * FScale;
+ end
+ else if Abs(Width) > Abs(Height) then
+ begin
+ x := (Left + Width) * FScale;
+ y := Top * FScale;
+ end
+ else
+ begin
+ x := Left * FScale;
+ y := (Top + Height) * FScale;
+ end;
+ end
+ else
+ begin
+ x := Left * FScale;
+ y := Top * FScale;
+ end;
+
+ with Canvas do
+ begin
+ Stroke.Color := claBlack;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ Stroke.Kind := TBrushKind.bkSolid;
+
+ DrawLine(PointF(Round(x) - 3.5, Round(y) + 0.5), PointF(Round(x) + 4.5, Round(y) + 0.5), 1);
+ DrawLine(PointF(Round(x) + 0.5, Round(y) - 3.5), PointF(Round(x) + 0.5, Round(y) + 4.5), 1);
+
+ if FMouseDown then
+ DrawLine(PointF(Round(FInsertion.Left * FScale) + 0.5, Round(FInsertion.Top * FScale) + 0.5),
+ PointF(Round(x) + 0.5, Round(y) + 0.5), 1);
+ end;
+end;
+
+procedure TfrxDesignerWorkspace.FindNearest(dx, dy: Integer);
+var
+ i: Integer;
+ c, sel, found: TfrxComponent;
+ min, dist, dist_dx, dist_dy: Extended;
+ r1, r2, r3: TfrxRect;
+
+ function RectsIntersect(r1, r2: TfrxRect): Boolean;
+ begin
+ Result := not ((r2.Left > r1.Right) or (r2.Right < r1.Left) or
+ (r2.Top > r1.Bottom) or (r2.Bottom < r1.Top));
+ end;
+
+begin
+ if SelectedCount <> 1 then Exit;
+
+ found := nil;
+ sel := FSelectedObjects[0];
+ min := 1e10;
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if not (c is TfrxReportComponent) or (c is TfrxBand) or (c = sel) then continue;
+
+ r1 := frxRect(c.AbsLeft, c.AbsTop, c.AbsLeft + c.Width, c.AbsTop + c.Height);
+ dist := 0;
+ dist_dx := 0;
+ dist_dy := 0;
+ with sel do
+ if dx = 1 then
+ begin
+ r2 := frxRect(AbsLeft, AbsTop, 1e10, AbsTop + Height);
+ r3 := frxRect(AbsLeft, 0, 1e10, 1e10);
+ dist := r1.Left - r2.Left;
+ dist_dx := r1.Left - (AbsLeft + Width);
+ if r1.Top > r2.Top then
+ dist_dy := r1.Top - r2.Bottom else
+ dist_dy := r2.Top - r1.Bottom;
+ end
+ else if dx = -1 then
+ begin
+ r2 := frxRect(-1e10, AbsTop, AbsLeft + Width, AbsTop + Height);
+ r3 := frxRect(0, 0, AbsLeft + Width, 1e10);
+ dist := r2.Right - r1.Right;
+ dist_dx := AbsLeft - r1.Right;
+ if r1.Top > r2.Top then
+ dist_dy := r1.Top - r2.Bottom else
+ dist_dy := r2.Top - r1.Bottom;
+ end
+ else if dy = 1 then
+ begin
+ r2 := frxRect(AbsLeft, AbsTop, AbsLeft + Width, 1e10);
+ r3 := frxRect(0, AbsTop, 1e10, 1e10);
+ dist := r1.Top - r2.Top;
+ dist_dy := r1.Top - (AbsTop + Height);
+ if r1.Left > r2.Left then
+ dist_dx := r1.Left - r2.Right else
+ dist_dx := r2.Left - r1.Right;
+ end
+ else if dy = -1 then
+ begin
+ r2 := frxRect(AbsLeft, -1e10, AbsLeft + Width, AbsTop + Height);
+ r3 := frxRect(0, 0, 1e10, AbsTop + Height);
+ dist := r2.Bottom - r1.Bottom;
+ dist_dy := AbsTop - r1.Bottom;
+ if r1.Left > r2.Left then
+ dist_dx := r1.Left - r2.Right else
+ dist_dx := r2.Left - r1.Right;
+ end;
+
+ if not RectsIntersect(r1, r2) then
+ begin
+ if (not RectsIntersect(r1, r3)) or
+ ((dx <> 0) and (dist_dx < dist_dy)) or
+ ((dy <> 0) and (dist_dy < dist_dx)) or
+ ((dist_dx = 0) and (dist_dy = 0)) then continue;
+ dist := sqrt(dist_dx * dist_dx + dist_dy * dist_dy) * (Width + Height);
+ end;
+
+ if dist < min then
+ begin
+ found := c;
+ min := dist;
+ end;
+ end;
+
+ if found <> nil then
+ begin
+ FSelectedObjects.Clear;
+ FSelectedObjects.Add(found);
+ if Assigned(FOnNotifyPosition) then
+ FOnNotifyPosition(GetSelectionBounds);
+ SelectionChanged;
+ end;
+end;
+
+procedure TfrxDesignerWorkspace.NormalizeCoord(c: TfrxComponent);
+begin
+ if c.Width < 0 then
+ begin
+ c.Width := -c.Width;
+ c.Left := c.Left - c.Width;
+ end;
+ if c.Height < 0 then
+ begin
+ c.Height := -c.Height;
+ c.Top := c.Top - c.Height;
+ end;
+end;
+
+procedure TfrxDesignerWorkspace.NormalizeRect(var R: TfrxRect);
+var
+ i: Extended;
+begin
+ with R do
+ begin
+ if Left > Right then
+ begin
+ i := Left;
+ Left := Right;
+ Right := i
+ end;
+ if Top > Bottom then
+ begin
+ i := Top;
+ Top := Bottom;
+ Bottom := i
+ end;
+ end;
+end;
+
+procedure TfrxDesignerWorkspace.AdjustBands(AttachObjects: Boolean = True);
+var
+ i, j: Integer;
+ sl: TfrxStringList;
+ b: TfrxBand;
+ c, c0: TfrxComponent;
+ add, add1: Extended;
+ l: TList;
+ ch: TfrxChild;
+
+ procedure DoBand(Bnd: TfrxBand);
+ var
+ y: Extended;
+ begin
+ if Bnd.Vertical then Exit;
+
+ if Bnd is TfrxPageHeader then
+ y := 0
+ else if Bnd is TfrxReportTitle then
+ y := 0.01
+ else if Bnd is TfrxColumnHeader then
+ y := 0.02
+ else if Bnd is TfrxColumnFooter then
+ y := 99999
+ else if Bnd is TfrxReportSummary then
+ y := 100000
+ else if Bnd is TfrxPageFooter then
+ y := 100001
+ else
+ y := Abs(Bnd.Top);
+
+ if TfrxReportPage(FPage).TitleBeforeHeader then
+ begin
+ if Bnd is TfrxReportTitle then
+ y := 0
+ else if Bnd is TfrxPageHeader then
+ y := 0.01
+ end;
+
+ sl.AddObject(Format('%9.2f', [y]), Bnd);
+ end;
+
+ procedure TossObjects(Bnd: TfrxBand);
+ var
+ i: Integer;
+ c: TfrxComponent;
+ SaveRestrictions: TfrxRestrictions;
+ begin
+ if Bnd.Vertical then Exit;
+
+ while Bnd.Objects.Count > 0 do
+ begin
+ c := Bnd.Objects[0];
+ SaveRestrictions := c.Restrictions;
+ c.Restrictions := [];
+ c.Top := c.AbsTop;
+ c.Restrictions := SaveRestrictions;
+ c.Parent := Bnd.Parent;
+ end;
+
+ if AttachObjects then
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if (c is TfrxView) and (c.AbsTop >= Bnd.Top - 1e-4) and (c.AbsTop < Bnd.Top + Bnd.Height + 1e-4) then
+ begin
+ SaveRestrictions := c.Restrictions;
+ c.Restrictions := [];
+ c.Top := c.AbsTop - Bnd.Top;
+ c.Restrictions := SaveRestrictions;
+ c.Parent := Bnd;
+ end;
+ end;
+ end;
+
+ function Round8(e: Extended): Extended;
+ begin
+ Result := Round(e * 100000000) / 100000000;
+ end;
+
+ procedure AdjustParent(Ctrl: TfrxComponent; Index: Integer);
+ var
+ i: Integer;
+ c: TfrxComponent;
+ found: Boolean;
+ begin
+ found := False;
+ for i := Index - 1 downto 0 do
+ begin
+ c := FObjects[i];
+ if (c <> Ctrl) and (c is TfrxDialogControl) {and
+ (csAcceptsControls in TfrxDialogControl(c).Control.ComponentStyle) }then
+ if (Ctrl.AbsLeft >= c.AbsLeft) and
+ (Ctrl.AbsTop >= c.AbsTop) and (Ctrl.AbsLeft < c.AbsLeft + c.Width) and
+ (Ctrl.AbsTop < c.AbsTop + c.Height) then
+ begin
+ Ctrl.Top := Ctrl.AbsTop - c.AbsTop;
+ Ctrl.Left := Ctrl.AbsLeft - c.AbsLeft;
+ Ctrl.Parent := c;
+ found := True;
+ break;
+ end;
+ end;
+
+ if not found and (Ctrl.Parent <> Page) then
+ begin
+ Ctrl.Top := Ctrl.AbsTop;
+ Ctrl.Left := Ctrl.AbsLeft;
+ Ctrl.Parent := Page;
+ BringToFront;
+ end;
+ //if Ctrl is TfrxDialogComponent then
+ // Ctrl.Parent := Self;
+
+ end;
+
+begin
+ sl := TfrxStringList.Create;
+ sl.Sorted := True;
+ sl.Duplicates := dupAccept;
+
+ { sort bands }
+ for i := 0 to FObjects.Count - 1 do
+ if TObject(FObjects[i]) is TfrxBand then
+ DoBand(FObjects[i]);
+
+ { arrange child bands }
+ sl.Sorted := False;
+ i := 0;
+ while i < sl.Count do
+ begin
+ sl[i] := '';
+ b := TfrxBand(sl.Objects[i]);
+ if b.Child <> nil then
+ begin
+ j := sl.IndexOfObject(b.Child);
+ if j <> -1 then
+ begin
+ c := TfrxComponent(sl.Objects[j]);
+ sl.Delete(j);
+ if j < i then
+ Dec(i);
+ sl.InsertObject(i + 1, '', c);
+ end;
+ end;
+ Inc(i);
+ end;
+
+ { set top/middle/bottom indexes }
+ i := 0;
+ while i < sl.Count do
+ begin
+ b := TfrxBand(sl.Objects[i]);
+ if sl[i] = '' then
+ if (b is TfrxPageHeader) or (b is TfrxReportTitle) or (b is TfrxColumnHeader) then
+ sl[i] := 'top'
+ else if (b is TfrxPageFooter) or (b is TfrxReportSummary) or (b is TfrxColumnFooter) then
+ sl[i] := 'bottom'
+ else
+ sl[i] := 'middle';
+ ch := b.Child;
+ while ch <> nil do
+ begin
+ j := sl.IndexOfObject(ch);
+ if j <> -1 then
+ sl[j] := sl[i];
+ ch := ch.Child;
+ end;
+ Inc(i);
+ end;
+
+ add1 := 0;
+ case FGridType of
+ gt1pt: add1 := 40;
+ gt1cm: add1 := fr1cm;
+ gt1in: add1 := fr1in * 0.4;
+ gtChar: add1 := fr1CharY;
+ end;
+
+ { rearrange all bands }
+ if not FFreeBandsPlacement then
+ for i := 0 to sl.Count - 1 do
+ begin
+ c := TfrxComponent(sl.Objects[i]);
+ if i = 0 then
+ c.Top := Round8(FBandHeader)
+ else
+ begin
+ c0 := TfrxComponent(sl.Objects[i - 1]);
+ if ((sl[i - 1] = 'top') and (sl[i] <> 'top')) or
+ ((sl[i] = 'bottom') and (sl[i - 1] <> 'bottom')) then
+ add := add1 else
+ add := 0;
+
+ c.Top := Round8(Round((c0.Top + c0.Height + FBandHeader + FGapBetweenBands)
+ / FGridY) * FGridY + add);
+ end;
+ end;
+
+ sl.Free;
+
+ { toss objects }
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if c is TfrxBand then
+ TossObjects(TfrxBand(c))
+ else if c is TfrxDialogControl then
+ AdjustParent(c, i);
+ end;
+
+ { move all bands to the begin of objects list }
+ l := TList.Create;
+ for i := 0 to FObjects.Count - 1 do
+ if TObject(FObjects[i]) is TfrxBand then
+ l.Add(FObjects[i]);
+ for i := 0 to FObjects.Count - 1 do
+ if not (TObject(FObjects[i]) is TfrxBand) then
+ l.Add(FObjects[i]);
+
+ FObjects.Clear;
+ for i := 0 to l.Count - 1 do
+ FObjects.Add(l[i]);
+ l.Free;
+end;
+
+procedure TfrxDesignerWorkspace.PrepareShiftTree(Band: TfrxBand);
+var
+ i, j, k: Integer;
+ c0, c1, c2, top: TfrxReportComponent;
+ allObjects: TStringList;
+ Found: Boolean;
+ area0, area1, area2, area01: TfrxRectArea;
+begin
+ allObjects := TfrxStringList.Create;
+ allObjects.Duplicates := dupAccept;
+
+ { temporary top object }
+ top := TfrxMemoView.Create(nil);
+ top.SetBounds(0, Band.Top-2, Band.Width, 1);
+
+ { sort objects }
+ for i := 0 to Band.Objects.Count - 1 do
+ begin
+ c0 := Band.Objects[i];
+ allObjects.AddObject(Format('%9.2f', [c0.Top]), c0);
+ c0.FShiftChildren.Clear;
+ end;
+ allObjects.Sort;
+ allObjects.InsertObject(0, Format('%10.2f', [top.Top]), top);
+
+ for i := 0 to allObjects.Count - 1 do
+ begin
+ c0 := TfrxReportComponent(allObjects.Objects[i]);
+ area0 := TfrxRectArea.Create(c0);
+
+ { find an object under c0 }
+ for j := i + 1 to allObjects.Count - 1 do
+ begin
+ c1 := TfrxReportComponent(allObjects.Objects[j]);
+ area1 := TfrxRectArea.Create(c1);
+
+ if not (area0.InterceptsY(area1)) and (area0.Y < area1.Y) and
+ area0.InterceptsX(area1) then
+ begin
+ area01 := area0.InterceptX(area1);
+ Found := False;
+
+ { check if there is no other objects between c1 and c0 }
+ for k := j - 1 downto i + 1 do
+ begin
+ c2 := TfrxReportComponent(allObjects.Objects[k]);
+ area2 := TfrxRectArea.Create(c2);
+
+ if not (area0.InterceptsY(area2)) and not (area1.InterceptsY(area2)) and
+ area01.InterceptsX(area2) then
+ Found := True;
+
+ area2.Free;
+ if Found then
+ break;
+ end;
+
+ if not Found then
+ c0.FShiftChildren.Add(c1);
+
+ area01.Free;
+ end;
+
+ area1.Free;
+ end;
+
+ area0.Free;
+ end;
+
+ { copy children from the top object to the band }
+ Band.FShiftChildren.Clear;
+ for i := 0 to top.FShiftChildren.Count - 1 do
+ Band.FShiftChildren.Add(top.FShiftChildren[i]);
+
+ allObjects.Free;
+ top.Free;
+end;
+
+procedure TfrxDesignerWorkspace.AdjustBandHeight(Bnd: TfrxBand);
+var
+ i: Integer;
+ max, min: Extended;
+ c: TfrxComponent;
+begin
+ max := 0;
+ min := 0;
+ for i := 0 to Bnd.Objects.Count - 1 do
+ begin
+ c := Bnd.Objects[i];
+ if (c is TfrxView) and (TfrxView(c).Align in [baClient, baBottom]) then
+ continue;
+ if c.Top + c.Height > max then
+ max := c.Top + c.Height;
+ if c.Top < min then
+ min := c.Top;
+ end;
+
+ max := max - min;
+ if Bnd.Height < max then
+ Bnd.Height := max;
+ if min < 0 then
+ for i := 0 to Bnd.Objects.Count - 1 do
+ with TfrxComponent(Bnd.Objects[i]) do
+ Top := Top - min;
+end;
+
+function TfrxDesignerWorkspace.ListsEqual(List1, List2: TList): Boolean;
+var
+ i: Integer;
+begin
+ Result := List1.Count = List2.Count;
+ if Result then
+ for i := 0 to List1.Count - 1 do
+ if List1.List[i] <> List2.List[i] then
+ Result := False;
+end;
+
+procedure TfrxDesignerWorkspace.DeleteObjects;
+var
+ c, c1: TfrxComponent;
+ i: Integer;
+begin
+ if SelectedCount = 0 then exit;
+
+ i := 0;
+ while FSelectedObjects.Count > i do
+ begin
+ c := FSelectedObjects[i];
+
+ if not (rfDontDelete in c.Restrictions) then
+ begin
+ if c.IsAncestor then
+ raise Exception.Create('Could not delete ' + c.Name + ', it was introduced in the ancestor report');
+ FSelectedObjects.Remove(c);
+ FObjects.Remove(c);
+
+ while c.Objects.Count > 0 do
+ begin
+ c1 := c.Objects[0];
+ FSelectedObjects.Remove(c1);
+ FObjects.Remove(c1);
+ c1.Free;
+ end;
+
+ c.Free;
+ end
+ else
+ Inc(i);
+ end;
+
+ if FSelectedObjects.Count = 0 then
+ FSelectedObjects.Add(FPage);
+
+ AdjustBands;
+ FModifyFlag := True;
+ DoModify;
+ SelectionChanged;
+end;
+
+procedure TfrxDesignerWorkspace.EditObject;
+begin
+ if FSelectedObjects.Count = 1 then
+ if Assigned(FOnEdit) then
+ FOnEdit(Self);
+end;
+
+procedure TfrxDesignerWorkspace.DoNudge(dx, dy: Extended; Smooth: Boolean);
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ if SelectedCount = 0 then exit;
+ if not Smooth or (GridType = gtChar) then
+ begin
+ dx := dx * FGridX;
+ dy := dy * FGridY;
+ end;
+
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ c.Left := c.Left + dx;
+ c.Top := c.Top + dy;
+ end;
+
+ FModifyFlag := True;
+ if Assigned(FOnNotifyPosition) then
+ FOnNotifyPosition(GetSelectionBounds);
+ Repaint;
+end;
+
+procedure TfrxDesignerWorkspace.DoSize(dx, dy: Extended);
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ if SelectedCount = 0 then exit;
+ dx := dx * FGridX;
+ dy := dy * FGridY;
+
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ c.Width := c.Width + dx;
+ if c.Width < 0 then
+ c.Width := c.Width - dx;
+ c.Height := c.Height + dy;
+ if c.Height < 0 then
+ c.Height := c.Height - dy;
+ end;
+
+ FModifyFlag := True;
+ if Assigned(FOnNotifyPosition) then
+ FOnNotifyPosition(GetSelectionBounds);
+ Repaint;
+end;
+
+procedure TfrxDesignerWorkspace.DoStick(dx, dy: Integer);
+var
+ i: Integer;
+ c, sel, found: TfrxComponent;
+ min, dist: Extended;
+ r1, r2: TfrxRect;
+ gapLeft, gapRight, gapTop, gapBottom: Extended;
+
+ function RectsIntersect(r1, r2: TfrxRect): Boolean;
+ begin
+ Result := not ((r2.Left > r1.Right) or (r2.Right < r1.Left) or
+ (r2.Top > r1.Bottom) or (r2.Bottom < r1.Top));
+ end;
+
+begin
+ if SelectedCount <> 1 then exit;
+
+ found := nil;
+ sel := FSelectedObjects[0];
+ min := 1e10;
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if not (c is TfrxReportComponent) or (c is TfrxBand) or (c = sel) then continue;
+
+ r1 := frxRect(c.AbsLeft, c.AbsTop, c.AbsLeft + c.Width, c.AbsTop + c.Height);
+ dist := 0;
+ with sel do
+ if dx = 1 then
+ begin
+ r2 := frxRect(AbsLeft, AbsTop, 1e10, AbsTop + Height);
+ dist := r1.Left - r2.Left;
+ end
+ else if dx = -1 then
+ begin
+ r2 := frxRect(-1e10, AbsTop, AbsLeft + Width, AbsTop + Height);
+ dist := r2.Right - r1.Right;
+ end
+ else if dy = 1 then
+ begin
+ r2 := frxRect(AbsLeft, AbsTop, AbsLeft + Width, 1e10);
+ dist := r1.Top - r2.Top;
+ end
+ else if dy = -1 then
+ begin
+ r2 := frxRect(AbsLeft, -1e10, AbsLeft + Width, AbsTop + Height);
+ dist := r2.Bottom - r1.Bottom;
+ end;
+
+ if RectsIntersect(r1, r2) then
+ if dist < min then
+ begin
+ found := c;
+ min := dist;
+ end;
+ end;
+
+ if found <> nil then
+ begin
+ gapLeft := 0;
+ gapRight := 0;
+ gapTop := 0;
+ gapBottom := 0;
+ if (sel is TfrxDMPMemoView) and (found is TfrxDMPMemoView) then
+ begin
+ if (ftLeft in TfrxDMPMemoView(sel).Frame.Typ) or
+ (ftRight in TfrxDMPMemoView(found).Frame.Typ) then
+ gapLeft := fr1CharX;
+ if (ftRight in TfrxDMPMemoView(sel).Frame.Typ) or
+ (ftLeft in TfrxDMPMemoView(found).Frame.Typ) then
+ gapRight := fr1CharX;
+ if (ftTop in TfrxDMPMemoView(sel).Frame.Typ) or
+ (ftBottom in TfrxDMPMemoView(found).Frame.Typ) then
+ gapTop := fr1CharY;
+ if (ftBottom in TfrxDMPMemoView(sel).Frame.Typ) or
+ (ftTop in TfrxDMPMemoView(found).Frame.Typ) then
+ gapBottom := fr1CharY;
+ end;
+ if dx = 1 then
+ sel.Left := found.Left - sel.Width - gapRight
+ else if dx = -1 then
+ sel.Left := found.Left + found.Width + gapLeft
+ else if dy = 1 then
+ sel.Top := found.Top - sel.Height - gapBottom
+ else if dy = -1 then
+ sel.Top := found.Top + found.Height + gapTop;
+
+ FModifyFlag := True;
+ if Assigned(FOnNotifyPosition) then
+ FOnNotifyPosition(GetSelectionBounds);
+ Repaint;
+ end;
+end;
+
+procedure TfrxDesignerWorkspace.DoTab;
+var
+ c: TfrxComponent;
+ i: Integer;
+begin
+ if SelectedCount <> 1 then Exit;
+
+ c := SelectedObjects[0];
+ if (c is TfrxBand) and (c.Objects.Count > 0) then
+ SelectedObjects[0] := c.Objects[0]
+ else if c is TfrxView then
+ begin
+ i := c.Parent.Objects.IndexOf(c);
+ if i = c.Parent.Objects.Count - 1 then
+ i := 0
+ else
+ Inc(i);
+ SelectedObjects[0] := c.Parent.Objects[i];
+ end;
+
+ if Assigned(FOnNotifyPosition) then
+ FOnNotifyPosition(GetSelectionBounds);
+ SelectionChanged;
+end;
+
+procedure TfrxDesignerWorkspace.KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+var
+ dx, dy: Integer;
+begin
+ if FDisableUpdate then
+ Exit;
+
+ dx := 0; dy := 0;
+
+ //if Shift = [] then
+ case Key of
+ vkDelete,
+ vkBack:
+ DeleteObjects;
+
+ vkReturn:
+ EditObject;
+
+ vkLeft:
+ dx := -1;
+
+ vkRight:
+ dx := 1;
+
+ vkUp:
+ dy := -1;
+
+ vkDown:
+ dy := 1;
+
+ vkTab:
+ DoTab;
+ end;
+
+ if (dx <> 0) or (dy <> 0) then
+ begin
+ if ssCtrl in Shift then
+ DoNudge(dx, dy, not (ssShift in Shift))
+ else if ssShift in Shift then
+ DoSize(dx, dy)
+ else if ssAlt in Shift then
+ DoStick(dx, dy)
+ else
+ FindNearest(dx, dy);
+ AdjustBands;
+ end;
+end;
+
+procedure TfrxDesignerWorkspace.KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if FDisableUpdate then exit;
+ DoModify;
+end;
+
+procedure TfrxDesignerWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+var
+ i, j: Integer;
+ c, c1: TfrxComponent;
+ EmptySpace: Boolean;
+ l: TList;
+ NeedRepaint: Boolean;
+
+ function Contain(c: TfrxComponent): Boolean;
+ var
+ w0, w1, w2, w3: Extended;
+ Left, Top, Right, Bottom, e, k, mx, my: Extended;
+ begin
+ Result := False;
+ w0 := 0;
+ w1 := 0;
+ w2 := 0;
+ if c.Width = 0 then
+ begin
+ w0 := 4;
+ w1 := 4
+ end
+ else if c.Height = 0 then
+ w2 := 4;
+ w3 := w2;
+ if c is TfrxBand then
+ if TfrxBand(c).Vertical then
+ w0 := FBandHeader
+ else
+ w2 := FBandHeader;
+
+ Left := c.AbsLeft;
+ Right := c.AbsLeft + c.Width;
+ Top := c.AbsTop;
+ Bottom := c.AbsTop + c.Height;
+ mx := X / FScale;
+ my := Y / FScale;
+
+ if Right < Left then
+ begin
+ e := Right;
+ Right := Left;
+ Left := e;
+ end;
+ if Bottom < Top then
+ begin
+ e := Bottom;
+ Bottom := Top;
+ Top := e;
+ end;
+
+ if (c is TfrxLineView) and TfrxLineView(c).Diagonal and
+ (c.Width <> 0) and (c.Height <> 0) then
+ begin
+ k := c.Height / c.Width;
+ if Abs((k * (mx - c.AbsLeft) - (my - c.AbsTop)) * cos(arctan(k))) < 5 then
+ Result := True;
+ if (mx < Left - 5) or (mx > Right + 5) or (my < Top - 5) or (my > Bottom + 5) then
+ Result := False;
+ end
+ else if (mx >= Left - w0) and (mx <= Right + w1) and
+ (my >= Top - w2) and (my <= Bottom + w3) then
+ Result := True;
+ end;
+
+begin
+ inherited;
+{$IFDEF MACOS}
+ X := X - 2;
+ Y := Y - 2;
+{$ENDIF}
+
+ if FDisableUpdate or FMouseDown then exit;
+ if FDblClicked then
+ begin
+ FDblClicked := False;
+ exit;
+ end;
+
+ l := TList.Create;
+ for i := 0 to FSelectedObjects.Count - 1 do
+ l.Add(FSelectedObjects[i]);
+
+ //if FPage is TfrxReportPage then
+ // ValidParentForm(Self).ActiveControl := Parent else
+ // ValidParentForm(Self).ActiveControl := nil;
+
+ SetFocus;
+
+ FMouseDown := True;
+ FLastMousePointX := X / FScale;
+ FLastMousePointY := Y / FScale;
+ NeedRepaint := False;
+
+// Ctrl was pressed
+ if (FMode1 = dmNone) and (ssCtrl in Shift) then
+ begin
+ FSelectedObjects.Clear;
+ FSelectedObjects.Add(FPage);
+ FMode1 := dmSelectionRect;
+ FDrawSelection := True;
+ FSelectionRect := frxRect(X, Y, X, Y);
+ NeedRepaint := True;
+ end;
+
+// clicked on object or on empty space
+ if FMode1 = dmNone then
+ begin
+ EmptySpace := True;
+
+ for i := FObjects.Count - 1 downto 0 do
+ begin
+ c := FObjects[i];
+ if (c is TfrxReportComponent) and Contain(c) then
+ begin
+ EmptySpace := False;
+
+ if csContainer in c.frComponentStyle then
+ begin
+ if c.ContainerMouseDown(Self, Round(X), Round(Y)) then
+ FMode1 := dmContainer
+ else
+ for j := c.ContainerObjects.Count - 1 downto 0 do
+ begin
+ c1 := c.ContainerObjects[j];
+ if c1.Visible and Contain(c1) then
+ begin
+ c := c1;
+ break;
+ end;
+ end;
+ end;
+
+ if ssShift in Shift then
+ if FSelectedObjects.IndexOf(c) <> -1 then
+ FSelectedObjects.Remove(c) else
+ FSelectedObjects.Add(c)
+ else if FSelectedObjects.IndexOf(c) = -1 then
+ begin
+ FSelectedObjects.Clear;
+ FSelectedObjects.Add(c);
+ end;
+
+ break;
+ end;
+ end;
+
+ if EmptySpace then
+ begin
+ FSelectedObjects.Clear;
+ FSelectedObjects.Add(FPage);
+ FMode1 := dmSelectionRect;
+ FDrawSelection := True;
+ FSelectionRect := frxRect(X, Y, X, Y);
+ end
+ else if FSelectedObjects.Count = 0 then
+ begin
+ FSelectedObjects.Add(FPage);
+ FMode1 := dmNone;
+ end
+ else
+ begin
+ FSelectedObjects.Remove(FPage);
+ if FMode1 <> dmContainer then
+ FMode1 := dmMove;
+ end;
+
+ NeedRepaint := True;
+ end;
+
+//band detach band objects
+ if (FMode1 = dmMove) and (FSelectedObjects.Count = 1) and
+ (TObject(FSelectedObjects[0]) is TfrxBand) and (ssAlt in Shift) then
+ AdjustBands(False);
+
+// scaling
+ if FMode1 = dmScale then
+ begin
+ FScaleRect := GetSelectionBounds;
+ FScaleRect.Right := FScaleRect.Right + FScaleRect.Left;
+ FScaleRect.Bottom := FScaleRect.Bottom + FScaleRect.Top;
+ FScaleRect1 := FScaleRect;
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ THackComponent(c).FOriginalRect := frxRect(c.AbsLeft, c.AbsTop, c.Width, c.Height);
+ end;
+ end;
+
+// inserting a line
+ if FMode1 = dmInsertLine then
+ begin
+ FInsertion.Width := 0;
+ FInsertion.Height := 0;
+ end;
+
+ if NeedRepaint then
+ if not ListsEqual(l, FSelectedObjects) then
+ SelectionChanged else
+ Repaint;
+
+ if Button = TMouseButton.mbRight then
+ begin
+ FMode1 := dmNone;
+ FMouseDown := False;
+ Repaint;
+ if Assigned(FOnPopup) then
+ FOnPopup(Self, X, Y);
+ end;
+
+ if FMode1 = dmMove then
+ begin
+ for i := 0 to FSelectedObjects.Count - 1 do
+ if TObject(FSelectedObjects[i]) is TfrxView then
+ begin
+ FSavedAlign.Add(Pointer(Integer(TfrxView(FSelectedObjects[i]).Align)));
+ TfrxView(FSelectedObjects[i]).Align := baNone;
+ end;
+ end;
+
+ l.Free;
+end;
+
+procedure TfrxDesignerWorkspace.MouseMove(Shift: TShiftState; X, Y: Single);
+var
+ c: TfrxComponent;
+ kx, ky, nx, ny: Extended;
+ i: Integer;
+ NotifyRect, SaveBounds: TfrxRect;
+ dpage: TfrxDialogPage;
+
+ function Contain(px, py: Extended): Boolean;
+ begin
+ Result := (X / FScale >= px - 2) and (X / FScale <= px + 3) and
+ (Y / FScale >= py - 2) and (Y / FScale <= py + 3);
+ end;
+
+ function Contain0(py: Extended): Boolean;
+ begin
+ Result := (Y / FScale >= py - 2) and (Y / FScale <= py + 2);
+ end;
+
+ function Contain1(px, py: Extended): Boolean;
+ begin
+ Result := (FLastMousePointX >= px - 2) and (FLastMousePointX <= px + 3) and
+ (FLastMousePointY >= py - 2) and (FLastMousePointY <= py + 3);
+ end;
+
+ function Contain2(c: TfrxComponent): Boolean;
+ var
+ w1, w2: Integer;
+ begin
+ w1 := 0;
+ w2 := 0;
+ if c.Width = 0 then
+ w1 := 4 else
+ w2 := 4;
+ if (X / FScale >= c.AbsLeft - w1) and (X / FScale <= c.AbsLeft + c.Width + w1) and
+ (Y / FScale >= c.AbsTop - w2) and (Y / FScale <= c.AbsTop + c.Height + w2) then
+ Result := True else
+ Result := False;
+ end;
+
+ function Contain3(px: Extended): Boolean;
+ begin
+ Result := (X / FScale >= px - 2) and (X / FScale <= px + 2);
+ end;
+
+ function GridCheck: Boolean;
+ begin
+ Result := (kx >= FGridX) or (kx <= -FGridX) or
+ (ky >= FGridY) or (ky <= -FGridY);
+ if Result then
+ begin
+ kx := Trunc(kx / FGridX) * FGridX;
+ ky := Trunc(ky / FGridY) * FGridY;
+ end;
+ end;
+
+ function CheckMove: Boolean;
+ var
+ al: Boolean;
+ begin
+ al := FGridAlign;
+ if ssAlt in Shift then
+ al := not al;
+
+ Result := False;
+
+ if (al and not GridCheck) or ((kx = 0) and (ky = 0)) then
+ Result := True;
+
+ CheckGuides(kx, ky, Result);
+ end;
+
+ procedure CheckNegative(c: TfrxComponent);
+ const
+ ar1: array[ct1..ct8] of TfrxCursorType = (ct3, ct4, ct1, ct2, ct6, ct5, ct0, ct0);
+ ar2: array[ct1..ct8] of TfrxCursorType = (ct4, ct3, ct2, ct1, ct0, ct0, ct8, ct7);
+ ar3: array[ct1..ct8] of TfrxCursorType = (ct2, ct1, ct4, ct3, ct0, ct0, ct0, ct0);
+ begin
+ if (c is TfrxLineView) and (TfrxLineView(c).Diagonal = True) then exit;
+ if (c.Width < 0) and (c.Height < 0) then
+ FCT := ar3[FCT]
+ else if c.Width < 0 then
+ FCT := ar1[FCT]
+ else if c.Height < 0 then
+ FCT := ar2[FCT];
+ NormalizeCoord(c);
+ end;
+
+ procedure CTtoCursor;
+ const
+ ar: array[ct0..ct10] of TCursor =
+ (crDefault, crSizeNWSE, crSizeNWSE, crSizeNESW,
+ crSizeNESW, crSizeWE, crSizeWE, crSizeNS, crSizeNS, crCross, crCross);
+ begin
+ Cursor := ar[FCT];
+ end;
+
+begin
+ inherited;
+ if FDisableUpdate then Exit;
+{$IFDEF MACOS}
+ X := X - 2;
+ Y := Y - 2;
+{$ENDIF}
+
+ if SelectedCount = 0 then
+ NotifyRect := frxRect(X / FScale, Y / FScale, 0, 0) else
+ NotifyRect := GetSelectionBounds;
+
+// cursor shapes
+ if not FMouseDown and (FMode = dmSelect) then
+ if SelectedCount = 1 then
+ begin
+ FMode1 := dmSize;
+ c := FSelectedObjects[0];
+ FCT := ct0;
+ if Contain(c.AbsLeft, c.AbsTop) then
+ FCT := ct1
+ else if Contain(c.AbsLeft + c.Width, c.AbsTop + c.Height) then
+ FCT := ct2
+ else if Contain(c.AbsLeft + c.Width, c.AbsTop) then
+ FCT := ct3
+ else if Contain(c.AbsLeft, c.AbsTop + c.Height) then
+ FCT := ct4
+ else if Contain(c.AbsLeft + c.Width, c.AbsTop + c.Height / 2) then
+ FCT := ct5
+ else if Contain(c.AbsLeft, c.AbsTop + c.Height / 2) then
+ FCT := ct6
+ else if Contain(c.AbsLeft + c.Width / 2, c.AbsTop) then
+ FCT := ct7
+ else if Contain(c.AbsLeft + c.Width / 2, c.AbsTop + c.Height) then
+ FCT := ct8;
+
+ if c is TfrxCustomLineView then
+ if not TfrxCustomLineView(c).Diagonal then
+ begin
+ if c.Width = 0 then
+ if FCT in [ct1, ct3] then
+ FCT := ct7
+ else if FCT in [ct4, ct2] then
+ FCT := ct8
+ else
+ FCT := ct0;
+ if c.Height = 0 then
+ if FCT in [ct1, ct4] then
+ FCT := ct6
+ else if FCT in [ct3, ct2] then
+ FCT := ct5
+ else
+ FCT := ct0;
+ end
+ else
+ if FCT = ct1 then
+ FCT := ct9
+ else if FCT = ct2 then
+ FCT := ct10
+ else
+ FCT := ct0;
+
+
+ if FCT = ct0 then
+ FMode1 := dmNone;
+ CTtoCursor;
+ end
+ else if SelectedCount > 1 then
+ begin
+ FMode1 := dmScale;
+ c := GetRightBottomObject;
+ if (c <> nil) and Contain(c.AbsLeft + c.Width, c.AbsTop + c.Height) then
+ Cursor := crSizeNWSE
+ else
+ begin
+ Cursor := crDefault;
+ FMode1 := dmNone;
+ end;
+ end
+ else if FPage is TfrxDialogPage then
+ begin
+ FMode1 := dmSize;
+ dpage := TfrxDialogPage(FPage);
+ FCT := ct0;
+ if Contain(dpage.ClientWidth - 2, dpage.ClientHeight - 2) then
+ FCT := ct2
+ else if Contain(dpage.ClientWidth - 2, dpage.ClientHeight / 2 - 1) then
+ FCT := ct5
+ else if Contain(dpage.ClientWidth / 2 - 1, dpage.ClientHeight - 2) then
+ FCT := ct8;
+
+ if FCT = ct0 then
+ FMode1 := dmNone;
+ CTtoCursor;
+ end
+ else
+ Cursor := crDefault;
+
+// resizing a band - setup
+ if not FMouseDown and (FMode = dmSelect) and not (FMode1 in [dmSize, dmScale]) then
+ begin
+ Cursor := crDefault;
+ FMode1 := dmNone;
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+
+ if c is TfrxBand then
+ if TfrxBand(c).Vertical then
+ begin
+ if Contain3(c.Left + c.Width) then
+ begin
+ Cursor := crHSplit;
+ FMode1 := dmSizeBand;
+ FSizedBand := TfrxBand(c);
+ break;
+ end;
+ end
+ else
+ begin
+ if Contain0(c.Top + c.Height) then
+ begin
+ Cursor := crVSplit;
+ FMode1 := dmSizeBand;
+ FSizedBand := TfrxBand(c);
+ break;
+ end;
+ end;
+ end;
+ end;
+
+// resizing a band
+ if FMouseDown and (FMode1 = dmSizeBand) then
+ begin
+ kx := X / FScale - FLastMousePointX;
+ ky := Y / FScale - FLastMousePointY;
+ if CheckMove then Exit;
+
+ FModifyFlag := True;
+ if FSizedBand.Vertical then
+ FSizedBand.Width := FSizedBand.Width + kx
+ else
+ FSizedBand.Height := FSizedBand.Height + ky;
+ AdjustBandHeight(FSizedBand);
+ AdjustBands;
+
+ FLastMousePointX := FLastMousePointX + kx;
+ FLastMousePointY := FLastMousePointY + ky;
+ Repaint;
+ with FSizedBand do
+ NotifyRect := frxRect(Left, Top, Width, Height);
+ end;
+
+// inserting
+ if not FMouseDown and (FMode1 = dmInsertObject) then
+ begin
+ kx := X / FScale - FInsertion.Left;
+ ky := Y / FScale - FInsertion.Top;
+ if CheckMove then Exit;
+
+ FInsertion.Left := FInsertion.Left + kx;
+ FInsertion.Top := FInsertion.Top + ky;
+ FDrawInsertion := True;
+ Repaint;
+ with FInsertion do
+ NotifyRect := frxRect(Left, Top, Width, Height);
+ end;
+
+// inserting + resizing
+ if FMouseDown and (FMode1 = dmInsertObject) then
+ begin
+ kx := X / FScale - FInsertion.Left;
+ ky := Y / FScale - FInsertion.Top;
+ if CheckMove then Exit;
+
+ FInsertion.Width := kx;
+ FInsertion.Height := ky;
+ FDrawInsertion := True;
+ Repaint;
+ with FInsertion do
+ NotifyRect := frxRect(Left, Top, Width, Height);
+ end;
+
+// moving
+ if FMouseDown and (FMode1 = dmMove) and not(ssShift in Shift) then
+ begin
+ kx := X / FScale - FLastMousePointX;
+ ky := Y / FScale - FLastMousePointY;
+ if CheckMove then Exit;
+
+ { vertical band }
+ if not FModifyFlag and (SelectedCount = 1) and
+ (TObject(FSelectedObjects[0]) is TfrxBand) and
+ (TfrxBand(FSelectedObjects[0]).Vertical) then
+ begin
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if (c is TfrxView) and
+ (c.Left >= TfrxBand(FSelectedObjects[0]).Left - 1e-4) and
+ (c.Left + c.Width <= TfrxBand(FSelectedObjects[0]).Left +
+ TfrxBand(FSelectedObjects[0]).Width + 1e-4) then
+ FSelectedObjects.Add(c);
+ end;
+ end;
+
+ if (TObject(FSelectedObjects[0]) is TfrxBand) and
+ (TfrxBand(FSelectedObjects[0]).Vertical) then
+ ky := 0;
+
+ FModifyFlag := True;
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ c.Left := c.Left + kx;
+ if FSelectedObjects.IndexOf(c.Parent) = -1 then
+ begin
+ if c.IsAncestor and (c is TfrxView) then
+ if (c.Top + ky < -1e-4) or (c.Top + ky > c.Parent.Height) then
+ continue;
+ c.Top := c.Top + ky;
+ end;
+ end;
+
+ FLastMousePointX := FLastMousePointX + kx;
+ FLastMousePointY := FLastMousePointY + ky;
+ Repaint;
+ NotifyRect := GetSelectionBounds;
+ end;
+
+// resizing one object
+ if FMouseDown and (FMode1 = dmSize) and (SelectedCount = 1) then
+ begin
+ kx := X / FScale - FLastMousePointX;
+ ky := Y / FScale - FLastMousePointY;
+ if CheckMove then Exit;
+
+ FModifyFlag := True;
+ c := FSelectedObjects[0];
+ SaveBounds := frxRect(c.Left, c.Top, c.Width, c.Height);
+ case FCT of
+ ct1, ct9:
+ begin
+ c.Left := c.Left + kx;
+ c.Width := c.Width - kx;
+ c.Top := c.Top + ky;
+ c.Height := c.Height - ky;
+ end;
+
+ ct2, ct10:
+ begin
+ c.Width := c.Width + kx;
+ c.Height := c.Height + ky;
+ end;
+
+ ct3:
+ begin
+ c.Top := c.Top + ky;
+ c.Width := c.Width + kx;
+ c.Height := c.Height - ky;
+ end;
+
+ ct4:
+ begin
+ c.Left := c.Left + kx;
+ c.Width := c.Width - kx;
+ c.Height := c.Height + ky;
+ end;
+
+ ct5:
+ begin
+ c.Width := c.Width + kx;
+ end;
+
+ ct6:
+ begin
+ c.Left := c.Left + kx;
+ c.Width := c.Width - kx;
+ end;
+
+ ct7:
+ begin
+ c.Top := c.Top + ky;
+ c.Height := c.Height - ky;
+ end;
+
+ ct8:
+ begin
+ c.Height := c.Height + ky;
+ end;
+ end;
+ CheckNegative(c);
+ CTtoCursor;
+
+ if c.Left < 0 then
+ c.Left := 0;
+
+ if c.IsAncestor and (c is TfrxView) then
+ if (c.Top < -1e-4) or (c.Top > c.Parent.Height) then
+ c.SetBounds(SaveBounds.Left, SaveBounds.Top, SaveBounds.Right, SaveBounds.Bottom);
+
+ if c is TfrxBand then
+ begin
+ if FCT in [ct1, ct3, ct7] then
+ for i := 0 to c.Objects.Count - 1 do
+ with TfrxComponent(c.Objects[i]) do
+ Top := Top - ky;
+ AdjustBandHeight(TfrxBand(c));
+ AdjustBands;
+ end;
+
+ FLastMousePointX := FLastMousePointX + kx;
+ FLastMousePointY := FLastMousePointY + ky;
+ Repaint;
+ NotifyRect := frxRect(c.Left, c.Top, c.Width, c.Height);
+ end;
+
+// resizing dialogue form
+ if FMouseDown and (FMode1 = dmSize) and (TObject(FSelectedObjects[0]) is TfrxDialogPage) then
+ begin
+ kx := X / FScale - FLastMousePointX;
+ ky := Y / FScale - FLastMousePointY;
+ if CheckMove then Exit;
+
+ FModifyFlag := True;
+ dpage := TObject(FSelectedObjects[0]) as TfrxDialogPage;
+ case FCT of
+ ct2:
+ begin
+ dpage.ClientWidth := dpage.ClientWidth + kx;
+ dpage.ClientHeight := dpage.ClientHeight + ky;
+ end;
+
+ ct5:
+ begin
+ dpage.ClientWidth := dpage.ClientWidth + kx;
+ end;
+
+ ct8:
+ begin
+ dpage.ClientHeight := dpage.ClientHeight + ky;
+ end;
+ end;
+
+ FLastMousePointX := FLastMousePointX + kx;
+ FLastMousePointY := FLastMousePointY + ky;
+ SetPageDimensions(Round(dpage.ClientWidth), Round(dpage.ClientHeight), Rect(0, 0, 0, 0));
+ Repaint;
+ NotifyRect := frxRect(0, 0, dpage.ClientWidth, dpage.ClientHeight);
+ end;
+
+// scaling
+ if FMouseDown and (FMode1 = dmScale) then
+ begin
+ kx := X / FScale - FLastMousePointX;
+ ky := Y / FScale - FLastMousePointY;
+ if CheckMove then Exit;
+
+ FModifyFlag := True;
+ with FScaleRect do
+ if not ((Right + kx < Left) or (Bottom + ky < Top)) then
+ FScaleRect := frxRect(Left, Top, Right + kx, Bottom + ky);
+ nx := (FScaleRect.Right - FScaleRect.Left) / (FScaleRect1.Right - FScaleRect1.Left);
+ ny := (FScaleRect.Bottom - FScaleRect.Top) / (FScaleRect1.Bottom - FScaleRect1.Top);
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ c.Left := FScaleRect1.Left + (THackComponent(c).FOriginalRect.Left - FScaleRect1.Left) * nx;
+ c.Top := FScaleRect1.Top + (THackComponent(c).FOriginalRect.Top - FScaleRect1.Top) * ny;
+ if c.Parent is TfrxBand then
+ c.Top := c.Top - c.Parent.Top;
+ c.Width := THackComponent(c).FOriginalRect.Right * nx;
+ c.Height := THackComponent(c).FOriginalRect.Bottom * ny;
+ end;
+
+ FLastMousePointX := FLastMousePointX + kx;
+ FLastMousePointY := FLastMousePointY + ky;
+ Repaint;
+ with FScaleRect do
+ NotifyRect := frxRect(Right - Left, Bottom - Top, nx, ny);
+ end;
+
+// drawing selection rectangle
+ if FMouseDown and (FMode1 = dmSelectionRect) then
+ begin
+ FSelectionRect := frxRect(FSelectionRect.Left, FSelectionRect.Top, X, Y);
+ Repaint;
+ end;
+
+// inserting a line
+ if not FMouseDown and (FMode1 = dmInsertLine) then
+ begin
+ kx := X / FScale - FInsertion.Left;
+ ky := Y / FScale - FInsertion.Top;
+ if CheckMove then Exit;
+
+ FInsertion.Left := FInsertion.Left + kx;
+ FInsertion.Top := FInsertion.Top + ky;
+ with FInsertion do
+ NotifyRect := frxRect(Left, Top, 0, 0);
+ Repaint;
+ end;
+
+// inserting a line + resizing
+ if FMouseDown and (FMode1 = dmInsertLine) then
+ begin
+ kx := X / FScale - (FInsertion.Left + FInsertion.Width);
+ ky := Y / FScale - (FInsertion.Top + FInsertion.Height);
+ if CheckMove then Exit;
+
+ FInsertion.Width := FInsertion.Width + kx;
+ FInsertion.Height := FInsertion.Height + ky;
+ with FInsertion do
+ NotifyRect := frxRect(Left, Top, Width, Height);
+ Repaint;
+ end;
+
+// check containers
+ if not FMouseDown and (FMode = dmSelect) and not (FMode1 in [dmSize, dmScale]) then
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if (csContainer in c.frComponentStyle) and Contain2(c) then
+ c.ContainerMouseMove(Self, Round(X), Round(Y));
+ end;
+
+// handle containers
+ if FMouseDown and (FMode1 = dmContainer) then
+ begin
+ kx := X / FScale - FLastMousePointX;
+ ky := Y / FScale - FLastMousePointY;
+ if CheckMove then Exit;
+
+ FModifyFlag := True;
+ c := FSelectedObjects[0];
+ c.ContainerMouseMove(Self, Round(X), Round(Y));
+ FLastMousePointX := FLastMousePointX + kx;
+ FLastMousePointY := FLastMousePointY + ky;
+ Repaint;
+ end;
+//todo
+// if FMouseDown and (Cursor <> crHand) then
+// if Parent is TScrollingWinControl then
+// with TScrollingWinControl(Parent) do
+// begin
+// x := x + Round(FMargins.Left * FScale);
+// y := y + Round(FMargins.Top * FScale);
+// if x > (ClientRect.Right + HorzScrollBar.Position) then
+// begin
+// i := x - (ClientRect.Right + HorzScrollBar.Position);
+// HorzScrollBar.Position := HorzScrollBar.Position + i;
+// end;
+// if x < HorzScrollBar.Position then
+// begin
+// i := HorzScrollBar.Position - x;
+// HorzScrollBar.Position := HorzScrollBar.Position - i;
+// end;
+// if y > (ClientRect.Bottom + VertScrollBar.Position) then
+// begin
+// i := y - (ClientRect.Bottom + VertScrollBar.Position);
+// VertScrollBar.Position := VertScrollBar.Position + i;
+// end;
+// if y < VertScrollBar.Position then
+// begin
+// i := VertScrollBar.Position - y;
+// VertScrollBar.Position := VertScrollBar.Position - i;
+// end;
+// end;
+
+ if (SelectedCount = 0) or FMouseDown then
+ if Assigned(FOnNotifyPosition) then
+ FOnNotifyPosition(NotifyRect);
+end;
+
+procedure TfrxDesignerWorkspace.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+var
+ i, j: Integer;
+ c, c1: TfrxComponent;
+ R: TfrxRect;
+ l: TList;
+ NotifyRect: TfrxRect;
+
+ function Round8(e: Extended): Extended;
+ begin
+ Result := Round(e * 100000000) / 100000000;
+ end;
+
+ function Contain(c: TfrxComponent): Boolean;
+ var
+ cLeft, cTop, cRight, cBottom, e: Extended;
+ Sign: Boolean;
+
+ function Dist(x, y: Extended): Boolean;
+ var
+ k: Extended;
+ begin
+ k := c.Height / c.Width;
+ k := (k * (x / FScale - c.AbsLeft) - (y / FScale - c.AbsTop)) * cos(arctan(k));
+ Result := k >= 0;
+ end;
+
+ function RectInRect: Boolean;
+ begin
+ with FSelectionRect do
+ Result := not ((cLeft > Right / FScale) or
+ (cRight < Left / FScale) or
+ (cTop > Bottom / FScale) or
+ (cBottom < Top / FScale));
+ end;
+
+ begin
+ Result := False;
+ cLeft := c.AbsLeft;
+ cRight := c.AbsLeft + c.Width;
+ cTop := c.AbsTop;
+ cBottom := c.AbsTop + c.Height;
+
+ if cRight < cLeft then
+ begin
+ e := cRight;
+ cRight := cLeft;
+ cLeft := e;
+ end;
+ if cBottom < cTop then
+ begin
+ e := cBottom;
+ cBottom := cTop;
+ cTop := e;
+ end;
+
+ if (c is TfrxLineView) and TfrxLineView(c).Diagonal and
+ (c.Width <> 0) and (c.Height <> 0) then
+ with FSelectionRect do
+ begin
+ Sign := Dist(Left, Top);
+ if Dist(Right, Top) <> Sign then
+ Result := True;
+ if Dist(Left, Bottom) <> Sign then
+ Result := True;
+ if Dist(Right, Bottom) <> Sign then
+ Result := True;
+
+ if Result then
+ Result := RectInRect;
+ end
+ else
+ Result := RectInRect;
+ end;
+
+begin
+ inherited;
+ if FDisableUpdate then Exit;
+ if Button <> TMouseButton.mbLeft then Exit;
+{$IFDEF MACOS}
+ X := X - 2;
+ Y := Y - 2;
+{$ENDIF}
+
+ l := TList.Create;
+ for i := 0 to FSelectedObjects.Count - 1 do
+ l.Add(FSelectedObjects[i]);
+ FMouseDown := False;
+
+// insert an object
+ if FMode = dmInsert then
+ begin
+ with FInsertion do
+ begin
+ R := frxRect(Left, Top, Left + Width, Top + Height);
+ if ((ComponentClass.InheritsFrom(TfrxCustomLineView)) and (Flags = 0)) then
+ begin
+ if Width < 0 then
+ R.Right := Left - Width;
+ if Height < 0 then
+ R.Bottom := Top - Height;
+
+ if (Width < 0) and (Abs(Width) > Abs(Height)) then
+ begin
+ R.Left := Left + Width;
+ R.Right := Left;
+ end;
+ if (Height < 0) and (Abs(Height) > Abs(Width)) then
+ begin
+ R.Top := Top + Height;
+ R.Bottom := Top;
+ end;
+ end
+ else if not ((ComponentClass.InheritsFrom(TfrxLineView)) and (Flags <> 0)) then
+ begin
+ if ((Width >= 0) and (Width < 4)) or ((Height > 0) and (Height < 4)) then
+ R := frxRect(Left, Top, Left + OriginalWidth, Top + OriginalHeight);
+ NormalizeRect(R);
+ end;
+ Left := Round8(R.Left);
+ Top := Round8(R.Top);
+ Width := Round8(R.Right - R.Left);
+ Height := Round8(R.Bottom - R.Top);
+ end;
+ FDrawInsertion := False;
+
+ if Assigned(FOnInsert) then
+ FOnInsert(Self);
+ end;
+
+// select objects that inside of selection rect
+ if FMode1 = dmSelectionRect then
+ begin
+ NormalizeRect(FSelectionRect);
+ FSelectedObjects.Clear;
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if (c is TfrxReportComponent) and not (c is TfrxBand) and Contain(c) then
+ if not (csContainer in c.frComponentStyle) then
+ FSelectedObjects.Add(c)
+ else
+ begin
+ for j := 0 to c.ContainerObjects.Count - 1 do
+ begin
+ c1 := c.ContainerObjects[j];
+ if c1.Visible and Contain(c1) then
+ FSelectedObjects.Add(c1);
+ end;
+ end;
+ end;
+ FDrawSelection := False;
+ if FSelectedObjects.Count = 0 then
+ FSelectedObjects.Add(FPage);
+ Repaint;
+ end;
+
+// round coordinates
+ if FMode1 in [dmMove, dmSize] then
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if (c is TfrxView) and (FMode1 = dmMove) then
+ if FSavedAlign.Count > 0 then
+ begin
+ TfrxView(c).Align := TfrxAlign(FSavedAlign[0]);
+ FSavedAlign.Delete(0);
+ end;
+ c.Left := Round8(c.Left);
+ c.Top := Round8(c.Top);
+ c.Width := Round8(c.Width);
+ c.Height := Round8(c.Height);
+ end;
+ if FMode1 = dmSizeBand then
+ FSizedBand.Height := Round8(FSizedBand.Height);
+
+ // container
+ if FMode1 = dmContainer then
+ begin
+ c := SelectedObjects[0];
+ c.ContainerMouseUp(Self, Round(X), Round(Y));
+ end;
+
+ AdjustBands;
+ if not ListsEqual(l, FSelectedObjects) then
+ SelectionChanged else
+ Repaint;
+ DoModify;
+ l.Free;
+ FCT := ct0;
+ if not ((FMode = dmInsert) and (FInsertion.ComponentClass <> nil)) then
+ FMode1 := dmNone;
+
+ if SelectedCount = 0 then
+ NotifyRect := frxRect(X / FScale, Y / FScale, 0, 0) else
+ NotifyRect := GetSelectionBounds;
+ if Assigned(FOnNotifyPosition) then
+ FOnNotifyPosition(NotifyRect);
+end;
+
+procedure TfrxDesignerWorkspace.DblClick;
+begin
+ inherited;
+ EditObject;
+ FDblClicked := True;
+end;
+
+procedure TfrxDesignerWorkspace.MouseLeave;
+begin
+ if not FMouseDown and (FMode1 = dmInsertObject) then
+ begin
+ FInsertion.Left := -FGridX * 1000;
+ FInsertion.Top := -FGridY * 1000;
+ FDrawInsertion := False;
+ Repaint;
+ end;
+ if not FMouseDown and (FMode1 = dmInsertLine) then
+ begin
+ if FGridType = gtChar then
+ begin
+ FInsertion.Left := - FGridX / 2;
+ FInsertion.Top := - FGridY / 2;
+ end
+ else
+ begin
+ FInsertion.Left := - FGridX;
+ FInsertion.Top := - FGridY;
+ end;
+ Repaint;
+ end;
+ if FMode = dmDrag then
+ SetInsertion(nil, 0, 0, 0);
+end;
+
+procedure TfrxDesignerWorkspace.CheckGuides(var kx, ky: Extended;
+ var Result: Boolean);
+begin
+//
+end;
+
+procedure TfrxDesignerWorkspace.GroupObjects;
+var
+ i, j: Integer;
+ c: TfrxComponent;
+ sl: TStringList;
+begin
+ sl := TfrxStringList.Create;
+ sl.Sorted := True;
+ sl.Duplicates := dupIgnore;
+
+ { reset group index }
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ c.GroupIndex := 0;
+ end;
+
+ { collect available indexes }
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ sl.Add(IntToStr(c.GroupIndex));
+ end;
+
+ { find an unique index }
+ j := 0;
+ repeat
+ Inc(j);
+ until sl.IndexOf(IntToStr(j)) = -1;
+
+ { set group index }
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ c.GroupIndex := j;
+ end;
+
+ sl.Free;
+end;
+
+procedure TfrxDesignerWorkspace.UngroupObjects;
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ c.GroupIndex := 0;
+ end;
+end;
+
+end.
diff --git a/LibD28/FMX.frxDesgnWorkspace.res b/LibD28/FMX.frxDesgnWorkspace.res
new file mode 100644
index 0000000..247c567
Binary files /dev/null and b/LibD28/FMX.frxDesgnWorkspace.res differ
diff --git a/LibD28/FMX.frxDesgnWorkspace1.pas b/LibD28/FMX.frxDesgnWorkspace1.pas
new file mode 100644
index 0000000..7a3c96e
--- /dev/null
+++ b/LibD28/FMX.frxDesgnWorkspace1.pas
@@ -0,0 +1,939 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Designer workspace }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDesgnWorkspace1;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, System.Types, FMX.Types,
+ FMX.Objects, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.frxClass,
+ FMX.frxDesgn, FMX.frxDesgnWorkspace, FMX.frxPopupForm,
+ System.Variants, System.UIConsts, FMX.ListBox
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+ TfrxGuideItem = class(TCollectionItem)
+ public
+ Left, Top, Right, Bottom: Extended;
+ end;
+
+ TfrxVirtualGuides = class(TCollection)
+ private
+ function GetGuides(Index: Integer): TfrxGuideItem;
+ public
+ constructor Create;
+ procedure Add(Left, Top, Right, Bottom: Extended);
+ property Items[Index: Integer]: TfrxGuideItem read GetGuides; default;
+ end;
+
+ TDesignerWorkspace = class(TfrxDesignerWorkspace)
+ private
+ FDesigner: TfrxDesignerForm;
+ FGuide: Integer;
+ FListBox: TListBox;
+ FMemo: TfrxMemoView;
+ FPopupForm: TfrxPopupForm;
+ FPopupFormVisible: Boolean;
+ FShowGuides: Boolean;
+ FSimulateMove: Boolean;
+ FVirtualGuides: TfrxVirtualGuides;
+ FVirtualGuideObjects: TList;
+ FDragObject: TObject;
+ FDragPoint: TPointF;
+ procedure DoLBClick(Sender: TObject);
+ procedure DoPopupHide(Sender: TObject);
+ procedure CreateVirtualGuides;
+ //procedure LBDrawItem(Control: TWinControl; Index: Integer;
+ // ARect: TRect; State: TOwnerDrawState);
+ procedure SetShowGuides(const Value: Boolean);
+ procedure SetHGuides(const Value: TStrings);
+ procedure SetVGuides(const Value: TStrings);
+ function GetHGuides: TStrings;
+ function GetVGuides: TStrings;
+ property HGuides: TStrings read GetHGuides write SetHGuides;
+ property VGuides: TStrings read GetVGuides write SetVGuides;
+ protected
+ procedure CheckGuides(var kx, ky: Extended; var Result: Boolean); override;
+ procedure DragEnter(const Data: TDragObject; const Point: TPointF); override;
+ procedure DragLeave; override;
+ procedure DragEnd; override;
+ procedure DragOver(const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF}); override;
+ procedure DrawObjects; override;
+ procedure DoDraw(ACanvas: TCanvas); override;
+ procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Single); override;
+ procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Single); override;
+ public
+ constructor Create(AOwner: TComponent); overload; override;
+ destructor Destroy; override;
+ procedure DeleteObjects; override;
+ procedure DragDrop(const Data: TDragObject; const Point: TPointF); override;
+ procedure SimulateMove;
+ procedure SetInsertion(AClass: TfrxComponentClass;
+ AWidth, AHeight: Extended; AFlag: Word); override;
+ property ShowGuides: Boolean read FShowGuides write SetShowGuides;
+ end;
+
+implementation
+
+uses
+ FMX.frxFMX, FMX.frxDesgnCtrls, FMX.frxUtils, FMX.frxDataTree, FMX.frxDMPClass, FMX.frxRes, FMX.TreeView, FMX.Platform, FMX.Layouts;
+
+type
+ THackMemo = class(TfrxCustomMemoView);
+
+function Round8(e: Extended): Extended;
+begin
+ Result := Round(e * 100000000) / 100000000;
+end;
+
+function ToIdent(const s: String): String;
+var
+ I: Integer;
+begin
+ Result := '';
+ for i := 1 to Length(s) do
+ if i = 1 then
+ begin
+ if CharInSet(s[i], ['A'..'Z','a'..'z','_']) then
+ Result := Result + s[i]
+ end
+ else if CharInSet(s[i], ['A'..'Z','a'..'z','_','0'..'9']) then
+ Result := Result + s[i];
+ if Length(Result) < Length(s) * 2 div 3 then
+ Result := 'Memo';
+end;
+
+
+{ TfrxVirtualGuides }
+
+constructor TfrxVirtualGuides.Create;
+begin
+ inherited Create(TfrxGuideItem);
+end;
+
+procedure TfrxVirtualGuides.Add(Left, Top, Right, Bottom: Extended);
+var
+ Item: TfrxGuideItem;
+begin
+ Item := TfrxGuideItem(inherited Add);
+ Item.Left := Left;
+ Item.Top := Top;
+ Item.Right := Right;
+ Item.Bottom := Bottom;
+end;
+
+function TfrxVirtualGuides.GetGuides(Index: Integer): TfrxGuideItem;
+begin
+ Result := TfrxGuideItem(inherited Items[Index]);
+end;
+
+
+{ TDesignerWorkspace }
+
+constructor TDesignerWorkspace.Create(AOwner: TComponent);
+begin
+ inherited;
+ FDesigner := TfrxDesignerForm(AOwner);
+ FVirtualGuides := TfrxVirtualGuides.Create;
+ FVirtualGuideObjects := TList.Create;
+end;
+
+destructor TDesignerWorkspace.Destroy;
+begin
+ FVirtualGuides.Free;
+ FVirtualGuideObjects.Free;
+ inherited;
+end;
+
+procedure TDesignerWorkspace.DeleteObjects;
+var
+ i: Integer;
+ NeedReload: Boolean;
+begin
+ NeedReload := False;
+ for i := 0 to FSelectedObjects.Count - 1 do
+ if TObject(FSelectedObjects[i]) is TfrxSubreport then
+ NeedReload := True;
+
+ FMemo := nil;
+ inherited;
+
+ if NeedReload then
+ FDesigner.ReloadPages(FDesigner.Report.Objects.IndexOf(Page));
+end;
+
+procedure TDesignerWorkspace.SetInsertion(AClass: TfrxComponentClass;
+ AWidth, AHeight: Extended; AFlag: Word);
+begin
+ inherited;
+ CreateVirtualGuides;
+end;
+
+procedure TDesignerWorkspace.DrawObjects;
+var
+ r: TRect;
+ i, d: Integer;
+ poly: TPolygon;
+begin
+ if FDesigner.Page is TfrxReportPage then
+ with TfrxReportPage(FDesigner.Page) do
+ if Columns > 1 then
+ for i := 0 to Columns - 1 do
+ begin
+ d := Round(frxStrToFloat(ColumnPositions[i]) * fr01cm * FScale);
+ if d = 0 then continue;
+ FCanvas.Stroke.Color := claSilver;
+ FCanvas.DrawLine(PointF(d, 0), PointF(d, Self.Height), 1);
+ end;
+
+ if FShowGuides and (FPage is TfrxReportPage) then
+ begin
+ with FCanvas do
+ begin
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := $FFFFCC00;
+ //Pen.Mode := pmCopy;
+ end;
+
+ for i := 0 to HGuides.Count - 1 do
+ begin
+ d := Round(frxStrToFloat(HGuides[i]) * Scale);
+ FCanvas.DrawLine(PointF(0, d), PointF(Width, d), 1);
+ end;
+
+ for i := 0 to VGuides.Count - 1 do
+ begin
+ d := Round(frxStrToFloat(VGuides[i]) * Scale);
+ FCanvas.DrawLine(PointF(d, 0), PointF(d, Height), 1);
+ end;
+ end;
+
+ inherited;
+
+ if (FMemo <> nil) and FDesigner.DropFields then
+ with FCanvas do
+ begin
+ r.TopLeft := Point(Round((FMemo.Left + FMemo.Width) * FScale) - 16,
+ Round((FMemo.AbsTop) * FScale) + 2);
+ r.BottomRight := Point(r.Left + 16, r.Top + 16);
+ //DrawButtonFace(FCanvas, r, 1, bsNew, False, False, False);
+ //todo
+ Fill.Color := claBlack;
+ Fill.Kind := TBrushKind.bkSolid;
+ Stroke.Color := claBlack;
+ Stroke.Kind := TBrushKind.bkSolid;
+ SetLength(poly, 4);
+ poly[0] := PointF(r.Left + 4, r.Top + 6);
+ poly[1] := PointF(r.Left + 7, r.Top + 9);
+ poly[2] := PointF(r.Left + 10, r.Top + 6);
+ poly[3] := PointF(r.Left + 4, r.Top + 6);
+ FCanvas.DrawPolygon(poly, 1);
+ end;
+
+
+ if FVirtualGuides.Count > 0 then
+ begin
+ if FMouseDown or (FMode1 = dmInsertObject) or (FMode1 = dmInsertLine) then
+ with FCanvas do
+ begin
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := $FFFFCC00;
+ for i := 0 to FVirtualGuides.Count - 1 do
+ begin
+ FCanvas.DrawLine(
+ PointF(Round(FVirtualGuides[i].Left * Scale) + 0.5, Round(FVirtualGuides[i].Top * Scale) + 0.5),
+ PointF(Round(FVirtualGuides[i].Right * Scale) + 0.5, Round(FVirtualGuides[i].Bottom * Scale) + 0.5), 1);
+ end;
+ end;
+ FVirtualGuides.Clear;
+ end;
+end;
+
+procedure TDesignerWorkspace.DragOver(const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+var
+ ds: TfrxDataset;
+ s, fld: String;
+ w: Integer;
+ X, Y: Single;
+{$IFDEF DELPHI20}
+ Accept: Boolean;
+{$ENDIF}
+begin
+ Accept := ((FDesigner.CheckOp(drDontInsertObject) and
+ (Data.Source is TTreeView) and
+ (TTreeView(Data.Source).Owner = FDesigner.DataTree) and
+ (FDesigner.DataTree.GetFieldName <> '')) or
+ ((Data.Source is TfrxRuler) and FDesigner.ShowGuides)) and (FDesigner.Page is TfrxReportPage);
+ if not Accept then Exit;
+{$IFDEF DELPHI20}
+ Operation := TDragOperation.Copy;
+{$ENDIF}
+ FMode := dmDrag;
+ if Data.Source is TfrxRuler then
+ begin
+ FDragObject := Data.Source;
+ if GridAlign then
+ begin
+ X := Round(Trunc(Point.X / (GridX * Scale)) * GridX * Scale);
+ Y := Round(Trunc(Point.Y / (GridY * Scale)) * GridY * Scale);
+ end
+ else
+ begin
+ X := Point.X;
+ Y := Point.Y;
+ end;
+ FDragPoint := PointF(X, Y);
+ Repaint;
+ MouseMove([], X, Y);
+ end
+ else
+ begin
+ if (FInsertion.ComponentClass = nil) and
+ (FDesigner.DataTree.InsFieldCB.IsChecked or
+ FDesigner.DataTree.InsCaptionCB.IsChecked or
+ not FDesigner.DataTree.IsDataField) then
+ begin
+ s := FDesigner.DataTree.GetFieldName;
+ s := Copy(s, 2, Length(s) - 2);
+ FDesigner.Report.GetDatasetAndField(s, ds, fld);
+ try
+ if (ds <> nil) and (fld <> '') then
+ w := ds.DisplayWidth[fld] else
+ w := 10;
+ except
+ w := 10;
+ end;
+
+ if w > 50 then
+ w := 50;
+
+ SetInsertion(TfrxMemoView, Round(w * 8 / GridX) * GridX,
+ FDesigner.GetDefaultObjectSize.Y, 0);
+ end;
+ MouseMove([], Point.X, Point.Y);
+ end;
+end;
+
+procedure TDesignerWorkspace.DragDrop(const Data: TDragObject; const Point: TPointF);
+var
+ eX, eY: Extended;
+ m: TfrxCustomMemoView;
+ ds: TfrxDataset;
+ s, fld: String;
+begin
+ if (Data.Source is TfrxRuler) and (FPage is TfrxReportPage) then
+ begin
+ if GridAlign then
+ begin
+ eX := Trunc(Point.X / Scale / GridX) * GridX;
+ eY := Trunc(Point.Y / Scale / GridY) * GridY;
+ end
+ else
+ begin
+ eX := Point.X / Scale;
+ eY := Point.Y / Scale;
+ end;
+
+ eX := Round8(eX);
+ eY := Round8(eY);
+
+ if TfrxRuler(Data.Source).Align = TAlignLayout.alLeft then
+ VGuides.Add(FloatToStr(eX)) else
+ HGuides.Add(FloatToStr(eY));
+ FMode := dmSelect;
+ end
+ else if (FDesigner.DataTree.InsFieldCB.IsChecked or
+ FDesigner.DataTree.InsCaptionCB.IsChecked or
+ not FDesigner.DataTree.IsDataField) then
+ begin
+ FSelectedObjects.Clear;
+
+ if Page is TfrxDMPPage then
+ m := TfrxDMPMemoView.Create(Page)
+ else
+ m := TfrxMemoView.Create(Page);
+ s := ToIdent(FDesigner.DataTree.GetFieldName);
+ if (s <> 'Memo') and (FDesigner.Report.FindObject(s) = nil) then
+ m.Name := s
+ else
+ begin
+ THackMemo(m).FBaseName := s;
+ m.CreateUniqueName;
+ end;
+ m.IsDesigning := True;
+ s := FDesigner.DataTree.GetFieldName;
+ s := Copy(s, 2, Length(s) - 2);
+ FDesigner.Report.GetDataSetAndField(s, ds, fld);
+
+ if not FDesigner.DataTree.IsDataField or FDesigner.DataTree.InsFieldCB.IsChecked then
+ begin
+ m.DataSet := ds;
+ m.DataField := fld;
+ if (ds = nil) and (fld = '') then
+ begin
+ if Pos('<', FDesigner.DataTree.GetFieldName) = 1 then
+ m.Text := '[' + s + ']' else
+ m.Text := '[' + FDesigner.DataTree.GetFieldName + ']';
+ end;
+ m.SetBounds(Round8(FInsertion.Left), Round8(FInsertion.Top),
+ Round8(FInsertion.Width), Round8(FInsertion.Height));
+ FDesigner.SampleFormat.ApplySample(m);
+ FObjects.Add(m);
+ FSelectedObjects.Add(m);
+ FInsertion.Top := FInsertion.Top - FInsertion.Height;
+ end
+ else
+ m.Free;
+ if FDesigner.DataTree.IsDataField and FDesigner.DataTree.InsCaptionCB.IsChecked then
+ begin
+ if Page is TfrxDMPPage then
+ m := TfrxDMPMemoView.Create(Page) else
+ m := TfrxMemoView.Create(Page);
+ m.CreateUniqueName;
+ m.IsDesigning := True;
+ m.Text := fld;
+ m.SetBounds(Round8(FInsertion.Left), Round8(FInsertion.Top),
+ Round8(FInsertion.Width), Round8(FInsertion.Height));
+ FDesigner.SampleFormat.ApplySample(m);
+ FObjects.Add(m);
+ FSelectedObjects.Add(m);
+ end;
+
+ if (frxDesignerComp <> nil) and Assigned(frxDesignerComp.OnInsertObject) then
+ frxDesignerComp.OnInsertObject(m);
+ SetInsertion(nil, 0, 0, 0);
+ end;
+
+ FModifyFlag := True;
+ MouseUp(TMouseButton.mbLeft, [], Point.X, Point.Y);
+ SelectionChanged;
+ FDragObject := nil;
+ FDragPoint := PointF(-1, - 1);
+end;
+
+procedure TDesignerWorkspace.DragEnd;
+begin
+ inherited;
+ FDragObject := nil;
+ FDragPoint := PointF(-1, - 1);
+end;
+
+procedure TDesignerWorkspace.DragEnter(const Data: TDragObject;
+ const Point: TPointF);
+begin
+ inherited;
+ FDragObject := Data.Source;
+ FDragPoint := Point;
+end;
+
+procedure TDesignerWorkspace.DragLeave;
+begin
+ inherited;
+ FDragObject := nil;
+ FDragPoint := PointF(-1, - 1);
+end;
+
+procedure TDesignerWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Single);
+var
+ ds: TfrxDataset;
+ r: TRectF;
+ p: TPointF;
+
+ function Contain(c: TfrxComponent): Boolean;
+ begin
+ Result := (X / FScale >= c.Left + c.Width - 16) and (X / FScale <= c.Left + c.Width) and
+ (Y / FScale >= c.AbsTop) and (Y / FScale <= c.AbsTop + 16);
+ end;
+
+begin
+ if FDisableUpdate then Exit;
+ if FPopupFormVisible then FPopupForm.Close;
+
+ if (FMode = dmSelect) and (FMemo <> nil) and Contain(FMemo) and FDesigner.DropFields then
+ begin
+ FPopupForm := TfrxPopupForm.Create(Self);
+ FPopupForm.OnDestroy := DoPopupHide;
+ FListBox := TListBox.Create(FPopupForm);
+ with FListBox do
+ begin
+ Parent := FPopupForm;
+ //Ctl3D := False;
+ Align := TAlignLayout.alClient;
+ //Style := lbOwnerDrawFixed;
+ ItemHeight := 16;
+ OnClick := DoLBClick;
+ //OnDrawItem := LBDrawItem;
+ r.Top := Round(FMemo.AbsTop * FScale) + 18;
+ r.Right := Round((FMemo.Left + FMemo.Width) * FScale);
+ r.Left := r.Right - 140;
+ r.Bottom := r.Top + 162;
+
+ if r.Left < 0 then
+ begin
+ r.Right := r.Right - r.Left;
+ r.Left := 0;
+ end;
+ p := Self.LocalToAbsolute(r.TopLeft);
+ p := GetComponentForm(Self).ClientToScreen(p);
+ FPopupForm.SetBounds(p.Round.X, p.Round.Y, r.Round.Right - r.Round.Left, r.Round.Bottom - r.Round.Top);
+
+ ds := TfrxDataBand(FMemo.Parent).Dataset;
+ if ds <> nil then
+ begin
+ ds.GetFieldList(Items);
+ ItemIndex := Items.IndexOf(FMemo.DataField);
+ FPopupForm.Show;
+ FPopupFormVisible := True;
+ end;
+ end;
+
+ FMode1 := dmNone;
+ FMouseDown := False;
+ Exit;
+ end;
+
+ inherited;
+
+ CreateVirtualGuides;
+end;
+
+procedure TDesignerWorkspace.MouseMove(Shift: TShiftState; X, Y: Single);
+var
+ i: Integer;
+ c, cOver: TfrxComponent;
+ ds: TfrxDataset;
+ e, kx, ky: Extended;
+
+ function Contain(c: TfrxComponent): Boolean;
+ begin
+ Result := (X / FScale >= c.Left) and (X / FScale <= c.Left + c.Width - 4) and
+ (Y / FScale >= c.AbsTop) and (Y / FScale <= c.AbsTop + c.Height);
+ end;
+
+ function GridCheck: Boolean;
+ begin
+ Result := (kx >= GridX) or (kx <= -GridX) or
+ (ky >= GridY) or (ky <= -GridY);
+ if Result then
+ begin
+ kx := Trunc(kx / GridX) * GridX;
+ ky := Trunc(ky / GridY) * GridY;
+ end;
+ end;
+
+begin
+ if FDisableUpdate then Exit;
+ inherited;
+
+ if not FMouseDown and (FMode = dmSelect) and
+ ((FMode1 = dmNone) or (FMode1 = dmMoveGuide)) and not FPopupFormVisible then
+ begin
+ if FPage is TfrxReportPage then
+ begin
+ for i := 0 to HGuides.Count - 1 do
+ begin
+ e := frxStrToFloat(HGuides[i]);
+ if (Y / Scale > e - 5) and (Y / Scale < e + 5) then
+ begin
+ FMode1 := dmMoveGuide;
+ Cursor := crVSplit;
+ FGuide := i;
+ end;
+ end;
+
+ for i := 0 to VGuides.Count - 1 do
+ begin
+ e := frxStrToFloat(VGuides[i]);
+ if (X / Scale > e - 5) and (X / Scale < e + 5) then
+ begin
+ FMode1 := dmMoveGuide;
+ Cursor := crHSplit;
+ FGuide := i;
+ end;
+ end;
+ end;
+
+ if FMode1 = dmNone then
+ begin
+ cOver := nil;
+ for i := FObjects.Count - 1 downto 0 do
+ begin
+ c := FObjects[i];
+ if (c is TfrxMemoView) and Contain(c) and
+ (c.Parent is TfrxDataBand) and
+ (TfrxDataBand(c.Parent).Dataset <> nil) and
+ (TfrxDataBand(c.Parent).Dataset.FieldsCount > 0) then
+ begin
+ ds := TfrxDataBand(c.Parent).Dataset;
+ if ds <> nil then
+ cOver := c;
+ break;
+ end;
+ end;
+
+ if FMemo <> cOver then
+ begin
+ FMemo := TfrxMemoView(cOver);
+ Repaint;
+ end;
+ end;
+ end;
+
+// moving the guideline
+ if FMouseDown and (FMode1 = dmMoveGuide) then
+ begin
+ if Cursor = crHSplit then
+ begin
+ e := frxStrToFloat(VGuides[FGuide]);
+ kx := X / Scale - FLastMousePointX;
+ ky := 0;
+
+ if not (GridAlign and not GridCheck) then
+ begin
+ FModifyFlag := True;
+ e := Round((e + kx) * 100000000) / 100000000;
+ FLastMousePointX := FLastMousePointX + kx;
+ end;
+
+ VGuides[FGuide] := FloatToStr(e);
+ end
+ else
+ begin
+ e := frxStrToFloat(HGuides[FGuide]);
+ kx := 0;
+ ky := Y / Scale - FLastMousePointY;
+
+ if not (GridAlign and not GridCheck) then
+ begin
+ FModifyFlag := True;
+ e := Round((e + ky) * 100000000) / 100000000;
+ FLastMousePointY := FLastMousePointY + ky;
+ end;
+
+ HGuides[FGuide] := FloatToStr(e);
+ end;
+
+ Repaint;
+ end;
+end;
+
+procedure TDesignerWorkspace.MouseUp(Button: TMouseButton;
+ Shift: TShiftState; X, Y: Single);
+var
+ e: Extended;
+begin
+ if FDisableUpdate then Exit;
+ FSimulateMove := False;
+ FVirtualGuideObjects.Clear;
+
+ if FMode1 = dmMoveGuide then
+ begin
+ if Cursor = crHSplit then
+ begin
+ e := frxStrToFloat(VGuides[FGuide]);
+ if (e < 3) or (e > (Width / Scale) - 3) then
+ VGuides.Delete(FGuide);
+ end
+ else
+ begin
+ e := frxStrToFloat(HGuides[FGuide]);
+ if (e < 3) or (e > (Height / Scale) - 3) then
+ HGuides.Delete(FGuide);
+ end;
+
+ Repaint;
+ end;
+
+ inherited;
+end;
+
+procedure TDesignerWorkspace.KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if (Key = VKESCAPE) and FSimulateMove then
+ begin
+ Key := VKDELETE;
+ MouseUp(TMouseButton.mbLeft, [], 0, 0);
+ end;
+ inherited;
+end;
+
+procedure TDesignerWorkspace.SimulateMove;
+var
+ r: TfrxRect;
+begin
+ FMode1 := dmMove;
+ r := GetSelectionBounds;
+ MouseDown(TMouseButton.mbLeft, [], Round(r.Left / Scale) + 20, Round(r.Top / Scale) + 20);
+ FSimulateMove := True;
+end;
+
+procedure TDesignerWorkspace.CreateVirtualGuides;
+var
+ i: Integer;
+begin
+ FVirtualGuideObjects.Clear;
+ for i := 0 to Objects.Count - 1 do
+ FVirtualGuideObjects.Add(Objects[i]);
+end;
+
+procedure TDesignerWorkspace.DoDraw(ACanvas: TCanvas);
+begin
+ inherited;
+ if FDragObject is TfrxRuler then
+ with ACanvas do
+ begin
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := claBlack;
+
+ if TfrxRuler(FDragObject).Align = TAlignLayout.alLeft then
+ DrawLine(PointF(FDragPoint.X, 0), PointF(FDragPoint.X, Self.Height), 1)
+ else
+ DrawLine(PointF(0, FDragPoint.Y), PointF(Self.Width, FDragPoint.Y), 1);
+ end
+end;
+
+procedure TDesignerWorkspace.DoLBClick(Sender: TObject);
+begin
+ if FMemo <> nil then
+ begin
+ FMemo.DataSet := TfrxDataBand(FMemo.Parent).Dataset;
+ FMemo.DataField := FListBox.Items[FListBox.ItemIndex];
+ end;
+ FPopupForm.Close;
+
+ FModifyFlag := True;
+ DoModify;
+end;
+
+procedure TDesignerWorkspace.DoPopupHide(Sender: TObject);
+begin
+ FPopupFormVisible := False;
+end;
+
+//procedure TDesignerWorkspace.LBDrawItem(Control: TWinControl; Index: Integer;
+// ARect: TRect; State: TOwnerDrawState);
+//begin
+// with FListBox do
+// begin
+// Canvas.FillRect(ARect);
+// frxResources.MainButtonImages.Draw(Canvas, ARect.Left, ARect.Top, 54);
+// Canvas.TextOut(ARect.Left + 20, ARect.Top + 1, Items[Index]);
+// end;
+//end;
+
+procedure TDesignerWorkspace.CheckGuides(var kx, ky: Extended;
+ var Result: Boolean);
+var
+ i: Integer;
+ c: TfrxComponent;
+
+ procedure CheckH(coord: Extended);
+ var
+ i: Integer;
+ e: Extended;
+ begin
+ if FPage is TfrxReportPage then
+ for i := 0 to HGuides.Count - 1 do
+ begin
+ e := frxStrToFloat(HGuides[i]);
+ if Abs(coord + ky - e) < 6 then
+ begin
+ ky := e - coord;
+ break;
+ end;
+ end;
+ end;
+
+ procedure CheckV(coord: Extended);
+ var
+ i: Integer;
+ e: Extended;
+ begin
+ if FPage is TfrxReportPage then
+ for i := 0 to VGuides.Count - 1 do
+ begin
+ e := frxStrToFloat(VGuides[i]);
+ if Abs(coord + kx - e) < 6 then
+ begin
+ kx := e - coord;
+ break;
+ end;
+ end;
+ end;
+
+ procedure CheckHH(Left, Top: Extended; Obj: TfrxComponent);
+ var
+ i: Integer;
+ c: TfrxComponent;
+ e: Extended;
+ begin
+ for i := 0 to FVirtualGuideObjects.Count - 1 do
+ begin
+ c := FVirtualGuideObjects[i];
+ if c = Obj then continue;
+ e := c.AbsTop;
+ if Abs(Top + ky - e) < 0.001 then
+ FVirtualGuides.Add(Left, e, c.AbsLeft, e);
+ e := c.AbsTop + c.Height;
+ if Abs(Top + ky - e) < 0.001 then
+ FVirtualGuides.Add(Left, e, c.AbsLeft, e);
+ end;
+ end;
+
+ procedure CheckVV(Left, Top: Extended; Obj: TfrxComponent);
+ var
+ i: Integer;
+ c: TfrxComponent;
+ e: Extended;
+ begin
+ for i := 0 to FVirtualGuideObjects.Count - 1 do
+ begin
+ c := FVirtualGuideObjects[i];
+ if c = Obj then continue;
+ e := c.AbsLeft;
+ if Abs(Left + kx - e) < 0.001 then
+ FVirtualGuides.Add(e, c.AbsTop, e, Top);
+ e := c.AbsLeft + c.Width;
+ if Abs(Left + kx - e) < 0.001 then
+ FVirtualGuides.Add(e, c.AbsTop, e, Top);
+ end;
+ end;
+
+begin
+ if not FShowGuides then Exit;
+
+ FVirtualGuides.Clear;
+
+ if FMouseDown and (FMode1 = dmSizeBand) then
+ CheckH(FSizedBand.Top + FSizedBand.Height);
+
+ if not FMouseDown and ((FMode1 = dmInsertObject) or (FMode1 = dmInsertLine)) then
+ begin
+ CheckV(FInsertion.Left);
+ CheckH(FInsertion.Top);
+ CheckVV(FInsertion.Left, FInsertion.Top, nil);
+ CheckHH(FInsertion.Left, FInsertion.Top, nil);
+ CheckV(FInsertion.Left + FInsertion.Width);
+ CheckH(FInsertion.Top + FInsertion.Height);
+ CheckVV(FInsertion.Left + FInsertion.Width, FInsertion.Top, nil);
+ CheckHH(FInsertion.Left, FInsertion.Top + FInsertion.Height, nil);
+ end;
+
+ if FMouseDown and ((FMode1 = dmInsertObject) or (FMode1 = dmInsertLine)) then
+ begin
+ CheckV(FInsertion.Left);
+ CheckH(FInsertion.Top);
+ CheckVV(FInsertion.Left, FInsertion.Top, nil);
+ CheckHH(FInsertion.Left, FInsertion.Top, nil);
+ end;
+
+ if FMouseDown and (FMode1 = dmMove) then
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ CheckV(c.Left);
+ CheckVV(c.AbsLeft, c.AbsTop, c);
+ CheckHH(c.AbsLeft, c.AbsTop, c);
+ CheckH(c.AbsTop);
+ CheckH(c.Top);
+ CheckV(c.Left + c.Width);
+ CheckVV(c.AbsLeft + c.Width, c.AbsTop, c);
+ CheckHH(c.AbsLeft, c.AbsTop + c.Height, c);
+ CheckH(c.AbsTop + c.Height);
+ end;
+
+ if FMouseDown and (FMode1 = dmSize) then
+ begin
+ c := FSelectedObjects[0];
+ if FCT in [ct1, ct6, ct4] then
+ begin
+ CheckV(c.Left);
+ CheckVV(c.AbsLeft, c.AbsTop, c);
+ end;
+ if FCT in [ct1, ct7, ct3] then
+ begin
+ CheckH(c.AbsTop);
+ CheckHH(c.AbsLeft, c.AbsTop, c);
+ end;
+ if FCT in [ct3, ct5, ct2] then
+ begin
+ CheckV(c.Left + c.Width);
+ CheckVV(c.AbsLeft + c.Width, c.AbsTop, c);
+ end;
+ if FCT in [ct4, ct8, ct2] then
+ begin
+ CheckH(c.AbsTop + c.Height);
+ CheckHH(c.AbsLeft, c.AbsTop + c.Height, c);
+ end;
+ end;
+end;
+
+procedure TDesignerWorkspace.SetShowGuides(const Value: Boolean);
+begin
+ FShowGuides := Value;
+ Repaint;
+ //Invalidate;
+end;
+
+function TDesignerWorkspace.GetHGuides: TStrings;
+begin
+ Result := TfrxReportPage(FPage).HGuides;
+end;
+
+function TDesignerWorkspace.GetVGuides: TStrings;
+begin
+ Result := TfrxReportPage(FPage).VGuides;
+end;
+
+procedure TDesignerWorkspace.SetHGuides(const Value: TStrings);
+begin
+ TfrxReportPage(FPage).HGuides := Value;
+end;
+
+procedure TDesignerWorkspace.SetVGuides(const Value: TStrings);
+begin
+ TfrxReportPage(FPage).VGuides := Value;
+end;
+
+end.
diff --git a/LibD28/FMX.frxDesgn_D23.fmx b/LibD28/FMX.frxDesgn_D23.fmx
new file mode 100644
index 0000000..46a5a7f
--- /dev/null
+++ b/LibD28/FMX.frxDesgn_D23.fmx
@@ -0,0 +1,1800 @@
+object frxDesignerForm: TfrxDesignerForm
+ Left = 0
+ Top = 0
+ Caption = 'Designer'
+ ClientHeight = 610
+ ClientWidth = 988
+ StyleBook = StyleBook1
+ OnActivate = FormActivate
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnCloseQuery = FormCloseQuery
+ OnKeyDown = FormKeyDown
+ OnMouseWheel = FormMouseWheel
+ OnResize = FormResize
+ object StatusBar: TStatusBar
+ Height = 19.000000000000000000
+ Position.Y = 591.000000000000000000
+ ShowSizeGrip = True
+ Width = 988.000000000000000000
+ OnDblClick = StatusBarDblClick
+ OnMouseDown = StatusBarMouseDown
+ end
+ object ObjectsTB1: TToolBar
+ Align = alLeft
+ Height = 513.000000000000000000
+ Position.Y = 78.000000000000000000
+ Width = 27.000000000000000000
+ end
+ object PagePopup: TPopupMenu
+ Left = 760
+ Top = 104
+ end
+ object MainMenu: TMenuBar
+ Align = alMostTop
+ Height = 24.000000000000000000
+ Width = 988.000000000000000000
+ object FileMenu: TMenuItem
+ Height = 24.000000000000000000
+ StyleLookup = 'menubaritemstyle'
+ Width = 16.000000000000000000
+ object NewMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 1
+ Width = 50.000000000000000000
+ OnClick = NewItemCmdExecute
+ end
+ object NewReportMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 1
+ Width = 50.000000000000000000
+ OnClick = NewReportCmdExecute
+ end
+ object NewPageMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 1
+ Width = 50.000000000000000000
+ OnClick = NewPageCmdExecute
+ end
+ object NewDialogMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 1
+ Width = 50.000000000000000000
+ OnClick = NewDialogCmdExecute
+ end
+ object OpenMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 2
+ Width = 50.000000000000000000
+ OnClick = OpenCmdExecute
+ end
+ object SaveMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 2
+ Width = 50.000000000000000000
+ OnClick = SaveCmdExecute
+ end
+ object SaveAsMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 2
+ Width = 50.000000000000000000
+ OnClick = SaveAsCmdExecute
+ end
+ object PreviewMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 3
+ Width = 50.000000000000000000
+ OnClick = PreviewCmdExecute
+ end
+ object PageSettingsMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 3
+ Width = 50.000000000000000000
+ OnClick = PageSettingsCmdExecute
+ end
+ object ExitMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 3
+ Width = 50.000000000000000000
+ OnClick = ExitCmdExecute
+ end
+ end
+ object EditMenu: TMenuItem
+ Height = 24.000000000000000000
+ Position.X = 16.000000000000000000
+ StyleLookup = 'menubaritemstyle'
+ Width = 16.000000000000000000
+ object UndoMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 4
+ Width = 50.000000000000000000
+ OnClick = UndoCmdExecute
+ end
+ object RedoMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 4
+ Width = 50.000000000000000000
+ OnClick = RedoCmdExecute
+ end
+ object CutMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = CutCmdExecute
+ end
+ object CopyMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = CopyCmdExecute
+ end
+ object PasteMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = PasteCmdExecute
+ end
+ object DeleteMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = DeleteCmdExecute
+ end
+ object DeletePageMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = DeletePageCmdExecute
+ end
+ object SelectAllMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = SelectAllCmdExecute
+ end
+ object GroupMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 7
+ Width = 50.000000000000000000
+ OnClick = GroupCmdExecute
+ end
+ object UngroupMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 7
+ Width = 50.000000000000000000
+ OnClick = UngroupCmdExecute
+ end
+ object EditMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 7
+ Width = 50.000000000000000000
+ OnClick = EditCmdExecute
+ end
+ object N2: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 7
+ Width = 50.000000000000000000
+ end
+ object FindMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 8
+ Width = 50.000000000000000000
+ OnClick = FindCmdExecute
+ end
+ object ReplaceMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 8
+ Width = 50.000000000000000000
+ OnClick = ReplaceCmdExecute
+ end
+ object FindNextMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 8
+ Width = 50.000000000000000000
+ OnClick = FindNextCmdExecute
+ end
+ object BringtoFrontMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 9
+ Width = 50.000000000000000000
+ OnClick = BringToFrontCmdExecute
+ end
+ object SendtoBackMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 9
+ Width = 50.000000000000000000
+ OnClick = SendToBackCmdExecute
+ end
+ end
+ object ReportMenu: TMenuItem
+ Height = 24.000000000000000000
+ Position.X = 32.000000000000000000
+ StyleLookup = 'menubaritemstyle'
+ Width = 16.000000000000000000
+ object ReportDataMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = ReportDataCmdExecute
+ end
+ object VariablesMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = VariablesCmdExecute
+ end
+ object ReportStylesMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = ReportStylesCmdExecute
+ end
+ object ReportSettingsMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = ReportOptionsCmdExecute
+ end
+ end
+ object ViewMenu: TMenuItem
+ Height = 24.000000000000000000
+ Position.X = 48.000000000000000000
+ StyleLookup = 'menubaritemstyle'
+ Width = 16.000000000000000000
+ object ShowRulersMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ AutoCheck = True
+ Width = 50.000000000000000000
+ OnClick = ShowRulersCmdExecute
+ end
+ object ShowGuidesMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ AutoCheck = True
+ Width = 50.000000000000000000
+ OnClick = ShowGuidesCmdExecute
+ end
+ object DeleteGuidesMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = DeleteGuidesCmdExecute
+ end
+ object OptionsMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = OptionsCmdExecute
+ end
+ end
+ object HelpMenu: TMenuItem
+ Height = 24.000000000000000000
+ Position.X = 64.000000000000000000
+ StyleLookup = 'menubaritemstyle'
+ Width = 16.000000000000000000
+ object AboutMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = AboutCmdExecute
+ end
+ end
+ end
+ object OpenDialog: TOpenDialog
+ Left = 304
+ Top = 104
+ end
+ object SaveDialog: TSaveDialog
+ Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing]
+ Left = 264
+ Top = 104
+ end
+ object TabPopup: TPopupMenu
+ Left = 832
+ Top = 120
+ object NewPageMI1: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = NewPageCmdExecute
+ TabOrder = 0
+ ShortCut = 0
+ end
+ object NewDialogMI1: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = NewDialogCmdExecute
+ TabOrder = 1
+ ShortCut = 0
+ end
+ object DeletePageMI1: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = DeletePageCmdExecute
+ TabOrder = 2
+ ShortCut = 0
+ end
+ object PageSettingsMI1: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = PageSettingsCmdExecute
+ TabOrder = 3
+ ShortCut = 0
+ end
+ end
+ object BandsPopup: TPopupMenu
+ Left = 936
+ Top = 208
+ object ReportTitleMI: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object ReportSummaryMI: TMenuItem
+ Tag = 1
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object PageHeaderMI: TMenuItem
+ Tag = 2
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object PageFooterMI: TMenuItem
+ Tag = 3
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object HeaderMI: TMenuItem
+ Tag = 4
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object FooterMI: TMenuItem
+ Tag = 5
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object MasterDataMI: TMenuItem
+ Tag = 6
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object DetailDataMI: TMenuItem
+ Tag = 7
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object SubdetailDataMI: TMenuItem
+ Tag = 8
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object Data4levelMI: TMenuItem
+ Tag = 9
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object Data5levelMI: TMenuItem
+ Tag = 10
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object Data6levelMI: TMenuItem
+ Tag = 11
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object GroupHeaderMI: TMenuItem
+ Tag = 12
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object GroupFooterMI: TMenuItem
+ Tag = 13
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object ChildMI: TMenuItem
+ Tag = 14
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object ColumnHeaderMI: TMenuItem
+ Tag = 15
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object ColumnFooterMI: TMenuItem
+ Tag = 16
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object OverlayMI: TMenuItem
+ Tag = 17
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object N3: TMenuItem
+ Height = 50.000000000000000000
+ Text = '-'
+ Width = 50.000000000000000000
+ end
+ object VerticalbandsMI: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ object HeaderMI1: TMenuItem
+ Tag = 104
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object FooterMI1: TMenuItem
+ Tag = 105
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object MasterDataMI1: TMenuItem
+ Tag = 106
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object DetailDataMI1: TMenuItem
+ Tag = 107
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object SubdetailDataMI1: TMenuItem
+ Tag = 108
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object GroupHeaderMI1: TMenuItem
+ Tag = 112
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object GroupFooterMI1: TMenuItem
+ Tag = 113
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object ChildMI1: TMenuItem
+ Tag = 114
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ end
+ end
+ object Timer: TTimer
+ Enabled = False
+ OnTimer = TimerTimer
+ Left = 488
+ Top = 96
+ end
+ object RotationPopup: TPopupMenu
+ Left = 632
+ Top = 96
+ object R0MI: TMenuItem
+ Tag = 30
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object R45MI: TMenuItem
+ Tag = 30
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object R90MI: TMenuItem
+ Tag = 30
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object R180MI: TMenuItem
+ Tag = 30
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object R270MI: TMenuItem
+ Tag = 30
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ end
+ object OpenScriptDialog: TOpenDialog
+ Left = 392
+ Top = 104
+ end
+ object SaveScriptDialog: TSaveDialog
+ Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing]
+ Left = 344
+ Top = 104
+ end
+ object ObjectsPopup: TPopupMenu
+ Left = 880
+ Top = 176
+ end
+ object DMPPopup: TPopupMenu
+ Left = 928
+ Top = 120
+ object BoldMI: TMenuItem
+ Tag = 34
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object ItalicMI: TMenuItem
+ Tag = 35
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object UnderlineMI: TMenuItem
+ Tag = 36
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object SuperScriptMI: TMenuItem
+ Tag = 37
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object SubScriptMI: TMenuItem
+ Tag = 38
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object CondensedMI: TMenuItem
+ Tag = 39
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object WideMI: TMenuItem
+ Tag = 40
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object N12cpiMI: TMenuItem
+ Tag = 41
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object N15cpiMI: TMenuItem
+ Tag = 42
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ end
+ object BackPanel: TPanel
+ Align = alClient
+ Height = 513.000000000000000000
+ Position.X = 27.000000000000000000
+ Position.Y = 78.000000000000000000
+ Width = 961.000000000000000000
+ object ScrollBoxPanel: TPanel
+ Height = 297.000000000000000000
+ Position.X = 65.000000000000000000
+ Position.Y = 95.000000000000000000
+ Width = 297.000000000000000000
+ object ScrollBox: TfrxScrollBox
+ Align = alClient
+ Height = 274.000000000000000000
+ Position.X = 23.000000000000000000
+ Position.Y = 23.000000000000000000
+ StyleLookup = 'ScrollBoxStyle1'
+ Width = 274.000000000000000000
+ OnResize = ScrollBoxResize
+ OnPositionChanged = ScrollBoxResize
+ end
+ object LeftRuler: TfrxRuler
+ Align = alLeft
+ Cursor = crHandPoint
+ DragMode = dmAutomatic
+ Height = 274.000000000000000000
+ Position.Y = 23.000000000000000000
+ Scale = 1.000000000000000000
+ StyleLookup = 'backgroundstyle'
+ Width = 23.000000000000000000
+ OnDragOver = TopRulerDragOver
+ Offset = 0
+ Start = 0
+ Units = ruCM
+ RulerSize = 0
+ end
+ object TopRuler: TfrxRuler
+ Align = alTop
+ Cursor = crHandPoint
+ DragMode = dmAutomatic
+ Height = 23.000000000000000000
+ Scale = 1.000000000000000000
+ StyleLookup = 'backgroundstyle'
+ Width = 297.000000000000000000
+ OnDragOver = TopRulerDragOver
+ Offset = 22
+ Start = 0
+ Units = ruCM
+ RulerSize = 0
+ end
+ end
+ object CodePanel: TPanel
+ Height = 289.000000000000000000
+ Position.X = 394.000000000000000000
+ Position.Y = 98.000000000000000000
+ Width = 377.000000000000000000
+ object CodeTB: TToolBar
+ Height = 25.000000000000000000
+ Width = 377.000000000000000000
+ object OpenScriptB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 169.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = OpenScriptBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object SaveScriptB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 192.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = SaveScriptBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object RunScriptB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 223.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = RunScriptBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object RunToCursorB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 246.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = RunToCursorBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object StepScriptB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 269.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = RunScriptBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object StopScriptB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 292.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = StopScriptBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object EvaluateB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 315.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = EvaluateBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object BreakPointB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 338.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = BreakPointBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object LangCB: TComboEdit
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 48.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 100.000000000000000000
+ Height = 20.000000000000000000
+ OnChange = LangCBClick
+ end
+ end
+ end
+ object TabPanel: TPanel
+ Align = alTop
+ Height = 24.000000000000000000
+ Width = 961.000000000000000000
+ end
+ object RightDockTB: TToolBar
+ Align = alRight
+ Height = 489.000000000000000000
+ Position.X = 816.000000000000000000
+ Position.Y = 24.000000000000000000
+ Width = 145.000000000000000000
+ OnResize = RightDockTBResize
+ end
+ object Splitter1: TSplitter
+ Align = alRight
+ Cursor = crHSplit
+ Height = 489.000000000000000000
+ MinSize = 20.000000000000000000
+ Position.X = 811.000000000000000000
+ Position.Y = 24.000000000000000000
+ Width = 5.000000000000000000
+ end
+ object LeftDockTB: TToolBar
+ Align = alLeft
+ Height = 489.000000000000000000
+ Position.Y = 24.000000000000000000
+ Width = 177.000000000000000000
+ OnResize = LeftDockTBResize
+ end
+ object Splitter2: TSplitter
+ Align = alLeft
+ Cursor = crHSplit
+ Height = 489.000000000000000000
+ MinSize = 20.000000000000000000
+ Position.X = 177.000000000000000000
+ Position.Y = 24.000000000000000000
+ Width = 5.000000000000000000
+ end
+ end
+ object TopToolBox: TToolBar
+ Align = alMostTop
+ Height = 54.000000000000000000
+ Position.Y = 24.000000000000000000
+ TabOrder = 3
+ Width = 988.000000000000000000
+ object AlignTB: TToolBar
+ Align = alNone
+ Height = 27.000000000000000000
+ Position.X = 526.000000000000000000
+ Width = 318.000000000000000000
+ object Grip1: TfrxToolGrip
+ Position.X = 4.000000000000000000
+ Position.Y = 6.000000000000000000
+ Width = 4.000000000000000000
+ Height = 14.000000000000000000
+ end
+ object AlignLeftsB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 8.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignLeftsBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 0
+ end
+ object AlignHorzCentersB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 31.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignHorzCentersBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 1
+ end
+ object AlignRightsB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 54.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignRightsBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 2
+ end
+ object Sep7: TfrxToolSeparator
+ Position.X = 80.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object AlignTopsB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 85.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignTopsBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 3
+ end
+ object AlignVertCentersB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 109.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignVertCentersBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 4
+ end
+ object AlignBottomsB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 131.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignBottomsBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 5
+ end
+ object Sep8: TfrxToolSeparator
+ Position.X = 157.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object SpaceHorzB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 162.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = SpaceHorzBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 6
+ end
+ object SpaceVertB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 185.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = SpaceVertBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 7
+ end
+ object Sep9: TfrxToolSeparator
+ Position.X = 211.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object CenterHorzB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 216.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = CenterHorzBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 8
+ end
+ object CenterVertB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 239.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = CenterVertBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 9
+ end
+ object Sep10: TfrxToolSeparator
+ Position.X = 265.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object SameWidthB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 270.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = SameWidthBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 10
+ end
+ object SameHeightB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 293.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = SameHeightBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 11
+ end
+ end
+ object ExtraToolsTB: TToolBar
+ Align = alNone
+ Height = 27.000000000000000000
+ Position.X = 877.000000000000000000
+ Visible = False
+ Width = 19.000000000000000000
+ end
+ object FrameTB: TToolBar
+ Align = alNone
+ Height = 27.000000000000000000
+ Position.X = 639.000000000000000000
+ Position.Y = 27.000000000000000000
+ Width = 308.000000000000000000
+ object Grip2: TfrxToolGrip
+ Position.X = 4.000000000000000000
+ Position.Y = 6.000000000000000000
+ Width = 4.000000000000000000
+ Height = 14.000000000000000000
+ end
+ object FrameTopB: TfrxToolButton
+ Tag = 20
+ Height = 22.000000000000000000
+ Position.X = 8.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 0
+ end
+ object FrameBottomB: TfrxToolButton
+ Tag = 21
+ Height = 22.000000000000000000
+ Position.X = 31.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 1
+ end
+ object FrameLeftB: TfrxToolButton
+ Tag = 22
+ Height = 22.000000000000000000
+ Position.X = 54.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 2
+ end
+ object FrameRightB: TfrxToolButton
+ Tag = 23
+ Height = 22.000000000000000000
+ Position.X = 77.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 3
+ end
+ object Sep14: TfrxToolSeparator
+ Position.X = 103.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object FrameAllB: TfrxToolButton
+ Tag = 24
+ Height = 22.000000000000000000
+ Position.X = 108.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 4
+ end
+ object FrameNoB: TfrxToolButton
+ Tag = 25
+ Height = 22.000000000000000000
+ Position.X = 131.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 21.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 5
+ end
+ object ShadowB: TfrxToolButton
+ Tag = 32
+ Height = 22.000000000000000000
+ Position.X = 154.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 6
+ end
+ object Sep15: TfrxToolSeparator
+ Position.X = 180.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object FillColorB: TfrxToolButton
+ Tag = 26
+ Height = 22.000000000000000000
+ Position.X = 185.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = FontColorBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 7
+ end
+ object FrameColorB: TfrxToolButton
+ Tag = 27
+ Height = 22.000000000000000000
+ Position.X = 208.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = FontColorBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 8
+ end
+ object FrameStyleB: TfrxToolButton
+ Tag = 28
+ Height = 22.000000000000000000
+ Position.X = 231.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = FrameStyleBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 9
+ end
+ object FrameWidthCB: TComboEdit
+ Tag = 29
+ TabOrder = 10
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ Items.Strings = (
+ '0,1'
+ '0,5'
+ '1'
+ '1,5'
+ '2'
+ '3'
+ '4'
+ '5'
+ '6'
+ '7'
+ '8'
+ '9'
+ '10')
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 256.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 49.000000000000000000
+ Height = 20.000000000000000000
+ OnChange = ToolButtonClick
+ OnKeyDown = FrameWidthCBKeyDown
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ end
+ end
+ object StandardTB: TToolBar
+ Align = alNone
+ Height = 27.000000000000000000
+ Width = 526.000000000000000000
+ object Grip3: TfrxToolGrip
+ Position.X = 4.000000000000000000
+ Position.Y = 6.000000000000000000
+ Width = 4.000000000000000000
+ Height = 14.000000000000000000
+ end
+ object NewB: TfrxToolButton
+ Tag = 40
+ Height = 22.000000000000000000
+ Position.X = 8.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = NewReportCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 0
+ end
+ object OpenB: TfrxToolButton
+ Tag = 41
+ Height = 22.000000000000000000
+ Position.X = 31.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = OpenCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 1
+ end
+ object SaveB: TfrxToolButton
+ Tag = 42
+ Height = 22.000000000000000000
+ Position.X = 54.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = SaveCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 2
+ end
+ object PreviewB: TfrxToolButton
+ Tag = 43
+ Height = 22.000000000000000000
+ Position.X = 77.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = PreviewCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 3
+ end
+ object Sep1: TfrxToolSeparator
+ Position.X = 103.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object NewPageB: TfrxToolButton
+ Tag = 52
+ Height = 22.000000000000000000
+ Position.X = 108.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = NewPageCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 4
+ end
+ object NewDialogB: TfrxToolButton
+ Tag = 70
+ Height = 22.000000000000000000
+ Position.X = 131.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = NewDialogCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 5
+ end
+ object DeletePageB: TfrxToolButton
+ Tag = 53
+ Height = 22.000000000000000000
+ Position.X = 154.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = DeletePageCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 6
+ end
+ object PageSettingsB: TfrxToolButton
+ Tag = 54
+ Height = 22.000000000000000000
+ Position.X = 177.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = PageSettingsCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 7
+ end
+ object Sep2: TfrxToolSeparator
+ Position.X = 203.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object CutB: TfrxToolButton
+ Tag = 44
+ Height = 22.000000000000000000
+ Position.X = 208.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = CutCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 9
+ end
+ object CopyB: TfrxToolButton
+ Tag = 45
+ Height = 22.000000000000000000
+ Position.X = 231.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = CopyCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 10
+ end
+ object PasteB: TfrxToolButton
+ Tag = 46
+ Height = 22.000000000000000000
+ Position.X = 254.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = PasteCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 11
+ end
+ object Sep4: TfrxToolSeparator
+ Position.X = 280.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object UndoB: TfrxToolButton
+ Tag = 47
+ Height = 22.000000000000000000
+ Position.X = 285.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = UndoCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 12
+ end
+ object RedoB: TfrxToolButton
+ Tag = 48
+ Height = 22.000000000000000000
+ Position.X = 308.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = RedoCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 13
+ end
+ object Sep5: TfrxToolSeparator
+ Position.X = 334.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object GroupB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 339.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = GroupCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 14
+ end
+ object UngroupB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 362.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = UngroupCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 15
+ end
+ object Sep6: TfrxToolSeparator
+ Position.X = 388.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object ShowGridB: TfrxToolButton
+ Tag = 55
+ Height = 22.000000000000000000
+ Position.X = 393.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ShowGridBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 16
+ end
+ object AlignToGridB: TfrxToolButton
+ Tag = 56
+ Height = 22.000000000000000000
+ Position.X = 416.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = AlignToGridBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 17
+ end
+ object SetToGridB: TfrxToolButton
+ Tag = 31
+ Height = 22.000000000000000000
+ Position.X = 439.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 18
+ end
+ object ScaleCB: TComboEdit
+ TabOrder = 19
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 465.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 59.000000000000000000
+ Height = 20.000000000000000000
+ OnClick = ScaleCBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ end
+ end
+ object TextTB: TToolBar
+ Align = alNone
+ Height = 27.000000000000000000
+ Position.Y = 27.000000000000000000
+ Width = 639.000000000000000000
+ object Grip4: TfrxToolGrip
+ Position.X = 4.000000000000000000
+ Position.Y = 6.000000000000000000
+ Width = 4.000000000000000000
+ Height = 14.000000000000000000
+ end
+ object StyleCB: TComboEdit
+ Tag = 33
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 8.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 97.000000000000000000
+ Height = 20.000000000000000000
+ OnChange = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ end
+ object FontNameCB: TComboEdit
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 107.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 138.000000000000000000
+ Height = 20.000000000000000000
+ OnChange = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ end
+ object FontSizeCB: TComboEdit
+ Tag = 1
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ Items.Strings = (
+ '5'
+ '6'
+ '7'
+ '8'
+ '9'
+ '10'
+ '11'
+ '12'
+ '14'
+ '16'
+ '18'
+ '20'
+ '22'
+ '24'
+ '26'
+ '28'
+ '36'
+ '48'
+ '72')
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 247.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 43.000000000000000000
+ Height = 20.000000000000000000
+ OnChange = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ end
+ object BoldB: TfrxToolButton
+ Tag = 2
+ Height = 22.000000000000000000
+ Position.X = 293.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 0
+ end
+ object ItalicB: TfrxToolButton
+ Tag = 3
+ Height = 22.000000000000000000
+ Position.X = 316.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 1
+ end
+ object UnderlineB: TfrxToolButton
+ Tag = 4
+ Height = 22.000000000000000000
+ Position.X = 339.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 2
+ end
+ object Sep11: TfrxToolSeparator
+ Position.X = 365.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object FontB: TfrxToolButton
+ Tag = 43
+ Height = 22.000000000000000000
+ Position.X = 370.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 3
+ end
+ object FontColorB: TfrxToolButton
+ Tag = 5
+ Height = 22.000000000000000000
+ Position.X = 393.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = FontColorBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 4
+ end
+ object HighlightB: TfrxToolButton
+ Tag = 6
+ Height = 22.000000000000000000
+ Position.X = 416.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = HighlightBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 5
+ end
+ object RotateB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 439.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = RotateBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 6
+ end
+ object Sep12: TfrxToolSeparator
+ Position.X = 465.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object TextAlignLeftB: TfrxToolButton
+ Tag = 7
+ Height = 22.000000000000000000
+ Position.X = 470.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 7
+ end
+ object TextAlignCenterB: TfrxToolButton
+ Tag = 8
+ Height = 22.000000000000000000
+ Position.X = 493.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 8
+ end
+ object TextAlignRightB: TfrxToolButton
+ Tag = 9
+ Height = 22.000000000000000000
+ Position.X = 516.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 9
+ end
+ object TextAlignBlockB: TfrxToolButton
+ Tag = 10
+ Height = 22.000000000000000000
+ Position.X = 539.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 10
+ end
+ object Sep13: TfrxToolSeparator
+ Position.X = 565.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object TextAlignTopB: TfrxToolButton
+ Tag = 11
+ Height = 22.000000000000000000
+ Position.X = 570.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 11
+ end
+ object TextAlignMiddleB: TfrxToolButton
+ Tag = 12
+ Height = 22.000000000000000000
+ Position.X = 593.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 12
+ end
+ object TextAlignBottomB: TfrxToolButton
+ Tag = 13
+ Height = 22.000000000000000000
+ Position.X = 616.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 13
+ end
+ end
+ end
+ object StyleBook1: TStyleBook
+ Styles = <
+ item
+ ResourcesBin = {
+ 464D585F5354594C4520322E35010611546162436F6E74726F6C315374796C65
+ 31034901060F48696E7450616E656C5374796C6531030A01005450463007544C
+ 61796F757400095374796C654E616D650611546162436F6E74726F6C31537479
+ 6C65310A506F736974696F6E2E5805000000000000008B07400A506F73697469
+ 6F6E2E5905000000000000809007400A53697A652E5769647468050000000000
+ 00008E06400B53697A652E4865696768740500000000000000CA05401453697A
+ 652E506C6174666F726D44656661756C7408000A5452656374616E676C650005
+ 416C69676E0708436F6E74656E74730A46696C6C2E436F6C6F720708636C6157
+ 686974650748697454657374080553696465730B03546F70044C656674055269
+ 676874000A53697A652E576964746805000000000000008E06400B53697A652E
+ 4865696768740500000000000000CA05401453697A652E506C6174666F726D44
+ 656661756C74080C5374726F6B652E436F6C6F72070978464638453845384500
+ 000054504630115443616C6C6F757452656374616E676C6500095374796C654E
+ 616D65060F48696E7450616E656C5374796C65310A46696C6C2E436F6C6F7207
+ 08636C6142656967650748697454657374080A506F736974696F6E2E58050000
+ 00000000008B08400A506F736974696F6E2E590500000000000000A607400A53
+ 697A652E57696474680500000000000000C804400B53697A652E486569676874
+ 0500000000000000C804401453697A652E506C6174666F726D44656661756C74
+ 080C5374726F6B652E436F6C6F7207097846463937393739370C43616C6C6F75
+ 7457696474680500000000000000B803400D43616C6C6F75744C656E67746805
+ 00000000000000B002400000}
+ end>
+ Left = 32
+ Top = 120
+ end
+ object HintPanel: TCalloutPanel
+ Height = 57.000000000000000000
+ Margins.Top = 11.000000000000000000
+ Position.X = 520.000000000000000000
+ Position.Y = 400.000000000000000000
+ StyleLookup = 'HintPanelStyle1'
+ Visible = False
+ Width = 97.000000000000000000
+ CalloutWidth = 23.000000000000000000
+ CalloutLength = 11.000000000000000000
+ object Label1: TLabel
+ Align = alClient
+ Height = 46.000000000000000000
+ Position.Y = 11.000000000000000000
+ Text = 'Label1'
+ TextAlign = taCenter
+ Width = 97.000000000000000000
+ end
+ end
+end
diff --git a/LibD28/FMX.frxDialogForm.fmx b/LibD28/FMX.frxDialogForm.fmx
new file mode 100644
index 0000000..423d7c0
--- /dev/null
+++ b/LibD28/FMX.frxDialogForm.fmx
@@ -0,0 +1,10 @@
+object frxDialogForm: TfrxDialogForm
+ Left = 0
+ Top = 0
+ Caption = ' '
+ ClientHeight = 59
+ ClientWidth = 115
+ Visible = False
+ OnCloseQuery = FormCloseQuery
+ StyleLookup = 'backgroundstyle'
+end
diff --git a/LibD28/FMX.frxDialogForm.pas b/LibD28/FMX.frxDialogForm.pas
new file mode 100644
index 0000000..59e0191
--- /dev/null
+++ b/LibD28/FMX.frxDialogForm.pas
@@ -0,0 +1,98 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Dialog form }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDialogForm;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.UITypes,
+ FMX.Controls, FMX.Forms
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm, System.SysUtils, System.Types
+{$ENDIF}
+ ;
+
+
+type
+{$IFDEF LINUX}
+ TfrxDialogForm = class(TfrxForm)
+{$ELSE}
+ TfrxDialogForm = class(TForm)
+{$ENDIF}
+ procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+ protected
+ procedure ReadState(Reader: TReader); override;
+ private
+ FOnModify: TNotifyEvent;
+ FThreadSafe: Boolean;
+ public
+ constructor Create(AOwner: TComponent); override;
+ property OnModify: TNotifyEvent read FOnModify write FOnModify;
+ property ThreadSafe: Boolean read FThreadSafe write FThreadSafe;
+{$IFDEF LINUX}
+ function ShowModal: TModalResult; overload;
+{$ENDIF}
+ end;
+
+implementation
+
+{$R *.FMX}
+
+{procedure TfrxDialogForm.WMExitSizeMove(var Msg: TMessage);
+begin
+ inherited;
+ if Assigned(OnModify) then
+ OnModify(Self);
+end;}
+
+procedure TfrxDialogForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+begin
+ CanClose := False;
+end;
+
+procedure TfrxDialogForm.ReadState(Reader: TReader);
+begin
+ if not ThreadSafe then
+ inherited ReadState(Reader);
+end;
+
+constructor TfrxDialogForm.Create(AOwner: TComponent);
+begin
+ if AOwner <> nil then
+ FThreadSafe := AOwner.Tag = 318;
+ AOwner := nil;
+
+ inherited CreateNew(AOwner);
+end;
+{$IFDEF LINUX}
+function TfrxDialogForm.ShowModal: TModalResult;
+var FDefaultWindowRect: TRectF;
+begin
+
+ if BorderStyle = TFmxFormBorderStyle.Single then
+ if GnomeAndRedHat then
+ begin
+ FDefaultWindowRect := TRectF.Create(0, 0,
+ ClientWidth,
+ ScaleWidthOrHeightForm(ClientHeight, 1.35));
+ FWinService.SetWindowRect(self, FDefaultWindowRect);
+ Height := Round(FDefaultWindowRect.Height);
+ end;
+
+ Result := inherited;
+end;
+{$ENDIF}
+end.
diff --git a/LibD28/FMX.frxDsgnIntf.pas b/LibD28/FMX.frxDsgnIntf.pas
new file mode 100644
index 0000000..c873b41
--- /dev/null
+++ b/LibD28/FMX.frxDsgnIntf.pas
@@ -0,0 +1,1789 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Design interface }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDsgnIntf;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.SysUtils, System.TypInfo, System.Types, System.Variants,
+ System.UIConsts, System.UITypes, FMX.Types, FMX.Menus, FMX.Colors,
+ FMX.frxClass, FMX.frxFMX
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+ TfrxPropertyAttribute = (paValueList, paSortList, paDialog,
+ paMultiSelect, paSubProperties, paReadOnly, paOwnerDraw);
+ TfrxPropertyAttributes = set of TfrxPropertyAttribute;
+
+ TfrxPropertyEditor = class(TObject)
+ private
+ FDesigner: TfrxCustomDesigner;
+ FCompList: TList;
+ FPropList: TList;
+ FItemHeight: Integer;
+ FValues: TStrings;
+ function GetPropInfo: PPropInfo;
+ function GetComponent: TPersistent;
+ function GetfrComponent: TfrxComponent;
+ protected
+ procedure GetStrProc(const s: String);
+ function GetFloatValue: Extended;
+ function GetOrdValue: NativeInt;
+ function GetStrValue: String;
+ function GetVarValue: Variant;
+ procedure SetFloatValue(Value: Extended);
+ procedure SetOrdValue(Value: frxInteger);
+ procedure SetStrValue(const Value: String);
+ procedure SetVarValue(Value: Variant);
+ public
+ constructor Create(Designer: TfrxCustomDesigner); virtual;
+ destructor Destroy; override;
+ function Edit: Boolean; virtual;
+ function GetAttributes: TfrxPropertyAttributes; virtual;
+ function GetName: String; virtual;
+ function GetExtraLBSize: Integer; virtual;
+ function GetValue: String; virtual;
+ procedure GetValues; virtual;
+ procedure SetValue(const Value: String); virtual;
+ procedure OnDrawLBItem(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF); virtual;
+ procedure OnDrawItem(Canvas: TCanvas; ARect: TRectF); virtual;
+ property Component: TPersistent read GetComponent;
+ property frComponent: TfrxComponent read GetfrComponent;
+ property Designer: TfrxCustomDesigner read FDesigner;
+ property ItemHeight: Integer read FItemHeight write FItemHeight;
+ property PropInfo: PPropInfo read GetPropInfo;
+ property Value: String read GetValue write SetValue;
+ property Values: TStrings read FValues;
+ end;
+
+ TfrxPropertyEditorClass = class of TfrxPropertyEditor;
+
+ TfrxComponentEditor = class(TObject)
+ private
+ FComponent: TfrxComponent;
+ FDesigner: TfrxCustomDesigner;
+ FMenu: TPopupMenu;
+ FOnClick: TNotifyEvent;
+ protected
+ function AddItem(const Caption: String; Tag: Integer;
+ Checked: Boolean = False): TMenuItem;
+ public
+ constructor Create(Component: TfrxComponent; Designer: TfrxCustomDesigner;
+ Menu: TPopupMenu);
+ function Edit: Boolean; virtual;
+ function HasEditor: Boolean; virtual;
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); virtual;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; virtual;
+ property Component: TfrxComponent read FComponent;
+ property Designer: TfrxCustomDesigner read FDesigner;
+ end;
+
+ TfrxComponentEditorClass = class of TfrxComponentEditor;
+
+ TfrxIntegerProperty = class(TfrxPropertyEditor)
+ public
+ function GetValue: String; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxFloatProperty = class(TfrxPropertyEditor)
+ public
+ function GetValue: String; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxCharProperty = class(TfrxPropertyEditor)
+ public
+ function GetValue: String; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxStringProperty = class(TfrxPropertyEditor)
+ public
+ function GetValue: String; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxEnumProperty = class(TfrxPropertyEditor)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function GetValue: String; override;
+ procedure GetValues; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxSetProperty = class(TfrxPropertyEditor)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function GetValue: String; override;
+ end;
+
+ TfrxSetElementProperty = class(TfrxPropertyEditor)
+ private
+ FElement: Integer;
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function GetName: String; override;
+ function GetValue: String; override;
+ procedure GetValues; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxClassProperty = class(TfrxPropertyEditor)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function GetValue: String; override;
+ end;
+
+ TfrxComponentProperty = class(TfrxPropertyEditor)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function GetValue: String; override;
+ procedure GetValues; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ end;
+
+ TfrxColorProperty = class(TfrxIntegerProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function GetValue: String; override;
+ procedure GetValues; override;
+ procedure SetValue(const Value: String); override;
+ procedure OnDrawLBItem(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF); override;
+ procedure OnDrawItem(Canvas: TCanvas; ARect: TRectF); override;
+ end;
+
+ TfrxFontProperty = class(TfrxClassProperty)
+ public
+ function Edit: Boolean; override;
+ function GetAttributes: TfrxPropertyAttributes; override;
+ end;
+
+ TfrxFontNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ end;
+
+ TfrxModalResultProperty = class(TfrxIntegerProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function GetValue: String; override;
+ procedure GetValues; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxCursorProperty = class(TfrxIntegerProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function GetValue: String; override;
+ procedure GetValues; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxDateTimeProperty = class(TfrxPropertyEditor)
+ public
+ function GetValue: String; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxDateProperty = class(TfrxPropertyEditor)
+ public
+ function GetValue: String; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxTimeProperty = class(TfrxPropertyEditor)
+ public
+ function GetValue: String; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+{ Internal classes used by Object Inspector }
+
+ TfrxPropertyList = class;
+
+ TfrxPropertyItem = class(TCollectionItem)
+ private
+ FEditor: TfrxPropertyEditor;
+ FExpanded: Boolean;
+ FSubProperty: TfrxPropertyList;
+ public
+ destructor Destroy; override;
+ property Editor: TfrxPropertyEditor read FEditor;
+ property Expanded: Boolean read FExpanded write FExpanded;
+ property SubProperty: TfrxPropertyList read FSubProperty;
+ end;
+
+ TfrxPropertyList = class(TCollection)
+ private
+ FComponent: TPersistent;
+ FDesigner: TfrxCustomDesigner;
+ FParent: TfrxPropertyList;
+ procedure AddProperties(PropertyList: TfrxPropertyList);
+ procedure FillProperties(AClass: TPersistent);
+ procedure FillCommonProperties(PropertyList: TfrxPropertyList);
+ procedure SetComponent(Value: TPersistent);
+ function GetPropertyItem(Index: Integer): TfrxPropertyItem;
+ public
+ constructor Create(Designer: TfrxCustomDesigner);
+ function Add: TfrxPropertyItem;
+ property Component: TPersistent read FComponent write SetComponent;
+ property Items[Index: Integer]: TfrxPropertyItem read GetPropertyItem; default;
+ property Parent: TfrxPropertyList read FParent;
+ end;
+
+
+{ registered items }
+
+ TfrxObjectCategory = (ctData, ctReport, ctDialog, ctDMP);
+ TfrxObjectCategories = set of TfrxObjectCategory;
+
+ TfrxObjectItem = class(TCollectionItem)
+ public
+ ClassRef: TfrxComponentClass;
+ ButtonBmp: TBitmap;
+ ButtonImageIndex: Integer;
+ ButtonHint: String;
+ CategoryName: String;
+ Flags: Word;
+ Category: TfrxObjectCategories;
+ end;
+
+ TfrxComponentEditorItem = class(TCollectionItem)
+ public
+ ComponentClass: TfrxComponentClass;
+ ComponentEditor: TfrxComponentEditorClass;
+ end;
+
+ TfrxPropertyEditorItem = class(TCollectionItem)
+ public
+ PropertyType: PTypeInfo;
+ ComponentClass: TClass;
+ PropertyName: String;
+ EditorClass: TfrxPropertyEditorClass;
+ end;
+
+ TfrxExportFilterItem = class(TCollectionItem)
+ public
+ Filter: TfrxCustomExportFilter;
+ end;
+
+ TfrxWizardItem = class(TCollectionItem)
+ public
+ ClassRef: TfrxWizardClass;
+ ButtonBmp: TBitmap;
+ ButtonImageIndex: Integer;
+ IsToolbarWizard: Boolean;
+ end;
+
+ TfrxObjectCollection = class(TCollection)
+ private
+ function GetObjectItem(Index: Integer): TfrxObjectItem;
+ public
+ constructor Create;
+ procedure RegisterCategory(const CategoryName: String; ButtonBmp: TBitmap;
+ const ButtonHint: String; ImageIndex: Integer = -1);
+ procedure RegisterObject(ClassRef: TfrxComponentClass; ButtonBmp: TBitmap;
+ const CategoryName: String = '');
+ procedure RegisterObject1(ClassRef: TfrxComponentClass; ButtonBmp: TBitmap;
+ const ButtonHint: String = ''; const CategoryName: String = '';
+ Flags: Integer = 0; ImageIndex: Integer = -1;
+ Category: TfrxObjectCategories = []);
+ procedure Unregister(ClassRef: TfrxComponentClass);
+ property Items[Index: Integer]: TfrxObjectItem read GetObjectItem; default;
+ end;
+
+ TfrxComponentEditorCollection = class(TCollection)
+ private
+ function GetComponentEditorItem(Index: Integer): TfrxComponentEditorItem;
+ public
+ constructor Create;
+ procedure Register(ComponentClass: TfrxComponentClass;
+ ComponentEditor: TfrxComponentEditorClass);
+ procedure UnRegister(ComponentEditor: TfrxComponentEditorClass);
+ function GetComponentEditor(Component: TfrxComponent;
+ Designer: TfrxCustomDesigner; Menu: TPopupMenu): TfrxComponentEditor;
+ property Items[Index: Integer]: TfrxComponentEditorItem
+ read GetComponentEditorItem; default;
+ end;
+
+ TfrxPropertyEditorCollection = class(TCollection)
+ private
+ FEventEditorItem: Integer;
+ function GetPropertyEditorItem(Index: Integer): TfrxPropertyEditorItem;
+ public
+ constructor Create;
+ procedure Register(PropertyType: PTypeInfo; ComponentClass: TClass;
+ const PropertyName: String; EditorClass: TfrxPropertyEditorClass);
+ procedure RegisterEventEditor(EditorClass: TfrxPropertyEditorClass);
+ procedure UnRegister(EditorClass: TfrxPropertyEditorClass);
+ function GetPropertyEditor(PropertyType: PTypeInfo; Component: TPersistent;
+ PropertyName: String): Integer;
+ property Items[Index: Integer]: TfrxPropertyEditorItem
+ read GetPropertyEditorItem; default;
+ end;
+
+ TfrxExportFilterCollection = class(TCollection)
+ private
+ function GetExportFilterItem(Index: Integer): TfrxExportFilterItem;
+ public
+ constructor Create;
+ procedure Register(Filter: TfrxCustomExportFilter);
+ procedure Unregister(Filter: TfrxCustomExportFilter);
+ property Items[Index: Integer]: TfrxExportFilterItem
+ read GetExportFilterItem; default;
+ end;
+
+ TfrxWizardCollection = class(TCollection)
+ private
+ function GetWizardItem(Index: Integer): TfrxWizardItem;
+ public
+ constructor Create;
+ procedure Register(ClassRef: TfrxWizardClass; ButtonBmp: TBitmap;
+ IsToolbarWizard: Boolean = False);
+ procedure Register1(ClassRef: TfrxWizardClass; ImageIndex: Integer);
+ procedure Unregister(ClassRef: TfrxWizardClass);
+ property Items[Index: Integer]: TfrxWizardItem read GetWizardItem; default;
+ end;
+
+
+{ internal methods }
+
+function frxCreatePropertyList(ComponentList: TList; Designer: TfrxCustomDesigner): TfrxPropertyList;
+procedure frxHideProperties(ComponentClass: TClass; const Properties: String);
+
+
+function frxObjects: TfrxObjectCollection;
+function frxComponentEditors: TfrxComponentEditorCollection;
+function frxPropertyEditors: TfrxPropertyEditorCollection;
+function frxExportFilters: TfrxExportFilterCollection;
+function frxWizards: TfrxWizardCollection;
+
+
+implementation
+
+uses
+ FMX.frxUtils, FMX.frxRes, FMX.ListBox, FMX.frxFontForm;
+
+type
+ TIntegerSet = set of 0..31;
+
+var
+ FObjects: TfrxObjectCollection = nil;
+ FComponentEditors: TfrxComponentEditorCollection = nil;
+ FPropertyEditors: TfrxPropertyEditorCollection = nil;
+ FExportFilters: TfrxExportFilterCollection = nil;
+ FWizards: TfrxWizardCollection = nil;
+
+{ Routines }
+
+procedure frxHideProperties(ComponentClass: TClass; const Properties: String);
+var
+ i: Integer;
+ sl: TStringList;
+begin
+ sl := TStringList.Create;
+ frxSetCommaText(Properties, sl);
+
+ for i := 0 to sl.Count - 1 do
+ frxPropertyEditors.Register(nil, ComponentClass, sl[i], nil);
+
+ sl.Free;
+end;
+
+function frxCreatePropertyList(ComponentList: TList;
+ Designer: TfrxCustomDesigner): TfrxPropertyList;
+var
+ i: Integer;
+ p: TfrxPropertyList;
+ l: TList;
+begin
+ if ComponentList.Count = 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ l := TList.Create;
+ for i := 0 to ComponentList.Count - 1 do
+ begin
+ p := TfrxPropertyList.Create(Designer);
+ l.Add(p);
+ p.Component := ComponentList[i];
+ end;
+
+ Result := l[0];
+ for i := 1 to ComponentList.Count - 1 do
+ Result.FillCommonProperties(TfrxPropertyList(l[i]));
+
+ for i := 1 to ComponentList.Count - 1 do
+ begin
+ TfrxPropertyList(l[i]).FillCommonProperties(Result);
+ Result.AddProperties(TfrxPropertyList(l[i]));
+ TfrxPropertyList(l[i]).Free;
+ end;
+
+ l.Free;
+end;
+
+function frStrToFloat(s: String): Extended;
+var
+ i: Integer;
+begin
+ for i := 1 to Length(s) do
+ if CharInSet(s[i], [',', '.']) then
+ s[i] := FormatSettings.DecimalSeparator;
+ Result := StrToFloat(Trim(s));
+end;
+
+
+{ TfrxPropertyEditor }
+
+constructor TfrxPropertyEditor.Create(Designer: TfrxCustomDesigner);
+begin
+ FDesigner := Designer;
+ FCompList := TList.Create;
+ FPropList := TList.Create;
+ FValues := TfrxStringList.Create;
+end;
+
+destructor TfrxPropertyEditor.Destroy;
+begin
+ FCompList.Free;
+ FPropList.Free;
+ FValues.Free;
+ inherited;
+end;
+
+function TfrxPropertyEditor.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect];
+end;
+
+function TfrxPropertyEditor.GetName: String;
+begin
+ Result := String(PropInfo.Name);
+end;
+
+function TfrxPropertyEditor.GetComponent: TPersistent;
+begin
+ Result := FCompList[0];
+end;
+
+function TfrxPropertyEditor.GetfrComponent: TfrxComponent;
+begin
+ if TObject(FCompList[0]) is TfrxComponent then
+ Result := FCompList[0] else
+ Result := nil;
+end;
+
+function TfrxPropertyEditor.GetPropInfo: PPropInfo;
+begin
+ Result := FPropList[0];
+end;
+
+function TfrxPropertyEditor.GetValue: String;
+begin
+ Result := '(Unknown)';
+end;
+
+procedure TfrxPropertyEditor.SetValue(const Value: String);
+begin
+ { empty method }
+end;
+
+function TfrxPropertyEditor.GetFloatValue: Extended;
+begin
+ Result := GetFloatProp(Component, PropInfo);
+end;
+
+function TfrxPropertyEditor.GetOrdValue: NativeInt;
+begin
+ Result := GetOrdProp(Component, PropInfo);
+end;
+
+function TfrxPropertyEditor.GetStrValue: String;
+begin
+ Result := GetStrProp(Component, PropInfo);
+end;
+
+function TfrxPropertyEditor.GetVarValue: Variant;
+begin
+ Result := GetVariantProp(Component, PropInfo);
+end;
+
+procedure TfrxPropertyEditor.SetFloatValue(Value: Extended);
+var
+ i: Integer;
+begin
+ for i := 0 to FCompList.Count - 1 do
+ if (PPropInfo(FPropList[i]).SetProc <> nil) then
+ SetFloatProp(TObject(FCompList[i]), PPropInfo(FPropList[i]), Value);
+end;
+
+procedure TfrxPropertyEditor.SetOrdValue(Value: frxInteger);
+var
+ i: Integer;
+begin
+ for i := 0 to FCompList.Count - 1 do
+ if (PPropInfo(FPropList[i]).SetProc <> nil) then
+ SetOrdProp(TObject(FCompList[i]), PPropInfo(FPropList[i]), Value);
+end;
+
+procedure TfrxPropertyEditor.SetStrValue(const Value: String);
+var
+ i: Integer;
+begin
+ for i := 0 to FCompList.Count - 1 do
+ if (PPropInfo(FPropList[i]).SetProc <> nil) then
+ SetStrProp(TObject(FCompList[i]), PPropInfo(FPropList[i]), Value);
+end;
+
+procedure TfrxPropertyEditor.SetVarValue(Value: Variant);
+var
+ i: Integer;
+begin
+ for i := 0 to FCompList.Count - 1 do
+ if (PPropInfo(FPropList[i]).SetProc <> nil) then
+ SetVariantProp(TObject(FCompList[i]), PPropInfo(FPropList[i]), Value);
+end;
+
+procedure TfrxPropertyEditor.GetValues;
+begin
+ FValues.Clear;
+ TStringList(FValues).Sorted := paSortList in GetAttributes;
+end;
+
+procedure TfrxPropertyEditor.GetStrProc(const s: String);
+begin
+ FValues.Add(s);
+end;
+
+function TfrxPropertyEditor.Edit: Boolean;
+var
+ i: Integer;
+begin
+ Result := False;
+ GetValues;
+ if FValues.Count > 0 then
+ begin
+ i := FValues.IndexOf(Value) + 1;
+ if i = FValues.Count then
+ i := 0;
+ Value := FValues[i];
+ Result := True;
+ end;
+end;
+
+procedure TfrxPropertyEditor.OnDrawLBItem(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF);
+begin
+ with Canvas do
+ begin
+ Fill.Kind := TBrushKind.bkSolid;
+ Fill.Color := claWhite;
+ FillRect(ARect, 0, 0, allCorners, 1);
+ Fill.Color := claBlack;
+ FillText(RectF(ARect.Left + FItemHeight + 4, ARect.Top + 1, ARect.Right, ARect.Bottom),
+ TListBoxItem(Sender).Text, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ end;
+end;
+
+procedure TfrxPropertyEditor.OnDrawItem(Canvas: TCanvas; ARect: TRectF);
+begin
+ with Canvas do
+ begin
+ Fill.Kind := TBrushKind.bkSolid;
+ FillText(RectF(ARect.Left + FItemHeight - 2, ARect.Top, ARect.Right, ARect.Bottom), Value, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ end;
+end;
+
+function TfrxPropertyEditor.GetExtraLBSize: Integer;
+begin
+ Result := FItemHeight + 2;
+end;
+
+
+{ TfrxComponentEditor }
+
+function TfrxComponentEditor.Edit: Boolean;
+begin
+ Result := False;
+end;
+
+procedure TfrxComponentEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ SepMI: TMenuItem;
+begin
+ SepMI := TMenuItem.Create(FMenu);
+ SepMI.Text := '-';
+ SepMI.Parent := FMenu;
+ FOnClick := OnClickEvent;
+end;
+
+function TfrxComponentEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+begin
+ Result := False;
+end;
+
+function TfrxComponentEditor.HasEditor: Boolean;
+begin
+ Result := False;
+end;
+
+function TfrxComponentEditor.AddItem(const Caption: String; Tag: Integer;
+ Checked: Boolean): TMenuItem;
+begin
+ Result := TMenuItem.Create(FMenu);
+ Result.Text := Caption;
+ Result.Tag := Tag;
+ Result.IsChecked := Checked;
+ Result.OnClick := FOnClick;
+ FMenu.AddObject(Result);
+end;
+
+
+constructor TfrxComponentEditor.Create(Component: TfrxComponent;
+ Designer: TfrxCustomDesigner; Menu: TPopupMenu);
+begin
+ FComponent := Component;
+ FDesigner := Designer;
+ FMenu := Menu;
+ FOnClick := nil;
+end;
+
+
+{ TfrxPropertyList }
+
+constructor TfrxPropertyList.Create(Designer: TfrxCustomDesigner);
+begin
+ inherited Create(TfrxPropertyItem);
+ FDesigner := Designer;
+end;
+
+function TfrxPropertyList.GetPropertyItem(Index: Integer): TfrxPropertyItem;
+begin
+ Result := TfrxPropertyItem(inherited Items[Index]);
+end;
+
+function TfrxPropertyList.Add: TfrxPropertyItem;
+begin
+ Result := TfrxPropertyItem(inherited Add);
+end;
+
+procedure TfrxPropertyList.SetComponent(Value: TPersistent);
+begin
+ FComponent := Value;
+ Clear;
+ FillProperties(FComponent);
+end;
+
+procedure TfrxPropertyList.FillProperties(AClass: TPersistent);
+var
+ Item, Item1: TfrxPropertyItem;
+ TypeInfo: PTypeInfo;
+ PropertyCount: Integer;
+ PropertyList: PPropList;
+ i, j: Integer;
+ FClass: TClass;
+
+ function CreateEditor(EditorClass: TfrxPropertyEditorClass; AClass: TPersistent;
+ PropInfo: PPropInfo): TfrxPropertyEditor;
+ var
+ Item: TfrxPropertyEditorItem;
+ e: Integer;
+ begin
+ Result := nil;
+ e := frxPropertyEditors.GetPropertyEditor(PropInfo.PropType^, AClass, String(PropInfo.Name));
+ if e <> -1 then
+ begin
+ Item := frxPropertyEditors[e];
+ if Item.EditorClass <> nil then
+ Result := TfrxPropertyEditor(Item.EditorClass.NewInstance) else
+ Exit;
+ end
+ else
+ Result := TfrxPropertyEditor(EditorClass.NewInstance);
+
+ Result.Create(FDesigner);
+ Result.FCompList.Add(AClass);
+ Result.FPropList.Add(PropInfo);
+ end;
+
+begin
+ if AClass = nil then exit;
+
+ TypeInfo := AClass.ClassInfo;
+ PropertyCount := GetPropList(TypeInfo, tkProperties, nil);
+ GetMem(PropertyList, PropertyCount * SizeOf(PPropInfo));
+ GetPropList(TypeInfo, tkProperties, PropertyList);
+
+ for i := 0 to PropertyCount - 1 do
+ begin
+ Item := Add;
+ case PropertyList[i].PropType^.Kind of
+ tkInteger:
+ Item.FEditor := CreateEditor(TfrxIntegerProperty, AClass, PropertyList[i]);
+
+ tkChar, tkWChar:
+ Item.FEditor := CreateEditor(TfrxCharProperty, AClass, PropertyList[i]);
+
+ tkFloat:
+ Item.FEditor := CreateEditor(TfrxFloatProperty, AClass, PropertyList[i]);
+
+ tkString, tkLString, tkWString, tkUString:
+ Item.FEditor := CreateEditor(TfrxStringProperty, AClass, PropertyList[i]);
+
+ tkEnumeration:
+ Item.FEditor := CreateEditor(TfrxEnumProperty, AClass, PropertyList[i]);
+
+ tkSet:
+ begin
+ Item.FSubProperty := TfrxPropertyList.Create(FDesigner);
+ Item.FSubProperty.FParent := Self;
+ Item.FEditor := CreateEditor(TfrxSetProperty, AClass, PropertyList[i]);
+ with GetTypeData(GetTypeData(PropertyList[i].PropType^).CompType^)^ do
+ for j := MinValue to MaxValue do
+ begin
+ Item1 := Item.FSubProperty.Add;
+ Item1.FEditor := CreateEditor(TfrxSetElementProperty, AClass, PropertyList[i]);
+ if Item1.FEditor <> nil then
+ TfrxSetElementProperty(Item1.FEditor).FElement := j;
+ end;
+ end;
+
+ tkClass:
+ begin
+ FClass := GetTypeData(PropertyList[i].PropType^)^.ClassType;
+ if FClass.InheritsFrom(TComponent) then
+ Item.FEditor := CreateEditor(TfrxComponentProperty, AClass, PropertyList[i])
+ else if FClass.InheritsFrom(TPersistent) then
+ begin
+ Item.FEditor := CreateEditor(TfrxClassProperty, AClass, PropertyList[i]);
+ Item.FSubProperty := TfrxPropertyList.Create(FDesigner);
+ Item.FSubProperty.FParent := Self;
+ Item.FSubProperty.Component := TPersistent(GetOrdProp(AClass, PropertyList[i]));
+ if Item.SubProperty.Count = 0 then
+ begin
+ Item.FSubProperty.Free;
+ Item.FSubProperty := nil;
+ end;
+ end;
+ end;
+ end;
+ if Item.FEditor = nil then
+ Item.Free;
+ end;
+
+ FreeMem(PropertyList, PropertyCount * SizeOf(PPropInfo));
+end;
+
+procedure TfrxPropertyList.FillCommonProperties(PropertyList: TfrxPropertyList);
+var
+ i, j: Integer;
+ p, p1: TfrxPropertyItem;
+ Found: Boolean;
+begin
+ i := 0;
+ while i < Count do
+ begin
+ p := Items[i];
+ Found := False;
+ if paMultiSelect in p.Editor.GetAttributes then
+ for j := 0 to PropertyList.Count - 1 do
+ begin
+ p1 := PropertyList.Items[j];
+ if (p1.Editor.GetPropInfo.PropType^.Kind = p.Editor.GetPropInfo.PropType^.Kind) and
+ (p1.Editor.GetPropInfo.Name = p.Editor.GetPropInfo.Name) then
+ begin
+ Found := True;
+ break;
+ end;
+ end;
+
+ if not Found then
+ p.Free else
+ Inc(i);
+ end;
+end;
+
+procedure TfrxPropertyList.AddProperties(PropertyList: TfrxPropertyList);
+
+ procedure EnumProperties(p1, p2: TfrxPropertyList);
+ var
+ i: Integer;
+ begin
+ for i := 0 to p1.Count - 1 do
+ begin
+ p1[i].Editor.FCompList.Add(p2[i].Editor.FCompList[0]);
+ p1[i].Editor.FPropList.Add(p2[i].Editor.FPropList[0]);
+ if p1[i].SubProperty <> nil then
+ EnumProperties(p1[i].SubProperty, p2[i].SubProperty);
+ end;
+ end;
+
+begin
+ EnumProperties(Self, PropertyList);
+end;
+
+
+{ TfrxPropertyItem }
+
+destructor TfrxPropertyItem.Destroy;
+begin
+ if Editor <> nil then
+ Editor.Free;
+ if SubProperty <> nil then
+ SubProperty.Free;
+ inherited;
+end;
+
+
+{ TfrxIntegerProperty }
+
+function TfrxIntegerProperty.GetValue: String;
+begin
+ Result := IntToStr(GetOrdValue);
+end;
+
+procedure TfrxIntegerProperty.SetValue(const Value: String);
+begin
+ SetOrdValue(StrToInt(Value));
+end;
+
+
+{ TfrxFloatProperty }
+
+function TfrxFloatProperty.GetValue: String;
+begin
+ Result := FloatToStr(GetFloatValue);
+end;
+
+procedure TfrxFloatProperty.SetValue(const Value: String);
+begin
+ SetFloatValue(frStrToFloat(Value));
+end;
+
+
+{ TfrxCharProperty }
+
+function TfrxCharProperty.GetValue: String;
+var
+ Ch: Char;
+begin
+ Ch := Chr(GetOrdValue);
+ if CharInSet(Ch, [#33..#255]) then
+ Result := Ch else
+ FmtStr(Result, '#%d', [Ord(Ch)]);
+end;
+
+procedure TfrxCharProperty.SetValue(const Value: String);
+var
+ i: Integer;
+begin
+ if Length(Value) = 0 then i := 0 else
+ if Length(Value) = 1 then i := Ord(Value[1]) else
+ if Value[1] = '#' then i := StrToInt(Copy(Value, 2, 255)) else
+ raise Exception.Create(frxResources.Get('prInvProp'));
+ SetOrdValue(i);
+end;
+
+
+{ TfrxStringProperty }
+
+function TfrxStringProperty.GetValue: String;
+begin
+ Result := GetStrValue;
+end;
+
+procedure TfrxStringProperty.SetValue(const Value: String);
+begin
+ SetStrValue(Value);
+end;
+
+
+{ TfrxEnumProperty }
+
+function TfrxEnumProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paSortList];
+end;
+
+function TfrxEnumProperty.GetValue: String;
+var
+ i: Integer;
+begin
+ i := GetOrdValue;
+ try
+ Result := GetEnumName(PropInfo.PropType^, i);
+ except
+ Result := '';
+ end;
+end;
+
+procedure TfrxEnumProperty.GetValues;
+var
+ i: Integer;
+begin
+ inherited;
+ with GetTypeData(PropInfo.PropType^)^ do
+ for i := MinValue to MaxValue do
+ Values.Add(GetEnumName(PropInfo.PropType^, i));
+end;
+
+procedure TfrxEnumProperty.SetValue(const Value: String);
+var
+ i: Integer;
+begin
+ i := GetEnumValue(PropInfo.PropType^, Value);
+ if i < 0 then
+ raise Exception.Create(frxResources.Get('prInvProp'));
+ SetOrdValue(i);
+end;
+
+
+{ TfrxSetProperty }
+
+function TfrxSetProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paSubProperties, paReadOnly];
+end;
+
+function TfrxSetProperty.GetValue: String;
+var
+ S: TIntegerSet;
+ TypeInfo: PTypeInfo;
+ I: Integer;
+begin
+ Integer(S) := GetOrdValue;
+ TypeInfo := GetTypeData(PropInfo.PropType^).CompType^;
+ Result := '[';
+ for i := 0 to 31 do
+ if i in S then
+ begin
+ if Length(Result) <> 1 then
+ Result := Result + ',';
+ Result := Result + GetEnumName(TypeInfo, i);
+ end;
+ Result := Result + ']';
+end;
+
+
+{ TfrxSetElementProperty }
+
+function TfrxSetElementProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paSortList];
+end;
+
+function TfrxSetElementProperty.GetName: String;
+begin
+ Result := GetEnumName(GetTypeData(PropInfo.PropType^).CompType^, FElement);
+end;
+
+function TfrxSetElementProperty.GetValue: String;
+var
+ S: TIntegerSet;
+begin
+ Integer(S) := GetOrdValue;
+ if FElement in S then
+ Result := 'True' else
+ Result := 'False';
+end;
+
+procedure TfrxSetElementProperty.GetValues;
+begin
+ inherited;
+ Values.Add('False');
+ Values.Add('True');
+end;
+
+procedure TfrxSetElementProperty.SetValue(const Value: String);
+var
+ S: TIntegerSet;
+begin
+ Integer(S) := GetOrdValue;
+ if CompareText(Value, 'True') = 0 then
+ Include(S, FElement)
+ else if CompareText(Value, 'False') = 0 then
+ Exclude(S, FElement)
+ else
+ raise Exception.Create(frxResources.Get('prInvProp'));
+
+ SetOrdValue(Integer(S));
+end;
+
+
+{ TfrxClassProperty }
+
+function TfrxClassProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paSubProperties, paReadOnly];
+end;
+
+function TfrxClassProperty.GetValue: String;
+begin
+ Result := {'';//}'(' + String(PropInfo.PropType^.Name) + ')';
+end;
+
+
+{ TComponentProperty }
+
+function TfrxComponentProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paSortList];
+end;
+
+function TfrxComponentProperty.GetValue: String;
+var
+ c: TComponent;
+begin
+ c := TComponent(GetOrdValue);
+ if c <> nil then
+ Result := c.Name else
+ Result := '';
+end;
+
+procedure TfrxComponentProperty.GetValues;
+var
+ i: Integer;
+ c, c1: TfrxComponent;
+begin
+ inherited;
+
+ if frComponent <> nil then
+ begin
+ if frComponent is TfrxReportComponent then
+ c := frComponent.Page else
+ c := frComponent;
+ for i := 0 to c.AllObjects.Count - 1 do
+ begin
+ c1 := c.AllObjects[i];
+ if (c1 <> frComponent) and
+ c1.InheritsFrom(GetTypeData(PropInfo.PropType^)^.ClassType) then
+ Values.Add(c1.Name);
+ end;
+ end;
+end;
+
+procedure TfrxComponentProperty.SetValue(const Value: String);
+var
+ c: TComponent;
+begin
+ c := nil;
+ if Value <> '' then
+ begin
+ c := frComponent.Report.FindObject(Value);
+ if c = nil then
+ raise Exception.Create(frxResources.Get('prInvProp'));
+ end;
+
+ SetOrdValue(frxInteger(c));
+end;
+
+
+{ TfrxNameProperty }
+
+function TfrxNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [];
+end;
+
+
+{ TfrxColorProperty }
+
+function TfrxColorProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paOwnerDraw];
+end;
+
+function TfrxColorProperty.GetValue: String;
+begin
+ Result := AlphaColorToString(GetOrdValue);
+end;
+
+procedure TfrxColorProperty.SetValue(const Value: String);
+begin
+ SetOrdValue(StringToAlphaColor(Value));
+end;
+
+procedure TfrxColorProperty.GetValues;
+begin
+ inherited;
+ GetAlphaColorValues(GetStrProc);
+end;
+
+procedure TfrxColorProperty.OnDrawLBItem(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF);
+var
+ r: TRectF;
+ c: Integer;
+begin
+ inherited;
+ with Canvas do
+ begin
+ r := RectF(Round(ARect.Left + 2) + 0.5, Round(ARect.Top + 2) + 0.5, Round(ARect.Left + (ARect.Bottom - ARect.Top - 2)) - 0.5, Round(ARect.Bottom - 2) + 0.5);
+ IdentToAlphaColor('cla' + TListBoxItem(Sender).Text, c);
+ Fill.Color := c;
+ Fill.Kind := TBrushKind.bkSolid;
+ FillRect(r, 0, 0, allCorners, 1);
+ Stroke.Color := claDimGray;
+ Stroke.Kind := TBrushKind.bkSolid;
+ DrawRect(r, 0, 0, allCorners, 1);
+ end;
+end;
+
+procedure TfrxColorProperty.OnDrawItem(Canvas: TCanvas; ARect: TRectF);
+var
+ r: TRectF;
+begin
+ inherited;
+ with Canvas do
+ begin
+ r := RectF(Round(ARect.Left) + 0.5, Round(ARect.Top) + 1.5, Round(ARect.Left + (ARect.Bottom - ARect.Top - 5)) - 0.5, Round(ARect.Bottom - 5) + 0.5);
+ Fill.Color := Cardinal(GetOrdValue) or $FF000000;
+ Fill.Kind := TBrushKind.bkSolid;
+ FillRect(r, 0, 0, allCorners, 1);
+ Stroke.Color := claDimGray;
+ Stroke.Kind := TBrushKind.bkSolid;
+ DrawRect(r, 0, 0, allCorners, 1);
+ end;
+end;
+
+
+{ TfrxFontProperty }
+
+function TfrxFontProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paDialog, paSubProperties, paReadOnly];
+end;
+
+function TfrxFontProperty.Edit: Boolean;
+//var
+ //FontDialog: TFontDialog;
+begin
+// todo
+{ FontDialog := TFontDialog.Create(Application);
+ try
+ FontDialog.Font := TFont(GetOrdValue);
+ FontDialog.Options := FontDialog.Options + [fdForceFontExist];
+ FontDialog.Device := fdBoth;
+ Result := FontDialog.Execute;
+ if Result then
+ SetOrdValue(Integer(FontDialog.Font));
+ finally
+ FontDialog.Free;
+ end;}
+ with TfrxFontForm.Create(nil) do
+ begin
+
+ try
+ FontS.Assign(TfrxFont(GetOrdValue));
+ FormActivate(nil);
+ if ShowModal = mrOk then
+ SetOrdValue(frxInteger(FontS));
+ finally
+ Free;
+ end;
+ end;
+ Result := True;
+end;
+
+
+{ TfrxFontNameProperty }
+
+function TfrxFontNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paSortList];
+end;
+
+procedure TfrxFontNameProperty.GetValues;
+begin
+ if Values.Count = 0 then
+ FillFontsList(Values);
+end;
+
+
+{ TfrxModalResultProperty }
+
+const
+ ModalResults: array[mrNone..mrYesToAll] of string = (
+ 'mrNone',
+ 'mrOk',
+ 'mrCancel',
+ 'mrAbort',
+ 'mrRetry',
+ 'mrIgnore',
+ 'mrYes',
+ 'mrNo',
+ 'mrClose',
+ 'mrHelp',
+ 'mrTryAgain',
+ 'mrContinue',
+ 'mrAll',
+ 'mrNoToAll',
+ 'mrYesToAll');
+
+function TfrxModalResultProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList];
+end;
+
+function TfrxModalResultProperty.GetValue: String;
+begin
+ if GetOrdValue in [mrNone..mrYesToAll] then
+ Result := ModalResults[GetOrdValue] else
+ Result := inherited GetValue;
+end;
+
+procedure TfrxModalResultProperty.SetValue(const Value: String);
+var
+ i: Integer;
+ s: String;
+begin
+ s := Value;
+ if s = '' then
+ s := '0';
+ for i := Low(ModalResults) to High(ModalResults) do
+ if CompareText(ModalResults[i], s) = 0 then
+ begin
+ SetOrdValue(i);
+ Exit;
+ end;
+ inherited SetValue(s);
+end;
+
+procedure TfrxModalResultProperty.GetValues;
+var
+ i: Integer;
+begin
+ inherited;
+ for i := mrNone to mrYesToAll do
+ Values.Add(ModalResults[i]);
+end;
+
+
+
+{ TfrxCursorProperty }
+
+function TfrxCursorProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paSortList];
+end;
+
+function TfrxCursorProperty.GetValue: string;
+begin
+ Result := CursorToString(TCursor(GetOrdValue));
+end;
+
+procedure TfrxCursorProperty.GetValues;
+begin
+ inherited;
+ GetCursorValues(GetStrProc);
+end;
+
+procedure TfrxCursorProperty.SetValue(const Value: string);
+var
+ NewValue: Integer;
+begin
+ if IdentToCursor(Value, NewValue) then
+ SetOrdValue(NewValue) else
+ inherited;
+end;
+
+
+{ TfrxDateTimeProperty }
+
+function TfrxDateTimeProperty.GetValue: String;
+var
+ DT: TDateTime;
+begin
+ DT := GetFloatValue;
+ if DT = 0.0 then
+ Result := ''
+ else
+ Result := DateTimeToStr(DT);
+end;
+
+procedure TfrxDateTimeProperty.SetValue(const Value: String);
+var
+ DT: TDateTime;
+begin
+ if Value = '' then
+ DT := 0.0
+ else
+ DT := StrToDateTime(Value);
+ SetFloatValue(DT);
+end;
+
+
+{ TfrxDateProperty }
+
+function TfrxDateProperty.GetValue: String;
+var
+ DT: TDateTime;
+begin
+ DT := GetFloatValue;
+ if DT = 0.0 then
+ Result := ''
+ else
+ Result := DateToStr(DT);
+end;
+
+procedure TfrxDateProperty.SetValue(const Value: String);
+var
+ DT: TDateTime;
+begin
+ if Value = '' then
+ DT := 0.0
+ else
+ DT := StrToDate(Value);
+ SetFloatValue(DT);
+end;
+
+
+{ TfrxTimeProperty }
+
+function TfrxTimeProperty.GetValue: String;
+var
+ DT: TDateTime;
+begin
+ DT := GetFloatValue;
+ if DT = 0.0 then
+ Result := ''
+ else
+ Result := TimeToStr(DT);
+end;
+
+procedure TfrxTimeProperty.SetValue(const Value: String);
+var
+ DT: TDateTime;
+begin
+ if Value = '' then
+ DT := 0.0
+ else
+ DT := StrToTime(Value);
+ SetFloatValue(DT);
+end;
+
+
+{ TfrxObjectCollection }
+
+constructor TfrxObjectCollection.Create;
+begin
+ inherited Create(TfrxObjectItem);
+end;
+
+function TfrxObjectCollection.GetObjectItem(Index: Integer): TfrxObjectItem;
+begin
+ Result := TfrxObjectItem(inherited Items[Index]);
+end;
+
+procedure TfrxObjectCollection.RegisterCategory(const CategoryName: String;
+ ButtonBmp: TBitmap; const ButtonHint: String; ImageIndex: Integer);
+begin
+ RegisterObject1(nil, ButtonBmp, ButtonHint, CategoryName, 0, ImageIndex);
+end;
+
+procedure TfrxObjectCollection.RegisterObject(ClassRef: TfrxComponentClass;
+ ButtonBmp: TBitmap; const CategoryName: String);
+begin
+ RegisterObject1(ClassRef, ButtonBmp, '', CategoryName);
+end;
+
+procedure TfrxObjectCollection.RegisterObject1(
+ ClassRef: TfrxComponentClass; ButtonBmp: TBitmap;
+ const ButtonHint: String = ''; const CategoryName: String = '';
+ Flags: Integer = 0; ImageIndex: Integer = -1;
+ Category: TfrxObjectCategories = []);
+var
+ i: Integer;
+ Item: TfrxObjectItem;
+begin
+ for i := 0 to Count - 1 do
+ begin
+ Item := Items[i];
+ if (Item.ClassRef <> nil) and (Item.ClassRef = ClassRef) and
+ (Item.Flags = Flags) then
+ Exit;
+ end;
+
+ if ClassRef <> nil then
+ RegisterFmxClasses([ClassRef]);
+
+ Item := TfrxObjectItem(Add);
+ Item.ClassRef := ClassRef;
+ Item.ButtonBmp := ButtonBmp;
+ Item.ButtonImageIndex := ImageIndex;
+ Item.ButtonHint := ButtonHint;
+ Item.CategoryName := CategoryName;
+ Item.Flags := Flags;
+ Item.Category := Category;
+
+ { if category is not set, determine it automatically }
+ if (ClassRef <> nil) and (Category = []) then
+ begin
+ if ClassRef.InheritsFrom(TfrxDataset) or
+ ClassRef.InheritsFrom(TfrxCustomDatabase) then
+ Item.Category := [ctData]
+ else if ClassRef.InheritsFrom(TfrxDialogControl) or
+ ClassRef.InheritsFrom(TfrxDialogComponent) then
+ Item.Category := [ctDialog]
+ else
+ Item.Category := [ctReport];
+ end;
+end;
+
+procedure TfrxObjectCollection.UnRegister(ClassRef: TfrxComponentClass);
+var
+ i: Integer;
+begin
+ i := 0;
+ while i < Count do
+ begin
+ if Items[i].ClassRef = ClassRef then
+ Items[i].Free else
+ Inc(i);
+ end;
+end;
+
+
+{ TfrxComponentEditorCollection }
+
+constructor TfrxComponentEditorCollection.Create;
+begin
+ inherited Create(TfrxComponentEditorItem);
+end;
+
+function TfrxComponentEditorCollection.GetComponentEditorItem(
+ Index: Integer): TfrxComponentEditorItem;
+begin
+ Result := TfrxComponentEditorItem(inherited Items[Index]);
+end;
+
+function TfrxComponentEditorCollection.GetComponentEditor(Component: TfrxComponent;
+ Designer: TfrxCustomDesigner; Menu: TPopupMenu): TfrxComponentEditor;
+var
+ i, j: Integer;
+begin
+ Result := nil;
+ j := -1;
+ for i := 0 to Count - 1 do
+ if Items[i].ComponentClass = Component.ClassType then
+ begin
+ j := i;
+ break;
+ end
+ else if Component.InheritsFrom(Items[i].ComponentClass) then
+ j := i;
+
+ if j <> -1 then
+ begin
+ Result := TfrxComponentEditor(Items[j].ComponentEditor.NewInstance);
+ Result.Create(Component, Designer, Menu);
+ end;
+end;
+
+procedure TfrxComponentEditorCollection.Register(ComponentClass: TfrxComponentClass;
+ ComponentEditor: TfrxComponentEditorClass);
+var
+ Item: TfrxComponentEditorItem;
+begin
+ Item := TfrxComponentEditorItem(Add);
+ Item.ComponentClass := ComponentClass;
+ Item.ComponentEditor := ComponentEditor;
+end;
+
+procedure TfrxComponentEditorCollection.UnRegister(ComponentEditor: TfrxComponentEditorClass);
+var
+ i: Integer;
+begin
+ i := 0;
+ while i < Count do
+ begin
+ if Items[i].ComponentEditor = ComponentEditor then
+ Items[i].Free else
+ Inc(i);
+ end;
+end;
+
+
+{ TfrxPropertyEditorCollection }
+
+constructor TfrxPropertyEditorCollection.Create;
+begin
+ inherited Create(TfrxPropertyEditorItem);
+ FEventEditorItem := -1;
+end;
+
+function TfrxPropertyEditorCollection.GetPropertyEditorItem(
+ Index: Integer): TfrxPropertyEditorItem;
+begin
+ Result := TfrxPropertyEditorItem(inherited Items[Index]);
+end;
+
+function TfrxPropertyEditorCollection.GetPropertyEditor(PropertyType: PTypeInfo;
+ Component: TPersistent; PropertyName: String): Integer;
+var
+ i: Integer;
+ Item: TfrxPropertyEditorItem;
+begin
+ if (Pos('tfrx', LowerCase(String(PropertyType.Name))) = 1) and
+ (Pos('event', LowerCase(String(PropertyType.Name))) = Length(PropertyType.Name) - 4) then
+ begin
+ Result := FEventEditorItem;
+ Exit;
+ end;
+
+ Result := -1;
+ for i := Count - 1 downto 0 do
+ begin
+ Item := Items[i];
+ if (Item.ComponentClass = nil) and (Item.PropertyName = '') and
+ (Item.PropertyType = PropertyType) then
+ Result := i
+ else if (Item.ComponentClass = nil) and (Item.PropertyType = PropertyType) and
+ (CompareText(Item.PropertyName, PropertyName) = 0) then
+ begin
+ Result := i;
+ break;
+ end
+ else if (Component.InheritsFrom(Item.ComponentClass)) and
+ (CompareText(Item.PropertyName, PropertyName) = 0) then
+ begin
+ Result := i;
+ break;
+ end;
+ end;
+end;
+
+procedure TfrxPropertyEditorCollection.Register(PropertyType: PTypeInfo;
+ ComponentClass: TClass; const PropertyName: String;
+ EditorClass: TfrxPropertyEditorClass);
+var
+ Item: TfrxPropertyEditorItem;
+begin
+ Item := TfrxPropertyEditorItem(Add);
+ Item.PropertyType := PropertyType;
+ Item.ComponentClass := ComponentClass;
+ Item.PropertyName := PropertyName;
+ Item.EditorClass := EditorClass;
+end;
+
+procedure TfrxPropertyEditorCollection.RegisterEventEditor(
+ EditorClass: TfrxPropertyEditorClass);
+begin
+ Register(nil, nil, '', EditorClass);
+ FEventEditorItem := Count - 1;
+end;
+
+procedure TfrxPropertyEditorCollection.UnRegister(EditorClass: TfrxPropertyEditorClass);
+var
+ i: Integer;
+begin
+ i := 0;
+ while i < Count do
+ begin
+ if Items[i].EditorClass = EditorClass then
+ Items[i].Free else
+ Inc(i);
+ end;
+end;
+
+
+{ TfrxExportFilterCollection }
+
+constructor TfrxExportFilterCollection.Create;
+begin
+ inherited Create(TfrxExportFilterItem);
+end;
+
+function TfrxExportFilterCollection.GetExportFilterItem(
+ Index: Integer): TfrxExportFilterItem;
+begin
+ Result := TfrxExportFilterItem(inherited Items[Index]);
+end;
+
+procedure TfrxExportFilterCollection.Register(Filter: TfrxCustomExportFilter);
+var
+ i: Integer;
+ Item: TfrxExportFilterItem;
+begin
+ if Filter = nil then Exit;
+ for i := 0 to Count - 1 do
+ if Items[i].Filter = Filter then
+ Exit;
+
+ Item := TfrxExportFilterItem(Add);
+ Item.Filter := Filter;
+end;
+
+procedure TfrxExportFilterCollection.UnRegister(Filter: TfrxCustomExportFilter);
+var
+ i: Integer;
+begin
+ i := 0;
+ while i < Count do
+ begin
+ if Items[i].Filter = Filter then
+ Items[i].Free else
+ Inc(i);
+ end;
+end;
+
+
+{ TfrxWizardCollection }
+
+constructor TfrxWizardCollection.Create;
+begin
+ inherited Create(TfrxWizardItem);
+end;
+
+function TfrxWizardCollection.GetWizardItem(Index: Integer): TfrxWizardItem;
+begin
+ Result := TfrxWizardItem(inherited Items[Index]);
+end;
+
+procedure TfrxWizardCollection.Register(ClassRef: TfrxWizardClass;
+ ButtonBmp: TBitmap; IsToolbarWizard: Boolean);
+var
+ i: Integer;
+ Item: TfrxWizardItem;
+begin
+ for i := 0 to Count - 1 do
+ if Items[i].ClassRef = ClassRef then
+ Exit;
+
+ Item := TfrxWizardItem(Add);
+ Item.ClassRef := ClassRef;
+ Item.ButtonBmp := ButtonBmp;
+ Item.ButtonImageIndex := -1;
+ Item.IsToolbarWizard := IsToolbarWizard;
+end;
+
+procedure TfrxWizardCollection.Register1(ClassRef: TfrxWizardClass;
+ ImageIndex: Integer);
+var
+ i: Integer;
+ Item: TfrxWizardItem;
+begin
+ for i := 0 to Count - 1 do
+ if Items[i].ClassRef = ClassRef then
+ Exit;
+
+ Item := TfrxWizardItem(Add);
+ Item.ClassRef := ClassRef;
+ Item.ButtonImageIndex := ImageIndex;
+end;
+
+procedure TfrxWizardCollection.UnRegister(ClassRef: TfrxWizardClass);
+var
+ i: Integer;
+begin
+ i := 0;
+ while i < Count do
+ begin
+ if Items[i].ClassRef = ClassRef then
+ Items[i].Free else
+ Inc(i);
+ end;
+end;
+
+
+{ globals }
+
+function frxObjects: TfrxObjectCollection;
+begin
+ if FObjects = nil then
+ FObjects := TfrxObjectCollection.Create;
+ Result := FObjects;
+end;
+
+function frxComponentEditors: TfrxComponentEditorCollection;
+begin
+ if FComponentEditors = nil then
+ FComponentEditors := TfrxComponentEditorCollection.Create;
+ Result := FComponentEditors;
+end;
+
+function frxPropertyEditors: TfrxPropertyEditorCollection;
+begin
+ if FPropertyEditors = nil then
+ FPropertyEditors := TfrxPropertyEditorCollection.Create;
+ Result := FPropertyEditors;
+end;
+
+function frxExportFilters: TfrxExportFilterCollection;
+begin
+ if FExportFilters = nil then
+ FExportFilters := TfrxExportFilterCollection.Create;
+ Result := FExportFilters;
+end;
+
+function frxWizards: TfrxWizardCollection;
+begin
+ if FWizards = nil then
+ FWizards := TfrxWizardCollection.Create;
+ Result := FWizards;
+end;
+
+
+initialization
+ frxPropertyEditors.Register(TypeInfo(TComponentName), nil, 'Name', TfrxNameProperty);
+ frxPropertyEditors.Register(TypeInfo(TAlphaColor), nil, '', TfrxColorProperty);
+// frxPropertyEditors.Register(TypeInfo(TfrxFont), nil, '', TfrxFontProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxFont, 'Name', TfrxFontNameProperty);
+ frxPropertyEditors.Register(TypeInfo(TModalResult), nil, '', TfrxModalResultProperty);
+ frxPropertyEditors.Register(TypeInfo(TCursor), nil, '', TfrxCursorProperty);
+ frxPropertyEditors.Register(TypeInfo(TDateTime), nil, '', TfrxDateTimeProperty);
+ frxPropertyEditors.Register(TypeInfo(TDate), nil, '', TfrxDateProperty);
+ frxPropertyEditors.Register(TypeInfo(TTime), nil, '', TfrxTimeProperty);
+
+
+finalization
+ if FObjects <> nil then
+ FObjects.Free;
+ FObjects := nil;
+ if FComponentEditors <> nil then
+ FComponentEditors.Free;
+ FComponentEditors := nil;
+ if FPropertyEditors <> nil then
+ FPropertyEditors.Free;
+ FPropertyEditors := nil;
+ if FExportFilters <> nil then
+ FExportFilters.Free;
+ FExportFilters := nil;
+ if FWizards <> nil then
+ FWizards.Free;
+ FWizards := nil;
+
+
+end.
+
diff --git a/LibD28/FMX.frxEditAliases.fmx b/LibD28/FMX.frxEditAliases.fmx
new file mode 100644
index 0000000..5d74512
--- /dev/null
+++ b/LibD28/FMX.frxEditAliases.fmx
@@ -0,0 +1,69 @@
+object frxAliasesEditorForm: TfrxAliasesEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Edit Aliases'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 386
+ ClientWidth = 349
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object HintL: TLabel
+ Position.Point = '(232,32)'
+ Width = 112.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object DSAliasL: TLabel
+ Position.Point = '(4,8)'
+ Width = 125.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object FieldAliasesL: TLabel
+ Position.Point = '(4,32)'
+ Width = 57.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 2
+ end
+ object OkB: TButton
+ Position.Point = '(188,356)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 3
+ ModalResult = 1
+ end
+ object CancelB: TButton
+ Position.Point = '(268,356)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 4
+ ModalResult = 2
+ end
+ object ResetB: TButton
+ Position.Point = '(4,356)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = ResetBClick
+ TabOrder = 5
+ end
+ object DSAliasE: TEdit
+ Position.Point = '(148,4)'
+ Width = 197.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 6
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object UpdateB: TButton
+ Position.Point = '(84,356)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = UpdateBClick
+ TabOrder = 7
+ end
+end
diff --git a/LibD28/FMX.frxEditAliases.pas b/LibD28/FMX.frxEditAliases.pas
new file mode 100644
index 0000000..6a5d65c
--- /dev/null
+++ b/LibD28/FMX.frxEditAliases.pas
@@ -0,0 +1,404 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ Aliases editor }
+{ }
+{ Copyright (c) 1998-2011 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditAliases;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Objects, FMX.Controls, FMX.Forms, FMX.Dialogs, System.Math,
+ FMX.frxClass, System.Variants, FMX.Edit, FMX.Types, FMX.Layouts, FMX.Grid, System.UITypes, System.Rtti
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+
+type
+
+
+{$IFNDEF DELPHI17}
+ TfrxStringGrid = class(TStringGrid)
+ protected
+ function GetValue(Col, Row: Integer): Variant; override;
+ procedure SetValue(Col, Row: Integer; const Value: Variant); override;
+ end;
+ THackStringGrid = class(TfrxStringGrid);
+{$ELSE}
+ THackStringGrid = class(TStringGrid);
+{$ENDIF}
+
+{$IFDEF LINUX}
+ TfrxAliasesEditorForm = class(TfrxForm)
+{$ELSE}
+ TfrxAliasesEditorForm = class(TForm)
+{$ENDIF}
+ OkB: TButton;
+ CancelB: TButton;
+ ResetB: TButton;
+ HintL: TLabel;
+ DSAliasL: TLabel;
+ DSAliasE: TEdit;
+ FieldAliasesL: TLabel;
+ UpdateB: TButton;
+ procedure FormHide(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure ResetBClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure UpdateBClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ FDataSet: TfrxCustomDBDataset;
+{$IFDEF DELPHI17}
+ AliasGrid: TStringGrid;
+{$ELSE}
+ AliasGrid: TfrxStringGrid;
+{$ENDIF}
+ procedure BuildAliasList(List: TStrings);
+ public
+ property DataSet: TfrxCustomDBDataset read FDataSet write FDataSet;
+ end;
+
+ { TStringColumn }
+
+ TStringCheckColumn = class(TCheckColumn)
+ private
+{$IFNDEF DELPHI24}
+ FRowCount: integer;
+ FCheckCells: array of Boolean;
+{$ENDIF}
+ protected
+{$IFNDEF DELPHI17}
+ procedure UpdateColumn; override;
+{$ELSE}
+{$IFNDEF DELPHI24}
+ procedure UpdateRowCount(const RowCount: integer); override;
+ function GetCells(ARow: Integer): TValue; override;
+ procedure SetCells(ARow: Integer; const Value: TValue); override;
+{$ENDIF}
+{$ENDIF}
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxRes, FMX.frxFMX;
+
+
+{ TStringColumn }
+
+{$IFNDEF DELPHI17}
+procedure TStringCheckColumn.UpdateColumn;
+begin
+ inherited;
+ FRowCount := Min(Grid.RowCount, Grid.VisibleRows);
+ SetLength(FCellControls, FRowCount);
+end;
+{$ELSE}
+{$IFNDEF DELPHI24}
+procedure TStringCheckColumn.UpdateRowCount(const RowCount: integer);
+begin
+ if (RowCount > 0) then
+ SetLength(FCheckCells, RowCount);
+ FRowCount := RowCount;
+end;
+
+function TStringCheckColumn.GetCells(ARow: Integer): TValue;
+begin
+ if (ARow >= 0) and (ARow < Length(FCheckCells)) then
+ Result := FCheckCells[ARow]
+ else
+ Result := inherited GetCells(ARow);
+end;
+
+procedure TStringCheckColumn.SetCells(ARow: Integer; const Value: TValue);
+var
+ S: Boolean;
+ LGrid : TCustomGrid;
+begin
+ if (ARow >= 0) and (ARow < Length(FCheckCells)) then
+ begin
+ S := Value.AsBoolean;
+ if FCheckCells[ARow] <> S then
+ begin
+ FCheckCells[ARow] := S;
+ LGrid := Grid;
+ if Assigned(LGrid) then
+{$IFDEF DELPHI20}
+ UpdateCell(ARow);
+{$ELSE}
+ UpdateColumn;
+{$ENDIF}
+ end;
+ end
+ else
+ inherited SetCells(ARow, Value);
+end;
+{$ENDIF}
+{$ENDIF}
+
+procedure TfrxAliasesEditorForm.BuildAliasList(List: TStrings);
+var
+ i, CheckColumn, AliasColumn, NameColumn: Integer;
+ s: String;
+begin
+ AliasGrid.BeginUpdate;
+ AliasGrid.RowCount := List.Count;
+ CheckColumn := 0;
+ AliasColumn := 1;
+ NameColumn := 2;
+ // in case column was moved
+ for i := 0 to AliasGrid.ColumnCount - 1 do
+ case AliasGrid.Columns[i].Tag of
+ 1: CheckColumn := AliasGrid.Columns[i].Index;
+ 2: AliasColumn := AliasGrid.Columns[i].Index;
+ 3: NameColumn := AliasGrid.Columns[i].Index;
+ end;
+
+ for i := 0 to List.Count - 1 do
+ begin
+ s := List.Names[i];
+{$IFNDEF DELPHI24}
+ THackStringGrid(AliasGrid).SetValue(CheckColumn, i, False);
+{$ELSE}
+ THackStringGrid(AliasGrid).Cells[CheckColumn, i] := BoolToStr(False);
+{$ENDIF}
+ AliasGrid.Cells[AliasColumn, i] := List.Values[s];
+ if s[1] = '-' then { field is disabled }
+ s := Copy(s, 2, 255) else
+{$IFNDEF DELPHI24}
+ THackStringGrid(AliasGrid).SetValue(CheckColumn, i, True);
+{$ELSE}
+ THackStringGrid(AliasGrid).Cells[CheckColumn, i] := BoolToStr(True);
+{$ENDIF}
+ AliasGrid.Cells[NameColumn, i] := s;
+ end;
+ AliasGrid.EndUpdate;
+end;
+
+
+
+procedure TfrxAliasesEditorForm.FormShow(Sender: TObject);
+begin
+ DSAliasE.Text := FDataSet.UserName;
+ BuildAliasList(FDataSet.FieldAliases);
+ if FDataSet.FieldAliases.Count = 0 then
+ ResetBClick(nil);
+end;
+
+procedure TfrxAliasesEditorForm.FormHide(Sender: TObject);
+var
+ i, CheckColumn, AliasColumn, NameColumn: Integer;
+ s: String;
+begin
+ if ModalResult = mrOk then
+ begin
+ CheckColumn := 0;
+ AliasColumn := 1;
+ NameColumn := 2;
+ FDataSet.UserName := DSAliasE.Text;
+ FDataSet.FieldAliases.Clear;
+
+ // in case column was moved
+ for i := 0 to AliasGrid.ColumnCount - 1 do
+ case AliasGrid.Columns[i].Tag of
+ 1: CheckColumn := AliasGrid.Columns[i].Index;
+ 2: AliasColumn := AliasGrid.Columns[i].Index;
+ 3: NameColumn := AliasGrid.Columns[i].Index;
+ end;
+
+ for i := 0 to AliasGrid.RowCount - 1 do
+ begin
+ s := AliasGrid.Cells[NameColumn, i];
+{$IFNDEF DELPHI17}
+ if THackStringGrid(AliasGrid).GetValue(CheckColumn, i) <> True then { disable the field }
+{$ELSE}
+{$IFNDEF DELPHI24}
+ if THackStringGrid(AliasGrid).GetValue(CheckColumn, i).AsBoolean <> True then { disable the field }
+{$ELSE}
+ if StrToBool(AliasGrid.Cells[CheckColumn, i]) <> True then { disable the field }
+{$ENDIF}
+{$ENDIF}
+ s := '-' + s;
+ FDataSet.FieldAliases.Add(s + '=' + AliasGrid.Cells[AliasColumn, i]);
+ end;
+ end;
+end;
+
+procedure TfrxAliasesEditorForm.ResetBClick(Sender: TObject);
+var
+ i: Integer;
+ l1, l2: TStrings;
+begin
+ l1 := TStringList.Create;
+ l2 := TStringList.Create;
+ l1.Assign(FDataSet.FieldAliases);
+ { clear aliases to get real field names }
+ FDataSet.FieldAliases.Clear;
+ FDataSet.GetFieldList(l2);
+ { set aliases back }
+ FDataSet.FieldAliases.Assign(l1);
+ l1.Free;
+
+ for i := 0 to l2.Count - 1 do
+ l2[i] := l2[i] + '=' + l2[i];
+
+ BuildAliasList(l2);
+ l2.Free;
+end;
+
+procedure TfrxAliasesEditorForm.UpdateBClick(Sender: TObject);
+var
+ i: Integer;
+ l1, l2: TStrings;
+begin
+ l1 := TStringList.Create;
+ l2 := TStringList.Create;
+ l1.Assign(FDataSet.FieldAliases);
+ try
+ { clear aliases to get real field names }
+ FDataSet.FieldAliases.Clear;
+ FDataSet.GetFieldList(l2);
+ finally
+ { set aliases back }
+ FDataSet.FieldAliases.Assign(l1);
+ end;
+
+ for i := 0 to l2.Count - 1 do
+ if l1.IndexOfName(l2[i]) = -1 then
+ l2[i] := l2[i] + '=' + l2[i]
+ else
+ l2[i] := l2[i] + '=' + l1.Values[l2[i]];
+
+ BuildAliasList(l2);
+ l1.Free;
+ l2.Free;
+end;
+
+procedure TfrxAliasesEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ FormHide(Self);
+end;
+
+procedure TfrxAliasesEditorForm.FormCreate(Sender: TObject);
+var
+ SColumn: TStringColumn;
+ CBColumn: TStringCheckColumn;
+begin
+ Caption := frxGet(3600);
+ HintL.Text := frxGet(3601);
+ DSAliasL.Text := frxGet(3602);
+ FieldAliasesL.Text := frxGet(3603);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ ResetB.Text := frxGet(3604);
+ UpdateB.Text := frxGet(3605);
+
+{$IFDEF DELPHI17}
+ AliasGrid := TStringGrid.Create(Self);
+{$ELSE}
+ AliasGrid := TfrxStringGrid.Create(Self);
+{$ENDIF}
+ AliasGrid.Parent := Self;
+ with AliasGrid do
+ begin
+ Position.X := 5;
+ Position.Y := 32;
+ Width := 337;
+ Height := 321;
+ StyleLookup := 'gridstyle';
+ TabOrder := 8;
+{$IFDEF DELPHI20}
+ Options := Options + [TGridOption.AlternatingRowBackground];
+{$ELSE}
+ AlternatingRowBackground := True;
+{$ENDIF}
+ RowHeight := 21;
+ RowCount := 0;
+ end;
+
+ AliasGrid.BeginUpdate;
+
+ AliasGrid.RowCount := 0;
+ CBColumn := TStringCheckColumn.Create(AliasGrid);
+ CBColumn.Tag := 1;
+ CBColumn.Header := ' - ';
+ CBColumn.Width := 20;
+ AliasGrid.AddObject(CBColumn);
+
+ SColumn := TStringColumn.Create(AliasGrid);
+ SColumn.Header := frxResources.Get('alUserName');
+ SColumn.Tag := 2;
+ AliasGrid.AddObject(SColumn);
+
+ SColumn := TStringColumn.Create(AliasGrid);
+ SColumn.Header := frxResources.Get('alOriginal');
+ SColumn.ReadOnly := True;
+ SColumn.Tag := 3;
+ AliasGrid.AddObject(SColumn);
+ TCheckColumn(AliasGrid.ColumnByIndex(0)).Header := '-';
+
+ AliasGrid.EndUpdate;
+end;
+
+procedure TfrxAliasesEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VK_F1 then
+ frxResources.Help(Self);
+ if Key = vkF5 then
+ UpdateBClick(nil);
+end;
+
+{$IFNDEF DELPHI17}
+{ TfrxStringGrid }
+
+function TfrxStringGrid.GetValue(Col, Row: Integer): Variant;
+var
+ C: TColumn;
+begin
+ C := Columns[Col];
+ if C is TStringCheckColumn then
+ begin
+ if Length(TStringCheckColumn(C).FCheckCells) <> RowCount then
+ SetLength(TStringCheckColumn(C).FCheckCells, RowCount);
+ Result := TStringCheckColumn(C).FCheckCells[Row]
+ end
+ else
+ Result := inherited GetValue(Col, Row);
+end;
+
+procedure TfrxStringGrid.SetValue(Col, Row: Integer; const Value: Variant);
+var
+ C: TColumn;
+begin
+ C := Columns[Col];
+ if C is TStringCheckColumn then
+ begin
+ if Length(TStringCheckColumn(C).FCheckCells) <> RowCount then
+ SetLength(TStringCheckColumn(C).FCheckCells, RowCount);
+ TStringCheckColumn(C).FCheckCells[Row] := Value;
+ //TStringCheckColumn(C).UpdateColumn;
+ end
+ else
+ inherited;
+end;
+{$ENDIF}
+
+end.
diff --git a/LibD28/FMX.frxEditDataBand.fmx b/LibD28/FMX.frxEditDataBand.fmx
new file mode 100644
index 0000000..fa03fe4
--- /dev/null
+++ b/LibD28/FMX.frxEditDataBand.fmx
@@ -0,0 +1,65 @@
+object frxDataBandEditorForm: TfrxDataBandEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Select DataSet'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 221
+ ClientWidth = 261
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object OkB: TButton
+ Position.Point = '(102,192)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = OkBClick
+ HelpContext = 40
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(182,192)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 50
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object GroupBox1: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 253.000000000000000000
+ Height = 177.000000000000000000
+ TabOrder = 2
+ object RecordsL: TLabel
+ Position.Point = '(16,148)'
+ Width = 151.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object DatasetsLB: TListBox
+ Position.Point = '(8,12)'
+ Width = 237.000000000000000000
+ Height = 121.000000000000000000
+ OnClick = DatasetsLBClick
+ OnDblClick = DatasetsLBDblClick
+ HelpContext = 88
+ TabOrder = 1
+ ItemHeight = 18.000000000000000000
+ end
+ object RecordsS: TSpinBox
+ Position.Point = '(179,144)'
+ Width = 65.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 2
+ KeyboardType = vktDefault
+ Max = 10000.000000000000000000
+ Increment = 1.000000000000000000
+ end
+ end
+end
diff --git a/LibD28/FMX.frxEditDataBand.pas b/LibD28/FMX.frxEditDataBand.pas
new file mode 100644
index 0000000..3c00b7a
--- /dev/null
+++ b/LibD28/FMX.frxEditDataBand.pas
@@ -0,0 +1,171 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Data Band editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditDataBand;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Objects, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.ExtCtrls, FMX.frxClass, FMX.Edit, FMX.Layouts, FMX.ListBox,
+ FMX.Types, System.Variants
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI21}
+ ,FMX.SpinBox
+{$ENDIF};
+
+
+type
+{$IFDEF LINUX}
+ TfrxDataBandEditorForm = class(TfrxForm)
+{$ELSE}
+ TfrxDataBandEditorForm = class(TForm)
+{$ENDIF}
+ OkB: TButton;
+ CancelB: TButton;
+ GroupBox1: TGroupBox;
+ DatasetsLB: TListBox;
+ RecordsL: TLabel;
+ RecordsS: TSpinBox;
+// procedure DatasetsLBDrawItem(Control: TWinControl; Index: Integer;
+// ARect: TRect; State: TOwnerDrawState);
+ procedure DatasetsLBDblClick(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure DatasetsLBClick(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure OkBClick(Sender: TObject);
+ private
+ { Private declarations }
+ FDataBand: TfrxDataBand;
+ FDesigner: TfrxCustomDesigner;
+ public
+ { Public declarations }
+ property DataBand: TfrxDataBand read FDataBand write FDataBand;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxUtils, FMX.frxRes;
+
+
+procedure TfrxDataBandEditorForm.FormShow(Sender: TObject);
+var
+ i: Integer;
+ dsList: TStringList;
+begin
+ FDesigner := TfrxCustomDesigner(Owner);
+
+ dsList := TStringList.Create;
+ FDesigner.Report.GetDatasetList(dsList);
+ dsList.Sort;
+ //DatasetsLB.Items := dsList;
+ DatasetsLB.Items.Add(frxResources.Get('dbNotAssigned'));
+ for i := 0 to dsList.Count - 1 do
+ DatasetsLB.Items.AddObject(dsList[i], dsList.Objects[i]);
+ //Add(dsList[i]);
+
+ dsList.Free;
+
+ i := DatasetsLB.Items.IndexOfObject(FDataBand.DataSet);
+ if i = -1 then
+ i := 0;
+ DatasetsLB.ItemIndex := i;
+
+ RecordsS.Text := IntToStr(FDataBand.RowCount);
+end;
+
+procedure TfrxDataBandEditorForm.OkBClick(Sender: TObject);
+begin
+
+end;
+
+//procedure TfrxDataBandEditorForm.DatasetsLBDrawItem(Control: TWinControl;
+// Index: Integer; ARect: TRect; State: TOwnerDrawState);
+//var
+// r: TRect;
+//begin
+// r := ARect;
+// r.Right := r.Left + 18;
+// r.Bottom := r.Top + 16;
+// OffsetRect(r, 2, 0);
+// with TListBox(Control) do
+// begin
+// Canvas.FillRect(ARect);
+// if Index > 0 then
+// frxResources.MainButtonImages.Draw(Canvas, ARect.Left + 2, ARect.Top + 1, 53);
+// Canvas.TextOut(ARect.Left + 22, ARect.Top + 2, Items[Index]);
+// end;
+//end;
+
+procedure TfrxDataBandEditorForm.DatasetsLBDblClick(Sender: TObject);
+begin
+ ModalResult := mrOk;
+end;
+
+procedure TfrxDataBandEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ if ModalResult = mrOk then
+ if DatasetsLB.ItemIndex = 0 then
+ begin
+ FDataBand.DataSet := nil;
+ FDataBand.RowCount := StrToInt(RecordsS.Text);
+ end
+ else
+ begin
+ FDataBand.DataSet := TfrxDataSet(DatasetsLB.Items.Objects[DatasetsLB.ItemIndex]);
+ FDataBand.RowCount := StrToInt(RecordsS.Text);
+ end;
+end;
+
+procedure TfrxDataBandEditorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(3100);
+ RecordsL.Text := frxGet(3101);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxDataBandEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+procedure TfrxDataBandEditorForm.DatasetsLBClick(Sender: TObject);
+begin
+ if DatasetsLB.ItemIndex <> 0 then
+ RecordsS.Text := '0';
+end;
+
+end.
+
diff --git a/LibD28/FMX.frxEditExpr.fmx b/LibD28/FMX.frxEditExpr.fmx
new file mode 100644
index 0000000..7fc6b1d
--- /dev/null
+++ b/LibD28/FMX.frxEditExpr.fmx
@@ -0,0 +1,75 @@
+object frxExprEditorForm: TfrxExprEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Expression Editor'
+ BorderIcons = [biSystemMenu, biMinimize, biMaximize, biHelp]
+ ClientHeight = 546
+ ClientWidth = 640
+ Visible = False
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ OnResize = FormResize
+ ActiveControl = ExprMemo
+ StyleLookup = 'backgroundstyle'
+ object Splitter1: TSplitter
+ Align = alBottom
+ Cursor = crVSplit
+ Position.Point = '(0,450)'
+ Width = 640.000000000000000000
+ Height = 3.000000000000000000
+ TabOrder = 0
+ MinSize = 20.000000000000000000
+ end
+ object ExprMemo: TMemo
+ Align = alBottom
+ Position.Point = '(0,453)'
+ Width = 640.000000000000000000
+ Height = 56.000000000000000000
+ OnDragOver = ExprMemoDragOver
+ OnDragDrop = ExprMemoDragDrop
+ TabOrder = 1
+ KeyboardType = vktDefault
+ end
+ object Panel1: TPanel
+ Align = alBottom
+ Position.Point = '(0,509)'
+ Width = 640.000000000000000000
+ Height = 37.000000000000000000
+ TabOrder = 2
+ StyleLookup = 'backgroundstyle'
+ object OkB: TButton
+ Position.Point = '(4,8)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 0
+ ModalResult = 1
+ end
+ object CancelB: TButton
+ Position.Point = '(84,8)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ end
+ object Panel2: TPanel
+ Align = alBottom
+ Position.Point = '(0,431)'
+ Width = 640.000000000000000000
+ Height = 19.000000000000000000
+ TabOrder = 3
+ object ExprL: TLabel
+ Position.Point = '(4,2)'
+ Width = 141.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ end
+ object Panel: TPanel
+ Align = alClient
+ Width = 640.000000000000000000
+ Height = 431.000000000000000000
+ TabOrder = 4
+ end
+end
diff --git a/LibD28/FMX.frxEditExpr.pas b/LibD28/FMX.frxEditExpr.pas
new file mode 100644
index 0000000..b4eb056
--- /dev/null
+++ b/LibD28/FMX.frxEditExpr.pas
@@ -0,0 +1,147 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Expression Editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditExpr;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.Types, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.ExtCtrls, FMX.frxDataTree,
+ FMX.Types, FMX.Layouts, FMX.Memo, System.Variants
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI22}
+ ,FMX.Memo.Types
+{$ENDIF};
+
+
+type
+ TfrxExprEditorForm = class(TForm)
+ ExprMemo: TMemo;
+ Panel1: TPanel;
+ OkB: TButton;
+ CancelB: TButton;
+ Splitter1: TSplitter;
+ Panel2: TPanel;
+ ExprL: TLabel;
+ Panel: TPanel;
+ procedure FormCreate(Sender: TObject);
+ procedure ExprMemoDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; var Accept: Boolean);
+ procedure ExprMemoDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+ procedure FormShow(Sender: TObject);
+ procedure FormHide(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormResize(Sender: TObject);
+ private
+ FDataTree: TfrxDataTreeForm;
+ FReport: TfrxReport;
+ procedure OnDataTreeDblClick(Sender: TObject);
+ public
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses
+ System.IniFiles, FMX.frxRes, FMX.TreeView, FMX.frxUtils;
+
+
+
+{ TfrxExprEditorForm }
+
+procedure TfrxExprEditorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(4400);
+ ExprL.Text := frxGet(4401);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+
+
+ FReport := TfrxCustomDesigner(Owner).Report;
+ FDataTree := TfrxDataTreeForm.Create(Self);
+ FDataTree.Report := FReport;
+ FDataTree.MainDataPanel.Parent := Panel;
+ FDataTree.MainDataPanel.OnDblClick := OnDataTreeDblClick;
+ //FDataTree.SetControlsParent(Panel);
+ FDataTree.HintPanel.Height := 60;
+ FDataTree.UpdateItems;
+end;
+
+procedure TfrxExprEditorForm.FormShow(Sender: TObject);
+var
+ Ini: TCustomIniFile;
+begin
+ Ini := FReport.GetIniFile;
+ Ini.WriteBool('TfrxExprEditorForm', 'Visible', True);
+ frxRestoreFormPosition(Ini, Self);
+ Ini.Free;
+// FDataTree.SetLastPosition(lastPosition);
+end;
+
+procedure TfrxExprEditorForm.FormHide(Sender: TObject);
+var
+ Ini: TCustomIniFile;
+begin
+ Ini := FReport.GetIniFile;
+ frxSaveFormPosition(Ini, Self);
+ Ini.Free;
+// lastPosition := FDataTree.GetLastPosition;
+end;
+
+procedure TfrxExprEditorForm.OnDataTreeDblClick(Sender: TObject);
+var
+ SelStart: TCaretPosition;
+ SelLen: Integer;
+begin
+ SelLen := ExprMemo.SelLength;
+ SelStart := ExprMemo.TextPosToPos(ExprMemo.SelStart);
+ ExprMemo.DeleteFrom(SelStart, SelLen, []);
+ ExprMemo.InsertAfter(SelStart, FDataTree.GetFieldName, []);
+ ExprMemo.SetFocus;
+end;
+
+procedure TfrxExprEditorForm.ExprMemoDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; var Accept: Boolean);
+begin
+ Accept := (Data.Source is TTreeView) and (TControl(Data.Source).Owner = FDataTree) and
+ (FDataTree.GetFieldName <> '');
+end;
+
+procedure TfrxExprEditorForm.ExprMemoDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+var
+ SelStart: TCaretPosition;
+ SelLen: Integer;
+begin
+ SelLen := ExprMemo.SelLength;
+ SelStart := ExprMemo.TextPosToPos(ExprMemo.SelStart);
+ ExprMemo.DeleteFrom(SelStart, SelLen, []);
+ ExprMemo.InsertAfter(SelStart, FDataTree.GetFieldName, []);
+ ExprMemo.SetFocus;
+end;
+
+procedure TfrxExprEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = vkF1 then
+ frxResources.Help(Self);
+end;
+
+procedure TfrxExprEditorForm.FormResize(Sender: TObject);
+begin
+ FDataTree.UpdateSize;
+end;
+
+end.
diff --git a/LibD28/FMX.frxEditFormat.fmx b/LibD28/FMX.frxEditFormat.fmx
new file mode 100644
index 0000000..7698bb6
--- /dev/null
+++ b/LibD28/FMX.frxEditFormat.fmx
@@ -0,0 +1,93 @@
+object frxFormatEditorForm: TfrxFormatEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Display Format'
+ ClientHeight = 264
+ ClientWidth = 316
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object OkB: TButton
+ Position.Point = '(156,232)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(236,232)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object CategoryL: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 151.000000000000000000
+ Height = 137.000000000000000000
+ TabOrder = 2
+ object CategoryLB: TListBox
+ Position.Point = '(8,20)'
+ Width = 133.000000000000000000
+ Height = 105.000000000000000000
+ OnClick = CategoryLBClick
+ TabOrder = 0
+ ItemHeight = 13.000000000000000000
+ end
+ end
+ object FormatL: TGroupBox
+ Position.Point = '(160,4)'
+ Width = 151.000000000000000000
+ Height = 137.000000000000000000
+ TabOrder = 3
+ object FormatLB: TListBox
+ Position.Point = '(8,20)'
+ Width = 133.000000000000000000
+ Height = 105.000000000000000000
+ OnClick = FormatLBClick
+ TabOrder = 0
+ ItemHeight = 13.000000000000000000
+ end
+ end
+ object GroupBox1: TGroupBox
+ Position.Point = '(4,146)'
+ Width = 307.000000000000000000
+ Height = 73.000000000000000000
+ TabOrder = 4
+ object FormatStrL: TLabel
+ Position.Point = '(8,16)'
+ Width = 129.000000000000000000
+ Height = 13.000000000000000000
+ OnClick = FormatStrLClick
+ TabOrder = 0
+ end
+ object SeparatorL: TLabel
+ Position.Point = '(8,44)'
+ Width = 129.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object FormatE: TEdit
+ Position.Point = '(152,12)'
+ Width = 133.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 2
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object SeparatorE: TEdit
+ Position.Point = '(152,40)'
+ Width = 25.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 3
+ KeyboardType = vktDefault
+ Password = False
+ Text = ','
+ end
+ end
+end
diff --git a/LibD28/FMX.frxEditFormat.pas b/LibD28/FMX.frxEditFormat.pas
new file mode 100644
index 0000000..f780440
--- /dev/null
+++ b/LibD28/FMX.frxEditFormat.pas
@@ -0,0 +1,223 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ DisplayFormat editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditFormat;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, System.Types, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.ExtCtrls, FMX.ListBox, FMX.Edit, FMX.frxClass, System.Variants, FMX.Layouts
+ {$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+
+type
+ TfrxFormatEditorForm = class(TForm)
+ OkB: TButton;
+ CancelB: TButton;
+ CategoryL: TGroupBox;
+ CategoryLB: TListBox;
+ FormatL: TGroupBox;
+ FormatLB: TListBox;
+ GroupBox1: TGroupBox;
+ FormatStrL: TLabel;
+ SeparatorL: TLabel;
+ FormatE: TEdit;
+ SeparatorE: TEdit;
+ procedure FormCreate(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure CategoryLBClick(Sender: TObject);
+ //procedure FormatLBDrawItem(Control: TWinControl; Index: Integer;
+ // ARect: TRect; State: TOwnerDrawState);
+ procedure FormatLBClick(Sender: TObject);
+ procedure FormHide(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormatStrLClick(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ { Private declarations }
+ FFormat: TfrxFormat;
+ public
+ { Public declarations }
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure HostControls(Host: TFmxObject);
+ procedure UnhostControls;
+ property Format: TfrxFormat read FFormat write FFormat;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxRes;
+
+const
+ CategoryNames: array[0..3] of String =
+ ('fkText', 'fkNumber', 'fkDateTime', 'fkBoolean');
+
+
+constructor TfrxFormatEditorForm.Create(AOwner: TComponent);
+begin
+ inherited;
+ FFormat := TfrxFormat.Create;
+end;
+
+destructor TfrxFormatEditorForm.Destroy;
+begin
+ FFormat.Free;
+ inherited;
+end;
+
+procedure TfrxFormatEditorForm.FormShow(Sender: TObject);
+
+ procedure FillCategory;
+ var
+ i: Integer;
+ begin
+ for i := 0 to 3 do
+ CategoryLB.Items.Add(frxResources.Get(CategoryNames[i]));
+ end;
+
+ procedure FindFormat;
+ var
+ i: Integer;
+ s: String;
+ begin
+ for i := 0 to FormatLB.Items.Count - 1 do
+ begin
+ s := FormatLB.Items[i];
+ if Copy(s, Pos(';', s) + 1, 255) = FFormat.FormatStr then
+ FormatLB.ItemIndex := i;
+ end;
+ end;
+
+begin
+ FillCategory;
+ CategoryLB.ItemIndex := Integer(FFormat.Kind);
+ CategoryLBClick(Self);
+ FindFormat;
+ FormatE.Text := FFormat.FormatStr;
+ SeparatorE.Text := FFormat.DecimalSeparator;
+end;
+
+procedure TfrxFormatEditorForm.FormHide(Sender: TObject);
+var
+ s: String;
+begin
+ FFormat.Kind := TfrxFormatKind(CategoryLB.ItemIndex);
+ FFormat.FormatStr := FormatE.Text;
+ s := SeparatorE.Text;
+ if s = '' then
+ FFormat.DecimalSeparator := ''
+ else
+ FFormat.DecimalSeparator := s[1];
+end;
+
+procedure TfrxFormatEditorForm.CategoryLBClick(Sender: TObject);
+var
+ i, n: Integer;
+ s: String;
+begin
+{$IFDEF DELPHI23}
+ FormatLB.Clear;
+{$ELSE}
+ FormatLB.Items.Clear;
+{$ENDIF}
+ n := CategoryLB.ItemIndex;
+ SeparatorE.Enabled := n = 1;
+ SeparatorL.Enabled := n = 1;
+
+ if (n = 0) or (n = 4) or (n = -1) then
+ Exit;
+
+ for i := 1 to 10 do
+ begin
+ s := frxResources.Get(CategoryNames[n] + IntToStr(i));
+ if Pos('fk', s) = 0 then
+ FormatLB.Items.Add(s);
+ end;
+end;
+
+procedure TfrxFormatEditorForm.FormatLBClick(Sender: TObject);
+var
+ s: String;
+begin
+ s := FormatLB.Items[FormatLB.ItemIndex];
+ FormatE.Text := Copy(s, Pos(';', s) + 1, 255);
+end;
+
+procedure TfrxFormatEditorForm.FormatStrLClick(Sender: TObject);
+begin
+
+end;
+
+//procedure TfrxFormatEditorForm.FormatLBDrawItem(Control: TWinControl;
+// Index: Integer; ARect: TRect; State: TOwnerDrawState);
+//var
+// s: String;
+//begin
+// with FormatLB do
+// begin
+// Canvas.FillRect(ARect);
+// s := Items[Index];
+// if Pos(';', s) <> 0 then
+// s := Copy(s, 1, Pos(';', s) - 1);
+// Canvas.TextOut(ARect.Left + 2, ARect.Top, s);
+// end;
+//end;
+
+procedure TfrxFormatEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ FormHide(Self);
+end;
+
+procedure TfrxFormatEditorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(4500);
+ CategoryL.Text := frxGet(4501);
+ FormatL.Text := frxGet(4502);
+ FormatStrL.Text := frxGet(4503);
+ SeparatorL.Text := frxGet(4504);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+end;
+
+procedure TfrxFormatEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+procedure TfrxFormatEditorForm.HostControls(Host: TFmxObject);
+begin
+ CategoryL.Parent := Host;
+ FormatL.Parent := Host;
+ GroupBox1.Parent := Host;
+ FormShow(Self);
+end;
+
+procedure TfrxFormatEditorForm.UnhostControls;
+begin
+ FormHide(Self);
+end;
+
+end.
diff --git a/LibD28/FMX.frxEditFrame.fmx b/LibD28/FMX.frxEditFrame.fmx
new file mode 100644
index 0000000..57ee349
--- /dev/null
+++ b/LibD28/FMX.frxEditFrame.fmx
@@ -0,0 +1,232 @@
+object frxFrameEditorForm: TfrxFrameEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Edit Frame'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 159
+ ClientWidth = 223
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object FrameL: TLabel
+ Position.Point = '(8,12)'
+ Width = 54.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object LineL: TLabel
+ Position.Point = '(8,64)'
+ Width = 57.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object ShadowL: TLabel
+ Position.Point = '(8,92)'
+ Width = 57.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 2
+ end
+ object FLineL: TLabel
+ Position.Point = '(8,37)'
+ Width = 57.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 3
+ end
+ object OkB: TButton
+ Position.Point = '(60,124)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 4
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(140,124)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 5
+ ModalResult = 2
+ Cancel = True
+ end
+ object ToolBar1: TToolBar
+ Align = alNone
+ Position.Point = '(72,8)'
+ Width = 149.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 6
+ object FrameTopB: TfrxToolButton
+ Tag = 1
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BClick
+ TabOrder = 0
+ end
+ object FrameBottomB: TfrxToolButton
+ Tag = 2
+ Position.Point = '(22,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BClick
+ TabOrder = 1
+ end
+ object FrameLeftB: TfrxToolButton
+ Tag = 3
+ Position.Point = '(44,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BClick
+ TabOrder = 2
+ end
+ object FrameRightB: TfrxToolButton
+ Tag = 4
+ Position.Point = '(66,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BClick
+ TabOrder = 3
+ end
+ object FrameAllB: TfrxToolButton
+ Tag = 5
+ Position.Point = '(96,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BClick
+ TabOrder = 4
+ end
+ object FrameNoB: TfrxToolButton
+ Tag = 6
+ Position.Point = '(118,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BClick
+ TabOrder = 5
+ end
+ end
+ object ToolBar2: TToolBar
+ Align = alNone
+ Position.Point = '(72,60)'
+ Width = 93.000000000000000000
+ Height = 23.000000000000000000
+ TabOrder = 7
+ object FrameColorB: TfrxToolButton
+ Tag = 7
+ Position.Point = '(50,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BClick
+ TabOrder = 0
+ end
+ object FrameStyleB: TfrxToolButton
+ Tag = 8
+ Position.Point = '(70,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BClick
+ TabOrder = 1
+ end
+ object Sep2: TPanel
+ Align = alLeft
+ Width = 47.000000000000000000
+ Height = 23.000000000000000000
+ TabOrder = 2
+ object FrameWidthCB: TComboEdit
+ Tag = 9
+ Cursor = crIBeam
+ Position.Point = '(5,2)'
+ Width = 40.000000000000000000
+ Height = 19.000000000000000000
+ OnClick = BClick
+ TabOrder = 0
+ KeyboardType = vktDefault
+ ItemHeight = 13.000000000000000000
+ ItemIndex = 0
+ Items.Strings = (
+ '0,1'
+ '0,5'
+ '1'
+ '1,5'
+ '2'
+ '3'
+ '4'
+ '5'
+ '6'
+ '7'
+ '8'
+ '9'
+ '10')
+ ListBoxResource = 'combolistboxstyle'
+ Text = '0,1'
+ end
+ end
+ end
+ object ToolBar3: TToolBar
+ Align = alNone
+ Position.Point = '(72,88)'
+ Width = 93.000000000000000000
+ Height = 23.000000000000000000
+ TabOrder = 8
+ object ShadowB: TfrxToolButton
+ Tag = 10
+ Position.Point = '(50,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BClick
+ TabOrder = 0
+ end
+ object ShadowColorB: TfrxToolButton
+ Tag = 11
+ Position.Point = '(70,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BClick
+ TabOrder = 1
+ end
+ object Sep3: TPanel
+ Align = alLeft
+ Width = 47.000000000000000000
+ Height = 23.000000000000000000
+ TabOrder = 2
+ object ShadowWidthCB: TComboEdit
+ Tag = 12
+ Cursor = crIBeam
+ Position.Point = '(5,2)'
+ Width = 40.000000000000000000
+ Height = 19.000000000000000000
+ OnClick = BClick
+ TabOrder = 0
+ KeyboardType = vktDefault
+ ItemHeight = 13.000000000000000000
+ ItemIndex = 0
+ Items.Strings = (
+ '1'
+ '2'
+ '3'
+ '4'
+ '5'
+ '6'
+ '7'
+ '8'
+ '9'
+ '10')
+ ListBoxResource = 'combolistboxstyle'
+ Text = '1'
+ end
+ end
+ end
+ object FrameLineCB: TComboEdit
+ Cursor = crIBeam
+ Position.Point = '(72,34)'
+ Width = 91.000000000000000000
+ Height = 19.000000000000000000
+ OnClick = BClick
+ TabOrder = 9
+ KeyboardType = vktDefault
+ ItemHeight = 13.000000000000000000
+ ItemIndex = -1
+ ListBoxResource = 'combolistboxstyle'
+ end
+end
diff --git a/LibD28/FMX.frxEditFrame.pas b/LibD28/FMX.frxEditFrame.pas
new file mode 100644
index 0000000..1a609c1
--- /dev/null
+++ b/LibD28/FMX.frxEditFrame.pas
@@ -0,0 +1,224 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Frame editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditFrame;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.ExtCtrls, FMX.frxCtrls, FMX.frxClass, FMX.frxFMX, FMX.ListBox, FMX.Edit
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+ {$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI21}
+ , FMX.ComboEdit, FMX.Controls.Presentation
+{$ENDIF};
+
+type
+{$IFDEF LINUX}
+ TfrxFrameEditorForm = class(TfrxForm)
+{$ELSE}
+ TfrxFrameEditorForm = class(TForm)
+{$ENDIF}
+ FrameL: TLabel;
+ LineL: TLabel;
+ ShadowL: TLabel;
+ OkB: TButton;
+ CancelB: TButton;
+ ToolBar1: TToolBar;
+ FrameTopB: TfrxToolButton;
+ FrameBottomB: TfrxToolButton;
+ FrameLeftB: TfrxToolButton;
+ FrameRightB: TfrxToolButton;
+ FrameAllB: TfrxToolButton;
+ FrameNoB: TfrxToolButton;
+ ToolBar2: TToolBar;
+ FrameColorB: TfrxToolButton;
+ FrameStyleB: TfrxToolButton;
+ Sep2: TPanel;
+ FrameWidthCB: TComboEdit;
+ ToolBar3: TToolBar;
+ ShadowB: TfrxToolButton;
+ ShadowColorB: TfrxToolButton;
+ Sep3: TPanel;
+ ShadowWidthCB: TComboEdit;
+ FrameLineCB: TComboEdit;
+ FLineL: TLabel;
+ procedure FormCreate(Sender: TObject);
+ procedure BClick(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ private
+ FFrame: TfrxFrame;
+ procedure UpdateControls;
+ function GetFrameLine: TfrxFrameLine;
+ public
+ property Frame: TfrxFrame read FFrame;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxDesgnCtrls, FMX.frxUtils, FMX.frxRes;
+
+
+procedure TfrxFrameEditorForm.FormCreate(Sender: TObject);
+begin
+ FFrame := TfrxFrame.Create;
+ Caption := frxGet(5200);
+ FrameL.Text := frxGet(5201);
+ LineL.Text := frxGet(2321);
+ ShadowL.Text := frxGet(5203);
+ FrameTopB.Hint := frxGet(5204);
+ FrameBottomB.Hint := frxGet(5205);
+ FrameLeftB.Hint := frxGet(5206);
+ FrameRightB.Hint := frxGet(5207);
+ FrameAllB.Hint := frxGet(5208);
+ FrameNoB.Hint := frxGet(5209);
+ FrameColorB.Hint := frxGet(5210);
+ FrameStyleB.Hint := frxGet(5211);
+ //FrameWidthCB.Hint := frxGet(5212);
+ ShadowB.Hint := frxGet(5213);
+ ShadowColorB.Hint := frxGet(5214);
+ //ShadowWidthCB.Hint := frxGet(5215);
+ FrameLineCB.Items.Add(frxGet(5208));
+ FrameLineCB.Items.Add(frxGet(5206));
+ FrameLineCB.Items.Add(frxGet(5207));
+ FrameLineCB.Items.Add(frxGet(5204));
+ FrameLineCB.Items.Add(frxGet(5205));
+ FLineL.Text := frxGet(5202);
+ FrameLineCB.ItemIndex := 1;
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ //FImageList := frxResources.MainButtonImages;
+ frxResources.LoadImageFromResouce(FrameTopB.Bitmap, 3, 2);
+ frxResources.LoadImageFromResouce(FrameBottomB.Bitmap, 3, 3);
+ frxResources.LoadImageFromResouce(FrameRightB.Bitmap, 3, 5);
+ frxResources.LoadImageFromResouce(FrameLeftB.Bitmap, 3, 4);
+ frxResources.LoadImageFromResouce(FrameNoB.Bitmap, 3, 7);
+ frxResources.LoadImageFromResouce(FrameAllB.Bitmap, 3, 6);
+ frxResources.LoadImageFromResouce(ShadowB.Bitmap, 7, 1);
+ frxResources.LoadImageFromResouce(FrameColorB.Bitmap, 3, 9);
+ frxResources.LoadImageFromResouce(FrameStyleB.Bitmap, 4, 0);
+ FormShow(Self);
+ //ToolBar1.Images := FImageList;
+ //ToolBar2.Images := FImageList;
+ //ToolBar3.Images := FImageList;
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+function TfrxFrameEditorForm.GetFrameLine: TfrxFrameLine;
+begin
+ case FrameLineCB.ItemIndex of
+ 2: Result := FFrame.RightLine;
+ 3: Result := FFrame.TopLine;
+ 4: Result := FFrame.BottomLine;
+ else Result := FFrame.LeftLine;
+ end;
+end;
+
+procedure TfrxFrameEditorForm.FormDestroy(Sender: TObject);
+begin
+ FFrame.Free;
+end;
+
+procedure TfrxFrameEditorForm.FormShow(Sender: TObject);
+begin
+ UpdateControls;
+end;
+
+procedure TfrxFrameEditorForm.UpdateControls;
+begin
+ FrameTopB.Down := ftTop in FFrame.Typ;
+ FrameBottomB.Down := ftBottom in FFrame.Typ;
+ FrameLeftB.Down := ftLeft in FFrame.Typ;
+ FrameRightB.Down := ftRight in FFrame.Typ;
+ ShadowB.Down := FFrame.DropShadow;
+ FrameWidthCB.Text := FloatToStr(GetFrameLine.Width);
+ ShadowWidthCB.Text := FloatToStr(FFrame.ShadowWidth);
+ if FrameLineCB.ItemIndex = 0 then
+ with FFrame do
+ begin
+ Style := GetFrameLine.Style;
+ Color := GetFrameLine.Color;
+ Width := GetFrameLine.Width;
+ end;
+
+end;
+
+procedure TfrxFrameEditorForm.BClick(Sender: TObject);
+
+ procedure SetFrameType(fType: TfrxFrameType; Include: Boolean);
+ begin
+ with FFrame do
+ if Include then
+ Typ := Typ + [fType] else
+ Typ := Typ - [fType];
+ end;
+
+begin
+ case TControl(Sender).Tag of
+ 1: SetFrameType(ftTop, FrameTopB.Down);
+ 2: SetFrameType(ftBottom, FrameBottomB.Down);
+ 3: SetFrameType(ftLeft, FrameLeftB.Down);
+ 4: SetFrameType(ftRight, FrameRightB.Down);
+ 5: FFrame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
+ 6: FFrame.Typ := [];
+ 7:
+ with TfrxColorSelector.Create(TComponent(Sender)) do
+ begin
+ OnColorChanged := BClick;
+ Tag := 70;
+ end;
+ 70: GetFrameLine.Color := TfrxColorSelector(Sender).Color;
+ 8:
+ with TfrxLineSelector.Create(TComponent(Sender)) do
+ begin
+ OnStyleChanged := BClick;
+ Tag := 80;
+ end;
+ 80: GetFrameLine.Style := TfrxFrameStyle(TfrxLineSelector(Sender).Style);
+ 9: GetFrameLine.Width := frxStrToFloat(FrameWidthCB.Text);
+ 10: FFrame.DropShadow := ShadowB.Down;
+ 11:
+ with TfrxColorSelector.Create(TComponent(Sender)) do
+ begin
+ OnColorChanged := BClick;
+ Tag := 110;
+ end;
+ 110: FFrame.ShadowColor := TfrxColorSelector(Sender).Color;
+ 12: FFrame.ShadowWidth := frxStrToFloat(ShadowWidthCB.Text);
+ end;
+
+ UpdateControls;
+end;
+
+procedure TfrxFrameEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VK_F1 then
+ frxResources.Help(Self);
+end;
+
+end.
diff --git a/LibD28/FMX.frxEditGroup.fmx b/LibD28/FMX.frxEditGroup.fmx
new file mode 100644
index 0000000..6424323
--- /dev/null
+++ b/LibD28/FMX.frxEditGroup.fmx
@@ -0,0 +1,113 @@
+object frxGroupEditorForm: TfrxGroupEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Group'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 307
+ ClientWidth = 365
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object OKB: TButton
+ Position.Point = '(205,276)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 40
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(285,276)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 50
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object BreakOnL: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 357.000000000000000000
+ Height = 125.000000000000000000
+ TabOrder = 2
+ object DataFieldCB: TComboBox
+ Position.Point = '(188,40)'
+ Width = 161.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 0
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ end
+ object DataSetCB: TComboBox
+ Position.Point = '(8,40)'
+ Width = 173.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 1
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ OnChange = DataSetCBChange
+ end
+ object ExpressionE: TfrxEditWithButton
+ Position.Point = '(8,92)'
+ Width = 341.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 2
+ OnButtonClick = ExpressionEButtonClick
+ end
+ object DataFieldRB: TRadioButton
+ Position.Point = '(8,20)'
+ Width = 173.000000000000000000
+ Height = 17.000000000000000000
+ OnChange = DataFieldRBClick
+ TabOrder = 3
+ end
+ object ExpressionRB: TRadioButton
+ Position.Point = '(8,72)'
+ Width = 173.000000000000000000
+ Height = 17.000000000000000000
+ OnChange = DataFieldRBClick
+ TabOrder = 4
+ end
+ end
+ object OptionsL: TGroupBox
+ Position.Point = '(4,136)'
+ Width = 357.000000000000000000
+ Height = 129.000000000000000000
+ TabOrder = 3
+ object KeepGroupTogetherCB: TCheckBox
+ Position.Point = '(8,20)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 0
+ end
+ object StartNewPageCB: TCheckBox
+ Position.Point = '(8,40)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ object OutlineCB: TCheckBox
+ Position.Point = '(8,60)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object DrillCB: TCheckBox
+ Position.Point = '(8,80)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ object ResetCB: TCheckBox
+ Position.Point = '(8,100)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 4
+ end
+ end
+end
diff --git a/LibD28/FMX.frxEditGroup.pas b/LibD28/FMX.frxEditGroup.pas
new file mode 100644
index 0000000..358a025
--- /dev/null
+++ b/LibD28/FMX.frxEditGroup.pas
@@ -0,0 +1,199 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Group editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditGroup;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.ExtCtrls, FMX.frxClass, FMX.frxCtrls, FMX.ListBox, FMX.Types, FMX.Edit, System.Variants
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+
+type
+{$IFDEF LINUX}
+ TfrxGroupEditorForm = class(TfrxForm)
+{$ELSE}
+ TfrxGroupEditorForm = class(TForm)
+{$ENDIF}
+ OKB: TButton;
+ CancelB: TButton;
+ BreakOnL: TGroupBox;
+ DataFieldCB: TComboBox;
+ DataSetCB: TComboBox;
+ ExpressionE: TfrxEditWithButton;
+ DataFieldRB: TRadioButton;
+ ExpressionRB: TRadioButton;
+ OptionsL: TGroupBox;
+ KeepGroupTogetherCB: TCheckBox;
+ StartNewPageCB: TCheckBox;
+ OutlineCB: TCheckBox;
+ DrillCB: TCheckBox;
+ ResetCB: TCheckBox;
+ procedure ExpressionEButtonClick(Sender: TObject);
+ procedure DataFieldRBClick(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure DataSetCBChange(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ FGroupHeader: TfrxGroupHeader;
+ FReport: TfrxReport;
+ procedure FillDataFieldCB;
+ procedure FillDataSetCB;
+ public
+ property GroupHeader: TfrxGroupHeader read FGroupHeader write FGroupHeader;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxUtils, FMX.frxRes;
+
+
+procedure TfrxGroupEditorForm.FormShow(Sender: TObject);
+var
+ ds: TfrxDataSet;
+ fld: String;
+begin
+ FReport := FGroupHeader.Report;
+ FillDataSetCB;
+
+ DataFieldRB.IsChecked := True;
+ FReport.GetDataSetAndField(FGroupHeader.Condition, ds, fld);
+ if FGroupHeader.Condition = '' then
+ begin
+ DataSetCB.ItemIndex := 0;
+ FillDataFieldCB;
+ DataFieldCB.SetFocus;
+ end
+ else if (ds <> nil) and (fld <> '') then
+ begin
+ DataSetCB.ItemIndex := DataSetCB.Items.IndexOf(FReport.GetAlias(ds));
+ FillDataFieldCB;
+ DataFieldCB.ItemIndex := DataFieldCB.Items.IndexOf(fld);
+ DataFieldCB.SetFocus;
+ end
+ else
+ begin
+ ExpressionE.Text := FGroupHeader.Condition;
+ ExpressionRB.IsChecked := True;
+ ExpressionE.SetFocus;
+ end;
+
+ KeepGroupTogetherCB.IsChecked := FGroupHeader.KeepTogether;
+ StartNewPageCB.IsChecked := FGroupHeader.StartNewPage;
+ OutlineCB.IsChecked := Trim(FGroupHeader.OutlineText) <> '';
+ DrillCB.IsChecked := FGroupHeader.DrillDown;
+ ResetCB.IsChecked := FGroupHeader.ResetPageNumbers;
+end;
+
+procedure TfrxGroupEditorForm.FillDataSetCB;
+begin
+ FReport.GetDataSetList(DataSetCB.Items);
+end;
+
+procedure TfrxGroupEditorForm.FillDataFieldCB;
+var
+ ds: TfrxDataSet;
+begin
+ ds := nil;
+ if DataSetCB.Selected <> nil then
+ ds := FReport.GetDataSet(DataSetCB.Selected.Text);
+ if ds <> nil then
+ ds.GetFieldList(DataFieldCB.Items) else
+{$IFDEF DELPHI23}
+ DataFieldCB.Clear;
+{$ELSE}
+ DataFieldCB.Items.Clear;
+{$ENDIF}
+end;
+
+procedure TfrxGroupEditorForm.ExpressionEButtonClick(Sender: TObject);
+var
+ s: String;
+begin
+ s := TfrxCustomDesigner(Owner).InsertExpression(ExpressionE.Text);
+ if s <> '' then
+ ExpressionE.Text := s;
+end;
+
+procedure TfrxGroupEditorForm.DataFieldRBClick(Sender: TObject);
+begin
+ DataSetCB.Enabled := DataFieldRB.IsChecked;
+ DataFieldCB.Enabled := DataFieldRB.IsChecked;
+ ExpressionE.Enabled := ExpressionRB.IsChecked;
+end;
+
+procedure TfrxGroupEditorForm.DataSetCBChange(Sender: TObject);
+begin
+ FillDataFieldCB;
+end;
+
+procedure TfrxGroupEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ if ModalResult = mrOk then
+ begin
+ if DataFieldRB.IsChecked then
+ if (DataSetCB.Selected <> nil) and (DataFieldCB.Selected <> nil) then
+ FGroupHeader.Condition := DataSetCB.Selected.Text + '."' + DataFieldCB.Selected.Text + '"' else
+ FGroupHeader.Condition := ExpressionE.Text;
+
+ FGroupHeader.KeepTogether := KeepGroupTogetherCB.IsChecked;
+ FGroupHeader.StartNewPage := StartNewPageCB.IsChecked;
+ if OutlineCB.IsChecked then
+ FGroupHeader.OutlineText := FGroupHeader.Condition else
+ FGroupHeader.OutlineText := '';
+ FGroupHeader.DrillDown := DrillCB.IsChecked;
+ FGroupHeader.ResetPageNumbers := ResetCB.IsChecked;
+ end;
+end;
+
+procedure TfrxGroupEditorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(3200);
+ BreakOnL.Text := frxGet(3201);
+ OptionsL.Text := frxGet(3202);
+ OKB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ DataFieldRB.Text := frxGet(3203);
+ ExpressionRB.Text := frxGet(3204);
+ KeepGroupTogetherCB.Text := frxGet(3205);
+ StartNewPageCB.Text := frxGet(3206);
+ OutlineCB.Text := frxGet(3207);
+ DrillCB.Text := frxResources.Get('bvDrillDown');
+ ResetCB.Text := frxResources.Get('bvResetPageNo');
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+end;
+
+procedure TfrxGroupEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+end.
+
diff --git a/LibD28/FMX.frxEditHighlight.fmx b/LibD28/FMX.frxEditHighlight.fmx
new file mode 100644
index 0000000..685a3f7
--- /dev/null
+++ b/LibD28/FMX.frxEditHighlight.fmx
@@ -0,0 +1,98 @@
+object frxHighlightEditorForm: TfrxHighlightEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Highlight'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 263
+ ClientWidth = 294
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object OKB: TButton
+ Position.Point = '(134,232)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(214,232)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object ConditionL: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 285.000000000000000000
+ Height = 53.000000000000000000
+ TabOrder = 2
+ object ConditionE: TfrxEditWithButton
+ Position.Point = '(8,20)'
+ Width = 269.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 0
+ OnButtonClick = ConditionEButtonClick
+ end
+ end
+ object FontL: TGroupBox
+ Position.Point = '(4,64)'
+ Width = 285.000000000000000000
+ Height = 85.000000000000000000
+ TabOrder = 3
+ object FontColorB: TColorComboBox
+ Position.Point = '(144,48)'
+ Width = 129.000000000000000000
+ Height = 25.000000000000000000
+ end
+ object BoldCB: TCheckBox
+ Position.Point = '(8,20)'
+ Width = 105.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ object ItalicCB: TCheckBox
+ Position.Point = '(8,40)'
+ Width = 105.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object UnderlineCB: TCheckBox
+ Position.Point = '(8,60)'
+ Width = 105.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ end
+ object BackgroundL: TGroupBox
+ Position.Point = '(4,156)'
+ Width = 285.000000000000000000
+ Height = 65.000000000000000000
+ TabOrder = 4
+ object BackColorB: TColorComboBox
+ Position.Point = '(144,28)'
+ Width = 129.000000000000000000
+ Height = 25.000000000000000000
+ end
+ object TransparentRB: TRadioButton
+ Position.Point = '(8,20)'
+ Width = 113.000000000000000000
+ Height = 17.000000000000000000
+ OnChange = TransparentRBClick
+ TabOrder = 1
+ end
+ object OtherRB: TRadioButton
+ Position.Point = '(8,40)'
+ Width = 113.000000000000000000
+ Height = 17.000000000000000000
+ OnChange = TransparentRBClick
+ TabOrder = 2
+ end
+ end
+end
diff --git a/LibD28/FMX.frxEditHighlight.pas b/LibD28/FMX.frxEditHighlight.pas
new file mode 100644
index 0000000..40ce5e0
--- /dev/null
+++ b/LibD28/FMX.frxEditHighlight.pas
@@ -0,0 +1,174 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Highlight editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditHighlight;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Types, FMX.Controls,
+ FMX.Forms, FMX.Dialogs, FMX.frxClass, FMX.ExtCtrls, FMX.frxCtrls,
+ System.Variants, FMX.ListBox, FMX.Edit, System.UIConsts, FMX.Colors
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+
+type
+{$IFDEF LINUX}
+ TfrxHighlightEditorForm = class(TfrxForm)
+{$ELSE}
+ TfrxHighlightEditorForm = class(TForm)
+{$ENDIF}
+ OKB: TButton;
+ CancelB: TButton;
+ ConditionL: TGroupBox;
+ ConditionE: TfrxEditWithButton;
+ FontL: TGroupBox;
+ FontColorB: TColorComboBox;
+ BoldCB: TCheckBox;
+ ItalicCB: TCheckBox;
+ UnderlineCB: TCheckBox;
+ //ColorDialog1: TColorDialog;
+ BackgroundL: TGroupBox;
+ BackColorB: TColorComboBox;
+ TransparentRB: TRadioButton;
+ OtherRB: TRadioButton;
+ procedure TransparentRBClick(Sender: TObject);
+ procedure ConditionEButtonClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ FHighlight: TfrxHighlight;
+ FMemoView: TfrxCustomMemoView;
+ public
+ property MemoView: TfrxCustomMemoView read FMemoView write FMemoView;
+ procedure HostControls(Host: TFmxObject);
+ procedure UnhostControls(AModalResult: TModalResult);
+ procedure FormShow(Sender: TObject);
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxRes;
+
+
+procedure TfrxHighlightEditorForm.FormShow(Sender: TObject);
+begin
+ FHighlight := FMemoView.Highlight;
+
+ ConditionE.Text := FHighlight.Condition;
+ BoldCB.IsChecked := TFontStyle.fsBold in FHighlight.Font.Style;
+ ItalicCB.IsChecked := TFontStyle.fsItalic in FHighlight.Font.Style;
+ UnderlineCB.IsChecked := TFontStyle.fsUnderline in FHighlight.Font.Style;
+ FontColorB.Color := FHighlight.Font.Color;
+
+ if FHighlight.Color = claNull then
+ TransparentRB.IsChecked := True else
+ OtherRB.IsChecked := True;
+ BackColorB.Color := FHighlight.Color;
+
+ TransparentRBClick(nil);
+end;
+
+
+procedure TfrxHighlightEditorForm.TransparentRBClick(Sender: TObject);
+begin
+ BackColorB.Enabled := OtherRB.IsChecked;
+ if TransparentRB.IsChecked then
+ BackColorB.Color := claNull;
+end;
+
+procedure TfrxHighlightEditorForm.ConditionEButtonClick(Sender: TObject);
+var
+ s: String;
+begin
+ s := TfrxCustomDesigner(Owner).InsertExpression(ConditionE.Text);
+ if s <> '' then
+ ConditionE.Text := s;
+end;
+
+procedure TfrxHighlightEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+var
+ fs: TFontStyles;
+begin
+ if ModalResult = mrOk then
+ begin
+ FHighlight.Condition := ConditionE.Text;
+
+ fs := [];
+ if BoldCB.IsChecked then
+ fs := fs + [TFontStyle.fsBold];
+ if ItalicCB.IsChecked then
+ fs := fs + [TFontStyle.fsItalic];
+ if UnderlineCB.IsChecked then
+ fs := fs + [TFontStyle.fsUnderline];
+
+ FHighlight.Font := MemoView.Font;
+ FHighlight.Font.Style := fs;
+ FHighlight.Font.Color := FontColorB.Color;
+ FHighlight.Color := BackColorB.Color;
+ end;
+end;
+
+procedure TfrxHighlightEditorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(4600);
+ ConditionL.Text := frxGet(4603);
+ FontL.Text := frxGet(4604);
+ BackgroundL.Text := frxGet(4605);
+ OKB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ BoldCB.Text := frxGet(4606);
+ ItalicCB.Text := frxGet(4607);
+ UnderlineCB.Text := frxGet(4608);
+ TransparentRB.Text := frxGet(4609);
+ OtherRB.Text := frxGet(4610);
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+end;
+
+procedure TfrxHighlightEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+procedure TfrxHighlightEditorForm.HostControls(Host: TFmxObject);
+begin
+ ConditionL.Parent := Host;
+ FontL.Parent := Host;
+ BackgroundL.Parent := Host;
+ FormShow(Self);
+end;
+
+procedure TfrxHighlightEditorForm.UnhostControls(AModalResult: TModalResult);
+var
+ ca: TCloseAction;
+begin
+ ModalResult := AModalResult;
+ FormClose(Self, ca);
+end;
+
+end.
+
diff --git a/LibD28/FMX.frxEditMD.fmx b/LibD28/FMX.frxEditMD.fmx
new file mode 100644
index 0000000..ace2e18
--- /dev/null
+++ b/LibD28/FMX.frxEditMD.fmx
@@ -0,0 +1,94 @@
+object frxMDEditorForm: TfrxMDEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Master-Detail link'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 250
+ ClientWidth = 324
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object Label1: TLabel
+ Position.Point = '(4,8)'
+ Width = 157.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object Label2: TLabel
+ Position.Point = '(17,8)'
+ Width = 187.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object Label3: TLabel
+ Position.Point = '(4,120)'
+ Width = 237.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 2
+ end
+ object DetailLB: TListBox
+ Position.Point = '(4,24)'
+ Width = 115.000000000000000000
+ Height = 85.000000000000000000
+ OnClick = DetailLBClick
+ HelpContext = 137
+ TabOrder = 3
+ ItemHeight = 13.000000000000000000
+ end
+ object MasterLB: TListBox
+ Position.Point = '(204,24)'
+ Width = 115.000000000000000000
+ Height = 85.000000000000000000
+ OnClick = MasterLBClick
+ HelpContext = 146
+ TabOrder = 4
+ ItemHeight = 13.000000000000000000
+ end
+ object AddB: TButton
+ Enabled = False
+ Position.Point = '(124,24)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = AddBClick
+ HelpContext = 156
+ TabOrder = 5
+ end
+ object LinksLB: TListBox
+ Position.Point = '(4,136)'
+ Width = 235.000000000000000000
+ Height = 61.000000000000000000
+ HelpContext = 164
+ TabOrder = 6
+ ItemHeight = 13.000000000000000000
+ end
+ object ClearB: TButton
+ Position.Point = '(244,136)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = ClearBClick
+ HelpContext = 174
+ TabOrder = 7
+ end
+ object OkB: TButton
+ Position.Point = '(164,220)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 40
+ TabOrder = 8
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(244,220)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 50
+ TabOrder = 9
+ ModalResult = 2
+ Cancel = True
+ end
+end
diff --git a/LibD28/FMX.frxEditMD.pas b/LibD28/FMX.frxEditMD.pas
new file mode 100644
index 0000000..5d36be6
--- /dev/null
+++ b/LibD28/FMX.frxEditMD.pas
@@ -0,0 +1,165 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ Master-Detail editor }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditMD;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.frxCustomDB, FMX.Layouts, FMX.ListBox, System.Variants
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+
+type
+ TfrxMDEditorForm = class(TForm)
+ DetailLB: TListBox;
+ MasterLB: TListBox;
+ Label1: TLabel;
+ Label2: TLabel;
+ AddB: TButton;
+ LinksLB: TListBox;
+ Label3: TLabel;
+ ClearB: TButton;
+ OkB: TButton;
+ CancelB: TButton;
+ procedure FormShow(Sender: TObject);
+ procedure FormHide(Sender: TObject);
+ procedure ClearBClick(Sender: TObject);
+ procedure DetailLBClick(Sender: TObject);
+ procedure MasterLBClick(Sender: TObject);
+ procedure AddBClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ FDetailDS: TfrxCustomDataset;
+ FMasterDS: TfrxCustomDBDataset;
+ FMasterFields: String;
+ procedure FillLists;
+ public
+ property DataSet: TfrxCustomDataset read FDetailDS write FDetailDS;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxUtils, FMX.frxRes, FMX.frxFMX;
+
+
+procedure TfrxMDEditorForm.FillLists;
+var
+ i: Integer;
+ s: String;
+ sl: TStrings;
+begin
+ FDetailDS.GetFieldList(DetailLB.Items);
+ FMasterDS.GetFieldList(MasterLB.Items);
+{$IFDEF DELPHI23}
+ LinksLB.Clear;
+{$ELSE}
+ LinksLB.Items.Clear;
+{$ENDIF}
+
+ sl := TStringList.Create;
+ frxSetCommaText(FMasterFields, sl);
+
+ for i := 0 to sl.Count - 1 do
+ begin
+ s := sl.Names[i];
+ if DetailLB.Items.IndexOf(s) <> -1 then
+ DetailLB.Items.Delete(DetailLB.Items.IndexOf(s));
+ s := sl.Values[sl.Names[i]];
+ if MasterLB.Items.IndexOf(s) <> -1 then
+ MasterLB.Items.Delete(MasterLB.Items.IndexOf(s));
+ LinksLB.Items.Add(sl[i]);
+ end;
+
+ AddB.Enabled := False;
+ sl.Free;
+end;
+
+procedure TfrxMDEditorForm.FormShow(Sender: TObject);
+begin
+ FMasterDS := FDetailDS.Master;
+ FMasterFields := FDetailDS.MasterFields;
+ FillLists;
+end;
+
+procedure TfrxMDEditorForm.FormHide(Sender: TObject);
+begin
+ if ModalResult = mrOk then
+ FDetailDS.MasterFields := FMasterFields;
+end;
+
+procedure TfrxMDEditorForm.ClearBClick(Sender: TObject);
+begin
+ FMasterFields := '';
+ FillLists;
+end;
+
+procedure TfrxMDEditorForm.DetailLBClick(Sender: TObject);
+begin
+ if MasterLB.ItemIndex <> -1 then
+ AddB.Enabled := True;
+end;
+
+procedure TfrxMDEditorForm.MasterLBClick(Sender: TObject);
+begin
+ if DetailLB.ItemIndex <> -1 then
+ AddB.Enabled := True;
+end;
+
+procedure TfrxMDEditorForm.AddBClick(Sender: TObject);
+var
+ s: String;
+begin
+ s := DetailLB.Items[DetailLB.ItemIndex] + '=' + MasterLB.Items[MasterLB.ItemIndex];
+ if FMasterFields = '' then
+ FMasterFields := s else
+ FMasterFields := FMasterFields + ';' + s;
+ FillLists;
+end;
+
+procedure TfrxMDEditorForm.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+ FormHide(Self);
+end;
+
+procedure TfrxMDEditorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(3800);
+ Label1.Text := frxGet(3801);
+ Label2.Text := frxGet(3802);
+ Label3.Text := frxGet(3803);
+ AddB.Text := frxGet(3804);
+ ClearB.Text := frxGet(3805);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+
+
+end;
+
+procedure TfrxMDEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VK_F1 then
+ frxResources.Help(Self);
+end;
+
+end.
+
diff --git a/LibD28/FMX.frxEditMemo.fmx b/LibD28/FMX.frxEditMemo.fmx
new file mode 100644
index 0000000..b9d46ed
--- /dev/null
+++ b/LibD28/FMX.frxEditMemo.fmx
@@ -0,0 +1,98 @@
+object frxMemoEditorForm: TfrxMemoEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Memo'
+ BorderIcons = [biSystemMenu, biMaximize]
+ ClientHeight = 404
+ ClientWidth = 458
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object TabControl: TTabControl
+ Align = alClient
+ Width = 458.000000000000000000
+ Height = 352.000000000000000000
+ TabIndex = 0
+ TabHeight = 20.000000000000000000
+ object TextTS: TTabItem
+ Width = 66.666664123535160000
+ Height = 20.000000000000000000
+ Index = 0
+ Text = 'TextTS'
+ WordWrap = False
+ object ToolBar: TToolBar
+ Width = 458.000000000000000000
+ Height = 28.000000000000000000
+ TabOrder = 0
+ object ExprB: TfrxToolButton
+ Position.Point = '(4,2)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = ExprBClick
+ Hint = 'Insert Expression'
+ end
+ object AggregateB: TfrxToolButton
+ Position.Point = '(27,2)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = AggregateBClick
+ end
+ object LocalFormatB: TfrxToolButton
+ Position.Point = '(50,2)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = LocalFormatBClick
+ end
+ object WordWrapB: TfrxToolButton
+ Position.Point = '(73,2)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = WordWrapBClick
+ Hint = 'Word Wrap'
+ end
+ end
+ end
+ object FormatTS: TTabItem
+ Width = 66.666664123535160000
+ Height = 20.000000000000000000
+ Index = 1
+ Text = 'FormatTS'
+ WordWrap = False
+ end
+ object HighlightTS: TTabItem
+ Width = 66.666664123535160000
+ Height = 20.000000000000000000
+ Index = 2
+ Text = 'HighlightTS'
+ WordWrap = False
+ end
+ end
+ object Panel1: TPanel
+ Align = alBottom
+ Position.Point = '(0,352)'
+ Width = 458.000000000000000000
+ Height = 50.000000000000000000
+ StyleLookup = 'backgroundstyle'
+ object CancelB: TButton
+ Position.Point = '(371,12)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object OkB: TButton
+ Position.Point = '(291,12)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 2
+ ModalResult = 1
+ end
+ end
+ object SaveDialog1: TSaveDialog
+ Left = 152
+ Top = 176
+ end
+end
diff --git a/LibD28/FMX.frxEditMemo.pas b/LibD28/FMX.frxEditMemo.pas
new file mode 100644
index 0000000..353d642
--- /dev/null
+++ b/LibD28/FMX.frxEditMemo.pas
@@ -0,0 +1,313 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Memo editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditMemo;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, System.Types, FMX.Types, FMX.Controls,
+ FMX.Forms, FMX.Dialogs, FMX.ExtCtrls, FMX.frxClass, FMX.TabControl,
+ FMX.frxEditFormat, FMX.frxEditHighlight, FMX.frxFMX, FMX.Memo, System.Variants, System.StrUtils,
+ FMX.frxBaseModalForm
+ {$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+ {$IFDEF DELPHI22}
+ ,FMX.Memo.Types
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+ TfrxMemoEditorForm = class(TfrxForm)
+ SaveDialog1: TSaveDialog;
+ TabControl: TTabControl;
+ TextTS: TTabItem;
+ FormatTS: TTabItem;
+ HighlightTS: TTabItem;
+ ToolBar: TToolBar;
+ ExprB: TfrxToolButton;
+ AggregateB: TfrxToolButton;
+ LocalFormatB: TfrxToolButton;
+ WordWrapB: TfrxToolButton;
+ Panel1: TPanel;
+ CancelB: TButton;
+ OkB: TButton;
+ procedure WordWrapBClick(Sender: TObject);
+ procedure MemoKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure ExprBClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure AggregateBClick(Sender: TObject);
+ procedure LocalFormatBClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure FormShow2(Sender: TObject);
+ private
+ FFormat: TfrxFormatEditorForm;
+ FHighlight: TfrxHighlightEditorForm;
+ FMemoView: TfrxCustomMemoView;
+ FText: WideString;
+ public
+ Memo: TMemo;
+ procedure FormShow(Sender: TObject);
+ property MemoView: TfrxCustomMemoView read FMemoView write FMemoView;
+ property Text: WideString read FText write FText;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses
+ FMX.frxEditSysMemo, System.IniFiles, FMX.frxRes, FMX.frxUnicodeUtils, FMX.frxUtils;
+
+
+{ TfrxMemoEditorForm }
+
+procedure TfrxMemoEditorForm.FormShow2(Sender: TObject);
+begin
+Memo.SetFocus;
+end;
+
+procedure TfrxMemoEditorForm.FormShow(Sender: TObject);
+var
+ Ini: TCustomIniFile;
+begin
+ Memo := TMemo.Create(TextTS);
+
+ with Memo do
+ begin
+ Parent := TextTS;
+ Align := TAlignLayout.alClient;
+ ///ScrollBars := ssBoth;
+ //TabOrder := 1;
+ OnKeyDown := MemoKeyDown;
+ end;
+
+ FFormat := TfrxFormatEditorForm.Create(Owner);
+ FFormat.Format.Assign(MemoView.DisplayFormat);
+ FFormat.HostControls(FormatTS);
+
+ FHighlight := TfrxHighlightEditorForm.Create(Owner);
+ FHighlight.MemoView := MemoView;
+ FHighlight.HostControls(HighlightTS);
+
+ Ini := TfrxCustomDesigner(Owner).Report.GetIniFile;
+ WordWrapB.Down := Ini.ReadBool('TfrxMemoEditorForm', 'WordWrap', False);
+ WordWrapBClick(nil);
+ frxRestoreFormPosition(Ini, Self);
+ Ini.Free;
+
+ with TfrxCustomDesigner(Owner) do
+ begin
+ if UseObjectFont then
+ begin
+ FMemoView.Font.AssignToFont(Memo.Font);
+ end
+ else
+ begin
+ {$IFDEF LINUX}
+ Memo.Font.Family := 'Liberation Sans';
+ {$ELSE}
+ Memo.Font.Family := 'Arial';
+ {$ENDIF}
+ Memo.Font.Size := 13;
+ end;
+ end;
+
+
+ Memo.Text := FMemoView.Text;
+ Memo.SelStart := Length(Memo.Text);
+ Memo.SelLength := 1;
+end;
+
+
+procedure TfrxMemoEditorForm.ExprBClick(Sender: TObject);
+var
+ s, s1, s2: String;
+ SelStart: TCaretPosition;
+ SelLen: Integer;
+
+ function BracketCount: Integer;
+ var
+ i: Integer;
+ begin
+ Result := 0;
+ for i := 1 to Length(s) do
+ if s[i] = '<' then
+ Inc(Result);
+ end;
+
+begin
+ s := TfrxCustomDesigner(Owner).InsertExpression('');
+ if s <> '' then
+ begin
+ s1 := MemoView.ExpressionDelimiters;
+ s2 := Copy(s1, Pos(',', s1) + 1, 255);
+ s1 := Copy(s1, 1, Pos(',', s1) - 1);
+ if (s[1] = '<') and (s[Length(s)] = '>') and (BracketCount = 1) then
+ s := Copy(s, 2, Length(s) - 2);
+ SelLen := Memo.SelLength;
+ SelStart := Memo.TextPosToPos(Memo.SelStart);
+ Memo.DeleteFrom(SelStart, SelLen, []);
+ Memo.InsertAfter(SelStart, s1 + s + s2, []);
+ //Memo.SelText := s1 + s + s2;
+ //todo
+ end;
+
+end;
+
+procedure TfrxMemoEditorForm.WordWrapBClick(Sender: TObject);
+begin
+ Memo.WordWrap := WordWrapB.Down;
+end;
+
+procedure TfrxMemoEditorForm.MemoKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if (Key = vkReturn) and (ssCtrl in Shift) then
+ ModalResult := mrOk
+ else if Key = vkEscape then
+ ModalResult := mrCancel
+ else if (Key = Ord('A')) and (Shift = [ssCtrl]) then
+ Memo.SelectAll;
+end;
+
+procedure TfrxMemoEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+var
+ Ini: TCustomIniFile;
+begin
+ Ini := TfrxCustomDesigner(Owner).Report.GetIniFile;
+ frxSaveFormPosition(Ini, Self);
+ Ini.WriteBool('TfrxMemoEditorForm', 'WordWrap', Memo.WordWrap);
+ Ini.Free;
+
+ FText := Memo.Text;
+
+ FFormat.UnhostControls;
+ if ModalResult = mrOk then
+ FMemoView.DisplayFormat.Assign(FFormat.Format);
+ FFormat.Free;
+ FHighlight.UnhostControls(ModalResult);
+ FHighlight.Free;
+end;
+
+
+procedure TfrxMemoEditorForm.FormCreate(Sender: TObject);
+begin
+ frxResources.LoadImageFromResouce(ExprB.Bitmap, 11, 3);
+ frxResources.LoadImageFromResouce(AggregateB.Bitmap, 6, 5);
+ frxResources.LoadImageFromResouce(LocalFormatB.Bitmap, 5, 2);
+ frxResources.LoadImageFromResouce(WordWrapB.Bitmap, 2, 5);
+ Caption := frxGet(3900);
+ ExprB.Hint := frxGet(3901);
+ AggregateB.Hint := frxGet(3902);
+ LocalFormatB.Hint := frxGet(3903);
+ WordWrapB.Hint := frxGet(3904);
+ TextTS.Text := frxGet(3905);
+ FormatTS.Text := frxGet(3906);
+ HighlightTS.Text := frxGet(3907);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+{$IFDEF DELPHI18}
+ CancelB.Anchors := [TAnchorKind.akRight, TAnchorKind.akTop];
+ OkB.Anchors := [TAnchorKind.akRight, TAnchorKind.akTop];
+{$ENDIF}
+{$IFDEF DELPHI18}
+ OnShow := FormShow2;
+{$ENDIF}
+
+ Toolbar.StyleLookup := 'backgroundstyle';
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxMemoEditorForm.AggregateBClick(Sender: TObject);
+var
+ SelStart: TCaretPosition;
+ SelLen: Integer;
+begin
+ with TfrxSysMemoEditorForm.Create(Owner) do
+ begin
+ AggregateOnly := True;
+ FormShow(nil);
+ if ShowModal = mrOk then
+ begin
+ SelLen := Memo.SelLength;
+ SelStart := Memo.TextPosToPos(Memo.SelStart);
+ Memo.DeleteFrom(SelStart, SelLen, []);
+ Memo.InsertAfter(SelStart, Text, []);
+ end;
+ ///Memo.SelText := Text;
+ Free;
+ end;
+end;
+
+procedure TfrxMemoEditorForm.LocalFormatBClick(Sender: TObject);
+var
+ s: String;
+ i: Integer;
+begin
+ with TfrxFormatEditorForm.Create(Owner) do
+ begin
+ FormShow(nil);
+ if ShowModal = mrOk then
+ begin
+ case Format.Kind of
+ fkText:
+ s := '';
+
+ fkNumeric:
+ begin
+ s := Format.FormatStr;
+ for i := 1 to Length(s) do
+ if CharInSet(s[i], ['.', ',', '-']) then
+ if Format.DecimalSeparator <> '' then
+ s[i] := Format.DecimalSeparator[1] else
+ s[i] := FormatSettings.DecimalSeparator;
+ s := ' #n' + s;
+ end;
+
+ fkDateTime:
+ s := ' #d' + Format.FormatStr;
+
+ fkBoolean:
+ s := ' #b' + Format.FormatStr;
+ end;
+
+ if s <> '' then
+ begin
+ i := Memo.SelStart;
+ if (i > 0) and (Memo.Text[i] = ']') then
+ Memo.SelStart := Memo.SelStart - 1;
+ //Memo.SelText := s;
+
+ end;
+ end;
+ Free;
+ end;
+end;
+
+procedure TfrxMemoEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+end.
+
diff --git a/LibD28/FMX.frxEditOptions.fmx b/LibD28/FMX.frxEditOptions.fmx
new file mode 100644
index 0000000..2d17468
--- /dev/null
+++ b/LibD28/FMX.frxEditOptions.fmx
@@ -0,0 +1,274 @@
+object frxOptionsEditor: TfrxOptionsEditor
+ Left = 0
+ Top = 0
+ Caption = 'Designer Options'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 443
+ ClientWidth = 349
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object OkB: TButton
+ Position.Point = '(188,412)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(268,412)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object RestoreDefaultsB: TButton
+ Position.Point = '(8,412)'
+ Width = 137.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = RestoreDefaultsBClick
+ TabOrder = 2
+ end
+ object Label1: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 341.000000000000000000
+ Height = 137.000000000000000000
+ TabOrder = 3
+ object Label2: TLabel
+ Position.Point = '(8,16)'
+ Width = 105.000000000000000000
+ Height = 18.000000000000000000
+ TabOrder = 0
+ end
+ object Label3: TLabel
+ Position.Point = '(128,16)'
+ Width = 89.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 1
+ end
+ object Label4: TLabel
+ Position.Point = '(26,110)'
+ Width = 95.000000000000000000
+ Height = 14.000000000000000000
+ TabOrder = 2
+ end
+ object Label13: TLabel
+ Position.Point = '(168,37)'
+ Width = 25.000000000000000000
+ Height = 15.000000000000000000
+ TabOrder = 3
+ end
+ object Label14: TLabel
+ Position.Point = '(168,61)'
+ Width = 25.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 4
+ end
+ object Label15: TLabel
+ Position.Point = '(168,85)'
+ Width = 33.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 5
+ end
+ object Label16: TLabel
+ Position.Point = '(168,109)'
+ Width = 41.000000000000000000
+ Height = 15.000000000000000000
+ TabOrder = 6
+ end
+ object CMRB: TRadioButton
+ Position.Point = '(8,36)'
+ Width = 109.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 7
+ end
+ object InchesRB: TRadioButton
+ Position.Point = '(8,60)'
+ Width = 109.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 8
+ end
+ object PixelsRB: TRadioButton
+ Position.Point = '(8,84)'
+ Width = 109.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 9
+ end
+ object CME: TEdit
+ Position.Point = '(128,34)'
+ Width = 37.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 10
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object InchesE: TEdit
+ Position.Point = '(128,58)'
+ Width = 37.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 11
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object PixelsE: TEdit
+ Position.Point = '(128,82)'
+ Width = 37.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 12
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object DialogFormE: TEdit
+ Position.Point = '(128,106)'
+ Width = 37.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 13
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object ShowGridCB: TCheckBox
+ Position.Point = '(196,36)'
+ Width = 137.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 14
+ end
+ object AlignGridCB: TCheckBox
+ Position.Point = '(196,56)'
+ Width = 137.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 15
+ end
+ end
+ object Label6: TGroupBox
+ Position.Point = '(4,144)'
+ Width = 341.000000000000000000
+ Height = 93.000000000000000000
+ TabOrder = 4
+ object Label7: TLabel
+ Position.Point = '(8,20)'
+ Width = 97.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object Label8: TLabel
+ Position.Point = '(8,48)'
+ Width = 97.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object Label9: TLabel
+ Position.Point = '(240,20)'
+ Width = 39.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object Label10: TLabel
+ Position.Point = '(240,48)'
+ Width = 39.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ object CodeWindowFontCB: TComboBox
+ Position.Point = '(112,18)'
+ Width = 121.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 4
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ DropDownCount = 12
+ end
+ object CodeWindowSizeCB: TComboBox
+ Position.Point = '(288,18)'
+ Width = 44.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 5
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ end
+ object MemoEditorFontCB: TComboBox
+ Position.Point = '(112,46)'
+ Width = 121.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 6
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ DropDownCount = 12
+ end
+ object MemoEditorSizeCB: TComboBox
+ Position.Point = '(288,46)'
+ Width = 44.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 7
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ end
+ object ObjectFontCB: TCheckBox
+ Position.Point = '(112,68)'
+ Width = 189.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 8
+ end
+ end
+ object Label5: TGroupBox
+ Position.Point = '(4,244)'
+ Width = 341.000000000000000000
+ Height = 153.000000000000000000
+ TabOrder = 5
+ object Label12: TLabel
+ Position.Point = '(8,127)'
+ Width = 140.000000000000000000
+ Height = 15.000000000000000000
+ TabOrder = 0
+ end
+ object Label17: TLabel
+ Position.Point = '(212,126)'
+ Width = 85.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ object EditAfterInsCB: TCheckBox
+ Position.Point = '(8,20)'
+ Width = 293.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object FreeBandsCB: TCheckBox
+ Position.Point = '(8,80)'
+ Width = 293.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ object GapE: TEdit
+ Position.Point = '(172,124)'
+ Width = 37.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 4
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object BandsCaptionsCB: TCheckBox
+ Position.Point = '(8,40)'
+ Width = 293.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 5
+ end
+ object DropFieldsCB: TCheckBox
+ Position.Point = '(8,60)'
+ Width = 293.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 6
+ end
+ object StartupCB: TCheckBox
+ Position.Point = '(8,100)'
+ Width = 293.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 7
+ end
+ end
+end
diff --git a/LibD28/FMX.frxEditOptions.pas b/LibD28/FMX.frxEditOptions.pas
new file mode 100644
index 0000000..9a0c6fc
--- /dev/null
+++ b/LibD28/FMX.frxEditOptions.pas
@@ -0,0 +1,266 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Designer options }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditOptions;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.Types, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.ExtCtrls, FMX.frxCtrls, FMX.Objects, FMX.ListBox, FMX.Edit, FMX.Types, System.Variants
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+
+type
+{$IFDEF LINUX}
+ TfrxOptionsEditor = class(TfrxForm)
+{$ELSE}
+ TfrxOptionsEditor = class(TForm)
+{$ENDIF}
+ OkB: TButton;
+ CancelB: TButton;
+ RestoreDefaultsB: TButton;
+ Label1: TGroupBox;
+ Label2: TLabel;
+ Label3: TLabel;
+ Label4: TLabel;
+ Label13: TLabel;
+ Label14: TLabel;
+ Label15: TLabel;
+ Label16: TLabel;
+ CMRB: TRadioButton;
+ InchesRB: TRadioButton;
+ PixelsRB: TRadioButton;
+ CME: TEdit;
+ InchesE: TEdit;
+ PixelsE: TEdit;
+ DialogFormE: TEdit;
+ ShowGridCB: TCheckBox;
+ AlignGridCB: TCheckBox;
+ Label6: TGroupBox;
+ Label7: TLabel;
+ Label8: TLabel;
+ Label9: TLabel;
+ Label10: TLabel;
+ CodeWindowFontCB: TComboBox;
+ CodeWindowSizeCB: TComboBox;
+ MemoEditorFontCB: TComboBox;
+ MemoEditorSizeCB: TComboBox;
+ ObjectFontCB: TCheckBox;
+ Label5: TGroupBox;
+ Label12: TLabel;
+ Label17: TLabel;
+ EditAfterInsCB: TCheckBox;
+ FreeBandsCB: TCheckBox;
+ GapE: TEdit;
+ BandsCaptionsCB: TCheckBox;
+ DropFieldsCB: TCheckBox;
+ StartupCB: TCheckBox;
+ procedure FormCreate(Sender: TObject);
+ procedure RestoreDefaultsBClick(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxDesgn, FMX.frxDesgnWorkspace, FMX.frxUtils, FMX.frxRes, FMX.frxFMX;
+
+
+{ TfrxPreferencesEditor }
+
+procedure TfrxOptionsEditor.FormShow(Sender: TObject);
+ var
+ aIndex: Integer;
+ procedure SetEnabled(cAr: Array of TControl; Enabled: Boolean);
+ var
+ i: Integer;
+ begin
+ for i := 0 to High(cAr) do
+ cAr[i].Enabled := Enabled;
+ end;
+
+ procedure FillSizes(Items: TStrings);
+ begin
+ Items.BeginUpdate;
+ Items.Add('4');
+ Items.Add('5');
+ Items.Add('6');
+ Items.Add('7');
+ Items.Add('8');
+ Items.Add('9');
+ Items.Add('10');
+ Items.Add('12');
+ Items.Add('14');
+ Items.Add('16');
+ Items.Add('18');
+ Items.Add('20');
+ Items.Add('22');
+ Items.Add('24');
+ Items.Add('26');
+ Items.Add('28');
+ Items.Add('36');
+ Items.EndUpdate;
+ end;
+
+begin
+ //ColorDialog.CustomColors.Add('ColorA=' + IntToHex(ColorToRGB(clBtnFace), 6));
+
+ with TfrxDesignerForm(Owner) do
+ begin
+ FillFontsList(CodeWindowFontCB.Items);
+ FillSizes(CodeWindowSizeCB.Items);
+ FillFontsList(MemoEditorFontCB.Items);
+
+ SetEnabled([CMRB, InchesRB, PixelsRB, CME, InchesE, PixelsE],
+ (Workspace.GridType <> gtDialog) and (Workspace.GridType <> gtChar));
+
+ CMRB.IsChecked := Units = duCM;
+ InchesRB.IsChecked := Units = duInches;
+ PixelsRB.IsChecked := Units = duPixels;
+
+ CME.Text := FloatToStr(GridSize1);
+ InchesE.Text := FloatToStr(GridSize2);
+ PixelsE.Text := FloatToStr(GridSize3);
+ DialogFormE.Text := FloatToStr(GridSize4);
+
+ ShowGridCB.IsChecked := ShowGrid;
+ AlignGridCB.IsChecked := GridAlign;
+ EditAfterInsCB.IsChecked := EditAfterInsert;
+ BandsCaptionsCB.IsChecked := Workspace.ShowBandCaptions;
+ DropFieldsCB.IsChecked := DropFields;
+ StartupCB.IsChecked := ShowStartup;
+ StartupCB.Visible := False;
+ FreeBandsCB.IsChecked := Workspace.FreeBandsPlacement;
+ GapE.Text := IntToStr(Workspace.GapBetweenBands);
+ aIndex := CodeWindowFontCB.Items.IndexOf(CodeWindow.FontSettings.Font.Family);
+ if aIndex <> -1 then
+ CodeWindowFontCB.ItemIndex := aIndex;
+ aIndex := CodeWindowSizeCB.Items.IndexOf(IntToStr(Round(CodeWindow.FontSettings.Font.Size)));
+ if aIndex = -1 then
+ aIndex := CodeWindowSizeCB.Items.Add(IntToStr(Round(CodeWindow.FontSettings.Font.Size)));
+ CodeWindowSizeCB.ItemIndex := aIndex;
+ MemoEditorFontCB.ItemIndex := MemoEditorFontCB.Items.IndexOf(MemoFontName);
+ MemoEditorSizeCB.ItemIndex := MemoEditorSizeCB.Items.IndexOf(IntToStr(MemoFontSize));
+ ObjectFontCB.IsChecked := UseObjectFont;
+ end;
+end;
+
+
+procedure TfrxOptionsEditor.RestoreDefaultsBClick(Sender: TObject);
+begin
+ TfrxDesignerForm(Owner).RestoreState(True);
+ ModalResult := mrOk;
+end;
+
+procedure TfrxOptionsEditor.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ if ModalResult = mrOk then
+ with TfrxDesignerForm(Owner) do
+ begin
+ GridSize4 := frxStrToFloat(DialogFormE.Text);
+
+ if CMRB.Enabled then
+ begin
+ GridSize1 := frxStrToFloat(CME.Text);
+ GridSize2 := frxStrToFloat(InchesE.Text);
+ GridSize3 := frxStrToFloat(PixelsE.Text);
+
+ if CMRB.IsChecked then
+ Units := duCM
+ else if InchesRB.IsChecked then
+ Units := duInches else
+ Units := duPixels;
+ end;
+
+ ShowGrid := ShowGridCB.IsChecked;
+ GridAlign := AlignGridCB.IsChecked;
+ EditAfterInsert := EditAfterInsCB.IsChecked;
+ Workspace.ShowBandCaptions := BandsCaptionsCB.IsChecked;
+ DropFields := DropFieldsCB.IsChecked;
+ ShowStartup := StartupCB.IsChecked;
+ Workspace.FreeBandsPlacement := FreeBandsCB.IsChecked;
+ Workspace.GapBetweenBands := StrToInt(GapE.Text);
+
+ if Assigned(CodeWindowFontCB.Selected) then
+ CodeWindow.FontSettings.Font.Family := CodeWindowFontCB.Selected.Text;
+ if Assigned(CodeWindowSizeCB.Selected) then
+ CodeWindow.FontSettings.Font.Size := StrToInt(CodeWindowSizeCB.Selected.Text);
+ if MemoEditorFontCB.Selected <> nil then
+ MemoFontName := MemoEditorFontCB.Selected.Text;
+ if MemoEditorSizeCB.Selected <> nil then
+ MemoFontSize := StrToInt(MemoEditorSizeCB.Selected.Text);
+ UseObjectFont := ObjectFontCB.IsChecked;
+ end;
+end;
+
+procedure TfrxOptionsEditor.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(3000);
+ Label1.Text := frxGet(3001);
+ Label2.Text := frxGet(3002);
+ Label3.Text := frxGet(3003);
+ Label4.Text := frxGet(3004);
+ Label5.Text := frxGet(3005);
+ Label6.Text := frxGet(3006);
+ Label7.Text := frxGet(3007);
+ Label8.Text := frxGet(3008);
+ Label9.Text := frxGet(3009);
+ Label10.Text := frxGet(3010);
+ Label12.Text := frxGet(3012);
+ Label13.Text := frxGet(3013);
+ Label14.Text := frxGet(3014);
+ Label15.Text := frxGet(3015);
+ Label16.Text := frxGet(3016);
+ Label17.Text := frxGet(3017);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ CMRB.Text := frxGet(3018);
+ InchesRB.Text := frxGet(3019);
+ PixelsRB.Text := frxGet(3020);
+ ShowGridCB.Text := frxGet(3021);
+ AlignGridCB.Text := frxGet(3022);
+ EditAfterInsCB.Text := frxGet(3023);
+ ObjectFontCB.Text := frxGet(3024);
+ FreeBandsCB.Text := frxGet(3028);
+ DropFieldsCB.Text := frxGet(3029);
+ StartupCB.Text := frxGet(3030);
+ RestoreDefaultsB.Text := frxGet(3031);
+ BandsCaptionsCB.Text := frxGet(3032);
+ FormShow(Self);
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxOptionsEditor.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VK_F1 then
+ frxResources.Help(Self);
+end;
+
+end.
diff --git a/LibD28/FMX.frxEditPage.fmx b/LibD28/FMX.frxEditPage.fmx
new file mode 100644
index 0000000..17a90d9
--- /dev/null
+++ b/LibD28/FMX.frxEditPage.fmx
@@ -0,0 +1,367 @@
+object frxPageEditorForm: TfrxPageEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Page options'
+ BorderStyle = bsSingle
+ BorderIcons = []
+ ClientHeight = 410
+ ClientWidth = 302
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object OKB: TButton
+ Position.Point = '(138,380)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(220,380)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object TabControl1: TTabControl
+ Position.Point = '(6,0)'
+ Width = 289.000000000000000000
+ Height = 377.000000000000000000
+ TabOrder = 2
+ TabIndex = 0
+ TabHeight = 20.000000000000000000
+ object TabSheet1: TTabItem
+ Width = 144.500000000000000000
+ Height = 20.000000000000000000
+ TabOrder = 0
+ Index = 0
+ Text = 'TabSheet1'
+ WordWrap = False
+ object Label11: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 277.000000000000000000
+ Height = 101.000000000000000000
+ TabOrder = 0
+ object Label1: TLabel
+ Position.Point = '(8,47)'
+ Width = 51.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 0
+ end
+ object Label2: TLabel
+ Position.Point = '(8,72)'
+ Width = 52.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 1
+ end
+ object UnitL1: TLabel
+ Position.Point = '(112,48)'
+ Width = 25.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object UnitL2: TLabel
+ Position.Point = '(112,72)'
+ Width = 33.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 3
+ end
+ object WidthE: TEdit
+ Position.Point = '(64,46)'
+ Width = 45.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 4
+ KeyboardType = vktDefault
+ OnChange = WidthEChange
+ Password = False
+ end
+ object HeightE: TEdit
+ Position.Point = '(64,70)'
+ Width = 45.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 5
+ KeyboardType = vktDefault
+ OnChange = WidthEChange
+ Password = False
+ end
+ object SizeCB: TComboBox
+ Position.Point = '(8,18)'
+ Width = 261.000000000000000000
+ Height = 21.000000000000000000
+ OnClick = SizeCBClick
+ TabOrder = 6
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ end
+ end
+ object Label12: TGroupBox
+ Position.Point = '(4,108)'
+ Width = 277.000000000000000000
+ Height = 65.000000000000000000
+ TabOrder = 1
+ object PortraitImg: TImage
+ Position.Point = '(148,21)'
+ Width = 26.000000000000000000
+ Height = 32.000000000000000000
+ end
+ object LandscapeImg: TImage
+ Position.Point = '(145,25)'
+ Width = 32.000000000000000000
+ Height = 26.000000000000000000
+ end
+ object PortraitRB: TRadioButton
+ Position.Point = '(8,20)'
+ Width = 109.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = PortraitRBClick
+ TabOrder = 2
+ end
+ object LandscapeRB: TRadioButton
+ Position.Point = '(8,40)'
+ Width = 109.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = PortraitRBClick
+ TabOrder = 3
+ end
+ end
+ object Label13: TGroupBox
+ Position.Point = '(4,176)'
+ Width = 277.000000000000000000
+ Height = 73.000000000000000000
+ TabOrder = 2
+ object Label3: TLabel
+ Position.Point = '(8,20)'
+ Width = 50.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 0
+ end
+ object Label4: TLabel
+ Position.Point = '(8,43)'
+ Width = 49.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ object Label5: TLabel
+ Position.Point = '(152,19)'
+ Width = 49.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 2
+ end
+ object Label6: TLabel
+ Position.Point = '(152,42)'
+ Width = 52.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ object UnitL3: TLabel
+ Position.Point = '(108,20)'
+ Width = 29.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 4
+ end
+ object UnitL4: TLabel
+ Position.Point = '(108,44)'
+ Width = 29.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 5
+ end
+ object UnitL5: TLabel
+ Position.Point = '(252,20)'
+ Width = 21.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 6
+ end
+ object UnitL6: TLabel
+ Position.Point = '(252,44)'
+ Width = 21.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 7
+ end
+ object MarginLeftE: TEdit
+ Position.Point = '(64,18)'
+ Width = 40.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 8
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object MarginTopE: TEdit
+ Position.Point = '(64,42)'
+ Width = 40.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 9
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object MarginRightE: TEdit
+ Position.Point = '(208,18)'
+ Width = 40.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 10
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object MarginBottomE: TEdit
+ Position.Point = '(208,42)'
+ Width = 40.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 11
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+ object Label14: TGroupBox
+ Position.Point = '(4,252)'
+ Width = 277.000000000000000000
+ Height = 73.000000000000000000
+ TabOrder = 3
+ object Label9: TLabel
+ Position.Point = '(8,20)'
+ Width = 89.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 0
+ end
+ object Label10: TLabel
+ Position.Point = '(8,44)'
+ Width = 97.000000000000000000
+ Height = 15.000000000000000000
+ TabOrder = 1
+ end
+ object Tray1CB: TComboBox
+ Position.Point = '(128,18)'
+ Width = 141.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 2
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ end
+ object Tray2CB: TComboBox
+ Position.Point = '(128,42)'
+ Width = 141.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 3
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ end
+ end
+ end
+ object TabSheet3: TTabItem
+ Width = 144.500000000000000000
+ Height = 20.000000000000000000
+ TabOrder = 1
+ Index = 1
+ Text = 'TabSheet3'
+ WordWrap = False
+ object Label17: TGroupBox
+ Position.Point = '(4,156)'
+ Width = 277.000000000000000000
+ Height = 169.000000000000000000
+ TabOrder = 0
+ object Label18: TLabel
+ Position.Point = '(8,132)'
+ Width = 73.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 0
+ end
+ object PrintOnPrevCB: TCheckBox
+ Position.Point = '(8,20)'
+ Width = 261.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ object MirrorMarginsCB: TCheckBox
+ Position.Point = '(8,40)'
+ Width = 261.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object LargeHeightCB: TCheckBox
+ Position.Point = '(8,100)'
+ Width = 261.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ object DuplexCB: TComboBox
+ Position.Point = '(88,130)'
+ Width = 141.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 4
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ end
+ object EndlessWidthCB: TCheckBox
+ Position.Point = '(8,60)'
+ Width = 261.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 5
+ end
+ object EndlessHeightCB: TCheckBox
+ Position.Point = '(8,80)'
+ Width = 261.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 6
+ end
+ end
+ object Label7: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 277.000000000000000000
+ Height = 149.000000000000000000
+ TabOrder = 1
+ object Label8: TLabel
+ Position.Point = '(8,19)'
+ Width = 73.000000000000000000
+ Height = 15.000000000000000000
+ TabOrder = 0
+ end
+ object Label15: TLabel
+ Position.Point = '(8,44)'
+ Width = 74.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 1
+ end
+ object Label16: TLabel
+ Position.Point = '(8,68)'
+ Width = 73.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object UnitL7: TLabel
+ Position.Point = '(136,44)'
+ Width = 13.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 3
+ end
+ object ColumnWidthE: TEdit
+ Position.Point = '(88,42)'
+ Width = 57.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 4
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object ColumnPositionsM: TMemo
+ Position.Point = '(88,66)'
+ Width = 113.000000000000000000
+ Height = 71.000000000000000000
+ TabOrder = 5
+ KeyboardType = vktDefault
+ end
+ object ColumnsNumberS: TSpinBox
+ Position.Point = '(88,16)'
+ Width = 57.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 6
+ KeyboardType = vktDefault
+ OnChange = ColumnsNumberSChange
+ Max = 10.000000000000000000
+ Increment = 1.000000000000000000
+ end
+ end
+ end
+ end
+end
diff --git a/LibD28/FMX.frxEditPage.pas b/LibD28/FMX.frxEditPage.pas
new file mode 100644
index 0000000..8fc485e
--- /dev/null
+++ b/LibD28/FMX.frxEditPage.pas
@@ -0,0 +1,375 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Page options }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditPage;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Types, FMX.Objects, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.ExtCtrls, FMX.frxCtrls, FMX.TabControl, FMX.LIstBox, FMX.Edit, Fmx.Memo, FMX.frxFMX
+, System.Variants, FMX.Layouts
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI21}
+ ,FMX.SpinBox
+{$ENDIF};
+
+
+type
+{$IFDEF LINUX}
+ TfrxPageEditorForm = class(TfrxForm)
+{$ELSE}
+ TfrxPageEditorForm = class(TForm)
+{$ENDIF}
+ OKB: TButton;
+ CancelB: TButton;
+ TabControl1: TTabControl;
+ TabSheet1: TTabItem;
+ TabSheet3: TTabItem;
+ Label11: TGroupBox;
+ Label1: TLabel;
+ Label2: TLabel;
+ UnitL1: TLabel;
+ UnitL2: TLabel;
+ WidthE: TEdit;
+ HeightE: TEdit;
+ SizeCB: TComboBox;
+ Label12: TGroupBox;
+ PortraitImg: TImage;
+ LandscapeImg: TImage;
+ PortraitRB: TRadioButton;
+ LandscapeRB: TRadioButton;
+ Label13: TGroupBox;
+ Label3: TLabel;
+ Label4: TLabel;
+ Label5: TLabel;
+ Label6: TLabel;
+ UnitL3: TLabel;
+ UnitL4: TLabel;
+ UnitL5: TLabel;
+ UnitL6: TLabel;
+ MarginLeftE: TEdit;
+ MarginTopE: TEdit;
+ MarginRightE: TEdit;
+ MarginBottomE: TEdit;
+ Label14: TGroupBox;
+ Label9: TLabel;
+ Label10: TLabel;
+ Tray1CB: TComboBox;
+ Tray2CB: TComboBox;
+ Label17: TGroupBox;
+ Label18: TLabel;
+ PrintOnPrevCB: TCheckBox;
+ MirrorMarginsCB: TCheckBox;
+ LargeHeightCB: TCheckBox;
+ DuplexCB: TComboBox;
+ EndlessWidthCB: TCheckBox;
+ EndlessHeightCB: TCheckBox;
+ Label7: TGroupBox;
+ Label8: TLabel;
+ Label15: TLabel;
+ Label16: TLabel;
+ UnitL7: TLabel;
+ ColumnWidthE: TEdit;
+ ColumnPositionsM: TMemo;
+ ColumnsNumberS: TSpinBox;
+ procedure PortraitRBClick(Sender: TObject);
+ procedure SizeCBClick(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure WidthEChange(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure ColumnsNumberSChange(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ { Private declarations }
+ FUpdating: Boolean;
+ public
+ { Public declarations }
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.Printer, FMX.frxPrinter, FMX.frxClass, FMX.frxUtils, FMX.frxDesgn, FMX.frxRes;
+
+
+procedure TfrxPageEditorForm.FormShow(Sender: TObject);
+var
+ i: Integer;
+ p: TfrxReportPage;
+begin
+ FUpdating := True;
+ SizeCB.OnChange := SizeCBClick;
+ with frxPrinters.Printer, TfrxDesignerForm(Owner) do
+ begin
+ p := TfrxReportPage(Page);
+
+ SizeCB.Items := Papers;
+ i := PaperIndex(p.PaperSize);
+ if i = -1 then
+ i := PaperIndex(256);
+ SizeCB.ItemIndex := i;
+
+ WidthE.Text := frxFloatToStr(mmToUnits(p.PaperWidth));
+ HeightE.Text := frxFloatToStr(mmToUnits(p.PaperHeight, False));
+ PortraitRB.IsChecked := p.Orientation = TPrinterOrientation.poPortrait;
+ LandscapeRB.IsChecked := p.Orientation = TPrinterOrientation.poLandscape;
+
+ MarginLeftE.Text := frxFloatToStr(mmToUnits(p.LeftMargin));
+ MarginRightE.Text := frxFloatToStr(mmToUnits(p.RightMargin));
+ MarginTopE.Text := frxFloatToStr(mmToUnits(p.TopMargin, False));
+ MarginBottomE.Text := frxFloatToStr(mmToUnits(p.BottomMargin, False));
+
+ Tray1CB.Items := Bins;
+ Tray2CB.Items := Tray1CB.Items;
+ i := BinIndex(p.Bin);
+ if i = -1 then
+ i := BinIndex(DMBIN_AUTO);
+ Tray1CB.ItemIndex := i;
+ i := BinIndex(p.BinOtherPages);
+ if i = -1 then
+ i := BinIndex(DMBIN_AUTO);
+ Tray2CB.ItemIndex := i;
+
+ ColumnsNumberS.Text := IntToStr(p.Columns);
+ ColumnWidthE.Text := frxFloatToStr(mmToUnits(p.ColumnWidth));
+ for i := 0 to p.ColumnPositions.Count - 1 do
+ ColumnPositionsM.Lines.Add(frxFloatToStr(mmToUnits(frxStrToFloat(p.ColumnPositions[i]))));
+ PrintOnPrevCB.IsChecked := p.PrintOnPreviousPage;
+ MirrorMarginsCB.IsChecked := p.MirrorMargins;
+ EndlessHeightCB.IsChecked := p.EndlessHeight;
+ EndlessWidthCB.IsChecked := p.EndlessWidth;
+ LargeHeightCB.IsChecked := p.LargeDesignHeight;
+ DuplexCB.ItemIndex := Integer(p.Duplex);
+ end;
+
+ PortraitRBClick(nil);
+ FUpdating := False;
+end;
+
+procedure TfrxPageEditorForm.PortraitRBClick(Sender: TObject);
+begin
+ PortraitImg.Visible := PortraitRB.IsChecked;
+ LandscapeImg.Visible := LandscapeRB.IsChecked;
+ SizeCBClick(nil);
+end;
+
+procedure TfrxPageEditorForm.SizeCBClick(Sender: TObject);
+var
+ pOr: TPrinterOrientation;
+ pNumber: Integer;
+ pWidth, pHeight: Extended;
+begin
+ if FUpdating then Exit;
+ FUpdating := True;
+
+ with frxPrinters.Printer, TfrxDesignerForm(Owner) do
+ begin
+ pNumber := PaperNameToNumber(SizeCB.Selected.Text);
+ pWidth := UnitsTomm(frxStrToFloat(WidthE.Text));
+ pHeight := UnitsTomm(frxStrToFloat(HeightE.Text), False);
+ if not PortraitRB.IsChecked then
+ pOr := poPortrait else
+ pOr := poLandscape;
+
+ if pNumber = 256 then
+ SetViewParams(pNumber, pHeight, pWidth, pOr) else
+ SetViewParams(pNumber, pWidth, pHeight, pOr);
+
+ if frxPrinters.Printer.Orientation = poPortrait then
+ PortraitRB.IsChecked := True
+ else
+ LandscapeRB.IsChecked := True;
+
+ WidthE.Text := frxFloatToStr(mmToUnits(PaperWidth));
+ HeightE.Text := frxFloatToStr(mmToUnits(PaperHeight, False));
+ end;
+
+ FUpdating := False;
+end;
+
+procedure TfrxPageEditorForm.ColumnsNumberSChange(Sender: TObject);
+var
+ n: Integer;
+ w: Extended;
+begin
+ if FUpdating then Exit;
+
+ n := StrToInt(ColumnsNumberS.Text);
+ if n = 0 then
+ n := 1;
+
+ with TfrxDesignerForm(Owner) do
+ begin
+ w := (UnitsTomm(frxStrToFloat(WidthE.Text)) -
+ UnitsTomm(frxStrToFloat(MarginLeftE.Text)) -
+ UnitsTomm(frxStrToFloat(MarginRightE.Text))) / n;
+ ColumnWidthE.Text := frxFloatToStr(mmToUnits(w));
+
+ with ColumnPositionsM.Lines do
+ begin
+ Clear;
+ while Count < n do
+ Add(frxFloatToStr(mmToUnits(Count * w)));
+ end;
+ end;
+end;
+
+
+procedure TfrxPageEditorForm.WidthEChange(Sender: TObject);
+begin
+ if not FUpdating then
+ SizeCB.ItemIndex := 0;
+end;
+
+procedure TfrxPageEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+var
+ p: TfrxReportPage;
+ i: Integer;
+ c: TfrxReportComponent;
+
+ procedure ChangePage(p: TfrxReportPage);
+ var
+ i: Integer;
+ begin
+ with frxPrinters.Printer, TfrxDesignerForm(Owner) do
+ begin
+ if PortraitRB.IsChecked then
+ p.Orientation := TPrinterOrientation.poPortrait else
+ p.Orientation := TPrinterOrientation.poLandscape;
+
+ p.SetSizeAndDimensions(PaperNameToNumber(SizeCB.Selected.Text),
+ UnitsTomm(frxStrToFloat(WidthE.Text)),
+ UnitsTomm(frxStrToFloat(HeightE.Text), False));
+
+ p.LeftMargin := UnitsTomm(frxStrToFloat(MarginLeftE.Text));
+ p.RightMargin := UnitsTomm(frxStrToFloat(MarginRightE.Text));
+ p.TopMargin := UnitsTomm(frxStrToFloat(MarginTopE.Text), False);
+ p.BottomMargin := UnitsTomm(frxStrToFloat(MarginBottomE.Text), False);
+
+ p.Bin := BinNameToNumber(Tray1CB.Selected.Text);
+ p.BinOtherPages := BinNameToNumber(Tray2CB.Selected.Text);
+
+ p.Columns := StrToInt(ColumnsNumberS.Text);
+ p.ColumnWidth := UnitsTomm(frxStrToFloat(ColumnWidthE.Text));
+ p.ColumnPositions.Clear;
+ for i := 0 to ColumnPositionsM.Lines.Count - 1 do
+ p.ColumnPositions.Add(frxFloatToStr(UnitsTomm(frxStrToFloat(ColumnPositionsM.Lines[i]))));
+ p.PrintOnPreviousPage := PrintOnPrevCB.IsChecked;
+ p.MirrorMargins := MirrorMarginsCB.IsChecked;
+ p.EndlessWidth := EndlessWidthCB.IsChecked;
+ p.EndlessHeight := EndlessHeightCB.IsChecked;
+ p.LargeDesignHeight := LargeHeightCB.IsChecked;
+ p.Duplex := TfrxDuplexMode(DuplexCB.ItemIndex);
+ end;
+ end;
+
+begin
+ if ModalResult = mrOk then
+ begin
+ p := TfrxReportPage(TfrxDesignerForm(Owner).Page);
+ ChangePage(p);
+
+ { change all subreport pages }
+ for i := 0 to p.AllObjects.Count - 1 do
+ begin
+ c := p.AllObjects[i];
+ if c is TfrxSubreport then
+ ChangePage(TfrxSubreport(c).Page);
+ end;
+ end;
+
+end;
+
+procedure TfrxPageEditorForm.FormCreate(Sender: TObject);
+var
+ uStr: String;
+begin
+ Caption := frxGet(2700);
+ OKB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ TabSheet1.Text := frxGet(2701);
+ Label1.Text := frxGet(2702);
+ Label2.Text := frxGet(2703);
+ Label11.Text := frxGet(2704);
+ Label12.Text := frxGet(2705);
+ Label3.Text := frxGet(2706);
+ Label4.Text := frxGet(2707);
+ Label5.Text := frxGet(2708);
+ Label6.Text := frxGet(2709);
+ Label13.Text := frxGet(2710);
+ Label14.Text := frxGet(2711);
+ Label9.Text := frxGet(2712);
+ Label10.Text := frxGet(2713);
+ PortraitRB.Text := frxGet(2714);
+ LandscapeRB.Text := frxGet(2715);
+ TabSheet3.Text := frxGet(2716);
+ Label7.Text := frxGet(2717);
+ Label8.Text := frxGet(2718);
+ Label15.Text := frxGet(2719);
+ Label16.Text := frxGet(2720);
+ Label17.Text := frxGet(2721);
+ Label18.Text := frxGet(2722);
+ PrintOnPrevCB.Text := frxGet(2723);
+ MirrorMarginsCB.Text := frxGet(2724);
+ LargeHeightCB.Text := frxGet(2725);
+ EndlessWidthCB.Text := frxGet(2726);
+ EndlessHeightCB.Text := frxGet(2727);
+{$IFDEF DELPHI23}
+ DuplexCB.Clear;
+{$ELSE}
+ DuplexCB.Items.Clear;
+{$ENDIF}
+ DuplexCB.Items.Add(frxResources.Get('dupDefault'));
+ DuplexCB.Items.Add(frxResources.Get('dupVert'));
+ DuplexCB.Items.Add(frxResources.Get('dupHorz'));
+ DuplexCB.Items.Add(frxResources.Get('dupSimpl'));
+
+ uStr := '';
+ case TfrxDesignerForm(Owner).Units of
+ duCM: uStr := frxResources.Get('uCm');
+ duInches: uStr := frxResources.Get('uInch');
+ duPixels: uStr := frxResources.Get('uPix');
+ duChars: uStr := frxResources.Get('uChar');
+ end;
+
+ UnitL1.Text := uStr;
+ UnitL2.Text := uStr;
+ UnitL3.Text := uStr;
+ UnitL4.Text := uStr;
+ UnitL5.Text := uStr;
+ UnitL6.Text := uStr;
+ UnitL7.Text := uStr;
+ FormShow(Self);
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxPageEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+end.
+
diff --git a/LibD28/FMX.frxEditPicture.fmx b/LibD28/FMX.frxEditPicture.fmx
new file mode 100644
index 0000000..a7348a5
--- /dev/null
+++ b/LibD28/FMX.frxEditPicture.fmx
@@ -0,0 +1,78 @@
+object frxPictureEditorForm: TfrxPictureEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Picture'
+ ClientHeight = 307
+ ClientWidth = 336
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnActivate = FormActivate
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object ToolBar: TToolBar
+ Width = 336.000000000000000000
+ Height = 31.000000000000000000
+ TabOrder = 0
+ object LoadB: TfrxToolButton
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = LoadBClick
+ TabOrder = 0
+ end
+ object CopyB: TfrxToolButton
+ Position.Point = '(23,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = CopyBClick
+ TabOrder = 1
+ end
+ object PasteB: TfrxToolButton
+ Position.Point = '(46,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = PasteBClick
+ TabOrder = 2
+ end
+ object ClearB: TfrxToolButton
+ Position.Point = '(69,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = ClearBClick
+ TabOrder = 3
+ end
+ object CancelB: TfrxToolButton
+ Position.Point = '(102,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = CancelBClick
+ TabOrder = 4
+ end
+ object OkB: TfrxToolButton
+ Position.Point = '(125,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = OkBClick
+ TabOrder = 5
+ end
+ end
+ object Box: TScrollBox
+ Align = alClient
+ Position.Point = '(0,31)'
+ Width = 336.000000000000000000
+ Height = 257.000000000000000000
+ TabOrder = 1
+ object Image: TImage
+ Position.Point = '(4,4)'
+ Width = 325.000000000000000000
+ Height = 241.000000000000000000
+ end
+ end
+ object StatusBar: TStatusBar
+ Position.Point = '(0,288)'
+ Width = 336.000000000000000000
+ Height = 19.000000000000000000
+ TabOrder = 2
+ ShowSizeGrip = True
+ end
+end
diff --git a/LibD28/FMX.frxEditPicture.pas b/LibD28/FMX.frxEditPicture.pas
new file mode 100644
index 0000000..9198afa
--- /dev/null
+++ b/LibD28/FMX.frxEditPicture.pas
@@ -0,0 +1,194 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Picture editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditPicture;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Controls,
+ FMX.Forms, FMX.Dialogs, FMX.ExtCtrls, FMX.frxCtrls, FMX.frxBaseModalForm,
+ FMX.Objects, FMX.Layouts, FMX.Types, FMX.frxFMX, System.Variants
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+
+type
+ TfrxPictureEditorForm = class(TfrxForm)
+ ToolBar: TToolBar;
+ LoadB: TfrxToolButton;
+ ClearB: TfrxToolButton;
+ OkB: TfrxToolButton;
+ Box: TScrollBox;
+ CancelB: TfrxToolButton;
+ Image: TImage;
+ StatusBar: TStatusBar;
+ CopyB: TfrxToolButton;
+ PasteB: TfrxToolButton;
+ procedure ClearBClick(Sender: TObject);
+ procedure LoadBClick(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure OkBClick(Sender: TObject);
+ procedure CancelBClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure CopyBClick(Sender: TObject);
+ procedure PasteBClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormActivate(Sender: TObject);
+ private
+ //FStatusBarOldWindowProc: TWndMethod;
+ //procedure StatusBarWndProc(var Message: TMessage);
+ { Private declarations }
+ procedure UpdateImage;
+ public
+ { Public declarations }
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxClass, FMX.frxUtils, FMX.frxRes, FMX.Platform ;
+
+
+{ TfrxPictureEditorForm }
+
+procedure TfrxPictureEditorForm.UpdateImage;
+begin
+// if (Image.Bitmap = nil) or Image.Bitmap.IsEmpty then
+// StatusBar.Panels[0].Text := frxResources.Get('piEmpty')
+// else
+// begin
+// StatusBar. Panels[0].Text := Format('%d x %d',
+// [Image.Picture.Width, Image.Picture.Height]);
+// Image.Stretch := (Image.Picture.Width > Image.Width) or
+// (Image.Picture.Height > Image.Height);
+// end;
+end;
+
+procedure TfrxPictureEditorForm.FormShow(Sender: TObject);
+begin
+ //Toolbar.Images := frxResources.MainButtonImages;
+
+
+end;
+
+procedure TfrxPictureEditorForm.ClearBClick(Sender: TObject);
+begin
+ Image.Bitmap.Assign(nil);
+ UpdateImage;
+end;
+
+procedure TfrxPictureEditorForm.LoadBClick(Sender: TObject);
+var
+ OpenDlg: TOpenDialog;
+begin
+ OpenDlg := TOpenDialog.Create(nil);
+ OpenDlg.Options := [];
+ OpenDlg.Filter := frxResources.Get('ftPictures') + ' (*.bmp ' +
+{$IFDEF JPEG}
+ '*.jpg ' +
+{$ENDIF}
+{$IFDEF PNG}
+ '*.png ' +
+{$ENDIF}
+ '*.ico *.wmf *.emf)|*.bmp;' +
+{$IFDEF JPEG}
+ '*.jpg;' +
+{$ENDIF}
+{$IFDEF PNG}
+ '*.png;' +
+{$ENDIF}
+ '*.ico;*.wmf;*.emf|' + frxResources.Get('ftAllFiles') + '|*.*';
+ if OpenDlg.Execute then
+ Image.Bitmap.LoadFromFile(OpenDlg.FileName);
+ PeekLastModalResult;
+ OpenDlg.Free;
+ UpdateImage;
+end;
+
+procedure TfrxPictureEditorForm.OkBClick(Sender: TObject);
+begin
+ ModalResult := mrOk;
+end;
+
+procedure TfrxPictureEditorForm.CancelBClick(Sender: TObject);
+begin
+ ModalResult := mrCancel;
+end;
+
+procedure TfrxPictureEditorForm.FormActivate(Sender: TObject);
+begin
+ UpdateImage;
+end;
+
+procedure TfrxPictureEditorForm.FormCreate(Sender: TObject);
+begin
+ //FStatusBarOldWindowProc := StatusBar.WindowProc;
+ //StatusBar.WindowProc := StatusBarWndProc;
+ Caption := frxGet(4000);
+ LoadB.Hint := frxGet(4001);
+ CopyB.Hint := frxGet(4002);
+ PasteB.Hint := frxGet(4003);
+ ClearB.Hint := frxGet(4004);
+ CancelB.Hint := frxGet(2);
+ OkB.Hint := frxGet(1);
+ frxResources.LoadImageFromResouce(OkB.Bitmap, 21, 0);
+ frxResources.LoadImageFromResouce(CancelB.Bitmap, 21, 2);
+ frxResources.LoadImageFromResouce(ClearB.Bitmap, 8, 2);
+ frxResources.LoadImageFromResouce(PasteB.Bitmap, 0, 7);
+ frxResources.LoadImageFromResouce(CopyB.Bitmap, 0, 6);
+ frxResources.LoadImageFromResouce(LoadB.Bitmap, 0, 1);
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxPictureEditorForm.CopyBClick(Sender: TObject);
+begin
+ //if Image.Bitmap <> nil then
+ //Platform.SetClipboard();
+ // Clipboard.Assign(Image.Picture);
+ //todo Platform.SetClipboard support only trxt clipboard
+end;
+
+procedure TfrxPictureEditorForm.PasteBClick(Sender: TObject);
+begin
+// if Clipboard.HasFormat(CF_BITMAP) or Clipboard.HasFormat(CF_METAFILEPICT) or
+// Clipboard.HasFormat(CF_PICTURE) then
+// begin
+// Image.Picture.Assign(Clipboard);
+// UpdateImage;
+// end
+// else
+// ShowMessage(frxResources.Get('erInvalidImg'));
+end;
+
+procedure TfrxPictureEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+//procedure TfrxPictureEditorForm.StatusBarWndProc(var Message: TMessage);
+//begin
+// if Message.Msg = WM_SYSCOLORCHANGE then
+// DefWindowProc(StatusBar.Handle,Message.Msg,Message.WParam,Message.LParam)
+// else
+// FStatusBarOldWindowProc(Message);
+//end;
+
+end.
+
diff --git a/LibD28/FMX.frxEditQueryParams.fmx b/LibD28/FMX.frxEditQueryParams.fmx
new file mode 100644
index 0000000..de2aebc
--- /dev/null
+++ b/LibD28/FMX.frxEditQueryParams.fmx
@@ -0,0 +1,65 @@
+object frxParamsEditorForm: TfrxParamsEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Parameters editor'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 381
+ ClientWidth = 392
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object OkB: TButton
+ Position.Point = '(232,348)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = OkBClick
+ TabOrder = 0
+ ModalResult = 1
+ end
+ object CancelB: TButton
+ Position.Point = '(312,348)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object ParamGrid: TStringGrid
+ Position.Point = '(8,8)'
+ Width = 377.000000000000000000
+ Height = 329.000000000000000000
+ OnResize = ParamGridResize
+ StyleLookup = 'gridstyle'
+ TabOrder = 2
+ RowHeight = 21.000000000000000000
+ OnSelChanged = ParamGridResize
+ RowCount = 100
+ end
+ object TypeCB: TComboBox
+ Position.Point = '(104,23)'
+ Width = 84.000000000000000000
+ Height = 19.000000000000000000
+ Visible = False
+ TabOrder = 3
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ ListBoxResource = 'transparentlistboxstyle'
+ OnChange = TypeCBChange
+ end
+ object ButtonPanel: TPanel
+ Position.Point = '(360,24)'
+ Width = 17.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 4
+ object ExpressionB: TSpeedButton
+ Width = 17.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = ValueEButtonClick
+ Text = '...'
+ end
+ end
+end
diff --git a/LibD28/FMX.frxEditQueryParams.pas b/LibD28/FMX.frxEditQueryParams.pas
new file mode 100644
index 0000000..7f0ad89
--- /dev/null
+++ b/LibD28/FMX.frxEditQueryParams.pas
@@ -0,0 +1,265 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ Query params editor }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditQueryParams;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Types, FMX.Controls, FMX.Forms,
+ Data.DB, FMX.frxCustomDB, FMX.frxCtrls, System.Rtti, System.UITypes
+, System.Variants, FMX.Edit, FMX.ListBox, FMX.Layouts, FMX.Grid, System.Types
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI24}
+ ,FMX.Grid.Style
+{$ENDIF}
+;
+
+
+type
+ THackStringGrid = class(TStringGrid);
+ TfrxParamsEditorForm = class(TForm)
+ TypeCB: TComboBox;
+ OkB: TButton;
+ CancelB: TButton;
+ ButtonPanel: TPanel;
+ ExpressionB: TSpeedButton;
+ ParamGrid: TStringGrid;
+ procedure FormShow(Sender: TObject);
+ procedure OkBClick(Sender: TObject);
+ procedure FormHide(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure ValueEButtonClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure TypeCBChange(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure ParamGridResize(Sender: TObject);
+ private
+ FParams: TfrxParams;
+ procedure ParamGridDragOver(Sender: TObject; const Data: TDragObject;
+ const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+ procedure ParamGridMouseUp(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Single);
+ public
+ property Params: TfrxParams read FParams write FParams;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxClass, FMX.frxRes, FMX.frxFMX;
+
+{ TfrxParamEditorForm }
+
+procedure TfrxParamsEditorForm.FormShow(Sender: TObject);
+var
+ i, NameColumn, dTypeColumn, ExpColumn: Integer;
+ t: TFieldType;
+begin
+ // in case column was moved
+
+ ExpColumn := 2;
+ dTypeColumn := 1;
+ NameColumn := 0;
+ for i := 0 to ParamGrid.ColumnCount - 1 do
+ case ParamGrid.Columns[i].Tag of
+ 1: NameColumn := ParamGrid.Columns[i].Index;
+ 2: dTypeColumn := ParamGrid.Columns[i].Index;
+ 3: ExpColumn := ParamGrid.Columns[i].Index;
+ end;
+
+ ParamGrid.RowCount := Params.Count;
+ ParamGrid.BeginUpdate;
+ for i := 0 to Params.Count - 1 do
+ begin
+ ParamGrid.Cells[NameColumn, i] := Params[i].Name;
+ ParamGrid.Cells[dTypeColumn, i] := FieldTypeNames[Params[i].DataType];
+ ParamGrid.Cells[ExpColumn, i] := Params[i].Expression;
+ end;
+ ParamGrid.EndUpdate;
+ for t := Low(TFieldType) to High(TFieldType) do
+ TypeCB.Items.Add(FieldTypeNames[t]);
+
+ ButtonPanel.Height := TypeCB.Height - 2;
+ ExpressionB.Height := TypeCB.Height - 2;
+ ButtonPanel.Visible := False;
+ TypeCB.Visible := False;
+end;
+
+procedure TfrxParamsEditorForm.FormHide(Sender: TObject);
+var
+ i, dTypeColumn, ExpColumn: Integer;
+ t: TFieldType;
+begin
+ if ModalResult <> mrOk then Exit;
+ ExpColumn := 2;
+ dTypeColumn := 1;
+ // in case column was moved
+ for i := 0 to ParamGrid.ColumnCount - 1 do
+ case ParamGrid.Columns[i].Tag of
+ 2: dTypeColumn := ParamGrid.Columns[i].Index;
+ 3: ExpColumn := ParamGrid.Columns[i].Index;
+ end;
+
+ for i := 0 to ParamGrid.RowCount - 1 do
+ begin
+ for t := Low(TFieldType) to High(TFieldType) do
+ if ParamGrid.Cells[dTypeColumn, i] = FieldTypeNames[t] then
+ begin
+ Params[i].DataType := t;
+ break;
+ end;
+ Params[i].Expression := ParamGrid.Cells[ExpColumn, i];
+ end;
+end;
+
+procedure TfrxParamsEditorForm.ParamGridDragOver(Sender: TObject;
+ const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+begin
+ ParamGridResize(nil);
+end;
+
+procedure TfrxParamsEditorForm.ParamGridMouseUp(Sender: TObject;
+ Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+var
+ C: TColumn;
+ RowIndex, i: Integer;
+begin
+ TypeCB.Visible := False;
+ ButtonPanel.Visible := False;
+ C := ParamGrid.ColumnByPoint(X, Y);
+ if C <> nil then
+ begin
+ if C.Tag = 2 then
+ begin
+ TypeCB.Position.X := C.Position.X + ParamGrid.Position.X + 2;
+ RowIndex := ParamGrid.RowByPoint(X, Y);
+ if RowIndex > ParamGrid.RowCount - 1 then Exit;
+ i := TypeCB.Items.IndexOf(ParamGrid.Cells[C.Index, RowIndex]);
+ if i <> -1 then
+ TypeCB.ListItems[i].IsSelected := True
+ else
+ TypeCB.ListItems[0].IsSelected := True;
+ TypeCB.Position.Y := RowIndex * ParamGrid.RowHeight + ParamGrid.Position.Y + ParamGrid.RowHeight + 3;
+ TypeCB.Width := C.Width;
+ TypeCB.Visible := True;
+ end
+ else
+ if C.Tag = 3 then
+ begin
+ ButtonPanel.Visible := True;
+ ButtonPanel.Position.X := C.Position.X + ParamGrid.Position.X + C.Width - ButtonPanel.Width - 2;
+ RowIndex := ParamGrid.RowByPoint(X, Y);
+ if RowIndex > ParamGrid.RowCount - 1 then Exit;
+
+ ButtonPanel.Position.Y := RowIndex * ParamGrid.RowHeight + ParamGrid.Position.Y + ParamGrid.RowHeight + 3;
+ ButtonPanel.Visible := True;
+ end;
+ end;
+end;
+
+
+procedure TfrxParamsEditorForm.ParamGridResize(Sender: TObject);
+begin
+ TypeCB.Visible := False;
+ ButtonPanel.Visible := False;
+end;
+
+procedure TfrxParamsEditorForm.TypeCBChange(Sender: TObject);
+begin
+ if TypeCB.Selected <> nil then
+ ParamGrid.Cells[ParamGrid.ColumnIndex, ParamGrid.Selected] := TypeCB.Selected.Text;
+end;
+
+procedure TfrxParamsEditorForm.OkBClick(Sender: TObject);
+begin
+// ParamsLV.Selected := ParamsLV.Items[0];
+end;
+
+procedure TfrxParamsEditorForm.ValueEButtonClick(Sender: TObject);
+var
+ s: String;
+begin
+ s := TfrxCustomDesigner(Owner).InsertExpression(ParamGrid.Cells[ParamGrid.ColumnIndex, ParamGrid.Selected]);
+ if s <> '' then
+ ParamGrid.Cells[ParamGrid.ColumnIndex, ParamGrid.Selected] := s;
+end;
+
+procedure TfrxParamsEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ FormHide(Self);
+end;
+
+procedure TfrxParamsEditorForm.FormCreate(Sender: TObject);
+var
+ SColumn: TStringColumn;
+begin
+
+ Caption := frxGet(3700);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ ParamGrid.BeginUpdate;
+
+ ParamGrid.RowCount := 0;
+
+ SColumn := TStringColumn.Create(ParamGrid);
+ SColumn.Header := frxResources.Get('qpName');
+ SColumn.ReadOnly := True;
+ SColumn.Tag := 1;
+ SColumn.OnResize := ParamGridResize;
+ SColumn.OnDragEnd := ParamGridResize;
+ SColumn.OnDragOver := ParamGridDragOver;
+ ParamGrid.AddObject(SColumn);
+
+ SColumn := TStringColumn.Create(ParamGrid);
+ SColumn.Header := frxResources.Get('qpDataType');
+ SColumn.ReadOnly := True;
+ SColumn.Tag := 2;
+ SColumn.OnResize := ParamGridResize;
+ SColumn.OnDragEnd := ParamGridResize;
+ SColumn.OnDragOver := ParamGridDragOver;
+ ParamGrid.AddObject(SColumn);
+
+ SColumn := TStringColumn.Create(ParamGrid);
+ SColumn.Header := frxResources.Get('qpValue');
+ SColumn.ReadOnly := False;
+ SColumn.OnResize := ParamGridResize;
+ SColumn.OnDragEnd := ParamGridResize;
+ SColumn.OnDragOver := ParamGridDragOver;
+ SColumn.Tag := 3;
+ ParamGrid.AddObject(SColumn);
+ ParamGrid.OnMouseUp := ParamGridMouseUp;
+ ParamGrid.OnDragOver := ParamGridDragOver;
+ ParamGrid.OnDragEnd := ParamGridResize;
+{$IFDEF DELPHI20}
+ ParamGrid.Options := ParamGrid.Options + [TGridOption.AlternatingRowBackground];
+{$ELSE}
+ ParamGrid.AlternatingRowBackground := True;
+{$ENDIF}
+ ParamGrid.EndUpdate;
+
+end;
+
+procedure TfrxParamsEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VK_F1 then
+ frxResources.Help(Self);
+end;
+
+end.
diff --git a/LibD28/FMX.frxEditReport.fmx b/LibD28/FMX.frxEditReport.fmx
new file mode 100644
index 0000000..670709f
--- /dev/null
+++ b/LibD28/FMX.frxEditReport.fmx
@@ -0,0 +1,350 @@
+object frxReportEditorForm: TfrxReportEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Report settings'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 418
+ ClientWidth = 416
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object OkB: TButton
+ Position.Point = '(254,340)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(334,340)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object PageControl: TTabControl
+ Position.Point = '(8,16)'
+ Width = 401.000000000000000000
+ Height = 321.000000000000000000
+ TabOrder = 2
+ TabIndex = 2
+ TabHeight = 20.000000000000000000
+ object GeneralTS: TTabItem
+ Width = 80.000000000000000000
+ Height = 20.000000000000000000
+ TabOrder = 0
+ Index = 0
+ Text = 'GeneralTS'
+ WordWrap = False
+ object GeneralL: TGroupBox
+ Position.Point = '(4,200)'
+ Width = 389.000000000000000000
+ Height = 93.000000000000000000
+ TabOrder = 0
+ object PasswordL: TLabel
+ Position.Point = '(186,19)'
+ Width = 73.000000000000000000
+ Height = 15.000000000000000000
+ TabOrder = 0
+ end
+ object DoublePassCB: TCheckBox
+ Position.Point = '(8,20)'
+ Width = 169.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ object PrintIfEmptyCB: TCheckBox
+ Position.Point = '(8,44)'
+ Width = 169.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object PasswordE: TEdit
+ Position.Point = '(268,16)'
+ Width = 109.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 3
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+ object ReportSettingsL: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 389.000000000000000000
+ Height = 193.000000000000000000
+ TabOrder = 1
+ object CopiesL: TLabel
+ Position.Point = '(16,164)'
+ Width = 47.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object PrintersLB: TListBox
+ Position.Point = '(12,18)'
+ Width = 365.000000000000000000
+ Height = 135.000000000000000000
+ TabOrder = 1
+ ItemHeight = 16.000000000000000000
+ end
+ object CopiesE: TEdit
+ Position.Point = '(68,160)'
+ Width = 37.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 2
+ KeyboardType = vktDefault
+ Password = False
+ Text = '1'
+ end
+ object CollateCB: TCheckBox
+ Position.Point = '(116,162)'
+ Width = 189.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ end
+ end
+ object DescriptionTS: TTabItem
+ Width = 80.000000000000000000
+ Height = 20.000000000000000000
+ TabOrder = 1
+ Index = 1
+ Text = 'DescriptionTS'
+ WordWrap = False
+ object DescriptionL: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 389.000000000000000000
+ Height = 213.000000000000000000
+ TabOrder = 0
+ object NameL: TLabel
+ Position.Point = '(8,20)'
+ Width = 73.000000000000000000
+ Height = 15.000000000000000000
+ TabOrder = 0
+ end
+ object PictureImg: TImage
+ Position.Point = '(88,124)'
+ Width = 81.000000000000000000
+ Height = 69.000000000000000000
+ end
+ object Description1L: TLabel
+ Position.Point = '(8,68)'
+ Width = 73.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 2
+ end
+ object PictureL: TLabel
+ Position.Point = '(8,120)'
+ Width = 65.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 3
+ end
+ object AuthorL: TLabel
+ Position.Point = '(8,44)'
+ Width = 73.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 4
+ end
+ object NameE: TEdit
+ Position.Point = '(88,18)'
+ Width = 289.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 5
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object DescriptionE: TMemo
+ Position.Point = '(88,66)'
+ Width = 289.000000000000000000
+ Height = 47.000000000000000000
+ TabOrder = 6
+ KeyboardType = vktDefault
+ end
+ object PictureB: TButton
+ Position.Point = '(180,120)'
+ Width = 75.000000000000000000
+ Height = 21.000000000000000000
+ OnClick = PictureBClick
+ TabOrder = 7
+ end
+ object AuthorE: TEdit
+ Position.Point = '(88,42)'
+ Width = 289.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 8
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+ object VersionL: TGroupBox
+ Position.Point = '(4,220)'
+ Width = 389.000000000000000000
+ Height = 73.000000000000000000
+ TabOrder = 1
+ object MajorL: TLabel
+ Position.Point = '(8,21)'
+ Width = 41.000000000000000000
+ Height = 15.000000000000000000
+ TabOrder = 0
+ end
+ object MinorL: TLabel
+ Position.Point = '(100,20)'
+ Width = 40.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 1
+ end
+ object ReleaseL: TLabel
+ Position.Point = '(196,19)'
+ Width = 50.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object BuildL: TLabel
+ Position.Point = '(300,21)'
+ Width = 36.000000000000000000
+ Height = 15.000000000000000000
+ TabOrder = 3
+ end
+ object CreatedL: TLabel
+ Position.Point = '(8,46)'
+ Width = 65.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 4
+ end
+ object Created1L: TLabel
+ Position.Point = '(76,46)'
+ Width = 133.000000000000000000
+ Height = 19.000000000000000000
+ TabOrder = 5
+ end
+ object ModifiedL: TLabel
+ Position.Point = '(212,46)'
+ Width = 77.000000000000000000
+ Height = 19.000000000000000000
+ TabOrder = 6
+ end
+ object Modified1L: TLabel
+ Position.Point = '(276,46)'
+ Width = 109.000000000000000000
+ Height = 19.000000000000000000
+ TabOrder = 7
+ end
+ object MajorE: TEdit
+ Position.Point = '(52,18)'
+ Width = 37.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 8
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object MinorE: TEdit
+ Position.Point = '(144,18)'
+ Width = 37.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 9
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object ReleaseE: TEdit
+ Position.Point = '(252,18)'
+ Width = 37.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 10
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object BuildE: TEdit
+ Position.Point = '(340,18)'
+ Width = 37.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 11
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+ end
+ object InheritTS: TTabItem
+ Width = 80.000000000000000000
+ Height = 20.000000000000000000
+ TabOrder = 2
+ Index = 2
+ Text = 'InheritTS'
+ WordWrap = False
+ object InheritGB: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 389.000000000000000000
+ Height = 289.000000000000000000
+ TabOrder = 0
+ object InheritStateL: TLabel
+ Position.Point = '(8,20)'
+ Width = 233.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 0
+ end
+ object SelectL: TLabel
+ Position.Point = '(8,44)'
+ Width = 135.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 1
+ end
+ object PathLB: TLabel
+ Position.Point = '(12,260)'
+ Width = 101.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 2
+ end
+ object DetachRB: TRadioButton
+ Position.Point = '(8,84)'
+ Width = 205.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ object InheritRB: TRadioButton
+ Position.Point = '(8,104)'
+ Width = 205.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 4
+ end
+ object DontChangeRB: TRadioButton
+ Position.Point = '(8,64)'
+ Width = 205.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 5
+ end
+ object PathE: TEdit
+ Position.Point = '(112,256)'
+ Width = 241.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 6
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object BrowseB: TButton
+ Position.Point = '(352,256)'
+ Width = 25.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BrowseBClick
+ TabOrder = 7
+ Text = '...'
+ end
+ object InheritLV: TListBox
+ Position.Point = '(10,128)'
+ Width = 369.000000000000000000
+ Height = 121.000000000000000000
+ TabOrder = 8
+ Sorted = True
+ end
+ end
+ end
+ end
+ object OpenDialog1: TOpenDialog
+ Left = 300
+ Top = 192
+ end
+end
diff --git a/LibD28/FMX.frxEditReport.pas b/LibD28/FMX.frxEditReport.pas
new file mode 100644
index 0000000..0d23bc6
--- /dev/null
+++ b/LibD28/FMX.frxEditReport.pas
@@ -0,0 +1,348 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Report options }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditReport;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, System.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.ExtCtrls, FMX.frxCtrls, FMX.Memo, FMX.Objects, FMX.frxBaseModalForm,
+ FMX.Edit, FMX.Layouts, FMX.ListBox, FMX.Types, System.Variants, FMX.TabControl
+ {$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+
+type
+ TfrxReportEditorForm = class(TfrxForm)
+ OkB: TButton;
+ CancelB: TButton;
+ PageControl: TTabControl;
+ GeneralTS: TTabItem;
+ DescriptionTS: TTabItem;
+ InheritTS: TTabItem;
+ GeneralL: TGroupBox;
+ PasswordL: TLabel;
+ DoublePassCB: TCheckBox;
+ PrintIfEmptyCB: TCheckBox;
+ PasswordE: TEdit;
+ ReportSettingsL: TGroupBox;
+ CopiesL: TLabel;
+ PrintersLB: TListBox;
+ CopiesE: TEdit;
+ CollateCB: TCheckBox;
+ DescriptionL: TGroupBox;
+ NameL: TLabel;
+ PictureImg: TImage;
+ Description1L: TLabel;
+ PictureL: TLabel;
+ AuthorL: TLabel;
+ NameE: TEdit;
+ DescriptionE: TMemo;
+ PictureB: TButton;
+ AuthorE: TEdit;
+ VersionL: TGroupBox;
+ MajorL: TLabel;
+ MinorL: TLabel;
+ ReleaseL: TLabel;
+ BuildL: TLabel;
+ CreatedL: TLabel;
+ Created1L: TLabel;
+ ModifiedL: TLabel;
+ Modified1L: TLabel;
+ MajorE: TEdit;
+ MinorE: TEdit;
+ ReleaseE: TEdit;
+ BuildE: TEdit;
+ InheritGB: TGroupBox;
+ InheritStateL: TLabel;
+ SelectL: TLabel;
+ PathLB: TLabel;
+ DetachRB: TRadioButton;
+ InheritRB: TRadioButton;
+ DontChangeRB: TRadioButton;
+ PathE: TEdit;
+ BrowseB: TButton;
+ InheritLV: TListBox;
+ OpenDialog1: TOpenDialog;
+ procedure FormCreate(Sender: TObject);
+ procedure PictureBClick(Sender: TObject);
+ //procedure PrintersLBDrawItem(Control: TWinControl; Index: Integer;
+ // ARect: TRect; State: TOwnerDrawState);
+ procedure FormShow(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormDestroy(Sender: TObject);
+ procedure BrowseBClick(Sender: TObject);
+ procedure FillTemplatelist;
+ procedure PathEKeyPress(Sender: TObject; var Key: Char);
+ procedure PageControlChange(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ { Private declarations }
+ FTemplates: TStringList;
+ public
+ { Public declarations }
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses
+ System.IOUtils, FMX.frxDesgn, FMX.frxEditPicture, FMX.frxPrinter, FMX.frxUtils, FMX.frxRes, FMX.frxClass;
+
+
+procedure TfrxReportEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+//var
+// templ: String;
+begin
+ if ModalResult = mrOk then
+ with TfrxDesignerForm(Owner).Report do
+ begin
+ if PrintersLB.ItemIndex <> -1 then
+ begin
+ PrintOptions.Printer := PrintersLB.Items[PrintersLB.ItemIndex];
+ SelectPrinter;
+ end;
+ PrintOptions.Collate := CollateCB.IsChecked;
+ PrintOptions.Copies := StrToInt(CopiesE.Text);
+ EngineOptions.DoublePass := DoublePassCB.IsChecked;
+ EngineOptions.PrintIfEmpty := PrintIfEmptyCB.IsChecked;
+
+ if ReportOptions.HiddenPassword = '' then
+ ReportOptions.Password := PasswordE.Text;
+
+ if not DontChangeRB.IsChecked then
+ begin
+ Designer.Lock;
+ try
+ if DetachRB.IsChecked then
+ ParentReport := ''
+ else if InheritRB.IsChecked and (InheritLV.Selected <> nil) then
+ begin
+ ParentReport := '';
+ //templ := FTemplates[Integer(InheritLV.Selected.Data)];
+ InheritFromTemplate(InheritLV.Selected.Text{templ});
+ end;
+ finally
+ Designer.ReloadReport;
+ end;
+ end;
+
+ ReportOptions.Name := NameE.Text;
+ ReportOptions.Author := AuthorE.Text;
+ ReportOptions.Description.Text := DescriptionE.Lines.Text;
+ ReportOptions.Picture.Assign(PictureImg.Bitmap);
+ ReportOptions.VersionMajor := MajorE.Text;
+ ReportOptions.VersionMinor := MinorE.Text;
+ ReportOptions.VersionRelease := ReleaseE.Text;
+ ReportOptions.VersionBuild := BuildE.Text;
+ end;
+end;
+
+procedure TfrxReportEditorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(4700);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ GeneralTS.Text := frxGet(4701);
+ ReportSettingsL.Text := frxGet(4702);
+ CopiesL.Text := frxGet(4703);
+ GeneralL.Text := frxGet(4704);
+ PasswordL.Text := frxGet(4705);
+ CollateCB.Text := frxGet(4706);
+ DoublePassCB.Text := frxGet(4707);
+ PrintIfEmptyCB.Text := frxGet(4708);
+ DescriptionTS.Text := frxGet(4709);
+ NameL.Text := frxGet(4710);
+ Description1L.Text := frxGet(4711);
+ PictureL.Text := frxGet(4712);
+ AuthorL.Text := frxGet(4713);
+ MajorL.Text := frxGet(4714);
+ MinorL.Text := frxGet(4715);
+ ReleaseL.Text := frxGet(4716);
+ BuildL.Text := frxGet(4717);
+ CreatedL.Text := frxGet(4718);
+ ModifiedL.Text := frxGet(4719);
+ DescriptionL.Text := frxGet(4720);
+ VersionL.Text := frxGet(4721);
+ PictureB.Text := frxGet(4722);
+ InheritTS.Text := frxGet(4728);
+ InheritGB.Text := frxGet(4723);
+ SelectL.Text := frxGet(4724);
+ DontChangeRB.Text := frxGet(4725);
+ DetachRB.Text := frxGet(4726);
+ InheritRB.Text := frxGet(4727);
+ PathLB.Text := frxGet(4729);
+
+ //if Screen.PixelsPerInch > 96 then
+ // PrintersLB.ItemHeight := 19;
+ //InheritLV.LargeImages := frxResources.WizardImages;
+
+ FTemplates := TStringList.Create;
+ FTemplates.Sorted := True;
+ FormShow(Self);
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxReportEditorForm.FormDestroy(Sender: TObject);
+begin
+ FTemplates.Free;
+end;
+
+procedure TfrxReportEditorForm.FormShow(Sender: TObject);
+var
+ i: Integer;
+begin
+ with TfrxDesignerForm(Owner).Report do
+ begin
+ PrintersLB.Items.BeginUpdate;
+ PrintersLB.Items.Add(frxResources.Get('prDefault'));
+ for i := 0 to frxPrinters.Printers.Count - 1 do
+ PrintersLB.Items.Add(frxPrinters.Printers[i]);
+ PrintersLB.Items.EndUpdate;
+
+ CollateCB.IsChecked := PrintOptions.Collate;
+ CopiesE.Text := IntToStr(PrintOptions.Copies);
+ DoublePassCB.IsChecked := EngineOptions.DoublePass;
+ PrintIfEmptyCB.IsChecked := EngineOptions.PrintIfEmpty;
+ if ReportOptions.HiddenPassword = '' then
+ PasswordE.Text := ReportOptions.Password
+ else
+ begin
+ PasswordE.Enabled := False;
+ //PasswordE.Color := claGray;
+ end;
+
+ if Trim(ParentReport) = '' then
+ begin
+ InheritStateL.Text := frxResources.Get('riNotInherited');
+ DetachRB.Enabled := False;
+ end
+ else
+ InheritStateL.Text := Format(frxResources.Get('riInherited'), [ParentReport]);
+
+ FillTemplatelist;
+ NameE.Text := ReportOptions.Name;
+ AuthorE.Text := ReportOptions.Author;
+ DescriptionE.Lines.Text := ReportOptions.Description.Text;
+ PictureImg.Bitmap.Assign(ReportOptions.Picture);
+ //PictureImg.Stretch := (PictureImg.Picture.Width > PictureImg.Width) or
+ // (PictureImg.Picture.Height > PictureImg.Height);
+
+ MajorE.Text := ReportOptions.VersionMajor;
+ MinorE.Text := ReportOptions.VersionMinor;
+ ReleaseE.Text := ReportOptions.VersionRelease;
+ BuildE.Text := ReportOptions.VersionBuild;
+ Created1L.Text := DateTimeToStr(ReportOptions.CreateDate);
+ Modified1L.Text := DateTimeToStr(ReportOptions.LastChange);
+ end;
+end;
+
+
+procedure TfrxReportEditorForm.PictureBClick(Sender: TObject);
+begin
+ with TfrxPictureEditorForm.Create(Owner) do
+ begin
+ Image.Bitmap.Assign(PictureImg.Bitmap);
+ if ShowModal = mrOk then
+ begin
+ PictureImg.Bitmap.Assign(Image.Bitmap);
+ //PictureImg.Stretch := (PictureImg.Picture.Width > PictureImg.Width) or
+ // (PictureImg.Picture.Height > PictureImg.Height);
+ end;
+ Free;
+ end;
+end;
+
+//procedure TfrxReportEditorForm.PrintersLBDrawItem(Control: TWinControl;
+// Index: Integer; ARect: TRect; State: TOwnerDrawState);
+//var
+// s: String;
+//begin
+// with PrintersLB.Canvas do
+// begin
+// FillRect(ARect);
+// frxResources.PreviewButtonImages.Draw(PrintersLB.Canvas, ARect.Left + 2, ARect.Top, 2);
+// s := PrintersLB.Items[Index];
+// if (Index <> 0) and (frxPrinters[Index - 1].Port <> '') then
+// s := s + ' ' + frxResources.Get('rePrnOnPort') + ' ' + frxPrinters[Index - 1].Port;
+// TextOut(ARect.Left + 24, ARect.Top + 1, s);
+// end;
+//end;
+
+procedure TfrxReportEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+procedure TfrxReportEditorForm.BrowseBClick(Sender: TObject);
+var
+ FolderName: String;
+begin
+ OpenDialog1.InitialDir := PathE.Text;
+ if OpenDialog1.Execute() then
+ begin
+ FolderName := ExtractFilePath(OpenDialog1.FileName);
+ TfrxDesignerForm(Owner).TemplatePath := FolderName;
+ FillTemplatelist;
+ end;
+ PeekLastModalResult;
+end;
+
+procedure TfrxReportEditorForm.FillTemplatelist;
+//var
+// i: Integer;
+begin
+ PathE.Text := TfrxDesignerForm(Owner).TemplatePath;
+ TfrxDesignerForm(Owner).GetTemplateList(FTemplates);
+ InheritLV.Clear;
+ InheritLV.Items := FTemplates;
+// InheritLV.Items.Clear;
+// for i := 0 to FTemplates.Count - 1 do
+// begin
+// lvItem := InheritLV.Items.Add;
+// lvItem.Caption := ExtractFileName(FTemplates[i]);
+// lvItem.Data := Pointer(i);
+// lvItem.ImageIndex := 5;
+// end;
+end;
+
+procedure TfrxReportEditorForm.PathEKeyPress(Sender: TObject;
+ var Key: Char);
+begin
+ if Key = #13 then
+ if DirectoryExists(PathE.Text) then
+ begin
+ TfrxDesignerForm(Owner).TemplatePath := PathE.Text;
+ FillTemplatelist;
+ end;
+end;
+
+procedure TfrxReportEditorForm.PageControlChange(Sender: TObject);
+begin
+ if PageControl.ActiveTab = InheritTS then
+ OkB.Default := False
+ else OkB.Default := True;
+end;
+
+end.
diff --git a/LibD28/FMX.frxEditReportData.fmx b/LibD28/FMX.frxEditReportData.fmx
new file mode 100644
index 0000000..d679e1a
--- /dev/null
+++ b/LibD28/FMX.frxEditReportData.fmx
@@ -0,0 +1,38 @@
+object frxReportDataForm: TfrxReportDataForm
+ Left = 0
+ Top = 0
+ Caption = 'Select Report Datasets'
+ BorderStyle = bsSingle
+ BorderIcons = []
+ ClientHeight = 239
+ ClientWidth = 229
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object OKB: TButton
+ Position.Point = '(68,208)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 0
+ ModalResult = 1
+ end
+ object CancelB: TButton
+ Position.Point = '(148,208)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object DatasetsLB: TListBox
+ Position.Point = '(4,4)'
+ Width = 221.000000000000000000
+ Height = 197.000000000000000000
+ TabOrder = 2
+ ItemHeight = 16.000000000000000000
+ ShowCheckboxes = True
+ end
+end
diff --git a/LibD28/FMX.frxEditReportData.pas b/LibD28/FMX.frxEditReportData.pas
new file mode 100644
index 0000000..98cb976
--- /dev/null
+++ b/LibD28/FMX.frxEditReportData.pas
@@ -0,0 +1,216 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Report datasets selector }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditReportData;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.Layouts, FMX.ListBox, FMX.Types, System.Variants
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+
+type
+{$IFDEF LINUX}
+ TfrxReportDataForm = class(TfrxForm)
+{$ELSE}
+ TfrxReportDataForm = class(TForm)
+{$ENDIF}
+
+ OKB: TButton;
+ CancelB: TButton;
+ DatasetsLB: TListBox;
+ procedure FormShow(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure DatasetsLBClickCheck(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ FStandalone: Boolean;
+ //procedure BuildConnectionList;
+ procedure BuildDatasetList;
+ public
+ Report: TfrxReport;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxDesgn, FMX.frxUtils, FMX.frxRes, System.IniFiles;
+
+var
+ PrevWidth: Integer = 0;
+ PrevHeight: Integer = 0;
+
+procedure TfrxReportDataForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+var
+ i: Integer;
+begin
+ PrevWidth := Width;
+ PrevHeight := Height;
+ if ModalResult <> mrOk then Exit;
+
+
+ Report.Datasets.Clear;
+
+ for i := 0 to DatasetsLB.Items.Count - 1 do
+ if DatasetsLB.ListItems[i].IsChecked then
+ Report.DataSets.Add(TfrxDataSet(DatasetsLB.Items.Objects[i]));
+end;
+
+procedure TfrxReportDataForm.FormCreate(Sender: TObject);
+begin
+ FStandalone := (frxDesignerComp <> nil) and frxDesignerComp.Standalone;
+ if FStandalone then
+ Caption := frxGet(5800)
+ else
+ Caption := frxGet(2800);
+ OKB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxReportDataForm.FormShow(Sender: TObject);
+begin
+ if PrevWidth <> 0 then
+ begin
+ Width := PrevWidth;
+ Height := PrevHeight;
+ end;
+
+ DatasetsLB.SetBounds(4, 4, ClientWidth - 8, ClientHeight - OkB.Height - 12);
+ OkB.Position.X := ClientWidth - OkB.Width - CancelB.Width - 8;
+ CancelB.Position.X := ClientWidth - CancelB.Width - 4;
+ OkB.Position.Y := ClientHeight - OkB.Height - 4;
+ CancelB.Position.Y := OkB.Position.Y;
+
+// if FStandalone then
+// BuildConnectionList
+// else
+ BuildDatasetList;
+end;
+
+
+// todo win only ?
+//procedure TfrxReportDataForm.BuildConnectionList;
+//var
+// i: Integer;
+// sl: TStringList;
+// s2: TStringList;
+//begin
+//
+// try
+// sl := TStringList.Create;
+// s2 := TStringList.Create;
+// try
+// ini.RootKey := HKEY_LOCAL_MACHINE;
+// if ini.OpenKeyReadOnly(DEF_REG_CONNECTIONS) then
+// begin
+// ini.GetValueNames(sl);
+// ini.CloseKey;
+// end;
+//
+// ini.RootKey := HKEY_CURRENT_USER;
+// if ini.OpenKeyReadOnly(DEF_REG_CONNECTIONS) then
+// begin
+// ini.GetValueNames(s2);
+// ini.CloseKey;
+// end;
+//
+// sl.AddStrings(s2);
+//
+// for i := 0 to sl.Count - 1 do
+// begin
+// DataSetsLB.Items.Add(sl[i]);
+// DataSetsLB.Checked[i] := CompareText(sl[i], Report.ReportOptions.ConnectionName) = 0;
+// end;
+// finally
+// sl.Free;
+// s2.Free;
+// end;
+// finally
+// ini.Free;
+// end;
+//end;
+
+procedure TfrxReportDataForm.BuildDatasetList;
+var
+ i: Integer;
+ ds: TfrxDataSet;
+ dsList: TStringList;
+begin
+ dsList := TStringList.Create;
+
+ if Report.EnabledDataSets.Count > 0 then
+ begin
+ for i := 0 to Report.EnabledDataSets.Count - 1 do
+ begin
+ ds := Report.EnabledDataSets[i].DataSet;
+ if ds <> nil then
+ dsList.AddObject(ds.UserName, ds);
+ end;
+ end
+ else
+ Report.GetActiveDataSetList(dsList);
+
+ dsList.Sort;
+
+ for i := 0 to dsList.Count - 1 do
+ begin
+ ds := TfrxDataSet(dsList.Objects[i]);
+ if (csDesigning in Report.ComponentState) and
+ ((ds.Owner is TForm) or (ds.Owner is TDataModule)) then
+ DataSetsLB.Items.AddObject(ds.UserName + ' (' + ds.Owner.Name + '.' + ds.Name + ')', ds)
+ else
+ begin
+ if not (ds.Owner is TfrxReport) or (ds.Owner = Report) then
+ DataSetsLB.Items.AddObject(ds.UserName, ds);
+ end;
+ if Report.Datasets.Find(ds) <> nil then
+ DataSetsLB.ListItems[DataSetsLB.Items.Count - 1].IsChecked := True;
+ end;
+
+ dsList.Free;
+end;
+
+procedure TfrxReportDataForm.DatasetsLBClickCheck(Sender: TObject);
+var
+ i: Integer;
+begin
+ if FStandalone then
+ for i := 0 to DatasetsLB.Items.Count - 1 do
+ if i <> DatasetsLB.ItemIndex then
+ DatasetsLB.ListItems[i].IsChecked := False;
+end;
+
+procedure TfrxReportDataForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+end.
diff --git a/LibD28/FMX.frxEditSQL.fmx b/LibD28/FMX.frxEditSQL.fmx
new file mode 100644
index 0000000..c159f97
--- /dev/null
+++ b/LibD28/FMX.frxEditSQL.fmx
@@ -0,0 +1,49 @@
+object frxSQLEditorForm: TfrxSQLEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Lines'
+ ClientHeight = 307
+ ClientWidth = 432
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnClose = FormClose
+ StyleLookup = 'backgroundstyle'
+ object ToolBar: TToolBar
+ Width = 432.000000000000000000
+ Height = 31.000000000000000000
+ TabOrder = 0
+ object QBB: TfrxToolButton
+ Position.Point = '(2,4)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ OnClick = QBBClick
+ TabOrder = 0
+ end
+ object ParamsB: TfrxToolButton
+ Position.Point = '(28,4)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = ParamsBClick
+ TabOrder = 1
+ end
+ object CancelB: TfrxToolButton
+ Position.Point = '(86,4)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = CancelBClick
+ TabOrder = 2
+ Hint = 'Cancel'
+ end
+ object OkB: TfrxToolButton
+ Position.Point = '(61,4)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = OkBClick
+ TabOrder = 3
+ Hint = 'OK'
+ end
+ end
+end
diff --git a/LibD28/FMX.frxEditSQL.pas b/LibD28/FMX.frxEditSQL.pas
new file mode 100644
index 0000000..570e716
--- /dev/null
+++ b/LibD28/FMX.frxEditSQL.pas
@@ -0,0 +1,220 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ SQL editor }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditSQL;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Controls, System.UITypes, System.UIConsts,
+ FMX.Forms, FMX.Dialogs, FMX.fs_SynMemo, FMX.frxFMX,
+ FMX.frxCustomDB
+, System.Variants, FMX.Types
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF QBUILDER}
+, FMX.fqbClass
+{$ENDIF};
+
+
+type
+ TfrxSQLEditorForm = class(TForm)
+ ToolBar: TToolBar;
+ OkB: TfrxToolButton;
+ CancelB: TfrxToolButton;
+ QBB: TfrxToolButton;
+ ParamsB: TfrxToolButton;
+ procedure OkBClick(Sender: TObject);
+ procedure CancelBClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure MemoKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormHide(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure QBBClick(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure ParamsBClick(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ { Private declarations }
+ FMemo: TfsSyntaxMemo;
+ FQuery: TfrxCustomQuery;
+{$IFDEF QBUILDER}
+ FQBEngine: TfqbEngine;
+{$ENDIF}
+ FSaveSQL: TStrings;
+ FSaveSchema: String;
+ FSaveParams: TfrxParams;
+ public
+ { Public declarations }
+ property Query: TfrxCustomQuery read FQuery write FQuery;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxClass, FMX.frxRes, System.IniFiles, FMX.frxEditQueryParams;
+
+
+procedure TfrxSQLEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ FormHide(Self);
+end;
+
+procedure TfrxSQLEditorForm.FormCreate(Sender: TObject);
+begin
+ FSaveSQL := TStringList.Create;
+ FSaveParams := TfrxParams.Create;
+
+ FMemo := TfsSyntaxMemo.Create(Self);
+ with FMemo do
+ begin
+ Parent := Self;
+ Align := alClient;
+ SyntaxType := stSQL;
+ ShowGutter := True;
+// GutterWidth := 20;
+ Fill.Color := claWhite;
+ OnKeyDown := MemoKeyDown;
+{$I frxEditSQL.inc}
+ end;
+ frxResources.LoadImageFromResouce(QBB.Bitmap, 5, 8);
+ frxResources.LoadImageFromResouce(ParamsB.Bitmap, 5, 6);
+ frxResources.LoadImageFromResouce(OkB.Bitmap, 21, 0);
+ frxResources.LoadImageFromResouce(CancelB.Bitmap, 21, 2);
+{$IFDEF QBUILDER}
+ QBB.Visible := True;
+{$ENDIF}
+ Caption := frxGet(4900);
+ QBB.Hint := frxGet(4901);
+ ParamsB.Hint := frxGet(5714);
+ CancelB.Hint := frxGet(2);
+ OkB.Hint := frxGet(1);
+
+// if UseRightToLeftAlignment then
+// FlipChildren(True);
+end;
+
+procedure TfrxSQLEditorForm.FormDestroy(Sender: TObject);
+begin
+ FSaveSQL.Free;
+ FSaveParams.Free;
+end;
+
+procedure TfrxSQLEditorForm.FormShow(Sender: TObject);
+var
+ Ini: TCustomIniFile;
+begin
+ FSaveSQL.Assign(Query.SQL);
+ FSaveParams.Assign(Query.Params);
+ FSaveSchema := Query.SQLSchema;
+{$IFDEF QBUILDER}
+ FQBEngine := Query.QBEngine;
+{$ENDIF}
+ FMemo.Lines.Assign(Query.SQL);
+
+ Ini := TfrxCustomDesigner(Owner).Report.GetIniFile;
+ Ini.WriteBool('Form4.TfrxSQLEditorForm', 'Visible', True);
+// frxRestoreFormPosition(Ini, Self);
+ Ini.Free;
+end;
+
+procedure TfrxSQLEditorForm.FormHide(Sender: TObject);
+var
+ Ini: TCustomIniFile;
+begin
+ if ModalResult = mrOk then
+ begin
+ Query.SQL.Assign(FMemo.Lines);
+ end
+ else
+ begin
+ Query.SQL.Assign(FSaveSQL);
+ Query.Params.Assign(FSaveParams);
+ Query.SQLSchema := FSaveSchema;
+ end;
+
+ Ini := TfrxCustomDesigner(Owner).Report.GetIniFile;
+ //frxSaveFormPosition(Ini, Self);
+ Ini.Free;
+{$IFDEF QBUILDER}
+ if FQBEngine <> nil then
+ FQBEngine.Free;
+{$ENDIF}
+end;
+
+procedure TfrxSQLEditorForm.OkBClick(Sender: TObject);
+begin
+ ModalResult := mrOk;
+end;
+
+procedure TfrxSQLEditorForm.CancelBClick(Sender: TObject);
+begin
+ ModalResult := mrCancel;
+end;
+
+procedure TfrxSQLEditorForm.MemoKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if (Key = vkReturn) and (ssCtrl in Shift) then
+ ModalResult := mrOk
+ else if Key = vkEscape then
+ ModalResult := mrCancel
+ else if Key = vkF1 then
+ frxResources.Help(Self);
+end;
+
+procedure TfrxSQLEditorForm.QBBClick(Sender: TObject);
+{$IFDEF QBUILDER}
+var
+ fqbDialog: TfqbDialog;
+{$ENDIF}
+begin
+{$IFDEF QBUILDER}
+ fqbDialog := TfqbDialog.Create(nil);
+ try
+ fqbDialog.Engine := FQBEngine;
+ fqbDialog.SchemaInsideSQL := False;
+ fqbDialog.SQL := FMemo.Lines.Text;
+ fqbDialog.SQLSchema := Query.SQLSchema;
+
+ if fqbDialog.Execute then
+ begin
+ FMemo.Lines.Text := fqbDialog.SQL;
+ Query.SQLSchema := fqbDialog.SQLSchema;
+ end;
+ finally
+ fqbDialog.Free;
+ end;
+{$ENDIF}
+end;
+
+procedure TfrxSQLEditorForm.ParamsBClick(Sender: TObject);
+begin
+ Query.SQL.Assign(FMemo.Lines);
+ if Query.Params.Count <> 0 then
+ with TfrxParamsEditorForm.Create(Owner) do
+ begin
+ Params := Query.Params;
+ FormShow(Self);
+ if ShowModal = mrOk then
+ Query.UpdateParams;
+ Free;
+ end;
+end;
+
+end.
+
diff --git a/LibD28/FMX.frxEditStrings.fmx b/LibD28/FMX.frxEditStrings.fmx
new file mode 100644
index 0000000..15ae38d
--- /dev/null
+++ b/LibD28/FMX.frxEditStrings.fmx
@@ -0,0 +1,41 @@
+object frxStringsEditorForm: TfrxStringsEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Lines'
+ ClientHeight = 226
+ ClientWidth = 432
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object ToolBar: TToolBar
+ Width = 432.000000000000000000
+ Height = 35.000000000000000000
+ TabOrder = 0
+ object CancelB: TfrxToolButton
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = CancelBClick
+ TabOrder = 0
+ Hint = 'Cancel'
+ end
+ object OkB: TfrxToolButton
+ Position.Point = '(23,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = OkBClick
+ TabOrder = 1
+ Hint = 'OK'
+ end
+ end
+ object Memo: TMemo
+ Align = alClient
+ Position.Point = '(0,35)'
+ Width = 432.000000000000000000
+ Height = 191.000000000000000000
+ OnKeyDown = MemoKeyDown
+ TabOrder = 1
+ KeyboardType = vktDefault
+ end
+end
diff --git a/LibD28/FMX.frxEditStrings.pas b/LibD28/FMX.frxEditStrings.pas
new file mode 100644
index 0000000..1de11a4
--- /dev/null
+++ b/LibD28/FMX.frxEditStrings.pas
@@ -0,0 +1,93 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ TStrings editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditStrings;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Controls,
+ FMX.Forms, FMX.Dialogs, FMX.ExtCtrls, FMX.Layouts,
+ FMX.Memo, FMX.Types, FMX.frxFMX
+, System.Variants
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+
+type
+ TfrxStringsEditorForm = class(TForm)
+ ToolBar: TToolBar;
+ OkB: TfrxToolButton;
+ CancelB: TfrxToolButton;
+ Memo: TMemo;
+ procedure OkBClick(Sender: TObject);
+ procedure CancelBClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure MemoKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxClass, FMX.frxRes;
+
+
+procedure TfrxStringsEditorForm.OkBClick(Sender: TObject);
+begin
+ ModalResult := mrOk;
+end;
+
+procedure TfrxStringsEditorForm.CancelBClick(Sender: TObject);
+begin
+ ModalResult := mrCancel;
+end;
+
+procedure TfrxStringsEditorForm.FormCreate(Sender: TObject);
+begin
+ //Toolbar.Images := frxResources.MainButtonImages;
+ //todo images
+ Caption := frxGet(4800);
+ CancelB.Hint := frxGet(2);
+ OkB.Hint := frxGet(1);
+ frxResources.LoadImageFromResouce(CancelB.Bitmap, 21, 2);
+ frxResources.LoadImageFromResouce(OkB.Bitmap, 21, 0);
+
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxStringsEditorForm.MemoKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if (Key = vkReturn) and (ssCtrl in Shift) then
+ ModalResult := mrOk
+ else if Key = vkEscape then
+ ModalResult := mrCancel;
+end;
+
+procedure TfrxStringsEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+end.
+
diff --git a/LibD28/FMX.frxEditStyle.fmx b/LibD28/FMX.frxEditStyle.fmx
new file mode 100644
index 0000000..8b15cfd
--- /dev/null
+++ b/LibD28/FMX.frxEditStyle.fmx
@@ -0,0 +1,138 @@
+object frxStyleEditorForm: TfrxStyleEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Style Editor'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 251
+ ClientWidth = 389
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object PaintBox: TPaintBox
+ Position.Point = '(164,150)'
+ Width = 216.000000000000000000
+ Height = 78.000000000000000000
+ OnPaint = PaintBoxPaint
+ end
+ object ToolBar: TToolBar
+ Width = 389.000000000000000000
+ Height = 35.000000000000000000
+ TabOrder = 1
+ object AddB: TfrxToolButton
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = AddBClick
+ TabOrder = 0
+ end
+ object DeleteB: TfrxToolButton
+ Position.Point = '(23,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = DeleteBClick
+ TabOrder = 1
+ end
+ object EditB: TfrxToolButton
+ Position.Point = '(46,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = EditBClick
+ TabOrder = 2
+ end
+ object LoadB: TfrxToolButton
+ Position.Point = '(77,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = LoadBClick
+ TabOrder = 3
+ end
+ object SaveB: TfrxToolButton
+ Position.Point = '(100,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = SaveBClick
+ TabOrder = 4
+ end
+ object CancelB: TfrxToolButton
+ Position.Point = '(131,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = CancelBClick
+ TabOrder = 5
+ end
+ object OkB: TfrxToolButton
+ Position.Point = '(154,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = OkBClick
+ TabOrder = 6
+ end
+ end
+ object ColorB: TButton
+ Tag = 2
+ Position.Point = '(164,46)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = BClick
+ TabOrder = 2
+ end
+ object FontB: TButton
+ Tag = 3
+ Position.Point = '(164,78)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = BClick
+ TabOrder = 3
+ end
+ object FrameB: TButton
+ Tag = 4
+ Position.Point = '(164,110)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = BClick
+ TabOrder = 4
+ end
+ object OpenDialog: TOpenDialog
+ Left = 72
+ Top = 104
+ end
+ object SaveDialog: TSaveDialog
+ Left = 40
+ Top = 88
+ end
+ object StylesTV: TfrxTreeView
+ Align = alLeft
+ Position.Point = '(0,35)'
+ Width = 161.000000000000000000
+ Height = 216.000000000000000000
+ OnClick = StylesTVClick
+ TabOrder = 5
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 0
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 1
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 2
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+end
diff --git a/LibD28/FMX.frxEditStyle.pas b/LibD28/FMX.frxEditStyle.pas
new file mode 100644
index 0000000..d01c582
--- /dev/null
+++ b/LibD28/FMX.frxEditStyle.pas
@@ -0,0 +1,326 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Style editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditStyle;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.Types, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.Layouts, FMX.TreeView, FMX.Types, FMX.frxFMX, FMX.Objects,
+ FMX.Edit, System.UIConsts, FMX.frxFontForm, FMX.frxBaseModalForm
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+ TfrxStyleEditorForm = class(TfrxForm)
+ ToolBar: TToolBar;
+ AddB: TfrxToolButton;
+ DeleteB: TfrxToolButton;
+ LoadB: TfrxToolButton;
+ SaveB: TfrxToolButton;
+ CancelB: TfrxToolButton;
+ OkB: TfrxToolButton;
+ OpenDialog: TOpenDialog;
+ SaveDialog: TSaveDialog;
+ EditB: TfrxToolButton;
+ PaintBox: TPaintBox;
+ ColorB: TButton;
+ FontB: TButton;
+ FrameB: TButton;
+ StylesTV: TfrxTreeView;
+ procedure FormCreate(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure CancelBClick(Sender: TObject);
+ procedure OkBClick(Sender: TObject);
+ procedure PaintBoxPaint(Sender: TObject; Canvas: TCanvas);
+ procedure FormHide(Sender: TObject);
+ procedure AddBClick(Sender: TObject);
+ procedure DeleteBClick(Sender: TObject);
+ procedure LoadBClick(Sender: TObject);
+ procedure SaveBClick(Sender: TObject);
+ procedure BClick(Sender: TObject);
+ procedure StylesTVClick(Sender: TObject);
+ procedure StylesTVEdited(Sender: TObject; Node: TfrxTreeViewItem; var S: String);
+ procedure EditBClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ FReport: TfrxReport;
+ FStyles: TfrxStyles;
+ procedure UpdateStyles(Focus: Integer = 0);
+ procedure UpdateControls;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxDesgn, FMX.frxEditFrame, FMX.frxDesgnCtrls, FMX.frxRes;
+
+
+constructor TfrxStyleEditorForm.Create(AOwner: TComponent);
+begin
+ inherited;
+ FStyles := TfrxStyles.Create(nil);
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+end;
+
+destructor TfrxStyleEditorForm.Destroy;
+begin
+ FStyles.Free;
+ inherited;
+end;
+
+procedure TfrxStyleEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ FormHide(Self);
+end;
+
+procedure TfrxStyleEditorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(5100);
+ ColorB.Text := frxGet(5101);
+ FontB.Text := frxGet(5102);
+ FrameB.Text := frxGet(5103);
+ AddB.Hint := frxGet(5104);
+ DeleteB.Hint := frxGet(5105);
+ EditB.Hint := frxGet(5106);
+ LoadB.Hint := frxGet(5107);
+ SaveB.Hint := frxGet(5108);
+ CancelB.Hint := frxGet(2);
+ OkB.Hint := frxGet(1);
+ StylesTV.Editable := True;
+ StylesTV.OnEdited := StylesTVEdited;
+ FReport := TfrxCustomDesigner(Owner).Report;
+ frxResources.LoadImageFromResouce(AddB.Bitmap, 8, 7);
+ frxResources.LoadImageFromResouce(DeleteB.Bitmap, 5, 1);
+ frxResources.LoadImageFromResouce(EditB.Bitmap, 10, 5);
+ frxResources.LoadImageFromResouce(LoadB.Bitmap, 0, 1);
+ frxResources.LoadImageFromResouce(SaveB.Bitmap, 0, 2);
+ frxResources.LoadImageFromResouce(CancelB.Bitmap, 21, 2);
+ frxResources.LoadImageFromResouce(OkB.Bitmap, 21, 0);
+end;
+
+procedure TfrxStyleEditorForm.FormShow(Sender: TObject);
+begin
+ FStyles.Assign(FReport.Styles);
+ UpdateStyles;
+end;
+
+procedure TfrxStyleEditorForm.FormHide(Sender: TObject);
+begin
+ if ModalResult = mrOk then
+ FReport.Styles.Assign(FStyles);
+end;
+
+procedure TfrxStyleEditorForm.UpdateStyles(Focus: Integer = 0);
+var
+ i: Integer;
+ Node: TfrxTreeViewItem;
+begin
+ StylesTV.BeginUpdate;
+ StylesTV.Clear;
+ for i := 0 to FStyles.Count - 1 do
+ begin
+ Node := StylesTV.AddItem(StylesTV, FStyles[i].Name);
+ Node.TagObject := FStyles[i];
+ end;
+ StylesTV.EndUpdate;
+
+ if Focus >= StylesTV.Count then
+ Focus := StylesTV.Count - 1;
+ if Focus <> -1 then
+ StylesTV.Selected := StylesTV.Items[Focus];
+ StylesTVClick(nil);
+end;
+
+procedure TfrxStyleEditorForm.UpdateControls;
+var
+ b: Boolean;
+begin
+ b := StylesTV.Selected <> nil;
+ ColorB.Enabled := b;
+ FontB.Enabled := b;
+ FrameB.Enabled := b;
+end;
+
+procedure TfrxStyleEditorForm.PaintBoxPaint(Sender: TObject; Canvas: TCanvas);
+var
+ m: TfrxMemoView;
+begin
+ with PaintBox.Canvas do
+ begin
+ Fill.Color := claWhite;
+ Stroke.Color := claGray;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ Stroke.Kind := TBrushKind.bkSolid;
+ DrawRect(RectF(0, 0, PaintBox.Width, PaintBox.Height), 1, 1, AllCorners, 1, TCornerType.ctBevel);
+ end;
+
+ if StylesTV.Selected = nil then Exit;
+
+ m := TfrxMemoView.Create(nil);
+ m.ApplyStyle(TfrxStyleItem(StylesTV.Selected.TagObject));
+ m.Text := frxResources.Get('dsStyleSample');
+ m.GapX := 20;
+ m.GapY := 10;
+ m.Width := m.CalcWidth;
+ m.Height := m.CalcHeight;
+ m.Left := (PaintBox.Width - m.Width) / 2;
+ m.Top := (PaintBox.Height - m.Height) / 2;
+ m.Draw(PaintBox.Canvas, 1, 1, 0, 0);
+ m.Free;
+end;
+
+procedure TfrxStyleEditorForm.StylesTVClick(Sender: TObject);
+begin
+ UpdateControls;
+ //PaintBoxPaint(nil, PaintBox.Canvas);
+ Self.InvalidateRect(RectF(0, 0, Self.Width, Self.Height));
+end;
+
+procedure TfrxStyleEditorForm.BClick(Sender: TObject);
+var
+ Style: TfrxStyleItem;
+begin
+ if StylesTV.Selected = nil then Exit;
+ Style := TfrxStyleItem(StylesTV.Selected.TagObject);
+
+ case TControl(Sender).Tag of
+ 2:
+ with TfrxColorSelector.Create(TComponent(Sender)) do
+ begin
+ OnColorChanged := BClick;
+
+ //Color := AColor;
+ BtnCaption := frxResources.Get('dsColorOth');
+ Popup(ColorB);
+ Tag := 20;
+ end;
+
+ 20:
+ Style.Color := TfrxColorSelector(Sender).Color;
+
+ 3:
+ with TfrxFontForm.Create(Application) do
+ begin
+ FontS.Assign(Style.Font);
+ FormActivate(Sender);
+ if ShowModal = mrOk then
+ Style.Font.Assign(FontS);
+ Free;
+ end;
+
+ 4:
+ with TfrxFrameEditorForm.Create(Owner) do
+ begin
+ Frame.Assign(Style.Frame);
+ if ShowModal = mrOk then
+ Style.Frame := Frame;
+ Free;
+ end;
+ end;
+ Self.InvalidateRect(RectF(0, 0, Self.Width, Self.Height));
+ //PaintBoxPaint(nil, PaintBox.Canvas);
+end;
+
+procedure TfrxStyleEditorForm.AddBClick(Sender: TObject);
+begin
+ FStyles.Add.CreateUniqueName;
+ UpdateStyles(FStyles.Count - 1);
+ StylesTV.DoEdit;
+end;
+
+procedure TfrxStyleEditorForm.DeleteBClick(Sender: TObject);
+begin
+ if StylesTV.Selected = nil then Exit;
+ TfrxStyleItem(StylesTV.Selected.TagObject).Free;
+ UpdateStyles(StylesTV.Selected.Index);
+end;
+
+procedure TfrxStyleEditorForm.LoadBClick(Sender: TObject);
+begin
+ OpenDialog.Filter := frxResources.Get('dsStyleFile') + ' (*.fs3)|*.fs3';
+ if frxDesignerComp <> nil then
+ OpenDialog.InitialDir := frxDesignerComp.OpenDir;
+ if OpenDialog.Execute then
+ begin
+ FStyles.LoadFromFile(OpenDialog.FileName);
+ UpdateStyles;
+ end;
+ PeekLastModalResult;
+end;
+
+procedure TfrxStyleEditorForm.SaveBClick(Sender: TObject);
+begin
+ SaveDialog.Filter := frxResources.Get('dsStyleFile') + ' (*.fs3)|*.fs3';
+ if frxDesignerComp <> nil then
+ SaveDialog.InitialDir := frxDesignerComp.SaveDir;
+ if SaveDialog.Execute then
+ FStyles.SaveToFile(ChangeFileExt(SaveDialog.FileName, '.fs3'));
+ PeekLastModalResult;
+end;
+
+procedure TfrxStyleEditorForm.CancelBClick(Sender: TObject);
+begin
+ ModalResult := mrCancel;
+end;
+
+procedure TfrxStyleEditorForm.OkBClick(Sender: TObject);
+begin
+ ModalResult := mrOk;
+end;
+
+procedure TfrxStyleEditorForm.StylesTVEdited(Sender: TObject; Node: TfrxTreeViewItem; var S: String);
+var
+ Style: TfrxStyleItem;
+begin
+ Style := TfrxStyleItem(Node.TagObject);
+ Style.Name := s;
+end;
+
+procedure TfrxStyleEditorForm.EditBClick(Sender: TObject);
+begin
+ if StylesTV.Selected = nil then Exit;
+ StylesTV.DoEdit;
+end;
+
+procedure TfrxStyleEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+ if Key = VKF2 then
+ EditBClick(nil);
+end;
+
+end.
diff --git a/LibD28/FMX.frxEditSysMemo.fmx b/LibD28/FMX.frxEditSysMemo.fmx
new file mode 100644
index 0000000..591b9ca
--- /dev/null
+++ b/LibD28/FMX.frxEditSysMemo.fmx
@@ -0,0 +1,178 @@
+object frxSysMemoEditorForm: TfrxSysMemoEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'System Memo'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 435
+ ClientWidth = 290
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object OKB: TButton
+ Position.Point = '(129,404)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 40
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(209,404)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 50
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object AggregateRB: TRadioButton
+ Position.Point = '(4,80)'
+ Width = 173.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object SysVariableRB: TRadioButton
+ Position.Point = '(4,4)'
+ Width = 173.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ object TextRB: TRadioButton
+ Position.Point = '(4,324)'
+ Width = 173.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 4
+ end
+ object AggregatePanel: TGroupBox
+ Position.Point = '(4,100)'
+ Width = 281.000000000000000000
+ Height = 217.000000000000000000
+ TabOrder = 5
+ object DataBandL: TLabel
+ Position.Point = '(8,44)'
+ Width = 89.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object DataSetL: TLabel
+ Position.Point = '(8,76)'
+ Width = 89.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object DataFieldL: TLabel
+ Position.Point = '(8,100)'
+ Width = 89.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 2
+ end
+ object FunctionL: TLabel
+ Position.Point = '(8,20)'
+ Width = 89.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 3
+ end
+ object ExpressionL: TLabel
+ Position.Point = '(8,124)'
+ Width = 89.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 4
+ end
+ object SampleL: TLabel
+ Position.Point = '(8,196)'
+ Width = 265.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 5
+ end
+ object DataFieldCB: TComboBox
+ Position.Point = '(100,96)'
+ Width = 173.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 6
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ OnChange = DataFieldCBChange
+ end
+ object DataSetCB: TComboBox
+ Position.Point = '(100,72)'
+ Width = 173.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 7
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ OnChange = DataSetCBChange
+ end
+ object DataBandCB: TComboBox
+ Position.Point = '(100,40)'
+ Width = 173.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 8
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ OnChange = DataBandCBChange
+ end
+ object CountInvisibleCB: TCheckBox
+ Position.Point = '(8,148)'
+ Width = 265.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = FunctionCBChange
+ TabOrder = 9
+ end
+ object FunctionCB: TComboBox
+ Position.Point = '(100,16)'
+ Width = 173.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 10
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ OnChange = FunctionCBChange
+ end
+ object ExpressionE: TfrxEditWithButton
+ Position.Point = '(100,120)'
+ Width = 173.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 11
+ OnButtonClick = ExpressionEButtonClick
+ end
+ object RunningTotalCB: TCheckBox
+ Position.Point = '(8,168)'
+ Width = 265.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = FunctionCBChange
+ TabOrder = 12
+ end
+ end
+ object GroupBox1: TGroupBox
+ Position.Point = '(4,24)'
+ Width = 281.000000000000000000
+ Height = 49.000000000000000000
+ TabOrder = 6
+ object SysVariableCB: TComboBox
+ Position.Point = '(8,16)'
+ Width = 173.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 0
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ end
+ end
+ object GroupBox2: TGroupBox
+ Position.Point = '(4,344)'
+ Width = 281.000000000000000000
+ Height = 49.000000000000000000
+ TabOrder = 7
+ object TextE: TEdit
+ Position.Point = '(8,16)'
+ Width = 265.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 0
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+end
diff --git a/LibD28/FMX.frxEditSysMemo.pas b/LibD28/FMX.frxEditSysMemo.pas
new file mode 100644
index 0000000..d2ccd25
--- /dev/null
+++ b/LibD28/FMX.frxEditSysMemo.pas
@@ -0,0 +1,319 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ SysMemo editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditSysMemo;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UiTypes, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.ExtCtrls, FMX.frxClass, FMX.frxCtrls, FMX.ListBox, FMX.Edit, System.Variants
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+
+type
+{$IFDEF LINUX}
+ TfrxSysMemoEditorForm = class(TfrxForm)
+{$ELSE}
+ TfrxSysMemoEditorForm = class(TForm)
+{$ENDIF}
+ OKB: TButton;
+ CancelB: TButton;
+ AggregateRB: TRadioButton;
+ SysVariableRB: TRadioButton;
+ TextRB: TRadioButton;
+ AggregatePanel: TGroupBox;
+ DataBandL: TLabel;
+ DataSetL: TLabel;
+ DataFieldL: TLabel;
+ FunctionL: TLabel;
+ ExpressionL: TLabel;
+ DataFieldCB: TComboBox;
+ DataSetCB: TComboBox;
+ DataBandCB: TComboBox;
+ CountInvisibleCB: TCheckBox;
+ FunctionCB: TComboBox;
+ ExpressionE: TfrxEditWithButton;
+ RunningTotalCB: TCheckBox;
+ GroupBox1: TGroupBox;
+ SysVariableCB: TComboBox;
+ GroupBox2: TGroupBox;
+ TextE: TEdit;
+ SampleL: TLabel;
+ procedure ExpressionEButtonClick(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure DataSetCBChange(Sender: TObject);
+ procedure DataBandCBChange(Sender: TObject);
+ procedure DataFieldCBChange(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FunctionCBChange(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ FAggregateOnly: Boolean;
+ FReport: TfrxReport;
+ FText: String;
+ procedure FillDataBandCB;
+ procedure FillDataFieldCB;
+ procedure FillDataSetCB;
+ function CreateAggregate: String;
+ procedure UpdateSample;
+ public
+ property AggregateOnly: Boolean read FAggregateOnly write FAggregateOnly;
+ property Text: String read FText write FText;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxUtils, FMX.frxRes;
+
+
+procedure TfrxSysMemoEditorForm.FormShow(Sender: TObject);
+var
+ s: String;
+ i: Integer;
+
+ procedure HideControls(ar: array of TControl);
+ var
+ i: Integer;
+ begin
+ for i := 0 to High(ar) do
+ ar[i].Visible := False;
+ end;
+
+begin
+ FReport := TfrxCustomDesigner(Owner).Report;
+ SysVariableRB.IsChecked := True;
+ FillDataBandCB;
+ FillDataSetCB;
+
+ s := FText;
+ if s <> '' then
+ SetLength(s, Length(s) - 2); { cut #13#10 }
+ i := SysVariableCB.Items.IndexOf(s);
+ if FAggregateOnly then
+ begin
+ Caption := frxResources.Get('agAggregate');
+ AggregateRB.IsChecked := True;
+ HideControls([SysVariableRB, AggregateRB, TextRB, SysVariableCB, TextE,
+ GroupBox1, GroupBox2]);
+ AggregatePanel.Position.Y := 4;
+ OkB.Position.Y := AggregatePanel.Height + 18;
+ CancelB.Position.Y := OkB.Position.Y;
+ ClientHeight := Round(CancelB.Position.Y + 33);
+ end
+ else if (i <> -1) or (s = '') then
+ begin
+ SysVariableRB.IsChecked := True;
+ SysVariableCB.ItemIndex := i;
+ end
+ else
+ begin
+ TextRB.IsChecked := True;
+ TextE.Text := s;
+ TextE.SetFocus;
+ end;
+ UpdateSample;
+end;
+
+function TfrxSysMemoEditorForm.CreateAggregate: String;
+var
+ s: String;
+ i: Integer;
+begin
+ if FunctionCB.Selected <> nil then
+ s := FunctionCB.Selected.Text;
+ i := 0;
+ if CountInvisibleCB.IsChecked then
+ i := i or 1;
+ if RunningTotalCB.IsChecked then
+ i := i or 2;
+
+ if s <> 'COUNT' then
+ begin
+ s := s + '(';
+ if ExpressionE.Text <> '' then
+ s := s + ExpressionE.Text
+ else if(DataSetCB.Selected <> nil) and (DataFieldCB.Selected <> nil) then
+ s := s + '<' + DataSetCB.Selected.Text + '."' + DataFieldCB.Selected.Text + '">';
+
+ if (DataBandCB.Selected <> nil) and (DataBandCB.Selected.Text <> '') then
+ begin
+ s := s + ',' + DataBandCB.Selected.Text;
+ if i <> 0 then
+ s := s + ',' + IntToStr(i);
+ end;
+ s := s + ')';
+ end
+ else
+ begin
+ s := s + '(';
+ if (DataBandCB.Selected <> nil) then
+ s := s + DataBandCB.Selected.Text;
+ if i <> 0 then
+ s := s + ',' + IntToStr(i);
+ s := s + ')';
+ end;
+
+ Result := s;
+end;
+
+procedure TfrxSysMemoEditorForm.FillDataBandCB;
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+{$IFDEF DELPHI23}
+ DataBandCB.Clear;
+{$ELSE}
+ DataBandCB.Items.Clear;
+{$ENDIF}
+ for i := 0 to FReport.Designer.Objects.Count - 1 do
+ begin
+ c := FReport.Designer.Objects[i];
+ if c is TfrxDataBand then
+ DataBandCB.Items.Add(c.Name);
+ end;
+end;
+
+procedure TfrxSysMemoEditorForm.FillDataSetCB;
+begin
+ FReport.GetDataSetList(DataSetCB.Items);
+end;
+
+procedure TfrxSysMemoEditorForm.FillDataFieldCB;
+var
+ ds: TfrxDataSet;
+begin
+ ds := FReport.GetDataSet(DataSetCB.Selected.Text);
+ if ds <> nil then
+ ds.GetFieldList(DataFieldCB.Items) else
+{$IFDEF DELPHI23}
+ DataFieldCB.Clear;
+{$ELSE}
+ DataFieldCB.Items.Clear;
+{$ENDIF}
+end;
+
+procedure TfrxSysMemoEditorForm.DataBandCBChange(Sender: TObject);
+var
+ b: TfrxDataBand;
+begin
+ b := nil;
+ if DataBandCB.Selected <> nil then
+ b := FReport.Designer.Page.FindObject(DataBandCB.Selected.Text) as TfrxDataBand;
+ if (DataSetCB.Selected <> nil) and (b <> nil) and (b.DataSet <> nil) and not (b.DataSet is TfrxUserDataSet) then
+ begin
+ DataSetCB.Selected.Text := FReport.GetAlias(b.DataSet);
+ DataSetCBChange(nil);
+ end;
+end;
+
+procedure TfrxSysMemoEditorForm.DataSetCBChange(Sender: TObject);
+begin
+ FillDataFieldCB;
+ ExpressionE.Text := '';
+ UpdateSample;
+end;
+
+procedure TfrxSysMemoEditorForm.DataFieldCBChange(Sender: TObject);
+begin
+ ExpressionE.Text := '';
+ UpdateSample;
+end;
+
+procedure TfrxSysMemoEditorForm.ExpressionEButtonClick(Sender: TObject);
+var
+ s: String;
+begin
+ s := TfrxCustomDesigner(Owner).InsertExpression(ExpressionE.Text);
+ if s <> '' then
+ ExpressionE.Text := s;
+ UpdateSample;
+end;
+
+procedure TfrxSysMemoEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ if ModalResult = mrOk then
+ begin
+ if (SysVariableRB.IsChecked) and (SysVariableCB.Selected <> nil) then
+ FText := SysVariableCB.Selected.Text
+ else if AggregateRB.IsChecked then
+ FText := '[' + CreateAggregate + ']'
+ else
+ FText := TextE.Text
+ end;
+end;
+
+procedure TfrxSysMemoEditorForm.FormCreate(Sender: TObject);
+var
+ i: Integer;
+begin
+ Caption := frxGet(3300);
+ DataBandL.Text := frxGet(3301);
+ DataSetL.Text := frxGet(3302);
+ DataFieldL.Text := frxGet(3303);
+ FunctionL.Text := frxGet(3304);
+ ExpressionL.Text := frxGet(3305);
+ OKB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ AggregateRB.Text := frxGet(3306);
+ SysVariableRB.Text := frxGet(3307);
+ CountInvisibleCB.Text := frxGet(3308);
+ TextRB.Text := frxGet(3309);
+ RunningTotalCB.Text := frxGet(3310);
+ FunctionCB.BeginUpdate;
+ FunctionCB.Items.Add('SUM');
+ FunctionCB.Items.Add('MIN');
+ FunctionCB.Items.Add('MAX');
+ FunctionCB.Items.Add('AVG');
+ FunctionCB.Items.Add('COUNT');
+ FunctionCB.EndUpdate;
+ for i := 1 to 6 do
+ SysVariableCB.Items.Add(frxResources.Get('vt' + IntToStr(i)));
+ FormShow(Self);
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxSysMemoEditorForm.UpdateSample;
+begin
+ if AggregateRB.IsChecked then
+ SampleL.Text := CreateAggregate
+ else
+ SampleL.Text := '';
+end;
+
+procedure TfrxSysMemoEditorForm.FunctionCBChange(Sender: TObject);
+begin
+ UpdateSample;
+end;
+
+procedure TfrxSysMemoEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+end.
+
diff --git a/LibD28/FMX.frxEditTabOrder.fmx b/LibD28/FMX.frxEditTabOrder.fmx
new file mode 100644
index 0000000..5c15a76
--- /dev/null
+++ b/LibD28/FMX.frxEditTabOrder.fmx
@@ -0,0 +1,58 @@
+object frxTabOrderEditorForm: TfrxTabOrderEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Tab Order'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 215
+ ClientWidth = 303
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object Label1: TLabel
+ Position.Point = '(8,8)'
+ Width = 131.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object OkB: TButton
+ Position.Point = '(220,28)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(220,56)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 2
+ ModalResult = 2
+ Cancel = True
+ end
+ object UpB: TButton
+ Position.Point = '(220,100)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = UpBClick
+ TabOrder = 3
+ end
+ object DownB: TButton
+ Position.Point = '(220,128)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = DownBClick
+ TabOrder = 4
+ end
+ object ControlsLB: TListBox
+ Position.Point = '(8,28)'
+ Width = 201.000000000000000000
+ Height = 177.000000000000000000
+ TabOrder = 5
+ ItemHeight = 13.000000000000000000
+ end
+end
diff --git a/LibD28/FMX.frxEditTabOrder.pas b/LibD28/FMX.frxEditTabOrder.pas
new file mode 100644
index 0000000..3ebd771
--- /dev/null
+++ b/LibD28/FMX.frxEditTabOrder.pas
@@ -0,0 +1,166 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Tab order editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditTabOrder;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.Layouts, FMX.ListBox, FMX.Types
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+type
+ TfrxTabOrderEditorForm = class(TForm)
+ OkB: TButton;
+ CancelB: TButton;
+ Label1: TLabel;
+ UpB: TButton;
+ DownB: TButton;
+ ControlsLB: TListBox;
+ procedure FormCreate(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure UpBClick(Sender: TObject);
+ procedure DownBClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ FOldOrder: TList;
+ FParent: TfrxComponent;
+ procedure UpdateOrder;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxRes;
+
+
+constructor TfrxTabOrderEditorForm.Create(AOwner: TComponent);
+begin
+ inherited;
+ FOldOrder := TList.Create;
+end;
+
+destructor TfrxTabOrderEditorForm.Destroy;
+begin
+ FOldOrder.Free;
+ inherited;
+end;
+
+procedure TfrxTabOrderEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+var
+ i: Integer;
+begin
+ if ModalResult <> mrOk then
+ for i := 0 to FOldOrder.Count - 1 do
+ FParent.Objects[i] := FOldOrder[i];
+end;
+
+procedure TfrxTabOrderEditorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(5400);
+ Label1.Text := frxGet(5401);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ UpB.Text := frxGet(5402);
+ DownB.Text := frxGet(5403);
+ FormShow(Self);
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxTabOrderEditorForm.FormShow(Sender: TObject);
+var
+ i: Integer;
+ l: TList;
+begin
+ if TfrxCustomDesigner(Owner).SelectedObjects.Count = 0 then
+ FParent := TfrxCustomDesigner(Owner).Page
+ else
+ FParent := TfrxCustomDesigner(Owner).SelectedObjects[0];
+ l := FParent.Objects;
+ for i := 0 to l.Count - 1 do
+ begin
+ FOldOrder.Add(l[i]);
+ if (TObject(l[i]) is TfrxDialogControl) and
+ (TfrxDialogControl(l[i]).Control is TControl) then
+ ControlsLB.Items.AddObject(TfrxDialogControl(l[i]).Name + ': ' +
+ TfrxDialogControl(l[i]).GetDescription, l[i]);
+ end;
+end;
+
+
+procedure TfrxTabOrderEditorForm.UpdateOrder;
+var
+ i: Integer;
+ c: TfrxDialogControl;
+begin
+ { TabOrder is self-arranged property, set it to big values to avoid conflicts }
+ for i := 0 to ControlsLB.Items.Count - 1 do
+ begin
+ c := TfrxDialogControl(ControlsLB.Items.Objects[i]);
+ c.Control.TabOrder := 1000 + i;
+ end;
+ { set to normal values }
+ for i := 0 to ControlsLB.Items.Count - 1 do
+ begin
+ c := TfrxDialogControl(ControlsLB.Items.Objects[i]);
+ c.Control.TabOrder := i;
+ end;
+end;
+
+procedure TfrxTabOrderEditorForm.UpBClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ i := ControlsLB.ItemIndex;
+ if (i = -1) or (i = 0) then Exit;
+
+ FParent.Objects.Exchange(FParent.Objects.IndexOf(ControlsLB.Items.Objects[i]),
+ FParent.Objects.IndexOf(ControlsLB.Items.Objects[i - 1]));
+ ControlsLB.Items.Exchange(i, i - 1);
+ ControlsLB.ItemIndex := i - 1;
+ UpdateOrder;
+end;
+
+procedure TfrxTabOrderEditorForm.DownBClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ i := ControlsLB.ItemIndex;
+ if (i = -1) or (i = ControlsLB.Items.Count - 1) then Exit;
+
+ FParent.Objects.Exchange(FParent.Objects.IndexOf(ControlsLB.Items.Objects[i]),
+ FParent.Objects.IndexOf(ControlsLB.Items.Objects[i + 1]));
+ ControlsLB.Items.Exchange(i, i + 1);
+ ControlsLB.ItemIndex := i + 1;
+ UpdateOrder;
+end;
+
+procedure TfrxTabOrderEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+end.
diff --git a/LibD28/FMX.frxEditVar.fmx b/LibD28/FMX.frxEditVar.fmx
new file mode 100644
index 0000000..e17688c
--- /dev/null
+++ b/LibD28/FMX.frxEditVar.fmx
@@ -0,0 +1,189 @@
+object frxVarEditorForm: TfrxVarEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Edit Variables'
+ BorderIcons = [biSystemMenu, biMinimize, biMaximize, biHelp]
+ ClientHeight = 548
+ ClientWidth = 532
+ Visible = False
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnActivate = FormActivate
+ OnKeyDown = FormKeyDown
+ OnResize = Splitter2Moved
+ StyleLookup = 'backgroundstyle'
+ object Splitter1: TSplitter
+ Align = alBottom
+ Cursor = crVSplit
+ Position.Point = '(0,469)'
+ Width = 532.000000000000000000
+ Height = 3.000000000000000000
+ TabOrder = 0
+ MinSize = 20.000000000000000000
+ end
+ object Splitter2: TSplitter
+ Align = alRight
+ Cursor = crHSplit
+ Position.Point = '(129,31)'
+ Width = 3.000000000000000000
+ Height = 421.000000000000000000
+ TabOrder = 1
+ MinSize = 20.000000000000000000
+ end
+ object ToolBar: TToolBar
+ Width = 532.000000000000000000
+ Height = 31.000000000000000000
+ TabOrder = 2
+ object NewCategoryB: TfrxToolButton
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = NewCategoryBClick
+ TabOrder = 0
+ end
+ object NewVarB: TfrxToolButton
+ Position.Point = '(23,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = NewVarBClick
+ TabOrder = 1
+ end
+ object EditB: TfrxToolButton
+ Position.Point = '(46,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = EditBClick
+ TabOrder = 2
+ end
+ object DeleteB: TfrxToolButton
+ Position.Point = '(69,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = DeleteBClick
+ TabOrder = 3
+ end
+ object EditListB: TfrxToolButton
+ Position.Point = '(92,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = EditListBClick
+ TabOrder = 4
+ end
+ object LoadB: TfrxToolButton
+ Position.Point = '(123,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = LoadBClick
+ TabOrder = 5
+ end
+ object SaveB: TfrxToolButton
+ Position.Point = '(146,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = SaveBClick
+ TabOrder = 6
+ end
+ object CancelB: TfrxToolButton
+ Position.Point = '(177,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = CancelBClick
+ TabOrder = 7
+ ModalResult = 2
+ end
+ object OkB: TfrxToolButton
+ Position.Point = '(200,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = OkBClick
+ TabOrder = 8
+ ModalResult = 1
+ end
+ end
+ object ExprMemo: TMemo
+ Align = alBottom
+ Position.Point = '(0,472)'
+ Width = 532.000000000000000000
+ Height = 76.000000000000000000
+ OnChange = ExprMemoChange
+ OnDragOver = ExprMemoDragOver
+ OnDragDrop = ExprMemoDragDrop
+ OnEnter = ExprMemoEnter
+ TabOrder = 3
+ KeyboardType = vktDefault
+ end
+ object ExprPanel: TPanel
+ Align = alBottom
+ Position.Point = '(0,452)'
+ Width = 532.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 4
+ end
+ object Panel: TPanel
+ Align = alRight
+ Position.Point = '(132,31)'
+ Width = 400.000000000000000000
+ Height = 421.000000000000000000
+ TabOrder = 5
+ end
+ object OpenDialog1: TOpenDialog
+ DefaultExt = '.fd3'
+ Left = 368
+ Top = 104
+ end
+ object SaveDialog1: TSaveDialog
+ DefaultExt = '.fd3'
+ Left = 232
+ Top = 112
+ end
+ object VarTree: TfrxTreeView
+ Align = alClient
+ Position.Point = '(0,31)'
+ Width = 129.000000000000000000
+ Height = 421.000000000000000000
+ OnResize = VarTreeResize
+ TabOrder = 6
+ OnChange = VarTreeChange
+ OnBeforeChange = VarTreeChanging
+ Editable = False
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 0
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 1
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 2
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 3
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 4
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+end
diff --git a/LibD28/FMX.frxEditVar.pas b/LibD28/FMX.frxEditVar.pas
new file mode 100644
index 0000000..9f6a54f
--- /dev/null
+++ b/LibD28/FMX.frxEditVar.pas
@@ -0,0 +1,554 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Variables editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditVar;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, System.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.frxVariables, FMX.frxDataTree, FMX.Memo, FMX.Types, FMX.frxFMX,
+ FMX.Layouts, FMX.TreeView, System.Variants, FMX.Edit, FMX.frxBaseModalForm
+ {$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI22}
+ ,FMX.Memo.Types
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+ TfrxVarEditorForm = class(TfrxForm)
+ ToolBar: TToolBar;
+ NewCategoryB: TfrxToolButton;
+ NewVarB: TfrxToolButton;
+ EditB: TfrxToolButton;
+ DeleteB: TfrxToolButton;
+ EditListB: TfrxToolButton;
+ OkB: TfrxToolButton;
+ CancelB: TfrxToolButton;
+ ExprMemo: TMemo;
+ Splitter1: TSplitter;
+ Splitter2: TSplitter;
+ ExprPanel: TPanel;
+ LoadB: TfrxToolButton;
+ SaveB: TfrxToolButton;
+ OpenDialog1: TOpenDialog;
+ SaveDialog1: TSaveDialog;
+ Panel: TPanel;
+ VarTree: TfrxTreeView;
+ procedure FormShow(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure DeleteBClick(Sender: TObject);
+ procedure NewCategoryBClick(Sender: TObject);
+ procedure NewVarBClick(Sender: TObject);
+ procedure OkBClick(Sender: TObject);
+ procedure EditBClick(Sender: TObject);
+ procedure VarTreeEdited(Sender: TObject; Node: TfrxTreeViewItem; var S: String);
+ procedure ExprMemoDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; var Accept: Boolean);
+ procedure ExprMemoDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+ procedure VarTreeChange(Sender: TObject);
+ procedure VarTreeChanging(Sender: TObject; OldNode: TfrxTreeViewItem; NewNode: TfrxTreeViewItem);
+ //procedure VarTreeChanging(Sender: TObject; Node: TTreeNode;
+ // var AllowChange: Boolean);
+ procedure CancelBClick(Sender: TObject);
+ procedure EditListBClick(Sender: TObject);
+ procedure FormHide(Sender: TObject);
+ procedure LoadBClick(Sender: TObject);
+ procedure SaveBClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure Splitter2Moved(Sender: TObject);
+ procedure VarTreeResize(Sender: TObject);
+ procedure FormActivate(Sender: TObject);
+ procedure ExprMemoChange(Sender: TObject);
+ procedure ExprMemoEnter(Sender: TObject);
+ private
+ FReport: TfrxReport;
+ FUpdating: Boolean;
+ FVariables: TfrxVariables;
+ FDataTree: TfrxDataTreeForm;
+ FExprMemoModified: Boolean;
+ FNodeOldText: String;
+ function Root: TfrxTreeViewItem;
+ procedure CreateUniqueName(var s: String);
+ procedure FillVariables;
+ procedure UpdateItem0;
+ procedure OnDataTreeDblClick(Sender: TObject);
+ procedure VarTreeKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ public
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxEditStrings, FMX.frxUtils, FMX.frxRes, System.IniFiles;
+
+var
+ lastPosition: TPoint;
+
+
+procedure SetImageIndex(Node: TfrxTreeViewItem; Index: Integer);
+begin
+ Node.OpenImageIndex := Index;
+ Node.CloseImageIndex := Index;
+end;
+
+{ TfrxVarEditorForm }
+
+procedure TfrxVarEditorForm.FormActivate(Sender: TObject);
+begin
+ if FDataTree <> nil then FDataTree.FormResize(FDataTree);
+end;
+
+procedure TfrxVarEditorForm.FormCreate(Sender: TObject);
+begin
+
+ FReport := TfrxCustomDesigner(Owner).Report;
+ //VarTree.Images := frxResources.MainButtonImages;
+ //Toolbar.Images := VarTree.Images;
+ VarTree.Editable := True;
+ VarTree.OnKeyDown := VarTreeKeyDown;
+
+ FVariables := TfrxVariables.Create;
+ FVariables.Assign(FReport.Variables);
+
+ FDataTree := TfrxDataTreeForm.Create(Owner);
+ FDataTree.Report := FReport;
+ FDataTree.MainDataPanel.Parent := Self.Panel;
+ FDataTree.MainDataPanel.Align := TAlignLayout.alClient;
+ FDataTree.Visible := False;
+ FDataTree.MainDataPanel.OnDblClick := OnDataTreeDblClick;
+ //FDataTree.OnDblClick := OnDataTreeDblClick;
+ //FDataTree.SetControlsParent(Panel);
+ FDataTree.HintPanel.Height := 64;
+ FDataTree.UpdateItems;
+
+ Caption := frxGet(2900);
+ NewCategoryB.Hint := frxGet(2901);
+ NewVarB.Hint := frxGet(2902);
+ EditB.Hint := frxGet(2903);
+ DeleteB.Hint := frxGet(2904);
+ EditListB.Hint := frxGet(2905);
+ LoadB.Hint := frxGet(2906);
+ SaveB.Hint := frxGet(2907);
+ CancelB.Hint := frxGet(2);
+ OkB.Hint := frxGet(1);
+ OpenDialog1.Filter := frxGet(2909);
+ SaveDialog1.Filter := frxGet(2910);
+ VarTree.OnEdited := VarTreeEdited;
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+ FillVariables;
+ VarTree.SetFocus;
+ FDataTree.SetLastPosition(lastPosition);
+ frxResources.LoadImageFromResouce(NewCategoryB.Bitmap, 20, 2);
+ frxResources.LoadImageFromResouce(NewVarB.Bitmap, 6, 0);
+ frxResources.LoadImageFromResouce(EditB.Bitmap, 11, 3);
+ frxResources.LoadImageFromResouce(DeleteB.Bitmap, 5, 1);
+ frxResources.LoadImageFromResouce(EditListB.Bitmap, 10, 5);
+ frxResources.LoadImageFromResouce(LoadB.Bitmap, 0, 1);
+ frxResources.LoadImageFromResouce(SaveB.Bitmap, 0, 2);
+ frxResources.LoadImageFromResouce(CancelB.Bitmap, 21, 2);
+ frxResources.LoadImageFromResouce(OkB.Bitmap, 21, 0);
+ VarTree.SetImages(frxResources.Images);
+end;
+
+procedure TfrxVarEditorForm.FormDestroy(Sender: TObject);
+begin
+ FDataTree.Free;
+ FVariables.Free;
+end;
+
+procedure TfrxVarEditorForm.FormShow(Sender: TObject);
+//var
+// Ini: TCustomIniFile;
+begin
+// Ini := FReport.GetIniFile;
+// Ini.WriteBool('Form4.TfrxVarEditorForm', 'Visible', True);
+// frxRestoreFormPosition(Ini, Self);
+// ExprMemo.Height := Ini.ReadInteger('Form4.TfrxVarEditorForm', 'Split1Pos', 76);
+// Panel.Width := Ini.ReadInteger('Form4.TfrxVarEditorForm', 'Split2Pos', 400);
+// FDataTree.UpdateSize;
+// Ini.Free;
+
+
+end;
+
+procedure TfrxVarEditorForm.FormHide(Sender: TObject);
+//var
+// Ini: TCustomIniFile;
+begin
+// Ini := FReport.GetIniFile;
+// frxSaveFormPosition(Ini, Self);
+// Ini.WriteInteger('Form4.TfrxVarEditorForm', 'Split1Pos', ExprMemo.Height);
+// Ini.WriteInteger('Form4.TfrxVarEditorForm', 'Split2Pos', Panel.Width);
+// Ini.Free;
+ lastPosition := FDataTree.GetLastPosition;
+end;
+
+procedure TfrxVarEditorForm.OkBClick(Sender: TObject);
+begin
+ FExprMemoModified := True; //save variable's value if OkB pressed without leaving of ExprMemo
+ ModalResult := mrOk;
+ VarTree.Selected := VarTree.ItemByGlobalIndex(0);
+ FReport.Variables.Assign(FVariables);
+end;
+
+procedure TfrxVarEditorForm.CancelBClick(Sender: TObject);
+begin
+ ModalResult := mrCancel;
+end;
+
+function TfrxVarEditorForm.Root: TfrxTreeViewItem;
+begin
+ //VarTree.UpdateGlobalIndexes;
+// Result := TfrxTreeViewItem(VarTree.ItemByGlobalIndex(0));
+ Result := TfrxTreeViewItem(VarTree.Items[0]);
+end;
+
+procedure TfrxVarEditorForm.UpdateItem0;
+begin
+ if Root.Count = 0 then
+ Root.Text := frxResources.Get('vaNoVar') else
+ Root.Text := frxResources.Get('vaVar');
+end;
+
+procedure TfrxVarEditorForm.CreateUniqueName(var s: String);
+var
+ i: Integer;
+begin
+ i := 0;
+ repeat
+ Inc(i);
+ until FVariables.IndexOf(s + IntToStr(i)) = -1;
+ s := s + IntToStr(i);
+end;
+
+procedure TfrxVarEditorForm.FillVariables;
+var
+ i: Integer;
+ CategoriesList, VariablesList: TStrings;
+ Node: TfrxTreeViewItem;
+
+ procedure AddVariables(Node: TfrxTreeViewItem);
+ var
+ i: Integer;
+ Node1: TfrxTreeViewItem;
+ begin
+ for i := 0 to VariablesList.Count - 1 do
+ begin
+ Node1 := VarTree.AddItem(Node, VariablesList[i]);
+ SetImageIndex(Node1, 80);
+ end;
+ end;
+
+begin
+ FUpdating := True;
+ CategoriesList := TStringList.Create;
+ VariablesList := TStringList.Create;
+ FVariables.GetCategoriesList(CategoriesList);
+
+ VarTree.Clear;
+ VarTree.AddItem(VarTree, '');
+
+
+ SetImageIndex(Root, 66);
+ VarTree.BeginUpdate;
+ for i := 0 to CategoriesList.Count - 1 do
+ begin
+ FVariables.GetVariablesList(CategoriesList[i], VariablesList);
+ Node := VarTree.AddItem(Root, CategoriesList[i]);
+ SetImageIndex(Node, 66);
+ AddVariables(Node);
+ end;
+
+ if CategoriesList.Count = 0 then
+ begin
+ FVariables.GetVariablesList('', VariablesList);
+ AddVariables(Root);
+ end;
+ VarTree.EndUpdate;
+ UpdateItem0;
+ VarTree.ExpandAll;
+
+ CategoriesList.Free;
+ VariablesList.Free;
+ FUpdating := False;
+end;
+
+procedure TfrxVarEditorForm.DeleteBClick(Sender: TObject);
+var
+ Node: TTreeViewItem;
+begin
+ Node := VarTree.Selected;
+ if (Node = nil) or (Node = Root) then Exit;
+
+ FUpdating := True;
+ if Node.ParentItem <> Root then
+ FVariables.DeleteVariable(Node.Text) else
+ FVariables.DeleteCategory(Node.Text);
+ Node.Free;
+ FUpdating := False;
+ UpdateItem0;
+end;
+
+procedure TfrxVarEditorForm.NewCategoryBClick(Sender: TObject);
+var
+ Node: TfrxTreeViewItem;
+ s: String;
+begin
+ s := ' New Category';
+ CreateUniqueName(s);
+ VarTree.BeginUpdate;
+ Node := VarTree.AddItem(Root, Trim(s));
+ VarTree.EndUpdate;
+ SetImageIndex(Node, 66);
+ FVariables.Add.Name := s;
+ VarTree.ExpandAll;
+ UpdateItem0;
+end;
+
+procedure TfrxVarEditorForm.NewVarBClick(Sender: TObject);
+var
+ Node: TTreeViewItem;
+ s: String;
+begin
+ if Root.Count = 0 then Exit;
+ Node := VarTree.Selected;
+ if (Node = nil) or (Node = Root) then
+ Node := VarTree.ItemByGlobalIndex(Root.Count - 1)
+ else if (Node.ParentItem <> Root) and (Node.ParentItem is TTreeViewItem) then
+ Node := TTreeViewItem(Node.ParentItem);
+
+ s := 'New Variable';
+ CreateUniqueName(s);
+ FVariables.AddVariable(Node.Text, s, '');
+ VarTree.BeginUpdate;
+ Node := VarTree.AddItem(Node, s);
+ VarTree.EndUpdate;
+ SetImageIndex(TfrxTreeViewItem(Node), 80);
+
+ VarTree.ExpandAll;
+ UpdateItem0;
+end;
+
+procedure TfrxVarEditorForm.EditBClick(Sender: TObject);
+var
+ Node: TTreeViewItem;
+begin
+ Node := VarTree.Selected;
+ if (Node = nil) or (Node = Root) then Exit;
+ VarTree.DoEdit;
+end;
+
+procedure TfrxVarEditorForm.VarTreeEdited(Sender: TObject; Node: TfrxTreeViewItem; var S: String);
+var
+ s1, s2: String;
+begin
+ if (FNodeOldText = s) or (Root.Count = 0) then Exit;
+ s1 := s;
+ s2 := FNodeOldText;
+
+ if Node.ParentItem = Root then
+ begin
+ s1 := ' ' + s1;
+ s2 := ' ' + s2;
+ end;
+
+ if FVariables.IndexOf(s1) <> -1 then
+ begin
+ s := FNodeOldText;
+ frxErrorMsg(frxResources.Get('vaDupName'));
+ end
+ else
+ FVariables.Items[FVariables.IndexOf(s2)].Name := s1;
+end;
+
+procedure TfrxVarEditorForm.VarTreeKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ case Key of
+ vkInsert:
+ if not VarTree.IsEditing then
+ if Root.Count = 0 then
+ NewCategoryBClick(nil) else
+ NewVarBClick(nil);
+ vkDelete:
+ if not VarTree.IsEditing then
+ DeleteBClick(nil);
+ vkReturn, vkF2:
+ if not VarTree.IsEditing then
+ EditBClick(nil);
+ end;
+end;
+
+procedure TfrxVarEditorForm.VarTreeResize(Sender: TObject);
+begin
+ if Assigned(FDataTree) then
+ FDataTree.UpdateSize;
+end;
+
+procedure TfrxVarEditorForm.ExprMemoDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; var Accept: Boolean);
+begin
+ Accept := (Data.Source is TTreeView) and (TControl(Data.Source).Owner = FDataTree) and
+ (FDataTree.GetFieldName <> '');
+end;
+
+procedure TfrxVarEditorForm.ExprMemoDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+var
+ SelStart: TCaretPosition;
+ SelLen: Integer;
+begin
+ SelLen := ExprMemo.SelLength;
+ SelStart := ExprMemo.TextPosToPos(ExprMemo.SelStart);
+ ExprMemo.DeleteFrom(SelStart, SelLen, []);
+ ExprMemo.InsertAfter(SelStart, FDataTree.GetFieldName, []);
+end;
+
+procedure TfrxVarEditorForm.ExprMemoEnter(Sender: TObject);
+begin
+ FExprMemoModified := False;
+end;
+
+procedure TfrxVarEditorForm.ExprMemoChange(Sender: TObject);
+begin
+ FExprMemoModified := True;
+end;
+
+procedure TfrxVarEditorForm.OnDataTreeDblClick(Sender: TObject);
+var
+ SelStart: TCaretPosition;
+ SelLen: Integer;
+begin
+ SelLen := ExprMemo.SelLength;
+ SelStart := ExprMemo.TextPosToPos(ExprMemo.SelStart);
+ ExprMemo.DeleteFrom(SelStart, SelLen, []);
+ ExprMemo.InsertAfter(SelStart, FDataTree.GetFieldName, []);
+end;
+
+procedure TfrxVarEditorForm.VarTreeChange(Sender: TObject);
+begin
+ if FUpdating then Exit;
+ FNodeOldText := VarTree.Selected.Text;
+ if (VarTree.Selected = nil) or (VarTree.Selected = Root) or (VarTree.Selected.ParentItem = Root) then
+ ExprMemo.Text := '' else
+ ExprMemo.Text := VarToStr(FVariables[VarTree.Selected.Text]);
+end;
+
+procedure TfrxVarEditorForm.VarTreeChanging(Sender: TObject; OldNode: TfrxTreeViewItem; NewNode: TfrxTreeViewItem);
+begin
+ if FUpdating then Exit;
+
+ if FExprMemoModified then
+ if not ((OldNode = nil) or (OldNode = Root) or (OldNode.ParentItem = Root) or (csDestroying in OldNode.ComponentState)) then
+ begin
+ FVariables[OldNode.Text] := ExprMemo.Text;
+ FExprMemoModified := False;
+ end;
+end;
+
+procedure TfrxVarEditorForm.EditListBClick(Sender: TObject);
+
+ procedure VarToStrings(Lines: TStrings);
+ var
+ i: Integer;
+ s: String;
+ begin
+ for i := 0 to FVariables.Count - 1 do
+ begin
+ s := FVariables.Items[i].Name;
+ if s <> '' then
+ if s[1] = ' ' then
+ s := Copy(s, 2, 255) else
+ s := ' ' + s;
+ Lines.Add(s);
+ end;
+ end;
+
+ procedure StringsToVar(Lines: TStrings);
+ var
+ i: Integer;
+ v: TfrxVariables;
+ s: String;
+ begin
+ v := TfrxVariables.Create;
+ for i := 0 to Lines.Count - 1 do
+ begin
+ s := Lines[i];
+ if Trim(s) <> '' then
+ begin
+ if s[1] = ' ' then
+ s := Copy(s, 2, 255) else
+ s := ' ' + s;
+ if FVariables.IndexOf(s) <> -1 then
+ v[s] := FVariables[s] else
+ v[s] := '';
+ end;
+ end;
+
+ FVariables.Assign(v);
+ FillVariables;
+ v.Free;
+ end;
+
+begin
+ with TfrxStringsEditorForm.Create(Owner) do
+ begin
+ VarToStrings(Memo.Lines);
+ if ShowModal = mrOk then
+ StringsToVar(Memo.Lines);
+ VarTree.Selected := VarTree.ItemByGlobalIndex(0);
+ Free;
+ end;
+end;
+
+procedure TfrxVarEditorForm.LoadBClick(Sender: TObject);
+begin
+ if OpenDialog1.Execute then
+ begin
+ FVariables.LoadFromFile(OpenDialog1.FileName);
+ FillVariables;
+ end;
+ PeekLastModalResult;
+end;
+
+procedure TfrxVarEditorForm.SaveBClick(Sender: TObject);
+begin
+ VarTree.Selected := VarTree.Items[0];
+ if SaveDialog1.Execute then
+ FVariables.SaveToFile(SaveDialog1.FileName);
+ PeekLastModalResult;
+end;
+
+procedure TfrxVarEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if (Shift = [ssCtrl]) and (Key = vkReturn) then
+ OkBClick(nil);
+ if Key = VKESCAPE then
+ CancelBClick(nil);
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+procedure TfrxVarEditorForm.Splitter2Moved(Sender: TObject);
+begin
+ if FDataTree <> nil then FDataTree.UpdateSize;
+end;
+
+end.
diff --git a/LibD28/FMX.frxEngine.pas b/LibD28/FMX.frxEngine.pas
new file mode 100644
index 0000000..70d297f
--- /dev/null
+++ b/LibD28/FMX.frxEngine.pas
@@ -0,0 +1,2810 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Report engine }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEngine;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.Variants, System.UITypes, System.Types,
+ FMX.Forms,
+ FMX.frxClass, FMX.frxAggregate, FMX.frxXML, FMX.frxDMPClass;
+
+
+type
+ { TfrxHeaderList holds a set of bands that should appear on each new page.
+ This includes page header, column header and header bands with
+ "Reprint on new page" setting }
+
+ TfrxHeaderListItem = class(TObject)
+ public
+ Band: TfrxBand;
+ Left: Extended;
+ IsInKeepList: Boolean;
+ end;
+
+ TfrxHeaderList = class(TObject)
+ private
+ FList: TList;
+ function GetCount: Integer;
+ function GetItems(Index: Integer): TfrxHeaderListItem;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Clear;
+ procedure AddItem(ABand: TfrxBand; ALeft: Extended; AInKeepList: Boolean);
+ procedure RemoveItem(ABand: TfrxBand);
+ property Count: Integer read GetCount;
+ property Items[Index: Integer]: TfrxHeaderListItem read GetItems; default;
+ end;
+
+ TfrxEngine = class(TfrxCustomEngine)
+ private
+ FAggregates: TfrxAggregateList;
+ FCallFromAddPage: Boolean;
+ FCallFromEndPage: Boolean;
+ FCurBand: TfrxBand;
+ FLastBandOnPage: TfrxBand;
+ FDontShowHeaders: Boolean;
+ FHeaderList: TfrxHeaderList; { list of header bands }
+ FFirstReportPage: Boolean; { needed for correct setting of PreviewPages.FirstPage }
+ FFirstColumnY: Extended; { position of the first column }
+ FIsFirstBand: Boolean; { needed for KeepTogether }
+ FIsFirstPage: Boolean; { first and last page flags }
+ FIsLastPage: Boolean; { }
+ FTitlePrinted: Boolean;
+ FHBandNamesTree: TStrings; { need for correct work with drill down in master-detail-subtetail-... }
+ FKeepBand: TfrxBand;
+ FKeepFooter: Boolean;
+ FKeeping: Boolean;
+ FKeepHeader: Boolean;
+ FKeepCurY: Extended; { need when group doesn't fit on the whole page}
+ FPrevFooterHeight: Extended; {need for correct freespace calculation when use printOnPreviousPage}
+ FKeepOutline: TfrxXMLItem;
+ FKeepPosition: Integer;
+ FKeepAnchor: Integer;
+ FCallFromPHeader: Boolean; { endless loop fix }
+ FOutputTo: TfrxNullBand; { used in the subreports }
+ FPage: TfrxReportPage; { currently proceeded page }
+ FPageCurX: Extended;
+ FStartNewPageBand: TfrxBand; { needed in addpage }
+ FVHeaderList: TList; { list of vheader bands }
+ FVMasterBand: TfrxBand; { master hband for vbands }
+ FVPageList: TList; { list of page breaks for vbands }
+ FFastCanvas: TObject;
+ procedure AddBandOutline(Band: TfrxBand);
+ procedure AddColumn;
+ procedure AddPage;
+ procedure AddPageOutline;
+ procedure AddToHeaderList(Band: TfrxBand);
+ procedure AddToVHeaderList(Band: TfrxBand);
+ procedure CheckBandColumns(Band: TfrxDataBand; ColumnKeepPos: Integer;
+ SaveCurY: Extended);
+ procedure CheckDrill(Master: TfrxDataBand; Band: TfrxGroupHeader);
+ procedure CheckGroups(Master: TfrxDataBand; Band: TfrxGroupHeader;
+ ColumnKeepPos: Integer; SaveCurY: Extended);
+ procedure CheckSubReports(Band: TfrxBand);
+ procedure CheckSuppress(Band: TfrxBand);
+ procedure DoShow(Band: TfrxBand);
+ procedure DrawSplit(Band: TfrxBand);
+ procedure EndColumn;
+ procedure EndKeep(Band: TfrxBand);
+ procedure InitGroups(Master: TfrxDataBand; Band: TfrxGroupHeader;
+ Index: Integer; ResetLineN: Boolean = False);
+ procedure InitPage;
+ procedure NotifyObjects(Band: TfrxBand);
+ procedure OutlineRoot;
+ procedure OutlineUp(Band: TfrxBand);
+ procedure PreparePage(ErrorList: TStrings; PrepareVBands: Boolean);
+ procedure PrepareShiftTree(Band: TfrxBand);
+ procedure RemoveFromHeaderList(Band: TfrxBand);
+ procedure RemoveFromVHeaderList(Band: TfrxBand);
+ procedure ResetSuppressValues(Band: TfrxBand);
+ procedure RunPage(Page: TfrxReportPage);
+ procedure RunReportPages;
+ procedure ShowGroupFooters(Band: TfrxGroupHeader; Index: Integer; Master: TfrxDataBand);
+ procedure ShowVBands(HBand: TfrxBand);
+ procedure StartKeep(Band: TfrxBand; Position: Integer = 0);
+ procedure Stretch(Band: TfrxBand);
+ procedure UnStretch(Band: TfrxBand);
+ function CanShow(Obj: TObject; PrintIfDetailEmpty: Boolean): Boolean;
+ function FindBand(Band: TfrxBandClass): TfrxBand;
+ function RunDialogs: Boolean;
+ protected
+ function GetPageHeight: Double; override;
+ public
+ constructor Create(AReport: TfrxReport); override;
+ destructor Destroy; override;
+ procedure EndPage; override;
+ procedure NewColumn; override;
+ procedure NewPage; override;
+ function Run: Boolean; override;
+ procedure ShowBand(Band: TfrxBand); overload; override;
+ procedure ShowBand(Band: TfrxBandClass); overload; override;
+ function HeaderHeight: Double; override;
+ function FooterHeight: Double; override;
+ function FreeSpace: Double; override;
+ procedure BreakAllKeep; override; { used in crosstab }
+ function GetAggregateValue(const Name, Expression: String;
+ Band: TfrxBand; Flags: Integer): Variant; override;
+ function Initialize: Boolean;
+ procedure Finalize;
+ end;
+
+
+implementation
+
+uses
+ FMX.frxUtils, FMX.frxPreviewPages, FMX.frxRes, FMX.frxFMX;
+
+type
+ THackComponent = class(TfrxComponent);
+ THackMemoView = class(TfrxCustomMemoView);
+
+
+{ TfrxHeaderList }
+
+constructor TfrxHeaderList.Create;
+begin
+ FList := TList.Create;
+end;
+
+destructor TfrxHeaderList.Destroy;
+begin
+ Clear;
+ FList.Free;
+ inherited;
+end;
+
+procedure TfrxHeaderList.Clear;
+begin
+ while FList.Count > 0 do
+ begin
+ TObject(FList[0]).Free;
+ FList.Delete(0);
+ end;
+end;
+
+function TfrxHeaderList.GetCount: Integer;
+begin
+ Result := FList.Count;
+end;
+
+function TfrxHeaderList.GetItems(Index: Integer): TfrxHeaderListItem;
+begin
+ Result := FList[Index];
+end;
+
+procedure TfrxHeaderList.AddItem(ABand: TfrxBand; ALeft: Extended; AInKeepList: Boolean);
+var
+ Item: TfrxHeaderListItem;
+begin
+ Item := TfrxHeaderListItem.Create;
+ Item.Band := ABand;
+ Item.Left := ALeft;
+ Item.IsInKeepList := AInKeepList;
+ FList.Add(Item);
+end;
+
+procedure TfrxHeaderList.RemoveItem(ABand: TfrxBand);
+var
+ i: Integer;
+begin
+ for i := 0 to Count - 1 do
+ if Items[i].Band = ABand then
+ begin
+ Items[i].Free;
+ FList.Delete(i);
+ break;
+ end;
+end;
+
+
+{ TfrxEngine }
+
+constructor TfrxEngine.Create(AReport: TfrxReport);
+begin
+ inherited;
+ FHeaderList := TfrxHeaderList.Create;
+ FVHeaderList := TList.Create;
+ FVPageList := TList.Create;
+ FAggregates := TfrxAggregateList.Create(AReport);
+ FHBandNamesTree := TStringList.Create;
+ FLastBandOnPage := nil;
+ FFastCanvas := nil;
+ if frxCanvasClass <> nil then
+ FFastCanvas := frxCanvasClass.Create;
+end;
+
+destructor TfrxEngine.Destroy;
+begin
+ FHeaderList.Free;
+ FVHeaderList.Free;
+ FVPageList.Free;
+ FAggregates.Free;
+ FHBandNamesTree.Free;
+ if Assigned(FFastCanvas) then
+ FFastCanvas.Free;
+ inherited;
+end;
+
+function TfrxEngine.Initialize: Boolean;
+var
+ i, j: Integer;
+ b: TfrxDataBand;
+begin
+ FPrevFooterHeight := 0;
+ PreviewPages.Initialize;
+ PreviewPages.AddPageAction := apAdd;
+ StartDate := Date;
+ StartTime := Time;
+ Running := True;
+ FKeeping := False;
+ CurVColumn := 0;
+ FOutputTo := nil;
+
+ { clear all aggregate items }
+ FAggregates.Clear;
+
+ { add all report pages to the PreviewPages }
+ for i := 0 to Report.PagesCount - 1 do
+ if Report.Pages[i] is TfrxReportPage then
+ begin
+ { set the current page }
+ FPage := TfrxReportPage(Report.Pages[i]);
+ { create band tree for the current page }
+ PreparePage(Report.Errors, False);
+ PreparePage(Report.Errors, True);
+ end;
+
+ { check datasets used }
+ for i := 0 to Report.PagesCount - 1 do
+ if Report.Pages[i] is TfrxReportPage then
+ begin
+ FPage := TfrxReportPage(Report.Pages[i]);
+ if (Report.DataSet <> nil) and (Report.DataSet = FPage.DataSet) then
+ begin
+ Report.Errors.Add('Cannot use the same dataset for Report.DataSet and Page.DataSet');
+ break;
+ end;
+ for j := 0 to FPage.FSubBands.Count - 1 do
+ begin
+ b := FPage.FSubBands[j];
+ if (b <> nil) and (b.DataSet <> nil) then
+ if Report.DataSet = b.DataSet then
+ begin
+ Report.Errors.Add('Cannot use the same dataset for Report.DataSet and Band.DataSet');
+ break;
+ end
+ else if FPage.DataSet = b.DataSet then
+ begin
+ Report.Errors.Add('Cannot use the same dataset for Page.DataSet and Band.DataSet');
+ break;
+ end
+ end;
+ end;
+
+ Result := Report.Errors.Count = 0;
+end;
+
+procedure TfrxEngine.Finalize;
+begin
+ try
+ Report.DataSets.Finalize;
+ finally
+ PreviewPages.Finish;
+ Running := False;
+ end;
+end;
+
+function TfrxEngine.Run: Boolean;
+var
+ i: Integer;
+begin
+ Result := False;
+ try
+ if Initialize then
+ try
+ Report.DataSets.Initialize;
+ Report.DoNotifyEvent(Report, Report.OnStartReport);
+ if RunDialogs then
+ begin
+ Result := True;
+
+ { add all report pages to the PreviewPages }
+ for i := 0 to Report.PagesCount - 1 do
+ if Report.Pages[i] is TfrxReportPage then
+ begin
+ FPage := TfrxReportPage(Report.Pages[i]);
+ PreviewPages.AddSourcePage(FPage);
+ { find aggregates }
+ FAggregates.AddItems(FPage);
+ end;
+
+ { start the report }
+ FinalPass := not DoublePass;
+ TotalPages := 0;
+ PreviewPages.BeginPass;
+ RunReportPages;
+ if DoublePass then
+ begin
+ TotalPages := PreviewPages.Count;
+ PreviewPages.CurPage := PreviewPages.Count - 1;
+ PreviewPages.ClearFirstPassPages;
+ FAggregates.ClearValues;
+ FinalPass := True;
+ RunReportPages;
+ end;
+ end
+ finally
+ Report.DoNotifyEvent(Report, Report.OnStopReport);
+ end;
+ finally
+ Finalize;
+ end;
+end;
+
+{$HINTS OFF}
+function TfrxEngine.RunDialogs: Boolean;
+var
+ i: Integer;
+ p: TfrxDialogPage;
+ v: Variant;
+begin
+ Result := True;
+{$IFNDEF FR_VER_BASIC}
+ if Trim(Report.OnRunDialogs) <> '' then
+ begin
+ v := VarArrayOf([True]);
+ Report.DoParamEvent(Report.OnRunDialogs, v);
+ Result := v[0];
+ end
+ else
+ for i := 0 to Report.PagesCount - 1 do
+ if (Report.Pages[i] is TfrxDialogPage) and Report.Pages[i].Visible then
+ begin
+ p := TfrxDialogPage(Report.Pages[i]);
+ { refresh the border style - it was bsSizeable in the designer }
+ p.DialogForm.BorderStyle := p.BorderStyle;
+ { don't show empty form }
+ if p.DialogForm.ChildrenCount <> 0 then
+ begin
+ if Assigned(OnRunDialog) then
+ OnRunDialog(p) else
+ p.ShowModal;
+ if p.ModalResult = mrCancel then
+ begin
+ Result := False;
+ break;
+ end;
+ end;
+ end;
+{$ENDIF}
+end;
+{$HINTS ON}
+
+procedure TfrxEngine.RunReportPages;
+
+ procedure DoPages;
+ var
+ i: Integer;
+ begin
+ for i := 0 to Report.PagesCount - 1 do
+ if Report.Pages[i] is TfrxReportPage then
+ begin
+ FPage := TfrxReportPage(Report.Pages[i]);
+ { ignore subreport pages and invisible pages }
+ if not FPage.IsSubReport and FPage.Visible then
+ RunPage(FPage);
+ if Report.Terminated then break;
+ FFirstReportPage := False;
+ end;
+ end;
+
+begin
+ FFirstReportPage := True;
+ if Report.DataSet = nil then
+ DoPages
+ else
+ begin
+ Report.DataSet.First;
+ while not Report.DataSet.Eof do
+ begin
+ if Report.Terminated then break;
+ DoPages;
+ Report.DataSet.Next;
+ end;
+ end;
+end;
+
+procedure TfrxEngine.PreparePage(ErrorList: TStrings; PrepareVBands: Boolean);
+var
+ i, j, k: Integer;
+ t, c: TfrxComponent;
+ b: TfrxBand;
+ Bands: TList;
+ SortBands: TStringList;
+
+ procedure ClearNils;
+ var
+ i: Integer;
+ begin
+ i := 0;
+ while i < Bands.Count do
+ if Bands[i] = nil then
+ Bands.Delete(i) else
+ Inc(i);
+ end;
+
+ procedure MakeTree(Obj: TObject; From: Integer);
+ var
+ i: Integer;
+ b: TfrxBand;
+ begin
+ if Obj is TfrxReportPage then
+ begin
+ { fill the first level - TfrxReportPage.FMasterBands }
+ for i := 0 to Bands.Count - 1 do
+ begin
+ b := Bands[i];
+ if b = nil then continue;
+ if b is TfrxMasterData then
+ begin
+// if TfrxDataBand(b).DataSet <> nil then { ignore empty datasets }
+ if PrepareVBands then
+ TfrxReportPage(Obj).FVSubBands.Add(b)
+ else
+ TfrxReportPage(Obj).FSubBands.Add(b);
+ Bands[i] := nil;
+ MakeTree(b, i + 1);
+ end;
+ end;
+ end
+ else
+ begin
+ { fill next levels - TfrxBand.FSubBands }
+ for i := From to Bands.Count - 1 do
+ begin
+ b := Bands[i];
+ if b = nil then continue;
+ { looking for sub-level bands }
+ if b.BandNumber = TfrxBand(Obj).BandNumber + 1 then
+ begin
+// if TfrxDataBand(b).DataSet <> nil then { ignore empty datasets }
+ TfrxBand(Obj).FSubBands.Add(b);
+ Bands[i] := nil;
+ if not (b is TfrxDataBand6) then
+ MakeTree(b, i + 1);
+ end
+ else if b.BandNumber <= TfrxBand(Obj).BandNumber then
+ break; { found higher-level data band }
+ end;
+ end;
+ end;
+
+ procedure ConnectHeaders;
+ var
+ i: Integer;
+ b1, b2: TfrxBand;
+ begin
+ for i := 0 to Bands.Count - 1 do
+ begin
+ b1 := Bands[i];
+ { looking for data band }
+ if b1 is TfrxDataBand then
+ begin
+ if i > 0 then
+ begin
+ b2 := Bands[i - 1];
+ if b2 is TfrxHeader then { if top band is header, connect it }
+ begin
+ b1.FHeader := b2;
+ Bands[i - 1] := nil;
+ end;
+ end;
+
+ if i < Bands.Count - 1 then { if bottom band is footer, connect it }
+ begin
+ b2 := Bands[i + 1];
+ if b2 is TfrxFooter then
+ begin
+ b1.FFooter := b2;
+ Bands[i + 1] := nil;
+ end;
+ end;
+ end;
+ end;
+
+ ClearNils;
+ { now all headers/footers must be connected. If not, add an error }
+ for i := 0 to Bands.Count - 1 do
+ begin
+ b1 := Bands[i];
+ if (b1 is TfrxHeader) or (b1 is TfrxFooter) then
+ begin
+ ErrorList.Add(frxResources.Get('enUnconnHeader') + ' ' + b1.Name);
+ Bands[i] := nil;
+ end;
+ end;
+
+ ClearNils;
+ end;
+
+ procedure ConnectGroups;
+ var
+ i, j: Integer;
+ b1, b2: TfrxBand;
+ begin
+ { connect group headers }
+ i := 0;
+ while i < Bands.Count do
+ begin
+ b1 := Bands[i];
+ if b1 is TfrxGroupHeader then
+ begin
+ b1.FSubBands.Add(b1);
+ Inc(i);
+ { add all subsequent headers to the first header's FSubBands }
+ while (i < Bands.Count) and (TfrxBand(Bands[i]) is TfrxGroupHeader) do
+ begin
+ b1.FSubBands.Add(Bands[i]);
+ Inc(i);
+ end;
+
+ { search for databand }
+ while (i < Bands.Count) and not (TfrxBand(Bands[i]) is TfrxDataBand) do
+ Inc(i);
+
+ { now we expect to see the databand }
+ if (i = Bands.Count) or not (TObject(Bands[i]) is TfrxDataBand) then
+ ErrorList.Add(frxResources.Get('enUnconnGroup') + ' ' + b1.Name)
+ else
+ TfrxBand(Bands[i]).FGroup := b1;
+ end
+ else
+ Inc(i);
+ end;
+
+ { connect group footers }
+ for i := 0 to Bands.Count - 1 do
+ begin
+ b1 := Bands[i];
+ if b1 is TfrxGroupFooter then
+ for j := i - 1 downto 0 do
+ begin
+ b2 := Bands[j];
+ if b2 is TfrxGroupHeader then { connect to top-nearest header }
+ begin
+ b2.FFooter := b1;
+ Bands[i] := nil;
+ Bands[j] := nil;
+ break;
+ end;
+ end;
+ end;
+
+ { remove header bands from the list }
+ for i := 0 to Bands.Count - 1 do
+ begin
+ b1 := Bands[i];
+ if b1 is TfrxGroupHeader then
+ Bands[i] := nil;
+ end;
+
+ { looking for footers w/o corresponding header }
+ for i := 0 to Bands.Count - 1 do
+ begin
+ b1 := Bands[i];
+ if b1 is TfrxGroupFooter then
+ begin
+ ErrorList.Add(frxResources.Get('enUnconnGFooter') + ' ' + b1.Name);
+ Bands[i] := nil;
+ end;
+ end;
+
+ ClearNils;
+ end;
+
+begin
+ SortBands := TfrxStringList.Create;
+ SortBands.Sorted := True;
+
+ { align all objects with Align property <> baNone }
+ FPage.AlignChildren;
+
+ { clear all page SubBands }
+ if PrepareVBands then
+ FPage.FVSubBands.Clear
+ else
+ FPage.FSubBands.Clear;
+
+ for i := 0 to FPage.Objects.Count - 1 do
+ begin
+ t := FPage.Objects[i];
+ if t is TfrxBand then
+ begin
+ b := TfrxBand(t);
+ if b.Vertical <> PrepareVBands then
+ continue;
+ PrepareShiftTree(b);
+ b.FSubBands.Clear;
+ b.FHeader := nil;
+ b.FFooter := nil;
+ b.FGroup := nil;
+ b.FHasVBands := False;
+ if b is TfrxDataBand then
+ if (TfrxDataBand(b).DataSet = nil) and (TfrxDataBand(b).RowCount > 0) then
+ begin
+ TfrxDataBand(b).DataSet := TfrxDataBand(b).VirtualDataSet;
+ TfrxDataBand(b).DataSet.Initialize;
+ end;
+
+ { connect objects to vertical bands }
+ if (not PrepareVBands) and not (b is TfrxOverlay) then
+ for j := 0 to FPage.Objects.Count - 1 do
+ begin
+ t := FPage.Objects[j];
+ if (t is TfrxBand) and TfrxBand(t).Vertical then
+ begin
+ k := 0;
+ while k < b.Objects.Count do
+ begin
+ c := b.Objects[k];
+ if (c.Left >= t.Left - 1e-4) and
+ (c.Left + c.Width <= t.Left + t.Width + 1e-4) then
+ begin
+ b.FHasVBands := True;
+ c.Parent := t;
+ THackComponent(c).FOriginalBand := b;
+ c.Left := c.Left - t.Left;
+ end
+ else
+ Inc(k);
+ end;
+ end;
+ end;
+ end;
+ end;
+
+ { sort bands by position }
+ for i := 0 to FPage.Objects.Count - 1 do
+ begin
+ t := FPage.Objects[i];
+ if t is TfrxBand then
+ begin
+ b := TfrxBand(t);
+ if b.Vertical <> PrepareVBands then
+ continue;
+ if b.BandNumber in [4..13] then
+ if b.Vertical then
+ SortBands.AddObject(Format('%9.2f', [b.Left]), b)
+ else
+ SortBands.AddObject(Format('%9.2f', [b.Top]), b);
+ end;
+ end;
+
+ { copy sorted items to TList - it's easier to work with it }
+ Bands := TList.Create;
+ for i := 0 to SortBands.Count - 1 do
+ begin
+ t := TfrxComponent(SortBands.Objects[i]);
+ Bands.Add(t);
+ end;
+
+ SortBands.Free;
+
+ ConnectGroups;
+ ConnectHeaders;
+ MakeTree(FPage, 0);
+
+ ClearNils;
+ for i := 0 to Bands.Count - 1 do
+ begin
+ t := Bands[i];
+ ErrorList.Add(frxResources.Get('enBandPos') + ' ' + t.Name);
+ end;
+
+ Bands.Free;
+end;
+
+procedure TfrxEngine.PrepareShiftTree(Band: TfrxBand);
+var
+ i, j, k: Integer;
+ c0, c1, c2, top: TfrxReportComponent;
+ allObjects: TStringList;
+ Found: Boolean;
+ area0, area1, area2, area01: TfrxRectArea;
+begin
+ if Band.FShiftChildren.Count <> 0 then
+ Exit;
+
+ allObjects := TfrxStringList.Create;
+ allObjects.Duplicates := dupAccept;
+
+ { temporary top object }
+ top := TfrxMemoView.Create(nil);
+ top.SetBounds(0, Band.Top-2, Band.Width, 1);
+
+ { sort objects }
+ for i := 0 to Band.Objects.Count - 1 do
+ begin
+ c0 := Band.Objects[i];
+ allObjects.AddObject(Format('%9.2f', [c0.Top]), c0);
+ c0.FShiftChildren.Clear;
+ end;
+ allObjects.Sort;
+ allObjects.InsertObject(0, Format('%10.2f', [top.Top]), top);
+
+ for i := 0 to allObjects.Count - 1 do
+ begin
+ c0 := TfrxReportComponent(allObjects.Objects[i]);
+ area0 := TfrxRectArea.Create(c0);
+
+ { find an object under c0 }
+ for j := i + 1 to allObjects.Count - 1 do
+ begin
+ c1 := TfrxReportComponent(allObjects.Objects[j]);
+ area1 := TfrxRectArea.Create(c1);
+
+ if not (area0.InterceptsY(area1)) and (area0.Y < area1.Y) and
+ area0.InterceptsX(area1) then
+ begin
+ area01 := area0.InterceptX(area1);
+ Found := False;
+
+ { check if there is no other objects between c1 and c0 }
+ for k := j - 1 downto i + 1 do
+ begin
+ c2 := TfrxReportComponent(allObjects.Objects[k]);
+ area2 := TfrxRectArea.Create(c2);
+
+ if not (area0.InterceptsY(area2)) and not (area1.InterceptsY(area2)) and
+ area01.InterceptsX(area2) then
+ Found := True;
+
+ area2.Free;
+ if Found then
+ break;
+ end;
+
+ if not Found then
+ c0.FShiftChildren.Add(c1);
+
+ area01.Free;
+ end;
+
+ area1.Free;
+ end;
+
+ area0.Free;
+ end;
+
+ { copy children from the top object to the band }
+ Band.FShiftChildren.Clear;
+ for i := 0 to top.FShiftChildren.Count - 1 do
+ Band.FShiftChildren.Add(top.FShiftChildren[i]);
+
+ allObjects.Free;
+ top.Free;
+end;
+
+function TfrxEngine.CanShow(Obj: TObject; PrintIfDetailEmpty: Boolean): Boolean;
+var
+ i: Integer;
+ Bands: TList;
+ b: TfrxDataBand;
+ res: Boolean;
+begin
+ if Obj is TfrxReportPage then
+ Bands := TfrxReportPage(Obj).FSubBands else
+ Bands := TfrxBand(Obj).FSubBands;
+
+ Result := True;
+ { Check all subdetail bands to ensure they all have records }
+ if not PrintIfDetailEmpty then
+ begin
+ Result := False;
+ if (Bands.Count = 0) and not (Obj is TfrxPage) then
+ Result := True;
+
+ for i := 0 to Bands.Count - 1 do
+ begin
+ b := Bands[i];
+ if b.DataSet <> nil then
+ begin
+ Report.DoNotifyEvent(b, b.OnMasterDetail);
+ b.DataSet.First;
+
+ while not b.DataSet.Eof do
+ begin
+ res := CanShow(b, b.PrintIfDetailEmpty);
+ if res then
+ begin
+ Result := True;
+ break;
+ end
+ else
+ b.DataSet.Next;
+ end;
+ end;
+ end;
+ end;
+end;
+
+procedure TfrxEngine.ResetSuppressValues(Band: TfrxBand);
+var
+ i: Integer;
+begin
+ for i := 0 to Band.Objects.Count - 1 do
+ if TObject(Band.Objects[i]) is TfrxCustomMemoView then
+ THackMemoView(Band.Objects[i]).FLastValue := Null;
+end;
+
+procedure TfrxEngine.InitGroups(Master: TfrxDataBand; Band: TfrxGroupHeader;
+ Index: Integer; ResetLineN: Boolean = False);
+var
+ i: Integer;
+ b: TfrxGroupHeader;
+begin
+ for i := Index to Band.FSubBands.Count - 1 do
+ begin
+ b := Band.FSubBands[i];
+ if ResetLineN then
+ begin
+ b.FLineN := 1;
+ b.FLineThrough := 1;
+ ResetSuppressValues(b);
+ end
+ else
+ begin
+ Inc(b.FLineN);
+ if i < Band.FSubBands.Count - 1 then
+ TfrxBand(Band.FSubBands[i + 1]).FLineN := 0;
+ Inc(b.FLineThrough);
+ end;
+ end;
+
+ CheckDrill(Master, Band);
+
+ for i := Index to Band.FSubBands.Count - 1 do
+ begin
+ b := Band.FSubBands[i];
+ CurLine := b.FLineN;
+ CurLineThrough := b.FLineThrough;
+ Report.CurObject := b.Name;
+ b.FLastValue := Report.Calc(b.Condition);
+ if b.KeepTogether then
+ StartKeep(b);
+ ShowBand(b);
+ AddBandOutline(b);
+ if b.Vertical then
+ AddToVHeaderList(b)
+ else
+ AddToHeaderList(b);
+ end;
+end;
+
+procedure TfrxEngine.ShowGroupFooters(Band: TfrxGroupHeader; Index: Integer;
+ Master: TfrxDataBand);
+var
+ i: Integer;
+ b: TfrxGroupHeader;
+begin
+ for i := Band.FSubBands.Count - 1 downto Index do
+ begin
+ b := Band.FSubBands[i];
+ if b.FFooter <> nil then
+ if not TfrxGroupFooter(b.FFooter).HideIfSingleDataRecord or (Master.FLineN > 2) then
+ ShowBand(b.FFooter)
+ else
+ FAggregates.Reset(b.FFooter);
+
+ OutlineUp(b);
+ if b.Vertical then
+ RemoveFromVHeaderList(b)
+ else
+ RemoveFromHeaderList(b);
+ if b.KeepTogether then
+ EndKeep(b);
+ end;
+end;
+
+procedure TfrxEngine.CheckDrill(Master: TfrxDataBand; Band: TfrxGroupHeader);
+var
+ i, j: Integer;
+ b, b1: TfrxGroupHeader;
+ drillVisible: Boolean;
+ BandNamesList: TStrings;
+begin
+ BandNamesList := FHBandNamesTree;
+
+ for i := 0 to Band.FSubBands.Count - 1 do
+ begin
+ b := Band.FSubBands[i];
+ if b.DrillDown then
+ begin
+ b.DrillName := '';
+ for j := 0 to BandNamesList.Count - 1 do
+ b.DrillName := b.DrillName + BandNamesList[j] + '.' + IntToStr(Integer(BandNamesList.Objects[j])) + '.';
+ b.DrillName := b.DrillName + b.Name + '.' + IntToStr(b.FLineThrough);
+ drillVisible := Report.DrillState.IndexOf(b.DrillName) <> -1;
+ if b.ExpandDrillDown then
+ drillVisible := not DrillVisible;
+ if (b.Child <> nil) and not Band.ShowChildIfDrillDown then
+ b.Child.Visible := drillVisible;
+ for j := i + 1 to Band.FSubBands.Count - 1 do
+ begin
+ b1 := Band.FSubBands[j];
+ b1.Visible := drillVisible;
+ if b1.FFooter <> nil then
+ b1.FFooter.Visible := drillVisible;
+ end;
+ Master.Visible := drillVisible;
+ if not b.ShowFooterIfDrillDown and (b.FFooter <> nil) then
+ b.FFooter.Visible := drillVisible;
+ if not drillVisible then
+ break;
+ end;
+ end;
+end;
+
+procedure TfrxEngine.CheckGroups(Master: TfrxDataBand; Band: TfrxGroupHeader;
+ ColumnKeepPos: Integer; SaveCurY: Extended);
+var
+ i: Integer;
+ b: TfrxGroupHeader;
+ NextNeeded: Boolean;
+begin
+ CheckDrill(Master, Band);
+
+ for i := 0 to Band.FSubBands.Count - 1 do
+ begin
+ b := Band.FSubBands[i];
+
+ Report.CurObject := b.Name;
+ if Report.Calc(b.Condition) <> b.FLastValue then
+ begin
+ Master.CurColumn := Master.Columns;
+ CheckBandColumns(Master, ColumnKeepPos, SaveCurY);
+
+ { avoid exception in uni-directional datasets }
+ NextNeeded := True;
+ try
+ Master.DataSet.Prior;
+ except
+ NextNeeded := False;
+ end;
+ ShowGroupFooters(Band, i, Master);
+ if NextNeeded then
+ Master.DataSet.Next;
+
+ InitGroups(Master, Band, i);
+ Master.FLineN := 1;
+ ResetSuppressValues(Master);
+ break;
+ end;
+ end;
+end;
+
+procedure TfrxEngine.CheckBandColumns(Band: TfrxDataBand; ColumnKeepPos: Integer;
+ SaveCurY: Extended);
+begin
+ if Band.Columns > 1 then
+ begin
+ { collect max position in b.FMaxY }
+ if CurY > Band.FMaxY then
+ Band.FMaxY := CurY;
+ { all columns have been printed }
+ if Band.CurColumn >= Band.Columns then
+ begin
+ { need page break, don't break if page has Endless Height}
+ if ((PageHeight - FooterHeight) - Band.FMaxY <= 1e-4) and (not FPage.EndlessHeight) then
+ begin
+ if FKeeping then { standard keep procedure }
+ NewColumn
+ else
+ begin
+ PreviewPages.CutObjects(ColumnKeepPos);
+ NewColumn;
+ PreviewPages.PasteObjects(CurX, CurY);
+ CurY := CurY + Band.FMaxY - SaveCurY;
+ end;
+ end
+ else
+ CurY := Band.FMaxY; { start the new band from saved b.FMaxY }
+ end
+ else
+ CurY := SaveCurY; { start the new band from saved SaveCurY }
+ if Band.Visible then
+ Band.CurColumn := Band.CurColumn + 1;
+ end;
+end;
+
+procedure TfrxEngine.NotifyObjects(Band: TfrxBand);
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ for i := 0 to NotifyList.Count - 1 do
+ begin
+ c := NotifyList[i];
+ if c <> nil then
+ c.OnNotify(Band);
+ end;
+end;
+
+procedure TfrxEngine.RunPage(Page: TfrxReportPage);
+var
+ PageCount: Integer;
+{$IFNDEF MSWINDOWS}
+ bIDLE: Boolean;
+{$ENDIF}
+ { "Null" band contains all free-placed objects that don't have a parent band }
+ procedure ShowNullBand;
+ var
+ i: Integer;
+ b: TfrxNullBand;
+ SaveCurY: Extended;
+ begin
+ b := TfrxNullBand.Create(nil);
+ b.Width := PageWidth;
+ b.Height := PageHeight;
+ SaveCurY := CurY;
+ for i := 0 to FPage.Objects.Count - 1 do
+ if not (TObject(FPage.Objects[i]) is TfrxBand) then
+ b.Objects.Add(FPage.Objects[i]);
+ try
+ b.AlignChildren;
+ ShowBand(b);
+ finally
+ CurY := SaveCurY;
+ b.Objects.Clear;
+ b.Free;
+ end;
+ end;
+
+ { Band tree is the structure that we created in the PreparePage method }
+ procedure ShowBandTree(Obj: TObject);
+ var
+ i: Integer;
+ Bands: TList;
+ b: TfrxDataBand;
+ FirstTime: Boolean;
+ FooterKeepPos, ColumnKeepPos: Integer;
+ SaveCurY: Extended;
+ begin
+ if not Report.EngineOptions.EnableThreadSafe then
+{$IFDEF MSWINDOWS}
+ Application.ProcessMessages;
+{$ELSE}
+ Application.DoIdle(bIDLE);
+{$ENDIF}
+ if Report.Terminated then Exit;
+
+ FooterKeepPos := 0;
+ ColumnKeepPos := 0;
+ SaveCurY := CurY;
+ if Obj is TfrxReportPage then
+ Bands := TfrxReportPage(Obj).FSubBands else
+ Bands := TfrxBand(Obj).FSubBands;
+
+ for i := 0 to Bands.Count - 1 do
+ begin
+ b := Bands[i];
+ if b.DataSet = nil then
+ continue;
+ b.DataSet.First;
+ b.FLineN := 1;
+ b.FLineThrough := 1;
+ b.CurColumn := 1;
+ FirstTime := True;
+ ResetSuppressValues(b);
+
+ while not b.DataSet.Eof do
+ begin
+ if CanShow(b, b.PrintIfDetailEmpty) then
+ begin
+ if FirstTime then
+ begin
+ if b.KeepHeader and (b.FHeader <> nil) then
+ begin
+ if FIsFirstBand then
+ FIsFirstBand := not FTitlePrinted;
+ FKeepHeader := not FIsFirstBand;
+ StartKeep(b);
+ end;
+ AddToHeaderList(b.FHeader);
+ ShowBand(b.FHeader);
+ if b.KeepTogether then
+ StartKeep(b);
+
+ end
+ { keeping a master-detail differs from keeping a group }
+ else if (b.FGroup = nil) and b.KeepTogether then
+ StartKeep(b);
+
+ if b.FGroup <> nil then
+ if FirstTime then
+ InitGroups(b, TfrxGroupHeader(b.FGroup), 0, True) else
+ CheckGroups(b, TfrxGroupHeader(b.FGroup), ColumnKeepPos, SaveCurY);
+
+ if b.KeepFooter then
+ FooterKeepPos := PreviewPages.GetCurPosition;
+ if (b.Columns > 1) and (b.CurColumn = 1) then
+ ColumnKeepPos := PreviewPages.GetCurPosition;
+
+ SaveCurY := CurY;
+ CurLine := b.FLineN;
+ CurLineThrough := b.FLineThrough;
+ ShowBand(b);
+ FKeepHeader := False;
+ NotifyObjects(b);
+
+ if FirstTime then
+ if b.KeepHeader and (b.FHeader <> nil) then
+ EndKeep(b);
+ FirstTime := False;
+
+ FHBandNamesTree.AddObject(b.Name, TObject(b.FLineThrough));
+ Inc(b.FLineN);
+ Inc(b.FLineThrough);
+ CheckBandColumns(b, ColumnKeepPos, SaveCurY);
+ AddBandOutline(b);
+ ShowBandTree(b);
+ FHBandNamesTree.Delete(FHBandNamesTree.Count - 1);
+ OutlineUp(b);
+
+ FIsFirstBand := False;
+
+ if b.FooterAfterEach then
+ ShowBand(b.FFooter);
+ end;
+
+ { keeping a master-detail differs from keeping a group }
+ if (b.FGroup = nil) and b.KeepTogether then
+ EndKeep(b);
+ b.DataSet.Next;
+ if b.RowCount <> 0 then
+ if b.FLineN > b.RowCount then break;
+
+ if Report.Terminated then break;
+ end;
+
+ { update the CurY if band is multicolumn }
+ b.CurColumn := b.Columns;
+ CheckBandColumns(b, ColumnKeepPos, SaveCurY);
+
+ if not FirstTime then { some bands have been printed }
+ begin
+ if b.FGroup <> nil then
+ ShowGroupFooters(TfrxGroupHeader(b.FGroup), 0, b);
+
+ if FKeeping then
+ RemoveFromHeaderList(b.FHeader);
+
+ if not b.FooterAfterEach then
+ begin
+ if b.KeepFooter then
+ StartKeep(b, FooterKeepPos);
+ FKeepFooter := True;
+ ShowBand(b.FFooter);
+ if b.KeepFooter then
+ EndKeep(b);
+ FKeepFooter := False;
+ end;
+ RemoveFromHeaderList(b.FHeader);
+ if (b.FGroup <> nil) and b.KeepTogether then
+ EndKeep(b);
+ end;
+
+ if Report.Terminated then break;
+ FIsFirstBand := False;
+ end;
+ end;
+
+ procedure ShowPage;
+ var
+ pgWidth, pgHeight: Extended;
+ begin
+ if CanShow(FPage, Report.EngineOptions.PrintIfEmpty) then
+ begin
+ InitPage;
+ ShowNullBand;
+
+ if Assigned(Report.OnManualBuild) then
+ Report.OnManualBuild(FPage)
+ else if Trim(FPage.OnManualBuild) <> '' then
+ Report.DoNotifyEvent(FPage, FPage.OnManualBuild)
+ else
+ ShowBandTree(FPage);
+ FIsLastPage := True;
+ if FPage.EndlessHeight or FPage.EndlessWidth then
+ begin
+ if FPage.EndlessWidth then
+ pgWidth := PageWidth + FPage.LeftMargin * fr01cm + FPage.RightMargin * fr01cm
+ else
+ pgWidth := FPage.PaperWidth * fr01cm;
+ if FPage.EndlessHeight then
+ begin
+ PageHeight := CurY + FooterHeight;
+ pgHeight := PageHeight + FPage.TopMargin * fr01cm + FPage.BottomMargin * fr01cm
+ end
+ else
+ pgHeight := FPage.PaperHeight * fr01cm;
+ TfrxPreviewPages(PreviewPages).UpdatePageDimensions(FPage, pgWidth, pgHeight);
+ end;
+
+ EndPage;
+ FIsLastPage := False;
+ end;
+ end;
+
+begin
+ { The Page parameter needed only for subreport pages. General is FPage }
+ if Page.IsSubReport then
+ begin
+ ShowBandTree(Page);
+ Exit;
+ end;
+
+ FIsFirstBand := True;
+ Report.DoNotifyEvent(FPage, FPage.OnBeforePrint);
+
+ if FPage.DataSet <> nil then
+ begin
+ FPage.DataSet.First;
+
+ while not FPage.DataSet.Eof do
+ begin
+ if Report.Terminated then break;
+ ShowPage;
+ FPage.DataSet.Next;
+ end;
+ end
+ else
+ for PageCount := 1 to FPage.PageCount do
+ begin
+ if Report.Terminated then break;
+ ShowPage;
+ end;
+
+ Report.DoNotifyEvent(FPage, FPage.OnAfterPrint);
+end;
+
+procedure TfrxEngine.ShowVBands(HBand: TfrxBand);
+var
+ SavePageNo: Integer;
+ procedure ShowBandTree(Bands: TList);
+ var
+ i: Integer;
+ b: TfrxDataBand;
+ FirstTime: Boolean;
+ begin
+ if Report.Terminated then Exit;
+
+ for i := 0 to Bands.Count - 1 do
+ begin
+ b := Bands[i];
+ if b.DataSet = nil then
+ continue;
+ b.DataSet.First;
+ b.FLineN := 1;
+ b.FLineThrough := 1;
+ b.CurColumn := 1;
+ CurLine := b.FLineN;
+ CurLineThrough := b.FLineThrough;
+ FirstTime := True;
+ ResetSuppressValues(b);
+
+ while not b.DataSet.Eof do
+ begin
+ if FirstTime then
+ begin
+ ShowBand(b.FHeader);
+ AddToVHeaderList(b.FHeader);
+ end;
+
+ if b.FGroup <> nil then
+ if FirstTime then
+ InitGroups(b, TfrxGroupHeader(b.FGroup), 0, True) else
+ CheckGroups(b, TfrxGroupHeader(b.FGroup), 0, 0);
+
+ FirstTime := False;
+
+ CurLine := b.FLineN;
+ CurLineThrough := b.FLineThrough;
+ ShowBand(b);
+ NotifyObjects(b);
+ Inc(b.FLineN);
+ Inc(b.FLineThrough);
+ ShowBandTree(b.FSubBands);
+
+ if b.FooterAfterEach then
+ ShowBand(b.FFooter);
+
+ b.DataSet.Next;
+ if b.RowCount <> 0 then
+ if b.FLineN > b.RowCount then break;
+ if Report.Terminated then break;
+ end;
+
+ if b.FGroup <> nil then
+ ShowGroupFooters(TfrxGroupHeader(b.FGroup), 0, b);
+
+ if not FirstTime then { some bands have been printed }
+ begin
+ RemoveFromVHeaderList(b.FHeader);
+ if not b.FooterAfterEach then
+ ShowBand(b.FFooter);
+ end;
+
+ if Report.Terminated then break;
+ end;
+ end;
+
+begin
+ FVMasterBand := HBand;
+ FVMasterBand.FOriginalObjectsCount := FVMasterBand.Objects.Count;
+ FVMasterBand.AllowSplit := False;
+ SavePageNo := PreviewPages.CurPage;
+ FVHeaderList.Clear;
+ FVPageList.Clear;
+ FVPageList.Add(Pointer(0));
+
+ CurVColumn := 0;
+ ShowBandTree(TfrxReportPage(HBand.Page).FVSubBands);
+ FVPageList.Add(Pointer(FVMasterBand.Objects.Count));
+ PreviewPages.CurPage := SavePageNo;
+end;
+
+procedure TfrxEngine.InitPage;
+begin
+ { fill in the header/footer lists }
+ FHeaderList.Clear;
+ if FPage.TitleBeforeHeader then
+ begin
+ FHeaderList.AddItem(FindBand(TfrxReportTitle), 0, False);
+ FHeaderList.AddItem(FindBand(TfrxPageHeader), 0, False);
+ end
+ else
+ begin
+ FHeaderList.AddItem(FindBand(TfrxPageHeader), 0, False);
+ FHeaderList.AddItem(FindBand(TfrxReportTitle), 0, False);
+ end;
+
+ { calculating the page/footer sizes }
+ PageHeight := FPage.PaperHeight * fr01cm - FPage.TopMargin * fr01cm -
+ FPage.BottomMargin * fr01cm;
+ PageWidth := FPage.PaperWidth * fr01cm - FPage.LeftMargin * fr01cm -
+ FPage.RightMargin * fr01cm;
+
+ { reset the current position }
+ CurX := 0;
+ CurY := 0;
+ CurColumn := 1;
+ FPageCurX := 0;
+ FVMasterBand := nil;
+
+ FIsFirstPage := True;
+ FIsLastPage := False;
+ OutlineRoot;
+ if FPage.ResetPageNumbers then
+ PreviewPages.ResetLogicalPageNumber;
+
+ if (PreviewPages.Count = 0) or not FPage.PrintOnPreviousPage then
+ AddPage
+ else
+ begin
+ PreviewPages.CurPage := PreviewPages.Count - 1;
+ CurY := PreviewPages.GetLastY;
+ RemoveFromHeaderList(FindBand(TfrxReportTitle));
+ ShowBand(TfrxReportTitle);
+ end;
+
+ if FFirstReportPage then
+ PreviewPages.FirstPage := PreviewPages.CurPage;
+ FFirstColumnY := CurY;
+ ShowBand(TfrxColumnHeader);
+ FHeaderList.AddItem(FindBand(TfrxColumnHeader), 0, False);
+ RemoveFromHeaderList(FindBand(TfrxReportTitle));
+ AddPageOutline;
+end;
+
+function TfrxEngine.HeaderHeight: Double;
+var
+ Band: TfrxBand;
+begin
+ Result := 0;
+
+ Band := FindBand(TfrxColumnHeader);
+ while Band <> nil do
+ begin
+ Result := Result + Band.Height;
+ Band := Band.Child;
+ end;
+ Band := FindBand(TfrxPageHeader);
+ while Band <> nil do
+ begin
+ Result := Result + Band.Height;
+ Band := Band.Child;
+ end;
+end;
+
+function TfrxEngine.FooterHeight: Double;
+var
+ Band: TfrxBand;
+begin
+ Result := 0;
+
+ Band := FindBand(TfrxColumnFooter);
+ if Band <> nil then
+ Result := Result + Band.Height;
+ Band := FindBand(TfrxPageFooter);
+ if Band <> nil then
+ Result := Result + Band.Height;
+end;
+
+function TfrxEngine.FindBand(Band: TfrxBandClass): TfrxBand;
+begin
+ Result := FPage.FindBand(Band);
+end;
+
+procedure TfrxEngine.ShowBand(Band: TfrxBand);
+var
+ chBand: TfrxBand;
+begin
+ if Band <> nil then
+ begin
+ if Band.KeepChild then
+ StartKeep(Band);
+ DoShow(Band);
+ if (Band is TfrxDataBand) and (TfrxDataBand(Band).CurColumn > 1) then { dont show childs for columns}
+ chBand := nil
+ else
+ chBand := Band.Child;
+ if (chBand <> nil) and (Band.Visible or Band.PrintChildIfInvisible) then
+ ShowBand(chBand);
+ if Band.KeepChild then
+ EndKeep(Band);
+ if Band is TfrxDataBand then
+ FAggregates.AddValue(Band);
+ end;
+end;
+
+procedure TfrxEngine.ShowBand(Band: TfrxBandClass);
+begin
+ ShowBand(FindBand(Band));
+end;
+
+procedure TfrxEngine.AddToHeaderList(Band: TfrxBand);
+begin
+ { only header bands with "Reprint on new page" flag can be added }
+ if ((Band is TfrxHeader) and TfrxHeader(Band).ReprintOnNewPage) or
+ ((Band is TfrxGroupHeader) and TfrxGroupHeader(Band).ReprintOnNewPage) then
+ FHeaderList.AddItem(Band, FPageCurX, FKeeping and not (Band is TfrxHeader));
+end;
+
+procedure TfrxEngine.AddToVHeaderList(Band: TfrxBand);
+begin
+ { only header bands with "Reprint on new page" flag can be added }
+ if ((Band is TfrxHeader) and TfrxHeader(Band).ReprintOnNewPage) or
+ ((Band is TfrxGroupHeader) and TfrxGroupHeader(Band).ReprintOnNewPage) then
+ FVHeaderList.Add(Band);
+end;
+
+procedure TfrxEngine.BreakAllKeep;
+begin
+ inherited;
+ FKeepCurY := 0;
+ FKeeping := False;
+ FKeepBand := nil;
+ FAggregates.EndKeep;
+ FKeepHeader := False;
+end;
+
+procedure TfrxEngine.RemoveFromHeaderList(Band: TfrxBand);
+begin
+ if Band <> nil then
+ FHeaderList.RemoveItem(Band);
+end;
+
+procedure TfrxEngine.RemoveFromVHeaderList(Band: TfrxBand);
+begin
+ if Band <> nil then
+ FVHeaderList.Remove(Band);
+end;
+
+function TfrxEngine.FreeSpace: Double;
+begin
+ if FPage.EndlessHeight then
+ Result := 1e+6
+ else
+ if FPrevFooterHeight <> 0 then
+ Result := PageHeight - FPrevFooterHeight - CurY
+ else Result := PageHeight - FooterHeight - CurY;
+end;
+
+procedure TfrxEngine.Stretch(Band: TfrxBand);
+var
+ i: Integer;
+ h, maxh: Extended;
+ c, maxc: TfrxView;
+ HaveSub, NeedShift: Boolean;
+
+ procedure DoSubReports;
+ var
+ i: Integer;
+ SaveCurX, SaveCurY, SavePageCurX: Extended;
+ Sub: TfrxSubreport;
+ MainBand: Boolean;
+ AllObjects: TList;
+ c: TfrxComponent;
+ begin
+ { create a band which will accepts all subsequent output }
+ MainBand := False;
+ if FOutputTo = nil then
+ begin
+ Band.FOriginalObjectsCount := Band.Objects.Count;
+ FOutputTo := TfrxNullBand.Create(nil);
+ MainBand := True;
+ end;
+
+ { save the current position }
+ SaveCurX := CurX;
+ SaveCurY := CurY;
+ SavePageCurX := FPageCurX;
+
+ { looking for subreport objects }
+ for i := 0 to Band.Objects.Count - 1 do
+ if TObject(Band.Objects[i]) is TfrxSubreport then
+ begin
+ Sub := TfrxSubreport(Band.Objects[i]);
+ if not Sub.Visible or not Sub.PrintOnParent or not MainBand then continue;
+
+ { set up all properties... }
+ FPageCurX := SavePageCurX + Sub.Left;
+ CurX := Sub.Left;
+ CurY := Sub.Top;
+ { ...and run the subreport }
+ RunPage(Sub.Page);
+ end;
+
+ { restore saved position }
+ CurX := SaveCurX;
+ CurY := SaveCurY;
+ FPageCurX := SavePageCurX;
+
+ if MainBand then
+ begin
+ { copy all output to the band }
+ AllObjects := FOutputTo.AllObjects;
+
+ for i := 0 to AllObjects.Count - 1 do
+ begin
+ c := AllObjects[i];
+ if (c is TfrxView) and not (c is TfrxSubreport) then
+ begin
+ c.Left := c.AbsLeft;
+ c.Top := c.AbsTop;
+ c.ParentFont := False;
+ c.Parent := Band;
+ end;
+ if c is TfrxStretcheable then
+ TfrxStretcheable(c).StretchMode := smDontStretch;
+ end;
+
+ { Clear the FOutputTo property. Extra objects will be freed
+ in the Unstretch method. }
+ FOutputTo.Free;
+ FOutputTo := nil;
+ end;
+ end;
+
+ procedure ShiftObjects(Parent: TfrxReportComponent; Amount: Extended);
+ var
+ i: Integer;
+ v: TfrxView;
+ diff: Extended;
+ begin
+ for i := 0 to Parent.FShiftChildren.Count - 1 do
+ begin
+ v := Parent.FShiftChildren[i];
+ if v.ShiftMode = smAlways then
+ begin
+ v.Top := v.Top + Amount;
+ ShiftObjects(v, Amount + v.FShiftAmount);
+ end
+ else if v.ShiftMode = smWhenOverlapped then
+ begin
+ if not (Parent is TfrxBand) and (v.Top < Parent.Top + Parent.Height) then
+ begin
+ diff := Parent.Top + Parent.Height - v.Top;
+ v.Top := Parent.Top + Parent.Height;
+ ShiftObjects(v, diff + v.FShiftAmount);
+ end
+ else
+ ShiftObjects(v, v.FShiftAmount);
+ end
+ else {if v.FShiftAmount <> 0 then}
+ ShiftObjects(v, Amount + v.FShiftAmount);
+
+ v.FShiftAmount := 0;
+ end;
+ end;
+
+begin
+ FCurBand := Band;
+ HaveSub := False;
+ NeedShift := False;
+ PrepareShiftTree(Band);
+
+ { it is not necessary for vertical bands }
+ if Band <> FVMasterBand then
+ begin
+ { firing band OnBeforePrint event }
+ Report.CurObject := Band.Name;
+ Band.BeforePrint;
+ Report.DoBeforePrint(Band);
+ end;
+
+ { firing OnBeforePrint events, stretching objects }
+ for i := 0 to Band.Objects.Count - 1 do
+ begin
+ c := Band.Objects[i];
+ if (c is TfrxSubreport) and TfrxSubreport(c).PrintOnParent then
+ HaveSub := True;
+
+ { skip getdata for vertical bands' objects }
+ if (Band <> FVMasterBand) or (i < Band.FOriginalObjectsCount) then
+ begin
+ Report.CurObject := c.Name;
+ c.BeforePrint;
+ if Band.Visible then
+ begin
+ Report.DoBeforePrint(c);
+ if c.Visible then
+ begin
+ c.GetData;
+ Report.DoNotifyEvent(c, c.OnAfterData);
+ end;
+ end;
+ end;
+ if not Band.Visible or not c.Visible then continue;
+
+ if (c is TfrxStretcheable) and (TfrxStretcheable(c).StretchMode <> smDontStretch) then
+ begin
+ TfrxStretcheable(c).SetFastCanvas(TfrxFastCanvaslayer(FFastCanvas));
+ h := TfrxStretcheable(c).CalcHeight;
+ TfrxStretcheable(c).SetFastCanvas(nil);
+ if h > c.Height then
+ begin
+ c.FShiftAmount := h - c.Height; { needed to shift underlying objects }
+ c.Height := h; { stretch the object }
+ NeedShift := True;
+ end
+ else
+ c.FShiftAmount := 0;
+ end;
+ end;
+
+ if not Band.Visible then Exit;
+
+ { shift objects }
+ if NeedShift then
+ ShiftObjects(Band, 0);
+
+ { check subreports that have PrintOnParent option }
+ if HaveSub then
+ DoSubReports;
+
+ { calculate the max height of the band }
+ maxh := 0;
+ maxc := nil;
+ for i := 0 to Band.Objects.Count - 1 do
+ begin
+ c := Band.Objects[i];
+ if c.Top + c.Height > maxh then
+ begin
+ maxh := c.Top + c.Height;
+ maxc := c;
+ end;
+ end;
+ if (maxc <> nil) and (maxc is TfrxDMPMemoView) and
+ (ftBottom in TfrxDMPMemoView(maxc).Frame.Typ) then
+ maxh := maxh + fr1CharY;
+ if Band.Stretched then
+ Band.Height := maxh;
+
+ { fire Band.OnAfterCalcHeight event }
+ Report.CurObject := Band.Name;
+ Report.DoNotifyEvent(Band, Band.OnAfterCalcHeight);
+
+ { set the height of objects that should stretch to max height }
+ for i := 0 to Band.Objects.Count - 1 do
+ begin
+ c := Band.Objects[i];
+ if (c is TfrxStretcheable) and (TfrxStretcheable(c).StretchMode = smMaxHeight) then
+ begin
+ c.Height := maxh - c.Top;
+ if (c is TfrxDMPMemoView) and (ftBottom in TfrxDMPMemoView(c).Frame.Typ) then
+ c.Height := c.Height - fr1CharY;
+ end;
+ end;
+end;
+
+procedure TfrxEngine.UnStretch(Band: TfrxBand);
+var
+ i: Integer;
+ c: TfrxView;
+begin
+ { fire OnAfterPrint event }
+ if Band.Visible then
+ for i := 0 to Band.Objects.Count - 1 do
+ begin
+ c := Band.Objects[i];
+ Report.CurObject := c.Name;
+ Report.DoAfterPrint(c);
+ end;
+
+ { restore state }
+
+ for i := 0 to Band.Objects.Count - 1 do
+ if (Band <> FVMasterBand) or (i < Band.FOriginalObjectsCount) then
+ begin
+ c := Band.Objects[i];
+ c.AfterPrint;
+ end
+ else break;
+
+
+ Report.CurObject := Band.Name;
+ Report.DoAfterPrint(Band);
+ Band.AfterPrint;
+
+ { remove extra band objects if any }
+ if Band.FOriginalObjectsCount <> -1 then
+ begin
+ while Band.Objects.Count > Band.FOriginalObjectsCount do
+ TObject(Band.Objects[Band.Objects.Count - 1]).Free;
+ Band.FOriginalObjectsCount := -1;
+ end;
+end;
+
+procedure TfrxEngine.AddPage;
+var
+ i: Integer;
+ SaveCurX: Extended;
+ SaveCurLine, SaveCurLineThrough: Integer;
+ Band: TfrxBand;
+ IsHeaderBand: Boolean;
+begin
+ FPrevFooterHeight := 0;
+ PreviewPages.AddPage(FPage);
+ CurY := 0;
+ Band := FindBand(TfrxOverlay);
+ if (Band <> nil) and not TfrxOverlay(Band).PrintOnTop then
+ ShowBand(Band);
+
+ CurY := 0;
+ SaveCurX := CurX;
+ FFirstColumnY := 0;
+
+ for i := 0 to FHeaderList.Count - 1 do
+ begin
+ { use own CurX - we may be inside subreports now }
+ CurX := FHeaderList[i].Left;
+ Band := FHeaderList[i].Band;
+ if Band = FStartNewPageBand then
+ continue;
+
+ if FIsFirstPage and (Band is TfrxPageHeader) and
+ not TfrxPageHeader(Band).PrintOnFirstPage then
+ begin
+ if Band.PrintChildIfInvisible then
+ Band := Band.Child
+ else
+ continue;
+ end;
+
+ IsHeaderBand := (Band is TfrxHeader);
+ if Band <> nil then
+ if not (FKeepHeader and IsHeaderBand) and not FHeaderList[i].IsInKeepList or FKeepFooter
+ {or (FKeeping and (FKeepBand.FHeader = Band))} then
+ begin
+ if (IsHeaderBand and FDontShowHeaders) or (IsHeaderBand and (FLastBandOnPage = Band)) or
+ ((Band is TfrxGroupHeader) and FDontShowHeaders) then
+ continue;
+ Band.Overflow := True;
+ SaveCurLine := CurLine;
+ SaveCurLineThrough := CurLineThrough;
+ CurLine := Band.FLineN;
+ CurLineThrough := Band.FLineThrough;
+ FCallFromAddPage := True;
+ FCallFromPHeader := (Band is TfrxPageHeader);
+
+ { fix the stack overflow error if call NewPage from ReportTitle }
+ if Band is TfrxReportTitle then
+ FHeaderList[i].Band := nil;
+
+ ShowBand(Band);
+ { correct column y position }
+ if Band is TfrxPageHeader then
+ FFirstColumnY := Band.FStretchedHeight;
+
+ if (FIsFirstBand) and (Band is TfrxReportTitle) then
+ FTitlePrinted := True;
+ FCallFromPHeader := False;
+ FCallFromAddPage := False;
+ Band.Overflow := False;
+ CurLine := SaveCurLine;
+ CurLineThrough := SaveCurLineThrough;
+ end;
+ end;
+
+ CurX := SaveCurX;
+end;
+
+procedure TfrxEngine.EndPage;
+var
+ Band: TfrxBand;
+ Offset: Extended;
+
+ procedure ShowBand(Band: TfrxBand);
+ begin
+ if Band = nil then Exit;
+
+ Stretch(Band);
+ try
+ if Band.Visible then
+ begin
+ Band.Left := 0;
+ Band.Top := CurY;
+
+ if Band is TfrxPageFooter then
+ if (FIsFirstPage and not TfrxPageFooter(Band).PrintOnFirstPage) or
+ (FIsLastPage and not TfrxPageFooter(Band).PrintOnLastPage and not FCallFromEndPage) then
+ Exit;
+
+ if not PreviewPages.BandExists(Band) then
+ PreviewPages.AddObject(Band);
+ CurY := CurY + Band.Height;
+ end;
+ finally
+ UnStretch(Band);
+ end;
+
+ FAggregates.Reset(Band);
+ end;
+
+begin
+ if not FCallFromEndPage then
+ EndColumn;
+ if not FIsLastPage then
+ begin
+ CurX := FPageCurX;
+ CurColumn := 1;
+ end;
+
+ if FIsLastPage and not FCallFromEndPage then
+ begin
+ { avoid stack overflow if reportsummary does not fit on the page }
+ FCallFromEndPage := True;
+ try
+ Offset := CurY;
+ Band := FindBand(TfrxReportSummary);
+ Self.ShowBand(Band);
+ if (Band <> nil) and (FPage.EndlessHeight) then
+ begin
+ Offset := CurY - Offset;
+ PageHeight := PageHeight + Offset;
+ TfrxPreviewPages(PreviewPages).UpdatePageDimensions(FPage, PageWidth + FPage.LeftMargin * fr01cm + FPage.RightMargin * fr01cm, PageHeight + FPage.TopMargin * fr01cm + FPage.BottomMargin * fr01cm);
+ end;
+ finally
+ FCallFromEndPage := False;
+ end;
+ end;
+
+ Band := FindBand(TfrxPageFooter);
+ if Band <> nil then
+ begin
+ CurY := PageHeight - Band.Height;
+ if FIsLastPage and TfrxPageFooter(Band).PrintOnLastPage and not FCallFromEndPage then
+ FPrevFooterHeight := Band.Height
+ else FPrevFooterHeight := 0;
+ end;
+ ShowBand(Band);
+ Band := FindBand(TfrxOverlay);
+ if (Band <> nil) and TfrxOverlay(Band).PrintOnTop then
+ begin
+ CurY := 0;
+ ShowBand(Band);
+ end;
+
+ FIsFirstPage := False;
+end;
+
+procedure TfrxEngine.AddColumn;
+var
+ i: Integer;
+ AddX: Extended;
+
+ procedure DoShow(Band: TfrxBand);
+ begin
+ Band.Overflow := True;
+ Stretch(Band);
+
+ try
+ if Band.Visible then
+ begin
+ Band.Left := CurX;
+ Band.Top := CurY;
+ PreviewPages.AddObject(Band);
+ CurY := CurY + Band.Height;
+ end;
+ finally
+ UnStretch(Band);
+ Band.Overflow := False;
+ end;
+ end;
+
+ procedure ShowBand(Band: TfrxBand);
+ begin
+ while Band <> nil do
+ begin
+ DoShow(Band);
+ if Band.Visible or Band.PrintChildIfInvisible then
+ Band := Band.Child else
+ break;
+ end;
+ end;
+
+begin
+ CurColumn := CurColumn + 1;
+ AddX := frxStrToFloat(FPage.ColumnPositions[CurColumn - 1]) * fr01cm;
+ CurY := FFirstColumnY;
+
+ for i := 0 to FHeaderList.Count - 1 do
+ begin
+ CurX := FHeaderList[i].Left + AddX;
+ if not (FHeaderList[i].Band is TfrxPageHeader) {and ((FHeaderList[i].Band is TfrxHeader)} and
+ (FLastBandOnPage <> FHeaderList[i].Band) and not FHeaderList[i].IsInKeepList and not FKeepHeader then
+ ShowBand(FHeaderList[i].Band);
+ end;
+
+ CurX := FPageCurX + AddX;
+end;
+
+procedure TfrxEngine.EndColumn;
+var
+ Band: TfrxBand;
+begin
+ Band := FindBand(TfrxColumnFooter);
+ if Band = nil then Exit;
+
+ Stretch(Band);
+ try
+ if Band.Visible then
+ begin
+ Band.Left := CurX - FPageCurX;
+ Band.Top := CurY;
+ PreviewPages.AddObject(Band);
+ { move the current position }
+ CurY := CurY + Band.Height;
+ end;
+ finally
+ UnStretch(Band);
+ end;
+
+ FAggregates.Reset(Band);
+end;
+
+procedure TfrxEngine.NewPage;
+var
+ CorrPage: TfrxReportPage;
+ RepeatedHeader: TfrxBand;
+ LastY: Extended;
+begin
+ { keep objects doesn't fit on whole page, so break keeping and leave the objets }
+ if (FKeepBand <> nil) and (CurY - FKeepCurY + FKeepBand.Height > PageHeight - FooterHeight) then
+ begin
+ FKeeping := False;
+ FAggregates.EndKeep;
+ end;
+ RepeatedHeader := nil;
+
+ if FKeeping then
+ begin
+ if FKeepFooter then
+ FAggregates.DeleteValue(FKeepBand);
+ PreviewPages.CutObjects(FKeepPosition);
+ LastY := PreviewPages.GetLastY;
+ if (ABS(LastY - CurY) >= 1e-4) and (FCurBand is TfrxDataband) then
+ RepeatedHeader := TfrxDataband(FCurBand).FHeader;
+ RemoveFromHeaderList(RepeatedHeader);
+ end;
+ FLastBandOnPage := FCurBand;
+ EndPage;
+ { fix for report with several pages and EndlessHeight }
+ { data dictionary doesn't using in this case }
+ if FPage.EndlessHeight then
+ with TfrxPreviewPages(PreviewPages) do
+ begin
+ CorrPage := Page[Count - 1];
+ CorrPage.PaperWidth := PageWidth / fr01cm + FPage.LeftMargin + FPage.RightMargin;
+ CorrPage.PaperHeight := (CurY + FooterHeight) / fr01cm + FPage.TopMargin + FPage.BottomMargin;
+ CorrPage.PaperSize := 256;
+ ModifyPage(Count - 1, CorrPage);
+ end;
+ AddPage;
+ FLastBandOnPage := nil;
+ if FKeeping then
+ begin
+ FAggregates.EndKeep;
+ PreviewPages.PasteObjects(0, CurY);
+ PreviewPages.Outline.ShiftItems(FKeepOutline, Round(CurY));
+ PreviewPages.ShiftAnchors(FKeepAnchor, Round(CurY));
+// if (FKeepBand is TfrxDataBand) and (TfrxDataBand(FKeepBand).CurColumn = 1) then
+// FSaveCurY := CurY;
+ CurY := PreviewPages.GetLastY;
+ if FKeepFooter then
+ FAggregates.AddValue(FKeepBand);
+ AddToHeaderList(RepeatedHeader);
+ end;
+ FKeeping := False;
+ FKeepHeader := False;
+ FKeepCurY := 0;
+ AddPageOutline;
+end;
+
+procedure TfrxEngine.NewColumn;
+begin
+ if CurColumn >= FPage.Columns then
+ NewPage
+ else
+ begin
+ { keeping for columns }
+ if FKeeping then
+ begin
+ if FKeepFooter then
+ FAggregates.DeleteValue(FKeepBand);
+ PreviewPages.CutObjects(FKeepPosition);
+ CurY := PreviewPages.GetLastY;
+ end;
+ FLastBandOnPage := FCurBand;
+ EndColumn;
+ AddColumn;
+ FLastBandOnPage := nil;
+ if FKeeping then
+ begin
+ FAggregates.EndKeep;
+ PreviewPages.PasteObjects(CurX, CurY);
+ PreviewPages.Outline.ShiftItems(FKeepOutline, Round(CurY));
+ PreviewPages.ShiftAnchors(FKeepAnchor, Round(CurY));
+ { new version of GetLastY has one parameter by default = 0,}
+ { it determinate column position for correct Y out result. }
+ { if parameter = 0 ,then function return last position on the page, }
+ { in other cases it return last Y position on X coordinate .}
+ CurY := PreviewPages.GetLastY(CurX);
+ if FKeepFooter then
+ FAggregates.AddValue(FKeepBand);
+ end;
+ FKeeping := False;
+ FKeepHeader := False;
+ end;
+end;
+
+procedure TfrxEngine.DrawSplit(Band: TfrxBand);
+var
+ i, ObjCount: Integer;
+ List, SaveObjects, ShiftedList: TList;
+ View: TfrxView;
+ StrView: TfrxStretcheable;
+ CurHeight, Corr, SavedHeight: Extended;
+ ObjStretch, HasNextPart: Boolean;
+{$IFNDEF MSWINDOWS}
+ bIDLE: Boolean;
+{$ENDIF}
+ procedure ShiftObjects(TopView: TfrxView; Delta: Extended);
+ var
+ i: Integer;
+ View: TfrxView;
+ begin
+ for i := 0 to List.Count - 1 do
+ begin
+ View := List[i];
+ if (View <> TopView) and (ShiftedList.IndexOf(View) = -1) and
+ (View.Top >= TopView.Top + TopView.Height) and
+ // (View.Left < TopView.Left + TopView.Width) and
+ (TopView.Left + TopView.Width - View.Left > 1e-4) and // MB: 10212009
+ // (TopView.Left < View.Left + View.Width)
+ (View.Left + View.Width - TopView.Left > 1e-4) // MB: 10212009
+ then
+ begin
+ View.Top := View.Top + Delta;
+ ShiftedList.Add(View);
+ end;
+ end;
+ end;
+
+ procedure DrawPart;
+ var
+ i: Integer;
+ View: TfrxView;
+ begin
+ { draw current objects }
+ Band.Left := CurX;
+ Band.Top := CurY;
+ PreviewPages.AddObject(Band);
+ { add new column/page }
+ CurY := CurY + Band.Height;
+ FCurBand := Band;
+ if List.Count > 0 then NewColumn;
+ { correct the top coordinate of remained objects }
+ Band.Objects.Clear;
+ for i := 0 to List.Count - 1 do
+ begin
+ View := List[i];
+ View.Top := View.Top - CurHeight;
+ { restore the height of stretched objects }
+ if View is TfrxStretcheable then
+ begin
+ { there is no splited objects, correct top positions }
+ if not ObjStretch and (List.Count = ObjCount) then
+ View.Top := TfrxStretcheable(View).FSavedTop;
+
+ if View.Top < 0 then
+ View.Top := 0;
+ View.Height := TfrxStretcheable(View).FSaveHeight;
+ end;
+ end;
+ end;
+
+ procedure CalcBandHeight;
+ var
+ i: Integer;
+ View: TfrxView;
+ begin
+ Band.Height := 0;
+ { calculate the band's height }
+ for i := 0 to Band.Objects.Count - 1 do
+ begin
+ View := Band.Objects[i];
+ if View.Top + View.Height > Band.Height then
+ Band.Height := View.Top + View.Height;
+ end;
+
+ { correct objects with StretchToMaxHeight or BandAlign = baBottom }
+ if List.Count = 0 then
+ for i := 0 to Band.Objects.Count - 1 do
+ begin
+ View := Band.Objects[i];
+ if View.Align = baBottom then
+ View.Top := Band.Height - View.Height
+ else if (View is TfrxStretcheable) and
+ (TfrxStretcheable(View).StretchMode = smMaxHeight) then
+ View.Height := Band.Height - View.Top;
+ end;
+ end;
+
+begin
+ List := TList.Create;
+ SaveObjects := TList.Create;
+ ShiftedList := TList.Create;
+ ObjStretch := False;
+
+ { initializing lists }
+ for i := 0 to Band.Objects.Count - 1 do
+ begin
+ View := Band.Objects[i];
+ if not (View is TfrxSubreport) then
+ List.Add(View);
+ SaveObjects.Add(View);
+ if View is TfrxStretcheable then
+ begin
+ TfrxStretcheable(View).InitPart;
+ TfrxStretcheable(View).FSaveHeight := View.Height;
+ end;
+ end;
+
+ Band.Objects.Clear;
+ ObjCount := List.Count;
+
+ CurHeight := FreeSpace;
+
+ while List.Count > 0 do
+ begin
+ ShiftedList.Clear;
+ i := 0;
+ if not Report.EngineOptions.EnableThreadSafe then
+{$IFDEF MSWINDOWS}
+ Application.ProcessMessages;
+{$ELSE}
+ Application.DoIdle(bIDLE);
+{$ENDIF}
+ if Report.Terminated then Break;
+
+ while i < List.Count do
+ begin
+ View := List[i];
+ Corr := 0;
+ SavedHeight := View.Height;
+ HasNextPart := False;
+ { call DrawPart above to proceess /page tag in rich object }
+ if View is TfrxStretcheable then
+ begin
+ { Save object top for streched object }
+ StrView := List[i];
+ StrView.FSavedTop := StrView.Top;
+ StrView.Height := CurHeight - StrView.Top;
+ StrView.SetFastCanvas(TfrxFastCanvaslayer(FFastCanvas));
+
+ if StrView.Top < CurHeight then
+ { trying to place it }
+ { DrawPart method returns the amount of unused space. If view
+ can't fit in the height, this method returns the Height }
+ Corr := StrView.DrawPart;
+ StrView.SetFastCanvas(nil);
+ SavedHeight := StrView.FSaveHeight;
+ { check: does object has new part of data independently from it size}
+ HasNextPart := StrView.HasNextDataPart;
+ end;
+
+ { whole object fits in the page }
+ if (View.Top + SavedHeight <= CurHeight) and not HasNextPart then
+ begin
+ View.Height := SavedHeight;
+ { add to band and remove from list }
+ Band.Objects.Add(View);
+ List.Remove(View);
+ continue;
+ end;
+
+ if View is TfrxStretcheable then
+ begin
+ StrView := List[i];
+
+ { view is inside draw area }
+ if StrView.Top < CurHeight then
+ begin
+ ShiftObjects(StrView, Corr);
+
+ if Abs(Corr - StrView.Height) < 1e-4 then
+ begin
+ { view can't fit, return back the height and correct the top }
+ StrView.Top := CurHeight;
+ { shift the underlying objects down }
+ StrView.Height := StrView.FSaveHeight;
+ end
+ else
+ begin
+ { view can draw something }
+ Band.Objects.Add(StrView);
+ { decrease the remained height }
+ StrView.FSaveHeight := StrView.FSaveHeight - StrView.Height + Corr;
+ ObjStretch := True;
+ end;
+
+ end;
+ end
+ else
+ begin
+ { non-stretcheable view can't be splitted, draw it in the next page }
+ if View.Height > PageHeight - FooterHeight then
+ begin
+ { add to band and remove from list }
+ Band.Objects.Add(View);
+ List.Remove(View);
+ { prepare last part of text }
+ continue;
+ end
+ else if View.Top < CurHeight then
+ begin
+ { shift the underlying objects down }
+ ShiftObjects(View, CurHeight - View.Top);
+ View.Top := CurHeight;
+ end;
+ end;
+
+ Inc(i);
+ end;
+
+ { draw the visible part }
+ CalcBandHeight;
+ DrawPart;
+ CurHeight := FreeSpace;
+ end;
+
+ { get objects back to the band }
+ Band.Objects.Clear;
+ for i := 0 to SaveObjects.Count - 1 do
+ Band.Objects.Add(SaveObjects[i]);
+
+ List.Free;
+ SaveObjects.Free;
+ ShiftedList.Free;
+end;
+
+procedure TfrxEngine.CheckSuppress(Band: TfrxBand);
+var
+ i: Integer;
+ c: TfrxComponent;
+ hasSuppress: Boolean;
+begin
+ hasSuppress := False;
+ for i := 0 to Band.Objects.Count - 1 do
+ begin
+ c := Band.Objects[i];
+ if (c is TfrxCustomMemoView) and TfrxCustomMemoView(c).SuppressRepeated then
+ begin
+ hasSuppress := True;
+ TfrxCustomMemoView(c).ResetSuppress;
+ end;
+ end;
+
+ if hasSuppress and not Band.FHasVBands then
+ begin
+ UnStretch(Band);
+ CurLine := Band.FLineN;
+ CurLineThrough := Band.FLineThrough;
+ SecondScriptCall := True;
+ try
+ Stretch(Band);
+ finally
+ SecondScriptCall := False;
+ end;
+ end;
+end;
+
+procedure TfrxEngine.DoShow(Band: TfrxBand);
+var
+ IsMultiColumnBand, IsSplit: Boolean;
+ TempBand: TfrxBand;
+ SaveCurX: Extended;
+ SavePageList: TList;
+ SaveVMasterBand: TfrxBand;
+ i: Integer;
+
+ procedure RenderVBand;
+ var
+ i, j, SavePageN: Integer;
+ SaveCurY: Extended;
+ c: TfrxComponent;
+ SaveObjects: TList;
+ begin
+ SaveObjects := TList.Create;
+ SavePageN := PreviewPages.CurPage;
+ SaveCurY := CurY;
+ { the next NewPage call shouldn't form a new page }
+ PreviewPages.AddPageAction := apWriteOver;
+
+ { save hband objects }
+ for i := 0 to FVMasterBand.Objects.Count - 1 do
+ SaveObjects.Add(FVMasterBand.Objects[i]);
+
+ for i := 0 to FVPageList.Count - 2 do
+ begin
+ FVMasterBand.Objects.Clear;
+ for j := Integer(FVPageList[i]) to Integer(FVPageList[i + 1]) - 1 do
+ begin
+ c := SaveObjects[j];
+ FVMasterBand.Objects.Add(c);
+ end;
+ PreviewPages.AddObject(FVMasterBand);
+
+ if i <> FVPageList.Count - 2 then
+ begin
+ FDontShowHeaders := True;
+ NewPage;
+ FDontShowHeaders := False;
+ end
+ else
+ EndPage;
+ end;
+
+ { restore hband objects }
+ FVMasterBand.Objects.Clear;
+ for i := 0 to SaveObjects.Count - 1 do
+ FVMasterBand.Objects.Add(SaveObjects[i]);
+ SaveObjects.Free;
+
+ PreviewPages.CurPage := SavePageN;
+ CurY := SaveCurY;
+ CurX := SaveCurX;
+ { the next NewPage call should form a new page }
+ PreviewPages.AddPageAction := apAdd;
+ end;
+
+ procedure AddVBand;
+ var
+ i: Integer;
+ c, c1: TfrxReportComponent;
+ begin
+ if Band is TfrxDataBand then
+ CurVColumn := CurVColumn + 1;
+ if (Band is TfrxFooter) or (Band is TfrxGroupFooter) then
+ FCurBand := Band
+ else
+ FCurBand := FVMasterBand;
+
+ { fire beforeprint }
+ Report.CurObject := Band.Name;
+ Band.BeforePrint;
+ Report.DoBeforePrint(Band);
+
+ if Band.Visible then
+ begin
+ if CurX + Band.Width > PageWidth then
+ if FPage.EndlessWidth then
+ PageWidth := PageWidth + Band.Width
+ else
+ begin
+ {need for correct Page calculation when move VBand to the next page}
+ with PreviewPages do
+ begin
+ if Count - 1 <= CurPage then
+ AddPage(FPage)
+ else
+ CurPage := CurPage + 1;
+ end;
+ CurX := 0;
+ FVPageList.Add(Pointer(FVMasterBand.Objects.Count));
+ { reprint headers }
+ for i := 0 to FVHeaderList.Count - 1 do
+ ShowBand(TfrxBand(FVHeaderList[i]));
+ end;
+
+ { find objects that intersect with vertical Band }
+ for i := 0 to Band.Objects.Count - 1 do
+ begin
+ c := Band.Objects[i];
+ if THackComponent(c).FOriginalBand = FVMasterBand then
+ begin
+ { fire beforeprint and getdata }
+ Report.CurObject := c.Name;
+ c.BeforePrint;
+ Report.DoBeforePrint(c);
+ c.GetData;
+ Report.DoNotifyEvent(c, c.OnAfterData);
+
+ { copy the object }
+ c1 := TfrxReportComponent(c.NewInstance);
+ c1.Create(FVMasterBand);
+ c1.Assign(c);
+ with THackComponent(c1) do
+ begin
+ FAliasName := THackComponent(c).FAliasName;
+ FOriginalComponent := THackComponent(c).FOriginalComponent;
+ end;
+ c1.Left := c1.Left + CurX;
+
+ { restore the object's state }
+ c.AfterPrint;
+ end;
+ end;
+
+ CurX := CurX + Band.Width;
+ end;
+
+ { fire afterprint }
+ Report.CurObject := Band.Name;
+ Report.DoAfterPrint(Band);
+ Band.AfterPrint;
+
+ if Band is TfrxDataBand then
+ FAggregates.AddValue(FVMasterBand, CurVColumn);
+
+ { reset aggregates }
+ if (Band is TfrxFooter) or (Band is TfrxGroupFooter) then
+ FAggregates.Reset(Band);
+ end;
+
+begin
+ SavePageList := nil;
+ SaveVMasterBand := nil;
+
+ { make cross-bands }
+ if Band.FHasVBands and not (Band is TfrxPageHeader) then
+ begin
+ SaveCurX := CurX;
+ { fire onbeforeprint }
+ Report.CurObject := Band.Name;
+ Band.BeforePrint;
+ Report.DoBeforePrint(Band);
+ { show vertical bands }
+ ShowVBands(Band);
+ CurX := 0;
+ { restore Line variables}
+ CurLine := Band.FLineN;
+ CurLineThrough := Band.FLineThrough;
+ { the next NewPage call should form a new page }
+ PreviewPages.AddPageAction := apAdd;
+
+ { save global variables - FVPageList and FVMasterBand }
+ { they may be changed in the NewPage call, if cross has a h-header }
+ { with ReprintOnNewPage option }
+ SavePageList := TList.Create;
+ for i := 0 to FVPageList.Count - 1 do
+ SavePageList.Add(FVPageList[i]);
+ SaveVMasterBand := FVMasterBand;
+ end;
+
+ { show one vertical band }
+ if Band.Vertical then
+ begin
+ AddVBand;
+ Exit;
+ end;
+
+ IsMultiColumnBand := (Band is TfrxDataBand) and (TfrxDataBand(Band).Columns > 1);
+ IsSplit := False;
+
+ { check for StartNewPage flag }
+ if not FCallFromAddPage then
+ if Band.Visible then { don't process invisible bands }
+ if Band.StartNewPage then
+ if FOutputTo = nil then
+ if not (((Band is TfrxDataBand) or (Band is TfrxGroupHeader)) and (Band.FLineN = 1)) then
+ begin
+ FStartNewPageBand := Band;
+ if (Band is TfrxGroupHeader) and (TfrxGroupHeader(Band).ResetPageNumbers) then
+ PreviewPages.ResetLogicalPageNumber;
+ NewPage;
+ FStartNewPageBand := nil;
+ end;
+
+ Stretch(Band);
+ Band.FStretchedHeight := Band.Height;
+ try
+ if Band.Visible then
+ begin
+ { if band has columns, print all columns in one page. Page feed will be
+ performed after the last column }
+ if not IsMultiColumnBand and not (Band is TfrxOverlay) and not (Band is TfrxNullBand) and
+ (Band.Height > FreeSpace) then
+ if FOutputTo = nil then
+ if (Band.AllowSplit and not FKeeping) or
+ ((Band.Height > PageHeight - FooterHeight) and not band.FHasVBands) then
+ begin
+ if (not Band.AllowSplit) and (Band.FLineThrough > 1) and (not Band.StartNewPage) then
+ begin
+ FCurBand := Band;
+ NewColumn;
+ end;
+ if FKeeping then
+ EndKeep(Band);
+ DrawSplit(Band);
+ IsSplit := True;
+ end
+ else
+ begin
+ if not FKeeping then
+ CheckSuppress(Band);
+ if not((Band is TfrxChild) and FCallFromPHeader) then {endless loop fix}
+ NewColumn;
+ end;
+
+ if not IsSplit then
+ begin
+ if not (Band is TfrxNullBand) then
+ begin
+ { multicolumn band manages its Left property itself }
+ if IsMultiColumnBand then
+ begin
+ Band.Left := Band.Left + CurX;
+ {if (TfrxDataBand(Band).CurColumn = 1) and (Band.Height > FreeSpace) then
+ begin
+ FCurBand := Band;
+ NewColumn;
+ // FSaveCurY := CurY;
+ end;}
+ end
+ else
+ Band.Left := CurX;
+ Band.Top := CurY;
+ end;
+
+ { output the band }
+ if FOutputTo = nil then
+ begin
+ if (Band.FHasVBands) and not (Band is TfrxPageHeader) then
+ begin
+ { restore global variables - FVPageList and FVMasterBand }
+ { they may be changed in the NewPage call, if cross has a h-header }
+ { with ReprintOnNewPage option }
+ FVPageList.Clear;
+ for i := 0 to SavePageList.Count - 1 do
+ FVPageList.Add(SavePageList[i]);
+ SavePageList.Free;
+ FVMasterBand := SaveVMasterBand;
+ Band.Left := 0;
+ RenderVBand;
+ end
+ else if (not FCallFromAddPage) or (not PreviewPages.BandExists(Band)) then
+ PreviewPages.AddObject(Band)
+ end
+ else
+ begin
+ TempBand := TfrxBand.Create(FOutputTo);
+ TempBand.AssignAll(Band, True);
+ end;
+
+ { move the current position }
+ CurY := CurY + Band.Height;
+ end;
+ end;
+ finally
+ UnStretch(Band);
+ end;
+
+ { reset aggregate values }
+// if (Band is TfrxFooter) or (Band is TfrxGroupFooter) or
+// (Band is TfrxPageFooter) or (Band is TfrxReportSummary) then
+ FAggregates.Reset(Band);
+
+ { print subreports contained in this band }
+ if Band.Visible then
+ CheckSubReports(Band);
+end;
+
+procedure TfrxEngine.CheckSubReports(Band: TfrxBand);
+var
+ i, SavePageN, SaveColumnN: Integer;
+ SaveCurX, SaveCurY, SavePageCurX: Extended;
+ HaveSub: Boolean;
+ Sub: TfrxSubreport;
+ MaxPageN, MaxColumnN: Integer;
+ MaxCurY: Extended;
+begin
+ { save the current position }
+ HaveSub := False;
+ SavePageN := PreviewPages.CurPage;
+ SaveColumnN := CurColumn;
+ SaveCurX := CurX;
+ SaveCurY := CurY;
+ SavePageCurX := FPageCurX;
+
+ { init max position }
+ MaxPageN := SavePageN; //0
+ MaxColumnN := SaveColumnN; //0
+ MaxCurY := SaveCurY; //0
+
+ { looking for subreport objects }
+ for i := 0 to Band.Objects.Count - 1 do
+ if TObject(Band.Objects[i]) is TfrxSubreport then
+ begin
+ Sub := TfrxSubreport(Band.Objects[i]);
+ if not Sub.Visible or Sub.PrintOnParent then continue;
+ HaveSub := True;
+
+ { set up all properties... }
+ PreviewPages.CurPage := SavePageN;
+ FPageCurX := SavePageCurX + Sub.Left;
+ CurColumn := SaveColumnN;
+ CurX := SaveCurX + Sub.Left;
+ CurY := SaveCurY - Band.FStretchedHeight + Sub.Top; //SaveCurY - Sub.Height;
+ { ...and run the subreport }
+ RunPage(Sub.Page);
+
+ { calc max position }
+ if PreviewPages.CurPage > MaxPageN then
+ begin
+ MaxPageN := PreviewPages.CurPage;
+ MaxColumnN := CurColumn;
+ MaxCurY := CurY;
+ end
+ else if PreviewPages.CurPage = MaxPageN then
+ if CurColumn > MaxColumnN then
+ begin
+ MaxColumnN := CurColumn;
+ MaxCurY := CurY;
+ end
+ else if CurColumn = MaxColumnN then
+ if CurY > MaxCurY then
+ MaxCurY := CurY;
+ end;
+
+ { move the current position to the last generated page }
+ if HaveSub then
+ begin
+ PreviewPages.CurPage := MaxPageN;
+ CurColumn := MaxColumnN;
+ CurX := SavePageCurX;
+ if CurColumn > 1 then
+ CurX := CurX + frxStrToFloat(FPage.ColumnPositions[CurColumn - 1]) * fr01cm;
+ CurY := MaxCurY;
+ FPageCurX := SavePageCurX;
+ end;
+end;
+
+procedure TfrxEngine.StartKeep(Band: TfrxBand; Position: Integer = 0);
+begin
+ if FKeeping or FIsFirstBand then Exit;
+
+ FKeepCurY := CurY;
+ FKeeping := True;
+ FKeepBand := Band;
+ if Position = 0 then
+ Position := PreviewPages.GetCurPosition;
+ FKeepPosition := Position;
+ FKeepOutline := PreviewPages.Outline.GetCurPosition;
+ FKeepAnchor := PreviewPages.GetAnchorCurPosition;
+ FAggregates.StartKeep;
+end;
+
+procedure TfrxEngine.EndKeep(Band: TfrxBand);
+begin
+ if FKeepBand = Band then
+ begin
+ FKeepCurY := 0;
+ FKeeping := False;
+ FKeepBand := nil;
+ FAggregates.EndKeep;
+ FKeepHeader := False;
+ end;
+end;
+
+function TfrxEngine.GetAggregateValue(const Name, Expression: String;
+ Band: TfrxBand; Flags: Integer): Variant;
+begin
+ Result := FAggregates.GetValue(FCurBand, CurVColumn, Name, Expression, Band, Flags);
+end;
+
+procedure TfrxEngine.AddBandOutline(Band: TfrxBand);
+var
+ pos: Integer;
+begin
+ if Band.OutlineText <> '' then
+ begin
+ Report.CurObject := Band.Name;
+ if Band.Stretched then
+ pos := Round(CurY - Band.FStretchedHeight)
+ else
+ pos := Round(CurY - Band.Height);
+ if Band.Visible then
+ PreviewPages.Outline.AddItem(VarToStr(Report.Calc(Band.OutlineText)), pos);
+ end;
+end;
+
+procedure TfrxEngine.AddPageOutline;
+begin
+ if FPage.OutlineText <> '' then
+ begin
+ OutlineRoot;
+ Report.CurObject := FPage.Name;
+ PreviewPages.Outline.AddItem(VarToStr(Report.Calc(FPage.OutlineText)), 0);
+ end;
+end;
+
+procedure TfrxEngine.OutlineRoot;
+begin
+ PreviewPages.Outline.LevelRoot;
+end;
+
+procedure TfrxEngine.OutlineUp(Band: TfrxBand);
+begin
+ if Band.OutlineText <> '' then
+ PreviewPages.Outline.LevelUp;
+end;
+
+
+function TfrxEngine.GetPageHeight: Double;
+begin
+ if (FPage <> nil) and FPage.EndlessHeight then
+ Result := CurY + FooterHeight
+ else
+ Result := inherited GetPageHeight;
+end;
+
+end.
diff --git a/LibD28/FMX.frxEvaluateForm.fmx b/LibD28/FMX.frxEvaluateForm.fmx
new file mode 100644
index 0000000..7ae9afe
--- /dev/null
+++ b/LibD28/FMX.frxEvaluateForm.fmx
@@ -0,0 +1,57 @@
+object frxEvaluateForm: TfrxEvaluateForm
+ Left = 0
+ Top = 0
+ Caption = 'Evaluate'
+ ClientHeight = 163
+ ClientWidth = 281
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object Label1: TLabel
+ Position.Point = '(4,4)'
+ Width = 52.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object Label2: TLabel
+ Position.Point = '(4,52)'
+ Width = 30.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object ExpressionE: TEdit
+ Position.Point = '(4,20)'
+ Width = 273.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 2
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object ResultM: TMemo
+ Position.Point = '(4,68)'
+ Width = 273.000000000000000000
+ Height = 89.000000000000000000
+ TabOrder = 3
+ KeyboardType = vktDefault
+ end
+ object OkB: TButton
+ Position.Point = '(120,56)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ Visible = False
+ TabOrder = 4
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(200,56)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ Visible = False
+ TabOrder = 5
+ ModalResult = 2
+ Cancel = True
+ end
+end
diff --git a/LibD28/FMX.frxEvaluateForm.pas b/LibD28/FMX.frxEvaluateForm.pas
new file mode 100644
index 0000000..6283f6d
--- /dev/null
+++ b/LibD28/FMX.frxEvaluateForm.pas
@@ -0,0 +1,109 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Evaluate dialog }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEvaluateForm;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.fs_iinterpreter, FMX.Layouts, FMX.Memo, FMX.Edit, FMX.Types, System.Variants
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+type
+ TfrxEvaluateForm = class(TForm)
+ Label1: TLabel;
+ ExpressionE: TEdit;
+ Label2: TLabel;
+ ResultM: TMemo;
+ OkB: TButton;
+ CancelB: TButton;
+ procedure FormShow(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ private
+ FScript: TfsScript;
+ FIsWatch: Boolean;
+ public
+ property IsWatch: Boolean read FIsWatch write FIsWatch;
+ property Script: TfsScript read FScript write FScript;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxRes;
+
+
+procedure TfrxEvaluateForm.FormShow(Sender: TObject);
+begin
+ ExpressionE.SelectAll;
+ ResultM.Text := '';
+ if IsWatch then
+ begin
+ OkB.Visible := True;
+ CancelB.Visible := True;
+ ResultM.Visible := False;
+ Label2.Visible := False;
+ ClientHeight := Round(OkB.Position.Y + OkB.Height + 4);
+ end;
+end;
+
+procedure TfrxEvaluateForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(5500);
+ Label1.Text := frxGet(5501);
+ Label2.Text := frxGet(5502);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ FormShow(Self);
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxEvaluateForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+var
+ v: Variant;
+ s: String;
+begin
+ if IsWatch then Exit;
+ if Key = vkReturn then
+ begin
+ v := FScript.Evaluate(ExpressionE.Text);
+ s := VarToStr(v);
+ if TVarData(v).VType = varBoolean then
+ if Boolean(v) = True then
+ s := 'True' else
+ s := 'False'
+ else if (TVarData(v).VType = varString) or (TVarData(v).VType = varOleStr)
+ or (TVarData(v).VType = varOleStr) then
+ s := '''' + v + ''''
+ else if v = Null then
+ s := 'Null';
+ ResultM.Text := s;
+ ExpressionE.SelectAll;
+ end
+ else if Key = VKESCAPE then
+ Close;
+ //if Key = VKESCAPE then
+ // ModalResult := mrCancel;
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+end.
diff --git a/LibD28/FMX.frxExportCSV.fmx b/LibD28/FMX.frxExportCSV.fmx
new file mode 100644
index 0000000..73001da
--- /dev/null
+++ b/LibD28/FMX.frxExportCSV.fmx
@@ -0,0 +1,110 @@
+object frxCSVExportDialog: TfrxCSVExportDialog
+ Left = 0
+ Top = 0
+ Caption = 'Export to CSV'
+ ClientHeight = 261
+ ClientWidth = 277
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ ActiveControl = OkB
+ StyleLookup = 'backgroundstyle'
+ object OkB: TButton
+ Position.Point = '(118,228)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(198,228)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object GroupPageRange: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 269.000000000000000000
+ Height = 141.000000000000000000
+ TabOrder = 2
+ object DescrL: TLabel
+ Position.Point = '(12,82)'
+ Width = 249.000000000000000000
+ Height = 47.000000000000000000
+ TabOrder = 0
+ end
+ object AllRB: TRadioButton
+ Position.Point = '(12,20)'
+ Width = 153.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 108
+ TabOrder = 1
+ IsChecked = True
+ end
+ object CurPageRB: TRadioButton
+ Position.Point = '(12,40)'
+ Width = 153.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 118
+ TabOrder = 2
+ end
+ object PageNumbersRB: TRadioButton
+ Position.Point = '(12,60)'
+ Width = 77.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 124
+ TabOrder = 3
+ end
+ object PageNumbersE: TEdit
+ Position.Point = '(92,58)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 133
+ TabOrder = 4
+ KeyboardType = vktDefault
+ OnChange = PageNumbersEChange
+ Password = False
+ end
+ end
+ object GroupQuality: TGroupBox
+ Position.Point = '(4,144)'
+ Width = 269.000000000000000000
+ Height = 53.000000000000000000
+ TabOrder = 3
+ object SeparatorLB: TLabel
+ Position.Point = '(137,21)'
+ Width = 76.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object OEMCB: TCheckBox
+ Position.Point = '(12,20)'
+ Width = 121.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ object SeparatorE: TEdit
+ Position.Point = '(224,16)'
+ Width = 33.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 2
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+ object OpenCB: TCheckBox
+ Position.Point = '(16,200)'
+ Width = 253.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 4
+ end
+ object SaveDialog1: TSaveDialog
+ DefaultExt = '.txt'
+ Filter = 'CSV file (*.csv)|*.csv'
+ Options = [ofHideReadOnly, ofNoChangeDir, ofEnableSizing]
+ end
+end
diff --git a/LibD28/FMX.frxExportCSV.pas b/LibD28/FMX.frxExportCSV.pas
new file mode 100644
index 0000000..42a9188
--- /dev/null
+++ b/LibD28/FMX.frxExportCSV.pas
@@ -0,0 +1,593 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ CSV export }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Fediachov, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+{ The specification of the CSV document file format
+ can be downloaded from here:
+
+ http://www.rfc-editor.org/rfc/rfc4180.txt }
+
+unit FMX.frxExportCSV;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.frxExportMatrix, FMX.Edit, FMX.Types
+, System.Variants, FMX.Controls, FMX.frxBaseModalForm
+{$IFDEF DELPHI18}
+ , FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+type
+ TfrxCSVExportDialog = class(TfrxForm)
+ OkB: TButton;
+ CancelB: TButton;
+ SaveDialog1: TSaveDialog;
+ GroupPageRange: TGroupBox;
+ DescrL: TLabel;
+ AllRB: TRadioButton;
+ CurPageRB: TRadioButton;
+ PageNumbersRB: TRadioButton;
+ PageNumbersE: TEdit;
+ GroupQuality: TGroupBox;
+ OpenCB: TCheckBox;
+ OEMCB: TCheckBox;
+ SeparatorLB: TLabel;
+ SeparatorE: TEdit;
+ procedure FormCreate(Sender: TObject);
+ procedure PageNumbersEChange(Sender: TObject);
+ procedure PageNumbersEKeyPress(Sender: TObject; var Key: Char);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ end;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxCSVExport = class(TfrxCustomExportFilter)
+ private
+
+ FMatrix: TfrxIEMatrix;
+ FOpenAfterExport: Boolean;
+ Exp: TStream;
+ FPage: TfrxReportPage;
+ FOEM: Boolean;
+ FSeparator: String;
+ FNoSysSymbols: Boolean;
+ FForcedQuotes: Boolean;
+
+ procedure ExportPage(Stream: TStream);
+
+ public
+
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ function ShowModal: TModalResult; override;
+ function Start: Boolean; override;
+ procedure Finish; override;
+ procedure FinishPage(Page: TfrxReportPage; Index: Integer); override;
+ procedure StartPage(Page: TfrxReportPage; Index: Integer); override;
+ procedure ExportObject(Obj: TfrxComponent); override;
+
+ published
+
+ property Separator: String read FSeparator write FSeparator;
+ property OEMCodepage: Boolean read FOEM write FOEM;
+ property OpenAfterExport: Boolean read FOpenAfterExport write FOpenAfterExport default False;
+ property OverwritePrompt;
+
+ { CSV export can ignore exporting of special system characters
+ from original strings in the report. The special characters are
+ all characters with ASCII codes $00..$1F. }
+
+ property NoSysSymbols: Boolean read FNoSysSymbols write FNoSysSymbols; {default True}
+
+ { Specification of CSV format allows to leave some fields to be unquoted.
+ The ForcedQuotes option allows to enclose all fields in double quotes. }
+
+ property ForcedQuotes: Boolean read FForcedQuotes write FForcedQuotes; {default False}
+
+ end;
+
+
+implementation
+
+uses FMX.frxUtils, {FMX.frxFileUtils,} FMX.frxUnicodeUtils, FMX.frxRes, FMX.frxFMX, FMX.frxrcExports
+{$IFDEF MSWINDOWS}
+, Winapi.ShellAPI, Winapi.Windows
+{$ENDIF}
+{$IFDEF LINUX}
+ ,FMUX.Api
+{$ENDIF}
+{$IFDEF MACOS}
+, Posix.Stdlib
+{$ENDIF};
+
+{$R *.FMX}
+
+
+function AnsiPos(const Substr, S: AnsiString): Integer;
+var
+ P: PAnsiChar;
+begin
+ Result := 0;
+ P := AnsiStrPos(PAnsiChar(S), PAnsiChar(SubStr));
+ if P <> nil then
+ Result := frxInteger(P) - frxInteger(PAnsiChar(S)) + 1;
+end;
+
+ function StringReplace(const S, OldPattern, NewPattern: AnsiString;
+ Flags: TReplaceFlags): AnsiString;
+var
+ SearchStr, Patt, NewStr: AnsiString;
+ Offset: Integer;
+begin
+ if rfIgnoreCase in Flags then
+ begin
+ SearchStr := AnsiString(AnsiUpperCase(String(S)));
+ Patt := AnsiString(AnsiUpperCase(String(OldPattern)));
+ end else
+ begin
+ SearchStr := S;
+ Patt := OldPattern;
+ end;
+ NewStr := S;
+ Result := '';
+ while SearchStr <> '' do
+ begin
+ Offset := AnsiPos(Patt, SearchStr);
+ if Offset = 0 then
+ begin
+ Result := Result + NewStr;
+ Break;
+ end;
+ Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
+ NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
+ if not (rfReplaceAll in Flags) then
+ begin
+ Result := Result + NewStr;
+ Break;
+ end;
+ SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
+ end;
+end;
+
+
+{ TfrxCSVExport }
+
+constructor TfrxCSVExport.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FOEM := False;
+ FSeparator := FormatSettings.ListSeparator;
+ FNoSysSymbols := True;
+ FilterDesc := frxGet(8851);
+ DefaultExt := frxGet(8852);
+end;
+
+class function TfrxCSVExport.GetDescription: String;
+begin
+ Result := frxResources.Get('CSVExport');
+end;
+
+procedure TfrxCSVExport.ExportPage(Stream: TStream);
+var
+ x, y: Integer;
+ Obj: TfrxIEMObject;
+ s: AnsiString;
+
+ { Before a byte string can be written to an output CSV document,
+ it must be prepaired as follows:
+
+ 1. text with special characters must be enclosed in double quotes
+ 2. if the text contains double quotes and was enclosed in double quotes,
+ its double quotes must be escaped by double quotes
+ 3. append the text by a separator (usually it's ";" or ",") }
+
+ function PrepareString(const Str: AnsiString): AnsiString;
+
+ { Returns count of a character within a byte string }
+
+ function CharCount(const s: AnsiString; c: AnsiChar): Integer;
+ var
+ i: Integer;
+ begin
+ Result := 0;
+
+ for i := 1 to Length(s) do
+ if s[i] = c then
+ Inc(Result);
+ end;
+
+ { Copies a source byte string to a destination byte string.
+ A specified character is copied twice. }
+
+ procedure DoubleCharacter(r: PAnsiChar; const s: AnsiString; c: AnsiChar);
+ var
+ si, ri: Integer;
+
+ procedure PushChar(c: AnsiChar);
+ begin
+ PAnsiChar(frxInteger(r) + ri)^ := c;
+ Inc(ri);
+ end;
+
+ begin
+ ri := 0;
+
+ for si := 1 to Length(s) do
+ begin
+ PushChar(s[si]);
+
+ if s[si] = c then
+ PushChar(s[si]);
+ end;
+ end;
+
+ { This routine finds special characters in a byte string.
+ If characters were found, the result is true, otherwise
+ the result is false.
+
+ Special characters are:
+
+ a) all characters with codes 00..31
+ b) the double quote character "
+ c) a specified character in the 2-nd argument }
+
+ function FindSpecChar(const s: AnsiString; c: AnsiChar): Boolean;
+ var
+ i: Integer;
+ begin
+ for i := 1 to Length(s) do
+ if (s[i] = c) or (Ord(s[i]) < 32) or (s[i] = '"') then
+ begin
+ Result := True;
+ Exit;
+ end;
+
+ Result := False;
+ end;
+
+ { Removes system symbols and returns a count of characters in
+ the cleaned up string. System symbols are characters with codes 0..31. }
+
+ function CleanSysSymbols(var s: AnsiString): Integer;
+ var
+ i, j: Integer;
+ begin
+ j := 1;
+
+ for i := 1 to Length(s) do
+ if Ord(s[i]) > 31 then
+ begin
+ s[j] := s[i];
+ Inc(j);
+ end;
+
+ Result := j - 1;
+ end;
+
+ var
+ s: AnsiString; // buffer
+ len: LongWord; // Length(Str)
+ qn: LongWord; // Count of the quote characters in Str
+ sep: AnsiChar;
+ begin
+
+ { FSeparator must never be empty,
+ but if it's empty, the export must not
+ crash }
+
+ if FSeparator = '' then
+ sep := AnsiChar(FormatSettings.ListSeparator)
+ else
+ sep := AnsiChar(FSeparator[1]);
+
+ if Str = '' then
+ begin
+ Result := sep;
+ Exit;
+ end;
+
+ { Convert to the OEM codepage if it needs }
+
+ if FOEM then
+ s := Str // todo oem
+ else
+ s := Str;
+
+ len := Length(s);
+
+ { Suppress ending trash }
+
+ if (len >= 2) and (s[len] = #10) and (s[len - 1] = #13) then
+ begin
+ Dec(len, 2);
+ SetLength(s, len);
+ end;
+
+ { Remove system symbols if it needs. }
+
+ if (len > 0) and NoSysSymbols then
+ begin
+ len := CleanSysSymbols(s);
+ SetLength(s, len);
+ end;
+
+ if len = 0 then
+ begin
+ Result := sep;
+ Exit;
+ end;
+
+ { If the text has no special characters,
+ it can be written directly to the output CSV
+ document }
+
+ if not FindSpecChar(s, sep) then
+ begin
+ if not ForcedQuotes then
+ Result := s + sep
+ else
+ begin
+ SetLength(Result, Length(s) + 3);
+ Result[1] := '"';
+ Result[2 + Length(s)] := '"';
+ Result[3 + Length(s)] := sep;
+ Move(s[1], Result[2], Length(s));
+ end;
+
+ Exit;
+ end;
+
+ { If the text contains special characters,
+ escape all double quotes with additional double quotes and
+ enclose the text in double quotes }
+
+ qn := CharCount(s, '"');
+ SetLength(Result, len + qn + 3);
+
+ Result[1] := '"';
+ Result[2 + qn + len] := '"';
+ Result[3 + qn + len] := sep;
+
+ DoubleCharacter(@Result[2], s, '"');
+ end;
+
+var
+ eoln: Word;
+ n: Integer;
+begin
+ FMatrix.Prepare;
+ eoln := $0a0d;
+
+ for y := 0 to FMatrix.Height - 2 do
+ begin
+ n := 0;
+
+ for x := 0 to FMatrix.Width - 1 do
+ begin
+ Obj := FMatrix.GetObject(x, y);
+ if Obj = nil then Continue;
+ Inc(n);
+
+ if Obj.Counter = 0 then
+ begin
+ s := AnsiString(Obj.Memo.Text);
+ s := PrepareString(s);
+ Stream.Write(s[1], Length(s));
+ Obj.Counter := 1;
+ end
+ else
+ begin
+ s := AnsiString(FSeparator);
+ Stream.Write(s[1], Length(s));
+ end;
+ end;
+
+ { this removes the last separator symbol }
+
+ if n > 0 then
+ Stream.Seek(Int64(-1), soFromCurrent);
+
+ Stream.Write(eoln, 2);
+ end;
+end;
+
+function TfrxCSVExport.ShowModal: TModalResult;
+begin
+ if not Assigned(Stream) then
+ begin
+ with TfrxCSVExportDialog.Create(nil) do
+ begin
+ OpenCB.Visible := not SlaveExport;
+ if OverwritePrompt then
+ SaveDialog1.Options := SaveDialog1.Options + [TOpenOption.ofOverwritePrompt];
+ if SlaveExport then
+ FOpenAfterExport := False;
+
+ if (FileName = '') and (not SlaveExport) then
+ SaveDialog1.FileName := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(Report.FileName)), SaveDialog1.DefaultExt)
+ else
+ SaveDialog1.FileName := FileName;
+
+ OpenCB.IsChecked := FOpenAfterExport;
+ OEMCB.IsChecked := FOEM;
+ SeparatorE.Text := FSeparator;
+
+ if PageNumbers <> '' then
+ begin
+ PageNumbersE.Text := PageNumbers;
+ PageNumbersRB.IsChecked := True;
+ end;
+
+ Result := ShowModal;
+ PeekLastModalResult;
+ if Result = mrOk then
+ begin
+ PageNumbers := '';
+ CurPage := False;
+ if CurPageRB.IsChecked then
+ CurPage := True
+ else if PageNumbersRB.IsChecked then
+ PageNumbers := PageNumbersE.Text;
+
+ FOpenAfterExport := OpenCB.IsChecked;
+ FOEM := OEMCB.IsChecked;
+ FSeparator := SeparatorE.Text;
+
+ if not SlaveExport then
+ begin
+ if DefaultPath <> '' then
+ SaveDialog1.InitialDir := DefaultPath;
+ if SaveDialog1.Execute then
+ FileName := SaveDialog1.FileName
+ else
+ Result := mrCancel;
+ PeekLastModalResult;
+ end;
+ end;
+ Free;
+ end;
+ end else
+ Result := mrOk;
+end;
+
+function TfrxCSVExport.Start: Boolean;
+begin
+ if SlaveExport then
+ begin
+ if Report.FileName <> '' then
+ FileName := ChangeFileExt(GetTemporaryFolder + ExtractFileName(Report.FileName), frxGet(8852))
+ else
+ FileName := ChangeFileExt(GetTempFile, frxGet(8852))
+ end;
+ if (FileName <> '') or Assigned(Stream) then
+ begin
+ if (ExtractFilePath(FileName) = '') and (DefaultPath <> '') then
+ FileName := DefaultPath + '\' + FileName;
+ FMatrix := TfrxIEMatrix.Create(UseFileCache, Report.EngineOptions.TempDir);
+ FMatrix.Background := False;
+ FMatrix.BackgroundImage := False;
+ FMatrix.Printable := ExportNotPrintable;
+ FMatrix.RichText := True;
+ FMatrix.PlainRich := True;
+ FMatrix.AreaFill := False;
+ FMatrix.CropAreaFill := True;
+ FMatrix.Inaccuracy := 0.5;
+ FMatrix.DeleteHTMLTags := True;
+ FMatrix.Images := False;
+ FMatrix.WrapText := True;
+ FMatrix.ShowProgress := False;
+ FMatrix.FramesOptimization := True;
+ try
+ if Assigned(Stream) then
+ Exp := Stream
+ else
+ Exp := TFileStream.Create(FileName, fmCreate);
+ Result := True;
+ except
+ Result := False;
+ end;
+ end
+ else
+ Result := False;
+end;
+
+procedure TfrxCSVExport.StartPage(Page: TfrxReportPage; Index: Integer);
+begin
+ FMatrix.Clear;
+end;
+
+procedure TfrxCSVExport.ExportObject(Obj: TfrxComponent);
+begin
+ if Obj is TfrxView then
+ FMatrix.AddObject(TfrxView(Obj));
+end;
+
+procedure TfrxCSVExport.FinishPage(Page: TfrxReportPage; Index: Integer);
+begin
+ FPage := Page;
+ ExportPage(Exp);
+end;
+
+procedure TfrxCSVExport.Finish;
+begin
+ FMatrix.Free;
+ if not Assigned(Stream) then
+ Exp.Free;
+ //if FOpenAfterExport and (not Assigned(Stream)) then
+ // ShellExecute(GetDesktopWindow, 'open', PChar(FileName), nil, nil, SW_SHOW);
+ if FOpenAfterExport and (not Assigned(Stream)) then
+ {$IFDEF MSWINDOWS}
+ ShellExecute(0, 'open', PChar(FileName), '', '', 5);
+ {$ENDIF}
+ {$IFDEF LINUX}
+ FmuxOpenFile(PChar(FileName));
+ {$ENDIF}
+ {$IFDEF MACOS}
+ ShellExecute(FileName);
+ {$ENDIF}
+end;
+
+{ TfrxCSVExportDialog }
+
+procedure TfrxCSVExportDialog.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(8850);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ GroupPageRange.Text := frxGet(7);
+ AllRB.Text := frxGet(3);
+ CurPageRB.Text := frxGet(4);
+ PageNumbersRB.Text := frxGet(5);
+ DescrL.Text := frxGet(9);
+ GroupQuality.Text := frxGet(8302);
+ OEMCB.Text := frxGet(8304);
+ OpenCB.Text := frxGet(8706);
+ SaveDialog1.Filter := frxGet(8851);
+ SaveDialog1.DefaultExt := frxGet(8852);
+ SeparatorLB.Text := frxGet(8853);
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxCSVExportDialog.PageNumbersEChange(Sender: TObject);
+begin
+ PageNumbersRB.IsChecked := True;
+end;
+
+procedure TfrxCSVExportDialog.PageNumbersEKeyPress(Sender: TObject;
+ var Key: Char);
+begin
+ case key of
+ '0'..'9':;
+ #8, '-', ',':;
+ else
+ key := #0;
+ end;
+end;
+
+procedure TfrxCSVExportDialog.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+end.
diff --git a/LibD28/FMX.frxExportHTML.fmx b/LibD28/FMX.frxExportHTML.fmx
new file mode 100644
index 0000000..8f7db1e
--- /dev/null
+++ b/LibD28/FMX.frxExportHTML.fmx
@@ -0,0 +1,171 @@
+object frxHTMLExportDialog: TfrxHTMLExportDialog
+ Left = 0
+ Top = 0
+ Caption = 'Export to HTML'
+ ClientHeight = 318
+ ClientWidth = 290
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object GroupQuality: TGroupBox
+ Position.Point = '(4,144)'
+ Width = 281.000000000000000000
+ Height = 109.000000000000000000
+ TabOrder = 0
+ object PicturesL: TLabel
+ Position.Point = '(12,84)'
+ Width = 73.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object StylesCB: TCheckBox
+ Position.Point = '(12,20)'
+ Width = 129.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ object PicsSameCB: TCheckBox
+ Position.Point = '(12,40)'
+ Width = 129.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object FixWidthCB: TCheckBox
+ Position.Point = '(144,20)'
+ Width = 129.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ object NavigatorCB: TCheckBox
+ Position.Point = '(12,60)'
+ Width = 129.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 4
+ end
+ object MultipageCB: TCheckBox
+ Position.Point = '(144,40)'
+ Width = 129.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 5
+ end
+ object BackgrCB: TCheckBox
+ Position.Point = '(144,60)'
+ Width = 129.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 6
+ end
+ object PFormatCB: TComboBox
+ Position.Point = '(88,80)'
+ Width = 181.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 7
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ object ListBoxItem1: TListBoxItem
+ Position.Point = '(5000,5000)'
+ Width = 19.000000000000000000
+ Height = 19.000000000000000000
+ HitTest = False
+ TabOrder = 0
+ Text = 'None'
+ end
+ object ListBoxItem2: TListBoxItem
+ Position.Point = '(5000,5000)'
+ Width = 19.000000000000000000
+ Height = 19.000000000000000000
+ HitTest = False
+ TabOrder = 1
+ Text = 'JPEG'
+ end
+ object ListBoxItem3: TListBoxItem
+ Position.Point = '(5000,5000)'
+ Width = 19.000000000000000000
+ Height = 19.000000000000000000
+ HitTest = False
+ TabOrder = 2
+ Text = 'BMP'
+ end
+ object ListBoxItem4: TListBoxItem
+ Position.Point = '(5000,5000)'
+ Width = 19.000000000000000000
+ Height = 19.000000000000000000
+ HitTest = False
+ TabOrder = 3
+ Text = 'GIF'
+ end
+ end
+ end
+ object GroupPageRange: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 281.000000000000000000
+ Height = 141.000000000000000000
+ TabOrder = 1
+ object DescrL: TLabel
+ Position.Point = '(12,82)'
+ Width = 249.000000000000000000
+ Height = 47.000000000000000000
+ TabOrder = 0
+ end
+ object AllRB: TRadioButton
+ Position.Point = '(12,20)'
+ Width = 153.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 108
+ TabOrder = 1
+ IsChecked = True
+ end
+ object CurPageRB: TRadioButton
+ Position.Point = '(12,40)'
+ Width = 153.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 118
+ TabOrder = 2
+ end
+ object PageNumbersRB: TRadioButton
+ Position.Point = '(12,60)'
+ Width = 77.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 124
+ TabOrder = 3
+ end
+ object PageNumbersE: TEdit
+ Position.Point = '(92,58)'
+ Width = 177.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 133
+ TabOrder = 4
+ KeyboardType = vktDefault
+ OnChange = PageNumbersEChange
+ Password = False
+ end
+ end
+ object OpenAfterCB: TCheckBox
+ Position.Point = '(12,260)'
+ Width = 257.000000000000000000
+ Height = 17.000000000000000000
+ Visible = False
+ TabOrder = 2
+ end
+ object OkB: TButton
+ Position.Point = '(130,288)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 3
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(210,288)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 4
+ ModalResult = 2
+ Cancel = True
+ end
+ object SaveDialog1: TSaveDialog
+ FilterIndex = 0
+ Options = [ofHideReadOnly, ofNoChangeDir, ofEnableSizing]
+ end
+end
diff --git a/LibD28/FMX.frxExportHTML.pas b/LibD28/FMX.frxExportHTML.pas
new file mode 100644
index 0000000..4376db6
--- /dev/null
+++ b/LibD28/FMX.frxExportHTML.pas
@@ -0,0 +1,1244 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ HTML table export filter }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Fediachov, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxExportHTML;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Types, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.frxExportMatrix, FMX.frxProgress, fmx.frxImageConverter, System.UIConsts,
+ System.Variants, FMX.Edit, FMX.ListBox, FMX.frxBaseModalForm
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+type
+ TfrxHTMLExportDialog = class(TfrxForm)
+ SaveDialog1: TSaveDialog;
+ GroupQuality: TGroupBox;
+ StylesCB: TCheckBox;
+ PicsSameCB: TCheckBox;
+ FixWidthCB: TCheckBox;
+ NavigatorCB: TCheckBox;
+ MultipageCB: TCheckBox;
+ GroupPageRange: TGroupBox;
+ DescrL: TLabel;
+ AllRB: TRadioButton;
+ CurPageRB: TRadioButton;
+ PageNumbersRB: TRadioButton;
+ PageNumbersE: TEdit;
+ OpenAfterCB: TCheckBox;
+ OkB: TButton;
+ CancelB: TButton;
+ BackgrCB: TCheckBox;
+ PicturesL: TLabel;
+ PFormatCB: TComboBox;
+ ListBoxItem1: TListBoxItem;
+ ListBoxItem2: TListBoxItem;
+ ListBoxItem3: TListBoxItem;
+ ListBoxItem4: TListBoxItem;
+ procedure FormCreate(Sender: TObject);
+ procedure PageNumbersEChange(Sender: TObject);
+ procedure PageNumbersEKeyPress(Sender: TObject; var Key: Char);
+ procedure FormKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+ end;
+
+ TfrxHTMLExportGetNavTemplate = procedure(const ReportName: String;
+ Multipage: Boolean; PicsInSameFolder: Boolean; Prefix: String;
+ TotalPages: Integer; var Template: String) of object;
+
+ TfrxHTMLExportGetMainTemplate = procedure(const Title: String;
+ const FrameFolder: String;
+ Multipage: Boolean; var Template: String) of object;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxHTMLExport = class(TfrxCustomExportFilter)
+ private
+ Exp: TStream;
+ FAbsLinks: Boolean;
+ FCurrentPage: Integer;
+ FExportPictures: Boolean;
+ FExportStyles: Boolean;
+ FFixedWidth: Boolean;
+ FMatrix: TfrxIEMatrix;
+ FMozillaBrowser: Boolean;
+ FMultipage: Boolean;
+ FNavigator: Boolean;
+ FOpenAfterExport: Boolean;
+ FPicsInSameFolder: Boolean;
+ FPicturesCount: Integer;
+ FProgress: TfrxProgress;
+ FServer: Boolean;
+ FPrintLink: String;
+ FRefreshLink: String;
+ FBackground: Boolean;
+ FBackImage: TBitmap;
+ FBackImageExist: Boolean;
+ FReportPath: String;
+ FCentered: Boolean;
+ FEmptyLines: Boolean;
+ FURLTarget: String;
+ FPictureType: TfrxPictureType;
+
+// FAvExports: String;
+// FSession: String;
+ FPrint: Boolean;
+
+ FUseTemplates: Boolean;
+ FGetNavTemplate: TfrxHTMLExportGetNavTemplate;
+ FGetMainTemplate: TfrxHTMLExportGetMainTemplate;
+
+ FHTMLDocumentBegin: TStrings;
+ FHTMLDocumentBody: TStrings;
+ FHTMLDocumentEnd: TStrings;
+
+ procedure WriteExpLn(const str: String);
+ procedure WriteExpLnA(const str: AnsiString);
+ procedure ExportPage;
+ function ChangeReturns(const Str: String): String;
+ function TruncReturns(const Str: WideString): WideString;
+ function GetPicsFolder: String;
+ function GetPicsFolderRel: String;
+ function GetFrameFolder: String;
+ function ReverseSlash(const S: String): String;
+ function HTMLCodeStr(const Str: String): String;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function ShowModal: TModalResult; override;
+ function Start: Boolean; override;
+ procedure Finish; override;
+ procedure FinishPage(Page: TfrxReportPage; Index: Integer); override;
+ procedure StartPage(Page: TfrxReportPage; Index: Integer); override;
+ procedure ExportObject(Obj: TfrxComponent); override;
+ class function GetDescription: String; override;
+ property Server: Boolean read FServer write FServer;
+ property PrintLink: String read FPrintLink write FPrintLink;
+ property RefreshLink: String read FRefreshLink write FRefreshLink;
+ property ReportPath: String read FReportPath write FReportPath;
+
+ property UseTemplates: Boolean read FUseTemplates write FUseTemplates;
+ property OnGetMainTemplate: TfrxHTMLExportGetMainTemplate read FGetMainTemplate
+ write FGetMainTemplate;
+ property OnGetNavTemplate: TfrxHTMLExportGetNavTemplate read FGetNavTemplate
+ write FGetNavTemplate;
+ published
+ property OpenAfterExport: Boolean read FOpenAfterExport write FOpenAfterExport default False;
+ property FixedWidth: Boolean read FFixedWidth write FFixedWidth default False;
+ property ExportPictures: Boolean read FExportPictures write FExportPictures default True;
+ property PicsInSameFolder: Boolean read FPicsInSameFolder write FPicsInSameFolder default False;
+ property ExportStyles: Boolean read FExportStyles write FExportStyles default True;
+ property Navigator: Boolean read FNavigator write FNavigator default False;
+ property Multipage: Boolean read FMultipage write FMultipage default False;
+ property MozillaFrames: Boolean read FMozillaBrowser write FMozillaBrowser default False;
+ property AbsLinks: Boolean read FAbsLinks write FAbsLinks default False;
+ property Background: Boolean read FBackground write FBackground;
+ property Centered: Boolean read FCentered write FCentered;
+ property EmptyLines: Boolean read FEmptyLines write FEmptyLines;
+ property OverwritePrompt;
+ property HTMLDocumentBegin: TStrings read FHTMLDocumentBegin;
+ property HTMLDocumentBody: TStrings read FHTMLDocumentBody;
+ property HTMLDocumentEnd: TStrings read FHTMLDocumentEnd;
+ property URLTarget: String read FURLTarget write FURLTarget;
+ property Print: Boolean read FPrint write FPrint;
+ property PictureType: TfrxPictureType read FPictureType write FPictureType;
+ end;
+
+
+implementation
+
+uses FMX.frxUtils, {FMX.frxFileUtils,} FMX.frxUnicodeUtils, FMX.frxRes, FMX.frxrcExports, System.Math, FMX.frxGraphicUtils, FMX.frxFMX
+ {$IFDEF MSWINDOWS}
+ , Winapi.ShellAPI
+ {$ENDIF}
+ {$IFDEF LINUX}
+ ,FMUX.Api
+ {$ENDIF};
+
+{$R *.fmx}
+
+const
+ Xdivider = 1;
+ Ydivider = 1.03;
+ Navigator_src =
+ ''#13#10 +
+ '' +
+ '' +
+ '' +
+ ''#13#10 +
+ ''#13#10 +
+ '';
+ Server_sect =
+ '
'#13#10 +
+ '
'#13#10;
+ DefPrint = 'parent.mainFrame.focus(); parent.mainFrame.print();';
+ LinkPrint = 'parent.location = "%s";';
+ DefRefresh = 'parent.location = "result?report=" + frRepName + "&multipage=" + frMultipage;';
+ LinkRefresh = 'parent.location = "%s";';
+
+{ TfrxHTMLExport }
+
+constructor TfrxHTMLExport.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FExportPictures := True;
+ FExportStyles := True;
+ FFixedWidth := True;
+ FServer := False;
+ FPrintLink := '';
+ FBackground := False;
+ FCentered := False;
+ FBackImage := TBitmap.Create(0, 0);
+ FilterDesc := frxGet(8210);
+ DefaultExt := frxGet(8211);
+ FEmptyLines := True;
+ Files := TStringList.Create;
+ FUseTemplates := False;
+ FHTMLDocumentBegin := TStringList.Create;
+ FHTMLDocumentBegin.Add('');
+ FHTMLDocumentBegin.Add('');
+ FHTMLDocumentBegin.Add('');
+ FHTMLDocumentBegin.Add('');
+ FHTMLDocumentBody := TStringList.Create;
+ FHTMLDocumentEnd := TStringList.Create;
+ FHTMLDocumentEnd.Add('');
+ FURLTarget := '';
+ FPrint := false;
+end;
+
+class function TfrxHTMLExport.GetDescription: String;
+begin
+ Result := frxResources.Get('HTMLexport');
+end;
+
+function TfrxHTMLExport.TruncReturns(const Str: WideString): WideString;
+var
+ l: Integer;
+begin
+ l := Length(Str);
+ if (l > 1) and (Str[l - 1] = #13) and (Str[l] = #10) then
+ Result := Copy(Str, 1, l - 2)
+ else
+ Result := Str;
+end;
+
+function TfrxHTMLExport.ChangeReturns(const Str: string): string;
+
+ function Hex(x: Byte): string;
+ const
+ d: string = '0123456789abcdef';
+ begin
+ Result := d[1 + x div 16] + d[1 + x mod 16];
+ end;
+
+ function HexColor(x: TColor): string;
+ var
+ r, g, b: Byte;
+ begin
+ r := x and 255;
+ g := (x shr 8) and 255;
+ b := (x shr 16) and 255;
+
+ Result := Hex(r) + Hex(g) + Hex(b);
+ end;
+
+ function EscapeSymbols(s: string): string;
+ var
+ i: Integer;
+ c: string;
+ begin
+ Result := '';
+
+ for i := 1 to Length(s) do
+ begin
+ c := s[i];
+
+ case s[i] of
+ '<': c := '<';
+ '>': c := '>';
+ '&': c := '&';
+ '"': c := '"';
+ #13: c := '';
+ #10:
+ if (i > 1) and (s[i - 1] = #13) then
+ c := ' ';
+ end;
+
+ Result := Result + c;
+ end;
+ end;
+
+ { function TaggedStr(s: string; t: TfrxHTMLTag): string;
+ begin
+ s := EscapeSymbols(s);
+
+ if fsBold in t.Style then
+ s := '' + s + '';
+
+ if fsItalic in t.Style then
+ s := '' + s + '';
+
+ if fsUnderline in t.Style then
+ s := '' + s + '';
+
+ if fsStrikeOut in t.Style then
+ s := '' + s + '';
+
+ if t.Color <> 0 then
+ s := '' + s + '';
+
+ Result := s;
+ end; }
+
+{var
+ i, j: Integer;
+ ht: TfrxHTMLTagsList;
+ LastTag, Tag: TfrxHTMLTag;
+ s: WideString;}
+begin
+{ s := Str;
+
+ ht := TfrxHTMLTagsList.Create;
+ ht.AllowTags := True;
+ ht.ExpandHTMLTags(s);
+
+ LastTag := nil;
+ s := '';
+ Result := '';
+
+ for i := 0 to ht.Count - 1 do
+ for j := 0 to ht[i].Count - 1 do
+ begin
+ Tag := ht[i][j];
+
+ if (LastTag <> nil) and ((LastTag.Style <> Tag.Style) or (LastTag.Color <> Tag.Color)) then
+ begin
+ Result := Result + TaggedStr(s, LastTag);
+ s := '';
+ end;
+
+ s := s + Str[Tag.Position + 1];
+ LastTag := Tag;
+ end;
+
+
+ if s <> '' then
+ Result := Result + TaggedStr(s, LastTag);
+
+ ht.Free; }
+ //todo
+ Result := Str;
+end;
+
+procedure TfrxHTMLExport.WriteExpLn(const str: String);
+var
+ TempStr: AnsiString;
+begin
+ TempStr := UTF8Encode(str);
+ Exp.Write(TempStr[1], Length(TempStr));
+ Exp.Write(AnsiChar(#13)+AnsiChar(#10), 2);
+end;
+
+procedure TfrxHTMLExport.WriteExpLnA(const str: AnsiString);
+begin
+ Exp.Write(str[1], Length(str));
+ Exp.Write(AnsiChar(#13)+AnsiChar(#10), 2);
+end;
+
+procedure TfrxHTMLExport.ExportPage;
+var
+ i, x, y, dx, dy, fx, fy, pbk: Integer;
+ dcol, drow: Integer;
+ text, buff: String;
+ s, s1, sb, si, su: String;
+ Vert, Horiz: String;
+ obj: TfrxIEMObject;
+ EStyle: TfrxIEMStyle;
+ St: String;
+ hlink, newpage: Boolean;
+ tableheader, columnWidths: String;
+
+ procedure AlignFR2AlignExcel(HAlign: TfrxHAlign; VAlign: TfrxVAlign;
+ var AlignH, AlignV: String);
+ begin
+ if HAlign = haLeft then
+ AlignH := 'Left'
+ else if HAlign = haRight then
+ AlignH := 'Right'
+ else if HAlign = haCenter then
+ AlignH := 'Center'
+ else if HAlign = haBlock then
+ AlignH := 'Justify'
+ else
+ AlignH := '';
+ if VAlign = vaTop then
+ AlignV := 'Top'
+ else if VAlign = vaBottom then
+ AlignV := 'Bottom'
+ else if VAlign = vaCenter then
+ AlignV := 'Middle'
+ else
+ AlignV := '';
+ end;
+
+begin
+ WriteExpLn(FHTMLDocumentBegin.Text);
+ if FPrint then
+ WriteExpLn('');
+ if Length(Report.ReportOptions.Name) > 0 then
+ s := Report.ReportOptions.Name
+ else
+ s := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(Report.FileName)), '');
+ WriteExpLnA('' + UTF8Encode(s) + '');
+
+ if FExportStyles then
+ begin
+ WriteExpLn('');
+ end;
+ WriteExpLn('');
+ WriteExpLn('');
+ WriteExpLn(FHTMLDocumentBody.Text);
+ WriteExpLn('');
+ if FFixedWidth then
+ st := ' width="' + IntToStr(Round((FMatrix.MaxWidth - FMatrix.Left) / Xdivider)) + '"'
+ else
+ st := '';
+ if FCentered then
+ st := st + ' align="center"';
+ tableheader := '');
+
+ columnWidths := '
';
+ for x := 0 to FMatrix.Width - 2 do
+ begin
+ dcol := Round((FMatrix.GetXPosById(x + 1) - FMatrix.GetXPosById(x)) / Xdivider);
+ columnWidths := columnWidths + '
';
+ end;
+ if FMatrix.Width < 2 then
+ columnWidths := columnWidths + '
';
+ columnWidths := columnWidths + '
';
+ WriteExpLn(columnWidths);
+
+ pbk := 0;
+ st := '';
+ newpage := False;
+
+ for y := 0 to FMatrix.Height - 2 do
+ begin
+ if ShowProgress and (not FMultipage) then
+ if FProgress.Terminated then
+ break;
+ drow := Round((FMatrix.GetYPosById(y + 1) - FMatrix.GetYPosById(y)) / Ydivider);
+ s := '';
+ if FMatrix.PagesCount > pbk then
+ if Round(FMatrix.GetPageBreak(pbk)) <= Round(FMatrix.GetYPosById(y + 1)) then
+ begin
+ Inc(pbk);
+ if ShowProgress and (not FMultipage) then
+ FProgress.Tick;
+ newpage := True;
+ end;
+ if drow = 0 then
+ drow := 1;
+ WriteExpLn('
');
+ if newpage then
+ begin
+ WriteExpLn('');
+ newpage := False;
+ if y < FMatrix.Height - 2 then
+ begin
+ WriteExpLn('');
+ WriteExpLn(tableheader + ' class="page_break">');
+ WriteExpLn(columnWidths);
+ end;
+ end;
+ end;
+ if FMultipage or (FMatrix.Height < 2) then
+ WriteExpLn('');
+ WriteExpLn(FHTMLDocumentEnd.Text);
+end;
+
+function TfrxHTMLExport.ShowModal: TModalResult;
+begin
+ if not Assigned(Stream) then
+ begin
+ with TfrxHTMLExportDialog.Create(nil) do
+ begin
+ //SendMessage(GetWindow(PFormatCB.Handle,GW_CHILD), EM_SETREADONLY, 1, 0);
+ OpenAfterCB.Visible := not SlaveExport;
+ MultipageCB.Enabled := not SlaveExport;
+ BackgrCB.Enabled := not SlaveExport;
+ NavigatorCB.Enabled := not SlaveExport;
+ PicsSameCB.Enabled := not SlaveExport;
+ if OverwritePrompt then
+ SaveDialog1.Options := SaveDialog1.Options + [TOpenOption.ofOverwritePrompt];
+
+ if SlaveExport then
+ begin
+ FOpenAfterExport := False;
+ FExportPictures := True;
+ FPicsInSameFolder := True;
+ FNavigator := False;
+ FMultipage := False;
+ FBackground := False;
+ end;
+
+ if (FileName = '') and (not SlaveExport) then
+ SaveDialog1.FileName := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(Report.FileName)), SaveDialog1.DefaultExt)
+ else
+ SaveDialog1.FileName := FileName;
+
+ StylesCB.IsChecked := FExportStyles;
+ PicsSameCB.IsChecked := FPicsInSameFolder;
+
+ if not FExportPictures then
+ PFormatCB.ItemIndex := 0
+ else
+ case PictureType of
+ gpBMP: PFormatCB.ItemIndex := 2;
+ gpJPG: PFormatCB.ItemIndex := 1;
+ gpGIF: PFormatCB.ItemIndex := 3;
+ else PFormatCB.ItemIndex := 1;
+ end;
+
+ OpenAfterCB.IsChecked := FOpenAfterExport;
+ FixWidthCB.IsChecked := FFixedWidth;
+ NavigatorCB.IsChecked := FNavigator;
+ MultipageCB.IsChecked := FMultipage;
+ BackgrCB.IsChecked := FBackground;
+
+ if PageNumbers <> '' then
+ begin
+ PageNumbersE.Text := PageNumbers;
+ PageNumbersRB.IsChecked := True;
+ end;
+
+ Result := ShowModal;
+ PeekLastModalResult;
+ if Result = mrOk then
+ begin
+ PageNumbers := '';
+ CurPage := False;
+ if CurPageRB.IsChecked then
+ CurPage := True
+ else if PageNumbersRB.IsChecked then
+ PageNumbers := PageNumbersE.Text;
+
+ FExportStyles := StylesCB.IsChecked;
+ FPicsInSameFolder := PicsSameCB.IsChecked;
+
+ FExportPictures := PFormatCB.ItemIndex > 0;
+
+ case PFormatCB.ItemIndex of
+ 1: PictureType := gpJPG;
+ 2: PictureType := gpBMP;
+ 3: PictureType := gpGIF;
+ else PictureType := gpPNG;
+ end;
+
+ FOpenAfterExport := OpenAfterCB.IsChecked;
+ FFixedWidth := FixWidthCB.IsChecked;
+ FMultipage := MultipageCB.IsChecked;
+ FNavigator := NavigatorCB.IsChecked;
+ FBackground := BackgrCB.IsChecked;
+
+ if not SlaveExport then
+ begin
+ if DefaultPath <> '' then
+ SaveDialog1.InitialDir := DefaultPath;
+ if SaveDialog1.Execute then
+ FileName := SaveDialog1.FileName
+ else
+ Result := mrCancel;
+ PeekLastModalResult;
+ end;
+ end;
+ Free;
+ end
+ end else
+ Result := mrOk;
+end;
+
+function TfrxHTMLExport.Start: Boolean;
+begin
+ if SlaveExport then
+ begin
+ FOpenAfterExport := False;
+ FExportPictures := True;
+ FPicsInSameFolder := True;
+ FNavigator := False;
+ FMultipage := False;
+ FBackground := False;
+ if Report.FileName <> '' then
+ FileName := ChangeFileExt(GetTemporaryFolder + ExtractFileName(Report.FileName), frxGet(8211))
+ else
+ FileName := ChangeFileExt(GetTempFile, frxGet(8211));
+ end;
+ if (FileName <> '') or Assigned(Stream) then
+ begin
+ if (ExtractFilePath(FileName) = '') and (DefaultPath <> '') then
+ FileName := DefaultPath + PathDelim + FileName;
+ FCurrentPage := 0;
+ FPicturesCount := 0;
+ FMatrix := TfrxIEMatrix.Create(UseFileCache, Report.EngineOptions.TempDir);
+ FMatrix.Report := Report;
+ if not FMultipage then
+ FMatrix.ShowProgress := ShowProgress
+ else
+ FMatrix.ShowProgress := False;
+ FMatrix.Inaccuracy := 0.5;
+ FMatrix.RotatedAsImage := True;
+ FMatrix.FramesOptimization := True;
+ FMatrix.Background := FBackground;
+ FMatrix.BackgroundImage := False;
+ FMatrix.Printable := ExportNotPrintable;
+ FMatrix.RichText := True;
+ FMatrix.PlainRich := True;
+ FMatrix.EmptyLines := EmptyLines;
+ if Assigned(Stream) then
+ begin
+ FMultipage := False;
+ FExportPictures := False;
+ FNavigator := False;
+ end;
+ Result := True
+ end
+ else
+ Result := False;
+ Files.Clear;
+end;
+
+procedure TfrxHTMLExport.StartPage(Page: TfrxReportPage; Index: Integer);
+begin
+ Inc(FCurrentPage);
+ FBackImageExist := False;
+ FBackImage.Width := 0;
+ FBackImage.Height := 0;
+end;
+
+procedure TfrxHTMLExport.ExportObject(Obj: TfrxComponent);
+begin
+ if (Obj is TfrxView) and (ExportNotPrintable or TfrxView(Obj).Printable) then
+ begin
+ if (Obj is TfrxCustomMemoView) or (Obj is TfrxLineView) or
+ (FExportPictures and (not (Obj is TfrxCustomMemoView))) then
+ FMatrix.AddObject(TfrxView(Obj));
+ if (TfrxView(Obj).Name = '_pagebackground') and FExportPictures and FBackground then
+ begin
+ FBackImageExist := True;
+ FBackImage.Width := Round(TfrxView(Obj).Width);
+ FBackImage.Height := Round(TfrxView(Obj).Height);
+ FBackImage.Canvas.BeginScene();
+ try
+ TfrxView(Obj).Draw(FBackImage.Canvas ,1, 1, -TfrxView(Obj).AbsLeft, -TfrxView(Obj).AbsTop);
+ finally
+ FBackImage.Canvas.EndScene;
+ end;
+ end;
+ end;
+end;
+
+procedure TfrxHTMLExport.FinishPage(Page: TfrxReportPage; Index: Integer);
+var
+ s: String;
+begin
+ if FMultipage then
+ begin
+ FMatrix.Prepare;
+ try
+ s := GetPicsFolder + IntToStr(FCurrentPage) + '.html';
+ Files.Add(s);
+ Exp := TFileStream.Create(s, fmCreate);
+ try
+ ExportPage;
+ finally
+ FMatrix.Clear;
+ Exp.Free;
+ end;
+ except
+ on e: Exception do
+ case Report.EngineOptions.NewSilentMode of
+ simSilent: Report.Errors.Add(e.Message);
+ simMessageBoxes: frxErrorMsg(e.Message);
+ simReThrow: raise;
+ end;
+ end;
+ end
+ else FMatrix.AddPage(Page.Orientation, Page.Width, Page.Height, Page.LeftMargin,
+ Page.TopMargin, Page.RightMargin, Page.BottomMargin, Page.MirrorMargins, Index);
+end;
+
+procedure TfrxHTMLExport.Finish;
+var
+ s, st, print: String;
+ serv, Refresh: String;
+ TempString: AnsiString;
+begin
+ if not FMultipage then
+ begin
+ if ShowProgress then
+ begin
+ FProgress := TfrxProgress.Create(nil);
+ FProgress.Execute(FCurrentPage - 1, frxResources.Get('ProgressWait'), true, true);
+ end;
+ FMatrix.Prepare;
+ try
+ if ShowProgress then
+ if FProgress.Terminated then
+ Exit;
+ if not Assigned(Stream) then
+ begin
+ if FNavigator then
+ begin
+ s := GetPicsFolder + 'main.html';
+ Files.Add(s);
+ Exp := TFileStream.Create(s, fmCreate);
+ end
+ else
+ begin
+ Exp := TFileStream.Create(FileName, fmCreate);
+ Files.Add(FileName);
+ end;
+ end
+ else
+ Exp := Stream;
+ try
+ ExportPage;
+ finally
+ FMatrix.Clear;
+ if not Assigned(Stream) then
+ Exp.Free;
+ end;
+ except
+ on e: Exception do
+ case Report.EngineOptions.NewSilentMode of
+ simSilent: Report.Errors.Add(e.Message);
+ simMessageBoxes: frxErrorMsg(e.Message);
+ simReThrow: raise;
+ end;
+ end;
+ if ShowProgress then
+ FProgress.Free;
+ end;
+ if FNavigator then
+ begin
+ try
+ s := GetPicsFolder + 'nav.html';
+ Files.Add(s);
+ Exp := TFileStream.Create(s, fmCreate);
+ try
+ if not FUseTemplates then
+ begin
+ if FMultipage then
+ s := '1'
+ else
+ s := '0';
+ st := '';
+ if FPicsInSameFolder then
+ st := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(FileName)), '.');
+ if FServer then
+ serv := Format(Server_sect, [UTF8Encode(frxResources.Get('HTMLNavRefresh')), UTF8Encode(frxResources.Get('HTMLNavPrint'))])
+ else
+ serv := '';
+ if Length(FPrintLink) > 0 then
+ print := Format(LinkPrint, [FPrintLink])
+ else
+ print := DefPrint;
+
+ if Length(FRefreshLink) > 0 then
+ refresh := Format(LinkRefresh, [FRefreshLink])
+ else
+ refresh := DefRefresh;
+
+ WriteExpLn(Format(Navigator_src, [
+ IntToStr(FCurrentPage),
+ HTMLCodeStr(StringReplace(Report.FileName, FReportPath, '', [])),
+ s, st, Refresh, print,
+ UTF8Encode(frxResources.Get('HTMLNavFirst')),
+ UTF8Encode(frxResources.Get('HTMLNavPrev')),
+ UTF8Encode(frxResources.Get('HTMLNavNext')),
+ UTF8Encode(frxResources.Get('HTMLNavLast')),
+ serv, UTF8Encode(frxResources.Get('HTMLNavTotal'))]));
+ end
+ else
+ begin
+ if Assigned(FGetNavTemplate) then
+ begin
+ s := '';
+ FGetNavTemplate(HTMLCodeStr(StringReplace(Report.FileName, FReportPath, '', [])),
+ FMultipage, FPicsInSameFolder,
+ ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(FileName)), '.'),
+ FCurrentPage,
+ s
+ );
+ TempString := UTF8Encode(s);
+ Exp.Write(TempString[1], Length(TempString));
+ end;
+ end;
+ finally
+ Exp.Free;
+ end;
+ except
+ on e: Exception do
+ case Report.EngineOptions.NewSilentMode of
+ simSilent: Report.Errors.Add(e.Message);
+ simMessageBoxes: frxErrorMsg(e.Message);
+ simReThrow: raise;
+ end;
+ end;
+ try
+ Files.Add(FileName);
+ Exp := TFileStream.Create(FileName, fmCreate);
+ try
+ if Length(Report.ReportOptions.Name) > 0 then
+ s := Report.ReportOptions.Name
+ else
+ s := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(Report.FileName)), '');
+ if not FUseTemplates then
+ begin
+ WriteExpLn('');
+ WriteExpLn('');
+ WriteExpLnA('' + UTF8Encode(s) + '');
+ WriteExpLn('');
+ WriteExpLn('');
+ WriteExpLn('');
+ WriteExpLn('');
+ end
+ else
+ begin
+ if Assigned(FGetMainTemplate) then
+ begin
+ st := '';
+ FGetMainTemplate(
+ String(UTF8Encode(s)), // title
+ ReverseSlash(GetFrameFolder), // frame folder
+ FMultipage, // multipage
+ st
+ );
+ TempString := UTF8Encode(st);
+ Exp.Write(TempString[1], Length(TempString));
+ end;
+ end;
+ finally
+ Exp.Free;
+ end;
+ except
+ on e: Exception do
+ case Report.EngineOptions.NewSilentMode of
+ simSilent: Report.Errors.Add(e.Message);
+ simMessageBoxes: frxErrorMsg(e.Message);
+ simReThrow: raise;
+ end;
+ end;
+ end;
+
+ FMatrix.Free;
+ //todo
+ if FOpenAfterExport and (not Assigned(Stream)) then
+ if FMultipage and (not FNavigator) then
+{$IFDEF MSWINDOWS}
+ ShellExecute(0, 'open', PChar(GetPicsFolder + '1.html'), '', '', 5)
+{$ENDIF}
+{$IFDEF LINUX}
+ FmuxOpenFile(PChar(GetPicsFolder + '1.html'))
+{$ENDIF}
+{$IFDEF MACOS}
+ ShellExecute(GetPicsFolder + '1.html')
+{$ENDIF}
+ else
+{$IFDEF MSWINDOWS}
+ ShellExecute(0, 'open', PChar(FileName), '', '', 5);
+{$ENDIF}
+{$IFDEF LINUX}
+ FmuxOpenFile(PChar(FileName));
+{$ENDIF}
+{$IFDEF MACOS}
+ ShellExecute(FileName);
+{$ENDIF}
+end;
+
+function TfrxHTMLExport.GetPicsFolderRel: String;
+begin
+ if FPicsInSameFolder then
+ Result := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(FileName)), '.')
+ else if FMultipage then
+ Result := ''
+ else if FAbsLinks then
+ Result := ExtractFilePath(FileName) + ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(FileName)),'.files') + PathDelim
+ else if FNavigator then
+ Result := ''
+ else
+ Result := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(FileName)),'.files') + PathDelim
+end;
+
+function TfrxHTMLExport.GetFrameFolder: String;
+begin
+ if not FPicsInSameFolder then
+ Result := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(FileName)),'.files') + PathDelim
+ else
+ Result := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(FileName)), '.');
+end;
+
+function TfrxHTMLExport.GetPicsFolder: String;
+{var
+ SecAtrtrs: TSecurityAttributes; }
+begin
+ if FPicsInSameFolder then
+ begin
+ if FAbsLinks then
+ Result := ExtractFilePath(FileName) + ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(FileName)), '.')
+ else
+ Result := ChangeFileExt(frxUnixPath2WinPath(FileName), '.') //ExtractFileName
+ end
+ else
+ begin
+ if FAbsLinks then
+ Result := ExtractFilePath(FileName) + ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(FileName)), '.files')
+ else
+ Result := ChangeFileExt(frxUnixPath2WinPath(FileName), '.files'); //ExtractFileName
+{ SecAtrtrs.nLength := SizeOf(TSecurityAttributes);
+ SecAtrtrs.lpSecurityDescriptor := nil;
+ SecAtrtrs.bInheritHandle := True;
+ CreateDirectory(PChar(Result), @SecAtrtrs); }
+ CreateDir(Result);
+ Result := Result + PathDelim;
+ end;
+end;
+
+function TfrxHTMLExport.ReverseSlash(const S: String): String;
+begin
+ Result := StringReplace(S, '\', '/', [rfReplaceAll]);
+end;
+
+destructor TfrxHTMLExport.Destroy;
+begin
+ FHTMLDocumentBegin.Free;
+ FHTMLDocumentBody.Free;
+ FHTMLDocumentEnd.Free;
+ FBackImage.Free;
+ Files.Free;
+ Files := nil;
+ inherited;
+end;
+
+function TfrxHTMLExport.HTMLCodeStr(const Str: String): String;
+var
+ i: Integer;
+ c: Char;
+ s: String;
+
+ function StrToHex(const s: String): String;
+ var
+ Len, i: Integer;
+ C, H, L: Byte;
+
+ function HexChar(N : Byte) : Char;
+ begin
+ if (N < 10) then Result := Chr(Ord('0') + N)
+ else Result := Chr(Ord('A') + (N - 10));
+ end;
+
+ begin
+ Len := Length(s);
+ SetLength(Result, Len shl 1);
+ for i := 1 to Len do begin
+ C := Ord(s[i]);
+ H := (C shr 4) and $f;
+ L := C and $f;
+ Result[i shl 1 - 1] := HexChar(H);
+ Result[i shl 1]:= HexChar(L);
+ end;
+ end;
+
+begin
+ Result := '';
+ for i := 1 to Length(Str) do
+ begin
+ c := Str[i];
+ case c of
+ '0'..'9', 'A'..'Z', 'a'..'z': Result := Result + c;
+ else begin
+ s := c;
+ Result := Result + '%' + StrToHex(s);
+ end
+ end;
+ end;
+end;
+
+{ TfrxHTMLExportDialog }
+
+procedure TfrxHTMLExportDialog.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(8200);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ GroupPageRange.Text := frxGet(7);
+ AllRB.Text := frxGet(3);
+ CurPageRB.Text := frxGet(4);
+ PageNumbersRB.Text := frxGet(5);
+ DescrL.Text := frxGet(9);
+ GroupQuality.Text := frxGet(8);
+ OpenAfterCB.Text := frxGet(8201);
+ StylesCB.Text := frxGet(8202);
+ PicturesL.Text := frxGet(8203);
+ PicsSameCB.Text := frxGet(8204);
+ FixWidthCB.Text := frxGet(8205);
+ NavigatorCB.Text := frxGet(8206);
+ MultipageCB.Text := frxGet(8207);
+ BackgrCB.Text := frxGet(8209);
+ SaveDialog1.Filter := frxGet(8210);
+ SaveDialog1.DefaultExt := frxGet(8211);
+ PFormatCB.Items[0] := frxGet(8313);
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+// if UseRightToLeftAlignment then
+// FlipChildren(True);
+end;
+
+
+procedure TfrxHTMLExportDialog.PageNumbersEChange(Sender: TObject);
+begin
+ PageNumbersRB.IsChecked := True;
+end;
+
+procedure TfrxHTMLExportDialog.PageNumbersEKeyPress(Sender: TObject;
+ var Key: Char);
+begin
+ case key of
+ '0'..'9':;
+ #8, '-', ',':;
+ else
+ key := #0;
+ end;
+end;
+
+procedure TfrxHTMLExportDialog.FormKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+begin
+ {if Key = VK_F1 then
+ frxResources.Help(Self); }
+end;
+
+end.
diff --git a/LibD28/FMX.frxExportImage.fmx b/LibD28/FMX.frxExportImage.fmx
new file mode 100644
index 0000000..b1c8d18
--- /dev/null
+++ b/LibD28/FMX.frxExportImage.fmx
@@ -0,0 +1,141 @@
+object frxIMGExportDialog: TfrxIMGExportDialog
+ Left = 0
+ Top = 0
+ ActiveControl = OK
+ Caption = 'Export to Images'
+ ClientHeight = 303
+ ClientWidth = 277
+ Position = poScreenCenter
+ OnCreate = FormCreate
+ object OK: TButton
+ Default = True
+ DisableFocusEffect = False
+ Height = 25.000000000000000000
+ ModalResult = 1
+ Position.X = 116.000000000000000000
+ Position.Y = 272.000000000000000000
+ Width = 75.000000000000000000
+ end
+ object Cancel: TButton
+ Cancel = True
+ DisableFocusEffect = False
+ Height = 25.000000000000000000
+ ModalResult = 2
+ Position.X = 196.000000000000000000
+ Position.Y = 272.000000000000000000
+ Width = 75.000000000000000000
+ end
+ object GroupPageRange: TGroupBox
+ Height = 145.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 4.000000000000000000
+ Width = 269.000000000000000000
+ object DescrL: TLabel
+ Height = 29.000000000000000000
+ Position.X = 12.000000000000000000
+ Position.Y = 82.000000000000000000
+ Width = 249.000000000000000000
+ end
+ object AllRB: TRadioButton
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ HelpContext = 108
+ IsChecked = True
+ Position.X = 12.000000000000000000
+ Position.Y = 20.000000000000000000
+ Width = 153.000000000000000000
+ end
+ object CurPageRB: TRadioButton
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ HelpContext = 118
+ Position.X = 12.000000000000000000
+ Position.Y = 40.000000000000000000
+ Width = 153.000000000000000000
+ end
+ object PageNumbersRB: TRadioButton
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ HelpContext = 124
+ Position.X = 12.000000000000000000
+ Position.Y = 60.000000000000000000
+ Width = 77.000000000000000000
+ end
+ object PageNumbersE: TEdit
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ Password = False
+ Position.X = 92.000000000000000000
+ Position.Y = 58.000000000000000000
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 133
+ OnChange = PageNumbersEChange
+ end
+ object SeparateCB: TCheckBox
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ Position.X = 16.000000000000000000
+ Position.Y = 116.000000000000000000
+ Width = 237.000000000000000000
+ end
+ end
+ object GroupBox1: TGroupBox
+ Height = 109.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 156.000000000000000000
+ Width = 269.000000000000000000
+ object Label2: TLabel
+ Height = 13.000000000000000000
+ Position.X = 16.000000000000000000
+ Position.Y = 48.000000000000000000
+ Width = 121.000000000000000000
+ end
+ object Label1: TLabel
+ Height = 13.000000000000000000
+ Position.X = 16.000000000000000000
+ Position.Y = 76.000000000000000000
+ Width = 113.000000000000000000
+ end
+ object CropPage: TCheckBox
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ Position.X = 140.000000000000000000
+ Position.Y = 20.000000000000000000
+ Width = 125.000000000000000000
+ end
+ object Quality: TEdit
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ Password = False
+ Text = '100'
+ Position.X = 140.000000000000000000
+ Position.Y = 44.000000000000000000
+ Width = 53.000000000000000000
+ Height = 21.000000000000000000
+ end
+ object Mono: TCheckBox
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ Position.X = 16.000000000000000000
+ Position.Y = 20.000000000000000000
+ Visible = False
+ Width = 121.000000000000000000
+ end
+ object Resolution: TEdit
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ Password = False
+ Text = '96'
+ Position.X = 140.000000000000000000
+ Position.Y = 72.000000000000000000
+ Width = 53.000000000000000000
+ Height = 21.000000000000000000
+ end
+ end
+ object SaveDialog1: TSaveDialog
+ Options = [ofHideReadOnly, ofNoChangeDir, ofEnableSizing]
+ Left = 72
+ Top = 208
+ end
+end
diff --git a/LibD28/FMX.frxExportImage.pas b/LibD28/FMX.frxExportImage.pas
new file mode 100644
index 0000000..d36229f
--- /dev/null
+++ b/LibD28/FMX.frxExportImage.pas
@@ -0,0 +1,1125 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Picture Export Filters }
+{ }
+{ Copyright (c) 1998-2011 }
+{ by Alexander Fediachov, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxExportImage;
+
+interface
+
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.Edit, FMX.Types, System.UITypes, System.Types,
+ System.UIConsts, System.Variants, FMX.frxBaseModalForm
+{$IFDEF DELPHI18}
+ , FMX.StdCtrls
+ , FMX.Surfaces
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+ TfrxCustomImageExport = class(TfrxCustomExportFilter)
+ private
+ FBitmap: TBitmap;
+ FCrop: Boolean;
+ FCurrentPage: Integer;
+ FJPEGQuality: Integer;
+ FMaxX: Integer;
+ FMaxY: Integer;
+ FMinX: Integer;
+ FMinY: Integer;
+ FMonochrome: Boolean;
+ FResolution: Integer;
+ FCurrentRes: Integer;
+ FSeparate: Boolean;
+ FYOffset: Integer;
+ FFileSuffix: String;
+ FFirstPage: Boolean;
+ FExportNotPrintable: Boolean;
+ function SizeOverflow(const Val: Extended): Boolean;
+ protected
+ FPaperWidth: Double;
+ FPaperHeight: Double;
+ FDiv: Extended;
+ procedure Save; virtual;
+ procedure FinishExport; virtual;
+ public
+ constructor Create(AOwner: TComponent); override;
+ function ShowModal: TModalResult; override;
+ function Start: Boolean; override;
+ procedure Finish; override;
+ procedure FinishPage(Page: TfrxReportPage; Index: Integer); override;
+ procedure StartPage(Page: TfrxReportPage; Index: Integer); override;
+ procedure ExportObject(Obj: TfrxComponent); override;
+
+ property JPEGQuality: Integer read FJPEGQuality write FJPEGQuality default 90;
+ property CropImages: Boolean read FCrop write FCrop default False;
+ property Monochrome: Boolean read FMonochrome write FMonochrome default False;
+ property Resolution: Integer read FResolution write FResolution;
+ property SeparateFiles: Boolean read FSeparate write FSeparate;
+ property ExportNotPrintable: Boolean read FExportNotPrintable write FExportNotPrintable;
+ property OverwritePrompt;
+ end;
+
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxBMPExport = class(TfrxCustomImageExport)
+ protected
+ procedure Save; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ published
+ property CropImages;
+ property Monochrome;
+ property OverwritePrompt;
+ end;
+
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxTIFFExport = class(TfrxCustomImageExport)
+ private
+ FMultiImage: Boolean;
+
+ { Saves a picture to a TIFF stream.
+ Arguments:
+
+ - Split - if set, the picture will be splitted into
+ chunks that fit into a standard page (its dimensions are in
+ FPaperWidth and FPaperHeight in millimeters)
+
+ - WriteHeader - a TIFF stream is capable to store several
+ images. If the first image is being written to a stream,
+ WriteHeader must be True. If an additional image is to be
+ written to a non empty TIFF stream, then WriteHeader must
+ be False. }
+
+ {procedure SaveTiffToStream(const Stream: TStream; const Bitmap: TBitmap;
+ Split: Boolean; WriteHeader: Boolean = True);}
+
+ protected
+ procedure Save; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ published
+ property CropImages;
+ property Monochrome;
+ property OverwritePrompt;
+
+ { It's possible to store a few picture in a single TIFF image.
+ If MultiPage = True, then all pictures larger than a standard
+ print page (its dimensions are stored in FPaperWidth and FPaperHeight
+ in millimeters) will be splitted into a few standard pages and
+ then saved to the TIFF image. }
+
+ property MultiImage: Boolean read FMultiImage write FMultiImage default False;
+ end;
+
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxJPEGExport = class(TfrxCustomImageExport)
+ protected
+ procedure Save; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ published
+ property JPEGQuality;
+ property CropImages;
+ property Monochrome;
+ property OverwritePrompt;
+ end;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxGIFExport = class(TfrxCustomImageExport)
+ protected
+ procedure Save; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ published
+ property CropImages;
+ property Monochrome;
+ property OverwritePrompt;
+ end;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxPNGExport = class(TfrxCustomImageExport)
+ protected
+ procedure Save; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ published
+ property CropImages;
+ property Monochrome;
+ property OverwritePrompt;
+ end;
+
+ TfrxIMGExportDialog = class(TfrxForm)
+ OK: TButton;
+ Cancel: TButton;
+ GroupPageRange: TGroupBox;
+ GroupBox1: TGroupBox;
+ CropPage: TCheckBox;
+ Label2: TLabel;
+ Quality: TEdit;
+ Mono: TCheckBox;
+ SaveDialog1: TSaveDialog;
+ DescrL: TLabel;
+ AllRB: TRadioButton;
+ CurPageRB: TRadioButton;
+ PageNumbersRB: TRadioButton;
+ PageNumbersE: TEdit;
+ Label1: TLabel;
+ Resolution: TEdit;
+ SeparateCB: TCheckBox;
+ procedure FormCreate(Sender: TObject);
+ procedure PageNumbersEChange(Sender: TObject);
+ procedure PageNumbersEKeyPress(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+ private
+ FFilter: TfrxCustomImageExport;
+ procedure SetFilter(const Value: TfrxCustomImageExport);
+ public
+ property Filter: TfrxCustomImageExport read FFilter write SetFilter;
+ end;
+
+implementation
+
+uses
+ FMX.frxUtils, FMX.frxRes, FMX.frxrcExports;
+
+{$R *.fmx}
+
+type
+ PDirEntry = ^TDirEntry;
+ TDirEntry = record
+ _Tag: Word;
+ _Type: Word;
+ _Count: LongInt;
+ _Value: LongInt;
+ end;
+
+const
+ EMF_DIV = 0.911;
+ TifHeader: array[0..7] of Byte = (
+ $49, $49, $2A, $00, $08, $00, $00, $00);
+
+ { Here http://www.fileformat.info/format/bmp/egff.htm
+ is written that BMP file can have size up to 32K x 32K }
+
+ MaxBitmapHeight = 30000;
+ MaxBitmapWidth = 30000;
+
+ MAXBITSCODES = 12;
+ HSIZE = 5003;
+ NullString: array[0..3] of Byte = ($00, $00, $00, $00);
+ Software: array[0..9] of AnsiChar = ('F', 'a', 's', 't', 'R', 'e', 'p', 'o', 'r', 't');
+ code_mask: array [0..16] of cardinal = ($0000, $0001, $0003, $0007, $000F,
+ $001F, $003F, $007F, $00FF, $01FF, $03FF, $07FF, $0FFF,
+ $1FFF, $3FFF, $7FFF, $FFFF);
+ BitsPerSample: array[0..2] of Word = ($0008, $0008, $0008);
+ D_BW_C: array[0..13] of TDirEntry = (
+ (_Tag: $00FE; _Type: $0004; _Count: $00000001; _Value: $00000000),
+ (_Tag: $0100; _Type: $0003; _Count: $00000001; _Value: $00000000),
+ (_Tag: $0101; _Type: $0003; _Count: $00000001; _Value: $00000000),
+ (_Tag: $0102; _Type: $0003; _Count: $00000001; _Value: $00000001),
+ (_Tag: $0103; _Type: $0003; _Count: $00000001; _Value: $00000001),
+ (_Tag: $0106; _Type: $0003; _Count: $00000001; _Value: $00000001),
+ (_Tag: $0111; _Type: $0004; _Count: $00000001; _Value: $00000000),
+ (_Tag: $0115; _Type: $0003; _Count: $00000001; _Value: $00000001),
+ (_Tag: $0116; _Type: $0004; _Count: $00000001; _Value: $00000000),
+ (_Tag: $0117; _Type: $0004; _Count: $00000001; _Value: $00000000),
+ (_Tag: $011A; _Type: $0005; _Count: $00000001; _Value: $00000000),
+ (_Tag: $011B; _Type: $0005; _Count: $00000001; _Value: $00000000),
+ (_Tag: $0128; _Type: $0003; _Count: $00000001; _Value: $00000002),
+ (_Tag: $0131; _Type: $0002; _Count: $0000000A; _Value: $00000000));
+ D_COL_C: array[0..14] of TDirEntry = (
+ (_Tag: $00FE; _Type: $0004; _Count: $00000001; _Value: $00000000),
+ (_Tag: $0100; _Type: $0003; _Count: $00000001; _Value: $00000000),
+ (_Tag: $0101; _Type: $0003; _Count: $00000001; _Value: $00000000),
+ (_Tag: $0102; _Type: $0003; _Count: $00000001; _Value: $00000008),
+ (_Tag: $0103; _Type: $0003; _Count: $00000001; _Value: $00000001),
+ (_Tag: $0106; _Type: $0003; _Count: $00000001; _Value: $00000003),
+ (_Tag: $0111; _Type: $0004; _Count: $00000001; _Value: $00000000),
+ (_Tag: $0115; _Type: $0003; _Count: $00000001; _Value: $00000001),
+ (_Tag: $0116; _Type: $0004; _Count: $00000001; _Value: $00000000),
+ (_Tag: $0117; _Type: $0004; _Count: $00000001; _Value: $00000000),
+ (_Tag: $011A; _Type: $0005; _Count: $00000001; _Value: $00000000),
+ (_Tag: $011B; _Type: $0005; _Count: $00000001; _Value: $00000000),
+ (_Tag: $0128; _Type: $0003; _Count: $00000001; _Value: $00000002),
+ (_Tag: $0131; _Type: $0002; _Count: $0000000A; _Value: $00000000),
+ (_Tag: $0140; _Type: $0003; _Count: $00000300; _Value: $00000008));
+ D_RGB_C: array[0..14] of TDirEntry = (
+ (_Tag: $00FE; _Type: $0004; _Count: $00000001; _Value: $00000000),
+ (_Tag: $0100; _Type: $0003; _Count: $00000001; _Value: $00000000),
+ (_Tag: $0101; _Type: $0003; _Count: $00000001; _Value: $00000000),
+ (_Tag: $0102; _Type: $0003; _Count: $00000003; _Value: $00000008),
+ (_Tag: $0103; _Type: $0003; _Count: $00000001; _Value: $00000001),
+ (_Tag: $0106; _Type: $0003; _Count: $00000001; _Value: $00000002),
+ (_Tag: $0111; _Type: $0004; _Count: $00000001; _Value: $00000000),
+ (_Tag: $0115; _Type: $0003; _Count: $00000001; _Value: $00000003),
+ (_Tag: $0116; _Type: $0004; _Count: $00000001; _Value: $00000000),
+ (_Tag: $0117; _Type: $0004; _Count: $00000001; _Value: $00000000),
+ (_Tag: $011A; _Type: $0005; _Count: $00000001; _Value: $00000000),
+ (_Tag: $011B; _Type: $0005; _Count: $00000001; _Value: $00000000),
+ (_Tag: $011C; _Type: $0003; _Count: $00000001; _Value: $00000001),
+ (_Tag: $0128; _Type: $0003; _Count: $00000001; _Value: $00000002),
+ (_Tag: $0131; _Type: $0002; _Count: $0000000A; _Value: $00000000));
+
+
+procedure SaveImage(Stream: TStream; Bitmap: TBitmap; FileName: String; FFileSuffix: String; Format: String);
+{$IFNDEF Delphi18}
+{$IFNDEF Delphi17}
+var
+ TFStream: TStream;
+ Filter: TBitmapCodec;
+begin
+ if Stream = nil then
+ TFStream := TFileStream.Create(ChangeFileExt(FileName, FFileSuffix + '.' + Format), fmCreate)
+ else
+ TFStream := Stream;
+ try
+ Filter := DefaultBitmapCodecClass.Create;
+ try
+ Filter.SaveToStream(TFStream, Bitmap, Format);
+ finally
+ Filter.Free
+ end;
+ finally
+ if Stream = nil then
+ TFStream.Free
+ end;
+{$ELSE}
+var
+ TFStream: TStream;
+begin
+ if Stream = nil then
+ TFStream := TFileStream.Create(ChangeFileExt(FileName, FFileSuffix + '.' + Format), fmCreate)
+ else
+ TFStream := Stream;
+ try
+ TBitmapCodecManager.SaveToStream(TFStream, Bitmap, Format);
+ finally
+ if Stream = nil then
+ TFStream.Free
+ end;
+{$ENDIF}
+{$ELSE}
+var
+ TFStream: TStream;
+ Surf: TBitmapSurface;
+begin
+ if Stream = nil then
+ TFStream := TFileStream.Create(ChangeFileExt(FileName, FFileSuffix + '.' + Format), fmCreate)
+ else
+ TFStream := Stream;
+ Surf := TBitmapSurface.Create;
+ Surf.Assign(Bitmap);
+ try
+ TBitmapCodecManager.SaveToStream(TFStream, Surf, Format);
+ finally
+ if Stream = nil then
+ TFStream.Free;
+ Surf.Free;
+ end;
+{$ENDIF}
+end;
+
+{ TfrxCustomImageExport }
+
+constructor TfrxCustomImageExport.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FCrop := True;
+ FJPEGQuality := 90;
+ FResolution := 96;
+ FSeparate := True;
+ FExportNotPrintable := False;
+ CropImages := False;
+end;
+
+function TfrxCustomImageExport.ShowModal: TModalResult;
+begin
+ with TfrxIMGExportDialog.Create(nil) do
+ begin
+ Filter := Self;
+ Quality.Text := IntToStr(FJPEGQuality);
+ CropPage.IsChecked := FCrop;
+ Mono.IsChecked := FMonochrome;
+ Quality.Enabled := Self is TfrxJPEGExport;
+ Mono.Enabled := not (Self is TfrxGIFExport);
+ Resolution.Text := IntToStr(FResolution);
+ if OverwritePrompt then
+ SaveDialog1.Options := SaveDialog1.Options + [TOpenOption.ofOverwritePrompt];
+ if SlaveExport then
+ begin
+ SeparateCB.IsChecked := False;
+ SeparateCB.Visible := False;
+ end
+ else
+ SeparateCB.IsChecked := FSeparate;
+
+ if (FileName = '') and (not SlaveExport) then
+ SaveDialog1.FileName := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(Report.FileName)), SaveDialog1.DefaultExt)
+ else
+ SaveDialog1.FileName := FileName;
+
+ if PageNumbers <> '' then
+ begin
+ PageNumbersE.Text := PageNumbers;
+ PageNumbersRB.IsChecked := True;
+ end;
+
+ Result := ShowModal;
+ PeekLastModalResult;
+ if Result = mrOk then
+ begin
+ FJPEGQuality := StrToInt(Quality.Text);
+ FCrop := CropPage.IsChecked;
+ FMonochrome := Mono.IsChecked;
+ FResolution := StrToInt(Resolution.Text);
+ FSeparate := SeparateCB.IsChecked;
+ PageNumbers := '';
+ CurPage := False;
+ if CurPageRB.IsChecked then
+ CurPage := True
+ else if PageNumbersRB.IsChecked then
+ PageNumbers := PageNumbersE.Text;
+
+ if not SlaveExport then
+ begin
+ if DefaultPath <> '' then
+ SaveDialog1.InitialDir := DefaultPath;
+ if SaveDialog1.Execute then
+ FileName := SaveDialog1.FileName else
+ Result := mrCancel;
+ PeekLastModalResult;
+ end;
+ end;
+ Free;
+ end;
+end;
+
+function TfrxCustomImageExport.Start: Boolean;
+begin
+ if SlaveExport then
+ begin
+ if Report.FileName <> '' then
+ FileName := ChangeFileExt(GetTemporaryFolder + ExtractFileName(Report.FileName), DefaultExt)
+ else
+ FileName := ChangeFileExt(GetTempFile, DefaultExt);
+ FSeparate := False;
+ end;
+ CurPage := False;
+ FCurrentPage := 0;
+ FYOffset := 0;
+ if not FSeparate then
+ begin
+ FBitmap := TBitmap.Create(0,0);
+ FCurrentRes := 96;// FBitmap.r;
+ FDiv := FResolution / FCurrentRes;
+ FBitmap.Canvas.Fill.Kind := TBrushKind.bkSolid;
+ FBitmap.Canvas.Fill.Color := claWhite;
+ //FBitmap.Canvas.Clear(claWhite);
+ //FBitmap.Monochrome := Monochrome;
+ FMaxX := 0;
+ FMaxY := 0;
+ FFirstPage := True;
+ end;
+ Result := (FileName <> '') or (Stream <> nil);
+ if (ExtractFilePath(FileName) = '') and (DefaultPath <> '') then
+ FileName := DefaultPath + '\' + FileName;
+end;
+
+procedure TfrxCustomImageExport.StartPage(Page: TfrxReportPage; Index: Integer);
+var
+ i: Integer;
+ h, w: Extended;
+begin
+ Inc(FCurrentPage);
+ if FSeparate then
+ begin
+
+ FCurrentRes := 96;// FBitmap.Canvas.Font.PixelsPerInch;
+ FDiv := FResolution / FCurrentRes;
+ //FBitmap.Canvas.Brush.Color := clWhite;
+ //FBitmap.Monochrome := Monochrome;
+ FBitmap := TBitmap.Create(Round(Page.Width * FDiv), Round(Page.Height * FDiv));
+ //FBitmap.UpdateHandles;
+ FBitmap.Canvas.Fill.Kind := TBrushKind.bkSolid;
+ FBitmap.Canvas.Fill.Color := claWhite;
+ FBitmap.Canvas.BeginScene();
+ FBitmap.Canvas.Clear(claWhite);
+
+ FMaxX := 0;
+ FMaxY := 0;
+ FMinX := FBitmap.Width;
+ FMinY := FBitmap.Height;
+ end
+ else if FFirstpage then
+ with FBitmap do
+ begin
+ w := 0;
+ h := 0;
+
+ for i := 0 to Report.PreviewPages.Count - 1 do
+ with Report.PreviewPages.Page[i] do
+ begin
+ if w < Width then
+ w := Width;
+
+ h := h + Height;
+ end;
+
+ w := w * FDiv;
+ h := h * FDiv;
+
+ if SizeOverflow(w) then
+ w := MaxBitmapWidth;
+
+ if SizeOverflow(h) then
+ h := MaxBitmapHeight;
+
+ Width := Round(w);
+ Height := Round(h);
+
+ FMinX := Width;
+ FMinY := Height;
+
+ FFirstPage := False;
+ Canvas.BeginScene();
+ Canvas.Clear(claWhite);
+ end;
+end;
+
+procedure TfrxCustomImageExport.ExportObject(Obj: TfrxComponent);
+var
+ z: Integer;
+begin
+ if (Obj is TfrxView) and (FExportNotPrintable or TfrxView(Obj).Printable) then
+ begin
+ if Obj.Name <> '_pagebackground' then
+ begin
+ z := Round(Obj.AbsLeft * FDiv);
+ if z < FMinX then
+ FMinX := z;
+ z := FYOffset + Round(Obj.AbsTop * FDiv);
+ if z < FMinY then
+ FMinY := z;
+ z := Round((Obj.AbsLeft + Obj.Width) * FDiv) + 1;
+ if z > FMaxX then
+ FMaxX := z;
+ z := FYOffset + Round((Obj.AbsTop + Obj.Height) * FDiv) + 1;
+ if z > FMaxY then
+ FMaxY := z;
+ end;
+ TfrxView(Obj).Draw(FBitmap.Canvas, FDiv, FDiv, 0, FYOffset);
+ end;
+end;
+
+procedure TfrxCustomImageExport.FinishPage(Page: TfrxReportPage; Index: Integer);
+begin
+ FPaperWidth := Page.PaperWidth;
+ FPaperHeight := Page.PaperHeight;
+
+ if FSeparate then
+ FinishExport
+ else
+ FYOffset := FYOffset + Round(Page.Height * FDiv);
+end;
+
+procedure TfrxCustomImageExport.Finish;
+begin
+ if not FSeparate then
+ FinishExport;
+end;
+
+procedure TfrxCustomImageExport.Save;
+begin
+ if FSeparate then
+ FFileSuffix := '.' + IntToStr(FCurrentPage)
+ else
+ FFileSuffix := '';
+end;
+
+procedure TfrxCustomImageExport.FinishExport;
+var
+ RFrom, RTo: TRectF;
+ TempBitmap: TBitmap;
+begin
+ try
+ FBitmap.Canvas.EndScene;
+ if FCrop then
+ begin
+ RFrom := RectF(FMinX, FMinY, FMaxX, FMaxY);
+ RTo := RectF(0, 0, FMaxX - FMinX, FMaxY - FMinY);
+ TempBitmap := TBitmap.Create(FBitmap.Width, FBitmap.Height);
+ TempBitmap.Canvas.BeginScene();
+{$IFDEF DELPHI18}
+ TempBitmap.Canvas.CopyBitmap(FBitmap, TempBitmap);
+{$ELSE}
+ TempBitmap.Canvas.DrawBitmap(FBitmap, RectF(0, 0, FBitmap.Width, FBitmap.Height), RectF(0, 0, FBitmap.Width, FBitmap.Height), 1, False);
+{$ENDIF}
+ TempBitmap.Canvas.EndScene;
+ FBitmap.Width := FMaxX - FMinX;
+ FBitmap.Height := FMaxY - FMinY;
+ FBitmap.Canvas.BeginScene();
+ FBitmap.Canvas.DrawBitmap(TempBitmap, RFrom, RTo, 1, False);
+ TempBitmap.Free;
+ FBitmap.Canvas.EndScene;
+ end;
+ Save;
+ finally
+ FBitmap.Free;
+ end;
+end;
+
+function TfrxCustomImageExport.SizeOverflow(const Val: Extended): Boolean;
+begin
+ Result := Val > MaxBitmapHeight;
+end;
+
+{ TfrxIMGExportDialog }
+
+procedure TfrxIMGExportDialog.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(8600);
+ OK.Text := frxGet(1);
+ Cancel.Text := frxGet(2);
+ GroupPageRange.Text := frxGet(7);
+ AllRB.Text := frxGet(3);
+ CurPageRB.Text := frxGet(4);
+ PageNumbersRB.Text := frxGet(5);
+ DescrL.Text := frxGet(9);
+ GroupBox1.Text := frxGet(8601);
+ Label2.Text := frxGet(8602);
+ Label1.Text := frxGet(8603);
+ SeparateCB.Text := frxGet(8604);
+ CropPage.Text := frxGet(8605);
+ Mono.Text := frxGet(8606);
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxIMGExportDialog.SetFilter(const Value: TfrxCustomImageExport);
+begin
+ FFilter := Value;
+ SaveDialog1.Filter := FFilter.FilterDesc;
+ SaveDialog1.DefaultExt := FFilter.DefaultExt;
+end;
+
+
+{ TfrxBMPExport }
+
+constructor TfrxBMPExport.Create(AOwner: TComponent);
+begin
+ inherited;
+ FilterDesc := frxResources.Get('BMPexportFilter');
+ DefaultExt := '.bmp';
+end;
+
+class function TfrxBMPExport.GetDescription: String;
+begin
+ Result := frxResources.Get('BMPexport');
+end;
+
+procedure TfrxBMPExport.Save;
+begin
+ inherited;
+ SaveImage(Stream, FBitmap, FileName, FFileSuffix, 'bmp');
+end;
+
+
+{ TfrxTIFFExport }
+
+constructor TfrxTIFFExport.Create(AOwner: TComponent);
+begin
+ inherited;
+ FilterDesc := frxResources.Get('TIFFexportFilter');
+ DefaultExt := '.tif';
+end;
+
+class function TfrxTIFFExport.GetDescription: String;
+begin
+ Result := frxResources.Get('TIFFexport');
+end;
+
+procedure TfrxTIFFExport.Save;
+begin
+ inherited;
+ try
+ SaveImage(Stream, FBitmap, FileName, FFileSuffix, 'tif');
+ except
+ on e: Exception do
+ case Report.EngineOptions.NewSilentMode of
+ simSilent: Report.Errors.Add(e.Message);
+ simMessageBoxes: frxErrorMsg(e.Message);
+ simReThrow: raise;
+ end;
+ end;
+end;
+
+{procedure TfrxTIFFExport.SaveTIFFToStream(const Stream: TStream; const Bitmap: TBitmap;
+ Split: Boolean; WriteHeader: Boolean);
+
+ function Min(a, b: Integer): Integer;
+ begin
+ if a < b then
+ Result := a
+ else
+ Result := b;
+ end;
+
+var
+ i, k, x, y: Integer;
+ dib_f: Boolean;
+ Header, Bits, BitsPtr, TmpBitsPtr, NewBits: PAnsiChar;
+ HeaderSize, BitsSize: DWORD;
+ Width, Height, DataWidth, BitCount: Integer;
+ MapRed, MapGreen, MapBlue: array[0..255, 0..1] of Byte;
+ ColTabSize, BmpWidth: Integer;
+ Red, Blue, Green: AnsiChar;
+ O_XRes, O_YRes, O_Soft, O_Strip, O_Dir, O_BPS: LongInt;
+ RGB: Word;
+ Res: Word;
+ NoOfDirs: array[0..1] of Byte;
+ D_BW: array[0..13] of TDirEntry;
+ D_COL: array[0..14] of TDirEntry;
+ D_RGB: array[0..14] of TDirEntry;
+ Res_Value: array[0..7] of Byte;
+ Page: TBitmap;
+ Source, Dest: TRect;
+ NextIfd: Integer;
+begin
+ //if Bitmap.Handle = 0 then
+ // Exit;
+ }
+ { split a big image into smaller images that fit
+ into a standard print page }
+ {
+ if Split then
+ begin
+ Width := Trunc(FPaperWidth / 25.4 * 96) + 1;
+ Height := Trunc(FPaperHeight / 25.4 * 96) + 1;
+
+ y := 0;
+ repeat
+ x := 0;
+
+ repeat
+ with Source do
+ begin
+ Left := x;
+ Top := y;
+ Right := Min(x + Width, Bitmap.Width) - 1;
+ Bottom := Min(y + Height, Bitmap.Height) - 1;
+ end;
+
+ with Dest do
+ begin
+ Left := 0;
+ Top := 0;
+ Right := Source.Right - Source.Left;
+ Bottom := Source.Bottom - Source.Top;
+ end;
+
+ Page := TBitmap.Create;
+
+ with Page do
+ begin
+ Canvas.Fill.Color := claWhite;
+ Monochrome := Monochrome;
+ Width := Dest.Right + 1;
+ Height := Dest.Bottom + 1;
+ Canvas.DrawBitmap(Bitmap, Source, Dest, 1, False );
+ end;
+
+ SaveTiffToStream(Stream, Page, False, WriteHeader);
+ WriteHeader := False;
+ Page.Free;
+ Inc(x, Width);
+ until x > Bitmap.Width;
+
+ Inc(y, Height);
+ until y > Bitmap.Height;
+
+ Exit;
+ end;
+
+ NoOfDirs[1] := 0;
+ Res := FResolution * 10;
+ Res_Value[0] := Res and $ff;
+ Res_Value[1] := Res shr 8;
+ Res_Value[2] := 0;
+ Res_Value[3] := 0;
+ Res_Value[4] := $0A;
+ Res_Value[5] := 0;
+ Res_Value[6] := 0;
+ Res_Value[7] := 0;
+ GetDIBSizes(Bitmap.Handle, HeaderSize, BitsSize);
+ Header := GlobalAllocPtr(GMEM_MOVEABLE or GMEM_SHARE, HeaderSize + BitsSize);
+ try
+ Bits := Header + HeaderSize;
+ dib_f := GetDIB(Bitmap.Handle, Bitmap.Palette, Header^, Bits^);
+ if dib_f then
+ begin
+ Width := PBITMAPINFO(Header)^.bmiHeader.biWidth;
+ Height := PBITMAPINFO(Header)^.bmiHeader.biHeight;
+ BitCount := PBITMAPINFO(Header)^.bmiHeader.biBitCount;
+ NoOfDirs[0] := $0F;
+ ColTabSize := 1 shl BitCount;
+ BmpWidth := BitsSize div DWORD(Height);
+
+ if not WriteHeader then
+ NextIfd := Stream.Size - 4
+ else
+ begin
+ Stream.Write(TifHeader, sizeof(TifHeader));
+ NextIfd := 4;
+ end;
+
+ if BitCount = 1 then
+ begin
+ CopyMemory(@D_BW, @D_BW_C, SizeOf(D_BW));
+ NoOfDirs[0] := $0E;
+
+ O_XRes := Stream.Position;
+ Stream.Write(Res_Value, sizeof(Res_Value));
+
+ O_YRes := Stream.Position;
+ Stream.Write(Res_Value, sizeof(Res_Value));
+
+ O_Soft := Stream.Position;
+ Stream.Write(Software, sizeof(Software));
+
+ DataWidth := ((Width + 7) div 8);
+ O_Strip := Stream.Position;
+ if Height < 0 then
+ for i := 0 to Height - 1 do
+ begin
+ BitsPtr := Bits + i * BmpWidth;
+ Stream.Write(BitsPtr^, DataWidth);
+ end
+ else
+ for i := 1 to Height do
+ begin
+ BitsPtr := Bits + (Height - i) * BmpWidth;
+ Stream.Write(BitsPtr^, DataWidth);
+ end;
+
+ Stream.Write(NullString, sizeof(NullString));
+
+ D_BW[1]._Value := LongInt(Width);
+ D_BW[2]._Value := LongInt(abs(Height));
+ D_BW[8]._Value := LongInt(abs(Height));
+ D_BW[9]._Value := LongInt(DataWidth * abs(Height));
+ D_BW[6]._Value := O_Strip;
+ D_BW[10]._Value := O_XRes;
+ D_BW[11]._Value := O_YRes;
+ D_BW[13]._Value := O_Soft;
+
+ O_Dir := Stream.Position;
+ Stream.Write(NoOfDirs, sizeof(NoOfDirs));
+ Stream.Write(D_BW, sizeof(D_BW));
+ Stream.Write(NullString, sizeof(NullString));
+ end;
+ if BitCount in [4, 8] then
+ begin
+ CopyMemory(@D_COL, @D_COL_C, SizeOf(D_COL));
+ DataWidth := Width;
+ if BitCount = 4 then
+ begin
+ Width := (Width div BitCount) * BitCount;
+ if BitCount = 4 then
+ DataWidth := Width div 2;
+ end;
+ D_COL[1]._Value := LongInt(Width);
+ D_COL[2]._Value := LongInt(abs(Height));
+ D_COL[3]._Value := LongInt(BitCount);
+ D_COL[8]._Value := LongInt(Height);
+ D_COL[9]._Value := LongInt(DataWidth * abs(Height));
+ for i := 0 to ColTabSize - 1 do
+ begin
+ MapRed[i][1] := PBITMAPINFO(Header)^.bmiColors[i].rgbRed;
+ MapRed[i][0] := 0;
+ MapGreen[i][1] := PBITMAPINFO(Header)^.bmiColors[i].rgbGreen;
+ MapGreen[i][0] := 0;
+ MapBlue[i][1] := PBITMAPINFO(Header)^.bmiColors[i].rgbBlue;
+ MapBlue[i][0] := 0;
+ end;
+ D_COL[14]._Count := LongInt(ColTabSize * 3);
+ Stream.Write(MapRed, ColTabSize * 2);
+ Stream.Write(MapGreen, ColTabSize * 2);
+ Stream.Write(MapBlue, ColTabSize * 2);
+ O_XRes := Stream.Position;
+ Stream.Write(Res_Value, sizeof(Res_Value));
+ O_YRes := Stream.Position;
+ Stream.Write(Res_Value, sizeof(Res_Value));
+ O_Soft := Stream.Position;
+ Stream.Write(Software, sizeof(Software));
+ O_Strip := Stream.Position;
+ if Height < 0 then
+ for i := 0 to Height - 1 do
+ begin
+ BitsPtr := Bits + i * BmpWidth;
+ Stream.Write(BitsPtr^, DataWidth);
+ end
+ else
+ for i := 1 to Height do
+ begin
+ BitsPtr := Bits + (Height - i) * BmpWidth;
+ Stream.Write(BitsPtr^, DataWidth);
+ end;
+ D_COL[6]._Value := O_Strip;
+ D_COL[10]._Value := O_XRes;
+ D_COL[11]._Value := O_YRes;
+ D_COL[13]._Value := O_Soft;
+ O_Dir := Stream.Position;
+ Stream.Write(NoOfDirs, sizeof(NoOfDirs));
+ Stream.Write(D_COL, sizeof(D_COL));
+ Stream.Write(NullString, sizeof(NullString));
+ end;
+ if BitCount = 16 then
+ begin
+ CopyMemory(@D_RGB, @D_RGB_C, SizeOf(D_RGB));
+ D_RGB[1]._Value := LongInt(Width);
+ D_RGB[2]._Value := LongInt(Height);
+ D_RGB[8]._Value := LongInt(Height);
+ D_RGB[9]._Value := LongInt(3 * Width * Height);
+ O_XRes := Stream.Position;
+ Stream.Write(Res_Value, sizeof(Res_Value));
+ O_YRes := Stream.Position;
+ Stream.Write(Res_Value, sizeof(Res_Value));
+ O_BPS := Stream.Position;
+ Stream.Write(BitsPerSample, sizeof(BitsPerSample));
+ O_Soft := Stream.Position;
+ Stream.Write(Software, sizeof(Software));
+ O_Strip := Stream.Position;
+ GetMem(NewBits, Width * Height * 3);
+ for i := 0 to Height - 1 do
+ begin
+ BitsPtr := Bits + i * BmpWidth;
+ TmpBitsPtr := NewBits + i * Width * 3;
+ for k := 0 to Width - 1 do
+ begin
+ RGB := PWord(BitsPtr)^;
+ Blue := AnsiChar((RGB and $1F) shl 3 or $7);
+ Green := AnsiChar((RGB shr 5 and $1F) shl 3 or $7);
+ Red := AnsiChar((RGB shr 10 and $1F) shl 3 or $7);
+ PByte(TmpBitsPtr)^ := Byte(Red);
+ PByte(TmpBitsPtr + 1)^ := Byte(Green);
+ PByte(TmpBitsPtr + 2)^ := Byte(Blue);
+ BitsPtr := BitsPtr + 2;
+ TmpBitsPtr := TmpBitsPtr + 3;
+ end;
+ end;
+ for i := 1 to Height do
+ begin
+ TmpBitsPtr := NewBits + (Height - i) * Width * 3;
+ Stream.Write(TmpBitsPtr^, Width * 3);
+ end;
+ FreeMem(NewBits);
+ D_RGB[3]._Value := O_BPS;
+ D_RGB[6]._Value := O_Strip;
+ D_RGB[10]._Value := O_XRes;
+ D_RGB[11]._Value := O_YRes;
+ D_RGB[14]._Value := O_Soft;
+ O_Dir := Stream.Position;
+ Stream.Write(NoOfDirs, sizeof(NoOfDirs));
+ Stream.Write(D_RGB, sizeof(D_RGB));
+ Stream.Write(NullString, sizeof(NullString));
+ end;
+ if BitCount in [24, 32] then
+ begin
+ CopyMemory(@D_RGB, @D_RGB_C, SizeOf(D_RGB));
+ D_RGB[1]._Value := LongInt(Width);
+ D_RGB[2]._Value := LongInt(Height);
+ D_RGB[8]._Value := LongInt(Height);
+ D_RGB[9]._Value := LongInt(3 * Width * Height);
+ O_XRes := Stream.Position;
+ Stream.Write(Res_Value, sizeof(Res_Value));
+ O_YRes := Stream.Position;
+ Stream.Write(Res_Value, sizeof(Res_Value));
+ O_BPS := Stream.Position;
+ Stream.Write(BitsPerSample, sizeof(BitsPerSample));
+ O_Soft := Stream.Position;
+ Stream.Write(Software, sizeof(Software));
+ O_Strip := Stream.Position;
+ for i := 0 to Height - 1 do
+ begin
+ BitsPtr := Bits + i * BmpWidth;
+ for k := 0 to Width - 1 do
+ begin
+ Blue := (BitsPtr)^;
+ Red := (BitsPtr + 2)^;
+ (BitsPtr)^ := Red;
+ (BitsPtr + 2)^ := Blue;
+ BitsPtr := BitsPtr + BitCount div 8;
+ end;
+ end;
+ if BitCount = 32 then
+ for i := 0 to Height - 1 do
+ begin
+ BitsPtr := Bits + i * BmpWidth;
+ TmpBitsPtr := BitsPtr;
+ for k := 0 to Width - 1 do
+ begin
+ (TmpBitsPtr)^ := (BitsPtr)^;
+ (TmpBitsPtr + 1)^ := (BitsPtr + 1)^;
+ (TmpBitsPtr + 2)^ := (BitsPtr + 2)^;
+ TmpBitsPtr := TmpBitsPtr + 3;
+ BitsPtr := BitsPtr + 4;
+ end;
+ end;
+ BmpWidth := Trunc(BitsSize / Height);
+ if Height < 0 then
+ for i := 0 to Height - 1 do
+ begin
+ BitsPtr := Bits + i * BmpWidth;
+ Stream.Write(BitsPtr^, Width * 3);
+ end
+ else
+ for i := 1 to Height do
+ begin
+ BitsPtr := Bits + (Height - i) * BmpWidth;
+ Stream.Write(BitsPtr^, Width * 3);
+ end;
+ D_RGB[3]._Value := O_BPS;
+ D_RGB[6]._Value := O_Strip;
+ D_RGB[10]._Value := O_XRes;
+ D_RGB[11]._Value := O_YRes;
+ D_RGB[14]._Value := O_Soft;
+ O_Dir := Stream.Position;
+ Stream.Write(NoOfDirs, sizeof(NoOfDirs));
+ Stream.Write(D_RGB, sizeof(D_RGB));
+ Stream.Write(NullString, sizeof(NullString));
+ end;
+ end;
+ finally
+ GlobalFreePtr(Header);
+ end;
+
+ Stream.Seek(NextIfd, soFromBeginning);
+ Stream.Write(O_Dir, 4);
+ Stream.Seek(0, soFromEnd);
+end; }
+
+{ TfrxJPEGExport }
+
+constructor TfrxJPEGExport.Create(AOwner: TComponent);
+begin
+ inherited;
+ FilterDesc := frxResources.Get('JPEGexportFilter');
+ DefaultExt := '.jpg';
+end;
+
+class function TfrxJPEGExport.GetDescription: String;
+begin
+ Result := frxResources.Get('JPEGexport');
+end;
+
+procedure TfrxJPEGExport.Save;
+begin
+ inherited;
+ try
+ SaveImage(Stream, FBitmap, FileName, FFileSuffix, 'jpeg');
+ except
+ on e: Exception do
+ case Report.EngineOptions.NewSilentMode of
+ simSilent: Report.Errors.Add(e.Message);
+ simMessageBoxes: frxErrorMsg(e.Message);
+ simReThrow: raise;
+ end;
+ end;
+end;
+
+{ TfrxGIFExport }
+
+constructor TfrxGIFExport.Create(AOwner: TComponent);
+begin
+ inherited;
+ FilterDesc := frxResources.Get('GifexportFilter');
+ DefaultExt := '.gif';
+end;
+
+class function TfrxGIFExport.GetDescription: String;
+begin
+ Result := frxResources.Get('GIFexport');
+end;
+
+procedure TfrxGIFExport.Save;
+begin
+ inherited;
+ try
+ SaveImage(Stream, FBitmap, FileName, FFileSuffix, 'gif');
+ except
+ on e: Exception do
+ case Report.EngineOptions.NewSilentMode of
+ simSilent: Report.Errors.Add(e.Message);
+ simMessageBoxes: frxErrorMsg(e.Message);
+ simReThrow: raise;
+ end;
+ end;
+end;
+
+procedure TfrxIMGExportDialog.PageNumbersEChange(Sender: TObject);
+begin
+ PageNumbersRB.IsChecked := True;
+end;
+
+procedure TfrxIMGExportDialog.PageNumbersEKeyPress(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+begin
+ case Char(key) of
+ '0'..'9':;
+ #8, '-', ',':;
+ else
+ key := 0;
+ end;
+end;
+
+
+{ TfrxPNGExport }
+
+constructor TfrxPNGExport.Create(AOwner: TComponent);
+begin
+ inherited;
+ DefaultExt := '.png';
+ FilterDesc := frxResources.Get('PNGexportFilter')
+end;
+
+class function TfrxPNGExport.GetDescription: String;
+begin
+ Result := frxResources.Get('PNGexport')
+end;
+
+procedure TfrxPNGExport.Save;
+begin
+ inherited;
+ SaveImage(Stream, FBitmap, FileName, FFileSuffix, 'png');
+end;
+
+end.
+
diff --git a/LibD28/FMX.frxExportMatrix.pas b/LibD28/FMX.frxExportMatrix.pas
new file mode 100644
index 0000000..cefa0bd
--- /dev/null
+++ b/LibD28/FMX.frxExportMatrix.pas
@@ -0,0 +1,1755 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Intermediate Export Matrix }
+{ }
+{ Copyright (c) 1998-2010 }
+{ by Alexander Fediachov, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxExportMatrix;
+
+{$I frx.inc}
+{$I fmx.inc}
+
+interface
+
+uses
+ System.SysUtils, System.Classes, FMX.Types, System.UITypes, System.Types, FMX.frxClass, FMX.frxPreviewPages,
+ FMX.frxProgress, {Printers,} FMX.frxUtils, FMX.frxUnicodeUtils, FMX.frxfmx, System.WideStrings, System.UIConsts
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+ TfrxIEMObject = class;
+ TfrxIEMObjectList = class;
+ TfrxIEMStyle = class;
+ TfrxIEMatrix = class;
+ TfrxIEMPage = class;
+
+ TfrxIEMatrix = class(TObject)
+ private
+ FIEMObjectList: TList;
+ FIEMStyleList: TList;
+ FXPos: TList;
+ FYPos: TList;
+ FPages: TList;
+ FWidth: Integer;
+ FHeight: Integer;
+ FMaxWidth: Extended;
+ FMaxHeight: Extended;
+ FMinLeft: Extended;
+ FMinTop: Extended;
+ FMatrix: array of integer;
+ FDeltaY: Extended;
+ FShowProgress: Boolean;
+ FMaxCellHeight: Extended;
+ FMaxCellWidth: Extended;
+ FInaccuracy: Extended;
+ FProgress: TfrxProgress;
+ FRotatedImage: Boolean;
+ FPlainRich: Boolean;
+ FRichText: Boolean;
+ FCropFillArea: Boolean;
+ FFillArea: Boolean;
+ FOptFrames: Boolean;
+ FLeft: Extended;
+ FTop: Extended;
+ FDeleteHTMLTags: Boolean;
+ FBackImage: Boolean;
+ FBackground: Boolean;
+ FReport: TfrxReport;
+ FPrintable: Boolean;
+ FImages: Boolean;
+ FWrap: Boolean;
+ FEmptyLines: Boolean;
+ FHeader: TfrxBand;
+ FFooter: TfrxBand;
+ FBrushAsBitmap: Boolean;
+ FFontList: TStringList;
+ FEMFPictures: Boolean;
+ FDotMatrix: Boolean;
+ function AddStyleInternal(Style: TfrxIEMStyle): integer;
+ function AddStyle(Obj: TfrxView): integer;
+ function AddInternalObject(Obj: TfrxIEMObject; x, y, dx, dy: integer): integer;
+ function IsMemo(Obj: TfrxView): boolean;
+ function IsLine(Obj: TfrxView): boolean;
+ function IsRect(Obj: TfrxView): boolean;
+ function QuickFind(aList: TList; aPosition: Extended; var Index: Integer): Boolean;
+ procedure SetCell(x, y: integer; Value: integer);
+ procedure FillArea(x, y, dx, dy: integer; Value: integer);
+ procedure ReplaceArea(ObjIndex:integer; x, y, dx, dy: integer; Value: integer);
+ procedure FindRectArea(x, y: integer; var dx, dy: integer);
+ procedure CutObject(ObjIndex: Integer; x, y, dx, dy: integer);
+ procedure CloneFrames(Obj1, Obj2: Integer);
+ procedure AddPos(List: TList; Value: Extended);
+ procedure OrderPosArray(List: TList; Vert: boolean);
+ procedure OrderByCells;
+ procedure Render;
+ procedure Analyse;
+ procedure OptimizeFrames;
+ function GetIEPages(Index: Integer): TfrxIEMPage;
+ public
+ constructor Create(const UseFileCache: Boolean; const TempDir: String);
+ destructor Destroy; override;
+ function GetObjectBounds(Obj: TfrxIEMObject): TfrxRect;
+ function GetFontCharset(Font: TFont): Integer;
+ function GetCell(x, y: integer): integer;
+ function GetObjectById(ObjIndex: integer): TfrxIEMObject;
+ function GetStyleById(StyleIndex: integer): TfrxIEMStyle;
+ function GetXPosById(PosIndex: integer): Extended;
+ function GetYPosById(PosIndex: integer): Extended;
+ function GetObject(x, y: integer): TfrxIEMObject;
+ function GetStyle(x, y: integer): TfrxIEMStyle;
+ function GetCellXPos(x: integer): Extended;
+ function GetCellYPos(y: integer): Extended;
+ procedure DeleteMatrixLine(y: Integer);
+ function GetStylesCount: Integer;
+ function GetPagesCount: Integer;
+ function GetObjectsCount: Integer;
+ procedure Clear;
+ procedure AddObject(Obj: TfrxView);
+ procedure AddDialogObject(Obj: TfrxReportComponent);
+ procedure AddPage(Orientation: TPrinterOrientation; Width: Extended;
+ Height: Extended; LeftMargin: Extended; TopMargin: Extended;
+ RightMargin: Extended; BottomMargin: Extended; MirrorMargins: Boolean; Index: Integer);
+ procedure Prepare;
+ procedure GetObjectPos(ObjIndex: integer; var x, y, dx, dy: integer);
+ function GetPageBreak(Page: integer): Extended;
+ function GetPageWidth(Page: integer): Extended;
+ function GetPageHeight(Page: integer): Extended;
+ function GetPageLMargin(Page: integer): Extended;
+ function GetPageTMargin(Page: integer): Extended;
+ function GetPageRMargin(Page: integer): Extended;
+ function GetPageBMargin(Page: integer): Extended;
+ function GetPageMirrorMargin(Page: integer): Boolean;
+ function GetPageOrientation(Page: integer): TPrinterOrientation;
+ procedure SetPageHeader(Band: TfrxBand);
+ procedure SetPageFooter(Band: TfrxBand);
+
+ property Width: Integer read FWidth;
+ property Height: Integer read FHeight;
+ property MaxWidth: Extended read FMaxWidth;
+ property MaxHeight: Extended read FMaxHeight;
+ property MinLeft: Extended read FMinLeft;
+ property MinTop: Extended read FMinTop;
+ property ShowProgress: Boolean read FShowProgress write FShowProgress;
+ property MaxCellHeight: Extended read FMaxCellHeight write FMaxCellHeight;
+ property MaxCellWidth: Extended read FMaxCellWidth write FMaxCellWidth;
+ property PagesCount: Integer read GetPagesCount;
+ property StylesCount: Integer read GetStylesCount;
+ property ObjectsCount: Integer read GetObjectsCount;
+ property Inaccuracy: Extended read FInaccuracy write FInaccuracy;
+ property RotatedAsImage: boolean read FRotatedImage write FRotatedImage;
+ property RichText: boolean read FRichText write FRichText;
+ property PlainRich: boolean read FPlainRich write FPlainRich;
+ property AreaFill: boolean read FFillArea write FFillArea;
+ property CropAreaFill: boolean read FCropFillArea write FCropFillArea;
+ property FramesOptimization: boolean read FOptFrames write FOptFrames;
+ property DeleteHTMLTags: Boolean read FDeleteHTMLTags write FDeleteHTMLTags;
+ property Left: Extended read FLeft;
+ property Top: Extended read FTop;
+ property BackgroundImage: Boolean read FBackImage write FBackImage;
+ property Background: Boolean read FBackground write FBackground;
+ property Report: TfrxReport read FReport write FReport;
+ property Printable: Boolean read FPrintable write FPrintable;
+ property Images: Boolean read FImages write FImages;
+ property WrapText: Boolean read FWrap write FWrap;
+ property EmptyLines: Boolean read FEmptyLines write FEmptyLines;
+ property BrushAsBitmap: Boolean read FBrushAsBitmap write FBrushAsBitmap;
+ property EMFPictures: Boolean read FEMFPictures write FEMFPictures;
+ property DotMatrix: Boolean read FDotMatrix write FDotMatrix;
+ property IEPages[Index: Integer]: TfrxIEMPage read GetIEPages;
+ end;
+
+ TfrxIEMObject = class(TObject)
+ private
+ FMemo: TWideStrings;
+ FURL: String;
+ FStyleIndex: Integer;
+ FStyle: TfrxIEMStyle;
+ FIsText: Boolean;
+ FIsRichText: Boolean;
+ FIsDialogObject: Boolean;
+ FLeft: Extended;
+ FTop: Extended;
+ FWidth: Extended;
+ FHeight: Extended;
+ FImage: TBitmap;
+ FParent: TfrxIEMObject;
+ FCounter: Integer;
+ FLink: TObject;
+ FRTL: Boolean;
+ FAnchor: String;
+ FCached: Boolean;
+ FFooter: Boolean;
+ FHeader: Boolean;
+ FName: String;
+ FHTMLTags: Boolean;
+ // FMetafile: TMetafile;
+ procedure SetMemo(const Value: TWideStrings);
+ function GetImage: TBitmap;
+ procedure SetImage(const Value: TBitmap);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ property Memo: TWideStrings read FMemo write SetMemo;
+ property URL: String read FURL write FURL;
+ property StyleIndex: Integer read FStyleIndex write FStyleIndex;
+ property IsText: Boolean read FIsText write FIsText;
+ property IsRichText: Boolean read FIsRichText write FIsRichText;
+ property IsDialogObject: Boolean read FIsDialogObject write FIsDialogObject;
+ property Left: Extended read FLeft write FLeft;
+ property Top: Extended read FTop write FTop;
+ property Width: Extended read FWidth write FWidth;
+ property Height: Extended read FHeight write FHeight;
+ property Image: TBitmap read GetImage write SetImage;
+ property Parent: TfrxIEMObject read FParent write FParent;
+ property Style: TfrxIEMStyle read FStyle write FStyle;
+ property Counter: Integer read FCounter write FCounter;
+ property Link: TObject read FLink write FLink;
+ property RTL: Boolean read FRTL write FRTL;
+ property Anchor: String read FAnchor write FAnchor;
+ property Cached: Boolean read FCached write FCached;
+ property Footer: Boolean read FFooter write FFooter;
+ property Header: Boolean read FHeader write FHeader;
+ property Name: String read FName write FName;
+ property HTMLTags: Boolean read FHTMLTags write FHTMLTags;
+ //property Metafile: TMetafile read FMetafile;
+ end;
+
+ TfrxIEMObjectList = class(TObject)
+ public
+ Obj: TfrxIEMObject;
+ x, y, dx, dy : Integer;
+ Exist: Boolean;
+ constructor Create;
+ destructor Destroy; override;
+ end;
+
+ TfrxIEMPos = class(TObject)
+ public
+ Value: Extended;
+ end;
+
+ TfrxIEMPage = class(TObject)
+ public
+ Value: Extended;
+ Orientation: TPrinterOrientation;
+ Width: Extended;
+ Height: Extended;
+ LeftMargin: Extended;
+ TopMargin:Extended;
+ BottomMargin: Extended;
+ RightMargin:Extended;
+ MirrorMargin: Boolean;
+ PrintOnPreviousPage: Boolean;
+ PageName: String;
+ end;
+
+ TfrxIEMStyle = class(TObject)
+ public
+ Font: TfrxFont;
+ LineSpacing: Extended;
+ VAlign: TfrxVAlign;
+ HAlign: TfrxHAlign;
+ FrameTyp: TfrxFrameTypes;
+ FrameWidth: Single;
+ FrameColor: TColor;
+ FrameStyle: TfrxFrameStyle;
+ Color: TAlphaColor;
+ Rotation: Integer;
+ BrushStyle: TBrushKind;
+ ParagraphGap: Extended;
+ GapX: Extended;
+ GapY: Extended;
+ CharSpacing: Extended;
+ WordBreak: Boolean;
+ Charset: Integer;
+ FDisplayFormat: TfrxFormat;
+ WordWrap: Boolean;
+
+ constructor Create;
+ destructor Destroy; override;
+ procedure Assign(Style: TfrxIEMStyle);
+ procedure SetDisplayFormat(const Value: TfrxFormat);
+
+ property DisplayFormat: TfrxFormat read FDisplayFormat write SetDisplayFormat;
+ end;
+
+implementation
+
+uses fmx.frxres, FMX.frxrcExports;
+
+{ TfrxIEMatrix }
+
+const
+ EMF_DIV = 0.911;
+ MAX_POS_SEARCH_DEPTH = 100;
+ DOT_MATRIX_FONT_SIZE = 9;
+
+constructor TfrxIEMatrix.Create(const UseFileCache: Boolean; const TempDir: String);
+begin
+ FFontList := TStringList.Create;
+ FIEMObjectList := TList.Create;
+ FIEMStyleList := TList.Create;
+ FXPos := TList.Create;
+ FYPos := TList.Create;
+ FPages := TList.Create;
+ FMaxWidth := 0;
+ FMaxHeight := 0;
+ FMinLeft := 99999;
+ FMinTop := 99999;
+ FDeltaY := 0;
+ FMaxCellHeight := 0;
+ FShowProgress := true;
+ FInaccuracy := 0;
+ FRotatedImage := false;
+ FPlainRich := true;
+ FRichText := false;
+ FFillArea := false;
+ FCropFillArea := false;
+ FOptFrames := false;
+ FTop := 0;
+ FLeft := 0;
+ FBackImage := False;
+ FBackground := False;
+ FReport := nil;
+ FPrintable := True;
+ FImages := True;
+ FWrap := False;
+ FEmptyLines := True;
+ FHeader := nil;
+ FFooter := nil;
+ FBrushAsBitmap := True;
+ FEMFPictures := False;
+ FDotMatrix := False;
+end;
+
+destructor TfrxIEMatrix.Destroy;
+begin
+ Clear;
+ FXPos.Free;
+ FYPos.Free;
+ FFontList.Free;
+ FIEMObjectList.Free;
+ FIEMStyleList.Free;
+ FPages.Free;
+ inherited;
+end;
+
+function TfrxIEMatrix.AddInternalObject(Obj: TfrxIEMObject; x, y, dx, dy: integer): integer;
+var
+ FObjItem: TfrxIEMObjectList;
+begin
+ FObjItem := TfrxIEMObjectList.Create;
+ FObjItem.x := x;
+ FObjItem.y := y;
+ FObjItem.dx := dx;
+ FObjItem.dy := dy;
+ FObjItem.Obj := Obj;
+ FIEMObjectList.Add(FObjItem);
+ Result := FIEMObjectList.Count - 1;
+end;
+
+procedure TfrxIEMatrix.AddObject(Obj: TfrxView);
+var
+ dx, dy, fdx, fdy: Extended;
+ FObj: TfrxIEMObject;
+ DrawPosX, DrawPosY: Extended;
+ Memo: TfrxCustomMemoView;
+ Line: TfrxCustomLineView;
+ OldFrameWidth: Extended;
+ FRealBounds: TfrxRect;
+ aLineHeight: Single;
+begin
+ if (Obj.Name = '_pagebackground') and
+ (not FBackground) and (FPrintable or Obj.Printable)
+ then
+ Exit;
+ OldFrameWidth := 0;
+
+ if Obj.Frame.DropShadow and (Obj is TfrxCustomMemoView) then
+ begin
+ Obj.Width := Obj.Width - Obj.Frame.ShadowWidth;
+ Obj.Height := Obj.Height - Obj.Frame.ShadowWidth;
+ Obj.Frame.DropShadow := False;
+ AddObject(Obj);
+ Obj.Width := Obj.Width + Obj.Frame.ShadowWidth;
+ Obj.Height := Obj.Height + Obj.Frame.ShadowWidth;
+ Obj.Frame.DropShadow := True;
+ Memo := TfrxCustomMemoView.Create(nil);
+ try
+ Memo.Name := 'Shadow';
+ Memo.Font.Size := 1;
+ Memo.Color := Obj.Frame.ShadowColor;
+ Memo.Left := Obj.AbsLeft + Obj.Width - Obj.Frame.ShadowWidth;
+ Memo.Top := Obj.AbsTop + Obj.Frame.ShadowWidth;
+ Memo.Width := Obj.Frame.ShadowWidth;
+ Memo.Height := Obj.Height - Obj.Frame.ShadowWidth;
+ AddObject(Memo);
+ Memo.Left := Obj.AbsLeft + Obj.Frame.ShadowWidth;
+ Memo.Top := Obj.AbsTop + Obj.Height - Obj.Frame.ShadowWidth;
+ Memo.Width := Obj.Width - Obj.Frame.ShadowWidth;
+ Memo.Height := Obj.Frame.ShadowWidth;
+ AddObject(Memo);
+ finally
+ Memo.Free;
+ end;
+ exit;
+ end;
+
+ {if (Obj.ClassName = 'TfrxRichView') and FRichText and FPlainRich then
+ begin
+ Memo := TfrxCustomMemoView.Create(nil);
+ try
+ Obj.PlainText := True;
+ Memo.Lines.Text := AnsiToUnicode(AnsiString(Obj.GetComponentText), DEFAULT_CHARSET);
+ Memo.Name := Obj.Name;
+ Memo.Left := Obj.AbsLeft;
+ Memo.Top := Obj.AbsTop;
+ Memo.Width := Obj.Width;
+ Memo.Height := Obj.Height;
+ AddObject(Memo);
+ finally
+ Obj.PlainText := False;
+ Memo.Free;
+ end;
+ exit;
+ end; }
+
+ FObj := TfrxIEMObject.Create;
+ FObj.Name := Obj.Name;
+ FObj.StyleIndex := AddStyle(Obj);
+ if FObj.StyleIndex <> -1 then
+ FObj.Style := TfrxIEMStyle(FIEMStyleList[FObj.StyleIndex]);
+ FObj.URL :=Obj.URL;
+ if Assigned(FReport) and (FObj.URL <> '') and (FObj.URL[1] = '#') then
+ FObj.URL := '@' + IntToStr(TfrxPreviewPages(FReport.PreviewPages).GetAnchorPage(StringReplace(FObj.URL, '#', '', [])));
+
+ if Obj.AbsLeft >= 0 then
+ FObj.Left := Obj.AbsLeft
+ else FObj.Left := 0;
+ if Obj.AbsTop >= 0 then
+ FObj.Top := FDeltaY + Obj.AbsTop
+ else FObj.Top := FDeltaY;
+ FObj.Width := Obj.Width;
+ FObj.Height := Obj.Height;
+ if IsMemo(Obj) then
+ begin
+ // Memo
+ if (FDeleteHTMLTags and TfrxCustomMemoView(Obj).AllowHTMLTags) or FWrap then
+ TfrxCustomMemoView(Obj).WrapText(True, aLineHeight, FObj.Memo)
+ else
+ FObj.Memo := TfrxCustomMemoView(Obj).Memo;
+ if not FDeleteHTMLTags then
+ FObj.HTMLTags := TfrxCustomMemoView(Obj).AllowHTMLTags;
+ {if TfrxCustomMemoView(Obj).Font.Charset <> DEFAULT_CHARSET then}
+ {if TfrxCustomMemoView(Obj).Font.Charset = OEM_CHARSET then
+ FObj.Memo.Text := AnsiToUnicode(OemToStr(_UnicodeToAnsi(FObj.Memo.Text, OEM_CHARSET)), DEFAULT_CHARSET);}
+ {FObj.Memo.Text := AnsiToUnicode(FObj.Memo.Text, TfrxCustomMemoView(Obj).Font.Charset)
+ else}
+ FObj.IsText := True;
+ FObj.IsRichText := False;
+ FObj.RTL := TfrxCustomMemoView(Obj).RTLReading;
+ end
+ {else if (Obj.ClassName = 'TfrxRichView') and (FRichText) then
+ begin
+ // Rich
+ FObj.IsText := True;
+ FObj.IsRichText := True;
+ FObj.Memo.Text := AnsiToUnicode(AnsiString(Obj.GetComponentText), DEFAULT_CHARSET);
+ end }
+ else if IsLine(Obj) then
+ begin
+ // Line
+ FObj.IsText := True;
+ FObj.IsRichText := False;
+ if FObj.Left > (FObj.Left + FObj.Width) then
+ begin
+ FObj.Left := FObj.Left + FObj.Width;
+ FObj.Width := -FObj.Width;
+ end;
+ if FObj.Top > (FObj.Top + Obj.Height) then
+ begin
+ FObj.Top := FObj.Top + FObj.Height;
+ FObj.Height := -FObj.Height;
+ end;
+ if FObj.Width = 0 then
+ FObj.Width := 1;
+ if FObj.Height = 0 then
+ FObj.Height := 1;
+ end
+ else if IsRect(Obj) or (Obj.ClassName = 'TfrxGradientView') then
+ begin
+ if Obj.Color = claNull then
+ begin
+ // Rect as lines
+ Line := TfrxCustomLineView.Create(nil);
+ Line.Name := 'Line';
+ Line.Frame.Assign(Obj.Frame);
+ Line.Left := Obj.AbsLeft;
+ Line.Top := Obj.AbsTop;
+ Line.Width := Obj.Width;
+ Line.Height := 0;
+ AddObject(Line);
+ Line.Left := Obj.AbsLeft;
+ Line.Top := Obj.AbsTop;
+ Line.Width := 0;
+ Line.Height := Obj.Height;
+ AddObject(Line);
+ Line.Left := Obj.AbsLeft;
+ Line.Top := Obj.AbsTop + Obj.Height;
+ Line.Width := Obj.Width;
+ Line.Height := 0;
+ AddObject(Line);
+ Line.Left := Obj.AbsLeft + Obj.Width;
+ Line.Top := Obj.AbsTop;
+ Line.Width := 0;
+ Line.Height := Obj.Height;
+ AddObject(Line);
+ Line.Free;
+ end else
+ begin
+ // Rect as memo
+ Memo := TfrxCustomMemoView.Create(nil);
+ Memo.Frame.Assign(Obj.Frame);
+ Memo.Name := 'Rect';
+ Memo.Color := Obj.Color;
+ Memo.Left := Obj.AbsLeft;
+ Memo.Top := Obj.AbsTop;
+ Memo.Width := Obj.Width;
+ Memo.Height := Obj.Height;
+ Memo.Frame.Typ := [ftLeft, ftTop, ftRight, ftBottom];
+ Memo.Font.Size := 1;
+ AddObject(Memo);
+ Memo.Free;
+ end;
+ FObj.Free;
+ Exit;
+ end
+ else begin
+ // Bitmap
+ if (not ((Obj.Name = '_pagebackground') and (not FBackImage))) and FImages and (Obj.ClassName <> 'TfrxGradientView') then
+ begin
+ if (Obj.Frame.Typ <> []) and (Obj.Frame.Width > 0) then
+ begin
+ OldFrameWidth := Obj.Frame.Width;
+ Obj.Frame.Width := 0;
+ end;
+ FObj.IsText := False;
+ FObj.IsRichText := False;
+
+ FRealBounds := Obj.GetRealBounds;
+ dx := FRealBounds.Right - FRealBounds.Left;
+ dy := FRealBounds.Bottom - FRealBounds.Top;
+
+ if (dx = Obj.Width) or (Obj.AbsLeft = FRealBounds.Left) then
+ fdx := 0
+ else if (Obj.AbsLeft + Obj.Width) = FRealBounds.Right then
+ fdx := (dx - Obj.Width)
+ else
+ fdx := (dx - Obj.Width) / 2;
+
+ if (dy = Obj.Height) or (Obj.AbsTop = FRealBounds.Top) then
+ fdy := 0
+ else if (Obj.AbsTop + Obj.Height) = FRealBounds.Bottom then
+ fdy := (dy - Obj.Height)
+ else
+ fdy := (dy - Obj.Height) / 2;
+
+ DrawPosX := Obj.AbsLeft - fdx;
+ DrawPosY := Obj.AbsTop - fdy;
+ FObj.Left := FObj.Left - fdx;
+ FObj.Top := FObj.Top - fdy;
+
+ if Round(dx) = 0 then
+ dx := 1;
+ if dx < 0 then
+ begin
+ dx := -dx;
+ FObj.Left := FObj.Left - dx;
+ DrawPosX := DrawPosX - dx;
+ end;
+ if Round(dy) = 0 then
+ dy := 1;
+ if dy < 0 then
+ begin
+ dy := -dy;
+ FObj.Top := FObj.Top - dy;
+ DrawPosY := DrawPosY - dy;
+ end;
+ FObj.Width := dx;
+ FObj.Height := dy;
+ {if FEMFPictures then
+ begin
+ with FObj.Metafile do
+ begin
+ Width := Round(dx);
+ Height := Round(dy);
+ end;
+
+ if (Obj is TfrxCustomLineView) and (OldFrameWidth > 0) then
+ Obj.Frame.Width := OldFrameWidth;
+
+ Canvas := TMetafileCanvas.Create(FObj.Metafile, 0);
+
+ try
+ Obj.Draw(Canvas, 1, 1, -DrawPosX, -DrawPosY);
+ except
+ // charts may throw exceptions when number are malformed
+ end;
+
+ Canvas.Free;
+
+ if OldFrameWidth > 0 then
+ Obj.Frame.Width := OldFrameWidth;
+ end
+ else}
+ begin
+ FObj.Image := TBitmap.Create(Round(dx) + 1, Round(dy) + 1);
+ FObj.Image.Canvas.BeginScene();
+ FObj.Image.Canvas.Clear(claWhite);
+ if (Obj is TfrxCustomLineView) and (OldFrameWidth > 0) then
+ Obj.Frame.Width := OldFrameWidth;
+ TfrxView(Obj).Draw(FObj.Image.Canvas, 1, 1, -DrawPosX, -DrawPosY);
+ FObj.Image.Canvas.EndScene();
+ if OldFrameWidth > 0 then
+ Obj.Frame.Width := OldFrameWidth;
+ end;
+ end
+ end;
+
+ if (Obj.Parent <> nil) and ((FHeader <> nil) or (FFooter <> nil)) then
+ begin
+ FObj.Header := Obj.Parent = FHeader;
+ FObj.Footer := Obj.Parent = FFooter;
+ end;
+
+ if FObj.Top + FObj.Height > FMaxHeight then
+ FMaxHeight := FObj.Top + FObj.Height;
+ if FObj.Left + FObj.Width > FMaxWidth then
+ FMaxWidth := FObj.Left + FObj.Width;
+ if FObj.Left < FMinLeft then
+ FMinLeft := FObj.Left;
+ if FObj.Top < FMinTop then
+ FMinTop := FObj.Top;
+ if (FObj.Left < FLeft) or (FLeft = 0) then
+ FLeft := FObj.Left;
+ if (FObj.Top < FTop) or (FTop = 0) then
+ FTop := FObj.Top;
+
+ AddPos(FXPos, FObj.Left);
+ AddPos(FXPos, FObj.Left + FObj.Width);
+ AddPos(FYPos, FObj.Top);
+ AddPos(FYPos, FObj.Top + FObj.Height);
+ AddInternalObject(FObj, 0, 0, 1, 1);
+end;
+
+procedure TfrxIEMatrix.AddDialogObject(Obj: TfrxReportComponent);
+var
+ FObj: TfrxIEMObject;
+begin
+ if Obj is TfrxDialogControl then
+ begin
+ FObj := TfrxIEMObject.Create;
+ FObj.StyleIndex := 0;
+ FObj.Style := nil;
+ FObj.URL := '';
+ FObj.Left := Obj.AbsLeft;
+ FObj.Top := Obj.AbsTop;
+ FObj.Width := Obj.Width;
+ FObj.Height := Obj.Height;
+ FObj.IsText := False;
+ FObj.IsRichText := False;
+ FObj.Link := Obj;
+ if FObj.Top + FObj.Height > FMaxHeight then
+ FMaxHeight := FObj.Top + FObj.Height;
+ if FObj.Left + FObj.Width > FMaxWidth then
+ FMaxWidth := FObj.Left + FObj.Width;
+ if FObj.Left < FMinLeft then
+ FMinLeft := FObj.Left;
+ if FObj.Top < FMinTop then
+ FMinTop := FObj.Top;
+ AddPos(FXPos, FObj.Left);
+ AddPos(FXPos, FObj.Left + FObj.Width);
+ AddPos(FYPos, FObj.Top);
+ AddPos(FYPos, FObj.Top + FObj.Height);
+ AddInternalObject(FObj, 0, 0, 1, 1);
+ end;
+end;
+
+procedure TfrxIEMatrix.AddPage(Orientation: TPrinterOrientation;
+Width: Extended; Height: Extended; LeftMargin: Extended; TopMargin: Extended;
+RightMargin: Extended; BottomMargin: Extended; MirrorMargins: Boolean; Index: Integer);
+var
+ Page: TfrxIEMPage;
+begin
+ FDeltaY := FMaxHeight;
+ Page := TfrxIEMPage.Create;
+ Page.Value := FMaxHeight;
+ Page.Orientation := Orientation;
+ Page.Width := Width;
+ Page.Height := Height;
+ Page.TopMargin := TopMargin;
+ Page.BottomMargin := BottomMargin;
+ if MirrorMargins and (((Index + 1) mod 2) = 0) then
+ begin
+ Page.MirrorMargin := true;
+ Page.LeftMargin := RightMargin;
+ Page.RightMargin := LeftMargin;
+ end else
+ begin
+ Page.MirrorMargin := false;
+ Page.LeftMargin := LeftMargin;
+ Page.RightMargin := RightMargin;
+ end;
+ FPages.Add(Page);
+end;
+
+procedure TfrxIEMatrix.AddPos(List: TList; Value: Extended);
+var
+ Pos: TfrxIEMPos;
+ i, cnt: integer;
+ Exist: Boolean;
+begin
+ Exist := False;
+ if List.Count > MAX_POS_SEARCH_DEPTH then
+ cnt := List.Count - MAX_POS_SEARCH_DEPTH
+ else
+ cnt := 0;
+ for i := List.Count - 1 downto cnt do
+ if TfrxIEMPos(List[i]).Value = Value then
+ begin
+ Exist := True;
+ break;
+ end;
+ if not Exist then
+ begin
+ Pos := TfrxIEMPos.Create;
+ Pos.Value := Value;
+ List.Add(Pos);
+ end;
+end;
+
+function TfrxIEMatrix.AddStyle(Obj: TfrxView): integer;
+var
+ Style: TfrxIEMStyle;
+ MObj: TfrxCustomMemoView;
+begin
+ Style := TfrxIEMStyle.Create;
+ if IsMemo(Obj) then
+ begin
+ MObj := TfrxCustomMemoView(Obj);
+ if MObj.Highlight.Active and
+ Assigned(MObj.Highlight.Font) then
+ begin
+ Style.Font.Assign(MObj.Highlight.Font);
+ if FDotMatrix then
+ Style.Font.Size := DOT_MATRIX_FONT_SIZE;
+ Style.Color := MObj.Highlight.Color;
+ end else
+ begin
+ Style.Font.Assign(MObj.Font);
+ if FDotMatrix then
+ Style.Font.Size := DOT_MATRIX_FONT_SIZE;
+ Style.Color := MObj.Color;
+ end;
+ Style.DisplayFormat := MObj.DisplayFormat;
+ Style.HAlign := MObj.HAlign;
+ Style.VAlign := MObj.VAlign;
+ Style.LineSpacing := MObj.LineSpacing;
+ Style.GapX := MObj.GapX;
+ Style.GapY := MObj.GapY;
+ { if MObj.Font.Charset = 1 then
+ Style.Charset := GetFontCharset(MObj.Font)
+ else
+ Style.Charset := MObj.Font.Charset; }
+ Style.CharSpacing := MObj.CharSpacing;
+ Style.ParagraphGap := MObj.ParagraphGap;
+ Style.WordBreak := MObj.WordBreak;
+ Style.FrameTyp := MObj.Frame.Typ;
+ Style.FrameWidth := MObj.Frame.Width;
+ Style.FrameColor := MObj.Frame.Color;
+ Style.FrameStyle := MObj.Frame.Style;
+ Style.Rotation := MObj.Rotation;
+ Style.BrushStyle := MObj.BrushStyle;
+ Style.WordWrap := MObj.WordWrap;
+ end
+ else if IsLine(Obj) then
+ begin
+ Style.Color := Obj.Color;
+ if Obj.Width = 0 then
+ Style.FrameTyp := [ftLeft]
+ else if Obj.Height = 0 then
+ Style.FrameTyp := [ftTop]
+ else Style.FrameTyp := [];
+ Style.FrameWidth := Obj.Frame.Width;
+ Style.FrameColor := Obj.Frame.Color;
+ Style.FrameStyle := Obj.Frame.Style;
+ Style.Font.Name := 'Arial';
+ Style.Font.Size := 1;
+ end
+ else if IsRect(Obj) then
+ begin
+ Style.Free;
+ Result := -1;
+ Exit;
+ end
+ else begin
+ Style.Font.Assign(Obj.Font);
+ if FDotMatrix then
+ Style.Font.Size := DOT_MATRIX_FONT_SIZE;
+ Style.Color := Obj.Color;
+ Style.FrameWidth := Obj.Frame.Width;
+ Style.FrameColor := Obj.Frame.Color;
+ Style.FrameStyle := Obj.Frame.Style;
+ if Obj is TfrxCustomLineView then
+ Style.FrameTyp := []
+ else
+ Style.FrameTyp := Obj.Frame.Typ;
+ end;
+ Result := AddStyleInternal(Style);
+end;
+
+function TfrxIEMatrix.AddStyleInternal(Style: TfrxIEMStyle): integer;
+var
+ i: integer;
+ Style2: TfrxIEMStyle;
+begin
+ Result := -1;
+ for i := 0 to FIEMStyleList.Count - 1 do
+ begin
+ Style2 := TfrxIEMStyle(FIEMStyleList[i]);
+ if (Style.Font.Size = Style2.Font.Size) and
+ (Style.HAlign = Style2.HAlign) and
+ (Style.VAlign = Style2.VAlign) and
+ (Style.Font.Color = Style2.Font.Color) and
+ (Style.Font.Name = Style2.Font.Name) and
+ (Style.Font.Style = Style2.Font.Style) and
+ (Style.FrameTyp = Style2.FrameTyp) and
+ (Style.FrameWidth = Style2.FrameWidth) and
+ (Style.FrameColor = Style2.FrameColor) and
+ (Style.FrameStyle = Style2.FrameStyle) and
+ (Style.Color = Style2.Color) and
+ (Style.DisplayFormat.Kind = Style2.DisplayFormat.Kind) and
+ (Style.DisplayFormat.DecimalSeparator = Style2.DisplayFormat.DecimalSeparator) and
+ (Style.DisplayFormat.FormatStr = Style2.DisplayFormat.FormatStr) and
+ (Style.LineSpacing = Style2.LineSpacing) and
+ (Style.GapX = Style2.GapX) and
+ (Style.GapY = Style2.GapY) and
+ (Style.ParagraphGap = Style2.ParagraphGap) and
+ (Style.CharSpacing = Style2.CharSpacing) and
+ (Style.Charset = Style2.Charset) and
+ (Style.WordBreak = Style2.WordBreak) and
+ (Style.Rotation = Style2.Rotation) and
+ (Style.WordWrap = Style2.WordWrap) and
+ (Style.BrushStyle = Style2.BrushStyle) then
+ begin
+ Result := i;
+ break;
+ end;
+ end;
+ if Result = -1 then
+ begin
+ FIEMStyleList.Add(Style);
+ Result := FIEMStyleList.Count - 1;
+ end else
+ Style.Free;
+end;
+
+procedure TfrxIEMatrix.Analyse;
+var
+ i, j, k: integer;
+ dx, dy: integer;
+ obj: TfrxIEMObjectList;
+begin
+ for i := 0 to FHeight - 1 do
+ for j := 0 to FWidth - 1 do
+ begin
+ k := GetCell(j, i);
+ if k <> -1 then
+ begin
+ obj := TfrxIEMObjectList(FIEMObjectList[k]);
+ if not obj.Exist then
+ begin
+ FindRectArea(j, i, dx, dy);
+
+ if (obj.dx = dx) and (obj.dy = dy) then
+ begin
+ obj.x := j;
+ obj.y := i;
+ end;
+
+ if (obj.x = j) and (obj.y = i) and (obj.dx = dx) and (obj.dy = dy) then
+ Obj.Exist := True
+ else
+ CutObject(k, j, i, dx, dy)
+ end;
+ end;
+ end;
+ if FShowProgress then
+ FProgress.Tick;
+end;
+
+procedure TfrxIEMatrix.Clear;
+var
+ i : Integer;
+begin
+ for i := 0 to FIEMObjectList.Count - 1 do
+ TfrxIEMObjectList(FIEMObjectList[i]).Free;
+ FIEMObjectList.Clear;
+ for i := 0 to FIEMStyleList.Count - 1 do
+ TfrxIEMStyle(FIEMStyleList[i]).Free;
+ FIEMStyleList.Clear;
+ for i := 0 to FXPos.Count - 1 do
+ TfrxIEMPos(FXPos[i]).Free;
+ FXPos.Clear;
+ for i := 0 to FYPos.Count - 1 do
+ TfrxIEMPos(FYPos[i]).Free;
+ FYPos.Clear;
+ for i := 0 to FPages.Count - 1 do
+ TfrxIEMPage(FPages[i]).Free;
+ FPages.Clear;
+ FFontList.Clear;
+ SetLength(FMatrix, 0);
+ FDeltaY := 0;
+end;
+
+procedure TfrxIEMatrix.CloneFrames(Obj1, Obj2: Integer);
+var
+ FOld, FNew: TfrxIEMObject;
+ FrameTyp: TfrxFrameTypes;
+ NewStyle: TfrxIEMStyle;
+begin
+ FOld := TfrxIEMObjectList(FIEMObjectList[Obj1]).Obj;
+ FNew := TfrxIEMObjectList(FIEMObjectList[Obj2]).Obj;
+ if (FOld.Style <> nil) and (FNew.Style <> nil) then
+ begin
+ FrameTyp := [];
+ if (ftTop in FOld.Style.FrameTyp) and (FOld.Top = FNew.Top) then
+ FrameTyp := FrameTyp + [ftTop];
+ if (ftLeft in FOld.Style.FrameTyp) and (FOld.Left = FNew.Left) then
+ FrameTyp := FrameTyp + [ftLeft];
+ if (ftBottom in FOld.Style.FrameTyp) and
+ ((FOld.Top + FOld.Height) = (FNew.Top + FNew.Height)) then
+ FrameTyp := FrameTyp + [ftBottom];
+ if (ftRight in FOld.Style.FrameTyp) and
+ ((FOld.Left + FOld.Width) = (FNew.Left + FNew.Width)) then
+ FrameTyp := FrameTyp + [ftRight];
+ if FrameTyp <> FNew.Style.FrameTyp then
+ begin
+ NewStyle := TfrxIEMStyle.Create;
+ NewStyle.FrameTyp := FrameTyp;
+ NewStyle.FrameWidth := FOld.Style.FrameWidth;
+ NewStyle.FrameColor := FOld.Style.FrameColor;
+ NewStyle.FrameStyle := FOld.Style.FrameStyle;
+ NewStyle.Font.Assign(FOld.Style.Font);
+ NewStyle.DisplayFormat.Assign(FOld.Style.DisplayFormat);
+ NewStyle.LineSpacing := FOld.Style.LineSpacing;
+ NewStyle.GapX := FOld.Style.GapX;
+ NewStyle.GapY := FOld.Style.GapY;
+ NewStyle.ParagraphGap := FOld.Style.ParagraphGap;
+ NewStyle.CharSpacing := FOld.Style.CharSpacing;
+ NewStyle.Charset := FOld.Style.Charset;
+ NewStyle.WordBreak := FOld.Style.WordBreak;
+ NewStyle.VAlign := FOld.Style.VAlign;
+ NewStyle.HAlign := FOld.Style.HAlign;
+ NewStyle.Color := FOld.Style.Color;
+ NewStyle.Rotation := FOld.Style.Rotation;
+ NewStyle.BrushStyle := FOld.Style.BrushStyle;
+ NewStyle.WordWrap := FOld.Style.WordWrap;
+ FNew.StyleIndex := AddStyleInternal(NewStyle);
+ FNew.Style := TfrxIEMStyle(FIEMStyleList[FNew.StyleIndex]);
+ end;
+end;
+end;
+
+procedure TfrxIEMatrix.CutObject(ObjIndex, x, y, dx, dy: integer);
+var
+ Obj: TfrxIEMObject;
+ NewObject: TfrxIEMObject;
+ NewIndex: Integer;
+ fdx, fdy: Extended;
+begin
+ Obj := TfrxIEMObjectList(FIEMObjectList[ObjIndex]).Obj;
+ NewObject := TfrxIEMObject.Create;
+ NewObject.StyleIndex := Obj.StyleIndex;
+ NewObject.Style := Obj.Style;
+ NewObject.Left := TfrxIEMPos(FXPos[x]).Value;
+ NewObject.Top := TfrxIEMPos(FYPos[y]).Value;
+ NewObject.Width := TfrxIEMPos(FXPos[x + dx]).Value - TfrxIEMPos(FXPos[x]).Value;
+ NewObject.Height := TfrxIEMPos(FYPos[y + dy]).Value - TfrxIEMPos(FYPos[y]).Value;
+ NewObject.Parent := Obj;
+ NewObject.IsText := Obj.IsText;
+ NewObject.IsRichText := Obj.IsRichText;
+ NewObject.HTMLTags := Obj.HTMLTags;
+ fdy := Obj.Top + Obj.Height - NewObject.Top;
+ fdx := Obj.Left + Obj.Width - NewObject.Left;
+ if (fdy > Obj.Height / 3) and (fdx > Obj.Width / 3) then
+ begin
+ NewObject.Image := Obj.Image;
+ NewObject.Link := Obj.Link;
+ NewObject.IsText := Obj.IsText;
+ NewObject.Memo := Obj.Memo;
+ Obj.Memo.Clear;
+ Obj.IsText := True;
+ Obj.Link := nil;
+ Obj.Image := nil;
+ end;
+ NewIndex := AddInternalObject(NewObject, x, y, dx, dy);
+ ReplaceArea(ObjIndex, x, y, dx, dy, NewIndex);
+ CloneFrames(ObjIndex, NewIndex);
+ TfrxIEMObjectList(FIEMObjectList[NewIndex]).Exist := True;
+end;
+
+procedure TfrxIEMatrix.FillArea(x, y, dx, dy, Value: integer);
+var
+ i, j: integer;
+begin
+ for i := y to y + dy - 1 do
+ for j := x to x + dx - 1 do
+ SetCell(j, i, Value);
+end;
+
+procedure TfrxIEMatrix.FindRectArea(x, y: integer; var dx, dy: integer);
+var
+ px, py: integer;
+ Obj: integer;
+begin
+ Obj := GetCell(x, y);
+ px := x;
+ py := y;
+ dx := 0;
+ while GetCell(px, py) = Obj do
+ begin
+ while GetCell(px, py) = Obj do
+ Inc(px);
+ if dx = 0 then
+ dx := px - x
+ else if px - x < dx then
+ break;
+ Inc(py);
+ px := x;
+ end;
+ dy := py - y;
+end;
+
+function TfrxIEMatrix.GetCell(x, y: integer): integer;
+begin
+ if (x < FWidth) and (y < FHeight) and (x >= 0) and (y >= 0) then
+ Result := FMatrix[FWidth * y + x]
+ else Result := -1;
+end;
+
+function TfrxIEMatrix.GetCellXPos(x: integer): Extended;
+begin
+ Result := TfrxIEMPos(FXPos[x]).Value;
+end;
+
+function TfrxIEMatrix.GetCellYPos(y: integer): Extended;
+begin
+ Result := TfrxIEMPos(FYPos[y]).Value;
+end;
+
+function TfrxIEMatrix.GetObject(x, y: integer): TfrxIEMObject;
+var
+ i: integer;
+begin
+ i := GetCell(x, y);
+ if i = -1 then
+ Result := nil
+ else
+ Result := TfrxIEMObjectList(FIEMObjectList[i]).Obj;
+end;
+
+function TfrxIEMatrix.GetObjectBounds(Obj: TfrxIEMObject): TfrxRect;
+begin
+ Result := frxRect(Obj.Left, Obj.Top, Obj.Left + Obj.Width, Obj.Top + Obj.Height)
+end;
+
+function TfrxIEMatrix.GetObjectById(ObjIndex: integer): TfrxIEMObject;
+begin
+ if ObjIndex < FIEMObjectList.Count then
+ Result := TfrxIEMObjectList(FIEMObjectList[ObjIndex]).Obj
+ else Result := nil;
+end;
+
+procedure TfrxIEMatrix.GetObjectPos(ObjIndex: integer; var x, y, dx,
+ dy: integer);
+begin
+ x := TfrxIEMObjectList(FIEMObjectList[ObjIndex]).x;
+ y := TfrxIEMObjectList(FIEMObjectList[ObjIndex]).y;
+ dx := TfrxIEMObjectList(FIEMObjectList[ObjIndex]).dx;
+ dy := TfrxIEMObjectList(FIEMObjectList[ObjIndex]).dy;
+end;
+
+function TfrxIEMatrix.GetObjectsCount: Integer;
+begin
+ Result := FIEMObjectList.Count;
+end;
+
+function TfrxIEMatrix.GetPageBreak(Page: integer): Extended;
+begin
+ if Page < FPages.Count then
+ Result := TfrxIEMPage(FPages[Page]).Value
+ else
+ Result := 0;
+end;
+
+function TfrxIEMatrix.GetPageHeight(Page: integer): Extended;
+begin
+ if Page < FPages.Count then
+ Result := TfrxIEMPage(FPages[Page]).Height
+ else
+ Result := 0;
+end;
+
+function TfrxIEMatrix.GetPageLMargin(Page: integer): Extended;
+begin
+ if (Page >= 0) and (Page < FPages.Count) then
+ Result := TfrxIEMPage(FPages[Page]).LeftMargin
+ else
+ Result := 0;
+end;
+
+function TfrxIEMatrix.GetPageTMargin(Page: integer): Extended;
+begin
+ if Page < FPages.Count then
+ Result := TfrxIEMPage(FPages[Page]).TopMargin
+ else
+ Result := 0;
+end;
+
+function TfrxIEMatrix.GetPageWidth(Page: integer): Extended;
+begin
+ if Page < FPages.Count then
+ Result := TfrxIEMPage(FPages[Page]).Width
+ else
+ Result := 0;
+end;
+
+function TfrxIEMatrix.GetPageBMargin(Page: integer): Extended;
+begin
+ if Page < FPages.Count then
+ Result := TfrxIEMPage(FPages[Page]).BottomMargin
+ else
+ Result := 0;
+end;
+
+function TfrxIEMatrix.GetPageMirrorMargin(Page: integer): Boolean;
+begin
+ if (Page >=0) and (Page < FPages.Count) then
+ Result := TfrxIEMPage(FPages[Page]).MirrorMargin
+ else
+ Result := false;
+end;
+
+function TfrxIEMatrix.GetPageRMargin(Page: integer): Extended;
+begin
+ if Page < FPages.Count then
+ Result := TfrxIEMPage(FPages[Page]).RightMargin
+ else
+ Result := 0;
+end;
+
+function TfrxIEMatrix.GetPageOrientation(Page: integer): TPrinterOrientation;
+begin
+ if Page < FPages.Count then
+ Result := TfrxIEMPage(FPages[Page]).Orientation
+ else
+ Result := poPortrait;
+end;
+
+function TfrxIEMatrix.GetPagesCount: Integer;
+begin
+ Result := FPages.Count;
+end;
+
+function TfrxIEMatrix.GetStyle(x, y: integer): TfrxIEMStyle;
+var
+ Obj: TfrxIEMObject;
+begin
+ Obj := GetObject(x, y);
+ if Obj <> nil then
+ Result := TfrxIEMStyle(FIEMStyleList[Obj.StyleIndex])
+ else
+ Result := nil;
+end;
+
+function TfrxIEMatrix.GetStyleById(StyleIndex: integer): TfrxIEMStyle;
+begin
+ Result := TfrxIEMStyle(FIEMStyleList[StyleIndex]);
+end;
+
+function TfrxIEMatrix.GetStylesCount: Integer;
+begin
+ Result := FIEMStyleList.Count;
+end;
+
+function TfrxIEMatrix.GetXPosById(PosIndex: integer): Extended;
+begin
+ Result := TfrxIEMPos(FXPos[PosIndex]).Value;
+end;
+
+function TfrxIEMatrix.GetYPosById(PosIndex: integer): Extended;
+begin
+ Result := TfrxIEMPos(FYPos[PosIndex]).Value;
+end;
+
+function TfrxIEMatrix.IsMemo(Obj: TfrxView): boolean;
+begin
+ Result := (Obj is TfrxCustomMemoView) and
+ ((Obj.BrushStyle in [TBrushKind.bkSolid, TBrushKind.bkNone]) or (not FBrushAsBitmap)) and
+ ((TfrxCustomMemoView(Obj).Rotation = 0) or (not FRotatedImage));
+end;
+
+function TfrxIEMatrix.IsLine(Obj: TfrxView): boolean;
+begin
+ Result := (Obj is TfrxCustomLineView) and ((Obj.Width = 0) or (Obj.Height = 0));
+end;
+
+function TfrxIEMatrix.IsRect(Obj: TfrxView): boolean;
+begin
+ Result := (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skRectangle);
+end;
+
+procedure TfrxIEMatrix.OptimizeFrames;
+var
+ x, y: Integer;
+ Obj, PrevObj: TfrxIEMObject;
+ FrameTyp: TfrxFrameTypes;
+ Style: TfrxIEMStyle;
+begin
+ for y := 0 to Height - 1 do
+ for x := 0 to Width - 1 do
+ begin
+ Obj := GetObject(x, y);
+ if Obj = nil then continue;
+ FrameTyp := Obj.Style.FrameTyp;
+
+ if (ftTop in FrameTyp) and (y > 0) then
+ begin
+ PrevObj := GetObject(x, y - 1);
+ if (PrevObj <> nil) and (PrevObj <> Obj) then
+ if (ftBottom in PrevObj.Style.FrameTyp) and
+ (PrevObj.Style.FrameWidth = Obj.Style.FrameWidth) and
+ (PrevObj.Style.FrameColor = Obj.Style.FrameColor) then
+ FrameTyp := FrameTyp - [ftTop];
+ end;
+ if (ftLeft in FrameTyp) and (x > 0) then
+ begin
+ PrevObj := GetObject(x - 1, y);
+ if (PrevObj <> nil) and (PrevObj <> Obj) then
+ if (ftRight in PrevObj.Style.FrameTyp) and
+ (PrevObj.Style.FrameWidth = Obj.Style.FrameWidth) and
+ (PrevObj.Style.FrameColor = Obj.Style.FrameColor) then
+ FrameTyp := FrameTyp - [ftLeft];
+ end;
+
+ if FrameTyp <> Obj.Style.FrameTyp then
+ begin
+ Style := TfrxIEMStyle.Create;
+ Style.Assign(Obj.Style);
+ Style.FrameTyp := FrameTyp;
+ Obj.StyleIndex := AddStyleInternal(Style);
+ Obj.Style := TfrxIEMStyle(FIEMStyleList[Obj.StyleIndex]);
+ end;
+ end;
+end;
+
+function TfrxIEMatrix.QuickFind(aList: TList; aPosition: Extended; var Index: Integer): Boolean;
+var
+ L, H, I: Integer;
+ C: Extended;
+begin
+ Result := False;
+ L := 0;
+ H := aList.Count - 1;
+ while L <= H do begin
+ I := (L + H) shr 1;
+ C := TfrxIEMPos(aList[I]).Value - aPosition;
+ if C < 0 then
+ L := I + 1
+ else begin
+ H := I - 1;
+ if C = 0 then begin
+ Result := True;
+ L := I
+ end
+ end
+ end;
+ Index := L
+end;
+
+procedure TfrxIEMatrix.OrderByCells;
+var
+ i, j, k, dx, dy: integer;
+ curx, cury: Extended;
+ obj: TfrxIEMObject;
+begin
+ OrderPosArray(FXPos, false);
+ OrderPosArray(FYPos, true);
+ for i := 0 to FIEMObjectList.Count - 1 do
+ begin
+ dx := 0; dy := 0;
+ obj := TfrxIEMObjectList(FIEMObjectList[i]).Obj;
+ QuickFind(FXPos, Obj.Left, j);
+ if j < FXPos.Count then
+ begin
+ TfrxIEMObjectList(FIEMObjectList[i]).x := j;
+ curx := Obj.Left;
+ k := j;
+ while (Obj.Left + Obj.Width > curx) and (k < FXPos.Count - 1) do
+ begin
+ Inc(k);
+ curx := TfrxIEMPos(FXPos[k]).Value;
+ Inc(dx);
+ end;
+ TfrxIEMObjectList(FIEMObjectList[i]).dx := dx;
+ end;
+ QuickFind(FYPos, Obj.Top, j);
+ if j < FYPos.Count then
+ begin
+ TfrxIEMObjectList(FIEMObjectList[i]).y := j;
+ cury := Obj.Top;
+ k := j;
+ while (Obj.Top + Obj.Height > cury) and (k < FYPos.Count - 1) do
+ begin
+ Inc(k);
+ cury := TfrxIEMPos(FYPos[k]).Value;
+ Inc(dy);
+ end;
+ TfrxIEMObjectList(FIEMObjectList[i]).dy := dy;
+ end;
+ end;
+ if FShowProgress then
+ FProgress.Tick;
+end;
+
+function SortPosCompare(Item1, Item2: Pointer): Integer;
+begin
+ if TfrxIEMPos(Item1).Value < TfrxIEMPos(Item2).Value then
+ Result := -1
+ else if TfrxIEMPos(Item1).Value > TfrxIEMPos(Item2).Value then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+procedure TfrxIEMatrix.OrderPosArray(List: TList; Vert: boolean);
+var
+ i, j, Cnt: integer;
+ pos1, pos2: Extended;
+ Reorder: Boolean;
+begin
+ List.Sort(SortPosCompare);
+ if FShowProgress then
+ FProgress.Tick;
+ i := 0;
+ while i <= List.Count - 2 do
+ begin
+ pos1 := TfrxIEMPos(List[i]).Value;
+ pos2 := TfrxIEMPos(List[i + 1]).Value;
+ if pos2 - pos1 < FInaccuracy then
+ begin
+ TfrxIEMPos(List[i]).Free;
+ List.Delete(i);
+ end else Inc(i);
+ end;
+ if FShowProgress then
+ FProgress.Tick;
+ Reorder := False;
+ if Vert and (FMaxCellHeight > 0) then
+ for i := 0 to List.Count - 2 do
+ begin
+ pos1 := TfrxIEMPos(List[i]).Value;
+ pos2 := TfrxIEMPos(List[i + 1]).Value;
+ if pos2 - pos1 > FMaxCellHeight then
+ begin
+ Cnt := Round(Int((pos2 - pos1) / FMaxCellHeight));
+ for j := 1 to Cnt do
+ AddPos(List, pos1 + FMaxCellHeight * j);
+ Reorder := True;
+ end;
+ end;
+ if FShowProgress then
+ FProgress.Tick;
+ if (not Vert) and (FMaxCellWidth > 0) then
+ for i := 0 to List.Count - 2 do
+ begin
+ pos1 := TfrxIEMPos(List[i]).Value;
+ pos2 := TfrxIEMPos(List[i + 1]).Value;
+ if pos2 - pos1 > FMaxCellWidth then
+ begin
+ Cnt := Round(Int((pos2 - pos1) / FMaxCellWidth));
+ for j := 1 to Cnt do
+ AddPos(List, pos1 + FMaxCellWidth * j);
+ Reorder := True;
+ end;
+ end;
+ if Reorder then
+ List.Sort(SortPosCompare);
+ if FShowProgress then
+ FProgress.Tick;
+end;
+
+procedure TfrxIEMatrix.Prepare;
+var
+ Style: TfrxIEMStyle;
+ FObj: TfrxIEMObject;
+ FObjItem: TfrxIEMObjectList;
+ i, j: Integer;
+ f: Boolean;
+{$IFDEF FR_DEBUG}
+ FLines: TStrings;
+ s, s1: String;
+{$ENDIF}
+begin
+ if FShowProgress then
+ begin
+ FProgress := TfrxProgress.Create(nil);
+ FProgress.Execute(11, frxResources.Get('ProgressWait'), false, true);
+ end;
+ if FFillArea then
+ begin
+ Style := TfrxIEMStyle.Create;
+ Style.FrameTyp := [];
+ Style.Color := claWhite;
+ FObj := TfrxIEMObject.Create;
+ FObj.StyleIndex := AddStyleInternal(Style);
+ FObj.Style := Style;
+ if FCropFillArea then
+ begin
+ FObj.Left := FMinLeft;
+ FObj.Top := FMinTop;
+ end
+ else
+ begin
+ FObj.Left := 0;
+ FObj.Top := 0;
+ end;
+ FObj.Width := MaxWidth;
+ FObj.Height := MaxHeight;
+ FObj.IsText := True;
+ AddPos(FXPos, 0);
+ AddPos(FYPos, 0);
+ FObjItem := TfrxIEMObjectList.Create;
+ FObjItem.x := 0;
+ FObjItem.y := 0;
+ FObjItem.dx := 1;
+ FObjItem.dy := 1;
+ FObjItem.Obj := FObj;
+ FIEMObjectList.Insert(0, FObjItem);
+ end;
+ OrderByCells;
+ FWidth := FXPos.Count;
+ FHeight := FYPos.Count;
+ Render;
+
+ if not FEmptyLines then
+ begin
+ i := 0;
+ while i < Height - 1 do
+ begin
+ f := True;
+ for j := 0 to Width - 1 do
+ f := f and (GetCell(j, i) = - 1);
+ if f then
+ DeleteMatrixLine(i)
+ else
+ Inc(i);
+ end;
+ end;
+
+ Analyse;
+ if FOptFrames then
+ OptimizeFrames;
+ if FShowProgress then
+ FProgress.Free;
+
+{$IFDEF FR_DEBUG}
+ FLines := TStringList.Create;
+ try
+ for i := 0 to Height - 1 do
+ begin
+ s := Format('%10f', [TfrxIEMPos(FYPos[i]).Value]) + ' |';
+ for j := 0 to Width - 1 do
+ begin
+ if GetCell(j, i) <> -1 then
+ s1 := GetObject(j, i).Memo.Text
+ else
+ s1 := '';
+ s := s + ' ' + Format('%6d', [GetCell(j, i)]) + '/' + Copy(s1, 1, 5);
+ end;
+ FLines.Add(s);
+ end;
+ FLines.SaveToFile('matrix_before.log');
+ finally
+ FLines.Free;
+ end;
+{$ENDIF}
+
+{$IFDEF FR_DEBUG}
+ FLines := TStringList.Create;
+ try
+ for i := 0 to Height - 1 do
+ begin
+ s := Format('%10f', [TfrxIEMPos(FYPos[i]).Value]) + ' |';
+ for j := 0 to Width - 1 do
+ s := s + ' ' + Format('%6d', [GetCell(j, i)]);
+ FLines.Add(s);
+ end;
+ FLines.SaveToFile('matrix_after.log');
+ finally
+ FLines.Free;
+ end;
+{$ENDIF}
+end;
+
+procedure TfrxIEMatrix.Render;
+var
+ i, old: integer;
+ obj: TfrxIEMObjectList;
+ Style: TfrxIEMStyle;
+ OldColor: TAlphaColor;
+begin
+ SetLength(FMatrix, FWidth * FHeight);
+ FillArea(0, 0, FWidth, FHeight, -1);
+ for i := 0 to FIEMObjectList.Count - 1 do
+ begin
+ obj := TfrxIEMObjectList(FIEMObjectList[i]);
+ if (Obj.Obj.Style <> nil) and (Obj.Obj.Style.Color = claNull) then
+ begin
+ old := GetCell(obj.x, obj.y);
+ if old <> -1 then
+ begin
+ OldColor := TfrxIEMObjectList(FIEMObjectList[Old]).Obj.Style.Color;
+ if (OldColor <> Obj.Obj.Style.Color) and (OldColor <> Obj.Obj.Style.Font.Color) then
+ begin
+ Style := TfrxIEMStyle.Create;
+ Style.Assign(Obj.Obj.Style);
+ Style.Color := OldColor;
+ Obj.Obj.StyleIndex := AddStyleInternal(Style);
+ Obj.Obj.Style := TfrxIEMStyle(FIEMStyleList[Obj.Obj.StyleIndex]);
+ end;
+ end;
+ end;
+ FillArea(obj.x, obj.y, obj.dx, obj.dy, i);
+ end;
+ if FShowProgress then
+ FProgress.Tick;
+end;
+
+procedure TfrxIEMatrix.ReplaceArea(ObjIndex, x, y, dx, dy, Value: integer);
+var
+ i, j: integer;
+begin
+ for i := y to y + dy - 1 do
+ for j := x to x + dx - 1 do
+ if GetCell(j, i) = ObjIndex then
+ FMatrix[FWidth * i + j] := Value;
+end;
+
+procedure TfrxIEMatrix.SetCell(x, y, Value: integer);
+begin
+ if (x < FWidth) and (y < FHeight) and (x >= 0) and (y >= 0) then
+ FMatrix[FWidth * y + x] := Value;
+end;
+
+procedure TfrxIEMatrix.DeleteMatrixLine(y: Integer);
+var
+ i, j: Integer;
+ delta: Extended;
+begin
+ if (y >= 0) and (y < FHeight) then
+ begin
+ if (y < FHeight - 1) then
+ delta := TfrxIEMPos(FYPos[y + 1]).Value - TfrxIEMPos(FYPos[y]).Value
+ else
+ delta := 0;
+ for i := 1 to FHeight - y - 1 do
+ TfrxIEMPos(FYPos[y + i]).Value := TfrxIEMPos(FYPos[y + i]).Value - delta;
+ if Assigned(TfrxIEMPos(FYPos[y])) then
+ TfrxIEMPos(FYPos[y]).Free;
+ FYPos.Delete(y);
+ j := FWidth * (FHeight - y - 1);
+ for i := 0 to j - 1 do
+ FMatrix[FWidth * y + i] := FMatrix[FWidth * (y + 1) + i];
+ Dec(FHeight);
+ end;
+end;
+
+function TfrxIEMatrix.GetFontCharset(Font: TFont): Integer;
+{var
+ b: TBitmap;
+ pm: ^OUTLINETEXTMETRIC;
+ i: Cardinal; }
+begin
+ Result := 0;
+{
+ if FFontList.IndexOf(Font.Name) <> -1 then
+ Result := StrToInt(FFontList.Values[Font.Name])
+ else
+ begin
+ b := TBitmap.Create;
+ try
+ b.Canvas.Lock;
+ b.Canvas.Font.Assign(Font);
+ i := GetOutlineTextMetrics(b.Canvas.Handle, 0, nil);
+ if i = 0 then
+ begin
+ b.Canvas.Font.Name := 'Arial';
+ i := GetOutlineTextMetrics(b.Canvas.Handle, 0, nil);
+ end;
+ if i <> 0 then
+ begin
+ pm := GlobalAllocPtr(GMEM_MOVEABLE or GMEM_SHARE, i);
+ try
+ if pm <> nil then
+ i := GetOutlineTextMetrics(b.Canvas.Handle, i, pm)
+ else
+ i := 0;
+ if i <> 0 then
+ begin
+ Result := pm.otmTextMetrics.tmCharSet;
+ FFontList.Add(Font.Name);
+ FFontList.Values[Font.Name] := IntToStr(Result);
+ end;
+ finally
+ GlobalFreePtr(pm);
+ end;
+ end;
+ finally
+ b.Canvas.Unlock;
+ b.Free;
+ end;
+ end; }
+end;
+
+procedure TfrxIEMatrix.SetPageFooter(Band: TfrxBand);
+begin
+ FFooter := Band;
+end;
+
+procedure TfrxIEMatrix.SetPageHeader(Band: TfrxBand);
+begin
+ FHeader := Band;
+end;
+
+function TfrxIEMatrix.GetIEPages(Index: Integer): TfrxIEMPage;
+begin
+ Result := nil;
+ if (Index < FPages.Count) and (Index >= 0) then
+ Result := TfrxIEMPage(FPages[Index]);
+end;
+
+{ TfrxIEMObjectList }
+
+constructor TfrxIEMObjectList.Create;
+begin
+ Exist := False;
+end;
+
+destructor TfrxIEMObjectList.Destroy;
+begin
+ Obj.Free;
+ inherited;
+end;
+
+{ TfrxIEMStyle }
+
+procedure TfrxIEMStyle.Assign(Style: TfrxIEMStyle);
+begin
+ Font.Assign(Style.Font);
+ FDisplayFormat.Assign(Style.DisplayFormat);
+ LineSpacing := Style.LineSpacing;
+ GapX := Style.GapX;
+ GapY := Style.GapY;
+ ParagraphGap := Style.ParagraphGap;
+ CharSpacing := Style.CharSpacing;
+ Charset := Style.Charset;
+ WordBreak := Style.WordBreak;
+ VAlign := Style.VAlign;
+ HAlign := Style.HAlign;
+ FrameTyp := Style.FrameTyp;
+ FrameWidth := Style.FrameWidth;
+ FrameColor := Style.FrameColor;
+ FrameStyle := Style.FrameStyle;
+ Color := Style.Color;
+ Rotation := Style.Rotation;
+ BrushStyle := Style.BrushStyle;
+ WordWrap := Style.WordWrap;
+end;
+
+constructor TfrxIEMStyle.Create;
+begin
+ Font := TfrxFont.Create;
+ FDisplayFormat := TfrxFormat.Create;
+ FDisplayFormat.DecimalSeparator := '';
+ FDisplayFormat.FormatStr := '';
+ FDisplayFormat.Kind := fkText;
+end;
+
+procedure TfrxIEMStyle.SetDisplayFormat(const Value: TfrxFormat);
+begin
+ FDisplayFormat.Assign(Value);
+end;
+
+destructor TfrxIEMStyle.Destroy;
+begin
+ FDisplayFormat.Free;
+ Font.Free;
+ inherited;
+end;
+
+{ TfrxIEMObject }
+
+constructor TfrxIEMObject.Create;
+begin
+ FMemo := TfrxWideStrings.Create;
+ //FMetafile := TMetafile.Create;
+ Left := 0;
+ Top := 0;
+ Image := nil;
+ FParent := nil;
+ FCounter := 0;
+ FIsText := true;
+ FIsRichText := false;
+ FIsDialogObject := False;
+ FLink := nil;
+ FHTMLTags := False;
+end;
+
+destructor TfrxIEMObject.Destroy;
+begin
+ //FMetafile.Free;
+ FMemo.Free;
+ if Assigned(FImage) then
+ FImage.Free;
+ inherited;
+end;
+
+function TfrxIEMObject.GetImage: TBitmap;
+begin
+ Result := FImage;
+end;
+
+procedure TfrxIEMObject.SetImage(const Value: TBitmap);
+begin
+ FImage := Value;
+end;
+
+procedure TfrxIEMObject.SetMemo(const Value: TWideStrings);
+begin
+ FMemo.Assign(Value);
+end;
+
+end.
diff --git a/LibD28/FMX.frxExportODF.fmx b/LibD28/FMX.frxExportODF.fmx
new file mode 100644
index 0000000..f852066
--- /dev/null
+++ b/LibD28/FMX.frxExportODF.fmx
@@ -0,0 +1,113 @@
+object frxODFExportDialog: TfrxODFExportDialog
+ Left = 0
+ Top = 0
+ Caption = 'Export to Open Document Spreadsheet'
+ ClientHeight = 263
+ ClientWidth = 277
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ ActiveControl = OkB
+ StyleLookup = 'backgroundstyle'
+ object OkB: TButton
+ Position.Point = '(118,232)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(198,232)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object GroupPageRange: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 269.000000000000000000
+ Height = 121.000000000000000000
+ TabOrder = 2
+ object DescrL: TLabel
+ Position.Point = '(12,82)'
+ Width = 249.000000000000000000
+ Height = 29.000000000000000000
+ TabOrder = 0
+ end
+ object AllRB: TRadioButton
+ Position.Point = '(12,20)'
+ Width = 153.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 108
+ TabOrder = 1
+ IsChecked = True
+ end
+ object CurPageRB: TRadioButton
+ Position.Point = '(12,40)'
+ Width = 153.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 118
+ TabOrder = 2
+ end
+ object PageNumbersRB: TRadioButton
+ Position.Point = '(12,60)'
+ Width = 77.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 124
+ TabOrder = 3
+ end
+ object PageNumbersE: TEdit
+ Position.Point = '(92,58)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 133
+ TabOrder = 4
+ KeyboardType = vktDefault
+ OnChange = PageNumbersEChange
+ Password = False
+ end
+ end
+ object GroupQuality: TGroupBox
+ Position.Point = '(4,128)'
+ Width = 269.000000000000000000
+ Height = 69.000000000000000000
+ TabOrder = 3
+ object WCB: TCheckBox
+ Position.Point = '(140,20)'
+ Width = 121.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 0
+ end
+ object ContinuousCB: TCheckBox
+ Position.Point = '(12,20)'
+ Width = 121.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ object PageBreaksCB: TCheckBox
+ Position.Point = '(12,40)'
+ Width = 121.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object BackgrCB: TCheckBox
+ Position.Point = '(140,40)'
+ Width = 121.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ end
+ object OpenCB: TCheckBox
+ Position.Point = '(12,204)'
+ Width = 257.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 4
+ end
+ object SaveDialog1: TSaveDialog
+ DefaultExt = '.ods'
+ Filter = 'Open Document Spreadsheet file (*.ods)|*.ods||'#13#10
+ Options = [ofHideReadOnly, ofNoChangeDir, ofEnableSizing]
+ end
+end
diff --git a/LibD28/FMX.frxExportODF.pas b/LibD28/FMX.frxExportODF.pas
new file mode 100644
index 0000000..18bcf48
--- /dev/null
+++ b/LibD28/FMX.frxExportODF.pas
@@ -0,0 +1,1884 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Open Document Format export }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Fediachov, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxExportODF;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.Printer, FMX.frxClass, FMX.frxExportMatrix, FMX.frxProgress, FMX.Objects, FMX.frxFMX,
+ FMX.frxXML, FMX.frxImageConverter, FMX.frxZip, FMX.Edit, FMX.Types , System.Variants,
+ FMX.frxBaseModalForm, System.UIConsts
+{$IFDEF DELPHI18}
+ , FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+type
+ TfrxODFExportDialog = class(TfrxForm)
+ OkB: TButton;
+ CancelB: TButton;
+ SaveDialog1: TSaveDialog;
+ GroupPageRange: TGroupBox;
+ DescrL: TLabel;
+ AllRB: TRadioButton;
+ CurPageRB: TRadioButton;
+ PageNumbersRB: TRadioButton;
+ PageNumbersE: TEdit;
+ GroupQuality: TGroupBox;
+ WCB: TCheckBox;
+ ContinuousCB: TCheckBox;
+ PageBreaksCB: TCheckBox;
+ OpenCB: TCheckBox;
+ BackgrCB: TCheckBox;
+ procedure FormCreate(Sender: TObject);
+ procedure PageNumbersEChange(Sender: TObject);
+ procedure PageNumbersEKeyPress(Sender: TObject; var Key: Char);
+ procedure FormKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+ end;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxODFExport = class(TfrxCustomExportFilter)
+ private
+ FExportPageBreaks: Boolean;
+ FExportStyles: Boolean;
+ FFirstPage: Boolean;
+ FMatrix: TfrxIEMatrix;
+ FOpenAfterExport: Boolean;
+ FPageBottom: Extended;
+ FPageLeft: Extended;
+ FPageRight: Extended;
+ FPageTop: Extended;
+ FPageWidth: Extended;
+ FPageHeight: Extended;
+ FPageOrientation: TPrinterOrientation;
+ FWysiwyg: Boolean;
+ FSingleSheet: Boolean;
+ FBackground: Boolean;
+ FCreator: String;
+ FEmptyLines: Boolean;
+ FTempFolder: String;
+ FZipFile: TfrxZipArchive;
+ FThumbImage: TBitmap;
+ FProgress: TfrxProgress;
+ FExportType: String;
+ FLanguage: string;
+ FStyleNode: TfrxXMLItem; // this node contains ODF styles
+ FStyles: TList; // List of TSpanStyle
+ FPicCount: Integer;
+ FCreationTime: TDateTime;
+ FPictureType: TfrxPictureType;
+ FRowStyleNames: TStrings;
+
+ function IsTerminated: Boolean;
+ procedure DoOnProgress(Sender: TObject);
+ function OdfPrepareString(const Str: WideString): WideString;
+ function OdfGetFrameName(const FrameStyle: TfrxFrameStyle): String;
+ procedure OdfMakeHeader(const Item: TfrxXMLItem);
+ procedure OdfCreateMeta(const FileName: String; const Creator: String);
+ procedure OdfCreateManifest(const FileName: String; const PicCount: Integer; const MValue: String);
+ procedure OdfCreateMime(const FileName: String; const MValue: String);
+ procedure AddNumberStyle(Item: TfrxXMLItem; const StyleName, Fmt: string);
+ procedure ExportBody(BodyNode: TfrxXMLItem);
+ procedure AddPic(Node: TfrxXMLItem; Obj: TfrxIEMObject);
+ procedure SplitOnTags( pNode: TfrxXMLItem; obj: TfrxIEMObject; line: WideString );
+ function GetHeaderText(m: TfrxIEMatrix): string;
+ function GetFooterText(m: TfrxIEMatrix): string;
+ procedure CreateStyles;
+ function CreateRowStyle(Row: Integer; PageBreakBefore: Boolean): string;
+
+ // Exports a row from the matrix to an ODF node.
+
+ procedure CreateRow(Node: TfrxXMLItem; Row: Integer; PageBreak: Boolean);
+
+ // Exports a range of rows from the matrix to an ODF node
+ // representing a report page.
+
+ procedure ExportRows(PageNode: TfrxXMLItem; RowFirst, RowLast, PageIndex: Integer);
+
+ // Creates an empty ODF cell.
+
+ procedure CreatEmptyCell(Node: TfrxXMLItem);
+
+ // Creates an adjacent empty cell.
+ // Such cells are created when an object covers several
+ // cells: one cell contains the object's data, the other
+ // are adjacent empty cells.
+
+ procedure CreateAdjacentCell(Node: TfrxXMLItem; Columns: Integer = 1);
+
+ // Creates an ODF cell with text or a picture.
+
+ procedure CreateDataCell(Node: TfrxXMLItem; Obj: TfrxIEMObject;
+ RowsSpanned, ColsSpanned: Integer);
+
+ //
+ // Adds a named style to the ODF document
+ // and returns the name of the added style.
+ // If a style with the same parameters has
+ // already been added, the duplicate is not
+ // created.
+ //
+
+ function AddStyle(Color: TAlphaColor; Style: TFontStyles): WideString;
+
+ // Checks whether a row in the matrix is empty.
+
+ function IsRowEmpty(Row: Integer): Boolean;
+
+ protected
+
+ procedure ExportPage(Stream: TStream);
+
+ public
+
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+
+ class function GetDescription: String; override;
+ class function ProcessSpaces(const s: WideString): WideString;
+ class function ProcessTabs(const s: WideString): WideString;
+ class function ProcessControlSymbols(const s: WideString): WideString;
+
+ function ShowModal: TModalResult; override;
+ function Start: Boolean; override;
+ procedure Finish; override;
+ procedure FinishPage(Page: TfrxReportPage; Index: Integer); override;
+ procedure StartPage(Page: TfrxReportPage; Index: Integer); override;
+ procedure ExportObject(Obj: TfrxComponent); override;
+
+ property ExportType: String read FExportType write FExportType;
+ property ExportTitle;
+
+ published
+
+ property PictureType: TfrxPictureType read FPictureType write FPictureType;
+ property ExportStyles: Boolean read FExportStyles write FExportStyles default True;
+ property ExportPageBreaks: Boolean read FExportPageBreaks write FExportPageBreaks default True;
+ property OpenAfterExport: Boolean read FOpenAfterExport write FOpenAfterExport default False;
+ property Wysiwyg: Boolean read FWysiwyg write FWysiwyg default True;
+ property Background: Boolean read FBackground write FBackground default False;
+ property Creator: String read FCreator write FCreator;
+ property CreationTime: TDateTime read FCreationTime write FCreationTime;
+ property EmptyLines: Boolean read FEmptyLines write FEmptyLines default True;
+ property SingleSheet: Boolean read FSingleSheet write FSingleSheet default False;
+ property Language: string read FLanguage write FLanguage; {default 'en'}
+ property SuppressPageHeadersFooters;
+ property OverwritePrompt;
+ end;
+
+ TfrxODSExport = class(TfrxODFExport)
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property ExportTitle;
+ published
+ property ExportStyles;
+ property ExportPageBreaks;
+ property OpenAfterExport;
+ property ShowProgress;
+ property Wysiwyg;
+ property Background;
+ property Creator;
+ property EmptyLines;
+ property SuppressPageHeadersFooters;
+ property OverwritePrompt;
+ end;
+
+ TfrxODTExport = class(TfrxODFExport)
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ published
+ property ExportStyles;
+ property ExportPageBreaks;
+ property OpenAfterExport;
+ property ShowProgress;
+ property Wysiwyg;
+ property Background;
+ property Creator;
+ property EmptyLines;
+ property SuppressPageHeadersFooters;
+ property OverwritePrompt;
+ end;
+
+implementation
+
+uses
+ FMX.frxUtils,
+ {frxFileUtils,}
+ FMX.frxUnicodeUtils,
+ FMX.frxRes,
+ FMX.frxrcExports,
+ FMX.frxGraphicUtils,
+ System.Types
+{$IFDEF MSWINDOWS}
+, Winapi.ShellAPI
+{$ENDIF}
+{$IFDEF LINUX}
+ ,FMUX.Api
+{$ENDIF}
+{$IFDEF MACOS}
+, Posix.Stdlib
+{$ENDIF}
+ ,System.IOUtils;
+
+{$R *.FMX}
+
+const
+ odfDivider = 38.5;
+ odfPageDiv = 37.8;
+ odfMargDiv = 10;
+ odfHeaderSize = 20;
+ odfRep = 'urn:oasis:names:tc:opendocument:xmlns:';
+
+var
+ odfXMLHeader: array[0..odfHeaderSize - 1] of array [0..1] of String = (
+ ('xmlns:office', odfRep + 'office:1.0'),
+ ('xmlns:style', odfRep + 'style:1.0'),
+ ('xmlns:text', odfRep + 'text:1.0'),
+ ('xmlns:table', odfRep + 'table:1.0'),
+ ('xmlns:draw', odfRep + 'drawing:1.0'),
+ ('xmlns:fo', odfRep + 'xsl-fo-compatible:1.0'),
+ ('xmlns:xlink', 'http://www.w3.org/1999/xlink'),
+ ('xmlns:dc', 'http://purl.org/dc/elements/1.1/'),
+ ('xmlns:meta', odfRep + 'meta:1.0'),
+ ('xmlns:number', odfRep + 'datastyle:1.0'),
+ ('xmlns:svg', odfRep + 'svg-compatible:1.0'),
+ ('xmlns:chart', odfRep + 'chart:1.0'),
+ ('xmlns:dr3d', odfRep + 'dr3d:1.0'),
+ ('xmlns:math', 'http://www.w3.org/1998/Math/MathML'),
+ ('xmlns:form', odfRep + 'form:1.0'),
+ ('xmlns:script', odfRep + 'script:1.0'),
+ ('xmlns:dom', 'http://www.w3.org/2001/xml-events'),
+ ('xmlns:xforms', 'http://www.w3.org/2002/xforms'),
+ ('xmlns:xsd', 'http://www.w3.org/2001/XMLSchema'),
+ ('xmlns:xsi', 'http://www.w3.org/2001/XMLSchema-instance'));
+
+type
+ TSpanStyle = class
+ public
+ Color: TAlphaColor;
+ Style: TFontStyles;
+ Name: WideString;
+ end;
+
+ TAnsiCharSet = set of AnsiChar;
+
+function FilterStr(const Src: string; const Chars: TAnsiCharSet): string;
+var
+ i: Integer;
+begin
+ Result := '';
+
+ for i := 1 to Length(Src) do
+ if AnsiChar(Src[i]) in Chars then
+ Result := Result + Src[i];
+end;
+
+{ TfrxODFExport }
+
+constructor TfrxODFExport.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FExportPageBreaks := True;
+ FExportStyles := True;
+ FWysiwyg := True;
+ FBackground := True;
+ FCreator := 'FastReport';
+ FEmptyLines := True;
+ FThumbImage := TBitmap.Create(1, 1);
+ FLanguage := 'en';
+ FRowStyleNames := TStringList.Create;
+ TStringList(FRowStyleNames).Sorted := True;
+end;
+
+procedure TfrxODFExport.AddNumberStyle(Item: TfrxXMLItem; const StyleName, Fmt: string);
+var
+ DecSep: Integer;
+ DecPlaces: string;
+begin
+ DecSep := Pos('.', Fmt);
+
+ if DecSep = 0 then
+ DecPlaces := '0'
+ else
+ DecPlaces := FilterStr(Copy(Fmt, DecSep, Length(Fmt)), ['0'..'9']);
+
+ if DecPlaces = '' then
+ DecPlaces := '0';
+
+ with Item do
+ begin
+ Name := 'number:number-style';
+
+ Prop['style:name'] := StyleName;
+
+ with Add do
+ begin
+ Name := 'number:number';
+
+ Prop['number:decimal-places'] := DecPlaces;
+ Prop['number:min-integer-digits'] := '1';
+ end;
+ end;
+end;
+
+class function TfrxODFExport.GetDescription: String;
+begin
+ Result := '';
+end;
+
+procedure TfrxODFExport.OdfCreateMeta(const FileName: String; const Creator: String);
+var
+ XML: TfrxXMLDocument;
+begin
+ XML := TfrxXMLDocument.Create;
+ try
+ XML.AutoIndent := True;
+ XML.Root.Name := 'office:document-meta';
+ XML.Root.Prop['xmlns:office'] := 'urn:oasis:names:tc:opendocument:xmlns:office:1.0';
+ XML.Root.Prop['xmlns:xlink'] := 'http://www.w3.org/1999/xlink';
+ XML.Root.Prop['xmlns:dc'] := 'http://purl.org/dc/elements/1.1/';
+ XML.Root.Prop['xmlns:meta'] := 'urn:oasis:names:tc:opendocument:xmlns:meta:1.0';
+ with XML.Root.Add do
+ begin
+ Name := 'office:meta';
+ with Add do
+ begin
+ Name := 'meta:generator';
+ Value := 'fast-report.com/Fast Report/build:' + FR_VERSION;
+ end;
+ with Add do
+ begin
+ Name := 'meta:initial-creator';
+ Value := string(UTF8Encode(Creator));
+ end;
+ with Add do
+ begin
+ Name := 'meta:creation-date';
+ Value := FormatDateTime('YYYY-MM-DD', CreationTime) + 'T' +
+ FormatDateTime('HH:MM:SS', CreationTime);
+ end;
+ end;
+ XML.SaveToFile(FileName);
+ finally
+ XML.Free;
+ end;
+end;
+
+procedure TfrxODFExport.OdfCreateMime(const FileName: String; const MValue: String);
+var
+ f: TFileStream;
+ s: AnsiString;
+begin
+ f := TFileStream.Create(FileName, fmCreate);
+ try
+ s := AnsiString('application/vnd.oasis.opendocument.' + MValue);
+ f.Write(s[1], Length(s));
+ finally
+ f.Free;
+ end;
+end;
+
+procedure TfrxODFExport.OdfCreateManifest(const FileName: String; const PicCount: Integer; const MValue: String);
+var
+ XML: TfrxXMLDocument;
+ i: Integer;
+ Fmime, s: String;
+begin
+ XML := TfrxXMLDocument.Create;
+ try
+ XML.AutoIndent := True;
+ XML.Root.Name := 'manifest:manifest';
+ XML.Root.Prop['xmlns:manifest'] := 'urn:oasis:names:tc:opendocument:xmlns:manifest:1.0';
+ with XML.Root.Add do
+ begin
+ Name := 'manifest:file-entry';
+ Prop['manifest:media-type'] := 'application/vnd.oasis.opendocument.' + MValue;
+ Prop['manifest:full-path'] := '/';
+ end;
+ with XML.Root.Add do
+ begin
+ Name := 'manifest:file-entry';
+ Prop['manifest:media-type'] := 'text/xml';
+ Prop['manifest:full-path'] := 'content.xml';
+ end;
+ with XML.Root.Add do
+ begin
+ Name := 'manifest:file-entry';
+ Prop['manifest:media-type'] := 'text/xml';
+ Prop['manifest:full-path'] := 'styles.xml';
+ end;
+ with XML.Root.Add do
+ begin
+ Name := 'manifest:file-entry';
+ Prop['manifest:media-type'] := 'text/xml';
+ Prop['manifest:full-path'] := 'meta.xml';
+ end;
+ s := '.' + GetPicFileExtension(PictureType);
+ FMime := s;//GetFileMIMEType(s);
+ for i := 1 to PicCount do
+ with XML.Root.Add do
+ begin
+ Name := 'manifest:file-entry';
+ Prop['manifest:media-type'] := FMime;
+ Prop['manifest:full-path'] := 'Pictures/Pic' + IntToStr(i) + s;
+ end;
+ XML.SaveToFile(FileName);
+ finally
+ XML.Free;
+ end;
+end;
+
+function TfrxODFExport.OdfPrepareString(const Str: WideString): WideString;
+var
+ i: Integer;
+ s: WideString;
+begin
+ Result := '';
+ s := Str;
+ if Copy(s, Length(s) - 1, 4) = #13#10 then
+ Delete(s, Length(s) - 1, 4);
+ for i := 1 to Length(s) do
+ begin
+ if s[i] = '&' then
+ Result := Result + '&'
+ else
+ if s[i] = '"' then
+ Result := Result + '"'
+ else if s[i] = '<' then
+ Result := Result + '<'
+ else if s[i] = '>' then
+ Result := Result + '>'
+ else if (s[i] <> #10) then
+ Result := Result + s[i]
+ end;
+end;
+
+class function TfrxODFExport.ProcessSpaces(const s: WideString): WideString;
+
+ function Ch(i: Integer): WideChar;
+ begin
+ if (i > 0) and (i <= Length(s)) then
+ Result := s[i]
+ else
+ Result := #0;
+ end;
+
+ function Ts(n: Integer): WideString;
+ begin
+ if n = 1 then
+ Result := ''
+ else
+ Result := '';
+ end;
+
+const
+ Space: WideChar = ' ';
+var
+ f, i: Integer;
+begin
+ if s = '' then
+ begin
+ Result := '';
+ Exit;
+ end;
+
+ f := 1;
+ Result := '';
+
+ for i := 1 to Length(s) do
+ if (s[f] = Space) <> (s[i] = Space) then
+ if s[f] = Space then
+ begin
+ Result := Result + Ts(i - f);
+ f := i;
+ end
+ else if (i > 0) and (s[i - 1] = Space) or (i = Length(s)) then
+ begin
+ Result := Result + Copy(s, f, i - f);
+ f := i;
+ end;
+
+ i := Length(s) + 1;
+
+ if s[f] = Space then
+ Result := Result + Ts(i - f)
+ else
+ Result := Result + Copy(s, f, i - f);
+end;
+
+class function TfrxODFExport.ProcessTabs(const s: WideString): WideString;
+begin
+ Result := StringReplace(s, #9, '', [rfReplaceAll]);
+end;
+
+class function TfrxODFExport.ProcessControlSymbols(const s: WideString): WideString;
+var
+ i, j: Integer;
+begin
+ SetLength(Result, Length(s));
+ i := 0;
+
+ for j := 1 to Length(s) do
+ if Ord(s[j]) > 31 then
+ begin
+ i := i + 1;
+ Result[i] := s[j];
+ end;
+
+ SetLength(Result, i);
+end;
+
+function TfrxODFExport.OdfGetFrameName(const FrameStyle: TfrxFrameStyle): String;
+begin
+ if FrameStyle = fsDouble then
+ Result := 'double'
+ else
+ Result := 'solid';
+end;
+
+procedure TfrxODFExport.OdfMakeHeader(const Item: TfrxXMLItem);
+var
+ i: Integer;
+begin
+ for i := 0 to odfHeaderSize - 1 do
+ Item.Prop[odfXMLHeader[i][0]] := odfXMLHeader[i][1];
+end;
+
+procedure TfrxODFExport.CreatEmptyCell(Node: TfrxXMLItem);
+begin
+ Node.Name := 'table:table-cell';
+end;
+
+procedure TfrxODFExport.CreateAdjacentCell(Node: TfrxXMLItem; Columns: Integer = 1);
+begin
+ Node.Name := 'table:covered-table-cell';
+ Node.Prop['table:style-name'] := 'ceb';
+
+ if Columns > 1 then
+ Node.Prop['table:number-columns-repeated'] := IntToStr(Columns);
+end;
+
+procedure TfrxODFExport.CreateDataCell(Node: TfrxXMLItem; Obj: TfrxIEMObject;
+ RowsSpanned, ColsSpanned: Integer);
+var
+ k: Integer;
+ sl: TStringList;
+ s, s2: WideString;
+ LineNode: TfrxXMLItem;
+begin
+ with Node do
+ begin
+ Name := 'table:table-cell';
+ Prop['table:style-name'] := 'ce' + IntToStr(Obj.StyleIndex);
+
+ if (RowsSpanned > 1) or (ColsSpanned > 1) then
+ begin
+ Prop['table:number-columns-spanned'] := IntToStr(ColsSpanned);
+ Prop['table:number-rows-spanned'] := IntToStr(RowsSpanned);
+ end;
+
+ // text cell
+
+ if Obj.IsText then
+ begin
+ s := Obj.Memo.Text;
+
+ if not Obj.HTMLTags then
+ s := OdfPrepareString(s);
+
+ s := ProcessSpaces(s);
+ s := ProcessTabs(s);
+ s := ProcessControlSymbols(s);
+
+ with Obj.Style.DisplayFormat do
+ if Kind <> fkNumeric then
+ begin
+ Prop['office:value-type'] := 'string';
+
+ sl := TStringList.Create;
+ sl.Text := s;
+
+ for k := 0 to sl.Count - 1 do
+ begin
+ LineNode := Add;
+ LineNode.Name := 'text:p';
+
+ if ExportType = 'text' then
+ LineNode.Prop['text:style-name'] := 'p' + IntToStr(Obj.StyleIndex);
+
+ if Obj.HTMLTags then
+ SplitOnTags(LineNode, Obj, sl[k])
+ else
+ LineNode.Value := sl[k];
+ end;
+
+ sl.Free;
+ end
+ else
+ begin
+ s2 := '';
+
+ for k := 1 to Length(s) do
+ if AnsiChar(s[k]) in ['0'..'9', '-'] then
+ s2 := s2 + s[k]
+ else
+ if (Char(s[k]) = FormatSettings.DecimalSeparator) or (s[k] = DecimalSeparator) then
+ s2 := s2 + FormatSettings.DecimalSeparator;
+
+ Prop['office:value-type'] := 'float';
+
+ Prop['office:value'] := string(UTF8Encode(
+ StringReplace(s2, FormatSettings.DecimalSeparator, '.', [rfReplaceAll])));
+
+ s := WideString(UTF8Encode(s));
+
+ with Add do
+ begin
+ Name := 'text:p';
+ Value := s;
+
+ if ExportType = 'text' then
+ Prop['text:style-name'] := 'p' + IntToStr(Obj.StyleIndex);
+ end;
+ end;
+ end
+
+ // picture cell
+
+ else if (Obj.Image <> nil) then
+ if FExportType <> 'text' then
+ AddPic(Add, Obj)
+ else
+ with Add do
+ begin
+ Name := 'text:p';
+ AddPic(Add, Obj);
+ end
+ end;
+end;
+
+procedure TfrxODFExport.CreateRow(Node: TfrxXMLItem; Row: Integer; PageBreak: Boolean);
+var
+ x: Integer;
+ Obj: TfrxIEMObject;
+ fx, fy, dx, dy: Integer;
+ acn: Integer; // number of consequent adjacent cells
+
+ procedure FlushAdjacentCells();
+ begin
+ if acn > 0 then
+ begin
+ CreateAdjacentCell(Node.Add, acn);
+ acn := 0;
+ end;
+ end;
+
+begin
+ Node.Name := 'table:table-row';
+ Node.Prop['table:style-name'] := CreateRowStyle(Row, PageBreak);
+
+ acn := 0;
+
+ for x := 0 to FMatrix.Width - 2 do
+ begin
+ Obj := FMatrix.GetObject(x, Row);
+
+ // empty cell
+
+ if Obj = nil then
+ begin
+ FlushAdjacentCells;
+ CreatEmptyCell(Node.Add);
+ end
+
+ // cell belonging to an already visited object
+
+ else if Obj.Counter <> 0 then
+ Inc(acn)
+
+ // cell that's not been visited before
+
+ else
+ begin
+ FlushAdjacentCells;
+ Obj.Counter := 1;
+ FMatrix.GetObjectPos(FMatrix.GetCell(x, Row), fx, fy, dx, dy);
+ CreateDataCell(Node.Add, Obj, dy, dx);
+ end;
+ end;
+
+ FlushAdjacentCells;
+end;
+
+function TfrxODFExport.CreateRowStyle(Row: Integer; PageBreakBefore: Boolean): string;
+var
+ Height: Extended;
+begin
+ Height := (FMatrix.GetYPosById(Row + 1) - FMatrix.GetYPosById(Row)) / odfDivider;
+ Result := 'ro' + frFloat2Str(Height, 3);
+
+ if PageBreakBefore then
+ Result := Result + 'b';
+
+ if FRowStyleNames.IndexOf(Result) >= 0 then
+ Exit;
+
+ FRowStyleNames.Add(Result);
+
+ with FStyleNode.Add do
+ begin
+ Name := 'style:style';
+
+ Prop['style:name'] := Result;
+ Prop['style:family'] := 'table-row';
+
+ with Add do
+ begin
+ Name := 'style:table-row-properties';
+
+ if PageBreakBefore then
+ Prop['fo:break-before'] := 'page'
+ else
+ Prop['fo:break-before'] := 'auto';
+
+ Prop['style:row-height'] := frFloat2Str(Height, 3) + 'cm';
+ end;
+ end;
+end;
+
+procedure TfrxODFExport.AddPic(Node: TfrxXMLItem; Obj: TfrxIEMObject);
+var
+ s: string;
+ r: TfrxRect;
+begin
+ r := FMatrix.GetObjectBounds(Obj);
+
+ with Node do
+ begin
+ s := 'Pic' + IntToStr(FPicCount) + '.' + GetPicFileExtension(PictureType);
+
+
+ if (Obj.Image <> nil) then
+ SaveGraphicAs(Obj.Image, FTempFolder + 'Pictures' + PathDelim + s, PictureType);
+
+ Name := 'draw:frame';
+ Prop['draw:z-index'] := '0';
+ Prop['draw:name'] := 'Picture' + IntToStr(FPicCount);
+ Prop['draw:style-name'] := 'gr1';
+ Prop['draw:text-style-name'] := 'P1';
+ Prop['svg:width'] := frFloat2Str((r.Right - r.Left) / odfDivider, 3) + 'cm';
+ Prop['svg:height'] := frFloat2Str((r.Bottom - r.Top) / odfDivider, 3) + 'cm';
+ Prop['svg:x'] := '0cm';
+ Prop['svg:y'] := '0cm';
+
+ with Add do
+ begin
+ Name := 'draw:image';
+ Prop['xlink:href'] := 'Pictures/' + s;
+ Prop['xlink:type'] := 'simple';
+ Prop['xlink:show'] := 'embed';
+ Prop['text:anchor-type'] := 'frame';
+ Prop['xlink:actuate'] := 'onLoad';
+ end;
+ end;
+
+ Inc(FPicCount);
+end;
+
+procedure TfrxODFExport.SplitOnTags(pNode: TfrxXMLItem;
+ obj: TfrxIEMObject; line: WideString);
+var
+ orig: WideString;
+ sub: WideString;
+ subTag: TfrxHTMLTag;
+
+ procedure SuppressEndingTrash( var s: WideString );
+ var
+ len: LongWord;
+ begin
+ if s = '' then Exit;
+ len := Length(s);
+ while ( len > 0 ) and ( s[len] < #32 ) do Dec(len);
+ SetLength( s, len );
+ end;
+
+ procedure Reset;
+ begin
+ subTag := Nil;
+ sub := '';
+ end;
+
+ function Empty: Boolean;
+ begin
+ Result := subTag = Nil;
+ end;
+
+ procedure Flush;
+ begin
+ with pNode.Add do
+ begin
+ Name := 'text:span';
+ Value := sub;
+ Prop['text:style-name'] := AddStyle( subTag.Color, subTag.Style );
+ end;
+ end;
+
+ procedure AddTag( tag: TfrxHTMLTag );
+ begin
+ sub := sub + orig[tag.Position];
+ subTag := tag;
+ end;
+
+ function Same( tag: TfrxHTMLTag ): Boolean;
+ begin
+ Result := False;
+ if subTag = Nil then Exit;
+
+ with subTag do
+ Result := ( Color = tag.Color ) and ( Style = tag.Style );
+ end;
+
+var
+ list: TfrxHTMLTagsList;
+ tags: TfrxHTMLTags;
+ tag: TfrxHTMLTag;
+ i, j: LongInt;
+
+begin
+ if line = '' then Exit;
+
+ list := TfrxHTMLTagsList.Create;
+ list.AllowTags := True;
+
+ with obj.Style.Font do
+ list.SetDefaults( Color, 0, Style );
+
+ orig := line;
+ list.ExpandHTMLTags(line);
+
+ for i := 0 to list.Count - 1 do
+ begin
+ tags := list[i];
+ if tags.Count = 0 then Continue;
+ Reset;
+
+ for j := 0 to tags.Count - 1 do
+ begin
+ tag := tags[j];
+
+ if not Empty and not Same(tag) then
+ begin
+ Flush;
+ Reset;
+ end;
+
+ AddTag(tag);
+ end;
+ end;
+
+ Flush;
+ list.Destroy;
+end;
+
+function TfrxODFExport.AddStyle(Color: TAlphaColor; Style: TFontStyles): WideString;
+var
+ i: LongInt;
+ s: TSpanStyle;
+begin
+ for i := 0 to FStyles.Count - 1 do
+ begin
+ s := TSpanStyle(FStyles[i]);
+ if (s.Color = Color) and (s.Style = Style) then
+ begin
+ Result := s.Name;
+ Exit;
+ end;
+ end;
+
+ s := TSpanStyle.Create;
+ FStyles.Add(s);
+
+ s.Color := Color;
+ s.Style := Style;
+ s.Name := 'ss-' + IntToStr(FStyles.Count);
+
+ with FStyleNode.Add do
+ begin
+ Name := 'style:style';
+ Prop['style:name'] := s.Name;
+ Prop['style:family'] := 'text';
+
+ with Add do
+ begin
+ Name := 'style:text-properties';
+ Prop['fo:color'] := HTMLRGBColor(Color);
+ end;
+
+ if fsItalic in s.Style then
+ with Add do
+ begin
+ Name := 'style:text-properties';
+ Prop['fo:font-style'] := 'italic';
+ Prop['style:font-style-asian'] := 'italic';
+ Prop['style:font-style-complex'] := 'italic';
+ end;
+
+ if fsBold in s.Style then
+ with Add do
+ begin
+ Name := 'style:text-properties';
+ Prop['fo:font-weight'] := 'bold';
+ Prop['style:font-weight-asian'] := 'bold';
+ Prop['style:font-weight-complex'] := 'bold';
+ end;
+
+ if fsUnderline in s.Style then
+ with Add do
+ begin
+ Name := 'style:text-properties';
+ Prop['style:text-underline-style'] := 'solid';
+ Prop['style:text-underline-width'] := 'auto';
+ Prop['style:text-underline-color'] := 'font-color';
+ end;
+
+ // todo: struck-out text
+ end;
+
+ Result := s.Name;
+end;
+
+function TfrxODFExport.GetHeaderText(m: TfrxIEMatrix): string;
+var
+ i: LongInt;
+begin
+ for i := 0 to m.GetObjectsCount - 1 do
+ with m.GetObjectById(i) do
+ if Header then
+ Result := Result + Memo.Text;
+
+ Result := OdfPrepareString(Result);
+end;
+
+function TfrxODFExport.IsRowEmpty(Row: Integer): Boolean;
+var
+ Col: Integer;
+begin
+ for Col := 0 to FMatrix.Width - 1 do
+ if FMatrix.GetCell(Col, Row) >= 0 then
+ begin
+ Result := False;
+ Exit;
+ end;
+
+ Result := True;
+end;
+
+function TfrxODFExport.IsTerminated: Boolean;
+begin
+ Result := (FProgress <> nil) and FProgress.Terminated
+end;
+
+function TfrxODFExport.GetFooterText(m: TfrxIEMatrix): string;
+var
+ i: LongInt;
+begin
+ for i := 0 to m.GetObjectsCount - 1 do
+ with m.GetObjectById(i) do
+ if Footer then
+ Result := Result + Memo.Text;
+
+ Result := OdfPrepareString(Result);
+end;
+
+procedure TfrxODFExport.CreateStyles;
+var
+ XML: TfrxXMLDocument;
+ f, h: string;
+begin
+ f := GetFooterText(FMatrix);
+ h := GetHeaderText(FMatrix);
+
+ XML := TfrxXMLDocument.Create;
+ try
+ XML.AutoIndent := True;
+ XML.Root.Name := 'office:document-styles';
+ OdfMakeHeader(XML.Root);
+
+ with XML.Root.Add do
+ begin
+ Name := 'office:styles';
+
+ with Add do
+ begin
+ Name := 'style:default-style';
+ Prop['style:family'] := 'paragraph';
+ end;
+
+ with Add do
+ begin
+ Name := 'style:paragraph-properties';
+
+ Prop['style:text-autospace'] := 'ideograph-alpha';
+ Prop['style:punctuation-wrap'] := 'hanging';
+ Prop['style:line-break'] := 'strict';
+ Prop['style:writing-mode'] := 'page';
+ end;
+
+ with Add do
+ begin
+ Name := 'style:text-properties';
+
+ Prop['fo:color'] := '#000000';
+ Prop['style:font-name'] := 'Times New Roman';
+ Prop['fo:font-size'] := '12pt';
+ Prop['fo:language'] := LowerCase(Language);
+ Prop['fo:country'] := UpperCase(Language);
+ Prop['style:font-name-asian'] := 'Arial Unicode MS';
+ Prop['style:font-size-asian'] := '12pt';
+ Prop['style:language-asian'] := LowerCase(Language);
+ Prop['style:country-asian'] := UpperCase(Language);
+ Prop['style:font-name-complex'] := 'Tahoma1';
+ Prop['style:font-size-complex'] := '12pt';
+ Prop['style:language-complex'] := LowerCase(Language);
+ Prop['style:country-complex'] := UpperCase(Language);
+ end;
+ end;
+
+ with XML.Root.Add do
+ begin
+ Name := 'office:automatic-styles';
+
+ with Add do
+ begin
+ Name := 'style:page-layout';
+ Prop['style:name'] := 'pm1';
+ with Add do
+ begin
+ Name := 'style:page-layout-properties';
+ Prop['fo:page-width'] := frFloat2Str( FPageWidth / odfPageDiv, 1) + 'cm';
+ Prop['fo:page-height'] := frFloat2Str( FPageHeight / odfPageDiv, 1) + 'cm';
+ Prop['fo:margin-top'] := frFloat2Str(FPageTop / odfMargDiv, 3) + 'cm';
+ Prop['fo:margin-bottom'] := frFloat2Str(FPageBottom / odfMargDiv, 3) + 'cm';
+ Prop['fo:margin-left'] := frFloat2Str(FPageLeft / odfMargDiv, 3) + 'cm';
+ Prop['fo:margin-right'] := frFloat2Str(FPageRight / odfMargDiv, 3) + 'cm';
+ end;
+ end;
+ end;
+
+ with XML.Root.Add do
+ begin
+ Name := 'office:master-styles';
+ with Add do
+ begin
+ Name := 'style:master-page';
+ Prop['style:name'] := 'PageDef';
+ Prop['style:page-layout-name'] := 'pm1';
+
+ if h <> '' then
+ with Add do
+ begin
+ Name := 'style:header';
+ with Add do
+ begin
+ Name := 'text:p';
+ Value := h;
+ end;
+ end;
+
+ if f <> '' then
+ with Add do
+ begin
+ Name := 'style:footer';
+ with Add do
+ begin
+ Name := 'text:p';
+ Value := f;
+ end;
+ end;
+ end;
+ end;
+
+ XML.SaveToFile(FTempFolder + 'styles.xml');
+ finally
+ XML.Free;
+ end;
+end;
+
+procedure TfrxODFExport.ExportPage(Stream: TStream);
+var
+ XML: TfrxXMLDocument;
+ s: WideString;
+ FList: TStringList;
+ i: Integer;
+ Style: TfrxIEMStyle;
+ d: Extended;
+ FilesList: TStringDynArray;
+begin
+ if ShowProgress then
+ FProgress.Execute(FMatrix.Height - 1, frxResources.Get('ProgressWait'), True, True);
+ FTempFolder := GetTempFile;
+ if TFile.Exists(FTempFolder) then
+ TFile.Delete(FTempFolder);
+ FTempFolder := FTempFolder + PathDelim;
+ MkDir(FTempFolder);
+ MkDir(FTempFolder + 'Pictures');
+ MkDir(FTempFolder + 'Thumbnails');
+ FPicCount := 0;
+ FThumbImage.SaveToFile(FTempFolder + 'Thumbnails' + PathDelim + 'thumbnail.bmp');
+ CreateStyles;
+
+ XML := TfrxXMLDocument.Create;
+ try
+ XML.AutoIndent := False;
+ XML.Root.Name := 'office:document-content';
+ OdfMakeHeader(XML.Root);
+ with XML.Root.Add do
+ Name := 'office:scripts';
+ // font styles
+ FList := TStringList.Create;
+ try
+ FList.Sorted := True;
+ for i := 0 to FMatrix.StylesCount - 1 do
+ begin
+ Style := FMatrix.GetStyleById(i);
+ if (Style.Font <> nil) and (FList.IndexOf(Style.Font.Name) = -1) then
+ FList.Add(Style.Font.Name);
+ end;
+ with XML.Root.Add do
+ begin
+ Name := 'office:font-face-decls';
+ for i := 0 to FList.Count - 1 do
+ begin
+ with Add do
+ begin
+ Name := 'style:font-face';
+ Prop['style:name'] := FList[i];
+ Prop['svg:font-family'] := ''' + FList[i] + ''';
+ Prop['style:font-pitch'] := 'variable';
+ end;
+ end;
+ end;
+ finally
+ FList.Free;
+ end;
+
+ FStyleNode := XML.Root.Add;
+ FStyles := TList.Create;
+
+ with FStyleNode do
+ begin
+ Name := 'office:automatic-styles';
+
+ with Add do
+ begin
+ Name := 'style:style';
+
+ Prop['style:style-name'] := 'pagebreak';
+ Prop['style:style-family'] := 'paragraph';
+ Prop['style:parent-style-name'] := 'Default';
+
+ with Add do
+ begin
+ Name := 'style:paragraph-properties';
+ Prop['fo:break-after'] := 'page';
+ end;
+ end;
+
+ FList := TStringList.Create;
+ try
+ FList.Sorted := True;
+ for i := 1 to FMatrix.Width - 1 do
+ begin
+ d := (FMatrix.GetXPosById(i) - FMatrix.GetXPosById(i - 1)) / odfDivider;
+ s := frFloat2Str(d, 3);
+ if FList.IndexOf(s) = -1 then
+ FList.Add(s);
+ end;
+ for i := 0 to FList.Count - 1 do
+ begin
+ with Add do
+ begin
+ Name := 'style:style';
+ Prop['style:name'] := 'co' + FList[i];
+ Prop['style:family'] := 'table-column';
+ with Add do
+ begin
+ Name := 'style:table-column-properties';
+ Prop['fo:break-before'] := 'auto';
+ Prop['style:column-width'] := FList[i] + 'cm';
+ end;
+ end;
+ end;
+ finally
+ FList.Free;
+ end;
+
+ FRowStyleNames.Clear;
+
+ // table style
+ with Add do
+ begin
+ Name := 'style:style';
+ Prop['style:name'] := 'ta1';
+ Prop['style:family'] := 'table';
+ Prop['style:master-page-name'] := 'PageDef';
+ with Add do
+ begin
+ Name := 'style:table-properties';
+ Prop['table:display'] := 'true';
+ Prop['style:writing-mode'] := 'lr-tb'; /// RTL - LTR?
+ end;
+ end;
+
+ // cells styles
+ with Add do
+ begin
+ Name := 'style:style';
+ Prop['style:name'] := 'ceb';
+ Prop['style:family'] := 'table-cell';
+ Prop['style:display'] := 'false';
+ end;
+
+ for i := 0 to FMatrix.StylesCount - 1 do
+ begin
+ Style := FMatrix.GetStyleById(i);
+
+ if Style.DisplayFormat.Kind = fkNumeric then
+ AddNumberStyle(Add, 'N' + IntToStr(i), Style.DisplayFormat.FormatStr);
+ end;
+
+ for i := 0 to FMatrix.StylesCount - 1 do
+ begin
+ Style := FMatrix.GetStyleById(i);
+
+ with Add do
+ begin
+ Name := 'style:style';
+ Prop['style:name'] := 'ce' + IntToStr(i);
+ Prop['style:family'] := 'table-cell';
+ Prop['style:parent-style-name'] := 'Standard';
+
+ if Style.DisplayFormat.Kind = fkNumeric then
+ Prop['style:data-style-name'] := 'N' + IntToStr(i);
+
+ if FExportType <> 'text' then
+ begin
+ with Add do
+ begin
+ Name := 'style:text-properties';
+ Prop['style:font-name'] := Style.Font.Name;
+ Prop['fo:font-size'] := IntToStr(Round(Style.Font.Size)) + 'pt';
+
+ if fsUnderline in Style.Font.Style then
+ begin
+ Prop['style:text-underline-style'] := 'solid';
+ Prop['style:text-underline-width'] := 'auto';
+ Prop['style:text-underline-color'] := 'font-color';
+ end;
+
+ if fsItalic in Style.Font.Style then
+ Prop['fo:font-style'] := 'italic';
+
+ if fsBold in Style.Font.Style then
+ Prop['fo:font-weight'] := 'bold';
+
+ Prop['fo:color'] := HTMLRGBColor(Style.Font.Color);
+ end;
+
+ with Add do
+ begin
+ Name := 'style:paragraph-properties';
+ if Style.HAlign = haLeft then
+ Prop['fo:text-align'] := 'start';
+ if Style.HAlign = haCenter then
+ Prop['fo:text-align'] := 'center';
+ if Style.HAlign = haRight then
+ Prop['fo:text-align'] := 'end';
+ if Style.GapX <> 0 then
+ begin
+ Prop['fo:margin-left'] := frFloat2Str(Style.GapX / odfDivider, 3) + 'cm';
+ Prop['fo:margin-right'] := Prop['fo:margin-left'];
+ end;
+ end;
+ end;
+
+ with Add do
+ begin
+ Name := 'style:table-cell-properties';
+
+ if Style.Color = claNull then
+ Prop['fo:background-color'] := 'transparent'
+ else
+ Prop['fo:background-color'] := HTMLRGBColor(Style.Color);
+
+ Prop['style:repeat-content'] := 'false';
+ if Style.Rotation > 0 then
+ begin
+ Prop['style:rotation-angle'] := IntToStr(Style.Rotation);
+ Prop['style:rotation-align'] := 'none';
+ end;
+ if Style.VAlign = vaCenter then
+ Prop['style:vertical-align'] := 'middle';
+ if Style.VAlign = vaTop then
+ Prop['style:vertical-align'] := 'top';
+ if Style.VAlign = vaBottom then
+ Prop['style:vertical-align'] := 'bottom';
+ if (ftLeft in Style.FrameTyp) then
+ Prop['fo:border-left'] := frFloat2Str(Style.FrameWidth / odfDivider, 3) + 'cm ' + OdfGetFrameName(Style.FrameStyle) + ' ' + HTMLRGBColor(Style.FrameColor);
+ if (ftRight in Style.FrameTyp) then
+ Prop['fo:border-right'] := frFloat2Str(Style.FrameWidth / odfDivider, 3) + 'cm ' + OdfGetFrameName(Style.FrameStyle) + ' ' + HTMLRGBColor(Style.FrameColor);
+ if (ftTop in Style.FrameTyp) then
+ Prop['fo:border-top'] := frFloat2Str(Style.FrameWidth / odfDivider, 3) + 'cm ' + OdfGetFrameName(Style.FrameStyle) + ' ' + HTMLRGBColor(Style.FrameColor);
+ if (ftBottom in Style.FrameTyp) then
+ Prop['fo:border-bottom'] := frFloat2Str(Style.FrameWidth / odfDivider, 3) + 'cm ' + OdfGetFrameName(Style.FrameStyle) + ' ' + HTMLRGBColor(Style.FrameColor);
+ if Style.WordWrap then
+ Prop['fo:wrap-option'] := 'wrap';
+ end;
+ end;
+ end;
+
+ if FExportType = 'text' then
+ begin
+ // text styles
+ with Add do
+ begin
+ Name := 'style:style';
+ Prop['style:name'] := 'pb';
+ Prop['style:family'] := 'paragraph';
+ Prop['style:display'] := 'false';
+ end;
+ for i := 0 to FMatrix.StylesCount - 1 do
+ begin
+ Style := FMatrix.GetStyleById(i);
+ with Add do
+ begin
+ Name := 'style:style';
+ Prop['style:name'] := 'p' + IntToStr(i);
+ Prop['style:family'] := 'paragraph';
+ Prop['style:parent-style-name'] := 'Standard';
+ with Add do
+ begin
+ Name := 'style:text-properties';
+ Prop['fo:letter-spacing'] := frFloat2Str(Style.CharSpacing/96, 4) + 'in';
+ Prop['style:font-name'] := Style.Font.Name;
+ Prop['fo:font-size'] := IntToStr(Round(Style.Font.Size)) + 'pt';
+ if fsUnderline in Style.Font.Style then
+ begin
+ Prop['style:text-underline-style'] := 'solid';
+ Prop['style:text-underline-width'] := 'auto';
+ Prop['style:text-underline-color'] := 'font-color';
+ end;
+ if fsItalic in Style.Font.Style then
+ Prop['fo:font-style'] := 'italic';
+ if fsBold in Style.Font.Style then
+ Prop['fo:font-weight'] := 'bold';
+ Prop['fo:color'] := HTMLRGBColor(Style.Font.Color);
+ end;
+ with Add do
+ begin
+ Name := 'style:paragraph-properties';
+ if Style.HAlign = haLeft then
+ Prop['fo:text-align'] := 'start';
+ if Style.HAlign = haCenter then
+ Prop['fo:text-align'] := 'center';
+ if Style.HAlign = haRight then
+ Prop['fo:text-align'] := 'end';
+ if Style.GapX <> 0 then
+ begin
+ Prop['fo:margin-left'] := frFloat2Str(Style.GapX / odfDivider, 3) + 'cm';
+ Prop['fo:margin-right'] := Prop['fo:margin-left'];
+ end;
+ end;
+ end;
+ end;
+ end;
+ // pic style
+ with Add do
+ begin
+ Name := 'style:style';
+ Prop['style:name'] := 'gr1';
+ Prop['style:family'] := 'graphic';
+ with Add do
+ begin
+ Name := 'style:graphic-properties';
+ Prop['draw:stroke'] := 'none';
+ Prop['draw:fill'] := 'none';
+ Prop['draw:textarea-horizontal-align'] := 'left';
+ Prop['draw:textarea-vertical-align'] := 'top';
+ Prop['draw:color-mode'] := 'standard';
+ Prop['draw:luminance'] := '0%';
+ Prop['draw:contrast'] := '0%';
+ Prop['draw:gamma'] := '100%';
+ Prop['draw:red'] := '0%';
+ Prop['draw:green'] := '0%';
+ Prop['draw:blue'] := '0%';
+ Prop['fo:clip'] := 'rect(0cm 0cm 0cm 0cm)';
+ Prop['draw:image-opacity'] := '100%';
+ Prop['style:mirror'] := 'none';
+ end;
+ end;
+ end;
+
+ ExportBody(XML.Root.Add);
+ XML.SaveToFile(FTempFolder + 'content.xml');
+ finally
+ XML.Free;
+
+ for i := 0 to FStyles.Count - 1 do
+ TObject(FStyles[i]).Free;
+
+ FStyles.Free;
+ end;
+ MkDir(FTempFolder + 'META-INF');
+ s := FExportType;
+ OdfCreateManifest(FTempFolder + 'META-INF' + PathDelim + 'manifest.xml', FPicCount, s);
+ OdfCreateMime(FTempFolder + 'mimetype', s);
+ OdfCreateMeta(FTempFolder + 'meta.xml', Creator);
+ FZipFile := TfrxZipArchive.Create;
+ try
+ FZipFile.RootFolder := AnsiString(FTempFolder);
+ FZipFile.AddDir(AnsiString(FTempFolder));
+ FZipFile.AddFile(AnsiString(FTempFolder + 'mimetype'));
+ FZipFile.AddDir(AnsiString(FTempFolder + 'META-INF' + PathDelim));
+ FZipFile.AddDir(AnsiString(FTempFolder + 'Pictures' + PathDelim));
+ FZipFile.AddDir(AnsiString(FTempFolder + 'Thumbnails' + PathDelim));
+ if ShowProgress then
+ begin
+ FProgress.Execute(FZipFile.FileCount, frxResources.Get('ProgressWait'), True, True);
+ FZipFile.OnProgress := DoOnProgress;
+ end;
+ FZipFile.SaveToStream(Stream);
+ finally
+ FZipFile.Free;
+ end;
+ FilesList := TDirectory.GetFiles(FTempFolder, '*', TSearchOption.soAllDirectories);
+ for s in FilesList do
+ if TFile.Exists(s) then
+ TFile.Delete(s);
+ TDirectory.Delete(FTempFolder, True);
+end;
+
+function TfrxODFExport.ShowModal: TModalResult;
+begin
+ if not Assigned(Stream) then
+ begin
+ with TfrxODFExportDialog.Create(nil) do
+ begin
+ SaveDialog1.DefaultExt := DefaultExt;
+ SaveDialog1.Filter := FilterDesc;
+ Caption := ExportTitle;
+ OpenCB.Visible := not SlaveExport;
+ if OverwritePrompt then
+ SaveDialog1.Options := SaveDialog1.Options + [TOpenOption.ofOverwritePrompt];
+ if SlaveExport then
+ FOpenAfterExport := False;
+
+ if (FileName = '') and (not SlaveExport) then
+ SaveDialog1.FileName := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(Report.FileName)), SaveDialog1.DefaultExt)
+ else
+ SaveDialog1.FileName := FileName;
+
+ ContinuousCB.IsChecked := SingleSheet;
+ PageBreaksCB.IsChecked := ExportPageBreaks;
+ WCB.IsChecked := Wysiwyg;
+ OpenCB.IsChecked := OpenAfterExport;
+ BackgrCB.IsChecked := Background;
+
+ if PageNumbers <> '' then
+ begin
+ PageNumbersE.Text := PageNumbers;
+ PageNumbersRB.IsChecked := True;
+ end;
+
+ Result := ShowModal;
+ PeekLastModalResult;
+ if Result = mrOk then
+ begin
+ PageNumbers := '';
+ CurPage := False;
+ if CurPageRB.IsChecked then
+ CurPage := True
+ else if PageNumbersRB.IsChecked then
+ PageNumbers := PageNumbersE.Text;
+
+ ExportPageBreaks := PageBreaksCB.IsChecked;
+ SingleSheet := ContinuousCB.IsChecked;
+ FWysiwyg := WCB.IsChecked;
+ FOpenAfterExport := OpenCB.IsChecked;
+ FBackground := BackgrCB.IsChecked;
+
+ CreationTime := Now;
+ if not SlaveExport then
+ begin
+ if DefaultPath <> '' then
+ SaveDialog1.InitialDir := DefaultPath;
+ if SaveDialog1.Execute then
+ FileName := SaveDialog1.FileName
+ else
+ Result := mrCancel;
+ PeekLastModalResult;
+ end
+ end;
+ Free;
+ end;
+ end else
+ Result := mrOk;
+end;
+
+function TfrxODFExport.Start: Boolean;
+begin
+ if SlaveExport then
+ begin
+ if Report.FileName <> '' then
+ FileName := ChangeFileExt(GetTemporaryFolder + ExtractFileName(Report.FileName), DefaultExt)
+ else
+ FileName := ChangeFileExt(GetTempFile, DefaultExt)
+ end;
+ FThumbImage.Width := 0;
+ FThumbImage.Height := 0;
+ if (FileName <> '') or Assigned(Stream) then
+ begin
+ if (ExtractFilePath(FileName) = '') and (DefaultPath <> '') then
+ FileName := DefaultPath + PathDelim + FileName;
+ FFirstPage := True;
+
+ FMatrix := TfrxIEMatrix.Create(UseFileCache, Report.EngineOptions.TempDir);
+ FMatrix.RotatedAsImage := False;
+ FMatrix.ShowProgress := ShowProgress;
+ FMatrix.Background := FBackground and FEmptyLines;
+ FMatrix.BackgroundImage := False;
+ FMatrix.Printable := ExportNotPrintable;
+ FMatrix.RichText := PictureType <> gpEMF;
+ FMatrix.PlainRich := PictureType <> gpEMF;
+ FMatrix.EmptyLines := FEmptyLines;
+ FMatrix.WrapText := False;
+ FMatrix.EMFPictures := True;
+ if FWysiwyg then
+ FMatrix.Inaccuracy := 0.5
+ else
+ FMatrix.Inaccuracy := 10;
+ FMatrix.DeleteHTMLTags := False;
+ Result := True
+ end
+ else
+ Result := False;
+end;
+
+procedure TfrxODFExport.StartPage(Page: TfrxReportPage; Index: Integer);
+begin
+ if FFirstPage then
+ begin
+ FPageLeft := Page.LeftMargin;
+ FPageTop := Page.TopMargin;
+ FPageBottom := Page.BottomMargin;
+ FPageRight := Page.RightMargin;
+ FPageOrientation := Page.Orientation;
+ FPageWidth := Page.Width;
+ FPageHeight := Page.Height;
+ FThumbImage.Width := Round(Page.Width / 5);
+ FThumbImage.Height := Round(Page.Height / 5);
+ end;
+end;
+
+procedure TfrxODFExport.ExportRows(PageNode: TfrxXMLItem; RowFirst, RowLast, PageIndex: Integer);
+var
+ x, y: Integer;
+ d: Extended;
+ s: string;
+ PageBreak: Boolean;
+begin
+ //DbgPrintMatrix(FMatrix, RowFirst, RowLast);
+
+ while (RowLast >= RowFirst) and IsRowEmpty(RowLast) do
+ Dec(RowLast);
+
+ while (RowLast >= RowFirst) and IsRowEmpty(RowFirst) do
+ Inc(RowFirst);
+
+ with PageNode do
+ begin
+ Name := 'table:table';
+
+ Prop['table:name'] := string(UTF8Encode(frxGet(8322) + ' ' + IntToStr(PageIndex + 1)));
+ Prop['table:style-name'] := 'ta1';
+ Prop['table:print'] := 'false';
+
+ for x := 0 to FMatrix.Width - 2 do
+ with Add do
+ begin
+ Name := 'table:table-column';
+ d := (FMatrix.GetXPosById(x + 1) - FMatrix.GetXPosById(x)) / odfDivider;
+ s := frFloat2Str(d, 3);
+ Prop['table:style-name'] := 'co' + s;
+ end;
+
+ for y := RowFirst to RowLast do
+ begin
+ PageBreak := ExportPageBreaks and
+ (FMatrix.PagesCount > PageIndex) and
+ (FMatrix.GetYPosById(y) >= FMatrix.GetPageBreak(PageIndex));
+
+ CreateRow(Add, y, PageBreak);
+
+ if PageBreak then
+ Inc(PageIndex);
+ end;
+ end;
+end;
+
+procedure TfrxODFExport.ExportBody(BodyNode: TfrxXMLItem);
+var
+ y1, y2, Page: Integer;
+begin
+ BodyNode.Name := 'office:body';
+
+ with BodyNode.Add do
+ begin
+ if ExportType = 'text' then
+ begin
+ Name := 'office:text';
+ Prop['text:use-soft-page-breaks'] := 'true';
+ end
+ else
+ Name := 'office:spreadsheet';
+
+ Page := 0;
+ y1 := 0;
+
+ if not SingleSheet then
+ with FMatrix do
+ for y2 := 0 to Height - 2 do
+ if (PagesCount > Page) and (GetYPosById(y2) >= GetPageBreak(Page)) then
+ begin
+ ExportRows(Add, y1, y2 - 1, Page);
+ y1 := y2;
+ Page := Page + 1;
+
+ if ExportPageBreaks then
+ with Add do
+ begin
+ Name := 'text:p';
+ Prop['text:style-name'] := 'pagebreak';
+ end;
+
+ DoOnProgress(Self);
+
+ if IsTerminated then
+ Break;
+ end;
+
+ if not IsTerminated then
+ ExportRows(Add, y1, FMatrix.Height - 2, Page);
+
+ DoOnProgress(Self);
+ end;
+end;
+
+procedure TfrxODFExport.ExportObject(Obj: TfrxComponent);
+var
+ Pic: TfrxPictureView;
+begin
+ { TfrxPreviewPages.Export adds a TfrxPictureView component
+ to each page. This component represents the background
+ picture. If the picture is not set and the background color is clNone,
+ then this component may be discarded.
+
+ The background component causes creation lots of quasi-components
+ that waste memory and time, so if possible the background should be
+ discarded. }
+
+ if (Obj.Name = '_pagebackground') then
+ if not Background then
+ Exit
+ else if (Obj is TfrxPictureView) then
+ begin
+ Pic := TfrxPictureView(Obj);
+
+ if (Pic.Picture.Width*Pic.Picture.Height = 0) and (Pic.Color = claNull) then
+ Exit;
+ end;
+
+ if (Obj is TfrxView) and (ExportNotPrintable or TfrxView(Obj).Printable) then
+ begin
+ FMatrix.AddObject(TfrxView(Obj));
+ if FFirstPage then
+ begin
+ FThumbImage.Canvas.BeginScene;
+ try
+ FThumbImage.Canvas.Fill.Color := claWhite;
+ FThumbImage.Canvas.FillRect(RectF(0, 0, FThumbImage.Width, FThumbImage.Height), 1, 1, AllCorners, 1);
+ TfrxView(Obj).Draw(FThumbImage.Canvas, 0.2, 0.2, Obj.Left / 5, Obj.Top / 5);
+ finally
+ FThumbImage.Canvas.EndScene;
+ end;
+ end;
+ end;
+end;
+
+procedure TfrxODFExport.FinishPage(Page: TfrxReportPage; Index: Integer);
+begin
+ FFirstPage := False;
+ FMatrix.AddPage(Page.Orientation, Page.Width, Page.Height, Page.LeftMargin,
+ Page.TopMargin, Page.RightMargin, Page.BottomMargin, Page.MirrorMargins, Index);
+end;
+
+procedure TfrxODFExport.Finish;
+var
+ Exp: TStream;
+begin
+ try
+ Exp := nil;
+ FProgress := nil;
+
+ try
+ if ShowProgress then
+ FProgress := TfrxProgress.Create(nil);
+
+ FMatrix.Prepare;
+
+ if Assigned(Stream) then
+ Exp := Stream
+ else
+ Exp := TFileStream.Create(FileName, fmCreate);
+
+ ExportPage(Exp);
+ finally
+ FProgress.Free;
+ FMatrix.Free;
+
+ if not Assigned(Stream) then
+ Exp.Free;
+ end;
+ except
+ on e: Exception do
+ case Report.EngineOptions.NewSilentMode of
+ simSilent: Report.Errors.Add(e.Message);
+ simMessageBoxes: frxErrorMsg(e.Message);
+ simReThrow: raise;
+ end;
+ end;
+
+ if OpenAfterExport and not Assigned(Stream) then
+{$IFDEF MSWINDOWS}
+ ShellExecute(0, 'open', PChar(FileName), '', '', 5);
+{$ENDIF}
+{$IFDEF LINUX}
+ FmuxOpenFile(PChar(FileName));
+{$ENDIF}
+{$IFDEF MACOS}
+ ShellExecute(FileName);
+{$ENDIF}
+end;
+
+destructor TfrxODFExport.Destroy;
+begin
+ FThumbImage.Free;
+ FRowStyleNames.Free;
+ inherited;
+end;
+
+procedure TfrxODFExport.DoOnProgress(Sender: TObject);
+begin
+ if ShowProgress then
+ FProgress.Tick;
+end;
+
+{ TfrxODSExport }
+
+constructor TfrxODSExport.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ ExportType := 'spreadsheet';
+ FilterDesc := frxResources.Get('ODSExportFilter');
+ DefaultExt := frxGet(8960);
+ ExportTitle := frxResources.Get('ODSExport');
+end;
+
+class function TfrxODSExport.GetDescription: String;
+begin
+ Result := frxResources.Get('ODSExport');
+end;
+
+{ TfrxODTExport }
+
+constructor TfrxODTExport.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ ExportType := 'text';
+ FilterDesc := frxResources.Get('ODTExportFilter');
+ DefaultExt := frxGet(8961);
+ ExportTitle := frxResources.Get('ODTExport');
+end;
+
+class function TfrxODTExport.GetDescription: String;
+begin
+ Result := frxResources.Get('ODTExport');
+end;
+
+{ TfrxODFExportDialog }
+
+procedure TfrxODFExportDialog.FormCreate(Sender: TObject);
+begin
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ GroupPageRange.Text := frxGet(7);
+ AllRB.Text := frxGet(3);
+ CurPageRB.Text := frxGet(4);
+ PageNumbersRB.Text := frxGet(5);
+ DescrL.Text := frxGet(9);
+ GroupQuality.Text := frxGet(8);
+ ContinuousCB.Text := frxGet(8950);
+ PageBreaksCB.Text := frxGet(6);
+ WCB.Text := frxGet(8102);
+ BackgrCB.Text := frxGet(8103);
+ OpenCB.Text := frxGet(8706);
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+end;
+
+
+procedure TfrxODFExportDialog.PageNumbersEChange(Sender: TObject);
+begin
+ PageNumbersRB.IsChecked := True;
+end;
+
+procedure TfrxODFExportDialog.PageNumbersEKeyPress(Sender: TObject;
+ var Key: Char);
+begin
+ case key of
+ '0'..'9':;
+ #8, '-', ',':;
+ else
+ key := #0;
+ end;
+end;
+
+procedure TfrxODFExportDialog.FormKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ if Key = VK_F1 then
+ frxResources.Help(Self);
+end;
+
+end.
diff --git a/LibD28/FMX.frxExportPDF.fmx b/LibD28/FMX.frxExportPDF.fmx
new file mode 100644
index 0000000..c959dd8
--- /dev/null
+++ b/LibD28/FMX.frxExportPDF.fmx
@@ -0,0 +1,351 @@
+object frxPDFExportDialog: TfrxPDFExportDialog
+ Left = 0
+ Top = 0
+ Caption = 'Export to PDF'
+ ClientHeight = 335
+ ClientWidth = 292
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object PageControl1: TTabControl
+ Position.Point = '(4,4)'
+ Width = 285.000000000000000000
+ Height = 293.000000000000000000
+ TabOrder = 0
+ TabIndex = 0
+ TabHeight = 20.000000000000000000
+ object ExportPage: TTabItem
+ Width = 71.250000000000000000
+ Height = 20.000000000000000000
+ TabOrder = 0
+ Index = 0
+ WordWrap = False
+ object OpenCB: TCheckBox
+ Position.Point = '(16,248)'
+ Width = 253.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 0
+ end
+ object GroupQuality: TGroupBox
+ Position.Point = '(4,152)'
+ Width = 267.000000000000000000
+ Height = 89.000000000000000000
+ TabOrder = 1
+ object CompressedCB: TCheckBox
+ Position.Point = '(12,20)'
+ Width = 117.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 0
+ IsChecked = True
+ end
+ object EmbeddedCB: TCheckBox
+ Position.Point = '(12,40)'
+ Width = 117.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ IsChecked = True
+ end
+ object PrintOptCB: TCheckBox
+ Position.Point = '(136,20)'
+ Width = 126.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object OutlineCB: TCheckBox
+ Position.Point = '(136,40)'
+ Width = 121.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ object BackgrCB: TCheckBox
+ Position.Point = '(12,60)'
+ Width = 117.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 4
+ end
+ end
+ object GroupPageRange: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 267.000000000000000000
+ Height = 141.000000000000000000
+ TabOrder = 2
+ object DescrL: TLabel
+ Position.Point = '(12,82)'
+ Width = 249.000000000000000000
+ Height = 47.000000000000000000
+ TabOrder = 0
+ end
+ object AllRB: TRadioButton
+ Position.Point = '(12,20)'
+ Width = 153.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 108
+ TabOrder = 1
+ IsChecked = True
+ end
+ object CurPageRB: TRadioButton
+ Position.Point = '(12,40)'
+ Width = 153.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 118
+ TabOrder = 2
+ end
+ object PageNumbersRB: TRadioButton
+ Position.Point = '(12,60)'
+ Width = 77.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 124
+ TabOrder = 3
+ end
+ object PageNumbersE: TEdit
+ Position.Point = '(92,58)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 133
+ TabOrder = 4
+ KeyboardType = vktDefault
+ OnChange = PageNumbersEChange
+ Password = False
+ end
+ end
+ end
+ object InfoPage: TTabItem
+ Width = 71.250000000000000000
+ Height = 20.000000000000000000
+ TabOrder = 1
+ Index = 1
+ WordWrap = False
+ object DocInfoGB: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 267.000000000000000000
+ Height = 197.000000000000000000
+ TabOrder = 0
+ object TitleL: TLabel
+ Position.Point = '(12,26)'
+ Width = 89.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 0
+ end
+ object AuthorL: TLabel
+ Position.Point = '(12,54)'
+ Width = 89.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 1
+ end
+ object SubjectL: TLabel
+ Position.Point = '(12,82)'
+ Width = 89.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 2
+ end
+ object KeywordsL: TLabel
+ Position.Point = '(12,110)'
+ Width = 89.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 3
+ end
+ object CreatorL: TLabel
+ Position.Point = '(12,138)'
+ Width = 89.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 4
+ end
+ object ProducerL: TLabel
+ Position.Point = '(12,166)'
+ Width = 89.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 5
+ end
+ object TitleE: TEdit
+ Position.Point = '(108,22)'
+ Width = 152.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 6
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object AuthorE: TEdit
+ Position.Point = '(108,50)'
+ Width = 152.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 7
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object SubjectE: TEdit
+ Position.Point = '(108,78)'
+ Width = 152.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 8
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object KeywordsE: TEdit
+ Position.Point = '(108,106)'
+ Width = 152.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 9
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object CreatorE: TEdit
+ Position.Point = '(108,134)'
+ Width = 152.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 10
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object ProducerE: TEdit
+ Position.Point = '(108,162)'
+ Width = 152.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 11
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+ end
+ object SecurityPage: TTabItem
+ Width = 71.250000000000000000
+ Height = 20.000000000000000000
+ TabOrder = 2
+ Index = 2
+ WordWrap = False
+ object SecGB: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 267.000000000000000000
+ Height = 84.000000000000000000
+ TabOrder = 0
+ object OwnPassL: TLabel
+ Position.Point = '(12,26)'
+ Width = 114.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 0
+ end
+ object UserPassL: TLabel
+ Position.Point = '(13,54)'
+ Width = 113.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 1
+ end
+ object OwnPassE: TEdit
+ Position.Point = '(127,22)'
+ Width = 133.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 2
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object UserPassE: TEdit
+ Position.Point = '(127,50)'
+ Width = 133.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 3
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+ object PermGB: TGroupBox
+ Position.Point = '(4,92)'
+ Width = 265.000000000000000000
+ Height = 121.000000000000000000
+ TabOrder = 1
+ object PrintCB: TCheckBox
+ Position.Point = '(12,21)'
+ Width = 248.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 0
+ end
+ object ModCB: TCheckBox
+ Position.Point = '(12,45)'
+ Width = 248.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ object CopyCB: TCheckBox
+ Position.Point = '(12,68)'
+ Width = 248.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object AnnotCB: TCheckBox
+ Position.Point = '(12,91)'
+ Width = 246.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ end
+ end
+ object ViewerPage: TTabItem
+ Width = 71.250000000000000000
+ Height = 20.000000000000000000
+ TabOrder = 3
+ Index = 3
+ WordWrap = False
+ object ViewerGB: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 267.000000000000000000
+ Height = 177.000000000000000000
+ TabOrder = 0
+ object HideToolbarCB: TCheckBox
+ Position.Point = '(12,24)'
+ Width = 241.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 0
+ end
+ object HideMenubarCB: TCheckBox
+ Position.Point = '(12,48)'
+ Width = 241.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ object HideWindowUICB: TCheckBox
+ Position.Point = '(12,72)'
+ Width = 241.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object FitWindowCB: TCheckBox
+ Position.Point = '(12,96)'
+ Width = 241.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ object CenterWindowCB: TCheckBox
+ Position.Point = '(12,120)'
+ Width = 241.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 4
+ end
+ object PrintScalingCB: TCheckBox
+ Position.Point = '(12,144)'
+ Width = 241.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 5
+ end
+ end
+ end
+ end
+ object OkB: TButton
+ Position.Point = '(126,303)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(206,303)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 2
+ ModalResult = 2
+ Cancel = True
+ end
+ object SaveDialog1: TSaveDialog
+ Options = [ofHideReadOnly, ofNoChangeDir, ofEnableSizing]
+ end
+end
diff --git a/LibD28/FMX.frxExportPDF.pas b/LibD28/FMX.frxExportPDF.pas
new file mode 100644
index 0000000..be3dd60
--- /dev/null
+++ b/LibD28/FMX.frxExportPDF.pas
@@ -0,0 +1,3967 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ PDF export filter }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Fediachov, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxExportPDF;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ {$IFDEF MSWINDOWS}
+ Winapi.Windows,
+ {$ENDIF}
+ {$IFDEF MACOS}
+ Macapi.CocoaTypes, Macapi.CoreText, Macapi.Mach, Macapi.CoreServices, Macapi.CoreFoundation, Macapi.CoreGraphics, Macapi.Foundation,
+ {$ENDIF}
+ System.SysUtils, System.Classes, FMX.Controls, FMX.Dialogs, FMX.Edit, FMX.frxFMX,
+ FMX.Types, FMX.TabControl, System.UITypes, System.Types, FMX.frxImageConverter,
+ FMX.Printer, FMX.frxClass, FMX.frxRC4, FMX.Forms, System.UIConsts, FMX.frxChBox,
+ FMX.frxBaseModalForm
+ {$IFDEF MSWINDOWS}
+ , Winapi.ShellAPI
+ {$ENDIF}
+ {$IFDEF MACOS}
+ , Posix.Stdlib, Macapi.AppKit
+ {$ENDIF}
+ , System.WideStrings, System.AnsiStrings, FMX.frxTrueTypeFont,
+ FMX.frxTrueTypeCollection, FMX.frxNameTableClass, System.Variants
+{$IFDEF DELPHI18}
+ , FMX.StdCtrls
+ , FMX.Surfaces
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+ SCRIPT_CACHE = Pointer;
+ PScriptCache = ^SCRIPT_CACHE;
+
+ SCRIPT_ANALYSIS = record
+ fFlags: Word;
+ s: Word
+ end;
+ PScriptAnalysis = ^SCRIPT_ANALYSIS;
+
+ SCRIPT_ITEM = record
+ iCharPos: Integer;
+ a: SCRIPT_ANALYSIS;
+ end;
+ PScriptItem = ^SCRIPT_ITEM;
+
+ GOFFSET = record
+ du: Longint;
+ dv: Longint;
+ end;
+ PGOffset = ^GOFFSET;
+
+ TRGBTriple = packed record
+ rgbtBlue: Byte;
+ rgbtGreen: Byte;
+ rgbtRed: Byte;
+ end;
+
+ TRGBAWord = packed record
+ Blue: Byte;
+ Green: Byte;
+ Red: Byte;
+ Alpha: Byte;
+ end;
+
+// PRGBAWord = ^TRGBAWord;
+
+ PRGBAWord = ^TRGBAWordArray;
+ TRGBAWordArray = array[0..4095] of TRGBAWord;
+
+type
+ TfrxPDFEncBit = (ePrint, eModify, eCopy, eAnnot);
+ TfrxPDFEncBits = set of TfrxPDFEncBit;
+
+ TfrxPDFExportDialog = class(TfrxForm)
+ PageControl1: TTabControl;
+ ExportPage: TTabItem;
+ InfoPage: TTabItem;
+ SecurityPage: TTabItem;
+ ViewerPage: TTabItem;
+ OkB: TButton;
+ CancelB: TButton;
+ SaveDialog1: TSaveDialog;
+ OpenCB: TCheckBox;
+ GroupQuality: TGroupBox;
+ CompressedCB: TCheckBox;
+ EmbeddedCB: TCheckBox;
+ PrintOptCB: TCheckBox;
+ OutlineCB: TCheckBox;
+ BackgrCB: TCheckBox;
+ GroupPageRange: TGroupBox;
+ DescrL: TLabel;
+ AllRB: TRadioButton;
+ CurPageRB: TRadioButton;
+ PageNumbersRB: TRadioButton;
+ PageNumbersE: TEdit;
+ SecGB: TGroupBox;
+ OwnPassL: TLabel;
+ UserPassL: TLabel;
+ OwnPassE: TEdit;
+ UserPassE: TEdit;
+ PermGB: TGroupBox;
+ PrintCB: TCheckBox;
+ ModCB: TCheckBox;
+ CopyCB: TCheckBox;
+ AnnotCB: TCheckBox;
+ DocInfoGB: TGroupBox;
+ TitleL: TLabel;
+ TitleE: TEdit;
+ AuthorE: TEdit;
+ AuthorL: TLabel;
+ SubjectL: TLabel;
+ SubjectE: TEdit;
+ KeywordsL: TLabel;
+ KeywordsE: TEdit;
+ CreatorE: TEdit;
+ CreatorL: TLabel;
+ ProducerL: TLabel;
+ ProducerE: TEdit;
+ ViewerGB: TGroupBox;
+ HideToolbarCB: TCheckBox;
+ HideMenubarCB: TCheckBox;
+ HideWindowUICB: TCheckBox;
+ FitWindowCB: TCheckBox;
+ CenterWindowCB: TCheckBox;
+ PrintScalingCB: TCheckBox;
+ procedure FormCreate(Sender: TObject);
+ procedure PageNumbersEChange(Sender: TObject);
+ procedure PageNumbersEKeyPress(Sender: TObject; var Key: Char);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure OkBClick(Sender: TObject);
+ end;
+
+type
+ TfrxPDFRun = class
+ public
+ analysis: SCRIPT_ANALYSIS;
+ text: WideString;
+ constructor Create(t: WideString; a: SCRIPT_ANALYSIS);
+ end;
+
+ TfrxPDFXObjectHash = array[0..15] of Byte; // MD5
+ TfrxPDFXObject = record
+ ObjId: Integer; // id that appears in 'id 0 R'
+ Hash: TfrxPDFXObjectHash;
+ end;
+
+
+ TfrxPDFFont = class
+ private
+ tempBitmap: TBitmap;
+ //FUSCache: PScriptCache;
+ TrueTypeTables: TrueTypeCollection;
+ FSubstituteName: String;
+ FCurrentFont: TrueTypeFont;
+ function GetGlyphIndices(text: WideString; glyphs: System.PWord; widths: System.PInteger; rtl: boolean): integer;
+ public
+ Index: Integer;
+ Widths: TList;
+ UsedAlphabet: TList;
+ UsedAlphabetUnicode: TList;
+ FComposedList: TList;
+ TextMetric: OutlineTextMetric;
+ Name: AnsiString;
+ SourceFont: TFont;
+ Reference: Longint;
+ Saved: Boolean;
+ PackFont: Boolean;
+ FontData: TMemoryStream;
+ FontDataSize: Longint;
+ PDFdpi_divider: double;
+ FDpiFX: double;
+ LastRemappedStrWidth: Integer;
+ LastRemappedStrSpacesCount: Integer;
+ constructor Create(Font: TFont);
+ destructor Destroy; override;
+ procedure Cleanup;
+ procedure FillOutlineTextMetrix;
+ procedure GetFontFile;
+ procedure PackFontFile;
+ function RemapString(str: WideString; rtl: Boolean): WideString;
+ function GetFontName: AnsiString;
+ end;
+
+ TfrxPDFOutlineNode = class
+ public
+ Number: Integer;
+ Dest: Integer; // Index to a page referred to by this outline node
+ Top: Integer; // Position on the referred to page
+ CountTree: Integer; // Number of all descendant nodes
+ Count: Integer; // Number of all first-level descendants
+ Title: string;
+
+ First: TfrxPDFOutlineNode; // The first first-level descendant
+ Last: TfrxPDFOutlineNode; // The last first-level descendant
+ Next: TfrxPDFOutlineNode; // The next neighbouring node
+ Prev: TfrxPDFOutlineNode; // The previous neighbouring node
+ Parent: TfrxPDFOutlineNode; // The parent node of this node
+
+ constructor Create;
+ destructor Destroy; override;
+ end;
+
+ TfrxPDFPage = class
+ public
+ Height: Double;
+ end;
+
+ TfrxPDFAnnot = class
+ public
+ Number: Integer;
+ Rect: String;
+ Hyperlink: String;
+ DestPage: Integer;
+ DestY: Integer;
+ end;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxPDFExport = class(TfrxCustomExportFilter)
+ private
+ FCompressed: Boolean;
+ FEmbedded: Boolean;
+ FEmbedProt: Boolean;
+ FOpenAfterExport: Boolean;
+ FPrintOpt: Boolean;
+ FPages: TList;
+ FOutline: Boolean;
+ FQuality: Integer;
+ FPreviewOutline: TfrxCustomOutline;
+ FSubject: WideString;
+ FAuthor: WideString;
+ FBackground: Boolean;
+ FCreator: WideString;
+ FTags: Boolean;
+ FProtection: Boolean;
+ FUserPassword: AnsiString;
+ FOwnerPassword: AnsiString;
+ FProtectionFlags: TfrxPDFEncBits;
+ FKeywords: WideString;
+ FTitle: WideString;
+ FProducer: WideString;
+ FPrintScaling: Boolean;
+ FFitWindow: Boolean;
+ FHideMenubar: Boolean;
+ FCenterWindow: Boolean;
+ FHideWindowUI: Boolean;
+ FHideToolbar: Boolean;
+
+ pdf: TStream;
+
+ FRootNumber: longint;
+ FPagesNumber: longint;
+ FInfoNumber: longint;
+ FStartXRef: longint;
+
+ FFonts: TList;
+ FPageFonts: TList;
+ FXRef: TStringList;
+ FPagesRef: TStringList;
+
+ FWidth: Extended;
+ FHeight: Extended;
+ FMarginLeft: Extended;
+ FMarginWoBottom: Extended;
+ FMarginTop: Extended;
+
+ FEncKey: AnsiString;
+ FOPass: AnsiString;
+ FUPass: AnsiString;
+
+ FEncBits: Cardinal;
+ FFileID: AnsiString;
+
+ FDivider: Extended;
+ FLastColor: TAlphaColor;
+ FLastColorResult: String;
+
+ OutStream: TMemoryStream;
+
+ FXObjects: array of TfrxPDFXObject;
+ FUsedXObjects: array of Integer; // XObjects' ids used within the current page
+ FPicTotalSize: Cardinal; // size occupied by all pictures
+
+ { When an anchor is being added, two changes are made:
+
+ - a link object is written to the document
+ - a reference to the link object is added to /Annots field of the page
+
+ FPageAnnots contains text of /Annots field.
+ This stream is updated by WriteLink and its auxiliary routines. }
+
+ FPageAnnots: TMemoryStream;
+ FAnnots: TList;
+ FBmpCanvas: TBitmap;
+
+ function PrepXrefPos(pos: Longint): String;
+ procedure Write(Stream: TStream; const S: AnsiString);{$IFDEF Delphi12} overload;
+ procedure Write(Stream: TStream; const S: String); overload;
+{$ENDIF}
+ procedure WriteLn(Stream: TStream; const S: AnsiString);{$IFDEF Delphi12} overload;
+ procedure WriteLn(Stream: TStream; const S: String); overload;
+{$ENDIF}
+ function GetID: AnsiString;
+ function CryptStr(Source: AnsiString; Key: AnsiString; Enc: Boolean; id: Integer): AnsiString;
+ function CryptStream(Source: TStream; Target: TStream; Key: AnsiString; id: Integer): AnsiString;
+ function PrepareString(const Text: WideString; Key: AnsiString; Enc: Boolean; id: Integer): AnsiString;
+ function EscapeSpecialChar(TextStr: AnsiString): AnsiString;
+ function StrToUTF16(const Value: WideString): AnsiString;
+ function StrToUTF16H(const Value: WideString): AnsiString;
+ function PMD52Str(p: Pointer): AnsiString;
+ function PadPassword(Password: AnsiString): AnsiString;
+ procedure PrepareKeys;
+ procedure SetProtectionFlags(const Value: TfrxPDFEncBits);
+ procedure Clear;
+ procedure WriteFont(pdfFont: TfrxPDFFont);
+ procedure AddObject(const Obj: TfrxView);
+ function StrToHex(const Value: WideString): AnsiString;
+ function StrToHexSp(const SourceStr, Value: WideString; SpaceAdjustment: Extended): AnsiString;
+ function AddPage(Page: TfrxReportPage): TfrxPDFPage;
+ function ObjNumber(FNumber: longint): String;
+ function ObjNumberRef(FNumber: longint): String;
+ function UpdateXRef: longint;
+ function GetPDFColor(const Color: TAlphaColor): String;
+
+ function FindXObject(const Hash: TfrxPDFXObjectHash): Integer;
+ function AddXObject(Id: Integer; const Hash: TfrxPDFXObjectHash): Integer;
+ procedure ClearXObject;
+ procedure GetStreamHash(out Hash: TfrxPDFXObjectHash; S: TStream);
+
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ function ShowModal: TModalResult; override;
+ function Start: Boolean; override;
+ procedure ExportObject(Obj: TfrxComponent); override;
+ procedure Finish; override;
+ procedure StartPage(Page: TfrxReportPage; Index: Integer); override;
+ procedure FinishPage(Page: TfrxReportPage; Index: Integer); override;
+ published
+ property Compressed: Boolean read FCompressed write FCompressed default True;
+ property EmbeddedFonts: Boolean read FEmbedded write FEmbedded default False;
+ property EmbedFontsIfProtected: Boolean read FEmbedProt write FEmbedProt default True;
+ property OpenAfterExport: Boolean read FOpenAfterExport
+ write FOpenAfterExport default False;
+ property PrintOptimized: Boolean read FPrintOpt write FPrintOpt;
+ property Outline: Boolean read FOutline write FOutline;
+ property Background: Boolean read FBackground write FBackground;
+ property HTMLTags: Boolean read FTags write FTags;
+ property OverwritePrompt;
+ property Quality: Integer read FQuality write FQuality;
+
+ property Title: WideString read FTitle write FTitle;
+ property Author: WideString read FAuthor write FAuthor;
+ property Subject: WideString read FSubject write FSubject;
+ property Keywords: WideString read FKeywords write FKeywords;
+ property Creator: WideString read FCreator write FCreator;
+ property Producer: WideString read FProducer write FProducer;
+
+ property UserPassword: AnsiString read FUserPassword write FUserPassword;
+ property OwnerPassword: AnsiString read FOwnerPassword write FOwnerPassword;
+ property ProtectionFlags: TfrxPDFEncBits read FProtectionFlags write SetProtectionFlags;
+
+ property HideToolbar: Boolean read FHideToolbar write FHideToolbar;
+ property HideMenubar: Boolean read FHideMenubar write FHideMenubar;
+ property HideWindowUI: Boolean read FHideWindowUI write FHideWindowUI;
+ property FitWindow: Boolean read FFitWindow write FFitWindow;
+ property CenterWindow: Boolean read FCenterWindow write FCenterWindow;
+ property PrintScaling: Boolean read FPrintScaling write FPrintScaling;
+ end;
+
+{ Returns a color in PDF form. }
+
+function PdfColor(Color: TAlphaColor): AnsiString;
+
+{ Returns a pair of coordinates in PDF form. }
+
+function PdfPoint(x, y: Double): AnsiString;
+
+{ Moves the pen to the specified point. }
+
+function PdfMove(x, y: Double): AnsiString;
+
+{ Draws a line to the specified point. }
+
+function PdfLine(x, y: Double): AnsiString;
+
+{ Changes the current color. }
+
+function PdfSetColor(Color: TAlphaColor): AnsiString;
+
+{ Changes width of the line drawed by the pen.
+ The width is measured in points (1/72 of an inch). }
+
+function PdfSetLineWidth(Width: Double): AnsiString;
+
+{ Changes the color of the pen. }
+
+function PdfSetLineColor(Color: TAlphaColor): AnsiString;
+
+{ Fills the latest contoured area. }
+
+function PdfFill: AnsiString;
+
+{ Fills a rectangle area. }
+
+function PdfFillRect(Left, Bottom, Right, Top: Double; Color: TAlphaColor): AnsiString;
+
+{ Returns either (...) or <...> sequence. }
+
+function PdfString(const Str: WideString): AnsiString;
+
+// list of fonts that do not have bold-italic versions and needs to be simulated
+var
+ frxPDFFontsNeedStyleSimulation: TStringList;
+
+implementation
+
+uses FMX.frxUtils, FMX.frxUnicodeUtils, {FMX.frxFileUtils,} FMX.frxRes, FMX.frxrcExports, FMX.frxPreviewPages,
+ FMX.frxGraphicUtils, FMX.frxGzip, FMX.frxMD5, System.Math, FMX.frxXML,
+ FMX.frxCrypto
+{$IFDEF LINUX}
+ , FMX.frxLinuxFonts
+ , FMUX.Api
+{$ENDIF};
+
+{$IFDEF MACOS}
+const
+ libCore = '/System/Library/Frameworks/ApplicationServices.framework/Frameworks/ATS.framework/ATS';
+ frxCoreFoundationLib = '/System/Library/Frameworks/CoreFoundation.framework/CoreFoundation';
+{$IFDEF UNDERSCOREIMPORTNAME}
+ _PFX = '_';
+{$ELSE}
+ _PFX = '';
+{$ENDIF}
+ function ATSFontGetFileReference( iFont: ATSFontRef; var oFile: FSRef ): OSStatus; cdecl; external libCore name _PFX + 'ATSFontGetFileReference';
+ {$ENDIF}
+const
+ PDF_VER = '1.5';
+ PDF_DIVIDER = 0.75;
+ PDF_MARG_DIVIDER = 0.05;
+ PDF_PRINTOPT = 3;
+ PDF_PK: array [ 1..32 ] of Byte =
+ ( $28, $BF, $4E, $5E, $4E, $75, $8A, $41, $64, $00, $4E, $56, $FF, $FA, $01, $08,
+ $2E, $2E, $00, $B6, $D0, $68, $3E, $80, $2F, $0C, $A9, $FE, $64, $53, $69, $7A );
+ KAPPA1 = 1.5522847498;
+ KAPPA2 = 2 - KAPPA1;
+ tpPt = 0.00357; //typography pt
+
+
+{$R *.fmx}
+
+{ PDF commands }
+
+{$IFDEF MACOS}
+type
+ TfrxCFURLStartAccessingSecurityScopedResource = function (url: CFURLRef): Boolean; cdecl;
+ TfrxCFURLStopAccessingSecurityScopedResource = procedure (url: CFURLRef); cdecl;
+
+var
+ kCTFontURLAttribute_ : Pointer;
+ _frxCFURLStartAccessingSecurityScopedResource: TfrxCFURLStartAccessingSecurityScopedResource;
+ _frxCFURLStopAccessingSecurityScopedResource: TfrxCFURLStopAccessingSecurityScopedResource;
+
+function ConvCFString(const Value: CFStringRef): String;
+begin
+ if Assigned(Value) then
+ Result := string(TNSString.Wrap(Value).UTF8String)
+ else
+ Result := '';
+end;
+
+function kCTFontURLAttribute: Pointer;
+var
+ CTLib: HMODULE;
+begin
+ CTLib := LoadLibrary(libCoreText);
+ if kCTFontURLAttribute_ = nil then
+ kCTFontURLAttribute_ := Pointer(GetProcAddress(CTLib, PWideChar('kCTFontURLAttribute'))^);
+ FreeLibrary(CTLib);
+ Result := kCTFontURLAttribute_;
+end;
+{$ENDIF}
+
+function PdfSetLineColor(Color: TAlphaColor): AnsiString;
+begin
+ Result := PdfColor(Color) + ' RG'#13#10;
+end;
+
+function PdfSetLineWidth(Width: Double): AnsiString;
+begin
+ Result := AnsiString(frFloat2Str(Width, 2) + ' w'#13#10);
+end;
+
+function PdfFillRect(Left, Bottom, Right, Top: Double; Color: TAlphaColor): AnsiString;
+begin
+ Result := PdfSetLineWidth(0) + PdfSetLineColor(Color) + PdfSetColor(Color) +
+ PdfMove(Left, Bottom) + PdfLine(Right, Bottom) + PdfLine(Right, Top) +
+ PdfLine(Left, Top) + PdfFill;
+end;
+
+function PdfSetColor(Color: TAlphaColor): AnsiString;
+begin
+ Result := PdfColor(Color) + ' rg'#13#10;
+end;
+
+function PdfFill: AnsiString;
+begin
+ Result := 'B'#13#10;
+end;
+
+function PdfPoint(x, y: Double): AnsiString;
+begin
+ Result := AnsiString(frFloat2Str(x, 2) + ' ' + frFloat2Str(y, 2));
+end;
+
+function PdfLine(x, y: Double): AnsiString;
+begin
+ Result := PdfPoint(x, y) + ' l'#13#10;
+end;
+
+function PdfMove(x, y: Double): AnsiString;
+begin
+ Result := PdfPoint(x, y) + ' m'#13#10;
+end;
+
+function PdfColor(Color: TAlphaColor): AnsiString;
+
+ function c(x: Integer): AnsiString;
+ begin
+ if x < 1 then
+ Result := '0'
+ else if x > 254 then
+ Result := '1'
+ else
+ Result := AnsiString('0.' + IntToStr(x * 100 shr 8));
+
+ { Actually, Result = x * 100 div 255, but
+ division by 255 works much slower then
+ division by 256. }
+ end;
+
+var
+ r, g, b: Integer;
+begin
+
+ b := Color and $ff;
+ g := Color shr 8 and $ff;
+ r := Color shr 16 and $ff;
+
+ Result := c(r) + ' ' + c(g) + ' ' + c(b);
+end;
+
+function PdfString(const Str: WideString): AnsiString;
+
+ { A string is literal if parentheses in it are balanced and all characters
+ are within the printable ASCII characters set. }
+
+ function IsLiteralString(const s: WideString): Boolean;
+ var
+ i: Integer;
+ nop: Integer; // number of opened parentheses
+ begin
+ Result := False;
+ nop := 0;
+
+ for i := 1 to Length(s) do
+ if s[i] = '(' then
+ Inc(nop)
+ else if s[i] = ')' then
+ if nop > 0 then
+ Dec(nop)
+ else
+ Exit
+ // printable ASCII characters are those with codes 32..126
+ else if (Word(s[i]) < 32) or (Word(s[i]) > 126) then
+ Exit;
+
+ Result := nop = 0;
+ end;
+
+ function GetLiteralString(const s: WideString): AnsiString;
+ begin
+ Result := '(' + AnsiString(s) + ')'
+ end;
+
+ function GetHexString(const s: WideString): AnsiString;
+ var
+ i: Integer;
+ hs: AnsiString;
+ begin
+ SetLength(Result, 2 + Length(s) * 4);
+ Result[1] := '<';
+ Result[Length(Result)] := '>';
+
+ for i := 1 to Length(s) do
+ begin
+ hs := AnsiString(IntToHex(Word(s[i]), 4));
+
+ Result[i*4 - 3 + 1] := hs[1];
+ Result[i*4 - 3 + 2] := hs[2];
+ Result[i*4 - 3 + 3] := hs[3];
+ Result[i*4 - 3 + 4] := hs[4];
+ end;
+ end;
+
+begin
+ if IsLiteralString(Str) then
+ Result := GetLiteralString(Str)
+ else
+ Result := GetHexString(Str)
+end;
+
+function PdfSubstituteName(const aName: String): String;
+var
+ i: Integer;
+begin
+ Result := aName;
+ i := 1;
+ while i <= ((High(Substitutes) - Low(Substitutes))) do
+ begin
+ if UTF8Decode(Substitutes[i]) = aName then
+ begin
+ Result := UTF8Decode(Substitutes[i + 1]);
+ break;
+ end;
+ i := i + 2;
+ end;
+end;
+
+{ TfrxPDFOutlineNode }
+
+constructor TfrxPDFOutlineNode.Create;
+begin
+ inherited;
+ Dest := -1;
+end;
+
+destructor TfrxPDFOutlineNode.Destroy;
+begin
+ if Next <> nil then
+ Next.Free;
+
+ if First <> nil then
+ First.Free;
+
+ inherited;
+end;
+
+{ TfrxPDFExport }
+
+constructor TfrxPDFExport.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FPageAnnots := TMemoryStream.Create;
+ FAnnots := TList.Create;
+ FCompressed := True;
+ FEmbedProt := True;
+ FPrintOpt := False;
+ FAuthor := 'FastReport';
+ FSubject := 'FastReport PDF export';
+ FBackground := False;
+ FCreator := 'FastReport';
+ FTags := True;
+ FProtection := False;
+ FUserPassword := '';
+ FOwnerPassword := '';
+ FProducer := '';
+ FKeywords := '';
+ FProtectionFlags := [ePrint, eModify, eCopy, eAnnot];
+ FilterDesc := frxGet(8707);
+ DefaultExt := frxGet(8708);
+ FCreator := Application.Name;
+ FPrintScaling := False;
+ FFitWindow := False;
+ FHideMenubar := False;
+ FCenterWindow := False;
+ FHideWindowUI := False;
+ FHideToolbar := False;
+
+ FRootNumber := 0;
+ FPagesNumber := 0;
+ FInfoNumber := 0;
+ FStartXRef := 0;
+
+ FPages := TList.Create;
+ FFonts := TList.Create;
+ FPageFonts := TList.Create;
+ FXRef := TStringList.Create;
+ FPagesRef := TStringList.Create;
+
+ FMarginLeft := 0;
+ FMarginWoBottom := 0;
+
+ FEncKey := '';
+ FOPass := '';
+ FUPass := '';
+
+ FEncBits := 0;
+
+ FDivider := 96;//frxDrawText.DefPPI / frxDrawText.ScrPPI;
+ FLastColor := claBlack;
+ FLastColorResult := '0 0 0';
+
+ FQuality := 95;
+ FBmpCanvas := TBitmap.Create(1, 1);
+end;
+
+destructor TfrxPDFExport.Destroy;
+begin
+ Clear;
+ FPageAnnots.Free;
+ FAnnots.Free;
+ FFonts.Free;
+ FPageFonts.Free;
+ FXRef.Free;
+ FPagesRef.Free;
+ FPages.Free;
+ FBmpCanvas.Free;
+ inherited;
+end;
+
+class function TfrxPDFExport.GetDescription: String;
+begin
+ Result := frxResources.Get('PDFexport');
+end;
+
+function TfrxPDFExport.ShowModal: TModalResult;
+var
+ s: String;
+begin
+ if (FTitle = '') and Assigned(Report) then
+ FTitle := Report.ReportOptions.Name;
+ if not Assigned(Stream) then
+ begin
+ if Assigned(Report) then
+ FOutline := Report.PreviewOptions.OutlineVisible
+ else
+ FOutline := True;
+ with TfrxPDFExportDialog.Create(nil) do
+ begin
+ OpenCB.Visible := not SlaveExport;
+ if OverwritePrompt then
+ SaveDialog1.Options := SaveDialog1.Options + [TOpenOption.ofOverwritePrompt];
+ if SlaveExport then
+ FOpenAfterExport := False;
+
+ if (FileName = '') and (not SlaveExport) then
+ begin
+ s := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(Report.FileName)), SaveDialog1.DefaultExt);
+ SaveDialog1.FileName := s;
+ end
+ else
+ SaveDialog1.FileName := FileName;
+
+ OpenCB.IsChecked := FOpenAfterExport;
+ CompressedCB.IsChecked := FCompressed;
+ EmbeddedCB.IsChecked := FEmbedded;
+ PrintOptCB.IsChecked := FPrintOpt;
+ OutlineCB.IsChecked := FOutline;
+ OutlineCB.Enabled := FOutline;
+ BackgrCB.IsChecked := FBackground;
+
+ if PageNumbers <> '' then
+ begin
+ PageNumbersE.Text := PageNumbers;
+ PageNumbersRB.IsChecked := True;
+ end;
+
+ OwnPassE.Text := String(FOwnerPassword);
+ UserPassE.Text := String(FUserPassword);
+ PrintCB.IsChecked := ePrint in FProtectionFlags;
+ CopyCB.IsChecked := eCopy in FProtectionFlags;
+ ModCB.IsChecked := eModify in FProtectionFlags;
+ AnnotCB.IsChecked := eAnnot in FProtectionFlags;
+
+ TitleE.Text := FTitle;
+ AuthorE.Text := FAuthor;
+ SubjectE.Text := FSubject;
+ KeywordsE.Text := FKeywords;
+ CreatorE.Text := FCreator;
+ ProducerE.Text := FProducer;
+
+ PrintScalingCB.IsChecked := FPrintScaling;
+ FitWindowCB.IsChecked := FFitWindow;
+ HideMenubarCB.IsChecked := FHideMenubar;
+ CenterWindowCB.IsChecked := FCenterWindow;
+ HideWindowUICB.IsChecked := FHideWindowUI;
+ HideToolbarCB.IsChecked := FHideToolbar;
+
+ Result := ShowModal;
+ PeekLastModalResult;
+ if Result = mrOk then
+ begin
+ FOwnerPassword := AnsiString(OwnPassE.Text);
+ FUserPassword := AnsiString(UserPassE.Text);
+ FProtectionFlags := [];
+ if PrintCB.IsChecked then
+ FProtectionFlags := FProtectionFlags + [ePrint];
+ if CopyCB.IsChecked then
+ FProtectionFlags := FProtectionFlags + [eCopy];
+ if ModCB.IsChecked then
+ FProtectionFlags := FProtectionFlags + [eModify];
+ if AnnotCB.IsChecked then
+ FProtectionFlags := FProtectionFlags + [eAnnot];
+ SetProtectionFlags(FProtectionFlags);
+ PageNumbers := '';
+ CurPage := False;
+ if CurPageRB.IsChecked then
+ CurPage := True
+ else if PageNumbersRB.IsChecked then
+ PageNumbers := PageNumbersE.Text;
+
+ FOpenAfterExport := OpenCB.IsChecked;
+ FCompressed := CompressedCB.IsChecked;
+ FEmbedded := EmbeddedCB.IsChecked;
+ FPrintOpt := PrintOptCB.IsChecked;
+ FOutline := OutlineCB.IsChecked;
+ FBackground := BackgrCB.IsChecked;
+ //FQuality := StrToInt(Quality.Text);
+
+ FTitle := TitleE.Text;
+ FAuthor := AuthorE.Text;
+ FSubject := SubjectE.Text;
+ FKeywords := KeywordsE.Text;
+ FCreator := CreatorE.Text;
+ FProducer := ProducerE.Text;
+
+ FPrintScaling := PrintScalingCB.IsChecked;
+ FFitWindow := FitWindowCB.IsChecked;
+ FHideMenubar := HideMenubarCB.IsChecked;
+ FCenterWindow := CenterWindowCB.IsChecked;
+ FHideWindowUI := HideWindowUICB.IsChecked;
+ FHideToolbar := HideToolbarCB.IsChecked;
+
+ if not SlaveExport then
+ begin
+ if DefaultPath <> '' then
+ SaveDialog1.InitialDir := DefaultPath;
+ if SaveDialog1.Execute then
+ FileName := SaveDialog1.FileName
+ else
+ Result := mrCancel;
+ PeekLastModalResult;
+ end;
+ end;
+ Free;
+ end;
+ end else
+ Result := mrOk;
+end;
+
+procedure TfrxPDFExport.Clear;
+var
+ i: Integer;
+begin
+ for i := 0 to FFonts.Count - 1 do
+ TfrxPDFFont(FFonts[i]).Free;
+
+ for i := 0 to FPages.Count - 1 do
+ TObject(FPages[i]).Free;
+
+ for i := 0 to FAnnots.Count - 1 do
+ TObject(FAnnots[i]).Free;
+
+ FPages.Clear;
+ FFonts.Clear;
+ FPageFonts.Clear;
+ FXRef.Clear;
+ FPageAnnots.Clear;
+ FAnnots.Clear;
+ FPagesRef.Clear;
+end;
+
+function TfrxPDFExport.GetID: AnsiString;
+var
+ AGUID: TGUID;
+ AGUIDString: widestring;
+begin
+ CreateGUID(AGUID);
+ SetLength(AGUIDString, 39);
+ AGUIDString := GUIDToString(AGUID);
+ //StringFromGUID2(AGUID, PWideChar(AGUIDString), 39);
+ Result := AnsiString(PWideChar(AGUIDString));
+ MD5String(AnsiString(PWideChar(AGUIDString)));
+end;
+
+function TfrxPDFExport.Start: Boolean;
+begin
+ if SlaveExport then
+ begin
+ if Report.FileName <> '' then
+ FileName := ChangeFileExt(GetTemporaryFolder + ExtractFileName(Report.FileName), frxGet(8708))
+ else
+ FileName := ChangeFileExt(GetTempFile, frxGet(8708))
+ end;
+
+ if (FileName <> '') or Assigned(Stream) then
+ begin
+ if (ExtractFilePath(FileName) = '') and (DefaultPath <> '') then
+ FileName := DefaultPath + PathDelim + FileName;
+ FProtection := (FOwnerPassword <> '') or (FUserPassword <> '');
+ if Assigned(Stream) then
+ pdf := Stream
+ else
+ pdf := TFileStream.Create(FileName, fmCreate);
+ Result := True;
+ // start here
+ Clear;
+ FFileID := MD5String(GetID);
+ if FProtection then
+ begin
+ PrepareKeys;
+ FEmbedded := FEmbedProt;
+ end;
+
+ if FOutline then
+ FPreviewOutline := Report.PreviewPages.Outline;
+
+ WriteLn(pdf, '%PDF-' + PDF_VER);
+ UpdateXRef;
+ end else
+ Result := False;
+end;
+
+procedure TfrxPDFExport.StartPage(Page: TfrxReportPage; Index: Integer);
+const
+ mm2p: Double = 1.0 / 25.4 * 72; // millimeters to points
+begin
+ SetLength(FUsedXObjects, 0);
+
+ AddPage(Page);
+ FWidth := Page.Width * PDF_DIVIDER;
+ FHeight := Page.Height * PDF_DIVIDER;
+ FMarginLeft := Page.LeftMargin * PDF_MARG_DIVIDER;
+ FMarginTop := Page.TopMargin * PDF_MARG_DIVIDER;
+ OutStream := TMemoryStream.Create;
+
+ with Page do
+ if Color <> claNull then
+ Write(OutStream, PdfFillRect(LeftMargin * mm2p,
+ BottomMargin * mm2p, FWidth - RightMargin * mm2p,
+ FHeight - TopMargin * mm2p, Color));
+end;
+
+procedure TfrxPDFExport.FinishPage(Page: TfrxReportPage; Index: Integer);
+var
+ FContentsPos, FPagePos: Integer;
+ s: String;
+ i: Integer;
+ TmpPageStream: TMemoryStream;
+ TmpPageStream2: TMemoryStream;
+begin
+// finish page
+ FContentsPos := UpdateXRef();
+ WriteLn(pdf, ObjNumber(FContentsPos));
+ Write(pdf, '<< ');
+ TmpPageStream := TMemoryStream.Create;
+ TmpPageStream2 := TMemoryStream.Create;
+ try
+ OutStream.Position := 0;
+ TmpPageStream2.CopyFrom(OutStream, OutStream.Size);
+ if FCompressed then
+ begin
+ frxDeflateStream(TmpPageStream2, TmpPageStream, gzFastest);
+ s := '/Filter /FlateDecode /Length ' + IntToStr(TmpPageStream.Size) +
+ ' /Length1 ' + IntToStr(TmpPageStream2.Size);
+ end
+ else
+ s := '/Length ' + IntToStr(TmpPageStream2.Size);
+ WriteLn(pdf, s + ' >>');
+ WriteLn(pdf, 'stream');
+
+ if FCompressed then
+ begin
+ if FProtection then
+ CryptStream(TmpPageStream, pdf, FEncKey, FContentsPos)
+ else
+ pdf.CopyFrom(TmpPageStream, 0);
+ WriteLn(pdf, '');
+ end else
+ if FProtection then
+ CryptStream(TmpPageStream2, pdf, FEncKey, FContentsPos)
+ else
+ pdf.CopyFrom(TmpPageStream2, 0);
+ finally
+ TmpPageStream2.Free;
+ TmpPageStream.Free;
+ end;
+ WriteLn(pdf, 'endstream');
+ WriteLn(pdf, 'endobj');
+
+ OutStream.Free;
+
+ if FPageFonts.Count > 0 then
+ for i := 0 to FPageFonts.Count - 1 do
+ if not TfrxPDFFont(FPageFonts[i]).Saved then
+ begin
+ TfrxPDFFont(FPageFonts[i]).Reference := UpdateXRef;
+ TfrxPDFFont(FPageFonts[i]).Saved := true;
+ end;
+
+ FPagePos := UpdateXRef();
+ FPagesRef.Add(IntToStr(FPagePos));
+ WriteLn(pdf, ObjNumber(FPagePos));
+ WriteLn(pdf, '<<');
+ WriteLn(pdf, '/Type /Page');
+ WriteLn(pdf, '/Parent 1 0 R');
+ WriteLn(pdf, '/MediaBox [0 0 ' + frFloat2Str(FWidth) +
+ ' ' + frFloat2Str(FHeight) + ' ]');
+
+ { Write the list of references
+ to anchor objects }
+
+ if FPageAnnots.Size > 0 then
+ begin
+ WriteLn(PDF, '/Annots [');
+ FPageAnnots.Seek(Int64(0), soFromBeginning);
+ PDF.CopyFrom(FPageAnnots, FPageAnnots.Size);
+ WriteLn(PDF, ']');
+ FPageAnnots.Clear;
+ end;
+
+ WriteLn(pdf, '/Resources <<');
+ Write(pdf, '/Font << ');
+ for i := 0 to FPageFonts.Count - 1 do
+{$IFDEF Delphi12}
+ Write(pdf, TfrxPDFFont(FPageFonts[i]).Name + AnsiString(' ' + ObjNumberRef(TfrxPDFFont(FPageFonts[i]).Reference) + ' '));
+{$ELSE}
+ Write(pdf, TfrxPDFFont(FPageFonts[i]).Name + ' ' + ObjNumberRef(TfrxPDFFont(FPageFonts[i]).Reference) + ' ');
+{$ENDIF}
+ WriteLn(pdf, '>>');
+ if Length(FUsedXObjects) > 0 then
+ begin
+ Write(pdf, '/XObject << ');
+
+ for i := 0 to High(FUsedXObjects) do
+ begin
+ Write(pdf, '/Im' + IntToStr(FUsedXObjects[i]) + ' ');
+ Write(pdf, ObjNumberRef(FXObjects[FUsedXObjects[i]].ObjId) + ' ');
+ end;
+
+ Writeln(pdf, '>>');
+ end;
+ WriteLn(pdf, '/ProcSet [/PDF /Text /ImageC ]');
+ WriteLn(pdf, '>>');
+ WriteLn(pdf, '/Contents ' + ObjNumberRef(FContentsPos));
+ WriteLn(pdf, '>>');
+ WriteLn(pdf, 'endobj');
+ { Clear piture cache }
+ Self.ClearXObject;
+end;
+
+procedure TfrxPDFExport.ExportObject(Obj: TfrxComponent);
+begin
+ if (Obj is TfrxView) and (ExportNotPrintable or TfrxView(Obj).Printable) then
+ AddObject(Obj as TfrxView);
+end;
+
+procedure TfrxPDFExport.Finish;
+var
+ i: Integer;
+ s: string;
+ FInfoNumber, FRootNumber: Longint;
+ OutlineTree: TfrxPDFOutlineNode;
+ pgN: TStringList;
+ FOutlineObjId: Integer;
+
+ function IsPageInRange(const PageN: Integer): Boolean;
+ begin
+ Result := (pgN.Count = 0) or (pgN.IndexOf(IntToStr(PageN + 1)) >= 0);
+ end;
+
+ { Converts TfrxCustomOutline to a tree of TfrxPDFOutlineNode nodes.
+ The last argument represents the number of already added objects
+ to FXRef. This value is needed to correctly assign object numbers
+ to TfrxPDFOutlineNode nodes. }
+
+ procedure PrepareOutline(Outline: TfrxCustomOutline; Node: TfrxPDFOutlineNode;
+ ObjNum: Integer);
+ var
+ i: Integer;
+ p: TfrxPDFOutlineNode;
+ Prev: TfrxPDFOutlineNode;
+ Text: string;
+ Page, Top: Integer;
+ begin
+ Prev := nil;
+ p := nil;
+
+ for i := 0 to Outline.Count - 1 do
+ begin
+ Outline.GetItem(i, Text, Page, Top);
+ if not IsPageInRange(Page) then
+ Continue;
+
+ p := TfrxPDFOutlineNode.Create;
+ p.Title := Text;
+ p.Dest := Page;
+ p.Top := Top;
+ p.Prev := Prev;
+
+ Inc(ObjNum);
+ p.Number := ObjNum;
+
+ if Prev <> nil then
+ Prev.Next := p
+ else
+ Node.First := p;
+
+ Prev := p;
+ p.Parent := Node;
+ Outline.LevelDown(i);
+
+ PrepareOutline(Outline, p, ObjNum);
+ Inc(ObjNum, p.CountTree);
+
+ Node.Count := Node.Count + 1;
+ Node.CountTree := Node.CountTree + p.CountTree + 1;
+ Outline.LevelUp;
+ end;
+
+ Node.Last := p;
+ end;
+
+ procedure WriteOutline(Node: TfrxPDFOutlineNode);
+ var
+ Page, y: Integer;
+ Dest: string;
+ begin
+ { Actually, the following line of code does nothing:
+ UpdateXRef returns a number that was predicted
+ by PrepareOutline. }
+
+ Node.Number := UpdateXRef;
+
+ WriteLn(pdf, IntToStr(Node.Number) + ' 0 obj');
+ WriteLn(pdf, '<<');
+ WriteLn(pdf, '/Title ' + PrepareString(Node.Title, FEncKey, FProtection, Node.Number));
+ WriteLn(pdf, '/Parent ' + IntToStr(Node.Parent.Number) + ' 0 R');
+
+ if Node.Prev <> nil then
+ WriteLn(pdf, '/Prev ' + IntToStr(Node.Prev.Number) + ' 0 R');
+
+ if Node.Next <> nil then
+ WriteLn(pdf, '/Next ' + IntToStr(Node.Next.Number) + ' 0 R');
+
+ if Node.First <> nil then
+ begin
+ WriteLn(pdf, '/First ' + IntToStr(Node.First.Number) + ' 0 R');
+ WriteLn(pdf, '/Last ' + IntToStr(Node.Last.Number) + ' 0 R');
+ WriteLn(pdf, '/Count ' + IntToStr(Node.Count));
+ end;
+
+ if IsPageInRange(Node.Dest) then
+ begin
+ if pgN.Count > 0 then
+ Page := pgN.IndexOf(IntToStr(Node.Dest + 1))
+ else
+ Page := Node.Dest;
+
+ y := Round(TfrxPDFPage(FPages[Page]).Height - Node.Top * PDF_DIVIDER);
+ Dest := FPagesRef[Page];
+ WriteLn(pdf, '/Dest [' + Dest + ' 0 R /XYZ 0 ' + IntToStr(y) + ' 0]');
+ end;
+
+ WriteLn(pdf, '>>');
+ WriteLn(pdf, 'endobj');
+
+ if Node.First <> nil then
+ WriteOutline(Node.First);
+
+ if Node.Next <> nil then
+ WriteOutline(Node.Next);
+ end;
+
+ procedure WriteAnnots;
+ var
+ i: Integer;
+ annot: TfrxPDFAnnot;
+ begin
+ for i := 0 to FAnnots.Count - 1 do
+ begin
+ annot := TfrxPDFAnnot(FAnnots[i]);
+ // fix xref position
+ FXref[annot.Number - 1] := PrepXrefPos(pdf.Position);
+
+ Writeln(pdf, ObjNumber(annot.Number));
+ Writeln(pdf, '<<');
+ Writeln(pdf, '/Type /Annot');
+ Writeln(pdf, '/Subtype /Link');
+ Writeln(pdf, '/Rect [' + annot.Rect + ']');
+
+ if annot.Hyperlink <> '' then
+ begin
+ Writeln(pdf, '/BS << /W 0 >>');
+ Writeln(pdf, '/A <<');
+ Writeln(pdf, '/URI ' + annot.Hyperlink);
+ Writeln(pdf, '/Type /Action');
+ Writeln(pdf, '/S /URI');
+ Writeln(pdf, '>>');
+ end
+ else
+ begin
+ Writeln(pdf, '/Border [16 16 0]');
+ Writeln(pdf, '/Dest [' + FPagesRef[annot.DestPage] +
+ ' 0 R /XYZ null ' + IntToStr(annot.DestY) + ' null]');
+ end;
+
+ Writeln(pdf, '>>');
+ Writeln(pdf, 'endobj');
+ end;
+ end;
+
+begin
+ for i := 0 to FFonts.Count - 1 do
+ WriteFont(TfrxPDFFont(FFonts[i]));
+
+ FPagesNumber := 1;
+ FXRef[0] := PrepXrefPos(pdf.Position);
+ WriteLn(pdf, ObjNumber(FPagesNumber));
+ WriteLn(pdf, '<<');
+ WriteLn(pdf, '/Type /Pages');
+ Write(pdf, '/Kids [');
+ for i := 0 to FPagesRef.Count - 1 do
+ Write(pdf, FPagesRef[i] + ' 0 R ');
+ WriteLn(pdf, ']');
+ WriteLn(pdf, '/Count ' + IntTOStr(FPagesRef.Count));
+ WriteLn(pdf, '>>');
+ WriteLn(pdf, 'endobj');
+ FInfoNumber := UpdateXRef();
+ WriteLn(pdf, ObjNumber(FInfoNumber));
+ WriteLn(pdf, '<<');
+ WriteLn(pdf, '/Title ' + PrepareString(FTitle, FEncKey, FProtection, FInfoNumber));
+ WriteLn(pdf, '/Author ' + PrepareString(FAuthor, FEncKey, FProtection, FInfoNumber));
+ WriteLn(pdf, '/Subject ' + PrepareString(FSubject, FEncKey, FProtection, FInfoNumber));
+ WriteLn(pdf, '/Keywords ' + PrepareString(FKeywords, FEncKey, FProtection, FInfoNumber));
+ WriteLn(pdf, '/Creator ' + PrepareString(FCreator, FEncKey, FProtection, FInfoNumber));
+ WriteLn(pdf, '/Producer ' + PrepareString(FProducer, FEncKey, FProtection, FInfoNumber));
+ s := 'D:' + FormatDateTime('yyyy', Now) + FormatDateTime('mm', Now) +
+ FormatDateTime('dd', Now) + FormatDateTime('hh', Now) +
+ FormatDateTime('nn', Now) + FormatDateTime('ss', Now);
+ if FProtection then
+ begin
+ WriteLn(pdf, '/CreationDate ' + PrepareString(s, FEncKey, FProtection, FInfoNumber));
+ WriteLn(pdf, '/ModDate ' + PrepareString(s, FEncKey, FProtection, FInfoNumber));
+ end
+ else
+ begin
+ WriteLn(pdf, '/CreationDate (' + s + ')');
+ WriteLn(pdf, '/ModDate (' + s + ')');
+ end;
+ WriteLn(pdf, '>>');
+ WriteLn(pdf, 'endobj');
+
+ { Write the document outline }
+
+ OutlineTree := TfrxPDFOutlineNode.Create;
+ pgN := TStringList.Create;
+ FOutlineObjId := 0;
+
+ if FOutline then
+ begin
+ frxParsePageNumbers(PageNumbers, pgN, Report.PreviewPages.Count);
+ FPreviewOutline.LevelRoot;
+
+ { PrepareOutline needs to know the exact number of objects
+ that will be written before the first outline node object.
+ The number of already written objects is FXRef.Count, and
+ one object (/Type /Outlines) will be written before the first
+ outline node. That's why PrepareOutline is given FXRef.Count + 1. }
+
+ PrepareOutline(FPreviewOutline, OutlineTree, FXRef.Count + 1);
+ end;
+
+ if OutlineTree.CountTree > 0 then
+ begin
+ FOutlineObjId := UpdateXRef;
+ OutlineTree.Number := FOutlineObjId;
+
+ { It's important to write the /Outlines object first,
+ because object numbers for outline nodes was calculated
+ in assumption that /Outlines will be written first. }
+
+ WriteLn(pdf, IntToStr(FOutlineObjId) + ' 0 obj');
+ WriteLn(pdf, '<<');
+ WriteLn(pdf, '/Type /Outlines');
+ WriteLn(pdf, '/Count ' + IntToStr(OutlineTree.Count));
+ WriteLn(pdf, '/First ' + IntToStr(OutlineTree.First.Number) + ' 0 R');
+ WriteLn(pdf, '/Last ' + IntToStr(OutlineTree.Last.Number) + ' 0 R');
+ WriteLn(pdf, '>>');
+ WriteLn(pdf, 'endobj');
+
+ { Write outline nodes }
+
+ WriteOutline(OutlineTree.First);
+ end;
+
+ OutlineTree.Free;
+ pgN.Free;
+
+ { Write annots }
+ if FAnnots.Count > 0 then
+ WriteAnnots;
+
+ { Write the catalog }
+
+ FRootNumber := UpdateXRef;
+ WriteLn(pdf, ObjNumber(FRootNumber));
+ WriteLn(pdf, '<<');
+ WriteLn(pdf, '/Type /Catalog');
+ WriteLn(pdf, '/Pages ' + IntToStr(FPagesNumber) + ' 0 R');
+
+ if FOutline then
+ s := '/UseOutlines'
+ else
+ s := '/UseNone';
+
+ WriteLn(pdf, '/PageMode ' + s);
+
+ if FOutline then
+ WriteLn(pdf, '/Outlines ' + IntToStr(FOutlineObjId) + ' 0 R');
+
+ WriteLn(pdf, '/ViewerPreferences <<');
+
+ if FTitle <> '' then
+ WriteLn(pdf, '/DisplayDocTitle true');
+ if FHideToolbar then
+ WriteLn(pdf, '/HideToolbar true');
+ if FHideMenubar then
+ WriteLn(pdf, '/HideMenubar true');
+ if FHideWindowUI then
+ WriteLn(pdf, '/HideWindowUI true');
+ if FFitWindow then
+ WriteLn(pdf, '/FitWindow true');
+ if FCenterWindow then
+ WriteLn(pdf, '/CenterWindow true');
+ if not FPrintScaling then
+ WriteLn(pdf, '/PrintScaling /None');
+
+ WriteLn(pdf, '>>');
+
+ WriteLn(pdf, '>>');
+ WriteLn(pdf, 'endobj');
+
+ FStartXRef := pdf.Position;
+ WriteLn(pdf, 'xref');
+ WriteLn(pdf, '0 ' + IntToStr(FXRef.Count + 1));
+ WriteLn(pdf, '0000000000 65535 f');
+ for i := 0 to FXRef.Count - 1 do
+ WriteLn(pdf, FXRef[i] + ' 00000 n');
+ WriteLn(pdf, 'trailer');
+ WriteLn(pdf, '<<');
+ WriteLn(pdf, '/Size ' + IntToStr(FXRef.Count + 1));
+ WriteLn(pdf, '/Root ' + ObjNumberRef(FRootNumber));
+ WriteLn(pdf, '/Info ' + ObjNumberRef(FInfoNumber));
+ WriteLn(pdf, '/ID [<' + FFileID + '><' + FFileID + '>]');
+ if FProtection then
+ begin
+ WriteLn(pdf, '/Encrypt <<');
+ WriteLn(pdf, '/Filter /Standard' );
+ WriteLn(pdf, '/V 2');
+ WriteLn(pdf, '/R 3');
+ WriteLn(pdf, '/Length 128');
+ WriteLn(pdf, '/P ' + IntToStr(Integer(FEncBits)));
+ WriteLn(pdf, '/O (' + EscapeSpecialChar(FOPass) + ')');
+ WriteLn(pdf, '/U (' + EscapeSpecialChar(FUPass) + ')');
+ WriteLn(pdf, '>>');
+ end;
+ WriteLn(pdf, '>>');
+ WriteLn(pdf, 'startxref');
+ WriteLn(pdf, IntToStr(FStartXRef));
+ WriteLn(pdf, '%%EOF');
+ Clear;
+ if not Assigned(Stream) then
+ pdf.Free;
+ if FOpenAfterExport and (not Assigned(Stream)) then
+{$IFDEF MSWINDOWS}
+ ShellExecute(0, 'open', PChar(FileName), '', '', 5);
+
+{$ENDIF}
+{$IFDEF LINUX}
+ FmuxOpenFile(PChar(FileName));
+{$ENDIF}
+{$IFDEF MACOS}
+ ShellExecute(FileName);
+ // _system(PAnsiChar('open ' + PChar(FileName)));
+{$ENDIF}
+end;
+
+procedure TfrxPDFExport.Write(Stream: TStream; const S: AnsiString);
+begin
+ Stream.Write(S[1], Length(S));
+end;
+
+procedure TfrxPDFExport.WriteLn(Stream: TStream; const S: AnsiString);
+begin
+ Stream.Write(S[1], Length(S));
+{$IFDEF Delphi12}
+ Stream.Write(AnsiChar(#13)+AnsiChar(#10), 2);
+{$ELSE}
+ Stream.Write(#13#10, 2);
+{$ENDIF}
+end;
+
+{$IFDEF Delphi12}
+procedure TfrxPDFExport.WriteLn(Stream: TStream; const S: String);
+begin
+ WriteLn(Stream, AnsiString(s));
+end;
+
+procedure TfrxPDFExport.Write(Stream: TStream; const S: String);
+begin
+ Write(Stream, AnsiString(S));
+end;
+{$ENDIF}
+
+function TfrxPDFExport.EscapeSpecialChar(TextStr: AnsiString): AnsiString;
+var
+ I: Integer;
+begin
+ Result := '';
+ for I := 1 to Length ( TextStr ) do
+ case TextStr [ I ] of
+ '(': Result := Result + '\(';
+ ')': Result := Result + '\)';
+ '\': Result := Result + '\\';
+ #13: Result := result + '\r';
+ #10: Result := result + '\n';
+ else
+ Result := Result + AnsiChar(chr ( Ord ( textstr [ i ] ) ));
+ end;
+end;
+
+function TfrxPDFExport.CryptStr(Source: AnsiString; Key: AnsiString; Enc: Boolean; id: Integer): AnsiString;
+var
+ k: array [ 1..21 ] of Byte;
+ rc4: TfrxRC4;
+ s, s1, ss: AnsiString;
+begin
+ if Enc then
+ begin
+ rc4 := TfrxRC4.Create;
+ try
+ s := Key;
+ FillChar(k, 21, 0);
+ Move(s[1], k, 16);
+ Move(id, k [17], 3);
+ SetLength(s1, 21);
+ MD5Buf(@k, 21, @s1[1]);
+ ss := Source;
+ SetLength(Result, Length(ss));
+ rc4.Start(@s1[1], 16);
+ rc4.Crypt(@ss[1], @Result[1], Length(ss));
+ Result := EscapeSpecialChar(Result);
+ finally
+ rc4.Free;
+ end;
+ end
+ else
+ Result := EscapeSpecialChar(Source);
+end;
+
+function TfrxPDFExport.CryptStream(Source: TStream; Target: TStream; Key: AnsiString; id: Integer): AnsiString;
+var
+ s: AnsiString;
+ k: array [ 1..21 ] of Byte;
+ rc4: TfrxRC4;
+ m1, m2: TMemoryStream;
+begin
+ FillChar(k, 21, 0);
+ Move(Key[1], k, 16);
+ Move(id, k[17], 3);
+ SetLength(s, 16);
+ MD5Buf(@k, 21, @s[1]);
+ m1 := TMemoryStream.Create;
+ m2 := TMemoryStream.Create;
+ rc4 := TfrxRC4.Create;
+ try
+ m1.LoadFromStream(Source);
+ m2.SetSize(m1.Size);
+ rc4.Start(@s[1], 16);
+ rc4.Crypt(m1.Memory, m2.Memory, m1.Size);
+ m2.SaveToStream(Target);
+ finally
+ m1.Free;
+ m2.Free;
+ rc4.Free;
+ end;
+end;
+
+function TfrxPDFExport.StrToUTF16H(const Value: WideString): AnsiString;
+var
+ i: integer;
+ pwc: ^Word;
+begin
+ result := 'FEFF';
+ for i := 1 to Length(Value) do
+ begin
+ pwc := @Value[i];
+ result := result + AnsiString(IntToHex(pwc^, 4));
+ end;
+end;
+
+function TfrxPDFExport.StrToUTF16(const Value: WideString): AnsiString;
+var
+ i: integer;
+ pwc: ^Word;
+begin
+ result := #$FE + #$FF;
+ for i := 1 to Length(Value) do
+ begin
+ pwc := @Value[i];
+ result := result + AnsiChar(pwc^ shr 8) + AnsiChar(pwc^ and $FF) ;
+ end;
+end;
+
+function TfrxPDFExport.PrepareString(const Text: WideString; Key: AnsiString; Enc: Boolean; id: Integer): AnsiString;
+begin
+ if Enc then
+ Result := '(' + CryptStr(StrToUTF16(Text), Key, Enc, id) + ')'
+ else
+ Result := '<' + StrToUTF16H(Text) + '>'
+end;
+
+function TfrxPDFExport.PMD52Str(p: Pointer): AnsiString;
+begin
+ SetLength(Result, 16);
+ Move(p^, Result[1], 16);
+end;
+
+function TfrxPDFExport.PadPassword(Password: AnsiString): AnsiString;
+var
+ i: Integer;
+begin
+ i := Length(Password);
+ Result := Copy(Password, 1, i);
+ SetLength(Result, 32);
+ if i < 32 then
+ Move(PDF_PK, Result[i + 1], 32 - i);
+end;
+
+procedure TfrxPDFExport.PrepareKeys;
+var
+ s, s1, p, p1, fid: AnsiString;
+ i, j: Integer;
+ rc4: TfrxRC4;
+ md5: TfrxMD5;
+begin
+// OWNER KEY
+ if FOwnerPassword = '' then
+ FOwnerPassword := FUserPassword;
+ p := PadPassword(FOwnerPassword);
+ md5 := TfrxMD5.Create;
+ try
+ md5.Init;
+ md5.Update(@p[1], 32);
+ md5.Finalize;
+ s := PMD52Str(md5.Digest);
+ for i := 1 to 50 do
+ begin
+ md5.Init;
+ md5.Update(@s[1], 16);
+ md5.Finalize;
+ s := PMD52Str(md5.Digest);
+ end;
+ finally
+ md5.Free;
+ end;
+
+ rc4 := TfrxRC4.Create;
+ try
+ p := PadPassword(FUserPassword);
+ SetLength(s1, 32);
+ rc4.Start(@s[1], 16);
+ rc4.Crypt(@p[1], @s1[1], 32);
+ SetLength(p1, 16);
+ for i := 1 to 19 do
+ begin
+ for j := 1 to 16 do
+ p1[j] := AnsiChar(Byte(s[j]) xor i);
+ rc4.Start(@p1[1], 16);
+ rc4.Crypt(@s1[1], @s1[1], 32);
+ end;
+ FOPass := s1;
+ finally
+ rc4.Free;
+ end;
+
+// ENCRYPTION KEY
+ p := PadPassword(FUserPassword);
+ md5 := TfrxMD5.Create;
+ try
+ md5.Init;
+ md5.Update(@p[1], 32);
+ md5.Update(@FOPass[1], 32);
+ md5.Update(@FEncBits, 4);
+ fid := '';
+ for i := 1 to 16 do
+ fid := fid + AnsiChar(chr(Byte(StrToInt('$' + String(FFileID[i * 2 - 1] + FFileID[i * 2])))));
+ md5.Update(@fid[1], 16);
+ md5.Finalize;
+ s := PMD52Str(md5.Digest);
+ for i := 1 to 50 do
+ begin
+ md5.Init;
+ md5.Update(@s[1], 16);
+ md5.Finalize;
+ s := PMD52Str(md5.Digest);
+ end;
+ finally
+ md5.Free;
+ end;
+ FEncKey := s;
+
+// USER KEY
+ md5 := TfrxMD5.Create;
+ try
+ md5.Update(@PDF_PK, 32);
+ md5.Update(@fid[1], 16);
+ md5.Finalize;
+ s := PMD52Str(md5.Digest);
+ s1 := FEncKey;
+ rc4 := TfrxRC4.Create;
+ try
+ rc4.Start(@s1[1], 16 );
+ rc4.Crypt(@s[1], @s[1], 16 );
+ SetLength(p1, 16);
+ for i := 1 to 19 do
+ begin
+ for j := 1 to 16 do
+ p1[j] := AnsiChar(Byte(s1[j]) xor i);
+ rc4.Start(@p1[1], 16 );
+ rc4.Crypt(@s[1], @s[1], 16 );
+ end;
+ FUPass := s;
+ finally
+ rc4.Free;
+ end;
+ SetLength(FUPass, 32);
+ FillChar(FUPass[17], 16, 0);
+ finally
+ md5.Free;
+ end;
+end;
+
+procedure TfrxPDFExport.SetProtectionFlags(const Value: TfrxPDFEncBits);
+begin
+ FProtectionFlags := Value;
+ FEncBits := $FFFFFFC0;
+ FEncBits := FEncBits + (Cardinal(ePrint in Value) shl 2 +
+ Cardinal(eModify in Value) shl 3 +
+ Cardinal(eCopy in Value) shl 4 +
+ Cardinal(eAnnot in Value) shl 5);
+end;
+
+procedure TfrxPDFExport.WriteFont(pdfFont: TfrxPDFFont);
+var
+ fontFileId, descriptorId, toUnicodeId, cIDSystemInfoId, descendantFontId: Longint;
+ fontName: String;
+ i: Integer;
+ memstream, fontstream, tounicode: TMemoryStream;
+begin
+ fontFileId := 0;
+ //fontstream := nil;
+{$IFDEF Delphi12}
+ fontName := String(pdfFont.GetFontName);
+{$ELSE}
+ fontName := pdfFont.GetFontName;
+{$ENDIF}
+ // embedded font
+ if FEmbedded then
+ begin
+ fontFileId := UpdateXRef;
+ WriteLn(pdf, ObjNumber(fontFileId));
+ pdfFont.PackFontFile;
+ if FCompressed then
+ begin
+ memstream := TMemoryStream.Create;
+ fontstream := TMemoryStream.Create;
+ try
+ //fontstream.Write(pdfFont.FontData.Memory, pdfFont.FontDataSize);
+ fontstream.CopyFrom(pdfFont.FontData, pdfFont.FontData.Size);
+ frxDeflateStream(fontstream, memstream, gzFastest);
+ WriteLn(pdf, '<< /Length ' + IntToStr(memstream.Size) + ' /Filter /FlateDecode /Length1 ' + IntToStr(fontstream.Size) + ' >>');
+ WriteLn(pdf, 'stream');
+ if FProtection then
+ CryptStream(memstream, pdf, FEncKey, fontFileId)
+ else
+ pdf.CopyFrom(memstream, 0);
+ finally
+ memstream.Free;
+ fontstream.Free;
+ end;
+ end
+ else
+ begin
+ WriteLn(pdf, '<< /Length ' + IntToStr(pdfFont.FontDataSize) + ' /Length1 ' + IntToStr(pdfFont.FontDataSize) + ' >>');
+ WriteLn(pdf, 'stream');
+
+ fontstream := TMemoryStream.Create;
+ try
+ fontstream.CopyFrom(pdfFont.FontData, pdfFont.FontData.Size);
+ if FProtection then
+ CryptStream(fontstream, pdf, FEncKey, fontFileId)
+ else
+ pdf.CopyFrom(fontstream, 0);
+ finally
+ fontstream.Free;
+ end;
+ end;
+ WriteLn(pdf, '');
+ WriteLn(pdf, 'endstream');
+ WriteLn(pdf, 'endobj');
+ end;
+ // descriptor
+ descriptorId := UpdateXRef;
+ WriteLn(pdf, ObjNumber(descriptorId));
+ WriteLn(pdf, '<<');
+ WriteLn(pdf, '/Type /FontDescriptor');
+ WriteLn(pdf, '/FontName /' + fontName);
+ WriteLn(pdf, '/FontFamily /' + fontName);
+ WriteLn(pdf, '/Flags 32');
+ WriteLn(pdf, '/FontBBox [' + IntToStr(pdfFont.TextMetric.otmrcFontBox.left) + ' ' +
+ IntToStr(pdfFont.TextMetric.otmrcFontBox.bottom) + ' ' +
+ IntToStr(pdfFont.TextMetric.otmrcFontBox.right) + ' ' +
+ IntToStr(pdfFont.TextMetric.otmrcFontBox.top) + ' ]');
+ WriteLn(pdf, '/ItalicAngle ' + IntToStr(pdfFont.TextMetric.otmItalicAngle));
+ WriteLn(pdf, '/Ascent ' + IntToStr(pdfFont.TextMetric.otmAscent));
+ WriteLn(pdf, '/Descent ' + IntToStr(pdfFont.TextMetric.otmDescent));
+ WriteLn(pdf, '/Leading ' + IntToStr(pdfFont.TextMetric.otmTextMetrics.tmInternalLeading));
+ WriteLn(pdf, '/CapHeight ' + IntToStr(pdfFont.TextMetric.otmTextMetrics.tmHeight));
+ WriteLn(pdf, '/StemV ' + IntToStr(50 + Round(sqr(pdfFont.TextMetric.otmTextMetrics.tmWeight / 65))));
+ WriteLn(pdf, '/AvgWidth ' + IntToStr(pdfFont.TextMetric.otmTextMetrics.tmAveCharWidth));
+ WriteLn(pdf, '/MxWidth ' + IntToStr(pdfFont.TextMetric.otmTextMetrics.tmMaxCharWidth));
+ WriteLn(pdf, '/MissingWidth ' + IntToStr(pdfFont.TextMetric.otmTextMetrics.tmAveCharWidth));
+ if FEmbedded then
+ WriteLn(pdf, '/FontFile2 ' + ObjNumberRef(fontFileId));
+ WriteLn(pdf, '>>');
+ WriteLn(pdf, 'endobj');
+ // ToUnicode
+ toUnicodeId := UpdateXRef();
+ WriteLn(pdf, ObjNumber(toUnicodeId));
+ tounicode := TMemoryStream.Create;
+ try
+ WriteLn(tounicode, '/CIDInit /ProcSet findresource begin');
+ WriteLn(tounicode, '12 dict begin');
+ WriteLn(tounicode, 'begincmap');
+ WriteLn(tounicode, '/CIDSystemInfo');
+ WriteLn(tounicode, '<< /Registry (Adobe)');
+ WriteLn(tounicode, '/Ordering (UCS)');
+ WriteLn(tounicode, '/Ordering (Identity)');
+ WriteLn(tounicode, '/Supplement 0');
+ WriteLn(tounicode, '>> def');
+ Write(tounicode, '/CMapName /');
+{$IFDEF Delphi12}
+ Write(tounicode, StringReplace(pdfFont.GetFontName, AnsiString(','), AnsiString('+'), [rfReplaceAll]));
+{$ELSE}
+ Write(tounicode, StringReplace(pdfFont.GetFontName, ',', '+', [rfReplaceAll]));
+{$ENDIF}
+ WriteLn(tounicode, ' def');
+ WriteLn(tounicode, '/CMapType 2 def');
+ WriteLn(tounicode, '1 begincodespacerange');
+ WriteLn(tounicode, '<0000> ');
+ WriteLn(tounicode, 'endcodespacerange');
+ Write(tounicode, IntToStr(pdfFont.UsedAlphabet.Count));
+ WriteLn(tounicode, ' beginbfchar');
+ for i := 0 to pdfFont.UsedAlphabet.Count - 1 do
+ begin
+ Write(tounicode, '<');
+ Write(tounicode, IntToHex(Word(pdfFont.UsedAlphabet[i]), 4));
+ Write(tounicode, '> <');
+ Write(tounicode, IntToHex(Word(pdfFont.UsedAlphabetUnicode[i]), 4));
+ WriteLn(tounicode, '>');
+ end;
+ WriteLn(tounicode, 'endbfchar');
+ WriteLn(tounicode, 'endcmap');
+ WriteLn(tounicode, 'CMapName currentdict /CMap defineresource pop');
+ WriteLn(tounicode, 'end');
+ WriteLn(tounicode, 'end');
+ tounicode.Position := 0;
+ if FCompressed then
+ begin
+ memstream := TMemoryStream.Create;
+ try
+ frxDeflateStream(tounicode, memstream, gzFastest);
+ WriteLn(pdf, '<< /Length ' + IntToStr(memstream.Size) + ' /Filter /FlateDecode /Length1 ' + IntToStr(tounicode.Size) + ' >>');
+ WriteLn(pdf, 'stream');
+ if FProtection then
+ CryptStream(memstream, pdf, FEncKey, toUnicodeId)
+ else
+ pdf.CopyFrom(memstream, 0);
+ finally
+ memstream.Free;
+ end;
+ end
+ else
+ begin
+ WriteLn(pdf, '<< /Length ' + IntToStr(tounicode.Size) + ' /Length1 ' + IntToStr(tounicode.Size) + ' >>');
+ WriteLn(pdf, 'stream');
+ if FProtection then
+ CryptStream(tounicode, pdf, FEncKey, toUnicodeId)
+ else
+ pdf.CopyFrom(tounicode, 0);
+ end;
+ WriteLn(pdf, 'endstream');
+ WriteLn(pdf, 'endobj');
+ finally
+ tounicode.Free;
+ end;
+ //CIDSystemInfo
+ cIDSystemInfoId := UpdateXRef;
+ WriteLn(pdf, ObjNumber(cIDSystemInfoId));
+ WriteLn(pdf, '<<');
+ WriteLn(pdf, '/Registry (Adobe) /Ordering (Identity) /Supplement 0');
+ WriteLn(pdf, '>>');
+ WriteLn(pdf, 'endobj');
+ //DescendantFonts
+ descendantFontId := UpdateXRef;
+ WriteLn(pdf, ObjNumber(descendantFontId));
+ WriteLn(pdf, '<<');
+ WriteLn(pdf, '/Type /Font');
+ WriteLn(pdf, '/Subtype /CIDFontType2');
+ WriteLn(pdf, '/BaseFont /' + fontName);
+ WriteLn(pdf, '/CIDSystemInfo ' + ObjNumberRef(cIDSystemInfoId));
+ WriteLn(pdf, '/FontDescriptor ' + ObjNumberRef(descriptorId));
+ Write(pdf, '/W [ ');
+ for i := 0 to pdfFont.UsedAlphabet.Count - 1 do
+ Write(pdf, IntToStr(Word(pdfFont.UsedAlphabet[i])) + ' [' + IntToStr(Integer(pdfFont.Widths [i])) + '] ');
+ WriteLn(pdf, ']');
+ WriteLn(pdf, '>>');
+ WriteLn(pdf, 'endobj');
+ // main
+ FXRef[pdfFont.Reference - 1] := PrepXrefPos(pdf.Position);
+ WriteLn(pdf, ObjNumber(pdfFont.Reference));
+ WriteLn(pdf, '<<');
+ WriteLn(pdf, '/Type /Font');
+ WriteLn(pdf, '/Subtype /Type0');
+ WriteLn(pdf, '/BaseFont /' + fontName);
+ WriteLn(pdf, '/Encoding /Identity-H');
+ WriteLn(pdf, '/DescendantFonts [' + ObjNumberRef(descendantFontId) + ']');
+ WriteLn(pdf, '/ToUnicode ' + ObjNumberRef(toUnicodeId));
+ WriteLn(pdf, '>>');
+ WriteLn(pdf, 'endobj');
+end;
+
+function TfrxPDFExport.AddPage(Page: TfrxReportPage): TfrxPDFPage;
+var
+ p: TfrxPDFPage;
+begin
+ p := TfrxPDFPage.Create;
+ p.Height := Page.Height * PDF_DIVIDER;
+ FPages.Add(p);
+ Result := p;
+end;
+
+function TfrxPDFExport.StrToHex(const Value: WideString): AnsiString;
+var
+ i: integer;
+begin
+ result := '';
+ for i := 1 to Length(Value) do
+ result := result + AnsiString(IntToHex(Word(Value[i]), 4));
+end;
+
+function TfrxPDFExport.StrToHexSp(const SourceStr, Value: WideString; SpaceAdjustment: Extended): AnsiString;
+var
+ i: integer;
+ w: Integer;
+ z: Extended;
+begin
+ result := '';
+ z := 0;
+ for i := 1 to Length(Value) do
+ begin
+ result := result + AnsiString(IntToHex(Word(Value[i]), 4));
+ if SourceStr[i] = ' ' then
+ begin
+ w := Trunc(SpaceAdjustment);
+ z := z + Frac(SpaceAdjustment);
+ if z > 1 then
+ begin
+ Inc(w);
+ z := Frac(z);
+ end;
+ if w <> 0 then
+ result := result + AnsiString('>' + IntToStr(w) + '<');
+ end;
+ end;
+end;
+
+function TfrxPDFExport.ObjNumber(FNumber: longint): String;
+begin
+ result := IntToStr(FNumber) + ' 0 obj';
+end;
+
+function TfrxPDFExport.ObjNumberRef(FNumber: longint): String;
+begin
+ result := IntToStr(FNumber) + ' 0 R';
+end;
+
+function TfrxPDFExport.PrepXrefPos(pos: Longint): String;
+begin
+ result := StringOfChar('0', 10 - Length(IntToStr(pos))) + IntToStr(pos)
+end;
+
+function TfrxPDFExport.UpdateXRef: longint;
+begin
+ FXRef.Add(PrepXrefPos(pdf.Position));
+ result := FXRef.Count;
+end;
+
+function TfrxPDFExport.GetPDFColor(const Color: TAlphaColor): String;
+begin
+ if Color = claBlack then
+ Result := '0 0 0'
+ else if Color = claWhite then
+ Result := '1 1 1'
+ else if Color = FLastColor then
+ Result := FLastColorResult
+ else begin
+ Result:= frFloat2Str(Byte(Color shr 16) / 255) + ' ' +
+ frFloat2Str(Byte(Color shr 8) / 255) + ' ' +
+ frFloat2Str(Byte(Color) / 255);
+ FLastColor := Color;
+ FLastColorResult := Result;
+ end;
+end;
+
+procedure TfrxPDFExport.GetStreamHash(out Hash: TfrxPDFXObjectHash; S: TStream);
+var
+ H: TCryptoHash;
+begin
+ H := TCryptoMD5.Create;
+
+ try
+ H.Push(S);
+ H.GetDigest(Hash[0], SizeOf(Hash));
+ finally
+ H.Free
+ end;
+end;
+
+
+function TfrxPDFExport.FindXObject(const Hash: TfrxPDFXObjectHash): Integer;
+begin
+ for Result := 0 to High(FXObjects) do
+ if CompareMem(@Hash, @FXObjects[Result].Hash, SizeOf(Hash)) then
+ Exit;
+
+ Result := -1;
+end;
+
+function TfrxPDFExport.AddXObject(Id: Integer; const Hash: TfrxPDFXObjectHash): Integer;
+var
+ X: TfrxPDFXObject;
+begin
+ X.ObjId := Id;
+ Move(Hash, X.Hash, SizeOf(Hash));
+ SetLength(FXObjects, Length(FXObjects) + 1);
+ FXObjects[High(FXObjects)] := X;
+ Result := High(FXObjects);
+end;
+
+procedure TfrxPDFExport.ClearXObject;
+var
+ i: Integer;
+begin
+ for i := 0 to High(FXObjects) do
+ begin
+ FXObjects[i].ObjId := 0;
+ FillChar( FXObjects[i].Hash, Sizeof(TfrxPDFXObjectHash), 0 );
+ end;
+end;
+
+procedure TfrxPDFExport.AddObject(const Obj: TfrxView);
+var
+ FontIndex: Integer;
+ x, y, dx, dy, fdx, fdy, PGap, FCharSpacing, ow, oh: Extended;
+ i, iz: Integer;
+ //Jpg: TJPEGImage;
+ s: AnsiString;
+ Lines: TWideStrings;
+ TempBitmap: TBitmap;
+{$IFDEF DELPHI17}
+ bData: TBitmapData;
+{$ENDIF}
+ OldFrameWidth: Extended;
+ TempColor: TAlphaColor;
+ Left, Right, Top, Bottom, Width, Height: String;
+ FUnderlinePosition: Double;
+ FStrikeoutPosition: Double;
+ FRealBounds: TfrxRect;
+ FLineHeight: Single;
+ FLineWidth: Single;
+ FHeightWoMargin: Extended;
+ pdfFont: TfrxPDFFont;
+ textObj: TfrxCustomMemoView;
+ AFont: TFont;
+ bx, by, bx1, by1, wx1, wx2, wy1, wy2, gx1, gy1: Integer;
+ FTextRect: TRectF;
+ angle, a_sin, a_cos, a_x, a_y: Extended;
+ rx, ry: Extended;
+ simulateBold, simulateItalic: Boolean;
+ dots: PRGBAWord;
+ Ix, Iy: Integer;
+ Counter: LongInt;
+ IsAlpha: Boolean;
+// GZip: TfrxGZipCompressor;
+ IsTransparent: Boolean;
+ MaskBytes: array of byte;
+ MaskSize: Integer;
+ XMaskHash: TfrxPDFXObjectHash;
+ MaskIndex: Integer;
+ XMaskId: Integer;
+// PDF/A backport
+ XObjectId: Integer;
+ XObjectHash: TfrxPDFXObjectHash;
+ XObjectStream: TStream;
+ XMaskStream: TStream;
+ PicIndex: Integer;
+ RemappedStr: WideString;
+ HWidth: Extended;
+ SpaceAdjustment: Extended;
+
+ function GetLeft(const Left: Extended): Extended;
+ begin
+ Result := FMarginLeft + Left * PDF_DIVIDER
+ end;
+
+ function GetTop(const Top: Extended): Extended;
+ begin
+ Result := FHeightWoMargin - Top * PDF_DIVIDER
+ end;
+
+ function GetVTextPos(const Top: Extended; const Height: Extended;
+ const Align: TfrxVAlign; const Line: Integer = 0;
+ const Count: Integer = 1): Extended;
+ var
+ i: Integer;
+ begin
+ if Line <= Count then
+ i := Line
+ else
+ i := 0;
+ if Align = vaBottom then
+ Result := Top + Height - FLineHeight * (Count - i - 1)
+ else if Align = vaCenter then
+ Result := Top + (Height - (FLineHeight * Count)) / 2 + FLineHeight * (i + 1)
+ else
+ Result := Top + FLineHeight * (i + 1);
+ end;
+
+ function GetVTextPosR(const Height: Extended;
+ const Align: TfrxVAlign; const Line: Integer = 0;
+ const Count: Integer = 1): Extended;
+ var
+ i: Integer;
+ begin
+ if Line <= Count then
+ i := Line
+ else
+ i := 0;
+ if Align = vaBottom then
+ Result := Height - FLineHeight * (Count - i - 1)
+ else if Align = vaCenter then
+ Result := -FLineHeight * Count / 2 + FLineHeight * (i + 1)
+ else
+ Result := - Height + FLineHeight * (i + 1);
+ end;
+
+
+ function GetHTextPos(const Left: Extended; const Width: Extended; const Text: WideString;
+ const Align: TfrxHAlign): Extended;
+ begin
+ case Align of
+ haLeft: Result := Left;
+ haRight: Result := Left + Width - FLineWidth;
+ haCenter: Result := Left + (Width - FLineWidth) / 2;
+ haBlock: Result := Left;
+ else Result := Left;
+ end;
+ end;
+
+
+
+
+ function GetHTextPosR(const Width: Extended; const Text: WideString;
+ const Align: TfrxHAlign): Extended;
+ begin
+ case Align of
+ haRight: Result := Width - FLineWidth;
+ haCenter: Result := -FLineWidth / 2;
+ else Result := -Width;
+ end;
+ end;
+
+ function GetPDFDash(const LineStyle: TfrxFrameStyle; Width: Extended): String;
+ var
+ dash, dot: String;
+ begin
+ if LineStyle = fsSolid then
+ Result := '[] 0 d'
+ else
+ begin
+ dash := frFloat2Str(Width * 6) + ' ';
+ dot := frFloat2Str(Width * 2) + ' ';
+ if LineStyle = fsDash then
+ Result := '[' + dash + dot + '] 0 d'
+ else if LineStyle = fsDashDot then
+ Result := '[' + dash + dash + dot + dash + '] 0 d'
+ else if LineStyle = fsDashDotDot then
+ Result := '[' + dash + dash + dot + dash + dot + dash + '] 0 d'
+ else if LineStyle = fsDot then
+ Result := '[' + dot + dot + '] 0 d'
+ else
+ Result := '[] 0 d';
+ end;
+ end;
+
+ procedure MakeUpFrames;
+ var
+ fRight, fBottom, fWidth, fHeight: String;
+ dLeft, dRight, dTop, dBottom: String;
+ begin
+ if (Obj.Frame.Typ <> []) and (Obj.Frame.Color <> claNull) then
+ begin
+
+ if Obj.Frame.DropShadow then
+ begin
+ fRight := frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width - Obj.Frame.ShadowWidth));
+ fBottom := frFloat2Str(GetTop(Obj.AbsTop + Obj.Height - Obj.Frame.ShadowWidth));
+ fWidth := frFloat2Str((Obj.Width - Obj.Frame.ShadowWidth) * PDF_DIVIDER);
+ fHeight := frFloat2Str((Obj.Height - Obj.Frame.ShadowWidth) * PDF_DIVIDER);
+ end
+ else
+ begin
+ fRight := Right;
+ fBottom := Bottom;
+ fWidth := Width;
+ fHeight := Height;
+ end;
+
+ dTop := frFloat2Str(GetTop(Obj.AbsTop) - 2 );
+ dRight := frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width) - 2);
+ dBottom := frFloat2Str(GetTop(Obj.AbsTop + Obj.Height) + 2);
+ dLeft := frFloat2Str(GetLeft(Obj.AbsLeft) + 2);
+
+ Write(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10);
+ if ftTop in Obj.Frame.Typ then
+ begin
+ Write(OutStream, GetPDFColor(Obj.Frame.TopLine.Color) + ' RG'#13#10);
+ WriteLn(OutStream, GetPDFDash(Obj.Frame.TopLine.Style, Obj.Frame.TopLine.Width));
+ Write(OutStream, frFloat2Str(Obj.Frame.TopLine.Width * PDF_DIVIDER) + ' w'#13#10);
+ Write(OutStream, Left + ' ' + Top + ' m'#13#10 + fRight + ' ' + Top + ' l'#13#10'S'#13#10);
+ if( Obj.Frame.TopLine.Style = fsDouble ) then begin
+ Write (OutStream, GetPDFColor(Obj.Frame.TopLine.Color) + ' RG'#13#10);
+ WriteLn (OutStream, GetPDFDash(Obj.Frame.TopLine.Style, Obj.Frame.TopLine.Width));
+ Write (OutStream, frFloat2Str(Obj.Frame.TopLine.Width * PDF_DIVIDER) + ' w'#13#10);
+ Write (OutStream, dLeft + ' ' + dTop + ' m'#13#10 + dRight + ' ' + dTop + ' l'#13#10'S'#13#10);
+ end;
+ end;
+ if ftRight in Obj.Frame.Typ then
+ begin
+ Write(OutStream, GetPDFColor(Obj.Frame.RightLine.Color) + ' RG'#13#10);
+ WriteLn(OutStream, GetPDFDash(Obj.Frame.RightLine.Style, Obj.Frame.RightLine.Width));
+ Write(OutStream, frFloat2Str(Obj.Frame.RightLine.Width * PDF_DIVIDER) + ' w'#13#10);
+ Write(OutStream, fRight + ' ' + Top + ' m'#13#10 + fRight + ' ' + fBottom + ' l'#13#10'S'#13#10);
+ if( Obj.Frame.RightLine.Style = fsDouble ) then begin
+ Write(OutStream, GetPDFColor(Obj.Frame.RightLine.Color) + ' RG'#13#10);
+ WriteLn(OutStream, GetPDFDash(Obj.Frame.RightLine.Style, Obj.Frame.RightLine.Width));
+ Write(OutStream, frFloat2Str(Obj.Frame.RightLine.Width * PDF_DIVIDER) + ' w'#13#10);
+ Write(OutStream, dRight + ' ' + dTop + ' m'#13#10 + dRight + ' ' + dBottom + ' l'#13#10'S'#13#10);
+ end;
+ end;
+ if ftBottom in Obj.Frame.Typ then
+ begin
+ Write(OutStream, GetPDFColor(Obj.Frame.BottomLine.Color) + ' RG'#13#10);
+ WriteLn(OutStream, GetPDFDash(Obj.Frame.BottomLine.Style, Obj.Frame.BottomLine.Width));
+ Write(OutStream, frFloat2Str(Obj.Frame.BottomLine.Width * PDF_DIVIDER) + ' w'#13#10);
+ Write(OutStream, Left + ' ' + fBottom + ' m'#13#10 + fRight + ' ' + fBottom + ' l'#13#10'S'#13#10);
+ if( Obj.Frame.BottomLine.Style = fsDouble ) then begin
+ Write(OutStream, GetPDFColor(Obj.Frame.BottomLine.Color) + ' RG'#13#10);
+ WriteLn(OutStream, GetPDFDash(Obj.Frame.BottomLine.Style, Obj.Frame.BottomLine.Width));
+ Write(OutStream, frFloat2Str(Obj.Frame.BottomLine.Width * PDF_DIVIDER) + ' w'#13#10);
+ Write(OutStream, dLeft + ' ' + dBottom + ' m'#13#10 + dRight + ' ' + dBottom + ' l'#13#10'S'#13#10);
+ end;
+ end;
+ if ftLeft in Obj.Frame.Typ then
+ begin
+ Write(OutStream, GetPDFColor(Obj.Frame.LeftLine.Color) + ' RG'#13#10);
+ WriteLn(OutStream, GetPDFDash(Obj.Frame.LeftLine.Style, Obj.Frame.LeftLine.Width));
+ Write(OutStream, frFloat2Str(Obj.Frame.LeftLine.Width * PDF_DIVIDER) + ' w'#13#10);
+ Write(OutStream, Left + ' ' + Top + ' m'#13#10 + Left + ' ' + fBottom + ' l'#13#10'S'#13#10);
+ if( Obj.Frame.LeftLine.Style = fsDouble ) then begin
+ Write(OutStream, GetPDFColor(Obj.Frame.LeftLine.Color) + ' RG'#13#10);
+ WriteLn(OutStream, GetPDFDash(Obj.Frame.LeftLine.Style, Obj.Frame.LeftLine.Width));
+ Write(OutStream, frFloat2Str(Obj.Frame.LeftLine.Width * PDF_DIVIDER) + ' w'#13#10);
+ Write(OutStream, dLeft + ' ' + dTop + ' m'#13#10 + dLeft + ' ' + dBottom + ' l'#13#10'S'#13#10);
+ end;
+ end;
+ end;
+ end;
+ function HTMLTags(const View: TfrxCustomMemoView): Boolean;
+ begin
+ if View.AllowHTMLTags then
+ Result := FTags and (Pos('<' ,View.Memo.Text) > 0)
+ else
+ Result := False;
+ end;
+
+ function CheckOutPDFChars(const Str: WideString): WideString;
+ var
+ i: Integer;
+ begin
+ Result := '';
+ for i := 1 to Length(Str) do
+ if Str[i] = '\' then
+ Result := Result + '\\'
+ else if Str[i] = '(' then
+ Result := Result + '\('
+ else if Str[i] = ')' then
+ Result := Result + '\)'
+ else
+ Result := Result + Str[i];
+ end;
+
+ procedure DrawArrow(Obj: TfrxCustomLineView; x1, y1, x2, y2: Extended);
+ var
+ k1, a, b, c, D: Double;
+ xp, yp, x3, y3, x4, y4, ld, wd: Extended;
+ begin
+ wd := Obj.ArrowWidth * PDF_DIVIDER;
+ ld := Obj.ArrowLength * PDF_DIVIDER;
+ if abs(x2 - x1) > 0 then
+ begin
+ k1 := (y2 - y1) / (x2 - x1);
+ a := Sqr(k1) + 1;
+ b := 2 * (k1 * ((x2 * y1 - x1 * y2) / (x2 - x1) - y2) - x2);
+ c := Sqr(x2) + Sqr(y2) - Sqr(ld) + Sqr((x2 * y1 - x1 * y2) / (x2 - x1)) -
+ 2 * y2 * (x2 * y1 - x1 * y2) / (x2 - x1);
+ D := Sqr(b) - 4 * a * c;
+ xp := (-b + Sqrt(D)) / (2 * a);
+ if (xp > x1) and (xp > x2) or (xp < x1) and (xp < x2) then
+ xp := (-b - Sqrt(D)) / (2 * a);
+ yp := xp * k1 + (x2 * y1 - x1 * y2) / (x2 - x1);
+ if y2 <> y1 then
+ begin
+ x3 := xp + wd * sin(ArcTan(k1));
+ y3 := yp - wd * cos(ArcTan(k1));
+ x4 := xp - wd * sin(ArcTan(k1));
+ y4 := yp + wd * cos(ArcTan(k1));
+ end
+ else
+ begin
+ x3 := xp; y3 := yp - wd;
+ x4 := xp; y4 := yp + wd;
+ end;
+ end
+ else
+ begin
+ xp := x2;
+ yp := y2 - ld;
+ if (yp > y1) and (yp > y2) or (yp < y1) and (yp < y2) then
+ yp := y2 + ld;
+ x3 := xp - wd; y3 := yp;
+ x4 := xp + wd; y4 := yp;
+ end;
+ WriteLn(OutStream, GetPDFDash(Obj.Frame.Style, Obj.Frame.Width));
+ WriteLn(OutStream, frFloat2Str(x3) + ' ' + frFloat2Str(y3) + ' m'#13#10 +
+ frFloat2Str(x2) + ' ' + frFloat2Str(y2) + ' l'#13#10 +
+ frFloat2Str(x4) + ' ' + frFloat2Str(y4) + ' l');
+ if Obj.ArrowSolid then
+ WriteLn(OutStream, '1 j'#13#10 + GetPDFColor(Obj.Frame.Color) + ' rg'#13#10'b')
+ else
+ WriteLn(OutStream, 'S');
+ end;
+
+ function FontNeedsBoldItalicSimulation(Font: TFont): Boolean;
+ var
+ Index: Integer;
+ begin
+ Index := frxPDFFontsNeedStyleSimulation.IndexOf(Font.Family);
+ if (Index <> -1) {and not ((Index = 5) and (Font.Style = [fsBold]))} then
+ Result := True
+ else
+ Result := False;
+ end;
+
+ function GetGlobalFont(const Font: TFont): TfrxPDFFont;
+ var
+ i: Integer;
+ Font2: TFont;
+ needBISimulation: Boolean;
+ begin
+ needBISimulation := FontNeedsBoldItalicSimulation(Font);
+ i := 0;
+ while (i < FFonts.Count) do
+ begin
+ Font2 := TfrxPDFFont(FFonts[i]).SourceFont;
+ if (Font.Family = Font2.Family) and ((Font.Style = Font2.Style) or needBISimulation) then
+ break;
+ Inc(i);
+ end;
+ if i < FFonts.Count then
+ result := TfrxPDFFont(FFonts[i])
+ else
+ begin
+ Font2 := nil;
+ try
+ if needBISimulation then
+ begin
+ Font2 := TFont.Create;
+ Font2.Assign(Font);
+ Font2.Style := [];
+ result := TfrxPDFFont.Create(Font2);
+ end
+ else
+ result := TfrxPDFFont.Create(Font);
+ result.FillOutlineTextMetrix();
+ finally
+ if needBISimulation then
+ Font2.Free;
+ end;
+ FFonts.Add(result);
+{$IFDEF Delphi12}
+ result.Name := AnsiString('/F' + IntToStr(FFonts.Count - 1));
+{$ELSE}
+ result.Name := '/F' + IntToStr(FFonts.Count - 1);
+{$ENDIF}
+ end;
+ end;
+
+ function GetObjFontNumber(const Font: TFont): integer;
+ var
+ i: Integer;
+ Font2: TFont;
+ needBISimulation: Boolean;
+ begin
+ needBISimulation := FontNeedsBoldItalicSimulation(Font);
+ i := 0;
+ while (i < FPageFonts.Count) do
+ begin
+ Font2 := TfrxPDFFont(FPageFonts[i]).SourceFont;
+ if (Font.Family = Font2.Family) and ((Font.Style = Font2.Style) or needBISimulation) then
+ break;
+ Inc(i);
+ end;
+ if i < FPageFonts.Count then
+ result := i
+ else
+ begin
+ FPageFonts.Add(GetGlobalFont(Font));
+ result := FPageFonts.Count - 1;
+ end;
+ end;
+
+ procedure Cmd(const Args: string; const Name: string = '');
+ begin
+ if Name = '' then
+ WriteLn(OutStream, Args)
+ else if Args = '' then
+ WriteLn(OutStream, Name)
+ else
+ WriteLn(OutStream, Args + ' ' + Name);
+ end;
+
+ function CmdCoords(x, y: Extended): string;
+ begin
+ Result := frFloat2Str(GetLeft(x)) + ' ' + frFloat2Str(GetTop(y));
+ end;
+
+ procedure CmdMove(x, y: Extended);
+ begin
+ Cmd(CmdCoords(x, y), 'm');
+ end;
+
+ procedure CmdLine(x, y: Extended);
+ begin
+ Cmd(CmdCoords(x, y), 'l');
+ end;
+
+ procedure CmdBezier(x1, y1, x2, y2, x3, y3: Extended);
+ begin
+ Cmd(CmdCoords(x1, y1) + ' ' + CmdCoords(x2, y2) + ' ' +
+ CmdCoords(x3, y3), 'c');
+ end;
+
+ { Rounded rectangle can be drawed
+ using the following PDF commands:
+
+ - m - start a new path
+ - v - add a bezier curve
+ - l - add a straight line
+ - S - stroke the path
+ - B - fill and stroke the path }
+
+ procedure WriteRoundedRect(RoundedRect: TfrxShapeView);
+ var
+ rad, rf, l, t, r, b, w, h: Extended;
+ begin
+ with RoundedRect do
+ begin
+ with Frame do
+ begin
+ Cmd(GetPDFDash(Style, Width));
+ Cmd(GetPDFColor(Color), 'RG');
+ Cmd(frFloat2Str(Width * PDF_DIVIDER), 'w');
+ end;
+
+ if Curve = 0 then
+ rad := 2 * 3.74
+ else
+ rad := Curve * 3.74;
+
+ rf := 0.5 * rad;
+ l := AbsLeft;
+ t := AbsTop;
+ w := Width;
+ h := Height;
+ r := l + w;
+ b := t + h;
+
+ Cmd(GetPDFColor(Color), 'rg');
+ CmdMove(l + rad, b);
+ CmdLine(r - rad, b);
+ CmdBezier(r - rf, b, r, b - rf, r, b - rad); // right-bottom
+ CmdLine(r, t + rad);
+ CmdBezier(r, t + rf, r - rf, t, r - rad, t); // right-top
+ CmdLine(l + rad, t);
+ CmdBezier(l + rf, t, l, t + rf, l, t + rad); // left-top
+ CmdLine(l, b - rad);
+ CmdBezier(l, b - rf, l + rf, b, l + rad, b); // left-bottom
+
+ if Color = claNull then
+ Cmd('', 'S')
+ else
+ Cmd('', 'B');
+ end;
+ end;
+
+ { An extenral link is a URL like http://company.com/index.html }
+
+ procedure WriteExternalLink(const URI: string);
+ var
+ ObjId: Integer;
+ annot: TfrxPDFAnnot;
+ begin
+ ObjId := UpdateXRef;
+ Writeln(FPageAnnots, ObjNumberRef(ObjId)); // for /Annots array in the page object
+
+ annot := TfrxPDFAnnot.Create;
+ annot.Number := ObjId;
+ annot.Rect := Left + ' ' + Bottom + ' ' + Right + ' ' + Top;
+ annot.Hyperlink := String(PdfString(WideString(URI)));
+ FAnnots.Add(annot);
+ end;
+
+ { Writes an anchor to the PDF document. This kind
+ of links make a jump to a specified location within
+ the current document.
+
+ Arguments:
+
+ - Page - an index of a page whither the anchor jumps
+ - Pos - a vertical position of the destination within the page }
+
+ procedure WritePageAnchor(Page: Integer; Pos: Double);
+ var
+ ObjId: Integer;
+ annot: TfrxPDFAnnot;
+ begin
+ ObjId := UpdateXRef;
+ Writeln(FPageAnnots, ObjNumberRef(ObjId)); // for /Annots array in the page object
+
+ annot := TfrxPDFAnnot.Create;
+ annot.Number := ObjId;
+ annot.Rect := Left + ' ' + Bottom + ' ' + Right + ' ' + Top;
+ annot.DestPage := Page;
+ annot.DestY := Round(GetTop(Pos));
+ FAnnots.Add(annot);
+ end;
+
+ { Writes a link object to the PDF document }
+
+ procedure WriteLink(a: string);
+ var
+ x: TfrxXMLItem;
+ begin
+ if a = '' then Exit;
+
+ { Anchors.
+
+ This kind of links make a jump to a specified
+ location within the current document. Anchors
+ begin with '#' sign. }
+
+ if a[1] = '#' then
+ begin
+ a := Copy(a, 2, Length(a) - 1);
+ x := (Report.PreviewPages as TfrxPreviewPages).FindAnchor(a);
+
+ if x <> nil then
+ WritePageAnchor(StrToInt(x.Prop['page']), StrToFloat(x.Prop['top']));
+ end
+
+ { Page anchors.
+
+ This kind of links make a jump to a
+ specified page. }
+
+ else if a[1] = '@' then
+ begin
+ a := Copy(a, 2, Length(a) - 1);
+ WritePageAnchor(StrToInt(a) - 1, 0.0);
+ end
+
+ { Extenal links.
+
+ An extenral link is a URL like http://company.com/index.html. }
+
+ else
+ WriteExternalLink(a)
+ end;
+
+ { Export checkbox }
+
+ procedure ExportChebox(Obj: TfrxView);
+ var
+ cb: TfrxCheckBoxView;
+ L: Extended;
+ T: Extended;
+ W: Extended;
+ H: Extended;
+ begin
+ cb := TfrxCheckBoxView(Obj);
+ L := Obj.AbsLeft;
+ T := Obj.AbsTop;
+ H := Obj.Height;
+ W := Obj.Width;
+
+ if Obj.Color <> claNull then
+ begin
+ Write(OutStream, GetPDFColor(Obj.Color) + ' RG'#13#10 +
+ frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
+ GetPDFColor(Obj.Color) + ' rg'#13#10 +
+ frFloat2Str(GetLeft(Obj.AbsLeft)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + Obj.Height)) + ' '#13#10 +
+ frFloat2Str(Obj.Width * PDF_DIVIDER) + ' ' + frFloat2Str(Obj.Height * PDF_DIVIDER) + ' re'#13#10);
+ Write(OutStream, 'B'#13#10);
+ end;
+
+ if Obj.Frame.Typ = [ftLeft, ftRight, ftTop, ftBottom] then
+ begin
+ WriteLn(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10);
+ WriteLn(OutStream, ' S ' +
+ frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w ' +
+ frFloat2Str(GetLeft(L)) + ' ' + frFloat2Str(GetTop(T)) + ' m ' +
+ frFloat2Str(GetLeft(L + W)) + ' ' + frFloat2Str(GetTop(T)) + ' l ' +
+ frFloat2Str(GetLeft(L + W)) + ' ' + frFloat2Str(GetTop(T + H)) + ' l ' +
+ frFloat2Str(GetLeft(L)) + ' ' + frFloat2Str(GetTop(T + H)) + ' l ' +
+ frFloat2Str(GetLeft(L)) + ' ' + frFloat2Str(GetTop(T)) + ' l ' );
+ Write(OutStream, 'S'#13#10);
+ end;
+
+ WriteLn(OutStream, GetPDFDash( fsSolid, Obj.Frame.Width * 2));
+ WriteLn(OutStream, GetPDFColor(cb.CheckColor) + ' RG'#13#10 +
+ frFloat2Str(Obj.Frame.Width * PDF_DIVIDER * 2) + ' w ' +
+ GetPDFColor(Obj.Color) + ' rg');
+
+ if cb.Checked then
+ case cb.CheckStyle of
+ csCross:
+ WriteLn(OutStream,
+ frFloat2Str(Obj.Frame.Width * PDF_DIVIDER * 3) + ' w 2 J ' +
+ frFloat2Str(GetLeft(L+W/4)) + ' ' + frFloat2Str(GetTop(T+H/4)) + ' m ' +
+ frFloat2Str(GetLeft(L+W-W/4)) + ' ' + frFloat2Str(GetTop(T+H-H/4)) + ' l ' +
+ frFloat2Str(GetLeft(L+W-W/4)) + ' ' + frFloat2Str(GetTop(T+H/4)) + ' m ' +
+ frFloat2Str(GetLeft(L+W/4)) + ' ' + frFloat2Str(GetTop(T+H-H/4)) + ' l ' );
+ csCheck:
+ WriteLn(OutStream,
+ frFloat2Str(Obj.Frame.Width * PDF_DIVIDER * 3) + ' w 2 J ' +
+ frFloat2Str(GetLeft(L + W / 5)) + ' ' + frFloat2Str(GetTop(T + obj.Height / 2 )) + ' m ' +
+ frFloat2Str(GetLeft(L + W / 3)) + ' ' + frFloat2Str(GetTop(T + H - H / 4)) + ' l ' +
+ frFloat2Str(GetLeft(L + W - W / 5)) + ' ' + frFloat2Str(GetTop(T + H / 7 )) + ' l ' ) ;
+ csLineCross:
+ WriteLn(OutStream,
+ frFloat2Str(GetLeft(L)) + ' ' + frFloat2Str(GetTop(T)) + ' m ' +
+ frFloat2Str(GetLeft(L + W)) + ' ' + frFloat2Str(GetTop(T + H)) + ' l ' +
+ frFloat2Str(GetLeft(L + W)) + ' ' + frFloat2Str(GetTop(T)) + ' m ' +
+ frFloat2Str(GetLeft(L)) + ' ' + frFloat2Str(GetTop(T + H)) + ' l ' ) ;
+ csPlus:
+ WriteLn(OutStream,
+ frFloat2Str(GetLeft(L + 0)) + ' ' + frFloat2Str(GetTop(T + obj.Height / 2 )) + ' m ' +
+ frFloat2Str(GetLeft(L + W - 0)) + ' ' + frFloat2Str(GetTop(T + obj.Height / 2 )) + ' l ' +
+ frFloat2Str(GetLeft(L + W / 2)) + ' ' + frFloat2Str(GetTop(T)) + ' m ' +
+ frFloat2Str(GetLeft(L + W / 2)) + ' ' + frFloat2Str(GetTop(T + obj.Height)) + ' l ');
+ end
+ else
+ case cb.UncheckStyle of
+ usEmpty: ;
+ usCross:
+ WriteLn(OutStream,
+ frFloat2Str(Obj.Frame.Width * PDF_DIVIDER * 3) + ' w 2 J ' +
+ frFloat2Str(GetLeft(L+W/4)) + ' ' + frFloat2Str(GetTop(T+H/4)) + ' m ' +
+ frFloat2Str(GetLeft(L+W-W/4)) + ' ' + frFloat2Str(GetTop(T+H-H/4)) + ' l ' +
+ frFloat2Str(GetLeft(L+W-W/4)) + ' ' + frFloat2Str(GetTop(T+H/4)) + ' m ' +
+ frFloat2Str(GetLeft(L+W/4)) + ' ' + frFloat2Str(GetTop(T+H-H/4)) + ' l ');
+ usLineCross:
+ WriteLn(OutStream,
+ frFloat2Str(GetLeft(L)) + ' ' + frFloat2Str(GetTop(T)) + ' m ' +
+ frFloat2Str(GetLeft(L + W)) + ' ' + frFloat2Str(GetTop(T + H)) + ' l ' +
+ frFloat2Str(GetLeft(L + W)) + ' ' + frFloat2Str(GetTop(T)) + ' m ' +
+ frFloat2Str(GetLeft(L)) + ' ' + frFloat2Str(GetTop(T + H)) + ' l ');
+ usMinus:
+ WriteLn(OutStream,
+ frFloat2Str(GetLeft(L + 0)) + ' ' + frFloat2Str(GetTop(T + obj.Height / 2 )) + ' m ' +
+ frFloat2Str(GetLeft(L + W - 0)) + ' ' + frFloat2Str(GetTop(T + obj.Height / 2 )) + ' l ');
+ end;
+
+ Write(OutStream, 'S'#13#10);
+
+ end;
+
+ function NeedSpaceAdjustment: Boolean;
+ function IsEndOfParagraph: Boolean;
+ begin
+ Result := Integer(Lines.Objects[i]) and 2 <> 0;
+ end;
+ begin
+ Result := (textObj.HAlign = haBlock) and not IsEndOfParagraph and
+ (pdfFont.LastRemappedStrSpacesCount > 0);
+ if not Result then
+ Exit;
+ FLineWidth := HWidth;
+ SpaceAdjustment := pdfFont.LastRemappedStrWidth - HWidth * PDF_DIVIDER * 1000 / textObj.Font.Size;
+ SpaceAdjustment := SpaceAdjustment / pdfFont.LastRemappedStrSpacesCount;
+ end;
+
+begin
+ FHeightWoMargin := FHeight - FMarginTop;
+ Left := frFloat2Str(GetLeft(Obj.AbsLeft));
+ Top := frFloat2Str(GetTop(Obj.AbsTop));
+ Right := frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width));
+ Bottom := frFloat2Str(GetTop(Obj.AbsTop + Obj.Height));
+ Width := frFloat2Str(Obj.Width * PDF_DIVIDER);
+ Height := frFloat2Str(Obj.Height * PDF_DIVIDER);
+
+ OldFrameWidth := 0;
+ WriteLink(Obj.URL);
+
+ { Memo object will be written to a pdf file as text if
+ the following conditions are satisfied. All other
+ memo objects will be saved as pictures:
+
+ - brush style is "solid" or "clear"
+ - "wordwrap" option is disabled
+ - clipping is disabled
+ - html formatting is disabled }
+
+ if (Obj is TfrxCustomMemoView)
+ and (TfrxCustomMemoView(Obj).BrushStyle in [ TBrushKind.bkSolid, TBrushKind.bkNone])
+ and not HTMLTags(TfrxCustomMemoView(Obj)) then
+ begin
+ // save clip to stack
+ Write(OutStream, 'q'#13#10);
+ Write(OutStream, frFloat2Str(GetLeft(Obj.AbsLeft - Obj.Frame.Width)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + Obj.Height + Obj.Frame.Width)) + ' ' +
+ frFloat2Str((Obj.Width + Obj.Frame.Width * 2) * PDF_DIVIDER) + ' ' + frFloat2Str((Obj.Height + Obj.Frame.Width * 2) * PDF_DIVIDER) + ' re'#13#10'W'#13#10'n'#13#10);
+ ow := Obj.Width;
+ oh := Obj.Height;
+ // Shadow
+ if Obj.Frame.DropShadow then
+ begin
+ ow := Obj.Width - Obj.Frame.ShadowWidth;
+ oh := Obj.Height - Obj.Frame.ShadowWidth;
+ Width := frFloat2Str(ow * PDF_DIVIDER);
+ Height := frFloat2Str(oh * PDF_DIVIDER);
+ Right := frFloat2Str(GetLeft(Obj.AbsLeft + ow));
+ Bottom := frFloat2Str(GetTop(Obj.AbsTop + oh));
+ s := AnsiString(GetPDFColor(Obj.Frame.ShadowColor));
+ Write(OutStream, s + ' rg'#13#10 + s + ' RG'#13#10 +
+ AnsiString(frFloat2Str(GetLeft(Obj.AbsLeft + ow)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + oh + Obj.Frame.ShadowWidth)) + ' ' +
+ frFloat2Str(Obj.Frame.ShadowWidth * PDF_DIVIDER) + ' ' + frFloat2Str(oh * PDF_DIVIDER) + ' re'#13#10'B'#13#10 +
+ frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Frame.ShadowWidth)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + oh + Obj.Frame.ShadowWidth)) + ' ' +
+ frFloat2Str(ow * PDF_DIVIDER) + ' ' + frFloat2Str(Obj.Frame.ShadowWidth * PDF_DIVIDER) + ' re'#13#10'B'#13#10));
+ end;
+
+ textObj := TfrxCustomMemoView(Obj);
+
+ AFont := TFont.Create;
+ try
+ if textObj.Highlight.Active and
+ Assigned(textObj.Highlight.Font) then
+ begin
+ textObj.Font.Assign(textObj.Highlight.Font);
+ textObj.Color := textObj.Highlight.Color;
+ end;
+
+ wx1 := Round((textObj.Frame.Width - 1) / 2);
+ wx2 := Round(textObj.Frame.Width / 2);
+ wy1 := Round((textObj.Frame.Width - 1) / 2);
+ wy2 := Round(textObj.Frame.Width / 2);
+
+ bx := Round(textObj.AbsLeft);
+ by := Round(textObj.AbsTop);
+ bx1 := Round(textObj.AbsLeft + textObj.Width);
+ by1 := Round(textObj.AbsTop + textObj.Height);
+ if ftLeft in textObj.Frame.Typ then
+ Inc(bx, wx1);
+ if ftRight in textObj.Frame.Typ then
+ Dec(bx1, wx2);
+ if ftTop in textObj.Frame.Typ then
+ Inc(by, wy1);
+ if ftBottom in textObj.Frame.Typ then
+ Dec(by1, wy2);
+ gx1 := Round(textObj.GapX);
+ gy1 := Round(textObj.GapY);
+
+ FTextRect := RectF(bx + gx1, by + gy1, bx1 - gx1 + 1, by1 - gy1 + 1);
+
+ FBmpCanvas.Canvas.BeginScene();
+ textObj.Font.AssignToCanvas(FBmpCanvas.Canvas);
+ FBmpCanvas.Canvas.EndScene;
+{$IFDEF Delphi10}
+ Lines := TfrxWideStrings.Create;
+{$ELSE}
+ Lines := TWideStrings.Create;
+{$ENDIF}
+ textObj.WrapText(textObj.WordBreak, FLineHeight, Lines, FBmpCanvas);
+
+ if textObj.Color <> claNull then
+ Write(OutStream, GetPDFColor(textObj.Color) + ' rg'#13#10 + Left + ' ' + Bottom + ' ' +
+ Width + ' ' + Height + ' re'#13#10'f'#13#10);
+ // Frames
+ MakeUpFrames;
+
+ if TextObj.Rotation > 0 then
+ begin
+ Angle := TextObj.Rotation * Pi / 180;
+ a_sin := Sin(Angle);
+ a_cos := Cos(Angle);
+
+ case TextObj.Rotation of
+ 90, 180, 270:
+ begin
+ a_x := GetLeft(TextObj.AbsLeft + TextObj.Width/2);
+ a_y := GetTop(TextObj.AbsTop + TextObj.Height/2);
+ end
+ else
+ begin
+ case TextObj.Rotation of
+ 45..135, 225..315:
+ begin
+ rx := TextObj.Height;
+ ry := TextObj.Width;
+ end
+ else
+ begin
+ rx := TextObj.Width;
+ ry := TextObj.Height;
+ end
+ end;
+
+ //a_x := GetLeft(TextObj.AbsLeft + 0.5 * (rx * a_cos + ry * a_sin));
+ //a_y := GetTop(TextObj.AbsTop + 0.5 * (rx * a_sin + ry * a_cos));
+ a_x := GetLeft(TextObj.AbsLeft + TextObj.Width/2);
+ a_y := GetTop(TextObj.AbsTop + TextObj.Height/2);
+ end
+ end;
+
+ WriteLn(OutStream, frFloat2Str(a_cos) + ' ' + frFloat2Str(a_sin) + ' ' +
+ frFloat2Str(-a_sin) + ' ' + frFloat2Str(a_cos) + ' ' +
+ frFloat2Str(a_x) + ' ' + frFloat2Str(a_y) + ' cm');
+ end;
+
+ if textObj.Underlines then
+ begin
+ iz := Trunc(textObj.Height / FLineHeight);
+ for i:= 0 to iz - 1 do
+ begin
+ y := GetTop(textObj.AbsTop + textObj.GapY + 1 + FLineHeight * (i + 1) - textObj.LineSpacing);
+ Write(OutStream, GetPDFColor(textObj.Frame.Color) + ' RG'#13#10 +
+ frFloat2Str(textObj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
+ Left + ' ' + frFloat2Str(y) + ' m'#13#10 +
+ Right + ' ' + frFloat2Str(y) + ' l'#13#10'S'#13#10);
+ end;
+ end;
+
+
+ if Lines.Count > 0 then
+ begin
+ textObj.Font.AssignToFont(AFont);
+ FontIndex := GetObjFontNumber(AFont);
+ pdfFont := TfrxPDFFont(FPageFonts[FontIndex]);
+ simulateBold := (TFontStyle.fsBold in textObj.Font.Style) and FontNeedsBoldItalicSimulation(AFont);
+ simulateItalic := (TFontStyle.fsItalic in textObj.Font.Style) and FontNeedsBoldItalicSimulation(AFont);
+{$IFDEF Delphi12}
+ Write(OutStream, TfrxPDFFont(FFonts[FontIndex]).Name +
+ AnsiString(' ' + frFloat2Str(((Round(textObj.Font.Size) - tpPt * Round(textObj.Font.Size)) * 10) / 10) + ' Tf'#13#10));
+{$ELSE}
+ Write(OutStream, TfrxPDFFont(FFonts[FontIndex]).Name +
+ ' ' + IntToStr(Round(textObj.Font.Size)) + ' Tf'#13#10);
+{$ENDIF}
+ if textObj.Font.Color <> claNull then
+ TempColor := textObj.Font.Color
+ else
+ TempColor := claBlack;
+ Write(OutStream, GetPDFColor(TempColor) + ' rg'#13#10);
+ //CharSpacing not used anymore , but we need it to emulate canvas behaviour
+ FCharSpacing := 0;// -0.2;// textObj.CharSpacing * PDF_DIVIDER;
+ if FCharSpacing <> 0 then
+ Write(OutStream, frFloat2Str(FCharSpacing) + ' Tc'#13#10);
+
+ // output lines of memo
+ FUnderlinePosition := textObj.Font.Size * 0.12;
+ FStrikeoutPosition := textObj.Font.Size * 0.28;
+ //frxDrawText.SetGaps(0, TfrxCustomMemoView(Obj).CharSpacing, TfrxCustomMemoView(Obj).LineSpacing);
+
+ for i := 0 to Lines.Count - 1 do
+ begin
+// ParagraphGap is not implimented
+// if textObj.Lines.Count <> Lines.Count then
+// begin
+// if Integer(Lines.Objects[i]) and 1 <> 0 then
+// PGap := textObj.ParagraphGap
+// else
+// PGap := 0;
+// end else
+// if i = 0 then
+// PGap := textObj.ParagraphGap
+// else
+ PGap := 0;
+
+ if Length(Lines[i]) > 0 then
+ begin
+ // Text output
+ if textObj.HAlign <> haRight then
+ FCharSpacing := 0;
+
+ RemappedStr := pdfFont.RemapString(Lines[i], textObj.RTLReading);
+ FLineWidth := pdfFont.LastRemappedStrWidth / PDF_DIVIDER / 1000 * textObj.Font.Size;
+
+ if textObj.Rotation > 0 then
+ begin
+ if ((textObj.Rotation >= 45) and (textObj.Rotation <= 135)) or
+ ((textObj.Rotation >= 225 ) and (textObj.Rotation <= 315)) then
+ begin
+ rx := oh;
+ ry := ow;
+ end
+ else
+ begin
+ rx := ow;
+ ry := oh;
+ end;
+ HWidth := rx;
+ x := FCharSpacing + (GetHTextPosR(rx / 2, Lines[i], textObj.HAlign)) * PDF_DIVIDER;
+ y := -(GetVTextPosR(ry / 2, textObj.VAlign, i, Lines.Count)) * PDF_DIVIDER + textObj.Font.Size * 0.4;
+ end
+ else
+ begin
+ HWidth := ow - textObj.GapX * 2 - PGap;
+ x := FCharSpacing + GetLeft(GetHTextPos(textObj.AbsLeft + textObj.GapX + PGap,
+ HWidth, Lines[i], textObj.HAlign));
+ y := GetTop(GetVTextPos(textObj.AbsTop + textObj.GapY - textObj.Font.Size * 0.2,
+ oh - textObj.GapY * 2, textObj.VAlign, i, Lines.Count));
+ end;
+
+ Write(OutStream, 'BT'#13#10);
+ Write(OutStream, frFloat2Str(x) + ' ' + frFloat2Str(y) + ' Td'#13#10);
+ if simulateItalic then
+ begin
+ Write(OutStream, '1 0 0.3333 1 ');
+ Write(OutStream, frFloat2Str(x) + ' ' + frFloat2Str(y) + ' Tm'#13#10);
+ end;
+ if simulateBold then
+ begin
+ Write(OutStream, '2 Tr ');
+ Write(OutStream, frFloat2Str(textObj.Font.Size / 35.0));
+ Write(OutStream, ' w ' + GetPDFColor(TempColor) + ' RG'#13#10);
+ end;
+ if NeedSpaceAdjustment then
+ Write(OutStream, '[<' + StrToHexSp(Lines[i], RemappedStr, SpaceAdjustment) + '>] TJ'#13#10'ET'#13#10)
+ else
+ Write(OutStream, '<' + StrToHex(RemappedStr) + '> Tj'#13#10'ET'#13#10);
+ if simulateBold then
+ Write(OutStream, '0 Tr'#13#10);
+
+ { underlined text }
+
+ with textObj do
+ if TFontStyle.fsUnderline in Font.Style then
+ begin
+ Cmd(GetPDFColor(Font.Color), 'RG');
+ Cmd(frFloat2Str(Font.Size * 0.08), 'w');
+ Cmd(frFloat2Str(x) + ' ' + frFloat2Str(y - FUnderlinePosition), 'm');
+ Cmd(frFloat2Str(x + FLineWidth * PDF_DIVIDER) + ' ' +
+ frFloat2Str(y - FUnderlinePosition), 'l');
+
+ Cmd('', 'S');
+ end;
+
+ { struck out text }
+
+ if TFontStyle.fsStrikeout in (textObj.Font.Style) then
+ Write(OutStream, GetPDFColor(textObj.Font.Color) + ' RG'#13#10 +
+ frFloat2Str(textObj.Font.Size * 0.08) + ' w'#13#10 +
+ frFloat2Str(x) + ' ' + frFloat2Str(y + FStrikeoutPosition) + ' m'#13#10 +
+ frFloat2Str(x + FLineWidth * PDF_DIVIDER) +
+ ' ' + frFloat2Str(y + FStrikeoutPosition) + ' l'#13#10'S'#13#10);
+ end;
+ end;
+ end;
+ finally
+ AFont.Free;
+ end;
+ // restore clip
+ Write(OutStream, 'Q'#13#10);
+ Lines.Free;
+ end
+ // Lines
+ else if Obj is TfrxCustomLineView then
+ begin
+ WriteLn(OutStream, GetPDFDash(Obj.Frame.Style, Obj.Frame.Width));
+ Write(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10 +
+ frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
+ Left + ' ' + Top + ' m'#13#10 +
+ Right + ' ' + Bottom + ' l'#13#10'S'#13#10);
+ if TfrxCustomLineView(Obj).ArrowStart then
+ DrawArrow(TfrxCustomLineView(Obj), GetLeft(Obj.AbsLeft + Obj.Width), GetTop(Obj.AbsTop + Obj.Height), GetLeft(Obj.AbsLeft), GetTop(Obj.AbsTop));
+ if TfrxCustomLineView(Obj).ArrowEnd then
+ DrawArrow(TfrxCustomLineView(Obj), GetLeft(Obj.AbsLeft), GetTop(Obj.AbsTop), GetLeft(Obj.AbsLeft + Obj.Width), GetTop(Obj.AbsTop + Obj.Height));
+ end
+ // Rects
+ else if (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skRectangle) then
+ begin
+ WriteLn(OutStream, GetPDFDash(Obj.Frame.Style, Obj.Frame.Width));
+ Write(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10 +
+ frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
+ GetPDFColor(Obj.Color) + ' rg'#13#10 +
+ Left + ' ' + Bottom + ' '#13#10 +
+ Width + ' ' + Height + ' re'#13#10);
+ if Obj.Color <> claNull then
+ Write(OutStream, 'B'#13#10)
+ else
+ Write(OutStream, 'S'#13#10);
+ end
+
+ { Rounded rectangle }
+
+ else if (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skRoundRectangle) then
+ WriteRoundedRect(TfrxShapeView(Obj))
+
+ // Shape line 1
+ else if (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skDiagonal1) then
+ begin
+ WriteLn(OutStream, GetPDFDash(Obj.Frame.Style, Obj.Frame.Width));
+ Write(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10 +
+ frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
+ Left + ' ' + Bottom + ' m'#13#10 + Right + ' ' + Top + ' l'#13#10'S'#13#10)
+ end
+ // Shape line 2
+ else if (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skDiagonal2) then
+ begin
+ WriteLn(OutStream, GetPDFDash(Obj.Frame.Style, Obj.Frame.Width));
+ Write(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10 +
+ frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
+ Left + ' ' + Top + ' m'#13#10 + Right + ' ' + Bottom + ' l'#13#10'S'#13#10)
+ end
+ // Shape diamond
+ else if (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skDiamond) then
+ begin
+ WriteLn(OutStream, GetPDFDash(Obj.Frame.Style, Obj.Frame.Width));
+ WriteLn(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10 +
+ frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
+ GetPDFColor(Obj.Color) + ' rg');
+ WriteLn(OutStream, frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width / 2)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop)) + ' m ' +
+ frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + Obj.Height / 2)) + ' l ' +
+ frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width / 2)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + Obj.Height)) + ' l ' +
+ frFloat2Str(GetLeft(Obj.AbsLeft)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + Obj.Height / 2)) + ' l ' +
+ frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width / 2)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop)) + ' l');
+ if Obj.Color <> claNull then
+ Write(OutStream, 'B'#13#10)
+ else
+ Write(OutStream, 'S'#13#10);
+ end
+ // Shape triangle
+ else if (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skTriangle) then
+ begin
+ WriteLn(OutStream, GetPDFDash(Obj.Frame.Style, Obj.Frame.Width));
+ WriteLn(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10 +
+ frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
+ GetPDFColor(Obj.Color) + ' rg');
+ WriteLn(OutStream, frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width / 2)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop)) + ' m ' +
+ frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + Obj.Height)) + ' l ' +
+ frFloat2Str(GetLeft(Obj.AbsLeft)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + Obj.Height)) + ' l ' +
+ frFloat2Str(GetLeft(Obj.AbsLeft + Obj.Width / 2)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop)) + ' l');
+ if Obj.Color <> claNull then
+ Write(OutStream, 'B'#13#10)
+ else
+ Write(OutStream, 'S'#13#10);
+ end
+ // Shape ellipse
+ else if (Obj is TfrxShapeView) and (TfrxShapeView(Obj).Shape = skEllipse) then
+ begin
+ WriteLn(OutStream, GetPDFDash(Obj.Frame.Style, Obj.Frame.Width));
+ WriteLn(OutStream, GetPDFColor(Obj.Frame.Color) + ' RG'#13#10 +
+ frFloat2Str(Obj.Frame.Width * PDF_DIVIDER) + ' w'#13#10 +
+ GetPDFColor(Obj.Color) + ' rg');
+ rx := Obj.Width / 2;
+ ry := Obj.Height / 2;
+ WriteLn(OutStream, frFloat2Str(GetLeft(Obj.AbsLeft + rx * 2)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + ry)) + ' m');
+ WriteLn(OutStream,
+ frFloat2Str(GetLeft(Obj.AbsLeft + rx * 2)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + ry * KAPPA1)) + ' ' +
+ frFloat2Str(GetLeft(Obj.AbsLeft + rx * KAPPA1)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + ry * 2)) + ' ' +
+ frFloat2Str(GetLeft(Obj.AbsLeft + rx)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + ry * 2)) + ' c');
+ WriteLn(OutStream,
+ frFloat2Str(GetLeft(Obj.AbsLeft + rx * KAPPA2)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + ry * 2)) + ' ' +
+ frFloat2Str(GetLeft(Obj.AbsLeft)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + ry * KAPPA1)) + ' ' +
+ frFloat2Str(GetLeft(Obj.AbsLeft)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + ry)) + ' c');
+ WriteLn(OutStream,
+ frFloat2Str(GetLeft(Obj.AbsLeft)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + ry * KAPPA2)) + ' ' +
+ frFloat2Str(GetLeft(Obj.AbsLeft + rx * KAPPA2)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop)) + ' ' +
+ frFloat2Str(GetLeft(Obj.AbsLeft + rx)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop)) + ' c');
+ WriteLn(OutStream,
+ frFloat2Str(GetLeft(Obj.AbsLeft + rx * KAPPA1)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop)) + ' ' +
+ frFloat2Str(GetLeft(Obj.AbsLeft + rx * 2)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + ry * KAPPA2)) + ' ' +
+ frFloat2Str(GetLeft(Obj.AbsLeft + rx * 2)) + ' ' + frFloat2Str(GetTop(Obj.AbsTop + ry)) + ' c');
+ if Obj.Color <> claNull then
+ Write(OutStream, 'B'#13#10)
+ else
+ Write(OutStream, 'S'#13#10);
+ end
+ else if (Obj is TfrxCheckboxView) then ExportChebox(Obj)
+ else
+ // Bitmaps
+{$IFNDEF OLD_STYLE}
+ // Bitmaps
+ if not ((Obj.Name = '_pagebackground') and (not Background)) and
+ (Obj.Height > 0) and (Obj.Width > 0) then
+ begin
+ if Obj.Frame.Width > 0 then
+ begin
+ OldFrameWidth := Obj.Frame.Width;
+ Obj.Frame.Width := 0;
+ end;
+
+ FRealBounds := Obj.GetRealBounds;
+ dx := FRealBounds.Right - FRealBounds.Left;
+ dy := FRealBounds.Bottom - FRealBounds.Top;
+
+ if (dx = Obj.Width) or (Obj.AbsLeft = FRealBounds.Left) then
+ fdx := 0
+ else if (Obj.AbsLeft + Obj.Width) = FRealBounds.Right then
+ fdx := (dx - Obj.Width)
+ else
+ fdx := (dx - Obj.Width) / 2;
+
+ if (dy = Obj.Height) or (Obj.AbsTop = FRealBounds.Top) then
+ fdy := 0
+ else if (Obj.AbsTop + Obj.Height) = FRealBounds.Bottom then
+ fdy := (dy - Obj.Height)
+ else
+ fdy := (dy - Obj.Height) / 2;
+
+ TempBitmap := TBitmap.Create(1,1);
+{$IFDEF DELPHI20}
+ ///TempBitmap.PixelFormat := TPixelFormat.RGBA;
+{$ENDIF}
+
+ try
+
+ if (PrintOptimized or (Obj is TfrxCustomMemoView)) and (Obj.BrushStyle in [TBrushKind.bkSolid, TBrushKind.bkNone]) then
+ i := PDF_PRINTOPT
+ else
+ i := 1;
+
+ iz := 0;
+
+ if (Obj.ClassName = 'TfrxBarCodeView') and not PrintOptimized then
+ begin
+ i := 2;
+ iz := i;
+ end;
+
+ TempBitmap.Width := Round(dx * i) + i;
+ TempBitmap.Height := Round(dy * i) + i;
+ IsTransparent := False;
+ IsAlpha := False;
+ if Obj is TfrxPictureView then
+ IsTransparent := TfrxPictureView(Obj).Transparent
+ else if Obj is TfrxMemoView then
+ IsTransparent := (TfrxMemoView(Obj).Color = claNull);
+
+ try
+ if IsTransparent then
+ begin
+ TempBitmap.Clear($FFFFFF);
+ MaskSize := TempBitmap.Height * TempBitmap.Width;
+ SetLength( MaskBytes, MaskSize );
+ end
+ else
+ TempBitmap.Clear(claWhite);
+ TempBitmap.Canvas.BeginScene();
+ Obj.Draw(TempBitmap.Canvas, i, i, -Round((Obj.AbsLeft - fdx) * i) + iz, -Round((Obj.AbsTop - fdy)* i));
+ TempBitmap.Canvas.EndScene;
+ if IsTransparent then
+ begin
+ IsAlpha := False;
+ Counter := 0;
+{$IFDEF DELPHI17}
+ TempBitmap.Map(TMapAccess.maReadWrite, bData);
+{$ENDIF}
+ for iy := 0 to TempBitmap.Height - 1 do
+ begin
+{$IFDEF DELPHI18}
+ dots := bData.GetScanline(iy);
+{$ELSE}
+{$IFDEF DELPHI17}
+ dots := @PLongByteArray(bData.Data)[iy * bData.Pitch];
+{$ELSE}
+ dots := Pointer(TempBitmap.Scanline[iy]);
+{$ENDIF}
+{$ENDIF}
+ for ix := 0 to TempBitmap.Width - 1 do
+ begin
+ if dots[ix].Alpha <> 0 then
+ IsAlpha := True;
+ MaskBytes[Counter] := dots[ix].Alpha;
+ Inc(Counter);
+ end;
+ end;
+{$IFDEF DELPHI17}
+ TempBitmap.Unmap(bData);
+{$ENDIF}
+ end;
+
+ except
+ // charts throw exceptions when numbers are malformed
+ end;
+
+ { Write XObject with a picture inside }
+
+
+ XObjectStream := TMemoryStream.Create;
+ XMaskStream := TMemoryStream.Create;
+ try
+ SaveGraphicAs(TempBitmap, XObjectStream, gpJPG);
+ // Prepare mask
+ if IsAlpha = True then
+ begin
+ XMaskStream.Position := 0;
+ XMaskStream.Write( Pointer(MaskBytes)^, Counter );
+ XMaskStream.Position := 0;
+ GetStreamHash(XMaskHash, XMaskStream);
+ MaskIndex := FindXObject(XMaskHash);
+
+ if MaskIndex < 0 then
+ begin
+ XMaskId := UpdateXRef;
+ MaskIndex := AddXObject(XMaskId, XMaskHash);
+ Writeln(pdf, ObjNumber(XMaskId));
+
+ WriteLn(pdf, '<< /Type /XObject');
+ WriteLn(pdf, '/Subtype /Image');
+ WriteLn(pdf, '/Width ' + IntToStr(TempBitmap.Width));
+ WriteLn(pdf, '/Height ' + IntToStr(TempBitmap.Height));
+ WriteLn(pdf, '/ColorSpace /DeviceGray/Matte[ 0 0 0] ');
+ WriteLn(pdf, '/BitsPerComponent 8');
+ WriteLn(pdf, '/Interpolate false');
+ WriteLn(pdf, ' /Length ' + IntToStr(MaskSize) + ' >>');
+ WriteLn(pdf, 'stream');
+ if FProtection then
+ CryptStream(XMaskStream, pdf, FEncKey, XObjectId)
+ else
+ pdf.CopyFrom(XMaskStream, 0);
+
+ Write(pdf, #13#10'endstream'#13#10);
+ WriteLn(pdf, 'endobj');
+ end;
+ { hash should be calculated for Pic + Mask }
+ XMaskStream.Position := XMaskStream.Size;
+ XObjectStream.Position := 0;
+ XMaskStream.CopyFrom(XObjectStream, 0);
+ XMaskStream.Position := 0;
+ XObjectStream.Position := 0;
+ GetStreamHash(XObjectHash, XMaskStream);
+ PicIndex := FindXObject(XObjectHash);
+ end
+ else
+ begin
+ XObjectStream.Position := 0;
+ GetStreamHash(XObjectHash, XObjectStream);
+ PicIndex := FindXObject(XObjectHash);
+ end;
+
+ if PicIndex < 0 then
+ begin
+ XObjectId := UpdateXRef;
+ PicIndex := AddXObject(XObjectId, XObjectHash);
+
+ Writeln(pdf, ObjNumber(XObjectId));
+ Writeln(pdf, '<<');
+ Writeln(pdf, '/Type /XObject');
+ Writeln(pdf, '/Subtype /Image');
+ Writeln(pdf, '/ColorSpace /DeviceRGB');
+ Writeln(pdf, '/BitsPerComponent 8');
+ Writeln(pdf, '/Filter /DCTDecode');
+ Writeln(pdf, '/Width ' + IntToStr(TempBitmap.Width));
+ Writeln(pdf, '/Height ' + IntToStr(TempBitmap.Height));
+ if IsAlpha = True then
+ WriteLn(pdf, '/SMask ' + IntToStr(XMaskId) + ' 0 R');
+ Writeln(pdf, '/Length ' + IntToStr(XObjectStream.Size));
+ Writeln(pdf, '>>');
+
+ Write(pdf, 'stream'#13#10); // 'stream'#10 is also valid
+ XObjectStream.Position := 0;
+ pdf.CopyFrom(XObjectStream, 0);
+ Write(pdf, #13#10'endstream'#13#10);
+ Inc(FPicTotalSize, XObjectStream.Size);
+
+ Writeln(pdf, 'endobj');
+
+ end;
+ finally
+ XObjectStream.Free;
+ XMaskStream.Free;
+ end;
+ finally
+ TempBitmap.Free;
+ end;
+
+ { Reference to this XObject }
+
+ SetLength(FUsedXObjects, Length(FUsedXObjects) + 1);
+ FUsedXObjects[High(FUsedXObjects)] := PicIndex;
+
+ Writeln(OutStream, 'q');
+ Writeln(OutStream,
+ frFloat2Str(dx * PDF_DIVIDER) + ' ' +
+ '0 ' +
+ '0 ' +
+ frFloat2Str(dy * PDF_DIVIDER) + ' ' +
+ frFloat2Str(GetLeft(Obj.AbsLeft - fdx)) + ' ' +
+ frFloat2Str(GetTop(Obj.AbsTop - fdy + dy)) + ' ' +
+ 'cm');
+ Writeln(OutStream, '/Im' + IntToStr(PicIndex) + ' Do');
+ Writeln(OUtStream, 'Q');
+
+ if OldFrameWidth > 0 then
+ Obj.Frame.Width := OldFrameWidth;
+
+ MakeUpFrames;
+ end;
+{$ELSE}
+ if not ((Obj.Name = '_pagebackground') and (not Background)) and
+ (Obj.Height > 0) and (Obj.Width > 0) then
+ begin
+ if Obj.Frame.Width > 0 then
+ begin
+ OldFrameWidth := Obj.Frame.Width;
+ Obj.Frame.Width := 0;
+ end;
+
+ FRealBounds := Obj.GetRealBounds;
+ dx := FRealBounds.Right - FRealBounds.Left;
+ dy := FRealBounds.Bottom - FRealBounds.Top;
+
+ if (dx = Obj.Width) or (Obj.AbsLeft = FRealBounds.Left) then
+ fdx := 0
+ else if (Obj.AbsLeft + Obj.Width) = FRealBounds.Right then
+ fdx := (dx - Obj.Width)
+ else
+ fdx := (dx - Obj.Width) / 2;
+
+ if (dy = Obj.Height) or (Obj.AbsTop = FRealBounds.Top) then
+ fdy := 0
+ else if (Obj.AbsTop + Obj.Height) = FRealBounds.Bottom then
+ fdy := (dy - Obj.Height)
+ else
+ fdy := (dy - Obj.Height) / 2;
+
+ TempBitmap := TBitmap.Create;
+ TempBitmap.PixelFormat := pf24bit;
+
+ if (PrintOptimized or (Obj is TfrxCustomMemoView)) and (Obj.BrushStyle in [bsSolid, bsClear]) then
+ i := PDF_PRINTOPT
+ else
+ i := 1;
+
+ iz := 0;
+
+ if (Obj.ClassName = 'TfrxBarCodeView') and not PrintOptimized then
+ begin
+ i := 2;
+ iz := i;
+ end;
+
+ TempBitmap.Width := Round(dx * i) + i;
+ TempBitmap.Height := Round(dy * i) + i;
+ TempBitmap.Canvas.BeginScene();
+ Obj.Draw(TempBitmap.Canvas, i, i, -Round((Obj.AbsLeft - fdx) * i) + iz, -Round((Obj.AbsTop - fdy)* i));
+ TempBitmap.Canvas.EndScene;
+ if dx <> 0 then
+ BWidth := frFloat2Str(dx * PDF_DIVIDER)
+ else
+ BWidth := '1';
+ if dy <> 0 then
+ BHeight := frFloat2Str(dy * PDF_DIVIDER)
+ else
+ BHeight := '1';
+
+ Write(OutStream, 'q'#13#10 + BWidth + ' 0 0 ' + BHeight + ' ' +
+ frFloat2Str(GetLeft(Obj.AbsLeft - fdx)) + ' ' +
+ frFloat2Str(GetTop(Obj.AbsTop - fdy + dy)) + ' cm'#13#10'BI'#13#10 +
+ '/W ' + IntToStr(TempBitmap.Width) + #13#10 +
+ '/H ' + IntToStr(TempBitmap.Height) + #13#10'/CS /RGB'#13#10'/BPC 8'#13#10'/I true'#13#10'/F [/DCT]'#13#10'ID'#13#10);
+
+ Jpg := TJPEGImage.Create;
+
+ if (Obj.ClassName = 'TfrxBarCodeView') or
+ (Obj is TfrxCustomLineView) or
+ (Obj is TfrxShapeView) then
+ begin
+ Jpg.PixelFormat := jf8Bit;
+ Jpg.CompressionQuality := FQuality+5; // 95;
+ end
+ else begin
+ Jpg.PixelFormat := jf24Bit;
+ Jpg.CompressionQuality := FQuality; //90;
+ end;
+
+ Jpg.Assign(TempBitmap);
+ Jpg.SaveToStream(OutStream);
+ Jpg.Free;
+
+ Write(OutStream, #13#10'EI'#13#10'Q'#13#10);
+ TempBitmap.Free;
+ if OldFrameWidth > 0 then
+ Obj.Frame.Width := OldFrameWidth;
+ MakeUpFrames;
+ end;
+{$ENDIF}
+end;
+
+{ TfrxPDFExportDialog }
+
+procedure TfrxPDFExportDialog.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(8700);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ GroupPageRange.Text := frxGet(7);
+ AllRB.Text := frxGet(3);
+ CurPageRB.Text := frxGet(4);
+ PageNumbersRB.Text := frxGet(5);
+ DescrL.Text := frxGet(9);
+ GroupQuality.Text := frxGet(8);
+ CompressedCB.Text := frxGet(8701);
+ EmbeddedCB.Text := frxGet(8702);
+ PrintOptCB.Text := frxGet(8703);
+ OutlineCB.Text := frxGet(8704);
+ BackgrCB.Text := frxGet(8705);
+ OpenCB.Text := frxGet(8706);
+ SaveDialog1.Filter := frxGet(8707);
+ SaveDialog1.DefaultExt := frxGet(8708);
+
+ ExportPage.Text := frxGet(107);
+ DocInfoGB.Text := frxGet(8971);
+ InfoPage.Text := frxGet(8972);
+ TitleL.Text := frxGet(8973);
+ AuthorL.Text := frxGet(8974);
+ SubjectL.Text := frxGet(8975);
+ KeywordsL.Text := frxGet(8976);
+ CreatorL.Text := frxGet(8977);
+ ProducerL.Text := frxGet(8978);
+
+ SecurityPage.Text := frxGet(8962);
+ SecGB.Text := frxGet(8979);
+ PermGB.Text := frxGet(8980);
+ OwnPassL.Text := frxGet(8964);
+ UserPassL.Text := frxGet(8965);
+ PrintCB.Text := frxGet(8966);
+ ModCB.Text := frxGet(8967);
+ CopyCB.Text := frxGet(8968);
+ AnnotCB.Text := frxGet(8969);
+
+ ViewerPage.Text := frxGet(8981);
+ ViewerGB.Text := frxGet(8982);
+ HideToolbarCB.Text := frxGet(8983);
+ HideMenubarCB.Text := frxGet(8984);
+ HideWindowUICB.Text := frxGet(8985);
+ FitWindowCB.Text := frxGet(8986);
+ CenterWindowCB.Text := frxGet(8987);
+ PrintScalingCB.Text := frxGet(8988);
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+end;
+
+procedure TfrxPDFExportDialog.PageNumbersEChange(Sender: TObject);
+begin
+ PageNumbersRB.IsChecked := True;
+end;
+
+procedure TfrxPDFExportDialog.PageNumbersEKeyPress(Sender: TObject;
+ var Key: Char);
+begin
+ case key of
+ '0'..'9':;
+ #8, '-', ',':;
+ else
+ key := #0;
+ end;
+end;
+
+procedure TfrxPDFExportDialog.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VK_F1 then
+ frxResources.Help(Self);
+end;
+
+procedure TfrxPDFExportDialog.OkBClick(Sender: TObject);
+begin
+
+end;
+
+{ TfrxPDFFont }
+
+constructor TfrxPDFFont.Create(Font: TFont);
+var
+ dpi: integer;
+begin
+ SourceFont := TFont.Create;
+ dpi := 72;//SourceFont.PixelsPerInch;
+ SourceFont.Assign(Font);
+ FSubstituteName := Font.Family;
+ FDpiFX := 96 / dpi;
+ PDFdpi_divider := 1 / (750 * FDpiFX);
+ SourceFont.Size := Round(750 * FDpiFX);
+ tempBitmap := TBitmap.Create(1,1);
+ Widths := TList.Create;
+ UsedAlphabet := TList.Create;
+ UsedAlphabetUnicode := TList.Create;
+ Saved := false;
+ PackFont := true;
+ FontDataSize := 0;
+ FComposedList := TList.Create;
+ FontData := TMemoryStream.Create;
+ TrueTypeTables := Nil;
+ GetFontFile;
+end;
+
+destructor TfrxPDFFont.Destroy;
+begin
+ Cleanup;
+ SourceFont.Free;
+ Widths.Free;
+ UsedAlphabet.Free;
+ UsedAlphabetUnicode.Free;
+ FComposedList.Free;
+ if Assigned(TrueTypeTables) then
+ TrueTypeTables.Free;
+ inherited;
+end;
+
+procedure TfrxPDFFont.Cleanup;
+begin
+ tempBitmap.Free;
+ Widths.Clear;
+ UsedAlphabet.Clear;
+ UsedAlphabetUnicode.Clear;
+ FComposedList.Clear;
+ if FontData <> nil then
+ begin
+ FontData.Free;
+ FontDataSize := 0;
+ FontData := nil;
+ end;
+end;
+
+
+function TfrxPDFFont.GetGlyphIndices(text: WideString; glyphs: System.PWord; widths: System.PInteger; rtl: boolean): integer;
+var
+ maxGlyphs: Integer;
+// maxItems: Integer;
+ j, len: Integer;
+ tempGlyphs, g1, g2: System.PWord;
+ tempWidths, w1, w2: System.PInteger;
+ FName: String;
+begin
+ FName := FSubstituteName;
+ FName := PdfSubstituteName(FName);
+ if text = '' then
+ result := 0
+ else
+ begin
+ maxGlyphs := Length(text) * 3;
+// maxItems := Length(text) * 2;
+ result := 0;
+ g2 := glyphs;
+ w2 := widths;
+ tempGlyphs := GetMemory(SizeOf(Word) * maxGlyphs);
+ tempWidths := GetMemory(SizeOf(Integer) * maxGlyphs);
+ try
+ len := FCurrentFont.GetGlyphIndices(text, tempGlyphs, tempWidths, rtl, FComposedList);
+ g1 := tempGlyphs;
+ w1 := tempWidths;
+ for j := 1 to len do
+ begin
+ g2^ := g1^;
+ w2^ := w1^;
+ Inc(g1);
+ Inc(g2);
+ Inc(w1);
+ Inc(w2);
+ end;
+ Inc(result, len);
+ finally
+ FreeMemory(tempGlyphs);
+ FreeMemory(tempWidths);
+ end;
+ end;
+end;
+
+procedure TfrxPDFFont.PackFontFile;
+var
+ packed_font: TByteArray;
+ AUsedAlphabet: TList;
+begin
+ if Self.PackFont then
+ begin
+
+ AUsedAlphabet := TList.Create;
+ AUsedAlphabet.Assign(UsedAlphabet, laOr, FComposedList);
+ packed_font := Self.TrueTypeTables.PackFont( SourceFont, AUsedAlphabet , FontData);
+ if packed_font <> nil then
+ begin
+ FontDataSize := Length(packed_font);
+ FontData.Size := FontDataSize;
+{$IFDEF DELPHI18}
+ FontData.WriteData(packed_font, FontDataSize);
+{$ELSE}
+ FontData.Write(packed_font[0], FontDataSize);
+{$ENDIF}
+ FontData.Position := 0;
+ SetLength(packed_font, 0);
+ end;
+ AUsedAlphabet.Free;
+ end;
+end;
+
+procedure TfrxPDFFont.FillOutlineTextMetrix;
+var
+ FName: String;
+begin
+ FName := FSubstituteName;
+ FName := PdfSubstituteName(FName);
+ FCurrentFont.GetOutlineTextMetrics(@TextMetric);
+end;
+
+//move this to font class later
+{$IFDEF MSWINDOWS}
+procedure TfrxPDFFont.GetFontFile;
+var
+ CollectionMode: Cardinal;
+ Name: String;
+ memDC: HDC;
+ fnt: HFONT;
+ fBold: Integer;
+ fItalic: Cardinal;
+begin
+ memDC := CreateCompatibleDC (0);
+ fBold := 0;
+ fItalic := 0;
+ if TFontStyle.fsBold in SourceFont.Style then fBold := 700;
+ if TFontStyle.fsItalic in SourceFont.Style then fItalic := 1;
+ fnt := CreateFont(0, 0, 0, 0, fBold, fItalic, 0, 0, DEFAULT_CHARSET, 0, 0, 0, 0, PWideChar(FSubstituteName));
+ try
+ SelectObject(memDC, fnt);
+ CollectionMode := $66637474;
+ FontDataSize := GetFontData(memDC, CollectionMode, 0, nil, 1);
+
+ if Cardinal(FontDataSize) = High(Cardinal) then
+ begin
+ CollectionMode := 0;
+ FontDataSize := GetFontData(memDC, CollectionMode, 0, nil, 1);
+ end;
+ FontData.SetSize(FontDataSize);
+ if FontData <> nil then
+ begin
+ GetFontData(memDC, CollectionMode, 0, FontData.Memory, FontDataSize);
+ if Assigned(TrueTypeTables) then
+ FreeAndNil(TrueTypeTables);
+ TrueTypeTables := TrueTypeCollection.Create();
+ TrueTypeTables.Initialize(FontData.Memory, FontDataSize);
+
+ Name := PdfSubstituteName(Name);
+
+ FCurrentFont := TrueTypeTables.GetTrueTypeFont(SourceFont);
+ FSubstituteName := FCurrentFont.Names.Item[NameID.FamilyName];
+ end;
+ finally
+ DeleteObject(fnt);
+ DeleteDC(memDC);
+ end;
+end;
+{$ENDIF}
+{$IFDEF MACOS}
+
+function frxCFURLStartAccessingSecurityScopedResource(url: CFURLRef): Boolean;
+var
+ CTLib: HMODULE;
+begin
+ Result := False;
+ if not Assigned(_frxCFURLStartAccessingSecurityScopedResource) then
+ begin
+ CTLib := LoadLibrary(frxCoreFoundationLib);
+ if CTLib <> 0 then
+ begin
+ _frxCFURLStartAccessingSecurityScopedResource := Pointer(GetProcAddress(CTLib, PWideChar(_PFX + 'CFURLStartAccessingSecurityScopedResource'))^);
+ FreeLibrary(CTLib);
+ end;
+ end;
+ if Assigned(_frxCFURLStartAccessingSecurityScopedResource) then
+ Result := _frxCFURLStartAccessingSecurityScopedResource(url);
+end;
+
+procedure frxCFURLStopAccessingSecurityScopedResource(url: CFURLRef);
+var
+ CTLib: HMODULE;
+begin
+ if not Assigned(_frxCFURLStopAccessingSecurityScopedResource) then
+ begin
+ CTLib := LoadLibrary(frxCoreFoundationLib);
+ if CTLib <> 0 then
+ begin
+ _frxCFURLStopAccessingSecurityScopedResource := Pointer(GetProcAddress(CTLib, PWideChar(_PFX + 'CFURLStopAccessingSecurityScopedResource'))^);
+ FreeLibrary(CTLib);
+ end;
+ end;
+ if Assigned(_frxCFURLStopAccessingSecurityScopedResource) then
+ _frxCFURLStopAccessingSecurityScopedResource(url);
+end;
+
+procedure TfrxPDFFont.GetFontFile;
+var
+ FontN, fPath: CFStringRef;
+ FontRef, NewFontRef: CTFontRef;
+ ASFont: ATSFontRef;
+ oFile: FSRef;
+ aURLRef: CFURLRef;
+ StrFilePath: String;
+ Name: String;
+ i: Integer;
+ cerr: CFErrorRef;
+ Status : OSStatus;
+ Accessing: Boolean;
+begin
+ Name := FSubstituteName;
+ Name := PdfSubstituteName(Name);
+ // Name := PrepareFontName(Name, SourceFont, TrueTypeTables);
+
+ Accessing := false;
+ FontN := CFSTR(Name);
+ FontRef := CTFontCreateWithName(FontN, SourceFont.Size, nil);
+ if TFontStyle.fsItalic in SourceFont.Style then
+ begin
+ NewFontRef := CTFontCreateCopyWithSymbolicTraits(FontRef, 0, nil,
+ kCTFontItalicTrait, kCTFontItalicTrait);
+ if NewFontRef <> nil then
+ begin
+ CFRelease(FontRef);
+ FontRef := NewFontRef;
+ end;
+ end;
+ if TFontStyle.fsBold in SourceFont.Style then
+ begin
+ NewFontRef := CTFontCreateCopyWithSymbolicTraits(FontRef, 0, nil,
+ kCTFontBoldTrait, kCTFontBoldTrait);
+ if NewFontRef <> nil then
+ begin
+ CFRelease(FontRef);
+ FontRef := NewFontRef;
+ end;
+ end;
+
+ try
+ ASFont := CTFontGetPlatformFont(FontRef, nil);
+ Status := ATSFontGetFileReference( ASFont, oFile);
+ aURLRef := CFURLCreateFromFSRef(kCFAllocatorDefault, @oFile);
+ aURLRef := CFURLCreateFilePathURL(kCFAllocatorDefault, aURLRef, @cerr);
+ except
+ aURLRef := CFURLRef(CTFontCopyAttribute (FontRef, kCTFontURLAttribute));
+ Accessing := true;
+{$IFDEF Delphi22}
+ CFURLStartAccessingSecurityScopedResource(aURLRef);
+{$ELSE}
+ frxCFURLStartAccessingSecurityScopedResource(aURLRef);
+{$ENDIF}
+ end;
+ fPath := CFURLCopyFileSystemPath(aURLRef, kCFURLPOSIXPathStyle);
+ StrFilePath := ConvCFString(fPath);
+
+ if StrFilePath <> '' then
+ begin
+ // just in case its not a URL to file
+ i := pos('localhost/', StrFilePath);
+ if i > 0 then
+ StrFilePath := Copy(StrFilePath, i + 11, Length(StrFilePath) - i - 10);
+ try
+ FontData.LoadFromFile(StrFilePath);
+ except
+ // use smth when font not found
+ FontData.LoadFromFile('/Library/Fonts/Arial.ttf');
+ end;
+ FontDataSize := FontData.Size;
+ FontData.Position := 0;
+
+ TrueTypeTables := TrueTypeCollection.Create();
+ try
+ TrueTypeTables.Initialize(FontData.Memory, FontData.Size);
+ except
+ on EInvalidTTFFormat do
+ begin
+ // Substitute
+ FontData.Clear;
+ FSubstituteName := 'Arial';
+ GetFontFile;
+ end;
+ end;
+
+ FCurrentFont := TrueTypeTables.GetTrueTypeFont(SourceFont);
+ FSubstituteName := FCurrentFont.Names.Item[NameID.FamilyName];
+ end;
+ if (Accessing) then
+{$IFDEF Delphi22}
+ CFURLStopAccessingSecurityScopedResource(aURLRef);
+{$ELSE}
+ frxCFURLStopAccessingSecurityScopedResource(aURLRef);
+{$ENDIF}
+end;
+{$ENDIF}
+
+{$IFDEF LINUX}
+procedure TfrxPDFFont.GetFontFile;
+var
+ StrFilePath: String;
+ Name, s: String;
+ i: Integer;
+ SkipList: TList;
+begin
+
+ Name := PdfSubstituteName(FSubstituteName);
+
+ SkipList := TList.Create;
+ SkipList.Add(Pointer(TablesID.EmbedBitmapLocation));
+ SkipList.Add(Pointer(TablesID.EmbededBitmapData));
+ SkipList.Add(Pointer(TablesID.HorizontakDeviceMetrix));
+ SkipList.Add(Pointer(TablesID.VerticalDeviceMetrix));
+ SkipList.Add(Pointer(TablesID.DigitalSignature));
+
+ StrFilePath := frxPosixFonts.GetFontPath(SourceFont, Name, SkipList);
+
+ try
+ FontData.LoadFromFile(StrFilePath);
+ except
+ raise Exception.Create('Error. Cant load/find font.');
+ end;
+ FontDataSize := FontData.Size;
+ FontData.Position := 0;
+
+ TrueTypeTables := TrueTypeCollection.Create();
+ TrueTypeTables.Initialize(FontData.Memory, FontData.Size);
+
+ for i := 0 to TrueTypeTables.FontCollection.Count - 1 do
+ begin
+ FCurrentFont := TrueTypeFont(TrueTypeTables.FontCollection[i]);
+ if not FCurrentFont.IsLoaded then
+ FCurrentFont.PrepareFont( SkipList );
+ s := FCurrentFont.Names.Item[NameID.FullName];
+ if s = Name then
+ break;
+ end;
+ SkipList.Free;
+
+ FSubstituteName := FCurrentFont.Names.Item[NameID.FamilyName];
+
+end;
+{$ENDIF}
+
+function TfrxPDFFont.RemapString(str: WideString;
+ rtl: Boolean): WideString;
+var
+ maxGlyphs: Integer;
+ g, g_: System.PWord;
+ w, w_: System.PInteger;
+ actualLength: Integer;
+ i, j: Integer;
+ c: Word;
+ wc: WideChar;
+begin
+ LastRemappedStrWidth := 0;
+ LastRemappedStrSpacesCount := 0;
+ result := '';
+ maxGlyphs := Length(str) * 3;
+ g := GetMemory(SizeOf(Word) * maxGlyphs);
+ w := GetMemory(SizeOf(Integer) * maxGlyphs);
+ tempBitmap.Canvas.BeginScene;
+ try
+ tempBitmap.Canvas.Font.Assign(SourceFont);
+ actualLength := GetGlyphIndices( str, g, w, rtl);
+ g_ := g;
+ w_ := w;
+ for i := 0 to actualLength - 1 do
+ begin
+ c := g_^;
+ Inc(LastRemappedStrWidth, w_^);
+ if actualLength = Length(str) then
+ begin
+ if rtl then
+ j := actualLength - i
+ else
+ j := i + 1;
+ if str[j] = ' ' then
+ Inc(LastRemappedStrSpacesCount);
+ end;
+ if UsedAlphabet.IndexOf(Pointer(c)) = -1 then
+ begin
+ UsedAlphabet.Add(Pointer(c));
+ Widths.Add(Pointer(w_^));
+ if actualLength = Length(str) then
+ begin
+ if rtl then
+ j := actualLength - i
+ else
+ j := i + 1;
+ UsedAlphabetUnicode.Add(Pointer(Word(str[j])));
+ end
+ else
+ UsedAlphabetUnicode.Add(Pointer(TextMetric.otmTextMetrics.tmDefaultChar));
+ end;
+ wc := WideChar(c);
+ result := result + wc;
+ Inc(g_);
+ Inc(w_);
+ end;
+
+ finally
+ FreeMemory(g);
+ FreeMemory(w);
+ tempBitmap.Canvas.EndScene;
+ end;
+
+end;
+
+function TfrxPDFFont.GetFontName: AnsiString;
+var
+ s: AnsiString;
+
+ function HexEncode7F(Str: WideString): AnsiString;
+ var
+ AnStr: AnsiString;
+ s: AnsiString;
+ Index, Len: Integer;
+ begin
+ s := '';
+ AnStr := AnsiString(Str);
+ Len := Length(AnStr);
+ Index := 0;
+ while Index < Len do
+ begin
+ Index := Index + 1;
+ if Byte(AnStr[Index]) > $7F then
+ s := s + '#' + AnsiString(IntToHex(Byte(AnStr[Index]), 2))
+ else
+ s := s + AnsiString(AnStr[Index]);
+ end;
+ Result := s;
+ end;
+
+begin
+{$IFDEF Delphi12}
+ Result := AnsiString(FSubstituteName);
+ Result := StringReplace(Result, AnsiString(' '), AnsiString('#20'), [rfReplaceAll]);
+ Result := StringReplace(Result, AnsiString('('), AnsiString('#28'), [rfReplaceAll]);
+ Result := StringReplace(Result, AnsiString(')'), AnsiString('#29'), [rfReplaceAll]);
+ Result := StringReplace(Result, AnsiString('%'), AnsiString('#25'), [rfReplaceAll]);
+ Result := StringReplace(Result, AnsiString('<'), AnsiString('#3C'), [rfReplaceAll]);
+ Result := StringReplace(Result, AnsiString('>'), AnsiString('#3E'), [rfReplaceAll]);
+ Result := StringReplace(Result, AnsiString('['), AnsiString('#5B'), [rfReplaceAll]);
+ Result := StringReplace(Result, AnsiString(']'), AnsiString('#5D'), [rfReplaceAll]);
+ Result := StringReplace(Result, AnsiString('{'), AnsiString('#7B'), [rfReplaceAll]);
+ Result := StringReplace(Result, AnsiString('}'), AnsiString('#7D'), [rfReplaceAll]);
+ Result := StringReplace(Result, AnsiString('/'), AnsiString('#2F'), [rfReplaceAll]);
+{$ELSE}
+ Result := SourceFont.Name;
+ Result := StringReplace(Result, ' ', '#20', [rfReplaceAll]);
+ Result := StringReplace(Result, '(', '#28', [rfReplaceAll]);
+ Result := StringReplace(Result, ')', '#29', [rfReplaceAll]);
+ Result := StringReplace(Result, '%', '#25', [rfReplaceAll]);
+ Result := StringReplace(Result, '<', '#3C', [rfReplaceAll]);
+ Result := StringReplace(Result, '>', '#3E', [rfReplaceAll]);
+ Result := StringReplace(Result, '[', '#5B', [rfReplaceAll]);
+ Result := StringReplace(Result, ']', '#5D', [rfReplaceAll]);
+ Result := StringReplace(Result, '{', '#7B', [rfReplaceAll]);
+ Result := StringReplace(Result, '}', '#7D', [rfReplaceAll]);
+ Result := StringReplace(Result, '/', '#2F', [rfReplaceAll]);
+{$ENDIF}
+ if frxPDFFontsNeedStyleSimulation.IndexOf(FSubstituteName) = -1 then
+ begin
+ s := '';
+ if fsBold in SourceFont.Style then
+ s := s + 'Bold';
+ if fsItalic in SourceFont.Style then
+ s := s + 'Italic';
+ if s <> '' then
+ Result := Result + ',' + s;
+ end;
+{$IFDEF Delphi12}
+ Result := HexEncode7F(String(Result));
+{$ELSE}
+ Result := HexEncode7F(Result);
+{$ENDIF}
+end;
+
+{ TfrxPDFRun }
+
+constructor TfrxPDFRun.Create(t: WideString; a: SCRIPT_ANALYSIS);
+begin
+ text := t;
+ analysis := a;
+end;
+
+initialization
+ frxPDFFontsNeedStyleSimulation := TStringList.Create;
+ frxPDFFontsNeedStyleSimulation.Add(#$FF2D#$FF33#$0020#$30B4#$30B7#$30C3#$30AF);
+ frxPDFFontsNeedStyleSimulation.Add(#$FF2D#$FF33#$0020#$FF30#$30B4#$30B7#$30C3#$30AF);
+ frxPDFFontsNeedStyleSimulation.Add(#$FF2D#$FF33#$0020#$660E#$671D);
+ frxPDFFontsNeedStyleSimulation.Add(#$FF2D#$FF33#$0020#$FF30#$660E#$671D);
+ frxPDFFontsNeedStyleSimulation.Add('MS UI Gothic');
+ frxPDFFontsNeedStyleSimulation.Add('Arial Unicode MS');
+ // doesn't have Italic
+ //frxPDFFontsNeedStyleSimulation.Add('Tahoma');
+
+finalization
+ frxPDFFontsNeedStyleSimulation.Free;
+
+end.
diff --git a/LibD28/FMX.frxExportRTF.fmx b/LibD28/FMX.frxExportRTF.fmx
new file mode 100644
index 0000000..3702f7a
--- /dev/null
+++ b/LibD28/FMX.frxExportRTF.fmx
@@ -0,0 +1,189 @@
+object frxRTFExportDialog: TfrxRTFExportDialog
+ Left = 295
+ Top = 193
+ Caption = 'Export to RTF'
+ ClientHeight = 278
+ ClientWidth = 277
+ Position = poScreenCenter
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ Left = 295
+ Top = 193
+ object OkB: TButton
+ Default = True
+ DisableFocusEffect = False
+ Height = 25.000000000000000000
+ ModalResult = 1
+ Position.X = 118.000000000000000000
+ Position.Y = 247.000000000000000000
+ Text = 'OK'
+ Width = 75.000000000000000000
+ end
+ object CancelB: TButton
+ Cancel = True
+ DisableFocusEffect = False
+ Height = 25.000000000000000000
+ ModalResult = 2
+ Position.X = 198.000000000000000000
+ Position.Y = 247.000000000000000000
+ Text = 'Cancel'
+ Width = 75.000000000000000000
+ end
+ object GroupPageRange: TGroupBox
+ Height = 121.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 4.000000000000000000
+ Text = ' Page range '
+ Width = 269.000000000000000000
+ object DescrL: TLabel
+ Height = 29.000000000000000000
+ Position.X = 12.000000000000000000
+ Position.Y = 82.000000000000000000
+ Text =
+ 'Enter page numbers and/or page ranges, separated by commas. For ' +
+ 'example, 1,3,5-12'
+ Width = 249.000000000000000000
+ end
+ object AllRB: TRadioButton
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ HelpContext = 108
+ IsChecked = True
+ Position.X = 12.000000000000000000
+ Position.Y = 20.000000000000000000
+ TabOrder = 0
+ Text = 'All'
+ Width = 153.000000000000000000
+ end
+ object CurPageRB: TRadioButton
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ HelpContext = 118
+ Position.X = 12.000000000000000000
+ Position.Y = 40.000000000000000000
+ TabOrder = 1
+ Text = 'Current page'
+ Width = 153.000000000000000000
+ end
+ object PageNumbersRB: TRadioButton
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ HelpContext = 124
+ Position.X = 12.000000000000000000
+ Position.Y = 60.000000000000000000
+ TabOrder = 2
+ Text = 'Pages:'
+ Width = 77.000000000000000000
+ end
+ object PageNumbersE: TEdit
+ TabOrder = 3
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ Password = False
+ Position.X = 92.000000000000000000
+ Position.Y = 58.000000000000000000
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 133
+ OnChange = PageNumbersEChange
+ OnKeyDown = PageNumbersEKeyDown
+ end
+ end
+ object GroupQuality: TGroupBox
+ Height = 93.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 128.000000000000000000
+ Text = ' Quality properties '
+ Width = 269.000000000000000000
+ object HeadFootL: TLabel
+ Height = 13.000000000000000000
+ Position.X = 12.000000000000000000
+ Position.Y = 65.000000000000000000
+ Text = 'Page headers/footers'
+ Width = 121.000000000000000000
+ end
+ object WCB: TCheckBox
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ IsChecked = True
+ Position.X = 140.000000000000000000
+ Position.Y = 20.000000000000000000
+ TabOrder = 0
+ Text = 'WYSIWYG'
+ Width = 121.000000000000000000
+ end
+ object PageBreaksCB: TCheckBox
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ IsChecked = True
+ Position.X = 12.000000000000000000
+ Position.Y = 40.000000000000000000
+ TabOrder = 1
+ Text = 'Page breaks'
+ Width = 121.000000000000000000
+ end
+ object PicturesCB: TCheckBox
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ IsChecked = True
+ Position.X = 12.000000000000000000
+ Position.Y = 20.000000000000000000
+ TabOrder = 2
+ Text = 'Pictures'
+ Width = 121.000000000000000000
+ end
+ object ContinuousCB: TCheckBox
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ IsChecked = True
+ Position.X = 140.000000000000000000
+ Position.Y = 40.000000000000000000
+ TabOrder = 3
+ Text = 'Continuous'
+ Width = 121.000000000000000000
+ end
+ object PColontitulCB: TComboBox
+ DisableFocusEffect = False
+ Height = 21.000000000000000000
+ ItemIndex = -1
+ ListBoxResource = 'transparentlistboxstyle'
+ Position.X = 140.000000000000000000
+ Position.Y = 62.000000000000000000
+ TabOrder = 4
+ Width = 109.000000000000000000
+ object ListBoxItem1: TListBoxItem
+ Height = 19.000000000000000000
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Text'
+ Width = 19.000000000000000000
+ end
+ object ListBoxItem2: TListBoxItem
+ Height = 19.000000000000000000
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'Headers/Footers'
+ Width = 19.000000000000000000
+ end
+ object ListBoxItem3: TListBoxItem
+ Height = 19.000000000000000000
+ Position.X = 5000.000000000000000000
+ Position.Y = 5000.000000000000000000
+ Text = 'None'
+ Width = 19.000000000000000000
+ end
+ end
+ end
+ object OpenCB: TCheckBox
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ IsChecked = True
+ Position.X = 12.000000000000000000
+ Position.Y = 225.000000000000000000
+ Text = 'Open after export'
+ Width = 257.000000000000000000
+ end
+ object SaveDialog1: TSaveDialog
+ Options = [ofHideReadOnly, ofNoChangeDir, ofEnableSizing]
+ end
+end
diff --git a/LibD28/FMX.frxExportRTF.pas b/LibD28/FMX.frxExportRTF.pas
new file mode 100644
index 0000000..5a82215
--- /dev/null
+++ b/LibD28/FMX.frxExportRTF.pas
@@ -0,0 +1,991 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ RTF export filter }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Fediachov, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxExportRTF;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Types, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.frxExportMatrix, FMX.frxProgress, fmx.frxImageConverter, System.UIConsts,
+ System.Variants, FMX.Edit, FMX.ListBox, FMX.frxGraphicUtils, FMX.frxBaseModalForm
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+type
+ TfrxHeaderFooterMode = (hfText, hfPrint, hfNone);
+
+ TfrxRTFExportDialog = class(TfrxForm)
+ OkB: TButton;
+ CancelB: TButton;
+ GroupPageRange: TGroupBox;
+ DescrL: TLabel;
+ AllRB: TRadioButton;
+ CurPageRB: TRadioButton;
+ PageNumbersRB: TRadioButton;
+ PageNumbersE: TEdit;
+ GroupQuality: TGroupBox;
+ WCB: TCheckBox;
+ PageBreaksCB: TCheckBox;
+ PicturesCB: TCheckBox;
+ OpenCB: TCheckBox;
+ SaveDialog1: TSaveDialog;
+ ContinuousCB: TCheckBox;
+ HeadFootL: TLabel;
+ PColontitulCB: TComboBox;
+ ListBoxItem1: TListBoxItem;
+ ListBoxItem2: TListBoxItem;
+ ListBoxItem3: TListBoxItem;
+ procedure FormCreate(Sender: TObject);
+ procedure PageNumbersEChange(Sender: TObject);
+ procedure PageNumbersEKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+ end;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxRTFExport = class(TfrxCustomExportFilter)
+ private
+ FColorTable: TStringList;
+ FCurrentPage: Integer;
+ FDataList: TList;
+ FExportPageBreaks: Boolean;
+ FExportPictures: Boolean;
+ FFirstPage: Boolean;
+ FFontTable: TStringList;
+ FCharsetTable: TStringList;
+ FMatrix: TfrxIEMatrix;
+ FOpenAfterExport: Boolean;
+ FProgress: TfrxProgress;
+ FWysiwyg: Boolean;
+ FCreator: String;
+ FHeaderFooterMode: TfrxHeaderFooterMode;
+ FAutoSize: Boolean;
+ FPictureType: TfrxPictureType;
+
+ function TruncReturns(const Str: WideString): WideString;
+ function GetRTFBorders(const Style: TfrxIEMStyle): string;
+ function GetRTFColor(const c: TAlphaColor): string;
+ function GetRTFFontStyle(const f: TFontStyles): String;
+ function GetRTFFontColor(const f: String): String;
+ function GetRTFFontName(const f: String; const charset: Integer): String;
+ function GetRTFHAlignment(const HAlign: TfrxHAlign) : String;
+ function GetRTFVAlignment(const VAlign: TfrxVAlign) : String;
+ function StrToRTFSlash(const Value: WideString): WideString;
+ function StrToRTFUnicodeEx(const Value: WideString): String;
+ function StrToRTFUnicode(const Value: WideString): String;
+ procedure ExportPage(const Stream: TStream);
+ procedure PrepareExport;
+ procedure SaveGraphic(Graphic: TBitmap; Stream: TStream;
+ Width, Height: Extended; PicType: TfrxPictureType);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ function ShowModal: TModalResult; override;
+ function Start: boolean; override;
+ procedure Finish; override;
+ procedure FinishPage(Page: TfrxReportPage; Index: Integer); override;
+ procedure StartPage(Page: TfrxReportPage; Index: Integer); override;
+ procedure ExportObject(Obj: TfrxComponent); override;
+ published
+ property PictureType: TfrxPictureType read FPictureType write FPictureType;
+ property ExportPageBreaks: Boolean read FExportPageBreaks write FExportPageBreaks default True;
+ property ExportPictures: Boolean read FExportPictures write FExportPictures default True;
+ property OpenAfterExport: Boolean read FOpenAfterExport write FOpenAfterExport default False;
+ property Wysiwyg: Boolean read FWysiwyg write FWysiwyg;
+ property Creator: String read FCreator write FCreator;
+ property SuppressPageHeadersFooters;
+ property HeaderFooterMode: TfrxHeaderFooterMode read FHeaderFooterMode write FHeaderFooterMode;
+ property AutoSize: Boolean read FAutoSize write FAutoSize;
+ property OverwritePrompt;
+ end;
+
+
+implementation
+
+uses
+ FMX.frxUtils, FMX.frxRes, FMX.frxrcExports, FMX.frxFMX
+{$IFDEF MSWINDOWS}
+, Winapi.ShellAPI
+{$ENDIF}
+{$IFDEF LINUX}
+ ,FMUX.Api
+{$ENDIF}
+{$IFDEF MACOS}
+, Posix.Stdlib
+{$ENDIF};
+
+{$R *.fmx}
+
+const
+ Xdivider = 15.05;
+ Ydivider = 15;
+ Ydivider_last = 14.5;
+ PageDivider = 15.02;
+ MargDivider = 56.48;
+ FONT_DIVIDER = 15;
+ IMAGE_DIVIDER = 25.3;
+ SW_SHOW = 5;
+
+
+{ TfrxRTFExport }
+
+constructor TfrxRTFExport.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ ShowDialog := True;
+ FExportPageBreaks := True;
+ FExportPictures := True;
+ FWysiwyg := True;
+ FHeaderFooterMode := hfText;
+ FAutoSize := False;
+ FCreator := 'FastReport';
+ FilterDesc := frxGet(8504);
+ DefaultExt := frxGet(8505);
+end;
+
+class function TfrxRTFExport.GetDescription: String;
+begin
+ Result := frxResources.Get('RTFexport');
+end;
+
+function TfrxRTFExport.TruncReturns(const Str: WideString): WideString;
+var
+ l: Integer;
+begin
+ l := Length(Str);
+ if (l > 1) and (Str[l - 1] = #13) and (Str[l] = #10) then
+ Result := Copy(Str, 1, l - 2)
+ else
+ Result := Str;
+end;
+
+function TfrxRTFExport.StrToRTFSlash(const Value: WideString): WideString;
+var
+ i: integer;
+begin
+ result := '';
+ for i := 1 to Length(Value) do
+ begin
+ if Value[i] = '\' then
+ result := result + '\\'
+ else if Value[i] = '{' then
+ result := result + '\{'
+ else if Value[i] = '}' then
+ result := result + '\}'
+ else if (Value[i] = #13) and (i < (Length(Value) - 1)) and (Value[i + 1] = #10) then
+ result := result + '\line'#13
+ else
+ result := result + Value[i];
+ end;
+end;
+
+function TfrxRTFExport.StrToRTFUnicodeEx(const Value: WideString): String;
+var
+ s: WideString;
+begin
+ s := StrToRTFSlash(Value);
+ Result := StrToRTFUnicode(s);
+end;
+
+function TfrxRTFExport.StrToRTFUnicode(const Value: WideString): String;
+var
+ i: integer;
+ pwc: ^Word;
+begin
+ result := '';
+ for i := 1 to Length(Value) do
+ begin
+ pwc := @Value[i];
+ if pwc^ > 127 then
+ result := result + '\u' + IntToStr(pwc^) + '\''3f'
+ else
+ result := result + Chr(pwc^);
+ end;
+end;
+
+function TfrxRTFExport.GetRTFBorders(const Style: TfrxIEMStyle): string;
+var
+ brdrw: String;
+ brdrc: String;
+ brdrs: String;
+begin
+{$IFNDEF FR_DEBUG}
+ Result := '';
+ brdrw := '\brdrs\brdrw' + IntToStr(Round(Style.FrameWidth * 20));
+ brdrc := '\brdrcf' + GetRTFFontColor(GetRTFColor(Style.FrameColor));
+ if Style.FrameStyle = fsDouble then
+ brdrs := '\brdrdb'
+ else if Style.FrameStyle <> fsSolid then
+ brdrs := '\brdrdashsm'
+ else brdrs := '';
+ if ftTop in Style.FrameTyp then
+ Result := Result + '\clbrdrt' + brdrw + brdrc + brdrs;
+ if ftLeft in Style.FrameTyp then
+ Result := Result + '\clbrdrl' + brdrw + brdrc + brdrs;
+ if ftBottom in Style.FrameTyp then
+ Result := Result + '\clbrdrb' + brdrw + brdrc + brdrs;
+ if ftRight in Style.FrameTyp then
+ Result := Result + '\clbrdrr' + brdrw + brdrc + brdrs;
+{$ELSE}
+ Result := '';
+ brdrw := '\brdrs\brdrw' + IntToStr(Round(Style.FrameWidth * 20));
+ brdrc := '\brdrcf' + GetRTFFontColor(GetRTFColor(Style.FrameColor));
+ brdrs := '';
+ Result := Result + '\clbrdrt' + brdrw + brdrc + brdrs;
+ Result := Result + '\clbrdrl' + brdrw + brdrc + brdrs;
+ Result := Result + '\clbrdrb' + brdrw + brdrc + brdrs;
+ Result := Result + '\clbrdrr' + brdrw + brdrc + brdrs;
+{$ENDIF}
+end;
+
+function TfrxRTFExport.GetRTFColor(const c: TAlphaColor): string;
+begin
+ if c = claNull then
+ Result := '\red255\green255\blue255;'
+ else
+ Result := '\red' + IntToStr(TAlphaColorRec(c).R) +
+ '\green' + IntToStr(TAlphaColorRec(c).G) +
+ '\blue' + IntToStr(TAlphaColorRec(c).B) + ';'
+end;
+
+function TfrxRTFExport.GetRTFFontStyle(const f: TFontStyles): String;
+begin
+ Result := '';
+ if fsItalic in f then Result := '\i';
+ if fsBold in f then Result := Result + '\b';
+ if fsUnderline in f then Result := Result + '\ul';
+end;
+
+function TfrxRTFExport.GetRTFFontColor(const f: String): String;
+var
+ i: Integer;
+begin
+ i := FColorTable.IndexOf(f);
+ if i <> -1 then
+ Result := IntToStr(i + 1)
+ else
+ begin
+ FColorTable.Add(f);
+ Result := IntToStr(FColorTable.Count);
+ end;
+end;
+
+function TfrxRTFExport.GetRTFFontName(const f: String; const Charset: Integer): String;
+var
+ i: Integer;
+begin
+ i := FFontTable.IndexOf(f);
+ if i <> -1 then
+ Result := IntToStr(i)
+ else
+ begin
+ FFontTable.Add(f);
+ FCharsetTable.Add(IntToStr(charset));
+ Result := IntToStr(FFontTable.Count - 1);
+ end;
+end;
+
+function TfrxRTFExport.GetRTFHAlignment(const HAlign: TfrxHAlign) : String;
+begin
+ case HAlign of
+ haLeft: Result := '\ql';
+ haRight: Result := '\qr';
+ haCenter: Result := '\qc';
+ haBlock: Result := '\qj';
+ else Result := '\ql';
+ end;
+end;
+
+function TfrxRTFExport.GetRTFVAlignment(const VAlign: TfrxVAlign) : String;
+begin
+ if (VAlign = vaTop) then Result := '\clvertalt'
+ else if (VAlign = vaCenter) then Result := '\clvertalc'
+ else if (VAlign = vaBottom) then Result := '\clvertalb'
+ else Result := '\clvertalt';
+end;
+
+procedure TfrxRTFExport.PrepareExport;
+var
+ i: Integer;
+ Obj: TfrxIEMObject;
+begin
+ for i := 0 to FMatrix.GetObjectsCount - 1 do
+ begin
+ Obj := FMatrix.GetObjectById(i);
+ Obj.Counter := -1;
+
+ GetRTFFontColor(GetRTFColor(Obj.Style.Color));
+ GetRTFFontColor(GetRTFColor(Obj.Style.FrameColor));
+
+ if Obj.IsText then
+ begin
+ GetRTFFontColor(GetRTFColor(Obj.Style.Font.Color));
+ GetRTFFontName(Obj.Style.Font.Name, Obj.Style.Charset);
+ end;
+ end;
+end;
+
+procedure TfrxRTFExport.ExportPage(const Stream: TStream);
+var
+ i, j, x, y, fx, fy, dx, dy, n1, pbk: Integer;
+ YDiv: Extended;
+ dcol, drow, xoffs: Integer;
+ buff, s, s1, s2: String;
+ st, st1: WideString;
+ CellsLine: AnsiString;
+ Obj: TfrxIEMObject;
+ ObjBounds: TfrxRect;
+ ObjWidth, ObjHeight: Extended;
+ Graphic: TBitmap;
+// Str,
+ CellsStream: TStream;
+// bArr: array[0..1023] of Byte;
+ FMode: Integer; // 3 - header, 2 - footer, 1 - body, 0 - stop
+ FHTMLTags: TfrxHTMLTagsList;
+ Tag: TfrxHTMLTag;
+
+ TagFColor: TAlphaColor;
+ TagFStyleB, TagFStyleU, TagFStyleI: Integer;
+
+ procedure WriteExpLn(const str: string);
+ var
+ TemsStr: AnsiString;
+ begin
+ TemsStr := AnsiString(str);
+ if Length(TemsStr) > 0 then
+ begin
+ Stream.Write(TemsStr[1], Length(TemsStr));
+ Stream.Write(AnsiString(#13#10), 2);
+ end;
+ end;
+
+ procedure SetPageProp(Page: Integer);
+ var
+ s: String;
+ begin
+ s := '\pgwsxn' + IntToStr(Round(FMatrix.GetPageWidth(Page) * PageDivider)) +
+ '\pghsxn' + IntToStr(Round(FMatrix.GetPageHeight(Page) * PageDivider)) +
+ '\marglsxn' + IntToStr(Round(FMatrix.GetPageLMargin(Page) * MargDivider)) +
+ '\margrsxn' + IntToStr(Round(FMatrix.GetPageRMargin(Page) * MargDivider)) +
+ '\margtsxn' + IntToStr(Round(FMatrix.GetPageTMargin(Page) * MargDivider)) +
+ '\margbsxn' + IntToStr(Round(FMatrix.GetPageBMargin(Page) * MargDivider));
+ WriteExpLn(s);
+ if FMatrix.GetPageOrientation(Page) = poLandscape then
+ WriteExpLn('\lndscpsxn');
+ end;
+
+begin
+ PrepareExport;
+ WriteExpLn('{\rtf1\ansi');
+ s := '{\fonttbl';
+ for i := 0 to FFontTable.Count - 1 do
+ begin
+ s1 := '{\f' + IntToStr(i) + '\fcharset' + FCharsetTable[i] + ' ' + FFontTable[i] + '}';
+ if Length(s + s1) < 255 then
+ s := s + s1
+ else
+ begin
+ WriteExpLn(s);
+ s := s1;
+ end;
+ end;
+ s := s + '}';
+ WriteExpLn(s);
+ s := '{\colortbl;';
+ for i := 0 to FColorTable.Count - 1 do
+ begin
+ s1 := FColorTable[i];
+ if Length(s + s1) < 255 then
+ s := s + s1
+ else
+ begin
+ WriteExpLn(s);
+ s := s1;
+ end;
+ end;
+ s := s + '}';
+ WriteExpLn(s);
+ WriteExpLn('{\info{\title ' + StrToRTFUnicodeEx(Report.ReportOptions.Name) +
+ '}{\author ' + StrToRTFUnicodeEx(FCreator) +
+ '}{\creatim\yr' + FormatDateTime('yyyy', CreationTime) +
+ '\mo' + FormatDateTime('mm', CreationTime) +
+ '\dy' + FormatDateTime('dd', CreationTime) +
+ '\hr' + FormatDateTime('hh', CreationTime) +
+ '\min' + FormatDateTime('nn', CreationTime) + '}}');
+ if ShowProgress then
+ FProgress.Execute(FMatrix.Height - 1, frxResources.Get('ProgressWait'), True, True);
+ pbk := 0;
+ SetPageProp(pbk);
+
+ if FHeaderFooterMode = hfPrint then
+ FMode := 3
+ else
+ FMode := 1;
+///
+ YDiv := Ydivider;
+ while FMode > 0 do
+ begin
+ if FMode = 3 then
+ WriteExpLn('{\header ')
+ else if FMode = 2 then
+ WriteExpLn('{\footer ');
+
+ if FMatrix.PagesCount = 1 then
+ YDiv := Ydivider_last;
+
+ for y := 0 to FMatrix.Height - 2 do
+ begin
+ if ShowProgress then
+ begin
+ FProgress.Tick;
+ if FProgress.Terminated then
+ break;
+ end;
+ if FExportPageBreaks and (FMode = 1) then
+ if pbk < FMatrix.PagesCount then
+ if FMatrix.GetPageBreak(pbk) <= FMatrix.GetYPosById(y) then
+ begin
+ WriteExpLn('\pard\sect');
+ Inc(pbk);
+ if pbk < FMatrix.PagesCount then
+ SetPageProp(pbk);
+ if pbk = FMatrix.PagesCount - 1 then
+ YDiv := Ydivider_last;
+ continue;
+ end;
+ drow := Round((FMatrix.GetYPosById(y + 1) - FMatrix.GetYPosById(y)) * YDiv);
+ if FAutoSize then
+ buff := '\trrh'
+ else
+ buff := '\trrh-';
+ buff := buff + IntToStr(drow) + '\trgaph15';
+ CellsStream := TMemoryStream.Create;
+ try
+ xoffs := Round(FMatrix.GetXPosById(0)) + Round(FMatrix.GetPageLMargin(pbk) * MargDivider / Xdivider);
+ for x := 1 to FMatrix.Width - 2 do
+ begin
+ i := FMatrix.GetCell(x, y);
+ if (i <> -1) then
+ begin
+ Obj := FMatrix.GetObjectById(i);
+
+ ObjBounds := FMatrix.GetObjectBounds(Obj);
+ ObjWidth := ObjBounds.Right - ObjBounds.Left;
+ ObjHeight := ObjBounds.Bottom - ObjBounds.Top;
+
+ if (FMode = 3) and (not Obj.Header) then
+ Continue;
+ if (FMode = 2) and (not Obj.Footer) then
+ Continue;
+ if (FMode = 1) and (Obj.Header or Obj.Footer) and
+ ((FHeaderFooterMode = hfPrint) or
+ (FHeaderFooterMode = hfNone)) then
+ Continue;
+
+ FMatrix.GetObjectPos(i, fx, fy, dx, dy);
+ if Obj.Counter = -1 then
+ begin
+ if dy > 1 then
+ buff := buff + '\clvmgf';
+ if (obj.Style.Color mod 16777216) <> $FFFFFF then
+ buff := buff + '\clcbpat' + GetRTFFontColor(GetRTFColor(Obj.Style.Color));
+
+ buff := buff + GetRTFVAlignment(Obj.Style.VAlign) + GetRTFBorders(Obj.Style) + '\cltxlrtb';
+ dcol := Round((ObjBounds.Right - xoffs) * Xdivider);
+ buff := buff + '\cellx' + IntToStr(dcol);
+ if Obj.IsText then
+ begin
+ s := '\f' + GetRTFFontName(Obj.Style.Font.Name, Obj.Style.Charset);
+ s := s + '\fs' + IntToStr(Round(Obj.Style.Font.Size * 2));
+ s := s + GetRTFFontStyle(Obj.Style.Font.Style);
+ s := s + '\cf' + GetRTFFontColor(GetRTFColor(Obj.Style.Font.Color));
+
+ // export HTML tags
+ if Obj.HTMLTags then
+ begin
+ FHTMLTags := TfrxHTMLTagsList.Create;
+ try
+ FHTMLTags.SetDefaults(Obj.Style.Font.Color, Round(Obj.Style.Font.Size), Obj.Style.Font.Style);
+ FHTMLTags.AllowTags := True;
+ st := StrToRTFSlash(TruncReturns(Obj.Memo.Text));
+ st1 := st;
+ s1 := '';
+
+ TagFColor := Obj.Style.Color;
+ TagFStyleB := 0;
+ TagFStyleU := 0;
+ TagFStyleI := 0;
+
+ FHTMLTags.ExpandHTMLTags(st);
+ for i := 0 to FHTMLTags.Count - 1 do
+ for j := 0 to FHTMLTags[i].Count - 1 do
+ begin
+ Tag := FHTMLTags[i].Items[j];
+
+ // bold tags
+ if (fsBold in Tag.Style) and (TagFStyleB = 0) then
+ begin
+ Inc(TagFStyleB);
+ s1 := s1 + '\b ';
+ end;
+ if (TagFStyleB > 0) and (not (fsBold in Tag.Style)) then
+ begin
+ Dec(TagFStyleB);
+ s1 := s1 + '\b0 ';
+ end;
+
+ // italic tags
+ if (fsItalic in Tag.Style) and (TagFStyleI = 0) then
+ begin
+ Inc(TagFStyleI);
+ s1 := s1 + '\i ';
+ end;
+ if (TagFStyleI > 0) and (not (fsItalic in Tag.Style)) then
+ begin
+ Dec(TagFStyleI);
+ s1 := s1 + '\i0 ';
+ end;
+
+ // underline tags
+ if (fsUnderline in Tag.Style) and (TagFStyleU = 0) then
+ begin
+ Inc(TagFStyleU);
+ s1 := s1 + '\ul ';
+ end;
+ if (TagFStyleU > 0) and (not (fsUnderline in Tag.Style)) then
+ begin
+ Dec(TagFStyleU);
+ s1 := s1 + '\ul0 ';
+ end;
+
+ // color tags
+ if (Tag.Color <> Obj.Style.Font.Color) and (Tag.Color <> TagFColor) then
+ begin
+ TagFColor := Tag.Color;
+ s1 := s1 + '\cf' + GetRTFFontColor(GetRTFColor(TagFColor)) + ' ';
+ end;
+ if (Tag.Color <> TagFColor) then
+ begin
+ TagFColor := Tag.Color;
+ s1 := s1 + '\cf' + GetRTFFontColor(GetRTFColor(TagFColor)) + ' ';
+ end;
+
+ s1 := s1 + StrToRTFUnicode(st1[Tag.Position]);
+
+ end;
+ s1 := s1 + '\plain';
+ finally
+ FHTMLTags.Free;
+ end;
+ end
+ else
+ s1 := StrToRTFUnicodeEx(TruncReturns(Obj.Memo.Text));
+
+ if Trim(s1) <> '' then
+ begin
+ s2 := '';
+ if not Obj.IsRichText then
+ begin
+ j := Round(Obj.Style.CharSpacing * FONT_DIVIDER);
+ if (Obj.Style.GapY + Obj.Style.LineSpacing - 1) > 0 then
+ n1 := Round((Obj.Style.GapY + Obj.Style.LineSpacing - 1) * YDiv)
+ else
+ n1 := 0;
+ s2 := '\sb' + IntToStr(n1) +
+ '\li' + IntToStr(Round((Obj.Style.GapX / 2) * Xdivider)) +
+ '\fi' + IntToStr(Round((Obj.Style.ParagraphGap) * Xdivider)) +
+ '\expnd' + IntToStr(j div 5) + '\expndtw' + IntToStr(j) +
+ '\sl-' + IntToStr(Round((Obj.Style.Font.Size * 96 / 72 + Obj.Style.LineSpacing) * YDiv * 0.98)) +
+ '\slmult0';
+ if Obj.Style.WordBreak then
+ s2 := s2 + '\hyphauto1\hyphcaps1';
+ end
+ end;
+ CellsLine := AnsiString(GetRTFHAlignment(Obj.Style.HAlign) +
+ '{' + s + s2 + ' ' + s1 + '\cell}');
+ s := '\par'#13#10'\cell';
+ while Pos(AnsiString(s), CellsLine) > 0 do
+ CellsLine := AnsiString(StringReplace(String(CellsLine), s, '\cell', []));
+ CellsStream.Write(CellsLine[1], Length(CellsLine));
+ end
+ else if FExportPictures then
+ begin
+ Graphic := Obj.Image;
+ if (Graphic <> nil) and (Graphic.Width <> 0) and (Graphic.Height <> 0) then
+ SaveGraphic(Graphic, CellsStream, ObjWidth, ObjHeight, PictureType)
+ end;
+ Obj.Counter := y + 1;
+ end
+ else
+ begin
+ if (dy > 1) and (Obj.Counter <> (y + 1)) then
+ begin
+ buff := buff + '\clvmrg';
+ buff := buff + GetRTFBorders(Obj.Style) + '\cltxlrtb';
+ dcol := Round((ObjBounds.Right - xoffs) * Xdivider);
+ buff := buff + '\cellx' + IntToStr(dcol);
+ j := drow div FONT_DIVIDER;
+ if j > 20 then
+ j := 20;
+ CellsLine := '{\fs' + AnsiString(IntToStr(j)) + '\cell}';
+ CellsStream.Write(CellsLine[1], Length(CellsLine));
+ Obj.Counter := y + 1;
+ end;
+ end
+ end
+ end;
+ if CellsStream.Size > 0 then
+ begin
+ s := '\trowd' + buff + '\pard\intbl';
+ WriteExpLn(s);
+ Stream.CopyFrom(CellsStream, 0);
+ WriteExpLn('\pard\intbl{\trowd' + buff + '\row}');
+ end;
+ finally
+ CellsStream.Free;
+ end;
+ end;
+ if FMode in [2, 3] then
+ WriteExpLn('}');
+ Dec(FMode);
+ end;
+ WriteExpLn('}');
+end;
+
+procedure TfrxRTFExport.SaveGraphic(Graphic: TBitmap; Stream: TStream;
+ Width, Height: Extended; PicType: TfrxPictureType);
+var
+ Blip: TStream;
+ CellsLine: AnsiString;
+ n1, n, j: Integer;
+ s: AnsiString;
+ bArr: array[0..1023] of Byte;
+ BlipType: AnsiString;
+begin
+ Blip := TMemoryStream.Create;
+
+ try
+ case PicType of
+ gpJPG:
+ begin
+ BlipType := 'jpegblip';
+ SaveGraphicAs(Graphic, Blip, gpJPG);
+ end
+
+ else
+ begin
+ BlipType := 'pngblip';
+ SaveGraphicAs(Graphic, Blip, gpPNG);
+ end;
+ end;
+
+ CellsLine := '{\sb0\li0\sl0\slmult0 {\pict\picw' +
+ AnsiString(FloatToStr(Round(Width * IMAGE_DIVIDER))) +
+ '\pich' +
+ AnsiString(FloatToStr(Round(Height * IMAGE_DIVIDER))) +
+ '\picscalex98\picscaley98\piccropl0\piccropr0\piccropt0\piccropb0\' +
+ BlipType +
+ #13#10;
+ Stream.Write(CellsLine[1], Length(CellsLine));
+
+ { todo: Rewrite slow code.
+ This code splits the Blip stream into 64-byte chunks,
+ converts each byte to 2 hex-dgits, appends each chunk with CRLF
+ and writes them all to Stream. }
+
+ Blip.Position := 0;
+ n1 := 0; s := '';
+ repeat
+ n := Blip.Read(bArr[0], 1024);
+ for j := 0 to n - 1 do
+ begin
+ s := s + AnsiString(IntToHex(bArr[j], 2));
+ Inc(n1);
+ if n1 > 63 then
+ begin
+ n1 := 0;
+ CellsLine := s + AnsiString(#13#10);
+ Stream.Write(CellsLine[1], Length(CellsLine));
+ s := '';
+ end;
+ end;
+ until n < 1024;
+ if n1 <> 0 then
+ begin
+ CellsLine := s + AnsiString(#13#10);
+ Stream.Write(CellsLine[1], Length(CellsLine));
+ end;
+ CellsLine := '}\cell}' + #13#10;
+ Stream.Write(CellsLine[1], Length(CellsLine));
+ finally
+ Blip.Free
+ end;
+end;
+
+function TfrxRTFExport.ShowModal: TModalResult;
+begin
+ if not Assigned(Stream) then
+ begin
+ with TfrxRTFExportDialog.Create(nil) do
+ begin
+ OpenCB.Visible := not SlaveExport;
+ if OverwritePrompt then
+ SaveDialog1.Options := SaveDialog1.Options + [TOpenOption.ofOverwritePrompt];
+ if SlaveExport then
+ FOpenAfterExport := False;
+
+ if (FileName = '') and (not SlaveExport) then
+ SaveDialog1.FileName := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(Report.FileName)), SaveDialog1.DefaultExt)
+ else
+ SaveDialog1.FileName := FileName;
+
+ ContinuousCB.IsChecked := SuppressPageHeadersFooters;
+ PicturesCB.IsChecked := FExportPictures;
+ PageBreaksCB.IsChecked := FExportPageBreaks;
+ WCB.IsChecked := FWysiwyg;
+ OpenCB.IsChecked := FOpenAfterExport;
+
+ if PageNumbers <> '' then
+ begin
+ PageNumbersE.Text := PageNumbers;
+ PageNumbersRB.IsChecked := True;
+ end;
+
+ if FHeaderFooterMode = hfText then
+ PColontitulCB.ItemIndex := 0
+ else if FHeaderFooterMode = hfPrint then
+ PColontitulCB.ItemIndex := 1
+ else
+ PColontitulCB.ItemIndex := 2;
+
+ Result := ShowModal;
+ PeekLastModalResult;
+ if Result = mrOk then
+ begin
+ if PColontitulCB.ItemIndex = 0 then
+ FHeaderFooterMode := hfText
+ else if PColontitulCB.ItemIndex = 1 then
+ FHeaderFooterMode := hfPrint
+ else
+ FHeaderFooterMode := hfNone;
+
+ PageNumbers := '';
+ CurPage := False;
+ if CurPageRB.IsChecked then
+ CurPage := True
+ else if PageNumbersRB.IsChecked then
+ PageNumbers := PageNumbersE.Text;
+
+ SuppressPageHeadersFooters := ContinuousCB.IsChecked;
+
+ if FHeaderFooterMode = hfPrint then
+ SuppressPageHeadersFooters := True;
+
+ FExportPictures := PicturesCB.IsChecked;
+ FExportPageBreaks := PageBreaksCB.IsChecked;
+ FWysiwyg := WCB.IsChecked;
+ FOpenAfterExport := OpenCB.IsChecked;
+
+ if not SlaveExport then
+ begin
+ if DefaultPath <> '' then
+ SaveDialog1.InitialDir := DefaultPath;
+ if SaveDialog1.Execute then
+ FileName := SaveDialog1.FileName
+ else
+ Result := mrCancel;
+ PeekLastModalResult;
+ end
+ end;
+ Free;
+ end;
+ end else
+ Result := mrOk;
+end;
+
+function TfrxRTFExport.Start: Boolean;
+begin
+ if SlaveExport then
+ begin
+ if Report.FileName <> '' then
+ FileName := ChangeFileExt(GetTemporaryFolder + ExtractFileName(Report.FileName), frxGet(8505))
+ else
+ FileName := ChangeFileExt(GetTempFile, frxGet(8505))
+ end;
+ if (FileName <> '') or Assigned(Stream) then
+ begin
+ if (ExtractFilePath(FileName) = '') and (DefaultPath <> '') then
+ FileName := DefaultPath + '\' + FileName;
+ FFirstPage := True;
+ FCurrentPage := 0;
+ FMatrix := TfrxIEMatrix.Create(UseFileCache, Report.EngineOptions.TempDir);
+ FMatrix.ShowProgress := ShowProgress;
+ if FWysiwyg then
+ FMatrix.Inaccuracy := 0.5
+ else
+ FMatrix.Inaccuracy := 10;
+ FMatrix.RotatedAsImage := True;
+ FMatrix.RichText := True;
+ FMatrix.PlainRich := False;
+ FMatrix.AreaFill := True;
+ FMatrix.CropAreaFill := True;
+ FMatrix.DeleteHTMLTags := False;
+ FMatrix.BackgroundImage := False;
+ FMatrix.Background := False;
+ FMatrix.Printable := ExportNotPrintable;
+ FMatrix.EMFPictures := PictureType <> gpBMP;
+ FFontTable := TStringList.Create;
+ FCharsetTable := TStringList.Create;
+ FColorTable := TStringList.Create;
+ FDataList := TList.Create;
+ Result := True
+ end
+ else
+ Result := False;
+end;
+
+procedure TfrxRTFExport.StartPage(Page: TfrxReportPage; Index: Integer);
+begin
+ Inc(FCurrentPage);
+ if FFirstPage then
+ FFirstPage := False;
+end;
+
+procedure TfrxRTFExport.ExportObject(Obj: TfrxComponent);
+begin
+ if (Obj is TfrxPageHeader) and (ExportNotPrintable or TfrxView(Obj).Printable) then
+ FMatrix.SetPageHeader(TfrxBand(Obj))
+ else if (Obj is TfrxPageFooter) and (ExportNotPrintable or TfrxView(Obj).Printable) then
+ FMatrix.SetPageFooter(TfrxBand(Obj))
+ else if (Obj is TfrxView) and (ExportNotPrintable or TfrxView(Obj).Printable) then
+ begin
+ if (Obj is TfrxCustomMemoView) or
+ (FExportPictures and (not (Obj is TfrxCustomMemoView))) then
+ FMatrix.AddObject(TfrxView(Obj))
+ end;
+end;
+
+procedure TfrxRTFExport.FinishPage(Page: TfrxReportPage; Index: Integer);
+begin
+ FMatrix.AddPage(Page.Orientation, Page.Width, Page.Height, Page.LeftMargin,
+ Page.TopMargin, Page.RightMargin, Page.BottomMargin, Page.MirrorMargins, Index);
+end;
+
+procedure TfrxRTFExport.Finish;
+var
+ Exp: TStream;
+begin
+ FMatrix.Prepare;
+ if ShowProgress then
+ FProgress := TfrxProgress.Create(nil);
+ try
+ if Assigned(Stream) then
+ Exp := Stream
+ else
+ Exp := TFileStream.Create(FileName, fmCreate);
+ try
+ ExportPage(Exp);
+ finally
+ if not Assigned(Stream) then
+ Exp.Free;
+ end;
+ if FOpenAfterExport and (not Assigned(Stream)) then
+{$IFDEF MSWINDOWS}
+ ShellExecute(0, 'open', PChar(FileName), '', '', 5);
+{$ENDIF}
+{$IFDEF LINUX}
+ FmuxOpenFile(PChar(FileName));
+{$ENDIF}
+{$IFDEF MACOS}
+ ShellExecute(FileName);
+{$ENDIF}
+ except
+ on e: Exception do
+ case Report.EngineOptions.NewSilentMode of
+ simSilent: Report.Errors.Add(e.Message);
+ simMessageBoxes: frxErrorMsg(e.Message);
+ simReThrow: raise;
+ end;
+ end;
+ FMatrix.Clear;
+ FMatrix.Free;
+ FFontTable.Free;
+ FCharsetTable.Free;
+ FColorTable.Free;
+ FDataList.Free;
+ if ShowProgress then
+ FProgress.Free;
+end;
+
+{ TfrxRTFExportDialog }
+
+procedure TfrxRTFExportDialog.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(8500);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ GroupPageRange.Text := frxGet(7);
+ AllRB.Text := frxGet(3);
+ CurPageRB.Text := frxGet(4);
+ PageNumbersRB.Text := frxGet(5);
+ DescrL.Text := frxGet(9);
+ GroupQuality.Text := frxGet(8);
+ ContinuousCB.Text := frxGet(8950);
+ PicturesCB.Text := frxGet(8501);
+ PageBreaksCB.Text := frxGet(6);
+ WCB.Text := frxGet(8502);
+ OpenCB.Text := frxGet(8503);
+ SaveDialog1.Filter := frxGet(8504);
+ SaveDialog1.DefaultExt := frxGet(8505);
+ HeadFootL.Text := frxGet(8951);
+ PColontitulCB.Items[0] := frxGet(8952);
+ PColontitulCB.Items[1] := frxGet(8953);
+ PColontitulCB.Items[2] := frxGet(8954);
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+end;
+
+procedure TfrxRTFExportDialog.PageNumbersEChange(Sender: TObject);
+begin
+ PageNumbersRB.IsChecked := True;
+end;
+
+procedure TfrxRTFExportDialog.PageNumbersEKeyDown(Sender: TObject;var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+begin
+ case KeyChar of
+ '0'..'9':;
+ #8, '-', ',':;
+ else
+ key := 0;
+ end;
+end;
+
+procedure TfrxRTFExportDialog.FormKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VK_F1 then
+ frxResources.Help(Self);
+end;
+
+end.
diff --git a/LibD28/FMX.frxExportTXT.fmx b/LibD28/FMX.frxExportTXT.fmx
new file mode 100644
index 0000000..35ea22d
--- /dev/null
+++ b/LibD28/FMX.frxExportTXT.fmx
@@ -0,0 +1,400 @@
+object frxTXTExportDialog: TfrxTXTExportDialog
+Position.Point = '(252,183)'
+ ActiveControl = OK
+ BorderStyle = bsDialog
+ Caption = 'Export to text (dot-matrix printer)'
+ ClientHeight = 378
+ ClientWidth = 622
+ Color = clBtnFace
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ Font.Style = []
+ KeyPreview = True
+ OldCreateOrder = True
+ Position = poScreenCenter
+ Scaled = False
+ ShowHint = True
+ OnActivate = FormActivate
+ OnClose = FormClose
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ PixelsPerInch = 96
+ TextHeight = 13
+ object OK: TButton
+Position.Point = '(456,345)'
+ Width = 75
+ Height = 25
+ Anchors = [akRight, akBottom]
+ Caption = 'OK'
+ Default = True
+ ModalResult = 1
+ TabOrder = 2
+ end
+ object Cancel: TButton
+Position.Point = '(540,345)'
+ Width = 75
+ Height = 25
+ Anchors = [akRight, akBottom]
+ Cancel = True
+ Caption = 'Cancel'
+ ModalResult = 2
+ TabOrder = 3
+ end
+ object Panel1: TPanel
+Position.Point = '(4,4)'
+ Width = 261
+ Height = 333
+ TabOrder = 0
+ object BtnPreview: TSpeedButton
+Position.Point = '(207,282)'
+ Width = 32
+ Height = 32
+ Hint = 'Preview on/off'
+ AllowAllUp = True
+ GroupIndex = 2
+ Flat = True
+ Glyph.Data = {
+ 4E010000424D4E01000000000000760000002800000012000000120000000100
+ 040000000000D800000000000000000000001000000010000000000000000000
+ 80000080000000808000800000008000800080800000C0C0C000808080000000
+ FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
+ 7774470000007777777777777747440000007777777777777474440000007777
+ 7777777747444700000077770000007474447700000077007777780744477700
+ 00007087777777F844777700000070777777777F077777000000077777777777
+ 8077770000000777777777777077770000000777777777777077770000000777
+ 7777777770777700000007F77777777770777700000007F77777777770777700
+ 000070FF77777777077777000000708FFF777778077777000000770077777700
+ 777777000000777700000077777777000000}
+ OnClick = BtnPreviewClick
+ end
+ object GroupCellProp: TGroupBox
+Position.Point = '(8,108)'
+ Width = 245
+ Height = 77
+ Caption = ' Export properties '
+ TabOrder = 2
+ object CB_PageBreaks: TCheckBox
+Position.Point = '(12,20)'
+ Width = 113
+ Height = 17
+ Caption = 'Page breaks'
+ Checked = True
+ State = cbChecked
+ TabOrder = 0
+ OnClick = E_ScaleXChange
+ end
+ object CB_OEM: TCheckBox
+Position.Point = '(128,20)'
+ Width = 113
+ Height = 17
+ Caption = 'OEM codepage'
+ Checked = True
+ State = cbChecked
+ TabOrder = 2
+ OnClick = CB_OEMClick
+ end
+ object CB_EmptyLines: TCheckBox
+Position.Point = '(12,44)'
+ Width = 113
+ Height = 17
+ Caption = 'Empty lines'
+ Checked = True
+ State = cbChecked
+ TabOrder = 1
+ OnClick = E_ScaleXChange
+ end
+ object CB_LeadSpaces: TCheckBox
+Position.Point = '(128,44)'
+ Width = 113
+ Height = 17
+ Caption = 'Lead spaces'
+ Checked = True
+ State = cbChecked
+ TabOrder = 3
+ OnClick = E_ScaleXChange
+ end
+ end
+ object GroupPageRange: TGroupBox
+Position.Point = '(8,188)'
+ Width = 245
+ Height = 77
+ Caption = ' Page range '
+ TabOrder = 3
+ object Pages: TLabel
+Position.Point = '(12,20)'
+ Width = 68
+ Height = 13
+ Caption = 'Page numbers'
+ end
+ object Descr: TLabel
+Position.Point = '(12,40)'
+ Width = 229
+ Height = 29
+ AutoSize = False
+ Caption =
+ 'Enter numbers and/or page ranges, separated by commas. For examp' +
+ 'le: 1,3,5-12'
+ WordWrap = True
+ end
+ object E_Range: TEdit
+Position.Point = '(92,16)'
+ Width = 141
+ Height = 21
+ TabOrder = 0
+ end
+ end
+ object GroupScaleSettings: TGroupBox
+Position.Point = '(8,4)'
+ Width = 129
+ Height = 101
+ Caption = ' Scaling '
+ TabOrder = 0
+ object ScX: TLabel
+Position.Point = '(11,28)'
+ Width = 50
+ Height = 13
+ AutoSize = False
+ Caption = 'Width'
+ end
+ object Label2: TLabel
+Position.Point = '(111,28)'
+ Width = 11
+ Height = 13
+ Caption = '%'
+ end
+ object ScY: TLabel
+Position.Point = '(11,64)'
+ Width = 46
+ Height = 13
+ AutoSize = False
+ Caption = 'Height'
+ end
+ object Label9: TLabel
+Position.Point = '(111,64)'
+ Width = 11
+ Height = 13
+ Caption = '%'
+ end
+ object E_ScaleX: TEdit
+Position.Point = '(57,24)'
+ Width = 33
+ Height = 21
+ TabOrder = 0
+ Text = '100'
+ end
+ object UpDown1: TUpDown
+Position.Point = '(90,24)'
+ Width = 17
+ Height = 21
+ Associate = E_ScaleX
+ ArrowKeys = False
+ Min = 10
+ Max = 500
+ Increment = 10
+ ParentShowHint = False
+ Position = 100
+ ShowHint = False
+ TabOrder = 1
+ Thousands = False
+ Wrap = False
+ OnChanging = UpDown1Changing
+ end
+ object UpDown2: TUpDown
+Position.Point = '(90,60)'
+ Width = 17
+ Height = 21
+ Associate = E_ScaleY
+ ArrowKeys = False
+ Min = 10
+ Max = 500
+ Increment = 10
+ ParentShowHint = False
+ Position = 100
+ ShowHint = False
+ TabOrder = 2
+ Thousands = False
+ Wrap = False
+ OnChanging = UpDown1Changing
+ end
+ object E_ScaleY: TEdit
+Position.Point = '(57,60)'
+ Width = 33
+ Height = 21
+ TabOrder = 3
+ Text = '100'
+ end
+ end
+ object GroupFramesSettings: TGroupBox
+Position.Point = '(144,4)'
+ Width = 109
+ Height = 101
+ Caption = ' Frames '
+ TabOrder = 1
+ object RB_NoneFrames: TRadioButton
+ Tag = 1
+Position.Point = '(12,20)'
+ Width = 85
+ Height = 17
+ Caption = 'None'
+ Checked = True
+ TabOrder = 0
+ TabStop = True
+ OnClick = E_ScaleXChange
+ end
+ object RB_Simple: TRadioButton
+ Tag = 1
+Position.Point = '(12,44)'
+ Width = 89
+ Height = 17
+ Caption = 'Simple'
+ TabOrder = 1
+ OnClick = E_ScaleXChange
+ end
+ object RB_Graph: TRadioButton
+ Tag = 1
+Position.Point = '(12,68)'
+ Width = 89
+ Height = 17
+ Hint = 'Only with OEM codepage'
+ Caption = 'Graphic'
+ ParentShowHint = False
+ ShowHint = True
+ TabOrder = 2
+ OnClick = E_ScaleXChange
+ end
+ end
+ object CB_PrintAfter: TCheckBox
+Position.Point = '(20,276)'
+ Width = 157
+ Height = 17
+ Caption = 'Print after export'
+ Checked = True
+ State = cbChecked
+ TabOrder = 4
+ end
+ end
+ object Panel2: TPanel
+Position.Point = '(268,4)'
+ Width = 351
+ Height = 333
+ TabOrder = 1
+ object GroupBox1: TGroupBox
+Position.Point = '(8,4)'
+ Width = 337
+ Height = 321
+ Caption = ' Preview '
+ TabOrder = 0
+ object Label1: TLabel
+Position.Point = '(4,20)'
+ Width = 49
+ Height = 13
+ Alignment = taRightJustify
+ AutoSize = False
+ Caption = 'Width:'
+ end
+ object Label3: TLabel
+Position.Point = '(76,20)'
+ Width = 49
+ Height = 13
+ Alignment = taRightJustify
+ AutoSize = False
+ Caption = 'Height:'
+ end
+ object PgHeight: TLabel
+Position.Point = '(128,20)'
+ Width = 25
+ Height = 13
+ AutoSize = False
+ Caption = '0'
+ end
+ object PgWidth: TLabel
+Position.Point = '(56,20)'
+ Width = 25
+ Height = 13
+ AutoSize = False
+ Caption = '0'
+ end
+ object LBPage: TLabel
+Position.Point = '(208,20)'
+ Width = 49
+ Height = 13
+ Alignment = taRightJustify
+ AutoSize = False
+ Caption = 'Page'
+ end
+ object ToolButton1: TSpeedButton
+Position.Point = '(160,14)'
+ Width = 23
+ Height = 22
+ Flat = True
+ Glyph.Data = {
+ F6000000424DF600000000000000760000002800000010000000100000000100
+ 0400000000008000000000000000000000001000000010000000000000000000
+ 80000080000000808000800000008000800080800000C0C0C000808080000000
+ FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
+ 7447777777777777474477777777777474447777777777474447777770000474
+ 447777700FFFF84447777708FFFFFF808777770FFF22FFF0777770FFFF22FFFF
+ 077770FF222222FF077770FF222222FF077770FFFF22FFFF0777770FFF22FFF0
+ 77777708FFFFFF80777777700FFFF00777777777700007777777}
+ OnClick = ToolButton1Click
+ end
+ object ToolButton2: TSpeedButton
+Position.Point = '(183,14)'
+ Width = 23
+ Height = 22
+ Flat = True
+ Glyph.Data = {
+ F6000000424DF600000000000000760000002800000010000000100000000100
+ 0400000000008000000000000000000000001000000010000000000000000000
+ 80000080000000808000800000008000800080800000C0C0C000808080000000
+ FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777
+ 7447777777777777474477777777777474447777777777474447777770000474
+ 447777700FFFF84447777708FFFFFF808777770FFFFFFFF0777770FFFFFFFFFF
+ 077770FF222222FF077770FF222222FF077770FFFFFFFFFF0777770FFFFFFFF0
+ 77777708FFFFFF80777777700FFFF00777777777700007777777}
+ OnClick = ToolButton2Click
+ end
+ object Preview: TMemo
+Position.Point = '(8,44)'
+ Width = 321
+ Height = 269
+ DragCursor = crDefault
+ Font.Charset = DEFAULT_CHARSET
+ Font.Color = clWindowText
+ Font.Height = -11
+ Font.Name = 'Courier New'
+ Font.Style = []
+ ParentFont = False
+ ReadOnly = True
+ ScrollBars = ssBoth
+ TabOrder = 1
+ WordWrap = False
+ end
+ object EPage: TEdit
+Position.Point = '(264,16)'
+ Width = 40
+ Height = 21
+ TabOrder = 0
+ Text = '1'
+ OnChange = E_ScaleXChange
+ end
+ object PageUpDown: TUpDown
+Position.Point = '(304,16)'
+ Width = 25
+ Height = 21
+ Associate = EPage
+ Min = 1
+ Orientation = udHorizontal
+ Position = 1
+ TabOrder = 2
+ Wrap = False
+ end
+ end
+ end
+ object SaveDialog1: TSaveDialog
+ Options = [ofHideReadOnly, ofNoChangeDir, ofEnableSizing]
+Position.Point = '(56,344)'
+ end
+end
diff --git a/LibD28/FMX.frxExportTXT.pas b/LibD28/FMX.frxExportTXT.pas
new file mode 100644
index 0000000..c71d560
--- /dev/null
+++ b/LibD28/FMX.frxExportTXT.pas
@@ -0,0 +1,1541 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Text advanced export filter }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Fediachov, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit frxExportTXT;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ StdCtrls, ExtCtrls, frxClass, frxProgress, Buttons, ComCtrls, Variants, FMX.frxBaseModalForm;
+
+type
+ TfrxTXTExport = class;
+
+ TfrxTXTExportDialog = class(TfrxForm)
+ OK: TButton;
+ Cancel: TButton;
+ Panel1: TPanel;
+ GroupCellProp: TGroupBox;
+ GroupPageRange: TGroupBox;
+ Pages: TLabel;
+ Descr: TLabel;
+ E_Range: TEdit;
+ GroupScaleSettings: TGroupBox;
+ ScX: TLabel;
+ Label2: TLabel;
+ ScY: TLabel;
+ Label9: TLabel;
+ E_ScaleX: TEdit;
+ CB_PageBreaks: TCheckBox;
+ GroupFramesSettings: TGroupBox;
+ RB_NoneFrames: TRadioButton;
+ RB_Simple: TRadioButton;
+ RB_Graph: TRadioButton;
+ CB_OEM: TCheckBox;
+ CB_EmptyLines: TCheckBox;
+ CB_LeadSpaces: TCheckBox;
+ CB_PrintAfter: TCheckBox;
+ Panel2: TPanel;
+ GroupBox1: TGroupBox;
+ Label1: TLabel;
+ Label3: TLabel;
+ PgHeight: TLabel;
+ PgWidth: TLabel;
+ Preview: TMemo;
+ EPage: TEdit;
+ PageUpDown: TUpDown;
+ LBPage: TLabel;
+ ToolButton1: TSpeedButton;
+ ToolButton2: TSpeedButton;
+ BtnPreview: TSpeedButton;
+ SaveDialog1: TSaveDialog;
+ UpDown1: TUpDown;
+ UpDown2: TUpDown;
+ E_ScaleY: TEdit;
+ procedure FormCreate(Sender: TObject);
+ procedure CB_OEMClick(Sender: TObject);
+ procedure RefreshClick(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure FormActivate(Sender: TObject);
+ procedure E_ScaleXChange(Sender: TObject);
+ procedure BtnPreviewClick(Sender: TObject);
+ procedure ToolButton1Click(Sender: TObject);
+ procedure ToolButton2Click(Sender: TObject);
+ procedure UpDown1Changing(Sender: TObject; var AllowChange: Boolean);
+ procedure FormKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+ private
+ TxtExp: TfrxTXTExport;
+ Flag, created, MakeInit, running: Boolean;
+ printer: Integer;
+ public
+ PagesCount: Integer;
+ Exporter: TfrxTXTExport;
+ PreviewActive: Boolean;
+ end;
+
+ PfrxTXTStyle = ^TfrxTXTStyle;
+ TfrxTXTStyle = packed record
+ Font: TFont;
+ VAlignment: TfrxVAlign;
+ HAlignment: TfrxHAlign;
+ FrameTyp: TfrxFrameTypes;
+ FrameWidth: Single;
+ FrameColor: TColor;
+ FrameStyle: TfrxFrameStyle;
+ FillColor: TColor;
+ IsText: Boolean;
+ end;
+
+ TfrxTXTPrinterCommand = {packed} record
+ Name: String;
+ SwitchOn: String;
+ SwitchOff: String;
+ Trigger: Boolean;
+ end;
+
+ TfrxTXTPrinterType = {packed} record
+ name: String;
+ CommCount: Integer;
+ Commands: array[0..31] of TfrxTXTPrinterCommand;
+ end;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxTXTExport = class(TfrxCustomExportFilter)
+ private
+ CurrentPage: Integer;
+ FirstPage: Boolean;
+ CurY: Integer;
+ RX: TList; // TObjCell
+ RY: TList; // TObjCell
+ ObjectPos: TList; // TObjPos
+ PageObj: TList; // TfrxView
+ StyleList: TList;
+ CY, LastY: Extended;
+ frExportSet: TfrxTXTExportDialog;
+ pgBreakList: TStringList;
+ expBorders, expBordersGraph, expPrintAfter, expUseSavedProps,
+ expPrinterDialog, expPageBreaks, expOEM, expEmptyLines,
+ expLeadSpaces: Boolean;
+ expCustomFrameSet: String;
+ expScaleX, expScaleY: Extended;
+ MaxWidth: Extended;
+ Scr: array of Char;
+ ScrWidth: Integer;
+ ScrHeight: Integer;
+ PrinterInitString: String;
+ Stream: TFileStream;
+ FStripHTMLTags: Boolean;
+ procedure WriteExpLn(const str: String);
+ procedure WriteExp(const str: String);
+ procedure ObjCellAdd(Vector: TList; Value: Extended);
+ procedure ObjPosAdd(Vector: TList; x, y, dx, dy, obj: Integer);
+ function CompareStyles(Style1, Style2: PfrxTXTStyle): Boolean;
+ function FindStyle(Style: PfrxTXTStyle): Integer;
+ procedure MakeStyleList;
+ procedure ClearLastPage;
+ procedure OrderObjectByCells;
+ procedure ExportPage;
+ function ChangeReturns(const Str: String): String;
+ function TruncReturns(const Str: String): String;
+ procedure AfterExport(const FileName: String);
+ procedure PrepareExportPage;
+ procedure DrawMemo(x, y: Integer; dx, dy: Integer; text: String; st: Integer);
+ procedure FlushScr;
+ procedure CreateScr(dx, dy: Integer);
+ procedure FreeScr;
+ procedure ScrType(x, y: Integer; c: Char);
+ function ScrGet(x, y: Integer): Char;
+ procedure ScrString(x, y: Integer; const s: String);
+ procedure FormFeed;
+ function MakeInitString: String;
+ public
+ PrintersCount: Integer;
+ PrinterTypes: array [0..15] of TfrxTXTPrinterType;
+ SelectedPrinterType: Integer;
+ PageWidth, PageHeight: Integer;
+ IsPreview: Boolean;
+ Copys: Integer;
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function ShowModal: TModalResult; override;
+ function Start: Boolean; override;
+ procedure Finish; override;
+ procedure FinishPage(Page: TfrxReportPage; Index: Integer); override;
+ procedure StartPage(Page: TfrxReportPage; Index: Integer); override;
+ procedure ExportObject(Obj: TfrxComponent); override;
+ class function GetDescription: String; override;
+ function RegisterPrinterType(const Name: String):Integer;
+ procedure RegisterPrinterCommand(PrinterIndex: Integer;
+ const Name, switch_on, switch_off: String);
+ procedure LoadPrinterInit(const FName: String);
+ procedure SavePrinterInit(const FName: String);
+ procedure SpoolFile(const FileName: String);
+ published
+ property ScaleWidth: Extended read expScaleX write expScaleX;
+ property ScaleHeight: Extended read expScaleY write expScaleY;
+ property Borders: Boolean read expBorders write expBorders;
+ property Pseudogrpahic: Boolean read expBordersGraph write expBordersGraph;
+ property PageBreaks: Boolean read expPageBreaks write expPageBreaks;
+ property OEMCodepage: Boolean read expOEM write expOEM;
+ property EmptyLines: Boolean read expEmptyLines write expEmptyLines;
+ property LeadSpaces: Boolean read expLeadSpaces write expLeadSpaces;
+ property PrintAfter: Boolean read expPrintAfter write expPrintAfter;
+ property PrinterDialog: Boolean read expPrinterDialog write expPrinterDialog;
+ property UseSavedProps: Boolean read expUseSavedProps write expUseSavedProps;
+ property InitString: String read PrinterInitString write PrinterInitString;
+ property CustomFrameSet: String read expCustomFrameSet write expCustomFrameSet;
+ property StripHTMLTags: Boolean read FStripHTMLTags write FStripHTMLTags default False;
+ end;
+
+implementation
+
+uses frxUtils, frxprinter, Printers, Winspool, frxExportTxtPrn,
+ frxFileUtils, frxres, frxrcExports;
+
+{$R *.dfm}
+
+type
+ PObjCell = ^TObjCell;
+ TObjCell = packed record
+ Value: Extended;
+ Count: Integer;
+ end;
+
+ PObjPos = ^TObjPos;
+ TObjPos = packed record
+ obj: Integer;
+ x,y: Integer;
+ dx, dy: Integer;
+ style: Integer;
+ end;
+
+const
+ Xdivider = 7;
+ Ydivider = 8;
+ FrameSet: array [1..2] of String = (
+// frameset: vertical, horizontal, up-left corner, up-right corner
+// down-left corner, down-right corner, down tap, left tap,
+// up tap, right tap, cross
+ '|-+++++++++',
+ #179#196#218#191#192#217#193#195#194#180#197 );
+ EpsonCommCnt = 12;
+ Epson: array [0..EpsonCommCnt - 1, 0..2] of String = (
+ ('Reset', #27#64, ''),
+ ('Normal', #27#120#00, ''),
+ ('Pica', #27#120#01#27#107#00, ''),
+ ('Elite', #27#120#01#27#107#01, ''),
+ ('Condensed', #15, #18),
+ ('Bold', #27#71, #27#72),
+ ('Italic', #27#52, #27#53),
+ ('Wide', #27#87#01, #27#87#00),
+ ('12cpi', #27#77, #27#80),
+ ('Linefeed 1/8"', #27#48, ''),
+ ('Linefeed 7/72"', #27#49, ''),
+ ('Linefeed 1/6"', #27#50, ''));
+ HPCommCnt = 6;
+ HPComm: array [0..HPCommCnt - 1, 0..2] of String = (
+ ('Reset', #27#69, ''),
+ ('Landscape orientation', #27#38#108#49#79, #27#38#108#48#79),
+ ('Italic', #27#40#115#49#83, #27#40#115#48#83),
+ ('Bold', #27#40#115#51#66, #27#40#115#48#66),
+ ('Draft EconoMode', #27#40#115#49#81, #27#40#115#50#81),
+ ('Condenced', #27#40#115#49#50#72#27#38#108#56#68, #27#40#115#49#48#72));
+ IBMCommCnt = 8;
+ IBMComm: array [0..IBMCommCnt - 1, 0..2] of String = (
+ ('Reset', #27#64, ''),
+ ('Normal', #27#120#00, ''),
+ ('Pica', #27#48#73, ''),
+ ('Elite', #27#56#73, ''),
+ ('Condensed', #15, #18),
+ ('Bold', #27#71, #27#72),
+ ('Italic', #27#52, #27#53),
+ ('12cpi', #27#77, #27#80));
+
+function ComparePoints(Item1, Item2: Pointer): Integer;
+begin
+ if PObjCell(Item1).Value > PObjCell(Item2).Value then
+ Result := 1
+ else if PObjCell(Item1).Value < PObjCell(Item2).Value then
+ Result := -1
+ else
+ Result := 0;
+end;
+
+function CompareObjects(Item1, Item2: Pointer): Integer;
+var
+ m1, m2: TfrxView;
+ Res: Extended;
+begin
+ m1 := TfrxView(Item1);
+ m2 := TfrxView(Item2);
+ Res := m1.Top - m2.Top;
+ if Res = 0 then
+ Res := m1.Left - m2.Left;
+ if Res = 0 then
+ if (m1 is TfrxCustomMemoView) and (m2 is TfrxCustomMemoView) then
+ Res := Length(TfrxMemoView(m1).Memo.Text) - Length(TfrxMemoView(m2).Memo.Text);
+ if Res > 0 then
+ Result := 1
+ else if Res < 0 then
+ Result := -1
+ else
+ Result := 0;
+end;
+
+class function TfrxTXTExport.GetDescription: String;
+begin
+ Result := frxResources.Get('TextExport');
+end;
+
+constructor TfrxTXTExport.Create(AOwner: TComponent);
+var
+ i: Integer;
+begin
+ inherited Create(AOwner);
+ RX := TList.Create;
+ RY := TList.Create;
+ PageObj := TList.Create;
+ ObjectPos := TList.Create;
+ StyleList := TList.Create;
+ pgBreakList := TStringList.Create;
+ ShowDialog := True;
+ expBorders := False;
+ expPageBreaks := True;
+ expScaleX := 1.0;
+ expScaleY := 1.0;
+ expBordersGraph := False;
+ expOEM := False;
+ expEmptyLines := False;
+ expLeadSpaces := False;
+ PrinterInitString := '';
+ PageWidth := 0;
+ PageHeight := 0;
+ IsPreview := False;
+ expPrintAfter := False;
+ expUseSavedProps := True;
+ expPrinterDialog := True;
+ PrintersCount := 0;
+ SelectedPrinterType := 0;
+ expCustomFrameSet := '';
+ FilterDesc := frxGet(8801);
+ DefaultExt := frxGet(8802);
+ Copys := 1;
+ FStripHTMLTags := False;
+ /// printer registration
+ RegisterPrinterType('NONE');
+ RegisterPrinterType('EPSON ESC/P2 Matrix/Stylus)');
+ for i := 0 to EpsonCommCnt - 1 do
+ RegisterPrinterCommand(1, Epson[i, 0], Epson[i, 1], Epson[i, 2]);
+ RegisterPrinterType('HP PCL (LaserJet/DeskJet)');
+ for i := 0 to HPCommCnt - 1 do
+ RegisterPrinterCommand(2, HPComm[i, 0], HPComm[i, 1], HPComm[i, 2]);
+ RegisterPrinterType('CANON/IBM (Matrix)');
+ for i := 0 to IBMCommCnt - 1 do
+ RegisterPrinterCommand(3, IBMComm[i, 0], IBMComm[i, 1], IBMComm[i, 2]);
+end;
+
+destructor TfrxTXTExport.Destroy;
+begin
+ ClearLastPage;
+ RX.Free;
+ RY.Free;
+ PageObj.Free;
+ ObjectPos.Free;
+ StyleList.Free;
+ pgBreakList.Free;
+ inherited;
+end;
+
+function TfrxTXTExport.TruncReturns(const Str: String): String;
+begin
+ Result := StringReplace(Str, #1, '', [rfReplaceAll]);
+ if Copy(Result, Length(Result) - 1, 2) = #13#10 then
+ Delete(Result, Length(Result) - 1, 2);
+end;
+
+function TfrxTXTExport.ChangeReturns(const Str: String): String;
+begin
+ Result := StringReplace(Str, #1, '', [rfReplaceAll]);
+end;
+
+procedure TfrxTXTExport.ClearLastPage;
+var
+ i: Integer;
+begin
+ PageObj.Clear;
+ for i := 0 to StyleList.Count - 1 do
+ begin
+ PfrxTXTStyle(StyleList[i]).Font.Free;
+ FreeMemory(PfrxTXTStyle(StyleList[i]));
+ end;
+ StyleList.Clear;
+ for i := 0 to RX.Count - 1 do FreeMem(PObjCell(RX[i]));
+ RX.Clear;
+ for i := 0 to RY.Count - 1 do FreeMem(PObjCell(RY[i]));
+ RY.Clear;
+ for i := 0 to ObjectPos.Count - 1 do FreeMem(PObjPos(ObjectPos[i]));
+ ObjectPos.Clear;
+end;
+
+procedure TfrxTXTExport.ObjCellAdd(Vector: TList; Value: Extended);
+var
+ ObjCell: PObjCell;
+ i, cnt: Integer;
+ exist: Boolean;
+begin
+ exist := False;
+ if Vector.Count > 0 then
+ begin
+ if Vector.Count > 100 then
+ cnt := Vector.Count - 100 else
+ cnt := 0;
+ for i := Vector.Count - 1 downto cnt do
+ if Round(PObjCell(Vector[i]).Value) = Round(Value) then
+ begin
+ exist := True;
+ break;
+ end;
+ end;
+ if not exist then
+ begin
+ GetMem(ObjCell, SizeOf(TObjCell));
+ ObjCell.Value := Value;
+ ObjCell.Count := 0;
+ Vector.Add(ObjCell);
+ end;
+end;
+
+procedure TfrxTXTExport.ObjPosAdd(Vector: TList; x, y, dx, dy, obj: Integer);
+var
+ ObjPos: PObjPos;
+begin
+ GetMem(ObjPos, SizeOf(TObjPos));
+ ObjPos.x := x;
+ ObjPos.y := y;
+ ObjPos.dx := dx;
+ ObjPos.dy := dy;
+ ObjPos.obj := Obj;
+ Vector.Add(ObjPos);
+end;
+
+procedure TfrxTXTExport.OrderObjectByCells;
+var
+ obj, c, fx, fy, dx, dy, mi: integer;
+ m, curx, cury: Extended;
+begin
+ for obj := 0 to PageObj.Count - 1 do
+ begin
+ fx := 0; fy := 0;
+ dx := 1; dy := 1;
+ for c := 0 to RX.Count - 1 do
+ if Round(PObjCell(RX[c]).Value) = Round(TfrxView(PageObj[obj]).Left) then
+ begin
+ fx := c;
+ m := TfrxView(PageObj[obj]).Left;
+ mi := c + 1;
+ curx := TfrxView(PageObj[obj]).Left + TfrxView(PageObj[obj]).Width;
+ while Round(m) < Round(curx) do
+ begin
+ m := m + PObjCell(RX[mi]).Value - PObjCell(RX[mi - 1]).Value;
+ inc(mi);
+ end;
+ dx := mi - c - 1;
+ break;
+ end;
+ for c := 0 to RY.Count - 1 do
+ if Round(PObjCell(RY[c]).Value) = Round(TfrxView(PageObj[obj]).Top) then
+ begin
+ fy := c;
+ m := TfrxView(PageObj[obj]).Top;
+ mi := c + 1;
+ cury := TfrxView(PageObj[obj]).Top + TfrxView(PageObj[obj]).Height;
+ while Round(m) < Round(cury) do
+ begin
+ m := m + PObjCell(RY[mi]).Value - PObjCell(RY[mi - 1]).Value;
+ inc(mi);
+ end;
+ dy := mi - c - 1;
+ break;
+ end;
+ ObjPosAdd(ObjectPos, fx, fy, dx, dy, obj);
+ end;
+end;
+
+function TfrxTXTExport.CompareStyles(Style1, Style2: PfrxTXTStyle): Boolean;
+begin
+ if Style1.IsText and Style2.IsText then
+ begin
+ Result := (Style1.Font.Color = Style2.Font.Color) and
+ (Style1.Font.Name = Style2.Font.Name) and
+ (Style1.Font.Size = Style2.Font.Size) and
+ (Style1.Font.Style = Style2.Font.Style) and
+ (Style1.Font.Charset = Style2.Font.Charset) and
+ (Style1.VAlignment = Style2.VAlignment) and
+ (Style1.HAlignment = Style2.HAlignment) and
+ (Style1.FrameTyp = Style2.FrameTyp) and
+ (Style1.FrameWidth = Style2.FrameWidth) and
+ (Style1.FrameColor = Style2.FrameColor) and
+ (Style1.FrameStyle = Style2.FrameStyle) and
+ (Style1.FillColor = Style2.FillColor);
+ end
+ else if (not Style1.IsText) and (not Style2.IsText) then
+ begin
+ Result := (Style1.VAlignment = Style2.VAlignment) and
+ (Style1.HAlignment = Style2.HAlignment) and
+ (Style1.FrameTyp = Style2.FrameTyp) and
+ (Style1.FrameWidth = Style2.FrameWidth) and
+ (Style1.FrameColor = Style2.FrameColor) and
+ (Style1.FrameStyle = Style2.FrameStyle) and
+ (Style1.FillColor = Style2.FillColor);
+ end
+ else
+ Result := False;
+end;
+
+function TfrxTXTExport.FindStyle(Style: PfrxTXTStyle): Integer;
+var
+ i: Integer;
+begin
+ Result := -1;
+ for i := 0 to StyleList.Count - 1 do
+ if CompareStyles(Style, PfrxTXTStyle(StyleList[i])) then
+ Result := i;
+end;
+
+procedure TfrxTXTExport.MakeStyleList;
+var
+ i, j, k: Integer;
+ obj: TfrxView;
+ style: PfrxTXTStyle;
+begin
+ j := 0;
+ for i := 0 to ObjectPos.Count - 1 do
+ begin
+ obj := PageObj[PObjPos(ObjectPos[i]).obj];
+ style := AllocMem(SizeOf(TfrxTXTStyle));
+ if obj is TfrxCustomMemoView then
+ begin
+ style.Font := TFont.Create;
+ style.Font.Assign(TfrxMemoView(obj).Font);
+ style.VAlignment := TfrxMemoView(obj).VAlign;
+ style.HAlignment := TfrxMemoView(obj).HAlign;
+ style.IsText := True;
+ end
+ else
+ begin
+ style.Font := nil;
+ style.IsText := False;
+ end;
+ style.FrameTyp := obj.Frame.Typ;
+ style.FrameWidth := obj.Frame.Width;
+ style.FrameColor := obj.Frame.Color;
+ style.FrameStyle := obj.Frame.Style;
+ style.FillColor := obj.Color;
+ k := FindStyle(Style);
+ if k = -1 then
+ begin
+ StyleList.Add(style);
+ PObjPos(ObjectPos[i]).style := j;
+ j := j + 1;
+ end
+ else
+ begin
+ PObjPos(ObjectPos[i]).style := k;
+ Style.Font.Free;
+ FreeMemory(Style);
+ end;
+ end;
+end;
+
+function StrToOem(const AnsiStr: AnsiString): AnsiString;
+begin
+ SetLength(Result, Length(AnsiStr));
+ if Length(Result) > 0 then
+ CharToOemBuffA(PAnsiChar(AnsiStr), PAnsiChar(Result), Length(Result));
+end;
+
+function MakeStr(C: Char; N: Integer): String;
+begin
+ if N < 1 then
+ Result := ''
+ else
+ begin
+ SetLength(Result, N);
+ FillChar(Result[1], Length(Result), C);
+ end;
+end;
+
+function AddChar(C: Char; const S: String; N: Integer): String;
+begin
+ if Length(S) < N then
+ Result := MakeStr(C, N - Length(S)) + S else
+ Result := S;
+end;
+
+function AddCharR(C: Char; const S: String; N: Integer): String;
+begin
+ if Length(S) < N then
+ Result := S + MakeStr(C, N - Length(S)) else
+ Result := S;
+end;
+
+function LeftStr(const S: String; N: Integer): String;
+begin
+ Result := AddCharR(' ', S, N);
+end;
+
+function RightStr(const S: String; N: Integer): String;
+begin
+ Result := AddChar(' ', S, N);
+end;
+
+function CenterStr(const S: String; Len: Integer): String;
+begin
+ if Length(S) < Len then
+ begin
+ Result := MakeStr(' ', (Len div 2) - (Length(S) div 2)) + S;
+ Result := Result + MakeStr(' ', Len - Length(Result));
+ end
+ else
+ Result := S;
+end;
+
+const
+ Delims = [' ', #9, '-'];
+
+function WrapTxt(s: String; dx, dy: Integer): String;
+var
+ i, j, k: Integer;
+ buf1, buf2: String;
+begin
+ i := 0;
+ buf2 := s;
+ Result := '';
+ while (i < dy) and (Length(Buf2) > 0) do
+ begin
+ if Length(buf2) > dx then
+ begin
+ if buf2[dx + 1] = #10 then
+ buf1 := copy(buf2, 1, dx + 1)
+ else if buf2[dx + 1] = #13 then
+ buf1 := copy(buf2, 1, dx + 2)
+ else
+ buf1 := copy(buf2, 1, dx)
+ end
+ else
+ begin
+ Result := Result + buf2;
+ break;
+ end;
+ k := Pos(#13#10, buf1);
+ if k > 0 then
+ j := k + 1
+ else if Length(Buf1) < dx then
+ begin
+ j := Length(Buf1);
+ k := 1;
+ end
+ else
+ j := dx;
+ if (not (buf2[dx + 1] in Delims)) or (k > 0) then
+ begin
+ if k = 0 then
+ while (j > 0) and (not (buf1[j] in Delims)) do
+ Dec(j);
+ if j > 0 then
+ begin
+ buf1 := copy(buf1, 1, j);
+ buf2 := copy(buf2, j + 1, Length(buf2) - j)
+ end
+ else
+ buf2 := copy(buf2, dx + 1, Length(buf2) - dx);
+ end
+ else
+ buf2 := copy(buf2, dx + 2, Length(buf2) - dx - 1);
+ i := i + 1;
+ Result := Result + buf1;
+ if k = 0 then
+ Result := Result + #13#10;
+ end;
+end;
+
+procedure TfrxTXTExport.WriteExpLn(const str: String);
+var
+ ln: AnsiString;
+ TmpB: AnsiString;
+begin
+ if Length(str) > 0 then
+ begin
+ if Length(str) > PageWidth then
+ PageWidth := Length(str);
+ Inc(PageHeight);
+ TmpB := AnsiString(str);
+ Stream.Write(TmpB[1], Length(TmpB));
+ ln := #13#10;
+ Stream.Write(ln[1], Length(ln));
+ end
+ else if expEmptyLines then
+ begin
+ ln := #13#10;
+ Inc(PageHeight);
+ Stream.Write(ln[1], Length(ln));
+ end;
+end;
+
+procedure TfrxTXTExport.WriteExp(const str: String);
+var
+ TmpB: AnsiString;
+begin
+ TmpB := AnsiString(str);
+ if Length(TmpB) > 0 then
+ Stream.Write(TmpB[1], Length(TmpB));
+end;
+
+procedure TfrxTXTExport.CreateScr(dx, dy: Integer);
+var
+ i, j: Integer;
+begin
+ ScrWidth := dx;
+ ScrHeight := dy;
+ Initialize(Scr);
+ SetLength(Scr, ScrWidth * ScrHeight);
+ for i := 0 to ScrHeight - 1 do
+ for j := 0 to ScrWidth - 1 do
+ Scr[i * ScrWidth + j] := ' ';
+end;
+
+procedure TfrxTXTExport.ScrString(x, y: Integer; const s: String);
+var
+ i: Integer;
+begin
+ for i := 0 to Length(s) - 1 do
+ ScrType(x + i, y, s[i + 1]);
+end;
+
+function TfrxTXTExport.ScrGet(x, y: Integer): Char;
+begin
+ if (x < ScrWidth) and (y < ScrHeight) and
+ (x >= 0) and (y >= 0) then
+ Result := Scr[ScrWidth * y + x] else
+ Result := ' ';
+end;
+
+procedure TfrxTXTExport.DrawMemo(x, y, dx, dy: Integer; text: String;
+ st: Integer);
+var
+ i, sx, sy, lines: Integer;
+ buf: String;
+ style: PfrxTXTStyle;
+ f: String;
+
+ function AlignBuf: String;
+ begin
+ if (style.HAlignment = haLeft) then
+ buf := LeftStr(buf, dx - 1)
+ else if (style.HAlignment = haRight) then
+ buf := RightStr(buf, dx - 1)
+ else if (style.HAlignment = haCenter) then
+ buf := CenterStr(buf, dx - 1)
+ else
+ buf := LeftStr(buf, dx - 1);
+ if expOEM then
+ buf := String(StrToOem(AnsiString(buf)));
+ Result := buf;
+ end;
+
+begin
+ style := PfrxTXTStyle(StyleList[st]);
+ if (Style.FrameTyp <> []) and expBorders then
+ begin
+ if Length(expCustomFrameSet) > 0 then
+ f := CustomFrameSet
+ else if expBordersGraph then
+ f := FrameSet[2]
+ else
+ f := FrameSet[1];
+ if (ScrGet(x + 1, y) in [f[1], f[3], f[4]]) then
+ begin
+ Inc(x);
+ Dec(dx);
+ end
+ else if (ScrGet(x - 1, y) in [f[1], f[3], f[4]]) then
+ begin
+ Dec(x);
+ Inc(dx);
+ end;
+ if (ftLeft in Style.FrameTyp) then
+ for i := 0 to dy do
+ if i = 0 then
+ ScrType(x, y + i, f[3])
+ else if i = dy then
+ ScrType(x, y + i, f[5])
+ else
+ ScrType(x, y + i, f[1]);
+ if (ftRight in Style.FrameTyp) then
+ for i := 0 to dy do
+ if i = 0 then
+ ScrType(x + dx, y + i, f[4])
+ else if i = dy then
+ ScrType(x + dx, y + i, f[6])
+ else
+ ScrType(x + dx, y + i, f[1]);
+ if (ftTop in Style.FrameTyp) then
+ for i := 0 to dx do
+ if i = 0 then
+ ScrType(x + i, y, f[3])
+ else if i = dx then
+ ScrType(x + i, y, f[4])
+ else
+ ScrType(x + i, y, f[2]);
+ if (ftBottom in Style.FrameTyp) then
+ for i := 0 to dx do
+ if i = 0 then
+ ScrType(x + i, y + dy, f[5])
+ else if i = dx then
+ ScrType(x + i, y + dy, f[6])
+ else
+ ScrType(x + i, y + dy, f[2]);
+ end;
+ text := WrapTxt(text, dx - 1, dy - 1);
+ text := StringReplace(text, #13#10, #13, [rfReplaceAll]);
+ lines := 1;
+ for i := 0 to Length(text) - 1 do
+ if text[i + 1] = #13 then
+ Inc(lines);
+ sx := x;
+ if (style.VAlignment = vaBottom) then
+ sy := y + dy - lines - 1
+ else if (style.VAlignment = vaCenter) then
+ sy := y + (dy - lines - 1) div 2
+ else
+ sy := y;
+ buf := '';
+ for i := 0 to Length(text) - 1 do
+ if text[i + 1] = #13 then
+ begin
+ Inc(sy);
+ if sy > (y + dy) then
+ break;
+ ScrString(sx + 1, sy, AlignBuf);
+ buf := '';
+ end
+ else
+ begin
+ buf := buf + text[i + 1];
+ end;
+ if buf <> '' then
+ ScrString(sx + 1, sy + 1, AlignBuf);
+end;
+
+procedure TfrxTXTExport.FlushScr;
+var
+ i, j, cnt, maxcnt: Integer;
+ buf: String;
+ f: String;
+ c: Char;
+
+ function IsLine(c: Char): Boolean;
+ begin
+ Result := (c in [f[1], f[2]]);
+ end;
+
+ function IsConner(c: Char): Boolean;
+ begin
+ Result := (c in [f[3], f[4], f[5], f[6], f[7], f[8], f[9], f[10], f[11]]);
+ end;
+
+ function IsFrame(c: Char): Boolean;
+ begin
+ Result := IsLine(c) or IsConner(c);
+ end;
+
+ function FrameOpt(c: Char; x, y: Integer; f: String): Char;
+ begin
+ if (not IsLine(ScrGet(x - 1, y))) and
+ (not IsLine(ScrGet(x + 1, y))) and
+ (not IsLine(ScrGet(x, y - 1))) and
+ (IsLine(ScrGet(x, y + 1))) then
+ Result := f[1]
+ else if (not IsLine(ScrGet(x - 1, y))) and
+ (not IsLine(ScrGet(x + 1, y))) and
+ (IsLine(ScrGet(x, y - 1))) and
+ (not IsLine(ScrGet(x, y + 1))) then
+ Result := f[1]
+ else if (not IsLine(ScrGet(x - 1, y))) and
+ (IsLine(ScrGet(x + 1, y))) and
+ (not IsLine(ScrGet(x, y - 1))) and
+ (not IsLine(ScrGet(x, y + 1))) then
+ Result := f[2]
+ else if (not IsLine(ScrGet(x + 1, y))) and
+ (IsLine(ScrGet(x - 1, y))) and
+ (not IsLine(ScrGet(x, y - 1))) and
+ (not IsLine(ScrGet(x, y + 1))) then
+ Result := f[2]
+ else if (not IsFrame(ScrGet(x + 1, y))) and
+ (not IsFrame(ScrGet(x - 1, y))) and
+ (ScrGet(x, y + 1) = f[1]) and
+ (ScrGet(x, y - 1) = f[1]) then
+ Result := f[1]
+ else if (ScrGet(x + 1, y) = f[2]) and
+ (ScrGet(x - 1, y) = f[2]) and
+ (not IsFrame(ScrGet(x, y + 1))) and
+ (not IsFrame(ScrGet(x, y - 1))) then
+ Result := f[2]
+ else if (ScrGet(x + 1, y) = f[2]) and
+ (ScrGet(x - 1, y) = f[2]) and
+ (ScrGet(x, y + 1) = f[1]) and
+ (ScrGet(x, y - 1) = f[1]) then
+ Result := f[11]
+ else if (ScrGet(x + 1, y) = f[2]) and
+ (ScrGet(x - 1, y) = f[2]) and
+ (ScrGet(x, y + 1) = f[1]) and
+ (ScrGet(x, y - 1) <> f[1]) then
+ Result := f[9]
+ else if (ScrGet(x + 1, y) = f[2]) and
+ (ScrGet(x - 1, y) = f[2]) and
+ (ScrGet(x, y - 1) = f[1]) and
+ (ScrGet(x, y + 1) <> f[1]) then
+ Result := f[7]
+ else if (ScrGet(x, y - 1) = f[1]) and
+ (ScrGet(x, y + 1) = f[1]) and
+ (ScrGet(x + 1, y) = f[2]) and
+ (ScrGet(x - 1, y) <> f[2])then
+ Result := f[8]
+ else if (ScrGet(x, y - 1) = f[1]) and
+ (ScrGet(x, y + 1) = f[1]) and
+ (ScrGet(x - 1, y) = f[2]) and
+ (ScrGet(x + 1, y) <> f[2])then
+ Result := f[10]
+ else if (ScrGet(x + 1, y) = f[2]) and
+ (ScrGet(x - 1, y) <> f[2]) and
+ (ScrGet(x, y + 1) = f[1]) and
+ (ScrGet(x, y - 1) <> f[1]) then
+ Result := f[3]
+ else if (ScrGet(x + 1, y) = f[2]) and
+ (ScrGet(x - 1, y) <> f[2]) and
+ (ScrGet(x, y + 1) <> f[1]) and
+ (ScrGet(x, y - 1) = f[1]) then
+ Result := f[5]
+ else if (ScrGet(x + 1, y) <> f[2]) and
+ (ScrGet(x - 1, y) = f[2]) and
+ (ScrGet(x, y + 1) <> f[1]) and
+ (ScrGet(x, y - 1) = f[1]) then
+ Result := f[6]
+ else if (ScrGet(x + 1, y) <> f[2]) and
+ (ScrGet(x - 1, y) = f[2]) and
+ (ScrGet(x, y + 1) = f[1]) and
+ (ScrGet(x, y - 1) <> f[1]) then
+ Result := f[4]
+ else
+ Result := c;
+ end;
+
+begin
+ if expBorders then
+ begin
+ if Length(expCustomFrameSet) > 0 then
+ f := CustomFrameSet
+ else if expBordersGraph then
+ f := FrameSet[2]
+ else
+ f := FrameSet[1];
+ for i := 0 to ScrHeight - 1 do
+ for j := 0 to ScrWidth - 1 do
+ begin
+ c := Scr[i * ScrWidth + j];
+ if IsConner(c) then
+ Scr[i * ScrWidth + j] := FrameOpt(c, j, i, f);
+ end;
+ end;
+ if not expLeadSpaces then
+ begin
+ maxcnt := 99999;
+ for i := 0 to ScrHeight - 1 do
+ begin
+ cnt := 0;
+ for j := 0 to ScrWidth - 1 do
+ if (Scr[i * ScrWidth + j] = ' ') then
+ Inc(cnt) else
+ break;
+ if cnt < maxcnt then
+ maxcnt := cnt;
+ end;
+ end
+ else
+ maxcnt := 0;
+ for i := 0 to ScrHeight - 1 do
+ begin
+ buf := '';
+ for j := 0 to ScrWidth - 1 do
+ buf := buf + Scr[i * ScrWidth + j];
+ buf := TrimRight(buf);
+ if (maxcnt > 0) then
+ buf := Copy(buf, maxcnt + 1, Length(buf) - maxcnt);
+ WriteExpLn(buf);
+ end;
+end;
+
+procedure TfrxTXTExport.FreeScr;
+begin
+ Finalize(Scr);
+ ScrHeight := 0;
+ ScrWidth := 0;
+end;
+
+procedure TfrxTXTExport.ScrType(x,y: Integer; c: Char);
+var
+ i: Integer;
+begin
+ i := ScrWidth * y + x;
+ if (not expOEM) and (c = #160) then
+ c := ' ';
+ Scr[i] := c;
+end;
+
+procedure TfrxTXTExport.ExportPage;
+var
+ i, x, y: Integer;
+ s: String;
+ obj: TfrxMemoView;
+begin
+ i := 0;
+ CreateScr(Round(expScaleX * MaxWidth / Xdivider) + 10, Round(expScaleY * LastY / Ydivider) + 2);
+ for y := 1 to RY.Count - 1 do
+ begin
+ for x := 1 to RX.Count - 1 do
+ if i < ObjectPos.Count then
+ if ((PObjPos(ObjectPos[i]).y + CurY + 1) = y) and
+ ((PObjPos(ObjectPos[i]).x + 1) = x) then
+ begin
+ Obj := TfrxMemoView(PageObj[PObjPos(ObjectPos[i]).obj]);
+ s := ChangeReturns(TruncReturns(Obj.Memo.Text));
+ DrawMemo(Round(expScaleX * obj.Left / Xdivider),
+ Round(expScaleY * obj.Top / Ydivider),
+ Round(expScaleX * obj.Width / Xdivider),
+ Round(expScaleY * obj.Height / Ydivider),
+ s, PObjPos(ObjectPos[i]).style);
+ Obj.Free;
+ Inc(i);
+ end;
+ end;
+ FlushScr;
+ FreeScr;
+end;
+
+
+function TfrxTXTExport.ShowModal: TModalResult;
+var
+ preview: Boolean;
+begin
+ if ShowDialog then
+ begin
+ preview := False;
+ frExportSet := TfrxTXTExportDialog.Create(nil);
+ frExportSet.Exporter := Self;
+ frExportSet.CB_PrintAfter.Visible := not SlaveExport;
+ if SlaveExport then
+ expPrintAfter := False;
+
+ if FileName = '' then
+ frExportSet.SaveDialog1.FileName := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(Report.FileName)), frExportSet.SaveDialog1.DefaultExt)
+ else
+ frExportSet.SaveDialog1.FileName := FileName;
+
+ if OverwritePrompt then
+ with frExportSet.SaveDialog1 do
+ Options := Options + [ofOverwritePrompt];
+
+ frExportSet.PreviewActive := false;
+ frExportSet.RB_Graph.Checked := expBordersGraph;
+ frExportSet.RB_NoneFrames.Checked := not expBorders;
+ frExportSet.RB_Simple.Checked := expBorders and (not expBordersGraph);
+ frExportSet.CB_PageBreaks.Checked := expPageBreaks;
+ frExportSet.CB_OEM.Checked := expOEM;
+ frExportSet.CB_EmptyLines.Checked := expEmptyLines;
+ frExportSet.CB_LeadSpaces.Checked := expLeadSpaces;
+ frExportSet.UpDown1.Position := StrToInt(IntToStr(Round(expScaleX * 100)));
+ frExportSet.UpDown2.Position := StrToInt(IntToStr(Round(expScaleY * 100)));
+ frExportSet.CB_PrintAfter.Checked := expPrintAfter;
+ frExportSet.PreviewActive := preview;
+ frExportSet.PagesCount := Report.PreviewPages.Count;
+ Result := frExportSet.ShowModal;
+ PeekLastModalResult;
+ if Result = mrOk then
+ begin
+ PageNumbers := frExportSet.E_Range.Text;
+ expBorders := not frExportSet.RB_NoneFrames.Checked;
+ expBordersGraph := frExportSet.RB_Graph.Checked;
+ expPageBreaks := frExportSet.CB_PageBreaks.Checked;
+ expOEM := frExportSet.CB_OEM.Checked;
+ expEmptyLines := frExportSet.CB_EmptyLines.Checked;
+ expLeadSpaces := frExportSet.CB_LeadSpaces.Checked;
+ expScaleX := StrToInt(frExportSet.E_ScaleX.Text) / 100;
+ expScaleY := StrToInt(frExportSet.E_ScaleY.Text) / 100;
+ expPrintAfter := frExportSet.CB_PrintAfter.Checked;
+ if frExportSet.MakeInit then
+ begin
+ SelectedPrinterType := frExportSet.printer;
+ MakeInitString;
+ end;
+ if DefaultPath <> '' then
+ frExportSet.SaveDialog1.InitialDir := DefaultPath;
+ if not SlaveExport then
+ begin
+ if frExportSet.SaveDialog1.Execute then
+ begin
+ FileName := frExportSet.SaveDialog1.Filename;
+ end
+ else
+ Result := mrCancel;
+ PeekLastModalResult;
+ end
+ end;
+ frExportSet.Free;
+ end
+ else
+ Result := mrOk;
+end;
+
+function TfrxTXTExport.Start: Boolean;
+begin
+ if SlaveExport then
+ begin
+ if Report.FileName <> '' then
+ FileName := ChangeFileExt(GetTemporaryFolder + ExtractFileName(Report.FileName), frxGet(8326))
+ else
+ FileName := ChangeFileExt(GetTempFile, frxGet(8326))
+ end;
+ CurrentPage := 0;
+ FirstPage := True;
+ ClearLastPage;
+ if not IsPreview then
+ WriteExp(PrinterInitString);
+ pgBreakList.Clear;
+ if FileName <> '' then
+ begin
+ if (ExtractFilePath(FileName) = '') and (DefaultPath <> '') then
+ FileName := DefaultPath + '\' + FileName;
+ Stream := TFileStream.Create(FileName, fmCreate);
+ Result := True
+ end
+ else
+ Result := False;
+end;
+
+procedure TfrxTXTExport.StartPage(Page: TfrxReportPage; Index: Integer);
+begin
+ Inc(CurrentPage);
+ MaxWidth := 0;
+ LastY := 0;
+ CY := 0;
+ CurY := 0;
+ PageWidth := 0;
+ PageHeight := 0;
+end;
+
+procedure TfrxTXTExport.ExportObject(Obj: TfrxComponent);
+var
+ MemoView: TfrxMemoView;
+ maxy: Extended;
+begin
+ if Obj is TfrxCustomMemoView then
+ begin
+ if ((TfrxMemoView(Obj).Memo.Count > 0) or (TfrxMemoView(Obj).Frame.Typ <> [])) then
+ begin
+ MemoView := TfrxMemoView.Create(nil);
+ MemoView.Assign(Obj);
+ MemoView.Left := Obj.AbsLeft;
+ MemoView.Top := Obj.AbsTop + CY;
+ MemoView.Width := Obj.Width;
+ MemoView.Height := Obj.Height;
+ MemoView.Font.Assign(Obj.Font); // added by Samuel Herzog
+
+ if StripHTMLTags then
+ MemoView.Text := MemoView.WrapText(False);
+
+ PageObj.Add(MemoView);
+ ObjCellAdd(RX, Obj.AbsLeft);
+ ObjCellAdd(RX, Obj.AbsLeft + Obj.Width);
+ ObjCellAdd(RY, Obj.AbsTop + CY);
+ ObjCellAdd(RY, Obj.AbsTop + Obj.Height + CY);
+ end;
+ end;
+ if Obj.AbsLeft + Obj.Width > MaxWidth then
+ MaxWidth := Obj.AbsLeft + Obj.Width;
+ maxy := Obj.AbsTop + Obj.Height + CY;
+ if maxy > LastY then
+ LastY := maxy;
+end;
+
+procedure TfrxTXTExport.FinishPage(Page: TfrxReportPage; Index: Integer);
+begin
+ PrepareExportPage;
+ ExportPage;
+ if expPageBreaks then
+ FormFeed;
+ ClearLastPage;
+end;
+
+procedure TfrxTXTExport.Finish;
+begin
+ if (not expPageBreaks) and (not IsPreview) then
+ FormFeed;
+ Stream.Free;
+ AfterExport(FileName);
+end;
+
+procedure TfrxTXTExport.SpoolFile(const FileName: String);
+const
+ BUF_SIZE = 1024;
+var
+ f: TFileStream;
+ buf: String;
+ l: longint;
+begin
+ frxPrinters.Printer.Title := FileName;
+ frxPrinters.Printer.BeginRAWDoc;
+ f := TFileStream.Create(FileName, fmOpenRead);
+ SetLength(buf, BUF_SIZE);
+ l := BUF_SIZE;
+ while l = BUF_SIZE do
+ begin
+ l := f.Read(buf[1], BUF_SIZE);
+ SetLength(buf, l);
+ frxPrinters.Printer.WriteRAWDoc(buf);
+ end;
+ f.Free;
+ frxPrinters.Printer.EndRAWDoc;
+ DeleteFile(FileName);
+end;
+
+function GetTempFName: String;
+var
+ Path: String[64];
+ FileName: String[255];
+begin
+ Path[0] := AnsiChar(Chr(GetTempPath(64, PWideChar(@Path[1]))));
+ GetTempFileName(@Path[1], PChar('fr'), 0, @FileName[1]);
+ Result := StrPas(PWideChar(@FileName[1]));
+end;
+
+procedure TfrxTXTExport.AfterExport(const FileName: String);
+var
+ i: Integer;
+ fname: String;
+ f, ffrom: TFileStream;
+begin
+ if expPrintAfter then
+ begin
+ if Printer.Printers.Count = 0 then Exit;
+ if expPrinterDialog then
+ with TfrxPrnInit.Create(Self) do
+ begin
+ i := ShowModal;
+ if i = mrOk then
+ Copys := UpDown1.Position;
+ Free;
+ end
+ else
+ i := mrOk;
+ if i = mrOk then
+ begin
+ MakeInitString;
+ fname := GetTempFName;
+ f := TFileStream.Create(fname, fmCreate);
+ ffrom := TFileStream.Create(FileName, fmOpenRead);
+ f.Write(PrinterInitString[1], Length(PrinterInitString));
+ f.CopyFrom(ffrom, 0);
+ f.Free;
+ ffrom.Free;
+ f := TFileStream.Create(FileName, fmCreate);
+ ffrom := TFileStream.Create(fname, fmOpenRead);
+ f.CopyFrom(ffrom, 0);
+ f.Free;
+ ffrom.Free;
+ DeleteFile(fname);
+ for i := 1 to Copys do
+ SpoolFile(FileName);
+ end;
+ end;
+end;
+
+procedure TfrxTXTExport.PrepareExportPage;
+begin
+ RX.Sort(@ComparePoints);
+ RY.Sort(@ComparePoints);
+ PageObj.Sort(@CompareObjects);
+ OrderObjectByCells;
+ MakeStyleList;
+end;
+
+function TfrxTXTExport.MakeInitString: String;
+var
+ i: Integer;
+begin
+ if PrintersCount > 0 then
+ begin
+ PrinterInitString := '';
+ for i := 0 to PrinterTypes[SelectedPrinterType].CommCount - 1 do
+ if PrinterTypes[SelectedPrinterType].Commands[i].Trigger then
+ PrinterInitString := PrinterInitString +
+ PrinterTypes[SelectedPrinterType].Commands[i].SwitchOn
+ else
+ PrinterInitString := PrinterInitString +
+ PrinterTypes[SelectedPrinterType].Commands[i].SwitchOff;
+ end;
+end;
+
+procedure TfrxTXTExport.RegisterPrinterCommand(PrinterIndex: Integer;
+ const Name, switch_on, switch_off: String);
+var
+ i: Integer;
+begin
+ i := PrinterTypes[PrinterIndex].CommCount;
+ PrinterTypes[PrinterIndex].Commands[i].Name := Name;
+ PrinterTypes[PrinterIndex].Commands[i].SwitchOn := Switch_On;
+ PrinterTypes[PrinterIndex].Commands[i].SwitchOff := Switch_Off;
+ PrinterTypes[PrinterIndex].Commands[i].Trigger := False;
+ Inc(PrinterTypes[PrinterIndex].CommCount);
+end;
+
+function TfrxTXTExport.RegisterPrinterType(const Name: String): Integer;
+begin
+ PrinterTypes[PrintersCount].Name := Name;
+ PrinterTypes[PrintersCount].CommCount := 0;
+ Inc(PrintersCount);
+ Result := PrintersCount - 1;
+end;
+
+procedure TfrxTXTExport.LoadPrinterInit(const FName: String);
+var
+ f: TextFile;
+ i: Integer;
+ buf: String;
+ b: Boolean;
+begin
+{$I-}
+ AssignFile(f, FName);
+ Reset(f);
+ ReadLn(f, buf);
+ SelectedPrinterType := StrToInt(buf);
+ i := 0;
+ while (not eof(f)) and (i < PrinterTypes[SelectedPrinterType].CommCount) do
+ begin
+ ReadLn(f, buf);
+ if Pos('True', buf) > 0 then
+ b := True
+ else
+ b := False;
+ PrinterTypes[SelectedPrinterType].Commands[i].Trigger := b;
+ Inc(i);
+ end;
+ MakeInitString;
+{$I+}
+end;
+
+procedure TfrxTXTExport.SavePrinterInit(const FName: String);
+var
+ f: TextFile;
+ i: Integer;
+ s: String;
+begin
+{$I-}
+ AssignFile(f, FName);
+ Rewrite(f);
+ WriteLn(f, IntToStr(SelectedPrinterType));
+ for i := 0 to PrinterTypes[SelectedPrinterType].CommCount - 1 do
+ begin
+ if PrinterTypes[SelectedPrinterType].Commands[i].Trigger then
+ s := 'True' else
+ s := 'False';
+ WriteLn(f, s);
+ end;
+ CloseFile(f);
+{$I+}
+end;
+
+procedure TfrxTXTExport.FormFeed;
+begin
+ WriteExp(#12);
+end;
+
+//////////////////////////////////////////////
+
+procedure TfrxTXTExportDialog.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(8300);
+ OK.Caption := frxGet(1);
+ Cancel.Caption := frxGet(2);
+ BtnPreview.Hint := frxGet(8301);
+ GroupCellProp.Caption := frxGet(8302);
+ CB_PageBreaks.Caption := frxGet(8303);
+ CB_OEM.Caption := frxGet(8304);
+ CB_EmptyLines.Caption := frxGet(8305);
+ CB_LeadSpaces.Caption := frxGet(8306);
+ GroupPageRange.Caption := frxGet(7);
+ Pages.Caption := frxGet(8307);
+ Descr.Caption := frxGet(8308);
+ GroupScaleSettings.Caption := frxGet(8309);
+ ScX.Caption := frxGet(8310);
+ ScY.Caption := frxGet(8311);
+ GroupFramesSettings.Caption := frxGet(8312);
+ RB_NoneFrames.Caption := frxGet(8313);
+ RB_Simple.Caption := frxGet(8314);
+ RB_Graph.Caption := frxGet(8315);
+ RB_Graph.Hint := frxGet(8316);
+ CB_PrintAfter.Caption := frxGet(8317);
+ GroupBox1.Caption := frxGet(8319);
+ Label1.Caption := frxGet(8320);
+ Label3.Caption := frxGet(8321);
+ LBPage.Caption := frxGet(8322);
+ ToolButton1.Hint := frxGet(8323);
+ ToolButton2.Hint := frxGet(8324);
+ SaveDialog1.Filter := frxGet(8325);
+ SaveDialog1.DefaultExt := frxGet(8326);
+
+ created := False;
+ TxtExp := TfrxTXTExport.CreateNoRegister;
+ BtnPreviewClick(Sender);
+ Created := True;
+ MakeInit := False;
+ printer := 0;
+ PageUpDown.Max := PagesCount;
+ running := False;
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+ if UseRightToLeftAlignment then
+ FlipChildren(True);
+end;
+
+procedure TfrxTXTExportDialog.CB_OEMClick(Sender: TObject);
+begin
+ RB_Graph.Enabled := CB_OEM.Checked;
+ if not RB_Simple.Checked then
+ RB_Simple.Checked := RB_Graph.Checked;
+ E_ScaleXChange(Sender);
+end;
+
+procedure TfrxTXTExportDialog.RefreshClick(Sender: TObject);
+var
+ fname: String;
+ Progr: Boolean;
+begin
+ if Flag then
+ begin
+ running := true;
+ fname := GetTempFName;
+ TxtExp.IsPreview := True;
+ TxtExp.ShowDialog := False;
+ TxtExp.Borders := not RB_NoneFrames.Checked;
+ TxtExp.Pseudogrpahic := RB_Graph.Checked;
+ TxtExp.PageBreaks := CB_PageBreaks.Checked;
+ TxtExp.OEMCodepage := CB_OEM.Checked;
+ TxtExp.EmptyLines := CB_EmptyLines.Checked;
+ TxtExp.LeadSpaces := CB_LeadSpaces.Checked;
+ TxtExp.ScaleWidth := StrToInt(E_ScaleX.Text) / 100;
+ TxtExp.ScaleHeight := StrToInt(E_ScaleY.Text) / 100;
+ progr := Exporter.ShowProgress;
+ Exporter.ShowProgress := False;
+ TxtExp.FileName := fname;
+ TxtExp.PageNumbers := EPage.Text;
+ Exporter.Report.Export(TxtExp);
+ Exporter.ShowProgress := progr;
+ if CB_OEM.Checked then
+ Preview.Font.Name := 'Terminal' else
+ Preview.Font.Name := 'Courier New';
+ Preview.Lines.LoadFromFile(fname);
+ DeleteFile(fname);
+ PgWidth.Caption := IntToStr(TxtExp.PageWidth);
+ PgHeight.Caption := IntToStr(TxtExp.PageHeight);
+ running := false;
+ end;
+end;
+
+procedure TfrxTXTExportDialog.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ TxtExp.Free;
+end;
+
+procedure TfrxTXTExportDialog.FormActivate(Sender: TObject);
+begin
+{ CB_OEMClick(Sender);
+ if PreviewActive then
+ BtnPreview.Down := True;
+ BtnPreviewClick(Sender);}
+end;
+
+procedure TfrxTXTExportDialog.E_ScaleXChange(Sender: TObject);
+begin
+ if PreviewActive then
+ RefreshClick(Sender);
+end;
+
+procedure TfrxTXTExportDialog.BtnPreviewClick(Sender: TObject);
+begin
+ if BtnPreview.Down then
+ begin
+ PreviewActive := True;
+ Left := Left - 177;
+ Width := 631;
+ Panel2.Visible := True;
+ Flag := True;
+ E_ScaleXChange(Sender);
+ end
+ else
+ begin
+ if created and PreviewActive then
+ Left := Left + 177;
+ Flag := False;
+ PreviewActive := False;
+ Width := 277;
+ Panel2.Visible := False;
+ end;
+end;
+
+procedure TfrxTXTExportDialog.ToolButton1Click(Sender: TObject);
+begin
+ if Preview.Font.Size < 30 then
+ Preview.Font.Size := Preview.Font.Size + 1;
+end;
+
+procedure TfrxTXTExportDialog.ToolButton2Click(Sender: TObject);
+begin
+ if Preview.Font.Size > 2 then
+ Preview.Font.Size := Preview.Font.Size - 1;
+end;
+
+procedure TfrxTXTExportDialog.UpDown1Changing(Sender: TObject;
+ var AllowChange: Boolean);
+begin
+ if PreviewActive then
+ if not running then
+ RefreshClick(Sender)
+ else
+ AllowChange := False;
+end;
+
+procedure TfrxTXTExportDialog.FormKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ if Key = VK_F1 then
+ frxResources.Help(Self);
+end;
+
+end.
diff --git a/LibD28/FMX.frxExportText.fmx b/LibD28/FMX.frxExportText.fmx
new file mode 100644
index 0000000..e3cc4a8
--- /dev/null
+++ b/LibD28/FMX.frxExportText.fmx
@@ -0,0 +1,115 @@
+object frxSimpleTextExportDialog: TfrxSimpleTextExportDialog
+ Left = 0
+ Top = 0
+ Caption = 'Export to Text'
+ ClientHeight = 279
+ ClientWidth = 277
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ ActiveControl = OkB
+ StyleLookup = 'backgroundstyle'
+ object OkB: TButton
+ Position.Point = '(118,248)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(198,248)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object GroupPageRange: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 269.000000000000000000
+ Height = 141.000000000000000000
+ TabOrder = 2
+ object DescrL: TLabel
+ Position.Point = '(12,82)'
+ Width = 249.000000000000000000
+ Height = 47.000000000000000000
+ TabOrder = 0
+ end
+ object AllRB: TRadioButton
+ Position.Point = '(12,20)'
+ Width = 153.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 108
+ TabOrder = 1
+ IsChecked = True
+ end
+ object CurPageRB: TRadioButton
+ Position.Point = '(12,40)'
+ Width = 153.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 118
+ TabOrder = 2
+ end
+ object PageNumbersRB: TRadioButton
+ Position.Point = '(12,60)'
+ Width = 77.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 124
+ TabOrder = 3
+ end
+ object PageNumbersE: TEdit
+ Position.Point = '(92,58)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 133
+ TabOrder = 4
+ KeyboardType = vktDefault
+ OnChange = PageNumbersEChange
+ Password = False
+ end
+ end
+ object GroupQuality: TGroupBox
+ Position.Point = '(4,144)'
+ Width = 269.000000000000000000
+ Height = 69.000000000000000000
+ TabOrder = 3
+ object PageBreaksCB: TCheckBox
+ Position.Point = '(12,20)'
+ Width = 121.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 0
+ end
+ object FramesCB: TCheckBox
+ Position.Point = '(12,40)'
+ Width = 121.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ object EmptyLinesCB: TCheckBox
+ Position.Point = '(136,20)'
+ Width = 121.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object OEMCB: TCheckBox
+ Position.Point = '(136,40)'
+ Width = 121.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ end
+ object OpenCB: TCheckBox
+ Position.Point = '(16,220)'
+ Width = 253.000000000000000000
+ Height = 17.000000000000000000
+ Visible = False
+ TabOrder = 4
+ end
+ object SaveDialog1: TSaveDialog
+ DefaultExt = '.txt'
+ Filter = 'Text file (*.txt)|*.txt'
+ Options = [ofHideReadOnly, ofNoChangeDir, ofEnableSizing]
+ end
+end
diff --git a/LibD28/FMX.frxExportText.pas b/LibD28/FMX.frxExportText.pas
new file mode 100644
index 0000000..d8623be
--- /dev/null
+++ b/LibD28/FMX.frxExportText.pas
@@ -0,0 +1,594 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Simple text export }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Fediachov, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxExportText;
+
+interface
+
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.frxExportMatrix, FMX.Edit, FMX.Types, System.UITypes,
+ System.Types, System.Variants, FMX.frxBaseModalForm
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+type
+ TfrxSimpleTextExportDialog = class(TfrxForm)
+ OkB: TButton;
+ CancelB: TButton;
+ SaveDialog1: TSaveDialog;
+ GroupPageRange: TGroupBox;
+ DescrL: TLabel;
+ AllRB: TRadioButton;
+ CurPageRB: TRadioButton;
+ PageNumbersRB: TRadioButton;
+ PageNumbersE: TEdit;
+ GroupQuality: TGroupBox;
+ PageBreaksCB: TCheckBox;
+ OpenCB: TCheckBox;
+ FramesCB: TCheckBox;
+ EmptyLinesCB: TCheckBox;
+ OEMCB: TCheckBox;
+ procedure FormCreate(Sender: TObject);
+ procedure PageNumbersEChange(Sender: TObject);
+ procedure PageNumbersEKeyPress(Sender: TObject; var Key: Char);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ end;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxSimpleTextExport = class(TfrxCustomExportFilter)
+ private
+ FPageBreaks: Boolean;
+ FMatrix: TfrxIEMatrix;
+ FOpenAfterExport: Boolean;
+ Exp: TStream;
+ FPage: TfrxReportPage;
+ FFrames: Boolean;
+ pX: Extended;
+ pY: Extended;
+ pT: Extended;
+ FEmptyLines: Boolean;
+ FOEM: Boolean;
+ FDeleteEmptyColumns: Boolean;
+ procedure ExportPage(Stream: TStream);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ function ShowModal: TModalResult; override;
+ function Start: Boolean; override;
+ procedure Finish; override;
+ procedure FinishPage(Page: TfrxReportPage; Index: Integer); override;
+ procedure StartPage(Page: TfrxReportPage; Index: Integer); override;
+ procedure ExportObject(Obj: TfrxComponent); override;
+ published
+ property PageBreaks: Boolean read FPageBreaks write FPageBreaks default True;
+ property Frames: Boolean read FFrames write FFrames;
+ property EmptyLines: Boolean read FEmptyLines write FEmptyLines;
+ property OEMCodepage: Boolean read FOEM write FOEM;
+ property OpenAfterExport: Boolean read FOpenAfterExport write FOpenAfterExport default False;
+ property OverwritePrompt;
+ property DeleteEmptyColumns: Boolean read FDeleteEmptyColumns write FDeleteEmptyColumns;
+ end;
+
+
+implementation
+
+uses FMX.frxUtils, {frxFileUtils,} FMX.frxUnicodeUtils, FMX.frxRes, FMX.frxFMX, FMX.frxrcExports
+ {$IFDEF MSWINDOWS}
+ , Winapi.ShellAPI
+ {$ENDIF}
+ {$IFDEF LINUX}
+ ,FMUX.Api
+ {$ENDIF};
+
+{$R *.fmx}
+
+function Trim(const S: AnsiString): AnsiString;
+var
+ I, L: Integer;
+begin
+ L := Length(S);
+ I := 1;
+ while (I <= L) and (S[I] <= ' ') do Inc(I);
+ if I > L then Result := '' else
+ begin
+ while S[L] <= ' ' do Dec(L);
+ Result := Copy(S, I, L - I + 1);
+ end;
+end;
+
+function TrimRight(const S: AnsiString): AnsiString;
+var
+ I: Integer;
+begin
+ I := Length(S);
+ while (I > 0) and (S[I] <= ' ') do Dec(I);
+ Result := Copy(S, 1, I);
+end;
+
+{ TfrxSimpleTextExport }
+
+constructor TfrxSimpleTextExport.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FPageBreaks := True;
+ FFrames := False;
+ FEmptyLines := False;
+ FOEM := False;
+ FDeleteEmptyColumns := True;
+ FilterDesc := frxGet(8801);
+ DefaultExt := frxGet(8802);
+end;
+
+class function TfrxSimpleTextExport.GetDescription: String;
+begin
+ Result := frxResources.Get('SimpleTextExport');
+end;
+
+procedure TfrxSimpleTextExport.ExportPage(Stream: TStream);
+var
+ x, y, i: Integer;
+ FScreen: array of AnsiChar;
+ FScreenWidth: Integer;
+ FScreenHeight: Integer;
+ Obj: TfrxIEMObject;
+ ObjBounds: TfrxRect;
+ ObjWidth, ObjHeight: Extended;
+ c: AnsiChar;
+ s: AnsiString;
+
+ procedure InitObjBounds(Obj: TfrxIEMObject);
+ begin
+ ObjBounds := FMatrix.GetObjectBounds(Obj);
+ ObjWidth := ObjBounds.Right - ObjBounds.Left;
+ ObjHeight := ObjBounds.Bottom - ObjBounds.Top;
+ end;
+
+ function MakeStr(C: AnsiChar; N: Integer): AnsiString;
+ begin
+ if N < 1 then
+ Result := ''
+ else
+ begin
+ SetLength(Result, N);
+ FillChar(Result[1], Length(Result), C);
+ end;
+ end;
+
+ function AddChar(C: AnsiChar; const S: AnsiString; N: Integer): AnsiString;
+ begin
+ if Length(S) < N then
+ Result := MakeStr(C, N - Length(S)) + S else
+ Result := S;
+ end;
+
+ function AddCharR(C: AnsiChar; const S: AnsiString; N: Integer): AnsiString;
+ begin
+ if Length(S) < N then
+ Result := S + MakeStr(C, N - Length(S)) else
+ Result := S;
+ end;
+
+ function LeftStr(const S: AnsiString; N: Integer): AnsiString;
+ begin
+ Result := AddCharR(' ', S, N);
+ end;
+
+ function RightStr(const S: AnsiString; N: Integer): AnsiString;
+ begin
+ Result := AddChar(' ', S, N);
+ end;
+
+ function CenterStr(const S: AnsiString; Len: Integer): AnsiString;
+ begin
+ if Length(S) < Len then
+ begin
+ Result := MakeStr(' ', (Len div 2) - (Length(S) div 2)) + S;
+ Result := Result + MakeStr(' ', Len - Length(Result));
+ end
+ else
+ Result := S;
+ end;
+
+ function AlignStr(const Buf: AnsiString; const style: TfrxIEMStyle; const Width: Integer): AnsiString;
+ begin
+ if (style.HAlign = haRight) then
+ Result := RightStr(buf, Width - 1)
+ else if (style.HAlign = haCenter) then
+ Result := CenterStr(buf, Width - 1)
+ else
+ Result := LeftStr(buf, Width - 1);
+ end;
+
+ procedure ScreenCreate;
+ begin
+ Initialize(FScreen);
+ SetLength(FScreen, FScreenWidth * FScreenHeight);
+ FillChar(FScreen[0], Length(FScreen), #32);
+ end;
+
+ procedure ScreenType(const x,y: Integer; const c: AnsiChar);
+ begin
+ FScreen[FScreenWidth * y + x] := c;
+ end;
+
+ procedure ScreenString(const x, y: Integer; const s: AnsiString);
+ var
+ i: Integer;
+ begin
+ for i := 0 to Length(s) - 1 do
+ ScreenType(x + i, y, s[i + 1]);
+ end;
+
+ procedure ScreenMemo(const Obj: TfrxIEMObject);
+ var
+ i: Integer;
+ curx, cury: Integer;
+ s: AnsiString;
+
+ function StrToOem(const AnsiStr: AnsiString): AnsiString;
+ begin
+ Result := AnsiStr;// todo
+ {SetLength(Result, Length(AnsiStr));
+ if Length(Result) > 0 then
+ CharToOemBuffA(PAnsiChar(AnsiStr), PAnsiChar(Result), Length(Result)); }
+ end;
+
+ begin
+ curx := Round(ObjBounds.Left / pX);
+ cury := Round(ObjBounds.Top / pY);
+ for i := 0 to Obj.Memo.Count - 1 do
+ begin
+ if FOEM then
+ s := StrToOem(AnsiString(Obj.Memo[i]))
+ else // todo use LocaleCharsFromUnicode
+ s := AnsiString(Obj.Memo[i]);
+ ScreenString(curx, cury + i, AlignStr(s, Obj.Style, Round(ObjWidth / pX) - 1));
+ end;
+ if FFrames then
+ begin
+ if (ftLeft in Obj.Style.FrameTyp) then
+ for i := 0 to Round(ObjHeight / pY) - 1 do
+ ScreenType(curx - 1, cury + i, '|');
+ if (ftRight in Obj.Style.FrameTyp) then
+ for i := 0 to Round(ObjHeight / pY) - 1 do
+ ScreenType(curx + Round(ObjWidth / pX) - 2, cury + i, '|');
+ if (ftTop in Obj.Style.FrameTyp) then
+ for i := 0 to Round(ObjWidth / pX) - 1 do
+ ScreenType(curx - 1 + i, cury - 1, '-');
+ if (ftBottom in Obj.Style.FrameTyp) then
+ for i := 0 to Round(ObjWidth / pX) - 1 do
+ ScreenType(curx - 1 + i, cury + Round(ObjHeight / pY) - 1, '-');
+ end;
+ end;
+
+ function ScreenGet(const x, y: Integer): AnsiChar;
+ begin
+ if (x < FScreenWidth) and (y < FScreenHeight) and
+ (x >= 0) and (y >= 0) then
+ Result := FScreen[FScreenWidth * y + x] else
+ Result := ' ';
+ end;
+
+ function GetMaxPX(const Obj: TfrxIEMObject): Extended;
+ var
+ i : Integer;
+ begin
+ Result := 0;
+ for i := 0 to Obj.Memo.Count - 1 do
+ if Length(Obj.Memo[i]) > Result then
+ Result := Length(Obj.Memo[i]);
+ if (Result > 0) then //and (Obj.Width )
+ Result := 6 * ObjWidth / (Result * Obj.Style.Font.Size);
+ if Result < 1 then
+ Result := 1;
+ end;
+
+ function GetMaxPY(const Obj: TfrxIEMObject): Extended;
+ begin
+ if Obj.Memo.Count > 0 then
+ Result := 5 * ObjHeight / (Obj.Memo.Count * Obj.Style.Font.Size)
+ else
+ Result := 0;
+ end;
+
+ function ColumnEmpty(const x: Integer): Boolean;
+ var
+ y: Integer;
+ begin
+ Result := True;
+ for y := 0 to FScreenHeight - 1 do
+ if FScreen[FScreenWidth * y + x] <> #32 then
+ begin
+ Result := False;
+ break;
+ end;
+ end;
+
+ procedure DeleteColumn(const x: Integer);
+ var
+ i, j: Integer;
+ begin
+ for i := 0 to FScreenHeight - 1 do
+ begin
+ for j := x to FScreenWidth - 2 do
+ FScreen[FScreenWidth * i + j] := FScreen[FScreenWidth * i + j + 1];
+ FScreen[FScreenWidth * i + FScreenWidth - 1] := #32;
+ end;
+ end;
+
+begin
+ FMatrix.Prepare;
+
+ for i := 0 to FMatrix.ObjectsCount - 1 do
+ begin
+ Obj := FMatrix.GetObjectById(i);
+ InitObjBounds(Obj);
+
+ pT := GetMaxPX(Obj);
+
+ if (pT < pX) and (pT <> 0) then
+ pX := pT;
+
+ pT := GetMaxPY(Obj);
+
+ if (pT < pY) and (pT <> 0) then
+ pY := pT;
+ end;
+
+ FScreenWidth := Round(FPage.Width / pX);
+ FScreenHeight := Round(FPage.Height / pY);
+ ScreenCreate;
+
+ for y := 0 to FMatrix.Height - 2 do
+ begin
+ for x := 0 to FMatrix.Width - 1 do
+ begin
+ i := FMatrix.GetCell(x, y);
+ if (i <> -1) then
+ begin
+ Obj := FMatrix.GetObjectById(i);
+ InitObjBounds(Obj);
+ ScreenMemo(Obj);
+ end;
+ end;
+ end;
+
+ x := 0;
+ i := 2;
+ y := FScreenWidth;
+ while x < y - 1 do
+ if DeleteEmptyColumns and ColumnEmpty(x) then
+ if i = 0 then
+ begin
+ DeleteColumn(x);
+ Dec(y);
+ end
+ else
+ begin
+ Dec(i);
+ Inc(x);
+ end
+ else
+ begin
+ Inc(x);
+ i := 2;
+ end;
+
+ for y := 0 to FScreenHeight - 1 do
+ begin
+ s := '';
+ for x := 0 to FScreenWidth - 1 do
+ begin
+ c := ScreenGet(x, y);
+ s := s + c;
+ end;
+ s := TrimRight(s);
+ if (Length(Trim(s)) > 0) or FEmptyLines then
+ begin
+ s := s + #13#10;
+ Stream.Write(s[1], Length(s));
+ end;
+ end;
+ if FPageBreaks then
+ Stream.Write(AnsiString(#12), 1);
+end;
+
+function TfrxSimpleTextExport.ShowModal: TModalResult;
+begin
+ if not Assigned(Stream) then
+ begin
+ with TfrxSimpleTextExportDialog.Create(nil) do
+ begin
+ OpenCB.Visible := not SlaveExport;
+ if OverwritePrompt then
+ SaveDialog1.Options := SaveDialog1.Options + [TOpenOption.ofOverwritePrompt];
+ if SlaveExport then
+ FOpenAfterExport := False;
+
+ if (FileName = '') and (not SlaveExport) then
+ SaveDialog1.FileName := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(Report.FileName)), SaveDialog1.DefaultExt)
+ else
+ SaveDialog1.FileName := FileName;
+
+ PageBreaksCB.IsChecked := FPageBreaks;
+ OpenCB.IsChecked := FOpenAfterExport;
+ FramesCB.IsChecked := FFrames;
+ EmptyLinesCB.IsChecked := FEmptyLines;
+ OEMCB.IsChecked := FOEM;
+
+ if PageNumbers <> '' then
+ begin
+ PageNumbersE.Text := PageNumbers;
+ PageNumbersRB.IsChecked := True;
+ end;
+
+ Result := ShowModal;
+ PeekLastModalResult;
+ if Result = mrOk then
+ begin
+ PageNumbers := '';
+ CurPage := False;
+ if CurPageRB.IsChecked then
+ CurPage := True
+ else if PageNumbersRB.IsChecked then
+ PageNumbers := PageNumbersE.Text;
+
+ FPageBreaks := PageBreaksCB.IsChecked;
+ FOpenAfterExport := OpenCB.IsChecked;
+ FFrames := FramesCB.IsChecked;
+ FEmptyLines := EmptyLinesCB.IsChecked;
+ FOEM := OEMCB.IsChecked;
+
+ if not SlaveExport then
+ begin
+ if DefaultPath <> '' then
+ SaveDialog1.InitialDir := DefaultPath;
+ if SaveDialog1.Execute then
+ FileName := SaveDialog1.FileName
+ else
+ Result := mrCancel;
+ PeekLastModalResult;
+ end
+ end;
+ Free;
+ end;
+ end else
+ Result := mrOk;
+end;
+
+function TfrxSimpleTextExport.Start: Boolean;
+begin
+ if (FileName <> '') or Assigned(Stream) then
+ begin
+ if (ExtractFilePath(FileName) = '') and (DefaultPath <> '') then
+ FileName := DefaultPath + '\' + FileName;
+ FMatrix := TfrxIEMatrix.Create(UseFileCache, Report.EngineOptions.TempDir);
+ FMatrix.Background := False;
+ FMatrix.BackgroundImage := False;
+ FMatrix.Printable := ExportNotPrintable;
+ FMatrix.RichText := True;
+ FMatrix.PlainRich := True;
+ FMatrix.AreaFill := False;
+ FMatrix.CropAreaFill := True;
+ FMatrix.Inaccuracy := 0.5;
+ FMatrix.DeleteHTMLTags := True;
+ FMatrix.Images := False;
+ FMatrix.WrapText := True;
+ FMatrix.ShowProgress := False;
+ FMatrix.FramesOptimization := True;
+ try
+ if Assigned(Stream) then
+ Exp := Stream
+ else
+ Exp := TFileStream.Create(FileName, fmCreate);
+ Result := True;
+ except
+ Result := False;
+ end;
+ end
+ else
+ Result := False;
+end;
+
+procedure TfrxSimpleTextExport.StartPage(Page: TfrxReportPage; Index: Integer);
+begin
+ FMatrix.Clear;
+ pX := 65535;
+ pY := 65535;
+end;
+
+procedure TfrxSimpleTextExport.ExportObject(Obj: TfrxComponent);
+begin
+ if Obj is TfrxView then
+ FMatrix.AddObject(TfrxView(Obj));
+end;
+
+procedure TfrxSimpleTextExport.FinishPage(Page: TfrxReportPage; Index: Integer);
+begin
+ FPage := Page;
+ ExportPage(Exp);
+end;
+
+procedure TfrxSimpleTextExport.Finish;
+begin
+ FMatrix.Free;
+ if not Assigned(Stream) then
+ Exp.Free;
+ if FOpenAfterExport and (not Assigned(Stream)) then
+{$IFDEF MSWINDOWS}
+ ShellExecute(0, 'open', PChar(FileName), '', '', 5);
+{$ENDIF}
+{$IFDEF LINUX}
+ FmuxOpenFile(PChar(FileName));
+{$ENDIF}
+{$IFDEF MACOS}
+ ShellExecute(FileName);
+{$ENDIF}
+end;
+
+{ TfrxSimpleTextExportDialog }
+
+procedure TfrxSimpleTextExportDialog.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(8800);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ GroupPageRange.Text := frxGet(7);
+ AllRB.Text := frxGet(3);
+ CurPageRB.Text := frxGet(4);
+ PageNumbersRB.Text := frxGet(5);
+ DescrL.Text := frxGet(9);
+ GroupQuality.Text := frxGet(8302);
+ PageBreaksCB.Text := frxGet(6);
+ FramesCB.Text := frxGet(8312);
+ EmptyLinesCB.Text := frxGet(8305);
+ OEMCB.Text := frxGet(8304);
+ OpenCB.Text := frxGet(8706);
+ SaveDialog1.Filter := frxGet(8801);
+ SaveDialog1.DefaultExt := frxGet(8802);
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxSimpleTextExportDialog.PageNumbersEChange(Sender: TObject);
+begin
+ PageNumbersRB.IsChecked := True;
+end;
+
+procedure TfrxSimpleTextExportDialog.PageNumbersEKeyPress(Sender: TObject;
+ var Key: Char);
+begin
+ case key of
+ '0'..'9':;
+ #8, '-', ',':;
+ else
+ key := #0;
+ end;
+end;
+
+procedure TfrxSimpleTextExportDialog.FormKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+begin
+//todo
+ {if Key = VK_F1 then
+ frxResources.Help(Self);}
+end;
+
+end.
diff --git a/LibD28/FMX.frxExportXML.fmx b/LibD28/FMX.frxExportXML.fmx
new file mode 100644
index 0000000..ce92e67
--- /dev/null
+++ b/LibD28/FMX.frxExportXML.fmx
@@ -0,0 +1,210 @@
+object frxXMLExportDialog: TfrxXMLExportDialog
+ Left = 0
+ Top = 0
+ Caption = 'Export to Excel'
+ ClientHeight = 364
+ ClientWidth = 277
+ Position = poScreenCenter
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ object OkB: TButton
+ Default = True
+ DisableFocusEffect = False
+ Height = 25.000000000000000000
+ ModalResult = 1
+ Position.X = 118.000000000000000000
+ Position.Y = 336.000000000000000000
+ Text = 'OK'
+ Width = 75.000000000000000000
+ end
+ object CancelB: TButton
+ Cancel = True
+ DisableFocusEffect = False
+ Height = 25.000000000000000000
+ ModalResult = 2
+ Position.X = 198.000000000000000000
+ Position.Y = 336.000000000000000000
+ Text = 'Cancel'
+ Width = 75.000000000000000000
+ end
+ object GroupPageRange: TGroupBox
+ Height = 121.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 4.000000000000000000
+ Text = ' Page range '
+ Width = 269.000000000000000000
+ object DescrL: TLabel
+ Height = 29.000000000000000000
+ Position.X = 12.000000000000000000
+ Position.Y = 82.000000000000000000
+ Text =
+ 'Enter page numbers and/or page ranges, separated by commas. For ' +
+ 'example, 1,3,5-12'
+ Width = 249.000000000000000000
+ end
+ object AllRB: TRadioButton
+ DisableFocusEffect = False
+ GroupName = '1'
+ Height = 17.000000000000000000
+ HelpContext = 108
+ IsChecked = True
+ Position.X = 12.000000000000000000
+ Position.Y = 20.000000000000000000
+ TabOrder = 0
+ Text = 'All'
+ Width = 153.000000000000000000
+ end
+ object CurPageRB: TRadioButton
+ DisableFocusEffect = False
+ GroupName = '1'
+ Height = 17.000000000000000000
+ HelpContext = 118
+ Position.X = 12.000000000000000000
+ Position.Y = 40.000000000000000000
+ TabOrder = 1
+ Text = 'Current page'
+ Width = 245.000000000000000000
+ end
+ object PageNumbersRB: TRadioButton
+ DisableFocusEffect = False
+ GroupName = '1'
+ Height = 17.000000000000000000
+ HelpContext = 124
+ Position.X = 12.000000000000000000
+ Position.Y = 60.000000000000000000
+ TabOrder = 2
+ Text = 'Pages:'
+ Width = 77.000000000000000000
+ end
+ object PageNumbersE: TEdit
+ TabOrder = 3
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ Password = False
+ Position.X = 92.000000000000000000
+ Position.Y = 58.000000000000000000
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 133
+ OnChange = PageNumbersEChange
+ OnKeyDown = PageNumbersEKeyDown
+ end
+ end
+ object GroupQuality: TGroupBox
+ Height = 65.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 128.000000000000000000
+ Text = ' Quality properties '
+ Width = 269.000000000000000000
+ object WCB: TCheckBox
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ IsChecked = True
+ Position.X = 140.000000000000000000
+ Position.Y = 20.000000000000000000
+ Text = 'WYSIWYG'
+ Width = 121.000000000000000000
+ end
+ object ContinuousCB: TCheckBox
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ IsChecked = True
+ Position.X = 12.000000000000000000
+ Position.Y = 20.000000000000000000
+ Text = 'Continuous'
+ Width = 121.000000000000000000
+ end
+ object PageBreaksCB: TCheckBox
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ IsChecked = True
+ Position.X = 12.000000000000000000
+ Position.Y = 40.000000000000000000
+ Text = 'Page breaks'
+ Width = 121.000000000000000000
+ end
+ object BackgrCB: TCheckBox
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ IsChecked = True
+ Position.X = 140.000000000000000000
+ Position.Y = 40.000000000000000000
+ Text = 'Background'
+ Width = 121.000000000000000000
+ end
+ end
+ object OpenExcelCB: TCheckBox
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ IsChecked = True
+ Position.X = 12.000000000000000000
+ Position.Y = 308.000000000000000000
+ Text = 'Open Excel after export'
+ Width = 257.000000000000000000
+ end
+ object SplitToSheetGB: TGroupBox
+ Height = 110.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 195.000000000000000000
+ Text = 'Split pages to sheets'
+ Width = 269.000000000000000000
+ object RPagesRB: TRadioButton
+ DisableFocusEffect = False
+ GroupName = '2'
+ Height = 17.000000000000000000
+ HelpContext = 108
+ Position.X = 12.000000000000000000
+ Position.Y = 40.000000000000000000
+ Text = 'Use report pages'
+ Width = 245.000000000000000000
+ end
+ object PrintOnPrevRB: TRadioButton
+ DisableFocusEffect = False
+ GroupName = '2'
+ Height = 17.000000000000000000
+ HelpContext = 118
+ Position.X = 12.000000000000000000
+ Position.Y = 60.000000000000000000
+ Text = 'Use print on previous page'
+ Width = 245.000000000000000000
+ end
+ object RowsCountRB: TRadioButton
+ DisableFocusEffect = False
+ GroupName = '2'
+ Height = 17.000000000000000000
+ HelpContext = 124
+ Position.X = 12.000000000000000000
+ Position.Y = 80.000000000000000000
+ Text = 'Rows count:'
+ Width = 133.000000000000000000
+ end
+ object ERows: TEdit
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ Password = False
+ Position.X = 152.000000000000000000
+ Position.Y = 78.000000000000000000
+ Width = 105.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 133
+ OnChange = ERowsChange
+ OnKeyDown = ERowsKeyDown
+ end
+ object NotSplitRB: TRadioButton
+ DisableFocusEffect = False
+ GroupName = '2'
+ Height = 17.000000000000000000
+ HelpContext = 108
+ IsChecked = True
+ Position.X = 12.000000000000000000
+ Position.Y = 20.000000000000000000
+ Text = 'Don'#39't split'
+ Width = 245.000000000000000000
+ end
+ end
+ object SaveDialog1: TSaveDialog
+ FilterIndex = 0
+ Options = [ofHideReadOnly, ofNoChangeDir, ofEnableSizing]
+ Top = 336
+ end
+end
diff --git a/LibD28/FMX.frxExportXML.pas b/LibD28/FMX.frxExportXML.pas
new file mode 100644
index 0000000..1239971
--- /dev/null
+++ b/LibD28/FMX.frxExportXML.pas
@@ -0,0 +1,849 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ XML Excel export }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Fediachov, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+{ Improved by Bysoev Alexander }
+{ Kanal-B@Yandex.ru }
+{******************************************}
+
+unit FMX.frxExportXML;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Types, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.frxExportMatrix, FMX.frxProgress, fmx.frxImageConverter, System.UIConsts,
+ System.Variants, FMX.Edit, FMX.ListBox, FMX.frxBaseModalForm
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+type
+ TfrxSplitToSheet = (ssNotSplit, ssRPages, ssPrintOnPrev, ssRowsCount);
+
+ TfrxXMLExportDialog = class(TfrxForm)
+ OkB: TButton;
+ CancelB: TButton;
+ SaveDialog1: TSaveDialog;
+ GroupPageRange: TGroupBox;
+ DescrL: TLabel;
+ AllRB: TRadioButton;
+ CurPageRB: TRadioButton;
+ PageNumbersRB: TRadioButton;
+ PageNumbersE: TEdit;
+ GroupQuality: TGroupBox;
+ WCB: TCheckBox;
+ ContinuousCB: TCheckBox;
+ PageBreaksCB: TCheckBox;
+ OpenExcelCB: TCheckBox;
+ BackgrCB: TCheckBox;
+ SplitToSheetGB: TGroupBox;
+ RPagesRB: TRadioButton;
+ PrintOnPrevRB: TRadioButton;
+ RowsCountRB: TRadioButton;
+ ERows: TEdit;
+ NotSplitRB: TRadioButton;
+ procedure FormCreate(Sender: TObject);
+ procedure PageNumbersEChange(Sender: TObject);
+ procedure PageNumbersEKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+ procedure ERowsKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+ procedure ERowsChange(Sender: TObject);
+ end;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxXMLExport = class(TfrxCustomExportFilter)
+ private
+ FExportPageBreaks: Boolean;
+ FExportStyles: Boolean;
+ FFirstPage: Boolean;
+ FMatrix: TfrxIEMatrix;
+ FOpenExcelAfterExport: Boolean;
+ FPageBottom: Extended;
+ FPageLeft: Extended;
+ FPageRight: Extended;
+ FPageTop: Extended;
+ FPageOrientation: TPrinterOrientation;
+ FProgress: TfrxProgress;
+ FWysiwyg: Boolean;
+ FBackground: Boolean;
+ FCreator: String;
+ FEmptyLines: Boolean;
+ FRowsCount: Integer;
+ FSplit: TfrxSplitToSheet;
+
+ procedure ExportPage(Stream: TStream);
+ function ChangeReturns(const Str: String): String;
+ function TruncReturns(const Str: WideString): WideString;
+ procedure SetRowsCount(const Value: Integer);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ function ShowModal: TModalResult; override;
+ function Start: Boolean; override;
+ procedure Finish; override;
+ procedure FinishPage(Page: TfrxReportPage; Index: Integer); override;
+ procedure StartPage(Page: TfrxReportPage; Index: Integer); override;
+ procedure ExportObject(Obj: TfrxComponent); override;
+ published
+ property ExportStyles: Boolean read FExportStyles write FExportStyles default True;
+ property ExportPageBreaks: Boolean read FExportPageBreaks write FExportPageBreaks default True;
+ property OpenExcelAfterExport: Boolean read FOpenExcelAfterExport
+ write FOpenExcelAfterExport default False;
+ property Wysiwyg: Boolean read FWysiwyg write FWysiwyg default True;
+ property Background: Boolean read FBackground write FBackground default False;
+ property Creator: string read FCreator write FCreator;
+ property EmptyLines: Boolean read FEmptyLines write FEmptyLines;
+ property SuppressPageHeadersFooters;
+ property OverwritePrompt;
+ property RowsCount: Integer read FRowsCount write SetRowsCount;
+ property Split: TfrxSplitToSheet read FSplit write FSplit;
+ end;
+
+
+implementation
+
+uses
+ FMX.frxUtils, FMX.frxUnicodeUtils, FMX.frxRes, FMX.frxrcExports, FMX.frxFMX
+{$IFDEF MSWINDOWS}
+, Winapi.ShellAPI, Winapi.Windows
+{$ENDIF}
+{$IFDEF LINUX}
+ ,FMUX.Api
+{$ENDIF}
+{$IFDEF MACOS}
+, Posix.Stdlib
+{$ENDIF};
+
+{$R *.fmx}
+
+const
+ Xdivider = 1.6;
+ Ydivider = 1.376;
+ MargDiv = 26.6;
+ XLMaxHeight = 409;
+
+
+{ TfrxXMLExport }
+
+constructor TfrxXMLExport.Create(AOwner: TComponent);
+begin
+ inherited;
+ FExportPageBreaks := True;
+ FExportStyles := True;
+ FWysiwyg := True;
+ FBackground := True;
+ FCreator := 'FastReport';
+ FilterDesc := frxGet(8105);
+ DefaultExt := frxGet(8106);
+ FEmptyLines := True;
+end;
+
+class function TfrxXMLExport.GetDescription: String;
+begin
+ Result := frxResources.Get('XlsXMLexport');
+end;
+
+function TfrxXMLExport.TruncReturns(const Str: WideString): WideString;
+var
+ l: Integer;
+begin
+ l := Length(Str);
+ if (l > 1) and (Str[l - 1] = #13) and (Str[l] = #10) then
+ Result := Copy(Str, 1, l - 2)
+ else
+ Result := Str;
+end;
+
+function TfrxXMLExport.ChangeReturns(const Str: string): string;
+var
+ i: Integer;
+begin
+ Result := '';
+
+ for i := 1 to Length(Str) do
+ case Str[i] of
+ '&': Result := Result + '&';
+ '"': Result := Result + '"';
+ '<': Result := Result + '<';
+ '>': Result := Result + '>';
+ #13: {skip this symbol};
+ #0..#12, #14..#31: Result := Result + '&#' + IntToStr(Ord(Str[i])) + ';';
+ else Result := Result + Str[i]
+ end
+end;
+
+procedure TfrxXMLExport.ExportPage(Stream: TStream);
+var
+ i, x, y, dx, dy, fx, fy, Page, LastPrevRow: Integer;
+ s: WideString;
+ sb, si, su, ss, decsep, thsep: String;
+ dcol, drow: Extended;
+ Vert, Horiz: String;
+ obj: TfrxIEMObject;
+ IEMPage: TfrxIEMPage;
+ EStyle: TfrxIEMStyle;
+ St, PrevPageName: String;
+ PageBreak: TStringList;
+
+ function IsDigits(const Str: String): Boolean;
+ var
+ i: Integer;
+ begin
+ Result := True;
+ for i := 1 to Length(Str) do
+ if not((AnsiChar(Str[i]) in ['0'..'9', ',' ,'.' ,'-', ' ', '']) or (Ord(Str[i]) = 160)) then
+ begin
+ Result := False;
+ break;
+ end;
+ end;
+
+ procedure WriteExpLn(const str: String);
+ var
+ TempStr: AnsiString;
+ begin
+ TempStr := UTF8Encode(str);
+ if Length(TempStr) > 0 then
+ Stream.Write(TempStr[1], Length(TempStr));
+ Stream.Write(AnsiString(#13#10), 2);
+ end;
+
+ procedure AlignFR2AlignExcel(HAlign: TfrxHAlign; VAlign: TfrxVAlign;
+ var AlignH, AlignV: String);
+ begin
+ if HAlign = haLeft then
+ AlignH := 'Left'
+ else if HAlign = haRight then
+ AlignH := 'Right'
+ else if HAlign = haCenter then
+ AlignH := 'Center'
+ else if HAlign = haBlock then
+ AlignH := 'Justify'
+ else
+ AlignH := '';
+ if VAlign = vaTop then
+ AlignV := 'Top'
+ else if VAlign = vaBottom then
+ AlignV := 'Bottom'
+ else if VAlign = vaCenter then
+ AlignV := 'Center'
+ else
+ AlignV := '';
+ end;
+
+ function ConvertFormat(const fstr, fdecsep, fthsep: string): string;
+ var
+ err, p : integer;
+ s: string;
+ begin
+ result := '';
+ s := '';
+ if length(fstr)>0 then
+ begin
+ p := pos('.', fstr);
+ if p > 0 then
+ begin
+ s := Copy(fstr, p+1, length(fstr)-p-1);
+ val(s, p ,err);
+ SetLength(s, p);
+ if p>0 then
+ begin
+ s := StringOfChar(Char('0'), p);
+ s := '.' + s;
+ end;
+ end;
+ case fstr[length(fstr)] of
+ 'n': result := '#,##0' + s;
+ 'f': result := '0' + s;
+ 'g': result := '0.##';
+ 'm': result := '#,##0.00';
+// 'm': result := '#,##0.00".;"';
+ else
+ result := '#,##0.00';
+ end;
+ end;
+ end;
+
+ procedure FinishWorkSheet;
+ var
+ i: Integer;
+ begin
+ WriteExpLn('');
+ WriteExpLn('');
+ WriteExpLn('');
+ if FPageOrientation = poLandscape then
+ WriteExpLn('');
+ WriteExpLn('');
+ WriteExpLn('');
+ WriteExpLn('');
+
+ if FExportPageBreaks then
+ begin
+ WriteExpLn('');
+ WriteExpLn('');
+ for i := 0 to PageBreak.Count - 1 do
+ begin
+ WriteExpLn('');
+ WriteExpLn('' + PageBreak[i] + '');
+ WriteExpLn('');
+ end;
+ WriteExpLn('');
+ WriteExpLn('');
+ end;
+ if PageBreak.Count > 0 then
+ LastPrevRow := LastPrevRow + StrToInt(PageBreak[PageBreak.Count - 1]);
+ PageBreak.Clear;
+ WriteExpLn('');
+ end;
+
+ procedure StartWorkSheet(SheetName: String);
+ var
+ x:Integer;
+ begin
+ if SheetName = '' then SheetName := 'UnnamedPage_' + IntTostr(Page);
+ WriteExpLn('');
+
+ WriteExpLn('
');
+
+ for x := 1 to FMatrix.Width - 1 do
+ begin
+ dcol := (FMatrix.GetXPosById(x) - FMatrix.GetXPosById(x - 1)) / Xdivider;
+ WriteExpLn('');
+ end;
+ end;
+
+begin
+ PageBreak := TStringList.Create;
+
+ try
+ if ShowProgress then
+ begin
+ FProgress := TfrxProgress.Create(nil);
+ FProgress.Execute(FMatrix.PagesCount, 'Exporting pages', True, True);
+ end;
+
+ WriteExpLn('');
+ WriteExpLn('');
+ WriteExpLn('');
+ WriteExpLn('');
+ WriteExpLn('');
+ WriteExpLn('');
+ WriteExpLn('' + Report.ReportOptions.Name + '');
+ WriteExpLn('' + Report.ReportOptions.Author + '');
+ WriteExpLn('' + DateToStr(CreationTime) + 'T' + TimeToStr(CreationTime) + 'Z');
+ WriteExpLn('' + Report.ReportOptions.VersionMajor + '.' +
+ Report.ReportOptions.VersionMinor + '.' +
+ Report.ReportOptions.VersionRelease + '.' +
+ Report.ReportOptions.VersionBuild + '');
+ WriteExpLn('');
+ WriteExpLn('');
+ WriteExpLn('False');
+ WriteExpLn('False');
+ WriteExpLn('');
+ if FExportStyles then
+ begin
+ WriteExpLn('');
+ for x := 0 to FMatrix.StylesCount - 1 do
+ begin
+ EStyle := FMatrix.GetStyleById(x);
+ s := 's' + IntToStr(x);
+ WriteExpLn('');
+ end;
+ WriteExpLn('');
+ end;
+
+ st := '';
+ Page := 0;
+ LastPrevRow := 0;
+ IEMPage := FMatrix.IEPages[Page];
+ if IEMPage <> nil then
+ PrevPageName := IEMPage.PageName;
+ StartWorkSheet(PrevPageName);
+ for y := 0 to FMatrix.Height - 2 do
+ begin
+ drow := (FMatrix.GetYPosById(y + 1) - FMatrix.GetYPosById(y)) / Ydivider;
+ WriteExpLn('');
+ if (FMatrix.PagesCount > Page) or (FRowsCount > 0) then
+ if (FMatrix.GetYPosById(y) >= FMatrix.GetPageBreak(Page)) or
+ ((FRowsCount <= y + 1 - LastPrevRow) and (FRowsCount > 0)) then
+ begin
+ Inc(Page);
+ PageBreak.Add(IntToStr(y + 1 - LastPrevRow));
+ if ShowProgress then
+ begin
+ FProgress.Tick;
+ if FProgress.Terminated then
+ break;
+ end;
+ end;
+ for x := 0 to FMatrix.Width - 1 do
+ begin
+ if ShowProgress then
+ if FProgress.Terminated then
+ break;
+ si := ' ss:Index="' + IntToStr(x + 1) + '" ';
+ i := FMatrix.GetCell(x, y);
+ if (i <> -1) then
+ begin
+ Obj := FMatrix.GetObjectById(i);
+ if Obj.Counter = 0 then
+ begin
+ FMatrix.GetObjectPos(i, fx, fy, dx, dy);
+ Obj.Counter := 1;
+ if Obj.IsText then
+ begin
+ if dx > 1 then
+ begin
+ s := 'ss:MergeAcross="' + IntToStr(dx - 1) + '" ';
+ Inc(dx);
+ end
+ else
+ s := '';
+ if dy > 1 then
+ sb := 'ss:MergeDown="' + IntToStr(dy - 1) + '" '
+ else
+ sb := '';
+ if FExportStyles then
+ st := 'ss:StyleID="' + 's' + IntToStr(Obj.StyleIndex) + '" '
+ else
+ st := '';
+ WriteExpLn('');
+
+ s := TruncReturns(Obj.Memo.Text);
+ if (Obj.Style.DisplayFormat.Kind = fkNumeric) and IsDigits(s) then
+ begin
+
+
+ s := StringReplace(s, FormatSettings.ThousandSeparator, '', [rfReplaceAll]);
+ s := StringReplace(s, FormatSettings.CurrencyString, '', [rfReplaceAll]);
+ if Obj.Style.DisplayFormat.DecimalSeparator <> '' then
+ s := StringReplace(s, Obj.Style.DisplayFormat.DecimalSeparator, '.', [rfReplaceAll])
+ else
+ s := StringReplace(s, FormatSettings.DecimalSeparator, '.', [rfReplaceAll]);
+
+
+ s := Trim(s);
+ si := ' ss:Type="Number"';
+ WriteExpLn('' + s + '');
+ end
+ else
+ begin
+ si := ' ss:Type="String"';
+ s := ChangeReturns(s);
+ WriteExpLn('' + s + '');
+ end;
+ WriteExpLn('');
+ end;
+ end
+ end
+ else
+ WriteExpLn('');
+ end;
+ WriteExpLn('');
+
+
+ if (FSplit = ssRowsCount) and
+ ((FRowsCount <= y + 1 - LastPrevRow) and (FRowsCount > 0)) then
+ begin
+ FinishWorkSheet;
+ StartWorkSheet('');
+ end
+ else
+ begin
+ IEMPage := FMatrix.IEPages[Page];
+ if IEMPage <> nil then
+ if ((FSplit = ssRPages) and (PrevpageName <> IEMPage.PageName))
+ or ((FSplit = ssPrintOnPrev) and (PrevpageName <> IEMPage.PageName)
+ and (Page > 0) and not IEMPage.PrintOnPreviousPage) then
+ begin
+ PrevpageName := IEMPage.PageName;
+ FinishWorkSheet;
+ StartWorkSheet(PrevPageName);
+ end;
+ end;
+
+ end;
+
+ FinishWorkSheet;
+ WriteExpLn('');
+ finally
+ PageBreak.Free;
+ end;
+ if ShowProgress then
+ FProgress.Free;
+end;
+
+function TfrxXMLExport.ShowModal: TModalResult;
+begin
+ if not Assigned(Stream) then
+ begin
+ with TfrxXMLExportDialog.Create(nil) do
+ begin
+ OpenExcelCB.Visible := not SlaveExport;
+ if OverwritePrompt then
+ SaveDialog1.Options := SaveDialog1.Options + [TOpenOption.ofOverwritePrompt];
+ if SlaveExport then
+ FOpenExcelAfterExport := False;
+
+ if (FileName = '') and (not SlaveExport) then
+ SaveDialog1.FileName := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(Report.FileName)), SaveDialog1.DefaultExt)
+ else
+ SaveDialog1.FileName := FileName;
+
+ ContinuousCB.IsChecked := (not EmptyLines) or SuppressPageHeadersFooters;
+ PageBreaksCB.IsChecked := FExportPageBreaks and (not ContinuousCB.IsChecked);
+ PrintOnPrevRB.IsChecked := (FSplit = ssPrintOnPrev);
+ RPagesRB.IsChecked := (FSplit = ssRPages);
+ NotSplitRB.IsChecked := (FSplit = ssNotSplit);
+ if FRowsCount <> 0 then
+ begin
+ ERows.Text := IntToStr(FRowsCount);
+ RowsCountRB.IsChecked := True;
+ end;
+
+ WCB.IsChecked := FWysiwyg;
+ OpenExcelCB.IsChecked := FOpenExcelAfterExport;
+ BackgrCB.IsChecked := FBackground;
+
+ if PageNumbers <> '' then
+ begin
+ PageNumbersE.Text := PageNumbers;
+ PageNumbersRB.IsChecked := True;
+ end;
+
+ Result := ShowModal;
+ PeekLastModalResult;
+ if Result = mrOk then
+ begin
+ PageNumbers := '';
+ CurPage := False;
+ if CurPageRB.IsChecked then
+ CurPage := True
+ else if PageNumbersRB.IsChecked then
+ PageNumbers := PageNumbersE.Text;
+
+ if RowsCountRB.IsChecked then
+ begin
+ FSplit := ssRowsCount;
+ FRowsCount := StrToInt(ERows.Text);
+ end
+ else if PrintOnPrevRB.IsChecked then
+ FSplit := ssPrintOnPrev
+ else if RPagesRB.IsChecked then
+ FSplit := ssRPages
+ else
+ FSplit := ssNotSplit;
+
+ FExportPageBreaks := PageBreaksCB.IsChecked and (not ContinuousCB.IsChecked);
+ EmptyLines := not ContinuousCB.IsChecked;
+ SuppressPageHeadersFooters := ContinuousCB.IsChecked;
+ FWysiwyg := WCB.IsChecked;
+ FOpenExcelAfterExport := OpenExcelCB.IsChecked;
+ FBackground := BackgrCB.IsChecked;
+
+ if not SlaveExport then
+ begin
+ if DefaultPath <> '' then
+ SaveDialog1.InitialDir := DefaultPath;
+ if SaveDialog1.Execute then
+ FileName := SaveDialog1.FileName
+ else
+ Result := mrCancel;
+ PeekLastModalResult;
+ end
+ end;
+ Free;
+ end;
+ end else
+ Result := mrOk;
+end;
+
+function TfrxXMLExport.Start: Boolean;
+begin
+ if SlaveExport then
+ begin
+ if Report.FileName <> '' then
+ FileName := ChangeFileExt(GetTemporaryFolder + ExtractFileName(Report.FileName), frxGet(8106))
+ else
+ FileName := ChangeFileExt(GetTempFile, frxGet(8106))
+ end;
+ if (FileName <> '') or Assigned(Stream) then
+ begin
+ if (ExtractFilePath(FileName) = '') and (DefaultPath <> '') then
+ FileName := DefaultPath + '\' + FileName;
+ FFirstPage := True;
+ FMatrix := TfrxIEMatrix.Create(UseFileCache, Report.EngineOptions.TempDir);
+ FMatrix.DotMatrix := Report.DotMatrixReport;
+ FMatrix.ShowProgress := ShowProgress;
+ FMatrix.MaxCellHeight := XLMaxHeight * Ydivider;
+ FMatrix.Background := FBackground and FEmptyLines;
+ FMatrix.BackgroundImage := False;
+ FMatrix.Printable := ExportNotPrintable;
+ FMatrix.RichText := True;
+ FMatrix.PlainRich := True;
+ FMatrix.EmptyLines := FEmptyLines;
+ FExportPageBreaks := FExportPageBreaks and FEmptyLines;
+ if FWysiwyg then
+ FMatrix.Inaccuracy := 0.5
+ else
+ FMatrix.Inaccuracy := 10;
+ FMatrix.DeleteHTMLTags := True;
+ Result := True
+ end
+ else
+ Result := False;
+end;
+
+procedure TfrxXMLExport.StartPage(Page: TfrxReportPage; Index: Integer);
+begin
+ if FFirstPage then
+ begin
+ FFirstPage := False;
+ FPageLeft := Page.LeftMargin;
+ FPageTop := Page.TopMargin;
+ FPageBottom := Page.BottomMargin;
+ FPageRight := Page.RightMargin;
+ FPageOrientation := Page.Orientation;
+ end;
+end;
+
+procedure TfrxXMLExport.ExportObject(Obj: TfrxComponent);
+begin
+ if Obj.Page <> nil then
+ Obj.Page.Top := FMatrix.Inaccuracy;
+ if Obj.Name = '_pagebackground' then
+ Exit;
+ if Obj is TfrxView then
+ FMatrix.AddObject(TfrxView(Obj));
+end;
+
+procedure TfrxXMLExport.FinishPage(Page: TfrxReportPage; Index: Integer);
+var
+ IEMPage: TfrxIEMPage;
+begin
+ FMatrix.AddPage(Page.Orientation, Page.Width, Page.Height, Page.LeftMargin,
+ Page.TopMargin, Page.RightMargin, Page.BottomMargin, Page.MirrorMargins, Index);
+ IEMPage := FMatrix.IEPages[Index];
+ if IEMPage <> nil then
+ with IEMPage do
+ begin
+ PageName := Page.Name;
+ PrintOnPreviousPage := Page.PrintOnPreviousPage;
+ end;
+
+end;
+
+procedure TfrxXMLExport.Finish;
+var
+ Exp: TStream;
+begin
+ FMatrix.Prepare;
+ try
+ if Assigned(Stream) then
+ Exp := Stream
+ else
+ Exp := TFileStream.Create(FileName, fmCreate);
+
+ try
+ ExportPage(Exp);
+ finally
+ if not Assigned(Stream) then
+ Exp.Free;
+ end;
+ if FOpenExcelAfterExport and (not Assigned(Stream)) then
+ begin
+{$IFDEF MSWINDOWS}
+ ShellExecute(0, 'open', PChar(FileName), '', '', 5);
+{$ENDIF}
+{$IFDEF LINUX}
+ FmuxOpenFile(PChar(FileName));
+{$ENDIF}
+{$IFDEF MACOS}
+ ShellExecute(FileName);
+{$ENDIF}
+ end;
+ except
+ on e: Exception do
+ case Report.EngineOptions.NewSilentMode of
+ simSilent: Report.Errors.Add(e.Message);
+ simMessageBoxes: frxErrorMsg(e.Message);
+ simReThrow: raise;
+ end;
+ end;
+ FMatrix.Free;
+end;
+
+procedure TfrxXMLExport.SetRowsCount(const Value: Integer);
+begin
+ FRowsCount := Value;
+ if Value > 0 then
+ FSplit := ssRowsCount
+ else
+ begin
+ FSplit := ssNotSplit;
+ FRowsCount := 0;
+ end;
+end;
+
+{ TfrxXMLExportDialog }
+
+procedure TfrxXMLExportDialog.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(8100);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ GroupPageRange.Text := frxGet(7);
+ AllRB.Text := frxGet(3);
+ CurPageRB.Text := frxGet(4);
+ PageNumbersRB.Text := frxGet(5);
+ DescrL.Text := frxGet(9);
+ GroupQuality.Text := frxGet(8);
+ ContinuousCB.Text := frxGet(8950);
+ PageBreaksCB.Text := frxGet(6);
+ WCB.Text := frxGet(8102);
+ BackgrCB.Text := frxGet(8103);
+ OpenExcelCB.Text := frxGet(8104);
+ SaveDialog1.Filter := frxGet(8105);
+ SaveDialog1.DefaultExt := frxGet(8106);
+ RowsCountRB.Text := frxGet(9000);
+ SplitToSheetGB.Text := frxGet(9001);
+ NotSplitRB.Text := frxGet(9002);
+ RPagesRB.Text := frxGet(9003);
+ PrintOnPrevRB.Text := frxGet(9004);
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+end;
+
+
+procedure TfrxXMLExportDialog.PageNumbersEChange(Sender: TObject);
+begin
+ PageNumbersRB.IsChecked := True;
+end;
+
+procedure TfrxXMLExportDialog.PageNumbersEKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+begin
+ case KeyChar of
+ '0'..'9':;
+ #8, '-', ',':;
+ else
+ key := 0;
+ end;
+end;
+
+procedure TfrxXMLExportDialog.FormKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VK_F1 then
+ frxResources.Help(Self);
+end;
+
+procedure TfrxXMLExportDialog.ERowsKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+begin
+ case KeyChar of
+ '0'..'9', #8:;
+ else
+ key := 0;
+ end;
+end;
+
+procedure TfrxXMLExportDialog.ERowsChange(Sender: TObject);
+begin
+ RowsCountRB.IsChecked := True;
+end;
+
+end.
diff --git a/LibD28/FMX.frxFDComponents.pas b/LibD28/FMX.frxFDComponents.pas
new file mode 100644
index 0000000..aa00412
--- /dev/null
+++ b/LibD28/FMX.frxFDComponents.pas
@@ -0,0 +1,1325 @@
+{ --------------------------------------------------------------------------- }
+{ AnyDAC FastReport v 4.0 enduser components }
+{ }
+{ (c)opyright DA-SOFT Technologies 2004-2013. }
+{ All rights reserved. }
+{ }
+{ Initially created by: Serega Glazyrin }
+{ Extended by: Francisco Armando Duenas Rodriguez }
+{ --------------------------------------------------------------------------- }
+{$I frx.inc}
+{$I fmx.inc}
+
+unit FMX.frxFDComponents;
+
+interface
+
+uses
+ System.Classes, System.SysUtils, FMX.frxClass, FMX.frxCustomDB, Data.DB, FireDAC.DatS,
+ FireDAC.Comp.Client, FireDAC.Stan.Option, FireDAC.Comp.DataSet
+{$IFDEF Delphi6}
+, System.Variants
+{$ENDIF}
+{$IFDEF QBUILDER}
+, fqbClass
+{$ENDIF};
+
+type
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxFDComponents = class(TfrxDBComponents)
+ private
+ FDefaultDatabase: TFDConnection;
+ FOldComponents: TfrxFDComponents;
+ FDesignTimeExpr: Boolean;
+ procedure SetDefaultDatabase(const AValue: TFDConnection);
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function GetDescription: String; override;
+ published
+ property DefaultDatabase: TFDConnection read FDefaultDatabase write SetDefaultDatabase;
+ // whether or not to calc expressions at design-time
+ property DesignTimeExpr: Boolean read FDesignTimeExpr write FDesignTimeExpr
+ stored True default True;
+ end;
+
+ TfrxFDDatabase = class(TfrxCustomDatabase)
+ private
+ FDatabase: TFDConnection;
+ function GetDriverName: string;
+ procedure SetDriverName(const AValue: string);
+ function GetConnectionDefName: string;
+ procedure SetConnectionDefName(const AValue: string);
+ protected
+ procedure SetConnected(AValue: Boolean); override;
+ procedure SetDatabaseName(const AValue: String); override;
+ procedure SetLoginPrompt(AValue: Boolean); override;
+ procedure SetParams(AValue: TStrings); override;
+ function GetConnected: Boolean; override;
+ function GetDatabaseName: String; override;
+ function GetLoginPrompt: Boolean; override;
+ function GetParams: TStrings; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ procedure SetLogin(const ALogin, APassword: String); override;
+ function ToString: WideString; override;
+ procedure FromString(const AConnection: WideString); override;
+ property Database: TFDConnection read FDatabase;
+ published
+ property ConnectionDefName: string read GetConnectionDefName write SetConnectionDefName;
+ property DriverName: string read GetDriverName write SetDriverName;
+ property DatabaseName;
+ property Params;
+ property LoginPrompt;
+ property Connected;
+ end;
+
+ TfrxFDQuery = class(TfrxCustomQuery)
+ private
+ FDatabase: TfrxFDDatabase;
+ FQuery: TFDQuery;
+ procedure SetDatabase(const AValue: TfrxFDDatabase);
+ function GetUniDirectional: boolean;
+ procedure SetUniDirectional(const AValue: boolean);
+ procedure DoMasterSetValues(ASender: TFDDataSet);
+ protected
+ FLocked: Boolean;
+ FStrings: TStrings;
+ procedure Notification(AComponent: TComponent; AOperation: TOperation); override;
+ procedure OnChangeSQL(Sender: TObject); override;
+ procedure SetMaster(const AValue: TDataSource); override;
+ procedure SetMasterFields(const AValue: String); override;
+ procedure SetSQL(AValue: TStrings); override;
+ function GetSQL: TStrings; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor DesignCreate(AOwner: TComponent; AFlags: Word); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ procedure BeforeStartReport; override;
+ procedure FetchParams; virtual;
+ procedure UpdateParams; override;
+{$IFDEF QBUILDER}
+ function QBEngine: TfqbEngine; override;
+{$ENDIF}
+ property Query: TFDQuery read FQuery;
+ published
+ property SQL;
+ property Database: TfrxFDDatabase read FDatabase write SetDatabase;
+ property UniDirectional: Boolean read GetUniDirectional write SetUniDirectional default False;
+ property MasterFields;
+ end;
+
+ TfrxFDTable = class(TfrxCustomTable)
+ private
+ FDatabase: TfrxFDDatabase;
+ FTable: TFDTable;
+ procedure SetDatabase(const AValue: TfrxFDDatabase);
+ function GetCatalogName: String;
+ function GetSchemaName: String;
+ procedure SetCatalogName(const AValue: String);
+ procedure SetSchemaName(const AValue: String);
+ protected
+ procedure Notification(AComponent: TComponent; AOperation: TOperation); override;
+ procedure SetMaster(const AValue: TDataSource); override;
+ procedure SetMasterFields(const AValue: String); override;
+ procedure SetIndexFieldNames(const AValue: String); override;
+ procedure SetIndexName(const AValue: String); override;
+ procedure SetTableName(const AValue: String); override;
+ function GetIndexFieldNames: String; override;
+ function GetIndexName: String; override;
+ function GetTableName: String; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ constructor DesignCreate(AOwner: TComponent; AFlags: Word); override;
+ class function GetDescription: String; override;
+ procedure BeforeStartReport; override;
+ property Table: TFDTable read FTable;
+ published
+ property Database: TfrxFDDatabase read FDatabase write SetDatabase;
+ property CatalogName: String read GetCatalogName write SetCatalogName;
+ property SchemaName: String read GetSchemaName write SetSchemaName;
+ end;
+
+ TfrxCustomStoredProc = class(TfrxCustomDataset)
+ private
+ FParams: TfrxParams;
+ FSaveOnBeforeOpen: TDataSetNotifyEvent;
+ FSaveOnAfterOpen: TDataSetNotifyEvent;
+ procedure ReadParamData(AReader: TReader);
+ procedure WriteParamData(AWriter: TWriter);
+ procedure SetParams(AValue: TfrxParams);
+ protected
+ procedure DefineProperties(AFiler: TFiler); override;
+ function GetStoredProcName: string; virtual;
+ procedure SetStoredProcName(const AValue: string); virtual;
+ procedure TriggerOnBeforeOpen(ADataSet: TDataSet); virtual;
+ procedure TriggerOnAfterOpen(ADataSet: TDataSet); virtual;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure ExecProc; virtual;
+ procedure UpdateParams; virtual;
+ procedure Prepare; virtual;
+ procedure FetchParams; virtual;
+ function ParamByName(const AValue: String): TfrxParamItem;
+ published
+ property Params: TfrxParams read FParams write SetParams;
+ property StoredProcName: string read GetStoredProcName write SetStoredProcName; {added by fduenas}
+ end;
+
+ TfrxFDStoredProc = class(TfrxCustomStoredProc)
+ private
+ FDatabase: TfrxFDDatabase;
+ FStoredProc: TFDStoredProc;
+ // added for Master-Detail relationship
+ procedure DoMasterSetValues(ASender: TFDDataSet);
+ procedure SetDatabase(const AValue: TfrxFDDatabase);
+ function GetPackageName: String;
+ procedure SetPackageName(const AValue: String);
+ function GetCatalogName: String;
+ function GetSchemaName: String;
+ procedure SetCatalogName(const AValue: String);
+ procedure SetSchemaName(const AValue: String);
+ protected
+ procedure Notification(AComponent: TComponent; AOperation: TOperation); override;
+ function GetStoredProcName: string; override;
+ procedure SetStoredProcName(const AValue: string); override;
+ // added for Master-Detail RelationShip
+ procedure SetMaster(const AValue: TDataSource); override;
+ procedure TriggerOnAfterOpen(ADataSet: TDataSet); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor DesignCreate(AOwner: TComponent; AFlags: Word); override;
+ class function GetDescription: String; override;
+ procedure BeforeStartReport; override;
+ procedure ExecProc; override;
+ procedure Prepare; override;
+ procedure UpdateParams; override;
+ procedure FetchParams; override;
+ property StoredProc: TFDStoredProc read FStoredProc;
+ published
+ property Database: TfrxFDDatabase read FDatabase write SetDatabase;
+ property CatalogName: String read GetCatalogName write SetCatalogName;
+ property SchemaName: String read GetSchemaName write SetSchemaName;
+ property PackageName: String read GetPackageName write SetPackageName;
+ end;
+
+{$IFDEF QBUILDER}
+ TfrxEngineFD = class(TfqbEngine)
+ private
+ FQuery: TFDQuery;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure ReadTableList(ATableList: TStrings); override;
+ procedure ReadFieldList(const ATableName: string; var AFieldList: TfqbFieldList); override;
+ function ResultDataSet: TDataSet; override;
+ procedure SetSQL(const AValue: string); override;
+ end;
+{$ENDIF}
+
+var
+ GFDComponents: TfrxFDComponents;
+
+implementation
+
+{$R *.res}
+
+uses
+ FMX.Dialogs, System.StrUtils,
+ FMX.frxFDRTTI,
+{$IFNDEF NO_EDITORS}
+ FMX.frxFDEditor,
+{$ENDIF}
+ FMX.frxDsgnIntf, FMX.frxUtils, FMX.frxRes,
+ FireDAC.Stan.Param, FireDAC.Stan.Def, FireDAC.Stan.Util,
+ FireDAC.Phys;
+
+type
+ TfrxHackFDDataSet = Class(TFDDataSet);
+
+{-------------------------------------------------------------------------------}
+{ TfrxFDComponents }
+{-------------------------------------------------------------------------------}
+constructor TfrxFDComponents.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FOldComponents := GFDComponents;
+ FDesignTimeExpr := True;
+ GFDComponents := Self;
+end;
+
+{-------------------------------------------------------------------------------}
+destructor TfrxFDComponents.Destroy;
+begin
+ if GFDComponents = Self then
+ GFDComponents := FOldComponents;
+ inherited Destroy;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDComponents.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited Notification(AComponent, Operation);
+ if (AComponent = FDefaultDatabase) and (Operation = opRemove) then
+ FDefaultDatabase := nil;
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDComponents.GetDescription: String;
+begin
+ Result := 'FD';
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDComponents.SetDefaultDatabase(const AValue: TFDConnection);
+begin
+ if FDefaultDatabase <> AValue then begin
+ if FDefaultDatabase <> nil then
+ FDefaultDatabase.RemoveFreeNotification(Self);
+ FDefaultDatabase := AValue;
+ if FDefaultDatabase <> nil then
+ FDefaultDatabase.FreeNotification(Self);
+ end;
+end;
+
+{-------------------------------------------------------------------------------}
+{ TfrxFDDatabase }
+{-------------------------------------------------------------------------------}
+constructor TfrxFDDatabase.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FDatabase := TFDConnection.Create(nil);
+ Component := FDatabase;
+end;
+
+{-------------------------------------------------------------------------------}
+destructor TfrxFDDatabase.Destroy;
+begin
+ // FDatabase.Free;
+ inherited Destroy;
+end;
+
+{-------------------------------------------------------------------------------}
+class function TfrxFDDatabase.GetDescription: String;
+begin
+ Result := 'FD Database';
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDDatabase.GetConnectionDefName: string;
+begin
+ Result := FDatabase.ConnectionDefName;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDDatabase.SetConnectionDefName(const AValue: string);
+begin
+ FDatabase.ConnectionDefName := AValue;
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDDatabase.GetDriverName: string;
+begin
+ Result := FDatabase.DriverName;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDDatabase.SetDriverName(const AValue: string);
+begin
+ FDatabase.DriverName := AValue;
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDDatabase.GetDatabaseName: String;
+begin
+{$IFDEF DELPHI21}
+ Result := FDatabase.ResultConnectionDef.Params.Database;
+{$ELSE}
+ Result := FDatabase.ResultConnectionDef.Database;
+{$ENDIF}
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDDatabase.SetDatabaseName(const AValue: String);
+begin
+{$IFDEF DELPHI21}
+ FDatabase.ResultConnectionDef.Params.Database := AValue;
+{$ELSE}
+ FDatabase.ResultConnectionDef.Database := AValue;
+{$ENDIF}
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDDatabase.GetParams: TStrings;
+begin
+ Result := FDatabase.Params;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDDatabase.SetParams(AValue: TStrings);
+begin
+{$IFDEF DELPHI21}
+ FDatabase.Params.Assign(AValue);
+{$ELSE}
+ FDatabase.Params := AValue;
+{$ENDIF}
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDDatabase.GetLoginPrompt: Boolean;
+begin
+ Result := FDatabase.LoginPrompt;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDDatabase.SetLoginPrompt(AValue: Boolean);
+begin
+ FDatabase.LoginPrompt := AValue;
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDDatabase.GetConnected: Boolean;
+begin
+ Result := FDatabase.Connected;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDDatabase.SetConnected(AValue: Boolean);
+begin
+ BeforeConnect(AValue);
+ FDatabase.Connected := AValue;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDDatabase.SetLogin(const ALogin, APassword: String);
+begin
+{$IFDEF DELPHI21}
+ FDatabase.ResultConnectionDef.Params.UserName := ALogin;
+ FDatabase.ResultConnectionDef.Params.Password := APassword;
+{$ELSE}
+ FDatabase.ResultConnectionDef.UserName := ALogin;
+ FDatabase.ResultConnectionDef.Password := APassword;
+{$ENDIF}
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDDatabase.FromString(const AConnection: WideString);
+begin
+ FDatabase.ResultConnectionDef.ParseString(AConnection);
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDDatabase.ToString: WideString;
+begin
+ Result := FDatabase.ResultConnectionDef.BuildString();
+end;
+
+{-------------------------------------------------------------------------------}
+{ TfrxFDQuery }
+{-------------------------------------------------------------------------------}
+procedure frxParamsToFDParams(ADataSet: TfrxCustomDataset; AFrxParams: TfrxParams;
+ AFDParams: TFDParams; AMasterDetail: boolean=false);
+var
+ i, j, iFld: Integer;
+ oFDParam: TFDParam;
+ oFrxParam: TfrxParamItem;
+ oMasterFields: TStringList;
+ lSkip, lDesignTime, lDesignTimeExpr: Boolean;
+ oQuery: TFDQuery;
+ sExpr: String;
+ vRes: Variant;
+
+ function CanExpandEscape(AReport: TfrxReport; AExpr: String;
+ out ARes: Variant): Boolean;
+ var
+ sVar: String;
+ i: Integer;
+ lIsVar: Boolean;
+ begin
+ Result := oQuery.Connection <> nil;
+ if Result then begin
+ sVar := AExpr;
+ // 1st iteration of check
+ lIsVar := (sVar[1] = '<') and (sVar[Length(sVar)] = '>');
+ if lIsVar then begin
+ i := AReport.Variables.IndexOf(Copy(sVar, 2, Length(sVar) - 2));
+ Result := i <> -1;
+ if Result then
+ sVar := VarToStr(AReport.Variables.Items[i].Value)
+ else
+ Exit;
+ end;
+ // 2nd iteration
+ Result := (Length(sVar) >= 5) and (sVar[1] = '{') and
+ (sVar[Length(sVar)] = '}') and not(FDInSet(sVar[2], ['0' .. '9']));
+ if Result then begin
+ oQuery.SQL.Text := 'SELECT ' + sVar;
+ try
+ oQuery.Open;
+ except
+ Result := False;
+ end;
+ Result := Result and (oQuery.RecordCount = 1);
+ if Result then
+ ARes := oQuery.Fields[0].Value;
+ end;
+ end;
+ end;
+
+begin
+ lDesignTime := (ADataSet.IsLoading or ADataSet.IsDesigning);
+ lDesignTimeExpr := Assigned(GFDComponents) and GFDComponents.DesignTimeExpr;
+ oQuery := TFDQuery.Create(nil);
+ oQuery.Connection := TfrxFDQuery(ADataSet).FQuery.Connection;
+ oQuery.ResourceOptions.EscapeExpand := True;
+ try
+ for i := 0 to AFDParams.Count - 1 do begin
+ oFDParam := AFDParams[i];
+ j := AFrxParams.IndexOf(oFDParam.Name);
+ if j <> -1 then begin
+ oFrxParam := AFrxParams[j];
+ oFDParam.Clear;
+ oFDParam.DataType := oFrxParam.DataType;
+ oFDParam.Bound := lDesignTime;
+
+ if AMasterDetail and (ADataSet is TfrxFDQuery) then begin
+ oMasterFields := TStringList.Create;
+ try
+ oMasterFields.Delimiter := ';';
+ oMasterFields.DelimitedText := TfrxFDQuery(ADataSet).FQuery.MasterFields;
+ lSkip := False;
+ for iFld := 0 to oMasterFields.Count - 1 do begin
+ lSkip := {$IFDEF AnyDAC_NOLOCALE_META} FDCompareText {$ELSE} AnsiCompareText {$ENDIF}
+ (oFDParam.Name, oMasterFields[iFld]) = 0;
+ if lSkip then
+ Break;
+ end;
+ if lSkip then
+ Continue;
+ finally
+ oMasterFields.Free;
+ end;
+ end;
+
+ sExpr := oFrxParam.Expression;
+ if Trim(sExpr) <> '' then begin
+ if ADataSet.Report <> nil then
+ if CanExpandEscape(ADataSet.Report, sExpr, vRes) then
+ oFrxParam.Value := vRes
+ else if (lDesignTime and lDesignTimeExpr or not lDesignTime) then begin
+ ADataSet.Report.CurObject := ADataSet.Name;
+ try
+ oFrxParam.Value := ADataSet.Report.Calc(sExpr);
+ except
+ oFrxParam.Value := null;
+ end;
+ end
+ else
+ oFrxParam.Value := sExpr;
+ end;
+
+ if not VarIsEmpty(oFrxParam.Value) then begin
+ oFDParam.Bound := True;
+ oFDParam.Value := oFrxParam.Value;
+ end;
+ end;
+ end;
+ finally
+ oQuery.Free;
+ end;
+end;
+
+{-------------------------------------------------------------------------------}
+{
+ function used to recreate a TFrxParams collection from a TFDParams collection
+ useful when borrowing TFDparams from any TFDQuery and TFDStoredProc objects after assigning
+ a new SQL Text that can contain parameters (:paramName1, :paramName2, :paramNameN)
+}
+
+procedure frxFDParamsToParams(ADataSet: TfrxCustomDataSet; AFDParams: TFDParams;
+ AfrxParams: TfrxParams; AIgnoreDuplicates: Boolean = True; AMasterDataSet: TDataset=nil );
+var
+ i, j: Integer;
+ NewParams: TfrxParams;
+begin
+ if AfrxParams = nil then
+ Exit;
+ { create new TfrxParams object and copy all params to it }
+ NewParams := TfrxParams.Create;
+ try
+ for i := 0 to AFDParams.Count - 1 do
+ if not ((NewParams.IndexOf(AFDParams[i].Name) <> -1) and AIgnoreDuplicates) then
+ with NewParams.Add do begin
+ Name := AFDParams[i].Name;
+ j := AfrxParams.IndexOf(Name);
+ DataType := AFDParams.Items[i].DataType;
+ if assigned( AMasterDataSet ) and
+ assigned( AMasterDataSet.FindField(Name) ) and
+ (DataType = ftUnknown) then
+ DataType := AMasterDataSet.FindField(Name).DataType;
+
+ if j <> -1 then begin
+ Value := AfrxParams.Items[j].Value;
+ Expression := AfrxParams.Items[j].Expression;
+ end
+ else
+ Value := AFDParams.Items[i].Value;
+ end;
+ AfrxParams.Clear;
+ AfrxParams.Assign(NewParams);
+ finally
+ NewParams.Free;
+ end;
+end;
+
+{-------------------------------------------------------------------------------}
+{
+ function borrow only values from any TFDparams to TfrxParams
+ used normally when calling TfrxFDStoredProc.ExecProc and the stored
+ procedure returns values by Parameters )
+}
+
+procedure frxFDParamValuesToParams(ADataSet: TfrxCustomDataSet; AFDParams: TFDParams;
+ AfrxParams: TfrxParams; AOnlyOutputParams: Boolean = False);
+var
+ i, j: Integer;
+begin
+ if AfrxParams = nil then
+ Exit;
+ for i := 0 to AFDParams.Count - 1 do
+ if not AOnlyOutputParams or
+ (AFDParams[i].ParamType in [ptInputOutput, ptOutput]) then begin
+ j := AfrxParams.IndexOf(AFDParams[i].Name);
+ if j > -1 then begin
+ AfrxParams.Items[j].DataType := AFDParams.Items[i].DataType;
+ AfrxParams.Items[j].Value := AFDParams.Items[i].Value;
+ end;
+ end;
+end;
+
+{-------------------------------------------------------------------------------}
+{ Code to assign current Master field values for Master-Detail Relationship }
+
+procedure frxDoMasterSetValues(ADetailDataSet: TFDDataSet);
+var
+ i: Integer;
+ oParam: TFDParam;
+ oField: TField;
+begin
+ with ADetailDataSet do begin
+ if (MasterSource = nil) or (MasterLink = nil) then
+ Exit;
+ for i := 0 to MasterLink.Fields.Count - 1 do begin
+ oField := TField(MasterLink.Fields[i]);
+ oParam := FindParam(oField.FieldName);
+ if oParam <> nil then
+ oParam.AssignFieldValue(oField, oField.Value);
+ end;
+ end;
+end;
+
+{-------------------------------------------------------------------------------}
+constructor TfrxFDQuery.Create(AOwner: TComponent);
+begin
+ FLocked := false;
+ FStrings := TStringList.Create;
+ FQuery := TFDQuery.Create(nil);
+ FQuery.OnMasterSetValues := DoMasterSetValues;
+ Dataset := FQuery;
+ SetDatabase(nil);
+ inherited Create(AOwner);
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDQuery.DoMasterSetValues(ASender: TFDDataSet);
+begin
+ frxParamsToFDParams(Self, Params, FQuery.Params, true);
+ // Code to assign current Master field values for Master-Detail Relationship
+ frxDoMasterSetValues(FQuery);
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDQuery.FetchParams;
+begin
+ frxFDParamsToParams(Self, FQuery.Params, Params, IgnoreDupParams);
+end;
+
+{-------------------------------------------------------------------------------}
+constructor TfrxFDQuery.DesignCreate(AOwner: TComponent; AFlags: Word);
+var
+ i: Integer;
+ l: TList;
+begin
+ inherited DesignCreate(AOwner, AFlags);
+ l := Report.AllObjects;
+ for i := 0 to l.Count - 1 do
+ if TObject(l[i]) is TfrxFDDatabase then begin
+ SetDatabase(TfrxFDDatabase(l[i]));
+ Break;
+ end;
+end;
+
+{-------------------------------------------------------------------------------}
+destructor TfrxFDQuery.Destroy;
+begin
+ FStrings.Clear;
+ FreeAndNil(FStrings);
+ inherited Destroy;
+end;
+
+{-------------------------------------------------------------------------------}
+class function TfrxFDQuery.GetDescription: String;
+begin
+ Result := 'FD Query';
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDQuery.Notification(AComponent: TComponent; AOperation: TOperation);
+begin
+ inherited Notification(AComponent, AOperation);
+ if (AOperation = opRemove) and (AComponent = FDatabase) then
+ SetDatabase(nil);
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDQuery.OnChangeSQL(Sender: TObject);
+var
+ i, ind: Integer;
+ Param: TfrxParamItem;
+ QParam: TFDParam;
+begin
+ // code borrowed from TfrxFDOquery component
+ if not FLocked then begin
+ // needed to update parameters
+ FQuery.SQL.Text := '';
+ FQuery.SQL.Assign(FStrings);
+
+ frxParamsToFDParams(Self, Params, FQuery.Params);
+ inherited;
+ // fill datatype automatically, if possible
+ for i := 0 to FQuery.Params.Count - 1 do
+ begin
+
+ QParam := FQuery.Params[i];
+ ind := Params.IndexOf(QParam.Name);
+
+ if ind <> -1 then
+ begin
+ Param := Params[ind];
+
+ if (Param.DataType = ftUnknown) and Self.IsDesigning then
+ begin
+ if assigned( self.Master ) and assigned( self.Master.DataSet ) then
+ begin
+ if (not Self.Master.DataSet.Active) and
+ (Self.Master.DataSet.FieldCount=0) and
+ ( Self.Master.FieldAliases.IndexOfName(QParam.Name) > -1 ) then
+ Self.Master.DataSet.Active := true;
+ if assigned( Self.Master.DataSet.FindField(QParam.Name) ) then
+ begin
+ Param.DataType := self.master.DataSet.FindField(QParam.Name).DataType;
+ QParam.DataType := self.master.DataSet.FindField(QParam.Name).DataType;
+ end;
+ end;
+ end;
+
+ if (Param.DataType = ftUnknown) and (QParam.DataType <> ftUnknown) then
+ Param.DataType := QParam.DataType;
+
+ end;
+ end;
+ end;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDQuery.SetDatabase(const AValue: TfrxFDDatabase);
+begin
+ FDatabase := AValue;
+ if AValue <> nil then
+ FQuery.Connection := AValue.Database
+ else if GFDComponents <> nil then
+ FQuery.Connection := GFDComponents.DefaultDatabase
+ else
+ FQuery.Connection := nil;
+ DBConnected := FQuery.Connection <> nil;
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDQuery.GetSQL: TStrings;
+begin
+ FLocked := True;
+ try
+ FStrings.Assign(FQuery.SQL);
+ finally
+ FLocked := False;
+ end;
+ Result := FStrings;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDQuery.SetSQL(AValue: TStrings);
+begin
+ FQuery.SQL.Assign(AValue);
+ FStrings.Assign(FQuery.SQL);
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDQuery.SetMaster(const AValue: TDataSource);
+begin
+ FQuery.MasterSource := AValue;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDQuery.SetMasterFields(const AValue: String);
+begin
+ FQuery.MasterFields := AValue;
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDQuery.GetUniDirectional: boolean;
+begin
+ Result := FQuery.FetchOptions.Unidirectional;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDQuery.SetUniDirectional(const AValue: Boolean);
+begin
+ FQuery.FetchOptions.Unidirectional := AValue;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDQuery.UpdateParams;
+begin
+ frxParamsToFDParams(Self, Params, FQuery.Params, ASSIGNED(Master));
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDQuery.BeforeStartReport;
+begin
+ SetDatabase(FDatabase);
+end;
+
+{-------------------------------------------------------------------------------}
+{$IFDEF QBUILDER}
+function TfrxFDQuery.QBEngine: TfqbEngine;
+begin
+ Result := TfrxEngineFD.Create(nil);
+ TfrxEngineFD(Result).FQuery.Connection := FQuery.Connection;
+ if (FQuery.Connection <> nil) and not FQuery.Connection.Connected then
+ FQuery.Connection.Connected := True;
+end;
+{$ENDIF}
+
+{-------------------------------------------------------------------------------}
+{ TfrxFDTable }
+{-------------------------------------------------------------------------------}
+constructor TfrxFDTable.Create(AOwner: TComponent);
+begin
+ FTable := TFDTable.Create(nil);
+ DataSet := FTable;
+ SetDatabase(nil);
+ inherited Create(AOwner);
+end;
+
+{-------------------------------------------------------------------------------}
+destructor TfrxFDTable.Destroy;
+begin
+ if Assigned(FTable) then
+ inherited;
+end;
+
+{-------------------------------------------------------------------------------}
+constructor TfrxFDTable.DesignCreate(AOwner: TComponent; AFlags: Word);
+var
+ i: Integer;
+ l: TList;
+begin
+ inherited DesignCreate(AOwner, AFlags);
+ l := Report.AllObjects;
+ for i := 0 to l.Count - 1 do
+ if TObject(l[i]) is TfrxFDDatabase then begin
+ SetDatabase(TfrxFDDatabase(l[i]));
+ break;
+ end;
+end;
+
+{-------------------------------------------------------------------------------}
+class function TfrxFDTable.GetDescription: String;
+begin
+ Result := 'FD Table';
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDTable.Notification(AComponent: TComponent; AOperation: TOperation);
+begin
+ inherited Notification(AComponent, AOperation);
+ if (AOperation = opRemove) and (AComponent = FDatabase) then
+ SetDatabase(nil);
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDTable.SetDatabase(const AValue: TfrxFDDatabase);
+begin
+ FDatabase := AValue;
+ if AValue <> nil then
+ FTable.Connection := AValue.Database
+ else if GFDComponents <> nil then
+ FTable.Connection := GFDComponents.DefaultDatabase
+ else
+ FTable.Connection := nil;
+ DBConnected := FTable.Connection <> nil;
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDTable.GetIndexFieldNames: String;
+begin
+ Result := FTable.IndexFieldNames;
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDTable.GetIndexName: String;
+begin
+ Result := FTable.IndexName;
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDTable.GetCatalogName: String;
+begin
+ Result := FTable.CatalogName;
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDTable.GetSchemaName: String;
+begin
+ Result := FTable.SchemaName;
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDTable.GetTableName: String;
+begin
+ Result := FTable.TableName;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDTable.SetIndexFieldNames(const AValue: String);
+begin
+ FTable.IndexFieldNames := AValue;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDTable.SetIndexName(const AValue: String);
+begin
+ FTable.IndexName := AValue;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDTable.SetCatalogName(const AValue: String);
+begin
+ FTable.CatalogName := AValue;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDTable.SetSchemaName(const AValue: String);
+begin
+ FTable.SchemaName := AValue;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDTable.SetTableName(const AValue: String);
+begin
+ FTable.TableName := AValue;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDTable.SetMaster(const AValue: TDataSource);
+begin
+ FTable.MasterSource := AValue;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDTable.SetMasterFields(const AValue: String);
+begin
+ FTable.MasterFields := AValue;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDTable.BeforeStartReport;
+begin
+ SetDatabase(FDatabase);
+end;
+
+{-------------------------------------------------------------------------------}
+{ TfrxCustomStoredProc }
+{-------------------------------------------------------------------------------}
+constructor TfrxCustomStoredProc.Create(AOwner: TComponent);
+begin
+ FParams := TfrxParams.Create;
+ inherited Create(AOwner);
+ if DataSet <> nil then
+ begin
+ FSaveOnBeforeOpen := DataSet.BeforeOpen;
+ FSaveOnAfterOpen := DataSet.AfterOpen;
+ DataSet.BeforeOpen := TriggerOnBeforeOpen;
+ end;
+end;
+
+{-------------------------------------------------------------------------------}
+destructor TfrxCustomStoredProc.Destroy;
+begin
+ FParams.Free;
+ if DataSet <> nil then
+ DataSet.BeforeOpen := FSaveOnBeforeOpen;
+ inherited Destroy;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxCustomStoredProc.ExecProc;
+begin
+ // Do nothing, code Should be added on inherited Classes;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxCustomStoredProc.DefineProperties(AFiler: TFiler);
+begin
+ inherited DefineProperties(AFiler);
+ AFiler.DefineProperty('Parameters', ReadParamData, WriteParamData, True);
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxCustomStoredProc.ReadParamData(AReader: TReader);
+begin
+ frxReadCollection(FParams, AReader, Self);
+ UpdateParams;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxCustomStoredProc.WriteParamData(AWriter: TWriter);
+begin
+ frxWriteCollection(FParams, AWriter, Self);
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxCustomStoredProc.TriggerOnAfterOpen(ADataSet: TDataSet);
+begin
+ if Assigned(FSaveOnAfterOpen) then
+ FSaveOnAfterOpen(DataSet);
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxCustomStoredProc.TriggerOnBeforeOpen(ADataSet: TDataSet);
+begin
+ UpdateParams;
+ if Assigned(FSaveOnBeforeOpen) then
+ FSaveOnBeforeOpen(DataSet);
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxCustomStoredProc.ParamByName(const AValue: String): TfrxParamItem;
+begin
+ Result := FParams.Find(AValue);
+ if Result = nil then
+ raise Exception.Create('Parameter "' + AValue + '" not found');
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxCustomStoredProc.Prepare;
+begin
+ // Do nothing, code Should be added on inherited Classes;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxCustomStoredProc.FetchParams;
+begin
+ // Do nothing, code Should be added on inherited Classes;
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxCustomStoredProc.GetStoredProcName: string;
+begin
+ // Do nothing, code Should be added on inherited Classes;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxCustomStoredProc.SetParams(AValue: TfrxParams);
+begin
+ FParams.Assign(AValue);
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxCustomStoredProc.SetStoredProcName(const AValue: string);
+begin
+ // Do nothing, code Should be added on inherited Classes;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxCustomStoredProc.UpdateParams;
+begin
+ // Do nothing, code Should be added on inherited Classes;
+end;
+
+{-------------------------------------------------------------------------------}
+{ TfrxFDStoredProc }
+{-------------------------------------------------------------------------------}
+constructor TfrxFDStoredProc.Create(AOwner: TComponent);
+begin
+ FStoredProc := TFDStoredProc.Create(nil);
+ FStoredProc.OnMasterSetValues := DoMasterSetValues;
+ Dataset := FStoredProc;
+ SetDatabase(nil);
+ inherited Create(AOwner);
+end;
+
+{-------------------------------------------------------------------------------}
+constructor TfrxFDStoredProc.DesignCreate(AOwner: TComponent; AFlags: Word);
+var
+ i: Integer;
+ l: TList;
+begin
+ inherited DesignCreate(AOwner, AFlags);
+ l := Report.AllObjects;
+ for i := 0 to l.Count - 1 do
+ if TObject(l[i]) is TfrxFDDatabase then begin
+ SetDatabase(TfrxFDDatabase(l[i]));
+ Break;
+ end;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDStoredProc.DoMasterSetValues(ASender: TFDDataSet);
+begin
+ if FStoredProc = nil then Exit;
+ // Code to assign current Master field values for Master-Detail Relationship
+ frxDoMasterSetValues( FStoredProc );
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDStoredProc.ExecProc;
+begin
+ if FStoredProc = nil then Exit;
+ UpdateParams;
+ FStoredProc.ExecProc;
+ frxFDParamValuesToParams(Self, FStoredProc.Params, Params, True);
+end;
+
+{-------------------------------------------------------------------------------}
+class function TfrxFDStoredProc.GetDescription: String;
+begin
+ Result := 'FD StoredProc';
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDStoredProc.Notification(AComponent: TComponent;
+ AOperation: TOperation);
+begin
+ inherited Notification(AComponent, AOperation);
+ if (AOperation = opRemove) and (AComponent = FDatabase) then
+ SetDatabase(nil);
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDStoredProc.Prepare;
+begin
+ FetchParams;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDStoredProc.FetchParams;
+begin
+ if FStoredProc = nil then Exit;
+ if csDesigning in ComponentState then
+ Exit;
+ FStoredProc.Unprepare;
+ if (StoredProcName <> '') and (FStoredProc.Connection <> nil) then
+ FStoredProc.Prepare;
+ if (StoredProcName = '') or FStoredProc.Prepared then
+ frxFDParamsToParams(Self, FStoredProc.Params, FParams, True);
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDStoredProc.SetCatalogName(const AValue: String);
+begin
+ if FStoredProc = nil then Exit;
+ FStoredProc.CatalogName := AValue;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDStoredProc.SetSchemaName(const AValue: String);
+begin
+ if FStoredProc = nil then Exit;
+ FStoredProc.SchemaName := AValue;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDStoredProc.TriggerOnAfterOpen(ADataSet: TDataSet);
+begin
+ if FStoredProc = nil then Exit;
+ // copy Values from Output Type TFDParams to TfrxParams, only for SP that return values
+ frxFDParamValuesToParams(Self, FStoredProc.Params, Params, true);
+ inherited;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDStoredProc.SetDatabase(const AValue: TfrxFDDatabase);
+begin
+ if FStoredProc = nil then Exit;
+ FDatabase := AValue;
+ if AValue <> nil then
+ FStoredProc.Connection := AValue.Database
+ else if GFDComponents <> nil then
+ FStoredProc.Connection := GFDComponents.DefaultDatabase
+ else
+ FStoredProc.Connection := nil;
+ FetchParams;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDStoredProc.SetMaster(const AValue: TDataSource);
+begin
+ if FStoredProc = nil then Exit;
+ FStoredProc.MasterSource := AValue;
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDStoredProc.GetPackageName: String;
+begin
+ if FStoredProc = nil then Exit;
+ Result := FStoredProc.PackageName;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDStoredProc.SetPackageName(const AValue: String);
+begin
+ if FStoredProc = nil then Exit;
+ FStoredProc.PackageName := AValue;
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDStoredProc.GetCatalogName: String;
+begin
+ if FStoredProc = nil then Exit;
+ Result := FStoredProc.CatalogName;
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDStoredProc.GetSchemaName: String;
+begin
+ if FStoredProc = nil then Exit;
+ Result := FStoredProc.SchemaName;
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDStoredProc.GetStoredProcName: string;
+begin
+ Result := FStoredProc.StoredProcName;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDStoredProc.SetStoredProcName(const AValue: string);
+begin
+ FStoredProc.StoredProcName := AValue;
+ FetchParams;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDStoredProc.UpdateParams;
+begin
+ if FStoredProc = nil then Exit;
+ frxParamsToFDParams(Self, Params, FStoredProc.Params);
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDStoredProc.BeforeStartReport;
+begin
+ if FStoredProc = nil then Exit;
+ inherited BeforeStartReport;
+ SetDatabase(FDatabase);
+end;
+
+{-------------------------------------------------------------------------------}
+{ TfrxEngineFD }
+{-------------------------------------------------------------------------------}
+{$IFDEF QBUILDER}
+constructor TfrxEngineFD.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FQuery := TFDQuery.Create(nil);
+end;
+
+{-------------------------------------------------------------------------------}
+destructor TfrxEngineFD.Destroy;
+begin
+ FreeAndNil(FQuery);
+ inherited Destroy;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxEngineFD.ReadFieldList(const ATableName: string;
+ var AFieldList: TfqbFieldList);
+var
+ oTab: TFDTable;
+ oDefs: TFieldDefs;
+ i: Integer;
+ oQBField: TfqbField;
+begin
+ AFieldList.Clear;
+ oTab := TFDTable.Create(Self);
+ oTab.Connection := FQuery.Connection;
+ oTab.TableName := ATableName;
+ oDefs := oTab.FieldDefs;
+ try
+ try
+ oTab.Active := True;
+ oQBField := TfqbField(AFieldList.Add);
+ oQBField.FieldName := '*';
+ for i := 0 to oDefs.Count - 1 do begin
+ oQBField := TfqbField(AFieldList.Add);
+ oQBField.FieldName := oDefs.Items[i].Name;
+ oQBField.FieldType := Ord(oDefs.Items[i].DataType)
+ end;
+ except
+ end;
+ finally
+ oTab.Free;
+ end;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxEngineFD.ReadTableList(ATableList: TStrings);
+begin
+ ATableList.Clear;
+ FQuery.Connection.GetTableNames(FQuery.ConnectionName, '', '', ATableList);
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxEngineFD.ResultDataSet: TDataSet;
+begin
+ Result := FQuery;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxEngineFD.SetSQL(const AValue: string);
+begin
+ FQuery.SQL.Text := AValue;
+end;
+{$ENDIF}
+
+{-------------------------------------------------------------------------------}
+initialization
+ frxObjects.RegisterObject1(TfrxFDDataBase, nil, '', {$IFDEF DB_CAT}'DATABASES'{$ELSE}''{$ENDIF}, 0, 250);
+ frxObjects.RegisterObject1(TfrxFDTable, nil, '', {$IFDEF DB_CAT}'QUERIES'{$ELSE}''{$ENDIF}, 0, 251);
+ frxObjects.RegisterObject1(TfrxFDQuery, nil, '', {$IFDEF DB_CAT}'QUERIES'{$ELSE}''{$ENDIF}, 0, 252);
+ frxObjects.RegisterObject1(TfrxFDStoredProc, nil, '', {$IFDEF DB_CAT}'QUERIES'{$ELSE}''{$ENDIF}, 0, 252);
+finalization
+ frxObjects.UnRegister(TfrxFDDataBase);
+ frxObjects.UnRegister(TfrxFDTable);
+ frxObjects.UnRegister(TfrxFDQuery);
+ frxObjects.UnRegister(TfrxFDStoredProc);
+end.
diff --git a/LibD28/FMX.frxFDComponents.res b/LibD28/FMX.frxFDComponents.res
new file mode 100644
index 0000000..0f99b77
Binary files /dev/null and b/LibD28/FMX.frxFDComponents.res differ
diff --git a/LibD28/FMX.frxFDEditor.pas b/LibD28/FMX.frxFDEditor.pas
new file mode 100644
index 0000000..df7b53e
--- /dev/null
+++ b/LibD28/FMX.frxFDEditor.pas
@@ -0,0 +1,375 @@
+{ --------------------------------------------------------------------------- }
+{ FireDAC FastReport v 4.0 enduser components }
+{ }
+{ (c)opyright DA-SOFT Technologies 2004-2013. }
+{ All rights reserved. }
+{ }
+{ Initially created by: Serega Glazyrin }
+{ Extended by: Francisco Armando Duenas Rodriguez }
+{ --------------------------------------------------------------------------- }
+{$I frx.inc}
+
+unit FMX.frxFDEditor;
+
+interface
+
+implementation
+
+uses
+ System.Classes, System.SysUtils, FMX.Forms, FMX.Dialogs, FMX.Controls, System.UIConsts, System.UITypes,
+{$IFDEF Delphi6}
+ System.Variants,
+{$ENDIF}
+ FMX.frxFDComponents, FMX.frxCustomDB, FMX.frxEditQueryParams, FMX.frxCustomDBEditor,
+ FMX.frxDsgnIntf, FMX.frxRes,
+ FireDAC.Comp.Client, FireDAC.FMXUI.Login, FireDAC.Stan.ResStrs;
+
+type
+ TfrxFDDatabaseNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ function ShowConnEditDlg(AConn: TFDCustomConnection; const ACaption: String;
+ AHideOptionsTab: Boolean = False): Boolean;
+ end;
+
+ TfrxFDDatabaseProperty = class(TfrxComponentProperty)
+ public
+ function GetValue: String; override;
+ procedure SetValue(const AValue: String); override;
+ end;
+
+ TfrxFDDriverNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ procedure SetValue(const AValue: String); override;
+ end;
+
+ TfrxFDConnectionDefNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ procedure SetValue(const AValue: String); override;
+ end;
+
+ TfrxFDPackageNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ procedure SetValue(const AValue: String); override;
+ end;
+
+ TfrxFDStoredProcNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ procedure SetValue(const AValue: String); override;
+ end;
+
+ TfrxFDTableNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ procedure SetValue(const AValue: String); override;
+ end;
+
+ TfrxFDIndexNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ end;
+
+ TfrxFDParamsProperty = class(TfrxClassProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+{-------------------------------------------------------------------------------}
+{ TfrxFDDatabaseProperty }
+{-------------------------------------------------------------------------------}
+function TfrxFDDatabaseProperty.GetValue: String;
+var
+ db: TfrxFDDatabase;
+begin
+ db := TfrxFDDatabase(GetOrdValue);
+ if db = nil then begin
+ if (GFDComponents <> nil) and (GFDComponents.DefaultDatabase <> nil) then
+ Result := GFDComponents.DefaultDatabase.Name
+ else
+ Result := frxResources.Get('prNotAssigned');
+ end
+ else
+ Result := inherited GetValue;
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDDatabaseProperty.SetValue(const AValue: String);
+begin
+ inherited SetValue(AValue);
+ Designer.UpdateDataTree;
+end;
+
+{-------------------------------------------------------------------------------}
+{ TfrxFDDriverNameProperty }
+{-------------------------------------------------------------------------------}
+function TfrxFDDriverNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paSortList];
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDDriverNameProperty.GetValues;
+begin
+ inherited GetValues;
+ FDManager.GetDriverNames(Values);
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDDriverNameProperty.SetValue(const AValue: String);
+begin
+ inherited SetValue(AValue);
+ Designer.UpdateDataTree;
+end;
+
+{-------------------------------------------------------------------------------}
+{ TfrxFDConnectionDefNameProperty }
+{-------------------------------------------------------------------------------}
+function TfrxFDConnectionDefNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paSortList];
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDConnectionDefNameProperty.GetValues;
+begin
+ inherited GetValues;
+ FDManager.GetConnectionDefNames(Values);
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDConnectionDefNameProperty.SetValue(const AValue: String);
+begin
+ inherited SetValue(AValue);
+ Designer.UpdateDataTree;
+end;
+
+{-------------------------------------------------------------------------------}
+{ TfrxFDPackageNameProperty }
+{-------------------------------------------------------------------------------}
+function TfrxFDPackageNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paSortList];
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDPackageNameProperty.GetValues;
+begin
+ inherited GetValues;
+ with TfrxFDStoredProc(Component).StoredProc do
+ if Connection <> nil then
+ Connection.GetPackageNames(CatalogName, SchemaName, '', Values);
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDPackageNameProperty.SetValue(const AValue: String);
+begin
+ inherited SetValue(AValue);
+ Designer.UpdateDataTree;
+end;
+
+{-------------------------------------------------------------------------------}
+{ TfrxFDStoredProcNameProperty }
+{-------------------------------------------------------------------------------}
+function TfrxFDStoredProcNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paSortList];
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDStoredProcNameProperty.GetValues;
+begin
+ inherited GetValues;
+ with TfrxFDStoredProc(Component).StoredProc do
+ if Connection <> nil then
+ Connection.GetStoredProcNames(CatalogName, SchemaName, PackageName, '', Values);
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDStoredProcNameProperty.SetValue(const AValue: String);
+begin
+ inherited SetValue(AValue);
+ Designer.UpdateDataTree;
+end;
+
+{-------------------------------------------------------------------------------}
+{ TfrxFDTableNameProperty }
+{-------------------------------------------------------------------------------}
+function TfrxFDTableNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paSortList];
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDTableNameProperty.GetValues;
+begin
+ inherited GetValues;
+ with TfrxFDTable(Component).Table do
+ if Connection <> nil then
+ Connection.GetTableNames(CatalogName, SchemaName, '', Values);
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDTableNameProperty.SetValue(const AValue: String);
+begin
+ inherited SetValue(AValue);
+ Designer.UpdateDataTree;
+end;
+
+{-------------------------------------------------------------------------------}
+{ TfrxFDIndexNameProperty }
+{-------------------------------------------------------------------------------}
+function TfrxFDIndexNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList];
+end;
+
+{-------------------------------------------------------------------------------}
+procedure TfrxFDIndexNameProperty.GetValues;
+var
+ i: Integer;
+begin
+ inherited GetValues;
+ try
+ with TfrxFDTable(Component).Table do
+ if (TableName <> '') and (IndexDefs <> nil) then begin
+ IndexDefs.Update;
+ for i := 0 to IndexDefs.Count - 1 do
+ if IndexDefs[i].Name <> '' then
+ Values.Add(IndexDefs[i].Name);
+ end;
+ except
+ end;
+end;
+
+{-------------------------------------------------------------------------------}
+{ TfrxFDParamsProperty }
+{-------------------------------------------------------------------------------}
+function TfrxFDParamsProperty.Edit: Boolean;
+var
+ oProc: TfrxCustomStoredProc;
+begin
+ Result := False;
+ oProc := TfrxCustomStoredProc(Component);
+ if oProc.Params.Count <> 0 then
+ with TfrxParamsEditorForm.Create(Designer) do
+ try
+ Params := oProc.Params;
+ Result := ShowModal = mrOk;
+ if Result then begin
+ oProc.UpdateParams;
+ Self.Designer.UpdateDataTree;
+ end;
+ finally
+ Free;
+ end;
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDParamsProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog, paReadOnly];
+end;
+
+{-------------------------------------------------------------------------------}
+{ TfrxFDDatabaseNameProperty }
+{-------------------------------------------------------------------------------}
+function TfrxFDDatabaseNameProperty.Edit: Boolean;
+var
+ lSaveConnected: Boolean;
+ oConn: TFDCustomConnection;
+begin
+ oConn := TfrxFDDatabase(Component).Database;
+ lSaveConnected := oConn.Connected;
+ oConn.Connected := False;
+
+ Result := ShowConnEditDlg(oConn, TfrxFDDatabase(Component).Name, True);
+
+ if Result then begin
+ TfrxFDDatabase(Component).Params.Text := oConn.Params.Text;
+{$IFDEF DELPHI21}
+ TfrxFDDatabase(Component).DatabaseName := oConn.ResultConnectionDef.Params.Database;
+ TfrxFDDatabase(Component).DriverName := oConn.ResultConnectionDef.Params.DriverID;
+{$ELSE}
+ TfrxFDDatabase(Component).DatabaseName := oConn.ResultConnectionDef.Database;
+ TfrxFDDatabase(Component).DriverName := oConn.ResultConnectionDef.DriverID;
+{$ENDIF}
+ TfrxFDDatabase(Component).ConnectionDefName := oConn.ConnectionDefName;
+ TfrxFDDatabase(Component).LoginPrompt := oConn.LoginPrompt;
+ end;
+
+ oConn.Connected := lSaveConnected;
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDDatabaseNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog];
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDDatabaseNameProperty.ShowConnEditDlg(AConn: TFDCustomConnection;
+ const ACaption: String; AHideOptionsTab: Boolean): Boolean;
+//var
+ //oFrm: TfrmFDGUIxFMXLogin;
+begin
+ Result := False;
+ // fmx version of FireDac doesn't have connection editor UI
+ { Show Standard AnyDAC connection dialog
+ improved options should be implemented for:
+ a) Hide Connection 'Options Tab' or
+ add an optional parameter to TfrmFDGUIxFormsConnEdit.Execute to pass an already
+ instantiated TfrmFDGUIxFormsConnEdit object where Specified tabs can be Hidden
+ before showing the connection editor
+ b) Or Implement the same TFDConnection properties to tfrxFDDatabase so editing
+ any advanced options in the Dialog can be assigned to TfrxFDDatabase }
+// oFrm := TfrmFDGUIxFMXLogin.Create(nil);
+ try
+ //oFrm.tsOptions.TabVisible := not AHideOptionsTab;
+ // Result := oFrm.ExecuteLogin();
+// Execute(ALoginAction: TFDGUIxLoginAction)
+ finally
+ // oFrm.Free;
+ end;
+end;
+
+{-------------------------------------------------------------------------------}
+initialization
+ frxPropertyEditors.Register(TypeInfo(String), TfrxFDDataBase, 'DatabaseName',
+ TfrxFDDataBaseNameProperty);
+
+ frxPropertyEditors.Register(TypeInfo(String), TfrxFDDatabase, 'DriverName',
+ TfrxFDDriverNameProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxFDDatabase, 'ConnectionDefName',
+ TfrxFDConnectionDefNameProperty);
+
+ frxPropertyEditors.Register(TypeInfo(TfrxFDDatabase), TfrxFDQuery, 'Database',
+ TfrxFDDatabaseProperty);
+
+ frxPropertyEditors.Register(TypeInfo(TfrxFDDatabase), TfrxFDTable, 'Database',
+ TfrxFDDatabaseProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxFDTable, 'TableName',
+ TfrxFDTableNameProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxFDTable, 'IndexName',
+ TfrxFDIndexNameProperty);
+
+ frxPropertyEditors.Register(TypeInfo(TfrxFDDatabase), TfrxFDStoredProc, 'Database',
+ TfrxFDDatabaseProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxFDStoredProc, 'PackageName',
+ TfrxFDPackageNameProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxFDStoredProc, 'StoredProcName',
+ TfrxFDStoredProcNameProperty);
+ frxPropertyEditors.Register(TypeInfo(TfrxParams), TfrxCustomStoredProc, 'Params',
+ TfrxFDParamsProperty);
+end.
diff --git a/LibD28/FMX.frxFDRTTI.pas b/LibD28/FMX.frxFDRTTI.pas
new file mode 100644
index 0000000..9e40559
--- /dev/null
+++ b/LibD28/FMX.frxFDRTTI.pas
@@ -0,0 +1,161 @@
+{ --------------------------------------------------------------------------- }
+{ FireDAC FastReport v 2.0 enduser components }
+{ }
+{ (c)opyright DA-SOFT Technologies 2004-2013. }
+{ All rights reserved. }
+{ }
+{ Initially created by: Serega Glazyrin }
+{ Extended by: Francisco Armando Duenas Rodriguez }
+{ --------------------------------------------------------------------------- }
+{$I frx.inc}
+
+unit FMX.frxFDRTTI;
+
+interface
+
+implementation
+
+uses
+ System.Classes, System.Types, System.SysUtils, FMX.Forms,
+{$IFDEF Delphi6}
+ System.Variants,
+{$ENDIF}
+ FireDAC.DatS, FireDAC.Comp.DataSet, FireDAC.Comp.Client,
+ FMX.fs_iinterpreter, FMX.fs_idbrtti, FMX.frxFDComponents;
+
+type
+ TfrxFDFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+{-------------------------------------------------------------------------------}
+constructor TfrxFDFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do begin
+ AddClass(TFDManager, 'TComponent');
+ AddClass(TFDConnection, 'TComponent');
+ AddClass(TFDDataSet, 'TDataSet');
+ AddClass(TFDAdaptedDataSet, 'TFDDataSet');
+ AddClass(TFDRdbmsDataSet, 'TFDAdaptedDataSet');
+
+ with AddClass(TFDQuery, 'TFDRdbmsDataSet') do begin
+ AddMethod('procedure ExecSQL', CallMethod);
+ AddMethod('function ParamByName(const Value: string): TParam', CallMethod);
+ AddMethod('procedure Prepare', CallMethod);
+ AddProperty('ParamCount', 'Word', GetProp, nil);
+ end;
+ with AddClass(TFDStoredProc, 'TFDRdbmsDataSet') do begin
+ AddMethod('procedure ExecProc', CallMethod);
+ AddMethod('function ParamByName(const Value: string): TParam', CallMethod);
+ AddMethod('procedure Prepare', CallMethod);
+ AddProperty('ParamCount', 'Word', GetProp, nil);
+ end;
+
+ with AddClass(TfrxFDDatabase, 'TfrxCustomDatabase') do
+ AddProperty('Database', 'TFDConnection', GetProp, nil);
+ //AddClass(TfrxADTable, 'TfrxCustomTable');
+
+ with AddClass(TfrxFDQuery, 'TfrxCustomQuery') do begin
+ AddMethod('procedure ExecSQL', CallMethod);
+ AddProperty('Query', 'TFDQuery', GetProp, nil);
+ end;
+
+ with AddClass(TfrxCustomStoredProc, 'TfrxCustomDataset') do begin
+ AddMethod('procedure ExecProc', CallMethod);
+ AddMethod('procedure FetchParams', CallMethod);
+ AddMethod('function ParamByName(const AValue: String): TfrxParamItem', CallMethod);
+ AddMethod('procedure Prepare', CallMethod);
+ AddMethod('procedure UpdateParams', CallMethod);
+ end;
+
+ with AddClass(TfrxFDStoredProc, 'TfrxCustomStoredProc') do begin
+ AddProperty('StoredProc', 'TFDStoredProc', GetProp, nil);
+ end;
+ end;
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TFDQuery then begin
+ if MethodName = 'EXECSQL' then
+ TFDQuery(Instance).ExecSQL
+ else if MethodName = 'PARAMBYNAME' then
+ Result := Integer(TFDQuery(Instance).ParamByName(Caller.Params[0]))
+ else if MethodName = 'PREPARE' then
+ TFDQuery(Instance).Prepare;
+ end
+ else if ClassType = TFDStoredProc then begin
+ if MethodName = 'EXECPROC' then
+ TFDStoredProc(Instance).ExecProc
+ else if MethodName = 'PARAMBYNAME' then
+ Result := Integer(TFDStoredProc(Instance).ParamByName(Caller.Params[0]))
+ else if MethodName = 'PREPARE' then
+ TFDStoredProc(Instance).Prepare;
+ end
+ else if ClassType = TfrxFDQuery then begin
+ if MethodName = 'EXECSQL' then
+ TfrxFDQuery(Instance).Query.ExecSQL
+ else if MethodName = 'FETCHPARAMS' then
+ TfrxFDQuery(Instance).FetchParams;
+ end
+ else if ClassType = TfrxCustomStoredProc then begin
+ if MethodName = 'EXECPROC' then
+ TfrxCustomStoredProc(Instance).ExecProc
+ else if MethodName = 'FETCHPARAMS' then
+ TfrxCustomStoredProc(Instance).FetchParams
+ else if MethodName = 'PARAMBYNAME' then
+ Result := Integer(TfrxCustomStoredProc(Instance).ParamByName(Caller.Params[0]))
+ else if MethodName = 'PREPARE' then
+ TfrxCustomStoredProc(Instance).Prepare
+ else if MethodName = 'UPDATEPARAMS' then
+ TfrxCustomStoredProc(Instance).FetchParams;
+ end
+end;
+
+{-------------------------------------------------------------------------------}
+function TfrxFDFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TFDQuery then begin
+ if PropName = 'PARAMCOUNT' then
+ Result := TFDQuery(Instance).ParamCount;
+ end
+ else if ClassType = TFDStoredProc then begin
+ if PropName = 'PARAMCOUNT' then
+ Result := TFDStoredProc(Instance).ParamCount;
+ end
+ else if ClassType = TfrxFDDatabase then begin
+ if PropName = 'DATABASE' then
+ Result := Integer(TfrxFDDatabase(Instance).Database);
+ end
+ else if ClassType = TfrxFDQuery then begin
+ if PropName = 'QUERY' then
+ Result := Integer(TfrxFDQuery(Instance).Query);
+ end
+ else if ClassType = TfrxFDStoredProc then begin
+ if PropName = 'STOREDPROC' then
+ Result := Integer(TfrxFDStoredProc(Instance).StoredProc);
+ end;
+end;
+
+{-------------------------------------------------------------------------------}
+initialization
+ fsRTTIModules.Add(TfrxFDFunctions);
+
+finalization
+ fsRTTIModules.Remove(TfrxFDFunctions);
+
+end.
diff --git a/LibD28/FMX.frxFDReg.pas b/LibD28/FMX.frxFDReg.pas
new file mode 100644
index 0000000..744ee27
--- /dev/null
+++ b/LibD28/FMX.frxFDReg.pas
@@ -0,0 +1,34 @@
+{ --------------------------------------------------------------------------- }
+{ AnyDAC FastReport v 2.0 enduser components }
+{ }
+{ (c)opyright DA-SOFT Technologies 2004-2013. }
+{ All rights reserved. }
+{ }
+{ Initially created by: Serega Glazyrin }
+{ Extended by: Francisco Armando Duenas Rodriguez }
+{ --------------------------------------------------------------------------- }
+{$I frx.inc}
+
+unit FMX.frxFDReg;
+
+interface
+
+procedure Register;
+
+implementation
+
+uses
+ System.SysUtils, System.Classes
+{$IFNDEF Delphi6}
+, DsgnIntf
+{$ELSE}
+, DesignIntf, DesignEditors
+{$ENDIF}
+, FMX.frxFDComponents;
+
+procedure Register;
+begin
+ RegisterComponents('FastReport 2.0 FMX', [TfrxFDComponents]);
+end;
+
+end.
diff --git a/LibD28/FMX.frxFMX.pas b/LibD28/FMX.frxFMX.pas
new file mode 100644
index 0000000..2428de7
--- /dev/null
+++ b/LibD28/FMX.frxFMX.pas
@@ -0,0 +1,2970 @@
+{***************************************************}
+{ }
+{ FastReport v4.0 }
+{ Things missing in FMX }
+{ }
+{ Copyright (c) 1998-2011 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{***************************************************}
+
+unit FMX.frxFMX;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Types, FMX.Controls,
+ System.Types, System.UIConsts, FMX.ListBox, FMX.Objects, System.Math,
+ FMX.TreeView, FMX.Edit, FMX.Forms, FMX.Platform, System.Variants
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.TextLayout , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF MSWINDOWS}
+, Winapi.Windows, Winapi.WinSpool, Winapi.Messages
+{$ENDIF}
+{$IFDEF LINUX}
+ ,FMUX.Api
+{$ENDIF}
+{$IFDEF MACOS}
+, Macapi.CoreText, Macapi.CoreFoundation, MacApi.CocoaTypes, Macapi.Foundation, FMX.Canvas.Mac, MacApi.CoreGraphics, Macapi.AppKit
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+const
+ DMBIN_AUTO = 7;
+{$EXTERNALSYM DMBIN_AUTO}
+ DMPAPER_A4 = 9;
+{$EXTERNALSYM DMPAPER_A4}
+ DMPAPER_USER = 256;
+{$EXTERNALSYM DMPAPER_USER}
+ VK_F1 = vkF1;
+{$EXTERNALSYM VK_F1}
+ poPortrait = TPrinterOrientation.poPortrait;
+ poLandscape = TPrinterOrientation.poLandscape;
+ fsBold = TFontStyle.fsBold;
+ fsItalic = TFontStyle.fsItalic;
+ fsUnderline = TFontStyle.fsUnderline;
+ fsStrikeout = TFontStyle.fsStrikeout;
+ mbLeft = TMouseButton.mbLeft;
+ mbRight = TMouseButton.mbRight;
+ alLeft = TAlignLayout.alLeft;
+ alClient = TAlignLayout.alClient;
+ taCenter = TTextAlign.taCenter;
+ wsMaximized = TWindowState.wsMaximized;
+ {$IFDEF LINUX}
+ DefFontName = 'Liberation Sans';
+ {$ELSE}
+ DefFontName = 'Arial';
+ {$ENDIF}
+
+ DefFontSize = 10;
+ frxDefPPIUnits = 72;
+ frxDefDPIUnits = 96;
+
+ { WIN Paper consts for paper linkage }
+ FRX_DMPAPER_LETTER = 1;
+ FRX_DMPAPER_LETTERSMALL = 2;
+ FRX_DMPAPER_TABLOID = 3;
+ FRX_DMPAPER_LEDGER = 4;
+ FRX_DMPAPER_LEGAL = 5;
+ FRX_DMPAPER_STATEMENT = 6;
+ FRX_DMPAPER_EXECUTIVE = 7;
+ FRX_DMPAPER_A3 = 8;
+ FRX_DMPAPER_A4 = 9;
+ FRX_DMPAPER_A4SMALL = 10;
+ FRX_DMPAPER_A5 = 11;
+ FRX_DMPAPER_B4 = 12;
+ FRX_DMPAPER_B5 = 13;
+ FRX_DMPAPER_FOLIO = 14;
+ FRX_DMPAPER_QUARTO = 15;
+ FRX_DMPAPER_10X14 = 16;
+ FRX_DMPAPER_11X17 = 17;
+ FRX_DMPAPER_NOTE = 18;
+ FRX_DMPAPER_ENV_9 = 19;
+ FRX_DMPAPER_ENV_10 = 20;
+ FRX_DMPAPER_ENV_11 = 21;
+ FRX_DMPAPER_ENV_12 = 22;
+ FRX_DMPAPER_ENV_14 = 23;
+ FRX_DMPAPER_CSHEET = 24;
+ FRX_DMPAPER_DSHEET = 25;
+ FRX_DMPAPER_ESHEET = 26;
+ FRX_DMPAPER_ENV_DL = 27;
+ FRX_DMPAPER_ENV_C5 = 28;
+ FRX_DMPAPER_ENV_C3 = 29;
+ FRX_DMPAPER_ENV_C4 = 30;
+ FRX_DMPAPER_ENV_C6 = 31;
+ FRX_DMPAPER_ENV_C65 = 32;
+ FRX_DMPAPER_ENV_B4 = 33;
+ FRX_DMPAPER_ENV_B5 = 34;
+ FRX_DMPAPER_ENV_B6 = 35;
+ FRX_DMPAPER_ENV_ITALY = 36;
+ FRX_DMPAPER_ENV_MONARCH = 37;
+ FRX_DMPAPER_ENV_PERSONAL = 38;
+ FRX_DMPAPER_FANFOLD_US = 39;
+ FRX_DMPAPER_FANFOLD_STD_GERMAN = 40;
+ FRX_DMPAPER_FANFOLD_LGL_GERMAN = 41;
+ FRX_DMPAPER_ISO_B4 = 42;
+ FRX_DMPAPER_JAPANESE_POSTCARD = 43;
+ FRX_DMPAPER_9X11 = 44;
+ FRX_DMPAPER_10X11 = 45;
+ FRX_DMPAPER_15X11 = 46;
+ FRX_DMPAPER_ENV_INVITE = 47;
+ FRX_DMPAPER_RESERVED_48 = 48;
+ FRX_DMPAPER_RESERVED_49 = 49;
+ FRX_DMPAPER_LETTER_EXTRA = 50;
+ FRX_DMPAPER_LEGAL_EXTRA = 51;
+ FRX_DMPAPER_TABLOID_EXTRA = 52;
+ FRX_DMPAPER_A4_EXTRA = 53;
+ FRX_DMPAPER_LETTER_TRANSVERSE = 54;
+ FRX_DMPAPER_A4_TRANSVERSE = 55;
+ FRX_DMPAPER_LETTER_EXTRA_TRANSVERSE = 56;
+ FRX_DMPAPER_A_PLUS = 57;
+ FRX_DMPAPER_B_PLUS = 58;
+ FRX_DMPAPER_LETTER_PLUS = 59;
+ FRX_DMPAPER_A4_PLUS = 60;
+ FRX_DMPAPER_A5_TRANSVERSE = 61;
+ FRX_DMPAPER_B5_TRANSVERSE = 62;
+ FRX_DMPAPER_A3_EXTRA = 63;
+ FRX_DMPAPER_A5_EXTRA = 64;
+ FRX_DMPAPER_B5_EXTRA = 65;
+ FRX_DMPAPER_A2 = 66;
+ FRX_DMPAPER_A3_TRANSVERSE = 67;
+ FRX_DMPAPER_A3_EXTRA_TRANSVERSE = 68;
+ FRX_DMPAPER_DBL_JAPANESE_POSTCARD = 69;
+ FRX_DMPAPER_A6 = 70;
+ FRX_DMPAPER_JENV_KAKU2 = 71;
+ FRX_DMPAPER_JENV_KAKU3 = 72;
+ FRX_DMPAPER_JENV_CHOU3 = 73;
+ FRX_DMPAPER_JENV_CHOU4 = 74;
+ FRX_DMPAPER_LETTER_ROTATED = 75;
+ FRX_DMPAPER_A3_ROTATED = 76;
+ FRX_DMPAPER_A4_ROTATED = 77;
+ FRX_DMPAPER_A5_ROTATED = 78;
+ FRX_DMPAPER_B4_JIS_ROTATED = 79;
+ FRX_DMPAPER_B5_JIS_ROTATED = 80;
+ FRX_DMPAPER_JAPANESE_POSTCARD_ROTATED = 81;
+ FRX_DMPAPER_DBL_JAPANESE_POSTCARD_ROTATED = 82;
+ FRX_DMPAPER_A6_ROTATED = 83;
+ FRX_DMPAPER_JENV_KAKU2_ROTATED = 84;
+ FRX_DMPAPER_JENV_KAKU3_ROTATED = 85;
+ FRX_DMPAPER_JENV_CHOU3_ROTATED = 86;
+ FRX_DMPAPER_JENV_CHOU4_ROTATED = 87;
+ FRX_DMPAPER_B6_JIS = 88;
+ FRX_DMPAPER_B6_JIS_ROTATED = 89;
+ FRX_DMPAPER_12X11 = 90;
+ FRX_DMPAPER_JENV_YOU4 = 91;
+ FRX_DMPAPER_JENV_YOU4_ROTATED = 92;
+ FRX_DMPAPER_P16K = 93;
+ FRX_DMPAPER_P32K = 94;
+ FRX_DMPAPER_P32KBIG = 95;
+ FRX_DMPAPER_PENV_1 = 96;
+ FRX_DMPAPER_PENV_2 = 97;
+ FRX_DMPAPER_PENV_3 = 98;
+ FRX_DMPAPER_PENV_4 = 99;
+ FRX_DMPAPER_PENV_5 = 100;
+ FRX_DMPAPER_PENV_6 = 101;
+ FRX_DMPAPER_PENV_7 = 102;
+ FRX_DMPAPER_PENV_8 = 103;
+ FRX_DMPAPER_PENV_9 = 104;
+ FRX_DMPAPER_PENV_10 = 105;
+ FRX_DMPAPER_P16K_ROTATED = 106;
+ FRX_DMPAPER_P32K_ROTATED = 107;
+ FRX_DMPAPER_P32KBIG_ROTATED = 108;
+ FRX_DMPAPER_PENV_1_ROTATED = 109;
+ FRX_DMPAPER_PENV_2_ROTATED = 110;
+ FRX_DMPAPER_PENV_3_ROTATED = 111;
+ FRX_DMPAPER_PENV_4_ROTATED = 112;
+ FRX_DMPAPER_PENV_5_ROTATED = 113;
+ FRX_DMPAPER_PENV_6_ROTATED = 114;
+ FRX_DMPAPER_PENV_7_ROTATED = 115;
+ FRX_DMPAPER_PENV_8_ROTATED = 116;
+ FRX_DMPAPER_PENV_9_ROTATED = 117;
+ FRX_DMPAPER_PENV_10_ROTATED = 118;
+
+ FRX_DMBIN_UPPER = 1;
+ FRX_DMBIN_ONLYONE = 1;
+ FRX_DMBIN_LOWER = 2;
+ FRX_DMBIN_MIDDLE = 3;
+ FRX_DMBIN_MANUAL = 4;
+ FRX_DMBIN_ENVELOPE = 5;
+ FRX_DMBIN_ENVMANUAL = 6;
+ FRX_DMBIN_AUTO = 7;
+ FRX_DMBIN_TRACTOR = 8;
+ FRX_DMBIN_SMALLFMT = 9;
+ FRX_DMBIN_LARGEFMT = 10;
+ FRX_DMBIN_LARGECAPACITY = 11;
+ FRX_DMBIN_CASSETTE = 14;
+ FRX_DMBIN_FORMSOURCE = 15;
+
+type
+{$IFDEF DELPHI28}
+ TStringsChangeOpHelper = record helper for TCustomListBox.TStringsChangeOp
+ const
+ tsoAdded = TCustomListBox.TStringsChangeOp.Added deprecated 'Use TCustomListBox.TStringsChangeOp.Added';
+ tsoDeleted = TCustomListBox.TStringsChangeOp.Deleted deprecated 'Use TCustomListBox.TStringsChangeOp.Deleted';
+ tsoClear = TCustomListBox.TStringsChangeOp.Clear deprecated 'Use TCustomListBox.TStringsChangeOp.Clear';
+ end;
+{$ENDIF}
+ { VCL TFont compatibility }
+ TfrxFont = class(TPersistent)
+ private
+ FName: String;
+ FSize: Single;
+ FPixelsPerInch: Single;
+ FStyle: TFontStyles;
+ FColor: TAlphaColor;
+ FOnChange: TNotifyEvent;
+ procedure SetName(const Value: string);
+ procedure SetSize(Value: Single);
+ procedure SetStyle(Value: TFontStyles);
+ procedure SetColor(Value: TAlphaColor);
+ procedure SetHeight(Value: Single);
+ procedure DoChange;
+ protected
+ function GetHeight: Single; overload;
+ public
+ constructor Create;
+ procedure Assign(Value: TfrxFont); reintroduce;
+ procedure AssignToFont(Value: TFont);
+ procedure AssignToCanvas(Canvas: TCanvas);
+ function GetHeight(Canvas: TCanvas): Single; overload;
+ function IsEqual(ToFont: TObject): Boolean;
+ published
+ property Name: String read FName write SetName;
+ property Size: Single read FSize write SetSize stored False;
+ property PixelsPerInch: Single read FPixelsPerInch write FPixelsPerInch;
+ property Style: TFontStyles read FStyle write SetStyle;
+ property Color: TAlphaColor read FColor write SetColor;
+ property Height: Single read GetHeight write SetHeight;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ end;
+
+ TfrxImageList = class(TComponent)
+ private
+ FImages: TList;
+ FWidth: Integer;
+ FHeight: Integer;
+ function GetCount: Integer;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Clear;
+{$IFDEF DELPHI19}
+ procedure AddMasked(Bmp: FMX.Graphics.TBitmap; Color: TAlphaColor);
+ function Get(Index: Integer): FMX.Graphics.TBitmap;
+ {$ELSE}
+ procedure AddMasked(Bmp: FMX.Types.TBitmap; Color: TAlphaColor);
+ function Get(Index: Integer): FMX.Types.TBitmap;
+{$ENDIF}
+ procedure Draw(Canvas: TCanvas; x, y: Single; Index: Integer);
+ property Width: Integer read FWidth write FWidth;
+ property Height: Integer read FHeight write FHeight;
+ property Count: Integer read GetCount;
+ end;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxToolButton = class(TSpeedButton)
+ private
+{$IFDEF DELPHI19}
+ FBitmap: FMX.Graphics.TBitmap;
+ {$ELSE}
+ FBitmap: FMX.Types.TBitmap;
+{$ENDIF}
+ FDown: Boolean;
+{$IFDEF DELPHI19}
+ procedure SetBitmap(const Value: FMX.Graphics.TBitmap);
+ {$ELSE}
+ procedure SetBitmap(const Value: FMX.Types.TBitmap);
+{$ENDIF}
+ protected
+ procedure DoMouseEnter; override;
+ procedure DoMouseLeave; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure DoPaint; override;
+ property Down: Boolean read FDown write FDown;
+ published
+{$IFDEF DELPHI19}
+ property Bitmap: FMX.Graphics.TBitmap read FBitmap write SetBitmap;
+{$ELSE}
+ property Bitmap: FMX.Types.TBitmap read FBitmap write SetBitmap;
+{$ENDIF}
+ property Hint;
+{$IFDEF Delphi17}
+ property TabOrder;
+{$ENDIF}
+ end;
+
+ TfrxToolSeparator = class(TControl)
+ public
+ procedure Paint; override;
+{$IFDEF Delphi17}
+ published
+ property Position;
+ property Width;
+ property Height;
+{$ENDIF}
+ end;
+
+ TfrxToolGrip = class(TControl)
+ public
+ procedure Paint; override;
+{$IFDEF Delphi17}
+ published
+ property Position;
+ property Width;
+ property Height;
+{$ENDIF}
+ end;
+
+ TfrxTreeViewItem = class(TTreeViewItem)
+ private
+ FButton: TCustomButton;
+ FCloseImageIndex: Integer;
+ FOpenImageIndex: Integer;
+ FImgPos: Single;
+ FData: TObject;
+{$IFDEF DELPHI19}
+ function GetBitmap(): FMX.Graphics.TBitmap;
+{$ELSE}
+ function GetBitmap(): FMX.Types.TBitmap;
+{$ENDIF}
+
+ protected
+ procedure ApplyStyle; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure Paint; override;
+ property CloseImageIndex: Integer read FCloseImageIndex write FCloseImageIndex;
+ property OpenImageIndex: Integer read FOpenImageIndex write FOpenImageIndex;
+ property Data: TObject read FData write FData;
+ end;
+
+ TfrxOnEditedEvent = procedure(Sender: TObject; Node: TfrxTreeViewItem; var S: String) of Object;
+ TfrxOnBeforeChangeEvent = procedure(Sender: TObject; OldNode: TfrxTreeViewItem; NewNode: TfrxTreeViewItem) of Object;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxTreeView = class(TTreeView)
+ private
+{$IFDEF DELPHI19}
+ FPicBitmap: FMX.Graphics.TBitmap;
+{$ELSE}
+ FPicBitmap: FMX.Types.TBitmap;
+{$ENDIF}
+ FIconWidth: Integer;
+ FIconHeight: Integer;
+ FEditBox: TEdit;
+ FIsEditing: Boolean;
+ FEditable: Boolean;
+ FFreePicOnDelete: Boolean;
+ FOnEdited: TfrxOnEditedEvent;
+ FOnBeforeChange: TfrxOnBeforeChangeEvent;
+ FManualDragAndDrop: Boolean;
+ protected
+ procedure DoEditKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure DoExit; override;
+ procedure SetSelected(const Value: TTreeViewItem); override;
+ procedure DblClick; override;
+ procedure DoExitEdit (Sender: TObject);
+ procedure BeginAutoDrag; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure DoEdit();
+ procedure EndEdit(Accept: Boolean);
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
+ procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
+ procedure LoadResouces(Stream: TStream; IconWidth, IconHeight: Integer);
+{$IFDEF DELPHI19}
+ property PicPitmap: FMX.Graphics.TBitmap read FPicBitmap write FPicBitmap;
+{$ELSE}
+ property PicPitmap: FMX.Types.TBitmap read FPicBitmap write FPicBitmap;
+{$ENDIF}
+ property IconWidth: Integer read FIconWidth write FIconWidth;
+ property IconHeight: Integer read FIconHeight write FIconHeight;
+ function GetBitmapRect(Index: Integer): TRectF;
+ procedure DragOver(const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF}); override;
+ procedure DragDrop(const Data: TDragObject; const Point: TPointF); override;
+ function AddItem(Root: TFmxObject; Text: String): TfrxTreeViewItem;
+{$IFDEF DELPHI19}
+ procedure SetImages(Bmp: FMX.Graphics.TBitmap);
+{$ELSE}
+ procedure SetImages(Bmp: FMX.Types.TBitmap);
+{$ENDIF}
+ property IsEditing: Boolean read FIsEditing;
+ property ManualDragAndDrop: Boolean read FManualDragAndDrop write FManualDragAndDrop;
+ published
+ property StyleLookup;
+ property CanFocus default True;
+ property DisableFocusEffect;
+ property TabOrder;
+ property AllowDrag default False;
+ property AlternatingRowBackground default False;
+ property ItemHeight;
+{$IFNDEF Delphi17}
+ property HideSelectionUnfocused default False;
+{$ENDIF}
+ property MultiSelect default False;
+ property ShowCheckboxes default False;
+ property Sorted default False;
+ property OnChange;
+ property OnChangeCheck;
+ property OnCompare;
+ property OnDragChange;
+ property OnEdited: TfrxOnEditedEvent read FOnEdited write FOnEdited;
+ property OnBeforeChange: TfrxOnBeforeChangeEvent read FOnBeforeChange write FOnBeforeChange;
+ property Editable: Boolean read FEditable write FEditable;
+ end;
+
+ TfrxListBoxItem = class(TListBoxItem)
+ private
+ FButton: TButton;
+ FCheck: TCheckBox;
+ FCheckVisible : Boolean;
+ function GetCheckVisible: Boolean;
+ procedure SetCheckVisible(const Value: Boolean);
+ procedure OnBtnClick(Sender: TObject);
+ protected
+ procedure ApplyStyle; override;
+ procedure FreeStyle; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ property CheckVisible: Boolean read GetCheckVisible write SetCheckVisible;
+ end;
+
+ TfrxOnButtonClick = procedure (Sender: TObject; aButton: TObject; aItem: TfrxListBoxItem) of Object;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxListBox = class(TListBox)
+ private type
+ TfrxListBoxStrings = class(TStrings)
+ private
+ [Weak] FListBox: TCustomListBox;
+ procedure ReadData(Reader: TReader);
+ procedure WriteData(Writer: TWriter);
+ protected
+ procedure Put(Index: Integer; const S: string); override;
+ function Get(Index: Integer): string; override;
+ function GetCount: Integer; override;
+ function GetObject(Index: Integer): TObject; override;
+ procedure PutObject(Index: Integer; AObject: TObject); override;
+ procedure SetUpdateState(Updating: Boolean); override;
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ function Add(const S: string): Integer; override;
+ procedure Clear; override;
+ procedure Delete(Index: Integer); override;
+ procedure Exchange(Index1, Index2: Integer); override;
+ function IndexOf(const S: string): Integer; override;
+ procedure Insert(Index: Integer; const S: string); override;
+ end;
+ private
+ FManualDragAndDrop: Boolean;
+ FOnButtonClickEvnt: TfrxOnButtonClick;
+ FItems: TStrings;
+ FCheckBoxText: String;
+ FButtonText: String;
+ FShowButtons: Boolean;
+ function ItemsStored: Boolean;
+ procedure SetItems(const Value: TStrings);
+ protected
+ procedure BeginAutoDrag; override;
+ procedure DragEnd; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
+ procedure DragOver(const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF}); override;
+ procedure DragDrop(const Data: TDragObject; const Point: TPointF); override;
+ procedure DoButtonClick(aButton: TObject; aItem: TfrxListBoxItem);
+ procedure Assign(Source: TPersistent); override;
+ property ManualDragAndDrop: Boolean read FManualDragAndDrop write FManualDragAndDrop;
+ property Items: TStrings read FItems write SetItems stored ItemsStored;
+ published
+ property StyleLookup;
+ property CanFocus default True;
+ property DisableFocusEffect;
+ property TabOrder;
+ property AllowDrag default False;
+ property AlternatingRowBackground default False;
+ property ItemHeight;
+ property MultiSelect default False;
+ property ShowCheckboxes default False;
+ property Sorted default False;
+ property OnChange;
+ property OnChangeCheck;
+ property OnCompare;
+ property OnDragChange;
+ property ShowButtons: Boolean read FShowButtons write FShowButtons;
+ property CheckBoxText: String read FCheckBoxText write FCheckBoxText;
+ property ButtonText: String read FButtonText write FButtonText;
+ property OnButtonClick: TfrxOnButtonClick read FOnButtonClickEvnt write FOnButtonClickEvnt;
+ end;
+
+ TfrxStringList = class(TStringList)
+ private
+ FUseUnicode: Boolean;
+ protected
+ function CompareStrings(const S1, S2: string): Integer; override;
+ public
+ constructor Create; overload;
+ constructor Create(UseUnicode: Boolean); overload;
+ end;
+
+ type
+{$IFDEF DELPHI19}
+ { fake class - do not use instances of this canvas for Full draw , only Text draw ! }
+ TfrxFastCanvasLayer = class(TCanvas)
+ protected
+ FContext: THandle;
+ FCanvas: TCanvas;
+ function GetContext: THandle; virtual;
+ procedure SetContext(const Value: THandle); virtual;
+ procedure SetFont(const Value: TFont); virtual;
+ procedure SetCanvas(const Value: TCanvas); virtual;
+ function DoBeginScene({$IFNDEF DELPHI28}const{$ENDIF} AClipRects: PClipRects = nil; AContextHandle: THandle = 0): Boolean; override;
+ procedure DoEndScene; override;
+ { empty }
+{$IFDEF DELPHI21}
+ class function DoInitializeBitmap(const Width, Height: Integer; const Scale: Single; var PixelFormat: TPixelFormat): THandle; override;
+ class procedure DoFinalizeBitmap(var Bitmap: THandle); override;
+ class function DoMapBitmap(const Bitmap: THandle; const Access: TMapAccess; var Data: TBitmapData): Boolean; override;
+ class procedure DoUnmapBitmap(const Bitmap: THandle; var Data: TBitmapData); override;
+ function DoFillPolygon(const Points: TPolygon; const AOpacity: Single; const ABrush: TBrush): Boolean; override;
+{$ELSE}
+{$IFDEF DELPHI19}
+ class procedure DoInitializeBitmap(const Bitmap: FMX.Graphics.TBitmap); override;
+ class procedure DoFinalizeBitmap(const Bitmap: FMX.Graphics.TBitmap); override;
+ class function DoMapBitmap(const Bitmap: FMX.Graphics.TBitmap; const Access: TMapAccess; var Data: TBitmapData): Boolean; override;
+ class procedure DoUnmapBitmap(const Bitmap: FMX.Graphics.TBitmap; var Data: TBitmapData); override;
+{$ENDIF}
+{$ENDIF}
+
+ procedure DoFillRect(const ARect: TRectF; const AOpacity: Single; const ABrush: TBrush); override;
+ procedure DoFillPath(const APath: TPathData; const AOpacity: Single; const ABrush: TBrush); override;
+ procedure DoFillEllipse(const ARect: TRectF; const AOpacity: Single; const ABrush: TBrush); override;
+{$IFDEF DELPHI19}
+ procedure DoDrawBitmap(const ABitmap: FMX.Graphics.TBitmap; const SrcRect, DstRect: TRectF; const AOpacity: Single;
+ const HighSpeed: Boolean = False); override;
+{$ELSE}
+ procedure DoDrawBitmap(const ABitmap: FMX.Types.TBitmap; const SrcRect, DstRect: TRectF; const AOpacity: Single;
+ const HighSpeed: Boolean = False); override;
+{$ENDIF}
+ procedure DoDrawLine(const APt1, APt2: TPointF; const AOpacity: Single; const ABrush: TStrokeBrush); override;
+ procedure DoDrawRect(const ARect: TRectF; const AOpacity: Single; const ABrush: TStrokeBrush); override;
+ procedure DoDrawPath(const APath: TPathData; const AOpacity: Single; const ABrush: TStrokeBrush); override;
+ procedure DoDrawEllipse(const ARect: TRectF; const AOpacity: Single; const ABrush: TStrokeBrush); override;
+ { empty end }
+ public
+ constructor Create; virtual;
+ destructor Destroy; override;
+ procedure ClearCache; virtual;
+ procedure UpdateHandle(AParent: TFmxObject); virtual;
+ { empty }
+ procedure Clear(const Color: TAlphaColor); override;
+ procedure ClearRect(const ARect: TRectF; const AColor: TAlphaColor = 0); override;
+ procedure IntersectClipRect(const ARect: TRectF); override;
+ procedure ExcludeClipRect(const ARect: TRectF); override;
+ function PtInPath(const APoint: TPointF; const APath: TPathData): Boolean; override;
+ { empty end }
+ procedure FillText(const ARect: TRectF; const AText: string; const WordWrap: Boolean; const AOpacity: Single; const Flags: TFillTextFlags; const ATextAlign, AVTextAlign: TTextAlign); override;
+ procedure MeasureText(var ARect: TRectF; const AText: string; const WordWrap: Boolean; const Flags: TFillTextFlags; const ATextAlign, AVTextAlign: TTextAlign); override;
+ function CalcHeight(aText: String): Single; virtual;
+ function CalcWidth(aText: String): Single; virtual;
+ property Font: TFont write SetFont;
+ property Context: THandle read GetContext write SetContext;
+ property Canvas: TCanvas read FCanvas write SetCanvas;
+ end;
+{$IFDEF MACoS}
+ TfrxFastCanvas = class(TfrxFastCanvasLayer)
+ private
+ FCurentFont: CTFontRef;
+ FFontCacheList: TStringList;
+ FFontTransformMatrix: CGAffineTransform;
+ FColorSpace: CGColorSpaceRef;
+ FOpacity: Single;
+ FText: String;
+ FTextAlign: TTextAlign;
+ FWordWrap: Boolean;
+ FFlags: TFillTextFlags;
+ FPath: CGMutablePathRef;
+ FTextHeight: Single;
+ FTextWidth: Single;
+ function CreateCTFont(const AFont: TFont): CTFontRef;
+ function GetCTFont(const AFont: TFont): CTFontRef;
+ function GetFontNameHash(const AFont: TFont): String;
+ function AddCTFontToList(const aNameFont: String; aFontRef: CTFontRef): Integer;
+ procedure ClearFontCache;
+ procedure SetFont(const Value: TFont); reintroduce;
+ procedure CreateFrame(Canvas: TCanvas; StringRef: CFStringRef; var AttributedS: CFMutableAttributedStringRef; var Frame: CTFrameRef);
+ procedure AddFontAttribute(AAttribute: CFMutableAttributedStringRef;
+ AFont: TFont; const AStart, ALength: Integer);
+ function CalcHeight(Frame: CTFrameRef): Single; reintroduce;
+ function CalcWidth(Frame: CTFrameRef): Single; reintroduce;
+ protected
+ function GetContext: THandle; override;
+ procedure SetCanvas(const Value: TCanvas); reintroduce;
+ public
+ constructor Create; override;
+ destructor Destroy; override;
+ procedure FillText(const ARect: TRectF; const AText: string; const WordWrap: Boolean; const AOpacity: Single; const Flags: TFillTextFlags; const ATextAlign, AVTextAlign: TTextAlign); override;
+ procedure MeasureText(var ARect: TRectF; const AText: string; const WordWrap: Boolean; const Flags: TFillTextFlags; const ATextAlign, AVTextAlign: TTextAlign); override;
+ end;
+{$ENDIF}
+
+{$IFDEF MSWINDOWS}
+ TfrxFastCanvas = class(TfrxFastCanvasLayer)
+ private
+ FFontCacheList: TStringList;
+
+ function GetFontNameHash(const AFont: TFont; WordWrap: Boolean; const Flags: TFillTextFlags; const ATextAlign: TTextAlign; const VTextAlign: TTextAlign): String;
+ procedure ClearFontCache;
+ protected
+ function GetContext: THandle; override;
+ public
+ constructor Create; override;
+ destructor Destroy; override;
+ procedure FillText(const ARect: TRectF; const AText: string; const WordWrap: Boolean; const AOpacity: Single; const Flags: TFillTextFlags; const ATextAlign, AVTextAlign: TTextAlign); override;
+ procedure MeasureText(var ARect: TRectF; const AText: string; const WordWrap: Boolean; const Flags: TFillTextFlags; const ATextAlign, AVTextAlign: TTextAlign); override;
+ end;
+{$ENDIF}
+{$ELSE}
+ TfrxFastCanvasLayer = class(TCanvas)
+ protected
+ FContext: THandle;
+ FCanvas: TCanvas;
+ public
+ procedure ClearCache; virtual; abstract;
+ procedure UpdateHandle(AParent: TFmxObject); virtual;
+ property Context: THandle read FContext write FContext;
+ property Canvas: TCanvas read FCanvas write FCanvas;
+ end;
+{$ENDIF}
+
+function GetLongHint(const Hint: string): string;
+function GetShortHint(const Hint: string): string;
+
+procedure FillFontsList(List: TStrings);
+function GetComponentForm(Comp: TFmxObject): TCommonCustomForm;
+procedure SetClipboard(const Value: String);
+function GetClipboard: String;
+{$IFDEF DELPHI19}
+function CreateRotationMatrix(const Angle: Single): TMatrix;
+function CreateScaleMatrix(const ScaleX, ScaleY: Single): TMatrix;
+function CreateTranslateMatrix(const DX, DY: Single): TMatrix;
+function MatrixMultiply(const M1, M2: TMatrix): TMatrix;
+{$ENDIF}
+
+{$IFDEF MACOS}
+procedure ShellExecute(fName: String);
+{$ENDIF}
+
+function frxCompareText(s1: String; s2: String): Integer;
+// procedure FillText(aLayout: TTextLayout; Canvas: TCanvas; const ARect: TRectF; const AText: string; const WordWrap: Boolean; const AOpacity: Single; const Flags: TFillTextFlags; const ATextAlign, AVTextAlign: TTextAlign);
+// procedure MeasureText(aLayout: TTextLayout; Canvas: TCanvas; var ARect: TRectF; const AText: string{;
+// const WordWrap: Boolean; const Flags: TFillTextFlags; const ATextAlign,
+// AVTextAlign: TTextAlign});
+implementation
+
+uses FMX.frxClass, FMX.Consts;
+
+const
+ IdentityMatrix: TMatrix = (m11: 1.0; m12: 0.0; m13: 0.0; m21: 0.0; m22: 1.0; m23: 0.0; m31: 0.0; m32: 0.0; m33: 1.0);
+
+{$IFDEF MACOS}
+const
+ kUCCollateComposeInsensitiveMask = 1 shl 1;
+ kUCCollateWidthInsensitiveMask = 1 shl 2;
+ kUCCollateCaseInsensitiveMask = 1 shl 3;
+ kUCCollateDiacritInsensitiveMask = 1 shl 4;
+ kUCCollatePunctuationSignificantMask = 1 shl 15;
+ kUCCollateDigitsOverrideMask = 1 shl 16;
+ kUCCollateDigitsAsNumberMask = 1 shl 17;
+
+
+{$IFDEF UNDERSCOREIMPORTNAME}
+ _PFX = '_';
+{$ELSE}
+ _PFX = '';
+{$ENDIF}
+
+{$EXTERNALSYM _PFX}
+
+const
+{$IFDEF MACOS64}
+ libUnicodeCore = '/System/Library/Frameworks/CoreServices.framework/Frameworks/CarbonCore.framework/CarbonCore';
+{$ELSE}
+ libUnicodeCore = '/System/Library/Frameworks/CoreServices.framework/Frameworks/CarbonCore.framework/CarbonCore';
+{$ENDIF}
+
+
+var
+ collatorRef: Pointer;
+ collatorRefIgnoreCase: Pointer;
+
+
+function UCCreateCollator(locale: Pointer; opVariant: PUInt32; options: UInt32; collatorRef: Pointer): OSStatus; cdecl; external libUnicodeCore name _PFX + 'UCCreateCollator';
+function UCDisposeCollator(collatorRef: Pointer): OSStatus; cdecl; external libUnicodeCore name _PFX + 'UCDisposeCollator';
+
+function UCCompareText(collatorRef: Pointer; text1Ptr: PWideChar; text1Length: UInt32; text2Ptr: PWideChar; text2Length: UInt32; equivalent: PBoolean; order: PInteger): OSStatus; cdecl; external libUnicodeCore name _PFX + 'UCCompareText';
+
+procedure ShellExecute(fName: String);
+var
+ wspace: NSWorkspace;
+begin
+ wspace := TNSWorkspace.Create;
+ try
+ if FileExists(fName) then
+ wspace.openFile(NSSTR(fName));
+ finally
+ wspace.release;
+ end;
+end;
+{$ENDIF}
+
+{$IFDEF MSWINDOWS}
+var
+ frxDefaultPPI: Integer;
+{$ENDIF}
+
+function frxCompareText(s1: String; s2: String): Integer;
+{$IFDEF MACOS}
+begin
+ Result := -1;
+ try
+ UCCompareText(collatorRefIgnoreCase, PWideChar(s1), Length(s1), PWideChar(s2), Length(s2), nil, @Result);
+ finally
+ end;
+end;
+{$ELSE}
+begin
+ Result := AnsiCompareText(s1, s2);
+end;
+{$ENDIF}
+
+function frxCompareStr(const S1, S2: string): Integer;
+{$IFDEF MACOS}
+begin
+ Result := -1;
+ try
+ UCCompareText(collatorRef, PWideChar(s1), Length(s1), PWideChar(s2), Length(s2), nil, @Result);
+ finally
+ end;
+end;
+{$ELSE}
+begin
+ Result := CompareStr(s1, s2);
+end;
+{$ENDIF}
+
+type
+ THackCustomListBox = class(TCustomListBox);
+function CreateScaleMatrix(const ScaleX, ScaleY: Single): TMatrix;
+begin
+ Result := IdentityMatrix;
+ Result.m11 := ScaleX;
+ Result.m22 := ScaleY;
+end;
+
+
+function CreateTranslateMatrix(const DX, DY: Single): TMatrix;
+begin
+ Result := IdentityMatrix;
+ Result.m31 := DX;
+ Result.m32 := DY;
+end;
+
+function CreateRotationMatrix(const Angle: Single): TMatrix;
+var
+ cosine, sine: Extended;
+begin
+ SinCos(Angle, sine, cosine);
+
+ Result.m11 := cosine;
+ Result.m12 := sine;
+ Result.m13 := 0;
+ Result.m21 := -sine;
+ Result.m22 := cosine;
+ Result.m23 := 0;
+
+ Result.m31 := 0;
+ Result.m32 := 0;
+ Result.m33 := 1;
+end;
+
+function MatrixMultiply(const M1, M2: TMatrix): TMatrix;
+begin
+ Result.m11 := M1.m11 * M2.m11 + M1.m12 * M2.m21 + M1.m13 * M2.m31;
+ Result.m12 := M1.m11 * M2.m12 + M1.m12 * M2.m22 + M1.m13 * M2.m32;
+ Result.m13 := M1.m11 * M2.m13 + M1.m12 * M2.m23 + M1.m13 * M2.m33;
+ Result.m21 := M1.m21 * M2.m11 + M1.m22 * M2.m21 + M1.m23 * M2.m31;
+ Result.m22 := M1.m21 * M2.m12 + M1.m22 * M2.m22 + M1.m23 * M2.m32;
+ Result.m23 := M1.m21 * M2.m13 + M1.m22 * M2.m23 + M1.m23 * M2.m33;
+ Result.m31 := M1.m31 * M2.m11 + M1.m32 * M2.m21 + M1.m33 * M2.m31;
+ Result.m32 := M1.m31 * M2.m12 + M1.m32 * M2.m22 + M1.m33 * M2.m32;
+ Result.m33 := M1.m31 * M2.m13 + M1.m32 * M2.m23 + M1.m33 * M2.m33;
+end;
+{$IFDEF DELPHI19}
+{$ENDIF}
+
+function GetLongHint(const Hint: string): string;
+var
+ I: Integer;
+begin
+ I := Pos('|', Hint);
+ if I = 0 then
+ Result := Hint else
+ Result := Copy(Hint, I + 1, Maxint);
+end;
+
+function GetShortHint(const Hint: string): string;
+var
+ I: Integer;
+begin
+ I := Pos('|', Hint);
+ if I = 0 then
+ Result := Hint else
+ Result := Copy(Hint, 1, I - 1);
+end;
+
+procedure SetClipboard(const Value: String);
+{$IFDEF Delphi17}
+var
+ ClipService: IFMXClipboardService;
+begin
+ if TPlatformServices.Current.SupportsPlatformService(IFMXClipboardService, IInterface(ClipService)) then
+ ClipService.SetClipboard(Value);
+end;
+{$ELSE}
+begin
+ Platform.SetClipboard(Value);
+end;
+{$ENDIF}
+
+function GetClipboard: String;
+{$IFDEF Delphi17}
+var
+ ClipService: IFMXClipboardService;
+begin
+ if TPlatformServices.Current.SupportsPlatformService(IFMXClipboardService, IInterface(ClipService)) then
+ Result := ClipService.GetClipboard.ToString
+ else
+ Result := '';
+end;
+{$ELSE}
+begin
+ Result := VarToStr(Platform.GetClipboard);
+end;
+{$ENDIF}
+
+
+{$IFDEF MSWINDOWS}
+function EnumFontsProc(var LogFont: TLogFont; var TextMetric: TTextMetric;
+ FontType: DWORD; Data: LPARAM): Integer; stdcall;
+begin
+ if(Data <> 0) then
+ if (TStrings(Data).IndexOf(LogFont.lfFaceName) < 0) then
+ TStringList(Data).Add(LogFont.lfFaceName);
+ Result := 1;
+end;
+
+procedure FillFontsList(List: TStrings);
+var
+ dc: HDC;
+ sortedList: TStringList;
+ LFont: TLogFont;
+
+begin
+ sortedList := TStringList.Create;
+ dc := GetDC(0);
+ try
+ FillChar(LFont, sizeof(LFont), 0);
+ LFont.lfCharset := DEFAULT_CHARSET;
+ EnumFontFamiliesEx(dc, LFont, @EnumFontsProc, LPARAM(sortedList), 0);
+ finally
+ ReleaseDC(0, dc);
+ end;
+ sortedList.Sort;
+
+ List.BeginUpdate;
+ List.Clear;
+ List.AddStrings(sortedList);
+ List.EndUpdate;
+ sortedList.Free;
+end;
+ {$ENDIF}
+{$IFDEF LINUX}
+procedure FillFontsList(List: TStrings);
+var
+ sortedList: TStringList;
+ i, c: Integer;
+begin
+ sortedList := TStringList.Create;
+ sortedList.BeginUpdate;
+ try
+ sortedList.Clear;
+ c := FmuxGetFontCount;
+ for i := 0 to c - 1 do
+ sortedList.Add(FmuxGetFontName(i));
+ finally
+ sortedList.EndUpdate;
+ end;
+
+ sortedList.Sort;
+
+ List.BeginUpdate;
+ List.Clear;
+ List.AddStrings(sortedList);
+ List.EndUpdate;
+ sortedList.Free;
+end;
+{$ENDIF}
+{$IFDEF MACOS}
+var
+ kCTFontFamilyNameAttribute_: Pointer = nil;
+
+function kCTFontFamilyNameAttribute: Pointer;
+var
+ CTLib: HMODULE;
+begin
+ if kCTFontFamilyNameAttribute_ = nil then
+ begin
+ CTLib := LoadLibrary(libCoreText);
+ kCTFontFamilyNameAttribute_ := Pointer(GetProcAddress(CTLib, PWideChar('kCTFontFamilyNameAttribute'))^);
+ FreeLibrary(CTLib);
+ end;
+ Result := kCTFontFamilyNameAttribute_;
+end;
+
+function ConvCFString(const Value: CFStringRef): String;
+begin
+ if Assigned(Value) then
+ Result := string(TNSString.Wrap(Value).UTF8String)
+ else
+ Result := '';
+end;
+
+procedure FillFontsList(List: TStrings);
+var
+ collection: CTFontCollectionRef;
+ arr: CFArrayRef;
+ fontDescr: CTFontDescriptorRef;
+ fontName: String;
+ i, arrnum: Integer;
+ sortedList: TStringList;
+begin
+ sortedList := TStringList.Create;
+ sortedList.Sorted := True;
+ try
+ collection := CTFontCollectionCreateFromAvailableFonts(nil);
+ arr := CTFontCollectionCreateMatchingFontDescriptors(collection);
+ try
+ arrnum := CFArrayGetCount(arr);
+ for i := 0 to arrnum - 1 do
+ begin
+ fontDescr := CFArrayGetValueAtIndex(arr, i);
+ fontName := ConvCFString(CTFontDescriptorCopyAttribute(fontDescr, kCTFontFamilyNameAttribute));
+ if sortedList.IndexOf(fontName) = -1 then
+ sortedList.Add(fontName);
+ end;
+ finally
+ CFRelease(arr);
+ CFRelease(collection);
+ end;
+ except
+ sortedList.Add('Unable to retrieve fonts');
+ end;
+
+ List.BeginUpdate;
+ List.Clear;
+ List.AddStrings(sortedList);
+ List.EndUpdate;
+ sortedList.Free;
+end;
+{$ENDIF}
+
+{$IFDEF DELPHI19}
+type
+ TTextLayoutHack = class(TTextLayout);
+{$IFDEF MACOS}
+ TQuartzBitmap = class
+ private
+ FData: Pointer;
+ FContext: CGContextRef;
+ FImage: CGImageRef;
+ function GetImage: CGImageRef;
+ end;
+ TRGBFloat = packed record
+ r, g, b, a: single;
+ end;
+
+function CGColor(const C: TAlphaColor; Opacity: single = 1): TRGBFloat;
+var
+ cc: TAlphaColor;
+begin
+ cc := MakeColor(C, Opacity);
+ Result.a := TAlphaColorRec(cc).a / $FF;
+ Result.r := TAlphaColorRec(cc).r / $FF;
+ Result.g := TAlphaColorRec(cc).g / $FF;
+ Result.b := TAlphaColorRec(cc).b / $FF;
+end;
+
+
+const
+ ItalicMatrix: CGAffineTransform = (
+ a: 1;
+ b: 0;
+ c: 0.176326981;
+ d: 1;
+ tx: 0;
+ ty: 0
+ );
+
+function CreateFont(const AFont: TFont): CTFontRef;
+var
+ FontRefCopy: CTFontRef;
+ m: PCGAffineTransform;
+begin
+ m := nil;
+ Result := CTFontCreateWithName(CFSTR(AFont.Family), AFont.Size * 1, nil);
+ try
+ if TFontStyle.fsItalic in AFont.Style then
+ begin
+ FontRefCopy := CTFontCreateCopyWithSymbolicTraits(Result, 0, nil,
+ kCTFontItalicTrait, kCTFontItalicTrait);
+ if Assigned(FontRefCopy) then
+ begin
+ CFRelease(Result);
+ Result := FontRefCopy;
+ end
+ else
+ begin
+ m := @ItalicMatrix;
+
+ FontRefCopy := CTFontCreateWithName(CFSTR(AFont.Family), AFont.Size * 1, @ItalicMatrix);
+ if Assigned(FontRefCopy) then
+ begin
+ CFRelease(Result);
+ Result := FontRefCopy;
+ end;
+ end;
+ end;
+ if TFontStyle.fsBold in AFont.Style then
+ begin
+ FontRefCopy := CTFontCreateCopyWithSymbolicTraits(Result, 0, m,
+ kCTFontBoldTrait, kCTFontBoldTrait);
+ if Assigned(FontRefCopy) then
+ begin
+ CFRelease(Result);
+ Result := FontRefCopy;
+ end;
+ end;
+ except
+ CFRelease(Result);
+ end;
+end;
+{$ENDIF}
+{$ENDIF}
+
+function GetComponentForm(Comp: TFmxObject): TCommonCustomForm;
+begin
+ Result := nil;
+ while (Comp.Parent <> nil) do
+ begin
+ if (Comp.Parent is TCommonCustomForm) then
+ begin
+ Result := Comp.Parent as TCommonCustomForm;
+ Exit;
+ end;
+ Comp := Comp.Parent;
+ end;
+end;
+
+{ TfrxFont }
+
+constructor TfrxFont.Create;
+begin
+ FName := DefFontName;
+ FSize := DefFontSize;
+ FColor := claBlack;
+ FPixelsPerInch := frxDefPPI;
+end;
+
+procedure TfrxFont.Assign(Value: TfrxFont);
+begin
+ FName := Value.Name;
+ FSize := Value.Size;
+ FStyle := Value.Style;
+ FColor := Value.Color;
+ DoChange;
+end;
+
+procedure TfrxFont.AssignToFont(Value: TFont);
+{$IFDEF Delphi25}
+{$IFDEF MSWINDOWS}
+var
+ NewStyleExt: TFontStyleExt;
+{$ENDIF}
+{$ENDIF}
+begin
+ Value.Family := FName;
+ Value.Size := FSize;
+ Value.Style := FStyle;
+{$IFDEF Delphi25}
+{$IFDEF MSWINDOWS}
+ { D2D campatibility with GDI+ name }
+ if Pos('NARROW', UpperCase(Name)) <> 0 then
+ begin
+ NewStyleExt := TFontStyleExt.Create(Value.StyleExt.Weight, Value.StyleExt.Slant, Value.StyleExt.Stretch, Value.Style);
+ NewStyleExt.Stretch := TFontStretch.Condensed;
+ Value.StyleExt := NewStyleExt;
+ end;
+{$ENDIF}
+{$ENDIF}
+end;
+
+{$IFDEF MSWINDOWS}
+type
+ THackCanvas = class(TCanvas);
+{$ENDIF}
+
+procedure TfrxFont.AssignToCanvas(Canvas: TCanvas);
+var
+ ScaleF: Single;
+{$IFDEF MSWINDOWS}
+ IsD2D: Boolean;
+ aScaleX: Single;
+{$IFDEF Delphi25}
+ NewStyleExt: TFontStyleExt;
+{$ENDIF}
+{$ENDIF}
+begin
+ Canvas.Font.Family := Name;
+ ScaleF := FPixelsPerInch / 72;
+{ we need increase D2D font height a bit to make it look the same as in GDIp }
+{ cause of this code - canvas implimentation hidden inside modules }
+{$IFDEF MSWINDOWS}
+ IsD2D := (CompareText(Canvas.ClassName, 'TCanvasD2D') = 0);
+ if IsD2D then
+ ScaleF := ScaleF + 1 / 72 * 5;
+ aScaleX := frxDefaultPPI / 96;
+{$IFNDEF Delphi17}
+ if not IsD2D and Assigned(THackCanvas(Canvas).FBitmap) and (aScaleX > 1) then
+{$ELSE}
+ if not IsD2D and Assigned(Canvas.Bitmap) and (aScaleX > 1) then
+{$ENDIF}
+ ScaleF := ScaleF * aScaleX;
+{$ENDIF}
+ Canvas.Font.Size := Size * ScaleF;
+ Canvas.Font.Style := Style;
+ Canvas.Fill.Color := Color;
+{$IFDEF MSWINDOWS}
+{$IFDEF Delphi25}
+ { D2D campatibility with GDI+ name }
+ if IsD2D and (Pos('NARROW', UpperCase(Name)) <> 0) then
+ begin
+ NewStyleExt := TFontStyleExt.Create(Canvas.Font.StyleExt.Weight, Canvas.Font.StyleExt.Slant, Canvas.Font.StyleExt.Stretch, Canvas.Font.Style);
+ NewStyleExt.Stretch := TFontStretch.Condensed;
+ Canvas.Font.StyleExt := NewStyleExt;
+ end;
+{$ENDIF}
+{$ENDIF}
+end;
+
+procedure TfrxFont.DoChange;
+begin
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+end;
+
+function TfrxFont.GetHeight(Canvas: TCanvas): Single;
+begin
+// todo
+ Result := Size * FPixelsPerInch / 72;
+end;
+
+function TfrxFont.IsEqual(ToFont: TObject): Boolean;
+begin
+ Result := (ToFont is TFont) and SameValue(Size * FPixelsPerInch / 72, TFont(ToFont).Size, 1E-2) and (Name = TFont(ToFont).Family) and
+ (Style = TFont(ToFont).Style);
+end;
+
+procedure TfrxFont.SetName(const Value: string);
+begin
+ if FName <> Value then
+ begin
+ FName := Value;
+ DoChange;
+ end;
+end;
+
+procedure TfrxFont.SetSize(Value: Single);
+begin
+ if FSize <> Value then
+ begin
+ FSize := Value;
+ DoChange;
+ end;
+end;
+
+procedure TfrxFont.SetStyle(Value: TFontStyles);
+begin
+ if FStyle <> Value then
+ begin
+ FStyle := Value;
+ DoChange;
+ end;
+end;
+
+procedure TfrxFont.SetColor(Value: TAlphaColor);
+begin
+ if FColor <> Value then
+ begin
+ FColor := Value;
+ DoChange;
+ end;
+end;
+
+procedure TfrxFont.SetHeight(Value: Single);
+begin
+ Size := - Value * 72 / FPixelsPerInch;
+end;
+
+function TfrxFont.GetHeight: Single;
+begin
+ Result := - Size * FPixelsPerInch / 72;
+end;
+
+
+{ TfrxImageList }
+
+constructor TfrxImageList.Create(AOwner: TComponent);
+begin
+ inherited;
+ FImages := TList.Create;
+end;
+
+destructor TfrxImageList.Destroy;
+begin
+ FImages.Destroy;
+ inherited;
+end;
+
+
+procedure TfrxImageList.Clear;
+begin
+ FImages.Clear;
+end;
+
+{$IFDEF DELPHI19}
+ procedure TfrxImageList.AddMasked(Bmp: FMX.Graphics.TBitmap; Color: TAlphaColor);
+{$ELSE}
+ procedure TfrxImageList.AddMasked(Bmp: FMX.Types.TBitmap; Color: TAlphaColor);
+{$ENDIF}
+begin
+ FImages.Add(Bmp);
+end;
+
+procedure TfrxImageList.Draw(Canvas: TCanvas; x, y: Single; Index: Integer);
+begin
+end;
+
+function TfrxImageList.GetCount: Integer;
+begin
+ Result := FImages.Count;
+end;
+
+{$IFDEF DELPHI19}
+function TfrxImageList.Get(Index: Integer): FMX.Graphics.TBitmap;
+begin
+ Result := FMX.Graphics.TBitmap(FImages[Index]);
+end;
+{$ELSE}
+function TfrxImageList.Get(Index: Integer): FMX.Types.TBitmap;
+begin
+ Result := FMX.Types.TBitmap(FImages[Index]);
+end;
+{$ENDIF}
+
+{ TfrxToolButton }
+
+constructor TfrxToolButton.Create(AOwner: TComponent);
+begin
+{$IFDEF DELPHI19}
+ FBitmap := FMX.Graphics.TBitmap.Create(0,0);
+{$ELSE}
+ FBitmap := FMX.Types.TBitmap.Create(0,0);
+{$ENDIF}
+ inherited;
+end;
+
+destructor TfrxToolButton.Destroy;
+begin
+ FBitmap.Free;
+ inherited;
+end;
+
+procedure TfrxToolButton.DoMouseEnter;
+begin
+ inherited;
+ Repaint;
+end;
+
+procedure TfrxToolButton.DoMouseLeave;
+begin
+ inherited;
+ Repaint;
+end;
+
+procedure TfrxToolButton.DoPaint;
+var
+ rect: TRectF;
+ bmpRect: TRectF;
+ oldM: TMatrix;
+ state: TCanvasSaveState;
+begin
+ OldM := Canvas.Matrix;
+ State := Canvas.SaveState;
+
+ try
+ Canvas.SetMatrix(CreateTranslateMatrix(AbsoluteRect.Left, AbsoluteRect.Top));
+ rect := RectF(0.5, 0.5, Width - 0.5, Height - 0.5);
+
+ bmpRect.Top := Round((Self.Height - FBitmap.Height)/ 2);
+ bmpRect.Left := Round((Self.Width - FBitmap.Width) / 2);
+ bmpRect.Bottom := bmpRect.Top + FBitmap.Height;
+ bmpRect.Right := bmpRect.Left + FBitmap.Width;
+
+ if csDesigning in ComponentState then
+ begin
+ Canvas.Stroke.Color := claBlack;
+ Canvas.Stroke.Kind := TBrushKind.bkSolid;
+{$IFDEF Delphi25}
+ Canvas.Stroke.Thickness := 2;
+{$ELSE}
+ Canvas.StrokeThickness := 2;
+{$ENDIF}
+ Canvas.DrawRect(RectF(0, 0, Width, Height), 1, 1, AllCorners, 1, TCornerType.ctBevel);
+ end;
+
+ if Enabled then
+ Canvas.DrawBitmap(FBitmap, RectF(0, 0, FBitmap.Width, FBitmap.Height), bmpRect, 1 )
+ else
+ Canvas.DrawBitmap(FBitmap, RectF(0, 0, FBitmap.Width, FBitmap.Height), bmpRect, 0.2 );
+
+ if IsMouseOver or IsPressed then
+ begin
+ Canvas.Stroke.Color := claBlack;
+ Canvas.Stroke.Kind := TBrushKind.bkSolid;
+{$IFDEF Delphi25}
+ Canvas.Stroke.Thickness := 1;
+{$ELSE}
+ Canvas.StrokeThickness := 1;
+{$ENDIF}
+ Canvas.Fill.Color := claBlack;
+ Canvas.Fill.Kind := TBrushKind.bkSolid;
+ Canvas.FillRect(rect, 1, 1, AllCorners, 0.1, TCornerType.ctInnerRound);
+ Canvas.DrawRect(rect, 1, 1, AllCorners, 0.3, TCornerType.ctInnerRound);
+ end;
+{$IFNDEF DELPHI18}
+ if Text <> '' then
+ Canvas.FillText(RectF(0, 0, Width, Height), Text, False, 1, [], TTextAlign.taCenter);
+{$ENDIF}
+ finally
+ Canvas.RestoreState(state);
+ Canvas.SetMatrix(OldM);
+ end;
+end;
+
+procedure TfrxToolSeparator.Paint;
+begin
+ with Canvas do
+ begin
+ Stroke.Color := claGray;
+ Stroke.Kind := TBrushKind.bkSolid;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+
+ if Self.Width > Self.Height then
+ begin
+ DrawLine(PointF(0, 0.5), PointF(Self.Width, 0.5), 1);
+ Stroke.Color := claWhite;
+ DrawLine(PointF(0, 1.5), PointF(Self.Width, 1.5), 1);
+ end
+ else
+ begin
+ DrawLine(PointF(0.5, 0), PointF(0.5, Self.Height), 1);
+ Stroke.Color := claWhite;
+ DrawLine(PointF(1.5, 0), PointF(1.5, Self.Height), 1);
+ end;
+ end;
+end;
+
+procedure TfrxToolGrip.Paint;
+var
+ i: Integer;
+begin
+ with Canvas do
+ begin
+ Fill.Kind := TBrushKind.bkSolid;
+
+ for i := 0 to 3 do
+ if Self.Width > Self.Height then
+ begin
+ Fill.Color := claGray;
+ FillRect(RectF(i * 4, 0, i * 4 + 2, 2), 0, 0, allCorners, 1);
+ end
+ else
+ begin
+ Fill.Color := claGray;
+ FillRect(RectF(0, i * 4, 2, i * 4 + 2), 0, 0, allCorners, 1);
+ end;
+ end;
+end;
+
+{ TfrxTreeViewItem }
+
+procedure TfrxTreeViewItem.ApplyStyle;
+var
+ B: TFmxObject;
+ Offset: Single;
+begin
+ inherited;
+ B := FindStyleResource('button');
+ if (B <> nil) and (B is TCustomButton) then
+ begin
+ FButton := TCustomButton(B);
+ B := FindStyleResource('text');
+ Offset := 0;
+ if Self.TreeView is TfrxTreeView then
+ Offset := TfrxTreeView(Self.TreeView).IconWidth;
+
+ if (B <> nil) and (B is TText) then
+{$IFDEF DELPHI18}
+ TText(B).Margins.Left := Offset;
+{$ELSE}
+ TText(B).Padding.Left := Offset;
+{$ENDIF}
+ FImgPos := FButton.Position.X + FButton.Width - 2;
+ end;
+end;
+
+
+constructor TfrxTreeViewItem.Create(AOwner: TComponent);
+begin
+ inherited;
+ FImgPos := 0;
+ FCloseImageIndex := -1;
+ FOpenImageIndex := -1;
+end;
+
+{$IFDEF DELPHI19}
+function TfrxTreeViewItem.GetBitmap: FMX.Graphics.TBitmap;
+{$ELSE}
+function TfrxTreeViewItem.GetBitmap: FMX.Types.TBitmap;
+{$ENDIF}
+begin
+ Result := nil;
+ if TreeView is TfrxTreeView then
+ begin
+ Result := TfrxTreeView(TreeView).FPicBitmap;
+ end;
+end;
+
+procedure TfrxTreeViewItem.Paint;
+var
+{$IFDEF DELPHI19}
+ Bmp: FMX.Graphics.TBitmap;
+{$ELSE}
+ Bmp: FMX.Types.TBitmap;
+{$ENDIF}
+ IconRect: TRectF;
+ Index: Integer;
+begin
+ inherited Paint;
+ if IsExpanded then
+ Index := FOpenImageIndex
+ else
+ Index := FCloseImageIndex;
+
+ if Index = -1 then Exit;
+
+
+ Bmp := GetBitmap;
+ if TreeView is TfrxTreeView then
+ begin
+ IconRect := TfrxTreeView(TreeView).GetBitmapRect(Index);
+ end;
+ if (Bmp <> nil) and (FImgPos > 0)then
+ Canvas.DrawBitmap(Bmp, IconRect, RectF(16, 0, 32, 16), 1 );
+end;
+
+{ TfrxTreeView }
+
+function TfrxTreeView.AddItem(Root: TFmxObject; Text: String): TfrxTreeViewItem;
+begin
+ Result := TfrxTreeViewItem.Create(Root);
+ Result.Text := Text;
+ Root.AddObject(Result);
+end;
+
+constructor TfrxTreeView.Create(AOwner: TComponent);
+begin
+ inherited;
+ FPicBitmap := nil;
+ FIconWidth := 16;
+ FIconHeight := 16;
+ FEditBox := TEdit.Create(Self);
+ FEditBox.Parent := Self;
+ FEditBox.Visible := False;
+ FEditBox.OnKeyDown := DoEditKeyDown;
+ FEditBox.OnEnter := DoExitEdit;
+ FIsEditing := False;
+ FEditable := False;
+ FFreePicOnDelete := False;
+ FManualDragAndDrop := False;
+end;
+
+procedure TfrxTreeView.DblClick;
+begin
+ inherited;
+ DoEdit;
+end;
+
+destructor TfrxTreeView.Destroy;
+begin
+ if (FPicBitmap <> nil) and FFreePicOnDelete then
+ FPicBitmap.Free;
+
+ inherited;
+end;
+
+procedure TfrxTreeView.DoEdit;
+var
+ r: TRectF;
+begin
+ if (Selected = nil) or (not FEditable) then exit;
+
+ FEditBox.Text := Selected.Text;
+ r := Self.GetItemRect(Selected);
+ //p := Selected.LocalToAbsolute(PointF(Selected.Position.X, Selected.Position.Y));
+ FEditBox.SetBounds(r.Left, r.Top, r.Width, r.Height);
+ Selected.Visible := False;
+ FEditBox.Visible := True;
+ FEditBox.SetFocus;
+ FIsEditing := True;
+end;
+
+procedure TfrxTreeView.DoEditKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = vkReturn then
+ EndEdit(True)
+ else if Key = vkEscape then
+ EndEdit(False);
+end;
+
+procedure TfrxTreeView.DoExit;
+begin
+ inherited;
+ EndEdit(False);
+end;
+
+procedure TfrxTreeView.DoExitEdit(Sender: TObject);
+begin
+ EndEdit(False);
+end;
+
+procedure TfrxTreeView.BeginAutoDrag;
+var
+{$IFDEF DELPHI19}
+ S: FMX.Graphics.TBitmap;
+{$ELSE}
+ S: FMX.Types.TBitmap;
+{$ENDIF}
+
+begin
+ if (Selected = nil) or (Root = nil) then
+ Exit;
+ S := Selected.MakeScreenshot;
+ try
+{$IFNDEF DELPHI20}
+ FRoot.BeginInternalDrag(Self, S);
+{$ELSE}
+ Root.BeginInternalDrag(Self, S);
+{$ENDIF}
+ finally
+ S.Free;
+ end;
+end;
+
+procedure TfrxTreeView.DragDrop(const Data: TDragObject; const Point: TPointF);
+begin
+ //inherited;
+ // don't use TTreeView handlers
+end;
+
+procedure TfrxTreeView.DragOver(const Data: TDragObject; const Point: TPointF;
+ {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+begin
+ //inherited;
+ //don't use TTreeView handlers
+end;
+
+procedure TfrxTreeView.EndEdit(Accept: Boolean);
+var
+ S: String;
+begin
+ if (Selected = nil) or (FEditBox.Text = '') or not FIsEditing then exit;
+ FEditBox.Parent := Self;
+ if Accept then
+ begin
+ Selected.Text := FEditBox.Text;
+ S := Selected.Text;
+ if Assigned(FOnEdited) then
+ begin
+ FOnEdited(Self, TfrxTreeViewItem(Selected), S);
+ Selected.Text := S;
+ end;
+ end;
+ FEditBox.Visible := False;
+ Selected.Visible := True;
+ Self.SetFocus;
+ FIsEditing := False;
+end;
+
+function TfrxTreeView.GetBitmapRect(Index: Integer): TRectF;
+var
+ ColCount, ColId, RowId: Integer;
+begin
+ Result := RectF(0, 0, 0, 0);
+ if FPicBitmap = nil then Exit;
+
+ ColCount := FPicBitmap.Width div FIconWidth;
+ RowId := Index div ColCount;
+ ColId := Index mod ColCount;
+ Result := RectF(FIconWidth * ColId, FIconHeight * RowId, FIconWidth * ColId + FIconWidth, FIconHeight * RowId + FIconHeight);
+end;
+
+procedure TfrxTreeView.KeyDown(var Key: Word; var KeyChar: WideChar;
+ Shift: TShiftState);
+begin
+ inherited;
+ if Key = vkReturn then
+ DoEdit;
+end;
+
+procedure TfrxTreeView.LoadResouces(Stream: TStream; IconWidth,
+ IconHeight: Integer);
+begin
+ FIconWidth := IconWidth;
+ FIconHeight := IconHeight;
+ FFreePicOnDelete := True;
+ if FPicBitmap = nil then
+{$IFDEF DELPHI19}
+ FPicBitmap := FMX.Graphics.TBitmap.CreateFromStream(Stream)
+{$ELSE}
+ FPicBitmap := FMX.Types.TBitmap.CreateFromStream(Stream)
+{$ENDIF}
+ else
+ FPicBitmap.LoadFromStream(Stream);
+end;
+
+
+
+procedure TfrxTreeView.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
+ Y: Single);
+begin
+ EndEdit(True);
+ inherited;
+{$IFDEF DELPHI18}
+ if (DragMode = TDragMode.dmManual) and FManualDragAndDrop then
+ BeginAutoDrag;
+{$ENDIF}
+end;
+
+{$IFDEF DELPHI19}
+procedure TfrxTreeView.SetImages(Bmp: FMX.Graphics.TBitmap);
+{$ELSE}
+procedure TfrxTreeView.SetImages(Bmp: FMX.Types.TBitmap);
+{$ENDIF}
+begin
+ if (FPicBitmap <> nil) and FFreePicOnDelete then
+ FPicBitmap.Free;
+ FFreePicOnDelete := False;
+ FPicBitmap := Bmp;
+end;
+
+procedure TfrxTreeView.SetSelected(const Value: TTreeViewItem);
+begin
+ if Assigned(FOnBeforeChange) then
+ FOnBeforeChange(Self, TfrxTreeViewItem(Selected), TfrxTreeViewItem(Value));
+ EndEdit(True);
+ inherited;
+end;
+
+{$IFDEF DELPHI19}
+procedure TfrxToolButton.SetBitmap(const Value: FMX.Graphics.TBitmap);
+{$ELSE}
+procedure TfrxToolButton.SetBitmap(const Value: FMX.Types.TBitmap);
+{$ENDIF}
+begin
+ FBitmap.Assign(Value);
+end;
+
+
+{ TfrxListBox }
+
+procedure TfrxListBox.Assign(Source: TPersistent);
+var
+ i: Integer;
+ Item: TListBoxItem;
+begin
+ if Source is TStrings then
+ begin
+ BeginUpdate;
+ try
+ Clear;
+ for i := 0 to TStrings(Source).Count - 1 do
+ begin
+ Item := TfrxListBoxItem.Create(Owner);
+ if i <> TStrings(Source).Count - 1 then
+ TfrxListBoxItem(Item).CheckVisible := True;
+ Item.Parent := Self;
+ Item.Text := TStrings(Source)[i];
+ end;
+ finally
+ EndUpdate;
+ end;
+ end
+ else
+ inherited;
+end;
+
+procedure TfrxListBox.BeginAutoDrag;
+var
+{$IFDEF DELPHI19}
+ S: FMX.Graphics.TBitmap;
+{$ELSE}
+ S: FMX.Types.TBitmap;
+{$ENDIF}
+
+begin
+ if (Selected = nil) or (Root = nil) then
+ Exit;
+ S := Selected.MakeScreenshot;
+ try
+{$IFNDEF DELPHI20}
+ FRoot.BeginInternalDrag(Self, S);
+{$ELSE}
+ Root.BeginInternalDrag(Self, S);
+{$ENDIF}
+ finally
+ S.Free;
+ end;
+end;
+
+constructor TfrxListBox.Create(AOwner: TComponent);
+begin
+ inherited;
+ FManualDragAndDrop := False;
+ FShowButtons := False;
+ FItems := TfrxListBoxStrings.Create;
+ TfrxListBoxStrings(FItems).FListBox := Self;
+end;
+
+destructor TfrxListBox.Destroy;
+begin
+ inherited;
+ FreeAndNil(FItems);
+end;
+
+procedure TfrxListBox.DoButtonClick(aButton: TObject; aItem: TfrxListBoxItem);
+begin
+ if Assigned(OnButtonClick) then
+ OnButtonClick(Self, aButton, aItem);
+end;
+
+procedure TfrxListBox.DragDrop(const Data: TDragObject; const Point: TPointF);
+begin
+ inherited;
+end;
+
+procedure TfrxListBox.DragEnd;
+begin
+ inherited;
+ DragLeave;
+end;
+
+procedure TfrxListBox.DragOver(const Data: TDragObject; const Point: TPointF;
+ {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+begin
+ if Assigned(OnDragOver) then
+ OnDragOver(Self, Data, Point, {$IFNDEF DELPHI20}Accept{$ELSE}Operation{$ENDIF});
+ //don't use TListBox handlers
+end;
+
+function TfrxListBox.ItemsStored: Boolean;
+var
+ I: Integer;
+begin
+ for I := 0 to Count - 1 do
+ if ListItems[I].Stored then
+ Exit(False);
+ Result := True;
+end;
+
+procedure TfrxListBox.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
+ Y: Single);
+begin
+ inherited;
+{$IFDEF DELPHI18}
+ if (DragMode = TDragMode.dmManual) and FManualDragAndDrop then
+ BeginAutoDrag;
+{$ENDIF}
+end;
+
+procedure TfrxListBox.SetItems(const Value: TStrings);
+begin
+ Items.Assign(Value);
+end;
+
+{ TfrxListBox.TfrxListBoxStrings }
+
+function TfrxListBox.TfrxListBoxStrings.Add(const S: string): Integer;
+var
+ Item: TListBoxItem;
+begin
+ Item := TfrxListBoxItem.Create(FListBox);
+ try
+ Item.Text := S;
+ Item.Stored := False;
+ FListBox.AddObject(Item);
+{$IFDEF DELPHI19}
+{$IFDEF LINUX}
+
+{$ELSE}
+ Item.StyleLookup := FListBox.DefaultItemStyles.ItemStyle;
+ THackCustomListBox(FListBox).DispatchStringsChangeEvent(S, TCustomListBox.TStringsChangeOp.tsoAdded);
+{$ENDIF}
+{$ENDIF}
+ Result := Item.Index;
+ except
+ Item.Free;
+ raise;
+ end;
+end;
+
+procedure TfrxListBox.TfrxListBoxStrings.Clear;
+begin
+ if not (csDestroying in FListBox.ComponentState) then
+ FListBox.Clear;
+end;
+
+procedure TfrxListBox.TfrxListBoxStrings.DefineProperties(Filer: TFiler);
+ function DoWrite: Boolean;
+ begin
+ if Filer.Ancestor <> nil then
+ begin
+ Result := True;
+ if Filer.Ancestor is TStrings then
+ Result := not Equals(TStrings(Filer.Ancestor))
+ end
+ else
+ Result := Count > 0;
+ end;
+begin
+ Filer.DefineProperty('Strings', ReadData, WriteData, DoWrite);
+end;
+
+procedure TfrxListBox.TfrxListBoxStrings.Delete(Index: Integer);
+var
+ Item: TListBoxItem;
+begin
+ Item := FListBox.ListItems[Index];
+ if Assigned(Item) then
+ begin
+{$IFDEF DELPHI19}
+ if Item = FListBox.ItemDown then
+ FListBox.ItemDown := nil;
+{$ENDIF}
+ FListBox.RemoveObject(Item);
+ Item.Free;
+ end;
+end;
+
+procedure TfrxListBox.TfrxListBoxStrings.Exchange(Index1, Index2: Integer);
+begin
+ FListBox.Exchange(FListBox.ItemByIndex(Index1), FListBox.ItemByIndex(Index2));
+
+end;
+
+function TfrxListBox.TfrxListBoxStrings.Get(Index: Integer): string;
+begin
+ Result := FListBox.ListItems[Index].Text;
+end;
+
+function TfrxListBox.TfrxListBoxStrings.GetCount: Integer;
+begin
+ Result := FListBox.Count;
+end;
+
+function TfrxListBox.TfrxListBoxStrings.GetObject(Index: Integer): TObject;
+begin
+ Result := FListBox.ListItems[Index].Data;
+end;
+
+function TfrxListBox.TfrxListBoxStrings.IndexOf(const S: string): Integer;
+var
+ I: Integer;
+begin
+ for I := 0 to FListBox.Count - 1 do
+ if SameText(FListBox.ListItems[I].Text, S) then
+ Exit(I);
+ Result := -1;
+
+end;
+
+procedure TfrxListBox.TfrxListBoxStrings.Insert(Index: Integer;
+ const S: string);
+var
+ Item: TListBoxItem;
+begin
+ Item := TfrxListBoxItem.Create(FListBox);
+ try
+ if Index <> Count - 1 then
+ TfrxListBoxItem(Item).CheckVisible := True;
+ Item.Text := S;
+ Item.Stored := False;
+ FListBox.InsertObject(Index, Item);
+ except
+ Item.Free;
+ raise;
+ end;
+
+end;
+
+procedure TfrxListBox.TfrxListBoxStrings.Put(Index: Integer; const S: string);
+begin
+ FListBox.ListItems[Index].Text := S;
+
+end;
+
+procedure TfrxListBox.TfrxListBoxStrings.PutObject(Index: Integer;
+ AObject: TObject);
+begin
+ FListBox.ListItems[Index].Data := AObject;
+
+end;
+
+procedure TfrxListBox.TfrxListBoxStrings.ReadData(Reader: TReader);
+begin
+ Reader.ReadListBegin;
+ BeginUpdate;
+ try
+ if TfrxListBox(FListBox).ItemsStored then
+ begin
+ Clear;
+ while not Reader.EndOfList do
+ Add(Reader.ReadString);
+ end
+ else
+ begin
+ while not Reader.EndOfList do
+ Reader.ReadString;
+ end;
+ finally
+ EndUpdate;
+ end;
+ Reader.ReadListEnd;
+end;
+
+procedure TfrxListBox.TfrxListBoxStrings.SetUpdateState(Updating: Boolean);
+begin
+ if Updating then
+ FListBox.BeginUpdate
+ else
+ FListBox.EndUpdate;
+end;
+
+procedure TfrxListBox.TfrxListBoxStrings.WriteData(Writer: TWriter);
+var
+ I: Integer;
+begin
+ Writer.WriteListBegin;
+ for I := 0 to Count - 1 do
+ Writer.WriteString(Get(I));
+ Writer.WriteListEnd;
+end;
+
+{ TfrxListBoxItem }
+
+procedure TfrxListBoxItem.ApplyStyle;
+var
+ B: TFmxObject;
+begin
+ inherited;
+ B := FindStyleResource('check');
+ if Assigned(B) and (B is TCheckBox) then
+ begin
+ FCheck := TCheckBox(B);
+ FCheck.Align := TAlignLayout.alRight;
+ if ListBox is TfrxListBox then
+ begin
+ if TfrxListBox(ListBox).ShowButtons then
+ begin
+ FButton.Parent := FCheck.Parent;
+ FButton.Visible := True;
+ FButton.Align := TAlignLayout.alMostRight;
+ FButton.Position.X := Width;
+ FButton.Width := 40;
+ FButton.Height := FCheck.Height;
+ FButton.Text := TfrxListBox(ListBox).ButtonText;
+ FButton.OnClick := OnBtnClick;
+ end;
+ FCheck.Text := TfrxListBox(ListBox).CheckBoxText;
+ end;
+
+ FCheck.Width := 90;
+ FCheck.Visible := FCheckVisible;
+ end;
+end;
+
+constructor TfrxListBoxItem.Create(AOwner: TComponent);
+begin
+ inherited;
+ FButton := TButton.Create(Self);
+ FCheck := nil;
+ FCheckVisible := False;
+end;
+
+destructor TfrxListBoxItem.Destroy;
+begin
+ inherited;
+end;
+
+procedure TfrxListBoxItem.FreeStyle;
+begin
+ inherited;
+ FCheck := nil;
+end;
+
+function TfrxListBoxItem.GetCheckVisible: Boolean;
+begin
+ Result := FCheckVisible;
+ if FCheck <> nil then
+ begin
+ Result := FCheck.Visible;
+ end;
+end;
+
+procedure TfrxListBoxItem.OnBtnClick(Sender: TObject);
+begin
+ if ListBox is TfrxListBox then
+ begin
+ TfrxListBox(ListBox).DoButtonClick(Sender, Self);
+ end;
+end;
+
+procedure TfrxListBoxItem.SetCheckVisible(const Value: Boolean);
+begin
+ if FCheck <> nil then
+ begin
+ FCheck.Visible := Value;
+ end;
+ FCheckVisible := Value;
+end;
+
+{ TfrxStringList }
+
+function TfrxStringList.CompareStrings(const S1, S2: string): Integer;
+begin
+ if FUseUnicode then
+ begin
+ if CaseSensitive then
+ Result := frxCompareStr(S1, S2)
+ else
+ Result := frxCompareText(S1, S2);
+ end
+ else
+ begin
+ if CaseSensitive then
+ Result := CompareStr(S1, S2)
+ else
+ Result := CompareText(S1, S2);
+ end;
+end;
+
+constructor TfrxStringList.Create(UseUnicode: Boolean);
+begin
+ Create;
+ FUseUnicode := UseUnicode;
+end;
+
+constructor TfrxStringList.Create;
+begin
+ Inherited Create;
+ FUseUnicode := False;
+end;
+{$IFDEF DELPHI19}
+{$IFDEF MACOS}
+function TQuartzBitmap.GetImage: CGImageRef;
+begin
+ if FImage = nil then
+ FImage := CGBitmapContextCreateImage(FContext);
+ Result := FImage;
+end;
+{$ENDIF}
+
+{ TfrxFastCanvas }
+{$IFDEF MACoS}
+function TfrxFastCanvas.AddCTFontToList(const aNameFont: String;
+ aFontRef: CTFontRef): Integer;
+begin
+ Result := FFontCacheList.AddObject(aNameFont, TObject(aFontRef))
+end;
+
+procedure TfrxFastCanvas.AddFontAttribute(
+ AAttribute: CFMutableAttributedStringRef; AFont: TFont; const AStart,
+ ALength: Integer);
+var
+ LFontRef: CTFontRef;
+ Underline: CFNumberRef;
+ LValue: Cardinal;
+begin
+ // Font
+ LFontRef := GetCTFont(AFont);
+ if Assigned(LFontRef) then
+
+ CFAttributedStringSetAttribute(AAttribute, CFRangeMake(AStart, ALength),
+ kCTFontAttributeName, LFontRef);
+ // Underline
+ if TFontStyle.fsUnderline in AFont.Style then
+ begin
+ LValue := kCTUnderlineStyleSingle;
+ Underline := CFNumberCreate(nil, kCFNumberSInt32Type, @LValue);
+ CFAttributedStringSetAttribute(AAttribute, CFRangeMake(AStart, ALength),
+ kCTUnderlineStyleAttributeName, Underline);
+ end;
+end;
+
+function TfrxFastCanvas.CalcHeight(Frame: CTFrameRef): Single;
+var
+ fRect: CGRect;
+ Lines: CFArrayRef;
+ Index: CFIndex;
+ Desc: CGFloat;
+ Line: CTLineRef;
+ LineOrigin: CGPoint;
+begin
+ FTextHeight := 0;
+ if Assigned(Frame) then
+ begin
+ fRect := CGPathGetBoundingBox(FPath);
+ Lines := CTFrameGetLines(Frame);
+ Index := CFArrayGetCount(Lines) - 1;
+ Line := CTLineRef(CFArrayGetValueAtIndex(Lines, Index));
+ CTLineGetTypographicBounds(Line, nil, @Desc, nil);
+ CTFrameGetLineOrigins(Frame, CFRangeMake(Index, 1), @LineOrigin);
+ FTextHeight := CGRectGetMaxY(fRect) - LineOrigin.y + Desc;
+ end;
+ Result := FTextHeight;
+end;
+
+function TfrxFastCanvas.CalcWidth(Frame: CTFrameRef): Single;
+var
+ LFrameRect: CGRect;
+ Lines: CFArrayRef;
+ NumLines: CFIndex;
+ Index: CFIndex;
+ aWidth: CGFloat;
+ Line: CTLineRef;
+begin
+ Result := 0;
+ if Assigned(Frame) then
+ begin
+ LFrameRect := CGPathGetBoundingBox(FPath);
+ Lines := CTFrameGetLines(Frame);
+ NumLines := CFArrayGetCount(Lines);
+ FTextWidth := 0;
+ if NumLines > 0 then
+ for Index := 0 to NumLines - 1 do
+ begin
+ Line := CTLineRef(CFArrayGetValueAtIndex(Lines, Index));
+ aWidth := CTLineGetTypographicBounds(Line, nil, nil, nil);
+ FTextWidth := Max(aWidth, FTextWidth);
+ end;
+ Result := FTextWidth;
+ end;
+end;
+
+procedure TfrxFastCanvas.ClearFontCache;
+var
+ i: Integer;
+begin
+ for i := 0 to FFontCacheList.Count - 1 do
+ CFRelease(CTFontRef(FFontCacheList.Objects[i]));
+ FFontCacheList.Clear;
+end;
+
+constructor TfrxFastCanvas.Create;
+begin
+ // use same matrix as in FMX, because we need same output
+ FFontTransformMatrix.a := 1;
+ FFontTransformMatrix.b := 0;
+ FFontTransformMatrix.c := Tan(10);
+ FFontTransformMatrix.d := 1;
+ FFontTransformMatrix.tx := 0;
+ FFontTransformMatrix.ty := 0;
+ FOpacity := 1;
+ FCurentFont := nil;
+ FFontCacheList := TfrxStringList.Create;
+ FColorSpace := CGColorSpaceCreateDeviceRGB;
+ FCanvas := nil;
+end;
+
+function TfrxFastCanvas.CreateCTFont(const AFont: TFont): CTFontRef;
+var
+ FontRefCopy: CTFontRef;
+ m: PCGAffineTransform;
+begin
+ Result := CTFontCreateWithName(CFSTR(AFont.Family), AFont.Size * 1, nil);
+ m := nil;
+ try
+ if TFontStyle.fsItalic in AFont.Style then
+ begin
+ FontRefCopy := CTFontCreateCopyWithSymbolicTraits(Result, 0, nil,
+ kCTFontItalicTrait, kCTFontItalicTrait);
+ if Assigned(FontRefCopy) then
+ begin
+ CFRelease(Result);
+ Result := FontRefCopy;
+ end
+ else
+ begin
+ m := @FFontTransformMatrix;
+ FontRefCopy := CTFontCreateWithName(CFSTR(AFont.Family), AFont.Size * 1, @FFontTransformMatrix);
+ if Assigned(FontRefCopy) then
+ begin
+ CFRelease(Result);
+ Result := FontRefCopy;
+ end;
+ end;
+ end;
+ if TFontStyle.fsBold in AFont.Style then
+ begin
+ FontRefCopy := CTFontCreateCopyWithSymbolicTraits(Result, 0, m,
+ kCTFontBoldTrait, kCTFontBoldTrait);
+ if Assigned(FontRefCopy) then
+ begin
+ CFRelease(Result);
+ Result := FontRefCopy;
+ end;
+ end;
+ except
+ CFRelease(Result);
+ end;
+end;
+
+procedure TfrxFastCanvas.CreateFrame(Canvas: TCanvas; StringRef: CFStringRef;
+ var AttributedS: CFMutableAttributedStringRef; var Frame: CTFrameRef);
+var
+ Value: Cardinal;
+ Ligature: CFNumberRef;
+ FrameSetter: CTFramesetterRef;
+ AlphaRec: TAlphaColorRec;
+ rgba: array [0 .. 3] of CGFloat;
+ TextColor: CGColorRef;
+ Alignment: Byte;
+ Direction: Byte;
+ Wrapping: Byte;
+ ParaSettings: array [0 .. 2] of CTParagraphStyleSetting;
+ ParagraphStyle: CTParagraphStyleRef;
+begin
+ AttributedS := CFAttributedStringCreateMutable(kCFAllocatorDefault, 0);
+ CFAttributedStringReplaceString(AttributedS, CFRangeMake(0, 0), StringRef);
+ CFAttributedStringBeginEditing(AttributedS);
+
+ AlphaRec := TAlphaColorRec(MakeColor(Canvas.Fill.Color, FOpacity));
+ rgba[0] := AlphaRec.r / $FF;
+ rgba[1] := AlphaRec.g / $FF;
+ rgba[2] := AlphaRec.b / $FF;
+ rgba[3] := AlphaRec.a / $FF;
+
+ TextColor := CGColorCreate(FColorSpace, @rgba[0]);
+ CFAttributedStringSetAttribute(AttributedS, CFRangeMake(0, FText.Length),
+ kCTForegroundColorAttributeName, TextColor);
+ CFRelease(TextColor);
+
+ Value := 0;
+ Ligature := CFNumberCreate(nil, kCFNumberSInt32Type, @Value);
+ CFAttributedStringSetAttribute(AttributedS, CFRangeMake(0, FText.Length), kCTLigatureAttributeName, Ligature);
+ AddFontAttribute(AttributedS, Canvas.Font, 0, FText.Length);
+
+ case FTextAlign of
+ TTextAlign.taCenter:
+ Alignment := kCTCenterTextAlignment;
+ TTextAlign.taLeading:
+ Alignment := kCTLeftTextAlignment;
+ TTextAlign.taTrailing:
+ Alignment := kCTRightTextAlignment;
+ end;
+ ParaSettings[0].spec := kCTParagraphStyleSpecifierAlignment;
+ ParaSettings[0].valueSize := sizeof(Alignment);
+ ParaSettings[0].Value := @Alignment;
+
+ if FWordWrap then
+ Wrapping := kCTLineBreakByWordWrapping
+ else
+ Wrapping := kCTLineBreakByClipping;
+
+ ParaSettings[1].spec := kCTParagraphStyleSpecifierLineBreakMode;
+ ParaSettings[1].valueSize := SizeOf(Wrapping);
+ ParaSettings[1].value := @Wrapping;
+
+ if TFillTextFlag.ftRightToLeft in FFlags then
+ Direction := kCTWritingDirectionRightToLeft
+ else
+ Direction := kCTWritingDirectionLeftToRight;
+ ParaSettings[2].spec := kCTParagraphStyleSpecifierBaseWritingDirection;
+ ParaSettings[2].valueSize := SizeOf(Direction);
+ ParaSettings[2].value := @Direction;
+ ParagraphStyle := CTParagraphStyleCreate(@ParaSettings[0], 3);
+
+ CFAttributedStringSetAttribute(AttributedS, CFRangeMake(0, CFStringGetLength(StringRef)), kCTParagraphStyleAttributeName, ParagraphStyle);
+ CFRelease(ParagraphStyle);
+ CFAttributedStringEndEditing(AttributedS);
+ FrameSetter := CTFramesetterCreateWithAttributedString(CFAttributedStringRef(AttributedS));
+ Frame := CTFramesetterCreateFrame(FrameSetter, CFRangeMake(0, 0), FPath, nil);
+end;
+
+destructor TfrxFastCanvas.Destroy;
+begin
+ ClearFontCache;
+ FreeAndNil(FFontCacheList);
+ inherited;
+end;
+type TProc = procedure of object;
+
+procedure TfrxFastCanvas.FillText(
+ const ARect: TRectF; const AText: string; const WordWrap: Boolean;
+ const AOpacity: Single; const Flags: TFillTextFlags; const ATextAlign,
+ AVTextAlign: TTextAlign);
+var
+ cref: CGContextRef;
+ LStringRef: CFStringRef;
+ FCTFrame: CTFrameRef;
+ Bounds: CGRect;
+ Attr: CFMutableAttributedStringRef;
+begin
+ if AText.Length = 0 then Exit;
+ FText := AText;
+ FTextAlign := ATextAlign;
+ FWordWrap := WordWrap;
+ FFlags := Flags;
+ FOpacity := AOpacity;
+ if (CompareText(Canvas.ClassName, 'TCanvasQuartz') = 0) and (FContext <> 0) then
+ begin
+ FPath := CGPathCreateMutable();
+ Bounds := CGRectMake(0, 0, ARect.Width, $FFFF);
+ CGPathAddRect(FPath, nil, Bounds);
+ LStringRef := CFStringCreateWithCharacters(kCFAllocatorDefault, PChar(AText), AText.Length);
+ CreateFrame(Canvas, LStringRef, Attr, FCTFrame);
+
+ cref := Pointer(FContext);
+ CGContextSaveGState(cref);
+ CGContextClipToRect(cref, CGRectMake(ARect.Left, ARect.Top, ARect.Width, ARect.Height));
+ CGContextSetTextMatrix(cref, CGAffineTransformMakeScale(1.0, 1.0));
+ CGContextTranslateCTM(cref, ARect.Left, ARect.Bottom);
+ CGContextScaleCTM(cref, 1, -1);
+ CGContextTranslateCTM(cref, 0, -($FFFF - ARect.Height));
+
+ CalcHeight(FCTFrame);
+
+ case AVTextAlign of
+ TTextAlign.taCenter:
+ CGContextTranslateCTM(cref, 0,
+ -(ARect.Height - FTextHeight) / 2);
+ TTextAlign.taLeading:
+ CGContextTranslateCTM(cref, 0, 0);
+ TTextAlign.taTrailing:
+ CGContextTranslateCTM(cref, 0,
+ -(ARect.Height - FTextHeight));
+ end;
+
+ CTFrameDraw(FCTFrame, cref);
+
+ CGContextRestoreGState(cref);
+ CFRelease(LStringRef);
+ CFRelease(Attr);
+ CFRelease(FPath);
+ CFRelease(FCTFrame);
+ end
+ else
+ Inherited;
+end;
+
+function TfrxFastCanvas.GetContext: THandle;
+begin
+ if Assigned(FCanvas.Bitmap) and (FCanvas.Bitmap.Handle <> 0) then
+ begin
+ if (TQuartzBitmap(FCanvas.Bitmap.Handle).FImage <> nil) then
+ begin
+ CGImageRelease(TQuartzBitmap(FCanvas.Bitmap.Handle).FImage);
+ TQuartzBitmap(FCanvas.Bitmap.Handle).FImage := nil;
+ end;
+ FContext := THandle(CGBitmapContextCreate(TQuartzBitmap(FCanvas.Bitmap.Handle).FData, FCanvas.Bitmap.Width, FCanvas.Bitmap.Height, 8,
+ FCanvas.Bitmap.Width * 4, FColorSpace, kCGImageAlphaPremultipliedLast));
+ end;
+ Result := FContext;
+end;
+
+function TfrxFastCanvas.GetCTFont(const AFont: TFont): CTFontRef;
+var
+ fName: String;
+ Index: Integer;
+begin
+ Result := nil;
+ fName := GetFontNameHash(aFont);
+ Index := FFontCacheList.IndexOf(fName);
+ if Index = -1 then
+ Index := AddCTFontToList(fName, CreateCTFont(aFont));
+ Result := CTFontRef(FFontCacheList.Objects[Index])
+end;
+
+function TfrxFastCanvas.GetFontNameHash(const AFont: TFont): String;
+begin
+ Result := aFont.Family;
+ if fsBold in aFont.Style then
+ Result := Result + 'B';
+ if fsItalic in aFont.Style then
+ Result := Result + 'I';
+ Result := Result + FloatToStr(aFont.Size);
+end;
+
+procedure TfrxFastCanvas.MeasureText(var ARect: TRectF; const AText: string; const WordWrap: Boolean; const Flags: TFillTextFlags; const ATextAlign, AVTextAlign: TTextAlign);
+var
+ cref: CGContextRef;
+ LStringRef: CFStringRef;
+ FCTFrame: CTFrameRef;
+ Bounds: CGRect;
+ Attr: CFMutableAttributedStringRef;
+ w, h: Double;
+begin
+ w := 0;
+ h := 0;
+ if AText.Length = 0 then
+ Exit;
+ FText := AText;
+ FTextAlign := ATextAlign;
+ FWordWrap := WordWrap;
+ FFlags := Flags;
+ if CompareText(Canvas.ClassName, 'TCanvasQuartz') = 0 then
+ begin
+ FPath := CGPathCreateMutable();
+ Bounds := CGRectMake(0, 0, ARect.Width, $FFFF);
+ CGPathAddRect(FPath, nil, Bounds);
+ LStringRef := CFStringCreateWithCharacters(kCFAllocatorDefault, PChar(AText), AText.Length);
+ CreateFrame(Canvas, LStringRef, Attr, FCTFrame);
+ cref := Pointer(FContext);
+
+ CGContextSaveGState(cref);
+ CGContextClipToRect(cref, CGRectMake(ARect.Left, ARect.Top, ARect.Width, ARect.Height));
+ CGContextSetTextMatrix(cref, CGAffineTransformMakeScale(1.0, 1.0));
+ CGContextTranslateCTM(cref, ARect.Left, ARect.Bottom);
+ CGContextScaleCTM(cref, 1, -1);
+ CGContextTranslateCTM(cref, 0, -($FFFF - ARect.Height));
+
+ w := CalcWidth(FCTFrame);
+ h := CalcHeight(FCTFrame);
+ CGContextRestoreGState(cref);
+ CFRelease(Attr);
+ CFRelease(LStringRef);
+ CFRelease(FPath);
+ CFRelease(FCTFrame);
+ end;
+
+ ARect.Right := ARect.Left + w;
+ ARect.Bottom := ARect.Top + h;
+end;
+
+procedure TfrxFastCanvas.SetCanvas(const Value: TCanvas);
+begin
+ FCanvas := Value;
+end;
+
+procedure TfrxFastCanvas.SetFont(const Value: TFont);
+begin
+ FCurentFont := GetCTFont(Value);
+end;
+{$ENDIF}
+
+{ TfrxFastCanvasLayer }
+
+function TfrxFastCanvasLayer.CalcHeight(aText: String): Single;
+begin
+ Result := 0;
+ if Assigned(Canvas) then
+ Result := Canvas.TextHeight(aText);
+end;
+
+function TfrxFastCanvasLayer.CalcWidth(aText: String): Single;
+begin
+ Result := 0;
+ if Assigned(Canvas) then
+ Result := Canvas.TextWidth(aText);
+end;
+
+procedure TfrxFastCanvasLayer.Clear(const Color: TAlphaColor);
+begin
+ //fake
+end;
+
+procedure TfrxFastCanvasLayer.ClearCache;
+begin
+ //nothing
+end;
+
+procedure TfrxFastCanvasLayer.ClearRect(const ARect: TRectF;
+ const AColor: TAlphaColor);
+begin
+ //fake
+end;
+
+constructor TfrxFastCanvasLayer.Create;
+begin
+ FContext := 0;
+end;
+
+destructor TfrxFastCanvasLayer.Destroy;
+begin
+
+ inherited;
+end;
+
+function TfrxFastCanvasLayer.DoBeginScene({$IFNDEF DELPHI28}const{$ENDIF} AClipRects: PClipRects;
+ AContextHandle: THandle): Boolean;
+begin
+ Result := False;
+ if AContextHandle = 0 then
+ AContextHandle := THandle(GetContext);
+ if Assigned(Canvas) then
+ Result := Canvas.BeginScene(AClipRects, AContextHandle);
+end;
+
+
+{$IFDEF DELPHI19}
+procedure TfrxFastCanvasLayer.DoDrawBitmap(const ABitmap: FMX.Graphics.TBitmap;
+ const SrcRect, DstRect: TRectF; const AOpacity: Single;
+ const HighSpeed: Boolean);
+{$ELSE}
+procedure TfrxFastCanvasLayer.DoDrawBitmap(const ABitmap: FMX.Types.TBitmap;
+ const SrcRect, DstRect: TRectF; const AOpacity: Single;
+ const HighSpeed: Boolean);
+{$ENDIF}
+begin
+ inherited;
+
+end;
+
+procedure TfrxFastCanvasLayer.DoDrawEllipse(const ARect: TRectF;
+ const AOpacity: Single; const ABrush: TStrokeBrush);
+begin
+ //fake
+end;
+
+procedure TfrxFastCanvasLayer.DoDrawLine(const APt1, APt2: TPointF;
+ const AOpacity: Single; const ABrush: TStrokeBrush);
+begin
+ //fake
+end;
+
+procedure TfrxFastCanvasLayer.DoDrawPath(const APath: TPathData;
+ const AOpacity: Single; const ABrush: TStrokeBrush);
+begin
+ //fake
+end;
+
+procedure TfrxFastCanvasLayer.DoDrawRect(const ARect: TRectF;
+ const AOpacity: Single; const ABrush: TStrokeBrush);
+begin
+ inherited;
+
+end;
+
+procedure TfrxFastCanvasLayer.DoEndScene;
+begin
+ if Assigned(Canvas) then
+ Canvas.EndScene;
+end;
+
+procedure TfrxFastCanvasLayer.DoFillEllipse(const ARect: TRectF;
+ const AOpacity: Single; const ABrush: TBrush);
+begin
+ //fake
+end;
+
+procedure TfrxFastCanvasLayer.DoFillPath(const APath: TPathData;
+ const AOpacity: Single; const ABrush: TBrush);
+begin
+ //fake
+end;
+
+procedure TfrxFastCanvasLayer.DoFillRect(const ARect: TRectF;
+ const AOpacity: Single; const ABrush: TBrush);
+begin
+ //fake
+end;
+
+{$IFDEF DELPHI21}
+
+function TfrxFastCanvasLayer.DoFillPolygon(const Points: TPolygon;
+ const AOpacity: Single; const ABrush: TBrush): Boolean;
+begin
+ //fake
+ Result := False;
+end;
+
+class procedure TfrxFastCanvasLayer.DoFinalizeBitmap(var Bitmap: THandle);
+begin
+ //fake
+end;
+
+class function TfrxFastCanvasLayer.DoInitializeBitmap(const Width,
+ Height: Integer; const Scale: Single; var PixelFormat: TPixelFormat): THandle;
+begin
+ //fake
+ Result := 0;
+end;
+
+class function TfrxFastCanvasLayer.DoMapBitmap(const Bitmap: THandle;
+ const Access: TMapAccess; var Data: TBitmapData): Boolean;
+begin
+ //fake
+ Result := False;
+end;
+
+class procedure TfrxFastCanvasLayer.DoUnmapBitmap(const Bitmap: THandle;
+ var Data: TBitmapData);
+begin
+ //fake
+end;
+{$ELSE}
+{$IFDEF DELPHI19}
+class procedure TfrxFastCanvasLayer.DoInitializeBitmap(const Bitmap: FMX.Graphics.TBitmap);
+begin
+ //fake
+end;
+class procedure TfrxFastCanvasLayer.DoFinalizeBitmap(const Bitmap: FMX.Graphics.TBitmap);
+begin
+ //fake
+end;
+class function TfrxFastCanvasLayer.DoMapBitmap(const Bitmap: FMX.Graphics.TBitmap; const Access: TMapAccess; var Data: TBitmapData): Boolean;
+begin
+ Result := False;
+ //fake
+end;
+class procedure TfrxFastCanvasLayer.DoUnmapBitmap(const Bitmap: FMX.Graphics.TBitmap; var Data: TBitmapData);
+begin
+ //fake
+end;
+{$ENDIF}
+{$ENDIF}
+
+procedure TfrxFastCanvasLayer.ExcludeClipRect(const ARect: TRectF);
+begin
+ //fake
+end;
+
+procedure TfrxFastCanvasLayer.FillText(const ARect: TRectF;
+ const AText: string; const WordWrap: Boolean; const AOpacity: Single;
+ const Flags: TFillTextFlags; const ATextAlign, AVTextAlign: TTextAlign);
+begin
+ if Assigned(Canvas) then
+ Canvas.FillText(ARect, AText, WordWrap, AOpacity, Flags, ATextAlign,
+ AVTextAlign);
+end;
+
+function TfrxFastCanvasLayer.GetContext: THandle;
+begin
+ Result := FContext;
+end;
+
+procedure TfrxFastCanvasLayer.IntersectClipRect(const ARect: TRectF);
+begin
+ //fake
+end;
+
+procedure TfrxFastCanvasLayer.MeasureText(var ARect: TRectF;
+ const AText: string; const WordWrap: Boolean; const Flags: TFillTextFlags;
+ const ATextAlign, AVTextAlign: TTextAlign);
+begin
+ if Assigned(Canvas) then
+ Canvas.MeasureText(ARect, AText, WordWrap, Flags, ATextAlign,
+ AVTextAlign);
+end;
+
+function TfrxFastCanvasLayer.PtInPath(const APoint: TPointF;
+ const APath: TPathData): Boolean;
+begin
+ //fake
+ Result := False;
+end;
+
+procedure TfrxFastCanvasLayer.SetCanvas(const Value: TCanvas);
+begin
+ if Assigned(Value) then
+ begin
+ FWidth := Value.Width;
+ FHeight := Value.Height;
+ end;
+ FCanvas := Value;
+end;
+
+procedure TfrxFastCanvasLayer.SetContext(const Value: THandle);
+begin
+ FContext := Value;
+end;
+
+procedure TfrxFastCanvasLayer.SetFont(const Value: TFont);
+begin
+ if Assigned(Canvas) then
+ Canvas.Font.Assign(Value);
+end;
+
+{ TfrxFastCanvas }
+
+{$IFDEF MSWINDOWS}
+procedure TfrxFastCanvas.ClearFontCache;
+var
+ i: Integer;
+begin
+ for i := 0 to FFontCacheList.Count - 1 do
+ FFontCacheList.Objects[i].Free;
+ FFontCacheList.Clear;
+end;
+
+constructor TfrxFastCanvas.Create;
+begin
+ FFontCacheList := TfrxStringList.Create;
+ FFontCacheList.Sorted := True;
+end;
+
+destructor TfrxFastCanvas.Destroy;
+begin
+ ClearFontCache;
+ FreeAndNil(FFontCacheList);
+ inherited;
+end;
+
+procedure TfrxFastCanvas.FillText(const ARect: TRectF; const AText: string;
+ const WordWrap: Boolean; const AOpacity: Single; const Flags: TFillTextFlags;
+ const ATextAlign, AVTextAlign: TTextAlign);
+var
+ DLayont: TTextLayout;
+ Fonthash: String;
+ Index: Integer;
+begin
+ if Canvas.ClassName <> 'TCanvasGdiPlus' then
+ begin
+ Inherited;
+ Exit;
+ end;
+ fonthash := GetFontNameHash(FCanvas.Font, WordWrap, Flags, ATextAlign, AVTextAlign);
+ Index := FFontCacheList.IndexOf(fonthash);
+
+ if Index = -1 then
+ begin
+ DLayont := TTextLayoutManager.TextLayoutByCanvas(Canvas.ClassType)
+ .Create(Canvas);
+ DLayont.BeginUpdate;
+ DLayont.Font := Canvas.Font;
+ DLayont.WordWrap := WordWrap;
+ DLayont.HorizontalAlign := ATextAlign;
+ DLayont.VerticalAlign := AVTextAlign;
+ DLayont.RightToLeft := TFillTextFlag.ftRightToLeft in Flags;
+ DLayont.EndUpdate;
+ DLayont.BeginUpdate;
+ Index := FFontCacheList.AddObject(fonthash, DLayont);
+ end;
+
+ DLayont := TTextLayout(FFontCacheList.Objects[Index]);
+ DLayont.Color := Canvas.Fill.Color;
+ DLayont.Opacity := AOpacity;
+ DLayont.TopLeft := ARect.TopLeft;
+ DLayont.MaxSize := PointF(ARect.Width, ARect.Height);
+ DLayont.Text := AText;
+ TTextLayoutHack(DLayont).DoDrawLayout(Canvas);
+end;
+
+function TfrxFastCanvas.GetContext: THandle;
+begin
+ Result := 0;
+end;
+
+function TfrxFastCanvas.GetFontNameHash(const AFont: TFont; WordWrap: Boolean; const Flags: TFillTextFlags; const ATextAlign: TTextAlign; const VTextAlign: TTextAlign): String;
+begin
+ Result := aFont.Family;
+ if fsBold in aFont.Style then
+ Result := Result + 'B';
+ if fsItalic in aFont.Style then
+ Result := Result + 'I';
+ if fsUnderline in aFont.Style then
+ Result := Result + 'U';
+ if fsStrikeout in aFont.Style then
+ Result := Result + 'U';
+ if WordWrap then
+ Result := Result + 'W';
+ case ATextAlign of
+ TTextAlign.taCenter: Result := Result + 'C';
+ TTextAlign.taLeading: Result := Result + 'L';
+ TTextAlign.taTrailing: Result := Result + 'T';
+ end;
+ case VTextAlign of
+ TTextAlign.taCenter: Result := Result + 'VC';
+ TTextAlign.taLeading: Result := Result + 'VL';
+ TTextAlign.taTrailing: Result := Result + 'VT';
+ end;
+ if TFillTextFlag.ftRightToLeft in Flags then
+ Result := Result + 'R';
+ Result := Result + FloatToStr(aFont.Size);
+end;
+
+
+procedure TfrxFastCanvas.MeasureText(var ARect: TRectF; const AText: string;
+ const WordWrap: Boolean; const Flags: TFillTextFlags; const ATextAlign,
+ AVTextAlign: TTextAlign);
+var
+ DLayont: TTextLayout;
+ Fonthash: String;
+ Index: Integer;
+ tr: TTextRange;
+ LRegion: TRegion;
+ i: Integer;
+begin
+ if Canvas.ClassName <> 'TCanvasGdiPlus' then
+ begin
+ Inherited;
+ Exit;
+ end;
+ fonthash := GetFontNameHash(FCanvas.Font, WordWrap, Flags, ATextAlign, AVTextAlign);
+ Index := FFontCacheList.IndexOf(fonthash);
+
+ if Index = -1 then
+ begin
+ DLayont := TTextLayoutManager.TextLayoutByCanvas(Canvas.ClassType)
+ .Create(Canvas);
+ DLayont.BeginUpdate;
+ DLayont.Font := Canvas.Font;
+ DLayont.WordWrap := WordWrap;
+ DLayont.HorizontalAlign := ATextAlign;
+ DLayont.VerticalAlign := AVTextAlign;
+ DLayont.RightToLeft := False;
+ DLayont.EndUpdate;
+ DLayont.BeginUpdate;
+ Index := FFontCacheList.AddObject(fonthash, DLayont);
+ end;
+
+ DLayont := TTextLayout(FFontCacheList.Objects[Index]);
+ DLayont.TopLeft := ARect.TopLeft;
+ DLayont.MaxSize := PointF(ARect.Width, ARect.Height);
+ DLayont.Text := AText;
+ DLayont.TopLeft := ARect.TopLeft;
+ DLayont.MaxSize := PointF(ARect.Width, ARect.Height);
+ DLayont.Text := AText;
+ tr.Pos := 0;
+ tr.Length := Length(AText);
+ LRegion := TTextLayoutHack(DLayont).DoRegionForRange(tr);
+
+ if Length(LRegion) > 0 then
+ begin
+ for i := 1 to High(LRegion) do
+ LRegion[0].Union(LRegion[i]);
+ ARect.Left := LRegion[0].Left;
+ ARect.Top := LRegion[0].Top;
+ ARect.Width := LRegion[0].Width;
+ ARect.Height := LRegion[0].Height;
+ end;
+
+end;
+
+{$ENDIF}
+{$ENDIF}
+
+{ TfrxFastCanvasLayer }
+
+type
+ TCommonCustomFormHack = class(TCommonCustomForm);
+
+procedure TfrxFastCanvasLayer.UpdateHandle(AParent: TFmxObject);
+var
+ ParentForm: TFmxObject;
+begin
+ ParentForm := AParent;
+ while (ParentForm <> nil) and not (ParentForm is TCommonCustomForm) do
+ ParentForm := ParentForm.Parent;
+ if (ParentForm is TCommonCustomForm) then
+ Context := TCommonCustomFormHack(ParentForm).ContextHandle
+ else
+ Context := 0;
+end;
+
+{$IFDEF MSWINDOWS}
+function frxGetDefaultPPI: Integer;
+var
+ dc: HDC;
+begin
+ dc := GetDC(0);
+ try
+ Result := GetDeviceCaps(dc, LOGPIXELSX);
+ finally
+ ReleaseDC(0, dc);
+ end;
+end;
+{$ENDIF}
+
+initialization
+{$IFDEF MSWINDOWS}
+ frxDefaultPPI := frxGetDefaultPPI;
+{$ENDIF}
+
+ frxCanvasClass;
+
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxToolButton, TFmxObject);
+ GroupDescendentsWith(TfrxToolSeparator, TFmxObject);
+ GroupDescendentsWith(TfrxToolGrip, TFmxObject);
+ GroupDescendentsWith(TfrxFont, TFmxObject);
+ GroupDescendentsWith(TfrxTreeView, TFmxObject);
+ GroupDescendentsWith(TfrxTreeViewItem, TFmxObject);
+ GroupDescendentsWith(TfrxImageList, TFmxObject);
+ GroupDescendentsWith(TfrxListBoxItem, TFmxObject);
+ GroupDescendentsWith(TfrxListBox, TFmxObject);
+ RegisterFmxClasses([TfrxToolButton, TfrxTreeViewItem, TfrxTreeView, TfrxListBoxItem, TfrxListBox, TfrxToolSeparator, TfrxToolGrip, TfrxFont]);
+{$IFDEF MACOS}
+ UCCreateCollator(nil, nil, kUCCollateCaseInsensitiveMask, @collatorRefIgnoreCase);
+ UCCreateCollator(nil, nil, 0, @collatorRef);
+
+finalization
+ UCDisposeCollator(@collatorRefIgnoreCase);
+ UCDisposeCollator(@collatorRef);
+{$ENDIF}
+end.
diff --git a/LibD28/FMX.frxFontForm.fmx b/LibD28/FMX.frxFontForm.fmx
new file mode 100644
index 0000000..a7094ce
--- /dev/null
+++ b/LibD28/FMX.frxFontForm.fmx
@@ -0,0 +1,160 @@
+object frxFontForm: TfrxFontForm
+ Left = 0
+ Top = 0
+ Caption = 'Font selector'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 293
+ ClientWidth = 328
+ Position = poOwnerFormCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnActivate = FormActivate
+ OnResize = FormResize
+ StyleLookup = 'backgroundstyle'
+ object FontL: TLabel
+ Position.Point = '(8,8)'
+ Width = 153.000000000000000000
+ Height = 15.000000000000000000
+ TabOrder = 0
+ Font.Family = 'Arial'
+ Text = 'Font:'
+ end
+ object SizeL: TLabel
+ Position.Point = '(168,8)'
+ Width = 57.000000000000000000
+ Height = 15.000000000000000000
+ TabOrder = 1
+ Font.Family = 'Arial'
+ Text = 'Size:'
+ end
+ object GroupBox1: TGroupBox
+ Position.Point = '(232,48)'
+ Width = 89.000000000000000000
+ Height = 97.000000000000000000
+ TabOrder = 2
+ Font.Family = 'Arial'
+ Text = 'Font Type'
+ object BoldB: TfrxToolButton
+ Position.Point = '(16,24)'
+ Width = 25.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BoldBClick
+ TabOrder = 0
+ StaysPressed = True
+ end
+ object ItalicB: TfrxToolButton
+ Position.Point = '(48,24)'
+ Width = 25.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = ItalicBClick
+ TabOrder = 1
+ StaysPressed = True
+ end
+ object UnderlineB: TfrxToolButton
+ Position.Point = '(16,56)'
+ Width = 24.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = UnderlineBClick
+ TabOrder = 2
+ StaysPressed = True
+ end
+ object StrikeoutB: TfrxToolButton
+ Position.Point = '(48,56)'
+ Width = 25.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = StrikeoutBClick
+ TabOrder = 3
+ StaysPressed = True
+ Bitmap.PNG = {
+ 89504E470D0A1A0A0000000D49484452000000100000001008060000001FF3FF
+ 61000000017352474200AECE1CE90000000467414D410000B18F0BFC61050000
+ 00097048597300000EC300000EC301C76FA8640000008B49444154384FDD92E1
+ 0D403010463B80052C600E83D8C00656B082192C610B93F8C7F7C497204D9AF6
+ 1F2F79B9B4E5AEEE844F305EB1885EAEB23E57052C7297C3B9CAA49354270131
+ 9B49B6920448C2287EA0C44D46A1BAA1B25FE04649E838CD637CD6BD986512AA
+ BFC7C61448901CA9ABBF61DFB7B87FDE83467248027EA04A02913EB06F39FF07
+ 211C8BC92E31DA25457C0000000049454E44AE426082}
+ end
+ end
+ object Sample: TGroupBox
+ Position.Point = '(8,200)'
+ Width = 217.000000000000000000
+ Height = 89.000000000000000000
+ TabOrder = 3
+ Font.Family = 'Arial'
+ Text = 'Sample'
+ end
+ object FontE: TEdit
+ Position.Point = '(8,24)'
+ Width = 153.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 4
+ KeyboardType = vktDefault
+ OnChange = FontEChange
+ OnChangeTracking = FontEChange
+ Password = False
+ end
+ object SizeE: TEdit
+ Position.Point = '(168,24)'
+ Width = 57.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 5
+ KeyboardType = vktDefault
+ OnChangeTracking = SizeEChangeTracking
+ Password = False
+ end
+ object FontLB: TListBox
+ Position.Point = '(8,48)'
+ Width = 153.000000000000000000
+ Height = 145.000000000000000000
+ TabOrder = 6
+ OnChange = FontLBChange
+ end
+ object SizeLB: TListBox
+ Position.Point = '(168,48)'
+ Width = 57.000000000000000000
+ Height = 145.000000000000000000
+ TabOrder = 7
+ OnChange = SizeLBChange
+ end
+ object CancelBtn: TButton
+ Position.Point = '(236,258)'
+ Width = 80.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 8
+ ModalResult = 2
+ Text = 'Cancel'
+ end
+ object OkBtn: TButton
+ Position.Point = '(236,216)'
+ Width = 80.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 9
+ ModalResult = 1
+ Text = 'Ok'
+ end
+ object ComboColorBox1: TComboColorBox
+ Position.Point = '(232,24)'
+ Width = 89.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 10
+ Color = claWhite
+ OnChange = ComboColorBox1Change
+ end
+ object ColorL: TLabel
+ Position.Point = '(232,8)'
+ Width = 120.000000000000000000
+ Height = 15.000000000000000000
+ TabOrder = 11
+ Font.Family = 'Arial'
+ Text = 'Color:'
+ end
+ object PaintBox1: TPaintBox
+ Position.Point = '(16,224)'
+ Width = 201.000000000000000000
+ Height = 50.000000000000000000
+ OnPaint = PaintBox1Paint
+ end
+end
diff --git a/LibD28/FMX.frxFontForm.pas b/LibD28/FMX.frxFontForm.pas
new file mode 100644
index 0000000..8ee8b87
--- /dev/null
+++ b/LibD28/FMX.frxFontForm.pas
@@ -0,0 +1,233 @@
+unit FMX.frxFontForm;
+
+{$I frx.inc}
+interface
+
+uses
+ System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
+ FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.frxFMX, FMX.Layouts, FMX.frxRes,
+ FMX.ListBox, FMX.Edit, FMX.Objects, FMX.Colors, System.UIConsts
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+{$IFDEF LINUX}
+ TfrxFontForm = class(TfrxForm)
+{$ELSE}
+ TfrxFontForm = class(TForm)
+{$ENDIF}
+ FontL: TLabel;
+ SizeL: TLabel;
+ GroupBox1: TGroupBox;
+ Sample: TGroupBox;
+ PaintBox1: TPaintBox;
+ FontE: TEdit;
+ SizeE: TEdit;
+ FontLB: TListBox;
+ SizeLB: TListBox;
+ CancelBtn: TButton;
+ OkBtn: TButton;
+ BoldB: TfrxToolButton;
+ ItalicB: TfrxToolButton;
+ UnderlineB: TfrxToolButton;
+ StrikeoutB: TfrxToolButton;
+ ComboColorBox1: TComboColorBox;
+ ColorL: TLabel;
+ procedure FormCreate(Sender: TObject);
+ procedure FontEChange(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure ComboColorBox1Change(Sender: TObject);
+ procedure FontLBChange(Sender: TObject);
+ procedure SizeLBChange(Sender: TObject);
+ procedure SizeEChangeTracking(Sender: TObject);
+ procedure PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
+ procedure BoldBClick(Sender: TObject);
+ procedure ItalicBClick(Sender: TObject);
+ procedure UnderlineBClick(Sender: TObject);
+ procedure StrikeoutBClick(Sender: TObject);
+ procedure FormActivate(Sender: TObject);
+ procedure FormResize(Sender: TObject);
+ private
+ FFontS: TfrxFont;
+ FIsCallFromEdit: Boolean;
+ { Private declarations }
+ public
+ property FontS: TfrxFont read FFontS;
+ { Public declarations }
+ end;
+
+var
+ frxFontForm: TfrxFontForm;
+
+implementation
+
+{$R *.fmx}
+
+procedure SetFontStyle(AFont: TfrxFont; fStyle: TFontStyle; Include: Boolean);
+begin
+ with AFont do
+ if Include then
+ Style := Style + [fStyle] else
+ Style := Style - [fStyle];
+end;
+
+procedure TfrxFontForm.BoldBClick(Sender: TObject);
+begin
+ SetFontStyle(FFontS, fsBold, BoldB.IsPressed);
+ Self.InvalidateRect(RectF(0, 0, Self.Width, Self.Height));
+end;
+
+procedure TfrxFontForm.ComboColorBox1Change(Sender: TObject);
+begin
+ FFonts.Color := ComboColorBox1.Color;
+ Self.InvalidateRect(RectF(0, 0, Self.Width, Self.Height));
+end;
+
+procedure TfrxFontForm.FontEChange(Sender: TObject);
+var
+ i: Integer;
+begin
+ //i := FontLB.Items.IndexOf(FontE.Text);
+ for i := 0 to FontLB.Items.Count - 1 do
+ begin
+ if (Pos(UpperCase(FontE.Text), UpperCase(FontLB.Items[i])) = 1) then
+ begin
+ FIsCallFromEdit := True;
+ FontLB.ItemIndex := i;
+ FIsCallFromEdit := False;
+ break;
+ end;
+ end;
+end;
+
+procedure TfrxFontForm.FontLBChange(Sender: TObject);
+begin
+ if FontLB.Selected <> nil then
+ begin
+ FFontS.Name := FontLB.Selected.Text;
+ if not FIsCallFromEdit then
+ FontE.Text := FontLB.Selected.Text;
+ Self.InvalidateRect(RectF(0, 0, Self.Width, Self.Height));
+ end;
+end;
+
+procedure TfrxFontForm.FormActivate(Sender: TObject);
+begin
+ BoldB.IsPressed := fsBold in FFontS.Style;
+ ItalicB.IsPressed := fsItalic in FFontS.Style;
+ StrikeoutB.IsPressed := fsStrikeout in FFontS.Style;
+ UnderlineB.IsPressed := fsUnderline in FFontS.Style;
+end;
+
+procedure TfrxFontForm.FormCreate(Sender: TObject);
+begin
+ FFontS := TfrxFont.Create;
+ frxResources.LoadImageFromResouce(UnderlineB.Bitmap, 2, 2);
+ frxResources.LoadImageFromResouce(BoldB.Bitmap, 2, 0);
+ frxResources.LoadImageFromResouce(ItalicB.Bitmap, 2, 1);
+ FIsCallFromEdit := False;
+{$IFDEF DELPHI23}
+ SizeLB.Clear;
+{$ELSE}
+ SizeLB.Items.Clear;
+{$ENDIF}
+ SizeLB.BeginUpdate;
+ SizeLB.Items.Add('8');
+ SizeLB.Items.Add('9');
+ SizeLB.Items.Add('10');
+ SizeLB.Items.Add('11');
+ SizeLB.Items.Add('12');
+ SizeLB.Items.Add('14');
+ SizeLB.Items.Add('16');
+ SizeLB.Items.Add('18');
+ SizeLB.Items.Add('20');
+ SizeLB.Items.Add('22');
+ SizeLB.Items.Add('24');
+ SizeLB.Items.Add('26');
+ SizeLB.Items.Add('28');
+ SizeLB.Items.Add('36');
+ SizeLB.Items.Add('48');
+ SizeLB.Items.Add('72');
+ SizeLB.EndUpdate;
+{$IFDEF DELPHI23}
+ FontLB.Clear;
+{$ELSE}
+ FontLB.Items.Clear;
+{$ENDIF}
+ FontLB.BeginUpdate;
+ FillFontsList(FontLB.Items);
+ FontLB.EndUpdate;
+ FontE.Text := FFontS.Name;
+ SizeE.Text := FloatToStr(FFontS.Size);
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+end;
+
+procedure TfrxFontForm.FormDestroy(Sender: TObject);
+begin
+ FFontS.Free;
+end;
+
+procedure TfrxFontForm.FormResize(Sender: TObject);
+begin
+ FormActivate(Sender);
+end;
+
+procedure TfrxFontForm.ItalicBClick(Sender: TObject);
+begin
+ SetFontStyle(FFontS, fsItalic, ItalicB.IsPressed);
+ Self.InvalidateRect(RectF(0, 0, Self.Width, Self.Height));
+end;
+
+procedure TfrxFontForm.PaintBox1Paint(Sender: TObject; Canvas: TCanvas);
+begin
+ Canvas.Fill.Color := claWhite;
+ Canvas.FillRect(RectF(0, 0, PaintBox1.Width, PaintBox1.Height), 0,0, AllCorners, 1);
+ FFontS.AssignToCanvas(Canvas);
+ Canvas.FillText(RectF(0, 0, PaintBox1.Width, PaintBox1.Height), 'Sample Text', false, 1, [], TTextAlign.taCenter );
+end;
+
+procedure TfrxFontForm.SizeEChangeTracking(Sender: TObject);
+var
+ OutF: Single;
+begin
+ if TryStrToFloat(SizeE.Text, OutF) then
+ begin
+ FFontS.Size := OutF;
+ Self.InvalidateRect(RectF(0, 0, Self.Width, Self.Height));
+ end
+ else
+ SizeE.Text := FloatToStr(FFontS.Size);
+end;
+
+procedure TfrxFontForm.SizeLBChange(Sender: TObject);
+begin
+ if SizeLB.Selected <> nil then
+ SizeE.Text := SizeLB.Selected.Text;
+end;
+
+procedure TfrxFontForm.StrikeoutBClick(Sender: TObject);
+begin
+ SetFontStyle(FFontS, fsStrikeout, StrikeoutB.IsPressed);
+ Self.InvalidateRect(RectF(0, 0, Self.Width, Self.Height));
+end;
+
+procedure TfrxFontForm.UnderlineBClick(Sender: TObject);
+begin
+ SetFontStyle(FFontS, fsUnderline, UnderlineB.IsPressed);
+ Self.InvalidateRect(RectF(0, 0, Self.Width, Self.Height));
+end;
+
+end.
diff --git a/LibD28/FMX.frxFontHeaderClass.pas b/LibD28/FMX.frxFontHeaderClass.pas
new file mode 100644
index 0000000..380eed3
--- /dev/null
+++ b/LibD28/FMX.frxFontHeaderClass.pas
@@ -0,0 +1,139 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Font parser }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Aleksey Mandrykin, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+{$hints off}
+unit FMX.frxFontHeaderClass;
+
+interface uses FMX.TTFHelpers, FMX.frxTrueTypeTable;
+
+type // Nested Types
+ FontHeader = packed record
+ public version: Cardinal;
+ public revision: Cardinal;
+ public checkSumAdjustment: Cardinal;
+ public magicNumber: Cardinal;
+ public flags: Word;
+ public unitsPerEm: Word;
+ public CreatedDateTime: UInt64;
+ public ModifiedDateTime: UInt64;
+ public xMin: Smallint;
+ public yMin: Smallint;
+ public xMax: Smallint;
+ public yMax: Smallint;
+ public macStyle: Word;
+ public lowestRecPPEM: Word;
+ public fontDirectionHint: Smallint;
+ public indexToLocFormat: Smallint;
+ public glyphDataFormat: Smallint;
+ end;
+
+ IndexToLoc = (LongType=1, ShortType=0);
+
+ FontType = (TrueTypeCollection=$66637474, TrueTypeFontType=0);
+
+ FontHeaderClass = class(TrueTypeTable)
+ public font_header: FontHeader;
+
+ private function get_indexToLocFormat: IndexToLoc;
+
+ // Properties
+ private property checkSumAdjustment: Cardinal write font_header.checkSumAdjustment;
+ private property Flags: Word read font_header.flags;
+// public property FontBox: FontRect read font_header.FontBox;
+ public property indexToLocFormat: IndexToLoc read get_indexToLocFormat;
+ public property unitsPerEm: Word read font_header.unitsPerEm;
+
+
+ // Methods
+ public constructor Create(src: TrueTypeTable);
+ strict private procedure ChangeEndian;
+ public procedure Load(font: Pointer); override;
+ public procedure SaveFontHeader(header_ptr: Pointer; CheckSum: Cardinal);
+
+end;
+
+implementation
+
+ constructor FontHeaderClass.Create(src: TrueTypeTable);
+ begin
+ inherited Create(src);
+ end;
+
+ function FontHeaderClass.get_indexToLocFormat: IndexToLoc;
+ begin
+ Result := IndexToLoc(font_header.indexToLocFormat);
+ end;
+
+ procedure FontHeaderClass.ChangeEndian;
+ begin
+ self.font_header.indexToLocFormat := TTF_Helpers.SwapInt16(self.font_header.indexToLocFormat);
+ self.font_header.magicNumber := TTF_Helpers.SwapUInt32(self.font_header.magicNumber);
+ self.font_header.unitsPerEm := TTF_Helpers.SwapUInt16(self.font_header.unitsPerEm);
+ self.font_header.flags := TTF_Helpers.SwapUInt16(self.font_header.flags);
+ end;
+
+ procedure FontHeaderClass.Load(font: Pointer);
+ var
+ header: ^FontHeader;
+ begin
+ header := TTF_Helpers.Increment(font, self.entry.offset); //header_ptr;
+ self.font_header.checkSumAdjustment := header.checkSumAdjustment;
+ self.font_header.CreatedDateTime := header.CreatedDateTime;
+ self.font_header.flags := header.flags;
+ self.font_header.fontDirectionHint := header.fontDirectionHint;
+ self.font_header.glyphDataFormat := header.glyphDataFormat;
+ self.font_header.indexToLocFormat:= header.indexToLocFormat;
+ self.font_header.lowestRecPPEM := header.lowestRecPPEM;
+ self.font_header.macStyle := header.macStyle;
+ self.font_header.magicNumber := header.magicNumber;
+ self.font_header.ModifiedDateTime := header.ModifiedDateTime;
+ self.font_header.revision := header.revision;
+ self.font_header.unitsPerEm := header.unitsPerEm;
+ self.font_header.version := header.version;
+ self.font_header.xMax := header.xMax;
+ self.font_header.xMin := header.xMin;
+ self.font_header.yMax := header.yMax;
+ self.font_header.yMin := header.yMin;
+ self.ChangeEndian;
+
+ header.checkSumAdjustment := 0;
+ end;
+
+ procedure FontHeaderClass.SaveFontHeader(header_ptr: Pointer; CheckSum: Cardinal);
+ var
+ header: ^FontHeader;
+ begin
+ self.ChangeEndian;
+ header_ptr := TTF_Helpers.Increment(header_ptr, self.entry.offset);
+ header := header_ptr;
+
+ self.font_header.checkSumAdjustment := TTF_Helpers.SwapUInt32(CheckSum);
+
+ header.checkSumAdjustment := self.font_header.checkSumAdjustment;
+ header.CreatedDateTime := self.font_header.CreatedDateTime;
+ self.font_header.flags := header.flags;
+ header.fontDirectionHint := self.font_header.fontDirectionHint;
+ header.glyphDataFormat := self.font_header.glyphDataFormat;
+ header.indexToLocFormat := self.font_header.indexToLocFormat;
+ header.lowestRecPPEM := self.font_header.lowestRecPPEM;
+ header.macStyle := self.font_header.macStyle;
+ header.magicNumber := self.font_header.magicNumber;
+ header.ModifiedDateTime := self.font_header.ModifiedDateTime;
+ header.revision := self.font_header.revision;
+ header.unitsPerEm := self.font_header.unitsPerEm;
+ header.version := self.font_header.version;
+ header.xMax := self.font_header.xMax;
+ header.xMin := self.font_header.xMin;
+ header.yMax := self.font_header.yMax;
+ header.yMin := self.font_header.yMin;
+ self.ChangeEndian
+ end;
+{$hints on}
+end.
diff --git a/LibD28/FMX.frxGZip.pas b/LibD28/FMX.frxGZip.pas
new file mode 100644
index 0000000..778e034
--- /dev/null
+++ b/LibD28/FMX.frxGZip.pas
@@ -0,0 +1,257 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ GZIP compress/decompress }
+{ }
+{ Copyright (c) 2004-2008 }
+{ by Alexander Fediachov, }
+{ Fast Reports, Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxGZip;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.ZLib,
+ FMX.frxClass;
+
+
+type
+ TfrxCompressionLevel = (gzNone, gzFastest, gzDefault, gzMax);
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxGZipCompressor = class(TfrxCustomCompressor)
+ public
+ procedure Compress(Dest: TStream); override;
+ function Decompress(Source: TStream): Boolean; override;
+ end;
+
+
+procedure frxCompressStream(Source, Dest: TStream;
+ Compression: TfrxCompressionLevel = gzDefault; FileNameW: String = '');
+function frxDecompressStream(Source, Dest: TStream): AnsiString;
+procedure frxDeflateStream(Source, Dest: TStream;
+ Compression: TfrxCompressionLevel = gzDefault);
+procedure frxInflateStream(Source, Dest: TStream);
+
+
+implementation
+
+uses
+ System.SysConst, System.SysUtils, FMX.frxUtils;
+
+procedure frxCompressStream(Source, Dest: TStream;
+ Compression: TfrxCompressionLevel = gzDefault; FileNameW: String = '');
+var
+ header: array [0..3] of Byte;
+ Compressor: TZCompressionStream;
+ Size: Cardinal;
+ CRC: Cardinal;
+ FileName: AnsiString;
+begin
+ CRC := frxStreamCRC32(Source);
+ Size := Source.Size;
+ FileName := AnsiString(FileNameW);
+ if FileName = '' then
+ FileName := '1';
+ FileName := FileName + #0;
+
+ // put gzip header
+ header[0] := $1f; // ID1 (IDentification 1)
+ header[1] := $8b; // ID2 (IDentification 2)
+ header[2] := $8; // CM (Compression Method) CM = 8 denotes the "deflate"
+ header[3] := $8; // FLG (FLaGs) bit 3 FNAME
+ Dest.Write(header, 4);
+
+ // reserve 4 bytes in MTIME field
+ Dest.Write(header, 4);
+
+ header[0] := 0; // XFL (eXtra FLags) XFL = 2 - compressor used maximum compression
+ header[1] := 0; // OS (Operating System) 0 - FAT filesystem (MS-DOS, OS/2, NT/Win32)
+ Dest.Write(header, 2);
+
+ // original file name, zero-terminated
+ Dest.Write(FileName[1], Length(FileName));
+
+ // seek back to skip 2 bytes zlib header
+ Dest.Seek(Int64(-2), soFromCurrent);
+
+ // put compressed data
+ Compressor := TZCompressionStream.Create(Dest, TZCompressionLevel(Compression), 15);
+ try
+ Compressor.CopyFrom(Source, 0);
+ finally
+ Compressor.Free;
+ end;
+
+ // get adler32 checksum
+ Dest.Seek(Int64(-4), soFromEnd);
+ Dest.Read(header, 4);
+ // write it to the header (to MTIME field)
+ Dest.Position := 4;
+ Dest.Write(header, 4);
+
+ // restore original file name (it was corrupted by zlib header)
+ Dest.Seek(Int64(2), soFromCurrent);
+ Dest.Write(FileName[1], Length(FileName));
+
+ // put crc32 and length
+ Dest.Seek(Int64(-4), soFromEnd);
+ Dest.Write(CRC, 4);
+ Dest.Write(Size, 4);
+end;
+
+function frxDecompressStream(Source, Dest: TStream): AnsiString;
+var
+ s: AnsiString;
+ header: array [0..3] of byte;
+ adler32: Integer;
+ FTempStream: TMemoryStream;
+ UnknownPtr: Pointer;
+ NewSize: Integer;
+begin
+ s := '';
+
+ // read gzip header
+ Source.Read(header, 4);
+ if (header[0] = $1f) and (header[1] = $8b) and (header[2] = $8) then
+ begin
+ Source.Read(adler32, 4);
+ Source.Read(header, 2);
+ if (header[3] and $8) <> 0 then
+ begin
+ Source.Read(header, 1);
+ while header[0] <> 0 do
+ begin
+ s := s + AnsiChar(Char(header[0]));
+ Source.Read(header, 1);
+ end;
+ end;
+ end;
+
+ FTempStream := TMemoryStream.Create;
+ try
+ // put zlib header
+ s := #$78#$DA;
+ FTempStream.Write(s[1], 2);
+ // put compressed data, skip gzip's crc32 and filelength
+ FTempStream.CopyFrom(Source, Source.Size - Source.Position - 8);
+ // put adler32
+ FTempStream.Write(adler32, 4);
+
+ // uncompress data and save it to the Dest
+ ZDeCompress(FTempStream.Memory, FTempStream.Size, UnknownPtr, NewSize);
+ Dest.Write(UnknownPtr^, NewSize);
+ FreeMem(UnknownPtr, NewSize);
+ finally
+ FTempStream.Free;
+ end;
+ Result := s;
+end;
+
+procedure frxDeflateStream(Source, Dest: TStream;
+ Compression: TfrxCompressionLevel = gzDefault);
+
+var
+ Compressor: TZCompressionStream;
+{$IFDEF DELPHI28}
+ function OldCopyFrom(const Source: TStream; Count: Int64; BufferSize: Integer): Int64;
+ var
+ N: Integer;
+ Buffer: TBytes;
+ begin
+ if BufferSize <= 0 then
+ raise ERangeError.CreateRes(@SRangeError);
+ if Count <= 0 then
+ begin
+ Source.Position := 0;
+ Count := Source.Size;
+ end;
+ Result := Count;
+ if Count < BufferSize then BufferSize := Count;
+ SetLength(Buffer, BufferSize);
+ try
+ while Count <> 0 do
+ begin
+ if Count > BufferSize then N := BufferSize else N := Count;
+ Source.ReadBuffer(Buffer, N);
+ Compressor.WriteBuffer(Buffer, N);
+ Dec(Count, N);
+ end;
+ finally
+ SetLength(Buffer, 0);
+ end;
+ end;
+{$ENDIF}
+begin
+ Compressor := TZCompressionStream.Create(Dest, TZCompressionLevel(Compression), 15);
+ try
+{$IFDEF DELPHI28}
+ OldCopyFrom(Source, 0, $100000);
+{$ELSE}
+ Compressor .CopyFrom(Source, 0);
+{$ENDIF}
+ finally
+ Compressor.Free;
+ end;
+end;
+
+procedure frxInflateStream(Source, Dest: TStream);
+var
+ FTempStream: TMemoryStream;
+ UnknownPtr: Pointer;
+ NewSize: Integer;
+begin
+ FTempStream := TMemoryStream.Create;
+ try
+ FTempStream.CopyFrom(Source, 0);
+ // uncompress data and save it to the Dest
+ ZDeCompress(FTempStream.Memory, FTempStream.Size, UnknownPtr, NewSize);
+ Dest.Write(UnknownPtr^, NewSize);
+ FreeMem(UnknownPtr, NewSize);
+ finally
+ FTempStream.Free;
+ end;
+end;
+
+
+{ TfrxGZipCompressor }
+
+procedure TfrxGZipCompressor.Compress(Dest: TStream);
+var
+ Compression: TfrxCompressionLevel;
+ FileName: String;
+begin
+ if IsFR3File then
+ begin
+ Compression := gzMax;
+ FileName := '1.fr3';
+ end
+ else
+ begin
+ Compression := gzDefault;
+ FileName := '1.fp3';
+ end;
+ frxCompressStream(Stream, Dest, Compression, FileName);
+end;
+
+function TfrxGZipCompressor.Decompress(Source: TStream): Boolean;
+var
+ Signature: array[0..1] of Byte;
+begin
+ Source.Read(Signature, 2);
+ Source.Seek(Int64(-2), soFromCurrent);
+ Result := (Signature[0] = $1F) and (Signature[1] = $8B);
+ if Result then
+ frxDecompressStream(Source, Stream);
+ Stream.Position := 0;
+end;
+
+end.
+
diff --git a/LibD28/FMX.frxGlyphSubstitutionClass.pas b/LibD28/FMX.frxGlyphSubstitutionClass.pas
new file mode 100644
index 0000000..5c4519d
--- /dev/null
+++ b/LibD28/FMX.frxGlyphSubstitutionClass.pas
@@ -0,0 +1,164 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Font parser }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Aleksey Mandrykin, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxGlyphSubstitutionClass;
+
+interface uses FMX.TTFHelpers, FMX.frxTrueTypeTable;
+
+ type // Nested Types
+ FeatureRecord = packed record
+ public Feature: Word;
+ public FeatureTag: Cardinal;
+ end;
+
+ GSUB_Header = record
+ public Version: Cardinal;
+ public ScriptList: Word;
+ public FeatureList: Word;
+ public LookupList: Word;
+ end;
+
+ LangSysRecord = packed record
+ public LangSysTag: Cardinal;
+ public LangSys: Word;
+ end;
+
+ LangSysTable = packed record
+ public LookupOrder: Word;
+ public ReqFeatureIndex: Word;
+ public FeatureCount: Word;
+ end;
+
+ ScriptListRecord = packed record
+ public ScriptTag: Cardinal;
+ public ScriptOffset: Word;
+ end;
+
+ ScriptListTable = packed record
+ public CountScripts: Word;
+ end;
+
+ ScriptTable = packed record
+ public DefaultLangSys: Word;
+ public LangSysCount: Word;
+ end;
+
+
+ GlyphSubstitutionClass = class(TrueTypeTable)
+ // Fields
+// strict private gsub_ptr: Pointer;
+ strict private header: GSUB_Header;
+
+ // Methods
+ public constructor Create(src: TrueTypeTable);
+ strict private procedure ChangeEndian;
+ public procedure Load(font: Pointer); override;
+// strict private procedure LoadFeatureList(feature_idx: Cardinal);
+// strict private procedure LoadScriptList;
+ public function Save(font: Pointer; offset: Cardinal): Cardinal; override;
+ end;
+
+implementation
+
+ constructor GlyphSubstitutionClass.Create(src: TrueTypeTable);
+ begin
+ inherited Create(src);
+ end;
+
+ procedure GlyphSubstitutionClass.ChangeEndian;
+ begin
+ self.header.Version := TTF_Helpers.SwapUInt32(self.header.Version);
+ self.header.ScriptList := TTF_Helpers.SwapUInt16(self.header.ScriptList);
+ self.header.LookupList := TTF_Helpers.SwapUInt16(self.header.LookupList);
+ self.header.FeatureList := TTF_Helpers.SwapUInt16(self.header.FeatureList)
+ end;
+
+ procedure GlyphSubstitutionClass.Load(font: Pointer);
+ var
+ gsub: ^GSUB_Header;
+ begin
+ gsub := TTF_Helpers.Increment(font, self.entry.offset);
+ self.header.FeatureList := gsub.FeatureList;
+ self.header.LookupList := gsub.LookupList;
+ self.header.ScriptList := gsub.ScriptList;
+ self.header.Version := gsub.Version;
+ self.ChangeEndian
+ end;
+
+ {
+ procedure GlyphSubstitutionClass.LoadFeatureList(feature_idx: Cardinal);
+ var
+ feature_list_table_ptr: Pointer;
+ feature_count: Word;
+ begin
+ feature_list_table_ptr := TTF_Helpers.Increment(self.gsub_ptr, self.header.FeatureList);
+ feature_count := TTF_Helpers.SwapUInt16((Marshal.PtrToStructure(feature_list_table_ptr, typeof(Word)) as Word));
+ if (feature_idx >= feature_count) then
+ raise Exception.Create('Feature index out of bound');
+ feature_record := (Marshal.PtrToStructure(TTF_Helpers.Increment(feature_list_table_ptr, (2 + ((feature_idx * 6) as Integer))), typeof(FeatureRecord)) as FeatureRecord);
+ FeatureTag := string.Concat(New(array[5] of TObject, ( ( '', (($ff and feature_record.FeatureTag) as Char), (($ff and (feature_record.FeatureTag shr 8)) as Char), (($ff and (feature_record.FeatureTag shr $10)) as Char), (($ff and (feature_record.FeatureTag shr $18)) as Char) ) )))
+ end;
+
+ procedure GlyphSubstitutionClass.LoadScriptList;
+ var
+ lang_sys_rec_ptr: IntPtr;
+ begin
+ script_list_table_ptr := TTF_Helpers.Increment(self.gsub_ptr, self.header.ScriptList);
+ script_list_table := (Marshal.PtrToStructure(script_list_table_ptr, typeof(ScriptListTable)) as ScriptListTable);
+ script_list_table.CountScripts := TTF_Helpers.SwapUInt16(script_list_table.CountScripts);
+ script_record_ptr := TTF_Helpers.Increment(script_list_table_ptr, Marshal.SizeOf(script_list_table));
+ i := 0;
+ while ((i < script_list_table.CountScripts)) do
+ begin
+ script_record := (Marshal.PtrToStructure(script_record_ptr, typeof(ScriptListRecord)) as ScriptListRecord);
+ script_record.ScriptOffset := TTF_Helpers.SwapUInt16(script_record.ScriptOffset);
+ ScriptTag := string.Concat(New(array[5] of TObject, ( ( '', (($ff and script_record.ScriptTag) as Char), (($ff and (script_record.ScriptTag shr 8)) as Char), (($ff and (script_record.ScriptTag shr $10)) as Char), (($ff and (script_record.ScriptTag shr $18)) as Char) ) )));
+ script_table_ptr := TTF_Helpers.Increment(script_list_table_ptr, script_record.ScriptOffset);
+ script_table := (Marshal.PtrToStructure(script_table_ptr, typeof(ScriptTable)) as ScriptTable);
+ script_table.DefaultLangSys := TTF_Helpers.SwapUInt16(script_table.DefaultLangSys);
+ script_table.LangSysCount := TTF_Helpers.SwapUInt16(script_table.LangSysCount);
+ if (script_table.DefaultLangSys <> 0) then
+ begin
+ lang_sys_rec_ptr := TTF_Helpers.Increment(script_table_ptr, script_table.DefaultLangSys);
+ lang_sys_table := (Marshal.PtrToStructure(lang_sys_rec_ptr, typeof(LangSysTable)) as LangSysTable);
+ lang_sys_table.LookupOrder := TTF_Helpers.SwapUInt16(lang_sys_table.LookupOrder);
+ lang_sys_table.ReqFeatureIndex := TTF_Helpers.SwapUInt16(lang_sys_table.ReqFeatureIndex);
+ lang_sys_table.FeatureCount := TTF_Helpers.SwapUInt16(lang_sys_table.FeatureCount);
+ feature_index_ptr := TTF_Helpers.Increment(lang_sys_rec_ptr, Marshal.SizeOf(lang_sys_table));
+ k := 0;
+ while ((k < lang_sys_table.FeatureCount)) do
+ begin
+ feature_idx := TTF_Helpers.SwapUInt16((Marshal.PtrToStructure(feature_index_ptr, typeof(Word)) as Word));
+ self.LoadFeatureList(feature_idx);
+ feature_index_ptr := TTF_Helpers.Increment(feature_index_ptr, 2);
+ inc(k)
+ end
+ end;
+ lang_sys_rec_ptr := TTF_Helpers.Increment(script_table_ptr, Marshal.SizeOf(script_table));
+ j := 0;
+ while ((j < script_table.LangSysCount)) do
+ begin
+ lang_sys_rec := (Marshal.PtrToStructure(lang_sys_rec_ptr, typeof(LangSysRecord)) as LangSysRecord);
+ lang_sys_rec.LangSys := TTF_Helpers.SwapUInt16(lang_sys_rec.LangSys);
+ LangSysTag := string.Concat(New(array[5] of TObject, ( ( '', (($ff and lang_sys_rec.LangSysTag) as Char), (($ff and (lang_sys_rec.LangSysTag shr 8)) as Char), (($ff and (lang_sys_rec.LangSysTag shr $10)) as Char), (($ff and (lang_sys_rec.LangSysTag shr $18)) as Char) ) )));
+ lang_sys_rec_ptr := TTF_Helpers.Increment(lang_sys_rec_ptr, Marshal.SizeOf(lang_sys_rec));
+ inc(j)
+ end;
+ script_record_ptr := TTF_Helpers.Increment(script_record_ptr, Marshal.SizeOf(script_record));
+ inc(i)
+ end
+ end;
+}
+ function GlyphSubstitutionClass.Save(font: Pointer; offset: Cardinal): Cardinal;
+ begin
+ Result := inherited Save(font, offset)
+ end;
+end.
diff --git a/LibD28/FMX.frxGlyphTableClass.pas b/LibD28/FMX.frxGlyphTableClass.pas
new file mode 100644
index 0000000..4c8008a
--- /dev/null
+++ b/LibD28/FMX.frxGlyphTableClass.pas
@@ -0,0 +1,334 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Font parser }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Aleksey Mandrykin, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxGlyphTableClass;
+{$HINTS OFF}
+interface uses FMX.TTFHelpers, System.Classes, FMX.frxTrueTypeTable;
+
+ type // Nested Types
+ TIntegerList = TList;
+ CompositeFlags = (ARG_1_AND_2_ARE_WORDS=1, ARGS_ARE_XY_VALUES=2, MORE_COMPONENTS=$20, OVERLAP_COMPOUND=$400, RESERVED=$10, ROUND_XY_TO_GRID=4, SCALED_COMPONENT_OFFSET=$800, UNSCALED_COMPONENT_OFFSET=$10000, USE_MY_METRICS=$200, WE_HAVE_A_SCALE=8, WE_HAVE_A_TWO_BY_TWO=$80, WE_HAVE_AN_X_AND_Y_SCALE=$40, WE_HAVE_INSTRUCTIONS=$100);
+ GlyphFlags = (ON_CURVE=1, REP=8, X_POSITIVE=$10, X_SAME=$10, X_SHORT=2, Y_POSITIVE=$20, Y_SAME=$20, Y_SHORT=4);
+
+ CompositeGlyphHeader = packed record
+ public flags: Word;
+ public glyphIndex: Word;
+ end;
+ GlyphHeader = packed record
+ public numberOfContours: Smallint;
+ public xMin: Smallint;
+ public yMin: Smallint;
+ public xMax: Smallint;
+ public yMax: Smallint;
+ end;
+ GlyphTableClass = class(TrueTypeTable)
+ strict private glyph_table_ptr: Pointer;
+
+ // Methods
+ public constructor Create(src: TrueTypeTable);
+ {
+ strict private procedure AddSpline(path: GraphicsPath; pntStart: PointF; pntB: PointF; pntEnd: PointF; position: Point);
+ private function GetGlyph(glyph_offset: Integer; glyph_data_size: Integer; font_rsize: Single; position: Point; [Out] var gheader: GlyphHeader): GraphicsPath;
+ }
+ public function CheckGlyph(glyph_offset: Integer; glyph_size: Integer): TIntegerList;
+ private function GetGlyphHeader(glyph_offset: Integer): GlyphHeader;
+ public procedure Load(font: Pointer); override;
+ strict private function ReadRawByte(ptr: Pointer; var val: Byte): Pointer;
+ end;
+
+ GlyphPoint = class
+ // Properties
+// public property Point: TPointF read get_Point;
+
+ // Fields
+ public end_of_contour: boolean;
+ public on_curve: boolean;
+ public x: Single;
+ public y: Single;
+ end;
+
+implementation
+
+//function GlyphPoint.get_Point: TPointF;
+//begin
+// Result := PointF(x, y);
+//end;
+
+
+// Methods
+ constructor GlyphTableClass.Create(src: TrueTypeTable);
+ begin
+ inherited Create(src);
+ end;
+{
+ procedure GlyphTableClass.AddSpline(path: GraphicsPath; pntStart: PointF; pntB: PointF; pntEnd: PointF; position: Point);
+ begin
+ pnt1 := pntStart;
+ inc(pnt1.X, (0.6666667 * (pntB.X - pntStart.X)));
+ inc(pnt1.Y, (0.6666667 * (pntB.Y - pntStart.Y)));
+ pnt2 := pntB;
+ inc(pnt2.X, ((pntEnd.X - pntB.X) div 3));
+ inc(pnt2.Y, ((pntEnd.Y - pntB.Y) div 3));
+ path.AddBezier(pntStart, pnt1, pnt2, pntEnd)
+ end;
+}
+ function GlyphTableClass.CheckGlyph(glyph_offset: Integer; glyph_size: Integer): TIntegerlist;
+ var
+ gheader: GlyphHeader;
+ pcgh: ^CompositeGlyphHeader;
+ cgh: CompositeGlyphHeader;
+ CompositeIndexes: TIntegerlist;
+ glyph_ptr: Pointer;
+ composite_header_ptr: Pointer;
+ num_instr: Integer;
+ pword: ^Word;
+ begin
+ CompositeIndexes := TIntegerlist.Create;
+ gheader := self.GetGlyphHeader(glyph_offset);
+
+ glyph_ptr := TTF_Helpers.Increment(self.glyph_table_ptr, glyph_offset);
+ if (gheader.numberOfContours < 0) then
+ begin
+ composite_header_ptr := TTF_Helpers.Increment(glyph_ptr, SizeOf(GlyphHeader));
+ repeat
+ pcgh := composite_header_ptr;
+ cgh.flags := TTF_Helpers.SwapUInt16(pcgh.flags);
+ cgh.glyphIndex := TTF_Helpers.SwapUInt16(pcgh.glyphIndex);
+ CompositeIndexes.Add( Pointer(cgh.glyphIndex) );
+ // Skip
+ composite_header_ptr := TTF_Helpers.Increment(composite_header_ptr, SizeOf(CompositeGlyphHeader));
+ if ((cgh.flags and 1) <> 0) then
+ composite_header_ptr := TTF_Helpers.Increment(composite_header_ptr, 4)
+ else
+ composite_header_ptr := TTF_Helpers.Increment(composite_header_ptr, 2);
+ if ((cgh.flags and 8) <> 0) then
+ composite_header_ptr := TTF_Helpers.Increment(composite_header_ptr, 2)
+ else
+ if ((cgh.flags and $40) <> 0) then
+ composite_header_ptr := TTF_Helpers.Increment(composite_header_ptr, 4)
+ else
+ if ((cgh.flags and $80) <> 0) then
+ composite_header_ptr := TTF_Helpers.Increment(composite_header_ptr, 8)
+ until ((cgh.flags and $20) = 0);
+
+ if ((cgh.flags and $100) <> 0) then
+ begin
+ pword := composite_header_ptr;
+ num_instr := TTF_Helpers.SwapUInt16( pword^ );
+ composite_header_ptr := TTF_Helpers.Increment(composite_header_ptr, (2 + num_instr))
+ end
+ end;
+ Result := CompositeIndexes;
+ exit
+ end;
+{
+ function GlyphTableClass.GetGlyph(glyph_offset: Integer; glyph_data_size: Integer; font_rsize: Single; position: Point; [Out] var gheader: GlyphHeader): GraphicsPath;
+ var
+ i: Integer;
+ val: Byte;
+ sign: boolean;
+ &end: PointF;
+ next: PointF;
+ implied: PointF;
+ next_on_curve: boolean;
+ begin
+ glyph_ptr := TTF_Helpers.Increment(self.glyph_table_ptr, glyph_offset);
+ gheader := (Marshal.PtrToStructure(glyph_ptr, typeof(GlyphHeader)) as GlyphHeader);
+ gheader.numberOfContours := TTF_Helpers.SwapInt16(gheader.numberOfContours);
+ gheader.xMax := TTF_Helpers.SwapInt16(gheader.xMax);
+ gheader.yMax := TTF_Helpers.SwapInt16(gheader.yMax);
+ gheader.xMin := TTF_Helpers.SwapInt16(gheader.xMin);
+ gheader.yMin := TTF_Helpers.SwapInt16(gheader.yMin);
+ endPtsOfContours := New(array[gheader.numberOfContours] of Word);
+ ptr := TTF_Helpers.Increment(glyph_ptr, Marshal.SizeOf((gheader as GlyphHeader)));
+ i := 0;
+ while ((i < endPtsOfContours.Length)) do
+ begin
+ endPtsOfContours[i] := TTF_Helpers.SwapUInt16((Marshal.PtrToStructure(ptr, typeof(Word)) as Word));
+ ptr := TTF_Helpers.Increment(ptr, 2);
+ inc(i)
+ end;
+ instructions_count := TTF_Helpers.SwapUInt16((Marshal.PtrToStructure(ptr, typeof(Word)) as Word));
+ ptr := TTF_Helpers.Increment(ptr, 2);
+ instructions := New(array[instructions_count] of Byte);
+ Marshal.Copy(ptr, instructions, 0, instructions.Length);
+ ptr := TTF_Helpers.Increment(ptr, instructions.Length);
+ number_of_points := (endPtsOfContours[(endPtsOfContours.Length - 1)] + 1);
+ flags := New(array[number_of_points] of Byte);
+ points := New(array[number_of_points] of GlyphPoint);
+ repeatCount := 0;
+ repeatFlag := 0;
+ i := 0;
+ while ((i < number_of_points)) do
+ begin
+ if (repeatCount > 0) then
+ begin
+ flags[i] := repeatFlag;
+ repeatCount := ((repeatCount - 1) as Byte)
+ end
+ else
+ begin
+ ptr := self.ReadRawByte(ptr, @(flags[i]));
+ if ((flags[i] and 8) <> 0) then
+ begin
+ ptr := self.ReadRawByte(ptr, @(repeatCount));
+ repeatFlag := flags[i]
+ end
+ end;
+ points[i] := GlyphPoint.Create;
+ points[i].on_curve := ((flags[i] and 1) <> 0);
+ inc(i)
+ end;
+ i := 0;
+ while ((i < endPtsOfContours.Length)) do
+ begin
+ points[endPtsOfContours[i]].end_of_contour := true;
+ inc(i)
+ end;
+ last := 0;
+ i := 0;
+ while ((i < number_of_points)) do
+ begin
+ sign := ((flags[i] and $10) <> 0);
+ if ((flags[i] and 2) <> 0) then
+ begin
+ val := Marshal.ReadByte(ptr);
+ ptr := TTF_Helpers.Increment(ptr, 1);
+ last := ((last + } {pseudo} {(if sign then (val as Smallint) else (-val as Smallint))) as Smallint)
+ end
+ else
+ if (not sign) then
+ begin
+ last := ((last + TTF_Helpers.SwapInt16(Marshal.ReadInt16(ptr))) as Smallint);
+ ptr := TTF_Helpers.Increment(ptr, 2)
+ end;
+ points[i].x := ((last as Single) div font_rsize);
+ inc(i)
+ end;
+ last := 0;
+ i := 0;
+ while ((i < number_of_points)) do
+ begin
+ sign := ((flags[i] and $20) <> 0);
+ if ((flags[i] and 4) <> 0) then
+ begin
+ val := Marshal.ReadByte(ptr);
+ ptr := TTF_Helpers.Increment(ptr, 1);
+ last := ((last + }{pseudo}{ (if sign then (val as Smallint) else (-val as Smallint))) as Smallint)
+ end
+ else
+ if (not sign) then
+ begin
+ last := ((last + TTF_Helpers.SwapInt16(Marshal.ReadInt16(ptr))) as Smallint);
+ ptr := TTF_Helpers.Increment(ptr, 2)
+ end;
+ points[i].y := ((last as Single) div font_rsize);
+ inc(i)
+ end;
+ start_new_contour := true;
+ idx := 0;
+ path := GraphicsPath.Create(FillMode.Winding);
+ first_point := points[idx];
+ start_new_contour := true;
+ beg := PointF.Create((points[0].Point.X + position.X), (position.Y - points[0].Point.Y));
+ first := beg;
+ idx := 0;
+ while ((idx < points.Length)) do
+ begin
+ curent_on_curve := points[idx].on_curve;
+ if ((idx + 1) < points.Length) then
+ begin
+ next := PointF.Create((points[(idx + 1)].Point.X + position.X), (position.Y - points[(idx + 1)].Point.Y));
+ next_on_curve := points[(idx + 1)].on_curve
+ end
+ else
+ begin
+ next := PointF.Create((points[0].Point.X + position.X), (position.Y - points[0].Point.Y));
+ next_on_curve := points[0].on_curve
+ end;
+ if (start_new_contour) then
+ begin
+ path.StartFigure;
+ first := beg;
+ start_new_contour := false
+ end;
+ if (points[idx].end_of_contour) then
+ begin
+ start_new_contour := true;
+ implied := PointF.Create((points[idx].Point.X + position.X), (position.Y - points[idx].Point.Y));
+ end := first;
+ if (curent_on_curve) then
+ path.AddLine(beg, end)
+ else
+ self.AddSpline(path, beg, implied, end, position);
+ beg := next
+ end
+ else
+ if (curent_on_curve) then
+ if (next_on_curve) then
+ begin
+ end := next;
+ path.AddLine(beg, end);
+ beg := end
+ end
+ else
+ begin
+ implied := PointF.Create((points[idx].Point.X + position.X), (position.Y - points[idx].Point.Y));
+ if (next_on_curve) then
+ begin
+ end := next;
+ self.AddSpline(path, beg, implied, end, position);
+ beg := end
+ end
+ else
+ begin
+ X := ((position.X + ((points[(idx + 1)].x - points[idx].x) div 2)) + points[idx].x);
+ Y := (position.Y - (((points[(idx + 1)].y - points[idx].y) div 2) + points[idx].y));
+ end := PointF.Create(X, Y);
+ self.AddSpline(path, beg, implied, end, position);
+ beg := end
+ end
+ end;
+ inc(idx)
+ end;
+ begin
+ Result := path;
+ exit
+ end
+ end;
+}
+ function GlyphTableClass.GetGlyphHeader(glyph_offset: Integer): GlyphHeader;
+ var
+ gheader: ^GlyphHeader;
+ begin
+ gheader := TTF_Helpers.Increment(self.glyph_table_ptr, glyph_offset);
+ Result.numberOfContours := TTF_Helpers.SwapInt16(gheader.numberOfContours);
+ Result.xMax := TTF_Helpers.SwapInt16(gheader.xMax);
+ Result.yMax := TTF_Helpers.SwapInt16(gheader.yMax);
+ Result.xMin := TTF_Helpers.SwapInt16(gheader.xMin);
+ Result.yMin := TTF_Helpers.SwapInt16(gheader.yMin);
+ end;
+
+ procedure GlyphTableClass.Load(font: Pointer);
+ begin
+ self.glyph_table_ptr := TTF_Helpers.Increment(font, self.entry.offset)
+ end;
+
+ function GlyphTableClass.ReadRawByte(ptr: Pointer; var val: Byte): Pointer;
+ var
+ p: ^Byte;
+ begin
+ p := ptr;
+ val := p^;
+ Result := TTF_Helpers.Increment(ptr, 1)
+ end;
+{$HINTS ON}
+end.
diff --git a/LibD28/FMX.frxGradient.pas b/LibD28/FMX.frxGradient.pas
new file mode 100644
index 0000000..5e92d24
--- /dev/null
+++ b/LibD28/FMX.frxGradient.pas
@@ -0,0 +1,333 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Gradient object }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxGradient;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Types, System.UITypes, System.Classes, System.UIConsts, FMX.Types, FMX.frxClass
+, System.Variants
+{$IFDEF DELPHI18}
+ ,FMX.Controls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases
+{$ENDIF};
+
+type
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxGradientObject = class(TComponent); // fake component
+
+ TfrxGradientStyle = (gsHorizontal, gsVertical, gsElliptic, gsRectangle,
+ gsVertCenter, gsHorizCenter);
+
+ TfrxGradientView = class(TfrxView)
+ private
+ FBeginColor: TAlphaColor;
+ FEndColor: TAlphaColor;
+ FStyle: TfrxGradientStyle;
+ procedure DrawGradient(X, Y, X1, Y1: Integer);
+ function GetColor: TAlphaColor;
+ procedure SetColor(const Value: TAlphaColor);
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ class function GetDescription: String; override;
+ published
+ property BeginColor: TAlphaColor read FBeginColor write FBeginColor default claWhite;
+ property EndColor: TAlphaColor read FEndColor write FEndColor default claGray;
+ property Style: TfrxGradientStyle read FStyle write FStyle;
+ property Frame;
+ property Color: TAlphaColor read GetColor write SetColor;
+ end;
+
+
+implementation
+
+uses System.Math, FMX.frxGradientRTTI, FMX.frxDsgnIntf, FMX.frxRes;
+
+
+constructor TfrxGradientView.Create(AOwner: TComponent);
+begin
+ inherited;
+ FBeginColor := claWhite;
+ FEndColor := claGray;
+end;
+
+class function TfrxGradientView.GetDescription: String;
+begin
+ Result := frxResources.Get('obGrad');
+end;
+
+function MulDiv(nNumber, nNumerator, nDenominator: Single): Single; overload; inline;
+begin
+ Result := (nNumber * nNumerator) / nDenominator;
+end;
+
+function MulDiv(nNumber, nNumerator, nDenominator: Double): Double; overload; inline;
+begin
+ Result := (nNumber * nNumerator) / nDenominator;
+end;
+
+function MulDiv(nNumber, nNumerator, nDenominator: Integer): Integer; overload; inline;
+begin
+ Result := (nNumber * nNumerator) div nDenominator;
+end;
+
+function RGB(r, g, b: Byte): TAlphaColor;
+begin
+ Result := (r or (g shl 8) or (b shl 16)) or $FF000000;
+end;
+
+
+procedure TfrxGradientView.DrawGradient(X, Y, X1, Y1: Integer);
+var
+ FromR, FromG, FromB: Cardinal;
+ DiffR, DiffG, DiffB: Integer;
+ ox, oy, dx, dy: Integer;
+
+ procedure DoHorizontal(fr, fg, fb, dr, dg, db: Integer);
+ var
+ ColorRect: TRectF;
+ I: Integer;
+ R, G, B: Byte;
+ begin
+ ColorRect.Top := oy;
+ ColorRect.Bottom := oy + dy;
+ for I := 0 to 255 do
+ begin
+ ColorRect.Left := MulDiv (I, dx, 256) + ox;
+ ColorRect.Right := MulDiv (I + 1, dx, 256) + ox;
+ R := fr + MulDiv(I, dr, 255);
+ G := fg + MulDiv(I, dg, 255);
+ B := fb + MulDiv(I, db, 255);
+ FCanvas.Fill.Color := RGB(R, G, B);
+ FCanvas.FillRect(ColorRect, 0, 0, AllCorners, 1, TCornerType.ctBevel);
+ end;
+ end;
+
+ procedure DoVertical(fr, fg, fb, dr, dg, db: Integer);
+ var
+ ColorRect: TRectF;
+ I: Integer;
+ R, G, B: Byte;
+ begin
+ ColorRect.Left := ox;
+ ColorRect.Right := ox + dx;
+ for I := 0 to 255 do
+ begin
+ ColorRect.Top := MulDiv (I, dy, 256) + oy;
+ ColorRect.Bottom := MulDiv (I + 1, dy, 256) + oy;
+ R := fr + MulDiv(I, dr, 255);
+ G := fg + MulDiv(I, dg, 255);
+ B := fb + MulDiv(I, db, 255);
+ FCanvas.Fill.Color := RGB(R, G, B);
+ FCanvas.FillRect(ColorRect, 0, 0, AllCorners, 1, TCornerType.ctBevel);
+ end;
+ end;
+
+ procedure DoElliptic(fr, fg, fb, dr, dg, db: Integer);
+ var
+ I: Integer;
+ R, G, B: Byte;
+ Pw, Ph: Double;
+ x1, y1, x2, y2: Double;
+ bmp: TBitmap;
+ begin
+ bmp := TBitmap.Create(dx, dy);
+ //bmp.Width := dx;
+ //bmp.Height := dy;
+// bmp.Canvas.Stroke.Kind := TBrushKind.;
+
+ x1 := 0 - (dx / 4);
+ x2 := dx + (dx / 4);
+ y1 := 0 - (dy / 4);
+ y2 := dy + (dy / 4);
+ Pw := ((dx / 4) + (dx / 2)) / 155;
+ Ph := ((dy / 4) + (dy / 2)) / 155;
+ for I := 0 to 155 do
+ begin
+ x1 := x1 + Pw;
+ x2 := X2 - Pw;
+ y1 := y1 + Ph;
+ y2 := y2 - Ph;
+ R := fr + MulDiv(I, dr, 155);
+ G := fg + MulDiv(I, dg, 155);
+ B := fb + MulDiv(I, db, 155);
+ bmp.Canvas.Fill.Color := R or (G shl 8) or (b shl 16);
+ bmp.Canvas.FillEllipse(RectF(Trunc(x1), Trunc(y1), Trunc(x2), Trunc(y2)), 1);
+ end;
+
+// FCanvas.DrawBitmap(ox, oy, bmp);
+ FCanvas.DrawBitmap(bmp, RectF(0, 0, dx, dy), RectF(ox, oy, ox + dx, oy + dy), 1);
+ bmp.Free;
+ end;
+
+ procedure DoRectangle(fr, fg, fb, dr, dg, db: Integer);
+ var
+ I: Integer;
+ R, G, B: Byte;
+ Pw, Ph: Real;
+ x1, y1, x2, y2: Double;
+ begin
+ //FCanvas.Pen.Style := psClear;
+ //FCanvas.Pen.Mode := pmCopy;
+ x1 := 0 + ox;
+ x2 := ox + dx;
+ y1 := 0 + oy;
+ y2 := oy + dy;
+ Pw := (dx / 2) / 255;
+ Ph := (dy / 2) / 255;
+ for I := 0 to 255 do
+ begin
+ x1 := x1 + Pw;
+ x2 := X2 - Pw;
+ y1 := y1 + Ph;
+ y2 := y2 - Ph;
+ R := fr + MulDiv(I, dr, 255);
+ G := fg + MulDiv(I, dg, 255);
+ B := fb + MulDiv(I, db, 255);
+ FCanvas.Fill.Color := RGB(R, G, B);
+
+ FCanvas.FillRect(RectF(Integer(Trunc(x1)), Integer(Trunc(y1)), Integer(Trunc(x2)), Integer(Trunc(y2))), 0, 0, AllCorners, 1, TCornerType.ctBevel);
+ end;
+ //FCanvas.Pen.Style := psSolid;
+ end;
+
+ procedure DoVertCenter(fr, fg, fb, dr, dg, db: Integer);
+ var
+ ColorRect: TRectF;
+ I: Integer;
+ R, G, B: Byte;
+ Haf: Integer;
+ begin
+ Haf := dy Div 2;
+ ColorRect.Left := 0 + ox;
+ ColorRect.Right := ox + dx;
+ for I := 0 to Haf do
+ begin
+ ColorRect.Top := MulDiv(I, Haf, Haf) + oy;
+ ColorRect.Bottom := MulDiv(I + 1, Haf, Haf) + oy;
+ R := fr + MulDiv(I, dr, Haf);
+ G := fg + MulDiv(I, dg, Haf);
+ B := fb + MulDiv(I, db, Haf);
+ FCanvas.Fill.Color := RGB(R, G, B);
+ FCanvas.FillRect(ColorRect, 0, 0, AllCorners, 1, TCornerType.ctBevel);
+ ColorRect.Top := dy - (MulDiv (I, Haf, Haf)) + oy;
+ ColorRect.Bottom := dy - (MulDiv (I + 1, Haf, Haf)) + oy;
+ FCanvas.FillRect(ColorRect, 0, 0, AllCorners, 1, TCornerType.ctBevel);
+ end;
+ end;
+
+ procedure DoHorizCenter(fr, fg, fb, dr, dg, db: Integer);
+ var
+ ColorRect: TRectF;
+ I: Integer;
+ R, G, B: Byte;
+ Haf: Integer;
+ begin
+ Haf := dx Div 2;
+ ColorRect.Top := 0 + oy;
+ ColorRect.Bottom := oy + dy;
+ for I := 0 to Haf do
+ begin
+ ColorRect.Left := MulDiv(I, Haf, Haf) + ox;
+ ColorRect.Right := MulDiv(I + 1, Haf, Haf) + ox;
+ R := fr + MulDiv(I, dr, Haf);
+ G := fg + MulDiv(I, dg, Haf);
+ B := fb + MulDiv(I, db, Haf);
+ FCanvas.Fill.Color := RGB(R, G, B);
+ FCanvas.FillRect(ColorRect, 0, 0, AllCorners, 1, TCornerType.ctBevel);
+ ColorRect.Left := dx - (MulDiv (I, Haf, Haf)) + ox;
+ ColorRect.Right := dx - (MulDiv (I + 1, Haf, Haf)) + ox;
+ FCanvas.FillRect(ColorRect, 0, 0, AllCorners, 1, TCornerType.ctBevel);
+ end;
+ end;
+
+begin
+ ox := X;
+ oy := Y;
+ dx := X1 - X;
+ dy := Y1 - Y;
+ FromR := FBeginColor and $000000ff;
+ FromG := (FBeginColor shr 8) and $000000ff;
+ FromB := (FBeginColor shr 16) and $000000ff;
+ DiffR := (FEndColor and $000000ff) - FromR;
+ DiffG := ((FEndColor shr 8) and $000000ff) - FromG;
+ DiffB := ((FEndColor shr 16) and $000000ff) - FromB;
+
+ case FStyle of
+ gsHorizontal:
+ DoHorizontal(FromR, FromG, FromB, DiffR, DiffG, DiffB);
+ gsVertical:
+ DoVertical(FromR, FromG, FromB, DiffR, DiffG, DiffB);
+ gsElliptic:
+ DoElliptic(FromR, FromG, FromB, DiffR, DiffG, DiffB);
+ gsRectangle:
+ DoRectangle(FromR, FromG, FromB, DiffR, DiffG, DiffB);
+ gsVertCenter:
+ DoVertCenter(FromR, FromG, FromB, DiffR, DiffG, DiffB);
+ gsHorizCenter:
+ DoHorizCenter(FromR, FromG, FromB, DiffR, DiffG, DiffB);
+ end;
+end;
+
+procedure TfrxGradientView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+begin
+ BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+ DrawGradient(FX, FY, FX1, FY1);
+ DrawFrame;
+end;
+
+function TfrxGradientView.GetColor: TAlphaColor;
+var
+ R, G, B: Byte;
+ FromR, FromG, FromB: Cardinal;
+ DiffR, DiffG, DiffB: Integer;
+begin
+ FromR := FBeginColor and $000000ff;
+ FromG := (FBeginColor shr 8) and $000000ff;
+ FromB := (FBeginColor shr 16) and $000000ff;
+ DiffR := (FEndColor and $000000ff) - FromR;
+ DiffG := ((FEndColor shr 8) and $000000ff) - FromG;
+ DiffB := ((FEndColor shr 16) and $000000ff) - FromB;
+ R := FromR + Cardinal(MulDiv(127, DiffR, 255));
+ G := FromG + Cardinal(MulDiv(127, DiffG, 255));
+ B := FromB + Cardinal(MulDiv(127, DiffB, 255));
+ result := RGB(R, G, B);
+end;
+
+procedure TfrxGradientView.SetColor(const Value: TAlphaColor);
+begin
+ inherited Color := value;
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxGradientObject, TFmxObject);
+ frxObjects.RegisterObject1(TfrxGradientView, nil, '', '', 0, 141);
+
+finalization
+ frxObjects.UnRegister(TfrxGradientView);
+
+
+end.
diff --git a/LibD28/FMX.frxGradientRTTI.pas b/LibD28/FMX.frxGradientRTTI.pas
new file mode 100644
index 0000000..6dcbc53
--- /dev/null
+++ b/LibD28/FMX.frxGradientRTTI.pas
@@ -0,0 +1,53 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Gradient RTTI }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxGradientRTTI;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, System.SysUtils, FMX.Forms, FMX.fs_iinterpreter, FMX.frxGradient, FMX.frxClassRTTI
+, System.Variants, System.Types;
+
+
+type
+ TFunctions = class(TfsRTTIModule)
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TfrxGradientStyle', 'gsHorizontal, gsVertical, gsElliptic, ' +
+ 'gsRectangle, gsVertCenter, gsHorizCenter');
+ AddClass(TfrxGradientView, 'TfrxView');
+ end;
+end;
+
+
+initialization
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/FMX.frxGraphicUtils.pas b/LibD28/FMX.frxGraphicUtils.pas
new file mode 100644
index 0000000..7a4271a
--- /dev/null
+++ b/LibD28/FMX.frxGraphicUtils.pas
@@ -0,0 +1,1704 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Graphic routines }
+{ }
+{ Copyright (c) 1998-2011 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxGraphicUtils;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, System.UIConsts, System.StrUtils,
+ System.WideStrings, System.Types, System.Variants, System.Generics.Collections,
+ System.Math, FMX.Types, FMX.Forms,
+ FMX.frxFMX, FMX.frxClass
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases
+{$ENDIF};
+
+type
+ TBaseLine = (Normal, Subscript, Superscript);
+
+ TStyleDescriptor = record
+ FontStyle: TFontStyles;
+ Color: TAlphaColor;
+ BaseLine: TBaseLine;
+ end;
+
+ TParagraph = class;
+ TLine = class;
+ TWord = class;
+ TRun = class;
+
+ TSubStyle = (ssNormal, ssSubscript, ssSuperscript);
+
+ TfrxHTMLTag = class(TObject)
+ public
+ Position: Integer;
+ Size: Integer;
+ AddY: Integer;
+ Style: TFontStyles;
+ Color: TAlphaColor;
+ Default: Boolean;
+ Small: Boolean;
+ DontWRAP: Boolean;
+ SubType: TSubStyle;
+ procedure Assign(Tag: TfrxHTMLTag);
+ end;
+
+ TfrxHTMLTags = class(TObject)
+ private
+ FItems: TList;
+ procedure Add(Tag: TfrxHTMLTag);
+ function GetItems(Index: Integer): TfrxHTMLTag;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Clear;
+ function Count: Integer;
+ property Items[Index: Integer]: TfrxHTMLTag read GetItems; default;
+ end;
+
+ TfrxHTMLTagsList = class(TObject)
+ private
+ FAllowTags: Boolean;
+ FAddY: Integer;
+ FColor: Integer;
+ FDefColor: LongInt;
+ FDefSize: Integer;
+ FDefStyle: TFontStyles;
+ FItems: TList;
+ FPosition: Integer;
+ FSize: Integer;
+ FStyle: TFontStyles;
+ FDontWRAP: Boolean;
+ FSubStyle: TSubStyle;
+ procedure NewLine;
+ function Add: TfrxHTMLTag;
+ function GetItems(Index: Integer): TfrxHTMLTags;
+ function GetPrevTag: TfrxHTMLTag;
+ protected
+ procedure Wrap(TagsCount: Integer; AddBreak: Boolean);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Clear;
+ procedure SetDefaults(DefColor: TColor; DefSize: Integer;
+ DefStyle: TFontStyles);
+ procedure ExpandHTMLTags(var s: WideString);
+ function Count: Integer;
+ property AllowTags: Boolean read FAllowTags write FAllowTags;
+ property Items[Index: Integer]: TfrxHTMLTags read GetItems; default;
+ property Position: Integer read FPosition write FPosition;
+ end;
+
+ TAdvancedTextRenderer = class
+ private
+ FParagraphs: TList;
+ FText: String;
+ FCanvas: TCanvas;
+ FFont: TfrxFont;
+ FDisplayRect: TRectF;
+ FHorzAlign: TfrxHAlign;
+ FVertAlign: TfrxVAlign;
+ FLineHeight: Single;
+ FFontLineHeight: Single;
+ FAngle: Integer;
+ FForceJustify: Boolean;
+ FWysiwyg: Boolean;
+ FHtmlTags: Boolean;
+ FWordWrap: Boolean;
+ FRightToLeft: Boolean;
+ FPDFMode: Boolean;
+ FSpaceWidth: Single;
+ FSymbolWidth: Single;
+ FScaleFactor: Single;
+ FFastRender: TfrxFastCanvasLayer;
+ procedure SplitToParagraphs(const text: String);
+ procedure AdjustParagraphLines;
+ public
+ constructor Create(aCanvas: TCanvas; const aText: String; aFont: TfrxFont; rect: TRectF;
+ aHorzAlign: TfrxHAlign; aVertAlign: TfrxVAlign; aLineHeight: Single; aAngle: Integer;
+ aWordWrap: Boolean; aForceJustify: Boolean; aHtmlTags: Boolean; aPdfMode: Boolean; aScaLeFactor: Single);
+ destructor Destroy; override;
+ function CalcWidth: Single;
+ function MeasureTextWidth(const aText: String): Single;
+ function CalcHeight: Single; overload;
+ function CalcHeight(var charsFit: Integer; var style: TStyleDescriptor): Single; overload;
+ function GetTabPosition(pos: Single): Single;
+ procedure Draw;
+ property Paragraphs: TList read FParagraphs;
+ property Canvas: TCanvas read FCanvas;
+ property Font: TfrxFont read FFont;
+ property DisplayRect: TRectF read FDisplayRect;
+ property HorzAlign: TfrxHAlign read FHorzAlign;
+ property VertAlign: TfrxVAlign read FVertAlign;
+ property LineHeight: Single read FLineHeight;
+ property FontLineHeight: Single read FFontLineHeight;
+ property Angle: Integer read FAngle;
+ property ForceJustify: Boolean read FForceJustify;
+ property Wysiwyg: Boolean read FWysiwyg;
+ property HtmlTags: Boolean read FHtmlTags;
+ property WordWrap: Boolean read FWordWrap;
+ property RightToLeft: Boolean read FRightToLeft;
+ property PDFMode: Boolean read FPDFMode;
+ property SpaceWidth: Single read FSpaceWidth;
+ property SymbolWidth: Single read FSymbolWidth;
+ end;
+
+ TParagraph = class
+ private
+ FLines: TList;
+ FRenderer: TAdvancedTextRenderer;
+ FText: String;
+ FOriginalCharIndex: Integer;
+ public
+ constructor Create(const text: String; renderer: TAdvancedTextRenderer; originalCharIndex: Integer);
+ destructor Destroy; override;
+ function IsLast: Boolean;
+ function IsEmpty: Boolean;
+ function WrapLines(style: TStyleDescriptor): TStyleDescriptor;
+ procedure AlignLines(forceJustify: Boolean);
+ procedure Draw;
+ property Lines: TList read FLines;
+ property Renderer: TAdvancedTextRenderer read FRenderer;
+ end;
+
+ TLine = class
+ private
+ FWords: TList;
+ FParagraph: TParagraph;
+ FTop: Single;
+ FWidth: Single;
+ FOriginalCharIndex: Integer;
+ FUnderlines: TList;
+ FStrikeouts: TList;
+ function GetStyle: TStyleDescriptor;
+ function GetRenderer: TAdvancedTextRenderer;
+ function GetLeft: Single;
+ procedure PrepareUnderlines(list: TList; style: TFontStyle);
+ function GetText: String;
+ public
+ constructor Create(paragraph: TParagraph; originalCharIndex: Integer);
+ destructor Destroy; override;
+ function IsLast: Boolean;
+ procedure AlignWords(align: TfrxHAlign);
+ procedure MakeUnderlines;
+ procedure Draw;
+ property Words: TList read FWords;
+ property Left: Single read GetLeft;
+ property Top: Single read FTop write FTop;
+ property Width: Single read FWidth;
+ property Text: String read GetText;
+ property OriginalCharIndex: Integer read FOriginalCharIndex;
+ property Renderer: TAdvancedTextRenderer read GetRenderer;
+ property Style: TStyleDescriptor read GetStyle;
+ property Underlines: TList read FUnderlines;
+ property Strikeouts: TList read FStrikeouts;
+ end;
+
+ TWord = class
+ private
+ FRuns: TList;
+ FLeft: Single;
+ FWidth: Single;
+ FLine: TLine;
+ function GetWidth: Single;
+ function GetTop: Single;
+ function GetRenderer: TAdvancedTextRenderer;
+ function GetText: String;
+ public
+ constructor Create(aLine: TLine);
+ destructor Destroy; override;
+ procedure AdjustRuns;
+ procedure SetLine(aLine: TLine);
+ procedure Draw;
+ property Left: Single read FLeft write FLeft;
+ property Width: Single read GetWidth;
+ property Top: Single read GetTop;
+ property Text: String read GetText;
+ property Renderer: TAdvancedTextRenderer read GetRenderer;
+ property Runs: TList read FRuns;
+ end;
+
+ TTab = class(TWord);
+
+ TRun = class
+ private
+ FText: String;
+ FStyle: TStyleDescriptor;
+ FWord: TWord;
+ FLeft: Single;
+ FWidth: Single;
+ function GetRenderer: TAdvancedTextRenderer;
+ function GetTop: Single;
+ function GetFont(disableUnderlinesStrikeouts: Boolean): TfrxFont; overload;
+ public
+ constructor Create(const aText: String; aStyle: TStyleDescriptor; aWord: TWord);
+ function GetFont: TfrxFont; overload;
+ procedure Draw;
+ property Text: String read FText;
+ property Style: TStyleDescriptor read FStyle;
+ property Renderer: TAdvancedTextRenderer read GetRenderer;
+ property Left: Single read FLeft write FLeft;
+ property Top: Single read GetTop;
+ property Width: Single read FWidth;
+ end;
+
+implementation
+{ TStyleDescriptor routines }
+
+function StyleDescriptor(FontStyle: TFontStyles; Color: TAlphaColor; BaseLine: TBaseLine): TStyleDescriptor;
+begin
+ Result.FontStyle := FontStyle;
+ Result.Color := Color;
+ Result.BaseLine := BaseLine;
+end;
+
+function NullStyle: TStyleDescriptor;
+begin
+ Result.FontStyle := [];
+ Result.Color := 0;
+ Result.BaseLine := TBaseLine.Normal;
+end;
+
+function StyleDescriptorToString(style: TStyleDescriptor): String;
+begin
+ Result := '';
+
+ if fsBold in style.FontStyle then
+ Result := Result + '';
+ if fsItalic in style.FontStyle then
+ Result := Result + '';
+ if fsUnderline in style.FontStyle then
+ Result := Result + '';
+ if fsStrikeout in style.FontStyle then
+ Result := Result + '';
+ if style.BaseLine = TBaseLine.Subscript then
+ Result := Result + '';
+ if style.BaseLine = TBaseLine.Superscript then
+ Result := Result + '';
+
+ Result := Result + '';
+end;
+
+function AdjY(Value, Thickness: Single): Single;
+begin
+ Result := Round(Value);
+ if (Trunc(Thickness) mod 2) = 1 then
+ Result := Result + 0.5;
+end;
+
+{ TfrxHTMLTag }
+
+procedure TfrxHTMLTag.Assign(Tag: TfrxHTMLTag);
+begin
+ Position := Tag.Position;
+ Size := Tag.Size;
+ AddY := Tag.AddY;
+ Style := Tag.Style;
+ Color := Tag.Color;
+ Default := Tag.Default;
+ Small := Tag.Small;
+ Self.SubType := Tag.SubType;
+end;
+
+
+{ TfrxHTMLTags }
+
+constructor TfrxHTMLTags.Create;
+begin
+ FItems := TList.Create;
+end;
+
+destructor TfrxHTMLTags.Destroy;
+begin
+ Clear;
+ FItems.Free;
+ inherited;
+end;
+
+procedure TfrxHTMLTags.Clear;
+var
+ i: Integer;
+begin
+ for i := 0 to FItems.Count - 1 do
+ TfrxHTMLTag(FItems[i]).Free;
+ FItems.Clear;
+end;
+
+function TfrxHTMLTags.GetItems(Index: Integer): TfrxHTMLTag;
+begin
+ Result := TfrxHTMLTag(FItems[Index]);
+end;
+
+function TfrxHTMLTags.Count: Integer;
+begin
+ Result := FItems.Count;
+end;
+
+procedure TfrxHTMLTags.Add(Tag: TfrxHTMLTag);
+begin
+ FItems.Add(Tag);
+end;
+
+
+{ TfrxHTMLTagsList }
+
+constructor TfrxHTMLTagsList.Create;
+begin
+ FItems := TList.Create;
+ FAllowTags := True;
+end;
+
+destructor TfrxHTMLTagsList.Destroy;
+begin
+ Clear;
+ FItems.Free;
+ inherited;
+end;
+
+procedure TfrxHTMLTagsList.Clear;
+var
+ i: Integer;
+begin
+ for i := 0 to FItems.Count - 1 do
+ TfrxHTMLTags(FItems[i]).Free;
+ FItems.Clear;
+end;
+
+procedure TfrxHTMLTagsList.NewLine;
+begin
+ if Count <> 0 then
+ FItems.Add(TfrxHTMLTags.Create);
+end;
+
+procedure TfrxHTMLTagsList.Wrap(TagsCount: Integer; AddBreak: Boolean);
+var
+ i: Integer;
+ Line, OldLine: TfrxHTMLTags;
+ NewTag: TfrxHTMLTag;
+begin
+ OldLine := Items[Count - 1];
+ if OldLine.Count <= TagsCount then
+ Exit;
+
+ NewLine;
+ Line := Items[Count - 1];
+ for i := TagsCount to OldLine.Count - 1 do
+ Line.Add(OldLine[i]);
+ OldLine.FItems.Count := TagsCount;
+ if AddBreak then
+ begin
+ NewTag := TfrxHTMLTag.Create;
+ OldLine.FItems.Add(NewTag);
+ NewTag.Assign(TfrxHTMLTag(OldLine.FItems[TagsCount - 1]))
+ end
+ else if Line[0].Default then
+ Line[0].Assign(OldLine[TagsCount - 1]);
+end;
+
+function TfrxHTMLTagsList.Count: Integer;
+begin
+ Result := FItems.Count;
+end;
+
+function TfrxHTMLTagsList.GetItems(Index: Integer): TfrxHTMLTags;
+begin
+ Result := TfrxHTMLTags(FItems[Index]);
+end;
+
+function TfrxHTMLTagsList.Add: TfrxHTMLTag;
+var
+ i: Integer;
+begin
+ Result := TfrxHTMLTag.Create;
+ i := Count - 1;
+ if i = -1 then
+ begin
+ FItems.Add(TfrxHTMLTags.Create);
+ i := 0;
+ end;
+ Items[i].Add(Result);
+end;
+
+function TfrxHTMLTagsList.GetPrevTag: TfrxHTMLTag;
+var
+ Tags: TfrxHTMLTags;
+begin
+ Result := nil;
+ Tags := Items[Count - 1];
+ if Tags.Count > 1 then
+ Result := Tags[Tags.Count - 2]
+ else if Count > 1 then
+ begin
+ Tags := Items[Count - 2];
+ Result := Tags[Tags.Count - 1];
+ end;
+end;
+
+procedure TfrxHTMLTagsList.SetDefaults(DefColor: TColor; DefSize: Integer;
+ DefStyle: TFontStyles);
+begin
+ FDefColor := DefColor;
+ FDefSize := DefSize;
+ FDefStyle := DefStyle;
+ FAddY := 0;
+ FColor := FDefColor;
+ FSize := FDefSize;
+ FStyle := FDefStyle;
+ FDontWRAP := False;
+ FPosition := 1;
+ Self.FSubStyle := ssNormal;
+ Clear;
+end;
+
+procedure TfrxHTMLTagsList.ExpandHTMLTags(var s: WideString);
+var
+ i, j, j1: Integer;
+ b: Boolean;
+ cl: WideString;
+
+ procedure AddTag;
+ var
+ Tag, PrevTag: TfrxHTMLTag;
+ begin
+ Tag := Add;
+ Tag.Position := FPosition; // this will help us to get position in the original text
+ Tag.Size := FSize;
+ Tag.Style := FStyle;
+ Tag.Color := FColor;
+ Tag.AddY := FAddY;
+ Tag.DontWRAP := FDontWRAP;
+ Tag.SubType := Self.FSubStyle;
+// when "Default" changes, we need to set Font.Style, Size and Color
+ if FAllowTags then
+ begin
+ PrevTag := GetPrevTag;
+ if PrevTag <> nil then
+ Tag.Default := (FStyle = PrevTag.Style) and
+ (Cardinal(FColor) = PrevTag.Color) and
+ (FSize = PrevTag.Size) and (FAddY = PrevTag.AddY) and (FDontWRAP = PrevTag.DontWRAP)
+ else
+ Tag.Default := (FStyle = FDefStyle) and (FColor = FDefColor) and (FSize = FDefSize);
+ end
+ else
+ Tag.Default := True;
+ Tag.Small := FSize <> FDefSize;
+ end;
+
+begin
+ i := 1;
+ if Length(s) = 0 then Exit;
+
+ while i <= Length(s) do
+ begin
+ b := True;
+
+ if FAllowTags then
+ if s[i] = '<' then
+ begin
+
+ // , , tags
+ if (i + 2 <= Length(s)) and (s[i + 2] = '>') then
+ begin
+ case s[i + 1] of
+ 'b','B': FStyle := FStyle + [fsBold];
+ 'i','I': FStyle := FStyle + [fsItalic];
+ 'u','U': FStyle := FStyle + [fsUnderline];
+ else
+ b := False;
+ end;
+ if b then
+ begin
+ System.Delete(s, i, 3);
+ Inc(FPosition, 3);
+ continue;
+ end;
+ end
+
+ // , tags
+ else if (i + 4 <= Length(s)) and (s[i + 4] = '>') then
+ begin
+ if Pos('SUB>', AnsiUpperCase(s)) = i + 1 then
+ begin
+ FSize := Round(FDefSize / 1.5);
+ FAddY := 1;
+ b := True;
+ Self.FSubStyle := ssSubscript;
+ end
+ else if Pos('SUP>', AnsiUpperCase(s)) = i + 1 then
+ begin
+ FSize := Round(FDefSize / 1.5);
+ FAddY := 0;
+ b := True;
+ Self.FSubStyle := ssSuperscript;
+ end;
+ if b then
+ begin
+ System.Delete(s, i, 5);
+ Inc(FPosition, 5);
+ continue;
+ end;
+ end
+
+ // , tags
+ else if (i + 5 <= Length(s)) and (s[i + 5] = '>') then
+ begin
+ if (Pos('/SUB>', AnsiUpperCase(s)) = i + 1) or (Pos('/SUP>', AnsiUpperCase(s)) = i + 1) then
+ begin
+ FSize := FDefSize;
+ FAddY := 0;
+ b := True;
+ Self.FSubStyle := ssNormal;
+ end;
+ if b then
+ begin
+ System.Delete(s, i, 6);
+ Inc(FPosition, 6);
+ continue;
+ end;
+ end
+
+
+ else if (i + 7 <= Length(s)) and ((s[i + 1] = 'n') or (s[i + 1] = 'N')) then
+ begin
+ if Pos('NOWRAP>', AnsiUpperCase(s)) = i + 1 then
+ begin
+ FDontWRAP := True;
+ System.Delete(s, i, 8);
+ Inc(FPosition, 8);
+ continue;
+ end;
+ end
+
+ // tag
+ else if (i + 1 <= Length(s)) and ((s[i + 1] = 's') or (s[i + 1] = 'S')) then
+ begin
+ if Pos('STRIKE>', AnsiUpperCase(s)) = i + 1 then
+ begin
+ FStyle := FStyle + [fsStrikeOut];
+ System.Delete(s, i, 8);
+ Inc(FPosition, 8);
+ continue;
+ end;
+ end
+
+ // , , , , , , tags
+ else if (i + 1 <= Length(s)) and (s[i + 1] = '/') then
+ begin
+ if (i + 3 <= Length(s)) and (s[i + 3] = '>') then
+ begin
+ case s[i + 2] of
+ 'b','B': FStyle := FStyle - [fsBold];
+ 'i','I': FStyle := FStyle - [fsItalic];
+ 'u','U': FStyle := FStyle - [fsUnderline];
+ else
+ b := False;
+ end;
+ if b then
+ begin
+ System.Delete(s, i, 4);
+ Inc(FPosition, 4);
+ continue;
+ end;
+ end
+ else if (Pos('STRIKE>', AnsiUpperCase(s)) = i + 2) then
+ begin
+ FStyle := FStyle - [fsStrikeOut];
+ System.Delete(s, i, 9);
+ Inc(FPosition, 9);
+ continue;
+ end
+ else if (Pos('NOWRAP>', AnsiUpperCase(s)) = i + 2) then
+ begin
+ FDontWRAP := False;
+ System.Delete(s, i, 9);
+ Inc(FPosition, 9);
+ continue;
+ end
+ else if Pos('FONT>', AnsiUpperCase(s)) = i + 2 then
+ begin
+ FColor := FDefColor;
+ System.Delete(s, i, 7);
+ Inc(FPosition, 7);
+ continue;
+ end
+ else if (Pos('SUB>', AnsiUpperCase(s)) = i + 2) or
+ (Pos('SUP>', AnsiUpperCase(s)) = i + 2) then
+ begin
+ FSize := FDefSize;
+ FAddY := 0;
+ System.Delete(s, i, 6);
+ Inc(FPosition, 6);
+ continue;
+ end
+ end
+
+ // tag
+ else if Pos('FONT COLOR', AnsiUpperCase(s)) = i + 1 then
+ begin
+ j := i + 11;
+ while (j <= Length(s)) and (s[j] <> '=') do
+ Inc(j);
+ Inc(j);
+ while (j <= Length(s)) and (s[j] = ' ') do
+ Inc(j);
+ j1 := j;
+ while (j <= Length(s)) and (s[j] <> '>') do
+ Inc(j);
+
+ cl := Copy(s, j1, j - j1);
+ if cl <> '' then
+ begin
+ if (Length(cl) > 3) and (cl[1] = '"') and (cl[2] = '#') and
+ (cl[Length(cl)] = '"') then
+ begin
+ cl := '$' + Copy(cl, 3, Length(cl) - 3);
+ FColor := StrToInt(cl);
+ FColor := (FColor and $000000FF) div 65536 +
+ (FColor and $00FF0000) * 65536 +
+ (FColor and $0000FF00);
+ System.Delete(s, i, j - i + 1);
+ Inc(FPosition, j - i + 1);
+ continue;
+ end
+ else if IdentToAlphaColor('cl' + cl, FColor) then
+ begin
+ System.Delete(s, i, j - i + 1);
+ Inc(FPosition, j - i + 1);
+ continue;
+ end;
+ end;
+ end
+ end;
+
+ AddTag;
+ Inc(i);
+ Inc(FPosition);
+ end;
+
+ if Length(s) = 0 then
+ begin
+ AddTag;
+ s := ' ';
+ end;
+end;
+
+{ TAdvancedTextRenderer }
+
+function TAdvancedTextRenderer.MeasureTextWidth(const aText: String): Single;
+var
+ r: TRectF;
+begin
+ r := RectF(0, 0, 10000, 10000);
+ if FFastRender <> nil then
+ FFastRender.MeasureText(r, aText, False, [], TTextAlign.taLeading, TTextAlign.taLeading)
+ else
+ Canvas.MeasureText(r, aText, False, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ Result := r.Width;
+end;
+
+procedure TAdvancedTextRenderer.SplitToParagraphs(const text: String);
+var
+ style: TStyleDescriptor;
+ lines: TStringDynArray;
+ line: String;
+ i, lineLength, originalCharIndex: Integer;
+ paragraph: TParagraph;
+begin
+ style := StyleDescriptor(Font.Style, Font.Color, TBaseLine.Normal);
+ lines := SplitString(text, #10);
+ originalCharIndex := 0;
+
+ for i := 0 to Length(lines) - 1 do
+ begin
+ line := lines[i];
+ lineLength := Length(line);
+ if (lineLength > 0) and (line[lineLength] = #13) then
+ Delete(line, lineLength, 1);
+
+ paragraph := TParagraph.Create(line, self, originalCharIndex);
+ FParagraphs.Add(paragraph);
+ style := paragraph.WrapLines(style);
+
+ Inc(originalCharIndex, lineLength + 1);
+ end;
+
+ // skip empty paragraphs at the end
+ for i := FParagraphs.Count - 1 downto 0 do
+ begin
+ if FParagraphs[i].IsEmpty then
+ begin
+ FParagraphs[i].Free;
+ FParagraphs.Delete(i);
+ end
+ else
+ break;
+ end;
+end;
+
+procedure TAdvancedTextRenderer.AdjustParagraphLines;
+var
+ i: Integer;
+ height, offsetY: Single;
+ paragraph: TParagraph;
+ line: TLine;
+begin
+ // calculate text height
+ height := 0;
+ for paragraph in Paragraphs do
+ height := height + paragraph.Lines.Count * LineHeight;
+
+ // calculate Y offset
+ offsetY := DisplayRect.Top;
+ if VertAlign = vaCenter then
+ offsetY := offsetY + (DisplayRect.Height - height) / 2
+ else if VertAlign = vaBottom then
+ offsetY := offsetY + (DisplayRect.Height - height) - 1;
+
+ for i := 0 to Paragraphs.Count - 1 do
+ begin
+ paragraph := Paragraphs[i];
+ paragraph.AlignLines((i = Paragraphs.Count - 1) and ForceJustify);
+
+ // adjust line tops
+ for line in paragraph.Lines do
+ begin
+ line.Top := offsetY;
+ line.MakeUnderlines;
+ offsetY := offsetY + LineHeight;
+ end;
+ end;
+end;
+
+procedure TAdvancedTextRenderer.Draw;
+var
+ state: TCanvasSaveState;
+ m, OldM: TMatrix;
+ paragraph: TParagraph;
+begin
+ // set clipping
+ // avoid bug under win platform, after state restore matrix has unexpected values
+ OldM := Canvas.Matrix;
+ State := Canvas.SaveState;
+
+ try
+ { increase bounds for 2 pixels }
+ { increase Top for 1 * Scale (preview or print) pixels for subscripts }
+ Canvas.IntersectClipRect(RectF(DisplayRect.Left, DisplayRect.Top - 1 * FScaleFactor, DisplayRect.Right + 2, DisplayRect.Bottom));
+
+ if Angle <> 0 then
+ begin
+ m := CreateRotationMatrix(-DegToRad(Angle));
+ // offset
+ m.m31 := OldM.m31 + DisplayRect.Left + DisplayRect.Width / 2;
+ m.m32 := OldM.m32 + DisplayRect.Top + DisplayRect.Height / 2;
+ Canvas.SetMatrix(m);
+ end;
+
+ for paragraph in Paragraphs do
+ paragraph.Draw;
+
+ finally
+ // restore clipping
+ Canvas.RestoreState(state);
+ Canvas.SetMatrix(OldM);
+ end;
+end;
+
+function TAdvancedTextRenderer.CalcHeight: Single;
+var
+ charsFit: Integer;
+ style: TStyleDescriptor;
+begin
+ Result := CalcHeight(charsFit, style);
+end;
+
+function TAdvancedTextRenderer.CalcHeight(var charsFit: Integer; var style: TStyleDescriptor): Single;
+var
+ i, j: Integer;
+ height, displayHeight: Single;
+ line: TLine;
+begin
+ charsFit := 0;
+ style := NullStyle;
+ height := 0;
+ displayHeight := DisplayRect.Height;
+ if LineHeight > displayHeight then
+ begin
+ Result := 0;
+ Exit;
+ end;
+
+ for i := 0 to Paragraphs.Count - 1 do
+ begin
+ for j := 0 to Paragraphs[i].Lines.Count - 1 do
+ begin
+ line := Paragraphs[i].Lines[j];
+ height := height + LineHeight;
+ if (charsFit = 0) and (height > displayHeight) then
+ begin
+ charsFit := line.OriginalCharIndex;
+ if HtmlTags then
+ style := line.Style;
+ height := height - LineHeight;
+ break;
+ end;
+ end;
+ if (charsFit <> 0) then break;
+ end;
+
+ if charsFit = 0 then
+ charsFit := Length(FText);
+ Result := height ;
+end;
+
+function TAdvancedTextRenderer.CalcWidth: Single;
+var
+ paragraph: TParagraph;
+ line: TLine;
+ width: Single;
+begin
+ width := 0;
+
+ for paragraph in Paragraphs do
+ for line in paragraph.Lines do
+ begin
+ if width < line.Width then
+ width := line.Width;
+ end;
+
+ Result := width + FSpaceWidth;
+end;
+
+function TAdvancedTextRenderer.GetTabPosition(pos: Single): Single;
+var
+ tabOffset, tabSize: Single;
+ tabPosition: Integer;
+begin
+ tabOffset := 0;
+ tabSize := 64;
+ tabPosition := Trunc((pos - tabOffset) / tabSize);
+ if pos < tabOffset then
+ Result := tabOffset
+ else
+ Result := (tabPosition + 1) * tabSize + tabOffset;
+end;
+
+constructor TAdvancedTextRenderer.Create(aCanvas: TCanvas; const aText: String;
+ aFont: TfrxFont; rect: TRectF; aHorzAlign: TfrxHAlign; aVertAlign: TfrxVAlign;
+ aLineHeight: Single; aAngle: Integer; aWordWrap: Boolean; aForceJustify: Boolean;
+ aHtmlTags: Boolean; aPdfMode: Boolean; aScaLeFactor: Single);
+begin
+ if aCanvas is TfrxFastCanvasLayer then
+ begin
+ FFastRender := TfrxFastCanvasLayer(aCanvas);
+ FCanvas := FFastRender.Canvas;
+ end
+ else
+ FCanvas := aCanvas;
+ FScaleFactor := aScaLeFactor;
+ if SameValue(FScaleFactor, 0, 0.09) then
+ FScaleFactor := 0.1;
+ FParagraphs := TList.Create;
+ FText := aText;
+ FFont := aFont;
+ FDisplayRect := rect;
+ FHorzAlign := aHorzAlign;
+ FVertAlign := aVertAlign;
+ FLineHeight := aLineHeight;
+ FFontLineHeight := aFont.GetHeight(FCanvas) + 2;
+ if FLineHeight = 0 then
+ FLineHeight := FFontLineHeight
+ else
+ FFontLineHeight := FLineHeight;
+ FAngle := aAngle;
+ FWordWrap := aWordWrap;
+ FForceJustify := aForceJustify;
+ FHtmlTags := aHtmlTags;
+ FPDFMode := aPdfMode;
+ aFont.AssignToCanvas(FCanvas);
+{$IFDEF DELPHI25}
+{$IFDEF MSWINDOWS}
+ // workaround for Tokyo - DoRenderLayout now has MeasureString call and calculates one space symbol incorrect
+ FSpaceWidth := Round(MeasureTextWidth(' ') / 5 );
+{$ELSE}
+ FSpaceWidth := MeasureTextWidth(' ');
+{$ENDIF}
+{$ELSE}
+ FSpaceWidth := MeasureTextWidth(' ');
+{$ENDIF}
+ if Canvas.ClassName = 'TCanvasGdiPlus' then
+ FSpaceWidth := FSpaceWidth - FScaleFactor;
+ FSymbolWidth := MeasureTextWidth('W');
+ if Angle <> 0 then
+ begin
+ // shift displayrect
+ FDisplayRect.Left := -rect.Width / 2;
+ FDisplayRect.Top := -rect.Height / 2;
+ FDisplayRect.Right := FDisplayRect.Left + rect.Width;
+ FDisplayRect.Bottom := FDisplayRect.Top + rect.Height;
+
+ // rotate displayrect if angle is 90 or 270
+ if ((Angle >= 90) and (Angle < 180)) or ((Angle >= 270) and (Angle < 360)) then
+ FDisplayRect := RectF(DisplayRect.Top, DisplayRect.Left, DisplayRect.Bottom, DisplayRect.Right);
+ end;
+
+ SplitToParagraphs(aText);
+ AdjustParagraphLines;
+
+ // restore original values
+ FDisplayRect := rect;
+end;
+
+destructor TAdvancedTextRenderer.Destroy;
+var
+ paragraph: TParagraph;
+begin
+ for paragraph in Paragraphs do
+ paragraph.Free;
+ Paragraphs.Free;
+ inherited;
+end;
+
+
+{ TParagraph }
+
+function TParagraph.IsLast: Boolean;
+begin
+ Result := FRenderer.Paragraphs[FRenderer.Paragraphs.Count - 1] = self;
+end;
+
+function TParagraph.IsEmpty: Boolean;
+begin
+ Result := FText = '';
+end;
+
+function TParagraph.WrapLines(style: TStyleDescriptor): TStyleDescriptor;
+var
+ line: TLine;
+ aWord: TWord;
+ text, currentWord, tag, colorName: String;
+ width, WLineWidth: Single;
+ skipSpace, match, isLastWord: Boolean;
+ i, originalCharIndex, istart, iend: Integer;
+ newStyle: TStyleDescriptor;
+begin
+ line := TLine.Create(self, FOriginalCharIndex);
+ FLines.Add(line);
+ aWord := TWord.Create(line);
+ line.Words.Add(aWord);
+ WLineWidth := 0;
+ text := FText;
+ currentWord := '';
+ width := 0;
+ skipSpace := True;
+ originalCharIndex := FOriginalCharIndex;
+ i := 1;
+ while i <= Length(text) do
+ begin
+ if Renderer.HtmlTags and (text[i] = '<') then
+ begin
+ // probably html tag
+ newStyle := style;
+ tag := '';
+ match := False;
+
+ // , ,
+ if i + 3-1 <= Length(text) then
+ begin
+ match := True;
+ tag := LowerCase(Copy(text, i, 3));
+ if tag = '' then
+ newStyle.FontStyle := newStyle.FontStyle + [fsBold]
+ else if tag = '' then
+ newStyle.FontStyle := newStyle.FontStyle + [fsItalic]
+ else if tag = '' then
+ newStyle.FontStyle := newStyle.FontStyle + [fsUnderline]
+ else
+ match := False;
+
+ if match then
+ Inc(i, 3);
+ end;
+
+ // , ,
+ if not match and (i + 4-1 <= Length(text)) and (text[i + 1] = '/') then
+ begin
+ match := True;
+ tag := LowerCase(Copy(text, i, 4));
+ if tag = '' then
+ newStyle.FontStyle := newStyle.FontStyle - [fsBold]
+ else if tag = '' then
+ newStyle.FontStyle := newStyle.FontStyle - [fsItalic]
+ else if tag = '' then
+ newStyle.FontStyle := newStyle.FontStyle - [fsUnderline]
+ else
+ match := False;
+
+ if match then
+ Inc(i, 4);
+ end;
+
+ // ,
+ if not match and (i + 5-1 <= Length(text)) then
+ begin
+ match := True;
+ tag := LowerCase(Copy(text, i, 5));
+ if tag = '' then
+ newStyle.BaseLine := TBaseLine.Subscript
+ else if tag = '' then
+ newStyle.BaseLine := TBaseLine.Superscript
+ else
+ match := False;
+
+ if match then
+ Inc(i, 5);
+ end;
+
+ // ,
+ if not match and (i + 6-1 <= Length(text)) and (text[i + 1] = '/') then
+ begin
+ match := True;
+ tag := LowerCase(Copy(text, i, 6));
+ if (tag = '') or (tag = '') then
+ newStyle.BaseLine := TBaseLine.Normal
+ else
+ match := False;
+
+ if match then
+ Inc(i, 6);
+ end;
+
+ //
+ if not match and (i + 8-1 <= Length(text)) then
+ begin
+ tag := LowerCase(Copy(text, i, 8));
+ if tag = '' then
+ begin
+ newStyle.FontStyle := newStyle.FontStyle + [fsStrikeout];
+ match := True;
+ Inc(i, 8);
+ end;
+ end;
+
+ //
+ if not match and (i + 9-1 <= Length(text)) then
+ begin
+ tag := LowerCase(Copy(text, i, 9));
+ if tag = '' then
+ begin
+ newStyle.FontStyle := newStyle.FontStyle - [fsStrikeout];
+ match := True;
+ Inc(i, 9);
+ end;
+ end;
+
+ // '=') do
+ Inc(istart);
+ Inc(istart);
+ while (istart <= Length(text)) and (text[istart] = ' ') do
+ Inc(istart);
+ iend := istart;
+ while (iend <= Length(text)) and (text[iend] <> '>') do
+ Inc(iend);
+
+ if iend <= Length(text) then
+ begin
+ colorName := Copy(text, istart, iend - istart);
+ if (colorName[1] = '"') and (colorName[Length(colorName)] = '"') then
+ colorName := Copy(colorName, 2, Length(colorName) - 2);
+ newStyle.Color := StringToAlphaColor(colorName);
+ i := iend + 1;
+ match := True;
+ end;
+ end;
+ end;
+
+ //
+ if not match and (i + 7-1 <= Length(text)) then
+ begin
+ tag := LowerCase(Copy(text, i, 7));
+ if tag = '' then
+ begin
+ newStyle.Color := Renderer.Font.Color;
+ match := True;
+ Inc(i, 7);
+ end;
+ end;
+
+ if match then
+ begin
+ // finish the word
+ if currentWord <> '' then
+ aWord.Runs.Add(TRun.Create(currentWord, style, aWord));
+
+ currentWord := '';
+ style := newStyle;
+
+ if i >= Length(text) then
+ begin
+ // check width
+ width := width + aWord.Width + Renderer.SpaceWidth;
+ if width > Trunc(Renderer.DisplayRect.Width - 0.5) then
+ begin
+ // line is too long, make a new line
+ if line.Words.Count > 1 then
+ begin
+ // if line has several words, delete the last word from the current line
+ line.Words.Delete(line.Words.Count - 1);
+ // make new line
+ line := TLine.Create(self, originalCharIndex);
+ // and add word to it
+ line.Words.Add(aWord);
+ aWord.SetLine(line);
+ FLines.Add(line);
+ end;
+ end;
+ end;
+ continue;
+ end;
+ end;
+
+ if (text[i] = ' ') or (text[i] = #9) or (i = Length(text)) or (WLineWidth > 0) then
+ begin
+ // finish the last word
+ isLastWord := i = Length(text);
+ if isLastWord then
+ begin
+ currentWord := currentWord + text[i];
+ skipSpace := False;
+ end;
+
+ if text[i] = #9 then
+ skipSpace := False;
+
+ // space
+ if skipSpace then
+ currentWord := currentWord + text[i]
+ else
+ begin
+ // finish the word
+ if currentWord <> '' then
+ aWord.Runs.Add(TRun.Create(currentWord, style, aWord));
+
+ // check width
+ width := width + aWord.Width + Renderer.SpaceWidth;
+ // we need addition space witdth to avoid exeeds of bounds with different scale
+ if (width > Trunc(Renderer.DisplayRect.Width - 0.5)) or (WLineWidth > 0) then
+ begin
+ WLineWidth := 0;
+ // line is too long, make a new line
+ width := 0;
+ if line.Words.Count > 1 then
+ begin
+ // if line has several words, delete the last word from the current line
+ line.Words.Delete(line.Words.Count - 1);
+ // make new line
+ line := TLine.Create(self, originalCharIndex);
+ // and add word to it
+ line.Words.Add(aWord);
+ aWord.SetLine(line);
+ width := width + aWord.Width + Renderer.SpaceWidth;
+ end
+ else
+ line := TLine.Create(self, FOriginalCharIndex + i + 1);
+ FLines.Add(line);
+ end;
+
+ // TAB symbol
+ if text[i] = #9 then
+ begin
+ if currentWord = '' then
+ line.Words.Delete(line.Words.Count - 1);
+ aWord := TTab.Create(line);
+ line.Words.Add(aWord);
+ // adjust width
+ width := Renderer.GetTabPosition(width);
+ end;
+
+ if not isLastWord then
+ begin
+ aWord := TWord.Create(line);
+ line.Words.Add(aWord);
+ currentWord := '';
+ originalCharIndex := FOriginalCharIndex + i + 1;
+ skipSpace := True;
+ WLineWidth := 0;
+ end;
+ end;
+ end
+ else
+ begin
+ // symbol
+ currentWord := currentWord + text[i];
+ skipSpace := False;
+ // word wrap - do something better than call measure text every time
+ // TODO
+ // use aproximate width first
+ if FRenderer.WordWrap and (Length(currentWord) * renderer.SymbolWidth >=
+ Trunc(renderer.DisplayRect.Width - 0.5)) then
+ begin
+ while (Renderer.MeasureTextWidth(currentWord) >
+ Trunc(renderer.DisplayRect.Width - 0.5)) and (Length(currentWord) > 1) do
+ begin
+ Dec(i);
+ Delete(currentWord, Length(currentWord), 1);
+ WLineWidth := 1; // used as flag
+ end;
+ if (WLineWidth = 1) or (Length(currentWord) = 1) then
+ begin
+ Dec(i, 1);
+ WLineWidth := Renderer.MeasureTextWidth(currentWord);
+ end;
+
+ end;
+ end;
+
+ Inc(i);
+ end;
+
+ Result := style;
+end;
+
+procedure TParagraph.AlignLines(forceJustify: Boolean);
+var
+ i: Integer;
+ align: TfrxHAlign;
+begin
+ for i := 0 to Lines.Count - 1 do
+ begin
+ align := Renderer.HorzAlign;
+ if (align = TfrxHAlign.haBlock) and (i = Lines.Count - 1) and not forceJustify then
+ align := TfrxHAlign.haLeft;
+ Lines[i].AlignWords(align);
+ end;
+end;
+
+procedure TParagraph.Draw;
+var
+ line: TLine;
+begin
+ for line in Lines do
+ line.Draw;
+end;
+
+constructor TParagraph.Create(const text: String; renderer: TAdvancedTextRenderer; originalCharIndex: Integer);
+begin
+ FLines := TList.Create;
+ FText := text;
+ FRenderer := renderer;
+ FOriginalCharIndex := originalCharIndex;
+end;
+
+destructor TParagraph.Destroy;
+var
+ line: TLine;
+begin
+ for line in Lines do
+ line.Free;
+ Lines.Free;
+ inherited;
+end;
+
+
+{ TLine }
+
+function TLine.GetLeft: Single;
+begin
+ if Words.Count > 0 then
+ Result := Words[0].Left
+ else
+ Result := 0;
+end;
+
+function TLine.GetRenderer: TAdvancedTextRenderer;
+begin
+ Result := FParagraph.Renderer;
+end;
+
+function TLine.GetStyle: TStyleDescriptor;
+begin
+ Result := NullStyle;
+ if Words.Count > 0 then
+ if Words[0].Runs.Count > 0 then
+ Result := Words[0].Runs[0].Style;
+end;
+
+function TLine.GetText: String;
+var
+ word: TWord;
+begin
+ Result := '';
+ for word in Words do
+ begin
+ if Result <> '' then
+ Result := Result + ' ';
+ Result := Result + word.Text;
+ end;
+end;
+
+function TLine.IsLast: Boolean;
+begin
+ Result := FParagraph.Lines[FParagraph.Lines.Count - 1] = self;
+end;
+
+procedure TLine.PrepareUnderlines(list: TList; style: TFontStyle);
+var
+ left, right: Single;
+ styleOn: Boolean;
+ aWord: TWord;
+ run: TRun;
+ fnt: TfrxFont;
+begin
+ list.Clear;
+ if Words.Count = 0 then
+ Exit;
+
+ left := 0;
+ right := 0;
+ styleOn := False;
+
+ for aWord in Words do
+ begin
+ for run in aWord.Runs do
+ begin
+ fnt := run.GetFont;
+ if style in fnt.Style then
+ begin
+ if not styleOn then
+ begin
+ styleOn := True;
+ left := run.Left;
+ end;
+ right := run.Left + run.Width;
+ end;
+ if not (style in fnt.Style) and styleOn then
+ begin
+ styleOn := False;
+ list.Add(RectF(left, Top, right, Top));
+ end;
+ fnt.Free;
+ end;
+ end;
+ // close the style
+ if styleOn then
+ list.Add(RectF(left, Top, right, Top));
+end;
+
+procedure TLine.AlignWords(align: TfrxHAlign);
+var
+ left, rectWidth, delta, curDelta: Single;
+ i: Integer;
+ aWord: TWord;
+begin
+ FWidth := 0;
+ left := 0;
+ i := 0;
+ while i < Words.Count do
+ begin
+ aWord := Words[i];
+ aWord.Left := left;
+
+ if aWord is TTab then
+ begin
+ left := Renderer.GetTabPosition(left);
+ // remove tab
+ Words.Delete(i);
+ aWord.Free;
+ Dec(i);
+ end
+ else
+ left := left + aWord.Width + Renderer.SpaceWidth;
+ Inc(i);
+ end;
+
+ FWidth := left;
+ rectWidth := Renderer.DisplayRect.Width;
+ if align = TfrxHAlign.haBlock then
+ begin
+ if Words.Count > 1 then
+ begin
+ delta := (rectWidth - FWidth) / (Words.Count - 1);
+ curDelta := delta;
+ for i := 1 to Words.Count - 1 do
+ begin
+ FWords[i].Left := FWords[i].Left + curDelta;
+ curDelta := curDelta + delta;
+ end;
+ end;
+ end
+ else
+ begin
+ delta := 0;
+ if align = TfrxHAlign.haCenter then
+ delta := (rectWidth - FWidth) / 2
+ else if align = TfrxHAlign.haRight then
+ delta := rectWidth - (FWidth - Renderer.SpaceWidth);
+ for aWord in Words do
+ aWord.Left := aWord.Left + delta;
+ end;
+
+ // adjust X offset
+ for aWord in Words do
+ begin
+ if Renderer.RightToLeft then
+ aWord.Left := Renderer.DisplayRect.Right - aWord.Left
+ else
+ aWord.Left := aWord.Left + Renderer.DisplayRect.Left;
+ aWord.AdjustRuns;
+ if Renderer.RightToLeft and Renderer.PDFMode then
+ aWord.Left := aWord.Left - aWord.Width;
+ end;
+end;
+
+procedure TLine.MakeUnderlines;
+begin
+ PrepareUnderlines(FUnderlines, TFontStyle.fsUnderline);
+ PrepareUnderlines(FStrikeouts, TFontStyle.fsStrikeout);
+end;
+
+procedure TLine.Draw;
+var
+ aWord: TWord;
+ h, w, th: Single;
+ rect: TRectF;
+begin
+ for aWord in Words do
+ aWord.Draw;
+
+ if (Underlines.Count > 0) or (Strikeouts.Count > 0) then
+ begin
+ h := Renderer.FontLineHeight;
+ w := h * 0.1; // to match char X offset
+ // invert offset in case of rtl
+ if Renderer.RightToLeft then
+ w := -w;
+ th := Round(Renderer.Font.Size * 0.1);
+{$IFDEF Delphi25}
+ Renderer.Canvas.Stroke.Thickness := th;
+{$ELSE}
+ Renderer.Canvas.StrokeThickness := th;
+{$ENDIF}
+ Renderer.Canvas.Stroke.Color := Renderer.Font.Color;
+
+ // emulate underline & strikeout
+ for rect in Underlines do
+ Renderer.Canvas.DrawLine(
+ PointF(rect.Left + w, AdjY(rect.Top + h - w, th)), PointF(rect.Right + w, AdjY(rect.Top + h - w, th)), 1);
+
+ h := h / 2;
+ for rect in Strikeouts do
+ Renderer.Canvas.DrawLine(
+ PointF(rect.Left + w, AdjY(rect.Top + h, th)), PointF(rect.Right + w, AdjY(rect.Top + h, th)), 1);
+ end;
+end;
+
+constructor TLine.Create(paragraph: TParagraph; originalCharIndex: Integer);
+begin
+ FWords := TList.Create;
+ FParagraph := paragraph;
+ FOriginalCharIndex := originalCharIndex;
+ FUnderlines := TList.Create;
+ FStrikeouts := TList.Create;
+end;
+
+destructor TLine.Destroy;
+var
+ aWord: TWord;
+begin
+ for aWord in Words do
+ aWord.Free;
+ Words.Free;
+ Underlines.Free;
+ Strikeouts.Free;
+ inherited;
+end;
+
+
+{ TWord }
+
+function TWord.GetText: String;
+var
+ run: TRun;
+begin
+ Result := '';
+ for run in Runs do
+ begin
+ Result := Result + run.Text;
+ end;
+end;
+
+function TWord.GetTop: Single;
+begin
+ Result := FLine.Top;
+end;
+
+function TWord.GetRenderer: TAdvancedTextRenderer;
+begin
+ Result := FLine.Renderer;
+end;
+
+function TWord.GetWidth: Single;
+var
+ run: TRun;
+begin
+ if FWidth = -1 then
+ begin
+ FWidth := 0;
+ for run in Runs do
+ FWidth := FWidth + run.Width;
+ end;
+ Result := FWidth;
+end;
+
+procedure TWord.AdjustRuns;
+var
+ aLeft: Single;
+ run: TRun;
+begin
+ aLeft := Left;
+ for run in Runs do
+ begin
+ run.Left := aLeft;
+
+ if Renderer.RightToLeft then
+ begin
+ aLeft := aLeft - run.Width;
+ if Renderer.PDFMode then
+ run.Left := run.Left - run.Width;
+ end
+ else
+ aLeft := aLeft + run.Width;
+ end;
+end;
+
+procedure TWord.SetLine(aLine: TLine);
+begin
+ FLine := aLine;
+end;
+
+procedure TWord.Draw;
+var
+ run: TRun;
+begin
+ for run in Runs do
+ run.Draw;
+end;
+
+constructor TWord.Create(aLine: TLine);
+begin
+ FRuns := TList.Create;
+ FLine := aLine;
+ FWidth := -1;
+end;
+
+destructor TWord.Destroy;
+var
+ run: TRun;
+begin
+ for run in Runs do
+ run.Free;
+ FRuns.Free;
+ inherited;
+end;
+
+
+{ TRun }
+
+function TRun.GetRenderer: TAdvancedTextRenderer;
+begin
+ Result := FWord.Renderer;
+end;
+
+function TRun.GetTop: Single;
+var
+ baseLine: Single;
+begin
+ baseLine := 0;
+ if Style.BaseLine = TBaseLine.Subscript then
+ baseLine := baseLine + Renderer.FontLineHeight * 0.45
+ else if Style.BaseLine = TBaseLine.Superscript then
+ baseLine := baseLine - Renderer.FontLineHeight * 0.15;
+ Result := FWord.Top + baseLine;
+end;
+
+function TRun.GetFont(disableUnderlinesStrikeouts: Boolean): TfrxFont;
+var
+ fontSize: Single;
+ fontStyle: TFontStyles;
+begin
+ fontSize := Renderer.Font.Size;
+ if Style.BaseLine <> TBaseLine.Normal then
+ fontSize := fontSize * 0.6;
+
+ fontStyle := Style.FontStyle;
+ if disableUnderlinesStrikeouts then
+ fontStyle := fontStyle - [fsUnderline, fsStrikeout];
+
+ Result := TfrxFont.Create;
+ Result.Name := Renderer.Font.Name;
+ Result.Color := Style.Color;
+ Result.Size := fontSize;
+ Result.Style := fontStyle;
+end;
+
+function TRun.GetFont: TfrxFont;
+begin
+ Result := GetFont(false);
+end;
+
+procedure TRun.Draw;
+var
+ font: TfrxFont;
+begin
+ font := GetFont(True);
+ font.AssignToCanvas(Renderer.Canvas);
+
+
+ if Renderer.FFastRender <> nil then
+ Renderer.FFastRender.FillText(RectF(Left, Top, Left + 10000, Top + 10000), FText, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading)
+ else
+ Renderer.Canvas.FillText(RectF(Left, Top, Left + 10000, Top + 10000), FText, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ font.Free;
+end;
+
+constructor TRun.Create(const aText: String; aStyle: TStyleDescriptor; aWord: TWord);
+var
+ font: TfrxFont;
+begin
+ FText := aText;
+ FStyle := aStyle;
+ FWord := aWord;
+
+ font := GetFont;
+ font.AssignToCanvas(Renderer.Canvas);
+ FWidth := Renderer.MeasureTextWidth(aText);
+ font.Free;
+end;
+
+end.
diff --git a/LibD28/FMX.frxHorizontalHeaderClass.pas b/LibD28/FMX.frxHorizontalHeaderClass.pas
new file mode 100644
index 0000000..9a2d7b7
--- /dev/null
+++ b/LibD28/FMX.frxHorizontalHeaderClass.pas
@@ -0,0 +1,133 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Font parser }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Aleksey Mandrykin, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxHorizontalHeaderClass;
+
+interface uses FMX.TTFHelpers, FMX.frxTrueTypeTable;
+
+
+type
+ HorizontalHeader = packed record
+ public Version: Cardinal;
+ public Ascender: Smallint;
+ public Descender: Smallint;
+ public LineGap: Smallint;
+ public advanceWidthMax: Word;
+ public minLeftSideBearing: Smallint;
+ public minRightSideBearing: Smallint;
+ public xMaxExtent: Smallint;
+ public caretSlopeRise: Smallint;
+ public caretSlopeRun: Smallint;
+ public reserved1: Smallint;
+ public reserved2: Smallint;
+ public reserved3: Smallint;
+ public reserved4: Smallint;
+ public reserved5: Smallint;
+ public metricDataFormat: Smallint;
+ public numberOfHMetrics: Word;
+ end;
+
+ HorizontalHeaderClass = class(TrueTypeTable)
+ // Fields
+ strict private horizontal_header: HorizontalHeader;
+
+ // Methods
+ public constructor Create(src: TrueTypeTable);
+ strict private procedure ChangeEndian;
+ public procedure Load(font: Pointer); override;
+ public function Save(font: Pointer; offset: Cardinal): Cardinal; override;
+
+ // Properties
+ public property Ascender: Smallint read horizontal_header.Ascender;
+ public property Descender: Smallint read horizontal_header.Descender;
+ public property LineGap: Smallint read horizontal_header.LineGap;
+ public property MaxWidth: Word read horizontal_header.advanceWidthMax;
+ public property NumberOfHMetrics: Word read horizontal_header.NumberOfHMetrics;
+ end;
+
+implementation
+
+// Methods
+ constructor HorizontalHeaderClass.Create(src: TrueTypeTable);
+ begin
+ inherited Create(src);
+ end;
+
+ procedure HorizontalHeaderClass.ChangeEndian;
+ begin
+ self.horizontal_header.Version := TTF_Helpers.SwapUInt32(self.horizontal_header.Version);
+ self.horizontal_header.Ascender := TTF_Helpers.SwapInt16(self.horizontal_header.Ascender);
+ self.horizontal_header.Descender := TTF_Helpers.SwapInt16(self.horizontal_header.Descender);
+ self.horizontal_header.LineGap := TTF_Helpers.SwapInt16(self.horizontal_header.LineGap);
+ self.horizontal_header.advanceWidthMax := TTF_Helpers.SwapUInt16(self.horizontal_header.advanceWidthMax);
+ self.horizontal_header.minLeftSideBearing := TTF_Helpers.SwapInt16(self.horizontal_header.minLeftSideBearing);
+ self.horizontal_header.minRightSideBearing := TTF_Helpers.SwapInt16(self.horizontal_header.minRightSideBearing);
+ self.horizontal_header.xMaxExtent := TTF_Helpers.SwapInt16(self.horizontal_header.xMaxExtent);
+ self.horizontal_header.caretSlopeRise := TTF_Helpers.SwapInt16(self.horizontal_header.caretSlopeRise);
+ self.horizontal_header.caretSlopeRun := TTF_Helpers.SwapInt16(self.horizontal_header.caretSlopeRun);
+ self.horizontal_header.metricDataFormat := TTF_Helpers.SwapInt16(self.horizontal_header.metricDataFormat);
+ self.horizontal_header.numberOfHMetrics := TTF_Helpers.SwapUInt16(self.horizontal_header.numberOfHMetrics)
+ end;
+
+ procedure HorizontalHeaderClass.Load(font: Pointer);
+ var
+ horizontal_header: ^HorizontalHeader;
+ begin
+ horizontal_header := TTF_Helpers.Increment(font, self.entry.offset);
+ self.horizontal_header.advanceWidthMax := horizontal_header.advanceWidthMax;
+ self.horizontal_header.Ascender := horizontal_header.Ascender;
+ self.horizontal_header.caretSlopeRise := horizontal_header.caretSlopeRise;
+ self.horizontal_header.caretSlopeRun := horizontal_header.caretSlopeRun;
+ self.horizontal_header.Descender := horizontal_header.Descender;
+ self.horizontal_header.LineGap := horizontal_header.LineGap;
+ self.horizontal_header.metricDataFormat := horizontal_header.metricDataFormat;
+ self.horizontal_header.minLeftSideBearing := horizontal_header.minLeftSideBearing;
+ self.horizontal_header.minRightSideBearing := horizontal_header.minRightSideBearing;
+ self.horizontal_header.numberOfHMetrics := horizontal_header.numberOfHMetrics;
+ self.horizontal_header.reserved1 := horizontal_header.reserved1;
+ self.horizontal_header.reserved2 := horizontal_header.reserved2;
+ self.horizontal_header.reserved3 := horizontal_header.reserved3;
+ self.horizontal_header.reserved4 := horizontal_header.reserved4;
+ self.horizontal_header.reserved5 := horizontal_header.reserved5;
+ self.horizontal_header.Version := horizontal_header.Version;
+ self.horizontal_header.xMaxExtent := horizontal_header.xMaxExtent;
+ self.ChangeEndian
+ end;
+
+ function HorizontalHeaderClass.Save(font: Pointer; offset: Cardinal): Cardinal;
+ var
+ horizontal_header: ^HorizontalHeader;
+ begin
+ self.entry.offset := offset;
+ self.ChangeEndian;
+ horizontal_header := TTF_Helpers.Increment(font, self.entry.offset);
+ horizontal_header.advanceWidthMax := self.horizontal_header.advanceWidthMax;
+ horizontal_header.Ascender := self.horizontal_header.Ascender;
+ horizontal_header.caretSlopeRise := self.horizontal_header.caretSlopeRise;
+ horizontal_header.caretSlopeRun := self.horizontal_header.caretSlopeRun;
+ horizontal_header.Descender := self.horizontal_header.Descender;
+ horizontal_header.LineGap := self.horizontal_header.LineGap;
+ horizontal_header.metricDataFormat := self.horizontal_header.metricDataFormat;
+ horizontal_header.minLeftSideBearing := self.horizontal_header.minLeftSideBearing;
+ horizontal_header.minRightSideBearing := self.horizontal_header.minRightSideBearing;
+ horizontal_header.numberOfHMetrics := self.horizontal_header.numberOfHMetrics;
+ horizontal_header.reserved1 := self.horizontal_header.reserved1;
+ horizontal_header.reserved2 := self.horizontal_header.reserved2;
+ horizontal_header.reserved3 := self.horizontal_header.reserved3;
+ horizontal_header.reserved4 := self.horizontal_header.reserved4;
+ horizontal_header.reserved5 := self.horizontal_header.reserved5;
+ horizontal_header.Version := self.horizontal_header.Version;
+ horizontal_header.xMaxExtent := self.horizontal_header.xMaxExtent;
+ self.ChangeEndian;
+ Result := (offset + self.entry.length)
+ end;
+END.
+
diff --git a/LibD28/FMX.frxHorizontalMetrixClass.pas b/LibD28/FMX.frxHorizontalMetrixClass.pas
new file mode 100644
index 0000000..a525153
--- /dev/null
+++ b/LibD28/FMX.frxHorizontalMetrixClass.pas
@@ -0,0 +1,69 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Font parser }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Aleksey Mandrykin, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxHorizontalMetrixClass;
+
+interface uses FMX.TTFHelpers, FMX.frxTrueTypeTable;
+
+type
+ longHorMetric = packed record
+ public advanceWidth: Word;
+ public lsb: Smallint;
+ end;
+
+ THorMetricArray = array of longHorMetric;
+
+ HorizontalMetrixClass = class(TrueTypeTable)
+ strict private MetrixTable: THorMetricArray;
+ public NumberOfMetrics: Word;
+
+ public constructor Create(src: TrueTypeTable);
+ public procedure Load(font: Pointer); override;
+ public function GetItem(index : integer): longHorMetric;
+
+ public property Item[index: Integer]: longHorMetric read GetItem;
+
+
+end;
+
+implementation
+
+ constructor HorizontalMetrixClass.Create(src: TrueTypeTable);
+ begin
+ inherited Create(src);
+ end;
+
+ function HorizontalMetrixClass.GetItem(index : integer): longHorMetric;
+ begin
+ if index >= NumberOfMetrics then
+ Result := MetrixTable[NumberOfMetrics - 1]
+ else
+ Result := MetrixTable[index];
+ end;
+
+ procedure HorizontalMetrixClass.Load(font: Pointer);
+ var
+ h_metrix: ^longHorMetric;
+ i: Integer;
+ begin
+
+ SetLength(self.MetrixTable, self.NumberOfMetrics);
+ h_metrix := TTF_Helpers.Increment(font, self.entry.offset);
+ i := 0;
+ while ((i < self.NumberOfMetrics)) do
+ begin
+ self.MetrixTable[i].advanceWidth := TTF_Helpers.SwapUInt16( h_metrix.advanceWidth );
+ self.MetrixTable[i].lsb := TTF_Helpers.SwapInt16( h_metrix.lsb);
+ Inc(h_metrix); // Check incremet size - must be record size
+ inc(i)
+ end
+ end;
+end.
diff --git a/LibD28/FMX.frxIBXComponents.pas b/LibD28/FMX.frxIBXComponents.pas
new file mode 100644
index 0000000..dd53011
--- /dev/null
+++ b/LibD28/FMX.frxIBXComponents.pas
@@ -0,0 +1,538 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ IBX enduser components }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxIBXComponents;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.Classes, FMX.frxClass, FMX.frxCustomDB,
+{$IFDEF DELPHI20}
+ Data.DB, IBX.IBDatabase, IBX.IBTable, IBX.IBQuery
+{$ELSE}
+ Data.DB, IBDatabase, IBTable, IBQuery
+{$ENDIF}
+, System.Variants, FMX.Types
+{$IFDEF QBUILDER}
+, FMX.fqbClass
+{$ENDIF};
+
+
+type
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxIBXComponents = class(TfrxDBComponents)
+ private
+ FDefaultDatabase: TIBDatabase;
+ FOldComponents: TfrxIBXComponents;
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetDefaultDatabase(Value: TIBDatabase);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function GetDescription: String; override;
+ published
+ property DefaultDatabase: TIBDatabase read FDefaultDatabase write SetDefaultDatabase;
+ end;
+
+ TfrxIBXDatabase = class(TfrxCustomDatabase)
+ private
+ FDatabase: TIBDatabase;
+ FTransaction: TIBTransaction;
+ function GetSQLDialect: Integer;
+ procedure SetSQLDialect(const Value: Integer);
+ protected
+ procedure SetConnected(Value: Boolean); override;
+ procedure SetDatabaseName(const Value: String); override;
+ procedure SetLoginPrompt(Value: Boolean); override;
+ procedure SetParams(Value: TStrings); override;
+ function GetConnected: Boolean; override;
+ function GetDatabaseName: String; override;
+ function GetLoginPrompt: Boolean; override;
+ function GetParams: TStrings; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ procedure SetLogin(const Login, Password: String); override;
+ property Database: TIBDatabase read FDatabase;
+ published
+ property DatabaseName;
+ property LoginPrompt;
+ property Params;
+ property SQLDialect: Integer read GetSQLDialect write SetSQLDialect;
+ property Connected;
+ end;
+
+ TfrxIBXTable = class(TfrxCustomTable)
+ private
+ FDatabase: TfrxIBXDatabase;
+ FTable: TIBTable;
+ procedure SetDatabase(const Value: TfrxIBXDatabase);
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetMaster(const Value: TDataSource); override;
+ procedure SetMasterFields(const Value: String); override;
+ procedure SetIndexFieldNames(const Value: String); override;
+ procedure SetIndexName(const Value: String); override;
+ procedure SetTableName(const Value: String); override;
+ function GetIndexFieldNames: String; override;
+ function GetIndexName: String; override;
+ function GetTableName: String; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor DesignCreate(AOwner: TComponent; Flags: Word); override;
+ class function GetDescription: String; override;
+ procedure BeforeStartReport; override;
+ property Table: TIBTable read FTable;
+ published
+ property Database: TfrxIBXDatabase read FDatabase write SetDatabase;
+ end;
+
+ TfrxIBXQuery = class(TfrxCustomQuery)
+ private
+ FDatabase: TfrxIBXDatabase;
+ FQuery: TIBQuery;
+ procedure SetDatabase(const Value: TfrxIBXDatabase);
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetMaster(const Value: TDataSource); override;
+ procedure SetSQL(Value: TStrings); override;
+ function GetSQL: TStrings; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor DesignCreate(AOwner: TComponent; Flags: Word); override;
+ class function GetDescription: String; override;
+ procedure BeforeStartReport; override;
+ procedure UpdateParams; override;
+{$IFDEF QBUILDER}
+ function QBEngine: TfqbEngine; override;
+{$ENDIF}
+ property Query: TIBQuery read FQuery;
+ published
+ property Database: TfrxIBXDatabase read FDatabase write SetDatabase;
+ end;
+
+{$IFDEF QBUILDER}
+ TfrxEngineIBX = class(TfqbEngine)
+ private
+ FQuery: TIBQuery;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure ReadTableList(ATableList: TStrings); override;
+ procedure ReadFieldList(const ATableName: string; var AFieldList: TfqbFieldList); override;
+ function ResultDataSet: TDataSet; override;
+ procedure SetSQL(const Value: string); override;
+ end;
+{$ENDIF}
+
+var
+ IBXComponents: TfrxIBXComponents;
+
+
+implementation
+
+uses
+ FMX.frxIBXRTTI,
+{$IFNDEF NO_EDITORS}
+ FMX.frxIBXEditor,
+{$ENDIF}
+ FMX.frxDsgnIntf, FMX.frxRes;
+
+
+{ TfrxDBComponents }
+
+constructor TfrxIBXComponents.Create(AOwner: TComponent);
+begin
+ inherited;
+ FOldComponents := IBXComponents;
+ IBXComponents := Self;
+end;
+
+destructor TfrxIBXComponents.Destroy;
+begin
+ if IBXComponents = Self then
+ IBXComponents := FOldComponents;
+ inherited;
+end;
+
+function TfrxIBXComponents.GetDescription: String;
+begin
+ Result := 'IBX';
+end;
+
+procedure TfrxIBXComponents.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited;
+ if (AComponent = FDefaultDatabase) and (Operation = opRemove) then
+ FDefaultDatabase := nil;
+end;
+
+procedure TfrxIBXComponents.SetDefaultDatabase(Value: TIBDatabase);
+begin
+ if (Value <> nil) then
+ Value.FreeNotification(Self);
+
+ if FDefaultDatabase <> nil then
+ FDefaultDatabase.RemoveFreeNotification(Self);
+
+ FDefaultDatabase := Value;
+end;
+
+
+{ TfrxIBXDatabase }
+
+constructor TfrxIBXDatabase.Create(AOwner: TComponent);
+begin
+ inherited;
+ FDatabase := TIBDatabase.Create(nil);
+ FTransaction := TIBTransaction.Create(nil);
+ FDatabase.DefaultTransaction := FTransaction;
+ Component := FDatabase;
+end;
+
+destructor TfrxIBXDatabase.Destroy;
+begin
+ FTransaction.Free;
+ inherited;
+end;
+
+class function TfrxIBXDatabase.GetDescription: String;
+begin
+ Result := frxResources.Get('obIBXDB');
+end;
+
+function TfrxIBXDatabase.GetConnected: Boolean;
+begin
+ Result := FDatabase.Connected;
+end;
+
+function TfrxIBXDatabase.GetDatabaseName: String;
+begin
+ Result := FDatabase.DatabaseName;
+end;
+
+function TfrxIBXDatabase.GetLoginPrompt: Boolean;
+begin
+ Result := FDatabase.LoginPrompt;
+end;
+
+function TfrxIBXDatabase.GetParams: TStrings;
+begin
+ Result := FDatabase.Params;
+end;
+
+function TfrxIBXDatabase.GetSQLDialect: Integer;
+begin
+ Result := FDatabase.SQLDialect;
+end;
+
+procedure TfrxIBXDatabase.SetConnected(Value: Boolean);
+begin
+ BeforeConnect(Value);
+ FDatabase.Connected := Value;
+ FTransaction.Active := Value;
+end;
+
+procedure TfrxIBXDatabase.SetDatabaseName(const Value: String);
+begin
+ FDatabase.DatabaseName := Value;
+end;
+
+procedure TfrxIBXDatabase.SetLoginPrompt(Value: Boolean);
+begin
+ FDatabase.LoginPrompt := Value;
+end;
+
+procedure TfrxIBXDatabase.SetParams(Value: TStrings);
+begin
+ FDatabase.Params := Value;
+end;
+
+procedure TfrxIBXDatabase.SetSQLDialect(const Value: Integer);
+begin
+ FDatabase.SQLDialect := Value;
+end;
+
+procedure TfrxIBXDatabase.SetLogin(const Login, Password: String);
+begin
+ Params.Text := 'user_name=' + Login + #13#10 + 'password=' + Password;
+end;
+
+
+{ TfrxIBXTable }
+
+constructor TfrxIBXTable.Create(AOwner: TComponent);
+begin
+ FTable := TIBTable.Create(nil);
+ DataSet := FTable;
+ SetDatabase(nil);
+ inherited;
+end;
+
+constructor TfrxIBXTable.DesignCreate(AOwner: TComponent; Flags: Word);
+var
+ i: Integer;
+ l: TList;
+begin
+ inherited;
+ l := Report.AllObjects;
+ for i := 0 to l.Count - 1 do
+ if TObject(l[i]) is TfrxIBXDatabase then
+ begin
+ SetDatabase(TfrxIBXDatabase(l[i]));
+ break;
+ end;
+end;
+
+class function TfrxIBXTable.GetDescription: String;
+begin
+ Result := frxResources.Get('obIBXTb');
+end;
+
+procedure TfrxIBXTable.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FDatabase) then
+ SetDatabase(nil);
+end;
+
+procedure TfrxIBXTable.SetDatabase(const Value: TfrxIBXDatabase);
+begin
+ FDatabase := Value;
+ if Value <> nil then
+ FTable.Database := Value.Database
+ else if IBXComponents <> nil then
+ FTable.Database := IBXComponents.DefaultDatabase
+ else
+ FTable.Database := nil;
+ DBConnected := FTable.Database <> nil;
+end;
+
+function TfrxIBXTable.GetIndexFieldNames: String;
+begin
+ Result := FTable.IndexFieldNames;
+end;
+
+function TfrxIBXTable.GetIndexName: String;
+begin
+ Result := FTable.IndexName;
+end;
+
+function TfrxIBXTable.GetTableName: String;
+begin
+ Result := FTable.TableName;
+end;
+
+procedure TfrxIBXTable.SetIndexFieldNames(const Value: String);
+begin
+ FTable.IndexFieldNames := Value;
+end;
+
+procedure TfrxIBXTable.SetIndexName(const Value: String);
+begin
+ FTable.IndexName := Value;
+end;
+
+procedure TfrxIBXTable.SetTableName(const Value: String);
+begin
+ FTable.TableName := Value;
+end;
+
+procedure TfrxIBXTable.SetMaster(const Value: TDataSource);
+begin
+ FTable.MasterSource := Value;
+end;
+
+procedure TfrxIBXTable.SetMasterFields(const Value: String);
+begin
+ FTable.MasterFields := Value;
+end;
+
+procedure TfrxIBXTable.BeforeStartReport;
+begin
+ SetDatabase(FDatabase);
+end;
+
+
+{ TfrxIBXQuery }
+
+constructor TfrxIBXQuery.Create(AOwner: TComponent);
+begin
+ FQuery := TIBQuery.Create(nil);
+ Dataset := FQuery;
+ SetDatabase(nil);
+ inherited;
+end;
+
+constructor TfrxIBXQuery.DesignCreate(AOwner: TComponent; Flags: Word);
+var
+ i: Integer;
+ l: TList;
+begin
+ inherited;
+ l := Report.AllObjects;
+ for i := 0 to l.Count - 1 do
+ if TObject(l[i]) is TfrxIBXDatabase then
+ begin
+ SetDatabase(TfrxIBXDatabase(l[i]));
+ break;
+ end;
+end;
+
+class function TfrxIBXQuery.GetDescription: String;
+begin
+ Result := frxResources.Get('obIBXQ');
+end;
+
+procedure TfrxIBXQuery.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FDatabase) then
+ SetDatabase(nil);
+end;
+
+procedure TfrxIBXQuery.SetDatabase(const Value: TfrxIBXDatabase);
+begin
+ FDatabase := Value;
+
+ if Value <> nil then
+ begin
+ FQuery.Database := Value.Database;
+ FQuery.Transaction := Value.FTransaction;
+ end
+ else if IBXComponents <> nil then
+ FQuery.Database := IBXComponents.DefaultDatabase
+ else
+ FQuery.Database := nil;
+ DBConnected := FQuery.Database <> nil;
+end;
+
+procedure TfrxIBXQuery.SetMaster(const Value: TDataSource);
+begin
+ FQuery.DataSource := Value;
+end;
+
+procedure TfrxIBXQuery.SetSQL(Value: TStrings);
+begin
+ FQuery.SQL := Value;
+end;
+
+function TfrxIBXQuery.GetSQL: TStrings;
+begin
+ Result := FQuery.SQL;
+end;
+
+procedure TfrxIBXQuery.UpdateParams;
+begin
+ frxParamsToTParams(Self, FQuery.Params);
+end;
+
+procedure TfrxIBXQuery.BeforeStartReport;
+begin
+ SetDatabase(FDatabase);
+end;
+
+{$IFDEF QBUILDER}
+function TfrxIBXQuery.QBEngine: TfqbEngine;
+begin
+ Result := TfrxEngineIBX.Create(nil);
+ TfrxEngineIBX(Result).FQuery.Database := FQuery.Database;
+end;
+{$ENDIF}
+
+
+{$IFDEF QBUILDER}
+constructor TfrxEngineIBX.Create(AOwner: TComponent);
+begin
+ inherited;
+ FQuery := TIBQuery.Create(Self);
+end;
+
+destructor TfrxEngineIBX.Destroy;
+begin
+ FQuery.Free;
+ inherited;
+end;
+
+procedure TfrxEngineIBX.ReadFieldList(const ATableName: string;
+ var AFieldList: TfqbFieldList);
+var
+ TempTable: TIBTable;
+ Fields: TFieldDefs;
+ i: Integer;
+ tmpField: TfqbField;
+begin
+ AFieldList.Clear;
+ TempTable := TIBTable.Create(Self);
+ TempTable.Database := FQuery.Database;
+ TempTable.TableName := ATableName;
+ Fields := TempTable.FieldDefs;
+ try
+ try
+ TempTable.Active := True;
+ tmpField:= TfqbField(AFieldList.Add);
+ tmpField.FieldName := '*';
+ for i := 0 to Fields.Count - 1 do
+ begin
+ tmpField := TfqbField(AFieldList.Add);
+ tmpField.FieldName := Fields.Items[i].Name;
+ tmpField.FieldType := Ord(Fields.Items[i].DataType)
+ end;
+ except
+ end;
+ finally
+ TempTable.Free;
+ end;
+end;
+
+procedure TfrxEngineIBX.ReadTableList(ATableList: TStrings);
+begin
+ ATableList.Clear;
+ FQuery.Database.GetTableNames(ATableList, ShowSystemTables);
+end;
+
+function TfrxEngineIBX.ResultDataSet: TDataSet;
+begin
+ Result := FQuery;
+end;
+
+procedure TfrxEngineIBX.SetSQL(const Value: string);
+begin
+ FQuery.SQL.Text := Value;
+end;
+{$ENDIF}
+
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxIBXDataBase, TFmxObject);
+ GroupDescendentsWith(TfrxIBXTable, TFmxObject);
+ GroupDescendentsWith(TfrxIBXQuery, TFmxObject);
+ frxObjects.RegisterObject1(TfrxIBXDataBase, nil, '', {$IFDEF DB_CAT}'DATABASES'{$ELSE}''{$ENDIF}, 0, 243);
+ frxObjects.RegisterObject1(TfrxIBXTable, nil, '', {$IFDEF DB_CAT}'TABLES'{$ELSE}''{$ENDIF}, 0, 244);
+ frxObjects.RegisterObject1(TfrxIBXQuery, nil, '', {$IFDEF DB_CAT}'QUERIES'{$ELSE}''{$ENDIF}, 0, 245);
+
+finalization
+ frxObjects.UnRegister(TfrxIBXDataBase);
+ frxObjects.UnRegister(TfrxIBXTable);
+ frxObjects.UnRegister(TfrxIBXQuery);
+
+
+end.
\ No newline at end of file
diff --git a/LibD28/FMX.frxIBXEditor.pas b/LibD28/FMX.frxIBXEditor.pas
new file mode 100644
index 0000000..fdc019d
--- /dev/null
+++ b/LibD28/FMX.frxIBXEditor.pas
@@ -0,0 +1,167 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ IBX components design editors }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxIBXEditor;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, System.SysUtils, FMX.Forms, FMX.Dialogs, FMX.frxIBXComponents, FMX.frxCustomDB,
+ FMX.frxDsgnIntf, FMX.frxRes,
+{$IFDEF DELPHI20}
+ IBX.IBDatabase, IBX.IBTable
+{$ELSE}
+ IBDatabase, IBTable
+{$ENDIF}
+ , System.Variants;
+
+
+type
+ TfrxDatabaseNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+ TfrxDatabaseProperty = class(TfrxComponentProperty)
+ public
+ function GetValue: String; override;
+ end;
+
+ TfrxTableNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxIndexNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ end;
+
+
+{ TfrxDatabaseNameProperty }
+
+function TfrxDatabaseNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog];
+end;
+
+function TfrxDatabaseNameProperty.Edit: Boolean;
+var
+ SaveConnected: Boolean;
+begin
+ with TOpenDialog.Create(nil) do
+ begin
+ InitialDir := GetCurrentDir;
+ Filter := frxResources.Get('ftDB') + ' (*.gdb)|*.gdb|' +
+ frxResources.Get('ftAllFiles') + ' (*.*)|*.*';
+ Result := Execute;
+ if Result then
+ with TfrxIBXDatabase(Component).Database do
+ begin
+ SaveConnected := Connected;
+ Connected := False;
+ DatabaseName := FileName;
+ Connected := SaveConnected;
+ end;
+ Free;
+ end;
+end;
+
+
+{ TfrxDatabaseProperty }
+
+function TfrxDatabaseProperty.GetValue: String;
+var
+ db: TfrxIBXDatabase;
+begin
+ db := TfrxIBXDatabase(GetOrdValue);
+ if db = nil then
+ begin
+ if (IBXComponents <> nil) and (IBXComponents.DefaultDatabase <> nil) then
+ Result := IBXComponents.DefaultDatabase.Name
+ else
+ Result := frxResources.Get('prNotAssigned');
+ end
+ else
+ Result := inherited GetValue;
+end;
+
+
+{ TfrxTableNameProperty }
+
+function TfrxTableNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paSortList];
+end;
+
+procedure TfrxTableNameProperty.GetValues;
+begin
+ inherited;
+ with TfrxIBXTable(Component).Table do
+ if Database <> nil then
+ DataBase.GetTableNames(Values, False);
+end;
+
+procedure TfrxTableNameProperty.SetValue(const Value: String);
+begin
+ inherited;
+ Designer.UpdateDataTree;
+end;
+
+
+{ TfrxIndexProperty }
+
+function TfrxIndexNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList];
+end;
+
+procedure TfrxIndexNameProperty.GetValues;
+var
+ i: Integer;
+begin
+ inherited;
+ try
+ with TfrxIBXTable(Component).Table do
+ if (TableName <> '') and (IndexDefs <> nil) then
+ begin
+ IndexDefs.Update;
+ for i := 0 to IndexDefs.Count - 1 do
+ if IndexDefs[i].Name <> '' then
+ Values.Add(IndexDefs[i].Name);
+ end;
+ except
+ end;
+end;
+
+
+initialization
+ frxPropertyEditors.Register(TypeInfo(String), TfrxIBXDataBase, 'DatabaseName',
+ TfrxDataBaseNameProperty);
+ frxPropertyEditors.Register(TypeInfo(TfrxIBXDatabase), TfrxIBXTable, 'Database',
+ TfrxDatabaseProperty);
+ frxPropertyEditors.Register(TypeInfo(TfrxIBXDatabase), TfrxIBXQuery, 'Database',
+ TfrxDatabaseProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxIBXTable, 'TableName',
+ TfrxTableNameProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxIBXTable, 'IndexName',
+ TfrxIndexNameProperty);
+
+end.
diff --git a/LibD28/FMX.frxIBXRTTI.pas b/LibD28/FMX.frxIBXRTTI.pas
new file mode 100644
index 0000000..0de2871
--- /dev/null
+++ b/LibD28/FMX.frxIBXRTTI.pas
@@ -0,0 +1,98 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ IBX components RTTI }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxIBXRTTI;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, FMX.fs_iinterpreter, FMX.frxIBXComponents, FMX.fs_iibxrtti
+, System.Variants;
+
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ with AddClass(TfrxIBXDatabase, 'TfrxCustomDatabase') do
+ AddProperty('Database', 'TIBDatabase', GetProp, nil);
+ with AddClass(TfrxIBXTable, 'TfrxCustomTable') do
+ AddProperty('Table', 'TIBTable', GetProp, nil);
+ with AddClass(TfrxIBXQuery, 'TfrxCustomQuery') do
+ begin
+ AddMethod('procedure ExecSQL', CallMethod);
+ AddProperty('Query', 'TIBQuery', GetProp, nil);
+ end;
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TfrxIBXQuery then
+ begin
+ if MethodName = 'EXECSQL' then
+ TfrxIBXQuery(Instance).Query.ExecSQL
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TfrxIBXDatabase then
+ begin
+ if PropName = 'DATABASE' then
+ Result := frxInteger(TfrxIBXDatabase(Instance).Database)
+ end
+ else if ClassType = TfrxIBXTable then
+ begin
+ if PropName = 'TABLE' then
+ Result := frxInteger(TfrxIBXTable(Instance).Table)
+ end
+ else if ClassType = TfrxIBXQuery then
+ begin
+ if PropName = 'QUERY' then
+ Result := frxInteger(TfrxIBXQuery(Instance).Query)
+ end
+end;
+
+
+initialization
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/FMX.frxIndexToLocationClass.pas b/LibD28/FMX.frxIndexToLocationClass.pas
new file mode 100644
index 0000000..63c86ce
--- /dev/null
+++ b/LibD28/FMX.frxIndexToLocationClass.pas
@@ -0,0 +1,107 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Font parser }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Aleksey Mandrykin, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxIndexToLocationClass;
+interface uses System.SysUtils, FMX.TTFHelpers, FMX.frxFontHeaderClass, FMX.frxTrueTypeTable;
+type
+ TCardinalArray = array of Cardinal;
+ TWordArray = array of Word;
+
+ IndexToLocationClass = class(TrueTypeTable)
+ strict private LongIndexToLocation: TCardinalArray;
+ strict private ShortIndexToLocation: TWordArray;
+
+ // Methods
+ public constructor Create(src: TrueTypeTable);
+ public function GetGlyph(i2l_idx: Word; font_header: FontHeaderClass; var location: Cardinal): Word;
+ public procedure LoadIndexToLocation(font: Pointer; font_header: FontHeaderClass);
+
+ // Properties
+ public property Long: TCardinalArray read LongIndexToLocation;
+ public property Short: TWordArray read ShortIndexToLocation;
+
+end;
+
+implementation
+
+ constructor IndexToLocationClass.Create(src: TrueTypeTable);
+ begin
+ inherited Create(src);
+ self.ShortIndexToLocation := nil;
+ self.LongIndexToLocation := nil
+ end;
+
+ function IndexToLocationClass.GetGlyph(i2l_idx: Word; font_header: FontHeaderClass; var location: Cardinal): Word;
+ begin
+ location := 0;
+ case font_header.indexToLocFormat of
+ IndexToLoc.ShortType:
+ begin
+ location := Cardinal(self.ShortIndexToLocation[i2l_idx] * 2);
+ Result := Word(2 * (self.ShortIndexToLocation[(i2l_idx + 1)] - self.ShortIndexToLocation[i2l_idx]));
+ exit
+ end;
+ IndexToLoc.LongType:
+ begin
+ location := self.LongIndexToLocation[i2l_idx];
+ Result := Word(self.LongIndexToLocation[(i2l_idx + 1)] - self.LongIndexToLocation[i2l_idx]);
+ exit
+ end;
+ end;
+ begin
+ Result := 0;
+ exit
+ end
+ end;
+
+ procedure IndexToLocationClass.LoadIndexToLocation(font: Pointer; font_header: FontHeaderClass);
+ type
+ TShortPtr = ^Word;
+ TLongPtr = ^Integer;
+ var
+ count: Integer;
+ i: Integer;
+ short_ptr: ^Word;
+ long_ptr: ^Cardinal;
+ begin
+ case font_header.indexToLocFormat of
+ IndexToLoc.ShortType:
+ begin
+ count := self.entry.length div 2;
+ SetLength(self.ShortIndexToLocation, count );
+ short_ptr := TTF_Helpers.Increment(font, self.entry.offset);
+ i := 0;
+ while ((i < count)) do
+ begin
+ self.ShortIndexToLocation[i] := TTF_Helpers.SwapUInt16( short_ptr^ );
+ Inc(short_ptr);
+ Inc(i)
+ end;
+ end;
+ IndexToLoc.LongType:
+ begin
+ count := self.entry.length div 4;
+ SetLength(self.LongIndexToLocation, count );
+ long_ptr := TTF_Helpers.Increment(font, self.entry.offset);
+ i := 0;
+ while ((i < count)) do
+ begin
+ self.LongIndexToLocation[i] := TTF_Helpers.SwapUInt32(long_ptr^);
+ Inc(long_ptr);
+ inc(i)
+ end;
+ end;
+
+ else raise Exception.Create('Unsupported Index to Location format')
+ end;
+ end;
+
+end.
diff --git a/LibD28/FMX.frxInheritError.fmx b/LibD28/FMX.frxInheritError.fmx
new file mode 100644
index 0000000..59a8a5e
--- /dev/null
+++ b/LibD28/FMX.frxInheritError.fmx
@@ -0,0 +1,50 @@
+object frxInheritErrorForm: TfrxInheritErrorForm
+ Left = 0
+ Top = 0
+ Caption = 'Error'
+ ClientHeight = 152
+ ClientWidth = 256
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ StyleLookup = 'backgroundstyle'
+ object MessageL: TLabel
+ Position.Point = '(60,16)'
+ Width = 185.000000000000000000
+ Height = 41.000000000000000000
+ TabOrder = 0
+ end
+ object PaintBox1: TPaintBox
+ Position.Point = '(12,16)'
+ Width = 32.000000000000000000
+ Height = 32.000000000000000000
+ end
+ object OkB: TButton
+ Position.Point = '(48,120)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 2
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(128,120)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 3
+ ModalResult = 2
+ Cancel = True
+ end
+ object DeleteRB: TRadioButton
+ Position.Point = '(12,68)'
+ Width = 229.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 4
+ end
+ object RenameRB: TRadioButton
+ Position.Point = '(12,88)'
+ Width = 229.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 5
+ end
+end
diff --git a/LibD28/FMX.frxInheritError.pas b/LibD28/FMX.frxInheritError.pas
new file mode 100644
index 0000000..0de2d00
--- /dev/null
+++ b/LibD28/FMX.frxInheritError.pas
@@ -0,0 +1,60 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Inherit error dialog }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxInheritError;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.UITypes,
+ FMX.Controls, FMX.Forms, FMX.Edit, FMX.Objects, FMX.Types
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+type
+ TfrxInheritErrorForm = class(TForm)
+ OkB: TButton;
+ CancelB: TButton;
+ MessageL: TLabel;
+ DeleteRB: TRadioButton;
+ RenameRB: TRadioButton;
+ procedure FormCreate(Sender: TObject);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses
+ FMX.frxRes;
+
+
+procedure TfrxInheritErrorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(6000);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ MessageL.Text := frxGet(6001);
+ DeleteRB.Text := frxGet(6002);
+ RenameRB.Text := frxGet(6003);
+end;
+
+end.
diff --git a/LibD28/FMX.frxInsp.fmx b/LibD28/FMX.frxInsp.fmx
new file mode 100644
index 0000000..1c52938
--- /dev/null
+++ b/LibD28/FMX.frxInsp.fmx
@@ -0,0 +1,485 @@
+object frxObjectInspector: TfrxObjectInspector
+ Left = 0
+ Top = 0
+ BorderStyle = bsSizeToolWin
+ Caption = 'Object Inspector'
+ ClientHeight = 628
+ ClientWidth = 207
+ StyleBook = StyleBook1
+ OnDeactivate = FormDeactivate
+ OnKeyDown = FormKeyDown
+ OnResize = FormResize
+ object PopupMenu1: TPopupMenu
+ Left = 48
+ Top = 424
+ object N11: TMenuItem
+ Height = 50.000000000000000000
+ ShortCut = 16472
+ Width = 50.000000000000000000
+ OnClick = N11Click
+ end
+ object N21: TMenuItem
+ Height = 50.000000000000000000
+ ShortCut = 16470
+ Width = 50.000000000000000000
+ OnClick = N21Click
+ end
+ object N31: TMenuItem
+ Height = 50.000000000000000000
+ ShortCut = 16451
+ Width = 50.000000000000000000
+ OnClick = N31Click
+ end
+ object N41: TMenuItem
+ Height = 50.000000000000000000
+ ShortCut = 8238
+ Width = 50.000000000000000000
+ OnClick = N11Click
+ end
+ object N51: TMenuItem
+ Height = 50.000000000000000000
+ ShortCut = 8237
+ Width = 50.000000000000000000
+ OnClick = N21Click
+ end
+ object N61: TMenuItem
+ Height = 50.000000000000000000
+ ShortCut = 16429
+ Width = 50.000000000000000000
+ OnClick = N31Click
+ end
+ end
+ object MainPanel: TPanel
+ Align = alClient
+ Height = 628.000000000000000000
+ Width = 207.000000000000000000
+ OnResize = FormResize
+ object BackPanel: TPanel
+ Height = 309.000000000000000000
+ Position.Y = 45.000000000000000000
+ Width = 185.000000000000000000
+ object Splitter1: TSplitter
+ Align = alBottom
+ Cursor = crVSplit
+ Height = 3.000000000000000000
+ MinSize = 20.000000000000000000
+ Position.Y = 241.000000000000000000
+ Width = 185.000000000000000000
+ end
+ object Box: TFramedScrollBox
+ Align = alClient
+ Height = 241.000000000000000000
+ StyleLookup = 'BoxStyle1'
+ Width = 185.000000000000000000
+ object PB: TPaintBox
+ Align = alClient
+ Height = 237.000000000000000000
+ Width = 181.000000000000000000
+ OnDblClick = PBDblClick
+ OnMouseDown = PBMouseDown
+ OnMouseMove = PBMouseMove
+ OnMouseUp = PBMouseUp
+ OnPaint = PBPaint
+ end
+ object Edit1: TEdit
+ StyleLookup = 'Edit1Style1'
+ DisableFocusEffect = False
+ Font.Size = 8.000000000000000000
+ KeyboardType = vktDefault
+ Password = False
+ Text = 'Edit1'
+ Position.X = 9.000000000000000000
+ Position.Y = 30.000000000000000000
+ Width = 113.000000000000000000
+ Height = 15.000000000000000000
+ Visible = False
+ OnKeyDown = Edit1KeyDown
+ OnDblClick = EditBtnClick
+ end
+ object EditPanel: TPanel
+ Height = 15.000000000000000000
+ Position.X = 123.000000000000000000
+ Position.Y = 30.000000000000000000
+ Visible = False
+ Width = 15.000000000000000000
+ object EditBtn: TSpeedButton
+ Height = 15.000000000000000000
+ StyleLookup = 'EditBtnStyle1'
+ Width = 15.000000000000000000
+ OnClick = EditBtnClick
+ end
+ end
+ object ComboPanel: TPanel
+ Height = 15.000000000000000000
+ Position.X = 139.000000000000000000
+ Position.Y = 30.000000000000000000
+ Visible = False
+ Width = 15.000000000000000000
+ object ComboBtn: TSpeedButton
+ Height = 15.000000000000000000
+ StyleLookup = 'ComboBtnStyle1'
+ Text = 'v'
+ Width = 15.000000000000000000
+ OnClick = ComboBtnClick
+ end
+ end
+ end
+ object HintPanel: TPanel
+ Align = alBottom
+ Height = 65.000000000000000000
+ Position.Y = 244.000000000000000000
+ Width = 185.000000000000000000
+ object PropL: TLabel
+ Align = alTop
+ Font.Style = [fsBold]
+ Height = 16.000000000000000000
+ Width = 185.000000000000000000
+ end
+ object DescrL: TLabel
+ Align = alClient
+ Height = 49.000000000000000000
+ Position.Y = 16.000000000000000000
+ VertTextAlign = taLeading
+ Width = 185.000000000000000000
+ end
+ end
+ end
+ object ObjectsCB: TComboBox
+ DisableFocusEffect = False
+ Height = 21.000000000000000000
+ ItemIndex = -1
+ ItemHeight = 15.000000000000000000
+ ListBoxResource = 'transparentlistboxstyle'
+ Position.Y = 20.000000000000000000
+ Width = 182.000000000000000000
+ OnChange = ObjectsCBClick
+ end
+ object Rectangle1: TRectangle
+ Align = alTop
+ Height = 18.000000000000000000
+ Margins.Left = 2.000000000000000000
+ Margins.Top = 1.000000000000000000
+ Stroke.Kind = bkNone
+ Width = 207.000000000000000000
+ object Label1: TLabel
+ Align = alClient
+ AutoSize = True
+ Height = 17.000000000000000000
+ Position.X = 2.000000000000000000
+ Position.Y = 1.000000000000000000
+ Text = 'Object Inspector'
+ Width = 205.000000000000000000
+ WordWrap = False
+ end
+ end
+ end
+ object StyleBook1: TStyleBook
+ Resource.Strings = (
+ 'object _1: TLayout'
+ ' Align = alClient'
+ ' Position.Point = '#39'(0,33)'#39
+ ' Width = 452.000000000000000000'
+ ' Height = 815.000000000000000000'
+ ' object TLayout'
+ ' StyleName = '#39'Edit1Style1'#39
+ ' Position.Point = '#39'(180,395)'#39
+ ' Width = 91.000000000000000000'
+ ' Height = 24.000000000000000000'
+ ' DesignVisible = False'
+ ' object TRectangle'
+ ' StyleName = '#39'background'#39
+ ' Align = alContents'
+ ' Locked = True'
+ ' Width = 91.000000000000000000'
+ ' Height = 24.000000000000000000'
+ ' HitTest = False'
+ ' Visible = False'
+ ' Fill.Color = xFFFEFEFE'
+ ' Stroke.Color = claSilver'
+ ' XRadius = 1.000000000000000000'
+ ' YRadius = 1.000000000000000000'
+ ' Sides = []'
+ ' object TColorAnimation'
+ ' Duration = 0.200000002980232200'
+ ' Trigger = '#39'IsMouseOver = true'#39
+ ' StartValue = claSilver'
+ ' StopValue = xFFA5D9FF'
+ ' PropertyName = '#39'Stroke.Color'#39
+ ' end'
+ ' object TColorAnimation'
+ ' Duration = 0.200000002980232200'
+ ' Inverse = True'
+ ' Trigger = '#39'IsMouseOver = false'#39
+ ' StartValue = claSilver'
+ ' StopValue = xFFA5D9FF'
+ ' PropertyName = '#39'Stroke.Color'#39
+ ' end'
+ ' end'
+ ' object TLayout'
+ ' StyleName = '#39'content'#39
+ ' Align = alContents'
+ ' Locked = True'
+ ' Width = 91.000000000000000000'
+ ' Height = 24.000000000000000000'
+ ' end'
+ ' object TBrushObject'
+ ' StyleName = '#39'foreground'#39
+ ' Brush.Color = claBlack'
+ ' end'
+ ' object TBrushObject'
+ ' StyleName = '#39'selection'#39
+ ' Brush.Color = x802A8ADF'
+ ' end'
+ ' object TGlowEffect'
+ ' Trigger = '#39'IsFocused=true'#39
+ ' Enabled = False'
+ ' Softness = 0.200000002980232200'
+ ' GlowColor = x82005ACC'
+ ' Opacity = 0.899999976158142100'
+ ' end'
+ ' end'
+ ' object TLayout'
+ ' StyleName = '#39'EditBtnStyle1'#39
+ ' Position.Point = '#39'(218,377)'#39
+ ' Width = 16.000000000000000000'
+ ' Height = 60.000000000000000000'
+ ' DesignVisible = False'
+ ' object TRectangle'
+ ' StyleName = '#39'background'#39
+ ' Align = alContents'
+ ' Width = 16.000000000000000000'
+ ' Height = 60.000000000000000000'
+ ' Opacity = 0.000099999997473788'
+ ' HitTest = False'
+ ' Fill.Color = xFFEFEFEF'
+ ' Stroke.Kind = bkNone'
+ ' XRadius = 2.000000000000000000'
+ ' YRadius = 2.000000000000000000'
+ ' object TRectangle'
+ ' Align = alContents'
+ ' Width = 16.000000000000000000'
+ ' Height = 60.000000000000000000'
+ ' HitTest = False'
+ ' Fill.Kind = bkGradient'
+ ' Fill.Gradient.Points = <'
+ ' item'
+ ' Color = x24F4F4F4'
+ ' end'
+ ' item'
+ ' Color = x24EAEAEA'
+ ' Offset = 0.499000012874603300'
+ ' end'
+ ' item'
+ ' Color = x4E868686'
+ ' Offset = 0.500000000000000000'
+ ' end>'
+ ' Stroke.Color = x484F4F4F'
+ ' XRadius = 2.000000000000000000'
+ ' YRadius = 2.000000000000000000'
+ ' end'
+ ' object TFloatAnimation'
+ ' Duration = 0.200000002980232200'
+ ' Trigger = '#39'IsMouseOver=true'#39
+ ' TriggerInverse = '#39'IsMouseOver=false'#39
+ ' StopValue = 1.000000000000000000'
+ ' PropertyName = '#39'Opacity'#39
+ ' end'
+ ' object TColorAnimation'
+ ' Duration = 0.200000002980232200'
+ ' Trigger = '#39'IsMouseOver=true;IsPressed=false'#39
+ ' StartValue = xFFEFEFEF'
+ ' StopValue = xFFFFD541'
+ ' PropertyName = '#39'Fill.Color'#39
+ ' end'
+ ' object TColorAnimation'
+ ' Duration = 0.200000002980232200'
+ ' Trigger = '#39'IsMouseOver=false;IsPressed=false'#39
+ ' StartValue = xFFFFD541'
+ ' StopValue = xFFEFEFEF'
+ ' PropertyName = '#39'Fill.Color'#39
+ ' end'
+ ' object TColorAnimation'
+ ' Duration = 0.200000002980232200'
+ ' Inverse = True'
+ ' Trigger = '#39'IsMouseOver=false;IsPressed=true'#39
+ ' StartValue = xFFDCAE0D'
+ ' StopValue = xFFFFD541'
+ ' PropertyName = '#39'Fill.Color'#39
+ ' end'
+ ' object TColorAnimation'
+ ' Duration = 0.200000002980232200'
+ ' Trigger = '#39'IsMouseOver=true;IsPressed=true'#39
+ ' StartValue = xFFDCAE0D'
+ ' StopValue = xFFFFD541'
+ ' PropertyName = '#39'Fill.Color'#39
+ ' end'
+ ' object TRectangle'
+ ' Align = alClient'
+ ' Position.Point = '#39'(1,1)'#39
+ ' Locked = True'
+ ' Width = 14.000000000000000000'
+ ' Height = 58.000000000000000000'
+ ' Padding.Rect = '#39'(1,1,1,1)'#39
+ ' HitTest = False'
+ ' Fill.Kind = bkNone'
+ ' Stroke.Color = x96FCFCFC'
+ ' XRadius = 2.000000000000000000'
+ ' YRadius = 2.000000000000000000'
+ ' end'
+ ' end'
+ ' object TGridLayout'
+ ' StyleName = '#39'GridLayout1'#39
+ ' Align = alCenter'
+ ' Position.Point = '#39'(3,29)'#39
+ ' Width = 12.000000000000000000'
+ ' Height = 2.000000000000000000'
+ ' Padding.Rect = '#39'(3,1,0,0)'#39
+ ' HitTest = False'
+ ' ItemHeight = 2.000000000000000000'
+ ' ItemWidth = 4.000000000000000000'
+ ' Orientation = orHorizontal'
+ ' object TRectangle'
+ ' StyleName = '#39'Rectangle2'#39
+ ' Width = 2.000000000000000000'
+ ' Height = 2.000000000000000000'
+ ' Margins.Rect = '#39'(0,0,5,0)'#39
+ ' Padding.Rect = '#39'(0,0,2,0)'#39
+ ' HitTest = False'
+ ' Fill.Color = claDimgray'
+ ' Stroke.Kind = bkNone'
+ ' end'
+ ' object TRectangle'
+ ' StyleName = '#39'Rectangle2'#39
+ ' Position.Point = '#39'(4,0)'#39
+ ' Width = 2.000000000000000000'
+ ' Height = 2.000000000000000000'
+ ' Padding.Rect = '#39'(0,0,2,0)'#39
+ ' HitTest = False'
+ ' Fill.Color = claDimgray'
+ ' Stroke.Kind = bkNone'
+ ' end'
+ ' object TRectangle'
+ ' StyleName = '#39'Rectangle2'#39
+ ' Position.Point = '#39'(8,0)'#39
+ ' Width = 2.000000000000000000'
+ ' Height = 2.000000000000000000'
+ ' Padding.Rect = '#39'(0,0,2,0)'#39
+ ' HitTest = False'
+ ' Fill.Color = claDimgray'
+ ' Stroke.Kind = bkNone'
+ ' end'
+ ' end'
+ ' end'
+ ' object TLayout'
+ ' StyleName = '#39'ComboBtnStyle1'#39
+ ' Position.Point = '#39'(189,394)'#39
+ ' Width = 73.000000000000000000'
+ ' Height = 26.000000000000000000'
+ ' DesignVisible = False'
+ ' object TRectangle'
+ ' StyleName = '#39'background'#39
+ ' Align = alContents'
+ ' Width = 73.000000000000000000'
+ ' Height = 26.000000000000000000'
+ ' Opacity = 0.000099999997473788'
+ ' HitTest = False'
+ ' Fill.Color = xFFEFEFEF'
+ ' Stroke.Kind = bkNone'
+ ' XRadius = 2.000000000000000000'
+ ' YRadius = 2.000000000000000000'
+ ' object TRectangle'
+ ' Align = alContents'
+ ' Width = 73.000000000000000000'
+ ' Height = 26.000000000000000000'
+ ' HitTest = False'
+ ' Fill.Kind = bkGradient'
+ ' Fill.Gradient.Points = <'
+ ' item'
+ ' Color = x24F4F4F4'
+ ' end'
+ ' item'
+ ' Color = x24EAEAEA'
+ ' Offset = 0.499000012874603300'
+ ' end'
+ ' item'
+ ' Color = x4E868686'
+ ' Offset = 0.500000000000000000'
+ ' end>'
+ ' Stroke.Color = x484F4F4F'
+ ' XRadius = 2.000000000000000000'
+ ' YRadius = 2.000000000000000000'
+ ' end'
+ ' object TFloatAnimation'
+ ' Duration = 0.200000002980232200'
+ ' Trigger = '#39'IsMouseOver=true'#39
+ ' TriggerInverse = '#39'IsMouseOver=false'#39
+ ' StopValue = 1.000000000000000000'
+ ' PropertyName = '#39'Opacity'#39
+ ' end'
+ ' object TColorAnimation'
+ ' Duration = 0.200000002980232200'
+ ' Trigger = '#39'IsMouseOver=true;IsPressed=false'#39
+ ' StartValue = xFFEFEFEF'
+ ' StopValue = xFFFFD541'
+ ' PropertyName = '#39'Fill.Color'#39
+ ' end'
+ ' object TColorAnimation'
+ ' Duration = 0.200000002980232200'
+ ' Trigger = '#39'IsMouseOver=false;IsPressed=false'#39
+ ' StartValue = xFFFFD541'
+ ' StopValue = xFFEFEFEF'
+ ' PropertyName = '#39'Fill.Color'#39
+ ' end'
+ ' object TColorAnimation'
+ ' Duration = 0.200000002980232200'
+ ' Inverse = True'
+ ' Trigger = '#39'IsMouseOver=false;IsPressed=true'#39
+ ' StartValue = xFFDCAE0D'
+ ' StopValue = xFFFFD541'
+ ' PropertyName = '#39'Fill.Color'#39
+ ' end'
+ ' object TColorAnimation'
+ ' Duration = 0.200000002980232200'
+ ' Trigger = '#39'IsMouseOver=true;IsPressed=true'#39
+ ' StartValue = xFFDCAE0D'
+ ' StopValue = xFFFFD541'
+ ' PropertyName = '#39'Fill.Color'#39
+ ' end'
+ ' object TRectangle'
+ ' Align = alClient'
+ ' Position.Point = '#39'(1,1)'#39
+ ' Locked = True'
+ ' Width = 71.000000000000000000'
+ ' Height = 24.000000000000000000'
+ ' Padding.Rect = '#39'(1,1,1,1)'#39
+ ' HitTest = False'
+ ' Fill.Kind = bkNone'
+ ' Stroke.Color = x96FCFCFC'
+ ' XRadius = 2.000000000000000000'
+ ' YRadius = 2.000000000000000000'
+ ' end'
+ ' end'
+ ' object TPath'
+ ' StyleName = '#39'Path1'#39
+ ' Align = alCenter'
+ ' Position.Point = '#39'(33,11)'#39
+ ' Width = 7.000000000000000000'
+ ' Height = 5.000000000000000000'
+ ' Padding.Rect = '#39'(0,1,0,0)'#39
+ ' HitTest = False'
+ ' Fill.Color = claDimgray'
+ ' Stroke.Color = claDimgray'
+ ' Data.Path = {'
+
+ ' 05000000000000000000000000000000010000000000204100000000' +
+ '01000000'
+
+ ' 0000A0400000A0400100000000000000000000000300000000000000' +
+ '00000000}'
+ ' end'
+ ' end'
+ 'end')
+ Left = 120
+ Top = 424
+ end
+end
diff --git a/LibD28/FMX.frxInsp.pas b/LibD28/FMX.frxInsp.pas
new file mode 100644
index 0000000..0a94be5
--- /dev/null
+++ b/LibD28/FMX.frxInsp.pas
@@ -0,0 +1,1151 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Object Inspector }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxInsp;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Controls, FMX.Forms,
+ FMX.Dialogs, FMX.ExtCtrls, FMX.frxDsgnIntf, System.Types, System.UIConsts,
+ FMX.frxClass, FMX.Menus, FMX.Types, FMX.Edit, FMX.Objects, FMX.Layouts,
+ FMX.ListBox, FMX.TabControl, FMX.Platform, System.Variants, FMX.TreeView
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+ TfrxObjectInspector = class(TForm)
+ PopupMenu1: TPopupMenu;
+ N11: TMenuItem;
+ N21: TMenuItem;
+ N31: TMenuItem;
+ N41: TMenuItem;
+ N51: TMenuItem;
+ N61: TMenuItem;
+ MainPanel: TPanel;
+ BackPanel: TPanel;
+ Splitter1: TSplitter;
+ Box: TFramedScrollBox;
+ PB: TPaintBox;
+ Edit1: TEdit;
+ EditPanel: TPanel;
+ EditBtn: TSpeedButton;
+ ComboPanel: TPanel;
+ ComboBtn: TSpeedButton;
+ HintPanel: TPanel;
+ PropL: TLabel;
+ DescrL: TLabel;
+ ObjectsCB: TComboBox;
+ Label1: TLabel;
+ Rectangle1: TRectangle;
+ StyleBook1: TStyleBook;
+ procedure FormResize(Sender: TObject);
+ procedure PBPaint(Sender: TObject; ACanvas: TCanvas);
+ procedure PBMouseDown(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Single);
+ procedure PBMouseUp(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Single);
+ procedure PBMouseMove(Sender: TObject; Shift: TShiftState;
+ X, Y: Single);
+ procedure Edit1KeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+ procedure EditBtnClick(Sender: TObject);
+ procedure ComboBtnClick(Sender: TObject);
+ procedure ObjectsCBClick(Sender: TObject);
+ procedure PBDblClick(Sender: TObject);
+ procedure FormMouseWheelDown(Sender: TObject; Shift: TShiftState;
+ MousePos: TPoint; var Handled: Boolean);
+ procedure FormMouseWheelUp(Sender: TObject; Shift: TShiftState;
+ MousePos: TPoint; var Handled: Boolean);
+ procedure FormShow(Sender: TObject);
+ procedure TabChange(Sender: TObject);
+ procedure N11Click(Sender: TObject);
+ procedure N21Click(Sender: TObject);
+ procedure N31Click(Sender: TObject);
+ procedure FormDeactivate(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+ private
+ { Private declarations }
+ FDesigner: TfrxCustomDesigner;
+ FDisableDblClick: Boolean;
+ FDisableUpdate: Boolean;
+ FDown: Boolean;
+ FEventList: TfrxPropertyList;
+ //FHintWindow: THintWindow; todo
+ FItemIndex: Integer;
+ FLastPosition: String;
+ FList: TfrxPropertyList;
+ FPopupForm: TPopup;
+ FPopupLB: TListBox;
+// FPopupLBVisible: Boolean;
+ FPropertyList: TfrxPropertyList;
+ FPanel: TPanel;
+ FRowHeight: Single;
+ FSelectedObjects: TList;
+ FSplitterPos: Single;
+ FTabs: TTabControl;
+ FTempList: TList;
+ FUpdatingObjectsCB: Boolean;
+ FUpdatingPB: Boolean;
+ FOnSelectionChanged: TNotifyEvent;
+ FOnModify: TNotifyEvent;
+// FPopupCloseTime: Extended;
+ FFastCanvas: TCanvas;
+ function Count: Integer;
+ function GetItem(Index: Integer): TfrxPropertyItem;
+ function GetName(Index: Integer): String;
+ function GetOffset(Index: Integer): Integer;
+ function GetType(Index: Integer): TfrxPropertyAttributes;
+ function GetValue(Index: Integer): String;
+ procedure AdjustControls;
+ procedure DrawOneLine(Canvas: TCanvas; i: Integer; Selected: Boolean);
+ procedure DoModify;
+ procedure SetObjects(Value: TList);
+ procedure SetItemIndex(Value: Integer);
+ procedure SetSelectedObjects(Value: TList);
+ procedure SetValue(Index: Integer; Value: String);
+ procedure LBClick(Sender: TObject);
+ procedure ClosePopup(Sender: TObject);
+ function GetSplitter1Pos: Integer;
+ procedure SetSplitter1Pos(const Value: Integer);
+ public
+ { Public declarations }
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure DisableUpdate;
+ procedure EnableUpdate;
+ procedure Inspect(AObjects: array of TPersistent);
+ procedure UpdateProperties;
+ procedure DoResize;
+ property Objects: TList write SetObjects;
+ property ItemIndex: Integer read FItemIndex write SetItemIndex;
+ property SelectedObjects: TList read FSelectedObjects write SetSelectedObjects;
+ property SplitterPos: Single read FSplitterPos write FSplitterPos;
+ property Splitter1Pos: Integer read GetSplitter1Pos write SetSplitter1Pos;
+ property OnModify: TNotifyEvent read FOnModify write FOnModify;
+ property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged write FOnSelectionChanged;
+ end;
+
+
+implementation
+{$IFDEF DELPHI23}
+{$R FMX.frxInsp_D23.FMX}
+{$ELSE}
+{$R *.FMX}
+{$ENDIF}
+
+uses FMX.frxFMX, FMX.frxUtils, FMX.frxRes, FMX.frxrcInsp;
+{ TfrxObjectInspector }
+
+constructor TfrxObjectInspector.Create(AOwner: TComponent);
+var
+ aTab: TTabItem;
+begin
+ inherited Create(AOwner);
+ FItemIndex := -1;
+ FTempList := TList.Create;
+ FDesigner := TfrxCustomDesigner(AOwner);
+ Box.ShowScrollBars := True;
+{$IFNDEF MSWINDOWS}
+ {$IFDEF DELPHI18}
+ Box.AutoHide := false;
+ {$ENDIF}
+{$ENDIF}
+{$IFDEF DELPHI19}
+ Box.AniCalculations.AutoShowing := false;
+{$ENDIF}
+ FPanel := TPanel.Create(Self);
+ FPanel.StyleLookup := 'backgroundstyle';
+ FPanel.Parent := Box;
+ PB.Parent := FPanel;
+ ComboPanel.Parent := FPanel;
+ EditPanel.Parent := FPanel;
+ Edit1.Parent := FPanel;
+ Edit1.Font.Size := 11;
+
+ FRowHeight := Round(Canvas.TextHeight('Wg') + 3);
+
+ MainPanel.StyleLookup := 'backgroundstyle';
+ BackPanel.StyleLookup := 'backgroundstyle';
+ FTabs := TTabControl.Create(Self);
+ FTabs.OnChange := TabChange;
+ FTabs.Parent := MainPanel;
+{$IFDEF Delphi17}
+ FTabs.TabHeight := 21;
+{$ENDIF}
+
+ aTab := TTabItem.Create(Self);
+ aTab.Text := frxResources.Get('oiProp');
+ FTabs.AddObject(aTab);
+ aTab := TTabItem.Create(Self);
+ aTab.Text := frxResources.Get('oiEvent');
+ FTabs.AddObject(aTab);
+ FTabs.TabIndex := 0;
+
+ FSplitterPos := Round(PB.Width) div 2;
+
+ FPopupForm := TPopup.Create(Self);
+ FPopupForm.Placement := TPlacement.plAbsolute;
+ FPopupForm.Parent := Self;
+ FPopupForm.OnClosePopup := ClosePopup;
+
+ FPopupLB := TListBox.Create(FPopupForm);
+ with FPopupLB do
+ begin
+ Parent := FPopupForm;
+ Align := TAlignLayout.alClient;
+ ItemHeight := FRowHeight;
+ OnClick := LBClick;
+ end;
+ FormResize(nil);
+
+ Label1.Text := frxGet(2000);
+ FFastCanvas := nil;
+ if frxCanvasClass <> nil then
+ FFastCanvas := frxCanvasClass.Create;
+end;
+
+destructor TfrxObjectInspector.Destroy;
+begin
+ DisableUpdate;
+ if frxCanvasClass <> nil then
+ FreeAndNil(FFastCanvas);
+ FTempList.Free;
+ if FPropertyList <> nil then
+ FPropertyList.Free;
+ if FEventList <> nil then
+ FEventList.Free;
+ inherited;
+end;
+
+procedure TfrxObjectInspector.UpdateProperties;
+begin
+ SetSelectedObjects(FSelectedObjects);
+end;
+
+procedure TfrxObjectInspector.Inspect(AObjects: array of TPersistent);
+var
+ i: Integer;
+begin
+ FTempList.Clear;
+ for i := Low(AObjects) to High(AObjects) do
+ FTempList.Add(AObjects[i]);
+ Objects := FTempList;
+ SelectedObjects := FTempList;
+end;
+
+function TfrxObjectInspector.GetSplitter1Pos: Integer;
+begin
+ Result := Round(HintPanel.Height);
+end;
+
+procedure TfrxObjectInspector.SetSplitter1Pos(const Value: Integer);
+begin
+ HintPanel.Height := Value;
+end;
+
+procedure TfrxObjectInspector.DisableUpdate;
+begin
+ FDisableUpdate := True;
+end;
+
+procedure TfrxObjectInspector.EnableUpdate;
+begin
+ FDisableUpdate := False;
+end;
+
+procedure TfrxObjectInspector.SetObjects(Value: TList);
+var
+ i: Integer;
+ s: String;
+begin
+ ObjectsCB.BeginUpdate;
+{$IFDEF DELPHI23}
+ ObjectsCB.Clear;
+{$ELSE}
+ ObjectsCB.Items.Clear;
+{$ENDIF}
+ for i := 0 to Value.Count - 1 do
+ begin
+ if TObject(Value[i]) is TComponent then
+ s := TComponent(Value[i]).Name + ': ' + TComponent(Value[i]).ClassName else
+ s := '';
+ ObjectsCB.Items.AddObject(s, Value[i]);
+ end;
+ ObjectsCB.EndUpdate;
+end;
+
+procedure TfrxObjectInspector.SetSelectedObjects(Value: TList);
+var
+ i: Integer;
+ s: String;
+
+ procedure CreateLists;
+ var
+ i: Integer;
+ p: TfrxPropertyItem;
+ s: String;
+ begin
+ if FPropertyList <> nil then
+ FPropertyList.Free;
+ if FEventList <> nil then
+ FEventList.Free;
+ FEventList := nil;
+
+ FPropertyList := frxCreatePropertyList(Value, FDesigner);
+ if FPropertyList <> nil then
+ begin
+ FEventList := TfrxPropertyList.Create(FDesigner);
+
+ i := 0;
+ while i < FPropertyList.Count do
+ begin
+ p := FPropertyList[i];
+ s := String(p.Editor.PropInfo.PropType^.Name);
+ if (Pos('Tfrx', s) = 1) and (Pos('Event', s) = Length(s) - 4) then
+ p.Collection := FEventList else
+ Inc(i);
+ end;
+ end;
+
+ if FTabs.TabIndex = 0 then
+ FList := FPropertyList else
+ FList := FEventList;
+ end;
+
+begin
+ FSelectedObjects := Value;
+ CreateLists;
+
+ FUpdatingObjectsCB := True;
+ if FSelectedObjects.Count = 1 then
+ begin
+ ObjectsCB.ItemIndex := ObjectsCB.Items.IndexOfObject(FSelectedObjects[0]);
+ if ObjectsCB.ItemIndex = -1 then
+ begin
+ s := TComponent(FSelectedObjects[0]).Name + ': ' +
+ TComponent(FSelectedObjects[0]).ClassName;
+ ObjectsCB.BeginUpdate;
+ ObjectsCB.Items.AddObject(s, FSelectedObjects[0]);
+ ObjectsCB.EndUpdate;
+ ObjectsCB.ItemIndex := ObjectsCB.Items.IndexOfObject(FSelectedObjects[0]);
+ end;
+ end
+ else
+ ObjectsCB.ItemIndex := -1;
+ FUpdatingObjectsCB := False;
+
+ FItemIndex := -1;
+ FormResize(nil);
+ if Count > 0 then
+ begin
+ for i := 0 to Count - 1 do
+ if GetName(i) = FLastPosition then
+ begin
+ ItemIndex := i;
+ Exit;
+ end;
+ s := FLastPosition;
+ ItemIndex := 0;
+ FLastPosition := s;
+ end;
+end;
+
+function TfrxObjectInspector.Count: Integer;
+
+ function EnumProperties(p: TfrxPropertyList): Integer;
+ var
+ i: Integer;
+ begin
+ Result := 0;
+ for i := 0 to p.Count - 1 do
+ begin
+ Inc(Result);
+ if (p[i].SubProperty <> nil) and p[i].Expanded then
+ Inc(Result, EnumProperties(p[i].SubProperty));
+ end;
+ end;
+
+begin
+ if FList <> nil then
+ Result := EnumProperties(FList) else
+ Result := 0;
+end;
+
+function TfrxObjectInspector.GetItem(Index: Integer): TfrxPropertyItem;
+
+ function EnumProperties(p: TfrxPropertyList; var Index: Integer): TfrxPropertyItem;
+ var
+ i: Integer;
+ begin
+ Result := nil;
+ for i := 0 to p.Count - 1 do
+ begin
+ Dec(Index);
+ if Index < 0 then
+ begin
+ Result := p[i];
+ break;
+ end;
+ if (p[i].SubProperty <> nil) and p[i].Expanded then
+ Result := EnumProperties(p[i].SubProperty, Index);
+ if Index < 0 then
+ break;
+ end;
+ end;
+
+begin
+ if (Index >= 0) and (Index < Count) then
+ Result := EnumProperties(FList, Index) else
+ Result := nil;
+end;
+
+function TfrxObjectInspector.GetOffset(Index: Integer): Integer;
+var
+ p: TfrxPropertyList;
+begin
+ Result := 0;
+ p := TfrxPropertyList(GetItem(Index).Collection);
+ while p.Parent <> nil do
+ begin
+ Inc(Result);
+ p := p.Parent;
+ end;
+end;
+
+function TfrxObjectInspector.GetName(Index: Integer): String;
+begin
+ Result := GetItem(Index).Editor.GetName;
+end;
+
+function TfrxObjectInspector.GetType(Index: Integer): TfrxPropertyAttributes;
+begin
+ Result := GetItem(Index).Editor.GetAttributes;
+end;
+
+function TfrxObjectInspector.GetValue(Index: Integer): String;
+begin
+ Result := GetItem(Index).Editor.Value;
+end;
+
+procedure TfrxObjectInspector.DoModify;
+var
+ i: Integer;
+begin
+ if FSelectedObjects.Count = 1 then
+ begin
+ i := ObjectsCB.Items.IndexOfObject(FSelectedObjects[0]);
+ if TObject(FSelectedObjects[0]) is TComponent then
+ ObjectsCB.Items.Strings[i] := TComponent(FSelectedObjects[0]).Name + ': ' +
+ TComponent(FSelectedObjects[0]).ClassName;
+ ObjectsCB.ItemIndex := ObjectsCB.Items.IndexOfObject(FSelectedObjects[0]);
+ end;
+
+ if Assigned(FOnModify) then
+ FOnModify(Self);
+end;
+
+procedure TfrxObjectInspector.DoResize;
+begin
+ FormResize(Self);
+end;
+
+procedure TfrxObjectInspector.SetItemIndex(Value: Integer);
+var
+ p: TfrxPropertyItem;
+ s: String;
+begin
+ PropL.Text := '';
+ DescrL.Text := '';
+ if Value > Count - 1 then
+ Value := Count - 1;
+ if Value < 0 then
+ Value := -1;
+
+ Edit1.Visible := Count > 0;
+ if Count = 0 then Exit;
+
+ if FItemIndex <> -1 then
+ if Edit1.Typing then
+ begin
+ Edit1.Typing := False;
+ SetValue(FItemIndex, Edit1.Text);
+ end;
+ FItemIndex := Value;
+
+ if FItemIndex <> -1 then
+ begin
+ FLastPosition := GetName(FItemIndex);
+ p := GetItem(FItemIndex);
+ s := GetName(FItemIndex);
+ PropL.Text := s;
+ if TfrxPropertyList(p.Collection).Component <> nil then
+ begin
+ s := 'prop' + s + '.' + TfrxPropertyList(p.Collection).Component.ClassName;
+ if frxResources.Get(s) = s then
+ s := frxResources.Get('prop' + GetName(FItemIndex)) else
+ s := frxResources.Get(s);
+ DescrL.Text := s;
+ end;
+ end;
+
+ AdjustControls;
+end;
+
+procedure TfrxObjectInspector.SetValue(Index: Integer; Value: String);
+var
+ pItem: TfrxPropertyItem;
+ vIdx: Integer;
+begin
+ pItem := GetItem(Index);
+ try
+ if True then
+ begin
+ if paValueList in pItem.Editor.GetAttributes then
+ begin
+ pItem.Editor.GetValues;
+ vIdx := pItem.Editor.Values.IndexOf(Value);
+ if vIdx <> -1 then
+ Value := pItem.Editor.Values[vIdx];
+ end;
+ pItem.Editor.Value := Value;
+ end;
+ DoModify;
+ PB.Repaint;
+/// PBPaint(nil, nil);
+
+ except
+ on E: Exception do
+ begin
+ frxErrorMsg(E.Message);
+ Edit1.Text := GetItem(Index).Editor.Value;
+ end;
+ end;
+end;
+
+procedure TfrxObjectInspector.AdjustControls;
+var
+ PropType: TfrxPropertyAttributes;
+ y, ww: Integer;
+begin
+ if FDisableUpdate then Exit;
+ if FItemIndex = -1 then
+ begin
+ EditPanel.Visible := False;
+ ComboPanel.Visible := False;
+ Edit1.Visible := False;
+ FUpdatingPB := False;
+ BackPanel.Repaint;
+ Exit;
+ end;
+
+ FUpdatingPB := True;
+ PropType := GetType(FItemIndex);
+
+ EditPanel.Visible := paDialog in PropType;
+ ComboPanel.Visible := paValueList in PropType;
+ Edit1.ReadOnly := paReadOnly in PropType;
+
+ ww := Round(PB.Width - FSplitterPos - 2);
+ y := Round(FItemIndex * FRowHeight + 1);
+ if EditPanel.Visible then
+ begin
+ EditPanel.SetBounds(PB.Width - 15, y - 1, 15, Round(FRowHeight) - 1);
+ EditBtn.SetBounds(0, 0, EditPanel.Width, EditPanel.Height);
+ Dec(ww, 15);
+ end;
+ if ComboPanel.Visible then
+ begin
+ ComboPanel.SetBounds(PB.Width - 15, y - 1, 15, Round(FRowHeight) - 1);
+ ComboBtn.SetBounds(0, 0, ComboPanel.Width, ComboPanel.Height);
+ Dec(ww, 15);
+ end;
+
+ Edit1.Text := GetValue(FItemIndex);
+ Edit1.Typing := False;
+ Edit1.SetBounds(FSplitterPos + 2, y, ww, FRowHeight - 2);
+ Edit1.SelectAll;
+{$IFDEF DELPHI18}
+ if y + FRowHeight > Box.ViewportPosition.Y + Box.ClientHeight then
+ Box.ViewportPosition := PointF(Box.ViewportPosition.X, y - Box.ClientHeight + FRowHeight);
+ if y < Box.ViewportPosition.Y then
+ Box.ViewportPosition := PointF(Box.ViewportPosition.X, y - 1);
+{$ELSE}
+ if y + FRowHeight > Box.VScrollBar.Value + Box.ClientHeight then
+ Box.VScrollBar.Value := y - Box.ClientHeight + FRowHeight;
+ if y < Box.VScrollBar.Value then
+ Box.VScrollBar.Value := y - 1;
+{$ENDIF}
+ FUpdatingPB := False;
+ BackPanel.Repaint;
+end;
+
+procedure TfrxObjectInspector.DrawOneLine(Canvas: TCanvas; i: Integer; Selected: Boolean);
+var
+ s: String;
+ p: TfrxPropertyItem;
+ offs, add: Integer;
+
+ procedure Line(x, y, dx, dy: Single);
+ begin
+ Canvas.DrawLine(PointF(Round(x) + 0.5, Round(y) + 0.5),
+ PointF(Round(x + dx) + 0.5, Round(y + dy) + 0.5), 1);
+ end;
+
+ procedure DrawProperty;
+ var
+ x, y: Single;
+ begin
+ x := offs + GetOffset(i) * (12 + add);
+ y := 1 + i * FRowHeight;
+
+ with Canvas do
+ begin
+ Stroke.Color := claGray;
+
+ if offs < 12 then
+ begin
+ DrawRect(RectF(Round(x) + 1.5, Round(y) + 2.5 + add, Round(x) + 9.5, Round(y) + 10.5 + add), 1, 1, AllCorners, 1);
+ Line(x + 3, y + 6 + add, 4, 0);
+ if s[1] = '+' then
+ Line(x + 5, y + 4 + add, 0, 4);
+
+ s := Copy(s, 2, 255);
+ x := x + 12 + add;
+ end;
+
+ Fill.Color := claBlack;
+ Font.Style := [];
+ if ((s = 'Name') or (s = 'Width') or (s = 'Height') or (s = 'Left') or (s = 'Top'))
+ and (GetOffset(i) = 0) then
+ Font.Style := [TFontStyle.fsBold];
+ FFastCanvas.FillText(RectF(x, y, FSplitterPos - 1, y + FRowHeight), s, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ end;
+ end;
+
+begin
+ if Count > 0 then
+ with Canvas do
+ begin
+ Stroke.Color := claLightGray;
+ Stroke.Kind := TBrushKind.bkSolid;
+ Font.Family := 'Segoe UI';
+ Font.Size := 8 * 96 / 72;
+ Font.Style := [];
+
+ //if Screen.PixelsPerInch > 96 then
+ // add := 2
+ //else
+ add := 0;
+ p := GetItem(i);
+ s := GetName(i);
+ if p.SubProperty <> nil then
+ begin
+ offs := 1 + add;
+ if p.Expanded then
+ s := '-' + s else
+ s := '+' + s;
+ end
+ else
+ offs := 13 + add;
+
+ p.Editor.ItemHeight := Round(FRowHeight);
+
+ if Selected then
+ begin
+ Line(0, FRowHeight + -1 + i * FRowHeight, PB.Width, 0);
+ Fill.Color := claLightGray;
+ FillRect(RectF(0, Round(i * FRowHeight), FSplitterPos, Round(i * FRowHeight + FRowHeight - 1)), 1, 1, AllCorners, 1);
+ DrawProperty;
+ end
+ else
+ begin
+
+ Line(0, FRowHeight + -1 + i * FRowHeight, PB.Width, 0);
+ Line(FSplitterPos - 1, 0 + i * FRowHeight, 0, FRowHeight);
+ DrawProperty;
+ Fill.Color := claNavy;
+ Font.Style := [];
+ if paOwnerDraw in p.Editor.GetAttributes then
+ p.Editor.OnDrawItem(Canvas, RectF(FSplitterPos + 2, 1 + i * FRowHeight, PB.Width, 1 + (i + 1) * FRowHeight))
+ else
+ FFastCanvas.FillText(RectF(FSplitterPos + 2, 1 + i * FRowHeight, PB.Width + 2, 1 + i * FRowHeight + FRowHeight), GetValue(i), False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ end;
+ end;
+end;
+
+
+{ Form events }
+
+procedure TfrxObjectInspector.FormShow(Sender: TObject);
+begin
+ AdjustControls;
+end;
+
+procedure TfrxObjectInspector.FormResize(Sender: TObject);
+var
+ h: Integer;
+begin
+ if FTabs = nil then Exit;
+ //if Screen.PixelsPerInch > 96 then
+ // h := 26
+ //else
+ h := 21;
+ FTabs.SetBounds(0, ObjectsCB.Position.Y + ObjectsCB.Height + 4, MainPanel.Width, h);
+
+ BackPanel.Position.Y := FTabs.Position.Y + FTabs.Height;
+
+ BackPanel.Width := MainPanel.Width;
+ BackPanel.Height := MainPanel.Height - BackPanel.Position.Y + 1;
+ ObjectsCB.Width := MainPanel.Width;
+
+ FPanel.Height := Count * FRowHeight;
+ FPanel.Width := Box.ClientWidth;
+ AdjustControls;
+end;
+
+procedure TfrxObjectInspector.TabChange(Sender: TObject);
+begin
+ if FDesigner.IsPreviewDesigner then
+ begin
+ FTabs.TabIndex := 0;
+ Exit;
+ end;
+ if FTabs.TabIndex = 0 then
+ FList := FPropertyList else
+{$IFNDEF FR_VER_BASIC}
+ FList := FEventList;
+{$ELSE}
+ FTabs.TabIndex := 0;
+{$ENDIF}
+ FItemIndex := -1;
+ FormResize(nil);
+end;
+
+procedure TfrxObjectInspector.N11Click(Sender: TObject);
+begin
+ if Edit1.Visible then
+ Edit1.CutToClipboard;
+end;
+
+procedure TfrxObjectInspector.N21Click(Sender: TObject);
+begin
+ if Edit1.Visible then
+ Edit1.PasteFromClipboard;
+end;
+
+procedure TfrxObjectInspector.N31Click(Sender: TObject);
+begin
+ if Edit1.Visible then
+ Edit1.CopyToClipboard;
+end;
+
+procedure TfrxObjectInspector.FormDeactivate(Sender: TObject);
+begin
+ if FDisableUpdate then Exit;
+ SetItemIndex(FItemIndex);
+end;
+
+
+{ PB events }
+
+
+procedure TfrxObjectInspector.PBPaint(Sender: TObject; ACanvas: TCanvas);
+var
+ i: Integer;
+ r: TRectF;
+begin
+ FUpdatingPB := FUpdatingPB or (Assigned(FPropertyList) and (FSelectedObjects.IndexOf(FPropertyList.Component) < 0));
+ if FUpdatingPB then Exit;
+ if ACanvas = nil then Exit;
+ if FFastCanvas is TfrxFastCanvasLayer then
+ begin
+ TfrxFastCanvasLayer(FFastCanvas).UpdateHandle(FDesigner);
+ TfrxFastCanvasLayer(FFastCanvas).Canvas := ACanvas;
+ end
+ else
+ FFastCanvas := ACanvas;
+ r := PB.BoundsRect;
+ with ACanvas do
+ begin
+ Fill.Color := claWhite;
+ Fill.Kind := TBrushKind.bkSolid;
+ FillRect(RectF(1, 1, r.Right, r.Bottom), 1, 1, AllCorners, 1);
+ end;
+
+ if not FDisableUpdate then
+ begin
+ for i := 0 to Count - 1 do
+ begin
+ { do not draw outbound items }
+{$IFDEF DELPHI18}
+ if (Box.ViewportPosition.Y > (FRowHeight * i) + FRowHeight) then
+ Continue;
+ if (Box.ViewportPosition.Y + Box.Height < (FRowHeight * i) + FRowHeight) then
+ break;
+{$ELSE}
+ if (Box.VScrollBar.Value > (FRowHeight * i) + FRowHeight) then
+ Continue;
+ if (Box.VScrollBar.Value + Box.Height < (FRowHeight * i) + FRowHeight) then
+ break;
+{$ENDIF}
+ if i <> ItemIndex then
+ DrawOneLine(ACanvas, i, False);
+ if FItemIndex <> -1 then
+ DrawOneLine(ACanvas, ItemIndex, True);
+ end;
+ end;
+
+ if not (FFastCanvas is TfrxFastCanvasLayer) then
+ FFastCanvas := nil;
+end;
+
+procedure TfrxObjectInspector.PBMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+var
+ p: TfrxPropertyItem;
+ n, x1: Integer;
+begin
+ FDisableDblClick := False;
+ if Count = 0 then Exit;
+ if PB.Cursor = crHSplit then
+ FDown := True
+ else
+ begin
+ n := Trunc(Y / FRowHeight);
+
+ if (X > FSplitterPos) and (X < FSplitterPos + 15) and
+ (n >= 0) and (n < Count) then
+ begin
+ p := GetItem(n);
+ if p.Editor.ClassName = 'TfrxBooleanProperty' then
+ begin
+ p.Editor.Edit;
+ DoModify;
+ PB.Repaint;
+ Exit;
+ end;
+ end;
+
+ ItemIndex := n;
+ Edit1.SetFocus;
+ SetFocused(Edit1);
+
+ p := GetItem(ItemIndex);
+ x1 := GetOffset(ItemIndex) * 12;
+ if (X > x1) and (X < x1 + 13) and (p.SubProperty <> nil) then
+ begin
+ p.Expanded := not p.Expanded;
+ FormResize(nil);
+ FDisableDblClick := True;
+ end;
+ end;
+end;
+
+procedure TfrxObjectInspector.PBMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+begin
+ FDown := False;
+end;
+
+procedure TfrxObjectInspector.PBMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
+var
+ n: Integer;
+// OffsetX: Single;
+ s: String;
+begin
+ if not FDown then
+ begin
+ if (X > FSplitterPos - 4) and (X < FSplitterPos + 2) then
+ PB.Cursor := crHSplit
+ else
+ begin
+ PB.Cursor := crDefault;
+
+ { hint window }
+ n := Round(Y / FRowHeight);
+ if (X > 12) and (n >= 0) and (n < Count) then
+ begin
+ if X <= FSplitterPos - 4 then
+ begin
+// OffsetX := (GetOffset(n) + 1) * 12;
+ s := GetName(n);
+ //MaxWidth := FSplitterPos - OffsetX;
+ end
+ else
+ begin
+// OffsetX := FSplitterPos + 1;
+ s := GetValue(n);
+// MaxWidth := PB.Width - FSplitterPos;
+// if n = ItemIndex then
+// MaxWidth := 1000;
+ end;
+ end;
+ end;
+ end
+ else
+ begin
+ if (x > 30) and (x < PB.Width - 30) then
+ FSplitterPos := X;
+ AdjustControls;
+ end;
+end;
+
+procedure TfrxObjectInspector.PBDblClick(Sender: TObject);
+var
+ p: TfrxPropertyItem;
+begin
+ if (Count = 0) or FDisableDblClick then Exit;
+
+ p := GetItem(ItemIndex);
+ if (p <> nil) and (p.SubProperty <> nil) then
+ begin
+ p.Expanded := not p.Expanded;
+ FormResize(nil);
+ end;
+end;
+
+
+{ Edit1 events }
+
+procedure TfrxObjectInspector.Edit1KeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+var
+ i: Integer;
+begin
+ if Count = 0 then Exit;
+ if Key = vkReturn then
+ begin
+ if paDialog in GetType(ItemIndex) then
+ EditBtnClick(nil)
+ else
+ if Edit1.Typing then
+ begin
+ Edit1.Typing := False;
+ SetValue(ItemIndex, Edit1.Text);
+ end;
+ Edit1.SelectAll;
+ Key := 0;
+ Exit;
+ end;
+
+ if Key = vkEscape then
+ begin
+ Edit1.Typing := False;
+ ItemIndex := ItemIndex;
+ Key := 0;
+ end;
+ if (Key = vkDelete) or (Key = vkBack) then
+ begin
+ Edit1.Typing := True;
+ end;
+
+ if Key = vkUp then
+ begin
+ if ItemIndex > 0 then
+ ItemIndex := ItemIndex - 1;
+ Key := 0;
+ end
+ else if Key = vkDown then
+ begin
+ if ItemIndex < Count - 1 then
+ ItemIndex := ItemIndex + 1;
+ Key := 0;
+ end
+ else if Key = vkPrior then
+ begin
+ i := Round(Box.Height / FRowHeight);
+ i := ItemIndex - i;
+ if i < 0 then
+ i := 0;
+ ItemIndex := i;
+ Key := 0;
+ end
+ else if Key = vkNext then
+ begin
+ i := Round(Box.Height / FRowHeight);
+ i := ItemIndex + i;
+ ItemIndex := i;
+ Key := 0;
+ end;
+end;
+
+
+{ EditBtn and ComboBtn events }
+
+procedure TfrxObjectInspector.EditBtnClick(Sender: TObject);
+begin
+ if GetItem(ItemIndex).Editor.Edit then
+ begin
+ ItemIndex := FItemIndex;
+ DoModify;
+ end;
+end;
+
+procedure TfrxObjectInspector.ClosePopup(Sender: TObject);
+begin
+ ComboBtn.Enabled := True;
+end;
+
+procedure TfrxObjectInspector.ComboBtnClick(Sender: TObject);
+var
+ i, wItems, nItems, wItem: Integer;
+ p: TPoint;
+ f: TCommonCustomForm;
+begin
+ ComboBtn.Enabled := False;
+ with FPopupLB do
+ begin
+ GetItem(FItemIndex).Editor.GetValues;
+ Items.Assign(GetItem(FItemIndex).Editor.Values);
+
+ if Items.Count > 0 then
+ begin
+ ItemIndex := Items.IndexOf(GetValue(FItemIndex));
+ wItems := 0;
+ for i := 0 to Items.Count - 1 do
+ begin
+ if paOwnerDraw in GetItem(FItemIndex).Editor.GetAttributes then
+ ListItems[i].OnPaint := GetItem(FItemIndex).Editor.OnDrawLBItem;
+ wItem := Round(Canvas.TextWidth(Items[i]));
+ if wItem > wItems then
+ wItems := wItem;
+ end;
+
+ Inc(wItems, 8);
+ if paOwnerDraw in GetItem(FItemIndex).Editor.GetAttributes then
+ Inc(wItems, GetItem(FItemIndex).Editor.GetExtraLBSize);
+ nItems := Items.Count;
+ if nItems > 8 then
+ begin
+ nItems := 8;
+ Inc(wItems, 8);
+ end;
+ f := GetComponentForm(MainPanel);
+ if f = nil then f := Self;
+
+ p := f.ClientToScreen(PointF(Edit1.AbsoluteRect.Left, Edit1.AbsoluteRect.Top + Position.Y + Edit1.Height)).Round;
+
+ if wItems < PB.Width - FSplitterPos then
+ begin
+ FPopupForm.Width := Round(PB.Width - FSplitterPos) + 1;
+ FPopupForm.Height := Round(nItems * ItemHeight) + 2;
+ with FPopupForm.PlacementRectangle do
+ begin
+ Left := p.X - 3;
+ Top := p.Y;
+ end;
+ end
+ else
+ begin
+ FPopupForm.Width := wItems;
+ FPopupForm.Height := Round(nItems * ItemHeight) + 2;
+ with FPopupForm.PlacementRectangle do
+ begin
+ Left := p.X + Round(PB.Width - FSplitterPos - wItems) - 2;
+ Top := p.Y;
+ end;
+ end;
+ if FPopupForm.PlacementRectangle.Left < 0 then
+ FPopupForm.PlacementRectangle.Left := 0;
+
+ FDisableUpdate := True;
+ // Popup doesnt work in many cases ?!
+ //FPopupForm.Popup;
+{$IFDEF LINUX}
+ FPopupForm.Popup;
+{$ENDIF}
+{$IFDEF DELPHI25}
+ FPopupLB.RecalcSize;
+{$ENDIF}
+ FPopupForm.PopupModal;
+ FDisableUpdate := False;
+ end;
+ end;
+end;
+
+procedure TfrxObjectInspector.LBClick(Sender: TObject);
+var
+ S: String;
+begin
+ s := Edit1.Text;
+ if FPopupLB.Selected <> nil then
+ s := FPopupLB.Selected.Text;
+ FPopupForm.IsOpen := False;
+ Edit1.Text := s;
+
+ Edit1.SetFocus;
+ SetFocused(Edit1);
+ Edit1.SelectAll;
+ SetValue(ItemIndex, Edit1.Text);
+end;
+
+
+{ ObjectsCB events }
+
+procedure TfrxObjectInspector.ObjectsCBClick(Sender: TObject);
+begin
+ if FUpdatingObjectsCB then Exit;
+
+ FSelectedObjects.Clear;
+ if ObjectsCB.ItemIndex <> -1 then
+ FSelectedObjects.Add(ObjectsCB.Items.Objects[ObjectsCB.ItemIndex]);
+ SetSelectedObjects(FSelectedObjects);
+ Edit1.SetFocus;
+ SetFocused(Edit1);
+ if Assigned(FOnSelectionChanged) then
+ FOnSelectionChanged(Self);
+end;
+
+
+{ Mouse wheel }
+
+procedure TfrxObjectInspector.FormMouseWheelDown(Sender: TObject;
+ Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
+begin
+{$IFDEF DELPHI18}
+ with Box.ViewportPosition do
+ Box.ViewportPosition := PointF(X, Y + FRowHeight);
+{$ELSE}
+ with Box.VScrollBar do
+ Value := Value + FRowHeight;
+{$ENDIF}
+end;
+
+procedure TfrxObjectInspector.FormMouseWheelUp(Sender: TObject;
+ Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
+begin
+{$IFDEF DELPHI18}
+ with Box.ViewportPosition do
+ Box.ViewportPosition := PointF(X, Y - FRowHeight);
+{$ELSE}
+ with Box.VScrollBar do
+ Value := Value - FRowHeight;
+{$ENDIF}
+end;
+
+procedure TfrxObjectInspector.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Assigned(FDesigner.OnKeyDown) then
+ FDesigner.OnKeyDown(Sender, Key, KeyChar, Shift);
+end;
+
+end.
diff --git a/LibD28/FMX.frxInsp_D23.fmx b/LibD28/FMX.frxInsp_D23.fmx
new file mode 100644
index 0000000..7ff7121
--- /dev/null
+++ b/LibD28/FMX.frxInsp_D23.fmx
@@ -0,0 +1,365 @@
+object frxObjectInspector: TfrxObjectInspector
+ Left = 0
+ Top = 0
+ BorderStyle = bsSizeToolWin
+ Caption = 'Object Inspector'
+ ClientHeight = 628
+ ClientWidth = 207
+ StyleBook = StyleBook1
+ OnDeactivate = FormDeactivate
+ OnKeyDown = FormKeyDown
+ OnResize = FormResize
+ object PopupMenu1: TPopupMenu
+ Left = 48
+ Top = 424
+ object N11: TMenuItem
+ Height = 50.000000000000000000
+ ShortCut = 16472
+ Width = 50.000000000000000000
+ OnClick = N11Click
+ end
+ object N21: TMenuItem
+ Height = 50.000000000000000000
+ ShortCut = 16470
+ Width = 50.000000000000000000
+ OnClick = N21Click
+ end
+ object N31: TMenuItem
+ Height = 50.000000000000000000
+ ShortCut = 16451
+ Width = 50.000000000000000000
+ OnClick = N31Click
+ end
+ object N41: TMenuItem
+ Height = 50.000000000000000000
+ ShortCut = 8238
+ Width = 50.000000000000000000
+ OnClick = N11Click
+ end
+ object N51: TMenuItem
+ Height = 50.000000000000000000
+ ShortCut = 8237
+ Width = 50.000000000000000000
+ OnClick = N21Click
+ end
+ object N61: TMenuItem
+ Height = 50.000000000000000000
+ ShortCut = 16429
+ Width = 50.000000000000000000
+ OnClick = N31Click
+ end
+ end
+ object MainPanel: TPanel
+ Align = alClient
+ Height = 628.000000000000000000
+ Width = 207.000000000000000000
+ OnResize = FormResize
+ object BackPanel: TPanel
+ Height = 309.000000000000000000
+ Position.Y = 45.000000000000000000
+ Width = 185.000000000000000000
+ object Splitter1: TSplitter
+ Align = alBottom
+ Cursor = crVSplit
+ Height = 3.000000000000000000
+ MinSize = 20.000000000000000000
+ Position.Y = 241.000000000000000000
+ Width = 185.000000000000000000
+ end
+ object Box: TFramedScrollBox
+ Align = alClient
+ Height = 241.000000000000000000
+ StyleLookup = 'BoxStyle1'
+ Width = 185.000000000000000000
+ object PB: TPaintBox
+ Align = alClient
+ Height = 237.000000000000000000
+ Width = 181.000000000000000000
+ OnDblClick = PBDblClick
+ OnMouseDown = PBMouseDown
+ OnMouseMove = PBMouseMove
+ OnMouseUp = PBMouseUp
+ OnPaint = PBPaint
+ end
+ object Edit1: TEdit
+ StyleLookup = 'Edit1Style1'
+ DisableFocusEffect = False
+ Font.Size = 8.000000000000000000
+ KeyboardType = vktDefault
+ Password = False
+ Text = 'Edit1'
+ Position.X = 9.000000000000000000
+ Position.Y = 30.000000000000000000
+ Width = 113.000000000000000000
+ Height = 15.000000000000000000
+ Visible = False
+ OnKeyDown = Edit1KeyDown
+ OnDblClick = EditBtnClick
+ end
+ object EditPanel: TPanel
+ Height = 15.000000000000000000
+ Position.X = 123.000000000000000000
+ Position.Y = 30.000000000000000000
+ Visible = False
+ Width = 15.000000000000000000
+ object EditBtn: TSpeedButton
+ Height = 15.000000000000000000
+ StyleLookup = 'EditBtnStyle1'
+ Width = 15.000000000000000000
+ OnClick = EditBtnClick
+ end
+ end
+ object ComboPanel: TPanel
+ Height = 15.000000000000000000
+ Position.X = 139.000000000000000000
+ Position.Y = 30.000000000000000000
+ Visible = False
+ Width = 15.000000000000000000
+ object ComboBtn: TSpeedButton
+ Height = 15.000000000000000000
+ StyleLookup = 'ComboBtnStyle1'
+ Text = 'v'
+ Width = 15.000000000000000000
+ OnClick = ComboBtnClick
+ end
+ end
+ end
+ object HintPanel: TPanel
+ Align = alBottom
+ Height = 65.000000000000000000
+ Position.Y = 244.000000000000000000
+ Width = 185.000000000000000000
+ object PropL: TLabel
+ Align = alTop
+ Font.Style = [fsBold]
+ Height = 16.000000000000000000
+ Width = 185.000000000000000000
+ end
+ object DescrL: TLabel
+ Align = alClient
+ Height = 49.000000000000000000
+ Position.Y = 16.000000000000000000
+ VertTextAlign = taLeading
+ Width = 185.000000000000000000
+ end
+ end
+ end
+ object ObjectsCB: TComboBox
+ DisableFocusEffect = False
+ Height = 21.000000000000000000
+ ItemIndex = -1
+ ItemHeight = 15.000000000000000000
+ ListBoxResource = 'transparentlistboxstyle'
+ Position.Y = 20.000000000000000000
+ Width = 182.000000000000000000
+ OnChange = ObjectsCBClick
+ end
+ object Rectangle1: TRectangle
+ Align = alTop
+ Height = 18.000000000000000000
+ Margins.Left = 2.000000000000000000
+ Margins.Top = 1.000000000000000000
+ Stroke.Kind = bkNone
+ Width = 207.000000000000000000
+ object Label1: TLabel
+ Align = alClient
+ AutoSize = True
+ Height = 17.000000000000000000
+ Position.X = 2.000000000000000000
+ Position.Y = 1.000000000000000000
+ Text = 'Object Inspector'
+ Width = 205.000000000000000000
+ WordWrap = False
+ end
+ end
+ end
+ object StyleBook1: TStyleBook
+ Styles = <
+ item
+ ResourcesBin = {
+ 464D585F5354594C4520322E3501060B45646974315374796C653103FB03060D
+ 4564697442746E5374796C6531036A0A060E436F6D626F42746E5374796C6531
+ 03E607005450463007544C61796F757400095374796C654E616D65060B456469
+ 74315374796C65310A506F736974696F6E2E580500000000000000B406400A50
+ 6F736974696F6E2E590500000000000080C507400A53697A652E576964746805
+ 00000000000000B605400B53697A652E4865696768740500000000000000C003
+ 401453697A652E506C6174666F726D44656661756C7408000A5452656374616E
+ 676C6500095374796C654E616D65060A6261636B67726F756E6405416C69676E
+ 0708436F6E74656E74730A46696C6C2E436F6C6F720709784646464546454645
+ 064C6F636B6564090748697454657374080553696465730B000A53697A652E57
+ 696474680500000000000000B605400B53697A652E4865696768740500000000
+ 000000C003401453697A652E506C6174666F726D44656661756C74080C537472
+ 6F6B652E436F6C6F720709636C6153696C7665720756697369626C6508075852
+ 6164697573050000000000000080FF3F07595261646975730500000000000000
+ 80FF3F000F54436F6C6F72416E696D6174696F6E00084475726174696F6E0500
+ 00000000CDCCCCFC3F0C50726F70657274794E616D65060C5374726F6B652E43
+ 6F6C6F720A537461727456616C75650709636C6153696C7665720953746F7056
+ 616C756507097846464135443946460754726967676572061249734D6F757365
+ 4F766572203D207472756500000F54436F6C6F72416E696D6174696F6E000844
+ 75726174696F6E050000000000CDCCCCFC3F07496E7665727365090C50726F70
+ 657274794E616D65060C5374726F6B652E436F6C6F720A537461727456616C75
+ 650709636C6153696C7665720953746F7056616C756507097846464135443946
+ 460754726967676572061349734D6F7573654F766572203D2066616C73650000
+ 0007544C61796F757400095374796C654E616D650607636F6E74656E7405416C
+ 69676E0708436F6E74656E7473064C6F636B6564090A53697A652E5769647468
+ 0500000000000000B605400B53697A652E4865696768740500000000000000C0
+ 03401453697A652E506C6174666F726D44656661756C740800000C5442727573
+ 684F626A65637400095374796C654E616D65060A666F726567726F756E640B42
+ 727573682E436F6C6F720708636C61426C61636B00000C5442727573684F626A
+ 65637400095374796C654E616D65060973656C656374696F6E0B42727573682E
+ 436F6C6F72070978383032413841444600000B54476C6F774566666563740008
+ 536F66746E657373050000000000CDCCCCFC3F09476C6F77436F6C6F72070978
+ 3832303035414343074F7061636974790500000000006666E6FE3F0754726967
+ 676572060E4973466F63757365643D7472756507456E61626C65640800000054
+ 50463007544C61796F757400095374796C654E616D65060D4564697442746E53
+ 74796C65310A506F736974696F6E2E580500000000000000DA06400A506F7369
+ 74696F6E2E590500000000000080BC07400A53697A652E576964746805000000
+ 000000008003400B53697A652E4865696768740500000000000000F004401453
+ 697A652E506C6174666F726D44656661756C7408000A5452656374616E676C65
+ 00095374796C654E616D65060A6261636B67726F756E6405416C69676E070843
+ 6F6E74656E74730A46696C6C2E436F6C6F720709784646454645464546074869
+ 745465737408074F70616369747905000000000017B7D1F13F0A53697A652E57
+ 6964746805000000000000008003400B53697A652E4865696768740500000000
+ 000000F004401453697A652E506C6174666F726D44656661756C74080B537472
+ 6F6B652E4B696E6407044E6F6E65075852616469757305000000000000008000
+ 4007595261646975730500000000000000800040000A5452656374616E676C65
+ 0005416C69676E0708436F6E74656E74730946696C6C2E4B696E640708477261
+ 6469656E741446696C6C2E4772616469656E742E506F696E74730E0105436F6C
+ 6F720709783234463446344634064F6666736574050000000000000000000000
+ 0105436F6C6F720709783234454145414541064F6666736574050000000000EE
+ 7CFFFD3F000105436F6C6F720709783445383638363836064F66667365740500
+ 00000000000080FE3F00000748697454657374080A53697A652E576964746805
+ 000000000000008003400B53697A652E4865696768740500000000000000F004
+ 401453697A652E506C6174666F726D44656661756C74080C5374726F6B652E43
+ 6F6C6F7207097834383446344634460758526164697573050000000000000080
+ 00400759526164697573050000000000000080004000000F54466C6F6174416E
+ 696D6174696F6E00084475726174696F6E050000000000CDCCCCFC3F0C50726F
+ 70657274794E616D6506074F7061636974790A537461727456616C7565050000
+ 00000000000000000953746F7056616C7565050000000000000080FF3F075472
+ 6967676572061049734D6F7573654F7665723D747275650E5472696767657249
+ 6E7665727365061149734D6F7573654F7665723D66616C736500000F54436F6C
+ 6F72416E696D6174696F6E00084475726174696F6E050000000000CDCCCCFC3F
+ 0C50726F70657274794E616D65060A46696C6C2E436F6C6F720A537461727456
+ 616C756507097846464546454645460953746F7056616C756507097846464646
+ 443534310754726967676572062049734D6F7573654F7665723D747275653B49
+ 73507265737365643D66616C736500000F54436F6C6F72416E696D6174696F6E
+ 00084475726174696F6E050000000000CDCCCCFC3F0C50726F70657274794E61
+ 6D65060A46696C6C2E436F6C6F720A537461727456616C756507097846464646
+ 443534310953746F7056616C7565070978464645464546454607547269676765
+ 72062149734D6F7573654F7665723D66616C73653B4973507265737365643D66
+ 616C736500000F54436F6C6F72416E696D6174696F6E00084475726174696F6E
+ 050000000000CDCCCCFC3F07496E7665727365090C50726F70657274794E616D
+ 65060A46696C6C2E436F6C6F720A537461727456616C75650709784646444341
+ 4530440953746F7056616C756507097846464646443534310754726967676572
+ 062049734D6F7573654F7665723D66616C73653B4973507265737365643D7472
+ 756500000F54436F6C6F72416E696D6174696F6E00084475726174696F6E0500
+ 00000000CDCCCCFC3F0C50726F70657274794E616D65060A46696C6C2E436F6C
+ 6F720A537461727456616C756507097846464443414530440953746F7056616C
+ 756507097846464646443534310754726967676572061F49734D6F7573654F76
+ 65723D747275653B4973507265737365643D7472756500000A5452656374616E
+ 676C650005416C69676E0706436C69656E740946696C6C2E4B696E6407044E6F
+ 6E65064C6F636B6564090748697454657374080C50616464696E672E4C656674
+ 050000000000000080FF3F0B50616464696E672E546F70050000000000000080
+ FF3F0D50616464696E672E5269676874050000000000000080FF3F0E50616464
+ 696E672E426F74746F6D050000000000000080FF3F0A53697A652E5769647468
+ 05000000000000008003400B53697A652E4865696768740500000000000000F0
+ 04401453697A652E506C6174666F726D44656661756C74080C5374726F6B652E
+ 436F6C6F72070978393646434643464307585261646975730500000000000000
+ 800040075952616469757305000000000000008000400000000B54477269644C
+ 61796F757400095374796C654E616D65060B477269644C61796F75743105416C
+ 69676E070643656E7465720748697454657374080A4974656D48656967687405
+ 00000000000000800040094974656D576964746805000000000000008001400C
+ 50616464696E672E4C6566740500000000000000C000400B50616464696E672E
+ 546F70050000000000000080FF3F0B4F7269656E746174696F6E070A486F7269
+ 7A6F6E74616C0A53697A652E57696474680500000000000000C002400B53697A
+ 652E48656967687405000000000000008000401453697A652E506C6174666F72
+ 6D44656661756C7408000A5452656374616E676C6500095374796C654E616D65
+ 060A52656374616E676C65320A46696C6C2E436F6C6F72070A636C6144696D67
+ 7261790748697454657374080D50616464696E672E5269676874050000000000
+ 00008000400D4D617267696E732E52696768740500000000000000A001400A50
+ 6F736974696F6E2E580500000000000000C000400A506F736974696F6E2E5905
+ 0000000000000080FF3F0B53697A652E48656967687405000000000000008000
+ 401453697A652E506C6174666F726D44656661756C74080B5374726F6B652E4B
+ 696E6407044E6F6E6500000A5452656374616E676C6500095374796C654E616D
+ 65060A52656374616E676C65320A46696C6C2E436F6C6F72070A636C6144696D
+ 677261790748697454657374080D50616464696E672E52696768740500000000
+ 0000008000400A506F736974696F6E2E580500000000000000C000400A506F73
+ 6974696F6E2E590500000000000000C000400A53697A652E5769647468050000
+ 00000000008001400B53697A652E486569676874050000000000000080004014
+ 53697A652E506C6174666F726D44656661756C74080B5374726F6B652E4B696E
+ 6407044E6F6E6500000A5452656374616E676C6500095374796C654E616D6506
+ 0A52656374616E676C65320A46696C6C2E436F6C6F72070A636C6144696D6772
+ 61790748697454657374080D50616464696E672E526967687405000000000000
+ 008000400A506F736974696F6E2E580500000000000000C000400A506F736974
+ 696F6E2E590500000000000000A001400A53697A652E57696474680500000000
+ 0000008001400B53697A652E4865696768740500000000000000800040145369
+ 7A652E506C6174666F726D44656661756C74080B5374726F6B652E4B696E6407
+ 044E6F6E65000000005450463007544C61796F757400095374796C654E616D65
+ 060E436F6D626F42746E5374796C65310A506F736974696F6E2E580500000000
+ 000000BD06400A506F736974696F6E2E590500000000000000C507400A53697A
+ 652E576964746805000000000000009205400B53697A652E4865696768740500
+ 000000000000D003401453697A652E506C6174666F726D44656661756C740800
+ 0A5452656374616E676C6500095374796C654E616D65060A6261636B67726F75
+ 6E6405416C69676E0708436F6E74656E74730A46696C6C2E436F6C6F72070978
+ 4646454645464546074869745465737408074F70616369747905000000000017
+ B7D1F13F0A53697A652E576964746805000000000000009205400B53697A652E
+ 4865696768740500000000000000D003401453697A652E506C6174666F726D44
+ 656661756C74080B5374726F6B652E4B696E6407044E6F6E6507585261646975
+ 7305000000000000008000400759526164697573050000000000000080004000
+ 0A5452656374616E676C650005416C69676E0708436F6E74656E74730946696C
+ 6C2E4B696E6407084772616469656E741446696C6C2E4772616469656E742E50
+ 6F696E74730E0105436F6C6F720709783234463446344634064F666673657405
+ 00000000000000000000000105436F6C6F720709783234454145414541064F66
+ 66736574050000000000EE7CFFFD3F000105436F6C6F72070978344538363836
+ 3836064F6666736574050000000000000080FE3F00000748697454657374080A
+ 53697A652E576964746805000000000000009205400B53697A652E4865696768
+ 740500000000000000D003401453697A652E506C6174666F726D44656661756C
+ 74080C5374726F6B652E436F6C6F720709783438344634463446075852616469
+ 7573050000000000000080004007595261646975730500000000000000800040
+ 00000F54466C6F6174416E696D6174696F6E00084475726174696F6E05000000
+ 0000CDCCCCFC3F0C50726F70657274794E616D6506074F7061636974790A5374
+ 61727456616C756505000000000000000000000953746F7056616C7565050000
+ 000000000080FF3F0754726967676572061049734D6F7573654F7665723D7472
+ 75650E54726967676572496E7665727365061149734D6F7573654F7665723D66
+ 616C736500000F54436F6C6F72416E696D6174696F6E00084475726174696F6E
+ 050000000000CDCCCCFC3F0C50726F70657274794E616D65060A46696C6C2E43
+ 6F6C6F720A537461727456616C756507097846464546454645460953746F7056
+ 616C756507097846464646443534310754726967676572062049734D6F757365
+ 4F7665723D747275653B4973507265737365643D66616C736500000F54436F6C
+ 6F72416E696D6174696F6E00084475726174696F6E050000000000CDCCCCFC3F
+ 0C50726F70657274794E616D65060A46696C6C2E436F6C6F720A537461727456
+ 616C756507097846464646443534310953746F7056616C756507097846464546
+ 454645460754726967676572062149734D6F7573654F7665723D66616C73653B
+ 4973507265737365643D66616C736500000F54436F6C6F72416E696D6174696F
+ 6E00084475726174696F6E050000000000CDCCCCFC3F07496E7665727365090C
+ 50726F70657274794E616D65060A46696C6C2E436F6C6F720A53746172745661
+ 6C756507097846464443414530440953746F7056616C75650709784646464644
+ 3534310754726967676572062049734D6F7573654F7665723D66616C73653B49
+ 73507265737365643D7472756500000F54436F6C6F72416E696D6174696F6E00
+ 084475726174696F6E050000000000CDCCCCFC3F0C50726F70657274794E616D
+ 65060A46696C6C2E436F6C6F720A537461727456616C75650709784646444341
+ 4530440953746F7056616C756507097846464646443534310754726967676572
+ 061F49734D6F7573654F7665723D747275653B4973507265737365643D747275
+ 6500000A5452656374616E676C650005416C69676E0706436C69656E74094669
+ 6C6C2E4B696E6407044E6F6E65064C6F636B6564090748697454657374080C50
+ 616464696E672E4C656674050000000000000080FF3F0B50616464696E672E54
+ 6F70050000000000000080FF3F0D50616464696E672E52696768740500000000
+ 00000080FF3F0E50616464696E672E426F74746F6D050000000000000080FF3F
+ 0A53697A652E576964746805000000000000009205400B53697A652E48656967
+ 68740500000000000000D003401453697A652E506C6174666F726D4465666175
+ 6C74080C5374726F6B652E436F6C6F7207097839364643464346430758526164
+ 6975730500000000000000800040075952616469757305000000000000008000
+ 4000000005545061746800095374796C654E616D650605506174683105416C69
+ 676E070643656E74657209446174612E506174680A4000000005000000000000
+ 000000000000000000010000000000204100000000010000000000A0400000A0
+ 400100000000000000000000000300000000000000000000000A46696C6C2E43
+ 6F6C6F72070A636C6144696D677261790748697454657374080B50616464696E
+ 672E546F70050000000000000080FF3F0A53697A652E57696474680500000000
+ 000000E001400B53697A652E4865696768740500000000000000A00140145369
+ 7A652E506C6174666F726D44656661756C74080C5374726F6B652E436F6C6F72
+ 070A636C6144696D67726179000000}
+ end>
+ Left = 120
+ Top = 424
+ end
+end
diff --git a/LibD28/FMX.frxKerningTableClass.pas b/LibD28/FMX.frxKerningTableClass.pas
new file mode 100644
index 0000000..de396c2
--- /dev/null
+++ b/LibD28/FMX.frxKerningTableClass.pas
@@ -0,0 +1,176 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Font parser }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Aleksey Mandrykin, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxKerningTableClass;
+{$HINTS OFF}
+interface uses System.Classes, FMX.TTFHelpers, FMX.frxFontHeaderClass, FMX.frxTrueTypeTable, System.Generics.Collections;
+
+type // Nested Types
+
+ CommonKerningHeader = packed record
+ public Coverage: Word;
+ public Length: Word;
+ public Version: Word;
+ end;
+
+ FormatZero = packed record
+ public entrySelector: Word;
+ public nPairs: Word;
+ public rangeShift: Word;
+ public searchRange: Word;
+ end;
+
+ FormatZeroPair = packed record
+ public key_value: Cardinal;
+ public value: Smallint;
+ end;
+
+ KerningTableHeader = packed record
+ public Version: Word;
+ public nTables: Word;
+ end;
+
+ KerningSubtableClass = class(TTF_Helpers)
+ // Fields
+ strict private common_header: CommonKerningHeader;
+ strict private format_zero: FormatZero;
+ strict private zero_pairs: TDictionary;
+ // Methods
+ public constructor Create(kerning_table_ptr: Pointer);
+ public destructor Destroy; override;
+
+ strict private function get_Item(inx: Cardinal): Smallint;
+ // Properties
+ public property Item[hash_value: Cardinal]: Smallint read get_Item;
+ public property Length: Word read common_header.Length;
+ end;
+
+ KerningTableClass = class(TrueTypeTable)
+ // Fields
+ strict private kerning_table_header: KerningTableHeader;
+ strict private kerning_subtables_collection: TList;
+ // Methods
+ public constructor Create(src: TrueTypeTable);
+ public Destructor Destroy; override;
+ strict private procedure ChangeEndian;
+ public procedure Load(font: Pointer); override;
+
+ private function get_Item(idx: Cardinal): Smallint;
+ // Properties
+ public property Item[hash_value: Cardinal]: Smallint read get_Item;
+ end;
+
+implementation uses System.SysUtils;
+
+ constructor KerningTableClass.Create(src: TrueTypeTable);
+ begin
+ inherited Create(src);
+ self.kerning_subtables_collection := TList.Create
+ end;
+
+destructor KerningTableClass.Destroy;
+var
+ i: Integer;
+begin
+ for I := 0 to kerning_subtables_collection.Count - 1 do
+ TObject(kerning_subtables_collection[i]).Free;
+
+ kerning_subtables_collection.Free;
+ inherited;
+end;
+
+procedure KerningTableClass.ChangeEndian;
+ begin
+ self.kerning_table_header.nTables := TTF_Helpers.SwapUInt16(self.kerning_table_header.nTables)
+ end;
+
+ function KerningTableClass.get_Item(idx: Cardinal): Smallint;
+ var
+ subtable: KerningSubtableClass;
+ begin
+ subtable := self.kerning_subtables_collection[0];
+ Result := subtable.Item[idx];
+ end;
+
+ procedure KerningTableClass.Load(font: Pointer);
+ var
+ kerning_table_header: ^KerningTableHeader;
+ i: Integer;
+ subtable_ptr: Pointer;
+ subtable: KerningSubtableClass;
+ begin
+ kerning_table_header := TTF_Helpers.Increment(font, self.entry.offset);
+ self.kerning_table_header.nTables := kerning_table_header.nTables;
+ self.ChangeEndian;
+
+ subtable_ptr := TTF_Helpers.Increment(kerning_table_header, SizeOf(KerningTableHeader));
+ i := 0;
+ while ((i < self.kerning_table_header.nTables)) do
+ begin
+ subtable := KerningSubtableClass.Create(subtable_ptr);
+ self.kerning_subtables_collection.Add(subtable);
+ subtable_ptr := TTF_Helpers.Increment(subtable_ptr, subtable.Length);
+ inc(i)
+ end
+ end;
+
+
+ constructor KerningSubtableClass.Create(kerning_table_ptr: Pointer);
+ var
+ subtable: ^CommonKerningHeader;
+ coverage_zero: ^FormatZero;
+ pair_zero: ^FormatZeroPair;
+ single_pair: ^FormatZeroPair;
+ i: Integer;
+ Val: Cardinal;
+ begin
+ zero_pairs := TDictionary.Create;
+ subtable := kerning_table_ptr;
+ self.common_header.Length := TTF_Helpers.SwapUInt16(subtable.Length);
+ self.common_header.Coverage := TTF_Helpers.SwapUInt16(subtable.Coverage);
+ if (self.common_header.Coverage <> 1) then
+ Exit;
+ coverage_zero := TTF_Helpers.Increment(subtable, SizeOf(subtable^));
+ self.format_zero.nPairs := TTF_Helpers.SwapUInt16(coverage_zero.nPairs);
+ self.format_zero.searchRange := TTF_Helpers.SwapUInt16(coverage_zero.searchRange);
+ self.format_zero.entrySelector := TTF_Helpers.SwapUInt16(coverage_zero.entrySelector);
+ self.format_zero.rangeShift := TTF_Helpers.SwapUInt16(coverage_zero.rangeShift);
+
+// pair_zero := TTF_Helpers.Increment( coverage_zero, SizeOf(FormatZero));
+ i := 0;
+ single_pair := TTF_Helpers.Increment( kerning_table_ptr, SizeOf(FormatZero)) ;
+ while ((i < self.format_zero.nPairs)) do
+ begin
+ Val := TTF_Helpers.SwapUInt32(single_pair.key_value);
+ if not self.zero_pairs.ContainsKey(Val) then
+ self.zero_pairs.Add(Val, TTF_Helpers.SwapInt16(single_pair.value));
+// self.zero_pairs.Items[] := );
+// kerning_table_ptr := kerning_table_ptr + SizeOf(single_pair);
+ Inc(single_pair);
+ inc(i)
+ end
+
+ end;
+
+destructor KerningSubtableClass.Destroy;
+begin
+ zero_pairs.Free;
+ inherited;
+end;
+
+function KerningSubtableClass.get_Item(inx: Cardinal): Smallint;
+ begin
+ Result := 0;
+ if zero_pairs.ContainsKey(inx) then
+ Result := zero_pairs.Items[inx];
+ end;
+{$HINTS ON}
+end.
diff --git a/LibD28/FMX.frxLinuxFonts.pas b/LibD28/FMX.frxLinuxFonts.pas
new file mode 100644
index 0000000..e8b3792
--- /dev/null
+++ b/LibD28/FMX.frxLinuxFonts.pas
@@ -0,0 +1,376 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Search for Linux fonts }
+{ }
+{ Copyright (c) 1998-2020 }
+{ by Alexander Syrykh, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+unit FMX.frxLinuxFonts;
+{$I fmx.inc}
+{$I frx.inc}
+interface
+
+uses System.Classes, System.UITypes, System.SysUtils, FMX.Types
+{$IFDEF DELPHI19}
+, FMX.Graphics
+{$ENDIF};
+
+type
+ TfrxFontsList = class
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function GetFontPath(AFont: TFont; FontName: String; SkipList: TList): String;
+ end;
+
+function frxPosixFonts: TfrxFontsList;
+function frxPosixFontsDirs: TStringList;
+
+implementation
+
+uses System.Types, System.IOUtils, FMX.frxTrueTypeCollection, FMX.frxTrueTypeFont, FMX.frxNameTableClass, FMX.frxXML, System.Generics.Collections;
+
+const DefFontsSubs: String =
+ '' +
+ '' +
+ '' +
+ '' +
+ '' +
+ '' +
+ '' +
+ '' +
+ '' +
+ '' +
+ '';
+
+ XMLConfName: String = 'SubFonts.xml';
+type
+ TfrxFontItem = class
+ private
+ FStylesFonts: TStringList;
+ public
+ constructor Create(const Path: String; Style: TFontStyles);
+ procedure AddFont(const Path: String; Style: TFontStyles);
+ function Find(Style: TFontStyles): Integer;
+ function FindPath(Style: TFontStyles): String;
+ destructor Destroy; override;
+ end;
+
+ TfrxFontsCollection = class(TStringList)
+ private
+ FSUBList: TDictionary;
+ public
+ destructor Destroy; override;
+ procedure AfterConstruction; override;
+ procedure ClearSubList;
+ procedure LoadSubstitutionConfig(Stream: TStream); overload;
+ procedure LoadSubstitutionConfig(const FileName: String); overload;
+ procedure AddFont(const FamilyName: String; const Path: String; Style: TFontStyles);
+ function FindFont(Font: TFont): String;
+ end;
+
+var
+ FLFonts: TfrxFontsList = nil;
+ FontCollection: TfrxFontsCollection;
+ FontDirs: TStringList;
+
+{TfrxFontsList}
+constructor TfrxFontsList.Create;
+
+ procedure AddFonts(const aPath: String);
+ var
+ i: Integer;
+ skip_list: TList;
+ ttf: TrueTypeFont;
+ fs: TFontStyles;
+ FontData: TMemoryStream;
+ TrueTypeTables: TrueTypeCollection;
+ begin
+
+ skip_list := TList.Create;
+ TrueTypeTables := TrueTypeCollection.Create;
+ FontData := TMemoryStream.Create;
+ try
+ try
+ FontData.LoadFromFile(aPath);
+ FontData.Position := 0;
+ TrueTypeTables.Initialize(FontData.Memory, FontData.Size);
+ except
+ Exit;
+ end;
+ skip_list.Add(Pointer(TablesID.EmbedBitmapLocation));
+ skip_list.Add(Pointer(TablesID.EmbededBitmapData));
+ skip_list.Add(Pointer(TablesID.HorizontakDeviceMetrix));
+ skip_list.Add(Pointer(TablesID.VerticalDeviceMetrix));
+ skip_list.Add(Pointer(TablesID.DigitalSignature));
+ skip_list.Add(Pointer(TablesID.HorizontalHeader));
+ skip_list.Add(Pointer(TablesID.GlyphSubstitution));
+ skip_list.Add(Pointer(TablesID.IndexToLocation));
+ skip_list.Add(Pointer(TablesID.Glyph));
+ skip_list.Add(Pointer(TablesID.KerningTable));
+ skip_list.Add(Pointer(TablesID.CMAP));
+ skip_list.Add(Pointer(TablesID.Postscript));
+ skip_list.Add(Pointer(TablesID.HorizontalMetrix));
+ skip_list.Add(Pointer(TablesID.PreProgram));
+ skip_list.Add(Pointer(TablesID.MaximumProfile));
+
+ for i := 0 to TrueTypeTables.fonts_collection.Count - 1 do
+ begin
+ fs := [];
+ ttf := TrueTypeFont(TrueTypeTables.fonts_collection[i]);
+ if not ttf.IsLoaded then
+ ttf.PrepareFont(skip_list);
+
+ if ttf.windows_metrix.win_metrix.fsSelection and 32 = 32 then
+ Include(fs, TFontStyle.fsBold);
+ if ttf.windows_metrix.win_metrix.fsSelection and 1 = 1 then
+ Include(fs, TFontStyle.fsItalic);
+ FontCollection.AddFont(ttf.Names.Item[NameID.FamilyName], aPath, fs);
+ end;
+
+ finally
+ TrueTypeTables.Free;
+ skip_list.Free;
+ FontData.Free;
+ end;
+ end;
+
+
+ procedure InitFonts;
+ var
+ i: Integer;
+
+ procedure AddFolder(AFolder: string);
+ var
+ files: TStringDynArray;
+ j: integer;
+ begin
+ AFolder := ExpandFileName(AFolder);
+ if (length(AFolder) <> 0) and (AFolder[length(AFolder)] <> PathDelim) then
+ AFolder := AFolder + PathDelim;
+ try
+ if TDirectory.Exists(AFolder) then
+ files := TDirectory.GetFiles(AFolder, '*.ttf', TSearchOption.soAllDirectories);
+ for j := 0 to Length(files) - 1 do
+ AddFonts(files[j]);
+ finally
+
+ end;
+ end;
+
+ begin
+ for i:= 0 to frxPosixFontsDirs.Count - 1 do
+ AddFolder(frxPosixFontsDirs[i]);
+ end;
+
+var
+ s: TStringStream;
+ fName: String;
+begin
+ FontCollection := TfrxFontsCollection.Create(True);
+ s := TStringStream.Create(DefFontsSubs);
+ try
+ s.Position := 0;
+ FontCollection.LoadSubstitutionConfig(s);
+ finally
+ s.Free;
+ end;
+
+ fName := ExtractFilePath(ParamStr(0)) + XMLConfName;
+ if FileExists(fName) then
+ FontCollection.LoadSubstitutionConfig(fName);
+
+ InitFonts;
+end;
+
+destructor TfrxFontsList.Destroy;
+begin
+ FreeAndNil(FontCollection);
+end;
+
+function TfrxFontsList.GetFontPath(AFont: TFont; FontName: String; SkipList: TList): String;
+var
+ Font: TFont;
+begin
+ Result := '';
+ Result := FontCollection.FindFont(AFont);
+ if (Result = '') then
+ begin
+ Font := TFont.Create;
+ try
+ Font.Assign(AFont);
+ Font.Family := 'FreeSans';
+ Result := FontCollection.FindFont(Font);
+ finally
+ Font.Free;
+ end;
+ end;
+end;
+
+function frxPosixFonts: TfrxFontsList;
+begin
+ if FLFonts = nil then
+ FLFonts := TfrxFontsList.Create;
+ Result := FLFonts;
+end;
+
+{ TfrxFontItem }
+
+procedure TfrxFontItem.AddFont(const Path: String; Style: TFontStyles);
+begin
+ if Find(Style)= -1 then
+ FStylesFonts.AddObject(Path, TObject(Byte(Style)));
+end;
+
+constructor TfrxFontItem.Create(const Path: String; Style: TFontStyles);
+begin
+ FStylesFonts := TStringList.Create;
+ AddFont(Path, Style);
+end;
+
+destructor TfrxFontItem.Destroy;
+begin
+ FreeAndNil(FStylesFonts);
+ inherited;
+end;
+
+function TfrxFontItem.Find(Style: TFontStyles): Integer;
+var
+ i: Integer;
+begin
+ Result := -1;
+ for i := 0 to FStylesFonts.Count - 1 do
+ if Byte(FStylesFonts.Objects[i]) = Byte(Style) then
+ begin
+ Result := i;
+ break;
+ end;
+end;
+
+function TfrxFontItem.FindPath(Style: TFontStyles): String;
+var
+ i: Integer;
+begin
+ Result := '';
+ Style := Style - [TFontStyle.fsUnderline, TFontStyle.fsStrikeOut];
+ i := Find(Style);
+ if i > -1 then Result := FStylesFonts[i];
+end;
+
+{ TfrxFontsCollection }
+
+procedure TfrxFontsCollection.AddFont(const FamilyName, Path: String;
+ Style: TFontStyles);
+var
+ i: Integer;
+begin
+ i := IndexOf(FamilyName);
+ if i < 0 then
+ AddObject(FamilyName, TfrxFontItem.Create(Path, Style))
+ else
+ TfrxFontItem(Objects[i]).AddFont(Path, Style);
+end;
+
+procedure TfrxFontsCollection.AfterConstruction;
+begin
+ inherited;
+ FSUBList := TDictionary.Create;
+end;
+
+procedure TfrxFontsCollection.ClearSubList;
+begin
+ FSUBList.Clear;
+end;
+
+destructor TfrxFontsCollection.Destroy;
+begin
+ FreeAndNil(FSUBList);
+ inherited;
+end;
+
+function TfrxFontsCollection.FindFont(Font: TFont): String;
+var
+ i: Integer;
+ FName: String;
+begin
+ Result := '';
+ if not FSUBList.TryGetValue(Font.Family, FName) then
+ FName := Font.Family;
+ i := IndexOf(FName);
+ if i < 0 then Exit;
+ Result := TfrxFontItem(Objects[i]).FindPath(Font.Style);
+end;
+
+procedure TfrxFontsCollection.LoadSubstitutionConfig(Stream: TStream);
+var
+ XMLDoc: TfrxXMLDocument;
+ Item: TfrxXMLItem;
+ I: Integer;
+ s1, s2: String;
+begin
+ XMLDoc := TfrxXMLDocument.Create;
+ try
+ XMLDoc.LoadFromStream(Stream);
+ Item := XMLDoc.Root;
+ i := XMLDoc.Root.Find('SUBFONTS');
+ if i <> -1 then
+ Item := XMLDoc.Root.Items[i];
+ if Item = nil then Exit;
+ if UpperCase(Item.Prop['Clear']) = 'TRUE' then
+ ClearSubList;
+ for I := 0 to Item.Count - 1 do
+ begin
+ s1 := Item[i].Prop['NAME'];
+ s2 := Item[i].Prop['SUBNAME'];
+ if (s1 <> '') and (s2 <> '') then
+ FSUBList.AddOrSetValue(s1, s2);
+ end;
+ finally
+ XMLDoc.Free;
+ end;
+end;
+
+procedure TfrxFontsCollection.LoadSubstitutionConfig(const FileName: String);
+var
+ s: TFileStream;
+begin
+ s := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ try
+ s.Position := 0;
+ LoadSubstitutionConfig(s);
+ finally
+ s.Free;
+ end;
+end;
+
+function frxPosixFontsDirs: TStringList;
+
+ procedure FillFontPathes(var AList: TStringList); //TODO: Rewrite to parse '/etc/fonts/fonts.conf'
+ begin
+ {$IFDEF LINUX}
+ AList.Add('/usr/share/cups/fonts/');
+ AList.Add('/usr/share/fonts/');
+ AList.Add('/usr/local/lib/X11/fonts/');
+ AList.Add( ExtractFilePath(ParamStr(0))+ 'fonts/');
+ {$ENDIF}
+ end;
+
+begin
+ if FontDirs = nil then
+ begin
+ FontDirs := TStringList.Create;
+ FillFontPathes(FontDirs);
+ end;
+ Result := FontDirs;
+end;
+
+initialization
+
+finalization
+ FreeAndNil(FLFonts);
+ FreeAndNil(FontDirs);
+
+end.
diff --git a/LibD28/FMX.frxMD5.pas b/LibD28/FMX.frxMD5.pas
new file mode 100644
index 0000000..c04fe9b
--- /dev/null
+++ b/LibD28/FMX.frxMD5.pas
@@ -0,0 +1,550 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ MD5 checksum generation }
+{ }
+{******************************************}
+// Original RSA Data Security, Inc. Copyright notice
+/////////////////////////////////////////////////////////////////////////
+//
+// Copyright (C) 1991-2, RSA Data Security, Inc. Created 1991. All
+// rights reserved.
+//
+// License to copy and use this software is granted provided that it
+// is identified as the "RSA Data Security, Inc. MD5 Message-Digest
+// Algorithm" in all material mentioning or referencing this software
+// or this function.
+// License is also granted to make and use derivative works provided
+// that such works are identified as "derived from the RSA Data
+// Security, Inc. MD5 Message-Digest Algorithm" in all material
+// mentioning or referencing the derived work.
+// RSA Data Security, Inc. makes no representations concerning either
+// the merchantability of this software or the suitability of this
+// software for any particular purpose. It is provided "as is"
+// without express or implied warranty of any kind.
+// These notices must be retained in any copies of any part of this
+// documentation and/or software.
+
+unit FMX.frxmd5;
+
+{$I frx.inc}
+
+interface
+
+uses System.Classes;
+
+const
+//Magic initialization constants
+ MD5_INIT_STATE_0 = $67452301;
+ MD5_INIT_STATE_1 = $efcdab89;
+ MD5_INIT_STATE_2 = $98badcfe;
+ MD5_INIT_STATE_3 = $10325476;
+//Constants for Transform routine.
+ MD5_S11 = 7;
+ MD5_S12 = 12;
+ MD5_S13 = 17;
+ MD5_S14 = 22;
+ MD5_S21 = 5;
+ MD5_S22 = 9;
+ MD5_S23 = 14;
+ MD5_S24 = 20;
+ MD5_S31 = 4;
+ MD5_S32 = 11;
+ MD5_S33 = 16;
+ MD5_S34 = 23;
+ MD5_S41 = 6;
+ MD5_S42 = 10;
+ MD5_S43 = 15;
+ MD5_S44 = 21;
+//Transformation Constants - Round 1
+ MD5_T01 = $d76aa478;
+ MD5_T02 = $e8c7b756;
+ MD5_T03 = $242070db;
+ MD5_T04 = $c1bdceee;
+ MD5_T05 = $f57c0faf;
+ MD5_T06 = $4787c62a;
+ MD5_T07 = $a8304613;
+ MD5_T08 = $fd469501;
+ MD5_T09 = $698098d8;
+ MD5_T10 = $8b44f7af;
+ MD5_T11 = $ffff5bb1;
+ MD5_T12 = $895cd7be;
+ MD5_T13 = $6b901122;
+ MD5_T14 = $fd987193;
+ MD5_T15 = $a679438e;
+ MD5_T16 = $49b40821;
+//Transformation Constants - Round 2
+ MD5_T17 = $f61e2562;
+ MD5_T18 = $c040b340;
+ MD5_T19 = $265e5a51;
+ MD5_T20 = $e9b6c7aa;
+ MD5_T21 = $d62f105d;
+ MD5_T22 = $02441453;
+ MD5_T23 = $d8a1e681;
+ MD5_T24 = $e7d3fbc8;
+ MD5_T25 = $21e1cde6;
+ MD5_T26 = $c33707d6;
+ MD5_T27 = $f4d50d87;
+ MD5_T28 = $455a14ed;
+ MD5_T29 = $a9e3e905;
+ MD5_T30 = $fcefa3f8;
+ MD5_T31 = $676f02d9;
+ MD5_T32 = $8d2a4c8a;
+//Transformation Constants - Round 3
+ MD5_T33 = $fffa3942;
+ MD5_T34 = $8771f681;
+ MD5_T35 = $6d9d6122;
+ MD5_T36 = $fde5380c;
+ MD5_T37 = $a4beea44;
+ MD5_T38 = $4bdecfa9;
+ MD5_T39 = $f6bb4b60;
+ MD5_T40 = $bebfbc70;
+ MD5_T41 = $289b7ec6;
+ MD5_T42 = $eaa127fa;
+ MD5_T43 = $d4ef3085;
+ MD5_T44 = $04881d05;
+ MD5_T45 = $d9d4d039;
+ MD5_T46 = $e6db99e5;
+ MD5_T47 = $1fa27cf8;
+ MD5_T48 = $c4ac5665;
+//Transformation Constants - Round 4
+ MD5_T49 = $f4292244;
+ MD5_T50 = $432aff97;
+ MD5_T51 = $ab9423a7;
+ MD5_T52 = $fc93a039;
+ MD5_T53 = $655b59c3;
+ MD5_T54 = $8f0ccc92;
+ MD5_T55 = $ffeff47d;
+ MD5_T56 = $85845dd1;
+ MD5_T57 = $6fa87e4f;
+ MD5_T58 = $fe2ce6e0;
+ MD5_T59 = $a3014314;
+ MD5_T60 = $4e0811a1;
+ MD5_T61 = $f7537e82;
+ MD5_T62 = $bd3af235;
+ MD5_T63 = $2ad7d2bb;
+ MD5_T64 = $eb86d391;
+//Null data (except for first BYTE) used to finalise the checksum calculation
+ PADDING: array [0..63] of byte =
+( $80, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0,
+ 0, 0, 0, 0, 0, 0, 0, 0);
+
+
+type
+ uint4 = longword;
+ uchar = byte;
+ Puint4 = ^uint4;
+ Puchar = ^uchar;
+
+ TfrxMD5 = class (TObject)
+ private
+ m_State: array [0..3] of uint4;
+ m_Count: array [0..1] of uint4;
+ m_Buffer: array [0..63] of uchar;
+ m_Digest: array [0..15] of uchar;
+ procedure Transform(block: Puchar);
+ procedure Encode(dest: Puchar; src: Puint4; nLength: uint4);
+ procedure Decode(dest: Puint4; src: Puchar; nLength: uint4);
+ function RotateLeft(x: uint4; n: uint4): uint4;
+ procedure FF(var a: uint4; b: uint4; c: uint4; d: uint4; x: uint4; s: uint4; ac: uint4);
+ procedure GG(var a: uint4; b: uint4; c: uint4; d: uint4; x: uint4; s: uint4; ac: uint4);
+ procedure HH(var a: uint4; b: uint4; c: uint4; d: uint4; x: uint4; s: uint4; ac: uint4);
+ procedure II(var a: uint4; b: uint4; c: uint4; d: uint4; x: uint4; s: uint4; ac: uint4);
+ public
+ constructor Create;
+ procedure Init;
+ procedure Update(chInput: Puchar; nInputLen: uint4);
+ procedure Finalize;
+ function Digest: Puchar;
+ end;
+
+function MD5String(szString: AnsiString): AnsiString;
+function MD5File(szFilename: String): AnsiString;
+function MD5Stream(Stream: TStream): AnsiString;
+procedure MD5Buf(Buf: Pointer; const Len: Integer; Digest: Pointer);
+function PrintMD5(md5Digest: Puchar): AnsiString;
+
+implementation
+
+uses System.SysUtils{$IFDEF Delphi12}, System.AnsiStrings{$ENDIF};
+
+{$IFOPT Q+}
+ {$DEFINE OVERDEF}
+ {$Q-}
+{$ENDIF}
+
+
+function Byte2Hex(const b: byte): AnsiString;
+var
+ H, L: Byte;
+ function HexChar(N : Byte) : AnsiChar;
+ begin
+ if (N < 10) then Result := AnsiChar(Chr(Ord('0') + N))
+ else Result := AnsiChar(Chr(Ord('A') + (N - 10)));
+ end;
+begin
+ SetLength(Result, 2);
+ H := (b shr 4) and $f;
+ L := b and $f;
+ Result[1] := HexChar(H);
+ Result[2]:= HexChar(L);
+end;
+
+// PrintMD5: Converts a completed md5 digest into a char* string.
+function PrintMD5(md5Digest: Puchar): AnsiString;
+var
+ nCount: Integer;
+ tmp: Puchar;
+begin
+ Result := '';
+ tmp := md5Digest;
+ for nCount := 0 to 15 do
+ begin
+ Result := Result + LowerCase(Byte2Hex(Byte(tmp^)));
+ Inc(tmp);
+ end;
+end;
+
+// MD5String: Performs the MD5 algorithm on a char* string, returning
+// the results as a char*.
+function MD5String(szString: AnsiString): AnsiString;
+var
+ nLen: Integer;
+ alg: TfrxMD5;
+begin
+ Result := '';
+ alg := TfrxMD5.Create;
+ try
+ nLen := Length(szString);
+ alg.Update(Puchar(szString), nLen);
+ alg.Finalize;
+ Result := PrintMD5(alg.Digest);
+ finally
+ alg.Free;
+ end;
+end;
+
+function MD5Stream(Stream: TStream): AnsiString;
+var
+ nLen: Integer;
+ buf: array [0..255] of AnsiChar;
+ alg: TfrxMD5;
+ oldpos: Longint;
+begin
+ Result := '';
+ alg := TfrxMD5.Create;
+ oldpos := Stream.Position;
+ try
+ Stream.Position := 0;
+ nLen := 256;
+ while nLen = 256 do
+ begin
+ nLen := Stream.Read(buf, nLen);
+ alg.Update(@buf, nLen);
+ end;
+ alg.Finalize;
+ Result := PrintMD5(alg.Digest);
+ finally
+ Stream.Position := oldpos;
+ alg.Free;
+ end;
+end;
+
+function MD5File(szFilename: String): AnsiString;
+var
+ f: TFileStream;
+begin
+ Result := '';
+ f := TFileStream.Create(szFilename, fmOpenRead + fmShareDenyWrite);
+ try
+ Result := MD5Stream(f);
+ finally
+ f.Free
+ end;
+end;
+
+procedure MD5Buf(Buf: Pointer; const Len: Integer; Digest: Pointer);
+var
+ md5: TfrxMD5;
+ d: Puchar;
+begin
+ md5 := TfrxMD5.Create;
+ try
+ md5.Update(Buf, Len);
+ md5.Finalize;
+ d := md5.Digest;
+ Move(d^, digest^, 16);
+ finally
+ md5.Free;
+ end;
+end;
+
+{ TfrxMD5 }
+constructor TfrxMD5.Create;
+begin
+ Init;
+end;
+
+// md5::Init
+// Initializes a new context.
+procedure TfrxMD5.Init;
+begin
+ FillChar(m_Count, 2 * SizeOf(uint4), 0);
+ m_State[0] := MD5_INIT_STATE_0;
+ m_State[1] := MD5_INIT_STATE_1;
+ m_State[2] := MD5_INIT_STATE_2;
+ m_State[3] := MD5_INIT_STATE_3;
+end;
+
+// MD5 block update operation. Continues an MD5 message-digest
+// operation, processing another message block, and updating the
+// context.
+procedure TfrxMD5.Update(chInput: Puchar; nInputLen: uint4);
+var
+ i, index, partLen: uint4;
+ tmp: Puchar;
+begin
+ // Compute number of bytes mod 64
+ index := (m_Count[0] shr 3) and $3F;
+ // Update number of bits
+ m_Count[0] := m_Count[0] + (nInputLen shl 3);
+ if m_Count[0] < (nInputLen shl 3) then
+ m_Count[1] := m_Count[1] + 1;
+ m_Count[1] := m_Count[1] + (nInputLen shr 29);
+ partLen := 64 - index;
+ // Transform as many times as possible.
+ if nInputLen >= partLen then
+ begin
+ Move(chInput^, m_Buffer[index], partLen);
+ Transform(Puchar(@m_Buffer));
+ i := partLen;
+ while (i + 63) < nInputLen do
+ begin
+ tmp := chInput;
+ Inc(tmp, i);
+ Transform(tmp);
+ i := i + 64;
+ end;
+ index := 0;
+ end else
+ i := 0;
+ // Buffer remaining input
+ tmp := chInput;
+ Inc(tmp, i);
+ Move(tmp^, m_Buffer[index], nInputLen - i);
+end;
+
+// MD5 finalization. Ends an MD5 message-digest operation, writing
+// the message digest and zeroizing the context.
+procedure TfrxMD5.Finalize;
+var
+ bits: array [0..7] of uchar;
+ index, padLen: uint4;
+begin
+ // Save number of bits
+ Encode(Puchar(@bits), Puint4(@m_Count), 8);
+ // Pad out to 56 mod 64
+ index := (m_Count[0] shr 3) and $3f;
+ if index < 56 then
+ padLen := 56 - index
+ else
+ padLen := 120 - index;
+ Update(Puchar(@PADDING), padLen);
+ // Append length (before padding)
+ Update(Puchar(@bits), 8);
+ // Store state in digest
+ Encode(Puchar(@m_Digest), Puint4(@m_State), 16);
+ FillChar(m_Count, 2 * sizeof(uint4), 0);
+ FillChar(m_State, 4 * sizeof(uint4), 0);
+ FillChar(m_Buffer, 64 * sizeof(uchar), 0);
+end;
+
+function TfrxMD5.Digest: Puchar;
+begin
+ Result := Puchar(@m_Digest);
+end;
+
+// MD5 basic transformation. Transforms state based on block.
+procedure TfrxMD5.Transform(block: Puchar);
+var
+ a, b, c, d: uint4;
+ X: array [0..15] of uint4;
+begin
+ a := m_State[0];
+ b := m_State[1];
+ c := m_State[2];
+ d := m_State[3];
+ Decode(Puint4(@X), block, 64);
+ //Perform Round 1 of the transformation
+ FF (a, b, c, d, X[ 0], MD5_S11, MD5_T01);
+ FF (d, a, b, c, X[ 1], MD5_S12, MD5_T02);
+ FF (c, d, a, b, X[ 2], MD5_S13, MD5_T03);
+ FF (b, c, d, a, X[ 3], MD5_S14, MD5_T04);
+ FF (a, b, c, d, X[ 4], MD5_S11, MD5_T05);
+ FF (d, a, b, c, X[ 5], MD5_S12, MD5_T06);
+ FF (c, d, a, b, X[ 6], MD5_S13, MD5_T07);
+ FF (b, c, d, a, X[ 7], MD5_S14, MD5_T08);
+ FF (a, b, c, d, X[ 8], MD5_S11, MD5_T09);
+ FF (d, a, b, c, X[ 9], MD5_S12, MD5_T10);
+ FF (c, d, a, b, X[10], MD5_S13, MD5_T11);
+ FF (b, c, d, a, X[11], MD5_S14, MD5_T12);
+ FF (a, b, c, d, X[12], MD5_S11, MD5_T13);
+ FF (d, a, b, c, X[13], MD5_S12, MD5_T14);
+ FF (c, d, a, b, X[14], MD5_S13, MD5_T15);
+ FF (b, c, d, a, X[15], MD5_S14, MD5_T16);
+ //Perform Round 2 of the transformation
+ GG (a, b, c, d, X[ 1], MD5_S21, MD5_T17);
+ GG (d, a, b, c, X[ 6], MD5_S22, MD5_T18);
+ GG (c, d, a, b, X[11], MD5_S23, MD5_T19);
+ GG (b, c, d, a, X[ 0], MD5_S24, MD5_T20);
+ GG (a, b, c, d, X[ 5], MD5_S21, MD5_T21);
+ GG (d, a, b, c, X[10], MD5_S22, MD5_T22);
+ GG (c, d, a, b, X[15], MD5_S23, MD5_T23);
+ GG (b, c, d, a, X[ 4], MD5_S24, MD5_T24);
+ GG (a, b, c, d, X[ 9], MD5_S21, MD5_T25);
+ GG (d, a, b, c, X[14], MD5_S22, MD5_T26);
+ GG (c, d, a, b, X[ 3], MD5_S23, MD5_T27);
+ GG (b, c, d, a, X[ 8], MD5_S24, MD5_T28);
+ GG (a, b, c, d, X[13], MD5_S21, MD5_T29);
+ GG (d, a, b, c, X[ 2], MD5_S22, MD5_T30);
+ GG (c, d, a, b, X[ 7], MD5_S23, MD5_T31);
+ GG (b, c, d, a, X[12], MD5_S24, MD5_T32);
+ //Perform Round 3 of the transformation
+ HH (a, b, c, d, X[ 5], MD5_S31, MD5_T33);
+ HH (d, a, b, c, X[ 8], MD5_S32, MD5_T34);
+ HH (c, d, a, b, X[11], MD5_S33, MD5_T35);
+ HH (b, c, d, a, X[14], MD5_S34, MD5_T36);
+ HH (a, b, c, d, X[ 1], MD5_S31, MD5_T37);
+ HH (d, a, b, c, X[ 4], MD5_S32, MD5_T38);
+ HH (c, d, a, b, X[ 7], MD5_S33, MD5_T39);
+ HH (b, c, d, a, X[10], MD5_S34, MD5_T40);
+ HH (a, b, c, d, X[13], MD5_S31, MD5_T41);
+ HH (d, a, b, c, X[ 0], MD5_S32, MD5_T42);
+ HH (c, d, a, b, X[ 3], MD5_S33, MD5_T43);
+ HH (b, c, d, a, X[ 6], MD5_S34, MD5_T44);
+ HH (a, b, c, d, X[ 9], MD5_S31, MD5_T45);
+ HH (d, a, b, c, X[12], MD5_S32, MD5_T46);
+ HH (c, d, a, b, X[15], MD5_S33, MD5_T47);
+ HH (b, c, d, a, X[ 2], MD5_S34, MD5_T48);
+ //Perform Round 4 of the transformation
+ II (a, b, c, d, X[ 0], MD5_S41, MD5_T49);
+ II (d, a, b, c, X[ 7], MD5_S42, MD5_T50);
+ II (c, d, a, b, X[14], MD5_S43, MD5_T51);
+ II (b, c, d, a, X[ 5], MD5_S44, MD5_T52);
+ II (a, b, c, d, X[12], MD5_S41, MD5_T53);
+ II (d, a, b, c, X[ 3], MD5_S42, MD5_T54);
+ II (c, d, a, b, X[10], MD5_S43, MD5_T55);
+ II (b, c, d, a, X[ 1], MD5_S44, MD5_T56);
+ II (a, b, c, d, X[ 8], MD5_S41, MD5_T57);
+ II (d, a, b, c, X[15], MD5_S42, MD5_T58);
+ II (c, d, a, b, X[ 6], MD5_S43, MD5_T59);
+ II (b, c, d, a, X[13], MD5_S44, MD5_T60);
+ II (a, b, c, d, X[ 4], MD5_S41, MD5_T61);
+ II (d, a, b, c, X[11], MD5_S42, MD5_T62);
+ II (c, d, a, b, X[ 2], MD5_S43, MD5_T63);
+ II (b, c, d, a, X[ 9], MD5_S44, MD5_T64);
+ m_State[0] := m_State[0] + a;
+ m_State[1] := m_State[1] + b;
+ m_State[2] := m_State[2] + c;
+ m_State[3] := m_State[3] + d;
+ FillChar(X, sizeof(X), 0);
+end;
+
+// Encodes input (uint4) into output (uchar). Assumes nLength is
+// a multiple of 4.
+procedure TfrxMD5.Encode(dest: Puchar; src: Puint4; nLength: uint4);
+var
+ j: uint4;
+ tmp: Puchar;
+ tmp2: Puint4;
+begin
+ j := 0;
+ tmp := dest;
+ tmp2 := src;
+ while j < nLength do
+ begin
+ tmp^ := uchar(tmp2^ and $ff);
+ Inc(tmp);
+ tmp^ := uchar((tmp2^ shr 8) and $ff);
+ Inc(tmp);
+ tmp^ := uchar((tmp2^ shr 16) and $ff);
+ Inc(tmp);
+ tmp^ := uchar((tmp2^ shr 24) and $ff);
+ Inc(tmp);
+ Inc(tmp2);
+ j := j + 4;
+ end;
+end;
+
+// Decodes input (uchar) into output (uint4). Assumes nLength is
+// a multiple of 4.
+procedure TfrxMD5.Decode(dest: Puint4; src: Puchar; nLength: uint4);
+var
+ j: uint4;
+ tmp2: Puchar;
+ tmp: Puint4;
+begin
+ j := 0;
+ tmp := dest;
+ tmp2 := src;
+ while j < nLength do
+ begin
+ tmp^ := uint4(tmp2^);
+ Inc(tmp2);
+ tmp^ := tmp^ or uint4(tmp2^ shl 8);
+ Inc(tmp2);
+ tmp^ := tmp^ or uint4(tmp2^ shl 16);
+ Inc(tmp2);
+ tmp^ := tmp^ or uint4(tmp2^ shl 24);
+ Inc(tmp2);
+ Inc(tmp);
+ j := j + 4;
+ end;
+end;
+
+function TfrxMD5.RotateLeft(x: uint4; n: uint4): uint4;
+begin
+ Result := (x shl n) or (x shr (32 - n));
+end;
+
+procedure TfrxMD5.FF(var a: uint4; b: uint4; c: uint4; d: uint4; x: uint4; s: uint4; ac: uint4);
+begin
+ a := a + ((b and c) or (not b and d)) + x + ac;
+ a := RotateLeft(a, s);
+ a := a + b;
+end;
+
+procedure TfrxMD5.GG(var a: uint4; b: uint4; c: uint4; d: uint4; x: uint4; s: uint4; ac: uint4);
+begin
+ a := a + ((b and d) or (c and (not d))) + x + ac;
+ a := RotateLeft(a, s);
+ a := a + b;
+end;
+
+procedure TfrxMD5.HH(var a: uint4; b: uint4; c: uint4; d: uint4; x: uint4; s: uint4; ac: uint4);
+begin
+ a := a + (b xor c xor d) + x + ac;
+ a := RotateLeft(a, s);
+ a := a + b;
+end;
+
+procedure TfrxMD5.II(var a: uint4; b: uint4; c: uint4; d: uint4; x: uint4; s: uint4; ac: uint4);
+begin
+ a := a + (c xor (b or (not d))) + x + ac;
+ a := RotateLeft(a, s);
+ a := a + b;
+end;
+
+{$IFDEF OVERDEF}
+ {$UNDEF OVERDEF}
+ {$Q+}
+{$ENDIF}
+
+end.
diff --git a/LibD28/FMX.frxMaximumProfileClass.pas b/LibD28/FMX.frxMaximumProfileClass.pas
new file mode 100644
index 0000000..44da5bc
--- /dev/null
+++ b/LibD28/FMX.frxMaximumProfileClass.pas
@@ -0,0 +1,117 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Font parser }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Aleksey Mandrykin, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxMaximumProfileClass;
+interface uses FMX.TTFHelpers, FMX.frxTrueTypeTable;
+
+ type // Nested Types
+ MaximumProfile = packed record
+ public maxComponentDepth: Word;
+ public maxComponentElements: Word;
+ public maxCompositeContours: Word;
+ public maxCompositePoints: Word;
+ public maxContours: Word;
+ public maxFunctionDefs: Word;
+ public maxInstructionDefs: Word;
+ public maxPoints: Word;
+ public maxSizeOfInstructions: Word;
+ public maxStackElements: Word;
+ public maxStorage: Word;
+ public maxTwilightPoints: Word;
+ public maxZones: Word;
+ public numGlyphs: Word;
+ public Version: Cardinal;
+ end;
+
+ MaximumProfileClass = class(TrueTypeTable)
+ strict private max_profile: MaximumProfile;
+
+ public constructor Create(src: TrueTypeTable);
+ strict private procedure ChangeEndian;
+ public procedure Load(font: Pointer); override;
+ public function Save(font: Pointer; offset: Cardinal): Cardinal; override;
+end;
+
+implementation
+
+ constructor MaximumProfileClass.Create(src: TrueTypeTable);
+ begin
+ inherited Create(src);
+ end;
+
+ procedure MaximumProfileClass.ChangeEndian;
+ begin
+ self.max_profile.Version := TTF_Helpers.SwapUInt32(self.max_profile.Version);
+ self.max_profile.numGlyphs := TTF_Helpers.SwapUInt16(self.max_profile.numGlyphs);
+ self.max_profile.maxPoints := TTF_Helpers.SwapUInt16(self.max_profile.maxPoints);
+ self.max_profile.maxContours := TTF_Helpers.SwapUInt16(self.max_profile.maxContours);
+ self.max_profile.maxCompositePoints := TTF_Helpers.SwapUInt16(self.max_profile.maxCompositePoints);
+ self.max_profile.maxCompositeContours := TTF_Helpers.SwapUInt16(self.max_profile.maxCompositeContours);
+ self.max_profile.maxZones := TTF_Helpers.SwapUInt16(self.max_profile.maxZones);
+ self.max_profile.maxTwilightPoints := TTF_Helpers.SwapUInt16(self.max_profile.maxTwilightPoints);
+ self.max_profile.maxStorage := TTF_Helpers.SwapUInt16(self.max_profile.maxStorage);
+ self.max_profile.maxFunctionDefs := TTF_Helpers.SwapUInt16(self.max_profile.maxFunctionDefs);
+ self.max_profile.maxInstructionDefs := TTF_Helpers.SwapUInt16(self.max_profile.maxInstructionDefs);
+ self.max_profile.maxStackElements := TTF_Helpers.SwapUInt16(self.max_profile.maxStackElements);
+ self.max_profile.maxSizeOfInstructions := TTF_Helpers.SwapUInt16(self.max_profile.maxSizeOfInstructions);
+ self.max_profile.maxComponentElements := TTF_Helpers.SwapUInt16(self.max_profile.maxComponentElements);
+ self.max_profile.maxComponentDepth := TTF_Helpers.SwapUInt16(self.max_profile.maxComponentDepth)
+ end;
+
+ procedure MaximumProfileClass.Load(font: Pointer);
+ var
+ max_profile: ^MaximumProfile;
+ begin
+ max_profile := TTF_Helpers.Increment(font, self.entry.offset);
+ self.max_profile.Version := max_profile.Version;
+ self.max_profile.numGlyphs := max_profile.numGlyphs;
+ self.max_profile.maxPoints := max_profile.maxPoints;
+ self.max_profile.maxContours := max_profile.maxContours;
+ self.max_profile.maxCompositePoints := max_profile.maxCompositePoints;
+ self.max_profile.maxCompositeContours := max_profile.maxCompositeContours;
+ self.max_profile.maxZones := max_profile.maxZones;
+ self.max_profile.maxTwilightPoints := max_profile.maxTwilightPoints;
+ self.max_profile.maxStorage := max_profile.maxStorage;
+ self.max_profile.maxFunctionDefs := max_profile.maxFunctionDefs;
+ self.max_profile.maxInstructionDefs := max_profile.maxInstructionDefs;
+ self.max_profile.maxStackElements := max_profile.maxStackElements;
+ self.max_profile.maxSizeOfInstructions := max_profile.maxSizeOfInstructions;
+ self.max_profile.maxComponentElements := max_profile.maxComponentElements;
+ self.max_profile.maxComponentDepth := max_profile.maxComponentDepth;
+ self.ChangeEndian
+ end;
+
+ function MaximumProfileClass.Save(font: Pointer; offset: Cardinal): Cardinal;
+ var
+ max_profile: ^MaximumProfile;
+ begin
+ self.entry.offset := offset;
+ self.ChangeEndian;
+ max_profile := TTF_Helpers.Increment(font, self.entry.offset);
+ max_profile.Version := self.max_profile.Version;
+ max_profile.numGlyphs := self.max_profile.numGlyphs;
+ max_profile.maxPoints := self.max_profile.maxPoints;
+ max_profile.maxContours := self.max_profile.maxContours;
+ max_profile.maxCompositePoints := self.max_profile.maxCompositePoints;
+ max_profile.maxCompositeContours := self.max_profile.maxCompositeContours;
+ max_profile.maxZones := self.max_profile.maxZones;
+ max_profile.maxTwilightPoints := self.max_profile.maxTwilightPoints;
+ max_profile.maxStorage := self.max_profile.maxStorage;
+ max_profile.maxFunctionDefs := self.max_profile.maxFunctionDefs;
+ max_profile.maxInstructionDefs := self.max_profile.maxInstructionDefs;
+ max_profile.maxStackElements := self.max_profile.maxStackElements;
+ max_profile.maxSizeOfInstructions := self.max_profile.maxSizeOfInstructions;
+ max_profile.maxComponentElements := self.max_profile.maxComponentElements;
+ max_profile.maxComponentDepth := self.max_profile.maxComponentDepth;
+ self.ChangeEndian;
+ Result := offset + self.entry.length
+ end;
+end.
diff --git a/LibD28/FMX.frxNameTableClass.pas b/LibD28/FMX.frxNameTableClass.pas
new file mode 100644
index 0000000..bbf43f0
--- /dev/null
+++ b/LibD28/FMX.frxNameTableClass.pas
@@ -0,0 +1,147 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Font parser }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Aleksey Mandrykin, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxNameTableClass;
+
+interface uses FMX.TTFHelpers, FMX.frxFontHeaderClass, FMX.frxTrueTypeTable;
+
+type
+ NameID = (CompatibleFull=$12, CopyrightNotice=0, Description=10, Designer=9,
+ FamilyName=1, FullName=4, LicenseDescription=13, LicenseInfoURL=14,
+ Manufacturer=8, PostscriptCID=20, PostscriptName=6, PreferredFamily=$10,
+ PreferredSubFamily=$11, SampleText=$13, SubFamilyName=2, Trademark=7,
+ UniqueID=3, URL_Designer=12, URL_Vendor=11, Version=5, WWS_Family_Name=$15,
+ WWS_SubFamily_Name=$16);
+
+ NamingTableHeader = packed record
+ public
+ TableVersion: Word;
+ Count: Word;
+ stringOffset: Word;
+ end;
+
+ NamingRecord = packed record
+ public
+ PlatformID: Word;
+ EncodingID: Word;
+ LanguageID: Word;
+ NameID: Word;
+ Length: Word;
+ Offset: Word;
+ end;
+
+ NameTableClass = class(TrueTypeTable)
+ // Fields
+ private
+ name_header: NamingTableHeader;
+ namerecord_ptr: Pointer;
+ string_storage_ptr: Pointer;
+
+ // Methods
+ public constructor Create(src: TrueTypeTable);
+ strict private procedure ChangeEndian;
+ public procedure Load(font: Pointer); override;
+ strict private function get_Item(Index: NameID): string;
+
+ // Properties
+ public property Item[Index: NameID]: string read get_Item;
+ end;
+
+ implementation
+
+ constructor NameTableClass.Create(src: TrueTypeTable);
+ begin
+ inherited Create(src);
+ end;
+
+ function NameTableClass.get_Item(Index: NameID): string;
+ var
+ i,j,sz: Integer;
+ name_record_ptr: ^NamingRecord;
+ name_rec: NamingRecord;
+ string_ptr: PWord;
+
+ pStr: PAnsiChar;
+ psName: PWideChar;
+
+ begin
+ Result := '';
+ name_record_ptr := namerecord_ptr;
+ for i := 0 to name_header.Count do
+ begin
+ name_rec.PlatformID := SwapUInt16(name_record_ptr.PlatformID);
+ name_rec.EncodingID := SwapUInt16(name_record_ptr.EncodingID);
+ name_rec.LanguageID := SwapUInt16(name_record_ptr.LanguageID);
+ name_rec.NameID := SwapUInt16(name_record_ptr.NameID);
+ name_rec.Length := SwapUInt16(name_record_ptr.Length);
+ name_rec.Offset := SwapUInt16(name_record_ptr.Offset);
+ string_ptr := TTF_Helpers.Increment(string_storage_ptr, name_rec.Offset);
+ if (name_rec.PlatformID = 1) and (NameID(name_rec.NameID) = Index) then
+ begin
+ GetMem(pStr, name_rec.Length);
+ try
+ SetLength(Result, name_rec.Length * 2);
+ sz := Utf8ToUnicode(PWideChar(Result), name_rec.Length * 2, PAnsiChar(string_ptr), name_rec.Length);
+ if Result[sz] = #0 then
+ SetLength(Result, sz - 1)
+ else
+ SetLength(Result, sz);
+ finally
+ FreeMem(pStr, name_rec.Length)
+ end;
+ Exit;
+ end
+ else if (((name_rec.PlatformID = 3) and (name_rec.EncodingID = 1))
+ or (name_rec.PlatformID = 0)) and (NameID(name_rec.NameID) = Index) then
+ begin
+ GetMem(psName, name_rec.Length + 2);
+ GetMem(pStr, name_rec.Length);
+ try
+ for j := 0 to name_rec.Length div 2 do
+ begin
+ psName[j] := WideChar(SwapUInt16(string_ptr^));
+ Inc(string_ptr);
+ end;
+ psName[name_rec.Length div 2] := #0;
+ sz := LocaleCharsFromUnicode( DefaultSystemCodePage, 0, PWideChar(psName), name_rec.Length Div 2, pStr, name_rec.Length, nil, nil);
+ Result := String(pStr);
+ if sz > 0 then SetLength(Result, sz);
+ finally
+ FreeMem(pStr, name_rec.Length);
+ FreeMem(psName, name_rec.Length + 2);
+ end;
+ Exit;
+ end;
+ Inc(name_record_ptr);
+ end;
+ end;
+
+ procedure NameTableClass.ChangeEndian;
+ begin
+ self.name_header.Count := TTF_Helpers.SwapUInt16(self.name_header.Count);
+ self.name_header.stringOffset := TTF_Helpers.SwapUInt16(self.name_header.stringOffset);
+ self.name_header.TableVersion := TTF_Helpers.SwapUInt16(self.name_header.TableVersion);
+ end;
+
+ procedure NameTableClass.Load(font: Pointer);
+ var
+ pNTH: ^NamingTableHeader;
+ begin
+ pNTH := TTF_Helpers.Increment( font, self.entry.offset );
+ name_header.TableVersion := pNTH.TableVersion;
+ name_header.stringOffset := pNTH.stringOffset;
+ name_header.Count := pNTH.Count;
+ ChangeEndian;
+ namerecord_ptr := Pointer(NativeInt(pNTH) + SizeOf(NamingTableHeader));
+ string_storage_ptr := Pointer(NativeInt(pNTH) + name_header.stringOffset);
+ end;
+
+end.
diff --git a/LibD28/FMX.frxNewItem.pas b/LibD28/FMX.frxNewItem.pas
new file mode 100644
index 0000000..de241b6
--- /dev/null
+++ b/LibD28/FMX.frxNewItem.pas
@@ -0,0 +1,170 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ New item dialog }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit frxNewItem;
+
+interface
+
+{$I frx.inc}
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ ComCtrls, StdCtrls, ImgList;
+
+type
+ TfrxNewItemForm = class(TForm)
+ Pages: TPageControl;
+ ItemsTab: TTabSheet;
+ OkB: TButton;
+ CancelB: TButton;
+ TemplateTab: TTabSheet;
+ InheritCB: TCheckBox;
+ TemplateLV: TListView;
+ ItemsLV: TListView;
+ procedure FormCreate(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure ItemsLVDblClick(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+ private
+ { Private declarations }
+ FTemplates: TStringList;
+ public
+ { Public declarations }
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ end;
+
+
+implementation
+
+{$R *.DFM}
+
+uses frxClass, frxDesgn, frxDsgnIntf, frxUtils, frxRes;
+
+
+constructor TfrxNewItemForm.Create(AOwner: TComponent);
+begin
+ inherited;
+ FTemplates := TStringList.Create;
+ FTemplates.Sorted := True;
+end;
+
+destructor TfrxNewItemForm.Destroy;
+begin
+ FTemplates.Free;
+ inherited;
+end;
+
+procedure TfrxNewItemForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(5300);
+ ItemsTab.Caption := frxGet(5301);
+ TemplateTab.Caption := frxGet(5302);
+ InheritCB.Caption := frxGet(5303);
+ OkB.Caption := frxGet(1);
+ CancelB.Caption := frxGet(2);
+ ItemsLV.LargeImages := frxResources.WizardImages;
+ TemplateLV.LargeImages := frxResources.WizardImages;
+
+ if UseRightToLeftAlignment then
+ FlipChildren(True);
+end;
+
+procedure TfrxNewItemForm.FormShow(Sender: TObject);
+var
+ i: Integer;
+ Item: TfrxWizardItem;
+ lvItem: TListItem;
+begin
+ for i := 0 to frxWizards.Count - 1 do
+ begin
+ Item := frxWizards[i];
+ if (Item.ButtonBmp <> nil) and (Item.ButtonImageIndex = -1) then
+ begin
+ frxResources.SetWizardImages(Item.ButtonBmp);
+ Item.ButtonImageIndex := frxResources.WizardImages.Count - 1;
+ end;
+
+ lvItem := ItemsLV.Items.Add;
+ lvItem.Caption := Item.ClassRef.GetDescription;
+ lvItem.Data := Item;
+ lvItem.ImageIndex := Item.ButtonImageIndex;
+ end;
+
+ TfrxDesignerForm(Owner).GetTemplateList(FTemplates);
+ for i := 0 to FTemplates.Count - 1 do
+ begin
+ lvItem := TemplateLV.Items.Add;
+ lvItem.Caption := ExtractFileName(FTemplates[i]);
+ lvItem.Data := Pointer(i);
+ lvItem.ImageIndex := 5;
+ end;
+end;
+
+procedure TfrxNewItemForm.ItemsLVDblClick(Sender: TObject);
+begin
+ ModalResult := mrOk;
+end;
+
+procedure TfrxNewItemForm.FormDestroy(Sender: TObject);
+var
+ w: TfrxCustomWizard;
+ Designer: TfrxDesignerForm;
+ Report: TfrxReport;
+ templ: String;
+begin
+ if ModalResult = mrOk then
+ begin
+ if (Pages.ActivePage = ItemsTab) and (ItemsLV.Selected <> nil) then
+ begin
+ w := TfrxCustomWizard(TfrxWizardItem(ItemsLV.Selected.Data).ClassRef.NewInstance);
+ w.Create(Owner);
+ if w.Execute then
+ w.Designer.Modified := True;
+ w.Free;
+ end
+ else if (Pages.ActivePage = TemplateTab) and (TemplateLV.Selected <> nil) then
+ begin
+ Designer := TfrxDesignerForm(Owner);
+ Report := Designer.Report;
+ templ := FTemplates[Integer(TemplateLV.Selected.Data)];
+ Designer.Lock;
+ try
+ Report.Clear;
+ if InheritCB.Checked then
+ Report.ParentReport := ExtractRelativePath(
+ Report.GetApplicationFolder, templ)
+ else
+ begin
+ if Assigned(Report.OnLoadTemplate) then
+ Report.OnLoadTemplate(Report, templ)
+ else
+ Report.LoadFromFile(templ);
+ end;
+ finally
+ Report.FileName := '';
+ Designer.ReloadReport;
+ end;
+ end;
+ end;
+end;
+
+procedure TfrxNewItemForm.FormKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ if Key = VK_F1 then
+ frxResources.Help(Self);
+end;
+
+end.
diff --git a/LibD28/FMX.frxOS2WindowsMetricsClass.pas b/LibD28/FMX.frxOS2WindowsMetricsClass.pas
new file mode 100644
index 0000000..0595dd2
--- /dev/null
+++ b/LibD28/FMX.frxOS2WindowsMetricsClass.pas
@@ -0,0 +1,214 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Font parser }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Aleksey Mandrykin, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxOS2WindowsMetricsClass;
+interface uses FMX.TTFHelpers, FMX.frxTrueTypeTable;
+{$HINTS OFF}
+type
+ TVendorID = packed array[0..3] of Byte;
+ TPanose = packed array[0..9] of Byte;
+ OS2WindowsMetrics = packed record
+ public Version: Word; // version number 0x0004
+ public xAvgCharWidth: Smallint;
+ public usWeightClass: Word;
+ public usWidthClass: Word;
+ public fsType: Word;
+ public ySubscriptXSize: Smallint;
+ public ySubscriptYSize: Smallint;
+ public ySubscriptXOffset: Smallint;
+ public ySubscriptYOffset: Smallint;
+ public ySuperscriptXSize: Smallint;
+ public ySuperscriptYSize: Smallint;
+ public ySuperscriptXOffset: Smallint;
+ public ySuperscriptYOffset: Smallint;
+ public yStrikeoutSize: Smallint;
+ public yStrikeoutPosition: Smallint;
+ public sFamilyClass: Smallint;
+ public panose: TPanose;
+ public ulUnicodeRange1: Cardinal;
+ public ulUnicodeRange2: Cardinal;
+ public ulUnicodeRange3: Cardinal;
+ public ulUnicodeRange4: Cardinal;
+ public achVendID: TVendorID;
+ public fsSelection: Word;
+ public usFirstCharIndex: Word;
+ public usLastCharIndex: Word;
+ public sTypoAscender: Smallint;
+ public sTypoDescender: Smallint;
+ public sTypoLineGap: Smallint;
+ public usWinAscent: Word;
+ public usWinDescent: Word;
+ public ulCodePageRange1: Cardinal;
+ public ulCodePageRange2: Cardinal;
+ public sxHeight: Smallint;
+ public sCapHeight: Smallint;
+ public usDefaultChar: Word;
+ public usBreakChar: Word;
+ public usMaxContext: Word;
+ end;
+
+ OS2WindowsMetricsClass = class(TrueTypeTable)
+ // Fields
+ public win_metrix: OS2WindowsMetrics;
+ // Methods
+ public constructor Create(src: TrueTypeTable);
+ strict private procedure ChangeEndian;
+ public procedure Load(font: Pointer); override;
+ public function Save(font: Pointer; offset: Cardinal): Cardinal; override;
+
+ // Properties
+ public property Ascent: Word read win_metrix.usWinAscent;
+ public property AvgCharWidth: Smallint read win_metrix.xAvgCharWidth;
+ public property BreakChar: Word read win_metrix.usBreakChar;
+ public property DefaultChar: Word read win_metrix.usDefaultChar;
+ public property Descent: Word read win_metrix.usWinDescent;
+ public property FirstCharIndex: Word read win_metrix.usFirstCharIndex;
+ public property LastCharIndex: Word read win_metrix.usLastCharIndex;
+ public property Panose: TPanose read win_metrix.panose;
+ end;
+
+implementation
+
+ constructor OS2WindowsMetricsClass.Create(src: TrueTypeTable);
+ begin
+ inherited Create(src);
+ end;
+
+ procedure OS2WindowsMetricsClass.ChangeEndian;
+ begin
+ self.win_metrix.Version := TTF_Helpers.SwapUInt16(self.win_metrix.Version);
+ self.win_metrix.xAvgCharWidth := TTF_Helpers.SwapInt16(self.win_metrix.xAvgCharWidth);
+ self.win_metrix.usWeightClass := TTF_Helpers.SwapUInt16(self.win_metrix.usWeightClass);
+ self.win_metrix.usWidthClass := TTF_Helpers.SwapUInt16(self.win_metrix.usWidthClass);
+ self.win_metrix.fsType := TTF_Helpers.SwapUInt16(self.win_metrix.fsType);
+ self.win_metrix.ySubscriptXSize := TTF_Helpers.SwapInt16(self.win_metrix.ySubscriptXSize);
+ self.win_metrix.ySubscriptYSize := TTF_Helpers.SwapInt16(self.win_metrix.ySubscriptYSize);
+ self.win_metrix.ySubscriptXOffset := TTF_Helpers.SwapInt16(self.win_metrix.ySubscriptXOffset);
+ self.win_metrix.ySubscriptYOffset := TTF_Helpers.SwapInt16(self.win_metrix.ySubscriptYOffset);
+ self.win_metrix.ySuperscriptXSize := TTF_Helpers.SwapInt16(self.win_metrix.ySuperscriptXSize);
+ self.win_metrix.ySuperscriptYSize := TTF_Helpers.SwapInt16(self.win_metrix.ySuperscriptYSize);
+ self.win_metrix.ySuperscriptXOffset := TTF_Helpers.SwapInt16(self.win_metrix.ySuperscriptXOffset);
+ self.win_metrix.ySuperscriptYOffset := TTF_Helpers.SwapInt16(self.win_metrix.ySuperscriptYOffset);
+ self.win_metrix.yStrikeoutSize := TTF_Helpers.SwapInt16(self.win_metrix.yStrikeoutSize);
+ self.win_metrix.yStrikeoutPosition := TTF_Helpers.SwapInt16(self.win_metrix.yStrikeoutPosition);
+ self.win_metrix.sFamilyClass := TTF_Helpers.SwapInt16(self.win_metrix.sFamilyClass);
+ self.win_metrix.ulUnicodeRange1 := TTF_Helpers.SwapUInt32(self.win_metrix.ulUnicodeRange1);
+ self.win_metrix.ulUnicodeRange2 := TTF_Helpers.SwapUInt32(self.win_metrix.ulUnicodeRange2);
+ self.win_metrix.ulUnicodeRange3 := TTF_Helpers.SwapUInt32(self.win_metrix.ulUnicodeRange3);
+ self.win_metrix.ulUnicodeRange4 := TTF_Helpers.SwapUInt32(self.win_metrix.ulUnicodeRange4);
+ self.win_metrix.fsSelection := TTF_Helpers.SwapUInt16(self.win_metrix.fsSelection);
+ self.win_metrix.usFirstCharIndex := TTF_Helpers.SwapUInt16(self.win_metrix.usFirstCharIndex);
+ self.win_metrix.usLastCharIndex := TTF_Helpers.SwapUInt16(self.win_metrix.usLastCharIndex);
+ self.win_metrix.sTypoAscender := TTF_Helpers.SwapInt16(self.win_metrix.sTypoAscender);
+ self.win_metrix.sTypoDescender := TTF_Helpers.SwapInt16(self.win_metrix.sTypoDescender);
+ self.win_metrix.sTypoLineGap := TTF_Helpers.SwapInt16(self.win_metrix.sTypoLineGap);
+ self.win_metrix.usWinAscent := TTF_Helpers.SwapUInt16(self.win_metrix.usWinAscent);
+ self.win_metrix.usWinDescent := TTF_Helpers.SwapUInt16(self.win_metrix.usWinDescent);
+ self.win_metrix.ulCodePageRange1 := TTF_Helpers.SwapUInt32(self.win_metrix.ulCodePageRange1);
+ self.win_metrix.ulCodePageRange1 := TTF_Helpers.SwapUInt32(self.win_metrix.ulCodePageRange2);
+ self.win_metrix.sxHeight := TTF_Helpers.SwapInt16(self.win_metrix.sxHeight);
+ self.win_metrix.sCapHeight := TTF_Helpers.SwapInt16(self.win_metrix.sCapHeight);
+ self.win_metrix.usDefaultChar := TTF_Helpers.SwapUInt16(self.win_metrix.usDefaultChar);
+ self.win_metrix.usBreakChar := TTF_Helpers.SwapUInt16(self.win_metrix.usBreakChar);
+ self.win_metrix.usMaxContext := TTF_Helpers.SwapUInt16(self.win_metrix.usMaxContext)
+ end;
+
+ procedure OS2WindowsMetricsClass.Load(font: Pointer);
+ var
+ win_metrix: ^OS2WindowsMetrics;
+ begin
+ win_metrix := TTF_Helpers.Increment(font, self.entry.offset );
+ self.win_metrix.Version := TTF_Helpers.SwapUInt16(win_metrix.Version);
+ self.win_metrix.xAvgCharWidth := TTF_Helpers.SwapInt16(win_metrix.xAvgCharWidth);
+ self.win_metrix.usWeightClass := TTF_Helpers.SwapUInt16(win_metrix.usWeightClass);
+ self.win_metrix.usWidthClass := TTF_Helpers.SwapUInt16(win_metrix.usWidthClass);
+ self.win_metrix.fsType := TTF_Helpers.SwapUInt16(win_metrix.fsType);
+ self.win_metrix.ySubscriptXSize := TTF_Helpers.SwapInt16(win_metrix.ySubscriptXSize);
+ self.win_metrix.ySubscriptYSize := TTF_Helpers.SwapInt16(win_metrix.ySubscriptYSize);
+ self.win_metrix.ySubscriptXOffset := TTF_Helpers.SwapInt16(win_metrix.ySubscriptXOffset);
+ self.win_metrix.ySubscriptYOffset := TTF_Helpers.SwapInt16(win_metrix.ySubscriptYOffset);
+ self.win_metrix.ySuperscriptXSize := TTF_Helpers.SwapInt16(win_metrix.ySuperscriptXSize);
+ self.win_metrix.ySuperscriptYSize := TTF_Helpers.SwapInt16(win_metrix.ySuperscriptYSize);
+ self.win_metrix.ySuperscriptXOffset := TTF_Helpers.SwapInt16(win_metrix.ySuperscriptXOffset);
+ self.win_metrix.ySuperscriptYOffset := TTF_Helpers.SwapInt16(win_metrix.ySuperscriptYOffset);
+ self.win_metrix.yStrikeoutSize := TTF_Helpers.SwapInt16(win_metrix.yStrikeoutSize);
+ self.win_metrix.yStrikeoutPosition := TTF_Helpers.SwapInt16(win_metrix.yStrikeoutPosition);
+ self.win_metrix.sFamilyClass := TTF_Helpers.SwapInt16(win_metrix.sFamilyClass);
+ self.win_metrix.ulUnicodeRange1 := TTF_Helpers.SwapUInt32(win_metrix.ulUnicodeRange1);
+ self.win_metrix.ulUnicodeRange2 := TTF_Helpers.SwapUInt32(win_metrix.ulUnicodeRange2);
+ self.win_metrix.ulUnicodeRange3 := TTF_Helpers.SwapUInt32(win_metrix.ulUnicodeRange3);
+ self.win_metrix.ulUnicodeRange4 := TTF_Helpers.SwapUInt32(win_metrix.ulUnicodeRange4);
+ self.win_metrix.fsSelection := TTF_Helpers.SwapUInt16(win_metrix.fsSelection);
+ self.win_metrix.usFirstCharIndex := TTF_Helpers.SwapUInt16(win_metrix.usFirstCharIndex);
+ self.win_metrix.usLastCharIndex := TTF_Helpers.SwapUInt16(win_metrix.usLastCharIndex);
+ self.win_metrix.sTypoAscender := TTF_Helpers.SwapInt16(win_metrix.sTypoAscender);
+ self.win_metrix.sTypoDescender := TTF_Helpers.SwapInt16(win_metrix.sTypoDescender);
+ self.win_metrix.sTypoLineGap := TTF_Helpers.SwapInt16(win_metrix.sTypoLineGap);
+ self.win_metrix.usWinAscent := TTF_Helpers.SwapUInt16(win_metrix.usWinAscent);
+ self.win_metrix.usWinDescent := TTF_Helpers.SwapUInt16(win_metrix.usWinDescent);
+ self.win_metrix.ulCodePageRange1 := TTF_Helpers.SwapUInt32(win_metrix.ulCodePageRange1);
+ self.win_metrix.ulCodePageRange1 := TTF_Helpers.SwapUInt32(win_metrix.ulCodePageRange2);
+ self.win_metrix.sxHeight := TTF_Helpers.SwapInt16(win_metrix.sxHeight);
+ self.win_metrix.sCapHeight := TTF_Helpers.SwapInt16(win_metrix.sCapHeight);
+ self.win_metrix.usDefaultChar := TTF_Helpers.SwapUInt16(win_metrix.usDefaultChar);
+ self.win_metrix.usBreakChar := TTF_Helpers.SwapUInt16(win_metrix.usBreakChar);
+ self.win_metrix.usMaxContext := TTF_Helpers.SwapUInt16(win_metrix.usMaxContext);
+// self.ChangeEndian
+ end;
+
+ function OS2WindowsMetricsClass.Save(font: Pointer; offset: Cardinal): Cardinal;
+ var
+ win_metrix: ^OS2WindowsMetrics;
+ begin
+ self.entry.offset := offset;
+// self.entry.length := SizeOf(OS2WindowsMetrics);
+// self.ChangeEndian;
+ win_metrix := TTF_Helpers.Increment(font, self.entry.offset);
+ win_metrix.Version := TTF_Helpers.SwapUInt16(self.win_metrix.Version);
+ win_metrix.xAvgCharWidth := TTF_Helpers.SwapInt16(self.win_metrix.xAvgCharWidth);
+ win_metrix.usWeightClass := TTF_Helpers.SwapUInt16(self.win_metrix.usWeightClass);
+ win_metrix.usWidthClass := TTF_Helpers.SwapUInt16(self.win_metrix.usWidthClass);
+ win_metrix.fsType := TTF_Helpers.SwapUInt16(self.win_metrix.fsType);
+ win_metrix.ySubscriptXSize := TTF_Helpers.SwapInt16(self.win_metrix.ySubscriptXSize);
+ win_metrix.ySubscriptYSize := TTF_Helpers.SwapInt16(self.win_metrix.ySubscriptYSize);
+ win_metrix.ySubscriptXOffset := TTF_Helpers.SwapInt16(self.win_metrix.ySubscriptXOffset);
+ win_metrix.ySubscriptYOffset := TTF_Helpers.SwapInt16(self.win_metrix.ySubscriptYOffset);
+ win_metrix.ySuperscriptXSize := TTF_Helpers.SwapInt16(self.win_metrix.ySuperscriptXSize);
+ win_metrix.ySuperscriptYSize := TTF_Helpers.SwapInt16(self.win_metrix.ySuperscriptYSize);
+ win_metrix.ySuperscriptXOffset := TTF_Helpers.SwapInt16(self.win_metrix.ySuperscriptXOffset);
+ win_metrix.ySuperscriptYOffset := TTF_Helpers.SwapInt16(self.win_metrix.ySuperscriptYOffset);
+ win_metrix.yStrikeoutSize := TTF_Helpers.SwapInt16(self.win_metrix.yStrikeoutSize);
+ win_metrix.yStrikeoutPosition := TTF_Helpers.SwapInt16(self.win_metrix.yStrikeoutPosition);
+ win_metrix.sFamilyClass := TTF_Helpers.SwapInt16(self.win_metrix.sFamilyClass);
+ win_metrix.ulUnicodeRange1 := TTF_Helpers.SwapUInt32(self.win_metrix.ulUnicodeRange1);
+ win_metrix.ulUnicodeRange2 := TTF_Helpers.SwapUInt32(self.win_metrix.ulUnicodeRange2);
+ win_metrix.ulUnicodeRange3 := TTF_Helpers.SwapUInt32(self.win_metrix.ulUnicodeRange3);
+ win_metrix.ulUnicodeRange4 := TTF_Helpers.SwapUInt32(self.win_metrix.ulUnicodeRange4);
+ win_metrix.fsSelection := TTF_Helpers.SwapUInt16(self.win_metrix.fsSelection);
+ win_metrix.usFirstCharIndex := TTF_Helpers.SwapUInt16(self.win_metrix.usFirstCharIndex);
+ win_metrix.usLastCharIndex := TTF_Helpers.SwapUInt16(self.win_metrix.usLastCharIndex);
+ win_metrix.sTypoAscender := TTF_Helpers.SwapInt16(self.win_metrix.sTypoAscender);
+ win_metrix.sTypoDescender := TTF_Helpers.SwapInt16(self.win_metrix.sTypoDescender);
+ win_metrix.sTypoLineGap := TTF_Helpers.SwapInt16(self.win_metrix.sTypoLineGap);
+ win_metrix.usWinAscent := TTF_Helpers.SwapUInt16(self.win_metrix.usWinAscent);
+ win_metrix.usWinDescent := TTF_Helpers.SwapUInt16(self.win_metrix.usWinDescent);
+ win_metrix.ulCodePageRange1 := TTF_Helpers.SwapUInt32(self.win_metrix.ulCodePageRange1);
+ win_metrix.ulCodePageRange1 := TTF_Helpers.SwapUInt32(self.win_metrix.ulCodePageRange2);
+ win_metrix.sxHeight := TTF_Helpers.SwapInt16(self.win_metrix.sxHeight);
+ win_metrix.sCapHeight := TTF_Helpers.SwapInt16(self.win_metrix.sCapHeight);
+ win_metrix.usDefaultChar := TTF_Helpers.SwapUInt16(self.win_metrix.usDefaultChar);
+ win_metrix.usBreakChar := TTF_Helpers.SwapUInt16(self.win_metrix.usBreakChar);
+ win_metrix.usMaxContext := TTF_Helpers.SwapUInt16(self.win_metrix.usMaxContext);
+// self.ChangeEndian;
+ Result := (offset + self.entry.length + 3) and $fffffffc;
+ end;
+{$HINTS ON}
+end.
diff --git a/LibD28/FMX.frxPassw.pas b/LibD28/FMX.frxPassw.pas
new file mode 100644
index 0000000..47ccf10
--- /dev/null
+++ b/LibD28/FMX.frxPassw.pas
@@ -0,0 +1,59 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Password form }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxPassw;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.UITypes,
+ FMX.Controls, FMX.Forms, FMX.Edit
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+
+
+type
+ TfrxPasswordForm = class(TForm)
+ OkB: TButton;
+ CancelB: TButton;
+ PasswordE: TEdit;
+ PasswordL: TLabel;
+ Image1: TImageControl;
+ procedure FormCreate(Sender: TObject);
+ private
+ public
+ end;
+
+
+implementation
+
+//{$R *.dfm}
+
+uses
+ FMX.frxRes;
+
+
+procedure TfrxPasswordForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(5000);
+ PasswordL.Text := frxGet(5001);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+end;
+
+end.
+
diff --git a/LibD28/FMX.frxPictureCache.pas b/LibD28/FMX.frxPictureCache.pas
new file mode 100644
index 0000000..dc33fed
--- /dev/null
+++ b/LibD28/FMX.frxPictureCache.pas
@@ -0,0 +1,357 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Picture Cache }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxPictureCache;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.SysUtils, System.Variants,
+ FMX.frxClass, FMX.frxXML, FMX.frxUtils;
+
+
+type
+ TfrxCacheItem = packed record
+ Segment: Longint;
+ Offset: Longint;
+ end;
+
+ PfrxCacheItem = ^TfrxCacheItem;
+
+ TfrxCacheList = class(TObject)
+ private
+ function Get(Index: Integer): PfrxCacheItem;
+ protected
+ FItems: TList;
+ protected
+ procedure Clear;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function Add: PfrxCacheItem;
+ function Count: Integer;
+ property Items[Index: Integer]: PfrxCacheItem read Get; default;
+ end;
+
+ TfrxFileStream = class(TFileStream)
+ private
+ FSz: LongWord;
+ public
+ function Seek(Offset: Longint; Origin: Word): Longint; overload; override;
+ function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override;
+ end;
+
+ TfrxMemoryStream = class(TMemoryStream)
+ private
+ FSz: LongWord;
+ public
+ function Seek(Offset: Longint; Origin: Word): Longint; overload; override;
+ function Seek(const Offset: Int64; Origin: TSeekOrigin): Int64; overload; override;
+ end;
+
+
+ TfrxPictureCache = class(TObject)
+ private
+ FItems: TfrxCacheList;
+ FCacheStreamList: TList;
+ FTempFile: TStringList;
+ FTempDir: String;
+ FUseFileCache: Boolean;
+ procedure Add;
+ procedure SetTempDir(const Value: String);
+ procedure SetUseFileCache(const Value: Boolean);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Clear;
+ procedure AddPicture(Picture: TfrxPictureView);
+ procedure GetPicture(Picture: TfrxPictureView);
+ procedure SaveToXML(Item: TfrxXMLItem);
+ procedure LoadFromXML(Item: TfrxXMLItem);
+ procedure AddSegment;
+ property UseFileCache: Boolean read FUseFileCache write SetUseFileCache;
+ property TempDir: String read FTempDir write SetTempDir;
+ end;
+
+
+implementation
+
+{$IFDEF POSIX}
+ uses Posix.Unistd;
+{$ENDIF}
+
+
+function frxStreamToString(Stream: TStream; Size: Integer): String;
+var
+ p: PChar;
+begin
+ SetLength(Result, Size * 2);
+ GetMem(p, Size);
+ Stream.Read(p^, Size);
+ BinToHex(p, PChar(@Result[1]), Size);
+ FreeMem(p, Size);
+end;
+
+procedure frxStringToStream(const s: String; Stream: TStream);
+var
+ Size: Integer;
+ p: PChar;
+begin
+ Size := Length(s) div 2;
+ GetMem(p, Size);
+ HexToBin(PChar(@s[1]), p, Size * 2);
+ Stream.Write(p^, Size);
+ FreeMem(p, Size);
+end;
+
+
+{ TfrxPictureCache }
+
+constructor TfrxPictureCache.Create;
+begin
+ FItems := TfrxCacheList.Create;
+ FCacheStreamList := TList.Create;
+ FTempFile := TStringList.Create;
+ FUseFileCache := False;
+end;
+
+destructor TfrxPictureCache.Destroy;
+begin
+ Clear;
+ FItems.Free;
+ FCacheStreamList.Free;
+ FTempFile.Free;
+ inherited;
+end;
+
+procedure TfrxPictureCache.Clear;
+begin
+ while FCacheStreamList.Count > 0 do
+ begin
+ TObject(FCacheStreamList[0]).Free;
+ FCacheStreamList.Delete(0);
+ if FUseFileCache then
+ begin
+ DeleteFile(FTempFile[0]);
+ FTempFile.Delete(0);
+ end;
+ end;
+ FItems.Clear;
+end;
+
+procedure TfrxPictureCache.Add;
+begin
+ if (FCacheStreamList.Count = 0) or (TStream(FCacheStreamList[FCacheStreamList.Count - 1]).Size >= Round(MaxInt - MaxInt/6)) then
+ AddSegment;
+
+ with FItems.Add^ do
+ begin
+ Segment := FCacheStreamList.Count - 1;
+ Offset := TStream(FCacheStreamList[FCacheStreamList.Count - 1]).Size;
+ TStream(FCacheStreamList[FCacheStreamList.Count - 1]).Position := Offset;
+ end;
+end;
+
+procedure TfrxPictureCache.AddPicture(Picture: TfrxPictureView);
+begin
+ if (Picture.Picture = nil) or (Picture.Picture.IsEmpty) then
+ Picture.ImageIndex := 0
+ else
+ begin
+ Picture.ImageIndex := FItems.Count + 1;
+ Add;
+ Picture.Picture.SaveToStream(TStream(FCacheStreamList[FItems[Picture.ImageIndex - 1]^.Segment]));
+ end;
+end;
+
+procedure TfrxPictureCache.GetPicture(Picture: TfrxPictureView);
+var
+ Size, Offset, Segment: Longint;
+ ImageIndex: Integer;
+ Stream: TStream;
+begin
+ if (Picture.ImageIndex <= 0) or (Picture.ImageIndex > FItems.Count) then
+ Picture.Picture.Assign(nil)
+ else
+ begin
+ if FCacheStreamList.Count = 0 then
+ Exit;
+ ImageIndex := Picture.ImageIndex ;
+ Segment := Fitems[ImageIndex - 1]^.Segment;
+ Offset := FItems[ImageIndex - 1]^.Offset;
+ Stream := TStream(FCacheStreamList[Segment]);
+
+ if (Picture.ImageIndex < FItems.Count) and (Fitems[ImageIndex]^.Segment = Segment) then
+ Size := FItems[ImageIndex]^.Offset - Offset
+ else
+ Size := Stream.Size - Offset;
+
+ Stream.Position := Offset;
+
+ if FUseFileCache then
+ TfrxFileStream(Stream).FSz := Offset + Size
+ else
+ TfrxMemoryStream(Stream).FSz := Offset + Size;
+
+ Picture.Picture.LoadFromStream(Stream);
+
+ if FUseFileCache then
+ TfrxFileStream(Stream).FSz := 0
+ else
+ TfrxMemoryStream(Stream).FSz := 0
+ end;
+end;
+
+procedure TfrxPictureCache.LoadFromXML(Item: TfrxXMLItem);
+var
+ i: Integer;
+ xi: TfrxXMLItem;
+begin
+ Clear;
+ for i := 0 to Item.Count - 1 do
+ begin
+ xi := Item[i];
+ Add;
+ frxStringToStream(xi.Prop['stream'], TStream(FCacheStreamList[FCacheStreamList.Count - 1]));
+ end;
+end;
+
+procedure TfrxPictureCache.SaveToXML(Item: TfrxXMLItem);
+var
+ i, Size: Integer;
+ xi: TfrxXMLItem;
+begin
+ Item.Clear;
+ for i := 0 to FCacheStreamList.Count - 1 do
+ TStream(FCacheStreamList[i]).Position := 0;
+ for i := 0 to FItems.Count - 1 do
+ begin
+ if (i + 1 < FItems.Count) and (Fitems[i]^.Segment = Fitems[i + 1]^.Segment) then
+ Size := frxInteger(FItems[i + 1]^.Offset) - frxInteger(FItems[i]^.Offset)
+ else
+ Size := TStream(FCacheStreamList[FItems[i]^.Segment]).Size - frxInteger(FItems[i]^.Offset);
+ xi := Item.Add;
+ xi.Name := 'item';
+ xi.Text := 'stream="' + frxStreamToString(TStream(FCacheStreamList[FItems[i]^.Segment]), Size) + '"';
+ end;
+end;
+
+procedure TfrxPictureCache.SetTempDir(const Value: String);
+begin
+ if FCacheStreamList.Count = 0 then
+ FTempDir := Value;
+end;
+
+procedure TfrxPictureCache.SetUseFileCache(const Value: Boolean);
+begin
+ if FCacheStreamList.Count = 0 then
+ FUseFileCache := Value;
+end;
+
+procedure TfrxPictureCache.AddSegment;
+var
+ Stream: TStream;
+ Path: WideString;
+ //FileName: WideString;
+begin
+ if FUseFileCache then
+ begin
+ Path := GetTempFile;
+ FTempFile.Add(String(Path));
+ Stream := TfrxFileStream.Create(String(Path), fmOpenReadWrite);
+ TfrxFileStream(Stream).FSz := 0;
+ end
+ else
+ begin
+ Stream := TfrxMemoryStream.Create;
+ TfrxMemoryStream(Stream).FSz := 0;
+ end;
+ FCacheStreamList.Add(Stream);
+end;
+
+function TfrxMemoryStream.Seek(Offset: Longint; Origin: Word): Longint;
+begin
+ if (FSz <> 0) and (Offset = 0) and (Origin = soFromEnd) then
+ Result := FSz
+ else
+ Result := inherited Seek(Offset, Origin);
+end;
+
+function TfrxMemoryStream.Seek(const Offset: Int64;
+ Origin: TSeekOrigin): Int64;
+begin
+ if (FSz <> 0) and (Offset = 0) and (Origin = soEnd) then
+ Result := FSz
+ else
+ Result := inherited Seek(Offset, Origin);
+end;
+
+function TfrxFileStream.Seek(Offset: Longint; Origin: Word): Longint;
+begin
+ if (FSz <> 0) and (Offset = 0) and (Origin = soFromEnd) then
+ Result := FSz
+ else
+ Result := inherited Seek(Offset, Origin);
+end;
+
+function TfrxFileStream.Seek(const Offset: Int64;
+ Origin: TSeekOrigin): Int64;
+begin
+ if (FSz <> 0) and (Offset = 0) and (Origin = soEnd) then
+ Result := FSz
+ else
+ Result := inherited Seek(Offset, Origin);
+end;
+
+{ TfrxCacheList }
+
+function TfrxCacheList.Add: PfrxCacheItem;
+begin
+ GetMem(Result, sizeof(TfrxCacheItem));
+ FItems.Add(Result);
+end;
+
+procedure TfrxCacheList.Clear;
+var
+ idx: Integer;
+begin
+ for idx := 0 to FItems.Count - 1 do
+ FreeMem(FItems[idx], sizeof(TfrxCacheItem));
+ FItems.Clear;
+end;
+
+function TfrxCacheList.Count: Integer;
+begin
+ Result := FItems.Count;
+end;
+
+constructor TfrxCacheList.Create;
+begin
+ FItems := TList.Create;
+end;
+
+destructor TfrxCacheList.Destroy;
+begin
+ Clear;
+ FItems.Free;
+ inherited;
+end;
+
+function TfrxCacheList.Get(Index: Integer): PfrxCacheItem;
+begin
+ Result := PfrxCacheItem(FItems[Index]);
+end;
+
+end.
diff --git a/LibD28/FMX.frxPopupForm.fmx b/LibD28/FMX.frxPopupForm.fmx
new file mode 100644
index 0000000..f1eb839
--- /dev/null
+++ b/LibD28/FMX.frxPopupForm.fmx
@@ -0,0 +1,15 @@
+object frxPopupForm: TfrxPopupForm
+ Left = 0
+ Top = 0
+ Caption = ' '
+ BorderStyle = bsNone
+ ClientHeight = 97
+ ClientWidth = 658
+ ShowActivated = False
+ StaysOpen = False
+ Transparency = True
+ TopMost = True
+ Visible = False
+ OnClose = FormClose
+ StyleLookup = 'backgroundstyle'
+end
diff --git a/LibD28/FMX.frxPopupForm.pas b/LibD28/FMX.frxPopupForm.pas
new file mode 100644
index 0000000..bce3ae1
--- /dev/null
+++ b/LibD28/FMX.frxPopupForm.pas
@@ -0,0 +1,49 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Parent form for pop-up controls }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxPopupForm;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Platform,
+ System.Variants;
+
+
+type
+ TfrxPopupForm = class(TForm)
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+//var
+// frxPopupFormCloseTime: Single = 0;
+
+
+implementation
+
+{$R *.FMX}
+
+
+procedure TfrxPopupForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+// frxPopupFormCloseTime := Platform.GetTick;
+ Action := TCloseAction.caFree;
+end;
+
+end.
diff --git a/LibD28/FMX.frxPostScriptClass.pas b/LibD28/FMX.frxPostScriptClass.pas
new file mode 100644
index 0000000..9812d0b
--- /dev/null
+++ b/LibD28/FMX.frxPostScriptClass.pas
@@ -0,0 +1,102 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Font parser }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Aleksey Mandrykin, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxPostScriptClass;
+interface uses FMX.TTFHelpers, FMX.frxTrueTypeTable;
+
+ type // Nested Types
+ PostScript = packed record
+ public isFixedPitch: Cardinal;
+ public ItalicAngle: Integer;
+ public maxMemType1: Cardinal;
+ public maxMemType42: Cardinal;
+ public minMemType1: Cardinal;
+ public minMemType42: Cardinal;
+ public underlinePosition: Smallint;
+ public underlineThickness: Smallint;
+ public Version: Cardinal;
+ end;
+
+
+ PostScriptClass = class(TrueTypeTable)
+ strict private post_script: PostScript;
+
+ // Methods
+ public constructor Create(src: TrueTypeTable);
+ strict private procedure ChangeEndian;
+ public procedure Load(font: Pointer); override;
+ public function Save(font: Pointer; offset: Cardinal): Cardinal; override;
+
+ // Properties
+ public property ItalicAngle: Integer read post_script.ItalicAngle;
+
+end;
+
+implementation
+
+// Methods
+ constructor PostScriptClass.Create(src: TrueTypeTable);
+ begin
+ inherited Create(src);
+ end;
+
+ procedure PostScriptClass.ChangeEndian;
+ begin
+ self.post_script.Version := TTF_Helpers.SwapUInt32(self.post_script.Version);
+ self.post_script.ItalicAngle := TTF_Helpers.SwapInt32(self.post_script.ItalicAngle);
+ self.post_script.underlinePosition := TTF_Helpers.SwapInt16(self.post_script.underlinePosition);
+ self.post_script.underlineThickness := TTF_Helpers.SwapInt16(self.post_script.underlineThickness);
+ self.post_script.isFixedPitch := TTF_Helpers.SwapUInt32(self.post_script.isFixedPitch);
+ self.post_script.minMemType42 := TTF_Helpers.SwapUInt32(self.post_script.minMemType42);
+ self.post_script.maxMemType42 := TTF_Helpers.SwapUInt32(self.post_script.maxMemType42);
+ self.post_script.minMemType1 := TTF_Helpers.SwapUInt32(self.post_script.minMemType1);
+ self.post_script.maxMemType1 := TTF_Helpers.SwapUInt32(self.post_script.maxMemType1)
+ end;
+
+ procedure PostScriptClass.Load(font: Pointer);
+ var
+ post_script: ^PostScript;
+ begin
+ post_script := TTF_Helpers.Increment(font, self.entry.offset);
+ self.post_script.Version := post_script.Version;
+ self.post_script.ItalicAngle := post_script.ItalicAngle;
+ self.post_script.underlinePosition := post_script.underlinePosition;
+ self.post_script.underlineThickness := post_script.underlineThickness;
+ self.post_script.isFixedPitch := post_script.isFixedPitch;
+ self.post_script.minMemType42 := post_script.minMemType42;
+ self.post_script.maxMemType42 := post_script.maxMemType42;
+ self.post_script.minMemType1 := post_script.minMemType1;
+ self.post_script.maxMemType1 := post_script.maxMemType1;
+ self.ChangeEndian
+ end;
+
+ function PostScriptClass.Save(font: Pointer; offset: Cardinal): Cardinal;
+ var
+ post_script: ^PostScript;
+ begin
+ self.entry.offset := offset;
+ self.post_script.Version := $30000;
+ self.entry.length := SizeOf(PostScript);
+ self.ChangeEndian;
+ post_script := TTF_Helpers.Increment(font, self.entry.offset);
+ post_script.Version := self.post_script.Version;
+ post_script.ItalicAngle := self.post_script.ItalicAngle;
+ post_script.underlinePosition := self.post_script.underlinePosition;
+ post_script.underlineThickness := self.post_script.underlineThickness;
+ post_script.isFixedPitch := self.post_script.isFixedPitch;
+ post_script.minMemType42 := self.post_script.minMemType42;
+ post_script.maxMemType42 := self.post_script.maxMemType42;
+ post_script.minMemType1 := self.post_script.minMemType1;
+ post_script.maxMemType1 := self.post_script.maxMemType1;
+ self.ChangeEndian;
+ Result := offset + self.entry.length
+ end;
+end.
diff --git a/LibD28/FMX.frxPreProgramClass.pas b/LibD28/FMX.frxPreProgramClass.pas
new file mode 100644
index 0000000..3b5966e
--- /dev/null
+++ b/LibD28/FMX.frxPreProgramClass.pas
@@ -0,0 +1,61 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Font parser }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Aleksey Mandrykin, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxPreProgramClass;
+interface uses FMX.TTFHelpers, FMX.frxTrueTypeTable;
+type
+ PreProgramClass = class(TrueTypeTable)
+ // Fields
+ strict private pre_program: Array of Byte;
+ // Methods
+ public constructor Create(src: TrueTypeTable);
+ public procedure Load(font: Pointer); override;
+ public function Save(font: Pointer; offset: Cardinal): Cardinal; override;
+end;
+
+implementation
+
+// Methods
+ constructor PreProgramClass.Create(src: TrueTypeTable);
+ begin
+ inherited Create(src);
+ end;
+
+ procedure PreProgramClass.Load(font: Pointer);
+ var
+ Tppr: ^Byte;
+ i: Integer;
+ begin
+ length := (((self.entry.length + 3) div 4) * 4);
+ SetLength(self.pre_program, length);
+ Tppr := TTF_Helpers.Increment(font, self.entry.offset);
+ for i := 0 to Length - 1 do
+ begin
+ self.pre_program[i] := Tppr^;
+ Inc(Tppr);
+ end;
+ end;
+
+ function PreProgramClass.Save(font: Pointer; offset: Cardinal): Cardinal;
+ var
+ Tppr: ^Byte;
+ i: Integer;
+ begin
+ self.entry.offset := offset;
+ Tppr := TTF_Helpers.Increment(font, self.entry.offset);
+ for i := 0 to Length - 1 do
+ begin
+ Tppr^ := self.pre_program[i];
+ Inc(Tppr);
+ end;
+ Result := offset + Length;
+ end;
+end.
diff --git a/LibD28/FMX.frxPreview.fmx b/LibD28/FMX.frxPreview.fmx
new file mode 100644
index 0000000..45b59b5
--- /dev/null
+++ b/LibD28/FMX.frxPreview.fmx
@@ -0,0 +1,352 @@
+object frxPreviewForm: TfrxPreviewForm
+ Left = 0
+ Top = 0
+ Caption = 'Preview'
+ ClientHeight = 584
+ ClientWidth = 803
+ Position = poScreenCenter
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnCloseQuery = FormCloseQuery
+ OnKeyDown = FormKeyDown
+ OnMouseUp = FormMouseUp
+ OnMouseWheel = FormMouseWheel
+ object ToolBar: TToolBar
+ Height = 31.000000000000000000
+ Width = 803.000000000000000000
+ object PrintB: TfrxToolButton
+ Height = 25.000000000000000000
+ Position.X = 5.000000000000000000
+ Position.Y = 3.000000000000000000
+ Text = ' '
+ Width = 25.000000000000000000
+ OnClick = PrintBClick
+ OnMouseEnter = PrintBMouseEnter
+ OnMouseLeave = PrintBMouseLeave
+ Hint = ''
+ end
+ object OpenB: TfrxToolButton
+ Height = 25.000000000000000000
+ Position.X = 31.000000000000000000
+ Position.Y = 3.000000000000000000
+ Text = ' '
+ Width = 25.000000000000000000
+ OnClick = OpenBClick
+ OnMouseEnter = PrintBMouseEnter
+ OnMouseLeave = PrintBMouseLeave
+ Hint = ''
+ end
+ object SaveB: TfrxToolButton
+ Height = 25.000000000000000000
+ Position.X = 57.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 25.000000000000000000
+ OnClick = SaveBClick
+ OnMouseEnter = PrintBMouseEnter
+ OnMouseLeave = PrintBMouseLeave
+ Hint = ''
+ end
+ object ExportB: TfrxToolButton
+ Height = 25.000000000000000000
+ PopupMenu = ExportPopup
+ Position.X = 83.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 25.000000000000000000
+ OnClick = ExportBClick
+ OnMouseEnter = PrintBMouseEnter
+ OnMouseLeave = PrintBMouseLeave
+ Hint = ''
+ end
+ object Line1: TfrxToolSeparator
+ Position.X = 111.000000000000000000
+ Position.Y = 7.000000000000000000
+ Width = 5.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object PageWidthB: TfrxToolButton
+ Height = 25.000000000000000000
+ Position.X = 192.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 25.000000000000000000
+ OnClick = PageWidthBClick
+ OnMouseEnter = PrintBMouseEnter
+ OnMouseLeave = PrintBMouseLeave
+ Hint = ''
+ end
+ object WholePageB: TfrxToolButton
+ Height = 25.000000000000000000
+ Position.X = 218.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 25.000000000000000000
+ OnClick = WholePageBClick
+ OnMouseEnter = PrintBMouseEnter
+ OnMouseLeave = PrintBMouseLeave
+ Hint = ''
+ end
+ object FullScreenBtn: TfrxToolButton
+ Height = 25.000000000000000000
+ Position.X = 244.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 25.000000000000000000
+ OnClick = FullScreenBtnClick
+ OnMouseEnter = PrintBMouseEnter
+ OnMouseLeave = PrintBMouseLeave
+ Hint = ''
+ end
+ object Line2: TfrxToolSeparator
+ Position.X = 272.000000000000000000
+ Position.Y = 7.000000000000000000
+ Width = 5.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object OutlineB: TfrxToolButton
+ Height = 25.000000000000000000
+ Position.X = 278.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 25.000000000000000000
+ OnClick = OutlineBClick
+ OnMouseEnter = PrintBMouseEnter
+ OnMouseLeave = PrintBMouseLeave
+ Hint = ''
+ end
+ object ThumbB: TfrxToolButton
+ Height = 25.000000000000000000
+ Position.X = 304.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 25.000000000000000000
+ OnClick = ThumbBClick
+ OnMouseEnter = PrintBMouseEnter
+ OnMouseLeave = PrintBMouseLeave
+ Hint = ''
+ end
+ object PageSettingsB: TfrxToolButton
+ Height = 25.000000000000000000
+ Position.X = 330.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 25.000000000000000000
+ OnClick = PageSettingsBClick
+ OnMouseEnter = PrintBMouseEnter
+ OnMouseLeave = PrintBMouseLeave
+ Hint = ''
+ end
+ object DesignerB: TfrxToolButton
+ Height = 25.000000000000000000
+ Position.X = 356.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 25.000000000000000000
+ OnClick = DesignerBClick
+ OnMouseEnter = PrintBMouseEnter
+ OnMouseLeave = PrintBMouseLeave
+ Hint = ''
+ end
+ object Line3: TfrxToolSeparator
+ Position.X = 384.000000000000000000
+ Position.Y = 7.000000000000000000
+ Width = 5.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object FirstB: TfrxToolButton
+ Height = 25.000000000000000000
+ Position.X = 390.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 25.000000000000000000
+ OnClick = FirstBClick
+ OnMouseEnter = PrintBMouseEnter
+ OnMouseLeave = PrintBMouseLeave
+ Hint = ''
+ end
+ object PriorB: TfrxToolButton
+ Height = 25.000000000000000000
+ Position.X = 416.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 25.000000000000000000
+ OnClick = PriorBClick
+ OnMouseEnter = PrintBMouseEnter
+ OnMouseLeave = PrintBMouseLeave
+ Hint = ''
+ end
+ object PageE: TEdit
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ Password = False
+ Position.X = 443.000000000000000000
+ Position.Y = 4.000000000000000000
+ Width = 49.000000000000000000
+ Height = 22.000000000000000000
+ OnKeyDown = FormKeyDown
+ end
+ object NextB: TfrxToolButton
+ Height = 25.000000000000000000
+ Position.X = 494.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 25.000000000000000000
+ OnClick = NextBClick
+ OnMouseEnter = PrintBMouseEnter
+ OnMouseLeave = PrintBMouseLeave
+ Hint = ''
+ end
+ object LastB: TfrxToolButton
+ Height = 25.000000000000000000
+ Position.X = 520.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 25.000000000000000000
+ OnClick = LastBClick
+ OnMouseEnter = PrintBMouseEnter
+ OnMouseLeave = PrintBMouseLeave
+ Hint = ''
+ end
+ object CancelB: TSpeedButton
+ Height = 23.000000000000000000
+ Position.X = 568.000000000000000000
+ Position.Y = 4.000000000000000000
+ Text = 'Cancel'
+ Width = 68.000000000000000000
+ OnClick = CancelBClick
+ end
+ object ZoomCB: TComboEdit
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ Position.X = 116.000000000000000000
+ Position.Y = 4.000000000000000000
+ Width = 69.000000000000000000
+ Height = 22.000000000000000000
+ OnChange = ZoomCBChange
+ OnChangeTracking = ZoomCBClick
+ OnClick = ZoomCBClick
+ end
+ end
+ object StatusBar: TStatusBar
+ Height = 24.000000000000000000
+ Position.Y = 560.000000000000000000
+ ShowSizeGrip = True
+ Width = 803.000000000000000000
+ object Panel0: TText
+ Align = alLeft
+ Height = 24.000000000000000000
+ Width = 249.000000000000000000
+ end
+ object Panel1: TText
+ Align = alLeft
+ Height = 24.000000000000000000
+ Position.X = 249.000000000000000000
+ Width = 265.000000000000000000
+ end
+ object Panel2: TText
+ Align = alLeft
+ Height = 24.000000000000000000
+ Position.X = 514.000000000000000000
+ Width = 273.000000000000000000
+ end
+ end
+ object ExportPopup: TPopupMenu
+ Left = 208
+ Top = 128
+ end
+ object HiddenMenu: TPopupMenu
+ Left = 112
+ Top = 128
+ object Showtemplate1: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = Showtemplate1Click
+ end
+ end
+ object RightMenu: TPopupMenu
+ Left = 56
+ Top = 128
+ object CollapseMI: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = CollapseAllClick
+ end
+ object ExpandMI: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ExpandAllClick
+ end
+ object N1: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ end
+ object OpenMI: TMenuItem
+ Height = 50.000000000000000000
+ Text = 'OpenMI'
+ Width = 50.000000000000000000
+ OnClick = OpenBClick
+ end
+ object SaveMI: TMenuItem
+ Height = 50.000000000000000000
+ Text = 'SaveMI'
+ Width = 50.000000000000000000
+ OnClick = SaveBClick
+ end
+ object PrintMI: TMenuItem
+ Height = 50.000000000000000000
+ Text = 'PrintMI'
+ Width = 50.000000000000000000
+ OnClick = PrintBClick
+ end
+ object ExportMI: TMenuItem
+ Height = 50.000000000000000000
+ Text = 'ExportMI'
+ Width = 50.000000000000000000
+ end
+ object ExportPDFMI: TMenuItem
+ Height = 50.000000000000000000
+ Text = 'ExportPDFMI'
+ Width = 50.000000000000000000
+ OnClick = PdfBClick
+ end
+ object ExportMailMI: TMenuItem
+ Height = 50.000000000000000000
+ Text = 'Export'
+ Width = 50.000000000000000000
+ OnClick = EmailBClick
+ end
+ object FindMI: TMenuItem
+ Height = 50.000000000000000000
+ Text = 'FindMI'
+ Width = 50.000000000000000000
+ end
+ object FullScrMI: TMenuItem
+ Height = 50.000000000000000000
+ Text = 'FullScrMI'
+ Width = 50.000000000000000000
+ OnClick = FullScreenBtnClick
+ end
+ object ZoomInMI: TMenuItem
+ Height = 50.000000000000000000
+ Text = 'ZoomInMI'
+ Width = 50.000000000000000000
+ OnClick = ZoomPlusBClick
+ end
+ object ZoomOutMI: TMenuItem
+ Height = 50.000000000000000000
+ Text = 'ZoomOutMI'
+ Width = 50.000000000000000000
+ OnClick = ZoomMinusBClick
+ end
+ end
+ object HintPanel: TCalloutPanel
+ Height = 45.000000000000000000
+ Margins.Top = 11.000000000000000000
+ Position.X = 8.000000000000000000
+ Position.Y = 492.000000000000000000
+ StyleLookup = 'HintPanelStyle1'
+ Visible = False
+ Width = 97.000000000000000000
+ CalloutWidth = 23.000000000000000000
+ CalloutLength = 11.000000000000000000
+ object Label1: TLabel
+ Align = alClient
+ Height = 34.000000000000000000
+ Position.Y = 11.000000000000000000
+ Text = 'Label1'
+ TextAlign = taCenter
+ Width = 97.000000000000000000
+ end
+ end
+end
diff --git a/LibD28/FMX.frxPreview.pas b/LibD28/FMX.frxPreview.pas
new file mode 100644
index 0000000..e9d36fb
--- /dev/null
+++ b/LibD28/FMX.frxPreview.pas
@@ -0,0 +1,2791 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Report preview }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxPreview;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.SysUtils, System.Types, System.UITypes, System.Variants,
+ FMX.Types, FMX.Controls, FMX.TreeView, FMX.Menus, FMX.Forms, FMX.Edit,
+ FMX.Dialogs, System.UIConsts,
+ FMX.frxCtrls, FMX.frxPreviewPages, FMX.frxClass, FMX.frxFMX, FMX.ListBox,
+ FMX.Objects, FMX.frxBaseModalForm
+ {$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI21}
+ , FMX.ComboEdit
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+ TfrxPreview = class;
+ TfrxPreviewWorkspace = class;
+ TfrxPageList = class;
+
+ TfrxPageChangedEvent = procedure(Sender: TfrxPreview; PageNo: Integer) of object;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxPreview = class(TfrxCustomPreview)
+ private
+ FAllowF3: Boolean;
+ FCancelButton: TButton;
+ FLocked: Boolean;
+ FMessageLabel: TLabel;
+ FMessagePanel: TPanel;
+ FOnPageChanged: TfrxPageChangedEvent;
+ FOutline: TTreeView;
+ FOutlineColor: TAlphaColor;
+ FOutlinePopup: TPopupMenu;
+ FPageNo: Integer;
+ FRefreshing: Boolean;
+ FRunning: Boolean;
+ FSplitter: TfrxSplitter;
+ FThumbnail: TfrxPreviewWorkspace;
+ FWorkspace: TfrxPreviewWorkspace;
+ FZoom: Double;
+ FZoomMode: TfrxZoomMode;
+ HintPanel: TCalloutPanel;
+ HintLabel: TLabel;
+ function GetActiveFrameColor: TAlphaColor;
+ function GetBackColor: TAlphaColor;
+ function GetFrameColor: TAlphaColor;
+ function GetOutlineVisible: Boolean;
+ function GetOutlineWidth: Integer;
+ function GetPageCount: Integer;
+ function GetThumbnailVisible: Boolean;
+ function GetOnMouseDown: TMouseEvent;
+ procedure EditTemplate;
+ procedure OnCancel(Sender: TObject);
+ procedure OnCollapseClick(Sender: TObject);
+ procedure OnExpandClick(Sender: TObject);
+ procedure OnMoveSplitter(Sender: TObject);
+ procedure OnOutlineClick(Sender: TObject);
+ procedure SetActiveFrameColor(const Value: TAlphaColor);
+ procedure SetBackColor(const Value: TAlphaColor);
+ procedure SetFrameColor(const Value: TAlphaColor);
+ procedure SetOutlineColor(const Value: TAlphaColor);
+ procedure SetOutlineWidth(const Value: Integer);
+ procedure SetOutlineVisible(const Value: Boolean);
+ procedure SetPageNo(Value: Integer);
+ procedure SetThumbnailVisible(const Value: Boolean);
+ procedure SetZoom(const Value: Double);
+ procedure SetZoomMode(const Value: TfrxZoomMode);
+ procedure SetOnMouseDown(const Value: TMouseEvent);
+ procedure UpdateOutline;
+ procedure UpdatePages;
+ procedure UpdatePageNumbers;
+ protected
+ procedure KeyDown(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState); override;
+ procedure Resize; override;
+ procedure OnResize(Sender: TObject);
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetParent(const Value: TFmxObject); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function GetCanvas: TCanvas; override;
+ procedure Init; override;
+ procedure Lock; override;
+ procedure ShowHint(aRect: TRectF; Text: String); override;
+ procedure HideHint; override;
+ procedure Unlock; override;
+ procedure RefreshReport; override;
+ procedure InternalOnProgressStart(Sender: TfrxReport;
+ ProgressType: TfrxProgressType; Progress: Integer); override;
+ procedure InternalOnProgress(Sender: TfrxReport;
+ ProgressType: TfrxProgressType; Progress: Integer); override;
+ procedure InternalOnProgressStop(Sender: TfrxReport;
+ ProgressType: TfrxProgressType; Progress: Integer); override;
+
+ procedure AddPage;
+ procedure DeletePage;
+ procedure Print;
+ procedure Edit;
+ procedure First;
+ procedure Next;
+ procedure Prior;
+ procedure Last;
+ procedure PageSetupDlg;
+ procedure PageSetupDialog;
+ procedure Cancel;
+ procedure Clear;
+ procedure ClearBackBuffer; override;
+ procedure SetPosition(PageN, Top: Integer);
+ procedure ShowMessage(const s: String);
+ procedure HideMessage;
+ procedure MouseWheelScroll(Delta: Integer; Horz: Boolean = False;
+ Zoom: Boolean = False);
+ function GetTopPosition: Integer;
+ procedure LoadFromFile; overload;
+ procedure LoadFromFile(FileName: String); overload;
+ procedure SaveToFile; overload;
+ procedure SaveToFile(FileName: String); overload;
+ procedure Export(Filter: TfrxCustomExportFilter);
+
+ property PageCount: Integer read GetPageCount;
+ property PageNo: Integer read FPageNo write SetPageNo;
+ property Zoom: Double read FZoom write SetZoom;
+ property ZoomMode: TfrxZoomMode read FZoomMode write SetZoomMode;
+ property Locked: Boolean read FLocked;
+ property OutlineTree: TTreeView read FOutline;
+ property Splitter: TfrxSplitter read FSplitter;
+ property Thumbnail: TfrxPreviewWorkspace read FThumbnail;
+ property Workspace: TfrxPreviewWorkspace read FWorkspace;
+ published
+ property Align;
+ property ActiveFrameColor: TAlphaColor read GetActiveFrameColor write SetActiveFrameColor default $804020;
+ property BackColor: TAlphaColor read GetBackColor write SetBackColor default claGray;
+ property FrameColor: TAlphaColor read GetFrameColor write SetFrameColor default claBlack;
+ property OutlineColor: TAlphaColor read FOutlineColor write SetOutlineColor default claWhite;
+ property OutlineVisible: Boolean read GetOutlineVisible write SetOutlineVisible;
+ property OutlineWidth: Integer read GetOutlineWidth write SetOutlineWidth;
+ property PopupMenu;
+ property Position;
+ property Width stored True;
+ property Height stored True;
+ property ThumbnailVisible: Boolean read GetThumbnailVisible write SetThumbnailVisible;
+ property OnClick;
+ property OnDblClick;
+ property OnPageChanged: TfrxPageChangedEvent read FOnPageChanged write FOnPageChanged;
+ property OnMouseDown: TMouseEvent read GetOnMouseDown write SetOnMouseDown;
+ property Anchors;
+ property UseReportHints;
+ end;
+
+ TfrxPreviewForm = class(TfrxForm)
+ ToolBar: TToolBar;
+ OpenB: TfrxToolButton;
+ SaveB: TfrxToolButton;
+ PrintB: TfrxToolButton;
+ ExportB: TfrxToolButton;
+ PageSettingsB: TfrxToolButton;
+ FirstB: TfrxToolButton;
+ PriorB: TfrxToolButton;
+ PageE: TEdit;
+ NextB: TfrxToolButton;
+ LastB: TfrxToolButton;
+ StatusBar: TStatusBar;
+ DesignerB: TfrxToolButton;
+ CancelB: TSpeedButton;
+ ExportPopup: TPopupMenu;
+ HiddenMenu: TPopupMenu;
+ Showtemplate1: TMenuItem;
+ RightMenu: TPopupMenu;
+ FullScreenBtn: TfrxToolButton;
+ OutlineB: TfrxToolButton;
+ ThumbB: TfrxToolButton;
+ N1: TMenuItem;
+ ExpandMI: TMenuItem;
+ CollapseMI: TMenuItem;
+ Line1: TfrxToolSeparator;
+ PageWidthB: TfrxToolButton;
+ WholePageB: TfrxToolButton;
+ Line2: TfrxToolSeparator;
+ Line3: TfrxToolSeparator;
+ Panel0: TText;
+ Panel1: TText;
+ Panel2: TText;
+ OpenMI: TMenuItem;
+ SaveMI: TMenuItem;
+ PrintMI: TMenuItem;
+ ExportMI: TMenuItem;
+ ExportPDFMI: TMenuItem;
+ ExportMailMI: TMenuItem;
+ FindMI: TMenuItem;
+ FullScrMI: TMenuItem;
+ ZoomInMI: TMenuItem;
+ ZoomOutMI: TMenuItem;
+ ZoomCB: TComboEdit;
+ HintPanel: TCalloutPanel;
+ Label1: TLabel;
+ procedure FormCreate(Sender: TObject);
+ procedure ZoomMinusBClick(Sender: TObject);
+ procedure FirstBClick(Sender: TObject);
+ procedure PriorBClick(Sender: TObject);
+ procedure NextBClick(Sender: TObject);
+ procedure LastBClick(Sender: TObject);
+ procedure PageEClick(Sender: TObject);
+ procedure PrintBClick(Sender: TObject);
+ procedure OpenBClick(Sender: TObject);
+ procedure SaveBClick(Sender: TObject);
+ procedure DesignerBClick(Sender: TObject);
+ procedure NewPageBClick(Sender: TObject);
+ procedure DelPageBClick(Sender: TObject);
+ procedure CancelBClick(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure FormKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+ procedure PageSettingsBClick(Sender: TObject);
+ procedure FormMouseWheel(Sender: TObject; Shift: TShiftState;
+ WheelDelta: Integer; var Handled: Boolean);
+ procedure DesignerBMouseUp(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+ procedure Showtemplate1Click(Sender: TObject);
+ procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+ procedure FullScreenBtnClick(Sender: TObject);
+ procedure PdfBClick(Sender: TObject);
+ procedure EmailBClick(Sender: TObject);
+ procedure ZoomPlusBClick(Sender: TObject);
+ procedure OutlineBClick(Sender: TObject);
+ procedure ThumbBClick(Sender: TObject);
+ procedure CollapseAllClick(Sender: TObject);
+ procedure ExpandAllClick(Sender: TObject);
+ procedure ZoomCBChange(Sender: TObject);
+ procedure PageWidthBClick(Sender: TObject);
+ procedure WholePageBClick(Sender: TObject);
+ procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Single);
+ procedure ExportBClick(Sender: TObject);
+ procedure ZoomCBClick(Sender: TObject);
+ procedure PrintBMouseEnter(Sender: TObject);
+ procedure PrintBMouseLeave(Sender: TObject);
+ private
+ FPopUpMItemsCount: Integer;
+ FPopUpExporttemsCount: Integer;
+ FFreeOnClose: Boolean;
+ FPreview: TfrxPreview;
+ FOldState: TWindowState;
+ FFullScreen: Boolean;
+ FPDFExport: TfrxCustomExportFilter;
+ FEmailExport: TfrxCustomExportFilter;
+ procedure ExportMIClick(Sender: TObject);
+ procedure OnPageChanged(Sender: TfrxPreview; PageNo: Integer);
+ procedure OnPreviewDblClick(Sender: TObject);
+ procedure UpdateControls;
+ procedure UpdateZoom;
+ function GetReport: TfrxReport;
+ public
+ procedure Init;
+ procedure SetMessageText(const Value: String; IsHint: Boolean = False);
+ procedure SwitchToFullScreen;
+ property FreeOnClose: Boolean read FFreeOnClose write FFreeOnClose;
+ property Preview: TfrxPreview read FPreview;
+ property Report: TfrxReport read GetReport;
+ end;
+
+ TfrxPreviewWorkspace = class(TfrxScrollWin)
+ private
+ FActiveFrameColor: TAlphaColor;
+ FBackColor: TAlphaColor;
+ FDefaultCursor: TCursor;
+ FDisableUpdate: Boolean;
+ FDown: Boolean;
+ FFrameColor: TAlphaColor;
+ FIsThumbnail: Boolean;
+ FLastPoint: TPointF;
+ FLocked: Boolean;
+ FOffset: TPoint;
+ FOldOffset: TPoint;
+ FPageList: TfrxPageList;
+ FPageNo: Integer;
+ FPreview: TfrxPreview;
+ FPreviewPages: TfrxCustomPreviewPages;
+ FZoom: Double;
+ FRTLLanguage: Boolean;
+ FDrawBuffer: TBitmap;
+ FDrawBuffer2: TBitmap;
+ FNeedBufferClear: Boolean;
+ FDoubleBuffered: Boolean;
+ FFastCanvas: TfrxFastCanvasLayer;
+ FDoDblClick: Boolean;
+ FParentForm: TfmxObject;
+ procedure DrawPages(BorderOnly: Boolean; DrawCanvas: TCanvas; ARect: TRectF);
+ procedure SetToPageNo(PageNo: Integer);
+ procedure UpdateScrollBars;
+ procedure SetDoubleBuffered(const Value: Boolean);
+ procedure SetLocked(const Value: Boolean);
+ protected
+ procedure PrevDblClick(Sender: TObject);
+ procedure MouseDown(Button: TMouseButton;
+ Shift: TShiftState; X, Y: Single); override;
+ procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Single); override;
+ procedure OnHScrollChange(Sender: TObject); override;
+ procedure OnVScrollChange(Sender: TObject); override;
+ procedure SetParent(const Value: TFmxObject); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure SetPosition(PageN, Top: Integer);
+ function GetTopPosition: Integer;
+ procedure ClearBackBuffer;
+ { page list }
+ procedure AddPage(AWidth, AHeight: Integer);
+ procedure ClearPageList;
+ procedure CalcPageBounds(ClientWidth: Integer);
+ procedure DoContentPaint(Sender: TObject; aCanvas: TCanvas; const ARect: TRectF); override;
+
+ property ActiveFrameColor: TAlphaColor read FActiveFrameColor write FActiveFrameColor default $804020;
+ property BackColor: TAlphaColor read FBackColor write FBackColor default claGray;
+ property DoubleBuffered: Boolean read FDoubleBuffered write SetDoubleBuffered default True;
+ property FrameColor: TAlphaColor read FFrameColor write FFrameColor default claBlack;
+ property IsThumbnail: Boolean read FIsThumbnail write FIsThumbnail;
+ property Locked: Boolean read FLocked write SetLocked;
+ property PageNo: Integer read FPageNo write FPageNo;
+ property Preview: TfrxPreview read FPreview write FPreview;
+ property PreviewPages: TfrxCustomPreviewPages read FPreviewPages
+ write FPreviewPages;
+ property Zoom: Double read FZoom write FZoom;
+ property RTLLanguage: Boolean read FRTLLanguage write FRTLLanguage;
+ property OnDblClick;
+ end;
+
+ TfrxPageItem = class(TCollectionItem)
+ public
+ Height: Integer;
+ Width: Integer;
+ OffsetX: Integer;
+ OffsetY: Integer;
+ end;
+
+ TfrxPageList = class(TCollection)
+ private
+ FMaxWidth: Integer;
+ function GetItems(Index: Integer): TfrxPageItem;
+ public
+ constructor Create;
+ property Items[Index: Integer]: TfrxPageItem read GetItems; default;
+ procedure AddPage(AWidth, AHeight: Integer; Zoom: Extended);
+ procedure CalcBounds(ClientWidth: Integer);
+ function FindPage(OffsetY: Integer; OffsetX: Integer = 0): Integer;
+ function GetPageBounds(Index: Integer; ClientWidth: Single; Scale: Extended; RTL: Boolean): TRect;
+ function GetMaxBounds: TPoint;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+{$R *.RES}
+
+uses
+ FMX.frxPrinter, FMX.frxSearchDialog, FMX.frxUtils, FMX.frxRes, FMX.frxDsgnIntf,
+ FMX.frxPreviewPageSettings, FMX.frxDMPClass;
+
+
+{ TfrxPageList }
+
+constructor TfrxPageList.Create;
+begin
+ inherited Create(TfrxPageItem);
+end;
+
+function TfrxPageList.GetItems(Index: Integer): TfrxPageItem;
+begin
+ Result := TfrxPageItem(inherited Items[Index]);
+end;
+
+procedure TfrxPageList.AddPage(AWidth, AHeight: Integer; Zoom: Extended);
+begin
+ with TfrxPageItem(Add) do
+ begin
+ Width := Round(AWidth * Zoom);
+ Height := Round(AHeight * Zoom);
+ end;
+end;
+
+procedure TfrxPageList.CalcBounds(ClientWidth: Integer);
+var
+ i, j, CurX, CurY, MaxY, offs: Integer;
+ Item: TfrxPageItem;
+begin
+ FMaxWidth := 0;
+ CurY := 10;
+ i := 0;
+ while i < Count do
+ begin
+ j := i;
+ CurX := 0;
+ MaxY := 0;
+ { find series of pages that will fit in the clientwidth }
+ { also calculate max height of series }
+ while j < Count do
+ begin
+ Item := Items[j];
+ { check the width, allow at least one iteration }
+ if (CurX > 0) and (CurX + Item.Width > ClientWidth) then break;
+ Item.OffsetX := CurX;
+ Item.OffsetY := CurY;
+ Inc(CurX, Item.Width + 10);
+ if Item.Height > MaxY then
+ MaxY := Item.Height;
+ Inc(j);
+ end;
+
+ if CurX > FMaxWidth then
+ FMaxWidth := CurX;
+
+ { center series horizontally }
+ offs := (ClientWidth - CurX + 10) div 2;
+ if offs < 0 then
+ offs := 0;
+ Inc(offs, 10);
+ while (i < j) do
+ begin
+ Inc(Items[i].OffsetX, offs);
+ Inc(i);
+ end;
+
+ Inc(CurY, MaxY + 10);
+ end;
+end;
+
+function TfrxPageList.FindPage(OffsetY: Integer; OffsetX: Integer = 0): Integer;
+var
+ i, i0, i1, c, add: Integer;
+ Item: TfrxPageItem;
+begin
+ i0 := 0;
+ i1 := Count - 1;
+
+ while i0 <= i1 do
+ begin
+ i := (i0 + i1) div 2;
+ if OffsetX <> 0 then
+ add := 0 else
+ add := Round(Items[i].Height / 5);
+ if Items[i].OffsetY <= OffsetY + add then
+ c := -1 else
+ c := 1;
+
+ if c < 0 then
+ i0 := i + 1 else
+ i1 := i - 1;
+ end;
+
+ { find exact page }
+ if OffsetX <> 0 then
+ begin
+ for i := i1 - 20 to i1 + 20 do
+ begin
+ if (i < 0) or (i >= Count) then continue;
+ Item := Items[i];
+ if PtInRect(Rect(Item.OffsetX, Item.OffsetY,
+ Item.OffsetX + Item.Width, Item.OffsetY + Item.Height),
+ Point(OffsetX, OffsetY)) then
+ begin
+ i1 := i;
+ break;
+ end;
+ end;
+ end;
+
+ Result := i1;
+end;
+
+function TfrxPageList.GetPageBounds(Index: Integer; ClientWidth: Single;
+ Scale: Extended; RTL: Boolean): TRect;
+var
+ ColumnOffs: Integer;
+ Item: TfrxPageItem;
+begin
+ if (Index >= Count) or (Index < 0) then
+ begin
+ if 794 * Scale > ClientWidth then
+ ColumnOffs := 10 else
+ ColumnOffs := Round((ClientWidth - 794 * Scale) / 2);
+ Result.Left := ColumnOffs;
+ Result.Top := Round(10 * Scale);
+ Result.Right := Result.Left + Round(794 * Scale);
+ Result.Bottom := Result.Top + Round(1123 * Scale);
+ end
+ else
+ begin
+ Item := Items[Index];
+ if RTL then
+ Result.Left := Round(ClientWidth) - Item.Width - Item.OffsetX
+ else
+ Result.Left := Item.OffsetX;
+ Result.Top := Item.OffsetY;
+ Result.Right := Result.Left + Item.Width;
+ Result.Bottom := Result.Top + Item.Height;
+ end;
+end;
+
+function TfrxPageList.GetMaxBounds: TPoint;
+begin
+ if Count = 0 then
+ Result := Point(0, 0)
+ else
+ begin
+ Result.X := FMaxWidth;
+ Result.Y := Items[Count - 1].OffsetY + Items[Count - 1].Height;
+ end;
+end;
+
+
+{ TfrxPreviewWorkspace }
+
+type
+ TCommonCustomFormHack = class(TCommonCustomForm);
+
+constructor TfrxPreviewWorkspace.Create(AOwner: TComponent);
+begin
+ inherited;
+ FPageList := TfrxPageList.Create;
+ OnDblClick := PrevDblClick;
+ FDoDblClick := False;
+ FBackColor := claGray;
+ FFrameColor := claBlack;
+ FActiveFrameColor := $804020;
+ FZoom := 1;
+ FDefaultCursor := crDefault;
+ FDrawBuffer := TBitmap.Create(1, 1);
+ FDrawBuffer2 := TBitmap.Create(1, 1);
+ FOldOffset := Point(0, 0);
+ FDoubleBuffered := True;
+{$IFDEF DELPHI27}
+ FDoubleBuffered := FDoubleBuffered and not GlobalUseMetal;
+{$ENDIF};
+ FFastCanvas := nil;
+ FParentForm := nil;
+ if frxCanvasClass <> nil then
+ FFastCanvas := frxCanvasClass.Create;
+end;
+
+destructor TfrxPreviewWorkspace.Destroy;
+begin
+ FPageList.Free;
+ if Assigned(FDrawBuffer) then
+ FreeAndNil(FDrawBuffer);
+ if Assigned(FDrawBuffer2) then
+ FreeAndNil(FDrawBuffer2);
+ if Assigned(FFastCanvas) then
+ FreeAndNil(FFastCanvas);
+ inherited;
+end;
+
+procedure TfrxPreviewWorkspace.DoContentPaint(Sender: TObject; aCanvas: TCanvas;
+ const ARect: TRectF);
+begin
+ if Assigned(FFastCanvas)then
+ begin
+ if not Assigned(FParentForm) then
+ begin
+ FParentForm := Parent;
+ while (FParentForm <> nil) and not (FParentForm is TCommonCustomForm) do
+ FParentForm := FParentForm.Parent;
+ end;
+ if FParentForm <> nil then
+ TfrxFastCanvasLayer(FFastCanvas).Context := TCommonCustomFormHack(FParentForm).ContextHandle;
+ end;
+ DrawPages(False, aCanvas, ARect);
+ inherited;
+end;
+
+procedure TfrxPreviewWorkspace.OnHScrollChange(Sender: TObject);
+begin
+ FOffset.X := Round(HorzPosition);
+ Repaint;
+end;
+
+procedure TfrxPreviewWorkspace.OnVScrollChange(Sender: TObject);
+var
+ i: Integer;
+begin
+ FOffset.Y := Round(VertPosition);
+ Repaint;
+
+ if not FIsThumbnail then
+ begin
+ i := FPageList.FindPage(FOffset.Y);
+ FDisableUpdate := True;
+ Preview.PageNo := i + 1;
+ FDisableUpdate := False;
+ end;
+end;
+
+procedure TfrxPreviewWorkspace.DrawPages(BorderOnly: Boolean; DrawCanvas: TCanvas; ARect: TRectF);
+var
+ n, aWidth, aHeight, TmpOffset: Integer;
+ PageBounds: TRect;
+ WorkArea, WorkRect, WorkAreaX, WorkAreaY: TRectF;
+ BufferArea: TRectF;
+ poly: TPolygon;
+ state: TCanvasSaveState;
+ cWidth: Single;
+ m: TMatrix;
+ aCanvas: TCanvas;
+ bUseBuffer: Boolean;
+
+ function PageVisible: Boolean;
+ begin
+ if (PageBounds.Top > WorkArea.Bottom) or (PageBounds.Bottom < WorkArea.Top)
+ then
+ Result := False
+ else
+ Result := True;
+ end;
+
+ procedure DrawPage(Index: Integer);
+ var
+ state: TCanvasSaveState;
+ m: TMatrix;
+ FramePath: TPathData;
+ begin
+ WorkRect := RectF(PageBounds.Left, PageBounds.Top, PageBounds.Right,
+ PageBounds.Bottom);
+ { correct work reak with re-draw work area }
+ if WorkArea.Left > WorkRect.Left then
+ WorkRect.Left := WorkArea.Left;
+ if WorkArea.Top > WorkRect.Top then
+ WorkRect.Top := WorkArea.Top;
+ if WorkArea.Bottom < WorkRect.Bottom then
+ WorkRect.Bottom := WorkArea.Bottom;
+ if WorkArea.Right < WorkRect.Right then
+ WorkRect.Right := WorkArea.Right;
+
+ { can't draw with negative coords }
+ if (WorkRect.Top > WorkRect.Bottom) or (WorkRect.Left > WorkRect.Right) then
+ Exit;
+
+ with ACanvas, PageBounds do
+ begin
+ Dec(Bottom);
+
+ m := ACanvas.Matrix;
+ State := ACanvas.SaveState;
+ FramePath := TPathData.Create;
+ { check what part of the frame we need to redraw add it to FramePath }
+ if PageBounds.Left > WorkArea.Left then
+ begin
+ FramePath.MoveTo(PointF(WorkRect.Left, WorkRect.Top));
+ FramePath.LineTo(PointF(WorkRect.Left, WorkRect.Bottom));
+ end;
+ if PageBounds.Bottom < WorkArea.Bottom then
+ begin
+ FramePath.MoveTo(PointF(WorkRect.Left, WorkRect.Bottom));
+ FramePath.LineTo(PointF(WorkRect.Right, WorkRect.Bottom));
+ end;
+ if PageBounds.Right < WorkArea.Right then
+ begin
+ FramePath.MoveTo(PointF(WorkRect.Right, WorkRect.Top));
+ FramePath.LineTo(PointF(WorkRect.Right, WorkRect.Bottom));
+ end;
+ if PageBounds.Top >= WorkRect.Top then
+ begin
+ FramePath.MoveTo(PointF(WorkRect.Left, WorkRect.Top));
+ FramePath.LineTo(PointF(WorkRect.Right, WorkRect.Top));
+ end;
+ { set clip for draw area }
+ aCanvas.IntersectClipRect(RectF(WorkRect.Left, WorkRect.Top,
+ WorkRect.Right, WorkRect.Bottom));
+ try
+ { draw background }
+ Fill.Kind := TBrushKind.bkSolid;
+ Fill.Color := claWhite;
+ FillRect(RectF(WorkRect.Left, WorkRect.Top, WorkArea.Right,
+ WorkArea.Bottom), 0, 0, allCorners, 1);
+ { draw frame if any }
+ Stroke.Color := FrameColor;
+{$IFDEF DELPHI25}
+ Stroke.Thickness := 2;
+{$ELSE}
+ StrokeThickness := 2;
+{$ENDIF}
+ Stroke.Kind := TBrushKind.bkSolid;
+ DrawPath(FramePath, 1);
+ { draw page objects only inside WorkArea }
+ PreviewPages.DrawPage(Index, aCanvas, Zoom, Zoom, PageBounds.Left,
+ PageBounds.Top, WorkArea);
+ finally
+ aCanvas.RestoreState(state);
+ aCanvas.SetMatrix(m);
+ FreeAndNil(FramePath);
+ end;
+ end;
+
+ if FIsThumbnail then
+ with aCanvas do
+ begin
+ Font.Family := 'Arial';
+ Font.Size := 8;
+ Font.Style := [];
+ Fill.Kind := TBrushKind.bkSolid;
+ Fill.Color := claWhite;
+ FillText(RectF(PageBounds.Left + 1, PageBounds.Top + 1,
+ PageBounds.Left + 10, PageBounds.Top + 10), ' ' + IntToStr(Index + 1)
+ + ' ', False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ end;
+ end;
+
+ procedure DrawPages();
+ var
+ i: Integer;
+ begin
+ { width of area to redraw }
+ cWidth := WorkArea.Right - WorkArea.Left;
+ { preview backcolor fill }
+ if not BorderOnly then
+ with aCanvas do
+ begin
+ Fill.Color := BackColor;
+ Fill.Kind := TBrushKind.bkSolid;
+ FillRect(RectF(WorkArea.Left, WorkArea.Top, WorkArea.Right,
+ WorkArea.Bottom), 0, 0, allCorners, 1);
+ end;
+
+ if Locked or (FPageList.Count = 0) then
+ Exit;
+
+ if PreviewPages = nil then
+ Exit;
+
+ { index of first visible page }
+ n := FPageList.FindPage(FOffset.Y);
+
+ { draw border around the active page }
+ PageBounds := FPageList.GetPageBounds(PageNo - 1, cWidth, Zoom,
+ FRTLLanguage);
+ OffsetRect(PageBounds, -FOffset.X, -FOffset.Y);
+ with aCanvas, PageBounds do
+ begin
+ Stroke.Color := ActiveFrameColor;
+{$IFDEF DELPHI25}
+ Stroke.Thickness := 2;
+{$ELSE}
+ StrokeThickness := 2;
+{$ENDIF}
+ Stroke.Kind := TBrushKind.bkSolid;
+ SetLength(poly, 5);
+ poly[0] := PointF(Left - 1, Top - 1);
+ poly[1] := PointF(Right + 1, Top - 1);
+ poly[2] := PointF(Right + 1, Bottom + 1);
+ poly[3] := PointF(Left - 1, Bottom + 1);
+ poly[4] := PointF(Left - 1, Top - 2);
+ // DrawPolygon(poly, 1);
+ // todo
+ end;
+ if not BorderOnly then
+ begin
+ { draw visible pages }
+ for i := n - 40 to n + 40 do
+ begin
+ if i < 0 then
+ continue;
+ if i >= FPageList.Count then
+ break;
+ PageBounds := FPageList.GetPageBounds(i, cWidth, Zoom, FRTLLanguage);
+ OffsetRect(PageBounds, -FOffset.X, -FOffset.Y);
+ Inc(PageBounds.Bottom);
+ { draw only pages in area }
+ if PageVisible then
+ DrawPage(i);
+ end;
+ end;
+ end;
+
+begin
+ if not Visible then Exit;
+ { assign default draw area }
+ aWidth := Round(ARect.Right - ARect.Left);
+ aHeight := Round(ARect.Bottom - ARect.Top);
+
+ WorkArea.Top := Round(aRect.Top);
+ WorkArea.Left := Round(aRect.Left);
+ WorkArea.Bottom := Round(aRect.Bottom);
+ WorkArea.Right := Round(aRect.Right);
+ { used for horizontal re-draw }
+ WorkAreaX := WorkArea;
+ { used for vertical re-draw }
+ WorkAreaY := WorkArea;
+
+ { there is no buffer to draw on, draws on canvas }
+ if not Assigned(FDrawBuffer) then
+ begin
+ aCanvas := DrawCanvas;
+ m := Canvas.Matrix;
+ State := Canvas.SaveState;
+ Canvas.IntersectClipRect(ARect);
+ try
+ DrawPages();
+ finally
+ Canvas.RestoreState(state);
+ Canvas.SetMatrix(m);
+ end;
+ Exit;
+ end;
+
+ BufferArea := aRect;
+ bUseBuffer := False;
+ { if scrooled area more than view size, redraw all buffer }
+ FNeedBufferClear := (FNeedBufferClear or (Abs(FOffset.X - FOldOffset.X) > aWidth) or (Abs(FOffset.Y - FOldOffset.Y) > aHeight));
+ // resize buffers
+ if (FDrawBuffer.Width <> aWidth) or (FDrawBuffer.Height <> aHeight) then
+ begin
+ FDrawBuffer2.SetSize(aWidth, aHeight);
+ FDrawBuffer.SetSize(aWidth, aHeight);
+ end
+ else
+ { do we need to re draw part of buffer, or just draw as is ? }
+ bUseBuffer := (((FOffset.X <> FOldOffset.X) or (FOffset.Y <> FOldOffset.Y))
+ and not FNeedBufferClear);
+
+ { redraw part of buffer }
+ if bUseBuffer then
+ begin
+ { calculate offset for buffer contend and new area to redraw objects }
+ if (FOffset.X > FOldOffset.X) then
+ begin
+ TmpOffset := FOffset.X - FOldOffset.X;
+ WorkAreaX.Left := WorkAreaX.Right - TmpOffset;
+ BufferArea.Left := BufferArea.Left - TmpOffset;
+ BufferArea.Right := BufferArea.Right - TmpOffset;
+ end;
+ if (FOffset.X < FOldOffset.X) then
+ begin
+ TmpOffset := FOldOffset.X - FOffset.X;
+ WorkAreaX.Right := WorkAreaX.Left + TmpOffset;
+ BufferArea.Right := BufferArea.Right + TmpOffset;
+ BufferArea.Left := BufferArea.Left + TmpOffset;
+ end;
+ if (FOffset.Y > FOldOffset.Y) then
+ begin
+ TmpOffset := FOffset.Y - FOldOffset.Y;
+ WorkAreaY.Top := WorkAreaY.Bottom - TmpOffset;
+ BufferArea.Top := BufferArea.Top - TmpOffset;
+ BufferArea.Bottom := BufferArea.Bottom - TmpOffset;
+ end;
+ if (FOffset.Y < FOldOffset.Y) then
+ begin
+ TmpOffset := FOldOffset.Y - FOffset.Y;
+ WorkAreaY.Bottom := WorkAreaY.Top + TmpOffset;
+ BufferArea.Bottom := BufferArea.Bottom + TmpOffset;
+ BufferArea.Top := BufferArea.Top + TmpOffset;
+ end;
+ { copy buffer content to temp buffer }
+ FDrawBuffer2.Canvas.BeginScene();
+ try
+ //FDrawBuffer2.Clear(BackColor);
+ FDrawBuffer2.Canvas.DrawBitmap(FDrawBuffer, RectF(0, 0, FDrawBuffer.Width,
+ FDrawBuffer.Height), RectF(0, 0, FDrawBuffer.Width,
+ FDrawBuffer.Height), 1, True);
+ finally
+ FDrawBuffer2.Canvas.EndScene;
+ end;
+ FDrawBuffer.Canvas.BeginScene();
+ State := FDrawBuffer.Canvas.SaveState;
+ m := FDrawBuffer.Canvas.Matrix;
+ { draws old content with offset from temp buffer }
+ try
+ FDrawBuffer.Clear(BackColor);
+ FDrawBuffer.Canvas.DrawBitmap(FDrawBuffer2, RectF(0, 0, FDrawBuffer.Width,
+ FDrawBuffer.Height), BufferArea, 1, True);
+ finally
+ FDrawBuffer.Canvas.RestoreState(state);
+ FDrawBuffer.Canvas.SetMatrix(m);
+ FDrawBuffer.Canvas.EndScene;
+ end;
+ end;
+ { set current canvas to draw, backbuffer canvas }
+ aCanvas := FDrawBuffer.Canvas;
+ { check if we have fake FR canvas assigned for fast draw }
+ if Assigned(FFastCanvas) then
+ begin
+ FFastCanvas.Canvas := aCanvas;
+ FFastCanvas.BeginScene;
+ end
+ else
+ aCanvas.BeginScene;
+
+ m := DrawCanvas.Matrix;
+ state := DrawCanvas.SaveState;
+ try
+ DrawCanvas.IntersectClipRect(aRect);
+ try
+ { draw full content if needed }
+ if FNeedBufferClear then
+ DrawPages()
+ else
+ begin
+ { draw for horizontal offset }
+ if (FOffset.X <> FOldOffset.X) then
+ begin
+ WorkArea := WorkAreaX;
+ DrawPages();
+ end;
+ { draw for vertical offset }
+ if (FOffset.Y <> FOldOffset.Y) then
+ begin
+ WorkArea := WorkAreaY;
+ DrawPages();
+ end;
+ end;
+ { reset offset }
+ FNeedBufferClear := False;
+ FOldOffset := FOffset;
+ finally
+ if Assigned(FFastCanvas) then
+ FFastCanvas.EndScene
+ else
+ aCanvas.EndScene;
+ end;
+ { draw from buffer to form canvas }
+ DrawCanvas.DrawBitmap(FDrawBuffer, RectF(0, 0, FDrawBuffer.Width,
+ FDrawBuffer.Height), aRect, 1, not GlobalUseDirect2D);
+ finally
+ DrawCanvas.RestoreState(state);
+ DrawCanvas.SetMatrix(m);
+ end;
+end;
+
+procedure TfrxPreviewWorkspace.MouseDown(Button: TMouseButton;
+ Shift: TShiftState; X, Y: Single);
+begin
+ if Assigned(OnMouseDown) then
+ OnMouseDown(Self, Button, Shift, X, Y);
+ if (FPageList.Count = 0) or Locked then Exit;
+
+ if Button = mbLeft then
+ begin
+ FDown := True;
+ FDoDblClick := ssDouble in Shift;
+ FLastPoint.X := X;
+ FLastPoint.Y := Y;
+ end;
+end;
+
+procedure TfrxPreviewWorkspace.MouseMove(Shift: TShiftState; X, Y: Single);
+var
+ PageNo: Integer;
+ PageBounds: TRect;
+ Cur: TCursor;
+begin
+ if (FPageList.Count = 0) or Locked or FIsThumbnail then Exit;
+
+ if FDown then
+ begin
+ HorzPosition := HorzPosition - (X - FLastPoint.X);
+ VertPosition := VertPosition - (Y - FLastPoint.Y);
+ FLastPoint.X := X;
+ FLastPoint.Y := Y;
+ end
+ else
+ begin
+ PageNo := FPageList.FindPage(FOffset.Y + Round(Y), FOffset.X + Round(X));
+ PageBounds := FPageList.GetPageBounds(PageNo, Width, Zoom, FRTLLanguage);
+ Cur := FDefaultCursor;
+ PreviewPages.ObjectOver(PageNo, Round(X), Round(Y), mbLeft, [], Zoom,
+ PageBounds.Left - FOffset.X, PageBounds.Top - FOffset.Y, False, Cur);
+ Cursor := Cur;
+ end;
+end;
+
+procedure TfrxPreviewWorkspace.MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Single);
+var
+ PageNo: Integer;
+ PageBounds: TRect;
+ Cur: TCursor;
+ XOffSet: Integer;
+begin
+ inherited;
+ if not FIsThumbnail and Assigned(Preview.OnClick) then
+ Preview.OnClick(Preview);
+ if (FPageList.Count = 0) or Locked then Exit;
+
+ FDown := False;
+ if FRTLLanguage then
+ XOffSet := Round(Width - (FOffset.X + X))
+ else
+ XOffSet := FOffset.X + Round(X);
+
+ PageNo := FPageList.FindPage(FOffset.Y + Round(Y), XOffSet);
+ FDisableUpdate := True;
+ Preview.PageNo := PageNo + 1;
+ FDisableUpdate := False;
+
+ if not FIsThumbnail and (Button <> mbRight) then
+ begin
+ PageBounds := FPageList.GetPageBounds(PageNo, Width, Zoom, FRTLLanguage);
+ if FDoDblClick then
+ begin
+ PreviewPages.ObjectOver(PageNo, Round(X), Round(Y), Button, Shift, Zoom,
+ PageBounds.Left - FOffset.X, PageBounds.Top - FOffset.Y, True, Cur, True);
+ FDoDblClick := False;
+ end
+ else
+ begin
+ PreviewPages.ObjectOver(PageNo, Round(X), Round(Y), Button, Shift, Zoom,
+ PageBounds.Left - FOffset.X, PageBounds.Top - FOffset.Y, True, Cur);
+ end;
+ end;
+end;
+
+procedure TfrxPreviewWorkspace.SetToPageNo(PageNo: Integer);
+begin
+ if FDisableUpdate then Exit;
+ VertPosition :=
+ FPageList.GetPageBounds(PageNo - 1, Width, Zoom, FRTLLanguage).Top - 10;
+end;
+
+procedure TfrxPreviewWorkspace.UpdateScrollBars;
+var
+ MaxSize: TPoint;
+begin
+ MaxSize := FPageList.GetMaxBounds;
+ HorzRange := MaxSize.X + 10;
+ VertRange := MaxSize.Y + 10;
+end;
+
+procedure TfrxPreviewWorkspace.SetDoubleBuffered(const Value: Boolean);
+begin
+ FDoubleBuffered := Value;
+{$IFDEF DELPHI27}
+ FDoubleBuffered := FDoubleBuffered and not GlobalUseMetal;
+{$ENDIF};
+ if Value = False then
+ begin
+ if Assigned(FDrawBuffer) then
+ FreeAndNil(FDrawBuffer);
+ if Assigned(FDrawBuffer2) then
+ FreeAndNil(FDrawBuffer2);
+ end;
+end;
+
+procedure TfrxPreviewWorkspace.SetLocked(const Value: Boolean);
+begin
+ if Value and not FLocked then
+ FNeedBufferClear := True;
+ FLocked := Value;
+end;
+
+procedure TfrxPreviewWorkspace.SetParent(const Value: TFmxObject);
+begin
+ inherited;
+ FParentForm := nil;
+end;
+
+procedure TfrxPreviewWorkspace.SetPosition(PageN, Top: Integer);
+var
+ Pos: Integer;
+ Page: TfrxReportPage;
+begin
+ Page := PreviewPages.Page[PageN - 1];
+ if Page = nil then
+ exit;
+ if Top = 0 then
+ Pos := 0
+ else
+ Pos := Round((Top + Page.TopMargin * fr01cm) * Zoom);
+
+ VertPosition := FPageList.GetPageBounds(PageN - 1, Width, Zoom, FRTLLanguage).Top - 10 + Pos;
+end;
+
+function TfrxPreviewWorkspace.GetTopPosition: Integer;
+var
+ Page: TfrxReportPage;
+begin
+ Result := 0;
+ Page := PreviewPages.Page[Preview.PageNo - 1];
+ if Page <> nil then
+ Result := Round((VertPosition - FPageList.GetPageBounds(Preview.PageNo - 1, Width, Zoom, FRTLLanguage).Top + 10)/ Zoom - Page.TopMargin * fr01cm);
+end;
+
+procedure TfrxPreviewWorkspace.AddPage(AWidth, AHeight: Integer);
+begin
+ FPageList.AddPage(AWidth, AHeight, Zoom);
+end;
+
+procedure TfrxPreviewWorkspace.CalcPageBounds(ClientWidth: Integer);
+begin
+ FPageList.CalcBounds(ClientWidth);
+end;
+
+procedure TfrxPreviewWorkspace.ClearBackBuffer;
+begin
+ FNeedBufferClear := True;
+end;
+
+procedure TfrxPreviewWorkspace.ClearPageList;
+begin
+ FPageList.Clear;
+ if Assigned(FFastCanvas) then
+ TfrxFastCanvasLayer(FFastCanvas).ClearCache;
+ FNeedBufferClear := True;
+end;
+
+
+procedure TfrxPreviewWorkspace.PrevDblClick(Sender: TObject);
+begin
+ if not IsThumbnail and Assigned(FPreview.OnDblClick) then
+ FPreview.OnDblClick(Sender);
+end;
+
+{ TfrxPreview }
+
+constructor TfrxPreview.Create(AOwner: TComponent);
+var
+ m: TMenuItem;
+begin
+ inherited;
+
+ FOutlinePopup := TPopupMenu.Create(Self);
+ m := TMenuItem.Create(FOutlinePopup);
+ FOutlinePopup.AddObject(m);
+ m.Text := frxGet(601);
+ FOutlinePopup.Stored := false;
+// m.Bitmap := 13;
+ m.OnClick := OnCollapseClick;
+ m := TMenuItem.Create(FOutlinePopup);
+ FOutlinePopup.AddObject(m);
+ m.Text := frxGet(600);
+// m.ImageIndex := 14;
+ m.OnClick := OnExpandClick;
+
+ FOutline := TTreeView.Create(Self);
+ with FOutline do
+ begin
+ Parent := Self;
+ Align := alLeft;
+ OnClick := OnOutlineClick;
+ PopupMenu := FOutlinePopup;
+ Stored := False;
+ end;
+
+ FThumbnail := TfrxPreviewWorkspace.Create(Self);
+ FThumbnail.Parent := Self;
+ FThumbnail.Align := alLeft;
+ FThumbnail.Visible := False;
+ FThumbnail.Zoom := 0.1;
+ FThumbnail.IsThumbnail := True;
+ FThumbnail.Preview := Self;
+ FThumbnail.Stored := False;
+
+ FSplitter := TfrxSplitter.Create(Self);
+ FSplitter.Parent := Self;
+ FSplitter.Align := alLeft;
+ FSplitter.Width := 4;
+ FSplitter.OnMove := OnMoveSplitter;
+ FSplitter.Stored := False;
+
+ FWorkspace := TfrxPreviewWorkspace.Create(Self);
+ FWorkspace.Parent := Self;
+ FWorkspace.Align := alClient;
+ FWorkspace.Preview := Self;
+ FWorkspace.OnResize := OnResize;
+ FWorkspace.Stored := False;
+ FWorkspace.DoubleBuffered := True
+{$IFDEF DELPHI27}
+ and not GlobalUseMetal;
+{$ENDIF};
+
+ FMessagePanel := TPanel.Create(Self);
+ FMessagePanel.Parent := Self;
+ FMessagePanel.Visible := False;
+ FMessagePanel.SetBounds(0, 0, 0, 0);
+ FMessagePanel.Stored := False;
+
+ FMessageLabel := TLabel.Create(FMessagePanel);
+ FMessageLabel.Parent := FMessagePanel;
+ FMessageLabel.AutoSize := False;
+ FMessageLabel.TextAlign := taCenter;
+ FMessageLabel.SetBounds(4, 20, 255, 20);
+ FMessageLabel.Stored := False;
+
+ FCancelButton := TButton.Create(FMessagePanel);
+ FCancelButton.Parent := FMessagePanel;
+ FCancelButton.SetBounds(92, 44, 75, 25);
+ FCancelButton.Text := frxResources.Get('clCancel');
+ FCancelButton.Visible := False;
+ FCancelButton.OnClick := OnCancel;
+ FCancelButton.Stored := False;
+
+ FPageNo := 1;
+ FZoom := 1;
+ FZoomMode := zmDefault;
+ FOutlineColor := claWhite;
+ UseReportHints := True;
+
+ Width := 100;
+ Height := 100;
+
+ HintPanel := TCalloutPanel.Create(Self);
+ HintPanel.Stored := False;
+ HintPanel.Parent := Self;
+ HintLabel := TLabel.Create(HintPanel);
+ HintLabel.Stored := False;
+ HintLabel.Parent := HintPanel;
+ HintPanel.Visible := False;
+ HintPanel.SetBounds(0,0,100, 40);
+ HintLabel.Align := TAlignLayout.alClient;
+end;
+
+destructor TfrxPreview.Destroy;
+begin
+ if Report <> nil then
+ Report.Preview := nil;
+ inherited;
+end;
+
+procedure TfrxPreview.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited Notification(AComponent, Operation);
+
+ if Operation = opRemove then
+ if AComponent = Report then
+ begin
+ Clear;
+ Report := nil;
+ PreviewPages := nil;
+ end;
+end;
+
+procedure TfrxPreview.Init;
+begin
+ if csDesigning in ComponentState then Exit;
+
+ FWorkspace.PreviewPages := PreviewPages;
+ FThumbnail.PreviewPages := PreviewPages;
+ FAllowF3 := False;
+
+ OutlineWidth := Report.PreviewOptions.OutlineWidth;
+ OutlineVisible := Report.PreviewOptions.OutlineVisible;
+ ThumbnailVisible := Report.PreviewOptions.ThumbnailVisible;
+ FZoomMode := Report.PreviewOptions.ZoomMode;
+ FZoom := Report.PreviewOptions.Zoom;
+ UpdatePages;
+ UpdateOutline;
+ First;
+end;
+
+procedure TfrxPreview.KeyDown(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState);
+begin
+ inherited;
+ if ssCtrl in Shift then
+ begin
+ if (Key = Ord('P')) and (pbPrint in Report.PreviewOptions.Buttons) then
+ Print
+ else if (Key = Ord('S')) and (pbSave in Report.PreviewOptions.Buttons) then
+ SaveToFile
+ else if (Key = Ord('O')) and (pbLoad in Report.PreviewOptions.Buttons) then
+ LoadFromFile
+ end;
+end;
+
+procedure TfrxPreview.Resize;
+begin
+ inherited;
+end;
+
+procedure TfrxPreview.OnMoveSplitter(Sender: TObject);
+begin
+ UpdatePages;
+end;
+
+procedure TfrxPreview.OnCollapseClick(Sender: TObject);
+begin
+ FOutline.CollapseAll;
+ FWorkspace.SetFocus;
+end;
+
+procedure TfrxPreview.OnExpandClick(Sender: TObject);
+begin
+ FOutline.ExpandAll;
+ FWorkspace.SetFocus;
+end;
+
+procedure TfrxPreview.SetZoom(const Value: Double);
+begin
+ FZoom := Value;
+ if FZoom < 0.25 then
+ FZoom := 0.25;
+ if FZoom > 5.0 then
+ FZoom := 5;
+
+ FZoomMode := zmDefault;
+ UpdatePages;
+end;
+
+procedure TfrxPreview.SetZoomMode(const Value: TfrxZoomMode);
+begin
+ FZoomMode := Value;
+ UpdatePages;
+end;
+
+function TfrxPreview.GetOutlineVisible: Boolean;
+begin
+ Result := FOutline.Visible;
+end;
+
+procedure TfrxPreview.SetOutlineVisible(const Value: Boolean);
+var
+ NeedChange: Boolean;
+begin
+ NeedChange := Value <> FOutline.Visible;
+
+ FSplitter.Visible := Value or ThumbnailVisible;
+ FOutline.Visible := Value;
+
+ if Value then
+ FThumbnail.Visible := False;
+
+ if Owner is TfrxPreviewForm then
+ TfrxPreviewForm(Owner).OutlineB.Down := Value;
+ if NeedChange then
+ UpdatePages;
+end;
+
+function TfrxPreview.GetThumbnailVisible: Boolean;
+begin
+ Result := FThumbnail.Visible;
+end;
+
+procedure TfrxPreview.SetThumbnailVisible(const Value: Boolean);
+var
+ NeedChange: Boolean;
+begin
+ NeedChange := Value <> FThumbnail.Visible;
+
+ FSplitter.Visible := Value or OutlineVisible;
+ FThumbnail.Visible := Value;
+
+ if Value then
+ FOutline.Visible := False;
+
+ if Value then
+ begin
+ FThumbnail.HorzPosition := FThumbnail.HorzPosition;
+ FThumbnail.VertPosition := FThumbnail.VertPosition;
+ end;
+ if Owner is TfrxPreviewForm then
+ TfrxPreviewForm(Owner).ThumbB.Down := Value;
+ if NeedChange then
+ UpdatePages;
+end;
+
+function TfrxPreview.GetOutlineWidth: Integer;
+begin
+ Result := Round(FOutline.Width);
+end;
+
+procedure TfrxPreview.SetOutlineWidth(const Value: Integer);
+begin
+ FOutline.Width := Value;
+ if not (csDesigning in ComponentState) then
+ FThumbnail.Width := Value;
+end;
+
+procedure TfrxPreview.SetOutlineColor(const Value: TAlphaColor);
+begin
+ FOutlineColor := Value;
+// FOutline.Color := Value;
+end;
+
+procedure TfrxPreview.SetPageNo(Value: Integer);
+begin
+ if Value < 1 then
+ Value := 1;
+ if Value > PageCount then
+ Value := PageCount;
+ if Value = 0 then Exit;
+
+ FPageNo := Value;
+ FWorkspace.PageNo := Value;
+ FThumbnail.PageNo := Value;
+
+ FWorkspace.SetToPageNo(FPageNo);
+ FThumbnail.SetToPageNo(FPageNo);
+ UpdatePageNumbers;
+end;
+
+procedure TfrxPreview.SetParent(const Value: TFmxObject);
+begin
+ inherited;
+ if Assigned(FWorkspace) then
+ FWorkspace.Parent := Self;
+end;
+
+function TfrxPreview.GetActiveFrameColor: TAlphaColor;
+begin
+ Result := FWorkspace.ActiveFrameColor;
+end;
+
+function TfrxPreview.GetBackColor: TAlphaColor;
+begin
+ Result := FWorkspace.BackColor;
+end;
+
+function TfrxPreview.GetCanvas: TCanvas;
+begin
+ Result := nil;
+ if Assigned(FWorkspace.FFastCanvas) then
+ Result := FWorkspace.FFastCanvas;
+end;
+
+function TfrxPreview.GetFrameColor: TAlphaColor;
+begin
+ Result := FWorkspace.FrameColor;
+end;
+
+procedure TfrxPreview.SetActiveFrameColor(const Value: TAlphaColor);
+begin
+ FWorkspace.ActiveFrameColor := Value;
+end;
+
+procedure TfrxPreview.SetBackColor(const Value: TAlphaColor);
+begin
+ FWorkspace.BackColor := Value;
+end;
+
+procedure TfrxPreview.SetFrameColor(const Value: TAlphaColor);
+begin
+ FWorkspace.FrameColor := Value;
+end;
+
+procedure TfrxPreview.UpdatePageNumbers;
+begin
+ if Assigned(FOnPageChanged) then
+ FOnPageChanged(Self, FPageNo);
+end;
+
+function TfrxPreview.GetPageCount: Integer;
+begin
+ if PreviewPages <> nil then
+ Result := PreviewPages.Count
+ else
+ Result := 0;
+end;
+
+function TfrxPreview.GetOnMouseDown: TMouseEvent;
+begin
+ Result := FWorkspace.OnMouseDown;
+end;
+
+procedure TfrxPreview.SetOnMouseDown(const Value: TMouseEvent);
+begin
+ FWorkspace.OnMouseDown := Value;
+end;
+
+procedure TfrxPreview.ShowHint(aRect: TRectF; Text: String);
+var
+ r: TRectF;
+begin
+ inherited;
+ HintPanel.CalloutPosition := TCalloutPosition.cpTop;
+ HintPanel.Position.X := aRect.Left + aRect.Width/2 - HintPanel.Width/2;
+ HintPanel.Position.Y := aRect.Top + aRect.Height;
+{$IFDEF DELPHI18}
+ HintLabel.Margins.Left := 0;
+ HintLabel.Margins.Top := 0;
+{$ELSE}
+ HintLabel.Padding.Left := 0;
+ HintLabel.Padding.Top := 0;
+{$ENDIF}
+ HintLabel.Visible := True;
+ HintLabel.WordWrap := True;
+ r := RectF(0, 0, 200, 1000);
+ if HintLabel.Canvas <> nil then
+ HintLabel.Canvas.MeasureText(r, Text, True, [], TTextAlign.taCenter, TTextAlign.taCenter);
+ HintPanel.Width := r.Width + 6;
+ HintPanel.Height := r.Height + HintPanel.CalloutLength + 10;
+ HintLabel.WordWrap := True;
+ HintLabel.VertTextAlign := TTextAlign.taCenter;
+ HintLabel.TextAlign := TTextAlign.taCenter;
+ HintLabel.Text := Text;
+ HintPanel.Visible := True;
+end;
+
+procedure TfrxPreview.ShowMessage(const s: String);
+begin
+ FMessagePanel.SetBounds((Width - 260) / 2, (Height - 75) / 3, 260, 75);
+ FMessageLabel.Text := s;
+ FMessagePanel.Visible := True;
+ FMessagePanel.Repaint;
+end;
+
+procedure TfrxPreview.HideHint;
+begin
+ inherited;
+ HintPanel.Visible := False;
+end;
+
+procedure TfrxPreview.HideMessage;
+begin
+ FMessagePanel.Visible := False;
+ FCancelButton.Visible := False;
+end;
+
+procedure TfrxPreview.First;
+begin
+ PageNo := 1;
+end;
+
+procedure TfrxPreview.Next;
+begin
+ PageNo := PageNo + 1;
+end;
+
+procedure TfrxPreview.Prior;
+begin
+ PageNo := PageNo - 1;
+end;
+
+procedure TfrxPreview.Last;
+begin
+ PageNo := PageCount;
+end;
+
+procedure TfrxPreview.Print;
+begin
+ if FRunning then Exit;
+ try
+ PreviewPages.CurPreviewPage := PageNo;
+ PreviewPages.Print;
+ finally
+ Unlock;
+ end;
+end;
+
+procedure TfrxPreview.SaveToFile;
+var
+ SaveDlg: TSaveDialog;
+begin
+ if FRunning then Exit;
+ SaveDlg := TSaveDialog.Create(Application);
+ try
+ SaveDlg.Filter := frxResources.Get('clFP3files') + ' (*.fp3)|*.fp3';
+ if SaveDlg.Execute then
+ begin
+ FWorkspace.Repaint;
+ SaveToFile(ChangeFileExt(SaveDlg.FileName, '.fp3'));
+ end;
+ finally
+ SaveDlg.Free;
+ end;
+end;
+
+procedure TfrxPreview.SaveToFile(FileName: String);
+begin
+ if FRunning then Exit;
+ try
+ Lock;
+ ShowMessage(frxResources.Get('clSaving'));
+ PreviewPages.SaveToFile(FileName);
+ finally
+ Unlock;
+ end;
+end;
+
+procedure TfrxPreview.LoadFromFile;
+var
+ OpenDlg: TOpenDialog;
+begin
+ if FRunning then Exit;
+ OpenDlg := TOpenDialog.Create(nil);
+ try
+ OpenDlg.Filter := frxResources.Get('clFP3files') + ' (*.fp3)|*.fp3';
+ if OpenDlg.Execute then
+ begin
+ FWorkspace.Repaint;
+ LoadFromFile(OpenDlg.FileName);
+ end;
+ finally
+ OpenDlg.Free;
+ end;
+end;
+
+procedure TfrxPreview.LoadFromFile(FileName: String);
+begin
+ if FRunning then Exit;
+ try
+ Lock;
+ ShowMessage(frxResources.Get('clLoading'));
+ PreviewPages.LoadFromFile(FileName);
+ finally
+ PageNo := 1;
+ UpdateOutline;
+ Unlock;
+ end;
+end;
+
+procedure TfrxPreview.Export(Filter: TfrxCustomExportFilter);
+begin
+ if FRunning then Exit;
+ try
+ PreviewPages.CurPreviewPage := PageNo;
+ if Report.DotMatrixReport and (frxDotMatrixExport <> nil) and
+ (Filter.ClassName = 'TfrxTextExport') then
+ Filter := frxDotMatrixExport;
+ PreviewPages.Export(Filter);
+ finally
+ Unlock;
+ end;
+end;
+
+procedure TfrxPreview.PageSetupDialog;
+begin
+ PageSetupDlg;
+end;
+
+procedure TfrxPreview.PageSetupDlg;
+var
+ APage: TfrxReportPage;
+
+ procedure UpdateReport;
+ var
+ i: Integer;
+ begin
+ for i := 0 to Report.PagesCount - 1 do
+ if Report.Pages[i] is TfrxReportPage then
+ with TfrxReportPage(Report.Pages[i]) do
+ begin
+ Orientation := APage.Orientation;
+ PaperWidth := APage.PaperWidth;
+ PaperHeight := APage.PaperHeight;
+ PaperSize := APage.PaperSize;
+
+ LeftMargin := APage.LeftMargin;
+ RightMargin := APage.RightMargin;
+ TopMargin := APage.TopMargin;
+ BottomMargin := APage.BottomMargin;
+ end;
+ end;
+
+begin
+ if FRunning then Exit;
+ APage := PreviewPages.Page[PageNo - 1];
+
+ if Assigned(APage) then with TfrxPageSettingsForm.Create(Application) do
+ begin
+ Page := APage;
+ Report := Self.Report;
+ FormShow(nil);
+ if ShowModal = mrOk then
+ begin
+ if NeedRebuild then
+ begin
+ UpdateReport;
+ Self.Report.PrepareReport;
+ end
+ else
+ begin
+ try
+ Lock;
+ PreviewPages.ModifyPage(PageNo - 1, Page);
+ finally
+ Unlock;
+ end;
+ end;
+ end;
+ if Report.PreviewForm is TfrxForm then
+ TfrxForm(Report.PreviewForm).PeekLastModalResult;
+ Free;
+ end;
+end;
+
+procedure TfrxPreview.Edit;
+var
+ r: TfrxReport;
+ p: TfrxReportPage;
+ SourcePage: TfrxPage;
+
+ procedure RemoveBands;
+ var
+ i: Integer;
+ l: TList;
+ c: TfrxComponent;
+ begin
+ l := p.AllObjects;
+
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if c is TfrxView then
+ begin
+ TfrxView(c).DataField := '';
+ TfrxView(c).DataSet := nil;
+ TfrxView(c).Restrictions := [];
+ end;
+
+ if c.Parent <> p then
+ begin
+ c.Left := c.AbsLeft;
+ c.Top := c.AbsTop;
+ c.ParentFont := False;
+ c.Parent := p;
+ if (c is TfrxView) and (TfrxView(c).Align in [baBottom, baClient]) then
+ TfrxView(c).Align := baNone;
+ end;
+ end;
+
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if c is TfrxBand then
+ c.Free;
+ end;
+ end;
+
+begin
+ SourcePage := PreviewPages.Page[PageNo - 1];
+ r := nil;
+ if Assigned(SourcePage) then
+ try
+
+ if SourcePage is TfrxDMPPage then
+ p := TfrxDMPPage.Create(nil) else
+ p := TfrxReportPage.Create(nil);
+ r := TfrxReport.Create(nil);
+ p.AssignAll(SourcePage);
+ p.Parent := r;
+ RemoveBands;
+ try
+ Lock;
+ if r.DesignPreviewPage then
+ PreviewPages.ModifyPage(PageNo - 1, TfrxReportPage(r.Pages[0]));
+ finally
+ Unlock;
+ end;
+ except
+ end;
+ if r <> nil then
+ r.Free;
+end;
+
+procedure TfrxPreview.EditTemplate;
+var
+ r: TfrxReport;
+ i: Integer;
+begin
+ r := TfrxReport.Create(nil);
+ try
+ for i := 0 to TfrxPreviewPages(PreviewPages).SourcePages.Count - 1 do
+ r.Objects.Add(TfrxPreviewPages(PreviewPages).SourcePages[i]);
+ r.DesignReport;
+ finally
+ r.Objects.Clear;
+ r.Free;
+ end;
+end;
+
+procedure TfrxPreview.Clear;
+begin
+ if FRunning then Exit;
+ Lock;
+ try
+ PreviewPages.Clear;
+ finally
+ Unlock;
+ end;
+
+ FWorkspace.ClearPageList;
+ FThumbnail.ClearPageList;
+ UpdateOutline;
+ PageNo := 1;
+ with FWorkspace do
+ begin
+ HorzRange := 0;
+ VertRange := 0;
+ end;
+ if ThumbnailVisible then
+ with FThumbnail do
+ begin
+ HorzRange := 0;
+ VertRange := 0;
+ end;
+end;
+
+procedure TfrxPreview.ClearBackBuffer;
+begin
+ FWorkspace.ClearBackBuffer;
+end;
+
+procedure TfrxPreview.AddPage;
+begin
+ if FRunning then Exit;
+ PreviewPages.AddEmptyPage(PageNo - 1);
+ UpdatePages;
+ PageNo := PageNo;
+end;
+
+procedure TfrxPreview.DeletePage;
+begin
+ if FRunning then Exit;
+ PreviewPages.DeletePage(PageNo - 1);
+ if PageNo >= PageCount then
+ PageNo := PageNo - 1;
+ UpdatePages;
+ UpdatePageNumbers;
+end;
+
+procedure TfrxPreview.Lock;
+begin
+ FLocked := True;
+ FWorkspace.Locked := True;
+ FThumbnail.Locked := True;
+end;
+
+procedure TfrxPreview.Unlock;
+begin
+ HideMessage;
+ FLocked := False;
+ FWorkspace.Locked := False;
+ FThumbnail.Locked := False;
+ UpdatePages;
+ FWorkspace.Repaint;
+ FThumbnail.Repaint;
+end;
+
+procedure TfrxPreview.SetPosition(PageN, Top: Integer);
+begin
+ if PageN > PageCount then
+ PageN := PageCount;
+ if PageN <= 0 then
+ PageN := 1;
+ FWorkspace.SetPosition(PageN, Top);
+end;
+
+function TfrxPreview.GetTopPosition: Integer;
+begin
+ Result := FWorkspace.GetTopPosition;
+end;
+
+procedure TfrxPreview.RefreshReport;
+var
+ hpos, vpos, pno: Integer;
+begin
+ if not Assigned(Report) then exit;
+
+ hpos := FWorkspace.FOffset.X;
+ vpos := FWorkspace.FOffset.Y;
+ pno := FPageNo;
+
+ Lock;
+ FRefreshing := True;
+ try
+ Report.PrepareReport;
+ FLocked := False;
+ FThumbnail.Locked := False;
+ if pno <= PageCount then
+ FPageNo := pno
+ else
+ FPageNo := 1;
+ UpdatePages;
+ UpdateOutline;
+ finally
+ Unlock;
+ FRefreshing := False;
+ end;
+
+ FWorkspace.FOffset.X := hpos;
+ FWorkspace.FOffset.Y := vpos;
+ FWorkspace.Locked := False;
+ FWorkspace.Repaint;
+ FThumbnail.Repaint;
+ if pno > PageCount then
+ PageNo := 1;
+end;
+
+procedure TfrxPreview.UpdatePages;
+var
+ PageSize: TPoint;
+ i: Integer;
+begin
+ if FLocked or (PageCount = 0) then Exit;
+
+ { calc zoom if not zmDefault}
+ PageSize := PreviewPages.PageSize[PageNo - 1];
+ if PageSize.Y = 0 then Exit;
+ case FZoomMode of
+ zmWholePage:
+ begin
+ if PageSize.Y / Height < PageSize.X / Width then
+ FZoom := (FWorkspace.Width - 26) / PageSize.X
+ else
+ FZoom := (FWorkspace.Height - 26) / PageSize.Y;
+ SetPosition(PageNo, 0);
+ end;
+ zmPageWidth:
+ FZoom := (FWorkspace.Width - 26) / PageSize.X
+ end;
+
+ { fill page list and calc bounds }
+ FWorkspace.Zoom := FZoom;
+ FThumbnail.Zoom := 0.1;
+ FWorkspace.ClearPageList;
+ FThumbnail.ClearPageList;
+ for i := 0 to PageCount - 1 do
+ begin
+ PageSize := PreviewPages.PageSize[i];
+ FWorkspace.AddPage(PageSize.X, PageSize.Y);
+ if not FRunning then
+ FThumbnail.AddPage(PageSize.X, PageSize.Y);
+ end;
+
+ FWorkspace.CalcPageBounds(Round(FWorkspace.Width - 26));
+ if not FRunning then
+ FThumbnail.CalcPageBounds(Round(FThumbnail.Width - 26));
+
+ FWorkspace.UpdateScrollBars;
+ FThumbnail.UpdateScrollBars;
+ { avoid positioning errors when resizing }
+ FWorkspace.HorzPosition := FWorkspace.HorzPosition;
+ FWorkspace.VertPosition := FWorkspace.VertPosition;
+
+ if not FRefreshing then
+ begin
+ FWorkspace.Repaint;
+ FThumbnail.Repaint;
+ end;
+
+ if Owner is TfrxPreviewForm then
+ TfrxPreviewForm(Owner).UpdateZoom;
+end;
+
+procedure TfrxPreview.UpdateOutline;
+var
+ Outline: TfrxCustomOutline;
+ procedure DoUpdate(RootNode: TFmxObject);
+ var
+ i, n: Integer;
+ Node: TTreeViewItem;
+ Page, Top: Integer;
+ Text: String;
+ begin
+ n := Outline.Count;
+ for i := 0 to n - 1 do
+ begin
+ Outline.GetItem(i, Text, Page, Top);
+ Node := TTreeViewItem.Create(RootNode);
+ Node.Text := Text;
+
+ Node.Tag := Page + 1;
+ Node.TagFloat := Top;
+ RootNode.AddObject(Node);
+
+ Outline.LevelDown(i);
+ DoUpdate(Node);
+ Outline.LevelUp;
+ end;
+ end;
+
+begin
+ FOutline.BeginUpdate;
+ FOutline.Clear;
+
+ Outline := Report.PreviewPages.Outline;
+ Outline.LevelRoot;
+ DoUpdate(FOutline);
+ if Report.PreviewOptions.OutlineExpand then
+ FOutline.ExpandAll;
+ //todo
+ //if FOutline.Count > 0 then
+ // FOutline.TopItem := FOutline.Items[0];
+ FOutline.EndUpdate;
+end;
+
+procedure TfrxPreview.OnOutlineClick(Sender: TObject);
+var
+ Node: TTreeViewItem;
+ PageN, Top: Integer;
+begin
+ Node := FOutline.Selected;
+ if Node = nil then Exit;
+
+ PageN := Node.Tag;
+ Top := Trunc(Node.TagFloat);
+
+ SetPosition(PageN, Top);
+ SetFocus;
+end;
+
+procedure TfrxPreview.OnResize(Sender: TObject);
+begin
+ if PreviewPages <> nil then
+ UpdatePages;
+end;
+
+procedure TfrxPreview.InternalOnProgressStart(Sender: TfrxReport;
+ ProgressType: TfrxProgressType; Progress: Integer);
+begin
+ if FRefreshing then Exit;
+
+ Clear;
+ Report.DrillState.Clear;
+ FRunning := True;
+ if Owner is TfrxPreviewForm then
+ TfrxPreviewForm(Owner).UpdateControls;
+end;
+
+procedure TfrxPreview.InternalOnProgress(Sender: TfrxReport;
+ ProgressType: TfrxProgressType; Progress: Integer);
+var
+ PageSize: TPoint;
+{$IFNDEF MSWINDOWS}
+ bIDLE: Boolean;
+{$ENDIF}
+begin
+ if FRefreshing then
+ begin
+ UpdatePageNumbers;
+ Exit;
+ end;
+
+ if Report.Engine.FinalPass then
+ begin
+ PageSize := Report.PreviewPages.PageSize[Progress];
+ if Progress < 50 then
+ begin
+ FWorkspace.AddPage(PageSize.X, PageSize.Y);
+ FWorkspace.CalcPageBounds(Round(FWorkspace.Width) - 26);
+ end;
+ end;
+
+ if Progress = 0 then
+ begin
+ PageNo := 1;
+ if Report.Engine.FinalPass then
+ UpdatePages;
+ if Owner is TfrxPreviewForm then
+ TfrxPreviewForm(Owner).CancelB.Text := frxResources.Get('clCancel');
+// FTick := GetTickCount;
+ end
+ else if Progress = 1 then
+ begin
+{ FTick := GetTickCount - FTick;
+ if FTick < 5 then
+ FTick := 50
+ else if FTick < 10 then
+ FTick := 20
+ else
+ FTick := 5;}
+ PageNo := 1;
+ if Report.Engine.FinalPass then
+ UpdatePages;
+ end
+ else //if Progress mod Integer(FTick) = 0 then
+ begin
+ UpdatePageNumbers;
+ if Report.Engine.FinalPass then
+ FWorkspace.UpdateScrollBars;
+ end;
+
+{$IFDEF MSWINDOWS}
+ Application.ProcessMessages;
+{$ELSE}
+ Application.DoIdle(bIDLE);
+{$ENDIF}
+end;
+
+procedure TfrxPreview.InternalOnProgressStop(Sender: TfrxReport;
+ ProgressType: TfrxProgressType; Progress: Integer);
+begin
+ if FRefreshing then Exit;
+
+ FRunning := False;
+ UpdatePageNumbers;
+ FWorkspace.UpdateScrollBars;
+ FThumbnail.UpdateScrollBars;
+ UpdatePages;
+ UpdateOutline;
+ if Owner is TfrxPreviewForm then
+ begin
+ TfrxPreviewForm(Owner).CancelB.Text := frxResources.Get('clClose');
+ TfrxPreviewForm(Owner).Panel1.Text := '';
+ TfrxPreviewForm(Owner).UpdateControls;
+ end;
+end;
+
+procedure TfrxPreview.OnCancel(Sender: TObject);
+begin
+ Report.Terminated := True;
+end;
+
+procedure TfrxPreview.Cancel;
+begin
+ if FRunning then
+ OnCancel(Self);
+end;
+
+procedure TfrxPreview.MouseWheelScroll(Delta: Integer; Horz: Boolean = False;
+ Zoom: Boolean = False);
+begin
+ //disable in sesign time, may cause AV
+ if csDesigning in ComponentState then Exit;
+ if Delta <> 0 then
+ if Zoom then
+ begin
+ FZoom := FZoom + Round(Delta / Abs(Delta)) / 10;
+ if FZoom < 0.3 then
+ FZoom := 0.3;
+ SetZoom(FZoom);
+ end
+ else
+ begin
+ with FWorkspace do
+ begin
+ if Horz then
+ HorzPosition := HorzPosition + Round(-Delta / Abs(Delta)) * 20
+ else
+ VertPosition := VertPosition + Round(-Delta / Abs(Delta)) * 20;
+ end;
+ end;
+end;
+
+
+{ TfrxPreviewForm }
+
+procedure TfrxPreviewForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(100);
+ frxResources.LoadImageFromResouce(PrintB.Bitmap, 19, 5);
+ PrintMI.Bitmap.Assign(PrintB.Bitmap);
+ PrintMI.Text := frxGet(102);
+ PrintB.Hint := frxGet(102);
+ OpenB.Hint := frxGet(104);
+ frxResources.LoadImageFromResouce(OpenB.Bitmap, 0, 1);
+ OpenMI.Bitmap.Assign(OpenB.Bitmap);
+ OpenMI.Text := frxGet(104);
+ SaveB.Hint := frxGet(106);
+ frxResources.LoadImageFromResouce(SaveB.Bitmap, 0, 2);
+ SaveMI.Bitmap.Assign(SaveB.Bitmap);
+ SaveMI.Text := frxGet(106);
+ ExportB.Hint := frxGet(108);
+ frxResources.LoadImageFromResouce(ExportB.Bitmap, 17, 9);
+ ExportMI.Bitmap.Assign(ExportB.Bitmap);
+ ExportMI.Text := frxGet(108);
+ FindMI.Text := frxGet(110);
+
+
+ PageSettingsB.Hint := frxGet(121);
+ frxResources.LoadImageFromResouce(PageSettingsB.Bitmap, 19, 4);
+ DesignerB.Hint := frxGet(133);
+ frxResources.LoadImageFromResouce(DesignerB.Bitmap, 19, 8);
+ {$IFDEF FR_LITE}
+ DesignerB.Hint := DesignerB.Hint + #13#10 + 'This feature is not available in FreeReport';
+ {$ENDIF}
+ FirstB.Hint := frxGet(135);
+ frxResources.LoadImageFromResouce(FirstB.Bitmap, 18, 5);
+ PriorB.Hint := frxGet(137);
+ frxResources.LoadImageFromResouce(PriorB.Bitmap, 18, 6);
+ NextB.Hint := frxGet(139);
+ frxResources.LoadImageFromResouce(NextB.Bitmap, 18, 7);
+ LastB.Hint := frxGet(141);
+ frxResources.LoadImageFromResouce(LastB.Bitmap, 18, 8);
+ CancelB.Text := frxResources.Get('clClose');
+ FullScreenBtn.Hint := frxGet(150);
+ frxResources.LoadImageFromResouce(FullScreenBtn.Bitmap, 19, 9);
+ FullScrMI.Bitmap.Assign(FullScreenBtn.Bitmap);
+ FullScrMI.Text := frxGet(150);
+ ExportPDFMI.Text := frxGet(151);
+ ExportMailMI.Text := frxGet(152);
+ ExportMailMI.Visible := False;
+ //ZoomPlusB.Hint := frxGet(125);
+ ZoomInMI.Text := frxGet(125);
+ //ZoomMinusB.Hint := frxGet(127);
+ ZoomOutMI.Text := frxGet(127);
+ OutlineB.Hint := frxGet(129);
+ frxResources.LoadImageFromResouce(OutlineB.Bitmap, 19, 6);
+ ThumbB.Hint := frxGet(131);
+ frxResources.LoadImageFromResouce(ThumbB.Bitmap, 7, 8);
+ frxResources.LoadImageFromResouce(PageWidthB.Bitmap, 23, 5);
+ frxResources.LoadImageFromResouce(WholePageB.Bitmap, 23, 6);
+
+// ZoomCB.Min := 25;
+// ZoomCB.Max := 500;
+// ZoomCB.Frequency := 25;
+ ZoomCB.Clear;
+ ZoomCB.Items.Add('25%');
+ ZoomCB.Items.Add('50%');
+ ZoomCB.Items.Add('75%');
+ ZoomCB.Items.Add('100%');
+ ZoomCB.Items.Add('150%');
+ ZoomCB.Items.Add('200%');
+ ZoomCB.Items.Add('300%');
+
+ PageWidthB.Hint := frxResources.Get('zmPageWidth');
+ WholePageB.Hint := frxResources.Get('zmWholePage');
+ ExpandMI.Text := frxGet(600);
+ CollapseMI.Text := frxGet(601);
+
+ FPreview := TfrxPreview.Create(Self);
+ FPreview.Parent := Self;
+ FPreview.Align := alClient;
+ FPreview.OnPageChanged := OnPageChanged;
+ FPreview.OnDblClick := OnPreviewDblClick;
+ FPreview.SetFocus;
+// FPreview.OnMouseUp := FormMouseUp;
+ FPreview.FWorkspace.OnMouseUp := FormMouseUp;
+ FFullScreen := False;
+ FPDFExport := nil;
+ FEmailExport := nil;
+end;
+
+procedure TfrxPreviewForm.Init;
+var
+ i: Integer;
+ m, m2: TMenuItem;
+
+ procedure RemoveInvisibleButtons;
+ var
+ i, j: Integer;
+ c, c1: TControl;
+ begin
+ for i := 0 to ToolBar.ChildrenCount - 1 do
+ begin
+ c := TControl(ToolBar.Children[i]);
+ if not c.Visible then
+ for j := 0 to ToolBar.ChildrenCount - 1 do
+ begin
+ c1 := TControl(ToolBar.Children[j]);
+ if(c1.Position.X > c.Position.X + c.Width ) then
+ c1.Position.X := c1.Position.X - c.Width - 1;
+ end;
+ end;
+ end;
+
+begin
+ FPreview.Init;
+ HintPanel.BringToFront;
+ with Report.PreviewOptions do
+ begin
+ if Maximized then
+ WindowState := wsMaximized;
+ FPreview.Zoom := Zoom;
+ FPreview.ZoomMode := ZoomMode;
+
+ {$IFDEF FR_LITE}
+ DesignerB.Enabled := False;
+ {$ELSE}
+ DesignerB.Enabled := AllowEdit;
+ {$ENDIF}
+ Preview.Workspace.RTLLanguage := RTLPreview;
+ PrintB.Visible := pbPrint in Buttons;
+ OpenB.Visible := pbLoad in Buttons;
+ SaveB.Visible := pbSave in Buttons;
+ ExportB.Visible := pbExport in Buttons;
+
+ PageWidthB.Visible := pbZoom in Buttons;
+ WholePageB.Visible := pbZoom in Buttons;
+ FullScreenBtn.Visible := pbFullScreen in Buttons;
+ OutlineB.Visible := pbOutline in Buttons;
+ ThumbB.Visible := pbThumbnails in Buttons;
+ PageSettingsB.Visible := pbPageSetup in Buttons;
+ DesignerB.Visible := pbEdit in Buttons;
+ FirstB.Visible := pbNavigator in Buttons;
+ PriorB.Visible := pbNavigator in Buttons;
+ NextB.Visible := pbNavigator in Buttons;
+ PageE.Visible := pbNavigator in Buttons;
+ LastB.Visible := pbNavigator in Buttons;
+ CancelB.Visible := pbClose in Buttons;
+ ZoomCB.Visible := pbZoom in Buttons;
+ Line1.Visible := ZoomCB.Visible or PageWidthB.Visible or WholePageB.Visible or FullScreenBtn.Visible;
+ Line2.Visible := OutlineB.Visible or ThumbB.Visible or PageSettingsB.Visible or DesignerB.Visible;
+ Line3.Visible := FirstB.Visible or PriorB.Visible or PageE.Visible or NextB.Visible or LastB.Visible or CancelB.Visible;
+ RemoveInvisibleButtons;
+
+{ ShiftControls([PrintB, OpenB, SaveB, ExportB,
+ Line1, ZoomCB, PageWidthB, WholePageB, FullScreenBtn,
+ Line2, OutlineB, ThumbB, PageSettingsB, DesignerB,
+ Line3, FirstB, PriorB, PageE, NextB, LastB, CancelB], 0);}
+
+ end;
+
+ if (frxExportFilters.Count = 0) or
+ ((frxExportFilters.Count = 1) and (frxExportFilters[0].Filter = frxDotMatrixExport)) then
+ ExportB.Visible := False;
+
+ for i := 0 to frxExportFilters.Count - 1 do
+ begin
+ if frxExportFilters[i].Filter = frxDotMatrixExport then
+ continue;
+
+ m := TMenuItem.Create(ExportMI);
+ m2 := TMenuItem.Create(ExportPopup);
+
+ m.Text := TfrxCustomExportFilter(frxExportFilters[i].Filter).GetDescription + '...';
+ m2.Text := TfrxCustomExportFilter(frxExportFilters[i].Filter).GetDescription + '...';
+ m.Tag := i;
+ m2.Tag := i;
+ m.OnClick := ExportMIClick;
+ m2.OnClick := ExportMIClick;
+ if TfrxCustomExportFilter(frxExportFilters[i].Filter).ClassName = 'TfrxPDFExport' then
+ begin
+ FPDFExport := TfrxCustomExportFilter(frxExportFilters[i].Filter);
+ //PdfB.Visible := pbExportQuick in Report.PreviewOptions.Buttons;
+ end;
+ ExportMI.AddObject(m);
+ ExportPopup.AddObject(m2);
+ end;
+ FPopUpMItemsCount := RightMenu.ChildrenCount;
+ FPopUpExporttemsCount := ExportPopup.ChildrenCount;
+ if Report.ReportOptions.Name <> '' then
+ Caption := Report.ReportOptions.Name;
+
+ UpdateControls;
+end;
+
+procedure TfrxPreviewForm.UpdateControls;
+
+ function HasDrillDown: Boolean;
+ var
+ l: TList;
+ i: Integer;
+ c: TfrxComponent;
+ begin
+ Result := False;
+ l := Report.AllObjects;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if (c is TfrxGroupHeader) and TfrxGroupHeader(c).DrillDown then
+ begin
+ Result := True;
+ break;
+ end;
+ end;
+ end;
+
+ procedure EnableControls(cAr: array of TObject; Enabled: Boolean);
+ var
+ i: Integer;
+ begin
+ for i := 0 to High(cAr) do
+ begin
+ if cAr[i] is TMenuItem then
+ TMenuItem(cAr[i]).Visible := Enabled
+ else if cAr[i] is TfrxToolButton then
+ begin
+ TfrxToolButton(cAr[i]).Enabled := Enabled;
+ TfrxToolButton(cAr[i]).Down := False;
+ if TfrxToolButton(cAr[i]).Tag <> 0 then
+ TMenuItem(TfrxToolButton(cAr[i]).Tag).Enabled := Enabled;
+ end;
+ end;
+ end;
+
+begin
+ EnableControls([PrintB, OpenB, SaveB, ExportB, PageSettingsB],
+ (not FPreview.FRunning) and (FPreview.PageCount > 0));
+ EnableControls([OpenB], (not FPreview.FRunning));
+ EnableControls([DesignerB],
+ not FPreview.FRunning and Report.PreviewOptions.AllowEdit);
+ EnableControls([ExpandMI, CollapseMI, N1],
+ not FPreview.FRunning and HasDrillDown);
+end;
+
+procedure TfrxPreviewForm.PrintBClick(Sender: TObject);
+begin
+ FPreview.Print;
+end;
+
+procedure TfrxPreviewForm.PrintBMouseEnter(Sender: TObject);
+var
+ p, r: TRectF;
+ s: String;
+begin
+ if (Sender is TControl) then
+ begin
+
+ if Sender is TfrxToolButton then
+ s:= TfrxToolButton(Sender).Hint
+ else
+ s := TControl(Sender).TagString;
+ p := TControl(Sender).AbsoluteRect;
+
+ r := RectF(0, 0, 300, 1000);
+ if Label1.Canvas <> nil then
+ begin
+ Label1.Canvas.MeasureText(r, s, True, [], TTextAlign.taCenter, TTextAlign.taCenter);
+ HintPanel.Width := r.Width + 12;
+ HintPanel.Height := r.Height + HintPanel.CalloutLength + 10;
+ end;
+
+ if (p.Left + TControl(Sender).Width/2 > HintPanel.Width/2) then
+ begin
+ HintPanel.CalloutPosition := TCalloutPosition.cpTop;
+ HintPanel.Position.X := p.Left + TControl(Sender).Width/2 - HintPanel.Width/2;
+ HintPanel.Position.Y := p.Top + TControl(Sender).Height;
+{$IFDEF DELPHI18}
+ Label1.Margins.Left := 0;
+ Label1.Margins.Top := 0;
+{$ELSE}
+ Label1.Padding.Left := 0;
+ Label1.Padding.Top := 0;
+{$ENDIF}
+ end
+ else
+ begin
+ HintPanel.CalloutPosition := TCalloutPosition.cpLeft;
+ HintPanel.Position.X := p.Left + TControl(Sender).Width;
+ HintPanel.Position.Y := p.Top - HintPanel.Height/2 + TControl(Sender).Height/2;
+ HintPanel.Width := HintPanel.Width + HintPanel.CalloutLength;
+{$IFDEF DELPHI18}
+ Label1.Margins.Left := HintPanel.CalloutLength / 2;
+ Label1.Margins.Top := HintPanel.CalloutLength / 2;
+{$ELSE}
+ Label1.Padding.Left := HintPanel.CalloutLength;
+ Label1.Padding.Top := -HintPanel.CalloutLength;
+{$ENDIF}
+ end;
+ HintPanel.Visible := True;
+ Label1.Text := s;
+end;
+end;
+
+procedure TfrxPreviewForm.PrintBMouseLeave(Sender: TObject);
+begin
+ HintPanel.Visible := False;
+end;
+
+procedure TfrxPreviewForm.OpenBClick(Sender: TObject);
+begin
+ FPreview.LoadFromFile;
+ PeekLastModalResult;
+ if Report.ReportOptions.Name <> '' then
+ Caption := Report.ReportOptions.Name
+ else
+ Caption := frxGet(100);
+{$IFDEF FRVIEWER}
+ UpdateControls;
+{$ENDIF}
+end;
+
+procedure TfrxPreviewForm.SaveBClick(Sender: TObject);
+begin
+ FPreview.SaveToFile;
+ PeekLastModalResult;
+end;
+
+procedure TfrxPreviewForm.ZoomPlusBClick(Sender: TObject);
+begin
+ FPreview.Zoom := FPreview.Zoom + 0.25;
+end;
+
+procedure TfrxPreviewForm.ZoomMinusBClick(Sender: TObject);
+begin
+ FPreview.Zoom := FPreview.Zoom - 0.25;
+end;
+
+function TfrxPreviewForm.GetReport: TfrxReport;
+begin
+ Result := Preview.Report;
+end;
+
+procedure TfrxPreviewForm.UpdateZoom;
+begin
+ ZoomCB.Text := IntToStr(Round(FPreview.Zoom * 100)) + '%';
+end;
+
+procedure TfrxPreviewForm.WholePageBClick(Sender: TObject);
+begin
+ FPreview.ZoomMode := zmWholePage
+end;
+
+procedure TfrxPreviewForm.ZoomCBChange(Sender: TObject);
+
+begin
+ if FPreview = nil then Exit;
+
+ FPreview.SetFocus;
+ //FPreview.Zoom := ZoomCB.Value / 100;
+end;
+
+procedure TfrxPreviewForm.ZoomCBClick(Sender: TObject);
+var
+ s: String;
+begin
+{ Note: TComboTrakBar causes errors in XE3 under OSX. Was removed }
+ if FPreview = nil then Exit;
+ s := ZoomCB.Text;
+ if Pos('%', s) <> 0 then
+ s[Pos('%', s)] := ' ';
+ while Pos(' ', s) <> 0 do
+ Delete(s, Pos(' ', s), 1);
+
+ if s <> '' then
+ FPreview.Zoom := frxStrToFloat(s) / 100;
+end;
+
+procedure TfrxPreviewForm.FormKeyDown(Sender: TObject;
+ var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = vkESCAPE then
+ CancelBClick(Self);
+ if Key = vkF11 then
+ SwitchToFullScreen;
+ if Key = vkF1 then
+ frxResources.Help(Self);
+ if Key = vkReturn then
+ begin
+ if ActiveControl = PageE then
+ PageEClick(nil);
+ end;
+end;
+
+procedure TfrxPreviewForm.PageSettingsBClick(Sender: TObject);
+begin
+ FPreview.PageSetupDlg;
+end;
+
+procedure TfrxPreviewForm.PageWidthBClick(Sender: TObject);
+begin
+ FPreview.ZoomMode := zmPageWidth;
+end;
+
+procedure TfrxPreviewForm.OnPageChanged(Sender: TfrxPreview; PageNo: Integer);
+var
+ FirstPass: Boolean;
+begin
+ FirstPass := False;
+ if FPreview.PreviewPages <> nil then
+ FirstPass := not FPreview.PreviewPages.Engine.FinalPass;
+
+ if FirstPass and FPreview.FRunning then
+ Panel0.Text := frxResources.Get('clFirstPass') + ' ' +
+ IntToStr(FPreview.PageCount)
+ else
+ Panel0.Text := Format(frxResources.Get('clPageOf'),
+ [PageNo, FPreview.PageCount]);
+ Panel0.Repaint;
+ PageE.Text := IntToStr(PageNo);
+end;
+
+procedure TfrxPreviewForm.PageEClick(Sender: TObject);
+begin
+ FPreview.PageNo := StrToInt(PageE.Text);
+ FPreview.SetFocus;
+end;
+
+procedure TfrxPreviewForm.FirstBClick(Sender: TObject);
+begin
+ FPreview.First;
+end;
+
+procedure TfrxPreviewForm.PriorBClick(Sender: TObject);
+begin
+ FPreview.Prior;
+end;
+
+procedure TfrxPreviewForm.NextBClick(Sender: TObject);
+begin
+ FPreview.Next;
+end;
+
+procedure TfrxPreviewForm.LastBClick(Sender: TObject);
+begin
+ FPreview.Last;
+end;
+
+procedure TfrxPreviewForm.FormMouseUp(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Single);
+var
+ p: TpointF;
+begin
+ p := ClientToScreen(PointF(X, Y));
+ if Button = TMouseButton.mbRight then
+ begin
+ { pop up menu never remove itself when clicking right mouse button }
+ { and create another instance of the menu }
+ { if menu has all Children items, then it's hiden and we can show it again }
+ if RightMenu.ChildrenCount = FPopUpMItemsCount then
+ RightMenu.Popup(p.X, p.Y);
+ end;
+end;
+
+procedure TfrxPreviewForm.FormMouseWheel(Sender: TObject; Shift: TShiftState;
+ WheelDelta: Integer; var Handled: Boolean);
+begin
+ FPreview.MouseWheelScroll(WheelDelta, False, ssCtrl in Shift);
+end;
+
+procedure TfrxPreviewForm.DesignerBClick(Sender: TObject);
+begin
+ FPreview.Edit;
+end;
+
+procedure TfrxPreviewForm.FormCloseQuery(Sender: TObject;
+ var CanClose: Boolean);
+begin
+ CanClose := not FPreview.FRunning;
+end;
+
+procedure TfrxPreviewForm.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+ if FFreeOnClose then
+ Action := TCloseAction.caFree;
+ if (Report <> nil) and (Assigned(Report.OnClosePreview)) then
+ Report.OnClosePreview(Self);
+end;
+
+procedure TfrxPreviewForm.NewPageBClick(Sender: TObject);
+begin
+ FPreview.AddPage;
+end;
+
+procedure TfrxPreviewForm.DelPageBClick(Sender: TObject);
+begin
+ FPreview.DeletePage;
+end;
+
+procedure TfrxPreviewForm.CancelBClick(Sender: TObject);
+begin
+ if FPreview.FRunning then
+ FPreview.Cancel else
+ Close;
+end;
+
+procedure TfrxPreviewForm.ExportBClick(Sender: TObject);
+var
+ p: TpointF;
+begin
+ p := ClientToScreen(ExportB.Position.Point);
+ if ExportPopup.ChildrenCount = FPopUpExporttemsCount then
+ ExportPopup.Popup(p.X, p.Y);
+end;
+
+procedure TfrxPreviewForm.ExportMIClick(Sender: TObject);
+begin
+ FPreview.Export(TfrxCustomExportFilter(frxExportFilters[TMenuItem(Sender).Tag].Filter));
+end;
+
+procedure TfrxPreviewForm.DesignerBMouseUp(Sender: TObject;
+ Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+//var
+// pt: TPoint;
+begin
+// todo
+{ pt := DesignerB.ClientToScreen(Point(0, 0));
+ if Button = mbRight then
+ HiddenMenu.Popup(pt.X, pt.Y);}
+end;
+
+procedure TfrxPreviewForm.Showtemplate1Click(Sender: TObject);
+begin
+ FPreview.EditTemplate;
+end;
+
+procedure TfrxPreviewForm.SetMessageText(const Value: String; IsHint: Boolean);
+begin
+ if IsHint then
+ begin
+ if not ((Value = '') and (Panel2.Text = '')) then
+ Panel2.Text := Value;
+ end
+ else
+ Panel1.Text := Value;
+ //Application.HandleMessage;
+ Report.AppHandleMessage;
+end;
+
+procedure TfrxPreviewForm.SwitchToFullScreen;
+begin
+ if not FFullScreen then
+ begin
+ StatusBar.Visible := False;
+ ToolBar.Visible := False;
+ FOldState := WindowState;
+ WindowState := wsMaximized;
+ FFullScreen := True;
+ end
+ else
+ begin
+ WindowState := FOldState;
+ FFullScreen := False;
+ StatusBar.Visible := True;
+ ToolBar.Visible := True;
+ end;
+end;
+
+procedure TfrxPreviewForm.FullScreenBtnClick(Sender: TObject);
+begin
+ SwitchToFullScreen;
+end;
+
+procedure TfrxPreviewForm.PdfBClick(Sender: TObject);
+begin
+ if Assigned(FPDFExport) then
+ FPreview.Export(FPDFExport);
+end;
+
+procedure TfrxPreviewForm.EmailBClick(Sender: TObject);
+begin
+ if Assigned(FEmailExport) then
+ FPreview.Export(FEmailExport);
+end;
+
+procedure TfrxPreviewForm.OutlineBClick(Sender: TObject);
+begin
+ FPreview.OutlineVisible := not FPreview.OutlineVisible;//OutlineB.Down;
+end;
+
+procedure TfrxPreviewForm.ThumbBClick(Sender: TObject);
+begin
+ FPreview.ThumbnailVisible := not FPreview.ThumbnailVisible;//ThumbB.Down;
+end;
+
+procedure TfrxPreviewForm.OnPreviewDblClick(Sender: TObject);
+begin
+ if FFullScreen then
+ SwitchToFullScreen;
+end;
+
+procedure TfrxPreviewForm.CollapseAllClick(Sender: TObject);
+var
+ l: TList;
+ i: Integer;
+ c: TfrxComponent;
+begin
+ FPreview.Lock;
+ l := Report.AllObjects;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if (c is TfrxGroupHeader) and TfrxGroupHeader(c).DrillDown then
+ TfrxGroupHeader(c).ExpandDrillDown := False;
+ end;
+ Report.DrillState.Clear;
+ Preview.RefreshReport;
+ Preview.SetPosition(0,0);
+end;
+
+procedure TfrxPreviewForm.ExpandAllClick(Sender: TObject);
+var
+ l: TList;
+ i: Integer;
+ c: TfrxComponent;
+begin
+ FPreview.Lock;
+ l := Report.AllObjects;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if (c is TfrxGroupHeader) and TfrxGroupHeader(c).DrillDown then
+ TfrxGroupHeader(c).ExpandDrillDown := True;
+ end;
+ Report.DrillState.Clear;
+ Preview.RefreshReport;
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxPreview, TFmxObject);
+ GroupDescendentsWith(TfrxPreviewWorkspace, TFmxObject);
+ RegisterFmxClasses([TfrxPreviewWorkspace, TfrxPreview]);
+end.
diff --git a/LibD28/FMX.frxPreview.res b/LibD28/FMX.frxPreview.res
new file mode 100644
index 0000000..f257e6b
Binary files /dev/null and b/LibD28/FMX.frxPreview.res differ
diff --git a/LibD28/FMX.frxPreviewPageSettings.fmx b/LibD28/FMX.frxPreviewPageSettings.fmx
new file mode 100644
index 0000000..8fb1202
--- /dev/null
+++ b/LibD28/FMX.frxPreviewPageSettings.fmx
@@ -0,0 +1,235 @@
+object frxPageSettingsForm: TfrxPageSettingsForm
+ Left = 0
+ Top = 0
+ Caption = 'Page Settings'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 359
+ ClientWidth = 286
+ Position = poScreenCenter
+ Visible = False
+ OnClose = FormClose
+ OnActivate = FormShow
+ StyleLookup = 'backgroundstyle'
+ object OKB: TButton
+ Position.Point = '(126,328)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 40
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(206,328)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 50
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object SizeL: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 277.000000000000000000
+ Height = 101.000000000000000000
+ TabOrder = 2
+ object WidthL: TLabel
+ Position.Point = '(8,48)'
+ Width = 41.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object HeightL: TLabel
+ Position.Point = '(8,72)'
+ Width = 49.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object UnitL1: TLabel
+ Position.Point = '(112,48)'
+ Width = 41.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 2
+ end
+ object UnitL2: TLabel
+ Position.Point = '(112,72)'
+ Width = 49.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 3
+ end
+ object WidthE: TEdit
+ Position.Point = '(64,46)'
+ Width = 45.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 140
+ TabOrder = 4
+ KeyboardType = vktDefault
+ OnChange = WidthEChange
+ Password = False
+ end
+ object HeightE: TEdit
+ Position.Point = '(64,70)'
+ Width = 45.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 150
+ TabOrder = 5
+ KeyboardType = vktDefault
+ OnChange = WidthEChange
+ Password = False
+ end
+ object SizeCB: TComboBox
+ Position.Point = '(8,18)'
+ Width = 261.000000000000000000
+ Height = 21.000000000000000000
+ OnClick = SizeCBClick
+ TabOrder = 6
+ ItemIndex = -1
+ end
+ end
+ object OrientationL: TGroupBox
+ Position.Point = '(4,108)'
+ Width = 277.000000000000000000
+ Height = 65.000000000000000000
+ TabOrder = 3
+ object PortraitImg: TImage
+ Position.Point = '(148,21)'
+ Width = 26.000000000000000000
+ Height = 32.000000000000000000
+ end
+ object LandscapeImg: TImage
+ Position.Point = '(145,25)'
+ Width = 32.000000000000000000
+ Height = 26.000000000000000000
+ end
+ object PortraitRB: TRadioButton
+ Position.Point = '(8,20)'
+ Width = 109.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = PortraitRBClick
+ HelpContext = 111
+ TabOrder = 2
+ GroupName = 'Orientation'
+ end
+ object LandscapeRB: TRadioButton
+ Position.Point = '(8,40)'
+ Width = 109.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = PortraitRBClick
+ HelpContext = 120
+ TabOrder = 3
+ GroupName = 'Orientation'
+ end
+ end
+ object MarginsL: TGroupBox
+ Position.Point = '(4,176)'
+ Width = 277.000000000000000000
+ Height = 73.000000000000000000
+ TabOrder = 4
+ object LeftL: TLabel
+ Position.Point = '(8,20)'
+ Width = 49.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object TopL: TLabel
+ Position.Point = '(8,44)'
+ Width = 49.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object RightL: TLabel
+ Position.Point = '(156,20)'
+ Width = 53.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 2
+ end
+ object BottomL: TLabel
+ Position.Point = '(156,44)'
+ Width = 53.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 3
+ end
+ object UnitL3: TLabel
+ Position.Point = '(108,20)'
+ Width = 37.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 4
+ end
+ object UnitL4: TLabel
+ Position.Point = '(108,44)'
+ Width = 37.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 5
+ end
+ object UnitL5: TLabel
+ Position.Point = '(248,20)'
+ Width = 25.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 6
+ end
+ object UnitL6: TLabel
+ Position.Point = '(248,44)'
+ Width = 25.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 7
+ end
+ object MarginLeftE: TEdit
+ Position.Point = '(64,18)'
+ Width = 40.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 72
+ TabOrder = 8
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object MarginTopE: TEdit
+ Position.Point = '(64,42)'
+ Width = 40.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 81
+ TabOrder = 9
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object MarginRightE: TEdit
+ Position.Point = '(203,18)'
+ Width = 40.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 91
+ TabOrder = 10
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object MarginBottomE: TEdit
+ Position.Point = '(203,42)'
+ Width = 40.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 101
+ TabOrder = 11
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+ object OtherL: TGroupBox
+ Position.Point = '(4,252)'
+ Width = 277.000000000000000000
+ Height = 65.000000000000000000
+ TabOrder = 5
+ object ApplyToCurRB: TRadioButton
+ Position.Point = '(8,20)'
+ Width = 261.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 0
+ GroupName = 'Changes'
+ end
+ object ApplyToAllRB: TRadioButton
+ Position.Point = '(8,40)'
+ Width = 261.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ IsChecked = True
+ GroupName = 'Changes'
+ end
+ end
+end
diff --git a/LibD28/FMX.frxPreviewPageSettings.pas b/LibD28/FMX.frxPreviewPageSettings.pas
new file mode 100644
index 0000000..7f1379c
--- /dev/null
+++ b/LibD28/FMX.frxPreviewPageSettings.pas
@@ -0,0 +1,275 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Preview Page settings }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxPreviewPageSettings;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.Variants, System.UITypes,
+ FMX.Objects, FMX.Forms, FMX.Controls, FMX.Edit, FMX.ListBox,
+ FMX.frxClass, FMX.Types
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+
+type
+ TfrxDesignerUnits = (duCM, duInches, duPixels, duChars);
+
+{$IFDEF LINUX}
+ TfrxPageSettingsForm = class(TfrxForm)
+{$ELSE}
+ TfrxPageSettingsForm = class(TForm)
+{$ENDIF}
+ OKB: TButton;
+ CancelB: TButton;
+ SizeL: TGroupBox;
+ WidthL: TLabel;
+ HeightL: TLabel;
+ UnitL1: TLabel;
+ UnitL2: TLabel;
+ WidthE: TEdit;
+ HeightE: TEdit;
+ SizeCB: TComboBox;
+ OrientationL: TGroupBox;
+ PortraitImg: TImage;
+ LandscapeImg: TImage;
+ PortraitRB: TRadioButton;
+ LandscapeRB: TRadioButton;
+ MarginsL: TGroupBox;
+ LeftL: TLabel;
+ TopL: TLabel;
+ RightL: TLabel;
+ BottomL: TLabel;
+ UnitL3: TLabel;
+ UnitL4: TLabel;
+ UnitL5: TLabel;
+ UnitL6: TLabel;
+ MarginLeftE: TEdit;
+ MarginTopE: TEdit;
+ MarginRightE: TEdit;
+ MarginBottomE: TEdit;
+ OtherL: TGroupBox;
+ ApplyToCurRB: TRadioButton;
+ ApplyToAllRB: TRadioButton;
+ procedure FormShow(Sender: TObject);
+ procedure PortraitRBClick(Sender: TObject);
+ procedure SizeCBClick(Sender: TObject);
+ procedure WidthEChange(Sender: TObject);
+ procedure FormKeyDown(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure PortraitRBChange(Sender: TObject);
+ protected
+ { Private declarations }
+ FPage: TfrxReportPage;
+ FReport: TfrxReport;
+ FUnits: TfrxDesignerUnits;
+ FUpdating: Boolean;
+ function GetNeedRebuild: Boolean;
+ function mmToUnits(mm: Extended): Extended;
+ function UnitsTomm(mm: Extended): Extended;
+ public
+ { Public declarations }
+ property NeedRebuild: Boolean read GetNeedRebuild;
+ property Page: TfrxReportPage read FPage write FPage;
+ property Report: TfrxReport read FReport write FReport;
+ end;
+
+
+implementation
+
+{$R *.fmx}
+
+uses
+ FMX.Printer, FMX.frxPrinter, FMX.frxUtils, FMX.frxRes, FMX.frxFMX, System.IniFiles;
+
+
+function TfrxPageSettingsForm.mmToUnits(mm: Extended): Extended;
+begin
+ Result := 0;
+ case FUnits of
+ duCM, duPixels, duChars:
+ Result := mm / 10;
+ duInches:
+ Result := mm / 25.4;
+ end;
+end;
+
+function TfrxPageSettingsForm.UnitsTomm(mm: Extended): Extended;
+begin
+ Result := 0;
+ case FUnits of
+ duCM, duPixels, duChars:
+ Result := mm * 10;
+ duInches:
+ Result := mm * 25.4;
+ end;
+end;
+
+function TfrxPageSettingsForm.GetNeedRebuild: Boolean;
+begin
+ Result := ApplyToAllRB.IsChecked;
+end;
+
+procedure TfrxPageSettingsForm.FormShow(Sender: TObject);
+var
+ i: Integer;
+ Ini: TCustomIniFile;
+ uStr: String;
+begin
+ FUpdating := True;
+
+ Caption := frxGet(400);
+
+ WidthL.Text := frxGet(401);
+ HeightL.Text := frxGet(402);
+ SizeL.Text := frxGet(403);
+ OrientationL.Text := frxGet(404);
+ LeftL.Text := frxGet(405);
+ TopL.Text := frxGet(406);
+ RightL.Text := frxGet(407);
+ BottomL.Text := frxGet(408);
+ MarginsL.Text := frxGet(409);
+ PortraitRB.Text := frxGet(410);
+ LandscapeRB.Text := frxGet(411);
+ OKB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ OtherL.Text := frxGet(412);
+ ApplyToCurRB.Text := frxGet(413);
+ ApplyToAllRB.Text := frxGet(414);
+
+ Ini := Report.GetIniFile;
+ FUnits := TfrxDesignerUnits(Ini.ReadInteger('TfrxDesignerForm', 'Units', 0));
+ Ini.Free;
+
+ uStr := '';
+ case FUnits of
+ duCM, duPixels, duChars:
+ uStr := frxResources.Get('uCm');
+ duInches:
+ uStr := frxResources.Get('uInch');
+ end;
+
+ UnitL1.Text := uStr;
+ UnitL2.Text := uStr;
+ UnitL3.Text := uStr;
+ UnitL4.Text := uStr;
+ UnitL5.Text := uStr;
+ UnitL6.Text := uStr;
+
+ SizeCB.Items := frxPrinters.Printer.Papers;
+ i := frxPrinters.Printer.PaperIndex(FPage.PaperSize);
+ if i = -1 then
+ i := frxPrinters.Printer.PaperIndex(256);
+ SizeCB.ItemIndex := i;
+ //SizeCB.ItemIndex := 0;
+
+ WidthE.Text := frxFloatToStr(mmToUnits(Page.PaperWidth));
+ HeightE.Text := frxFloatToStr(mmToUnits(Page.PaperHeight));
+ PortraitRB.IsChecked := Page.Orientation = poPortrait;
+ LandscapeRB.IsChecked := Page.Orientation = poLandscape;
+
+ MarginLeftE.Text := frxFloatToStr(mmToUnits(Page.LeftMargin));
+ MarginRightE.Text := frxFloatToStr(mmToUnits(Page.RightMargin));
+ MarginTopE.Text := frxFloatToStr(mmToUnits(Page.TopMargin));
+ MarginBottomE.Text := frxFloatToStr(mmToUnits(Page.BottomMargin));
+
+ PortraitRBClick(nil);
+ FUpdating := False;
+end;
+
+procedure TfrxPageSettingsForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ if ModalResult = mrOk then
+ begin
+ if PortraitRB.IsChecked then
+ Page.Orientation := poPortrait else
+ Page.Orientation := poLandscape;
+
+ Page.PaperWidth := UnitsTomm(frxStrToFloat(WidthE.Text));
+ Page.PaperHeight := UnitsTomm(frxStrToFloat(HeightE.Text));
+ //Page.PaperSize := frxPrinters.Printer.PaperNameToNumber(SizeCB.Selected.Text);
+
+ Page.LeftMargin := UnitsTomm(frxStrToFloat(MarginLeftE.Text));
+ Page.RightMargin := UnitsTomm(frxStrToFloat(MarginRightE.Text));
+ Page.TopMargin := UnitsTomm(frxStrToFloat(MarginTopE.Text));
+ Page.BottomMargin := UnitsTomm(frxStrToFloat(MarginBottomE.Text));
+
+ Page.AlignChildren;
+ end;
+end;
+
+procedure TfrxPageSettingsForm.PortraitRBChange(Sender: TObject);
+begin
+ SizeCBClick(nil);
+end;
+
+procedure TfrxPageSettingsForm.PortraitRBClick(Sender: TObject);
+begin
+ PortraitImg.Visible := PortraitRB.IsChecked;
+ LandscapeImg.Visible := LandscapeRB.IsChecked;
+ //SizeCBClick(nil);
+end;
+
+procedure TfrxPageSettingsForm.SizeCBClick(Sender: TObject);
+var
+ pOr: TPrinterOrientation;
+ pNumber: Integer;
+ pWidth, pHeight: Extended;
+begin
+ if FUpdating then Exit;
+ FUpdating := True;
+ if SizeCB.Count = 0 then Exit;
+
+ with frxPrinters.Printer do
+ begin
+ pNumber := PaperNameToNumber(SizeCB.Selected.Text);
+ pWidth := UnitsTomm(frxStrToFloat(WidthE.Text));
+ pHeight := UnitsTomm(frxStrToFloat(HeightE.Text));
+ if PortraitRB.IsChecked then
+ pOr := poPortrait else
+ pOr := poLandscape;
+
+ if pNumber = 256 then
+ SetViewParams(pNumber, pHeight, pWidth, pOr) else
+ SetViewParams(pNumber, pWidth, pHeight, pOr);
+
+ WidthE.Text := frxFloatToStr(mmToUnits(PaperWidth));
+ HeightE.Text := frxFloatToStr(mmToUnits(PaperHeight));
+ end;
+
+ FUpdating := False;
+end;
+
+procedure TfrxPageSettingsForm.WidthEChange(Sender: TObject);
+begin
+ if not FUpdating then
+ SizeCB.ItemIndex := 0;
+end;
+
+procedure TfrxPageSettingsForm.FormKeyDown(var Key: Word;
+ var KeyChar: System.WideChar; Shift: TShiftState);
+begin
+{ if Key = VK_F1 then
+ frxResources.Help(Self); }
+end;
+
+end.
+
diff --git a/LibD28/FMX.frxPreviewPages.pas b/LibD28/FMX.frxPreviewPages.pas
new file mode 100644
index 0000000..c83f305
--- /dev/null
+++ b/LibD28/FMX.frxPreviewPages.pas
@@ -0,0 +1,2742 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Preview Pages }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxPreviewPages;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.SysUtils, System.Types, System.UITypes, System.Variants,
+ FMX.Types, System.UIConsts,
+ FMX.frxClass, FMX.frxXML, FMX.frxPictureCache, System.Diagnostics, System.TimeSpan, FMX.frxXMLSerializer, FMX.frxFMX
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI19}
+, FMX.Printer
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+ THackCanvas = class(TCanvas);
+ TfrxOutline = class(TfrxCustomOutline)
+ private
+ protected
+ function GetCount: Integer; override;
+ public
+ function Root: TfrxXMLItem;
+ procedure AddItem(const Text: String; Top: Integer); override;
+ procedure LevelDown(Index: Integer); override;
+ procedure LevelRoot; override;
+ procedure LevelUp; override;
+ procedure GetItem(Index: Integer; var Text: String;
+ var Page, Top: Integer); override;
+ procedure ShiftItems(From: TfrxXMLItem; NewTop: Integer); override;
+ function GetCurPosition: TfrxXMLItem; override;
+ end;
+
+ TfrxDictionary = class(TObject)
+ private
+ FNames: TStringList;
+ FSourceNames: TStringList;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Add(const Name, SourceName: String; Obj: TObject);
+ procedure Clear;
+ function AddUnique(const Base, SourceName: String; Obj: TObject): String;
+ function CreateUniqueName(const Base: String): String;
+ function GetSourceName(const Name: String): String;
+ function GetObject(const Name: String): TObject;
+ property Names: TStringList read FNames;
+ property SourceNames: TStringList read FSourceNames;
+ end;
+
+ TfrxPreviewPages = class(TfrxCustomPreviewPages)
+ private
+ FAllowPartialLoading: Boolean;
+ FCopyNo: Integer;
+ FDictionary: TfrxDictionary; { list of all objects }
+ FFirstObjectIndex: Integer; { used in the ClearFirstPassPages }
+ FFirstPageIndex: Integer; { used in the ClearFirstPassPages }
+ FFirstOutlineIndex: Integer; { used in the ClearFirstPassPages }
+ FLogicalPageN: Integer;
+ FPageCache: TStringList; { last 20 TfrxPreviewPage }
+ FPageBitmapCache: TStringList; { last 20 TfrxPreviewPage bitmaps }
+ FPagesItem: TfrxXMLItem; { shortcut to XMLDoc.Root.FindName('previewpages') }
+ FPictureCache: TfrxPictureCache;
+ FPrintScale: Extended;
+ FSourcePages: TList; { list of source pages }
+ FTempStream: TStream;
+ FXMLDoc: TfrxXMLDocument; { parsed FP3 document }
+ FXMLSize: Integer;
+ FLastY: Extended; { last Y for composite report created with AddFrom }
+ FLastScale: Extended;
+ FSerializer: TfrxXMLSerializer;
+ FFastCanvas: TCanvas;
+ FFastPrintCanvas: TfrxFastCanvasLayer;
+ procedure AfterLoad;
+ procedure BeforeSave;
+ procedure ClearPageCache;
+ procedure ClearPageBitmapCache;
+ procedure ClearSourcePages;
+ function CurXMLPage: TfrxXMLItem;
+ function GetObject(const Name: String): TfrxComponent;
+ procedure DoLoadFromStream;
+ procedure DoSaveToStream;
+ procedure DrawPageInternal(Index: Integer; Canvas: TCanvas;
+ ScaleX, ScaleY, OffsetX, OffsetY: Extended; WorkArea: TRectF);
+ protected
+ function GetCount: Integer; override;
+ function GetPage(Index: Integer): TfrxReportPage; override;
+ function GetPageSize(Index: Integer): TPoint; override;
+ public
+ constructor Create(AReport: TfrxReport); override;
+ destructor Destroy; override;
+ procedure Clear; override;
+ procedure Initialize; override;
+
+ { engine commands }
+ procedure AddAnchor(const Text: String);
+ procedure AddObject(Obj: TfrxComponent); override;
+ procedure AddPage(Page: TfrxReportPage); override;
+ procedure AddPicture(Picture: TfrxPictureView); override;
+ procedure AddSourcePage(Page: TfrxReportPage); override;
+ procedure AddToSourcePage(Obj: TfrxComponent); override;
+ procedure BeginPass; override;
+ procedure ClearFirstPassPages; override;
+ procedure CutObjects(APosition: Integer); override;
+ procedure Finish; override;
+ procedure IncLogicalPageNumber; override;
+ procedure ResetLogicalPageNumber; override;
+ procedure PasteObjects(X, Y: Extended); override;
+ procedure ShiftAnchors(From, NewTop: Integer); override;
+ procedure UpdatePageDimensions(Page: TfrxReportPage; Width, Height: Extended);
+ function BandExists(Band: TfrxBand): Boolean; override;
+ function FindAnchor(const Text: String): TfrxXMLItem;
+ function GetAnchorPage(const Text: String): Integer;
+ function GetAnchorCurPosition: Integer; override;
+ function GetCurPosition: Integer; override;
+ function GetLastY(ColumnPosition: Extended = 0): Extended; override;
+ function GetLogicalPageNo: Integer; override;
+ function GetLogicalTotalPages: Integer; override;
+
+ { preview commands }
+ procedure DrawPage(Index: Integer; Canvas: TCanvas; ScaleX, ScaleY,
+ OffsetX, OffsetY: Extended; WorkArea: TRectF); override;
+ procedure AddEmptyPage(Index: Integer); override;
+ procedure DeletePage(Index: Integer); override;
+ procedure ModifyPage(Index: Integer; Page: TfrxReportPage); override;
+ procedure AddFrom(Report: TfrxReport); override;
+ procedure LoadFromStream(Stream: TStream;
+ AllowPartialLoading: Boolean = False); override;
+ procedure SaveToStream(Stream: TStream); override;
+ function LoadFromFile(const FileName: String;
+ ExceptionIfNotFound: Boolean = False): Boolean; override;
+ procedure SaveToFile(const FileName: String); override;
+ function Print: Boolean; override;
+ function Export(Filter: TfrxCustomExportFilter): Boolean; override;
+ procedure ObjectOver(Index: Integer; X, Y: Integer; Button: TMouseButton;
+ Shift: TShiftState; Scale, OffsetX, OffsetY: Extended;
+ Click: Boolean; var Cursor: TCursor; DBClick: Boolean = False); override;
+ property SourcePages: TList read FSourcePages;
+ end;
+
+
+implementation
+
+uses
+ FMX.frxPreview, FMX.frxPrinter,
+ FMX.frxUtils, FMX.frxDMPClass, FMX.frxRes, FMX.frxPrintDialog, FMX.Dialogs,
+ FMX.frxBaseModalForm
+{$IFDEF MSWINDOWS}
+ , Winapi.ShellAPI
+{$ENDIF}
+{$IFDEF LINUX}
+ ,FMUX.Api
+{$ENDIF}
+{$IFDEF MACOS}
+ , Posix.Stdlib
+{$ENDIF}
+{$IFDEF FRVIEWER}
+{$IFDEF MSWINDOWS}
+ , FMX.Forms
+{$ENDIF}
+{$ENDIF};
+
+
+type
+ THackComponent = class(TfrxComponent);
+ THackMemoView = class(TfrxCustomMemoView);
+ THackThread = class(TThread);
+
+
+
+{ TfrxOutline }
+
+procedure TfrxOutline.AddItem(const Text: String; Top: Integer);
+begin
+ CurItem := CurItem.Add;
+ CurItem.Name := 'item';
+ CurItem.Text := 'text="' + frxStrToXML(Text) +
+ '" page="' + IntToStr(PreviewPages.CurPage) +
+ '" top="' + IntToStr(Top) + '"';
+end;
+
+procedure TfrxOutline.GetItem(Index: Integer; var Text: String; var Page,
+ Top: Integer);
+var
+ Item: TfrxXMLItem;
+ s: String;
+begin
+ Item := CurItem[Index];
+ Text := Item.Prop['text'];
+
+ s := String(Item.Prop['page']);
+ if s <> '' then
+ Page := StrToInt(s);
+
+ s := String(Item.Prop['top']);
+ if s <> '' then
+ Top := StrToInt(s);
+end;
+
+procedure TfrxOutline.LevelDown(Index: Integer);
+begin
+ CurItem := CurItem[Index];
+end;
+
+procedure TfrxOutline.LevelRoot;
+begin
+ CurItem := Root;
+end;
+
+procedure TfrxOutline.LevelUp;
+begin
+ if CurItem <> Root then
+ CurItem := CurItem.Parent;
+end;
+
+function TfrxOutline.Root: TfrxXMLItem;
+begin
+ Result := TfrxPreviewPages(PreviewPages).FXMLDoc.Root.FindItem('outline');
+end;
+
+function TfrxOutline.GetCount: Integer;
+begin
+ if CurItem = nil then
+ Result := 0
+ else
+ Result := CurItem.Count;
+end;
+
+procedure TfrxOutline.ShiftItems(From: TfrxXMLItem; NewTop: Integer);
+var
+ i, TopY, CorrY: Integer;
+
+ procedure EnumItems(Item: TfrxXMLItem);
+ var
+ i: Integer;
+ begin
+ Item.Prop['page'] := IntToStr(StrToInt(Item.Prop['page']) + 1);
+ Item.Prop['top'] := IntToStr(StrToInt(Item.Prop['top']) + CorrY);
+ for i := 0 to Item.Count - 1 do
+ EnumItems(Item[i]);
+ end;
+
+begin
+ if From = nil then Exit;
+ i := From.Parent.IndexOf(From);
+ if i + 1 >= From.Parent.Count then Exit;
+ From := From.Parent[i + 1];
+
+ TopY := StrToInt(String(From.Prop['top']));
+ CorrY := NewTop - TopY;
+ EnumItems(From);
+end;
+
+function TfrxOutline.GetCurPosition: TfrxXMLItem;
+begin
+ if Count = 0 then
+ Result := nil else
+ Result := CurItem[Count - 1];
+end;
+
+
+{ TfrxDictionary }
+
+constructor TfrxDictionary.Create;
+begin
+ FNames := TfrxStringList.Create;
+ FNames.Sorted := True;
+ FSourceNames := TStringList.Create;
+end;
+
+destructor TfrxDictionary.Destroy;
+begin
+ FNames.Free;
+ FSourceNames.Free;
+ inherited;
+end;
+
+procedure TfrxDictionary.Clear;
+begin
+ FNames.Clear;
+ FSourceNames.Clear;
+end;
+
+procedure TfrxDictionary.Add(const Name, SourceName: String; Obj: TObject);
+var
+ i: Integer;
+begin
+ i := FSourceNames.AddObject(SourceName, Obj);
+ FNames.AddObject(Name, TObject(i));
+end;
+
+function TfrxDictionary.AddUnique(const Base, SourceName: String; Obj: TObject): String;
+var
+ TempStr: String;
+begin
+ TempStr := CreateUniqueName(Base);
+ Add(TempStr, SourceName, Obj);
+ Result := TempStr;
+end;
+
+function TfrxDictionary.CreateUniqueName(const Base: String): String;
+var
+ i: Integer;
+begin
+ i := 10000;
+ while (i > 1) and (FNames.IndexOf(Base + IntToStr(i)) = -1) do
+ i := i div 2;
+ while FNames.IndexOf(Base + IntToStr(i)) <> -1 do
+ Inc(i);
+ Result := Base + IntToStr(i);
+end;
+
+function TfrxDictionary.GetObject(const Name: String): TObject;
+var
+ i: Integer;
+begin
+ Result := nil;
+ i := FNames.IndexOf(Name);
+ if i <> -1 then
+ Result := FSourceNames.Objects[frxInteger(FNames.Objects[i])];
+end;
+
+function TfrxDictionary.GetSourceName(const Name: String): String;
+var
+ i: Integer;
+begin
+ Result := '';
+ i := FNames.IndexOf(Name);
+ if i <> -1 then
+ Result := FSourceNames[frxInteger(FNames.Objects[i])];
+end;
+
+
+{ TfrxPreviewPages }
+
+constructor TfrxPreviewPages.Create(AReport: TfrxReport);
+begin
+ inherited;
+ FDictionary := TfrxDictionary.Create;
+ FSourcePages := TList.Create;
+ FXMLDoc := TfrxXMLDocument.Create;
+ FXMLDoc.Root.Name := 'preparedreport';
+ FPageCache := TfrxStringList.Create;
+ FPageBitmapCache := TStringList.Create;
+ FPictureCache := TfrxPictureCache.Create;
+ FSerializer := TfrxXMLSerializer.Create(nil);
+ FLastY := 0;
+ FFastPrintCanvas := nil;
+end;
+
+destructor TfrxPreviewPages.Destroy;
+begin
+ ClearPageCache;
+ ClearPageBitmapCache;
+ FPageCache.Free;
+ FPageBitmapCache.Free;
+ FDictionary.Free;
+ ClearSourcePages;
+ FPictureCache.Free;
+ FSourcePages.Free;
+ FXMLDoc.Free;
+ FSerializer.Free;
+ if Assigned(FFastPrintCanvas) then
+ FFastPrintCanvas.Free;
+ inherited;
+end;
+
+procedure TfrxPreviewPages.Clear;
+begin
+ ClearPageCache;
+ ClearPageBitmapCache;
+ ClearSourcePages;
+ FXMLDoc.Clear;
+ FDictionary.Clear;
+ FPictureCache.Clear;
+ CurPage := -1;
+ FXMLSize := 0;
+ FLastY := 0;
+end;
+
+procedure TfrxPreviewPages.Initialize;
+begin
+ FPictureCache.UseFileCache := Report.PreviewOptions.PictureCacheInFile;
+ FPictureCache.TempDir := Report.EngineOptions.TempDir;
+ FXMLDoc.TempDir := Report.EngineOptions.TempDir;
+ Report.InternalOnProgressStart(ptRunning);
+end;
+
+procedure TfrxPreviewPages.ClearPageCache;
+begin
+ while FPageCache.Count > 0 do
+ begin
+ TfrxReportPage(FPageCache.Objects[0]).Free;
+ FPageCache.Delete(0);
+ end;
+end;
+
+procedure TfrxPreviewPages.ClearPageBitmapCache;
+begin
+ while FPageBitmapCache.Count > 0 do
+ begin
+ TBitmap(FPageBitmapCache.Objects[0]).Free;
+ FPageBitmapCache.Delete(0);
+ end;
+end;
+
+procedure TfrxPreviewPages.ClearSourcePages;
+begin
+ while FSourcePages.Count > 0 do
+ begin
+ TfrxReportPage(FSourcePages[0]).Free;
+ FSourcePages.Delete(0);
+ end;
+end;
+
+procedure TfrxPreviewPages.BeginPass;
+begin
+ FFirstPageIndex := Count - 1;
+ if FFirstPageIndex <> -1 then
+ begin
+ FFirstObjectIndex := FXMLDoc.Root.FindItem('previewpages')[FFirstPageIndex].Count;
+ FFirstOutlineIndex := FXMLDoc.Root.FindItem('outline').Count;
+ end;
+ ResetLogicalPageNumber;
+end;
+
+procedure TfrxPreviewPages.ClearFirstPassPages;
+var
+ PagesRoot, OutlineRoot: TfrxXMLItem;
+ p: TfrxXMLItem;
+ i: Integer;
+begin
+ if FFirstPageIndex = -1 then
+ begin
+ for i := 0 to FXMLDoc.Root.Count - 1 do
+ if (CompareText(FXMLDoc.Root[i].Name, 'anchors') <> 0) and
+ (CompareText(FXMLDoc.Root[i].Name, 'logicalpagenumbers') <> 0) then
+ FXMLDoc.Root[i].Clear;
+
+ end
+ else
+ begin
+ PagesRoot := FXMLDoc.Root.FindItem('previewpages');
+ OutlineRoot := FXMLDoc.Root.FindItem('outline');
+ p := PagesRoot[FFirstPageIndex];
+ { clear some objects on first page }
+ while p.Count > FFirstObjectIndex do
+ p[FFirstObjectIndex].Free;
+ { clear remained pages }
+ while Count > FFirstPageIndex + 1 do
+ PagesRoot[FFirstPageIndex + 1].Free;
+ { clear remained outline }
+ while OutlineRoot.Count > FFirstOutlineIndex do
+ OutlineRoot[FFirstOutlineIndex].Free;
+ end;
+
+ ResetLogicalPageNumber;
+ CurPage := FFirstPageIndex;
+ FXMLSize := 0;
+end;
+
+function TfrxPreviewPages.CurXMLPage: TfrxXMLItem;
+begin
+ Result := FXMLDoc.Root.FindItem('previewpages');
+ Result := Result[CurPage];
+end;
+
+function TfrxPreviewPages.GetCount: Integer;
+begin
+ Result := FXMLDoc.Root.FindItem('previewpages').Count;
+end;
+
+function TfrxPreviewPages.GetCurPosition: Integer;
+begin
+ Result := CurXMLPage.Count;
+end;
+
+procedure TfrxPreviewPages.AddAnchor(const Text: String);
+var
+ AnchorRoot, Item: TfrxXMLItem;
+begin
+ AnchorRoot := FXMLDoc.Root.FindItem('anchors');
+ Item := AnchorRoot.Add;
+ Item.Name := 'item';
+ Item.Text := 'text="' + frxStrToXML(Text) +
+ '" page="' + IntToStr(CurPage) +
+ '" top="' + IntToStr(Round(Engine.CurY)) + '"';
+end;
+
+function TfrxPreviewPages.FindAnchor(const Text: String): TfrxXMLItem;
+var
+ AnchorRoot, Item: TfrxXMLItem;
+ i: Integer;
+begin
+ Result := nil;
+ AnchorRoot := FXMLDoc.Root.FindItem('anchors');
+ for i := AnchorRoot.Count - 1 downto 0 do
+ begin
+ Item := AnchorRoot[i];
+ if frxCompareText(Item.Prop['text'], Text) = 0 then
+ begin
+ Result := Item;
+ Exit;
+ end;
+ end;
+end;
+
+function TfrxPreviewPages.GetAnchorPage(const Text: String): Integer;
+var
+ Item: TfrxXMLItem;
+begin
+ Item := FindAnchor(Text);
+ if Item <> nil then
+ Result := StrToInt(String(Item.Prop['page'])) + 1 else
+ Result := 1;
+end;
+
+function TfrxPreviewPages.GetAnchorCurPosition: Integer;
+begin
+ Result := FXMLDoc.Root.FindItem('anchors').Count - 1;
+end;
+
+procedure TfrxPreviewPages.ShiftAnchors(From, NewTop: Integer);
+var
+ i, CorrY: Integer;
+ AnchorRoot, Item: TfrxXMLItem;
+begin
+ AnchorRoot := FXMLDoc.Root.FindItem('anchors');
+ if (From + 1 < 0) or (From + 1 >= AnchorRoot.Count) then Exit;
+
+ Item := AnchorRoot[From + 1];
+ CorrY := NewTop - StrToInt(String(Item.Prop['top']));
+
+ for i := From + 1 to AnchorRoot.Count - 1 do
+ begin
+ Item := AnchorRoot[i];
+ Item.Prop['page'] := IntToStr(StrToInt(Item.Prop['page']) + 1);
+ Item.Prop['top'] := IntToStr(StrToInt(Item.Prop['top']) + CorrY);
+ end;
+end;
+
+procedure TfrxPreviewPages.IncLogicalPageNumber;
+var
+ xi: TfrxXMLItem;
+begin
+ if Engine.FinalPass and Engine.DoublePass then Exit;
+
+ Inc(FLogicalPageN);
+ xi := FXMLDoc.Root.FindItem('logicalpagenumbers').Add;
+ xi.Name := 'page';
+ xi.Prop['n'] := IntToStr(FLogicalPageN);
+end;
+
+procedure TfrxPreviewPages.ResetLogicalPageNumber;
+var
+ i: Integer;
+ xi, pageItem: TfrxXMLItem;
+begin
+ if Engine.FinalPass and Engine.DoublePass then Exit;
+
+ pageItem := FXMLDoc.Root.FindItem('logicalpagenumbers');
+ for i := CurPage downto FFirstPageIndex + 1 do
+ begin
+ if (i < 0) or (i >= pageItem.Count) then continue;
+ xi := pageItem[i];
+ xi.Prop['t'] := IntToStr(FLogicalPageN);
+ if xi.Prop['n'] = '1' then
+ break;
+ end;
+ FLogicalPageN := 0;
+end;
+
+function TfrxPreviewPages.GetLogicalPageNo: Integer;
+var
+ xi: TfrxXMLItem;
+begin
+ xi := FXMLDoc.Root.FindItem('logicalpagenumbers');
+ if (CurPage < 0) or (CurPage >= xi.Count) then
+ Result := CurPage - FirstPage + 1
+ else
+ begin
+ xi := xi[CurPage];
+ Result := StrToInt(String(xi.Prop['n']));
+ end;
+end;
+
+function TfrxPreviewPages.GetLogicalTotalPages: Integer;
+var
+ xi: TfrxXMLItem;
+begin
+ xi := FXMLDoc.Root.FindItem('logicalpagenumbers');
+ if (CurPage < 0) or (CurPage >= xi.Count) then
+ Result := Engine.TotalPages - FirstPage
+ else
+ begin
+ xi := xi[CurPage];
+ if xi.Prop['t'] <> '' then
+ Result := StrToInt(String(xi.Prop['t']))
+ else
+ Result := 0;
+ end;
+end;
+
+procedure TfrxPreviewPages.AddObject(Obj: TfrxComponent);
+var
+ IsOriginalPage: Boolean;
+ CurPageItem: TfrxXMLItem;
+
+ procedure DoAdd(c: TfrxComponent; Item: TfrxXMLItem);
+ var
+ i: Integer;
+ begin
+ if (not c.Visible) or not (csPreviewVisible in c.frComponentStyle) then Exit;
+
+ with THackComponent(c) do
+ begin
+ Item := Item.Add;
+ { the component that was created after report has been started }
+ if (FOriginalComponent = nil) or IsOriginalPage then
+ begin
+ Item.Name := ClassName;
+ Item.Text := AllDiff(nil);
+ end
+ else
+ begin
+ { the component that exists in the report template }
+ Item.Name := FAliasName;
+ if Engine.FinalPass then
+ begin
+ if csDefaultDiff in frComponentStyle then
+ Item.Text := AllDiff(FOriginalComponent) else
+ Item.Text := Diff(FOriginalComponent);
+ end
+ else
+ { we don't need to output all info on the first pass, only coordinates }
+ Item.Text := InternalDiff(FOriginalComponent);
+ end;
+ Inc(FXMLSize, Length(Item.Name) + Length(Item.Text) + Item.InstanceSize + 16);
+ end;
+
+ for i := 0 to c.Objects.Count - 1 do
+ DoAdd(c.Objects[i], Item);
+ end;
+
+begin
+ CurPageItem := CurXMLPage;
+ { need for PrintOnPrevPage option when report has pages added by AddFrom method}
+ IsOriginalPage := ((CompareText(CurPageItem.Name, 'TfrxReportPage') = 0) or
+ (CompareText(CurPageItem.Name, 'TfrxDMPPage') = 0));
+ DoAdd(Obj, CurPageItem);
+end;
+
+procedure TfrxPreviewPages.AddPage(Page: TfrxReportPage);
+var
+ xi: TfrxXMLItem;
+
+ procedure UnloadPages;
+ var
+ i: Integer;
+ begin
+ if Report.EngineOptions.UseFileCache then
+ if FXMLSize > Report.EngineOptions.MaxMemSize * 1024 * 1024 then
+ begin
+ for i := xi.Count - 2 downto 0 do
+ if xi[i].Loaded then
+ FXMLDoc.UnloadItem(xi[i]) else
+ break;
+ FXMLSize := 0;
+ end;
+ end;
+
+ function GetSourceNo(Page: TfrxReportPage): Integer;
+ var
+ i: Integer;
+ begin
+ Result := -1;
+ for i := 0 to FSourcePages.Count - 1 do
+ if THackComponent(FSourcePages[i]).FOriginalComponent = Page then
+ begin
+ Result := i;
+ break;
+ end;
+ end;
+
+begin
+ FPagesItem := FXMLDoc.Root.FindItem('previewpages');
+ xi := FPagesItem;
+ UnloadPages;
+
+ CurPage := CurPage + 1;
+ if (CurPage >= Count) or (AddPageAction = apAdd) then
+ begin
+ xi := xi.Add;
+ xi.Name := 'page' + IntToStr(GetSourceNo(Page));
+ if Count > 2 then
+ xi.Unloadable := True;
+ Report.InternalOnProgress(ptRunning, CurPage + 1);
+ AddPageAction := apWriteOver;
+ CurPage := Count - 1;
+ IncLogicalPageNumber;
+ end;
+end;
+
+procedure TfrxPreviewPages.AddSourcePage(Page: TfrxReportPage);
+var
+ p: TfrxReportPage;
+ xs: TfrxXMLSerializer;
+ xi: TfrxXMLItem;
+ i: Integer;
+ originals, copies: TList;
+ c1, c2: TfrxComponent;
+ s, s1: String;
+
+ function EnumObjects(Parent, Parent1: TfrxComponent): TfrxComponent;
+ var
+ i: Integer;
+ c: TfrxComponent;
+ begin
+ Result := nil;
+ if not (csPreviewVisible in Parent.frComponentStyle) then
+ begin
+ originals.Add(Parent);
+ copies.Add(nil);
+ Exit;
+ end;
+
+ c := TfrxComponent(Parent.NewInstance);
+ c.Create(Parent1);
+ if Parent is TfrxPictureView then
+ TfrxPictureView(Parent).IsPictureStored := False;
+ c.Assign(Parent);
+ if Parent is TfrxPictureView then
+ TfrxPictureView(Parent).IsPictureStored := True;
+ c.Name := Parent.Name;
+ originals.Add(Parent);
+ copies.Add(c);
+
+ for i := 0 to Parent.Objects.Count - 1 do
+ EnumObjects(Parent.Objects[i], c);
+ Result := c;
+ end;
+
+begin
+ xs := TfrxXMLSerializer.Create(nil);
+ xi := TfrxXMLItem.Create;
+ originals := TList.Create;
+ copies := TList.Create;
+
+ try
+ p := TfrxReportPage(EnumObjects(Page, nil));
+ THackComponent(p).FOriginalComponent := Page;
+ FSourcePages.Add(p);
+
+ for i := 1 to copies.Count - 1 do
+ begin
+ c1 := copies[i];
+ c2 := originals[i];
+ if (c1 = nil) and not (csPreviewVisible in c2.frComponentStyle ) then
+ begin
+ c2.AddSourceObjects;
+ continue;
+ end;
+
+ THackComponent(c2).FOriginalComponent := c1;
+ THackComponent(c1).FOriginalComponent := c2;
+
+ if c1 is TfrxBand then
+ s := 'b' else
+ s := LowerCase(c1.BaseName[1]);
+ s := FDictionary.AddUnique(String(s), 'Page' + IntToStr(FSourcePages.Count - 1) +
+ '.' + c1.Name, c1);
+ // speed optimization
+ if c1 is TfrxCustomMemoView then
+ begin
+ TfrxCustomMemoView(c1).DataSet := nil;
+ TfrxCustomMemoView(c1).DataField := '';
+ end;
+ if csDefaultDiff in c1.frComponentStyle then
+ s1 := c1.ClassName
+ else
+ s1 := xs.WriteComponentStr(c1);
+ THackComponent(c1).FBaseName := s1;
+ THackComponent(c1).FAliasName := s;
+ THackComponent(c2).FAliasName := s;
+ end;
+
+ finally
+ originals.Free;
+ copies.Free;
+ xs.Free;
+ xi.Free;
+ end;
+end;
+
+procedure TfrxPreviewPages.AddPicture(Picture: TfrxPictureView);
+begin
+ FPictureCache.AddPicture(Picture);
+end;
+
+procedure TfrxPreviewPages.AddToSourcePage(Obj: TfrxComponent);
+var
+ NewObj: TfrxComponent;
+ Page: TfrxReportPage;
+ s: String;
+ xs: TfrxXMLSerializer;
+begin
+ xs := TfrxXMLSerializer.Create(nil);
+ Page := FSourcePages[FSourcePages.Count - 1];
+ NewObj := TfrxComponent(Obj.NewInstance);
+ NewObj.Create(Page);
+ NewObj.Assign(Obj);
+ NewObj.CreateUniqueName;
+
+ s := FDictionary.AddUnique(LowerCase(String(NewObj.BaseName[1])),
+ 'Page' + IntToStr(FSourcePages.Count - 1) + '.' + NewObj.Name, NewObj);
+ if csDefaultDiff in NewObj.frComponentStyle then
+ THackComponent(NewObj).FBaseName := NewObj.ClassName else
+ THackComponent(NewObj).FBaseName := xs.WriteComponentStr(NewObj);
+
+ THackComponent(Obj).FOriginalComponent := NewObj;
+ THackComponent(Obj).FAliasName := s;
+ THackComponent(NewObj).FAliasName := s;
+ xs.Free;
+end;
+
+procedure TfrxPreviewPages.UpdatePageDimensions(Page: TfrxReportPage; Width, Height: Extended);
+var
+ SourcePage: TfrxReportPage;
+ xi: TfrxXMLItem;
+ i: Integer;
+begin
+ SourcePage := nil;
+ for i := 0 to FSourcePages.Count - 1 do
+ begin
+ SourcePage := FSourcePages[i];
+ if THackComponent(SourcePage).FOriginalComponent = Page then
+ break;
+ end;
+
+ SourcePage.PaperSize := 256;
+ SourcePage.PaperWidth := Width / fr01cm;
+ SourcePage.PaperHeight := Height / fr01cm;
+ xi := TfrxXMLItem.Create;
+ xi.Text := THackComponent(SourcePage).FBaseName;
+ xi.Prop['PaperSize'] := '256';
+ xi.Prop['PaperWidth'] := frxFloatToStr(SourcePage.PaperWidth);
+ xi.Prop['PaperHeight'] := frxFloatToStr(SourcePage.PaperHeight);
+ THackComponent(SourcePage).FBaseName := xi.Text;
+ xi.Free;
+end;
+
+procedure TfrxPreviewPages.Finish;
+var
+ i: Integer;
+begin
+ FLastY := 0;
+ ClearPageCache;
+ ClearPageBitmapCache;
+ { avoid bug with multiple PrepareReport(False) }
+ for i := 0 to FSourcePages.Count - 1 do
+ THackComponent(FSourcePages[i]).FOriginalComponent := nil;
+ Report.InternalOnProgressStop(ptRunning);
+end;
+
+function TfrxPreviewPages.BandExists(Band: TfrxBand): Boolean;
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ Result := False;
+ for i := 0 to CurXMLPage.Count - 1 do
+ begin
+ c := GetObject(CurXMLPage[i].Name);
+ if c <> nil then
+ if (THackComponent(c).FOriginalComponent = Band) or
+ ((Band is TfrxPageFooter) and (c is TfrxPageFooter)) or
+ ((Band is TfrxColumnFooter) and (c is TfrxColumnFooter)) then
+ begin
+ Result := True;
+ break;
+ end;
+ end;
+end;
+
+function TfrxPreviewPages.GetLastY(ColumnPosition: Extended): Extended;
+var
+ i: Integer;
+ c: TfrxComponent;
+ s: String;
+ y, x: Extended;
+begin
+ Result := 0;
+ y := 0;
+ for i := 0 to CurXMLPage.Count - 1 do
+ begin
+ c := GetObject(CurXMLPage[i].Name);
+ if c is TfrxBand then
+ if not (c is TfrxPageFooter) and not (c is TfrxOverlay) then
+ begin
+ s := String(CurXMLPage[i].Prop['l']);
+ if s <> '' then
+ x := frxStrToFloat(s) else
+ x := c.Left;
+ { check columns }
+ if (ColumnPosition = 0) or (ABS(ColumnPosition - x) < 0.001)
+ or (c is TfrxPageHeader) or (c is TfrxReportTitle) then
+ begin
+ s := String(CurXMLPage[i].Prop['t']);
+ if s <> '' then
+ y := frxStrToFloat(s) else
+ y := c.Top;
+
+ s := String(CurXMLPage[i].Prop['h']);
+ if s <> '' then
+ y := y + frxStrToFloat(s) else
+ y := y + c.Height;
+ end;
+ if y > Result then
+ Result := y;
+ end;
+ end;
+ if (Result = 0) and (FLastY <> 0) then
+ Result := FLastY;
+end;
+
+procedure TfrxPreviewPages.CutObjects(APosition: Integer);
+var
+ xi: TfrxXMLItem;
+begin
+ xi := FXMLDoc.Root.FindItem('cutted');
+ while APosition < CurXMLPage.Count do
+ xi.AddItem(CurXMLPage[APosition]);
+end;
+
+procedure TfrxPreviewPages.PasteObjects(X, Y: Extended);
+var
+ xi: TfrxXMLItem;
+ LeftX, TopY, CorrX, CorrY: Extended;
+
+ procedure CorrectX(xi: TfrxXMLItem);
+ var
+ X: Extended;
+ begin
+ if xi.Prop['l'] <> '' then
+ X := frxStrToFloat(xi.Prop['l']) else
+ X := 0;
+ X := X + CorrX;
+ xi.Prop['l'] := FloatToStr(X);
+ end;
+
+ procedure CorrectY(xi: TfrxXMLItem);
+ var
+ Y: Extended;
+ begin
+ if xi.Prop['t'] <> '' then
+ Y := frxStrToFloat(xi.Prop['t']) else
+ Y := 0;
+ Y := Y + CorrY;
+ xi.Prop['t'] := FloatToStr(Y);
+ end;
+
+begin
+ xi := FXMLDoc.Root.FindItem('cutted');
+
+ if xi.Count > 0 then
+ begin
+ if xi[0].Prop['l'] <> '' then
+ LeftX := frxStrToFloat(xi[0].Prop['l']) else
+ LeftX := 0;
+ CorrX := X - LeftX;
+
+ if xi[0].Prop['t'] <> '' then
+ TopY := frxStrToFloat(xi[0].Prop['t']) else
+ TopY := 0;
+ CorrY := Y - TopY;
+
+ while xi.Count > 0 do
+ begin
+ CorrectX(xi[0]);
+ CorrectY(xi[0]);
+ CurXMLPage.AddItem(xi[0]);
+ end;
+ end;
+
+ xi.Free;
+end;
+
+procedure TfrxPreviewPages.DoLoadFromStream;
+var
+ Compressor: TfrxCustomCompressor;
+begin
+ Compressor := nil;
+ if frxCompressorClass <> nil then
+ begin
+ FAllowPartialLoading := False;
+ Compressor := TfrxCustomCompressor(frxCompressorClass.NewInstance);
+ Compressor.Create(nil);
+ Compressor.Report := Report;
+ Compressor.IsFR3File := False;
+ try
+ Compressor.CreateStream;
+ if Compressor.Decompress(FTempStream) then
+ FTempStream := Compressor.Stream;
+ except
+ Compressor.Free;
+ Report.Errors.Add(frxResources.Get('clDecompressError'));
+ frxCommonErrorHandler(Report, frxResources.Get('clErrors') + #13#10 + Report.Errors.Text);
+ Exit;
+ end;
+ end;
+ FXMLDoc.LoadFromStream(FTempStream, FAllowPartialLoading);
+ AfterLoad;
+ if Compressor <> nil then
+ Compressor.Free;
+end;
+
+procedure TfrxPreviewPages.DoSaveToStream;
+var
+ Compressor: TfrxCustomCompressor;
+ StreamTo: TStream;
+begin
+ StreamTo := FTempStream;
+ Compressor := nil;
+ if Report.ReportOptions.Compressed and (frxCompressorClass <> nil) then
+ begin
+ Compressor := TfrxCustomCompressor(frxCompressorClass.NewInstance);
+ Compressor.Create(nil);
+ Compressor.Report := Report;
+ Compressor.IsFR3File := False;
+ Compressor.CreateStream;
+ StreamTo := Compressor.Stream;
+ end;
+ try
+ BeforeSave;
+ FXMLDoc.SaveToStream(StreamTo);
+ finally
+ if Compressor <> nil then
+ begin
+ try
+ Compressor.Compress(FTempStream);
+ finally
+ Compressor.Free;
+ end;
+ end;
+ end;
+end;
+
+procedure TfrxPreviewPages.LoadFromStream(Stream: TStream;
+ AllowPartialLoading: Boolean = False);
+begin
+ Clear;
+ FTempStream := Stream;
+ FAllowPartialLoading := AllowPartialLoading;
+ DoLoadFromStream;
+end;
+
+procedure TfrxPreviewPages.SaveToStream(Stream: TStream);
+begin
+ FTempStream := Stream;
+ DoSaveToStream;
+end;
+
+function TfrxPreviewPages.LoadFromFile(const FileName: String;
+ ExceptionIfNotFound: Boolean): Boolean;
+var
+ Stream: TFileStream;
+{$IFDEF FRVIEWER}
+{$IFDEF MSWINDOWS}
+ RepStream: TStringStream;
+{$ENDIF}
+{$ENDIF}
+begin
+ Result := FileExists(FileName);
+ if Result or ExceptionIfNotFound then
+ begin
+{$IFDEF FRVIEWER}
+{$IFDEF MSWINDOWS}
+ RepStream := TStringStream.Create;
+ try
+ RepStream.LoadFromFile(FileName);
+ if Pos('PixelsPerInch' ,RepStream.DataString, 1)= 0 then
+ begin
+ ShellExecute(0, 'open', PChar(ExtractFilePath(ParamStr(0)) + 'FastReportVCL_Viewer.exe'), PChar(FileName), '', 0);
+ Application.Terminate;
+ end;
+ finally
+ RepStream.Free;
+ end;
+{$ENDIF}
+{$ENDIF}
+ Stream := TFileStream.Create(FileName, fmOpenRead + fmShareDenyWrite);
+ try
+ LoadFromStream(Stream);
+ finally
+ Stream.Free;
+ end;
+ end;
+end;
+
+procedure TfrxPreviewPages.SaveToFile(const FileName: String);
+var
+ Stream: TFileStream;
+begin
+ Stream := TFileStream.Create(FileName, fmCreate);
+ try
+ SaveToStream(Stream);
+ finally
+ Stream.Free;
+ end;
+end;
+
+procedure TfrxPreviewPages.AfterLoad;
+var
+ i: Integer;
+ xs: TfrxXMLSerializer;
+ xi: TfrxXMLItem;
+ p: TfrxReportPage;
+
+{ store source objects' properties in the FBaseName to get it later in the GetPage }
+ procedure DoProps(p: TfrxReportPage);
+ var
+ i: Integer;
+ l: TList;
+ c: THackComponent;
+ begin
+ l := p.AllObjects;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ c.FBaseName := xs.WriteComponentStr(c);
+ end;
+ end;
+
+{ fill FDictionary.Objects }
+ procedure FillDictionary;
+ var
+ i: Integer;
+ Name, PageName, ObjName: String;
+ PageN: Integer;
+ begin
+ xi := FXMLDoc.Root.FindItem('dictionary');
+ FDictionary.Clear;
+ for i := 0 to xi.Count - 1 do
+ begin
+ Name := Copy(xi[i].Text, 7, Length(xi[i].Text) - 7);
+ PageName := Copy(Name, 1, Pos('.', Name) - 1);
+ ObjName := Copy(Name, Pos('.', Name) + 1, 255);
+
+ PageN := StrToInt(Copy(PageName, 5, 255));
+ FDictionary.Add(xi[i].Name, Name,
+ TfrxReportPage(FSourcePages[PageN]).FindObject(ObjName));
+ end;
+ end;
+
+begin
+ FPagesItem := FXMLDoc.Root.FindItem('previewpages');
+ xs := TfrxXMLSerializer.Create(nil);
+ xs.OldFormat := FXMLDoc.OldVersion;
+
+{ load the report settings }
+ xi := FXMLDoc.Root.FindItem('report');
+ if xi.Count > 0 then
+ xs.ReadRootComponent(Report, xi[0]);
+
+{ build sourcepages }
+ try
+ xi := FXMLDoc.Root.FindItem('sourcepages');
+ ClearSourcePages;
+
+ for i := 0 to xi.Count - 1 do
+ begin
+ if CompareText(xi[i].Name, 'TfrxDMPPage') = 0 then
+ p := TfrxDMPPage.Create(nil) else
+ p := TfrxReportPage.Create(nil);
+ xs.Owner := p;
+ xs.ReadRootComponent(p, xi[i]);
+ DoProps(p);
+ FSourcePages.Add(p);
+ end;
+ xi.Clear;
+
+ finally
+ xs.Free;
+ end;
+
+{ build the dictionary }
+ FillDictionary;
+
+{ load the picturecache }
+ FPictureCache.LoadFromXML(FXMLDoc.Root.FindItem('picturecache'));
+end;
+
+procedure TfrxPreviewPages.BeforeSave;
+var
+ i: Integer;
+ xs: TfrxXMLSerializer;
+ xi: TfrxXMLItem;
+begin
+ FPagesItem := FXMLDoc.Root.FindItem('previewpages');
+ xs := TfrxXMLSerializer.Create(nil);
+
+{ upload the report settings }
+ xi := FXMLDoc.Root.FindItem('report');
+ xi.Clear;
+ xi := xi.Add;
+ xi.Name := Report.ClassName;
+ xi.Text := 'DotMatrixReport="' + frxValueToXML(Report.DotMatrixReport) +
+ '" PreviewOptions.OutlineVisible="' + frxValueToXML(Report.PreviewOptions.OutlineVisible) +
+ '" PreviewOptions.OutlineWidth="' + frxValueToXML(Report.PreviewOptions.OutlineWidth) +
+ '" ReportOptions.Name="' + frxStrToXML(Report.ReportOptions.Name) + '"';
+
+{ upload the sourcepages }
+ try
+ xi := FXMLDoc.Root.FindItem('sourcepages');
+ xi.Clear;
+ for i := 0 to FSourcePages.Count - 1 do
+ xs.WriteRootComponent(FSourcePages[i], True, xi.Add);
+
+ finally
+ xs.Free;
+ end;
+
+{ upload the dictionary }
+ xi := FXMLDoc.Root.FindItem('dictionary');
+ xi.Clear;
+ for i := 0 to FDictionary.Names.Count - 1 do
+ with xi.Add do
+ begin
+ Name := FDictionary.Names[i];
+ Text := 'name="' + FDictionary.GetSourceName(Name) + '"';
+ end;
+
+{ upload the picturecache }
+ xi := FXMLDoc.Root.FindItem('picturecache');
+ FPictureCache.SaveToXML(xi);
+end;
+
+function TfrxPreviewPages.GetObject(const Name: String): TfrxComponent;
+begin
+ Result := TfrxComponent(FDictionary.GetObject(Name));
+end;
+
+function TfrxPreviewPages.GetPage(Index: Integer): TfrxReportPage;
+var
+ xi: TfrxXMLItem;
+ i: Integer;
+ Source: TfrxReportPage;
+
+ procedure DoObjects(Item: TfrxXMLItem; Owner: TfrxComponent);
+ var
+ i: Integer;
+ c, c0: TfrxComponent;
+ begin
+ for i := 0 to Item.Count - 1 do
+ begin
+ c0 := GetObject(Item[i].Name);
+ { object not found in the dictionary }
+ if c0 = nil then
+ c := FSerializer.ReadComponentStr(Owner, Item[i].Name + ' ' + Item[i].Text, True)
+ else
+ begin
+ c := FSerializer.ReadComponentStr(Owner,
+ THackComponent(c0).FBaseName + ' ' + Item[i].Text, True);
+ c.Name := c0.Name;
+ if (c is TfrxPictureView) and (TfrxPictureView(c).Picture.IsEmpty) then
+ FPictureCache.GetPicture(TfrxPictureView(c));
+ end;
+ c.Parent := Owner;
+
+ DoObjects(Item[i], c);
+ end;
+ end;
+
+begin
+ Result := nil;
+ if Count = 0 then Exit;
+ { check pagecache first }
+ if not Engine.Running then
+ begin
+ i := FPageCache.IndexOf(IntToStr(Index));
+ if i <> -1 then
+ begin
+ Result := TfrxReportPage(FPageCache.Objects[i]);
+ FPageCache.Exchange(i, 0);
+ Exit;
+ end;
+ end;
+
+ FSerializer.OldFormat := FXMLDoc.OldVersion;
+ FSerializer.Owner := nil;
+ { load the page item }
+ xi := FPagesItem[Index];
+ FXMLDoc.LoadItem(xi);
+
+ if CompareText(xi.Name, 'TfrxReportPage') = 0 then
+ begin
+ { page item do not refer to the originalpages }
+ Result := TfrxReportPage.Create(nil);
+ FSerializer.ReadRootComponent(Result, xi);
+ end
+ else if CompareText(xi.Name, 'TfrxDMPPage') = 0 then
+ begin
+ { page item do not refer to the originalpages }
+ Result := TfrxDMPPage.Create(nil);
+ FSerializer.ReadRootComponent(Result, xi);
+ end
+ else
+ begin
+ Source := FSourcePages[StrToInt(Copy(String(xi.Name), 5, 5))];
+ { create reportpage and assign properties from original page }
+ if Source is TfrxDMPPage then
+ Result := TfrxDMPPage.Create(nil)
+ else
+ Result := TfrxReportPage.Create(nil);
+ Result.Assign(Source);
+ Result.Name := Source.Name;
+ { create objects }
+ DoObjects(xi, Result);
+ end;
+ { update aligned objects }
+ Result.AlignChildren;
+ { add this page to the pagecache }
+ FPageCache.InsertObject(0, IntToStr(Index), Result);
+ i := FPageCache.Count;
+
+ { remove the least used item from the pagecache }
+ if (i > 1) and (i > Report.PreviewOptions.PagesInCache) then
+ begin
+ xi := FPagesItem[StrToInt(FPageCache[i - 1])];
+ if Report.EngineOptions.UseFileCache and xi.Unloadable then
+ begin
+ FXMLDoc.UnloadItem(xi);
+ xi.Clear;
+ end;
+ TfrxReportPage(FPageCache.Objects[i - 1]).Free;
+ FPageCache.Delete(i - 1);
+ end;
+end;
+
+function TfrxPreviewPages.GetPageSize(Index: Integer): TPoint;
+var
+ xi: TfrxXMLItem;
+ p: TfrxReportPage;
+begin
+ if (Count = 0) or (Index < 0) or (Index >= Count) then
+ begin
+ Result := Point(0, 0);
+ Exit;
+ end;
+
+ xi := FPagesItem[Index];
+ if (CompareText(xi.Name, 'TfrxReportPage') = 0) or
+ (CompareText(xi.Name, 'TfrxDMPPage') = 0) then
+ p := GetPage(Index) else
+ p := FSourcePages[StrToInt(Copy(String(xi.Name), 5, 256))];
+ Result.X := Round(p.Width);
+ Result.Y := Round(p.Height);
+end;
+
+procedure TfrxPreviewPages.AddEmptyPage(Index: Integer);
+var
+ xi: TfrxXMLItem;
+begin
+ if Count = 0 then Exit;
+
+ xi := TfrxXMLItem.Create;
+ xi.Name := FPagesItem[Index].Name;
+ FPagesItem.InsertItem(Index, xi);
+ ClearPageCache;
+ ClearPageBitmapCache;
+end;
+
+procedure TfrxPreviewPages.DeletePage(Index: Integer);
+begin
+ if Count < 2 then Exit;
+
+ FPagesItem[Index].Free;
+ ClearPageCache;
+ ClearPageBitmapCache;
+end;
+
+procedure TfrxPreviewPages.ModifyPage(Index: Integer; Page: TfrxReportPage);
+var
+ xs: TfrxXMLSerializer;
+begin
+ xs := TfrxXMLSerializer.Create(nil);
+ try
+ FPagesItem[Index].Clear;
+ xs.WriteRootComponent(Page, True, FPagesItem[Index]);
+ FPagesItem[Index].Unloadable := False;
+ ClearPageCache;
+ ClearPageBitmapCache;
+ finally
+ xs.Free;
+ end;
+end;
+
+procedure TfrxPreviewPages.AddFrom(Report: TfrxReport);
+var
+ i, nPageOffset: Integer;
+ Page: TfrxReportPage;
+ xi: TfrxXMLItem;
+ xs: TfrxXMLSerializer;
+ AnchorRootSource, AnchorRootDest: TfrxXMLItem;
+
+ procedure CopyOutline;
+ var
+ nPage, nTop, idx: Integer;
+ sText: String;
+ begin
+ for idx := 0 to Report.PreviewPages.Outline.Count - 1 do
+ begin
+ Report.PreviewPages.Outline.GetItem(idx, sText, nPage, nTop);
+ CurPage := nPageOffset + nPage;
+ Outline.AddItem(sText, nTop);
+ Report.PreviewPages.Outline.LevelDown(idx);
+ CopyOutline;
+ Report.PreviewPages.Outline.LevelUp;
+ Outline.LevelUp;
+ end;
+ end;
+
+begin
+ xs := TfrxXMLSerializer.Create(nil);
+
+ nPageOffset := Count;
+
+ for i := 0 to Report.PreviewPages.Count - 1 do
+ begin
+ Page := Report.PreviewPages.Page[i];
+ xi := TfrxXMLItem.Create;
+ xi.Name := FPagesItem[Count - 1].Name;
+ xs.WriteRootComponent(Page, True, xi);
+ xi.Unloadable := False;
+ FPagesItem.AddItem(xi);
+ end;
+
+ { Copy Anchors items}
+ AnchorRootDest := FXMLDoc.Root.FindItem('anchors');
+ AnchorRootSource := TfrxPreviewPages(Report.PreviewPages).FXMLDoc.Root.FindItem('anchors');
+
+ for i := 0 to AnchorRootSource.Count - 1 do
+ begin
+ xi := AnchorRootSource[i];
+ with AnchorRootDest.Add do
+ begin
+ Name := 'item';
+ Text := xi.Text;
+ Prop['page'] := IntToStr(StrToInt(Prop['page']) + nPageOffset);
+ end;
+ end;
+
+ {copy outline items}
+ Report.PreviewPages.Outline.LevelRoot;
+ Outline.LevelRoot;
+ CopyOutline;
+ if Report.PreviewPages.Count <> 0 then
+ begin
+ Report.PreviewPages.CurPage := Report.PreviewPages.Count - 1;
+ FLastY := Report.PreviewPages.GetLastY;
+ Report.PreviewPages.CurPage := -1;
+ end;
+
+ xs.Free;
+ ClearPageCache;
+ ClearPageBitmapCache;
+end;
+
+procedure TfrxPreviewPages.DrawPageInternal(Index: Integer; Canvas: TCanvas;
+ ScaleX, ScaleY, OffsetX, OffsetY: Extended; WorkArea: TRectF);
+var
+ i, pCount: Integer;
+ Page: TfrxReportPage;
+ l: TList;
+ c: TfrxComponent;
+ IsPrinting: Boolean;
+ SaveLeftMargin, SaveRightMargin: Extended;
+ ObjectRect: TRectF;
+begin
+ Page := GetPage(Index);
+ if Page = nil then
+ Exit;
+
+ SaveLeftMargin := Page.LeftMargin;
+ SaveRightMargin := Page.RightMargin;
+ if Page.MirrorMargins and (Index mod 2 = 1) then
+ begin
+ Page.LeftMargin := SaveRightMargin;
+ Page.RightMargin := SaveLeftMargin;
+ end;
+
+ IsPrinting := THackCanvas(Canvas).FPrinter <> nil;
+ Page.IsPrinting := IsPrinting;
+ Page.Draw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+ OffsetX := OffsetX + Page.LeftMargin * fr01cm * ScaleX;
+ OffsetY := OffsetY + Page.TopMargin * fr01cm * ScaleY;
+
+ l := Page.AllObjects;
+ pCount := Count;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if (c is TfrxView) then
+ if not IsPrinting or TfrxView(c).Printable then
+ begin
+ c.IsPrinting := IsPrinting;
+ TfrxView(c).SetFastCanvas(FFastCanvas);
+ { needed for TOTALPAGES macro }
+ if c is TfrxCustomMemoView then
+ begin
+ c.IsPrinting := IsPrinting;
+ THackMemoView(c).FTotalPages := pCount;
+ THackMemoView(c).FCopyNo := FCopyNo;
+ THackMemoView(c).FPrintScale := FPrintScale;
+ end;
+ { draw the object }
+ if WorkArea.Width = 1 then
+ WorkArea.Right := WorkArea.Right + 1
+
+ else if WorkArea.Height = 1 then
+ WorkArea.Bottom := WorkArea.Bottom + 1;
+
+
+ TfrxView(c).GetVisibleRect(ObjectRect);
+
+ ObjectRect.Left := ObjectRect.Left * ScaleX + OffsetX;
+ ObjectRect.Top := ObjectRect.Top * ScaleY + OffsetY;
+
+ if ObjectRect.Left < WorkArea.Left then
+ ObjectRect.Left := WorkArea.Left;
+ if ObjectRect.Top < WorkArea.Top then
+ ObjectRect.Top := WorkArea.Top;
+
+ ObjectRect.Right := ObjectRect.Right * ScaleX + OffsetX;
+ ObjectRect.Bottom := ObjectRect.Bottom * ScaleY + OffsetY;
+ if ObjectRect.Right > WorkArea.Right then
+ ObjectRect.Right := WorkArea.Right - 1;
+ if ObjectRect.Bottom > WorkArea.Bottom then
+ ObjectRect.Bottom := WorkArea.Bottom - 1;
+
+ if WorkArea.Contains(PointF(ObjectRect.Left + 1, ObjectRect.Top + 1)) and
+ WorkArea.Contains(PointF(ObjectRect.Right - 1, ObjectRect.Top + 1)) and
+ WorkArea.Contains(PointF(ObjectRect.Left + 1, ObjectRect.Bottom - 1)) and
+ WorkArea.Contains(PointF(ObjectRect.Right - 1, ObjectRect.Bottom - 1))
+ { zero rect means we want to draw everything, print or export }
+ or ((WorkArea.Top = 0) and (WorkArea.Left = 0) and
+ (WorkArea.Right = 0) and (WorkArea.Bottom = 0)) then
+ begin
+ TfrxView(c).Draw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+ c.IsPrinting := False;
+ end;
+ end;
+
+ end;
+ Page.LeftMargin := SaveLeftMargin;
+ Page.RightMargin := SaveRightMargin;
+end;
+
+procedure TfrxPreviewPages.DrawPage(Index: Integer; Canvas: TCanvas;
+ ScaleX, ScaleY, OffsetX, OffsetY: Extended; WorkArea: TRectF);
+var
+ i: Integer;
+ Page: TfrxReportPage;
+ IsPrinting: Boolean;
+ Bitmap: TBitmap;
+begin
+ Bitmap := nil;
+ FFastCanvas := nil;
+ IsPrinting := THackCanvas(Canvas).FPrinter <> nil;
+{$IFDEF DELPHI25}
+ if (Report <> nil) and Assigned(FFastPrintCanvas) then
+ begin
+ FFastPrintCanvas.Canvas := Canvas;
+ FFastCanvas := FFastPrintCanvas;
+ end;
+{$ENDIF}
+ if IsPrinting or Engine.Running then
+ begin
+ DrawPageInternal(Index, Canvas, ScaleX, ScaleY, OffsetX, OffsetY, WorkArea);
+ Exit;
+ end;
+ if (Report <> nil) and (Report.Preview <> nil) then
+ FFastCanvas := Report.Preview.GetCanvas;
+
+ if FLastScale <> ScaleX then
+ begin
+ ClearPageBitmapCache;
+ FLastScale := ScaleX;
+ end;
+ i := FPageBitmapCache.IndexOf(IntToStr(Index));
+ if i <> -1 then
+ begin
+ Bitmap := TBitmap(FPageBitmapCache.Objects[i]);
+ FPageBitmapCache.Exchange(i, 0);
+ end
+ else
+ begin
+ Page := GetPage(Index);
+ if Page = nil then Exit;
+ if Report.PreviewOptions.PagesInPictureCache and
+ (Round(Page.Width * ScaleX) < Report.PreviewOptions.MaxPagePictureWidth)
+ and (Round(Page.Height * ScaleX) <
+ Report.PreviewOptions.MaxPagePictureHeight) then
+ begin
+ Bitmap := TBitmap.Create(Round(Page.Width * ScaleX),
+ Round(Page.Height * ScaleY));
+ Bitmap.Canvas.BeginScene;
+ try
+ Bitmap.Canvas.Clear(claWhite);
+ DrawPageInternal(Index, Bitmap.Canvas, ScaleX, ScaleY, 0, 0,
+ RectF(0, 0, 0, 0));
+ finally
+ Bitmap.Canvas.EndScene;
+ end;
+ { add this page to the pagecache }
+ FPageBitmapCache.InsertObject(0, IntToStr(Index), Bitmap);
+ i := FPageBitmapCache.Count;
+
+ { remove the least used item from the pagecache }
+ if (i > 1) and (i > Report.PreviewOptions.PagesInCache) then
+ begin
+ TBitmap(FPageBitmapCache.Objects[i - 1]).Free;
+ FPageBitmapCache.Delete(i - 1);
+ end;
+ end;
+ end;
+
+ if Bitmap <> nil then
+ Canvas.DrawBitmap(Bitmap, RectF(0, 0, Bitmap.Width, Bitmap.Height),
+ RectF(OffsetX, OffsetY, OffsetX + Bitmap.Width, OffsetY + Bitmap.Height), 1)
+ else
+ DrawPageInternal(Index, Canvas, ScaleX, ScaleY, OffsetX, OffsetY, WorkArea);
+end;
+
+function TfrxPreviewPages.Print: Boolean;
+var
+ MaxCount: Integer;
+ PagesPrinted, ACopyNo: Integer;
+ pgList: TStringList;
+ LastDuplexMode: TfrxDuplexMode;
+ LastPaperSize, LastPaperWidth, LastPaperHeight, LastBin: Integer;
+ LastOrientation: TPrinterOrientation;
+ DuplexMode: TfrxDuplexMode;
+ SavePrintOptions: TfrxPrintOptions;
+ SheetWidth, SheetHeight, SplicingLineSz: Extended;
+ NeedFinishDuplex: Boolean;
+
+
+ function GetPageIndex(Index: Integer): Integer;
+ var
+ pgIdx: Integer;
+ begin
+ Result := -1;
+ if pgList.Count > 0 then
+ begin
+ pgIdx := StrToInt(pgList[Index]) - 1;
+ if (pgIdx < 0) or (pgIdx > Count) then
+ Result := -1
+ else
+ Result := pgIdx;
+ end
+ else if (Index < Count) and (Index >= 0) then
+ Result := Index;
+ end;
+
+ function GetNextPage(var Index: Integer): TfrxReportPage;
+ var
+ pgIdx: Integer;
+ begin
+ Result := nil;
+ Inc(Index);
+ pgIdx := GetPageIndex(Index);
+ if (pgIdx <> -1) then
+ Result := GetPage(pgIdx);
+ end;
+
+ procedure SplitPage(a, b, c, d: Extended; var x, y: Integer; var NeedRotate: Boolean);
+ var
+ tempX, tempY: Integer;
+ tempC: Extended;
+
+ procedure TrySplit;
+ begin
+ if Abs(Trunc(a / c) * c - a) < 11 then
+ x := Round(a / c)
+ else
+ x := Trunc(a / c) + 1;
+
+ if Abs(Trunc(b / d) * d - b) < 11 then
+ y := Round(b / d)
+ else
+ y := Trunc(b / d) + 1;
+ end;
+
+ begin
+ NeedRotate := False;
+
+ TrySplit;
+
+ tempX := x;
+ tempY := y;
+
+ tempC := c;
+ c := d;
+ d := tempC;
+
+ TrySplit;
+
+ if x * y >= tempX * tempY then
+ begin
+ x := tempX;
+ y := tempY;
+ end
+ else
+ NeedRotate := True;
+ end;
+
+ procedure DoPrint;
+ var
+ i: Integer;
+ Printer: TfrxCustomPrinter;
+ PagePrinted: Boolean;
+ Page: TfrxReportPage;
+
+ function PrintSplittedPage(Index: Integer): Boolean;
+ var
+ Bin, ACopies, x, y, countX, countY: Integer;
+ pieceX, pieceY{, offsX, offsY}, marginX, marginY, printedX, printedY: Extended;
+ SplitAddX, SplitAddY: Extended;
+
+ orient: TPrinterOrientation;
+ NeedChangeOrientation: Boolean;
+ dup: TfrxDuplexMode;
+
+ procedure SwapXY(var sX, sY: Extended);
+ var
+ TempZ: Extended;
+ begin
+ TempZ := sX;
+ sX := sY;
+ sY := TempZ;
+ end;
+ begin
+ Result := True;
+ Index := GetPageIndex(Index);
+ // if (pgList.Count <> 0) and (pgList.IndexOf(IntToStr(Index + 1)) = -1) then Exit;
+ if (Index = -1) or (Index >= Count) then Exit;
+ if ((Report.PrintOptions.PrintPages = ppOdd) and ((Index + 1) mod 2 = 0)) or
+ ((Report.PrintOptions.PrintPages = ppEven) and ((Index + 1) mod 2 = 1)) then Exit;
+ if Report.Terminated then
+ begin
+ Printer.Abort;
+ Result := False;
+ Exit;
+ end;
+
+ Page := GetPage(Index);
+
+ if Report.PrintOptions.Collate then
+ begin
+ ACopies := 1;
+ FCopyNo := ACopyNo;
+ end
+ else
+ begin
+ ACopies := Report.PrintOptions.Copies;
+ FCopyNo := 1;
+ end;
+
+ if Assigned(Report.OnPrintPage) then
+ Report.OnPrintPage(Page, FCopyNo);
+
+ if Index = 0 then
+ Bin := Page.Bin else
+ Bin := Page.BinOtherPages;
+
+ SplitPage(Page.PaperWidth, Page.PaperHeight, SheetWidth, SheetHeight,
+ countX, countY, NeedChangeOrientation);
+
+ { add splicing offset and calculate countX, countY again }
+ SplitAddX := 0;
+ SplitAddY := 0;
+ if countX > 1 then
+ SplitAddX := SplicingLineSz + Printer.TopMargin + Printer.BottomMargin;
+ if countY > 1 then
+ SplitAddY := SplicingLineSz + Printer.LeftMargin + Printer.RightMargin;
+ if NeedChangeOrientation then
+ SwapXY(SplitAddX, SplitAddY);
+ SplitPage(Page.PaperWidth, Page.PaperHeight, SheetWidth - SplitAddX, SheetHeight - SplitAddY,
+ countX, countY, NeedChangeOrientation);
+
+
+ orient := poPortrait;
+ if NeedChangeOrientation then
+ orient := poLandscape;
+
+ dup := Page.Duplex;
+ if DuplexMode <> dmNone then
+ dup := DuplexMode;
+
+ if not PagePrinted or (orient <> LastOrientation) then
+ Printer.SetPrintParams(Report.PrintOptions.PrintOnSheet,
+ SheetWidth, SheetHeight, orient, Bin, Integer(dup) {+ 1}, ACopies);
+ if not PagePrinted then
+ Printer.BeginDoc;
+
+ if orient = poPortrait then
+ begin
+ pieceX := SheetWidth * (Printer.DPI.X / 25.4);
+ pieceY := SheetHeight * (Printer.DPI.Y / 25.4);
+ end
+ else
+ begin
+ pieceX := SheetHeight * (Printer.DPI.X / 25.4);
+ pieceY := SheetWidth * (Printer.DPI.Y / 25.4);
+ end;
+
+ //marginY := 0;
+ printedY := 0;
+// offsY := -Printer.TopMargin * Printer.DPI.Y / 25.4;
+
+ SplitAddY := 0;
+
+ for y := 1 to countY do
+ begin
+ //marginX := 0;
+ printedX := 0;
+// offsX := -Printer.LeftMargin * Printer.DPI.X / 25.4;
+ SplitAddX := 0;
+
+ for x := 1 to countX do
+ begin
+// todo
+(* SavedDCState := SaveDC(Printer.Canvas.Handle);
+ OldRgn := CreateRectRgn(0, 0, 10000, 10000);
+ GetClipRgn(Printer.Canvas.Handle, OldRgn);
+ OutRgn := CreateRectRgn(Round(SplitAddX + Printer.LeftMargin * Printer.DPI.X / 25.4),
+ Round(SplitAddY + Printer.TopMargin * Printer.DPI.Y / 25.4),
+ Round(Page.PaperWidth * fr01cm * Printer.DPI.X / frxDefPPI - Printer.RightMargin * Printer.DPI.X / 25.4) - 1,
+ Round(Page.PaperHeight * fr01cm * Printer.DPI.Y / frxDefPPI - Printer.BottomMargin * Printer.DPI.Y / 25.4) - 1);
+ SelectClipRgn(Printer.Canvas.Handle, OutRgn);
+ SetMetaRgn(Printer.Canvas.Handle);
+ try
+ Printer.BeginPage;
+ DrawPage(Index, Printer.Canvas, Printer.DPI.X / frxDefPPI, Printer.DPI.Y / frxDefPPI,
+ offsX, offsY);
+
+
+ Printer.EndPage;
+ finally
+ { restore regions }
+ SelectClipRgn(Printer.Canvas.Handle, OldRgn);
+ DeleteObject(OutRgn);
+ DeleteObject(OldRgn);
+ RestoreDC(Printer.Canvas.Handle, SavedDCState);
+ end;*)
+ SplitAddX := SplicingLineSz * Printer.DPI.X / 25.4;
+ marginX := Printer.LeftMargin * Printer.DPI.X / 25.4;
+ printedX := printedX + (pieceX - marginX - Printer.RightMargin * Printer.DPI.X / 25.4) -
+ SplitAddX;
+// offsX := -printedX;
+ end;
+ marginY := Printer.TopMargin * Printer.DPI.Y / 25.4;
+ SplitAddY := SplicingLineSz * Printer.DPI.Y / 25.4;
+ printedY := printedY + (pieceY - marginY - Printer.BottomMargin * Printer.DPI.Y / 25.4) -
+ SplitAddY;
+// offsY := -printedY;
+ end;
+
+ Report.InternalOnProgress(ptPrinting, Index + 1);
+
+ PagePrinted := True;
+ Inc(PagesPrinted);
+
+ LastOrientation := Page.Orientation;
+ ClearPageCache;
+ end;
+
+
+ function PrintPage(Index: Integer): Boolean;
+ var
+ Bin, ACopies: Integer;
+ dup: TfrxDuplexMode;
+ ZoomX, ZoomY: Extended;
+ begin
+ Result := True;
+ //if (pgList.Count <> 0) and (pgList.IndexOf(IntToStr(Index + 1)) = -1) then Exit;
+ Index := GetPageIndex(Index);
+ if (Index = -1) or (Index >= Count) then Exit;
+ if ((Report.PrintOptions.PrintPages = ppOdd) and ((Index + 1) mod 2 = 0)) or
+ ((Report.PrintOptions.PrintPages = ppEven) and ((Index + 1) mod 2 = 1)) then Exit;
+ if Report.Terminated then
+ begin
+ Printer.Abort;
+ Result := False;
+ Exit;
+ end;
+
+ Page := GetPage(Index);
+
+ if Report.PrintOptions.Collate then
+ begin
+ ACopies := 1;
+ FCopyNo := ACopyNo;
+ end
+ else
+ begin
+ ACopies := Report.PrintOptions.Copies;
+ FCopyNo := 1;
+ end;
+
+ if Assigned(Report.OnPrintPage) then
+ Report.OnPrintPage(Page, FCopyNo);
+
+ if Index = 0 then
+ Bin := Page.Bin else
+ Bin := Page.BinOtherPages;
+
+ dup := Page.Duplex;
+ if DuplexMode <> dmNone then
+ dup := DuplexMode;
+
+ if LastDuplexMode <> dup then
+ NeedFinishDuplex := False;
+ if dup in [dmVertical, dmHorizontal] then
+ NeedFinishDuplex := not NeedFinishDuplex;
+
+ if Report.PrintOptions.PrintMode = pmDefault then
+ begin
+ if (not PagePrinted) or
+ (LastPaperSize <> Page.PaperSize) or
+ (LastPaperWidth <> Round(Page.PaperWidth)) or
+ (LastPaperHeight <> Round(Page.PaperHeight)) or
+ (LastBin <> Bin) or
+ (LastOrientation <> Page.Orientation) or
+ (LastDuplexMode <> dup) then
+ Printer.SetPrintParams(Page.PaperSize, Page.PaperWidth, Page.PaperHeight,
+ Page.Orientation, Bin, Integer(dup) {+ 1}, ACopies);
+ end
+ else
+ if (not PagePrinted) or
+ (LastBin <> Bin) or
+ (LastOrientation <> Page.Orientation) or
+ (LastDuplexMode <> dup) then
+ begin
+ Printer.SetPrintParams(Report.PrintOptions.PrintOnSheet,
+ SheetWidth, SheetHeight, Page.Orientation, Bin, Integer(dup) {+ 1}, ACopies);
+ SheetWidth := frxPrinters.Printer.PaperWidth;
+ SheetHeight := frxPrinters.Printer.PaperHeight;
+ end;
+ if not PagePrinted then
+ Printer.BeginDoc;
+
+ Printer.BeginPage;
+
+ if Report.PrintOptions.PrintMode = pmDefault then
+ begin
+ ZoomX := 1;
+ ZoomY := 1;
+ end
+ else
+ begin
+ ZoomX := SheetWidth / Page.PaperWidth;
+ ZoomY := SheetHeight / Page.PaperHeight;
+ if ZoomY < ZoomX then
+ FPrintScale := ZoomY
+ else
+ FPrintScale := ZoomX;
+ end;
+
+ DrawPage(Index, Printer.Canvas, Printer.DPI.X / frxDefPPI * ZoomX, Printer.DPI.Y / frxDefPPI * ZoomY,
+ -Printer.LeftMargin * Printer.DPI.X / 25.4,
+ -Printer.TopMargin * Printer.DPI.Y / 25.4, RectF(0, 0, 0, 0));
+
+ Report.InternalOnProgress(ptPrinting, Index + 1);
+
+
+ Printer.EndPage;
+
+ PagePrinted := True;
+ Inc(PagesPrinted);
+
+ LastPaperSize := Page.PaperSize;
+ LastPaperWidth := Round(Page.PaperWidth);
+ LastPaperHeight := Round(Page.PaperHeight);
+ LastBin := Bin;
+ LastOrientation := Page.Orientation;
+ LastDuplexMode := dup;
+ ClearPageCache;
+ end;
+
+ procedure PrintPages;
+ var
+ i: Integer;
+ begin
+ PagesPrinted := 0;
+
+ if Report.PrintOptions.Reverse then
+ begin
+ for i := MaxCount - 1 downto 0 do
+ if not PrintPage(i) then
+ break;
+ end
+ else
+ for i := 0 to MaxCount - 1 do
+ if not PrintPage(i) then
+ break;
+ end;
+
+ procedure PrintSplittedPages;
+ var
+ i: Integer;
+ begin
+ PagesPrinted := 0;
+
+ if Report.PrintOptions.Reverse then
+ begin
+ for i := MaxCount - 1 downto 0 do
+ if not PrintSplittedPage(i) then
+ break;
+ end
+ else
+ for i := 0 to MaxCount - 1 do
+ if not PrintSplittedPage(i) then
+ break;
+ end;
+
+ procedure PrintJoinedPages;
+ var
+ Index, cp, x, y, countX, countY: Integer;
+ pieceX, pieceY, offsX, offsY: Extended;
+ orient: TPrinterOrientation;
+ NeedChangeOrientation: Boolean;
+ dup: TfrxDuplexMode;
+ begin
+ PagesPrinted := 0;
+ if Count = 0 then Exit;
+
+ { get the first page and calculate the join options }
+ Index := -1;
+ Page := GetNextPage(Index);
+
+ SplitPage(SheetWidth, SheetHeight, Page.PaperWidth, Page.PaperHeight,
+ countX, countY, NeedChangeOrientation);
+ orient := poPortrait;
+ if NeedChangeOrientation then
+ begin
+ orient := poLandscape;
+ x := countX;
+ countX := countY;
+ countY := x;
+ end;
+
+ { setup the printer }
+ dup := Page.Duplex;
+ if DuplexMode <> dmNone then
+ dup := DuplexMode;
+ Printer.SetPrintParams(Report.PrintOptions.PrintOnSheet,
+ SheetWidth, SheetHeight, orient, Page.Bin, Integer(dup) {+ 1}, 1);
+ PagePrinted := True;
+ Printer.BeginDoc;
+
+ { start the cycle }
+ pieceX := Page.PaperWidth * (Printer.DPI.X / 25.4);
+ pieceY := Page.PaperHeight * (Printer.DPI.Y / 25.4);
+
+ Index := -1;
+ while Index < MaxCount - 1 do
+ begin
+ cp := 1;
+ offsY := -Printer.TopMargin * Printer.DPI.Y / 25.4;
+ Printer.BeginPage;
+
+ for y := 1 to countY do
+ begin
+ offsX := -Printer.LeftMargin * Printer.DPI.X / 25.4;
+
+ for x := 1 to countX do
+ begin
+ { get the next page }
+ FCopyNo := cp;
+ if cp = 1 then
+ Page := GetNextPage(Index)
+ else
+ begin
+ ClearPageCache;
+ Page := GetPage(GetPageIndex(Index));
+ end;
+ Inc(cp);
+ if cp > Report.PrintOptions.Copies then
+ cp := 1;
+
+ if Page = nil then break;
+
+ DrawPage(GetPageIndex(Index), Printer.Canvas, Printer.DPI.X / frxDefPPI, Printer.DPI.Y / frxDefPPI,
+ offsX, offsY, RectF(0, 0, 0, 0));
+
+ offsX := offsX + pieceX;
+ end;
+
+ if Page = nil then break;
+ offsY := offsY + pieceY;
+ end;
+
+
+ Printer.EndPage;
+
+ Report.InternalOnProgress(ptPrinting, Index);
+ if Report.Terminated then
+ begin
+ Printer.Abort;
+ Exit;
+ end;
+
+ Inc(PagesPrinted);
+ ClearPageCache;
+ end;
+ end;
+
+ begin
+ Printer := frxPrinters.Printer;
+ Report.Terminated := False;
+ Report.InternalOnProgressStart(ptPrinting);
+
+ if Report.ReportOptions.Name <> '' then
+ Printer.Title := Report.ReportOptions.Name else
+ Printer.Title := Report.FileName;
+ if Report.PrintOptions.Copies <= 0 then
+ Report.PrintOptions.Copies := 1;
+
+ if pgList.Count = 0 then
+ MaxCount := Count
+ else
+ MaxCount := pgList.Count;
+
+
+ PagePrinted := False;
+ LastDuplexMode := dmNone;
+ NeedFinishDuplex := False;
+
+ if Report.PrintOptions.Collate then
+ for i := 0 to Report.PrintOptions.Copies - 1 do
+ begin
+ ACopyNo := i + 1;
+ case Report.PrintOptions.PrintMode of
+ pmDefault, pmScale:
+ PrintPages;
+ pmSplit:
+ PrintSplittedPages;
+ pmJoin:
+ PrintJoinedPages;
+ end;
+ if NeedFinishDuplex then
+ begin
+ Printer.BeginPage;
+ Printer.EndPage;
+ end;
+
+ if Report.Terminated then break;
+ end
+ else
+ begin
+ case Report.PrintOptions.PrintMode of
+ pmDefault, pmScale:
+ PrintPages;
+ pmSplit:
+ PrintSplittedPages;
+ pmJoin:
+ PrintJoinedPages;
+ end;
+ end;
+
+ if PagePrinted then
+ Printer.EndDoc;
+ Report.InternalOnProgressStop(ptPrinting);
+ end;
+
+begin
+ Result := True;
+ if not frxPrinters.HasPhysicalPrinters then
+ begin
+ frxErrorMsg(frxResources.Get('clNoPrinters'));
+ Result := False;
+ Exit;
+ end;
+
+ FPrintScale := 1;
+
+ if Report.DotMatrixReport and (frxDotMatrixExport <> nil) then
+ begin
+ Report.SelectPrinter;
+ frxDotMatrixExport.ShowDialog := Report.PrintOptions.ShowDialog;
+ frxDotMatrixExport.PageNumbers := Report.PrintOptions.PageNumbers;
+ Result := Export(frxDotMatrixExport);
+ Exit;
+ end;
+
+ SavePrintOptions := TfrxPrintOptions.Create;
+ SavePrintOptions.Assign(Report.PrintOptions);
+ DuplexMode := Report.PrintOptions.Duplex;
+ Report.SelectPrinter;
+{$IFDEF MACOS}
+ if Report.PrintOptions.ShowDialog then
+ with TPrintDialog.Create(nil) do
+ begin
+ if not Execute then
+ begin
+ Free;
+ FCopyNo := 0;
+ Result := False;
+ SavePrintOptions.Free;
+ if Report.PreviewForm is TfrxForm then
+ TfrxForm(Report.PreviewForm).PeekLastModalResult;
+ Exit;
+ end;
+ if PrintRange = TPrintRange.prPageNums then
+ Report.PrintOptions.PageNumbers := IntToStr(FromPage) + '-' + IntToStr(ToPage);
+ Free;
+ end;
+ if Report.PreviewForm is TfrxForm then
+ TfrxForm(Report.PreviewForm).PeekLastModalResult;
+
+
+{$ELSE}
+// todo
+ if Report.PrintOptions.ShowDialog then
+ with TfrxPrintDialog.Create(nil) do
+ begin
+ AReport := Report;
+ ADuplexMode := DuplexMode;
+ FormShow(nil);
+ ShowModal;
+ if ModalResult = mrOk then
+ begin
+ DuplexMode := ADuplexMode;
+ Report.PrintOptions.Duplex := DuplexMode;
+ Free;
+ end
+ else
+ begin
+ Free;
+ FCopyNo := 0;
+ Result := False;
+ SavePrintOptions.Free;
+ Exit;
+ end;
+ end;
+{$ENDIF}
+
+ if Report.PrintOptions.PrnOutFileName <> '' then
+ frxPrinters.Printer.FileName := Report.PrintOptions.PrnOutFileName;
+
+ if Report.PrintOptions.PrintMode <> pmDefault then
+ begin
+ if Report.PrintOptions.PrintOnSheet <> 256 then
+ frxPrinters.Printer.SetViewParams(Report.PrintOptions.PrintOnSheet, 0, 0, poPortrait)
+ else
+ frxPrinters.Printer.SetViewParams(Report.PrintOptions.PrintOnSheet, frxPrinters.Printer.PaperWidth,
+ frxPrinters.Printer.PaperHeight, poPortrait);
+
+ SheetWidth := frxPrinters.Printer.PaperWidth;
+ SheetHeight := frxPrinters.Printer.PaperHeight;
+ SplicingLineSz := Report.PrintOptions.SplicingLine;
+ end;
+
+ if Assigned(Report.OnPrintReport) then
+ Report.OnPrintReport(Report);
+ Report.DoNotifyEvent(Report, Report.OnReportPrint, not Report.EngineOptions.DestroyForms);
+
+ if Report.Preview <> nil then
+ begin
+// todo?
+// Report.Preview.Lock;
+// Report.Preview.Refresh;
+ end;
+ pgList := TStringList.Create;
+{$IFDEF MSWINDOWS}
+ if frxCanvasClass <> nil then
+ FFastPrintCanvas := frxCanvasClass.Create;
+{$ENDIF}
+ try
+ if frxPrinters.Printer.Initialized then
+ begin
+ frxParsePageNumbers(Report.PrintOptions.PageNumbers, pgList, Count);
+ ClearPageCache;
+ DoPrint;
+ end
+ else frxErrorMsg('Printer selected is not valid');
+ finally
+ if Assigned(Report.OnAfterPrintReport) then
+ Report.OnAfterPrintReport(Report);
+ FCopyNo := 0;
+ Report.PrintOptions.Assign(SavePrintOptions);
+ SavePrintOptions.Free;
+ pgList.Free;
+{$IFDEF MSWINDOWS}
+ if Assigned(FFastPrintCanvas) then
+ FreeAndNil(FFastPrintCanvas);
+{$ENDIF}
+ end;
+end;
+
+function TfrxPreviewPages.Export(Filter: TfrxCustomExportFilter): Boolean;
+var
+ pgList: TStringList;
+ tempBMP: TBitmap;
+
+ procedure ExportPage(Index: Integer);
+ var
+ i, j: Integer;
+ Page: TfrxReportPage;
+ c: TfrxComponent;
+ p: TfrxPictureView;
+
+
+ procedure ExportObject(c: TfrxComponent);
+ begin
+ if Filter.DataOnly and not (c.Parent is TfrxDataBand) then
+ Exit;
+
+ if c is TfrxCustomMemoView then
+ begin
+ { set up font if Highlight is active }
+ if TfrxCustomMemoView(c).Highlight.Active then
+ TfrxCustomMemoView(c).Font.Assign(TfrxCustomMemoView(c).Highlight.Font);
+ { needed for TOTALPAGES, COPYNAME macros }
+ THackMemoView(c).FTotalPages := Count;
+ THackMemoView(c).FCopyNo := 1;
+ THackMemoView(c).ExtractMacros;
+ { needed if memo has AutoWidth and Align properties }
+ if THackMemoView(c).AutoWidth then
+ begin
+ tempBMP.Canvas.BeginScene;
+ try
+ THackMemoView(c).Draw(tempBMP.Canvas, 1, 1, 0, 0);
+ finally
+ tempBMP.Canvas.EndScene;
+ end;
+ end;
+ end;
+
+ if c is TfrxView then
+ begin
+ if Assigned(FFastPrintCanvas) then
+ TfrxView(c).SetFastCanvas(FFastPrintCanvas)
+ else
+ TfrxView(c).SetFastCanvas(nil);
+ end;
+ Filter.ExportObject(c);
+ if c is TfrxView then
+ TfrxView(c).SetFastCanvas(nil);
+ if Report.Terminated then
+ raise EExportTerminated.Create;
+ end;
+
+ begin
+ if Index >= Count then Exit;
+ if (pgList.Count <> 0) and (pgList.IndexOf(IntToStr(Index + 1)) = -1) then Exit;
+ Page := GetPage(Index);
+ if Page = nil then Exit;
+
+ if Filter.ShowProgress then
+ Report.InternalOnProgress(ptExporting, Index + 1);
+
+ Filter.StartPage(Page, Index);
+ try
+ { set the offset of the page objects }
+ if Page.MirrorMargins and (Index mod 2 = 1) then
+ Page.Left := Page.RightMargin * fr01cm else
+ Page.Left := Page.LeftMargin * fr01cm;
+ Page.Top := Page.TopMargin * fr01cm;
+
+ { export the page background picture and frame }
+ p := TfrxPictureView.Create(nil);
+ p.Name := '_pagebackground';
+ p.Color := Page.Color;
+ p.Frame.Assign(Page.Frame);
+ p.Picture.Assign(Page.BackPicture);
+ p.Stretched := True;
+ p.KeepAspectRatio := False;
+ try
+ p.SetBounds(Page.Left, Page.Top,
+ Page.Width - (Page.LeftMargin + Page.RightMargin) * fr01cm,
+ Page.Height - (Page.TopMargin + Page.BottomMargin) * fr01cm);
+ ExportObject(p);
+ finally
+ p.Free;
+ end;
+
+
+ for i := 0 to Page.Objects.Count - 1 do
+ begin
+ c := Page.Objects[i];
+ if c is TfrxBand then
+ begin
+ if c is TfrxPageHeader then
+ begin
+ { suppress a header }
+ if Filter.SuppressPageHeadersFooters and (Index <> 0) then continue;
+ end;
+ if c is TfrxPageFooter then
+ begin
+ { suppress a footer }
+ if Filter.SuppressPageHeadersFooters and (Index <> Count - 1) then continue;
+ end;
+ end;
+ ExportObject(c);
+ if c.Objects.Count <> 0 then
+ for j := 0 to c.Objects.Count - 1 do
+ ExportObject(c.Objects[j]);
+ end;
+
+ finally
+ Filter.FinishPage(Page, Index);
+ end;
+
+ if Report.Preview = nil then
+ ClearPageCache
+ else
+ begin
+ Page.Left := 0;
+ Page.Top := 0;
+ end;
+ end;
+
+ procedure DoExport;
+ var
+ i: Integer;
+ {$IFDEF DBGLOG}
+ Time: Cardinal;
+ {$ENDIF}
+ begin
+ if Assigned(Filter.OnBeginExport) then
+ Filter.OnBeginExport(Filter);
+
+ {$IFDEF DBGLOG}
+ Time := GetTickCount;
+ {$ENDIF}
+
+ if Filter.Start then
+ try
+ if Report.Preview <> nil then
+ begin
+ Report.Preview.Lock;
+ Report.Preview.Repaint;
+ end;
+
+ if Filter.ShowProgress then
+ Report.InternalOnProgressStart(ptExporting);
+
+
+ for i := 0 to Count - 1 do
+
+ begin
+ ExportPage(i);
+ end;
+
+ finally
+ if Report.Preview <> nil then
+ begin
+// todo
+// TfrxPreview(Report.Preview).HideMessage;
+// Report.Preview.Refresh;
+ end;
+
+ if Filter.ShowProgress then
+ Report.InternalOnProgressStop(ptExporting);
+
+ Filter.Finish;
+ end;
+
+ {$IFDEF DBGLOG}
+ Time := GetTickCount - Time;
+
+ DbgPrintTitle('Exporting Results');
+ DbgPrint('Filter: %s'#10, [Filter.ClassName]);
+ DbgPrint('Duration: %d ms'#10, [Time]);
+
+ if (Report <> nil) and (Report.FileName <> '') then
+ DbgPrint('Input: %s'#10, [Report.FileName]);
+
+ with Filter do
+ if Stream <> nil then
+ begin
+ DbgPrint('Output: %s'#10, [Stream.ClassName]);
+ DbgPrint('SHA1(Output): %s'#10, [HashStream('SHA1', Stream)]);
+ DbgPrint('Output size: %d'#10, [Stream.Size]);
+ end
+ else
+ begin
+ DbgPrint('Output: %s'#10, [FileName]);
+ DbgPrint('SHA1(Output): %s'#10, [HashFile('SHA1', FileName)]);
+
+ with TFileStream.Create(FileName, 0) do
+ try
+ DbgPrint('Output size: %d'#10, [Size]);
+ finally
+ Free;
+ end;
+ end;
+ {$ENDIF}
+ end;
+
+begin
+ Result := False;
+ FCopyNo := 0;
+
+ if Filter = nil then
+ Exit;
+
+ {$IFNDEF STATIC_EXPORTING_RESULTS}
+ Filter.CreationTime := Now;
+ {$ENDIF}
+
+ Filter.Report := Report;
+ if (Filter.ShowDialog and (Filter.ShowModal <> mrOk)) then
+ Exit;
+ if Filter.CurPage then
+ if Report.Preview <> nil then
+ Filter.PageNumbers := IntToStr(CurPreviewPage) else
+ Filter.PageNumbers := '1';
+
+ Result := True;
+ Report.Terminated := False;
+
+ pgList := TStringList.Create;
+ tempBMP := TBitmap.Create(1, 1);
+{$IFDEF DELPHI25}
+{$IFDEF MSWINDOWS}
+ if frxCanvasClass <> nil then
+ FFastPrintCanvas := frxCanvasClass.Create;
+{$ENDIF}
+{$ENDIF}
+ try
+ frxParsePageNumbers(Filter.PageNumbers, pgList, Count);
+
+ if Filter = frxDotMatrixExport then
+ if Assigned(Report.OnPrintReport) then
+ Report.OnPrintReport(Report);
+
+ try
+ DoExport;
+ except
+ on EExportTerminated do
+ {do nothing};
+ on e: Exception do
+ begin
+ Result := False;
+ Report.Errors.Text := e.Message;
+ frxCommonErrorHandler(Report, frxResources.Get('clErrors') + #13#10 + Report.Errors.Text);
+ end;
+ end;
+
+ if Filter = frxDotMatrixExport then
+ if Assigned(Report.OnAfterPrintReport) then
+ Report.OnAfterPrintReport(Report);
+ finally
+ pgList.Free;
+ tempBMP.Free;
+{$IFDEF MSWINDOWS}
+{$IFDEF DELPHI25}
+ if Assigned(FFastPrintCanvas) then
+ FreeAndNil(FFastPrintCanvas);
+{$ENDIF}
+{$ENDIF}
+ end;
+end;
+
+procedure TfrxPreviewPages.ObjectOver(Index: Integer; X, Y: Integer;
+ Button: TMouseButton; Shift: TShiftState; Scale, OffsetX, OffsetY: Extended;
+ Click: Boolean; var Cursor: TCursor; DBClick: Boolean);
+var
+ Page: TfrxReportPage;
+ c: TfrxComponent;
+ l: TList;
+ i: Integer;
+ Flag: Boolean;
+ v: TfrxView;
+ drill: TfrxGroupHeader;
+ aRect: TRectF;
+
+ function MouseInView(c: TfrxComponent): Boolean;
+ var
+ r: TRect;
+ begin
+ with c do
+ r := Rect(Round(AbsLeft * Scale), Round(AbsTop * Scale),
+ Round((AbsLeft + Width) * Scale),
+ Round((AbsTop + Height) * Scale));
+ OffsetRect(r, Round(OffsetX), Round(OffsetY));
+ Result := PtInRect(r, Point(X, Y));
+ end;
+
+ procedure SetToAnchor(const Text: String);
+ var
+ Item: TfrxXMLItem;
+ PageN, Top: Integer;
+ begin
+ Item := FindAnchor(Text);
+ if Item <> nil then
+ begin
+ PageN := StrToInt(String(Item.Prop['page']));
+ Top := StrToInt(String(Item.Prop['top']));
+ TfrxPreview(Report.Preview).SetPosition(PageN + 1, Top);
+ end;
+ end;
+
+begin
+ if (Index < 0) or (Index >= Count) or Engine.Running then Exit;
+ Page := GetPage(Index);
+ if Page = nil then Exit;
+
+ if Page.MirrorMargins and (Index mod 2 = 1) then
+ OffsetX := OffsetX + Page.RightMargin * fr01cm * Scale else
+ OffsetX := OffsetX + Page.LeftMargin * fr01cm * Scale;
+ OffsetY := OffsetY + Page.TopMargin * fr01cm * Scale;
+
+ Report.SetProgressMessage('');
+ Report.SetProgressMessage('', True);
+ Page := GetPage(Index); // get page again to ensure it was not cleared during export
+ if Page = nil then Exit;
+
+ drill := nil;
+ l := Page.AllObjects;
+
+ for i := l.Count - 1 downto 0 do
+ begin
+ c := l[i];
+ if (c is TfrxGroupHeader) and MouseInView(c) then
+ if TfrxGroupHeader(c).DrillDown then
+ begin
+ drill := TfrxGroupHeader(c);
+ //break;
+ end;
+
+ if (c is TfrxView) and MouseInView(c) then
+ begin
+ v := TfrxView(c);
+ if (v.Parent is TfrxGroupHeader) and TfrxGroupHeader(v.Parent).DrillDown then
+ begin
+ drill := TfrxGroupHeader(v.Parent);
+ //break;
+ end;
+ if v.Cursor <> crDefault then
+ Cursor := v.Cursor;
+ if v.URL <> '' then
+ begin
+ Report.SetProgressMessage(v.URL);
+ if v.Cursor = crDefault then
+ Cursor := crHandPoint;
+ end;
+ if (v.Hint <> '') and (v.ShowHint) and (Report.Preview.UseReportHints) then
+ begin
+ Report.SetProgressMessage(GetLongHint(v.Hint), True);
+ with v do
+ aRect := RectF(Round(AbsLeft * Scale), Round(AbsTop * Scale),
+ Round((AbsLeft + Width) * Scale),
+ Round((AbsTop + Height) * Scale));
+ OffsetRect(aRect, Round(OffsetX), Round(OffsetY));
+ Report.Preview.ShowHint(aRect, GetShortHint(v.Hint));
+ v.HintIsActive := True;
+ //GetShortHint(v.Hint);
+ //Report.Preview.ShowHint := True;}
+ end;
+
+ if Click and (drill = nil) then
+ begin
+ if v.URL <> '' then
+ if Pos('@', v.URL) = 1 then
+ TfrxPreview(Report.Preview).PageNo := StrToInt(Copy(v.URL, 2, 255))
+ else if Pos('#', v.URL) = 1 then
+ SetToAnchor(Copy(v.URL, 2, 255))
+ else
+{$IFDEF MSWINDOWS}
+ ShellExecute(0, 'open', PChar(v.URL), '', '', 1);
+{$ENDIF}
+{$IFDEF LINUX}
+ FmuxOpenUrl(PChar(v.URL));
+{$ENDIF}
+{$IFDEF MACOS}
+ _system(PAnsiChar('open ' + AnsiString(v.URL)));
+{$ENDIF}
+ Flag := False;
+ if DBClick then
+ Report.DoPreviewClick(v, Button, Shift, Flag, True)
+ else
+ Report.DoPreviewClick(v, Button, Shift, Flag);
+ if Flag then
+ begin
+ ModifyPage(Index, Page);
+ Report.Preview.ClearBackBuffer;
+ Report.Preview.Repaint;
+ end;
+ end
+ else if Assigned(Report.OnMouseOverObject) then
+ Report.OnMouseOverObject(v);
+ break;
+ end
+ else if c is TfrxView then
+ begin
+ if (TfrxView(c).ShowHint) and (TfrxView(c).HintIsActive) and (Report.Preview <> nil) and (Report.Preview.UseReportHints) then
+ begin
+ Report.Preview.HideHint;
+ TfrxView(c).HintIsActive := False;
+ end;
+ end;
+ end;
+
+ if drill <> nil then
+ begin
+ Cursor := crHandPoint;
+ if Click and (Button = mbLeft) then
+ begin
+ if Report.DrillState.IndexOf(drill.DrillName) = -1 then
+ Report.DrillState.Add(drill.DrillName)
+ else
+ Report.DrillState.Delete(Report.DrillState.IndexOf(drill.DrillName));
+ Report.Preview.RefreshReport;
+ end;
+ end;
+end;
+
+end.
diff --git a/LibD28/FMX.frxPrintDialog.fmx b/LibD28/FMX.frxPrintDialog.fmx
new file mode 100644
index 0000000..6dc1590
--- /dev/null
+++ b/LibD28/FMX.frxPrintDialog.fmx
@@ -0,0 +1,257 @@
+object frxPrintDialog: TfrxPrintDialog
+ Left = 0
+ Top = 0
+ Caption = 'Print'
+ ClientHeight = 333
+ ClientWidth = 557
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnActivate = FormShow
+ OnDeactivate = FormHide
+ StyleLookup = 'backgroundstyle'
+ object OkB: TButton
+ Position.Point = '(398,304)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 40
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(478,304)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 50
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object Label12: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 549.000000000000000000
+ Height = 73.000000000000000000
+ TabOrder = 2
+ object WhereL: TLabel
+ Position.Point = '(8,48)'
+ Width = 81.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object WhereL1: TLabel
+ Position.Point = '(60,48)'
+ Width = 43.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object NameL: TLabel
+ Position.Point = '(8,20)'
+ Width = 49.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 2
+ end
+ object PrintersCB: TComboBox
+ Position.Point = '(60,16)'
+ Width = 329.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = PrintersCBClick
+ HelpContext = 142
+ TabOrder = 3
+ ItemIndex = -1
+ ItemHeight = 16.000000000000000000
+ OnChange = PrintersCBClick
+ end
+ object PropButton: TButton
+ Position.Point = '(444,16)'
+ Width = 95.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = PropButtonClick
+ HelpContext = 152
+ TabOrder = 4
+ end
+ object FileCB: TCheckBox
+ Position.Point = '(408,48)'
+ Width = 129.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 5
+ end
+ end
+ object Label1: TGroupBox
+ Position.Point = '(4,80)'
+ Width = 261.000000000000000000
+ Height = 117.000000000000000000
+ TabOrder = 3
+ object DescrL: TLabel
+ Position.Point = '(8,82)'
+ Width = 249.000000000000000000
+ Height = 29.000000000000000000
+ TabOrder = 0
+ end
+ object AllRB: TRadioButton
+ Position.Point = '(8,20)'
+ Width = 125.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 108
+ TabOrder = 1
+ IsChecked = True
+ end
+ object CurPageRB: TRadioButton
+ Position.Point = '(8,40)'
+ Width = 125.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 118
+ TabOrder = 2
+ end
+ object PageNumbersRB: TRadioButton
+ Position.Point = '(8,60)'
+ Width = 77.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = PageNumbersRBClick
+ HelpContext = 124
+ TabOrder = 3
+ end
+ object PageNumbersE: TEdit
+ Position.Point = '(84,58)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ OnEnter = PageNumbersEEnter
+ HelpContext = 133
+ TabOrder = 4
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+ object Label2: TGroupBox
+ Position.Point = '(272,80)'
+ Width = 281.000000000000000000
+ Height = 117.000000000000000000
+ TabOrder = 4
+ object CopiesL: TLabel
+ Position.Point = '(12,20)'
+ Width = 125.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object CollateImg: TImage
+ Position.Point = '(20,48)'
+ Width = 74.000000000000000000
+ Height = 53.000000000000000000
+ Visible = False
+ end
+ object NonCollateImg: TImage
+ Position.Point = '(12,56)'
+ Width = 92.000000000000000000
+ Height = 40.000000000000000000
+ Visible = False
+ end
+ object CopiesPB: TPaintBox
+ Position.Point = '(12,48)'
+ Width = 92.000000000000000000
+ Height = 53.000000000000000000
+ end
+ object CopiesE: TEdit
+ Position.Point = '(140,16)'
+ Width = 113.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 99
+ TabOrder = 4
+ KeyboardType = vktDefault
+ Password = False
+ Text = '1'
+ end
+ object CollateCB: TCheckBox
+ Position.Point = '(140,58)'
+ Width = 133.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = CollateCBClick
+ HelpContext = 188
+ TabOrder = 5
+ end
+ end
+ object ScaleGB: TGroupBox
+ Position.Point = '(272,200)'
+ Width = 281.000000000000000000
+ Height = 97.000000000000000000
+ TabOrder = 5
+ object PagSizeL: TLabel
+ Position.Point = '(12,68)'
+ Width = 125.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object PagPageSizeCB: TComboBox
+ Enabled = False
+ Position.Point = '(140,64)'
+ Width = 129.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 1
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ end
+ object PrintModeCB: TComboBox
+ Enabled = False
+ Position.Point = '(12,16)'
+ Width = 257.000000000000000000
+ Height = 40.000000000000000000
+ OnClick = PrintModeCBClick
+ TabOrder = 2
+ ItemIndex = -1
+ ItemHeight = 34.000000000000000000
+ end
+ end
+ object OtherGB: TGroupBox
+ Position.Point = '(4,200)'
+ Width = 261.000000000000000000
+ Height = 97.000000000000000000
+ TabOrder = 6
+ object PrintL: TLabel
+ Position.Point = '(8,20)'
+ Width = 73.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object DuplexL: TLabel
+ Position.Point = '(8,68)'
+ Width = 73.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object OrderL: TLabel
+ Position.Point = '(8,44)'
+ Width = 73.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 2
+ end
+ object PrintPagesCB: TComboBox
+ Position.Point = '(84,16)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 196
+ TabOrder = 3
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ end
+ object DuplexCB: TComboBox
+ Position.Point = '(84,64)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 4
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ end
+ object OrderCB: TComboBox
+ Position.Point = '(84,40)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 5
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ end
+ end
+ object FileDlg: TSaveDialog
+ Filter = 'Printer files (*.prn)|*.prn'
+ Title = 'Print To File'
+ end
+end
diff --git a/LibD28/FMX.frxPrintDialog.pas b/LibD28/FMX.frxPrintDialog.pas
new file mode 100644
index 0000000..378103e
--- /dev/null
+++ b/LibD28/FMX.frxPrintDialog.pas
@@ -0,0 +1,365 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Print dialog }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxPrintDialog;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.SysUtils, System.Variants, System.UITypes,
+ FMX.Objects, FMX.Types, FMX.Controls, FMX.Forms, FMX.ListBox, FMX.Dialogs, FMX.Edit,
+ FMX.frxCtrls, FMX.frxClass
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+type
+ TfrxPrintDialog = class(TForm)
+ OkB: TButton;
+ CancelB: TButton;
+ FileDlg: TSaveDialog;
+ Label12: TGroupBox;
+ WhereL: TLabel;
+ WhereL1: TLabel;
+ PrintersCB: TComboBox;
+ PropButton: TButton;
+ FileCB: TCheckBox;
+ Label1: TGroupBox;
+ DescrL: TLabel;
+ AllRB: TRadioButton;
+ CurPageRB: TRadioButton;
+ PageNumbersRB: TRadioButton;
+ PageNumbersE: TEdit;
+ Label2: TGroupBox;
+ CopiesL: TLabel;
+ CollateImg: TImage;
+ NonCollateImg: TImage;
+ CopiesPB: TPaintBox;
+ CopiesE: TEdit;
+ CollateCB: TCheckBox;
+ //UpDown1: TUpDown;
+ ScaleGB: TGroupBox;
+ PagPageSizeCB: TComboBox;
+ NameL: TLabel;
+ PagSizeL: TLabel;
+ PrintModeCB: TComboBox;
+ //PrintModeIL: TfrxImageList;
+ OtherGB: TGroupBox;
+ PrintL: TLabel;
+ DuplexL: TLabel;
+ PrintPagesCB: TComboBox;
+ DuplexCB: TComboBox;
+ OrderL: TLabel;
+ OrderCB: TComboBox;
+ {procedure PrintersCBDrawItem(Control: TWinControl; Index: Integer;
+ ARect: TRect; State: TOwnerDrawState); }
+ procedure FormCreate(Sender: TObject);
+ procedure PropButtonClick(Sender: TObject);
+ procedure PrintersCBClick(Sender: TObject);
+ procedure PageNumbersRBClick(Sender: TObject);
+ procedure CollateLClick(Sender: TObject);
+ procedure CollateCBClick(Sender: TObject);
+ {procedure CopiesPBPaint(Sender: TObject); }
+ procedure PageNumbersEEnter(Sender: TObject);
+ procedure FormHide(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+ {procedure PrintModeCBDrawItem(Control: TWinControl; Index: Integer;
+ ARect: TRect; State: TOwnerDrawState);}
+ procedure FormShow(Sender: TObject);
+ procedure PrintModeCBClick(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ { Private declarations }
+ OldIndex: Integer;
+ public
+ { Public declarations }
+ AReport: TfrxReport;
+ ADuplexMode: TfrxDuplexMode;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses
+ FMX.frxPrinter, FMX.frxUtils, FMX.frxRes, FMX.FrxFmx;
+
+
+procedure TfrxPrintDialog.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+ FormHide(Sender);
+end;
+
+procedure TfrxPrintDialog.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(200);
+ Label12.Text := frxGet(201);
+ DescrL.Text := frxGet(9);
+ Label1.Text := frxGet(202);
+ CopiesL.Text := frxGet(203);
+ CollateCB.Text := frxGet(204);
+ Label2.Text := frxGet(205);
+ PrintL.Text := frxGet(206);
+ WhereL.Text := frxGet(208);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ PropButton.Text := frxGet(209);
+ AllRB.Text := frxGet(3);
+ CurPageRB.Text := frxGet(4);
+ PageNumbersRB.Text := frxGet(5);
+ FileCB.Text := frxGet(210);
+ NameL.Text := frxGet(212);
+ ScaleGB.Text := frxGet(213);
+ PagSizeL.Text := frxGet(214);
+ DuplexL.Text := frxGet(216);
+ OtherGB.Text := frxGet(207);
+ OrderL.Text := frxGet(211);
+ FileDlg.Title := frxGet(507);
+ FileDlg.Filter := frxGet(510);
+
+{$IFDEF DELPHI23}
+ OrderCB.Clear;
+{$ELSE}
+ OrderCB.Items.Clear;
+{$ENDIF}
+ OrderCB.Items.Add(frxResources.Get('poDirect'));
+ OrderCB.Items.Add(frxResources.Get('poReverse'));
+
+{$IFDEF DELPHI23}
+ PrintPagesCB.Clear;
+{$ELSE}
+ PrintPagesCB.Items.Clear;
+{$ENDIF}
+ PrintPagesCB.Items.Add(frxResources.Get('ppAll'));
+ PrintPagesCB.Items.Add(frxResources.Get('ppOdd'));
+ PrintPagesCB.Items.Add(frxResources.Get('ppEven'));
+ PrintPagesCB.ItemIndex := 0;
+
+
+{$IFDEF DELPHI23}
+ DuplexCB.Clear;
+{$ELSE}
+ DuplexCB.Items.Clear;
+{$ENDIF}
+ DuplexCB.Items.Add(frxResources.Get('dupDefault'));
+ DuplexCB.Items.Add(frxResources.Get('dupVert'));
+ DuplexCB.Items.Add(frxResources.Get('dupHorz'));
+ DuplexCB.Items.Add(frxResources.Get('dupSimpl'));
+ DuplexCB.ItemIndex := 0;
+
+{$IFDEF DELPHI23}
+ PrintModeCB.Clear;
+{$ELSE}
+ PrintModeCB.Items.Clear;
+{$ENDIF}
+ PrintModeCB.Items.Add(frxResources.Get('pmDefault'));
+ PrintModeCB.Items.Add(frxResources.Get('pmSplit'));
+ PrintModeCB.Items.Add(frxResources.Get('pmJoin'));
+ PrintModeCB.Items.Add(frxResources.Get('pmScale'));
+
+ //SetWindowLong(CopiesE.Handle, GWL_STYLE, GetWindowLong(CopiesE.Handle, GWL_STYLE) or ES_NUMBER);
+
+ //if Screen.PixelsPerInch > 96 then
+ // PrintersCB.ItemHeight := 19;
+ PrintersCB.Items.Assign(frxPrinters.Printers);
+ PrintersCB.ItemIndex := frxPrinters.PrinterIndex;
+ PrintersCBClick(nil);
+
+ OldIndex := frxPrinters.PrinterIndex;
+ CollateCBClick(nil);
+{$IFDEF LINUX}
+ FileCB.Enabled := False;
+{$ENDIF}
+ // if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxPrintDialog.FormShow(Sender: TObject);
+begin
+ //UpDown1.Position := AReport.PrintOptions.Copies;
+ CollateCB.IsChecked := AReport.PrintOptions.Collate;
+ PageNumbersE.Text := AReport.PrintOptions.PageNumbers;
+ if AReport.PrintOptions.PageNumbers <> '' then
+ PageNumbersRB.IsChecked := True;
+ PrintPagesCB.ItemIndex := Integer(AReport.PrintOptions.PrintPages);
+ if AReport.PrintOptions.Reverse then
+ OrderCB.ItemIndex := 1
+ else
+ OrderCB.ItemIndex := 0;
+
+ PrintModeCB.ItemIndex := Integer(AReport.PrintOptions.PrintMode);
+ DuplexCB.ItemIndex := Integer(ADuplexMode);
+ PrintModeCBClick(nil);
+ if AReport.PrintOptions.PrintMode <> pmDefault then
+ begin
+ PagPageSizeCB.ItemIndex := frxPrinters.Printer.PaperIndex(AReport.PrintOptions.PrintOnSheet) + 1;
+ if frxPrinters.Printer.PaperIndex(256) < frxPrinters.Printer.PaperIndex(AReport.PrintOptions.PrintOnSheet) then
+ PagPageSizeCB.ItemIndex := PagPageSizeCB.ItemIndex - 1;
+ end;
+end;
+
+procedure TfrxPrintDialog.FormHide(Sender: TObject);
+begin
+ if ModalResult <> mrOk then
+ frxPrinters.PrinterIndex := OldIndex
+ else
+ begin
+ frxPrinters.Printer.FileName := '';
+ if FileCB.IsChecked then
+ if FileDlg.Execute then
+ frxPrinters.Printer.FileName := ChangeFileExt(FileDlg.FileName, '.prn') else
+ ModalResult := mrCancel;
+ end;
+
+ if ModalResult = mrOk then
+ begin
+ AReport.PrintOptions.Copies := StrToInt(CopiesE.Text);
+ AReport.PrintOptions.Collate := CollateCB.IsChecked;
+ if AllRB.IsChecked then
+ AReport.PrintOptions.PageNumbers := ''
+ else if CurPageRB.IsChecked then
+ AReport.PrintOptions.PageNumbers := IntToStr(AReport.PreviewPages.CurPreviewPage)
+ else
+ AReport.PrintOptions.PageNumbers := PageNumbersE.Text;
+ AReport.PrintOptions.PrintPages := TfrxPrintPages(PrintPagesCB.ItemIndex);
+ ADuplexMode := TfrxDuplexMode(DuplexCB.ItemIndex);
+ AReport.PrintOptions.Reverse := OrderCB.ItemIndex = 1;
+
+ AReport.PrintOptions.PrintMode := TfrxPrintMode(PrintModeCB.ItemIndex);
+// AReport.PrintOptions.PrintOnSheet := frxPrinters.Printer.PaperNameToNumber(PagPageSizeCB.Text);
+ end;
+end;
+
+{procedure TfrxPrintDialog.PrintersCBDrawItem(Control: TWinControl; Index: Integer;
+ ARect: TRect; State: TOwnerDrawState);
+begin
+ with PrintersCB.Canvas do
+ begin
+ FillRect(ARect);
+ frxResources.PreviewButtonImages.Draw(PrintersCB.Canvas, ARect.Left + 2, ARect.Top, 2);
+ TextOut(ARect.Left + 24, ARect.Top + 1, PrintersCB.Items[Index]);
+ end;
+end; }
+
+procedure TfrxPrintDialog.PropButtonClick(Sender: TObject);
+var
+ dup: Integer;
+begin
+ frxPrinters.Printer.PropertiesDlg;
+ dup := frxPrinters.Printer.Duplex - 1;
+ if dup = 0 then dup := 3;
+
+ if dup > 0 then
+ begin
+ ADuplexMode := TfrxDuplexMode(dup);
+ DuplexCB.ItemIndex := dup;
+ end;
+end;
+
+procedure TfrxPrintDialog.PrintersCBClick(Sender: TObject);
+var
+ SaveSheet: Integer;
+begin
+ if PagPageSizeCB.ItemIndex <= 0 then
+ SaveSheet := -1
+ else
+ SaveSheet := frxPrinters.Printer.PaperNameToNumber(PagPageSizeCB.Items[PagPageSizeCB.ItemIndex]);
+
+ frxPrinters.PrinterIndex := PrintersCB.ItemIndex;
+ WhereL1.Text := frxPrinters.Printer.Port;
+ PagPageSizeCB.Items := frxPrinters.Printer.Papers;
+ PagPageSizeCB.Items.Delete(frxPrinters.Printer.PaperIndex(256));
+ PagPageSizeCB.Items.Insert(0, frxResources.Get('pgDefault'));
+
+ if (SaveSheet <> -1) and (frxPrinters.Printer.PaperIndex(SaveSheet) <> -1) then
+ begin
+ PagPageSizeCB.ItemIndex := frxPrinters.Printer.PaperIndex(SaveSheet) + 1;
+ if frxPrinters.Printer.PaperIndex(256) < frxPrinters.Printer.PaperIndex(SaveSheet) then
+ PagPageSizeCB.ItemIndex := PagPageSizeCB.ItemIndex - 1
+ end
+ else
+ PagPageSizeCB.ItemIndex := 0
+end;
+
+procedure TfrxPrintDialog.PageNumbersEEnter(Sender: TObject);
+begin
+ PageNumbersRB.IsChecked := True;
+end;
+
+procedure TfrxPrintDialog.PageNumbersRBClick(Sender: TObject);
+begin
+ if Visible then
+ PageNumbersE.SetFocus;
+end;
+
+procedure TfrxPrintDialog.CollateLClick(Sender: TObject);
+begin
+ CollateCB.IsChecked := not CollateCB.IsChecked;
+end;
+
+procedure TfrxPrintDialog.CollateCBClick(Sender: TObject);
+begin
+ //CopiesPBPaint(nil);
+end;
+
+{procedure TfrxPrintDialog.CopiesPBPaint(Sender: TObject);
+begin
+ with CopiesPB.Canvas do
+ begin
+ Brush.Color := Color;
+ FillRect(Rect(0, 0, CopiesPB.Width, CopiesPB.Height));
+ if CollateCB.Checked then
+ frxDrawTransparent(CopiesPB.Canvas, 0, 0, CollateImg.Picture.Bitmap) else
+ frxDrawTransparent(CopiesPB.Canvas, 0, 0, NonCollateImg.Picture.Bitmap);
+ end;
+end; }
+
+procedure TfrxPrintDialog.FormKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+// if Key = VK_F1 then
+ // frxResources.Help(Self);
+end;
+ {
+procedure TfrxPrintDialog.PrintModeCBDrawItem(Control: TWinControl;
+ Index: Integer; ARect: TRect; State: TOwnerDrawState);
+begin
+ with PrintModeCB do
+ begin
+ Canvas.FillRect(ARect);
+ PrintModeIL.Draw(Canvas, ARect.Left + 2, ARect.Top + 1, Index);
+ Canvas.TextOut(ARect.Left + 74, ARect.Top + 10, Items[Index]);
+ end;
+end; }
+
+procedure TfrxPrintDialog.PrintModeCBClick(Sender: TObject);
+var
+ DefaultMode: Boolean;
+begin
+ DefaultMode := PrintModeCB.ItemIndex = 0;
+ if DefaultMode then
+ PagPageSizeCB.ItemIndex := 0;
+ PagPageSizeCB.Enabled := not DefaultMode;
+ if not DefaultMode and (PagPageSizeCB.ItemIndex = 0) then
+ PagPageSizeCB.ItemIndex := frxPrinters.Printer.PaperIndex(DMPAPER_A4);
+end;
+
+end.
+
diff --git a/LibD28/FMX.frxPrinter.pas b/LibD28/FMX.frxPrinter.pas
new file mode 100644
index 0000000..de5ed04
--- /dev/null
+++ b/LibD28/FMX.frxPrinter.pas
@@ -0,0 +1,569 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Printer }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxPrinter;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.SysUtils, System.Types, System.UITypes, System.Variants,
+ FMX.Types
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+
+type
+
+ TfrxCustomPrinter = class(TObject)
+ protected
+ FBin: Integer;
+ FDuplex: Integer;
+ FBins: TStrings;
+ FCanvas: TCanvas;
+ FDefOrientation: TPrinterOrientation;
+ FDefPaper: Integer;
+ FDefPaperHeight: Double;
+ FDefPaperWidth: Double;
+ FDefDuplex: Integer;
+ FDefBin: Integer;
+ FDPI: TPoint;
+ FFileName: String;
+ FHandle: THandle;
+ FInitialized: Boolean;
+ FName: String;
+ FPaper: Integer;
+ FPapers: TStrings;
+ FPaperHeight: Double;
+ FPaperWidth: Double;
+ FLeftMargin: Double;
+ FTopMargin: Double;
+ FRightMargin: Double;
+ FBottomMargin: Double;
+ FOrientation: TPrinterOrientation;
+ FPort: String;
+ FPrinting: Boolean;
+ FTitle: String;
+ FOnDocStarted: TNotifyEvent;
+ public
+ constructor Create(const AName, APort: String); virtual;
+ destructor Destroy; override;
+ procedure Init; virtual; abstract;
+ procedure Abort; virtual; abstract;
+ procedure BeginDoc; virtual; abstract;
+ procedure BeginPage; virtual; abstract;
+ procedure BeginRAWDoc; virtual; abstract;
+ procedure EndDoc; virtual; abstract;
+ procedure EndPage; virtual; abstract;
+ procedure EndRAWDoc; virtual; abstract;
+ procedure WriteRAWDoc(const buf: AnsiString); virtual; abstract;
+
+ function BinIndex(ABin: Integer): Integer;
+ function PaperIndex(APaper: Integer): Integer;
+ function BinNameToNumber(const ABin: String): Integer;
+ function PaperNameToNumber(const APaper: String): Integer;
+ procedure SetViewParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended;
+ AOrientation: TPrinterOrientation); virtual; abstract;
+ procedure SetPrintParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
+ ABin, ADuplex, ACopies: Integer); virtual; abstract;
+ procedure PropertiesDlg; virtual; abstract;
+ function ShowPrintDialog: Boolean; virtual; abstract;
+
+ property Bin: Integer read FBin;
+ property Duplex: Integer read FDuplex;
+ property Bins: TStrings read FBins;
+ property Canvas: TCanvas read FCanvas;
+ property DefOrientation: TPrinterOrientation read FDefOrientation;
+ property DefPaper: Integer read FDefPaper;
+ property DefPaperHeight: Double read FDefPaperHeight;
+ property DefPaperWidth: Double read FDefPaperWidth;
+ property DefBin: Integer read FDefBin;
+ property DefDuplex: Integer read FDefDuplex;
+ property DPI: TPoint read FDPI;
+ property FileName: String read FFileName write FFileName;
+ property Handle: THandle read FHandle;
+ property Name: String read FName;
+ property Paper: Integer read FPaper;
+ property Papers: TStrings read FPapers;
+ property PaperHeight: Double read FPaperHeight;
+ property PaperWidth: Double read FPaperWidth;
+ property LeftMargin: Double read FLeftMargin;
+ property TopMargin: Double read FTopMargin;
+ property RightMargin: Double read FRightMargin;
+ property BottomMargin: Double read FBottomMargin;
+ property Orientation: TPrinterOrientation read FOrientation;
+ property Port: String read FPort;
+ property Title: String read FTitle write FTitle;
+ property Initialized: Boolean read FInitialized;
+ property OnDocStarted: TNotifyEvent read FOnDocStarted write FOnDocStarted;
+ end;
+
+ TfrxVirtualPrinter = class(TfrxCustomPrinter)
+ public
+ procedure Init; override;
+ procedure Abort; override;
+ procedure BeginDoc; override;
+ procedure BeginPage; override;
+ procedure BeginRAWDoc; override;
+ procedure EndDoc; override;
+ procedure EndPage; override;
+ procedure EndRAWDoc; override;
+ procedure WriteRAWDoc(const buf: AnsiString); override;
+ procedure SetViewParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended;
+ AOrientation: TPrinterOrientation); override;
+ procedure SetPrintParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
+ ABin, ADuplex, ACopies: Integer); override;
+ procedure PropertiesDlg; override;
+ function ShowPrintDialog: Boolean; override;
+ end;
+
+
+ TfrxCustomPrinters = class(TObject)
+ protected
+ FHasPhysicalPrinters: Boolean;
+ FPrinters: TStrings;
+ FPrinterIndex: Integer;
+ FPrinterList: TList;
+ function GetItem(Index: Integer): TfrxCustomPrinter;
+ function GetCurrentPrinter: TfrxCustomPrinter;
+ procedure SetPrinterIndex(Value: Integer);
+ function GetDefaultPrinter: String; virtual;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function IndexOf(AName: String): Integer;
+ procedure Clear;
+ procedure FillPrinters; virtual;
+ property Items[Index: Integer]: TfrxCustomPrinter read GetItem; default;
+ property HasPhysicalPrinters: Boolean read FHasPhysicalPrinters;
+ property Printer: TfrxCustomPrinter read GetCurrentPrinter;
+ property PrinterIndex: Integer read FPrinterIndex write SetPrinterIndex;
+ property Printers: TStrings read FPrinters;
+ end;
+
+ TfrxCustomPrintersClass = class of TfrxCustomPrinters;
+
+
+function frxGetPaperDimensions(PaperSize: Integer; var Width, Height: Double): Boolean;
+function frxPrinters: TfrxCustomPrinters;
+
+implementation
+
+uses
+ FMX.frxUtils, FMX.frxRes, FMX.frxFMX
+{$IFDEF MSWINDOWS}
+ ,FMX.Win.frxPrinter
+{$ENDIF}
+{$IFDEF LINUX}
+ ,FMX.Linux.frxPrinter
+{$ENDIF}
+{$IFDEF MACOS}
+ ,FMX.Mac.frxPrinter
+{$ENDIF};
+
+
+
+type
+ TPaperInfo = {packed} record
+ Typ: Integer;
+ Name: String;
+ X, Y: Integer;
+ end;
+
+
+const
+ PAPERCOUNT = 66;
+ PaperInfo: array[0..PAPERCOUNT - 1] of TPaperInfo = (
+ (Typ:1; Name: ''; X:2159; Y:2794),
+ (Typ:2; Name: ''; X:2159; Y:2794),
+ (Typ:3; Name: ''; X:2794; Y:4318),
+ (Typ:4; Name: ''; X:4318; Y:2794),
+ (Typ:5; Name: ''; X:2159; Y:3556),
+ (Typ:6; Name: ''; X:1397; Y:2159),
+ (Typ:7; Name: ''; X:1842; Y:2667),
+ (Typ:8; Name: ''; X:2970; Y:4200),
+ (Typ:9; Name: ''; X:2100; Y:2970),
+ (Typ:10; Name: ''; X:2100; Y:2970),
+ (Typ:11; Name: ''; X:1480; Y:2100),
+ (Typ:12; Name: ''; X:2500; Y:3540),
+ (Typ:13; Name: ''; X:1820; Y:2570),
+ (Typ:14; Name: ''; X:2159; Y:3302),
+ (Typ:15; Name: ''; X:2150; Y:2750),
+ (Typ:16; Name: ''; X:2540; Y:3556),
+ (Typ:17; Name: ''; X:2794; Y:4318),
+ (Typ:18; Name: ''; X:2159; Y:2794),
+ (Typ:19; Name: ''; X:984; Y:2254),
+ (Typ:20; Name: ''; X:1048; Y:2513),
+ (Typ:21; Name: ''; X:1143; Y:2635),
+ (Typ:22; Name: ''; X:1207; Y:2794),
+ (Typ:23; Name: ''; X:1270; Y:2921),
+ (Typ:25; Name: ''; X:4318; Y:5588),
+ (Typ:25; Name: ''; X:5588; Y:8636),
+ (Typ:26; Name: ''; X:8636; Y:11176),
+ (Typ:27; Name: ''; X:1100; Y:2200),
+ (Typ:28; Name: ''; X:1620; Y:2290),
+ (Typ:29; Name: ''; X:3250; Y:4580),
+ (Typ:30; Name: ''; X:2290; Y:3250),
+ (Typ:31; Name: ''; X:1140; Y:1620),
+ (Typ:32; Name: ''; X:1140; Y:2290),
+ (Typ:33; Name: ''; X:2500; Y:3530),
+ (Typ:34; Name: ''; X:1760; Y:2500),
+ (Typ:35; Name: ''; X:1760; Y:1250),
+ (Typ:36; Name: ''; X:1100; Y:2300),
+ (Typ:37; Name: ''; X:984; Y:1905),
+ (Typ:38; Name: ''; X:920; Y:1651),
+ (Typ:39; Name: ''; X:3778; Y:2794),
+ (Typ:40; Name: ''; X:2159; Y:3048),
+ (Typ:41; Name: ''; X:2159; Y:3302),
+ (Typ:42; Name: ''; X:2500; Y:3530),
+ (Typ:43; Name: ''; X:1000; Y:1480),
+ (Typ:44; Name: ''; X:2286; Y:2794),
+ (Typ:45; Name: ''; X:2540; Y:2794),
+ (Typ:46; Name: ''; X:3810; Y:2794),
+ (Typ:47; Name: ''; X:2200; Y:2200),
+ (Typ:50; Name: ''; X:2355; Y:3048),
+ (Typ:51; Name: ''; X:2355; Y:3810),
+ (Typ:52; Name: ''; X:2969; Y:4572),
+ (Typ:53; Name: ''; X:2354; Y:3223),
+ (Typ:54; Name: ''; X:2101; Y:2794),
+ (Typ:55; Name: ''; X:2100; Y:2970),
+ (Typ:56; Name: ''; X:2355; Y:3048),
+ (Typ:57; Name: ''; X:2270; Y:3560),
+ (Typ:58; Name: ''; X:3050; Y:4870),
+ (Typ:59; Name: ''; X:2159; Y:3223),
+ (Typ:60; Name: ''; X:2100; Y:3300),
+ (Typ:61; Name: ''; X:1480; Y:2100),
+ (Typ:62; Name: ''; X:1820; Y:2570),
+ (Typ:63; Name: ''; X:3220; Y:4450),
+ (Typ:64; Name: ''; X:1740; Y:2350),
+ (Typ:65; Name: ''; X:2010; Y:2760),
+ (Typ:66; Name: ''; X:4200; Y:5940),
+ (Typ:67; Name: ''; X:2970; Y:4200),
+ (Typ:68; Name: ''; X:3220; Y:4450));
+
+var
+ FPrinters: TfrxCustomPrinters = nil;
+
+function frxGetPaperDimensions(PaperSize: Integer; var Width, Height: Double): Boolean;
+var
+ i: Integer;
+begin
+ Result := False;
+ for i := 0 to PAPERCOUNT - 1 do
+ if PaperInfo[i].Typ = PaperSize then
+ begin
+ Width := PaperInfo[i].X / 10;
+ Height := PaperInfo[i].Y / 10;
+ Result := True;
+ break;
+ end;
+end;
+
+
+
+
+{ TfrxCustomPrinter }
+
+constructor TfrxCustomPrinter.Create(const AName, APort: String);
+begin
+ FName := AName;
+ FPort := APort;
+
+ FBins := TStringList.Create;
+ FBins.AddObject(frxResources.Get('prDefault'), Pointer(DMBIN_AUTO));
+
+ FPapers := TStringList.Create;
+ FPapers.AddObject(frxResources.Get('prCustom'), Pointer(256));
+
+ //FCanvas := TfrxPrinterCanvas.Create;
+ //FCanvas.FPrinter := Self;
+end;
+
+destructor TfrxCustomPrinter.Destroy;
+begin
+ FBins.Free;
+ FPapers.Free;
+ //FCanvas.Free;
+ inherited;
+end;
+
+function TfrxCustomPrinter.BinIndex(ABin: Integer): Integer;
+var
+ i: Integer;
+begin
+ Result := -1;
+ for i := 0 to FBins.Count - 1 do
+ if Integer(FBins.Objects[i]) = ABin then
+ begin
+ Result := i;
+ break;
+ end;
+end;
+
+function TfrxCustomPrinter.PaperIndex(APaper: Integer): Integer;
+var
+ i: Integer;
+begin
+ Result := -1;
+ for i := 0 to FPapers.Count - 1 do
+ if Integer(FPapers.Objects[i]) = APaper then
+ begin
+ Result := i;
+ break;
+ end;
+end;
+
+function TfrxCustomPrinter.BinNameToNumber(const ABin: String): Integer;
+var
+ i: Integer;
+begin
+ i := FBins.IndexOf(ABin);
+ if i = -1 then
+ i := 0;
+ Result := Integer(FBins.Objects[i]);
+end;
+
+function TfrxCustomPrinter.PaperNameToNumber(const APaper: String): Integer;
+var
+ i: Integer;
+begin
+ i := FPapers.IndexOf(APaper);
+ if i = -1 then
+ i := 0;
+ Result := Integer(FPapers.Objects[i]);
+end;
+
+
+{ TfrxVirtualPrinter }
+
+procedure TfrxVirtualPrinter.Init;
+var
+ i: Integer;
+begin
+ if FInitialized then Exit;
+
+ FDPI := Point(600, 600);
+ FDefPaper := DMPAPER_A4;
+ FDefOrientation := poPortrait;
+ FDefPaperWidth := 210;
+ FDefPaperHeight := 297;
+
+ for i := 0 to PAPERCOUNT - 1 do
+ FPapers.AddObject(PaperInfo[i].Name, Pointer(PaperInfo[i].Typ));
+
+ FBin := -1;
+ FDuplex := -1;
+ FInitialized := True;
+end;
+
+procedure TfrxVirtualPrinter.Abort;
+begin
+end;
+
+procedure TfrxVirtualPrinter.BeginDoc;
+begin
+end;
+
+procedure TfrxVirtualPrinter.BeginPage;
+begin
+end;
+
+procedure TfrxVirtualPrinter.EndDoc;
+begin
+end;
+
+procedure TfrxVirtualPrinter.EndPage;
+begin
+end;
+
+procedure TfrxVirtualPrinter.BeginRAWDoc;
+begin
+end;
+
+procedure TfrxVirtualPrinter.EndRAWDoc;
+begin
+end;
+
+procedure TfrxVirtualPrinter.WriteRAWDoc(const buf: AnsiString);
+begin
+end;
+
+procedure TfrxVirtualPrinter.SetViewParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation);
+var
+ i: Integer;
+ Found: Boolean;
+begin
+ Found := False;
+ if APaperSize <> 256 then
+ for i := 0 to PAPERCOUNT - 1 do
+ if PaperInfo[i].Typ = APaperSize then
+ begin
+ if AOrientation = poPortrait then
+ begin
+ APaperWidth := PaperInfo[i].X / 10;
+ APaperHeight := PaperInfo[i].Y / 10;
+ end
+ else
+ begin
+ APaperWidth := PaperInfo[i].Y / 10;
+ APaperHeight := PaperInfo[i].X / 10;
+ end;
+ Found := True;
+ break;
+ end;
+
+ if not Found then
+ APaperSize := 256;
+
+ FOrientation := AOrientation;
+ FPaper := APaperSize;
+ FPaperWidth := APaperWidth;
+ FPaperHeight := APaperHeight;
+ FLeftMargin := 5;
+ FTopMargin := 5;
+ FRightMargin := 5;
+ FBottomMargin := 5;
+end;
+
+function TfrxVirtualPrinter.ShowPrintDialog: Boolean;
+begin
+ Result := False;
+end;
+
+procedure TfrxVirtualPrinter.SetPrintParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
+ ABin, ADuplex, ACopies: Integer);
+begin
+ SetViewParams(APaperSize, APaperWidth, APaperHeight, AOrientation);
+ FBin := ABin;
+end;
+
+procedure TfrxVirtualPrinter.PropertiesDlg;
+begin
+end;
+
+
+{ TfrxCustomPrinters }
+
+constructor TfrxCustomPrinters.Create;
+begin
+ FPrinterList := TList.Create;
+ FPrinters := TStringList.Create;
+
+ try
+ FillPrinters;
+ except
+ end;
+ if FPrinterList.Count = 0 then
+ begin
+ FPrinterList.Add(TfrxVirtualPrinter.Create(frxResources.Get('prVirtual'), ''));
+ FHasPhysicalPrinters := False;
+ PrinterIndex := 0;
+ end
+ else
+ begin
+ FHasPhysicalPrinters := True;
+ PrinterIndex := IndexOf(GetDefaultPrinter);
+ if PrinterIndex = -1 then // important
+ PrinterIndex := 0;
+ end;
+end;
+
+destructor TfrxCustomPrinters.Destroy;
+begin
+ Clear;
+ FPrinterList.Free;
+ FPrinters.Free;
+ inherited;
+end;
+
+procedure TfrxCustomPrinters.Clear;
+begin
+ while FPrinterList.Count > 0 do
+ begin
+ TObject(FPrinterList[0]).Free;
+ FPrinterList.Delete(0);
+ end;
+ FPrinters.Clear;
+end;
+
+function TfrxCustomPrinters.GetItem(Index: Integer): TfrxCustomPrinter;
+begin
+ if Index >= 0 then
+ Result := FPrinterList[Index]
+ else
+ Result := nil
+end;
+
+function TfrxCustomPrinters.IndexOf(AName: String): Integer;
+var
+ i: Integer;
+begin
+ Result := -1;
+ for i := 0 to FPrinterList.Count - 1 do
+ if AnsiCompareText(Items[i].Name, AName) = 0 then
+ begin
+ Result := i;
+ break;
+ end;
+end;
+
+procedure TfrxCustomPrinters.SetPrinterIndex(Value: Integer);
+begin
+ if Value <> -1 then
+ FPrinterIndex := Value
+ else
+ FPrinterIndex := IndexOf(GetDefaultPrinter);
+ if FPrinterIndex <> -1 then
+ Items[FPrinterIndex].Init;
+end;
+
+function TfrxCustomPrinters.GetCurrentPrinter: TfrxCustomPrinter;
+begin
+ Result := Items[PrinterIndex];
+end;
+
+function TfrxCustomPrinters.GetDefaultPrinter: String;
+begin
+ Result := '';
+end;
+
+
+procedure TfrxCustomPrinters.FillPrinters;
+begin
+ // do nothing
+end;
+
+
+function frxPrinters: TfrxCustomPrinters;
+begin
+ if FPrinters = nil then
+ FPrinters := ActualfrxPrinterClass.Create;
+ Result := FPrinters;
+end;
+
+initialization
+
+finalization
+ if FPrinters <> nil then
+ FPrinters.Free;
+
+end.
+
diff --git a/LibD28/FMX.frxProgress.fmx b/LibD28/FMX.frxProgress.fmx
new file mode 100644
index 0000000..6c7539e
--- /dev/null
+++ b/LibD28/FMX.frxProgress.fmx
@@ -0,0 +1,43 @@
+object frxProgress: TfrxProgress
+ Left = 0
+ Top = 0
+ BorderStyle = bsNone
+ ClientHeight = 147
+ ClientWidth = 271
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ StyleLookup = 'backgroundstyle'
+ object Panel1: TPanel
+ Align = alClient
+ Width = 271.000000000000000000
+ Height = 147.000000000000000000
+ TabOrder = 0
+ object LMessage: TLabel
+ Position.Point = '(16,11)'
+ Width = 237.000000000000000000
+ Height = 20.000000000000000000
+ TabOrder = 0
+ TextAlign = taCenter
+ Text = 'LMessage'
+ end
+ object Bar: TProgressBar
+ Position.Point = '(16,37)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ Max = 100.000000000000000000
+ Orientation = orHorizontal
+ end
+ object CancelB: TButton
+ Position.Point = '(100,64)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = CancelBClick
+ TabOrder = 2
+ ModalResult = 2
+ Text = 'Cancel'
+ Cancel = True
+ end
+ end
+end
diff --git a/LibD28/FMX.frxProgress.pas b/LibD28/FMX.frxProgress.pas
new file mode 100644
index 0000000..45763e8
--- /dev/null
+++ b/LibD28/FMX.frxProgress.pas
@@ -0,0 +1,134 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Progress }
+{ }
+{ Copyright (c) 2004-2008 }
+{ by Alexander Fediachov, }
+{ Fast Reports, Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxProgress;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Forms, FMX.Controls, FMX.Types
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+type
+ TfrxProgress = class(TForm)
+ Panel1: TPanel;
+ LMessage: TLabel;
+ Bar: TProgressBar;
+ CancelB: TButton;
+ procedure FormCreate(Sender: TObject);
+ procedure CancelBClick(Sender: TObject);
+ private
+ FTerminated: Boolean;
+ FPosition: Integer;
+ FMessage: String;
+ FProgress: Boolean;
+ procedure SetPosition(Value: Integer);
+ procedure SetMessage(const Value: String);
+ procedure SetTerminated(Value: Boolean);
+ procedure SetProgress(Value: Boolean);
+ public
+ procedure Reset;
+ procedure Execute(MaxValue: Integer; const Msg: String;
+ Canceled: Boolean; Progress: Boolean);
+ procedure Tick;
+ property Terminated: Boolean read FTerminated write SetTerminated;
+ property Position: Integer read FPosition write SetPosition;
+ property ShowProgress: Boolean read FProgress write SetProgress;
+ property Message: String read FMessage write SetMessage;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses
+ FMX.frxRes;
+
+
+{ TfrxProgress }
+
+procedure TfrxProgress.FormCreate(Sender: TObject);
+begin
+ CancelB.Text := frxGet(2);
+ Bar.Min := 0;
+ Bar.Max := 100;
+ Position := 0;
+end;
+
+procedure TfrxProgress.Reset;
+begin
+ Position := 0;
+end;
+
+procedure TfrxProgress.SetPosition(Value: Integer);
+begin
+ FPosition := Value;
+ Bar.Value := Value;
+ BringToFront;
+end;
+
+procedure TfrxProgress.Execute(MaxValue: Integer; const Msg: String;
+ Canceled: Boolean; Progress: Boolean);
+begin
+ Terminated := False;
+ CancelB.Visible := Canceled;
+ ShowProgress := Progress;
+ Bar.Min := 0;
+ Reset;
+ Bar.Max := MaxValue;
+ Message := Msg;
+ Show;
+end;
+
+procedure TfrxProgress.Tick;
+begin
+ if (Position < Bar.Max) and (Position >= Bar.Min) then
+ Position := Position + 1;
+end;
+
+procedure TfrxProgress.SetMessage(const Value: String);
+begin
+ FMessage := Value;
+ LMessage.Text := Value;
+ LMessage.Repaint;
+end;
+
+procedure TfrxProgress.CancelBClick(Sender: TObject);
+begin
+ Terminated := True;
+end;
+
+procedure TfrxProgress.SetTerminated(Value: boolean);
+begin
+ FTerminated := Value;
+ if Value then Close;
+end;
+
+procedure TfrxProgress.SetProgress(Value: boolean);
+begin
+ Bar.Visible := Value;
+ FProgress := Value;
+ if Value then
+ LMessage.Position.Y := 15
+ else
+ LMessage.Position.Y := 35;
+end;
+
+end.
+
+
diff --git a/LibD28/FMX.frxRC4.pas b/LibD28/FMX.frxRC4.pas
new file mode 100644
index 0000000..4fe477e
--- /dev/null
+++ b/LibD28/FMX.frxRC4.pas
@@ -0,0 +1,78 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ RC4 crypto algorythm }
+{ }
+{******************************************}
+
+unit FMX.frxRC4;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes;
+
+type
+ PByte = ^Byte;
+
+ TfrxRC4 = class(TObject)
+ private
+ FKey: array[0..255] of byte;
+ procedure xchg(var byte1, byte2: Byte);
+ public
+ procedure Start(Key: Pointer; KeyLength: Integer);
+ procedure Crypt(Source, Target: Pointer; Length: Integer);
+ end;
+
+implementation
+
+procedure TfrxRC4.xchg(var byte1, byte2: Byte);
+var
+ t: Byte;
+begin
+ t := byte1;
+ byte1 := byte2;
+ byte2 := t;
+end;
+
+procedure TfrxRC4.Start(Key: Pointer; KeyLength: Integer);
+var
+ i, j: integer;
+ k: array[0..255] of byte;
+begin
+ if (KeyLength > 0) and (KeyLength <= 256) then
+ begin
+ for i := 0 to 255 do
+ begin
+ FKey[i] := i;
+ k[i] := PByte(NativeInt(Key) + (i mod KeyLength))^;
+ end;
+ j := 0;
+ for i := 0 to 255 do
+ begin
+ j := (j + FKey[i] + k[i]) and $FF;
+ xchg(FKey[i], FKey[j]);
+ end;
+ end;
+end;
+
+procedure TfrxRC4.Crypt(Source, Target: Pointer; Length: Integer);
+var
+ i, j: byte;
+ k: integer;
+begin
+ i := 0;
+ j := 0;
+ for k := 0 to Length - 1 do
+ begin
+ i := Byte(i + 1);
+ j := Byte(j + FKey[i]);
+ xchg(FKey[i], FKey[j]);
+ PByteArray(Target)[k] := PByteArray(Source)[k] xor FKey[Byte(FKey[i] + FKey[j])];
+ end;
+end;
+
+end.
diff --git a/LibD28/FMX.frxReportTree.fmx b/LibD28/FMX.frxReportTree.fmx
new file mode 100644
index 0000000..175d2a4
--- /dev/null
+++ b/LibD28/FMX.frxReportTree.fmx
@@ -0,0 +1,33 @@
+object frxReportTreeForm: TfrxReportTreeForm
+ Left = 0
+ Top = 0
+ BorderStyle = bsSizeToolWin
+ Caption = 'Report Tree'
+ ClientHeight = 347
+ ClientWidth = 179
+ OnCreate = FormCreate
+ object MainPanel: TPanel
+ Align = alClient
+ Height = 347.000000000000000000
+ StyleLookup = 'backgroundstyle'
+ Width = 179.000000000000000000
+ object Rectangle1: TRectangle
+ Align = alTop
+ Height = 18.000000000000000000
+ Margins.Left = 2.000000000000000000
+ Margins.Top = 1.000000000000000000
+ Stroke.Kind = bkNone
+ Width = 179.000000000000000000
+ object Label1: TLabel
+ Align = alClient
+ AutoSize = True
+ Height = 17.000000000000000000
+ Position.X = 2.000000000000000000
+ Position.Y = 1.000000000000000000
+ Text = 'Report Tree'
+ Width = 177.000000000000000000
+ WordWrap = False
+ end
+ end
+ end
+end
diff --git a/LibD28/FMX.frxReportTree.pas b/LibD28/FMX.frxReportTree.pas
new file mode 100644
index 0000000..137bb81
--- /dev/null
+++ b/LibD28/FMX.frxReportTree.pas
@@ -0,0 +1,251 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Report Tree }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxReportTree;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Objects, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.Types, FMX.Layouts, FMX.TreeView, FMX.frxFMX, System.Variants
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+ TfrxReportTreeForm = class(TForm)
+ MainPanel: TPanel;
+ Rectangle1: TRectangle;
+ Label1: TLabel;
+ procedure FormShow(Sender: TObject);
+ procedure TreeChange(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure TreeKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+ private
+ FComponents: TList;
+ FDesigner: TfrxCustomDesigner;
+ FNodes: TList;
+ FReport: TfrxReport;
+ FUpdating: Boolean;
+ FOnSelectionChanged: TNotifyEvent;
+ Tree: TfrxTreeView;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure UpdateItems;
+ procedure UpdateSelection;
+ property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged
+ write FOnSelectionChanged;
+ property Report: TfrxReport read FReport write FReport;
+ property ReportTree: TfrxTreeView read Tree;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxRes, FMX.frxDesgn, FMX.frxDsgnIntf;
+
+type
+ THackTreeView = class(TCustomTreeView);
+
+
+{ TfrxReportTreeForm }
+
+constructor TfrxReportTreeForm.Create(AOwner: TComponent);
+begin
+ inherited;
+ FComponents := TList.Create;
+ FNodes := TList.Create;
+ Tree := TfrxTreeView.Create(Self);
+ Tree.Parent := MainPanel;
+ Tree.Align := TAlignLayout.alClient;
+ Tree.SetImages(frxResources.Images);
+ Tree.OnChange := TreeChange;
+end;
+
+destructor TfrxReportTreeForm.Destroy;
+begin
+ FComponents.Free;
+ FNodes.Free;
+ inherited;
+end;
+
+procedure TfrxReportTreeForm.FormShow(Sender: TObject);
+begin
+ UpdateItems;
+end;
+
+procedure TfrxReportTreeForm.UpdateItems;
+
+ procedure SetImageIndex(Node: TfrxTreeViewItem; Index: Integer);
+ begin
+ Node.OpenImageIndex := Index;
+ Node.CloseImageIndex := Index;
+ end;
+
+ procedure EnumItems(c: TfrxComponent; RootNode: TfrxTreeViewItem);
+ var
+ i: Integer;
+ Node: TfrxTreeViewItem;
+ Item: TfrxObjectItem;
+ begin
+ if (c is TfrxDataPage) and (frxDesignerComp <> nil) and
+ (drDontEditInternalDatasets in frxDesignerComp.Restrictions) then
+ Exit;
+
+ Node := TfrxTreeViewItem.Create(Tree);
+ //Node.Text := s;
+ if RootNode <> nil then
+ Node.Parent := RootNode
+ else
+ Node.Parent := Tree;
+ Node.Parent.AddObject(Node);
+ Node.Text := c.Name;
+ //Node := Tree.Items.AddChild(RootNode, c.Name);
+ FComponents.Add(c);
+ FNodes.Add(Node);
+ Node.Data := c;
+ if c is TfrxReport then
+ begin
+ Node.Text := 'Report';
+ SetImageIndex(Node, 134);
+ end
+ else if c is TfrxReportPage then
+ SetImageIndex(Node, 135)
+ else if c is TfrxDialogPage then
+ SetImageIndex(Node, 136)
+ else if c is TfrxDataPage then
+ SetImageIndex(Node, 53)
+ else if c is TfrxReportTitle then
+ SetImageIndex(Node, 154)
+ else if c is TfrxReportSummary then
+ SetImageIndex(Node, 155)
+ else if c is TfrxPageHeader then
+ SetImageIndex(Node, 156)
+ else if c is TfrxPageFooter then
+ SetImageIndex(Node, 157)
+ else if c is TfrxColumnHeader then
+ SetImageIndex(Node, 158)
+ else if c is TfrxColumnFooter then
+ SetImageIndex(Node, 159)
+ else if c is TfrxHeader then
+ SetImageIndex(Node, 160)
+ else if c is TfrxFooter then
+ SetImageIndex(Node, 161)
+ else if c is TfrxDataBand then
+ SetImageIndex(Node, 162)
+ else if c is TfrxGroupHeader then
+ SetImageIndex(Node, 163)
+ else if c is TfrxGroupFooter then
+ SetImageIndex(Node, 164)
+ else if c is TfrxChild then
+ SetImageIndex(Node, 165)
+ else if c is TfrxOverlay then
+ SetImageIndex(Node, 166)
+ else
+ begin
+ for i := 0 to frxObjects.Count - 1 do
+ begin
+ Item := frxObjects[i];
+ if Item.ClassRef = c.ClassType then
+ begin
+ SetImageIndex(Node, Item.ButtonImageIndex);
+ break;
+ end;
+ end;
+ end;
+
+ if c is TfrxDataPage then
+ begin
+ for i := 0 to c.Objects.Count - 1 do
+ if TObject(c.Objects[i]) is TfrxDialogComponent then
+ EnumItems(c.Objects[i], Node)
+ end
+ else
+ for i := 0 to c.Objects.Count - 1 do
+ EnumItems(c.Objects[i], Node);
+ end;
+
+begin
+// XE3 bug - reset TCustomTreeView.FHoveredItem
+ THackTreeView(Tree).MouseMove([], -1, -1);
+
+ Tree.BeginUpdate;
+ Tree.Clear;
+ FComponents.Clear;
+ FNodes.Clear;
+ EnumItems(FReport, nil);
+ //xe4 issue ,EndUpdate should be before update selection or it cause AV
+ Tree.EndUpdate;
+ Tree.ExpandAll;
+ //xe4 issue need to call RealignContent after expanding
+{$IFDEF DELPHI18}
+ Tree.RealignContent;
+{$ENDIF}
+ UpdateSelection;
+
+end;
+
+procedure TfrxReportTreeForm.TreeChange(Sender: TObject);
+begin
+ if FUpdating or (Tree.Selected = nil) then Exit;
+ FDesigner.SelectedObjects.Clear;
+ FDesigner.SelectedObjects.Add(TfrxTreeViewItem(Tree.Selected).Data);
+ if Assigned(FOnSelectionChanged) then
+ FOnSelectionChanged(Self);
+end;
+
+procedure TfrxReportTreeForm.FormCreate(Sender: TObject);
+begin
+ FDesigner := TfrxCustomDesigner(Owner);
+ FReport := FDesigner.Report;
+ Label1.Text := frxGet(2200);
+end;
+
+procedure TfrxReportTreeForm.UpdateSelection;
+var
+ c: TComponent;
+ i: Integer;
+begin
+ if FDesigner.SelectedObjects.Count = 0 then Exit;
+ c := FDesigner.SelectedObjects[0];
+ FUpdating := True;
+ i := FComponents.IndexOf(c);
+ if i <> -1 then
+ begin
+ Tree.Selected := FNodes[i];
+ //Tree.Selected := Tree.ItemByGlobalIndex(i);
+ //Tree.TopItem := TTreeNode(FNodes[i]);
+ end;
+
+ FUpdating := False;
+end;
+
+procedure TfrxReportTreeForm.TreeKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ if Key = vkDelete then
+ begin
+ //THackWinControl(TfrxDesignerForm(FDesigner).Workspace).KeyDown(Key, Shift);
+ end;
+end;
+
+end.
diff --git a/LibD28/FMX.frxRes.pas b/LibD28/FMX.frxRes.pas
new file mode 100644
index 0000000..336804a
--- /dev/null
+++ b/LibD28/FMX.frxRes.pas
@@ -0,0 +1,375 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ Language resources management }
+{ }
+{ Copyright (c) 1998-2011 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxRes;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.Variants, System.WideStrings,
+ System.Types, FMX.Types, System.UIConsts,
+ FMX.frxUnicodeUtils, FMX.frxUtils, FMX.frxFMX
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+
+type
+ TfrxResources = class(TObject)
+ private
+ FNames: TStringList;
+ FImages: TBitmap;
+ FValues: TWideStrings;// TStringList;
+ FLanguages: TStringList;
+ FHelpFile: String;
+ FCP: Cardinal;
+ FImgWidth: Integer;
+ FImgHeight: Integer;
+ procedure BuildLanguagesList;
+ function GetImages: TBitmap;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function Get(const StrName: String): String;
+ procedure Add(const Ref, Str: String);
+ procedure AddW(const Ref: String; Str: WideString);
+ procedure AddStrings(const Str: String);
+ procedure AddXML(const Str: AnsiString);
+ procedure Clear;
+ procedure LoadFromFile(const FileName: String);
+ procedure LoadFromStream(Stream: TStream);
+ procedure LoadImageFromResouce(Image: TBitmap; RowId: Integer; ColId: Integer); overload;
+ procedure LoadImageFromResouce(Image: TBitmap; Index: Integer); overload;
+ procedure UpdateFSResources;
+ procedure Help(Sender: TObject); overload;
+ property Images: TBitmap read GetImages;
+ property Languages: TStringList read FLanguages;
+ property HelpFile: String read FHelpFile write FHelpFile;
+ end;
+
+function frxResources: TfrxResources;
+function frxGet(ID: Integer): String;
+
+
+implementation
+
+uses
+ FMX.fs_iconst, FMX.frxGZip, FMX.frxXML;
+
+var
+ FResources: TfrxResources = nil;
+
+type
+ frxInteger = NativeInt;
+
+{ TfrxResources }
+
+constructor TfrxResources.Create;
+begin
+ inherited;
+ FImgWidth := 16;
+ FImgHeight := 16;
+ FImages := TBitmap.Create(0, 0);
+ FNames := TfrxStringList.Create;
+ FValues := TfrxWideStrings.Create;
+ FNames.Sorted := True;
+ FLanguages := TStringList.Create;
+ HelpFile := 'FRUser.chm';
+ FCP := 0;
+ BuildLanguagesList;
+end;
+
+destructor TfrxResources.Destroy;
+begin
+ FLanguages.Free;
+ FNames.Free;
+ FValues.Free;
+ FImages.Free;
+ inherited;
+end;
+
+procedure TfrxResources.AddW(const Ref: String; Str: WideString);
+var
+ i: Integer;
+begin
+ i := FNames.IndexOf(Ref);
+ if i = -1 then
+ begin
+ FNames.AddObject(Ref, Pointer(FValues.Count));
+ FValues.Add(Str);
+ end
+ else
+ FValues[frxInteger(FNames.Objects[i])] := Str;
+end;
+
+procedure TfrxResources.Add(const Ref, Str: String);
+begin
+ AddW(Ref, Str);
+end;
+
+procedure TfrxResources.AddStrings(const Str: String);
+var
+ i: Integer;
+ sl: TWideStrings;
+ nm, vl: WideString;
+begin
+ sl := TfrxWideStrings.Create;
+ sl.Text := Str;
+ for i := 0 to sl.Count - 1 do
+ begin
+ nm := sl[i];
+ vl := Copy(nm, Pos('=', nm) + 1, MaxInt);
+ nm := Copy(nm, 1, Pos('=', nm) - 1);
+ if (nm <> '') and (vl <> '') then
+ Add(nm, vl);
+ end;
+ sl.Free;
+end;
+
+procedure TfrxResources.AddXML(const Str: AnsiString);
+var
+ Stream: TStringStream;
+begin
+ Stream := TStringStream.Create('', TEncoding.UTF8);
+ Stream.Write(Str[1], Length(Str));
+ Stream.Position := 0;
+ LoadFromStream(Stream);
+ Stream.Free;
+end;
+
+procedure TfrxResources.Clear;
+begin
+ FNames.Clear;
+ FValues.Clear;
+end;
+
+function TfrxResources.Get(const StrName: String): String;
+var
+ i: Integer;
+begin
+ i := FNames.IndexOf(StrName);
+ if i <> -1 then
+ Result := FValues[frxInteger(FNames.Objects[i])] else
+ Result := StrName;
+ if (Result <> '') and (Result[1] = '!') then
+ Delete(Result, 1, 1);
+ // UI amps
+ if Pos('&', Result) <> 0 then
+ Delete(Result, Pos('&', Result), 1);
+end;
+
+function TfrxResources.GetImages: TBitmap;
+var
+ res: TResourceStream;
+begin
+ if FImages.IsEmpty then
+ begin
+ res := TResourceStream.Create(hInstance, 'BUTTONS', RT_RCDATA);
+ try
+ FImages.LoadFromStream(res);
+ finally
+ res.Free;
+ end;
+ end;
+ Result := FImages;
+end;
+
+procedure TfrxResources.LoadFromFile(const FileName: String);
+var
+ f: TFileStream;
+begin
+ if FileExists(FileName) then
+ begin
+ f := TFileStream.Create(FileName, fmOpenRead);
+ try
+ LoadFromStream(f);
+ finally
+ f.Free;
+ end;
+ end;
+end;
+
+procedure TfrxResources.LoadFromStream(Stream: TStream);
+var
+ FXMLRes: TfrxXMLDocument;
+ idx: Integer;
+begin
+ FXMLRes := TfrxXMLDocument.Create;
+ FXMLRes.LoadFromStream(Stream);
+ try
+ with FXMLRes.Root do
+ begin
+ if Name = 'Resources' then
+ begin
+ FCP := StrToInt(Prop['CodePage']);
+ for idx := 0 to Count - 1 do
+ if Items[idx].Name = 'StrRes' then
+ if not FXMLRes.OldVersion then
+ Self.AddW(Items[idx].Prop['Name'], frxXMLToStr(Items[idx].Prop['Text'])) else
+ Self.AddW(Items[idx].Prop['Name'], UTF8Decode(AnsiString(frxXMLToStr(Items[idx].Prop['Text']))));
+
+ end;
+ end;
+ finally
+ FXMLRes.Free;
+ end;
+ UpdateFSResources;
+end;
+
+procedure TfrxResources.LoadImageFromResouce(Image: TBitmap;
+ RowId: Integer; ColId: Integer);
+begin
+ Image.SetSize(FImgWidth, FImgHeight);
+ Image.Canvas.BeginScene;
+ // need to clear image to avoid garbage output
+ Image.Clear(claNull);
+ Image.Canvas.DrawBitmap(Images, RectF(FImgWidth * ColId , FImgHeight * RowId, FImgWidth * ColId + FImgWidth , FImgHeight * RowId + FImgHeight), RectF(0, 0, FImgWidth, FImgHeight), 1 );
+ Image.Canvas.EndScene;
+{$IFNDEF Delphi17}
+ Image.BitmapChanged;
+{$ENDIF}
+end;
+
+procedure TfrxResources.LoadImageFromResouce(Image: TBitmap; Index: Integer);
+var
+ ColCount, ColId, RowId: Integer;
+begin
+ ColCount := Images.Width div FImgWidth;
+ RowId := Index div ColCount;
+ ColId := Index mod ColCount;
+ Image.SetSize(FImgWidth, FImgHeight);
+ Image.Canvas.BeginScene;
+ // need to clear image to avoid garbage output
+ Image.Clear(claNull);
+ Image.Canvas.DrawBitmap(Images, RectF(FImgWidth * ColId , FImgHeight * RowId, FImgWidth * ColId + FImgWidth , FImgHeight * RowId + FImgHeight), RectF(0, 0, FImgWidth, FImgHeight), 1 );
+ Image.Canvas.EndScene;
+{$IFNDEF Delphi17}
+ Image.BitmapChanged;
+{$ENDIF}
+end;
+
+procedure TfrxResources.UpdateFSResources;
+begin
+ SLangNotFound := Get('SLangNotFound');
+ SInvalidLanguage := Get('SInvalidLanguage');
+ SIdRedeclared := Get('SIdRedeclared');
+ SUnknownType := Get('SUnknownType');
+ SIncompatibleTypes := Get('SIncompatibleTypes');
+ SIdUndeclared := Get('SIdUndeclared');
+ SClassRequired := Get('SClassRequired');
+ SIndexRequired := Get('SIndexRequired');
+ SStringError := Get('SStringError');
+ SClassError := Get('SClassError');
+ SArrayRequired := Get('SArrayRequired');
+ SVarRequired := Get('SVarRequired');
+ SNotEnoughParams := Get('SNotEnoughParams');
+ STooManyParams := Get('STooManyParams');
+ SLeftCantAssigned := Get('SLeftCantAssigned');
+ SForError := Get('SForError');
+ SEventError := Get('SEventError');
+end;
+
+type
+ THelpTopic = record
+ Sender: String;
+ Topic: String;
+ end;
+
+const
+ helpTopicsCount = 17;
+ helpTopics: array[0..helpTopicsCount - 1] of THelpTopic =
+ (
+ (Sender: 'TfrxDesignerForm'; Topic: 'Designer.htm'),
+ (Sender: 'TfrxOptionsEditor'; Topic: 'Designer_options.htm'),
+ (Sender: 'TfrxReportEditorForm'; Topic: 'Report_options.htm'),
+ (Sender: 'TfrxPageEditorForm'; Topic: 'Page_options.htm'),
+ (Sender: 'TfrxCrossEditorForm'; Topic: 'Cross_tab_reports.htm'),
+ (Sender: 'TfrxChartEditorForm'; Topic: 'Diagrams.htm'),
+ (Sender: 'TfrxSyntaxMemo'; Topic: 'Script.htm'),
+ (Sender: 'TfrxDialogPage'; Topic: 'Dialogue_forms.htm'),
+ (Sender: 'TfrxDialogComponent'; Topic: 'Data_access_components.htm'),
+ (Sender: 'TfrxVarEditorForm'; Topic: 'Variables.htm'),
+ (Sender: 'TfrxHighlightEditorForm'; Topic: 'Conditional_highlighting.htm'),
+ (Sender: 'TfrxSysMemoEditorForm'; Topic: 'Inserting_aggregate_function.htm'),
+ (Sender: 'TfrxFormatEditorForm'; Topic: 'Values_formatting.htm'),
+ (Sender: 'TfrxGroupEditorForm'; Topic: 'Report_with_groups.htm'),
+ (Sender: 'TfrxPictureEditorForm'; Topic: 'Picture_object.htm'),
+ (Sender: 'TfrxMemoEditorForm'; Topic: 'Text_object.htm'),
+ (Sender: 'TfrxSQLEditorForm'; Topic: 'TfrxADOQuery.htm')
+ );
+
+
+
+
+procedure TfrxResources.Help(Sender: TObject);
+var
+ i: Integer;
+ topic: String;
+begin
+ topic := '';
+ if Sender <> nil then
+ for i := 0 to helpTopicsCount - 1 do
+ if CompareText(helpTopics[i].Sender, Sender.ClassName) = 0 then
+ topic := '::/' + helpTopics[i].Topic;
+end;
+
+procedure TfrxResources.BuildLanguagesList;
+var
+ i: Integer;
+ SRec: TSearchRec;
+ Dir: String;
+ s: String;
+begin
+ Dir := GetAppPath;
+ FLanguages.Clear;
+ i := FindFirst(Dir + '*.frc', faAnyFile, SRec);
+ try
+ while i = 0 do
+ begin
+ s := LowerCase(SRec.Name);
+ s := UpperCase(Copy(s, 1, 1)) + Copy(s, 2, Length(s) - 1);
+ s := StringReplace(s, '.frc', '', []);
+ FLanguages.Add(s);
+ i := FindNext(SRec);
+ end;
+ FLanguages.Sort;
+ finally
+ FindClose(Srec);
+ end;
+end;
+
+
+function frxResources: TfrxResources;
+begin
+ if FResources = nil then
+ FResources := TfrxResources.Create;
+ Result := FResources;
+end;
+
+function frxGet(ID: Integer): String;
+begin
+ Result := frxResources.Get(IntToStr(ID));
+end;
+
+
+initialization
+
+finalization
+ if FResources <> nil then
+ FResources.Free;
+ FResources := nil;
+
+end.
+
diff --git a/LibD28/FMX.frxSearchDialog.fmx b/LibD28/FMX.frxSearchDialog.fmx
new file mode 100644
index 0000000..fe9a965
--- /dev/null
+++ b/LibD28/FMX.frxSearchDialog.fmx
@@ -0,0 +1,104 @@
+object frxSearchDialog: TfrxSearchDialog
+ Left = 0
+ Top = 0
+ Caption = 'Find text'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 206
+ ClientWidth = 252
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnActivate = FormActivate
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object ReplacePanel: TPanel
+ Align = alTop
+ Position.Point = '(0,49)'
+ Width = 252.000000000000000000
+ Height = 52.000000000000000000
+ Visible = False
+ TabOrder = 0
+ object ReplaceL: TLabel
+ Position.Point = '(8,4)'
+ Width = 61.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object ReplaceE: TEdit
+ Position.Point = '(8,20)'
+ Width = 237.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 98
+ TabOrder = 1
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+ object Panel2: TPanel
+ Align = alTop
+ Width = 252.000000000000000000
+ Height = 49.000000000000000000
+ TabOrder = 1
+ object TextL: TLabel
+ Position.Point = '(8,4)'
+ Width = 169.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object TextE: TEdit
+ Position.Point = '(8,20)'
+ Width = 237.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 98
+ TabOrder = 1
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+ object Panel3: TPanel
+ Align = alTop
+ Position.Point = '(0,49)'
+ Width = 252.000000000000000000
+ Height = 105.000000000000000000
+ TabOrder = 2
+ object OkB: TButton
+ Position.Point = '(90,76)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 40
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(170,76)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 50
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object SearchL: TGroupBox
+ Position.Point = '(8,0)'
+ Width = 237.000000000000000000
+ Height = 65.000000000000000000
+ TabOrder = 2
+ object CaseCB: TCheckBox
+ Position.Point = '(8,40)'
+ Width = 177.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 107
+ TabOrder = 0
+ end
+ object TopCB: TCheckBox
+ Position.Point = '(8,20)'
+ Width = 177.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ end
+ end
+end
diff --git a/LibD28/FMX.frxSearchDialog.pas b/LibD28/FMX.frxSearchDialog.pas
new file mode 100644
index 0000000..3505e0b
--- /dev/null
+++ b/LibD28/FMX.frxSearchDialog.pas
@@ -0,0 +1,103 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Search dialog }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxSearchDialog;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.UITypes,
+ FMX.Controls, FMX.Forms, FMX.Edit, FMX.Types
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+type
+{$IFDEF LINUX}
+ TfrxSearchDialog = class(TfrxForm)
+{$ELSE}
+ TfrxSearchDialog = class(TForm)
+{$ENDIF}
+ ReplacePanel: TPanel;
+ ReplaceL: TLabel;
+ ReplaceE: TEdit;
+ Panel2: TPanel;
+ TextL: TLabel;
+ TextE: TEdit;
+ Panel3: TPanel;
+ OkB: TButton;
+ CancelB: TButton;
+ SearchL: TGroupBox;
+ CaseCB: TCheckBox;
+ TopCB: TCheckBox;
+ procedure FormCreate(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormActivate(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ public
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses
+ FMX.frxRes, FMX.frxFMX;
+
+var
+ LastText: String;
+
+procedure TfrxSearchDialog.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+ if ModalResult = mrOk then
+ LastText := TextE.Text;
+end;
+
+procedure TfrxSearchDialog.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(300);
+ TextL.Text := frxGet(301);
+ SearchL.Text := frxGet(302);
+ ReplaceL.Text := frxGet(303);
+ TopCB.Text := frxGet(304);
+ CaseCB.Text := frxGet(305);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ TextE.Text := LastText;
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+end;
+
+procedure TfrxSearchDialog.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VK_F1 then
+ frxResources.Help(Self);
+end;
+
+procedure TfrxSearchDialog.FormActivate(Sender: TObject);
+begin
+ TextE.SetFocus;
+ TextE.SelectAll;
+end;
+
+end.
+
+
diff --git a/LibD28/FMX.frxStdWizard.pas b/LibD28/FMX.frxStdWizard.pas
new file mode 100644
index 0000000..8c2c07e
--- /dev/null
+++ b/LibD28/FMX.frxStdWizard.pas
@@ -0,0 +1,1095 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Standard Report wizard }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit frxStdWizard;
+
+interface
+
+{$I frx.inc}
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ StdCtrls, Buttons, ComCtrls, ExtCtrls, frxClass, frxDesgn
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+type
+ TfrxStdWizard = class(TfrxCustomWizard)
+ public
+ class function GetDescription: String; override;
+ function Execute: Boolean; override;
+ end;
+
+ TfrxDotMatrixWizard = class(TfrxCustomWizard)
+ public
+ class function GetDescription: String; override;
+ function Execute: Boolean; override;
+ end;
+
+ TfrxStdEmptyWizard = class(TfrxCustomWizard)
+ public
+ class function GetDescription: String; override;
+ function Execute: Boolean; override;
+ end;
+
+ TfrxDMPEmptyWizard = class(TfrxCustomWizard)
+ public
+ class function GetDescription: String; override;
+ function Execute: Boolean; override;
+ end;
+
+ TfrxStdWizardForm = class(TForm)
+ Pages: TPageControl;
+ FieldsTab: TTabSheet;
+ GroupsTab: TTabSheet;
+ LayoutTab: TTabSheet;
+ FieldsLB: TListBox;
+ AddFieldB: TSpeedButton;
+ AddAllFieldsB: TSpeedButton;
+ RemoveFieldB: TSpeedButton;
+ RemoveAllFieldsB: TSpeedButton;
+ SelectedFieldsLB: TListBox;
+ SelectedFieldsL: TLabel;
+ FieldUpB: TSpeedButton;
+ FieldDownB: TSpeedButton;
+ AvailableFieldsLB: TListBox;
+ AddGroupB: TSpeedButton;
+ RemoveGroupB: TSpeedButton;
+ GroupsLB: TListBox;
+ GroupsL: TLabel;
+ GroupUpB: TSpeedButton;
+ GroupDownB: TSpeedButton;
+ AvailableFieldsL: TLabel;
+ BackB: TButton;
+ NextB: TButton;
+ FinishB: TButton;
+ FitWidthCB: TCheckBox;
+ Step2L: TLabel;
+ Step3L: TLabel;
+ Step4L: TLabel;
+ StyleTab: TTabSheet;
+ Step5L: TLabel;
+ ScrollBox1: TScrollBox;
+ StylePB: TPaintBox;
+ StyleLB: TListBox;
+ OrientationL: TGroupBox;
+ LayoutL: TGroupBox;
+ PortraitImg: TImage;
+ LandscapeImg: TImage;
+ PortraitRB: TRadioButton;
+ LandscapeRB: TRadioButton;
+ TabularRB: TRadioButton;
+ ColumnarRB: TRadioButton;
+ DataTab: TTabSheet;
+ DatasetsCB: TComboBox;
+ Step1L: TLabel;
+ NewTableB: TButton;
+ NewQueryB: TButton;
+ ScrollBox2: TScrollBox;
+ LayoutPB: TPaintBox;
+ AvailableFieldsL1: TLabel;
+ procedure FormCreate(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure DatasetsCBClick(Sender: TObject);
+ procedure AddFieldBClick(Sender: TObject);
+ procedure AddAllFieldsBClick(Sender: TObject);
+ procedure RemoveFieldBClick(Sender: TObject);
+ procedure RemoveAllFieldsBClick(Sender: TObject);
+ procedure AddGroupBClick(Sender: TObject);
+ procedure RemoveGroupBClick(Sender: TObject);
+ procedure FieldUpBClick(Sender: TObject);
+ procedure FieldDownBClick(Sender: TObject);
+ procedure GroupUpBClick(Sender: TObject);
+ procedure GroupDownBClick(Sender: TObject);
+ procedure NextBClick(Sender: TObject);
+ procedure BackBClick(Sender: TObject);
+ procedure GroupsTabShow(Sender: TObject);
+ procedure StylePBPaint(Sender: TObject);
+ procedure PortraitRBClick(Sender: TObject);
+ procedure PagesChange(Sender: TObject);
+ procedure StyleLBClick(Sender: TObject);
+ procedure FinishBClick(Sender: TObject);
+ procedure NewTableBClick(Sender: TObject);
+ procedure NewQueryBClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+ procedure LayoutPBPaint(Sender: TObject);
+ procedure TabularRBClick(Sender: TObject);
+ private
+ FDesigner: TfrxDesignerForm;
+ FDotMatrix: Boolean;
+ FLayoutReport: TfrxReport;
+ FReport: TfrxReport;
+ FStyleReport: TfrxReport;
+ FStyleSheet: TfrxStyleSheet;
+ procedure DrawSample(PaintBox: TPaintBox; Report: TfrxReport);
+ procedure FillDatasets;
+ procedure FillFields;
+ procedure NewDBItem(const wizName: String);
+ procedure UpdateAvailableFields;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ end;
+
+
+implementation
+
+{$R *.DFM}
+{$R *.RES}
+
+uses
+ frxEditReportData, frxDsgnIntf, frxRes, frxUtils, frxDMPClass,
+ IniFiles, Registry, Printers;
+
+const
+ StyleReport =
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'';
+
+ LayoutTabularReport =
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'';
+
+ LayoutColumnarReport =
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'';
+
+
+ Style =
+'' +
+'' +
+'' +
+'' +
+'' +
+'' +
+'';
+
+
+
+{ TfrxStdWizard }
+
+class function TfrxStdWizard.GetDescription: String;
+begin
+ Result := frxResources.Get('wzStd');
+end;
+
+function TfrxStdWizard.Execute: Boolean;
+begin
+ with TfrxStdWizardForm.Create(Owner) do
+ begin
+ FDesigner := TfrxDesignerForm(Self.Designer);
+ FReport := Report;
+ Result := ShowModal = mrOk;
+ Free;
+ end;
+end;
+
+
+{ TfrxDotMatrixWizard }
+
+class function TfrxDotMatrixWizard.GetDescription: String;
+begin
+ Result := frxResources.Get('wzDMP');
+end;
+
+function TfrxDotMatrixWizard.Execute: Boolean;
+begin
+ with TfrxStdWizardForm.Create(Owner) do
+ begin
+ FDesigner := TfrxDesignerForm(Self.Designer);
+ FDotMatrix := True;
+ FReport := Report;
+ Result := ShowModal = mrOk;
+ Free;
+ end;
+end;
+
+
+{ TfrxStdEmptyWizard }
+
+class function TfrxStdEmptyWizard.GetDescription: String;
+begin
+ Result := frxResources.Get('wzStdEmpty');
+end;
+
+function TfrxStdEmptyWizard.Execute: Boolean;
+var
+ Page: TfrxPage;
+begin
+ Result := True;
+ try
+ Designer.Lock;
+ Report.Clear;
+ Report.FileName := '';
+ Report.DotMatrixReport := False;
+
+ Page := TfrxDataPage.Create(Report);
+ Page.Name := 'Data';
+ Page := TfrxReportPage.Create(Report);
+ Page.Name := 'Page1';
+ TfrxReportPage(Page).SetDefaults;
+ finally
+ Designer.ReloadReport;
+ end;
+end;
+
+
+{ TfrxDMPEmptyWizard }
+
+class function TfrxDMPEmptyWizard.GetDescription: String;
+begin
+ Result := frxResources.Get('wzDMPEmpty');
+end;
+
+function TfrxDMPEmptyWizard.Execute: Boolean;
+var
+ Page: TfrxPage;
+begin
+ Result := True;
+ try
+ Designer.Lock;
+ Report.Clear;
+ Report.FileName := '';
+ Report.DotMatrixReport := True;
+
+ Page := TfrxDataPage.Create(Report);
+ Page.Name := 'Data';
+ Page := TfrxDMPPage.Create(Report);
+ Page.Name := 'Page1';
+ TfrxReportPage(Page).SetDefaults;
+ finally
+ Designer.ReloadReport;
+ end;
+end;
+
+
+{ TfrxStdWizardForm }
+
+constructor TfrxStdWizardForm.Create(AOwner: TComponent);
+var
+ s: TStringStream;
+begin
+ inherited;
+ FStyleReport := TfrxReport.Create(nil);
+ s := TStringStream.Create(StyleReport, TEncoding.UTF8);
+ FStyleReport.LoadFromStream(s);
+ s.Free;
+ FLayoutReport := TfrxReport.Create(nil);
+
+ FStyleSheet := TfrxStyleSheet.Create;
+ if FileExists(ExtractFilePath(Application.ExeName) + 'wizstyle.xml') then
+ FStyleSheet.LoadFromFile(ExtractFilePath(Application.ExeName) + 'wizstyle.xml')
+ else
+ begin
+ s := TStringStream.Create(Style, TEncoding.UTF8);
+ FStyleSheet.LoadFromStream(s);
+ s.Free;
+ end;
+end;
+
+destructor TfrxStdWizardForm.Destroy;
+begin
+ FStyleReport.Free;
+ FLayoutReport.Free;
+ FStyleSheet.Free;
+ inherited;
+end;
+
+procedure TfrxStdWizardForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(5600);
+ DataTab.Caption := frxGet(5601);
+ FieldsTab.Caption := frxGet(5602);
+ GroupsTab.Caption := frxGet(5603);
+ LayoutTab.Caption := frxGet(5604);
+ StyleTab.Caption := frxGet(5605);
+ Step1L.Caption := frxGet(5606);
+ Step2L.Caption := frxGet(5607);
+ Step3L.Caption := frxGet(5608);
+ Step4L.Caption := frxGet(5609);
+ Step5L.Caption := frxGet(5610);
+ AddFieldB.Caption := frxGet(5611);
+ AddAllFieldsB.Caption := frxGet(5612);
+ RemoveFieldB.Caption := frxGet(5613);
+ RemoveAllFieldsB.Caption := frxGet(5614);
+ AddGroupB.Caption := frxGet(5615);
+ RemoveGroupB.Caption := frxGet(5616);
+ SelectedFieldsL.Caption := frxGet(5617);
+ AvailableFieldsL.Caption := frxGet(5618);
+ AvailableFieldsL1.Caption := frxGet(5618);
+ GroupsL.Caption := frxGet(5619);
+ OrientationL.Caption := frxGet(5620);
+ LayoutL.Caption := frxGet(5621);
+ PortraitRB.Caption := frxGet(5622);
+ LandscapeRB.Caption := frxGet(5623);
+ TabularRB.Caption := frxGet(5624);
+ ColumnarRB.Caption := frxGet(5625);
+ FitWidthCB.Caption := frxGet(5626);
+ BackB.Caption := frxGet(5627);
+ NextB.Caption := frxGet(5628);
+ FinishB.Caption := frxGet(5629);
+ NewTableB.Caption := frxGet(5630);
+ NewQueryB.Caption := frxGet(5631);
+
+ if UseRightToLeftAlignment then
+ FlipChildren(True);
+end;
+
+procedure TfrxStdWizardForm.FormShow(Sender: TObject);
+var
+ Page: TfrxPage;
+begin
+ FDesigner.Lock;
+ FReport.Clear;
+
+ Page := TfrxDataPage.Create(FReport);
+ Page.Name := 'Data';
+
+ if FDotMatrix then
+ Page := TfrxDMPPage.Create(FReport) else
+ Page := TfrxReportPage.Create(FReport);
+ Page.Name := 'Page1';
+ TfrxReportPage(Page).SetDefaults;
+ FDesigner.SetReportDefaults;
+ FDesigner.ReloadReport;
+
+ FillDatasets;
+ DatasetsCB.ItemIndex := 0;
+ DatasetsCBClick(nil);
+
+ FStyleSheet.GetList(StyleLB.Items);
+ StyleLB.ItemIndex := 0;
+ StyleLBClick(nil);
+
+ TabularRBClick(nil);
+ if FDotMatrix then
+ StyleTab.Free;
+end;
+
+procedure TfrxStdWizardForm.FillDatasets;
+var
+ i: Integer;
+ ds: TfrxDataSet;
+ dsList: TStringList;
+begin
+ dsList := TStringList.Create;
+ FReport.GetActiveDataSetList(dsList);
+ dsList.Sort;
+
+ DatasetsCB.Clear;
+
+ for i := 0 to dsList.Count - 1 do
+ begin
+ ds := TfrxDataSet(dsList.Objects[i]);
+ if ds is TfrxCustomDBDataSet then
+ DatasetsCB.Items.AddObject(ds.UserName, ds);
+ end;
+
+ dsList.Free;
+end;
+
+procedure TfrxStdWizardForm.FillFields;
+var
+ ds: TfrxDataSet;
+begin
+ FieldsLB.Clear;
+ SelectedFieldsLB.Clear;
+ UpdateAvailableFields;
+
+ if DatasetsCB.ItemIndex <> -1 then
+ begin
+ ds := TfrxDataSet(DatasetsCB.Items.Objects[DatasetsCB.ItemIndex]);
+ ds.GetFieldList(FieldsLB.Items);
+ end;
+
+ if FieldsLB.Items.Count <> 0 then
+ begin
+ FieldsLB.ItemIndex := 0;
+ FieldsLB.Selected[0] := True;
+ end;
+end;
+
+procedure TfrxStdWizardForm.UpdateAvailableFields;
+begin
+ AvailableFieldsLB.Items := SelectedFieldsLB.Items;
+ GroupsLB.Clear;
+end;
+
+procedure TfrxStdWizardForm.NewDBItem(const wizName: String);
+var
+ i: Integer;
+ wiz: TfrxCustomWizard;
+begin
+ for i := 0 to frxWizards.Count - 1 do
+ if frxWizards[i].ClassRef.ClassName = wizName then
+ begin
+ wiz := TfrxCustomWizard(frxWizards[i].ClassRef.NewInstance);
+ wiz.Create(FDesigner);
+ try
+ FReport.Datasets.Clear;
+ if wiz.Execute then
+ begin
+ FillDatasets;
+ DatasetsCB.ItemIndex := DatasetsCB.Items.IndexOf(FReport.Datasets[0].Dataset.UserName);
+ DatasetsCBClick(nil);
+ FReport.Datasets.Clear;
+ FDesigner.ReloadReport;
+ end;
+ finally
+ wiz.Free;
+ end;
+ break;
+ end;
+end;
+
+procedure TfrxStdWizardForm.DrawSample(PaintBox: TPaintBox; Report: TfrxReport);
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ with PaintBox do
+ begin
+ Canvas.Pen.Color := clBlack;
+ Canvas.Brush.Color := clWindow;
+ Canvas.Rectangle(0, 0, Width, Height);
+
+ for i := 0 to Report.AllObjects.Count - 1 do
+ begin
+ c := Report.AllObjects[i];
+ if c is TfrxCustomMemoView then
+ with TfrxCustomMemoView(c) do
+ Draw(Canvas, 1, 1, 10, 10);
+ end;
+ end;
+end;
+
+procedure TfrxStdWizardForm.DatasetsCBClick(Sender: TObject);
+begin
+ FillFields;
+end;
+
+procedure TfrxStdWizardForm.NewTableBClick(Sender: TObject);
+begin
+ NewDBItem('TfrxDBTableWizard');
+end;
+
+procedure TfrxStdWizardForm.NewQueryBClick(Sender: TObject);
+begin
+ NewDBItem('TfrxDBQueryWizard');
+end;
+
+procedure TfrxStdWizardForm.AddFieldBClick(Sender: TObject);
+var
+ i, j: Integer;
+begin
+ if FieldsLB.ItemIndex = -1 then Exit;
+
+ i := 0;
+ j := -1;
+ while i < FieldsLB.Items.Count do
+ if FieldsLB.Selected[i] then
+ begin
+ if j = -1 then
+ j := i;
+ SelectedFieldsLB.Items.Add(FieldsLB.Items[i]);
+ FieldsLB.Items.Delete(i);
+ end
+ else
+ Inc(i);
+
+ if j = FieldsLB.Items.Count then
+ Dec(j);
+ if j <> -1 then
+ begin
+ FieldsLB.ItemIndex := j;
+ FieldsLB.Selected[j] := True;
+ end;
+
+ UpdateAvailableFields;
+end;
+
+procedure TfrxStdWizardForm.AddAllFieldsBClick(Sender: TObject);
+begin
+ if FieldsLB.Items.Count = 0 then Exit;
+ FillFields;
+ SelectedFieldsLB.Items := FieldsLB.Items;
+{$IFDEF DELPHI23}
+ FieldsLB.Clear;
+{$ELSE}
+ FieldsLB.Items.Clear;
+{$ENDIF}
+ UpdateAvailableFields;
+end;
+
+procedure TfrxStdWizardForm.RemoveFieldBClick(Sender: TObject);
+var
+ i, j: Integer;
+begin
+ if SelectedFieldsLB.ItemIndex = -1 then Exit;
+
+ i := 0;
+ j := -1;
+ while i < SelectedFieldsLB.Items.Count do
+ if SelectedFieldsLB.Selected[i] then
+ begin
+ if j = -1 then
+ j := i;
+ FieldsLB.Items.Add(SelectedFieldsLB.Items[i]);
+ SelectedFieldsLB.Items.Delete(i);
+ end
+ else
+ Inc(i);
+
+ if j = SelectedFieldsLB.Items.Count then
+ Dec(j);
+ if j <> -1 then
+ begin
+ SelectedFieldsLB.ItemIndex := j;
+ SelectedFieldsLB.Selected[j] := True;
+ end;
+
+ UpdateAvailableFields;
+end;
+
+procedure TfrxStdWizardForm.RemoveAllFieldsBClick(Sender: TObject);
+begin
+ FillFields;
+end;
+
+procedure TfrxStdWizardForm.AddGroupBClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ i := AvailableFieldsLB.ItemIndex;
+ if i = -1 then Exit;
+ GroupsLB.Items.Add(AvailableFieldsLB.Items[i]);
+ AvailableFieldsLB.Items.Delete(i);
+ AvailableFieldsLB.ItemIndex := i;
+end;
+
+procedure TfrxStdWizardForm.RemoveGroupBClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ i := GroupsLB.ItemIndex;
+ if i = -1 then Exit;
+ AvailableFieldsLB.Items.Add(GroupsLB.Items[i]);
+ GroupsLB.Items.Delete(i);
+ GroupsLB.ItemIndex := i;
+end;
+
+procedure TfrxStdWizardForm.FieldUpBClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ i := SelectedFieldsLB.ItemIndex;
+ if i < 1 then Exit;
+ SelectedFieldsLB.Items.Exchange(i, i - 1);
+ UpdateAvailableFields;
+end;
+
+procedure TfrxStdWizardForm.FieldDownBClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ i := SelectedFieldsLB.ItemIndex;
+ if (i = -1) or (SelectedFieldsLB.Items.Count = 0) or
+ (i = SelectedFieldsLB.Items.Count - 1) then Exit;
+ SelectedFieldsLB.Items.Exchange(i, i + 1);
+ SelectedFieldsLB.ItemIndex := i + 1;
+ UpdateAvailableFields;
+end;
+
+procedure TfrxStdWizardForm.GroupUpBClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ i := GroupsLB.ItemIndex;
+ if i < 1 then Exit;
+ GroupsLB.Items.Exchange(i, i - 1);
+end;
+
+procedure TfrxStdWizardForm.GroupDownBClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ i := GroupsLB.ItemIndex;
+ if (i = -1) or (i = GroupsLB.Items.Count - 1) then Exit;
+ GroupsLB.Items.Exchange(i, i + 1);
+ GroupsLB.ItemIndex := i + 1;
+end;
+
+procedure TfrxStdWizardForm.NextBClick(Sender: TObject);
+begin
+ Pages.SelectNextPage(True);
+ PagesChange(nil);
+end;
+
+procedure TfrxStdWizardForm.BackBClick(Sender: TObject);
+begin
+ Pages.SelectNextPage(False);
+ PagesChange(nil);
+end;
+
+procedure TfrxStdWizardForm.PagesChange(Sender: TObject);
+begin
+ if not FDotMatrix then
+ NextB.Enabled := Pages.ActivePage <> StyleTab else
+ NextB.Enabled := Pages.ActivePage <> LayoutTab;
+ BackB.Enabled := Pages.ActivePage <> DataTab;
+end;
+
+procedure TfrxStdWizardForm.GroupsTabShow(Sender: TObject);
+begin
+ AvailableFieldsLB.ItemIndex := 0;
+end;
+
+procedure TfrxStdWizardForm.StylePBPaint(Sender: TObject);
+begin
+ DrawSample(StylePB, FStyleReport);
+end;
+
+procedure TfrxStdWizardForm.LayoutPBPaint(Sender: TObject);
+begin
+ DrawSample(LayoutPB, FLayoutReport);
+end;
+
+procedure TfrxStdWizardForm.PortraitRBClick(Sender: TObject);
+begin
+ PortraitImg.Visible := PortraitRB.Checked;
+ LandscapeImg.Visible := LandscapeRB.Checked;
+end;
+
+procedure TfrxStdWizardForm.StyleLBClick(Sender: TObject);
+begin
+ FStyleReport.Styles := FStyleSheet.Find(StyleLB.Items[StyleLB.ItemIndex]);
+ StylePBPaint(nil);
+end;
+
+procedure TfrxStdWizardForm.TabularRBClick(Sender: TObject);
+var
+ s: TStringStream;
+begin
+ if TabularRB.Checked then
+ s := TStringStream.Create(LayoutTabularReport, TEncoding.UTF8)
+ else
+ s := TStringStream.Create(LayoutColumnarReport, TEncoding.UTF8);
+ FLayoutReport.LoadFromStream(s);
+ s.Free;
+ FLayoutReport.Styles := FStyleSheet[0];
+ LayoutPBPaint(nil);
+end;
+
+procedure TfrxStdWizardForm.FinishBClick(Sender: TObject);
+var
+ DataSet: TfrxDataSet;
+ Page: TfrxReportPage;
+ Band: TfrxBand;
+ Memo: TfrxCustomMemoView;
+ CurY, PageWidth, MaxHeaderWidth: Extended;
+ Widths, HeaderWidths, DataWidths: array of Extended;
+
+ function Duplicate(n: Integer): String;
+ begin
+ Result := StringOfChar(Char('0'), n)
+ end;
+
+ function CreateMemo(Parent: TfrxComponent): TfrxCustomMemoView;
+ begin
+ if FDotMatrix then
+ Result := TfrxDMPMemoView.Create(Parent) else
+ Result := TfrxMemoView.Create(Parent);
+ if Parent <> nil then
+ Result.CreateUniqueName;
+ end;
+
+ procedure CreatePage;
+ begin
+ Page := TfrxReportPage(FReport.Pages[1]);
+ if PortraitRB.Checked then
+ Page.Orientation := poPortrait else
+ Page.Orientation := poLandscape;
+ PageWidth := (Page.PaperWidth - Page.LeftMargin - Page.RightMargin) * 96 / 25.4;
+ end;
+
+ procedure CreateWidthsArray;
+ var
+ i, FieldsCount: Integer;
+ HeaderMemo, DataMemo: TfrxCustomMemoView;
+ MaxWidth, HeadersWidth, GapWidth: Extended;
+ Style: TfrxStyles;
+ begin
+ FieldsCount := AvailableFieldsLB.Items.Count;
+ SetLength(Widths, FieldsCount);
+ SetLength(HeaderWidths, FieldsCount);
+ SetLength(DataWidths, FieldsCount);
+
+ HeaderMemo := CreateMemo(nil);
+ DataMemo := CreateMemo(nil);
+ if not FDotMatrix then
+ begin
+ Style := FStyleSheet.Find(StyleLB.Items[StyleLB.ItemIndex]);
+ HeaderMemo.ApplyStyle(Style.Find('Header'));
+ DataMemo.ApplyStyle(Style.Find('Data'));
+ end;
+
+ MaxWidth := 0;
+ HeadersWidth := 0;
+ MaxHeaderWidth := 0;
+ GapWidth := 0;
+ for i := 0 to FieldsCount - 1 do
+ begin
+ HeaderMemo.Text := AvailableFieldsLB.Items[i];
+ DataMemo.Text := Duplicate(DataSet.DisplayWidth[AvailableFieldsLB.Items[i]]);
+ HeaderWidths[i] := HeaderMemo.CalcWidth;
+ DataWidths[i] := DataMemo.CalcWidth;
+ if HeaderWidths[i] > DataWidths[i] then
+ Widths[i] := HeaderWidths[i]
+ else
+ begin
+ Widths[i] := DataWidths[i];
+ GapWidth := GapWidth + DataWidths[i] - HeaderWidths[i];
+ end;
+ MaxWidth := MaxWidth + Widths[i];
+ HeadersWidth := HeadersWidth + HeaderWidths[i];
+ if HeaderWidths[i] > MaxHeaderWidth then
+ MaxHeaderWidth := HeaderWidths[i];
+ end;
+
+ if FitWidthCB.Checked and (MaxWidth > PageWidth) then
+ begin
+ if HeadersWidth > PageWidth then
+ begin
+ for i := 0 to FieldsCount - 1 do
+ Widths[i] := HeaderWidths[i] / (HeadersWidth / PageWidth);
+ end
+ else
+ begin
+ for i := 0 to FieldsCount - 1 do
+ if HeaderWidths[i] < DataWidths[i] then
+ Widths[i] := Widths[i] - (DataWidths[i] - HeaderWidths[i]) /
+ GapWidth * (MaxWidth - PageWidth);
+ end;
+ end;
+
+ HeaderMemo.Free;
+ DataMemo.Free;
+ end;
+
+ procedure CreateTitle;
+ begin
+ Band := TfrxReportTitle.Create(Page);
+ Band.CreateUniqueName;
+ Band.SetBounds(0, 0, 0, fr01cm * 7);
+ CurY := 30;
+
+ Memo := CreateMemo(Band);
+ Memo.SetBounds(0, 0, 0, fr01cm * 6);
+ Memo.Align := baWidth;
+ Memo.HAlign := haCenter;
+ Memo.VAlign := vaCenter;
+ Memo.Text := 'Report';
+ Memo.Style := 'Title';
+ end;
+
+ procedure CreateHeader;
+ var
+ i: Integer;
+ X, Y: Extended;
+ HeaderMemo: TfrxCustomMemoView;
+ begin
+ if ColumnarRB.Checked then Exit;
+
+ Band := TfrxPageHeader.Create(Page);
+ Band.CreateUniqueName;
+ Band.SetBounds(0, CurY, 0, fr01cm * 7);
+
+ HeaderMemo := CreateMemo(Band);
+ HeaderMemo.SetBounds(0, 0, PageWidth, 0);
+ HeaderMemo.Style := 'Header line';
+
+ X := 0;
+ Y := 0;
+ for i := 0 to AvailableFieldsLB.Items.Count - 1 do
+ begin
+ if X + Widths[i] > PageWidth + 1 then
+ begin
+ X := 0;
+ Y := Y + fr01cm * 6;
+ end;
+
+ Memo := CreateMemo(Band);
+ Memo.SetBounds(X, Y, Widths[i], fr01cm * 6);
+ Memo.Text := AvailableFieldsLB.Items[i];
+ Memo.Style := 'Header';
+
+ X := X + Widths[i];
+ end;
+
+ Band.Height := Y + fr01cm * 6;
+ HeaderMemo.Height := Band.Height;
+ if FDotMatrix then
+ HeaderMemo.Free;
+ CurY := CurY + Band.Height;
+ end;
+
+ procedure CreateGroupHeaders;
+ var
+ i: Integer;
+ begin
+ for i := 0 to GroupsLB.Items.Count - 1 do
+ begin
+ Band := TfrxGroupHeader.Create(Page);
+ Band.CreateUniqueName;
+ Band.SetBounds(0, CurY, 0, fr01cm * 7);
+ TfrxGroupHeader(Band).Condition := DataSet.UserName + '."' + GroupsLB.Items[i] + '"';
+ CurY := CurY + 30;
+
+ Memo := CreateMemo(Band);
+ Memo.SetBounds(0, 0, 0, fr01cm * 6);
+ Memo.Align := baWidth;
+ Memo.VAlign := vaCenter;
+ Memo.DataSet := DataSet;
+ Memo.DataField := GroupsLB.Items[i];
+ Memo.Style := 'Group header';
+ end;
+ end;
+
+ procedure CreateData;
+ var
+ i: Integer;
+ X, Y: Extended;
+ begin
+ Band := TfrxMasterData.Create(Page);
+ Band.CreateUniqueName;
+ Band.SetBounds(0, CurY, 0, 0);
+ TfrxMasterData(Band).DataSet := DataSet;
+ CurY := CurY + 30;
+
+ X := 0;
+ Y := 0;
+ for i := 0 to AvailableFieldsLB.Items.Count - 1 do
+ begin
+ if ColumnarRB.Checked then
+ begin
+ Memo := CreateMemo(Band);
+ Memo.SetBounds(0, Y, MaxHeaderWidth, fr01cm * 5);
+ Memo.Text := AvailableFieldsLB.Items[i];
+ Memo.Style := 'Header';
+
+ Memo := CreateMemo(Band);
+ Memo.SetBounds(MaxHeaderWidth + fr01cm * 5, Y, DataWidths[i], fr01cm * 5);
+ Memo.DataSet := DataSet;
+ Memo.DataField := AvailableFieldsLB.Items[i];
+ Memo.Style := 'Data';
+
+ Y := Y + fr01cm * 5;
+ end
+ else
+ begin
+ if X + Widths[i] > PageWidth + 1 then
+ begin
+ X := 0;
+ Y := Y + fr01cm * 5;
+ end;
+
+ Memo := CreateMemo(Band);
+ Memo.SetBounds(X, Y, Widths[i], fr01cm * 5);
+ Memo.DataSet := DataSet;
+ Memo.DataField := AvailableFieldsLB.Items[i];
+ Memo.Style := 'Data';
+
+ X := X + Widths[i];
+ end;
+ end;
+
+ Band.Height := Y + fr01cm * 5;
+ CurY := CurY + Band.Height;
+ end;
+
+ procedure CreateGroupFooters;
+ var
+ i: Integer;
+ begin
+ CurY := 1000;
+ for i := GroupsLB.Items.Count - 1 downto 0 do
+ begin
+ Band := TfrxGroupFooter.Create(Page);
+ Band.CreateUniqueName;
+ Band.SetBounds(0, CurY, 0, 0);
+ CurY := CurY - 30;
+ end;
+ end;
+
+ procedure CreateFooter;
+ begin
+ Band := TfrxPageFooter.Create(Page);
+ Band.CreateUniqueName;
+ Band.SetBounds(0, 1000, 0, fr01cm * 7);
+
+ Memo := CreateMemo(Band);
+ Memo.Align := baWidth;
+ Memo.Frame.Typ := [ftTop];
+ Memo.Frame.Width := 2;
+
+ Memo := CreateMemo(Band);
+ Memo.SetBounds(0, 1, 0, fr01cm * 6);
+ Memo.AutoWidth := True;
+ Memo.Text := '[Date] [Time]';
+
+ Memo := CreateMemo(Band);
+ Memo.SetBounds(100, 1, fr1cm * 2, fr01cm * 6);
+ Memo.Align := baRight;
+ Memo.HAlign := haRight;
+ Memo.Text := 'Page [Page#]';
+ end;
+
+begin
+ try
+ FDesigner.Lock;
+ FReport.FileName := '';
+ FReport.DotMatrixReport := FDotMatrix;
+
+ DataSet := nil;
+ FReport.DataSets.Clear;
+ if DatasetsCB.ItemIndex <> -1 then
+ begin
+ DataSet := TfrxDataSet(DatasetsCB.Items.Objects[DatasetsCB.ItemIndex]);
+ FReport.DataSets.Add(DataSet);
+ end;
+
+ CreatePage;
+ CreateWidthsArray;
+ CreateTitle;
+ CreateHeader;
+ CreateGroupHeaders;
+ CreateData;
+ CreateGroupFooters;
+ CreateFooter;
+
+ if not FDotMatrix then
+ FReport.Styles := FStyleSheet.Find(StyleLB.Items[StyleLB.ItemIndex]);
+
+ finally
+ FDesigner.ReloadReport;
+ Widths := nil;
+ HeaderWidths := nil;
+ DataWidths := nil;
+ end;
+end;
+
+procedure TfrxStdWizardForm.FormKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ if Key = VK_F1 then
+ frxResources.Help(Self);
+end;
+
+
+initialization
+ frxWizards.Register1(TfrxStdWizard, 1);
+ frxWizards.Register1(TfrxStdEmptyWizard, 0);
+{$IFNDEF FR_LITE}
+ frxWizards.Register1(TfrxDotMatrixWizard, 1);
+ frxWizards.Register1(TfrxDMPEmptyWizard, 0);
+{$ENDIF}
+
+finalization
+ frxWizards.Unregister(TfrxStdWizard);
+ frxWizards.Unregister(TfrxStdEmptyWizard);
+{$IFNDEF FR_LITE}
+ frxWizards.Unregister(TfrxDotMatrixWizard);
+ frxWizards.Unregister(TfrxDMPEmptyWizard);
+{$ENDIF}
+
+end.
diff --git a/LibD28/FMX.frxSynMemo.pas b/LibD28/FMX.frxSynMemo.pas
new file mode 100644
index 0000000..7570f6c
--- /dev/null
+++ b/LibD28/FMX.frxSynMemo.pas
@@ -0,0 +1,2143 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Syntax memo control }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit frxSynMemo;
+
+interface
+
+{$I frx.inc}
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, StdCtrls,
+ Forms, frxCtrls, fs_iparser, frxPopupForm, Imm
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+type
+ TCharAttr = (caNo, caText, caBlock, caComment, caKeyword, caString,
+ caNumber);
+ TCharAttributes = set of TCharAttr;
+
+ TfrxCodeCompletionEvent = procedure(const Name: String; List: TStrings) of object;
+
+ TfrxSyntaxMemo = class(TfrxScrollWin)
+ private
+ FActiveLine: Integer;
+ FAllowLinesChange: Boolean;
+ FBlockColor: TColor;
+ FBlockFontColor: TColor;
+ FBookmarks: array[0..9] of Integer;
+ FCharHeight: Integer;
+ FCharWidth: Integer;
+ FCommentAttr: TFont;
+ FCompletionForm: TfrxPopupForm;
+ FCompletionLB: TListBox;
+ FDoubleClicked: Boolean;
+ FDown: Boolean;
+ FToggleBreakPointDown: Boolean;
+ FGutterWidth: Integer;
+ FIsMonoType: Boolean;
+ FKeywordAttr: TFont;
+ FMaxLength: Integer;
+ FMessage: String;
+ FModified: Boolean;
+ FMoved: Boolean;
+ FNumberAttr: TFont;
+ FOffset: TPoint;
+ FOnChangePos: TNotifyEvent;
+ FOnChangeText: TNotifyEvent;
+ FOnCodeCompletion: TfrxCodeCompletionEvent;
+ FParser: TfsParser;
+ FPos: TPoint;
+ FStringAttr: TFont;
+ FSelEnd: TPoint;
+ FSelStart: TPoint;
+ FCompSelStart: TPoint;
+ FCompSelEnd: TPoint;
+ FShowGutter: boolean;
+ FSynStrings: TStrings;
+ FSyntax: String;
+ FTempPos: TPoint;
+ FText: TStringList;
+ FTextAttr: TFont;
+ FUndo: TStringList;
+ FUpdatingSyntax: Boolean;
+ FWindowSize: TPoint;
+ FBreakPoints: TStringList;
+ FTmpCanvas: TBitmap;
+ { need for east languages carret correction }
+ function GetCharWidth(Str: String): Integer;
+ function GetCharAttr(Pos: TPoint): TCharAttributes;
+ function GetLineBegin(Index: Integer): Integer;
+ function GetPlainTextPos(Pos: TPoint): Integer;
+ function GetPosPlainText(Pos: Integer): TPoint;
+ function GetRunLine(Index: Integer): Boolean;
+ function GetSelText: String;
+ function GetText: TStrings;
+ function LineAt(Index: Integer): String;
+ function LineLength(Index: Integer): Integer;
+ function Pad(n: Integer): String;
+ procedure AddSel;
+ procedure AddUndo;
+ procedure ClearSel;
+ procedure ClearSyntax(ClearFrom: Integer);
+ procedure CompletionLBDblClick(Sender: TObject);
+ procedure CompletionLBDrawItem(Control: TWinControl; Index: Integer;
+ ARect: TRect; State: TOwnerDrawState);
+ procedure CompletionLBKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure CorrectBookmark(Line, Delta: Integer);
+ procedure CorrectBreakPoints(Line, Delta: Integer);
+ procedure CreateSynArray(EndLine: Integer);
+ procedure DoBackspace;
+ procedure DoChange;
+ procedure DoChar(Ch: Char);
+ procedure DoCodeCompletion;
+ procedure DoCtrlI;
+ procedure DoCtrlU;
+ procedure DoCtrlR;
+ procedure DoCtrlL;
+ procedure DoDel;
+ procedure DoDown;
+ procedure DoEnd(Ctrl: Boolean);
+ procedure DoHome(Ctrl: Boolean);
+ procedure DoLeft;
+ procedure DoPgUp;
+ procedure DoPgDn;
+ procedure DoReturn;
+ procedure DoRight;
+ procedure DoUp;
+ procedure EnterIndent;
+ procedure LinesChange(Sender: TObject);
+ procedure SetActiveLine(Line: Integer);
+ procedure SetCommentAttr(Value: TFont);
+ procedure SetKeywordAttr(Value: TFont);
+ procedure SetNumberAttr(const Value: TFont);
+ procedure SetRunLine(Index: Integer; const Value: Boolean);
+ procedure SetSelText(const Value: String);
+ procedure SetShowGutter(Value: Boolean);
+ procedure SetStringAttr(Value: TFont);
+ procedure SetSyntax(const Value: String);
+ procedure SetText(Value: TStrings);
+ procedure SetTextAttr(Value: TFont);
+ procedure ShiftSelected(ShiftRight: Boolean);
+ procedure ShowCaretPos;
+ procedure TabIndent;
+ procedure UnIndent;
+ procedure UpdateScrollBar;
+ procedure WMKillFocus(var Msg: TWMKillFocus); message WM_KILLFOCUS;
+ procedure WMSetFocus(var Msg: TWMSetFocus); message WM_SETFOCUS;
+ procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
+ { Inline IME realisation }
+ procedure WMIMEStartComp(var Message: TMessage); message WM_IME_STARTCOMPOSITION;
+ procedure WMIMEEndComp(var Message: TMessage); message WM_IME_ENDCOMPOSITION;
+ procedure WMIMECOMPOSITION (var Message: TMessage); message WM_IME_COMPOSITION ;
+ function GetTextSelected: Boolean;
+ protected
+ procedure DblClick; override;
+ procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+ procedure KeyPress(var Key: Char); override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer); override;
+ procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer); override;
+ procedure MouseWheelDown(Sender: TObject; Shift: TShiftState;
+ MousePos: TPoint; var Handled: Boolean);
+ procedure MouseWheelUp(Sender: TObject; Shift: TShiftState;
+ MousePos: TPoint; var Handled: Boolean);
+ procedure OnHScrollChange(Sender: TObject); override;
+ procedure OnVScrollChange(Sender: TObject); override;
+ procedure Resize; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Paint; override;
+ procedure CopyToClipboard;
+ procedure CutToClipboard;
+ procedure PasteFromClipboard;
+ procedure SelectAll;
+ procedure SetPos(x, y: Integer);
+ procedure ShowMessage(const s: String);
+ procedure Undo;
+ procedure UpdateView;
+ function Find(const SearchText: String; CaseSensitive: Boolean;
+ var SearchFrom: Integer): Boolean;
+ function GetPlainPos: Integer;
+ function GetPos: TPoint;
+ function IsBookmark(Line: Integer): Integer;
+ procedure AddBookmark(Line, Number: Integer);
+ procedure DeleteBookmark(Number: Integer);
+ procedure GotoBookmark(Number: Integer);
+ procedure AddBreakPoint(Number: Integer; const Condition: String);
+ procedure ToggleBreakPoint(Number: Integer; const Condition: String);
+ procedure DeleteBreakPoint(Number: Integer);
+ procedure DeleteF4BreakPoints;
+ function IsBreakPoint(Number: Integer): Boolean;
+ function GetBreakPointCondition(Number: Integer): String;
+
+ property ActiveLine: Integer read FActiveLine write SetActiveLine;
+ property BlockColor: TColor read FBlockColor write FBlockColor;
+ property BlockFontColor: TColor read FBlockFontColor write FBlockFontColor;
+ property BreakPoints: TStringList read FBreakPoints;
+ property Color;
+ property CommentAttr: TFont read FCommentAttr write SetCommentAttr;
+ property Font;
+ property ImeMode;
+ property ImeName;
+ property GutterWidth: Integer read FGutterWidth write FGutterWidth;
+ property KeywordAttr: TFont read FKeywordAttr write SetKeywordAttr;
+ property Modified: Boolean read FModified write FModified;
+ property NumberAttr: TFont read FNumberAttr write SetNumberAttr;
+ property RunLine[Index: Integer]: Boolean read GetRunLine write SetRunLine;
+ property SelText: String read GetSelText write SetSelText;
+ property StringAttr: TFont read FStringAttr write SetStringAttr;
+ property TextAttr: TFont read FTextAttr write SetTextAttr;
+ property Lines: TStrings read GetText write SetText;
+ property Syntax: String read FSyntax write SetSyntax;
+ property ShowGutter: boolean read FShowGutter write SetShowGutter;
+ property TextSelected: Boolean read GetTextSelected;
+ property OnChangePos: TNotifyEvent read FOnChangePos write FOnChangePos;
+ property OnChangeText: TNotifyEvent read FOnChangeText write FOnChangeText;
+ property OnCodeCompletion: TfrxCodeCompletionEvent read FOnCodeCompletion
+ write FOnCodeCompletion;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnKeyDown;
+ end;
+
+
+implementation
+
+
+uses Clipbrd, fs_itools, frxXML;
+
+const
+ SQLKeywords =
+ 'active,after,all,alter,and,any,as,asc,ascending,at,auto,' +
+ 'base_name,before,begin,between,by,cache,call,cast,check,column,commit,' +
+ 'committed,computed,conditional,constraint,containing,count,create,' +
+ 'current,cursor,database,debug,declare,default,delete,desc,descending,' +
+ 'distinct,do,domain,drop,else,end,entry_point,escape,exception,execute,' +
+ 'exists,exit,external,extract,filter,for,foreign,from,full,function,' +
+ 'generator,grant,group,having,if,in,inactive,index,inner,insert,into,is,' +
+ 'isolation,join,key,left,level,like,merge,names,no,not,null,of,on,only,' +
+ 'or,order,outer,parameter,password,plan,position,primary,privileges,' +
+ 'procedure,protected,read,retain,returns,revoke,right,rollback,schema,' +
+ 'select,set,shadow,shared,snapshot,some,suspend,table,then,to,' +
+ 'transaction,trigger,uncommitted,union,unique,update,user,using,values,' +
+ 'view,wait,when,where,while,with,work';
+
+ WordChars = ['a'..'z', 'A'..'Z', ''..'', ''..'', '0'..'9', '_'];
+
+
+function IsUnicodeChar(Chr: Char): Boolean;
+begin
+ Result := ((Chr >= Char($007F)) and (Chr <= Char($FFFF)));
+end;
+
+{ TfrxSyntaxMemo }
+
+constructor TfrxSyntaxMemo.Create(AOwner: TComponent);
+var
+ i: Integer;
+begin
+ inherited;
+ FTmpCanvas := TBitmap.Create;
+ DoubleBuffered := True;
+ TabStop := True;
+ Cursor := crIBeam;
+ Color := clWindow;
+
+ FBreakPoints := TStringList.Create;
+
+ FBlockColor := clHighlight;
+ FBlockFontColor := clHighlightText;
+
+ FCommentAttr := TFont.Create;
+ FCommentAttr.Color := clNavy;
+ FCommentAttr.Style := [fsItalic];
+
+ FKeywordAttr := TFont.Create;
+ FKeywordAttr.Color := clWindowText;
+ FKeywordAttr.Style := [fsBold];
+
+ FNumberAttr := TFont.Create;
+ FNumberAttr.Color := clGreen;
+ FNumberAttr.Style := [];
+
+ FStringAttr := TFont.Create;
+ FStringAttr.Color := clNavy;
+ FStringAttr.Style := [];
+
+ FTextAttr := TFont.Create;
+ FTextAttr.Color := clWindowText;
+ FTextAttr.Style := [];
+
+ Font.Size := 10;
+ Font.Name := 'Courier New';
+
+ FText := TStringList.Create;
+ FParser := TfsParser.Create;
+ FParser.SkipSpace := False;
+ FParser.UseY := False;
+ FSynStrings := TStringList.Create;
+ FUndo := TStringList.Create;
+ FText.Add('');
+ FText.OnChange := LinesChange;
+ FMaxLength := 1024;
+ FMoved := True;
+ SetPos(1, 1);
+
+ ShowGutter := True;
+ OnMouseWheelUp := MouseWheelUp;
+ OnMouseWheelDown := MouseWheelDown;
+
+ FActiveLine := -1;
+ for i := 0 to 9 do
+ FBookmarks[i] := -1;
+end;
+
+destructor TfrxSyntaxMemo.Destroy;
+begin
+ FTmpCanvas.Free;
+ FBreakPoints.Free;
+ FCommentAttr.Free;
+ FKeywordAttr.Free;
+ FNumberAttr.Free;
+ FStringAttr.Free;
+ FTextAttr.Free;
+ FText.Free;
+ FUndo.Free;
+ FSynStrings.Free;
+ FParser.Free;
+ inherited;
+end;
+
+{ updating IME string and carret pos }
+procedure TfrxSyntaxMemo.WMIMECOMPOSITION(var Message: TMessage);
+var
+ h: HIMC;
+ nLen, nPos: Integer;
+ StrBuf: String;
+begin
+ if Message.LParam = $1E00 then
+ ResetImeComposition(CPS_CANCEL)
+ else
+ begin
+ h := Imm32GetContext(Handle);
+ if h <> 0 then
+ begin
+ nPos := Imm32GetCompositionString(h, GCS_CURSORPOS, nil, 0);
+ nLen := Imm32GetCompositionString(h, GCS_COMPSTR, nil, 0);
+ if nLen <> 0 then
+ begin
+ SetLength(StrBuf, nLen div 2);
+ Imm32GetCompositionString(h, GCS_COMPSTR, @StrBuf[1], nLen);
+ if (nLen div 2) > FCompSelEnd.X - FCompSelStart.X then
+ FCompSelEnd.X := FCompSelStart.X + (nLen div 2) - 1;
+ FSelStart.Y := FCompSelStart.Y;
+ FSelStart.X := FCompSelStart.X;
+ FSelEnd.Y := FCompSelEnd.Y;
+ FSelEnd.X := FCompSelEnd.X;
+ SelText := StrBuf;
+ FPos.X := FCompSelStart.X + nPos;
+ SetPos(FPos.X, FPos.Y);
+ FCompSelEnd.X := FCompSelStart.X + (nLen div 2);
+ Invalidate;
+ end;
+ Imm32ReleaseContext(Handle, h);
+ end;
+ Inherited;
+ end;
+end;
+
+procedure TfrxSyntaxMemo.WMIMEEndComp(var Message: TMessage);
+begin
+ FInImeComposition := False;
+end;
+
+procedure TfrxSyntaxMemo.WMIMEStartComp(var Message: TMessage);
+begin
+ FCompSelStart.Y := FPos.Y;
+ FCompSelStart.X := FPos.X;
+ FCompSelEnd.Y := FPos.Y;
+ FCompSelEnd.X := FPos.X;
+ FInImeComposition := True;
+end;
+
+procedure TfrxSyntaxMemo.WMKillFocus(var Msg: TWMKillFocus);
+begin
+ inherited;
+ HideCaret(Handle);
+ DestroyCaret;
+end;
+
+procedure TfrxSyntaxMemo.WMSetFocus(var Msg: TWMSetFocus);
+begin
+ inherited;
+ CreateCaret(Handle, 0, 2, FCharHeight);
+ ShowCaretPos;
+end;
+
+procedure TfrxSyntaxMemo.ShowCaretPos;
+var
+ cWidth: Integer;
+begin
+ if FPos.X > FOffset.X then
+ begin
+ if Length(Lines[FPos.Y - 1]) > FPos.X then
+ cWidth := GetCharWidth(Copy(Lines[FPos.Y - 1], 1, FPos.X - 1 - FOffset.X))
+ else
+ cWidth := FCharWidth * (FPos.X - 1 - FOffset.X);
+ SetCaretPos(cWidth + FGutterWidth,
+ FCharHeight * (FPos.Y - 1 - FOffset.Y));
+ ShowCaret(Handle);
+ end
+ else
+ SetCaretPos(-100, -100);
+ if Assigned(FOnChangePos) then
+ FOnChangePos(Self);
+end;
+
+procedure TfrxSyntaxMemo.CMFontChanged(var Message: TMessage);
+var
+ b: TBitmap;
+begin
+ FCommentAttr.Size := Font.Size;
+ FCommentAttr.Name := Font.Name;
+ FKeywordAttr.Size := Font.Size;
+ FKeywordAttr.Name := Font.Name;
+ FNumberAttr.Size := Font.Size;
+ FNumberAttr.Name := Font.Name;
+ FStringAttr.Size := Font.Size;
+ FStringAttr.Name := Font.Name;
+ FTextAttr.Size := Font.Size;
+ FTextAttr.Name := Font.Name;
+
+ b := TBitmap.Create;
+ with b.Canvas do
+ begin
+ Font.Assign(Self.Font);
+ Font.Style := [fsBold];
+ FCharHeight := TextHeight('Wg') + 1;
+ FCharWidth := TextWidth('W');
+ FIsMonoType := Pos('COURIER NEW', AnsiUppercase(Self.Font.Name)) <> 0;
+ end;
+ b.Free;
+end;
+
+procedure TfrxSyntaxMemo.Resize;
+begin
+ inherited;
+ if FCharWidth = 0 then Exit;
+ FWindowSize := Point((ClientWidth - FGutterWidth) div FCharWidth,
+ ClientHeight div FCharHeight);
+ HorzPage := FWindowSize.X;
+ VertPage := FWindowSize.Y;
+ UpdateScrollBar;
+end;
+
+procedure TfrxSyntaxMemo.UpdateScrollBar;
+begin
+ VertRange := FText.Count;
+ HorzRange := FMaxLength;
+ LargeChange := FWindowSize.Y;
+ VertPosition := FOffset.Y;
+ HorzPosition := FOffset.X;
+end;
+
+function TfrxSyntaxMemo.GetText: TStrings;
+//var
+// i: Integer;
+begin
+// FAllowLinesChange := False;
+// for i := 0 to FText.Count - 1 do
+// FText[i] := LineAt(i);
+ Result := FText;
+ FAllowLinesChange := True;
+end;
+
+function TfrxSyntaxMemo.GetPlainPos: Integer;
+begin
+ Result := GetPlainTextPos(FPos);
+end;
+
+function TfrxSyntaxMemo.GetPos: TPoint;
+begin
+ Result := FPos;
+end;
+
+procedure TfrxSyntaxMemo.SetText(Value: TStrings);
+begin
+ FAllowLinesChange := True;
+ FText.Assign(Value);
+end;
+
+procedure TfrxSyntaxMemo.SetSyntax(const Value: String);
+var
+ sl: TStringList;
+
+ procedure GetGrammar;
+ var
+ Grammar: TfrxXMLDocument;
+ ss: TStringStream;
+ ParserRoot, xi: TfrxXMLItem;
+ i: Integer;
+ Name, PropText: String;
+ begin
+ Grammar := TfrxXMLDocument.Create;
+ ss := TStringStream.Create(fsGetLanguage(Value), TEncoding.UTF8);
+ Grammar.LoadFromStream(ss);
+ ss.Free;
+
+ ParserRoot := Grammar.Root.FindItem('parser');
+ xi := ParserRoot.FindItem('keywords');
+ for i := 0 to xi.Count - 1 do
+ FParser.Keywords.Add(xi[i].Name);
+
+ for i := 0 to ParserRoot.Count - 1 do
+ begin
+ Name := LowerCase(ParserRoot[i].Name);
+ PropText := ParserRoot[i].Prop['text'];
+ if Name = 'identchars' then
+ FParser.ConstructCharset(PropText)
+ else if Name = 'commentline1' then
+ FParser.CommentLine1 := PropText
+ else if Name = 'commentline2' then
+ FParser.CommentLine2 := PropText
+ else if Name = 'commentblock1' then
+ FParser.CommentBlock1 := PropText
+ else if Name = 'commentblock2' then
+ FParser.CommentBlock2 := PropText
+ else if Name = 'stringquotes' then
+ FParser.StringQuotes := PropText
+ else if Name = 'hexsequence' then
+ FParser.HexSequence := PropText
+ end;
+
+ Grammar.Free;
+ end;
+
+begin
+ FSyntax := Value;
+ FParser.Keywords.Clear;
+ sl := TStringList.Create;
+ if AnsiCompareText(Value, 'SQL') = 0 then
+ begin
+ sl.CommaText := SQLKeywords;
+ FParser.Keywords.Assign(sl);
+ FParser.CommentLine1 := '--';
+ FParser.CommentLine2 := '';
+ FParser.CommentBlock1 := '/*,*/';
+ FParser.CommentBlock2 := '';
+ FParser.StringQuotes := '"';
+ FParser.HexSequence := '0x';
+ end
+ else
+ begin
+ fsGetLanguageList(sl);
+ if sl.IndexOf(Value) <> -1 then
+ GetGrammar;
+ end;
+
+ ClearSyntax(1);
+ sl.Free;
+end;
+
+procedure TfrxSyntaxMemo.SetCommentAttr(Value: TFont);
+begin
+ FCommentAttr.Assign(Value);
+ Repaint;
+end;
+
+procedure TfrxSyntaxMemo.SetKeywordAttr(Value: TFont);
+begin
+ FKeywordAttr.Assign(Value);
+ Repaint;
+end;
+
+procedure TfrxSyntaxMemo.SetNumberAttr(const Value: TFont);
+begin
+ FNumberAttr.Assign(Value);
+ Repaint;
+end;
+
+procedure TfrxSyntaxMemo.SetStringAttr(Value: TFont);
+begin
+ FStringAttr.Assign(Value);
+ Repaint;
+end;
+
+procedure TfrxSyntaxMemo.SetTextAttr(Value: TFont);
+begin
+ FTextAttr.Assign(Value);
+ Repaint;
+end;
+
+procedure TfrxSyntaxMemo.SetActiveLine(Line: Integer);
+begin
+ FActiveLine := Line;
+ Repaint;
+end;
+
+procedure TfrxSyntaxMemo.DoChange;
+begin
+ FModified := True;
+ if Assigned(FOnChangeText) then
+ FOnChangeText(Self);
+end;
+
+procedure TfrxSyntaxMemo.LinesChange(Sender: TObject);
+begin
+ if FAllowLinesChange then
+ begin
+ FAllowLinesChange := False;
+ if FText.Count = 0 then
+ FText.Add('');
+ ClearSyntax(1);
+ FMoved := True;
+ FUndo.Clear;
+ FPos := Point(1, 1);
+ FOffset := Point(0, 0);
+ ClearSel;
+ ShowCaretPos;
+ UpdateScrollBar;
+ end;
+end;
+
+procedure TfrxSyntaxMemo.ShowMessage(const s: String);
+begin
+ FMessage := s;
+ Repaint;
+end;
+
+procedure TfrxSyntaxMemo.CopyToClipboard;
+begin
+ if FSelStart.X <> 0 then
+ Clipboard.AsText := SelText;
+end;
+
+procedure TfrxSyntaxMemo.CutToClipboard;
+begin
+ if FSelStart.X <> 0 then
+ begin
+ Clipboard.AsText := SelText;
+ SelText := '';
+ end;
+ CorrectBookmark(FSelStart.Y, FSelStart.Y - FSelEnd.Y);
+ Repaint;
+end;
+
+procedure TfrxSyntaxMemo.PasteFromClipboard;
+begin
+ SelText := Clipboard.AsText;
+end;
+
+procedure TfrxSyntaxMemo.SelectAll;
+begin
+ SetPos(0, 0);
+ FSelStart := FPos;
+ SetPos(LineLength(FText.Count - 1) + 1, FText.Count);
+ FSelEnd := FPos;
+ Repaint;
+end;
+
+function TfrxSyntaxMemo.LineAt(Index: Integer): String;
+begin
+ if Index < FText.Count then
+ Result := TrimRight(FText[Index])
+ else
+ Result := '';
+end;
+
+function TfrxSyntaxMemo.LineLength(Index: Integer): Integer;
+begin
+ Result := Length(LineAt(Index));
+end;
+
+function TfrxSyntaxMemo.Pad(n: Integer): String;
+begin
+ Result := '';
+ SetLength(Result, n);
+ Result := StringOfChar(Char(' '), n);
+end;
+
+procedure TfrxSyntaxMemo.AddUndo;
+begin
+ if not FMoved then exit;
+ FUndo.Add(Format('%5d%5d', [FPos.X, FPos.Y]) + FText.Text);
+ if FUndo.Count > 32 then
+ FUndo.Delete(0);
+ FMoved := False;
+end;
+
+procedure TfrxSyntaxMemo.Undo;
+var
+ s: String;
+begin
+ FMoved := True;
+ if FUndo.Count = 0 then exit;
+ s := FUndo[FUndo.Count - 1];
+ FPos.X := StrToInt(Copy(s, 1, 5));
+ FPos.Y := StrToInt(Copy(s, 6, 5));
+ FAllowLinesChange := False;
+ FText.Text := Copy(s, 11, Length(s) - 10);
+ FAllowLinesChange := True;
+ FUndo.Delete(FUndo.Count - 1);
+ SetPos(FPos.X, FPos.Y);
+ ClearSyntax(1);
+ DoChange;
+end;
+
+function TfrxSyntaxMemo.GetPlainTextPos(Pos: TPoint): Integer;
+var
+ i: Integer;
+begin
+ Result := 0;
+ for i := 0 to Pos.Y - 2 do
+ Result := Result + Length(FText[i]) + 2;
+ Result := Result + Pos.X;
+end;
+
+function TfrxSyntaxMemo.GetPosPlainText(Pos: Integer): TPoint;
+var
+ i: Integer;
+ s: String;
+begin
+ Result := Point(0, 1);
+ s := FText.Text;
+ i := 1;
+ while i <= Pos do
+ if s[i] = #13 then
+ begin
+ Inc(i, 2);
+ if i <= Pos then
+ begin
+ Inc(Result.Y);
+ Result.X := 0;
+ end
+ else
+ Inc(Result.X);
+ end
+ else
+ begin
+ Inc(i);
+ Inc(Result.X);
+ end;
+end;
+
+function TfrxSyntaxMemo.GetLineBegin(Index: Integer): Integer;
+var
+ s: String;
+begin
+ s := FText[Index];
+ Result := 1;
+ if Trim(s) <> '' then
+ for Result := 1 to Length(s) do
+ if s[Result] <> ' ' then
+ break;
+end;
+
+procedure TfrxSyntaxMemo.TabIndent;
+begin
+ SelText := Pad((FPos.X div 8 + 1) * 8 - FPos.X);
+end;
+
+procedure TfrxSyntaxMemo.EnterIndent;
+var
+ res: Integer;
+begin
+ if Trim(FText[FPos.Y - 1]) = '' then
+ res := FPos.X else
+ res := GetLineBegin(FPos.Y - 1);
+
+ if FPos.X = 1 then
+ CorrectBookmark(FPos.Y - 1, 1) else
+ CorrectBookmark(FPos.Y, 1);
+
+ FPos := Point(1, FPos.Y + 1);
+ SelText := Pad(res - 1);
+end;
+
+procedure TfrxSyntaxMemo.UnIndent;
+var
+ i, res: Integer;
+begin
+ i := FPos.Y - 2;
+ res := FPos.X - 1;
+ CorrectBookmark(FPos.Y, -1);
+ while i >= 0 do
+ begin
+ res := GetLineBegin(i);
+ if (res < FPos.X) and (Trim(FText[i]) <> '') then
+ break else
+ Dec(i);
+ end;
+ FSelStart := FPos;
+ FSelEnd := FPos;
+ Dec(FSelEnd.X, FPos.X - res);
+ SelText := '';
+end;
+
+procedure TfrxSyntaxMemo.ShiftSelected(ShiftRight: Boolean);
+var
+ i, ib, ie: Integer;
+ s: String;
+ Shift: Integer;
+begin
+ AddUndo;
+ if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
+ begin
+ ib := FSelStart.Y - 1;
+ ie := FSelEnd.Y - 1;
+ end
+ else
+ begin
+ ib := FSelEnd.Y - 1;
+ ie := FSelStart.Y - 1;
+ end;
+ if FSelEnd.X = 1 then
+ Dec(ie);
+
+ Shift := 2;
+ if not ShiftRight then
+ for i := ib to ie do
+ begin
+ s := FText[i];
+ if (Trim(s) <> '') and (GetLineBegin(i) - 1 < Shift) then
+ Shift := GetLineBegin(i) - 1;
+ end;
+
+ for i := ib to ie do
+ begin
+ s := FText[i];
+ if ShiftRight then
+ s := Pad(Shift) + s
+ else if Trim(s) <> '' then
+ Delete(s, 1, Shift);
+ FText[i] := s;
+ end;
+
+ ClearSyntax(FSelStart.Y);
+ DoChange;
+end;
+
+function TfrxSyntaxMemo.GetSelText: String;
+var
+ p1, p2: TPoint;
+ i: Integer;
+begin
+ if FSelStart.X = 0 then
+ begin
+ Result := '';
+ Exit;
+ end;
+
+ if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
+ begin
+ p1 := FSelStart;
+ p2 := FSelEnd;
+ Dec(p2.X);
+ end
+ else
+ begin
+ p1 := FSelEnd;
+ p2 := FSelStart;
+ Dec(p2.X);
+ end;
+
+ if LineLength(p1.Y - 1) < p1.X then
+ begin
+ Inc(p1.Y);
+ p1.X := 1;
+ end;
+ if LineLength(p2.Y - 1) < p2.X then
+ p2.X := LineLength(p2.Y - 1);
+
+ i := GetPlainTextPos(p1);
+ Result := Copy(FText.Text, i, GetPlainTextPos(p2) - i + 1);
+end;
+
+procedure TfrxSyntaxMemo.SetSelText(const Value: String);
+var
+ p1, p2, p3: TPoint;
+ i: Integer;
+ s: String;
+begin
+ AddUndo;
+ if FSelStart.X = 0 then
+ begin
+ p1 := FPos;
+ p2 := p1;
+ Dec(p2.X);
+ end
+ else if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
+ begin
+ p1 := FSelStart;
+ p2 := FSelEnd;
+ Dec(p2.X);
+ end
+ else
+ begin
+ p1 := FSelEnd;
+ p2 := FSelStart;
+ Dec(p2.X);
+ end;
+ FAllowLinesChange := False;
+ if LineLength(p1.Y - 1) < p1.X then
+ FText[p1.Y - 1] := FText[p1.Y - 1] + Pad(p1.X - LineLength(p1.Y - 1) + 1);
+ if LineLength(p2.Y - 1) < p2.X then
+ p2.X := LineLength(p2.Y - 1);
+
+ i := GetPlainTextPos(p1);
+ s := FText.Text;
+ Delete(s, i, GetPlainTextPos(p2) - i + 1);
+ Insert(Value, s, i);
+ FText.Text := s;
+ p3 := GetPosPlainText(i + Length(Value));
+ FAllowLinesChange := True;
+ CorrectBookmark(FPos.Y, p3.y - FPos.Y);
+
+ SetPos(p3.X, p3.Y);
+ FSelStart.X := 0;
+ DoChange;
+ i := p3.Y;
+ if p2.Y < i then
+ i := p2.Y;
+ if p1.Y < i then
+ i := p1.Y;
+ ClearSyntax(i);
+end;
+
+procedure TfrxSyntaxMemo.ClearSel;
+begin
+ if FSelStart.X <> 0 then
+ begin
+ FSelStart := Point(0, 0);
+ Repaint;
+ end;
+end;
+
+procedure TfrxSyntaxMemo.AddSel;
+begin
+ if FSelStart.X = 0 then
+ FSelStart := FTempPos;
+ FSelEnd := FPos;
+ Repaint;
+end;
+
+procedure TfrxSyntaxMemo.SetPos(x, y: Integer);
+begin
+ if FMessage <> '' then
+ begin
+ FMessage := '';
+ Repaint;
+ end;
+
+ if x > FMaxLength then x := FMaxLength;
+ if x < 1 then x := 1;
+ if y > FText.Count then y := FText.Count;
+ if y < 1 then y := 1;
+
+ FPos := Point(x, y);
+ if (FWindowSize.X = 0) or (FWindowSize.Y = 0) then exit;
+
+ if FOffset.Y >= FText.Count then
+ FOffset.Y := FText.Count - 1;
+
+ if FPos.X > FOffset.X + FWindowSize.X then
+ begin
+ Inc(FOffset.X, FPos.X - (FOffset.X + FWindowSize.X));
+ Repaint;
+ end
+ else if FPos.X <= FOffset.X then
+ begin
+ Dec(FOffset.X, FOffset.X - FPos.X + 1);
+ Repaint;
+ end
+ else if FPos.Y > FOffset.Y + FWindowSize.Y then
+ begin
+ Inc(FOffset.Y, FPos.Y - (FOffset.Y + FWindowSize.Y));
+ Repaint;
+ end
+ else if FPos.Y <= FOffset.Y then
+ begin
+ Dec(FOffset.Y, FOffset.Y - FPos.Y + 1);
+ Repaint;
+ end;
+
+ ShowCaretPos;
+ UpdateScrollBar;
+
+end;
+
+procedure TfrxSyntaxMemo.OnHScrollChange(Sender: TObject);
+begin
+ FOffset.X := HorzPosition;
+ if FOffset.X > 1024 then
+ FOffset.X := 1024;
+ ShowCaretPos;
+ Repaint;
+end;
+
+procedure TfrxSyntaxMemo.OnVScrollChange(Sender: TObject);
+begin
+ FOffset.Y := VertPosition;
+ if FOffset.Y > FText.Count then
+ FOffset.Y := FText.Count;
+ ShowCaretPos;
+ Repaint;
+end;
+
+procedure TfrxSyntaxMemo.DblClick;
+var
+ s: String;
+begin
+ FDoubleClicked := True;
+ DoCtrlL;
+ FSelStart := FPos;
+ s := LineAt(FPos.Y - 1);
+ if s <> '' then
+ while CharInSet(s[FPos.X], WordChars)
+ or IsUnicodeChar(s[FPos.X]) do
+ Inc(FPos.X);
+ FSelEnd := FPos;
+ Repaint;
+end;
+
+procedure TfrxSyntaxMemo.MouseDown(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer);
+begin
+ if FDoubleClicked then
+ begin
+ FDoubleClicked := False;
+ Exit;
+ end;
+
+ FMoved := True;
+ if not Focused then
+ SetFocus;
+ FDown := True;
+ if X < FGutterWidth then
+ FToggleBreakPointDown := True;
+ X := (X - FGutterWidth) div FCharWidth + 1 + FOffset.X;
+ Y := Y div FCharHeight + 1 + FOffset.Y;
+ FTempPos := FPos;
+ SetPos(X, Y);
+ if ssShift in Shift then
+ AddSel
+ else
+ ClearSel;
+end;
+
+procedure TfrxSyntaxMemo.MouseMove(Shift: TShiftState; X, Y: Integer);
+begin
+ if FDown then
+ begin
+ FTempPos := FPos;
+ FPos.X := (X - FGutterWidth) div FCharWidth + 1 + FOffset.X;
+ FPos.Y := Y div FCharHeight + 1 + FOffset.Y;
+ if (FPos.X <> FTempPos.X) or (FPos.Y <> FTempPos.Y) then
+ begin
+ SetPos(FPos.X, FPos.Y);
+ AddSel;
+ end;
+ end;
+
+ if X < FGutterWidth then
+ Cursor := crArrow
+ else
+ Cursor := crIBeam;
+end;
+
+procedure TfrxSyntaxMemo.MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer);
+begin
+ FDown := False;
+ if (X < FGutterWidth) and (FToggleBreakPointDown) then
+ ToggleBreakPoint(FPos.Y, '');
+ FToggleBreakPointDown := False;
+end;
+
+procedure TfrxSyntaxMemo.KeyDown(var Key: Word; Shift: TShiftState);
+var
+ MyKey: Boolean;
+ TempPos: Tpoint;
+begin
+ inherited;
+ FAllowLinesChange := False;
+
+ FTempPos := FPos;
+ MyKey := True;
+ case Key of
+ vk_Left:
+ if ssCtrl in Shift then
+ DoCtrlL else
+ DoLeft;
+
+ vk_Right:
+ if ssCtrl in Shift then
+ DoCtrlR else
+ DoRight;
+
+ vk_Up:
+ DoUp;
+
+ vk_Down:
+ DoDown;
+
+ vk_Home:
+ DoHome(ssCtrl in Shift);
+
+ vk_End:
+ DoEnd(ssCtrl in Shift);
+
+ vk_Prior:
+ DoPgUp;
+
+ vk_Next:
+ DoPgDn;
+
+ vk_Return:
+ if Shift = [] then
+ DoReturn;
+
+ vk_Delete:
+ begin
+ if ssCtrl in Shift then // Ctrl+Del delete word before cursor
+ begin
+ TempPos := FPos;
+ Inc(FPos.X);
+ DblClick;
+ FDoubleClicked := False;
+ if FSelEnd.X <= TempPos.X then
+ begin
+ FSelStart := TempPos;
+ FSelEnd := TempPos;
+ dec(FSelStart.X);
+ end;
+ end;
+ if ssShift in Shift then
+ CutToClipboard else
+ DoDel;
+ end;
+
+ vk_Back:
+ begin
+ if ssCtrl in Shift then // Ctrl+BackSpace delete word after cursor
+ begin
+ DblClick;
+ FDoubleClicked := False;
+ end;
+ DoBackspace;
+ end;
+
+ vk_Insert:
+ if ssCtrl in Shift then
+ CopyToClipboard
+ else if ssShift in Shift then
+ PasteFromClipboard;
+
+ vk_Tab:
+ TabIndent;
+
+ else
+ MyKey := False;
+ end;
+
+ if Shift = [ssCtrl] then
+ if Key = 65 then // Ctrl+A Select all
+ begin
+ SelectAll;
+ end
+ else if Key = 89 then // Ctrl+Y Delete line
+ begin
+ if FText.Count > FPos.Y then
+ begin
+ FMoved := True;
+ AddUndo;
+ FText.Delete(FPos.Y - 1);
+ CorrectBookmark(FPos.Y, -1);
+ DoChange;
+ end
+ else if FText.Count = FPos.Y then
+ begin
+ FMoved := True;
+ AddUndo;
+ FText[FPos.Y - 1] := '';
+ FPos.X := 1;
+ SetPos(FPos.X, FPos.Y);
+ DoChange;
+ end;
+ ClearSyntax(FPos.Y);
+ end
+ else if Key in [48..57] then
+ GotoBookmark(Key - 48)
+ else if Key = 32 then // Ctrl+Space code completion
+ begin
+ if Assigned(FOnCodeCompletion) then
+ DoCodeCompletion;
+ MyKey := True;
+ end
+ else if Key = Ord('C') then
+ begin
+ CopyToClipboard;
+ MyKey := True;
+ end
+ else if Key = Ord('V') then
+ begin
+ PasteFromClipboard;
+ MyKey := True;
+ end
+ else if Key = Ord('X') then
+ begin
+ CutToClipboard;
+ MyKey := True;
+ end
+ else if Key = Ord('I') then
+ begin
+ DoCtrlI;
+ MyKey := True;
+ end
+ else if Key = Ord('U') then
+ begin
+ DoCtrlU;
+ MyKey := True;
+ end
+ else if Key = Ord('Z') then
+ begin
+ Undo;
+ MyKey := True;
+ end;
+
+ if Shift = [ssCtrl, ssShift] then
+ if Key in [48..57] then
+ if IsBookmark(FPos.Y - 1) < 0 then
+ AddBookmark(FPos.Y - 1, Key - 48)
+ else if IsBookmark(FPos.Y - 1) = (Key - 48) then
+ DeleteBookmark(Key - 48);
+
+ if Key in [vk_Left, vk_Right, vk_Up, vk_Down, vk_Home, vk_End, vk_Prior, vk_Next] then
+ begin
+ FMoved := True;
+ if ssShift in Shift then
+ AddSel else
+ ClearSel;
+ end
+ else if Key in [vk_Return, vk_Delete, vk_Back, vk_Insert, vk_Tab] then
+ FMoved := True;
+
+ if MyKey then
+ Key := 0;
+end;
+
+procedure TfrxSyntaxMemo.KeyPress(var Key: Char);
+var
+ MyKey, ControlKeyDown: Boolean;
+begin
+ inherited;
+
+ ControlKeyDown := (((GetKeyState(VK_LCONTROL) and not $7FFF) <> 0) or
+ ((GetKeyState(VK_RCONTROL) and not $7FFF) <> 0)) and
+ (GetKeyState(VK_RMENU) >= 0);
+ MyKey := True;
+
+ if ((Key = #32) and not ControlKeyDown) or (CharInSet(Key, [#33..#255]))
+ or IsUnicodeChar(Key) and not((Key = #127) and ControlKeyDown) then
+ begin
+ DoChar(Key);
+ FMoved := False;
+ end
+ else
+ MyKey := False;
+
+ if MyKey then
+ Key := #0;
+end;
+
+procedure TfrxSyntaxMemo.DoCodeCompletion;
+var
+ p: TPoint;
+
+ function GetCompletionString: String;
+ var
+ i: Integer;
+ s: String;
+ fl1, fl2: Boolean;
+ fl3, fl4: Integer;
+ begin
+ Result := '';
+ s := LineAt(FPos.Y - 1);
+ s := Trim(Copy(s, 1, FPos.X));
+
+ fl1 := False;
+ fl2 := False;
+ fl3 := 0;
+ fl4 := 0;
+
+ i := Length(s);
+ while i > 1 do
+ begin
+ Dec(i);
+ if (s[i] = '''') and not fl2 then
+ fl1 := not fl1
+ else if (s[i] = '"') and not fl1 then
+ fl2 := not fl2
+ else if not fl1 and not fl2 and (s[i] = ')') then
+ Inc(fl3)
+ else if not fl1 and not fl2 and (s[i] = '(') and (fl3 > 0) then
+ Dec(fl3)
+ else if not fl1 and not fl2 and (s[i] = ']') then
+ Inc(fl4)
+ else if not fl1 and not fl2 and (s[i] = '[') and (fl4 > 0) then
+ Dec(fl4)
+ else if not fl1 and not fl2 and (fl3 = 0) and (fl4 = 0) then
+ if CharInSet(s[i], ['A'..'Z', 'a'..'z', '0'..'9', '_', '.', ' '])
+ or IsUnicodeChar(s[i]) then
+ Result := s[i] + Result
+ else
+ break;
+ end;
+ end;
+
+begin
+ FCompletionForm := TfrxPopupForm.Create(Self);
+ FCompletionLB := TListBox.Create(FCompletionForm);
+ with FCompletionLB do
+ begin
+ Parent := FCompletionForm;
+ Ctl3D := False;
+ Align := alClient;
+ ItemHeight := ItemHeight + 2;
+ Style := lbOwnerDrawFixed;
+ Sorted := True;
+ OnDblClick := CompletionLBDblClick;
+ OnKeyDown := CompletionLBKeyDown;
+ OnDrawItem := CompletionLBDrawItem;
+ if Assigned(FOnCodeCompletion) then
+ FOnCodeCompletion(GetCompletionString, Items);
+
+ p := Self.ClientToScreen(
+ Point(FCharWidth * (FPos.X - 1 - FOffset.X) + FGutterWidth,
+ FCharHeight * (FPos.Y - FOffset.Y)));
+ FCompletionForm.SetBounds(p.X, p.Y, 300, 100);
+ FCompletionForm.Show;
+ end;
+end;
+
+procedure TfrxSyntaxMemo.CompletionLBDblClick(Sender: TObject);
+var
+ s, s1: String;
+ i: Integer;
+ stepBack: Boolean;
+begin
+ if FCompletionLB.ItemIndex <> -1 then
+ begin
+ s := FCompletionLB.Items[FCompletionLB.ItemIndex];
+ i := 2;
+ while (i <= Length(s)) and ((CharInSet(s[i], WordChars) or IsUnicodeChar(s[i]))) do
+ Inc(i);
+ s1 := Copy(s, 1, i - 1);
+ stepBack := (i <= Length(s)) and (s[i] = '(');
+ if stepBack then
+ s1 := s1 + '()';
+ SelText := s1;
+ if stepBack then
+ DoLeft;
+ end;
+ FCompletionForm.Close;
+end;
+
+procedure TfrxSyntaxMemo.CompletionLBKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ if Key = VK_ESCAPE then
+ FCompletionForm.Close;
+ if Key = VK_RETURN then
+ CompletionLBDblClick(nil);
+end;
+
+procedure TfrxSyntaxMemo.CompletionLBDrawItem(Control: TWinControl; Index: Integer;
+ ARect: TRect; State: TOwnerDrawState);
+var
+ i, w: Integer;
+ s: String;
+begin
+ with FCompletionLB.Canvas do
+ begin
+ FillRect(ARect);
+ if Index <> -1 then
+ begin
+ i := Integer(FCompletionLB.Items.Objects[Index]);
+ s := '';
+ Font.Color := clFuchsia;
+ if Pos('Constructor', FCompletionLB.Items[Index]) <> 0 then
+ s := 'constructor'
+ else
+ case i of
+ 0: begin s := 'var'; Font.Color := clBlue; end;
+ 1: begin s := 'property'; Font.Color := clBlue; end;
+ 2: s := 'procedure';
+ 3: s := 'function';
+ end;
+
+ if odSelected in State then
+ Font.Color := clWhite;
+ Font.Style := [];
+ TextOut(ARect.Left + 2, ARect.Top + 2, s);
+ w := TextWidth('constructor');
+ Font.Color := clBlack;
+ if odSelected in State then
+ Font.Color := clWhite;
+ Font.Style := [fsBold];
+ s := FCompletionLB.Items[Index];
+ i := 1;
+ while (i <= Length(s)) and ((CharInSet(s[i], WordChars))
+ or IsUnicodeChar(s[i])) do
+ Inc(i);
+ s := Copy(s, 1, i - 1);
+ TextOut(ARect.Left + w + 6, ARect.Top + 2, s);
+ w := w + TextWidth(s);
+ Font.Style := [];
+ s := Copy(FCompletionLB.Items[Index], i, 255);
+ if Pos(': Constructor', s) <> 0 then
+ s := Copy(s, 1, Pos(': Constructor', s) - 1);
+ TextOut(ARect.Left + w + 6, ARect.Top + 2, s);
+ end;
+ end;
+end;
+
+procedure TfrxSyntaxMemo.DoLeft;
+begin
+ Dec(FPos.X);
+ if FPos.X < 1 then
+ FPos.X := 1;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfrxSyntaxMemo.DoRight;
+begin
+ Inc(FPos.X);
+ if FPos.X > FMaxLength then
+ FPos.X := FMaxLength;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfrxSyntaxMemo.DoUp;
+begin
+ Dec(FPos.Y);
+ if FPos.Y < 1 then
+ FPos.Y := 1;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfrxSyntaxMemo.DoDown;
+begin
+ Inc(FPos.Y);
+ if FPos.Y > FText.Count then
+ FPos.Y := FText.Count;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfrxSyntaxMemo.DoHome(Ctrl: Boolean);
+begin
+ if Ctrl then
+ SetPos(1, 1) else
+ SetPos(1, FPos.Y);
+end;
+
+procedure TfrxSyntaxMemo.DoEnd(Ctrl: Boolean);
+begin
+ if Ctrl then
+ SetPos(LineLength(FText.Count - 1) + 1, FText.Count) else
+ SetPos(LineLength(FPos.Y - 1) + 1, FPos.Y);
+end;
+
+procedure TfrxSyntaxMemo.DoPgUp;
+begin
+ if FOffset.Y > FWindowSize.Y then
+ begin
+ Dec(FOffset.Y, FWindowSize.Y - 1);
+ Dec(FPos.Y, FWindowSize.Y - 1);
+ end
+ else
+ begin
+ if FOffset.Y > 0 then
+ begin
+ Dec(FPos.Y, FOffset.Y);
+ FOffset.Y := 0;
+ end
+ else
+ FPos.Y := 1;
+ end;
+ SetPos(FPos.X, FPos.Y);
+ Repaint;
+end;
+
+procedure TfrxSyntaxMemo.DoPgDn;
+begin
+ if FOffset.Y + FWindowSize.Y < FText.Count then
+ begin
+ Inc(FOffset.Y, FWindowSize.Y - 1);
+ Inc(FPos.Y, FWindowSize.Y - 1);
+ end
+ else
+ begin
+ FOffset.Y := FText.Count;
+ FPos.Y := FText.Count;
+ end;
+ SetPos(FPos.X, FPos.Y);
+ Repaint;
+end;
+
+procedure TfrxSyntaxMemo.DoReturn;
+var
+ s: String;
+begin
+ s := LineAt(FPos.Y - 1);
+ FText[FPos.Y - 1] := Copy(s, 1, FPos.X - 1);
+ FText.Insert(FPos.Y, Copy(s, FPos.X, FMaxLength));
+ EnterIndent;
+end;
+
+procedure TfrxSyntaxMemo.DoDel;
+var
+ s: String;
+begin
+ FMessage := '';
+ if FSelStart.X <> 0 then
+ SelText := ''
+ else
+ begin
+ s := FText[FPos.Y - 1];
+ AddUndo;
+ if FPos.X <= LineLength(FPos.Y - 1) then
+ begin
+ Delete(s, FPos.X, 1);
+ FText[FPos.Y - 1] := s;
+ end
+ else if FPos.Y < FText.Count then
+ begin
+ s := s + Pad(FPos.X - Length(s) - 1) + LineAt(FPos.Y);
+ FText[FPos.Y - 1] := s;
+ FText.Delete(FPos.Y);
+ CorrectBookmark(FPos.Y, -1);
+ end;
+ UpdateScrollBar;
+ ClearSyntax(FPos.Y);
+ DoChange;
+ end;
+end;
+
+procedure TfrxSyntaxMemo.DoBackspace;
+var
+ s: String;
+begin
+ FMessage := '';
+ if FSelStart.X <> 0 then
+ SelText := ''
+ else
+ begin
+ s := FText[FPos.Y - 1];
+ if FPos.X > 1 then
+ begin
+ if (GetLineBegin(FPos.Y - 1) = FPos.X) or (Trim(s) = '') then
+ UnIndent
+ else
+ begin
+ AddUndo;
+ if Trim(s) <> '' then
+ begin
+ Delete(s, FPos.X - 1, 1);
+ FText[FPos.Y - 1] := s;
+ DoLeft;
+ end
+ else
+ DoHome(False);
+ ClearSyntax(FPos.Y);
+ DoChange;
+ end;
+ end
+ else if FPos.Y > 1 then
+ begin
+ AddUndo;
+ CorrectBookmark(FPos.Y, -1);
+ s := LineAt(FPos.Y - 2);
+ FText[FPos.Y - 2] := s + FText[FPos.Y - 1];
+ FText.Delete(FPos.Y - 1);
+ SetPos(Length(s) + 1, FPos.Y - 1);
+ ClearSyntax(FPos.Y);
+ DoChange;
+ end;
+ end;
+end;
+
+procedure TfrxSyntaxMemo.DoCtrlI;
+begin
+ if FSelStart.X <> 0 then
+ ShiftSelected(True);
+end;
+
+procedure TfrxSyntaxMemo.DoCtrlU;
+begin
+ if FSelStart.X <> 0 then
+ ShiftSelected(False);
+end;
+
+procedure TfrxSyntaxMemo.DoCtrlL;
+var
+ i: Integer;
+ s: String;
+begin
+ s := FText.Text;
+ i := Length(LineAt(FPos.Y - 1));
+ if FPos.X > i then
+ FPos.X := i;
+
+ i := GetPlainTextPos(FPos);
+
+ Dec(i);
+ while (i > 0) and not ((CharInSet(s[i], WordChars))
+ or IsUnicodeChar(s[i])) do
+ if s[i] = #13 then
+ break else
+ Dec(i);
+ while (i > 0) and ((CharInSet(s[i], WordChars))
+ or IsUnicodeChar(s[i])) do
+ Dec(i);
+ Inc(i);
+
+ FPos := GetPosPlainText(i);
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfrxSyntaxMemo.DoCtrlR;
+var
+ i: Integer;
+ s: String;
+begin
+ s := FText.Text;
+ i := Length(LineAt(FPos.Y - 1));
+ if FPos.X > i then
+ begin
+ DoDown;
+ DoHome(False);
+ FPos.X := 0;
+ end;
+
+ i := GetPlainTextPos(FPos);
+
+ while (i < Length(s)) and ((CharInSet(s[i], WordChars))
+ or IsUnicodeChar(s[i])) do
+ Inc(i);
+ while (i < Length(s)) and not ((CharInSet(s[i], WordChars))
+ or IsUnicodeChar(s[i])) do
+ if s[i] = #13 then
+ begin
+ while (i > 1) and (s[i - 1] = ' ') do
+ Dec(i);
+ break;
+ end
+ else
+ Inc(i);
+
+ FPos := GetPosPlainText(i);
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfrxSyntaxMemo.DoChar(Ch: Char);
+begin
+ SelText := Ch;
+end;
+
+function TfrxSyntaxMemo.GetCharAttr(Pos: TPoint): TCharAttributes;
+
+ function IsBlock: Boolean;
+ var
+ p1, p2, p3: Integer;
+ begin
+ Result := False;
+ if FSelStart.X = 0 then Exit;
+
+ p1 := FSelStart.X + FSelStart.Y * FMaxLength;
+ p2 := FSelEnd.X + FSelEnd.Y * FMaxLength;
+ if p1 > p2 then
+ begin
+ p3 := p1;
+ p1 := p2;
+ p2 := p3;
+ end;
+ p3 := Pos.X + Pos.Y * FMaxLength;
+ Result := (p3 >= p1) and (p3 < p2);
+ end;
+
+ function CharAttr: TCharAttr;
+ var
+ s: String;
+ begin
+ if Pos.Y - 1 < FSynStrings.Count then
+ begin
+ s := FSynStrings[Pos.Y - 1];
+ if Pos.X <= Length(s) then
+ Result := TCharAttr(Ord(s[Pos.X])) else
+ Result := caText;
+ end
+ else
+ Result := caText;
+ end;
+
+begin
+ Result := [CharAttr];
+ if IsBlock then
+ Result := Result + [caBlock];
+end;
+
+function TfrxSyntaxMemo.GetCharWidth(Str: String): Integer;
+begin
+ with FTmpCanvas.Canvas do
+ begin
+ Font.Assign(Self.Font);
+ Result := TextWidth(Str);
+ end;
+end;
+
+procedure TfrxSyntaxMemo.Paint;
+var
+ i, j, j1: Integer;
+ a, a1: TCharAttributes;
+ s: String;
+
+ procedure SetAttr(a: TCharAttributes; Line: Integer);
+ begin
+ with Canvas do
+ begin
+ Brush.Color := Color;
+
+ if caText in a then
+ Font.Assign(FTextAttr);
+
+ if caComment in a then
+ Font.Assign(FCommentAttr);
+
+ if caKeyword in a then
+ Font.Assign(FKeywordAttr);
+
+ if caNumber in a then
+ Font.Assign(FNumberAttr);
+
+ if caString in a then
+ Font.Assign(FStringAttr);
+
+ if (caBlock in a) or (Line = FActiveLine - 1) then
+ begin
+ Brush.Color := FBlockColor;
+ Font.Color := FBlockFontColor;
+ end;
+
+ Font.Charset := Self.Font.Charset;
+ end;
+ end;
+
+ procedure MyTextOut(x, y: Integer; const s: String);
+ var
+ i: Integer;
+ begin
+ if FIsMonoType then
+ begin
+ Canvas.FillRect(Rect(x, y, x + Length(s) * FCharWidth, y + FCharHeight));
+ Canvas.TextOut(x, y, s)
+ end
+ else
+ with Canvas do
+ begin
+ FillRect(Rect(x, y, x + Length(s) * FCharWidth, y + FCharHeight));
+ for i := 1 to Length(s) do
+ TextOut(x + (i - 1) * FCharWidth, y, s[i]);
+ MoveTo(x + Length(s) * FCharWidth, y);
+ end;
+ end;
+
+ procedure DrawLineMarks(Line, Y: Integer);
+ begin
+ if not FShowGutter then Exit;
+ if IsBookmark(Line) >= 0 then
+ with Canvas do
+ begin
+ Brush.Color := clBlack;
+ FillRect(Rect(13, Y + 3, 23, Y + 14));
+ Brush.Color := clGreen;
+ FillRect(Rect(12, Y + 4, 22, Y + 15));
+ Font.Name := 'Tahoma';
+ Font.Color := clWhite;
+ Font.Style := [fsBold];
+ Font.Size := 7;
+ TextOut(14, Y + 4, IntToStr(IsBookmark(Line)));
+ end;
+ if RunLine[Line + 1] then
+ with Canvas do
+ begin
+ Brush.Color := clBlue;
+ Pen.Color := clBlack;
+ Ellipse(4, Y + 7, 8, Y + 11);
+ Pixels[5, Y + 7] := clAqua;
+ Pixels[4, Y + 8] := clAqua;
+ end;
+ if IsBreakPoint(Line + 1) then
+ with Canvas do
+ begin
+ Brush.Color := clRed;
+ Pen.Color := clRed;
+ Ellipse(2, Y + 4, 13, Y + 15);
+ end;
+ end;
+
+begin
+ inherited;
+
+ with Canvas do
+ begin
+ Brush.Color := clBtnFace;
+ FillRect(Rect(0, 0, FGutterWidth - 2, Height));
+ Pen.Color := clBtnHighlight;
+ MoveTo(FGutterWidth - 4, 0);
+ LineTo(FGutterWidth - 4, Height + 1);
+
+ if FUpdatingSyntax then Exit;
+ CreateSynArray(FOffset.Y + FWindowSize.Y - 1);
+
+ for i := FOffset.Y to FOffset.Y + FWindowSize.Y - 1 do
+ begin
+ if i >= FText.Count then break;
+
+ s := FText[i];
+ PenPos := Point(FGutterWidth, (i - FOffset.Y) * FCharHeight);
+ j1 := FOffset.X + 1;
+ a := GetCharAttr(Point(j1, i + 1));
+ a1 := a;
+
+ for j := j1 to FOffset.X + FWindowSize.X do
+ begin
+ if j > Length(s) then break;
+
+ a1 := GetCharAttr(Point(j, i + 1));
+ if a1 <> a then
+ begin
+ SetAttr(a, i);
+ MyTextOut(PenPos.X, PenPos.Y, Copy(FText[i], j1, j - j1));
+ a := a1;
+ j1 := j;
+ end;
+ end;
+
+ SetAttr(a, i);
+ MyTextOut(PenPos.X, PenPos.Y, Copy(s, j1, FMaxLength));
+ if (caBlock in GetCharAttr(Point(1, i + 1))) or (i = FActiveLine - 1) then
+ MyTextOut(PenPos.X, PenPos.Y, Pad(FWindowSize.X - Length(s) - FOffset.X + 3));
+
+ DrawLineMarks(i, PenPos.Y);
+ end;
+
+ if FMessage <> '' then
+ begin
+ Font.Name := 'Tahoma';
+ Font.Color := clWhite;
+ Font.Style := [fsBold];
+ Font.Size := 8;
+ Brush.Color := clMaroon;
+ FillRect(Rect(0, ClientHeight - TextHeight('|') - 6, ClientWidth, ClientHeight));
+ TextOut(6, ClientHeight - TextHeight('|') - 5, FMessage);
+ end
+ end;
+end;
+
+procedure TfrxSyntaxMemo.ClearSyntax(ClearFrom: Integer);
+begin
+ Dec(ClearFrom);
+ if ClearFrom < 1 then
+ ClearFrom := 1;
+ FUpdatingSyntax := True;
+ while FSynStrings.Count > ClearFrom - 1 do
+ FSynStrings.Delete(FSynStrings.Count - 1);
+ FUpdatingSyntax := False;
+ Repaint;
+end;
+
+procedure TfrxSyntaxMemo.CreateSynArray(EndLine: Integer);
+var
+ i, j, n, Max: Integer;
+ FSyn, s: String;
+ attr: TCharAttr;
+begin
+ if EndLine >= FText.Count then
+ EndLine := FText.Count - 1;
+ if EndLine <= FSynStrings.Count - 1 then Exit;
+
+ FUpdatingSyntax := True;
+ FAllowLinesChange := False;
+
+ for i := FSynStrings.Count to EndLine do
+ FSynStrings.Add(FText[i]);
+ FSyn := FSynStrings.Text;
+ FParser.Text := FText.Text;
+ Max := Length(FSyn);
+
+ for i := Length(FSyn) downto 1 do
+ if FSyn[i] = Chr(Ord(caText)) then
+ begin
+ j := i;
+ while (j > 1) and (FSyn[j] = Chr(Ord(caText))) do
+ Dec(j);
+ FParser.Position := j + 1;
+ break;
+ end;
+
+ while FParser.Position < Max do
+ begin
+ n := FParser.Position;
+ FParser.SkipSpaces;
+ for i := n to FParser.Position - 1 do
+ if i <= Max then
+ if FSyn[i] > #31 then
+ FSyn[i] := Chr(Ord(caComment));
+
+ attr := caText;
+ n := FParser.Position;
+ s := FParser.GetWord;
+ if s <> '' then
+ begin
+ if FParser.IsKeyword(s) then
+ attr := caKeyword;
+ end
+ else
+ begin
+ s := FParser.GetNumber;
+ if s <> '' then
+ attr := caNumber
+ else
+ begin
+ s := FParser.GetString;
+ if s <> '' then
+ attr := caString else
+ FParser.Position := FParser.Position + 1
+ end
+ end;
+
+ for i := n to FParser.Position - 1 do
+ if i <= Max then
+ if FSyn[i] > #31 then
+ FSyn[i] := Chr(Ord(attr));
+ end;
+
+ FSynStrings.Text := FSyn;
+ FUpdatingSyntax := False;
+ FAllowLinesChange := True;
+end;
+
+procedure TfrxSyntaxMemo.UpdateView;
+begin
+ Invalidate;
+end;
+
+procedure TfrxSyntaxMemo.MouseWheelUp(Sender: TObject;
+ Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
+begin
+ VertPosition := VertPosition - SmallChange;
+end;
+
+procedure TfrxSyntaxMemo.MouseWheelDown(Sender: TObject;
+ Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
+begin
+ VertPosition := VertPosition + SmallChange;
+end;
+
+procedure TfrxSyntaxMemo.SetShowGutter(Value: Boolean);
+begin
+ FShowGutter := Value;
+ if Value then
+ FGutterWidth := 30 else
+ FGutterWidth := 0;
+ Repaint;
+end;
+
+function TfrxSyntaxMemo.IsBookmark(Line: Integer): Integer;
+var
+ i: Integer;
+begin
+ Result := -1;
+ for i := 0 to 9 do
+ if FBookmarks[i] = Line then
+ begin
+ Result := i;
+ break;
+ end;
+end;
+
+procedure TfrxSyntaxMemo.AddBookmark(Line, Number: Integer);
+begin
+ if Number < Length(FBookmarks) then
+ begin
+ FBookmarks[Number] := Line;
+ Repaint;
+ end;
+end;
+
+procedure TfrxSyntaxMemo.DeleteBookmark(Number: Integer);
+begin
+ if Number < Length(FBookmarks) then
+ begin
+ FBookmarks[Number] := -1;
+ Repaint;
+ end;
+end;
+
+procedure TfrxSyntaxMemo.CorrectBookmark(Line, Delta: Integer);
+var
+ i: Integer;
+begin
+ if Delta = 0 then exit;
+ CorrectBreakPoints(Line, Delta);
+ for i := 0 to Length(FBookmarks) - 1 do
+ if FBookmarks[i] >= Line then
+ Inc(FBookmarks[i], Delta);
+end;
+
+procedure TfrxSyntaxMemo.GotoBookmark(Number : Integer);
+begin
+ if Number < Length(FBookmarks) then
+ if FBookmarks[Number] >= 0 then
+ SetPos(0, FBookmarks[Number] + 1);
+end;
+
+function TfrxSyntaxMemo.GetRunLine(Index: Integer): Boolean;
+begin
+ if (Index < 1) or (Index > FText.Count) then
+ Result := False else
+ Result := FText.Objects[Index - 1] = Pointer(1);
+end;
+
+procedure TfrxSyntaxMemo.SetRunLine(Index: Integer; const Value: Boolean);
+begin
+ if (Index < 1) or (Index > FText.Count) then Exit;
+ if Value then
+ FText.Objects[Index - 1] := Pointer(1) else
+ FText.Objects[Index - 1] := Pointer(0);
+end;
+
+function TfrxSyntaxMemo.Find(const SearchText: String;
+ CaseSensitive: Boolean; var SearchFrom: Integer): Boolean;
+var
+ i: Integer;
+ s: String;
+begin
+ i := 0;
+ Result := False;
+ if FText.Count > 1 then
+ begin
+ s := FText.Text;
+ if SearchFrom = 0 then
+ SearchFrom := 1;
+ s := Copy(s, SearchFrom, Length(s) - SearchFrom + 1);
+ if CaseSensitive then
+ begin
+ i := Pos(SearchText, s);
+ if i <> 0 then
+ Result := True;
+ end
+ else
+ begin
+ i := Pos(AnsiUpperCase(SearchText), AnsiUpperCase(s));
+ if i <> 0 then
+ Result := True;
+ end;
+ end;
+
+ if Result then
+ begin
+ Inc(SearchFrom, i);
+ FSelStart := GetPosPlainText(SearchFrom - 1);
+ FSelEnd := Point(FSelStart.X + Length(SearchText), FSelStart.Y);
+ Inc(SearchFrom, Length(SearchText));
+ SetPos(FSelStart.X, FSelStart.Y);
+ Repaint;
+ end;
+end;
+
+procedure TfrxSyntaxMemo.AddBreakPoint(Number: Integer; const Condition: String);
+begin
+ FBreakPoints.AddObject(Condition, TObject(Number));
+ Repaint;
+end;
+
+procedure TfrxSyntaxMemo.ToggleBreakPoint(Number: Integer; const Condition: String);
+begin
+ if IsBreakPoint(Number) then
+ DeleteBreakPoint(Number)
+ else
+ AddBreakPoint(Number, Condition);
+end;
+
+procedure TfrxSyntaxMemo.DeleteBreakPoint(Number: Integer);
+begin
+ if IsBreakPoint(Number) then
+ FBreakPoints.Delete(FBreakPoints.IndexOfObject(TObject(Number)));
+ Repaint;
+end;
+
+function TfrxSyntaxMemo.IsBreakPoint(Number: Integer): Boolean;
+begin
+ Result := FBreakPoints.IndexOfObject(TObject(Number)) <> -1;
+end;
+
+function TfrxSyntaxMemo.GetBreakPointCondition(Number: Integer): String;
+begin
+ Result := '';
+ if IsBreakPoint(Number) then
+ Result := FBreakPoints[FBreakPoints.IndexOfObject(TObject(Number))];
+end;
+
+procedure TfrxSyntaxMemo.DeleteF4BreakPoints;
+var
+ i: Integer;
+begin
+ i := 0;
+ while i < FBreakPoints.Count do
+ if FBreakPoints[i] = 'F4' then
+ FBreakPoints.Delete(i)
+ else
+ Inc(i);
+end;
+
+procedure TfrxSyntaxMemo.CorrectBreakPoints(Line, Delta: Integer);
+var
+ i, bPos: Integer;
+begin
+// FBreakPoints[FBreakPoints.IndexOfObject(TObject(Number))]
+ for i := 0 to FBreakPoints.Count - 1 do
+ begin
+ bPos := Integer(FBreakPoints.Objects[i]);
+ if bPos >= Line then
+ begin
+ Inc(bPos, Delta);
+ FBreakPoints.Objects[i] := TObject(bPos);
+ end;
+ end;
+end;
+
+function TfrxSyntaxMemo.GetTextSelected: Boolean;
+begin
+//
+ Result := True;// FSelStart
+
+end;
+
+end.
diff --git a/LibD28/FMX.frxTrueTypeCollection.pas b/LibD28/FMX.frxTrueTypeCollection.pas
new file mode 100644
index 0000000..f8a2935
--- /dev/null
+++ b/LibD28/FMX.frxTrueTypeCollection.pas
@@ -0,0 +1,305 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Font parser }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Aleksey Mandrykin, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxTrueTypeCollection;
+{$I frx.inc}
+interface uses System.Classes, System.SysUtils, System.UITypes, FMX.Types, FMX.Objects,
+ FMX.TTFHelpers, FMX.frxTrueTypeFont, FMX.frxFontHeaderClass, FMX.frxNameTableClass
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+type // Nested Types
+ EInvalidTTFFormat = class(Exception);
+
+ TFontCollection = TList;
+ TTCollectionHeader = packed record
+ public TTCTag: Cardinal;
+ public Version: Cardinal;
+ public numFonts: Cardinal;
+ end;
+
+ TrueTypeCollection = class(TTF_Helpers)
+ // Fields
+ public fonts_collection: TFontCollection;
+
+ private function get_FontCollection: TFontCollection;
+ private function get_Item(FamilyName: string): TrueTypeFont;
+ private function get_FamilyItem(FamilyName: string): TrueTypeFont;
+
+ // Methods
+ public constructor Create;
+ public destructor Destroy; override;
+ public procedure Initialize(FD: PAnsiChar; FontDataSize: Longint);
+ public function PackFont(font: Tfont; UsedAlphabet: TList; sStream: TStream) : TByteArray;
+ public function GetTrueTypeFont(aFont: TFont; RaiseException: Boolean = True): TrueTypeFont;
+
+ // Properties
+ public property FontCollection: TFontCollection read get_FontCollection;
+ public property Item[FamilyName: string]: TrueTypeFont read get_Item;
+ public property FamilyItem[FamilyName: string]: TrueTypeFont read get_FamilyItem;
+ end;
+
+const
+ // You may put national font names here
+{$WARNINGS OFF}
+ Elements =10;
+ Substitutes : array [1..Elements] of AnsiString = (
+ #$EF#$BC#$AD#$EF#$BC#$B3#$20#$E3#$82#$B4#$E3#$82#$B7#$E3#$83#$83#$E3#$82#$AF, 'MS Gothic',
+ #$EF#$BC#$AD#$EF#$BC#$B3#$20#$EF#$BC#$B0#$E3#$82#$B4#$E3#$82#$B7#$E3#$83#$83#$E3#$82#$AF, 'MS PGothic',
+ #$EF#$BC#$AD#$EF#$BC#$B3#$20#$E6#$98#$8E#$E6#$9C#$9D, 'MS Mincho',
+ #$EF#$BC#$AD#$EF#$BC#$B3#$20#$EF#$BC#$B0#$E6#$98#$8E#$E6#$9C#$9D, 'MS PMincho',
+ #$E3#$83#$A1#$E3#$82#$A4#$E3#$83#$AA#$E3#$82#$AA, 'Meiryo'
+ );
+{$WARNINGS ON}
+implementation
+
+destructor TrueTypeCollection.Destroy;
+var
+ i: Integer;
+begin
+ for i := 0 to fonts_collection.Count - 1 do
+ TObject(fonts_collection[i]).Free;
+ fonts_collection.Free;
+ inherited;
+end;
+
+function TrueTypeCollection.GetTrueTypeFont(aFont: TFont; RaiseException: Boolean): TrueTypeFont;
+var
+ i: Integer;
+ skip_list: TList;
+ s: String;
+ Name: String;
+ StyleFlag: Integer;
+ // Style: TFontStyles;
+ // -----------
+ Transform: WideString;
+ ttf: TrueTypeFont;
+begin
+ Result := nil;
+ skip_list := TList.Create;
+ try
+ skip_list.Add(Pointer(TablesID.EmbedBitmapLocation));
+ skip_list.Add(Pointer(TablesID.EmbededBitmapData));
+ skip_list.Add(Pointer(TablesID.HorizontakDeviceMetrix));
+ skip_list.Add(Pointer(TablesID.VerticalDeviceMetrix));
+ skip_list.Add(Pointer(TablesID.DigitalSignature));
+
+ Name := aFont.Family;
+
+ i := 1;
+ while i <= ((High(Substitutes) - Low(Substitutes))) do
+ begin
+ Transform := UTF8Decode(Substitutes[i]);
+ if Transform = Name then
+ begin
+ Name := UTF8Decode(Substitutes[i + 1]);
+ break;
+ end;
+ i := i + 2;
+ end;
+ StyleFlag := 0;
+ if TFontStyle.fsBold in aFont.Style then
+ StyleFlag := 32;
+ if TFontStyle.fsItalic in aFont.Style then
+ StyleFlag := StyleFlag or 1;
+
+ for i := 0 to Self.fonts_collection.Count - 1 do
+ begin
+ ttf := TrueTypeFont(Self.fonts_collection[i]);
+ if not ttf.IsLoaded then
+ ttf.PrepareFont(skip_list);
+ s := ttf.Names.Item[NameID.FamilyName];
+ if (s = Name) and
+ (ttf.windows_metrix.win_metrix.fsSelection and 33 = StyleFlag) then
+ begin
+ Result := ttf;
+ break;
+ end;
+ end;
+ finally
+ skip_list.Free;
+ end;
+ if (Result = nil) and RaiseException then
+ raise Exception.Create('Font not found in collection.');
+end;
+
+function TrueTypeCollection.get_FamilyItem(FamilyName: string): TrueTypeFont;
+ var
+ font: TrueTypeFont;
+ nt: NameTableClass;
+ s : String;
+ i: Integer;
+ begin
+ Result := nil;
+ for i := 0 to fonts_collection.Count - 1 do
+ begin
+ font := TrueTypeFont(fonts_collection[i]);
+ nt := font.Names;
+ if nt = nil then continue;
+
+ s := nt.Item[NameID.FamilyName];
+ if s = FamilyName then
+ begin
+ Result := font;
+ break
+ end;
+ end;
+ if Result = nil then raise Exception.Create('Font not found in collection');
+ end;
+
+function TrueTypeCollection.get_FontCollection: TFontCollection;
+ begin
+ Result := fonts_collection;
+ end;
+
+ function TrueTypeCollection.get_Item(FamilyName: string): TrueTypeFont;
+ var
+ font: TrueTypeFont;
+ nt: NameTableClass;
+ s : String;
+ i: Integer;
+ begin
+ Result := nil;
+ for i := 0 to fonts_collection.Count - 1 do
+ begin
+ font := TrueTypeFont(fonts_collection[i]);
+ nt := font.Names;
+ if nt = nil then continue;
+
+ s := nt.Item[NameID.FullName];
+ if s = FamilyName then
+ begin
+ Result := font;
+ break
+ end;
+ end;
+ if Result = nil then raise Exception.Create('Font not found in collection');
+ end;
+
+
+ constructor TrueTypeCollection.Create;
+ begin
+ self.fonts_collection := TFontCollection.Create;
+ end;
+
+ procedure TrueTypeCollection.Initialize(FD: PAnsiChar; FontDataSize: Longint);
+ var
+ CollectionMode: FontType;
+ i: Cardinal;
+ f: TrueTypeFont;
+ pch: ^TTCollectionHeader;
+ ch: TTCollectionHeader;
+ subfont_table: ^Cardinal;
+ subfont_idx: Cardinal;
+ subfont_ptr: Pointer;
+ begin
+ if (FD[0] = AnsiChar(0)) and (FD[1] = AnsiChar(1)) and (FD[2] = AnsiChar(0)) and (FD[3] = AnsiChar(0)) then
+ CollectionMode := FontType.TrueTypeFontType
+ else if (FD[0] = 't') and (FD[1] = 't') and (FD[2] = 'c') and (FD[3] = 'f') then
+ CollectionMode := FontType.TrueTypeCollection
+ else
+ raise EInvalidTTFFormat.Create('TrueType font format error');
+
+ if (CollectionMode = FontType.TrueTypeFontType) then
+ begin
+ f := TrueTypeFont.Create( Pointer(FD), Pointer(FD), ChecksumFaultAction.Warn);
+ self.fonts_collection.Add( f )
+ end else begin
+ pch := Pointer(FD);
+ ch.TTCTag := TTF_Helpers.SwapUInt32(pch.TTCTag);
+ ch.Version := TTF_Helpers.SwapUInt32(pch.Version);
+ ch.numFonts := TTF_Helpers.SwapUInt32(pch.numFonts);
+ case ch.Version of
+ $10000: subfont_table := TTF_Helpers.Increment( pch, 12 ); // Version 1
+ $20000: subfont_table := TTF_Helpers.Increment( pch, 12 ); // Version 2
+ else raise Exception.Create('Unknown font collection version');
+ end;
+
+ i := 0;
+ while i < ch.numFonts do
+ begin
+ subfont_idx := TTF_Helpers.SwapUInt32( subfont_table^ );
+ subfont_ptr := TTF_Helpers.Increment( FD, subfont_idx);
+ f := TrueTypeFont.Create(FD, subfont_ptr, ChecksumFaultAction.Warn);
+ self.fonts_collection.Add( f );
+ inc(i);
+ inc( subfont_table, 1)
+ end
+ end
+ end;
+
+ function TrueTypeCollection.PackFont( font: Tfont; UsedAlphabet: TList; sStream: TStream) : TByteArray;
+ var
+ i, j: Integer;
+ ttf: TrueTypeFont;
+ skip_list: TList;
+ ch: Char;
+ s: String;
+ Name: String;
+ StyleFlag: Integer;
+// Style: TFontStyles;
+ // -----------
+ Transform: WideString;
+ begin
+ Result := nil;
+ ttf := nil;
+ skip_list := TList.Create;
+ skip_list.Add( Pointer(TablesID.EmbedBitmapLocation));
+ skip_list.Add( Pointer(TablesID.EmbededBitmapData));
+ skip_list.Add( Pointer(TablesID.HorizontakDeviceMetrix));
+ skip_list.Add( Pointer(TablesID.VerticalDeviceMetrix));
+ skip_list.Add( Pointer(TablesID.DigitalSignature));
+
+ Name := font.Family;
+
+ i := 1;
+ while i <= ((High(Substitutes)-Low(Substitutes)) ) do
+ begin
+ Transform := UTF8Decode(Substitutes[i]);
+ if Transform = Name then
+ begin
+ Name := UTF8Decode(Substitutes[i+1]);
+ break;
+ end;
+ i := i + 2;
+ end;
+ StyleFlag := 0;
+ if TFontStyle.fsBold in font.Style then
+ StyleFlag := 32;
+ if TFontStyle.fsItalic in font.Style then
+ StyleFlag := StyleFlag or 1;
+
+ for i := 0 to Self.fonts_collection.Count - 1 do
+ begin
+ ttf := TrueTypeFont(Self.fonts_collection[i]);
+ if not ttf.IsLoaded then
+ ttf.PrepareFont( skip_list );
+ s := ttf.Names.Item[NameID.FamilyName];
+ if (s = Name) and (not((TFontStyle.fsBold in font.Style) or (TFontStyle.fsItalic in font.Style)) or (ttf.windows_metrix.win_metrix.fsSelection and StyleFlag = StyleFlag)) then
+ begin
+ break;
+ end;
+ end;
+
+ if not Assigned(ttf) then Exit;
+
+ for j := 0 to UsedAlphabet.Count - 1 do
+ begin
+ ch := Char(UsedAlphabet[j]);
+ ttf.AddCharacterToKeepList(ch);
+ end;
+ Result := ttf.PackFont(FontType.TrueTypeFontType, True, sStream);
+
+ skip_list.Free;
+ end;
+
+end.
diff --git a/LibD28/FMX.frxTrueTypeFont.pas b/LibD28/FMX.frxTrueTypeFont.pas
new file mode 100644
index 0000000..c8d95ae
--- /dev/null
+++ b/LibD28/FMX.frxTrueTypeFont.pas
@@ -0,0 +1,1114 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Font parser }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Aleksey Mandrykin, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+{$hints off}
+unit FMX.frxTrueTypeFont;
+interface
+
+uses FMX.TTFHelpers, FMX.frxCmapTableClass, FMX.frxFontHeaderClass, FMX.frxGlyphTableClass,
+ FMX.frxGlyphSubstitutionClass, FMX.frxHorizontalHeaderClass,
+ FMX.frxHorizontalMetrixClass, FMX.frxIndexToLocationClass,
+ FMX.frxKerningTableClass, FMX.frxNameTableClass, FMX.frxPostScriptClass,
+ FMX.frxMaximumProfileClass, FMX.frxOS2WindowsMetricsClass,
+ System.Classes, FMX.frxTrueTypeTable,
+ FMX.frxPreprogramClass, FMX.Types, System.UITypes, System.Types,
+ System.Generics.Collections;
+
+type
+
+ {$EXTERNALSYM PABC}
+ PABC = ^TABC;
+ {$EXTERNALSYM _ABC}
+ _ABC = record
+ abcA: Integer;
+ abcB: LongWord;
+ abcC: Integer;
+ end;
+ TABC = _ABC;
+ {$EXTERNALSYM ABC}
+ ABC = _ABC;
+
+ TPanose = record
+ bFamilyType: Byte;
+ bSerifStyle: Byte;
+ bWeight: Byte;
+ bProportion: Byte;
+ bContrast: Byte;
+ bStrokeVariation: Byte;
+ bArmStyle: Byte;
+ bLetterform: Byte;
+ bMidline: Byte;
+ bXHeight: Byte;
+ end;
+
+ PTextMetricA = ^TTextMetricA;
+ PTextMetricW = ^TTextMetricW;
+ PTextMetric = PTextMetricW;
+ {$EXTERNALSYM tagTEXTMETRICA}
+ tagTEXTMETRICA = record
+ tmHeight: Longint;
+ tmAscent: Longint;
+ tmDescent: Longint;
+ tmInternalLeading: Longint;
+ tmExternalLeading: Longint;
+ tmAveCharWidth: Longint;
+ tmMaxCharWidth: Longint;
+ tmWeight: Longint;
+ tmOverhang: Longint;
+ tmDigitizedAspectX: Longint;
+ tmDigitizedAspectY: Longint;
+ tmFirstChar: AnsiChar;
+ tmLastChar: AnsiChar;
+ tmDefaultChar: AnsiChar;
+ tmBreakChar: AnsiChar;
+ tmItalic: Byte;
+ tmUnderlined: Byte;
+ tmStruckOut: Byte;
+ tmPitchAndFamily: Byte;
+ tmCharSet: Byte;
+ end;
+ {$EXTERNALSYM tagTEXTMETRICW}
+ tagTEXTMETRICW = record
+ tmHeight: Longint;
+ tmAscent: Longint;
+ tmDescent: Longint;
+ tmInternalLeading: Longint;
+ tmExternalLeading: Longint;
+ tmAveCharWidth: Longint;
+ tmMaxCharWidth: Longint;
+ tmWeight: Longint;
+ tmOverhang: Longint;
+ tmDigitizedAspectX: Longint;
+ tmDigitizedAspectY: Longint;
+ tmFirstChar: WideChar;
+ tmLastChar: WideChar;
+ tmDefaultChar: WideChar;
+ tmBreakChar: WideChar;
+ tmItalic: Byte;
+ tmUnderlined: Byte;
+ tmStruckOut: Byte;
+ tmPitchAndFamily: Byte;
+ tmCharSet: Byte;
+ end;
+ {$EXTERNALSYM tagTEXTMETRIC}
+ tagTEXTMETRIC = tagTEXTMETRICW;
+ TTextMetricA = tagTEXTMETRICA;
+ TTextMetricW = tagTEXTMETRICW;
+ TTextMetric = TTextMetricW;
+ {$EXTERNALSYM TEXTMETRICA}
+ TEXTMETRICA = tagTEXTMETRICA;
+ {$EXTERNALSYM TEXTMETRICW}
+ TEXTMETRICW = tagTEXTMETRICW;
+
+ POutlineTextmetricA = ^TOutlineTextmetricA;
+ POutlineTextmetricW = ^TOutlineTextmetricW;
+ POutlineTextmetric = POutlineTextmetricW;
+ {$EXTERNALSYM _OUTLINETEXTMETRICA}
+ _OUTLINETEXTMETRICA = record
+ public
+ otmSize: LongWord;
+ otmTextMetrics: TTextMetricA;
+ otmFiller: Byte;
+ otmPanoseNumber: TPanose;
+ otmfsSelection: LongWord;
+ otmfsType: LongWord;
+ otmsCharSlopeRise: Integer;
+ otmsCharSlopeRun: Integer;
+ otmItalicAngle: Integer;
+ otmEMSquare: LongWord;
+ otmAscent: Integer;
+ otmDescent: Integer;
+ otmLineGap: LongWord;
+ otmsCapEmHeight: LongWord;
+ otmsXHeight: LongWord;
+ otmrcFontBox: TRect;
+ otmMacAscent: Integer;
+ otmMacDescent: Integer;
+ otmMacLineGap: LongWord;
+ otmusMinimumPPEM: LongWord;
+ otmptSubscriptSize: TPoint;
+ otmptSubscriptOffset: TPoint;
+ otmptSuperscriptSize: TPoint;
+ otmptSuperscriptOffset: TPoint;
+ otmsStrikeoutSize: LongWord;
+ otmsStrikeoutPosition: Integer;
+ otmsUnderscoreSize: Integer;
+ otmsUnderscorePosition: Integer;
+ otmpFamilyName: PAnsiChar; // Offset from the beginning of the structure
+ otmpFaceName: PAnsiChar; // Offset from the beginning of the structure
+ otmpStyleName: PAnsiChar; // Offset from the beginning of the structure
+ otmpFullName: PAnsiChar; // Offset from the beginning of the structure
+ end;
+ {$EXTERNALSYM _OUTLINETEXTMETRICW}
+ _OUTLINETEXTMETRICW = record
+ public
+ otmSize: LongWord;
+ otmTextMetrics: TTextMetricW;
+ otmFiller: Byte;
+ otmPanoseNumber: TPanose;
+ otmfsSelection: LongWord;
+ otmfsType: LongWord;
+ otmsCharSlopeRise: Integer;
+ otmsCharSlopeRun: Integer;
+ otmItalicAngle: Integer;
+ otmEMSquare: LongWord;
+ otmAscent: Integer;
+ otmDescent: Integer;
+ otmLineGap: LongWord;
+ otmsCapEmHeight: LongWord;
+ otmsXHeight: LongWord;
+ otmrcFontBox: TRect;
+ otmMacAscent: Integer;
+ otmMacDescent: Integer;
+ otmMacLineGap: LongWord;
+ otmusMinimumPPEM: LongWord;
+ otmptSubscriptSize: TPoint;
+ otmptSubscriptOffset: TPoint;
+ otmptSuperscriptSize: TPoint;
+ otmptSuperscriptOffset: TPoint;
+ otmsStrikeoutSize: LongWord;
+ otmsStrikeoutPosition: Integer;
+ otmsUnderscoreSize: Integer;
+ otmsUnderscorePosition: Integer;
+ otmpFamilyName: PAnsiChar; // Offset from the beginning of the structure
+ otmpFaceName: PAnsiChar; // Offset from the beginning of the structure
+ otmpStyleName: PAnsiChar; // Offset from the beginning of the structure
+ otmpFullName: PAnsiChar; // Offset from the beginning of the structure
+ end;
+ {$EXTERNALSYM _OUTLINETEXTMETRIC}
+ _OUTLINETEXTMETRIC = _OUTLINETEXTMETRICW;
+ TOutlineTextmetricA = _OUTLINETEXTMETRICA;
+ TOutlineTextmetricW = _OUTLINETEXTMETRICW;
+ TOutlineTextmetric = TOutlineTextmetricW;
+ {$EXTERNALSYM OUTLINETEXTMETRICA}
+ OUTLINETEXTMETRICA = _OUTLINETEXTMETRICA;
+ {$EXTERNALSYM OUTLINETEXTMETRICW}
+ OUTLINETEXTMETRICW = _OUTLINETEXTMETRICW;
+ {$EXTERNALSYM OUTLINETEXTMETRIC}
+ OUTLINETEXTMETRIC = OUTLINETEXTMETRICW;
+
+ ChecksumFaultAction = (IgnoreChecksum=0, ThrowException=1, Warn=2);
+ TablesID = (CMAP=$70616d63, ControlValueTable=$20747663, DigitalSignature=$47495344, EmbedBitmapLocation=$434c4245, EmbededBitmapData=$54444245, FontHeader=$64616568, FontProgram=$6d677066, Glyph=$66796c67, GlyphDefinition=$46454447, GlyphPosition=$534f5047, GlyphSubstitution=$42555347, GridFittingAndScanConversion=$70736167, HorizontakDeviceMetrix=$786d6468, HorizontalHeader=$61656868, HorizontalMetrix=$78746d68, IndexToLocation=$61636f6c, Justification=$4654534a, KerningTable=$6e72656b, LinearThreshold=$4853544c, MaximumProfile=$7078616d, Name=$656d616e, OS2Table=$322f534f, PCL5Table=$544c4350, Postscript=$74736f70, PreProgram=$70657270, VerticalDeviceMetrix=$584d4456, VerticalMetrix=$78746d76, VertivalMetrixHeader=$61656876);
+
+ TByteArray = Array of Byte;
+ TTagList = TList;
+
+ TableDirectory = packed record
+ public sfntversion: Cardinal;
+ public numTables: Word;
+ public searchRange: Word;
+ public entrySelector: Word;
+ public rangeShift: Word;
+ end;
+
+ TrueTypeFont = class(TTF_Helpers)
+ // Fields
+ strict private FIsLoaded: Boolean;
+ strict private beginfile_ptr: Pointer;
+ public checksum_action: ChecksumFaultAction;
+ strict private cmap_table: CmapTableClass;
+ strict private dir: TableDirectory;
+ strict private font_header: FontHeaderClass;
+ strict private glyph_table: GlyphTableClass;
+ strict private gsub_table: GlyphSubstitutionClass;
+ strict private horizontal_header: HorizontalHeaderClass;
+ strict private horizontal_metrix_table: HorizontalMetrixClass;
+ strict private index_to_location: IndexToLocationClass;
+ strict private kerning_table: KerningTableClass;
+ strict private name_table: NameTableClass;
+ strict private postscript: PostScriptClass;
+ strict private profile: MaximumProfileClass;
+ strict private selector_ptr: Pointer;
+ public windows_metrix: OS2WindowsMetricsClass;
+ strict private preprogram_table: PreProgramClass;
+
+ strict private ListOfTables: TDictionary;
+ strict private ListOfUsedGlyphs: TList;
+
+
+ // Methods
+ public constructor Create(bgn: Pointer; font: Pointer; action: ChecksumFaultAction);
+ public destructor Destroy; override;
+ public procedure AddCharacterToKeepList(ch: Char);
+ strict private procedure BuildGlyphIndexList(used_glyphs: TList; uniscribe: boolean; decompose: boolean; collate: boolean; use_kerning: boolean; var Indices: TIntegerList; var GlyphWidths: TIntegerList; ComposedList: TList);
+ strict private function CalcTableChecksum(font: Pointer; entry: TrueTypeTable; debug: boolean): Cardinal;
+ strict private procedure CalculateFontChecksum(start_offset: Pointer; font_length: Cardinal);
+ strict private procedure ChangeEndian;
+ strict private procedure CheckTablesChecksum;
+ // public function DrawString(text: string; position: Point; size: Integer): GraphicsPath;
+ // public function GetGlyph(ch: Char; size: Integer; position: Point): GraphicsPath;
+ public function GetGlyphIndices(text: string; glyphs: PWord; widths: PInteger; rtl: boolean; ComposedList: TList): Integer;
+ public procedure GetOutlineTextMetrics(FTextMetric: Pointer);
+ strict private function GetTablesOrder: TTagList;
+ strict private procedure LoadCoreTables;
+ strict private procedure LoadDescriptors(skip_array: TIntegerList);
+ public function PackFont(translate_to: FontType; uniscribe: boolean; sStream: TStream): TByteArray;
+ public procedure PrepareFont(skip_list: TIntegerList);
+ strict private procedure ReorderGlyphTable(position: Pointer; uniscribe: boolean);
+ strict private procedure SaveDescriptors(position: Pointer);
+ strict private procedure set_UsedGlyphs(dict: TList);
+
+ // Properties
+
+ public property Names: NameTableClass read name_table;
+ public property IsLoaded: Boolean read FIsLoaded;
+ public property UsedGlyphs: Tlist write set_UsedGlyphs;
+ // public property TablesList: ICollection read get_TablesList;
+ end;
+
+implementation uses System.SysUtils;
+
+ constructor TrueTypeFont.Create(bgn: Pointer; font: Pointer; action: ChecksumFaultAction);
+// var
+// key: Word;
+ begin
+ FIsLoaded := False;
+ self.ListOfTables := TDictionary.Create;
+ self.ListOfUsedGlyphs := TList.Create;
+ self.beginfile_ptr := {&}bgn;
+ self.selector_ptr := font;
+ self.checksum_action := action;
+// key := 0;
+// self.ListOfUsedGlyphs.Add(key)
+ end;
+
+
+destructor TrueTypeFont.Destroy;
+ var
+ t: TrueTypeTable;
+ i: TablesID;
+ begin
+ for i in ListOfTables.Keys do
+ begin
+ t := self.ListOfTables.Items[i];
+ t.Free;
+ end;
+ self.ListOfTables.Clear;
+ self.ListOfTables.Free;
+ self.ListOfUsedGlyphs.Clear;
+ self.ListOfUsedGlyphs.Free;
+// self.ListOfUsedWidths.Clear;
+// self.ListOfUsedWidths.Free;
+
+
+ end;
+
+
+procedure TrueTypeFont.set_UsedGlyphs(dict: TList);
+ var
+ i: Integer;
+ key: Word;
+ begin
+ self.ListOfUsedGlyphs.Clear;
+// self.ListOfUsedGlyphs.Add(0);
+ for i := 0 to dict.Count - 1 do
+ if Integer(Word(dict[i])) = Integer(dict[i]) then
+ begin
+ key := Word(dict[i]);
+ if (self.ListOfUsedGlyphs.IndexOf(Pointer(key)) = -1) then
+ self.ListOfUsedGlyphs.Add(Pointer(key))
+ end
+ else
+ raise Exception.Create('Format errir');
+ end;
+
+ procedure TrueTypeFont.AddCharacterToKeepList(ch: Char);
+ var
+ key: Word;
+ begin
+ key := Word(ch);
+ if (self.ListOfUsedGlyphs.IndexOf(Pointer(key)) = -1) then
+ self.ListOfUsedGlyphs.Add(Pointer(key))
+ end;
+
+ procedure TrueTypeFont.BuildGlyphIndexList(used_glyphs: TList; uniscribe: boolean; decompose: boolean; collate: boolean; use_kerning: boolean; var Indices: TIntegerlist; var GlyphWidths: TIntegerList; ComposedList: TList);
+ var
+ location: Cardinal;
+ composed_idx: Word;
+ i, j, length, GlyphWidth: Integer;
+ key, idx, next_idx: Word;
+ hash_index: Cardinal;
+ composed_indexes: TIntegerlist;
+ new_key, kerning: Smallint;
+ begin
+ composed_indexes := nil;
+ i := 0;
+ while ((i < used_glyphs.Count)) do
+ begin
+ key := Word(used_glyphs[i]);
+
+ if uniscribe then idx := key else idx := self.cmap_table.GetGlyphIndex(key);
+// if (collate) then self.ListOfUsedGlyphs[key] := idx;
+ length := self.index_to_location.GetGlyph(idx, self.font_header, location);
+ if (length <> 0) then
+ begin
+ GlyphWidth := 0;
+ composed_idx := $FFFF;
+
+ if (not collate or (Indices.IndexOf(Pointer(idx)) = -1)) then
+ begin
+ //if composed_idx = $FFFF then
+ Indices.Add( Pointer(idx));
+ //GlyphWidth := ((self.horizontal_metrix_table.Item[idx].advanceWidth * $3e8) div self.font_header.unitsPerEm);
+ //if idx < self.horizontal_metrix_table.NumberOfMetrics then
+ GlyphWidth := ((self.horizontal_metrix_table.Item[idx].advanceWidth * $3e8) div self.font_header.unitsPerEm);
+ // else
+ // GlyphWidth := (self.windows_metrix.AvgCharWidth * $3e8) div self.font_header.unitsPerEm;
+
+ GlyphWidths.Add(Pointer(GlyphWidth));
+ end;
+
+ composed_indexes := self.glyph_table.CheckGlyph(Cardinal(location), length);
+ for j := 0 to composed_indexes.Count - 1 do
+ begin
+ composed_idx := Word(composed_indexes[j]);
+ new_key := Indices.IndexOf(Pointer(composed_idx));
+ if (not collate or (decompose and (new_key = -1))) then
+ begin
+ if ComposedList <> nil then
+ begin
+ if ComposedList.IndexOf(Pointer(composed_idx)) = -1 then
+ ComposedList.Add(Pointer(composed_idx))
+ end
+ else
+ Indices.Add( Pointer(composed_idx));
+ //GlyphWidth := ((self.horizontal_metrix_table.Item[composed_idx].advanceWidth * $3e8) div self.font_header.unitsPerEm);
+// if (use_kerning and ((i < (used_glyphs.Count - 1)) and (self.kerning_table <> nil))) then
+// begin
+// new_key := Word(used_glyphs[i + 1]);
+// if uniscribe then next_idx := new_key else next_idx := self.cmap_table.GetGlyphIndex(new_key);
+// hash_index := Cardinal(composed_idx or (next_idx shl $10));
+// kerning := self.kerning_table.Item[hash_index];
+// inc(GlyphWidth, ((kerning * $3e8) div self.font_header.unitsPerEm))
+// end;
+ //GlyphWidths.Add(Pointer(GlyphWidth))
+ end;
+ end;
+ if Assigned(composed_indexes) then
+ FreeandNil(composed_indexes);
+
+ end
+ else
+ begin
+ new_key := Indices.IndexOf(Pointer(idx));
+ if (((key = $20) or (key = $A0)) and (not collate or (new_key = -1))) then
+ begin
+ Indices.Add(Pointer(idx));
+ if location <> 0 then
+ j := ((self.horizontal_metrix_table.Item[idx].advanceWidth * $3e8) div self.font_header.unitsPerEm)
+ else
+ j := (self.windows_metrix.AvgCharWidth * $3e8) div self.font_header.unitsPerEm;
+
+ if (use_kerning and (i < (used_glyphs.Count - 1))) then
+ begin
+ new_key := Word(used_glyphs[i + 1]);
+ if uniscribe then next_idx := new_key else next_idx := self.cmap_table.GetGlyphIndex(new_key);
+ hash_index := Cardinal(idx or (next_idx shl 16));
+ kerning := 0;
+ if (self.kerning_table <> nil) then
+ kerning := self.kerning_table.Item[hash_index];
+ if kerning = 0 then
+ kerning := self.horizontal_metrix_table.Item[next_idx].lsb;
+
+ Dec(j, ((kerning * $3e8) div self.font_header.unitsPerEm))
+ end;
+
+ GlyphWidths.Add(Pointer(j))
+ end;
+
+
+ end;
+ inc(i)
+ end;
+ //FreeandNil(used_glyphs);
+ end;
+ {$OVERFLOWCHECKS OFF}
+ function TrueTypeFont.CalcTableChecksum(font: Pointer; entry: TrueTypeTable; debug: boolean): Cardinal;
+ var
+ Sum, Length, i: Cardinal;
+ Temp: ^Cardinal;
+ test: LongWord;
+ begin
+ Sum := 0;
+ Length := entry.length div 4;
+ Temp := TTF_Helpers.Increment(font, entry.offset );
+ i := 0;
+ while ((i < Length)) do
+ begin
+ inc( Sum, TTF_Helpers.SwapUInt32( Temp^ ));
+// if debug then WriteLn( 'Idx ', i, ' Value ', Integer(Temp^), ' Sum ', IntToHex( Sum, 8));
+ Inc( Temp, 1 );
+ Inc(i, 1)
+ end;
+
+ if entry.length mod 4 <> 0 then
+ begin
+ i := i*4;
+ Test := $ffffffff;
+ if i + 1 = entry.length then Test:= $ff000000;
+ if i + 2 = entry.length then Test:= $ffff0000;
+ if i + 3 = entry.length then Test:= $ffffff00;
+ inc( Sum, (Test and TTF_Helpers.SwapUInt32( Temp^ )) );
+ end;
+ Result := Sum;
+ end;
+
+ procedure TrueTypeFont.CalculateFontChecksum(start_offset: Pointer; font_length: Cardinal);
+ var
+ Sum, Length, i: Cardinal;
+ Temp: ^Cardinal;
+ begin
+ Sum := 0;
+ length := font_length div 4;
+ Temp := start_offset;
+ i := 0;
+ while ((i < length)) do
+ begin
+ Inc(Sum, TTF_Helpers.SwapUInt32( Temp^ ));
+// WriteLn( 'Font checksum[', i, '] is ', IntToHex( Sum, 8));
+ Inc( Temp );
+ Inc(i, 1)
+ end;
+ Sum := ($b1b0afba - Sum);
+ self.font_header.SaveFontHeader(self.beginfile_ptr, Sum)
+ end;
+ {$OVERFLOWCHECKS ON}
+ procedure TrueTypeFont.ChangeEndian;
+ begin
+ self.dir.sfntversion := TTF_Helpers.SwapUInt32(self.dir.sfntversion);
+ self.dir.numTables := TTF_Helpers.SwapUInt16(self.dir.numTables);
+ self.dir.searchRange := TTF_Helpers.SwapUInt16(self.dir.searchRange);
+ self.dir.entrySelector := TTF_Helpers.SwapUInt16(self.dir.entrySelector);
+ self.dir.rangeShift := TTF_Helpers.SwapUInt16(self.dir.rangeShift)
+ end;
+
+ procedure TrueTypeFont.CheckTablesChecksum;
+ var
+ entry: TrueTypeTable;
+ checksum: Cardinal;
+ begin
+ if (self.checksum_action <> ChecksumFaultAction.IgnoreChecksum) then
+ for entry in self.ListOfTables.Values do try
+ checksum := self.CalcTableChecksum(self.beginfile_ptr, entry, false);
+ if ( checksum <> entry.checkSum) then
+ raise Exception.Create( String('Table ID "' + entry.TAGLINE + '" checksum error.' + IntToStr(checksum) + ' ' + IntToStr(entry.checkSum)))
+ except
+ on ex: Exception do
+ begin
+ if (self.checksum_action = ChecksumFaultAction.ThrowException) then
+ raise ex;
+ //if (Windows.MessageBox(GetDesktopWindow, PChar(ex.Message), PChar('Font table checksum error'), MB_YESNO) = 0) then
+ // raise ex
+ end
+ end
+ end;
+
+{$IFDEF DRAWING_MANUALLY}
+ function TrueTypeFont.DrawString(text: string; position: Point; size: Integer): GraphicsPath;
+ var
+ ch: Char;
+ location: Cardinal;
+ gheader: GlyphHeader;
+ glyph_path: GraphicsPath;
+ composed_idx: Word;
+ begin
+ path := GraphicsPath.Create(FillMode.Winding);
+ rsize := ((self.font_header.unitsPerEm as Single) div (size as Single));
+ uniscribe := false;
+
+ for ch in text do
+ begin
+ glyph_width := 0;
+ gheader.xMin := 0;
+ gheader.xMax := 10;
+ idx := /*pseudo*/ (if uniscribe then ch else self.cmap_table.GetGlyphIndex(ch));
+ glyph_size := self.index_to_location.GetGlyph(idx, self.font_header, @(location));
+ if (glyph_size <> 0) then
+ begin
+ composed_indexes := self.glyph_table.CheckGlyph((location as Integer), glyph_size);
+ if (composed_indexes.Count <> 0) then
+
+ for composed_idx in composed_indexes do
+ begin
+ glyph_size := self.index_to_location.GetGlyph(composed_idx, self.font_header, @(location));
+ glyph_path := self.glyph_table.GetGlyph((location as Integer), glyph_size, rsize, position, @(gheader));
+ path.AddPath(glyph_path, false)
+ end
+ else
+ begin
+ glyph_path := self.glyph_table.GetGlyph((location as Integer), glyph_size, rsize, position, @(gheader));
+ path.AddPath(glyph_path, false)
+ end
+ end;
+ glyph_width := (((gheader.xMax as Single) div rsize) as Integer);
+ inc(glyph_width, 4);
+ inc(position.X, glyph_width)
+ end;
+ begin
+ Result := path;
+ exit
+ end
+ end;
+
+ function TrueTypeFont.GetGlyph(ch: Char; size: Integer; position: Point): GraphicsPath;
+ var
+ gheader: GlyphHeader;
+ location: Cardinal;
+ begin
+ i2l_idx := self.cmap_table.GetGlyphIndex(ch);
+ length := self.index_to_location.GetGlyph(i2l_idx, self.font_header, @(location));
+ rsize := ((self.font_header.unitsPerEm as Single) div (size as Single));
+ Result := self.glyph_table.GetGlyph((location as Integer), length, rsize, position, @(gheader))
+ end;
+{$ENDIF}
+ function TrueTypeFont.GetGlyphIndices(text: string; glyphs: PWord; widths: PInteger; rtl: boolean; ComposedList: TList): Integer;
+ var
+ text_widths, text_as_array, IndexList: TIntegerList;
+ ch: Char;
+ I: Integer;
+ begin
+ IndexList := TIntegerList.Create;
+ text_widths := TIntegerList.Create;
+ text_as_array := TIntegerList.Create;
+
+ for ch in text do
+ begin
+ text_as_array.Add(PWord(ch))
+ end;
+ self.BuildGlyphIndexList(text_as_array, false, false, false, false, IndexList, text_widths, ComposedList);
+ //glyphs := GetMemory(sizeof(Word) * IndexList.Count);
+ for I := 0 to IndexList.Count - 1 do
+ begin
+ glyphs^ := Word(IndexList[I]);
+ Inc(glyphs);
+ end;
+ // widths := GetMemory(sizeof(Integer) * text_widths.Count);
+ for I := 0 to text_widths.Count - 1 do
+ begin
+ widths^ := Integer(text_widths[I]);
+ Inc(widths);
+ end;
+ //widths := (text_widths.ToArray(typeof(Integer)) as Integer[]);
+ //text_as_array.Free;
+
+ //begin
+ Result := IndexList.Count;
+ FreeandNil(IndexList);
+ FreeandNil(text_widths);
+ text_as_array.Free;
+ // exit
+ // end
+ end;
+
+
+ procedure TrueTypeFont.GetOutlineTextMetrics(FTextMetric: Pointer);
+ var
+ lMetric: POutlineTextmetric;
+ begin
+ lMetric := POutlineTextmetric(FTextMetric);
+ lMetric^.otmSize := $d4;
+ lMetric^.otmTextMetrics.tmHeight := (self.windows_metrix.Ascent + self.windows_metrix.Descent);
+ lMetric^.otmTextMetrics.tmAscent := self.windows_metrix.Ascent;
+ lMetric^.otmTextMetrics.tmDescent := self.windows_metrix.Descent;
+ lMetric^.otmTextMetrics.tmAveCharWidth := self.windows_metrix.AvgCharWidth;
+ lMetric^.otmTextMetrics.tmMaxCharWidth := self.horizontal_header.MaxWidth;
+ lMetric^.otmTextMetrics.tmFirstChar := WideChar(self.windows_metrix.FirstCharIndex);
+ lMetric^.otmTextMetrics.tmLastChar := WideChar(self.windows_metrix.LastCharIndex);
+ lMetric^.otmTextMetrics.tmDefaultChar := WideChar(self.windows_metrix.DefaultChar);
+ lMetric^.otmTextMetrics.tmBreakChar := WideChar(self.windows_metrix.BreakChar);
+ lMetric^.otmPanoseNumber.bFamilyType := self.windows_metrix.Panose[0];
+ lMetric^.otmPanoseNumber.bSerifStyle := self.windows_metrix.Panose[1];
+ lMetric^.otmPanoseNumber.bWeight := self.windows_metrix.Panose[2];
+ lMetric^.otmPanoseNumber.bProportion := self.windows_metrix.Panose[3];
+ lMetric^.otmPanoseNumber.bContrast := self.windows_metrix.Panose[4];
+ lMetric^.otmPanoseNumber.bStrokeVariation := self.windows_metrix.Panose[5];
+// FTextMetric.otmPanoseNumber.ArmStyle := self.windows_metrix.Panose[6];
+ lMetric^.otmPanoseNumber.bLetterform := self.windows_metrix.Panose[7];
+ lMetric^.otmPanoseNumber.bMidline := self.windows_metrix.Panose[8];
+ lMetric^.otmPanoseNumber.bXHeight := self.windows_metrix.Panose[9];
+ lMetric^.otmItalicAngle := ((self.postscript.ItalicAngle shr $10) * 10);
+ lMetric^.otmEMSquare := self.font_header.unitsPerEm;
+ lMetric^.otmAscent := self.horizontal_header.Ascender;
+ lMetric^.otmDescent := self.horizontal_header.Descender;
+ if self.horizontal_header.LineGap > 0 then
+ lMetric^.otmLineGap := Cardinal(self.horizontal_header.LineGap)
+ else
+ lMetric^.otmLineGap := 0;
+ lMetric^.otmpFamilyName := PAnsiChar(AnsiString(self.name_table.Item[NameID.FamilyName]));
+ lMetric^.otmpFullName := PAnsiChar(AnsiString(self.name_table.Item[NameID.FullName]))
+ end;
+
+
+ function TrueTypeFont.GetTablesOrder: TTagList;
+ var
+ entry: TrueTypeTable;
+ offset: Cardinal;
+ indexed_tags: TList; //;
+ tables_positions: TList;
+ TablesOrder: TDictionary;
+ tag: Cardinal;
+ i: Integer;
+ begin
+ TablesOrder := TDictionary.Create;
+
+ for entry in self.ListOfTables.Values do
+ begin
+ TablesOrder.Add(entry.offset, entry.tag)
+ end;
+
+ tables_positions := TList.Create(TablesOrder.Keys);
+ tables_positions.Sort;
+ indexed_tags := TList.Create;
+
+ for i := 0 to tables_positions.Count - 1 do
+ begin
+ offset := Cardinal(tables_positions[i]);
+ tag := Cardinal(TablesOrder.Items[offset]);
+ indexed_tags.Add(Pointer(tag))
+ end;
+ tables_positions.Clear;
+ TablesOrder.Clear;
+ begin
+ Result := indexed_tags;
+ end;
+ TablesOrder.Free;
+ tables_positions.Free;
+ end;
+
+ procedure TrueTypeFont.LoadCoreTables;
+ begin
+ if ListOfTables.ContainsKey(TablesID.FontHeader) then
+ begin
+ font_header := (self.ListOfTables.Items[TablesID.FontHeader] as FontHeaderClass);
+ font_header.Load(self.beginfile_ptr);
+ end;
+
+ if ListOfTables.ContainsKey(TablesID.MaximumProfile) then
+ begin
+ profile := (self.ListOfTables.Items[TablesID.MaximumProfile] as MaximumProfileClass);
+ profile.Load(self.beginfile_ptr);
+ end;
+
+ if ListOfTables.ContainsKey(TablesID.HorizontalHeader) then
+ begin
+ horizontal_header := (self.ListOfTables.Items[TablesID.HorizontalHeader] as HorizontalHeaderClass);
+ horizontal_header.Load(self.beginfile_ptr);
+ end;
+
+ if (ListOfTables.ContainsKey(TablesID.Postscript)) then
+ begin
+ postscript := (self.ListOfTables.Items[TablesID.Postscript] as PostScriptClass);
+ postscript.Load(self.beginfile_ptr)
+ end;
+
+ if ListOfTables.ContainsKey(TablesID.OS2Table) then
+ begin
+ windows_metrix := (self.ListOfTables.Items[TablesID.OS2Table] as OS2WindowsMetricsClass);
+ windows_metrix.Load(self.beginfile_ptr);
+ end;
+
+ if ListOfTables.ContainsKey(TablesID.IndexToLocation) then
+ begin
+ index_to_location := (self.ListOfTables.Items[TablesID.IndexToLocation] as IndexToLocationClass);
+ index_to_location.LoadIndexToLocation(self.beginfile_ptr, self.font_header);
+ end;
+
+ if ListOfTables.ContainsKey(TablesID.CMAP) then
+ begin
+ cmap_table := (self.ListOfTables.Items[TablesID.CMAP] as CmapTableClass);
+ cmap_table.LoadCmapTable(self.beginfile_ptr);
+ end;
+
+ if ListOfTables.ContainsKey(TablesID.Name) then
+ begin
+ name_table := (self.ListOfTables.Items[TablesID.Name] as NameTableClass);
+ name_table.Load(self.beginfile_ptr);
+ end;
+
+ if ListOfTables.ContainsKey(TablesID.Glyph) then
+ begin
+ glyph_table := (self.ListOfTables.Items[TablesID.Glyph] as GlyphTableClass);
+ glyph_table.Load(self.beginfile_ptr);
+ end;
+
+ if (self.ListOfTables.ContainsKey(TablesID.KerningTable)) then
+ begin
+ self.kerning_table := (self.ListOfTables.Items[TablesID.KerningTable] as KerningTableClass);
+ self.kerning_table.Load(self.beginfile_ptr)
+ end;
+
+ if ListOfTables.ContainsKey(TablesID.GlyphSubstitution) then
+ begin
+ gsub_table := (self.ListOfTables.Items[TablesID.GlyphSubstitution] as GlyphSubstitutionClass);
+ gsub_table.Load(self.beginfile_ptr)
+ end;
+
+ if ListOfTables.ContainsKey(TablesID.PreProgram) then
+ begin
+ preprogram_table := self.ListOfTables.Items[TablesID.PreProgram] as PreProgramClass;
+ preprogram_table.Load(self.beginfile_ptr);
+ end;
+
+ if ListOfTables.ContainsKey(TablesID.HorizontalMetrix) then
+ begin
+ horizontal_metrix_table := (self.ListOfTables.Items[TablesID.HorizontalMetrix] as HorizontalMetrixClass);
+ horizontal_metrix_table.NumberOfMetrics := self.horizontal_header.NumberOfHMetrics;
+ horizontal_metrix_table.Load(self.beginfile_ptr)
+ end
+ end;
+
+ procedure TrueTypeFont.LoadDescriptors(skip_array: TIntegerList);
+ var
+ parsed_table: TrueTypeTable;
+ table: TrueTypeTable;
+ i: Integer;
+// tbls: Pointer;
+ tdir_ptr: ^TableDirectory;
+ entry_ptr: ^TableEntry;
+ begin
+ tdir_ptr := self.selector_ptr;
+ self.dir.sfntversion := tdir_ptr.sfntversion;
+ self.dir.numTables := tdir_ptr.numTables;
+ self.dir.searchRange := tdir_ptr.searchRange;
+ self.dir.entrySelector := tdir_ptr.entrySelector;
+ self.dir.rangeShift := tdir_ptr.rangeShift;
+ self.ChangeEndian;
+ entry_ptr := TTF_Helpers.Increment(self.selector_ptr, SizeOf(TableDirectory));
+ i := 0;
+ while ((i < self.dir.numTables)) do
+ begin
+ table := TrueTypeTable.Create(entry_ptr);
+ if (skip_array.IndexOf( Pointer(table.tag)) = -1) then
+ begin
+ case ( TablesID(table.tag) ) of
+ TablesID.HorizontalHeader:
+ begin parsed_table := HorizontalHeaderClass.Create(table);
+ table.Free;
+ end;
+ TablesID.FontHeader:
+ begin parsed_table := FontHeaderClass.Create(table);
+ table.Free;
+ end;
+ TablesID.Name:
+ begin parsed_table := NameTableClass.Create(table);
+ table.Free;
+ end;
+ TablesID.OS2Table:
+ begin parsed_table := OS2WindowsMetricsClass.Create(table);
+ table.Free;
+ end;
+ TablesID.GlyphSubstitution:
+ begin parsed_table := GlyphSubstitutionClass.Create(table);
+ table.Free;
+ end;
+ TablesID.IndexToLocation:
+ begin parsed_table := IndexToLocationClass.Create(table);
+ table.Free;
+ end;
+ TablesID.Glyph:
+ begin parsed_table := GlyphTableClass.Create(table);
+ table.Free;
+ end;
+ TablesID.KerningTable:
+ begin parsed_table := KerningTableClass.Create(table);
+ table.Free;
+ end;
+ TablesID.CMAP:
+ begin parsed_table := CmapTableClass.Create(table);
+ table.Free;
+ end;
+ TablesID.Postscript:
+ begin parsed_table := PostScriptClass.Create(table);
+ table.Free;
+ end;
+ TablesID.HorizontalMetrix:
+ begin parsed_table := HorizontalMetrixClass.Create(table);
+ table.Free;
+ end;
+ TablesID.PreProgram:
+ begin parsed_table := PreProgramClass.Create(table);
+ table.Free;
+ end;
+ TablesID.MaximumProfile:
+ begin parsed_table := MaximumProfileClass.Create(table);
+ table.Free;
+ end;
+ else
+ begin parsed_table := table; end;
+ end;
+
+ try
+ self.ListOfTables.Add( TablesID(parsed_table.tag), parsed_table)
+ except
+ //on ex: Exception do
+ // Windows.MessageBox(0, PChar(ex.Message), PChar('Font format error'), MB_YesNo)
+ end
+ end
+ else
+ table.Free;
+// else Writeln('Skip table ', table.TAGLINE );
+ entry_ptr := TTF_Helpers.Increment(entry_ptr, SizeOf(TableEntry));
+ inc(i)
+ end;
+ self.dir.numTables := self.ListOfTables.Count
+ end;
+
+ procedure TrueTypeFont.SaveDescriptors(position: Pointer);
+ var
+ i: Integer;
+ tag: TablesID;
+ td_ptr: ^TableDirectory;
+ descriptor_list: TList;
+ tbls: Pointer;
+ begin
+ td_ptr := position;
+ td_ptr.sfntversion := TTF_Helpers.SwapUInt32(self.dir.sfntversion);
+ td_ptr.numTables := TTF_Helpers.SwapUInt16(self.dir.numTables);
+ td_ptr.searchRange := TTF_Helpers.SwapUInt16(self.dir.searchRange);
+ td_ptr.entrySelector := TTF_Helpers.SwapUInt16(self.dir.entrySelector);
+ td_ptr.rangeShift := TTF_Helpers.SwapUInt16(self.dir.rangeShift);
+
+ tbls := TTF_Helpers.Increment(position, SizeOf(TableDirectory));
+ descriptor_list := TList.Create(self.ListOfTables.Keys);
+ i := 0;
+ while ((i < descriptor_list.Count)) do
+ begin
+ descriptor_list.Items[i] := TablesID(TTF_Helpers.SwapUInt32( Cardinal(descriptor_list.Items[i])));
+ inc(i)
+ end;
+ descriptor_list.Sort;
+ i := 0;
+ while ((i < descriptor_list.Count)) do
+ begin
+ descriptor_list.Items[i] := TablesID(TTF_Helpers.SwapUInt32( Cardinal(descriptor_list.Items[i])));
+ inc(i)
+ end;
+
+ for tag in descriptor_list do
+ begin
+ tbls := TrueTypeTable(self.ListOfTables.Items[tag]).StoreDescriptor(tbls);
+ {
+ Writeln(
+ 'Indexed tag ', TrueTypeTable(self.ListOfTables.Items[tag]).TAGLINE,
+ ' Checksum ', IntToHex(TrueTypeTable(self.ListOfTables.Items[tag]).checkSum, 8),
+ ' Size ', TrueTypeTable(self.ListOfTables.Items[tag]).length );
+ }
+ end;
+ descriptor_list.Free;
+ descriptor_list := nil
+ end;
+
+ function TrueTypeFont.PackFont(translate_to: FontType; uniscribe: boolean; sStream: TStream): TByteArray;
+ var
+ tag: TablesID;
+ indexed_tags: TTagList;
+ current_offset: Cardinal;
+ buff: TByteArray;
+ table_ptr: TrueTypeTable;
+ i: Integer;
+ ptr: ^Byte;
+ begin
+ indexed_tags := self.GetTablesOrder;
+ self.ReorderGlyphTable(self.beginfile_ptr, uniscribe);
+ current_offset := Cardinal( 12 {SizeOf(FontHeaderClass.FontHeader)} + (self.dir.numTables * $10));
+ for i := 0 to indexed_tags.Count - 1 do
+ begin
+ tag := TablesID(indexed_tags[i]);
+ table_ptr := self.ListOfTables.Items[tag];
+ current_offset := table_ptr.Save(self.beginfile_ptr, current_offset);
+ if ((current_offset mod 4) <> 0) then
+ raise Exception.Create('Align error');
+ end;
+ self.SaveDescriptors(self.beginfile_ptr);
+ self.CalculateFontChecksum(self.beginfile_ptr, current_offset);
+ SetLength( buff, current_offset );
+ ptr := self.beginfile_ptr;
+ for i:=0 to current_offset - 1 do
+ begin
+ buff[i] := ptr^;
+ Inc(Ptr);
+ end;
+ Result := buff;
+ indexed_tags.Free;
+ end;
+
+ procedure TrueTypeFont.PrepareFont(skip_list: TIntegerList);
+ begin
+ self.LoadDescriptors(skip_list);
+ self.LoadCoreTables;
+ self.CheckTablesChecksum;
+ FIsLoaded := True;
+ end;
+
+ function ThisSort(Item1, Item2: Pointer): Integer;
+ begin
+ if ( Integer(Item1) < Integer(Item2) ) then Result := -1
+ else if (Integer(Item1) > Integer(Item2) )
+ then Result := 1 else Result := 0;
+ end;
+
+ procedure TrueTypeFont.ReorderGlyphTable(position: Pointer; uniscribe: boolean);
+ var
+
+ //used_glyphs: TList;
+ i,j: Integer;
+ idx: Word;
+ i2l_idx: Word;
+ length: Word;
+ glyph_table_size, location: Cardinal;
+ LongIndexToLocation: TCardinalArray;
+ ShortIndexToLocation: FMX.frxIndexToLocationClass.TWordArray;
+ table_entry: TrueTypeTable;
+ out_index : Cardinal;
+ sqz_index : Integer;
+ glyph_table_ptr: ^Byte;
+ glyph_ptr: ^Byte;
+ SelectedGlyphs: Array of Byte;
+ i2ll_ptr: ^Cardinal;
+ i2ls_ptr: ^Smallint;
+ out_ms: TMemoryStream;
+ composite_indexes: TIntegerList;
+ glyph_widths: TIntegerList;
+ begin
+ ShortIndexToLocation := self.index_to_location.Short;
+ LongIndexToLocation := self.index_to_location.Long;
+ self.ListOfUsedGlyphs.Sort(ThisSort);
+ //self.ListOfUsedGlyphs.Add(nil);
+ composite_indexes := TIntegerList.Create;
+ glyph_widths := TIntegerList.Create;
+ self.BuildGlyphIndexList(self.ListOfUsedGlyphs, uniscribe, true, true, false, composite_indexes, glyph_widths, nil);
+ composite_indexes.Sort(ThisSort);
+ glyph_table_size := 0;
+ length := 0;
+ location := 0;
+
+ for i := 0 to composite_indexes.Count - 1 do
+ begin
+ idx := Integer(composite_indexes[i]);
+ inc(glyph_table_size, self.index_to_location.GetGlyph(idx, self.font_header, location))
+ end;
+
+ table_entry := self.ListOfTables.Items[TablesID.Glyph];
+ glyph_table_ptr := TTF_Helpers.Increment(self.beginfile_ptr, (table_entry.offset));
+ SetLength( SelectedGlyphs, glyph_table_size);
+ out_index := 0;
+ sqz_index := 0;
+
+ for i := 0 to composite_indexes.Count - 1 do
+ begin
+ i2l_idx := Integer(composite_indexes[i]);
+ length := self.index_to_location.GetGlyph(i2l_idx, self.font_header, location);
+ case self.font_header.indexToLocFormat of
+ IndexToLoc.ShortType:
+ while ((sqz_index <= i2l_idx)) do
+ begin
+ ShortIndexToLocation[sqz_index] := Word((out_index div 2));
+ inc(sqz_index);
+ end;
+ IndexToLoc.LongType:
+ while ((sqz_index <= i2l_idx)) do
+ begin
+ LongIndexToLocation[sqz_index] := out_index;
+ inc(sqz_index);
+ end
+ else raise Exception.Create('Unknown IndexToLoc value')
+ end;
+ if length <> 0 then
+ begin
+ glyph_ptr := TTF_Helpers.Increment(glyph_table_ptr, location);
+ for j:= 0 to length-1 do
+ begin
+ SelectedGlyphs[out_index + Cardinal(j)] := glyph_ptr^;
+ Inc(glyph_ptr);
+ end;
+ Inc(out_index, length);
+ end;
+ end;
+
+ glyph_table_ptr := TTF_Helpers.Increment(self.beginfile_ptr, (table_entry.offset));
+ for i:= 0 to out_index - 1 do
+ begin
+ glyph_table_ptr^ := SelectedGlyphs[i];
+ Inc(glyph_table_ptr);
+ end;
+ table_entry.length := out_index;
+
+{ // Just debug
+ /////////////////////////////////////////////
+ begin
+ glyph_table_ptr := TTF_Helpers.Increment(self.beginfile_ptr, (table_entry.offset));
+ out_ms := TMemoryStream.Create;
+ with out_ms do begin
+ SetSize(out_index);
+ CopyMemory(out_ms.Memory, glyph_table_ptr, out_index);
+ end;
+
+ out_ms.SaveToFile('packed_glyf.bin');
+ out_ms.Clear;
+ out_ms.Free;
+
+ end;
+ /////////////////////////////////////////////
+}
+
+ SelectedGlyphs := nil;
+ table_entry := (self.ListOfTables.Items[TablesID.IndexToLocation] as TrueTypeTable);
+ i := 0;
+ case self.font_header.indexToLocFormat of
+ IndexToLoc.ShortType:
+ begin
+ i2ls_ptr := TTF_Helpers.Increment(self.beginfile_ptr, table_entry.offset);
+ while (sqz_index < High(ShortIndexToLocation)) do
+ begin
+ ShortIndexToLocation[sqz_index] := Word((out_index div 2));
+ inc(sqz_index)
+ end;
+ while (i < High(ShortIndexToLocation)) do
+ begin
+ i2ls_ptr^ := Smallint(TTF_Helpers.SwapUInt16(ShortIndexToLocation[i]));
+ Inc(i2ls_ptr);
+ inc(i)
+ end;
+ end;
+
+ IndexToLoc.LongType:
+ begin
+ i2ll_ptr := TTF_Helpers.Increment(self.beginfile_ptr, table_entry.offset);
+ while (sqz_index <= High(LongIndexToLocation)) do
+ begin
+ LongIndexToLocation[sqz_index] := out_index;
+ inc(sqz_index)
+ end;
+ while (i <= High(LongIndexToLocation)) do
+ begin
+ i2ll_ptr^ := Cardinal(TTF_Helpers.SwapUInt32(LongIndexToLocation[i]));
+ Inc(i2ll_ptr);
+ inc(i)
+ end;
+ end;
+ end;
+ table_entry.checkSum := self.CalcTableChecksum(self.beginfile_ptr, table_entry, false);
+ table_entry := (self.ListOfTables.Items[TablesID.Glyph] as TrueTypeTable);
+ table_entry.checkSum := self.CalcTableChecksum(self.beginfile_ptr, table_entry, true );
+ if glyph_widths <> nil then
+ begin
+ glyph_widths.Clear;
+ glyph_widths.Free;
+ end;
+ if composite_indexes <> nil then
+ begin
+ composite_indexes.Clear;
+ composite_indexes.Free;
+ end;
+ end;
+{$hints on}
+end.
+
+
diff --git a/LibD28/FMX.frxTrueTypeTable.pas b/LibD28/FMX.frxTrueTypeTable.pas
new file mode 100644
index 0000000..79fbdf4
--- /dev/null
+++ b/LibD28/FMX.frxTrueTypeTable.pas
@@ -0,0 +1,191 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Font parser }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Aleksey Mandrykin, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+{$hints off}
+unit FMX.frxTrueTypeTable;
+interface
+
+uses FMX.TTFHelpers;
+
+type // Nested Types
+
+ TableEntry = packed record
+ public tag: Cardinal;
+ public checkSum: Cardinal;
+ public offset: Cardinal;
+ public length: Cardinal;
+ end;
+
+ TrueTypeTable = class(TTF_Helpers)
+ // Fields
+ strict protected entry: TableEntry;
+
+ // Methods
+ public constructor Create(parent: TrueTypeTable); overload;
+ public constructor Create(entry_ptr: Pointer); overload;
+ strict private procedure ChangeEndian;
+ protected procedure Load(font: Pointer); virtual;
+ public function Save(font: Pointer; offset: Cardinal): Cardinal; virtual;
+ public function StoreDescriptor(descriptor_ptr: Pointer): Pointer;
+ strict private function StoreTable(source_ptr: Pointer; destination_ptr: Pointer; output_offset: Cardinal): Cardinal;
+ strict private function get_TAGLINE: string;
+ strict private procedure set_length(length: Cardinal);
+ strict private procedure set_offset(offset: Cardinal);
+
+ // Properties
+ public property length: Cardinal read entry.length write set_length;
+ public property offset: Cardinal read entry.offset write set_offset;
+ public property checkSum: Cardinal read entry.checkSum write entry.checkSum;
+ public property tag: Cardinal read entry.tag write entry.tag;
+ public property TAGLINE: string read get_TAGLINE;
+ { to do
+ public property descriptor_size: Integer read get_descriptor_size;
+ }
+
+end;
+
+implementation uses System.Classes;
+
+ function TrueTypeTable.get_TAGLINE: string;
+ var
+ s: string;
+ c: char;
+ tag: cardinal;
+ begin
+ SetLength(s, 4);
+ tag := entry.tag;
+ c := Char(tag mod $100);
+ tag := tag div $100;
+ s[1] := c;
+ c := Char(tag mod $100);
+ tag := tag div $100;
+ s[2] := c;
+ c := Char(tag mod $100);
+ tag := tag div $100;
+ s[3] := c;
+ c := Char(tag mod $100);
+// tag := tag div $100;
+ s[4] := c;
+ Result := s;
+ end;
+
+ procedure TrueTypeTable.set_length(length: Cardinal);
+ begin
+ self.entry.length := length;
+ end;
+
+ procedure TrueTypeTable.set_offset(offset: Cardinal);
+ begin
+ self.entry.offset := offset;
+ end;
+
+ constructor TrueTypeTable.Create(parent: TrueTypeTable);
+ begin
+ self.entry := parent.entry
+ end;
+
+ constructor TrueTypeTable.Create(entry_ptr: Pointer);
+ var
+ table_ptr: ^TableEntry;
+ begin
+ table_ptr := entry_ptr;
+ self.entry.checkSum := table_ptr.checkSum;
+ self.entry.length := table_ptr.length;
+ self.entry.offset := table_ptr.offset;
+ self.entry.tag := table_ptr.tag;
+ self.ChangeEndian;
+ end;
+
+ procedure TrueTypeTable.ChangeEndian;
+ begin
+ self.entry.checkSum := TTF_Helpers.SwapUInt32(self.entry.checkSum);
+ self.entry.offset := TTF_Helpers.SwapUInt32(self.entry.offset);
+ self.entry.length := TTF_Helpers.SwapUInt32(self.entry.length)
+ end;
+
+ procedure TrueTypeTable.Load(font: Pointer);
+ begin
+
+ end;
+
+ function TrueTypeTable.Save(font: Pointer; offset: Cardinal): Cardinal;
+// begin
+// Result := self.StoreTable(font, font, offset)
+// end;
+ var
+ out_ms: TMemoryStream;
+ name: string;
+ length: Integer;
+ buffer: Pointer;
+ begin
+ Result := self.StoreTable(font, font, offset);
+
+ begin
+ length := Integer((self.entry.length + 3) Div 4) * 4;
+ buffer := TTF_Helpers.Increment(font, self.entry.offset);
+
+{$IFDEF DEBUG_FONT}
+ out_ms := TMemoryStream.Create; // Debug issue
+ with out_ms do begin
+ SetSize(length);
+ CopyMemory(out_ms.Memory, buffer, length);
+ end;
+ if Self.get_TAGLINE = 'OS/2' then
+ name := 'C:\TEMP\FONT\OS2'
+ else
+ name := 'C:\TEMP\FONT\' + Self.get_TAGLINE;
+ out_ms.SaveToFile(name);
+ out_ms.Clear;
+ out_ms.Free;
+{$ENDIF}
+ end;
+ end;
+
+ function TrueTypeTable.StoreDescriptor(descriptor_ptr: Pointer): Pointer;
+ var
+ table_ptr: ^TableEntry;
+ begin
+ self.ChangeEndian;
+ table_ptr := descriptor_ptr;
+ table_ptr.checkSum := self.entry.checkSum;
+ table_ptr.length := self.entry.length;
+ table_ptr.offset := self.entry.offset;
+ table_ptr.tag := self.entry.tag;
+ self.ChangeEndian;
+ Result := TTF_Helpers.Increment(descriptor_ptr, SizeOf(TableEntry))
+ end;
+
+ function TrueTypeTable.StoreTable(source_ptr: Pointer; destination_ptr: Pointer; output_offset: Cardinal): Cardinal;
+ var
+ src, dst, buffer: Pointer;
+ length: Integer;
+ begin
+ length := Integer((self.entry.length + 3) Div 4) * 4;
+ src := TTF_Helpers.Increment(source_ptr, self.entry.offset);
+ dst := TTF_Helpers.Increment(destination_ptr, output_offset);
+ if (src <> dst) then
+ begin
+ buffer := AllocMem(length);
+ Move( src^, buffer^, self.entry.length);
+ Move( buffer^, dst^, length);
+ FreeMem(buffer, length);
+ self.entry.offset := output_offset
+ end;
+ output_offset := NativeInt(output_offset) + length;
+
+ begin
+ Result := output_offset;
+ exit
+ end
+ end;
+{$hints on}
+end.
+
diff --git a/LibD28/FMX.frxUnicodeUtils.pas b/LibD28/FMX.frxUnicodeUtils.pas
new file mode 100644
index 0000000..deb9006
--- /dev/null
+++ b/LibD28/FMX.frxUnicodeUtils.pas
@@ -0,0 +1,431 @@
+{*******************************************************}
+{ The Delphi Unicode Controls Project }
+{ }
+{ http://home.ccci.org/wolbrink }
+{ }
+{ Copyright (c) 2002, Troy Wolbrink (wolbrink@ccci.org) }
+{ }
+{*******************************************************}
+
+unit FMX.frxUnicodeUtils;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.Types, System.SysUtils, System.WideStrings;
+
+type
+ UINT = LongWord;
+ {$EXTERNALSYM UINT}
+ TWString = record
+ WString: WideString;
+ Obj: TObject;
+ end;
+
+ TfrxWideStrings = class(TWideStrings)
+ private
+ FWideStringList: TList;
+ procedure ReadData(Reader: TReader);
+ procedure ReadDataWOld(Reader: TReader);
+ procedure ReadDataW(Reader: TReader);
+ procedure WriteDataW(Writer: TWriter);
+ protected
+ function Get(Index: Integer): WideString; override;
+ procedure Put(Index: Integer; const S: WideString); override;
+ function GetObject(Index: Integer): TObject; override;
+ procedure PutObject(Index: Integer; Value: TObject); override;
+ procedure AssignTo(Dest: TPersistent); override;
+ procedure DefineProperties(Filer: TFiler); override;
+ function GetTextStr: WideString; override;
+ procedure SetTextStr(const Value: WideString); override;
+ function GetCount: Integer; override;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ procedure Clear; override;
+ procedure Delete(Index: Integer); override;
+ function Add(const S: WideString): Integer; override;
+ procedure AddStrings(Strings: TWideStrings); override;
+ function AddObject(const S: WideString; AObject: TObject): Integer; override;
+ function IndexOf(const S: WideString): Integer; override;
+ procedure Insert(Index: Integer; const S: WideString); override;
+ procedure LoadFromFile(const FileName: WideString); override;
+ procedure LoadFromStream(Stream: TStream); override;
+ procedure LoadFromWStream(Stream: TStream);
+ procedure SaveToFile(const FileName: WideString); override;
+ procedure SaveToStream(Stream: TStream); override;
+ property Objects[Index: Integer]: TObject read GetObject write PutObject;
+ property Strings[Index: Integer]: WideString read Get write Put; default;
+ property Text: WideString read GetTextStr write SetTextStr;
+ end;
+
+
+implementation
+
+const
+ sLineBreak = #13#10;
+ WideLineSeparator = WideChar($2028);
+ NameValueSeparator = '=';
+
+
+{ TWideStrings }
+constructor TfrxWideStrings.Create;
+begin
+ FWideStringList := TList.Create;
+end;
+
+destructor TfrxWideStrings.Destroy;
+begin
+ Clear;
+ FWideStringList.Free;
+ inherited;
+end;
+
+procedure TfrxWideStrings.Clear;
+var
+ Index: Integer;
+ PWStr: ^TWString;
+begin
+ for Index := 0 to FWideStringList.Count-1 do
+ begin
+ PWStr := FWideStringList.Items[Index];
+ if PWStr <> nil then
+ Dispose(PWStr);
+ end;
+ FWideStringList.Clear;
+end;
+
+function TfrxWideStrings.Get(Index: Integer): WideString;
+var
+ PWStr: ^TWString;
+begin
+ Result := '';
+ if ( (Index >= 0) and (Index < FWideStringList.Count) ) then
+ begin
+ PWStr := FWideStringList.Items[Index];
+ if PWStr <> nil then
+ Result := PWStr^.WString;
+ end;
+end;
+
+procedure TfrxWideStrings.Put(Index: Integer; const S: WideString);
+begin
+ Insert(Index, S);
+end;
+
+function TfrxWideStrings.GetObject(Index: Integer): TObject;
+var
+ PWStr: ^TWString;
+begin
+ Result := nil;
+ if ( (Index >= 0) and (Index < FWideStringList.Count) ) then
+ begin
+ PWStr := FWideStringList.Items[Index];
+ if PWStr <> nil then
+ Result := PWStr^.Obj;
+ end;
+end;
+
+procedure TfrxWideStrings.PutObject(Index: Integer; Value: TObject);
+var
+ PWStr: ^TWString;
+begin
+ if ( (Index >= 0) and (Index < FWideStringList.Count) ) then
+ begin
+ PWStr := FWideStringList.Items[Index];
+ if PWStr <> nil then
+ PWStr^.Obj := Value;
+ end;
+end;
+
+function TfrxWideStrings.Add(const S: WideString): Integer;
+var
+ PWStr: ^TWString;
+begin
+ New(PWStr);
+ PWStr^.WString := S;
+ PWStr^.Obj := nil;
+ Result := FWideStringList.Add(PWStr);
+end;
+
+procedure TfrxWideStrings.Delete(Index: Integer);
+var
+ PWStr: ^TWString;
+begin
+ PWStr := FWideStringList.Items[Index];
+ if PWStr <> nil then
+ Dispose(PWStr);
+ FWideStringList.Delete(Index);
+end;
+
+function TfrxWideStrings.IndexOf(const S: WideString): Integer;
+var
+ Index: Integer;
+ PWStr: ^TWString;
+begin
+ Result := -1;
+ for Index := 0 to FWideStringList.Count -1 do
+ begin
+ PWStr := FWideStringList.Items[Index];
+ if PWStr <> nil then
+ begin
+ if S = PWStr^.WString then
+ begin
+ Result := Index;
+ break;
+ end;
+ end;
+ end;
+end;
+
+function TfrxWideStrings.GetCount: Integer;
+begin
+ Result := FWideStringList.Count;
+end;
+
+procedure TfrxWideStrings.Insert(Index: Integer; const S: WideString);
+var
+ PWStr: ^TWString;
+begin
+ if((Index < 0) or (Index > FWideStringList.Count)) then
+ raise Exception.Create('Wide String Out of Bounds');
+ if Index < FWideStringList.Count then
+ begin
+ PWStr := FWideStringList.Items[Index];
+ if PWStr <> nil then
+ PWStr.WString := S;
+ end
+ else
+ Add(S);
+end;
+
+procedure TfrxWideStrings.AddStrings(Strings: TWideStrings);
+var
+ I: Integer;
+begin
+ for I := 0 to Strings.Count - 1 do
+ AddObject(Strings[I], Strings.Objects[I]);
+end;
+
+function TfrxWideStrings.AddObject(const S: WideString; AObject: TObject): Integer;
+begin
+ Result := Add(S);
+ PutObject(Result, AObject);
+end;
+
+procedure TfrxWideStrings.Assign(Source: TPersistent);
+var
+ I: Integer;
+begin
+ if Source is TWideStrings then
+ begin
+ Clear;
+ AddStrings(TWideStrings(Source));
+ end
+ else if Source is TStrings then
+ begin
+ Clear;
+ for I := 0 to TStrings(Source).Count - 1 do
+ AddObject(TStrings(Source)[I], TStrings(Source).Objects[I]);
+ end
+ else
+ inherited Assign(Source);
+end;
+
+procedure TfrxWideStrings.AssignTo(Dest: TPersistent);
+var
+ I: Integer;
+begin
+ if Dest is TWideStrings then
+ Dest.Assign(Self)
+ else if Dest is TStrings then
+ begin
+ TStrings(Dest).BeginUpdate;
+ try
+ TStrings(Dest).Clear;
+ for I := 0 to Count - 1 do
+ TStrings(Dest).AddObject(Strings[I], Objects[I]);
+ finally
+ TStrings(Dest).EndUpdate;
+ end;
+ end
+ else
+ inherited AssignTo(Dest);
+end;
+
+procedure TfrxWideStrings.DefineProperties(Filer: TFiler);
+begin
+ // compatibility
+ Filer.DefineProperty('Strings', ReadData, nil, Count > 0);
+ Filer.DefineProperty('UTF8', ReadDataWOld, nil, Count > 0);
+ Filer.DefineProperty('UTF8W', ReadDataW, WriteDataW, Count > 0);
+end;
+
+function TfrxWideStrings.GetTextStr: WideString;
+var
+ I, L, Size, Count: Integer;
+ P: PWideChar;
+ S, LB: WideString;
+begin
+ Count := FWideStringList.Count;
+ Size := 0;
+ LB := sLineBreak;
+ for I := 0 to Count - 1 do Inc(Size, Length(Get(I)) + Length(LB));
+ SetString(Result, nil, Size);
+ P := Pointer(Result);
+ for I := 0 to Count - 1 do
+ begin
+ S := Get(I);
+ L := Length(S);
+ if L <> 0 then
+ begin
+ System.Move(Pointer(S)^, P^, L * SizeOf(WideChar));
+ Inc(P, L);
+ end;
+ L := Length(LB);
+ if L <> 0 then
+ begin
+ System.Move(Pointer(LB)^, P^, L * SizeOf(WideChar));
+ Inc(P, L);
+ end;
+ end;
+end;
+
+procedure TfrxWideStrings.LoadFromFile(const FileName: WideString);
+var
+ Stream: TStream;
+begin
+ Stream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ try
+ LoadFromStream(Stream);
+ finally
+ Stream.Free;
+ end;
+end;
+
+procedure TfrxWideStrings.LoadFromStream(Stream: TStream);
+var
+ Size: Integer;
+ S: WideString;
+ ansiS: String;
+ sign: Word;
+begin
+ Size := Stream.Size - Stream.Position;
+ sign := 0;
+ if Size > 2 then
+ Stream.Read(sign, 2);
+
+ if sign = $FEFF then
+ begin
+ Dec(Size, 2);
+ SetLength(S, Size div 2);
+ Stream.Read(S[1], Size);
+ SetTextStr(S);
+ end
+ else
+ begin
+ Stream.Seek(Int64(-2), soFromCurrent);
+ SetLength(ansiS, Size);
+ Stream.Read(ansiS[1], Size);
+ SetTextStr(ansiS);
+ end;
+end;
+
+procedure TfrxWideStrings.LoadFromWStream(Stream: TStream);
+var
+ Size: Integer;
+ S: WideString;
+begin
+ Size := Stream.Size - Stream.Position;
+ SetLength(S, Size div 2);
+ Stream.Read(S[1], Size);
+ SetTextStr(S);
+end;
+
+procedure TfrxWideStrings.ReadData(Reader: TReader);
+begin
+ Clear;
+ Reader.ReadListBegin;
+ while not Reader.EndOfList do
+ if Reader.NextValue in [vaString, vaLString] then
+ Add(Reader.ReadString) {TStrings compatiblity}
+ else
+ Add(Reader.ReadWideString);
+ Reader.ReadListEnd;
+end;
+
+procedure TfrxWideStrings.ReadDataW(Reader: TReader);
+begin
+ Clear;
+ Reader.ReadListBegin;
+ while not Reader.EndOfList do
+ Add(Reader.ReadString);
+ Reader.ReadListEnd;
+end;
+
+procedure TfrxWideStrings.ReadDataWOld(Reader: TReader);
+begin
+ Clear;
+ Reader.ReadListBegin;
+ while not Reader.EndOfList do
+ Add(Utf8Decode(AnsiString(Reader.ReadString)));
+ Reader.ReadListEnd;
+end;
+
+procedure TfrxWideStrings.SaveToFile(const FileName: WideString);
+var
+ Stream: TStream;
+begin
+ Stream := TFileStream.Create(FileName, fmCreate);
+ try
+ SaveToStream(Stream);
+ finally
+ Stream.Free;
+ end;
+end;
+
+procedure TfrxWideStrings.SaveToStream(Stream: TStream);
+var
+ SW: WideString;
+begin
+ SW := GetTextStr;
+ Stream.WriteBuffer(PWideChar(SW)^, Length(SW) * SizeOf(WideChar));
+end;
+
+procedure TfrxWideStrings.SetTextStr(const Value: WideString);
+var
+ P, Start: PWideChar;
+ S: WideString;
+begin
+ Clear;
+ P := Pointer(Value);
+ if P <> nil then
+ while P^ <> #0 do
+ begin
+ Start := P;
+ while not (CharInSet(P^, [WideChar(#0), WideChar(#10), WideChar(#13)])) and (P^ <> WideLineSeparator) do
+ Inc(P);
+ SetString(S, Start, P - Start);
+ Add(S);
+ if P^ = #13 then Inc(P);
+ if P^ = #10 then Inc(P);
+ if P^ = WideLineSeparator then Inc(P);
+ end;
+end;
+
+procedure TfrxWideStrings.WriteDataW(Writer: TWriter);
+var
+ I: Integer;
+begin
+ Writer.WriteListBegin;
+ for I := 0 to Count - 1 do
+ Writer.WriteString(Get(I));
+ Writer.WriteListEnd;
+end;
+
+end.
+
diff --git a/LibD28/FMX.frxUtils.pas b/LibD28/FMX.frxUtils.pas
new file mode 100644
index 0000000..b91851a
--- /dev/null
+++ b/LibD28/FMX.frxUtils.pas
@@ -0,0 +1,937 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Various routines }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxUtils;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.Variants, System.Types, System.UITypes,
+ FMX.Types, FMX.Forms, FMX.Dialogs, System.IniFiles, System.UIConsts,
+ FMX.frxClass, FMX.frxFMX
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+ TfrxRectArea = class
+ public
+ X, Y, X1, Y1: Extended;
+ constructor Create(c: TfrxComponent); overload;
+ constructor Create(Left, Top, Right, Bottom: Extended); overload;
+ function InterceptsX(a: TfrxRectArea): Boolean;
+ function InterceptsY(a: TfrxRectArea): Boolean;
+ function InterceptX(a: TfrxRectArea): TfrxRectArea;
+ function InterceptY(a: TfrxRectArea): TfrxRectArea;
+ function Max(x1, x2: Extended): Extended;
+ function Min(x1, x2: Extended): Extended;
+ end;
+
+function frxFindComponent(Owner: TComponent; const Name: String): TComponent;
+procedure frxGetComponents(Owner: TComponent; ClassRef: TClass;
+ List: TStrings; Skip: TComponent);
+function frxGetFullName(Owner: TComponent; c: TComponent): String;
+procedure frxSetCommaText(const Text: String; sl: TStrings; Comma: Char = ';');
+function frxRemoveQuotes(const s: String): String;
+function frxStreamToString(Stream: TStream): String;
+procedure frxStringToStream(const s: String; Stream: TStream);
+
+function frxStrToFloat(s: String): Extended;
+
+function frxFloatToStr(d: Extended): String;
+function frxRect(ALeft, ATop, ARight, ABottom: Extended): TfrxRect;
+function frxPoint(X, Y: Extended): TfrxPoint;
+function frxGetBrackedVariable(const Str, OpenBracket, CloseBracket: AnsiString;
+ var i, j: Integer): AnsiString;
+function frxGetBrackedVariableW(const Str, OpenBracket, CloseBracket: WideString;
+ var i, j: Integer): WideString;
+procedure frxCommonErrorHandler(Report: TfrxReport; const Text: String);
+procedure frxErrorMsg(const Text: String);
+procedure frxInfoMsg(const Text: String);
+function frxConfirmMsg(const Text: String; Buttons: TMsgDlgButtons): Integer;
+function frxIsValidFloat(const Value: string): Boolean;
+procedure frxAssignImages(Bitmap: TBitmap; dx, dy: Integer;
+ ImgList1: TfrxImageList; ImgList2: TfrxImageList = nil);
+procedure frxParsePageNumbers(const PageNumbers: String; List: TStrings;
+ Total: Integer);
+function HTMLRGBColor(Color: TAlphaColor): string;
+procedure frxWriteCollection(Collection: TCollection; Writer: TWriter;
+ Owner: TfrxComponent);
+procedure frxReadCollection(Collection: TCollection; Reader: TReader;
+ Owner: TfrxComponent);
+function GetAppFileName: String;
+function GetAppPath: String;
+function GetTemporaryFolder: String;
+function GetTempFile: String;
+function frxCreateTempFile(const TempDir: String): String;
+function frFloat2Str(const Value: Extended; const Prec: Integer = 2; const Sep: Char = '.'): String;
+function frxReverseString(const AText: string): string;
+function frxStreamCRC32(Stream: TStream): Cardinal;
+function frxUnixPath2WinPath(const Path: string): string;
+
+function frxHAlignToTextAlign(HAlign: TfrxHAlign): TTextAlign;
+function frxVAlignToTextAlign(VAlign: TfrxVAlign): TTextAlign;
+procedure frxSaveFormPosition(Ini: TCustomIniFile; f: TForm);
+procedure frxRestoreFormPosition(Ini: TCustomIniFile; f: TForm);
+
+
+implementation
+
+uses
+ System.TypInfo, FMX.frxXMLSerializer, FMX.frxRes, System.IOUtils;
+
+
+const
+ rsForm = 'Form';
+ rsWidth = 'Width';
+ rsHeight = 'Height';
+ rsTop = 'Top';
+ rsLeft = 'Left';
+ rsVisible = 'Visible';
+ rsMaximized = 'Maximized';
+ rsData = 'Data';
+ rsSize = 'Size';
+
+
+procedure frxSaveFormPosition(Ini: TCustomIniFile; f: TForm);
+var
+ Name: String;
+begin
+ Name := rsForm + '.' + f.ClassName;
+ Ini.WriteInteger(Name, rsLeft, f.Left);
+ Ini.WriteInteger(Name, rsTop, f.Top);
+ Ini.WriteInteger(Name, rsWidth, f.Width);
+ Ini.WriteInteger(Name, rsHeight, f.Height);
+ Ini.WriteBool(Name, rsMaximized, f.WindowState = wsMaximized);
+ Ini.WriteBool(Name, rsVisible, f.Visible);
+end;
+
+procedure frxRestoreFormPosition(Ini: TCustomIniFile; f: TForm);
+var
+ Name: String;
+begin
+ Name := rsForm + '.' + f.ClassName;
+ if Ini.ReadBool(Name, rsMaximized, False) then
+ f.WindowState := wsMaximized
+ else
+ f.SetBounds(Ini.ReadInteger(Name, rsLeft, f.Left),
+ Ini.ReadInteger(Name, rsTop, f.Top),
+ Ini.ReadInteger(Name, rsWidth, f.Width),
+ Ini.ReadInteger(Name, rsHeight, f.Height));
+// if not (f is TfrxCustomDesigner) then
+ // f.Visible := Ini.ReadBool(Name, rsVisible, True);
+end;
+
+function frxHAlignToTextAlign(HAlign: TfrxHAlign): TTextAlign;
+begin
+ Result := TTextAlign.taCenter;
+ if HAlign = haLeft then
+ Result := TTextAlign.taLeading
+ else if HAlign = haRight then
+ Result := TTextAlign.taTrailing;
+end;
+
+function frxVAlignToTextAlign(VAlign: TfrxVAlign): TTextAlign;
+begin
+ Result := TTextAlign.taCenter;
+ if VAlign = vaTop then
+ Result := TTextAlign.taLeading
+ else if VAlign = vaBottom then
+ Result := TTextAlign.taTrailing;
+end;
+
+
+{ TfrxRectArea }
+
+constructor TfrxRectArea.Create(c: TfrxComponent);
+begin
+ Create(c.AbsLeft, c.AbsTop, c.AbsLeft + c.Width, c.AbsTop + c.Height);
+end;
+
+constructor TfrxRectArea.Create(Left, Top, Right, Bottom: Extended);
+begin
+ X := Left;
+ Y := Top;
+ X1 := Right;
+ Y1 := Bottom;
+end;
+
+function TfrxRectArea.InterceptsX(a: TfrxRectArea): Boolean;
+begin
+ Result := False;
+ if (a.X < X1 - 1e-4) and (a.X1 > X + 1e-4) then
+ Result := True;
+end;
+
+function TfrxRectArea.InterceptsY(a: TfrxRectArea): Boolean;
+begin
+ Result := False;
+ if (a.Y < Y1 - 1e-4) and (a.Y1 > Y + 1e-4) then
+ Result := True;
+end;
+
+function TfrxRectArea.InterceptX(a: TfrxRectArea): TfrxRectArea;
+begin
+ Result := nil;
+ if InterceptsX(a) then
+ Result := TfrxRectArea.Create(Max(a.X, X), 0, Min(a.X1, X1), 0);
+end;
+
+function TfrxRectArea.InterceptY(a: TfrxRectArea): TfrxRectArea;
+begin
+ Result := nil;
+ if InterceptsY(a) then
+ Result := TfrxRectArea.Create(0, Max(a.Y, Y), 0, Min(a.Y1, Y1));
+end;
+
+function TfrxRectArea.Max(x1, x2: Extended): Extended;
+begin
+ if x1 > x2 then
+ Result := x1
+ else
+ Result := x2;
+end;
+
+function TfrxRectArea.Min(x1, x2: Extended): Extended;
+begin
+ if x1 < x2 then
+ Result := x1
+ else
+ Result := x2;
+end;
+
+
+const
+ CRCTable: array [0..255] of Cardinal = (
+ 0000000000, 1996959894, 3993919788, 2567524794,
+ 0124634137, 1886057615, 3915621685, 2657392035,
+ 0249268274, 2044508324, 3772115230, 2547177864,
+ 0162941995, 2125561021, 3887607047, 2428444049,
+ 0498536548, 1789927666, 4089016648, 2227061214,
+ 0450548861, 1843258603, 4107580753, 2211677639,
+ 0325883990, 1684777152, 4251122042, 2321926636,
+ 0335633487, 1661365465, 4195302755, 2366115317,
+ 0997073096, 1281953886, 3579855332, 2724688242,
+ 1006888145, 1258607687, 3524101629, 2768942443,
+ 0901097722, 1119000684, 3686517206, 2898065728,
+ 0853044451, 1172266101, 3705015759, 2882616665,
+ 0651767980, 1373503546, 3369554304, 3218104598,
+ 0565507253, 1454621731, 3485111705, 3099436303,
+ 0671266974, 1594198024, 3322730930, 2970347812,
+ 0795835527, 1483230225, 3244367275, 3060149565,
+ 1994146192, 0031158534, 2563907772, 4023717930,
+ 1907459465, 0112637215, 2680153253, 3904427059,
+ 2013776290, 0251722036, 2517215374, 3775830040,
+ 2137656763, 0141376813, 2439277719, 3865271297,
+ 1802195444, 0476864866, 2238001368, 4066508878,
+ 1812370925, 0453092731, 2181625025, 4111451223,
+ 1706088902, 0314042704, 2344532202, 4240017532,
+ 1658658271, 0366619977, 2362670323, 4224994405,
+ 1303535960, 0984961486, 2747007092, 3569037538,
+ 1256170817, 1037604311, 2765210733, 3554079995,
+ 1131014506, 0879679996, 2909243462, 3663771856,
+ 1141124467, 0855842277, 2852801631, 3708648649,
+ 1342533948, 0654459306, 3188396048, 3373015174,
+ 1466479909, 0544179635, 3110523913, 3462522015,
+ 1591671054, 0702138776, 2966460450, 3352799412,
+ 1504918807, 0783551873, 3082640443, 3233442989,
+ 3988292384, 2596254646, 0062317068, 1957810842,
+ 3939845945, 2647816111, 0081470997, 1943803523,
+ 3814918930, 2489596804, 0225274430, 2053790376,
+ 3826175755, 2466906013, 0167816743, 2097651377,
+ 4027552580, 2265490386, 0503444072, 1762050814,
+ 4150417245, 2154129355, 0426522225, 1852507879,
+ 4275313526, 2312317920, 0282753626, 1742555852,
+ 4189708143, 2394877945, 0397917763, 1622183637,
+ 3604390888, 2714866558, 0953729732, 1340076626,
+ 3518719985, 2797360999, 1068828381, 1219638859,
+ 3624741850, 2936675148, 0906185462, 1090812512,
+ 3747672003, 2825379669, 0829329135, 1181335161,
+ 3412177804, 3160834842, 0628085408, 1382605366,
+ 3423369109, 3138078467, 0570562233, 1426400815,
+ 3317316542, 2998733608, 0733239954, 1555261956,
+ 3268935591, 3050360625, 0752459403, 1541320221,
+ 2607071920, 3965973030, 1969922972, 0040735498,
+ 2617837225, 3943577151, 1913087877, 0083908371,
+ 2512341634, 3803740692, 2075208622, 0213261112,
+ 2463272603, 3855990285, 2094854071, 0198958881,
+ 2262029012, 4057260610, 1759359992, 0534414190,
+ 2176718541, 4139329115, 1873836001, 0414664567,
+ 2282248934, 4279200368, 1711684554, 0285281116,
+ 2405801727, 4167216745, 1634467795, 0376229701,
+ 2685067896, 3608007406, 1308918612, 0956543938,
+ 2808555105, 3495958263, 1231636301, 1047427035,
+ 2932959818, 3654703836, 1088359270, 0936918000,
+ 2847714899, 3736837829, 1202900863, 0817233897,
+ 3183342108, 3401237130, 1404277552, 0615818150,
+ 3134207493, 3453421203, 1423857449, 0601450431,
+ 3009837614, 3294710456, 1567103746, 0711928724,
+ 3020668471, 3272380065, 1510334235, 0755167117);
+
+function frxStreamCRC32(Stream: TStream): Cardinal;
+var
+ OldPos: Integer;
+ b: Byte;
+ c: Cardinal;
+begin
+ OldPos := Stream.Position;
+ Stream.Position := 0;
+ c := $ffffffff;
+ while Stream.Position < Stream.Size do
+ begin
+ Stream.Read(b,1);
+ c := CrcTable[(c xor Cardinal(b)) and $ff] xor (c shr 8);
+ end;
+ Stream.Position := OldPos;
+ Result := c xor $ffffffff;
+end;
+
+function frxFindComponent(Owner: TComponent; const Name: String): TComponent;
+var
+ n: Integer;
+ s1, s2: String;
+begin
+ Result := nil;
+ n := Pos('.', Name);
+ try
+ if n = 0 then
+ begin
+ if Owner <> nil then
+ Result := Owner.FindComponent(Name);
+ if (Result = nil) and (Owner is TfrxReport) and (Owner.Owner <> nil) then
+ Result := Owner.Owner.FindComponent(Name);
+ end
+ else
+ begin
+ s1 := Copy(Name, 1, n - 1); // module name
+ s2 := Copy(Name, n + 1, 255); // component name
+ Owner := FindGlobalComponent(s1);
+ if Owner <> nil then
+ begin
+ n := Pos('.', s2);
+ if n <> 0 then // frame name - Delphi5
+ begin
+ s1 := Copy(s2, 1, n - 1);
+ s2 := Copy(s2, n + 1, 255);
+ Owner := Owner.FindComponent(s1);
+ if Owner <> nil then
+ Result := Owner.FindComponent(s2);
+ end
+ else
+ Result := Owner.FindComponent(s2);
+ end;
+ end;
+ except
+ on Exception do
+ raise EClassNotFound.Create('Missing ' + Name);
+ end;
+end;
+
+{$HINTS OFF}
+procedure frxGetComponents(Owner: TComponent; ClassRef: TClass;
+ List: TStrings; Skip: TComponent);
+var
+ i, j: Integer;
+
+ procedure EnumComponents(f: TComponent);
+ var
+ i: Integer;
+ c: TComponent;
+ begin
+ for i := 0 to f.ComponentCount - 1 do
+ begin
+ c := f.Components[i];
+ if (c <> Skip) and (c is ClassRef) then
+ List.AddObject(frxGetFullName(Owner, c), c);
+ end;
+ end;
+
+begin
+ List.Clear;
+ if Owner is TfrxReport then
+ EnumComponents(Owner);
+ for i := 0 to Screen.FormCount - 1 do
+ EnumComponents(Screen.Forms[i]);
+ for i := 0 to Screen.DataModuleCount - 1 do
+ EnumComponents(Screen.DataModules[i]);
+end;
+{$HINTS ON}
+
+function frxGetFullName(Owner: TComponent; c: TComponent): String;
+var
+ o: TComponent;
+begin
+ Result := '';
+ if c = nil then Exit;
+
+ o := c.Owner;
+ if (o = nil) or (o = Owner) or ((Owner is TfrxReport) and (o = Owner.Owner)) then
+ Result := c.Name
+ else if ((o is TForm) or (o is TDataModule)) then
+ Result := o.Name + '.' + c.Name
+end;
+
+procedure frxSetCommaText(const Text: String; sl: TStrings; Comma: Char = ';');
+var
+ i: Integer;
+
+ function ExtractCommaName(s: string; var Pos: Integer): string;
+ var
+ i: Integer;
+ begin
+ i := Pos;
+ while (i <= Length(s)) and (s[i] <> Comma) do Inc(i);
+ Result := Copy(s, Pos, i - Pos);
+ if (i <= Length(s)) and (s[i] = Comma) then Inc(i);
+ Pos := i;
+ end;
+
+begin
+ i := 1;
+ sl.Clear;
+ while i <= Length(Text) do
+ sl.Add(ExtractCommaName(Text, i));
+end;
+
+function frxRemoveQuotes(const s: String): String;
+begin
+ if (Length(s) > 2) and (s[1] = '"') and (s[Length(s)] = '"') then
+ Result := Copy(s, 2, Length(s) - 2) else
+ Result := s;
+end;
+
+function frxStreamToString(Stream: TStream): String;
+var
+ Size: Integer;
+ p: PAnsiChar;
+begin
+ Size := Stream.Size;
+ SetLength(Result, Size * 2);
+ GetMem(p, Size);
+
+ Stream.Position := 0;
+ Stream.Read(p^, Size);
+
+ BinToHex(p, PChar(@Result[1]), Size);
+
+ FreeMem(p, Size);
+end;
+
+procedure frxStringToStream(const s: String; Stream: TStream);
+var
+ Size: Integer;
+ p: PChar;
+begin
+ Size := Length(s) div 2;
+ GetMem(p, Size);
+
+ HexToBin(PChar(@s[1]), p, Size * 2);
+
+ Stream.Position := 0;
+ Stream.Write(p^, Size);
+
+ FreeMem(p, Size);
+end;
+
+function frxStrToFloat(s: String): Extended;
+var
+ i: Integer;
+begin
+ for i := 1 to Length(s) do
+ if CharInSet(s[i], [',', '.']) then
+ s[i] := FormatSettings.DecimalSeparator;
+ while Pos(' ', s) <> 0 do
+ Delete(s, Pos(' ', s), 1);
+ Result := StrToFloat(s);
+end;
+
+function frxFloatToStr(d: Extended): String;
+begin
+ if Int(d) = d then
+ Result := FloatToStr(d) else
+ Result := Format('%2.2f', [d]);
+end;
+
+function frxRect(ALeft, ATop, ARight, ABottom: Extended): TfrxRect;
+begin
+ with Result do
+ begin
+ Left := ALeft;
+ Top := ATop;
+ Right := ARight;
+ Bottom := ABottom;
+ end;
+end;
+
+function frxPoint(X, Y: Extended): TfrxPoint;
+begin
+ Result.X := X;
+ Result.Y := Y;
+end;
+
+function frxGetBrackedVariable(const Str, OpenBracket, CloseBracket: AnsiString;
+ var i, j: Integer): AnsiString;
+var
+ c: Integer;
+ fl1, fl2: Boolean;
+begin
+ Result := '';
+ j := i;
+ fl1 := True;
+ fl2 := True;
+ c := 0;
+ if (Str = '') or (j > Length(Str)) then Exit;
+
+ Dec(j);
+ repeat
+ Inc(j);
+// todo fmx
+// if isDBCSLeadByte(Byte(Str[j])) then { if DBCS then skip 2 bytes }
+// Inc(j, 2);
+ if fl1 and fl2 then
+ if Copy(Str, j, Length(OpenBracket)) = OpenBracket then
+ begin
+ if c = 0 then i := j;
+ Inc(c);
+ end
+ else if Copy(Str, j, Length(CloseBracket)) = CloseBracket then
+ Dec(c);
+ if fl1 then
+ if Str[j] = '"' then fl2 := not fl2;
+ if fl2 then
+ if Str[j] = '''' then fl1 := not fl1;
+ until (c = 0) or (j >= Length(Str));
+
+ Result := Copy(Str, i + Length(OpenBracket), j - i - Length(OpenBracket));
+ if i <> j then
+ Inc(j, Length(CloseBracket) - 1);
+end;
+
+function frxGetBrackedVariableW(const Str, OpenBracket, CloseBracket: WideString;
+ var i, j: Integer): WideString;
+var
+ c: Integer;
+ fl1, fl2: Boolean;
+begin
+ Result := '';
+ j := i;
+ fl1 := True;
+ fl2 := True;
+ c := 0;
+ if (Str = '') or (j > Length(Str)) then Exit;
+
+ Dec(j);
+ repeat
+ Inc(j);
+ if fl1 and fl2 then
+ if Copy(Str, j, Length(OpenBracket)) = OpenBracket then
+ begin
+ if c = 0 then i := j;
+ Inc(c);
+ end
+ else if Copy(Str, j, Length(CloseBracket)) = CloseBracket then
+ Dec(c);
+ if fl1 then
+ if Str[j] = '"' then fl2 := not fl2;
+ if fl2 then
+ if Str[j] = '''' then fl1 := not fl1;
+ until (c = 0) or (j >= Length(Str));
+
+ Result := Copy(Str, i + Length(OpenBracket), j - i - Length(OpenBracket));
+ if i <> j then
+ Inc(j, Length(CloseBracket) - 1);
+end;
+
+procedure frxCommonErrorHandler(Report: TfrxReport; const Text: String);
+var
+ e: Exception;
+begin
+ case Report.EngineOptions.NewSilentMode of
+ simMessageBoxes: frxErrorMsg(Text);
+ simReThrow: begin e := Exception.Create(Text); raise e; end;
+ end;
+end;
+
+procedure frxErrorMsg(const Text: String);
+begin
+ MessageDlg(Text, TMsgDlgType.mtError, [TMsgDlgBtn.mbOK], -1);
+end;
+
+function frxConfirmMsg(const Text: String; Buttons: TMsgDlgButtons): Integer;
+begin
+// todo - buttons
+ Result := MessageDlg(Text, TMsgDlgType.mtConfirmation, Buttons, -1);
+end;
+
+procedure frxInfoMsg(const Text: String);
+begin
+ MessageDlg(Text, TMsgDlgType.mtInformation, [TMsgDlgBtn.mbOK], -1);
+end;
+
+function frxIsValidFloat(const Value: string): Boolean;
+begin
+ Result := True;
+ try
+ frxStrToFloat(Value);
+ except
+ Result := False;
+ end;
+end;
+
+procedure frxAssignImages(Bitmap: TBitmap; dx, dy: Integer;
+ ImgList1: TfrxImageList; ImgList2: TfrxImageList = nil);
+begin
+{ todo
+ b := TBitmap.Create(dx, dy);
+
+ x := 0; y := 0;
+
+ repeat
+ b.Canvas.CopyRect(Rect(0, 0, dx, dy), Bitmap.Canvas, Rect(x, y, x + dx, y + dy));
+ Done := y > Bitmap.Height;
+
+ if not Done then
+ begin
+ ImgList1.AddMasked(b, b.TransparentColor);
+ if ImgList2 <> nil then
+ begin
+ Inc(x, dx);
+ b.Canvas.CopyRect(Rect(0, 0, dx, dy), Bitmap.Canvas, Rect(x, y, x + dx, y + dy));
+ ImgList2.AddMasked(b, b.TransparentColor);
+ end;
+ end;
+
+ Inc(x, dx);
+ if x >= Bitmap.Width then
+ begin
+ x := 0;
+ Inc(y, dy);
+ end;
+ until Done;
+
+ b.Free;}
+end;
+
+procedure frxParsePageNumbers(const PageNumbers: String; List: TStrings;
+ Total: Integer);
+var
+ i, j, n1, n2: Integer;
+ s: String;
+ IsRange: Boolean;
+begin
+ List.Clear;
+ s := PageNumbers;
+ while Pos(' ', s) <> 0 do
+ Delete(s, Pos(' ', s), 1);
+ if s = '' then Exit;
+
+ if s[Length(s)] = '-' then
+ s := s + IntToStr(Total);
+ s := s + ',';
+ i := 1; j := 1; n1 := 1;
+ IsRange := False;
+
+ while i <= Length(s) do
+ begin
+ if s[i] = ',' then
+ begin
+ n2 := StrToInt(Copy(s, j, i - j));
+ j := i + 1;
+ if IsRange then
+ while n1 <= n2 do
+ begin
+ List.Add(IntToStr(n1));
+ Inc(n1);
+ end
+ else
+ List.Add(IntToStr(n2));
+ IsRange := False;
+ end
+ else if s[i] = '-' then
+ begin
+ IsRange := True;
+ n1 := StrToInt(Copy(s, j, i - j));
+ j := i + 1;
+ end;
+ Inc(i);
+ end;
+end;
+
+function HTMLRGBColor(Color: TAlphaColor): string;
+begin
+ if Color = claNull then
+ Result := '#FFFFFF'
+ else
+ Result := '#' + Format('%.2x%.2x%.2x', [TAlphaColorRec(Color).R, TAlphaColorRec(Color).G, TAlphaColorRec(Color).B]);
+end;
+
+
+procedure ConvertOneItem(Item: TCollectionItem; ToAnsi: Boolean);
+var
+ i: Integer;
+ TypeInfo: PTypeInfo;
+ PropCount: Integer;
+ PropList: PPropList;
+
+ function Convert(const Value: String): String;
+ var
+ i: Integer;
+ begin
+ Result := '';
+ i := 1;
+ while i <= Length(Value) do
+ begin
+ if ToAnsi then
+ begin
+ if Value[i] >= #128 then
+ Result := Result + #1 + Chr(Ord(Value[i]) - 128) else
+ Result := Result + Value[i];
+ end
+ else
+ begin
+ if (Value[i] = #1) and (i < Length(Value)) then
+ begin
+ Result := Result + Chr(Ord(Value[i + 1]) + 128);
+ Inc(i);
+ end
+ else
+ Result := Result + Value[i];
+ end;
+
+ Inc(i);
+ end;
+ end;
+
+ procedure DoStrProp;
+ var
+ Value, NewValue: String;
+ begin
+ Value := GetStrProp(Item, PropList[i]);
+ NewValue := Convert(Value);
+ if Value <> NewValue then
+ SetStrProp(Item, PropList[i], NewValue);
+ end;
+
+ procedure DoVariantProp;
+ var
+ Value: Variant;
+ begin
+ Value := GetVariantProp(Item, PropList[i]);
+ if (TVarData(Value).VType = varString) or
+ (TVarData(Value).VType = varOleStr) or
+ (TVarData(Value).VType = varUString) then
+ begin
+ Value := Convert(Value);
+ SetVariantProp(Item, PropList[i], Value);
+ end;
+ end;
+
+begin
+ TypeInfo := Item.ClassInfo;
+ PropCount := GetTypeData(TypeInfo).PropCount;
+ GetMem(PropList, PropCount * SizeOf(PPropInfo));
+ GetPropInfos(TypeInfo, PropList);
+
+ try
+ for i := 0 to PropCount - 1 do
+ begin
+ case PropList[i].PropType^.Kind of
+ tkString, tkLString, tkWString:
+ DoStrProp;
+
+ tkVariant:
+ DoVariantProp;
+ end;
+ end;
+
+ finally
+ FreeMem(PropList, PropCount * SizeOf(PPropInfo));
+ end;
+end;
+
+procedure frxWriteCollection(Collection: TCollection; Writer: TWriter;
+ Owner: TfrxComponent);
+var
+ i: Integer;
+ xs: TfrxXMLSerializer;
+ s: String;
+begin
+ if Owner.IsWriting then
+ begin
+ { called from SaveToStream }
+ Writer.WriteListBegin;
+ xs := TfrxXMLSerializer.Create(nil);
+ try
+ xs.Owner := Owner.Report;
+ for i := 0 to Collection.Count - 1 do
+ begin
+ Writer.WriteListBegin;
+ s := xs.ObjToXML(Collection.Items[i]);
+ Writer.WriteString(s);
+ Writer.WriteListEnd;
+ end;
+ finally
+ Writer.WriteListEnd;
+ xs.Free;
+ end;
+ end
+ else
+ begin
+ { called from Delphi streamer }
+ Writer.WriteCollection(Collection);
+ end;
+end;
+
+procedure frxReadCollection(Collection: TCollection; Reader: TReader;
+ Owner: TfrxComponent);
+var
+ i: Integer;
+ vt: TValueType;
+ xs: TfrxXMLSerializer;
+ s: String;
+ Item: TCollectionItem;
+ NeedFree: Boolean;
+begin
+ vt := Reader.ReadValue;
+ if vt <> vaCollection then
+ begin
+ { called from LoadFromStream }
+ NeedFree := False;
+ xs := nil;
+ if Owner.Report <> nil then
+ xs := TfrxXMLSerializer(Owner.Report.XMLSerializer);
+
+ if xs = nil then
+ begin
+ xs := TfrxXMLSerializer.Create(nil);
+ xs.Owner := Owner.Report;
+ NeedFree := True;
+ end;
+
+ try
+ Collection.Clear;
+
+ while not Reader.EndOfList do
+ begin
+ Reader.ReadListBegin;
+ Item := Collection.Add;
+ s := Reader.ReadString;
+ if NeedFree then
+ xs.ReadPersistentStr(Owner.Report, Item, s)
+ else
+ xs.XMLToObj(s, Item);
+ Reader.ReadListEnd;
+ end;
+ finally
+ Reader.ReadListEnd;
+ if NeedFree then
+ xs.Free;
+ end;
+ end
+ else
+ begin
+ { called from Delphi streamer }
+ Reader.ReadCollection(Collection);
+ for i := 0 to Collection.Count - 1 do
+ ConvertOneItem(Collection.Items[i], False);
+ end;
+end;
+
+function GetTemporaryFolder: String;
+begin
+ Result := TPath.GetTempPath;
+end;
+
+function GetTempFile: String;
+{$IFDEF MACOS}
+var
+ fs: TFileStream;
+{$ENDIF}
+begin
+ Result := TPath.GetTempFileName;
+{$IFDEF MACOS}
+ fs := TFile.Create(Result);
+ fs.Free;
+{$ENDIF}
+end;
+
+function frxCreateTempFile(const TempDir: String): String;
+begin
+// TODO EngineOptions.TempDir
+ Result := TPath.GetTempFileName;
+end;
+
+function GetAppFileName: String;
+// todo
+begin
+ Result := '';
+end;
+
+function GetAppPath: String;
+// todo
+begin
+ Result := '';
+end;
+
+function frFloat2Str(const Value: Extended; const Prec: Integer = 2; const Sep: Char = '.'): String;
+var
+ FormatSettings: TFormatSettings;
+ Buffer: array[0..63] of Char;
+begin
+ FormatSettings.DecimalSeparator := Sep;
+ FormatSettings.ThousandSeparator := Char(0);
+ SetString(Result, Buffer, FloatToText(Buffer, Value, fvExtended,
+ ffFixed, 32, Prec, FormatSettings));
+end;
+
+function frxReverseString(const AText: string): string;
+var
+ I: Integer;
+ P: PChar;
+begin
+ SetLength(Result, Length(AText));
+ P := PChar(Result);
+ for I := Length(AText) downto 1 do
+ begin
+ P^ := AText[I];
+ Inc(P);
+ end;
+end;
+
+function ChangeChars(const Str: string; FromChar, ToChar: Char): string;
+var
+ I: Integer;
+begin
+ Result := Str;
+ for I := 1 to Length(Result) do
+ if Result[I] = FromChar then
+ Result[I] := ToChar;
+end;
+
+function frxUnixPath2WinPath(const Path: string): string;
+begin
+{$IFDEF MSWINDOWS}
+Result := ChangeChars(Path, '/', '\');
+{$ELSE}
+Result := Path;
+{$ENDIF}
+
+end;
+
+end.
+
diff --git a/LibD28/FMX.frxVariables.pas b/LibD28/FMX.frxVariables.pas
new file mode 100644
index 0000000..21e692f
--- /dev/null
+++ b/LibD28/FMX.frxVariables.pas
@@ -0,0 +1,407 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ FR Variables }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxVariables;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.frxXML, System.Variants;
+
+
+type
+ TfrxVariable = class(TCollectionItem)
+ private
+ FName: String;
+ FValue: Variant;
+ public
+ constructor Create(Collection: TCollection); override;
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Name: String read FName write FName;
+ property Value: Variant read FValue write FValue;
+ end;
+
+ TfrxVariables = class(TCollection)
+ private
+ function GetItems(Index: Integer): TfrxVariable;
+ function GetVariable(Index: String): Variant;
+ procedure SetVariable(Index: String; const Value: Variant);
+ public
+ constructor Create;
+ function Add: TfrxVariable;
+ function Insert(Index: Integer): TfrxVariable;
+ function IndexOf(const Name: String): Integer;
+ procedure AddVariable(const ACategory, AName: String; const AValue: Variant);
+ procedure DeleteCategory(const Name: String);
+ procedure DeleteVariable(const Name: String);
+ procedure GetCategoriesList(List: TStrings; ClearList: Boolean = True);
+ procedure GetVariablesList(const Category: String; List: TStrings);
+ procedure LoadFromFile(const FileName: String);
+ procedure LoadFromStream(Stream: TStream);
+ procedure LoadFromXMLItem(Item: TfrxXMLItem; OldXMLFormat: Boolean = True);
+ procedure SaveToFile(const FileName: String);
+ procedure SaveToStream(Stream: TStream);
+ procedure SaveToXMLItem(Item: TfrxXMLItem);
+ property Items[Index: Integer]: TfrxVariable read GetItems;
+ property Variables[Index: String]: Variant read GetVariable
+ write SetVariable; default;
+ end;
+
+ TfrxArray = class(TCollection)
+ private
+ function GetItems(Index: Integer): TfrxVariable;
+ function GetVariable(Index: Variant): Variant;
+ procedure SetVariable(Index: Variant; const Value: Variant);
+ public
+ constructor Create;
+ function IndexOf(const Name: Variant): Integer;
+ property Items[Index: Integer]: TfrxVariable read GetItems;
+ property Variables[Index: Variant]: Variant read GetVariable
+ write SetVariable; default;
+ end;
+
+
+implementation
+
+uses
+ FMX.frxXMLSerializer, FMX.frxFMX;
+
+
+{ TfrxVariable }
+
+constructor TfrxVariable.Create(Collection: TCollection);
+begin
+ inherited;
+ FValue := Null;
+end;
+
+procedure TfrxVariable.Assign(Source: TPersistent);
+begin
+ if Source is TfrxVariable then
+ begin
+ FName := TfrxVariable(Source).Name;
+ FValue := TfrxVariable(Source).Value;
+ end;
+end;
+
+
+{ TfrxVariables }
+
+constructor TfrxVariables.Create;
+begin
+ inherited Create(TfrxVariable);
+end;
+
+function TfrxVariables.Add: TfrxVariable;
+begin
+ Result := TfrxVariable(inherited Add);
+end;
+
+function TfrxVariables.Insert(Index: Integer): TfrxVariable;
+begin
+ Result := TfrxVariable(inherited Insert(Index));
+end;
+
+function TfrxVariables.GetItems(Index: Integer): TfrxVariable;
+begin
+ Result := TfrxVariable(inherited Items[Index]);
+end;
+
+function TfrxVariables.IndexOf(const Name: String): Integer;
+var
+ i: Integer;
+begin
+ Result := -1;
+ for i := 0 to Count - 1 do
+ if frxCompareText(Name, Items[i].Name) = 0 then
+ begin
+ Result := i;
+ break;
+ end;
+end;
+
+function TfrxVariables.GetVariable(Index: String): Variant;
+var
+ i: Integer;
+begin
+ i := IndexOf(Index);
+ if i <> -1 then
+ Result := Items[i].Value else
+ Result := Null;
+end;
+
+procedure TfrxVariables.SetVariable(Index: String; const Value: Variant);
+var
+ i: Integer;
+ v: TfrxVariable;
+begin
+ i := IndexOf(Index);
+ if i <> -1 then
+ Items[i].Value := Value
+ else
+ begin
+ v := Add;
+ v.Name := Index;
+ v.Value := Value;
+ end;
+end;
+
+procedure TfrxVariables.GetCategoriesList(List: TStrings; ClearList: Boolean = True);
+var
+ i: Integer;
+ s: String;
+begin
+ if ClearList then
+ List.Clear;
+
+ for i := 0 to Count - 1 do
+ begin
+ s := Items[i].Name;
+ if (s <> '') and (s[1] = ' ') then
+ List.Add(Copy(s, 2, 255));
+ end;
+end;
+
+procedure TfrxVariables.GetVariablesList(const Category: String; List: TStrings);
+var
+ i, j: Integer;
+ s: String;
+begin
+ List.Clear;
+ for i := 0 to Count - 1 do
+ if (Category = '') or (frxCompareText(Items[i].Name, ' ' + Category) = 0) then
+ begin
+ if Category <> '' then
+ j := i + 1 else
+ j := i;
+ while j < Count do
+ begin
+ s := Items[j].Name;
+ Inc(j);
+ if (s <> '') and (s[1] <> ' ') then
+ List.Add(s) else
+ break
+ end;
+ break;
+ end;
+end;
+
+procedure TfrxVariables.DeleteCategory(const Name: String);
+var
+ i: Integer;
+begin
+ i := 0;
+ while i < Count do
+ begin
+ if frxCompareText(Items[i].Name, ' ' + Name) = 0 then
+ begin
+ Items[i].Free;
+ while (i < Count) and (Items[i].Name[1] <> ' ') do
+ Items[i].Free;
+ break;
+ end;
+ Inc(i);
+ end;
+end;
+
+procedure TfrxVariables.DeleteVariable(const Name: String);
+var
+ i: Integer;
+begin
+ i := IndexOf(Name);
+ if i <> -1 then
+ Items[i].Free;
+end;
+
+procedure TfrxVariables.AddVariable(const ACategory, AName: String;
+ const AValue: Variant);
+var
+ i, idx: Integer;
+begin
+ i := 0;
+ while i < Count do
+ begin
+ if frxCompareText(Items[i].Name, ' ' + ACategory) = 0 then
+ begin
+ Inc(i);
+ while (i < Count) and (Items[i].Name[1] <> ' ') do
+ Inc(i);
+ idx := IndexOf(AName);
+ if idx <> - 1 then
+ Items[idx].Value := AValue
+ else
+ if i = Count then
+ with Add do
+ begin
+ Name := AName;
+ Value := AValue;
+ end
+ else
+ with Insert(i) do
+ begin
+ Name := AName;
+ Value := AValue;
+ end;
+ break;
+ end;
+ Inc(i);
+ end;
+end;
+
+procedure TfrxVariables.LoadFromFile(const FileName: String);
+var
+ f: TFileStream;
+begin
+ f := TFileStream.Create(FileName, fmOpenRead);
+ try
+ LoadFromStream(f);
+ finally
+ f.Free;
+ end;
+end;
+
+procedure TfrxVariables.LoadFromStream(Stream: TStream);
+var
+ x: TfrxXMLDocument;
+begin
+ Clear;
+ x := TfrxXMLDocument.Create;
+ try
+ x.LoadFromStream(Stream);
+ if CompareText(x.Root.Name, 'variables') = 0 then
+ LoadFromXMLItem(x.Root, x.OldVersion);
+ finally
+ x.Free;
+ end;
+end;
+
+procedure TfrxVariables.LoadFromXMLItem(Item: TfrxXMLItem; OldXMLFormat: Boolean);
+var
+ xs: TfrxXMLSerializer;
+ i: Integer;
+begin
+ Clear;
+ xs := TfrxXMLSerializer.Create(nil);
+ xs.OldFormat := OldXMLFormat;
+ try
+ for i := 0 to Item.Count - 1 do
+ if CompareText(Item[i].Name, 'item') = 0 then
+ xs.XMLToObj(Item[i].Text, Add);
+ finally
+ xs.Free;
+ end;
+end;
+
+procedure TfrxVariables.SaveToFile(const FileName: String);
+var
+ f: TFileStream;
+begin
+ f := TFileStream.Create(FileName, fmCreate);
+ try
+ SaveToStream(f);
+ finally
+ f.Free;
+ end;
+end;
+
+procedure TfrxVariables.SaveToStream(Stream: TStream);
+var
+ x: TfrxXMLDocument;
+begin
+ x := TfrxXMLDocument.Create;
+ x.AutoIndent := True;
+ try
+ x.Root.Name := 'variables';
+ SaveToXMLItem(x.Root);
+ x.SaveToStream(Stream);
+ finally
+ x.Free;
+ end;
+end;
+
+procedure TfrxVariables.SaveToXMLItem(Item: TfrxXMLItem);
+var
+ xi: TfrxXMLItem;
+ xs: TfrxXMLSerializer;
+ i: Integer;
+begin
+ xs := TfrxXMLSerializer.Create(nil);
+ try
+ for i := 0 to Count - 1 do
+ begin
+ xi := Item.Add;
+ xi.Name := 'item';
+ xi.Text := xs.ObjToXML(Items[i]);
+ end;
+ finally
+ xs.Free;
+ end;
+end;
+
+
+{ TfrxArray }
+
+constructor TfrxArray.Create;
+begin
+ inherited Create(TfrxVariable);
+end;
+
+function TfrxArray.GetItems(Index: Integer): TfrxVariable;
+begin
+ Result := TfrxVariable(inherited Items[Index]);
+end;
+
+function TfrxArray.IndexOf(const Name: Variant): Integer;
+var
+ i: Integer;
+begin
+ Result := -1;
+ for i := 0 to Count - 1 do
+ if frxCompareText(VarToStr(Name), Items[i].Name) = 0 then
+ begin
+ Result := i;
+ break;
+ end;
+end;
+
+function TfrxArray.GetVariable(Index: Variant): Variant;
+var
+ i: Integer;
+begin
+ i := IndexOf(Index);
+ if i <> -1 then
+ Result := Items[i].Value else
+ Result := Null;
+end;
+
+procedure TfrxArray.SetVariable(Index: Variant; const Value: Variant);
+var
+ i: Integer;
+ v: TfrxVariable;
+begin
+ i := IndexOf(Index);
+ if i <> -1 then
+ Items[i].Value := Value
+ else
+ begin
+ v := TfrxVariable(inherited Add);
+ v.Name := Index;
+ v.Value := Value;
+ end;
+end;
+
+end.
+
diff --git a/LibD28/FMX.frxWatchForm.fmx b/LibD28/FMX.frxWatchForm.fmx
new file mode 100644
index 0000000..2dcd5ea
--- /dev/null
+++ b/LibD28/FMX.frxWatchForm.fmx
@@ -0,0 +1,52 @@
+object frxWatchForm: TfrxWatchForm
+ Left = 0
+ Top = 0
+ Caption = 'Watch list'
+ BorderStyle = bsSizeToolWin
+ ClientHeight = 172
+ ClientWidth = 411
+ Position = poDefault
+ Visible = False
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnCloseQuery = FormCloseQuery
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object ToolBar1: TToolBar
+ Width = 411.000000000000000000
+ Height = 30.000000000000000000
+ TabOrder = 0
+ object AddB: TfrxToolButton
+ Width = 80.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = AddBClick
+ TabOrder = 0
+ Hint = 'Add watch'
+ end
+ object DeleteB: TfrxToolButton
+ Position.Point = '(23,0)'
+ Width = 80.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = DeleteBClick
+ TabOrder = 1
+ Hint = 'Delete watch'
+ end
+ object EditB: TfrxToolButton
+ Position.Point = '(46,0)'
+ Width = 80.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = EditBClick
+ TabOrder = 2
+ Hint = 'Edit watch'
+ end
+ end
+ object WatchLB: TListBox
+ Align = alClient
+ Position.Point = '(0,30)'
+ Width = 411.000000000000000000
+ Height = 142.000000000000000000
+ OnDblClick = EditBClick
+ TabOrder = 1
+ ItemHeight = 13.000000000000000000
+ end
+end
diff --git a/LibD28/FMX.frxWatchForm.pas b/LibD28/FMX.frxWatchForm.pas
new file mode 100644
index 0000000..704b2fc
--- /dev/null
+++ b/LibD28/FMX.frxWatchForm.pas
@@ -0,0 +1,196 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Watches toolwindow }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxWatchForm;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Types, FMX.Objects, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.fs_iinterpreter, FMX.Layouts, FMX.ListBox, FMX.frxFMX, System.Variants
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+type
+ TfrxWatchForm = class(TForm)
+ ToolBar1: TToolBar;
+ AddB: TfrxToolButton;
+ DeleteB: TfrxToolButton;
+ EditB: TfrxToolButton;
+ WatchLB: TListBox;
+ procedure FormShow(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormDestroy(Sender: TObject);
+ procedure AddBClick(Sender: TObject);
+ procedure DeleteBClick(Sender: TObject);
+ procedure EditBClick(Sender: TObject);
+ procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+ procedure WatchLBClickCheck(Sender: TObject);
+ private
+ FScript: TfsScript;
+ FScriptRunning: Boolean;
+ FWatches: TStrings;
+ function CalcWatch(const s: String): String;
+ public
+ procedure UpdateWatches;
+ property Script: TfsScript read FScript write FScript;
+ property ScriptRunning: Boolean read FScriptRunning write FScriptRunning;
+ property Watches: TStrings read FWatches;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxRes, FMX.frxEvaluateForm;
+
+
+
+procedure TfrxWatchForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(5900);
+ AddB.Hint := frxGet(5901);
+ DeleteB.Hint := frxGet(5902);
+ EditB.Hint := frxGet(5903);
+ FWatches := TStringList.Create;
+//{$IFDEF UseTabset}
+// WatchLB.BevelKind := bkFlat;
+//{$ELSE}
+// WatchLB.BorderStyle := bsSingle;
+//{$ENDIF}
+
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxWatchForm.FormDestroy(Sender: TObject);
+begin
+ FWatches.Free;
+end;
+
+procedure TfrxWatchForm.FormShow(Sender: TObject);
+begin
+ //Toolbar1.Images := frxResources.MainButtonImages;
+end;
+
+procedure TfrxWatchForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VK_F1 then
+ frxResources.Help(Self);
+end;
+
+procedure TfrxWatchForm.AddBClick(Sender: TObject);
+begin
+ with TfrxEvaluateForm.Create(Owner) do
+ begin
+ IsWatch := True;
+ if ShowModal = mrOk then
+ begin
+ //Watches.Add(ExpressionE.Text);
+ Watches.AddObject(ExpressionE.Text, TObject(1));
+ UpdateWatches;
+ end;
+ Free;
+ end;
+end;
+
+procedure TfrxWatchForm.DeleteBClick(Sender: TObject);
+begin
+ if WatchLB.ItemIndex <> -1 then
+ begin
+ Watches.Delete(WatchLB.ItemIndex);
+ UpdateWatches;
+ end;
+end;
+
+procedure TfrxWatchForm.EditBClick(Sender: TObject);
+begin
+ if WatchLB.ItemIndex <> -1 then
+ with TfrxEvaluateForm.Create(Owner) do
+ begin
+ IsWatch := True;
+ ExpressionE.Text := Watches[WatchLB.ItemIndex];
+ if ShowModal = mrOk then
+ begin
+ Watches[WatchLB.ItemIndex] := ExpressionE.Text;
+ UpdateWatches;
+ end;
+ Free;
+ end;
+end;
+
+function TfrxWatchForm.CalcWatch(const s: String): String;
+var
+ v: Variant;
+begin
+ if (FScript <> nil) and (FScriptRunning) then
+ begin
+ v := FScript.Evaluate(s);
+ Result := VarToStr(v);
+ if TVarData(v).VType = varBoolean then
+ if Boolean(v) = True then
+ Result := 'True' else
+ Result := 'False'
+ else if (TVarData(v).VType = varString) or (TVarData(v).VType = varOleStr)
+ or (TVarData(v).VType = varUString) then
+ Result := '''' + v + ''''
+ else if v = Null then
+ Result := 'Null';
+ end
+ else
+ Result := 'not accessible';
+end;
+
+procedure TfrxWatchForm.UpdateWatches;
+var
+ i: Integer;
+begin
+ WatchLB.Items.BeginUpdate;
+{$IFDEF DELPHI23}
+ WatchLB.Clear;
+{$ELSE}
+ WatchLB.Items.Clear;
+{$ENDIF}
+ for i := 0 to Watches.Count - 1 do
+ begin
+ if Watches.Objects[i] = TObject(1) then
+ WatchLB.Items.Add(Watches[i] + ': ' + CalcWatch(Watches[i]))
+ else
+ WatchLB.Items.Add(Watches[i] + ': disabled');
+ WatchLB.ListItems[i].IsChecked := Boolean(Watches.Objects[i]);
+ end;
+ WatchLB.Items.EndUpdate;
+end;
+
+procedure TfrxWatchForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+begin
+ CanClose := False;
+end;
+
+procedure TfrxWatchForm.WatchLBClickCheck(Sender: TObject);
+var
+ Bool: Boolean;
+begin
+ if (WatchLB.ItemIndex <> -1) then
+ begin
+ Bool := Boolean(Watches.Objects[WatchLB.ItemIndex]);
+ Watches.Objects[WatchLB.ItemIndex] := TObject(not Bool);
+ UpdateWatches;
+ end;
+end;
+
+end.
diff --git a/LibD28/FMX.frxXML.pas b/LibD28/FMX.frxXML.pas
new file mode 100644
index 0000000..62eee29
--- /dev/null
+++ b/LibD28/FMX.frxXML.pas
@@ -0,0 +1,983 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ XML document }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxXML;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.Variants, System.Types, System.SysUtils;
+
+
+type
+ TfrxInvalidXMLException = class(Exception);
+
+ TfrxXMLItem = class(TObject)
+ private
+ FData: Pointer; { optional item data }
+ FHiOffset: Byte; { hi-part of the offset }
+ FItems: TList; { subitems }
+ FLoaded: Boolean; { item is loaded, no need to call LoadItem }
+ FLoOffset: Integer; { lo-part of the offset }
+ FModified: Boolean; { item is modified (used by preview designer) }
+ FName: String; { item name }
+ FParent: TfrxXMLItem; { item parent }
+ FText: String; { item attributes }
+ FUnloadable: Boolean;
+ FValue: String; { item value Value }
+ function GetCount: Integer;
+ function GetItems(Index: Integer): TfrxXMLItem;
+ function GetOffset: Int64;
+ procedure SetOffset(const Value: Int64);
+ function GetProp(Index: String): String;
+ procedure SetProp(Index: String; const Value: String);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure AddItem(Item: TfrxXMLItem);
+ procedure Clear;
+ procedure InsertItem(Index: Integer; Item: TfrxXMLItem);
+
+ function Add: TfrxXMLItem; overload;
+ function Add(Name: string): TfrxXMLItem; overload;
+ function Find(const Name: String): Integer;
+ function FindItem(const Name: String): TfrxXMLItem;
+ function IndexOf(Item: TfrxXMLItem): Integer;
+ function PropExists(const Index: String): Boolean;
+ function Root: TfrxXMLItem;
+ procedure DeleteProp(const Index: String);
+
+ property Count: Integer read GetCount;
+ property Data: Pointer read FData write FData;
+ property Items[Index: Integer]: TfrxXMLItem read GetItems; default;
+ property Loaded: Boolean read FLoaded;
+ property Modified: Boolean read FModified write FModified;
+ property Name: String read FName write FName;
+{ offset is the position of the item in the tempstream. This parameter is needed
+ for dynamically loading large files. Items that can be loaded on-demand must
+ have Unloadable = True (in run-time) or have 'ld="0"' parameter (in the file) }
+ property Offset: Int64 read GetOffset write SetOffset;
+ property Parent: TfrxXMLItem read FParent;
+ property Prop[Index: String]: String read GetProp write SetProp;
+ property Text: String read FText write FText;
+ property Unloadable: Boolean read FUnloadable write FUnloadable;
+ property Value: String read FValue write FValue;
+ end;
+
+ TfrxXMLDocument = class(TObject)
+ private
+ FAutoIndent: Boolean; { use indents when writing document to a file }
+ FRoot: TfrxXMLItem; { root item }
+ FTempDir: String; { folder for temporary files }
+ FTempFile: String; { tempfile name }
+ FTempStream: TStream; { temp stream associated with tempfile }
+ FTempFileCreated: Boolean; { tempfile has been created - need to delete it }
+ FOldVersion: Boolean;
+ procedure CreateTempFile;
+ procedure DeleteTempFile;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Clear;
+ procedure LoadItem(Item: TfrxXMLItem);
+ procedure UnloadItem(Item: TfrxXMLItem);
+ procedure SaveToStream(Stream: TStream);
+ procedure LoadFromStream(Stream: TStream; AllowPartialLoading: Boolean = False);
+ procedure SaveToFile(const FileName: String);
+ procedure LoadFromFile(const FileName: String);
+
+ property AutoIndent: Boolean read FAutoIndent write FAutoIndent;
+ property Root: TfrxXMLItem read FRoot;
+ property TempDir: String read FTempDir write FTempDir;
+ property OldVersion: Boolean read FOldVersion;
+ end;
+
+{ TfrxXMLReader and TfrxXMLWriter are doing actual read/write to the XML file.
+ Read/write process is buffered. }
+
+ TfrxXMLReader = class(TObject)
+ private
+ FBuffer: PAnsiChar;
+ FBufPos: Integer;
+ FBufEnd: Integer;
+ FPosition: Int64;
+ FSize: Int64;
+ FStream: TStream;
+ FOldFormat: Boolean;
+ procedure SetPosition(const Value: Int64);
+ procedure ReadBuffer;
+ procedure ReadItem(var NameS, Text: String);
+ public
+ constructor Create(Stream: TStream);
+ destructor Destroy; override;
+ procedure RaiseException;
+ procedure ReadHeader;
+ procedure ReadRootItem(Item: TfrxXMLItem; ReadChildren: Boolean = True);
+ property Position: Int64 read FPosition write SetPosition;
+ property Size: Int64 read FSize;
+ end;
+
+ TfrxXMLWriter = class(TObject)
+ private
+ FAutoIndent: Boolean;
+ FBuffer: AnsiString;
+ FStream: TStream;
+ FTempStream: TStream;
+ procedure FlushBuffer;
+ procedure WriteLn(const s: AnsiString);
+ procedure WriteItem(Item: TfrxXMLItem; Level: Integer = 0);
+ public
+ constructor Create(Stream: TStream);
+ procedure WriteHeader;
+ procedure WriteRootItem(RootItem: TfrxXMLItem);
+ property TempStream: TStream read FTempStream write FTempStream;
+ property AutoIndent: Boolean read FAutoIndent write FAutoIndent;
+ end;
+
+
+{ StrToXML changes '<', '>', '"', cr, lf symbols to its ascii codes }
+function frxStrToXML(const s: String): String;
+
+{ ValueToXML convert a value to the valid XML string }
+function frxValueToXML(const Value: Variant): String;
+
+{ XMLToStr is opposite to StrToXML function }
+function frxXMLToStr(const s: String): String;
+
+
+
+implementation
+
+uses
+ System.IOUtils
+{$IFDEF MSWINDOWS}
+ , Winapi.Windows
+{$ENDIF MSWINDOWS}
+{$IFDEF POSIX}
+ , Posix.Stdio
+ , Posix.Unistd
+{$ENDIF POSIX};
+
+function frxUppercase(s: String): String;
+begin
+//{$IFDEF }
+// AnsiUppercase
+ Result := AnsiUppercase(s);
+end;
+
+function frxStrToXML(const s: String): String;
+const
+ SpecChars = ['<', '>', '"', #10, #13, '&'];
+var
+ i, lenRes, resI, ch: Integer;
+ pRes: PChar;
+
+ procedure ReplaceChars(var s: String; i: Integer);
+ begin
+ Insert('#' + IntToStr(Ord(s[i])) + ';', s, i + 1);
+ s[i] := '&';
+ end;
+
+begin
+ lenRes := Length(s);
+
+ if lenRes < 32 then
+ begin
+ Result := s;
+ for i := lenRes downto 1 do
+ if CharInSet(s[i], SpecChars) then
+ if s[i] <> '&' then
+ ReplaceChars(Result, i)
+ else
+ begin
+ if Copy(s, i + 1, 5) = 'quot;' then
+ begin
+ Delete(Result, i, 6);
+ Insert('"', Result, i);
+ end;
+ end;
+ Exit;
+ end;
+
+ { speed optimized code }
+ SetLength(Result, lenRes);
+ pRes := PChar(Result) - 1;
+ resI := 1;
+ i := 1;
+
+ while i <= Length(s) do
+ begin
+ if resI + 5 > lenRes then
+ begin
+ Inc(lenRes, 256);
+ SetLength(Result, lenRes);
+ pRes := PChar(Result) - 1;
+ end;
+
+ if CharInSet(s[i], SpecChars) then
+ begin
+ if (s[i] = '&') and (i <= Length(s) - 5) and (s[i + 1] = 'q') and
+ (s[i + 2] = 'u') and (s[i + 3] = 'o') and (s[i + 4] = 't') and (s[i + 5] = ';') then
+ begin
+ pRes[resI] := '&';
+ pRes[resI + 1] := '#';
+ pRes[resI + 2] := '3';
+ pRes[resI + 3] := '4';
+ pRes[resI + 4] := ';';
+ Inc(resI, 4);
+ Inc(i, 5);
+ end
+ else
+ begin
+ pRes[resI] := '&';
+ pRes[resI + 1] := '#';
+
+ ch := Ord(s[i]);
+ if ch < 10 then
+ begin
+ pRes[resI + 2] := Char(Chr(ch + $30));
+ Inc(resI, 3);
+ end
+ else if ch < 100 then
+ begin
+ pRes[resI + 2] := Char(Chr(ch div 10 + $30));
+ pRes[resI + 3] := Char(Chr(ch mod 10 + $30));
+ Inc(resI, 4);
+ end
+ else
+ begin
+ pRes[resI + 2] := Char(Chr(ch div 100 + $30));
+ pRes[resI + 3] := Char(Chr(ch mod 100 div 10 + $30));
+ pRes[resI + 4] := Char(Chr(ch mod 10 + $30));
+ Inc(resI, 5);
+ end;
+ pRes[resI] := ';';
+ end;
+ end
+ else
+ pRes[resI] := s[i];
+ Inc(resI);
+ Inc(i);
+ end;
+
+ SetLength(Result, resI - 1);
+end;
+
+function frxXMLToStr(const s: String): String;
+var
+ i, j, h, n: Integer;
+begin
+ Result := s;
+ i := 1;
+ n := Length(s);
+ while i < n do
+ begin
+ if Result[i] = '&' then
+ if (i + 3 <= n) and (Result[i + 1] = '#') then
+ begin
+ j := i + 3;
+ while Result[j] <> ';' do
+ Inc(j);
+ h := StrToInt(String(Copy(Result, i + 2, j - i - 2)));
+ Delete(Result, i, j - i);
+ Result[i] := Char(Chr(h));
+ Dec(n, j - i);
+ end
+ else if Copy(Result, i + 1, 5) = 'quot;' then
+ begin
+ Delete(Result, i, 5);
+ Result[i] := '"';
+ Dec(n, 5);
+ end
+ else if Copy(Result, i + 1, 4) = 'amp;' then
+ begin
+ Delete(Result, i, 4);
+ Result[i] := '&';
+ Dec(n, 4);
+ end
+ else if Copy(Result, i + 1, 3) = 'lt;' then
+ begin
+ Delete(Result, i, 3);
+ Result[i] := '<';
+ Dec(n, 3);
+ end
+ else if Copy(Result, i + 1, 3) = 'gt;' then
+ begin
+ Delete(Result, i, 3);
+ Result[i] := '>';
+ Dec(n, 3);
+ end;
+ Inc(i);
+ end;
+end;
+
+function frxValueToXML(const Value: Variant): String;
+begin
+ case TVarData(Value).VType of
+ varSmallint, varInteger, varByte:
+ Result := IntToStr(Value);
+
+ varSingle, varDouble, varCurrency:
+ Result := FloatToStr(Value);
+
+ varDate:
+ Result := DateToStr(Value);
+
+ varOleStr, varString, varVariant, varUString:
+ Result := frxStrToXML(Value);
+
+ varBoolean:
+ if Value = True then Result := '1' else Result := '0';
+
+ else
+ Result := '';
+ end;
+end;
+
+{ TfrxXMLItem }
+
+constructor TfrxXMLItem.Create;
+begin
+ FLoaded := True;
+end;
+
+destructor TfrxXMLItem.Destroy;
+begin
+ Clear;
+ if FParent <> nil then
+ FParent.FItems.Remove(Self);
+ inherited;
+end;
+
+procedure TfrxXMLItem.Clear;
+begin
+ if FItems <> nil then
+ begin
+ while FItems.Count > 0 do
+ TfrxXMLItem(FItems[0]).Free;
+ FItems.Free;
+ FItems := nil;
+ end;
+ if FUnloadable then
+ FLoaded := False;
+end;
+
+function TfrxXMLItem.GetItems(Index: Integer): TfrxXMLItem;
+begin
+ Result := TfrxXMLItem(FItems[Index]);
+end;
+
+function TfrxXMLItem.GetCount: Integer;
+begin
+ if FItems = nil then
+ Result := 0 else
+ Result := FItems.Count;
+end;
+
+function TfrxXMLItem.Add: TfrxXMLItem;
+begin
+ Result := TfrxXMLItem.Create;
+ AddItem(Result);
+end;
+
+function TfrxXMLItem.Add(Name: string): TfrxXMLItem;
+begin
+ Result := Add;
+ Result.Name := Name;
+end;
+
+procedure TfrxXMLItem.AddItem(Item: TfrxXMLItem);
+begin
+ if FItems = nil then
+ FItems := TList.Create;
+
+ FItems.Add(Item);
+ if Item.FParent <> nil then
+ Item.FParent.FItems.Remove(Item);
+ Item.FParent := Self;
+end;
+
+procedure TfrxXMLItem.InsertItem(Index: Integer; Item: TfrxXMLItem);
+begin
+ AddItem(Item);
+ FItems.Delete(FItems.Count - 1);
+ FItems.Insert(Index, Item);
+end;
+
+function TfrxXMLItem.Find(const Name: String): Integer;
+var
+ i: Integer;
+begin
+ Result := -1;
+ for i := 0 to Count - 1 do
+ if CompareText(Items[i].Name, Name) = 0 then
+ begin
+ Result := i;
+ break;
+ end;
+end;
+
+function TfrxXMLItem.FindItem(const Name: String): TfrxXMLItem;
+var
+ i: Integer;
+begin
+ i := Find(Name);
+ if i = -1 then
+ begin
+ Result := Add;
+ Result.Name := Name;
+ end
+ else
+ Result := Items[i];
+end;
+
+function TfrxXMLItem.GetOffset: Int64;
+begin
+ Result := Int64(FHiOffset) * $100000000 + Int64(FLoOffset);
+end;
+
+procedure TfrxXMLItem.SetOffset(const Value: Int64);
+begin
+ FHiOffset := Value div $100000000;
+ FLoOffset := Value mod $100000000;
+end;
+
+function TfrxXMLItem.Root: TfrxXMLItem;
+begin
+ Result := Self;
+ while Result.Parent <> nil do
+ Result := Result.Parent;
+end;
+
+function TfrxXMLItem.GetProp(Index: String): String;
+var
+ i: Integer;
+begin
+ i := Pos(' ' + frxUppercase(Index) + '="', frxUppercase(' ' + FText));
+ if i <> 0 then
+ begin
+ Result := Copy(FText, i + Length(Index + '="'), MaxInt);
+ Result := frxXMLToStr(Copy(Result, 1, Pos('"', Result) - 1));
+ end
+ else
+ Result := '';
+end;
+
+procedure TfrxXMLItem.SetProp(Index: String; const Value: String);
+var
+ i, j: Integer;
+ s: String;
+begin
+ i := Pos(' ' + frxUppercase(Index) + '="', frxUppercase(' ' + FText));
+ if i <> 0 then
+ begin
+ j := i + Length(Index + '="');
+ while (j <= Length(FText)) and (FText[j] <> '"') do
+ Inc(j);
+ Delete(FText, i, j - i + 1);
+ end
+ else
+ i := Length(FText) + 1;
+
+ s := Index + '="' + frxStrToXML(Value) + '"';
+ if (i > 1) and (FText[i - 1] <> ' ') then
+ s := ' ' + s;
+ Insert(s, FText, i);
+end;
+
+function TfrxXMLItem.PropExists(const Index: String): Boolean;
+begin
+ Result := Pos(' ' + frxUppercase(Index) + '="', ' ' + frxUppercase(FText)) > 0;
+end;
+
+procedure TfrxXMLItem.DeleteProp(const Index: String);
+var
+ i: Integer;
+begin
+ i := Pos(' ' + frxUppercase(Index) + '="', ' ' + frxUppercase(FText));
+ if i > 0 then
+ begin
+ SetProp(Index, '');
+ Delete(FText, i, Length(Index) + 4);
+ end;
+end;
+
+function TfrxXMLItem.IndexOf(Item: TfrxXMLItem): Integer;
+begin
+ Result := FItems.IndexOf(Item);
+end;
+
+
+{ TfrxXMLDocument }
+
+constructor TfrxXMLDocument.Create;
+begin
+ FRoot := TfrxXMLItem.Create;
+end;
+
+destructor TfrxXMLDocument.Destroy;
+begin
+ DeleteTempFile;
+ FRoot.Free;
+ inherited;
+end;
+
+procedure TfrxXMLDocument.Clear;
+begin
+ FRoot.Clear;
+ DeleteTempFile;
+end;
+
+procedure TfrxXMLDocument.CreateTempFile;
+begin
+ if FTempFileCreated then Exit;
+ FTempFile := TPath.GetTempFileName;
+ FTempStream := TFileStream.Create(FTempFile, fmOpenReadWrite);
+ FTempFileCreated := True;
+end;
+
+procedure TfrxXMLDocument.DeleteTempFile;
+begin
+ if FTempFileCreated then
+ begin
+ FTempStream.Free;
+ FTempStream := nil;
+ System.SysUtils.DeleteFile(FTempFile);
+ FTempFileCreated := False;
+ end;
+ if FTempStream <> nil then
+ FTempStream.Free;
+ FTempStream := nil;
+end;
+
+procedure TfrxXMLDocument.LoadItem(Item: TfrxXMLItem);
+var
+ rd: TfrxXMLReader;
+ Text: String;
+begin
+ if (FTempStream = nil) or Item.FLoaded or not Item.FUnloadable then Exit;
+
+ rd := TfrxXMLReader.Create(FTempStream);
+ try
+ rd.Position := Item.Offset;
+ Text := Item.Text;
+ rd.ReadRootItem(Item);
+ Item.Text := Text;
+ Item.FLoaded := True;
+ finally
+ rd.Free;
+ end;
+end;
+
+procedure TfrxXMLDocument.UnloadItem(Item: TfrxXMLItem);
+var
+ wr: TfrxXMLWriter;
+begin
+ if not Item.FLoaded or not Item.FUnloadable then Exit;
+
+ CreateTempFile;
+ FTempStream.Position := FTempStream.Size;
+ wr := TfrxXMLWriter.Create(FTempStream);
+ try
+ Item.Offset := FTempStream.Size;
+ wr.WriteRootItem(Item);
+ Item.Clear;
+ finally
+ wr.Free;
+ end;
+end;
+
+procedure TfrxXMLDocument.LoadFromStream(Stream: TStream;
+ AllowPartialLoading: Boolean = False);
+var
+ rd: TfrxXMLReader;
+begin
+ DeleteTempFile;
+
+ rd := TfrxXMLReader.Create(Stream);
+ try
+ FRoot.Clear;
+ FRoot.Offset := 0;
+ rd.ReadHeader;
+ FOldVersion := rd.FOldFormat;
+ rd.ReadRootItem(FRoot, not AllowPartialLoading);
+ finally
+ rd.Free;
+ end;
+
+ if AllowPartialLoading then
+ FTempStream := Stream else
+ FTempStream := nil;
+end;
+
+procedure TfrxXMLDocument.SaveToStream(Stream: TStream);
+var
+ wr: TfrxXMLWriter;
+begin
+ wr := TfrxXMLWriter.Create(Stream);
+ wr.TempStream := FTempStream;
+ wr.FAutoIndent := FAutoIndent;
+
+ try
+ wr.WriteHeader;
+ wr.WriteRootItem(FRoot);
+ finally
+ wr.Free;
+ end;
+end;
+
+procedure TfrxXMLDocument.LoadFromFile(const FileName: String);
+var
+ s: TFileStream;
+begin
+ s := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ LoadFromStream(s, True);
+end;
+
+procedure TfrxXMLDocument.SaveToFile(const FileName: String);
+var
+ s: TFileStream;
+begin
+ s := TFileStream.Create(FileName + '.tmp', fmCreate);
+ try
+ SaveToStream(s);
+ finally
+ s.Free;
+ end;
+
+ DeleteTempFile;
+ System.SysUtils.DeleteFile(FileName);
+ RenameFile(FileName + '.tmp', FileName);
+ LoadFromFile(FileName);
+end;
+
+
+{ TfrxXMLReader }
+
+constructor TfrxXMLReader.Create(Stream: TStream);
+begin
+ FStream := Stream;
+ FSize := Stream.Size;
+ FPosition := Stream.Position;
+ GetMem(FBuffer, 4096);
+end;
+
+destructor TfrxXMLReader.Destroy;
+begin
+ FreeMem(FBuffer, 4096);
+ FStream.Position := FPosition;
+ inherited;
+end;
+
+procedure TfrxXMLReader.ReadBuffer;
+begin
+ FBufEnd := FStream.Read(FBuffer^, 4096);
+ FBufPos := 0;
+end;
+
+procedure TfrxXMLReader.SetPosition(const Value: Int64);
+begin
+ FPosition := Value;
+ FStream.Position := Value;
+ FBufPos := 0;
+ FBufEnd := 0;
+end;
+
+procedure TfrxXMLReader.RaiseException;
+begin
+ raise TfrxInvalidXMLException.Create('Invalid file format');
+end;
+
+procedure TfrxXMLReader.ReadHeader;
+var
+ s1, s2: String;
+ i: Integer;
+ Ver: String;
+begin
+ ReadItem(s1, s2);
+ if Pos('?xml', s1) <> 1 then
+ RaiseException;
+ i := Pos('version=', s2);
+ if i <> 0 then
+ Ver := Copy(s2, i + 9, 3);
+ i := Pos('standalone=', s2);
+ if (Ver = '1.0') and (i = 0) then
+ FOldFormat := True;
+end;
+
+procedure TfrxXMLReader.ReadItem(var NameS, Text: String);
+var
+ c: Integer;
+ curpos, len: Integer;
+ state: (FindLeft, FindRight, FindComment, Done);
+ i, comment: Integer;
+ ps: PAnsiChar;
+ Name: AnsiString;
+begin
+ Text := '';
+ comment := 0;
+ state := FindLeft;
+ curpos := 0;
+ len := 4096;
+ SetLength(Name, len);
+ ps := @Name[1];
+
+ while FPosition < FSize do
+ begin
+ if FBufPos = FBufEnd then
+ ReadBuffer;
+ c := Ord(FBuffer[FBufPos]);
+ Inc(FBufPos);
+ Inc(FPosition);
+
+ if state = FindLeft then
+ begin
+ if c = Ord('<') then
+ state := FindRight
+ end
+ else if state = FindRight then
+ begin
+ if c = Ord('>') then
+ begin
+ state := Done;
+ break;
+ end
+ else if c = Ord('<') then
+ RaiseException
+ else
+ begin
+ ps[curpos] := AnsiChar(Chr(c));
+ Inc(curpos);
+ if (curpos = 3) and (Pos(AnsiString('!--'), Name) = 1) then
+ begin
+ state := FindComment;
+ comment := 0;
+ curpos := 0;
+ end;
+ if curpos >= len - 1 then
+ begin
+ Inc(len, 4096);
+ SetLength(Name, len);
+ ps := @Name[1];
+ end;
+ end;
+ end
+ else if State = FindComment then
+ begin
+ if comment = 2 then
+ begin
+ if c = Ord('>') then
+ state := FindLeft
+ else
+ comment := 0;
+ end
+ else begin
+ if c = Ord('-') then
+ Inc(comment)
+ else
+ comment := 0;
+ end;
+ end;
+ end;
+
+ len := curpos;
+ SetLength(Name, len);
+
+ if state = FindRight then
+ RaiseException;
+ if (Name <> '') and (Name[len] = ' ') then
+ SetLength(Name, len - 1);
+
+ i := Pos(AnsiString(' '), Name);
+ if i <> 0 then
+ begin
+ if FOldFormat then
+ Text := String(Copy(Name, i + 1, len - i)) else
+ Text := UTF8Decode(Copy(Name, i + 1, len - i));
+ Delete(Name, i, len - i + 1);
+ end;
+ NameS := String(Name);
+end;
+
+procedure TfrxXMLReader.ReadRootItem(Item: TfrxXMLItem; ReadChildren: Boolean = True);
+var
+ LastName: String;
+
+ function DoRead(RootItem: TfrxXMLItem): Boolean;
+ var
+ n: Integer;
+ ChildItem: TfrxXMLItem;
+ Done: Boolean;
+ CurPos: Int64;
+ begin
+ Result := False;
+ CurPos := Position;
+ ReadItem(RootItem.FName, RootItem.FText);
+ LastName := RootItem.FName;
+
+ if (RootItem.Name = '') or (RootItem.Name[1] = '/') then
+ begin
+ Result := True;
+ Exit;
+ end;
+
+ n := Length(RootItem.Name);
+ if RootItem.Name[n] = '/' then
+ begin
+ SetLength(RootItem.FName, n - 1);
+ Exit;
+ end;
+
+ n := Length(RootItem.Text);
+ if (n > 0) and (RootItem.Text[n] = '/') then
+ begin
+ SetLength(RootItem.FText, n - 1);
+ Exit;
+ end;
+
+ repeat
+ ChildItem := TfrxXMLItem.Create;
+ Done := DoRead(ChildItem);
+ if not Done then
+ RootItem.AddItem(ChildItem) else
+ ChildItem.Free;
+ until Done;
+
+ if (LastName <> '') and (CompareText(LastName, '/' + RootItem.Name) <> 0) then
+ RaiseException;
+
+ n := Pos(' ld="0"', LowerCase(RootItem.Text));
+ if n <> 0 then
+ Delete(RootItem.FText, n, 7);
+ if not ReadChildren and (n <> 0) then
+ begin
+ RootItem.Clear;
+ RootItem.Offset := CurPos;
+ RootItem.FUnloadable := True;
+ RootItem.FLoaded := False;
+ end;
+ end;
+
+begin
+ DoRead(Item);
+end;
+
+
+{ TfrxXMLWriter }
+
+constructor TfrxXMLWriter.Create(Stream: TStream);
+begin
+ FStream := Stream;
+end;
+
+procedure TfrxXMLWriter.FlushBuffer;
+begin
+ if FBuffer <> '' then
+ FStream.Write(FBuffer[1], Length(FBuffer));
+ FBuffer := '';
+end;
+
+procedure TfrxXMLWriter.WriteLn(const s: AnsiString);
+begin
+ if not FAutoIndent then
+ Insert(s, FBuffer, MaxInt) else
+ Insert(s + #13#10, FBuffer, MaxInt);
+ if Length(FBuffer) > 4096 then
+ FlushBuffer;
+end;
+
+procedure TfrxXMLWriter.WriteHeader;
+begin
+ WriteLn('');
+end;
+
+function Dup(n: Integer): AnsiString;
+begin
+ SetLength(Result, n);
+ FillChar(Result[1], n, ' ');
+end;
+
+procedure TfrxXMLWriter.WriteItem(Item: TfrxXMLItem; Level: Integer = 0);
+var
+ s: AnsiString;
+begin
+ if (Item.FText <> '') or Item.FUnloadable then
+ begin
+ s := UTF8Encode(Item.FText);
+ if (s = '') or (s[1] <> ' ') then
+ s := ' ' + s;
+ if Item.FUnloadable then
+ s := s + 'ld="0"';
+ end
+ else
+ s := '';
+
+ if Item.Count = 0 then
+ begin
+ if Item.Value = '' then
+ s := s + '/>'
+ else
+ s := s + '>' + UTF8Encode(Item.Value) + ''
+ end
+ else
+ s := s + '>';
+ if not FAutoIndent then
+ s := '<' + AnsiString(Item.Name) + s else
+ s := Dup(Level) + '<' + AnsiString(Item.Name) + s;
+ WriteLn(s);
+end;
+
+procedure TfrxXMLWriter.WriteRootItem(RootItem: TfrxXMLItem);
+
+ procedure DoWrite(RootItem: TfrxXMLItem; Level: Integer = 0);
+ var
+ i: Integer;
+ rd: TfrxXMLReader;
+ NeedClear: Boolean;
+ begin
+ NeedClear := False;
+ if not FAutoIndent then
+ Level := 0;
+
+ if (FTempStream <> nil) and RootItem.FUnloadable and not RootItem.FLoaded then
+ begin
+ rd := TfrxXMLReader.Create(FTempStream);
+ try
+ rd.Position := RootItem.Offset;
+ rd.ReadRootItem(RootItem);
+ NeedClear := True;
+ finally
+ rd.Free;
+ end;
+ end;
+
+ WriteItem(RootItem, Level);
+ for i := 0 to RootItem.Count - 1 do
+ DoWrite(RootItem[i], Level + 2);
+ if RootItem.Count > 0 then
+ if not FAutoIndent then
+ WriteLn('') else
+ WriteLn(Dup(Level) + '');
+
+ if NeedClear then
+ RootItem.Clear;
+ end;
+
+begin
+ DoWrite(RootItem);
+ FlushBuffer;
+end;
+
+end.
diff --git a/LibD28/FMX.frxXMLSerializer.pas b/LibD28/FMX.frxXMLSerializer.pas
new file mode 100644
index 0000000..700ae49
--- /dev/null
+++ b/LibD28/FMX.frxXMLSerializer.pas
@@ -0,0 +1,881 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ XML serializer }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxXMLSerializer;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.TypInfo, System.Variants,
+ FMX.frxXML, FMX.frxClass;
+
+
+type
+ TfrxGetAncestorEvent = procedure(const ComponentName: String;
+ var Ancestor: TPersistent) of object;
+
+{ TfrxXMLSerializer is the XML analogue of the Delphi component streaming -
+ TReader and TWriter }
+
+ TfrxXMLSerializer = class(TObject)
+ private
+ FErrors: TStringList;
+ FFixups: TList;
+ FOwner: TfrxComponent;
+ FReader: TReader;
+ FReaderStream: TMemoryStream;
+ FSerializeDefaultValues: Boolean;
+ FStream: TStream;
+ FOldFormat: Boolean;
+ FOnGetAncestor: TfrxGetAncestorEvent;
+ FCachedClasses: TStringList;
+ procedure AddFixup(Obj: TPersistent; p: PPropInfo; Value: String);
+ procedure ClearFixups;
+ procedure FixupReferences;
+ public
+ constructor Create(Stream: TStream);
+ destructor Destroy; override;
+ function ObjToXML(Obj: TPersistent; const Add: String = ''; Ancestor: TPersistent = nil): String;
+ function ReadComponent(Root: TfrxComponent): TfrxComponent;
+ function ReadComponentStr(Root: TfrxComponent; s: String; DontFixup: Boolean = False): TfrxComponent;
+ function WriteComponentStr(c: TfrxComponent): String;
+ procedure ReadRootComponent(Root: TfrxComponent; XMLItem: TfrxXMLItem = nil);
+ procedure CopyFixupList(FixList: TList);
+ procedure ReadPersistentStr(Root: TComponent; Obj: TPersistent; const s: String);
+ procedure WriteComponent(c: TfrxComponent);
+ procedure WriteRootComponent(Root: TfrxComponent; SaveChildren: Boolean = True;
+ XMLItem: TfrxXMLItem = nil; Streaming: Boolean = False);
+ procedure XMLToObj(const s: String; Obj: TPersistent);
+ property Errors: TStringList read FErrors;
+ property Owner: TfrxComponent read FOwner write FOwner;
+ property Stream: TStream read FStream;
+ property SerializeDefaultValues: Boolean read FSerializeDefaultValues
+ write FSerializeDefaultValues;
+ property OnGetAncestor: TfrxGetAncestorEvent read FOnGetAncestor write FOnGetAncestor;
+ property OldFormat: Boolean read FOldFormat write FOldFormat;
+ end;
+
+ TfrxFixupItem = class(TObject)
+ public
+ Obj: TPersistent;
+ PropInfo: PPropInfo;
+ Value: String;
+ end;
+
+
+implementation
+
+uses
+ System.UITypes, FMX.Types, FMX.frxUtils, FMX.frxRes, FMX.frxUnicodeUtils, FMX.frxFMX;
+
+
+type
+ THackComponent = class(TComponent);
+ THackPersistent = class(TPersistent);
+ THackReader = class(TReader);
+
+
+{ TfrxXMLSerializer }
+
+constructor TfrxXMLSerializer.Create(Stream: TStream);
+begin
+ FErrors := TStringList.Create;
+ FErrors.Sorted := True;
+ FErrors.Duplicates := dupIgnore;
+ FFixups := TList.Create;
+ FStream := Stream;
+ FReaderStream := TMemoryStream.Create;
+ FReader := TReader.Create(FReaderStream, 4096);
+ FOldFormat := False;
+ FCachedClasses := TfrxStringList.Create;
+ FCachedClasses.Sorted := True;
+end;
+
+destructor TfrxXMLSerializer.Destroy;
+begin
+ FErrors.Free;
+ FReader.Free;
+ FReaderStream.Free;
+ ClearFixups;
+ FFixups.Free;
+ FCachedClasses.Free;
+ inherited;
+end;
+
+procedure TfrxXMLSerializer.ClearFixups;
+begin
+ while FFixups.Count > 0 do
+ begin
+ TfrxFixupItem(FFixups[0]).Free;
+ FFixups.Delete(0);
+ end;
+end;
+
+procedure TfrxXMLSerializer.AddFixup(Obj: TPersistent; p: PPropInfo;
+ Value: String);
+var
+ Item: TfrxFixupItem;
+begin
+ Item := TfrxFixupItem.Create;
+ Item.Obj := Obj;
+ Item.PropInfo := p;
+ Item.Value := Value;
+ FFixups.Add(Item);
+end;
+
+procedure TfrxXMLSerializer.FixupReferences;
+var
+ i: Integer;
+ Item: TfrxFixupItem;
+ Ref: TObject;
+begin
+ for i := 0 to FFixups.Count - 1 do
+ begin
+ Item := FFixups[i];
+ Ref := nil;
+ if FOwner <> nil then
+ Ref := FOwner.FindObject(Item.Value);
+ if Ref = nil then
+ Ref := frxFindComponent(FOwner, Item.Value);
+ if Ref <> nil then
+ SetOrdProp(Item.Obj, Item.PropInfo, frxInteger(Ref));
+ end;
+
+ FReader.FixupReferences;
+ FReader.EndReferences;
+ ClearFixups;
+end;
+
+procedure TfrxXMLSerializer.XMLToObj(const s: String; Obj: TPersistent);
+var
+ i, j, start, len, code: Integer;
+ i1, start1, len1: Integer;
+ Name, Value: String;
+ Obj1: TPersistent;
+ p: PPropInfo;
+ ps, ps1: PChar;
+
+ procedure DoNonPublishedProps;
+ begin
+ FReaderStream.Clear;
+ frxStringToStream(Value, FReaderStream);
+ FReaderStream.Position := 0;
+ FReader.Position := 0;
+
+ try
+ while FReader.Position < FReaderStream.Size do
+ try
+ THackReader(FReader).ReadProperty(Obj1);
+ except
+ FReaderStream.Position := 0;
+ FReader.Position := 0;
+ THackReader(FReader).ReadProperty(Obj);
+ end;
+ except
+ end;
+ end;
+
+begin
+ ActivateClassGroup(TFmxObject);
+ { speed optimized code. affects the speed of loading prepared page in the preview }
+ len := Length(s);
+ i := 1;
+ ps := PChar(s) - 1;
+ while i < len do
+ begin
+ j := i;
+ len1 := len;
+ ps1 := ps;
+ while (j < len1) and (ps1[j] = ' ') do
+ Inc(j);
+ start := j;
+ while (j < len1) and (ps1[j] <> '=') do
+ Inc(j);
+ i := j;
+ if i < len then
+ begin
+ j := i - 1;
+ while (j > 0) and (ps1[j] = ' ') do
+ Dec(j);
+ Name := Copy(s, start, j - start + 1);
+ if Name = '' then break;
+ j := i;
+ len1 := len;
+ while (j < len1) and (ps1[j] <> '"') do
+ Inc(j);
+ start := j + 1;
+ Inc(j);
+ while (j < len1) and (ps1[j] <> '"') do
+ Inc(j);
+ i := j;
+ Value := Copy(s, start, i - start);
+ Inc(i);
+
+ Obj1 := Obj;
+
+ { check multiple properties }
+ len1 := Length(Name);
+ start1 := 1;
+ i1 := 1;
+ while (i1 < len1) and (Name[i1] <> '.') do
+ Inc(i1);
+ if i1 < len1 then
+ begin
+ while i1 < len1 do
+ begin
+ p := GetPropInfo(Obj1.ClassInfo, Copy(String(Name), start1, i1 - start1));
+ if p = nil then
+ break;
+ Obj1 := TPersistent(GetOrdProp(Obj1, p));
+ start1 := i1 + 1;
+ Inc(i1);
+ while (i1 < len1) and (Name[i1] <> '.') do
+ Inc(i1);
+ end;
+ Name := Copy(Name, start1, MaxInt);
+ end;
+
+ try
+ if Length(Name) = 1 then
+ begin
+ { special properties }
+ case Name[1] of
+ 'x':
+ begin
+ TfrxCustomMemoView(Obj1).Text := frxXMLToStr(Value);
+ continue;
+ end;
+ 'u':
+ begin
+ if FOldFormat then
+ TfrxCustomMemoView(Obj1).Text := frxXMLToStr(Utf8Decode(AnsiString(Value)))
+ else
+ TfrxCustomMemoView(Obj1).Text := frxXMLToStr(Value);
+ continue;
+ end;
+ 'l':
+ begin
+ TfrxComponent(Obj1).Left := frxStrToFloat(String(Value));
+ continue;
+ end;
+ 't':
+ begin
+ TfrxComponent(Obj1).Top := frxStrToFloat(String(Value));
+ continue;
+ end;
+ 'w':
+ begin
+ TfrxComponent(Obj1).Width := frxStrToFloat(String(Value));
+ continue;
+ end;
+ 'h':
+ begin
+ TfrxComponent(Obj1).Height := frxStrToFloat(String(Value));
+ continue;
+ end;
+ end;
+ end
+ else
+ begin
+ if Name = 'Text' then
+ begin
+ if Obj1 is TStrings then
+ begin
+ TStrings(Obj1).Text := frxXMLToStr(Value);
+ continue;
+ end
+ else if Obj1 is TfrxWideStrings then
+ begin
+ TfrxWideStrings(Obj1).Text := frxXMLToStr(Value);
+ continue;
+ end
+ else if Obj1 is TfrxCustomMemoView then
+ begin
+ if FOldFormat then
+ TfrxCustomMemoView(Obj1).Text := frxXMLToStr(Utf8Decode(AnsiString(Value)))
+ else
+ TfrxCustomMemoView(Obj1).Text := frxXMLToStr(Value);
+ continue;
+ end
+ end
+ else if Name = 'PropData' then
+ begin
+ DoNonPublishedProps;
+ continue;
+ end
+ else if (Obj1 is TfrxReport) and (Name = 'Name') then
+ continue;
+ end;
+
+ p := GetPropInfo(Obj1.ClassInfo, String(Name));
+ if (p <> nil) and (p.SetProc <> nil) then
+ case p.PropType^.Kind of
+ tkInteger, tkSet, tkChar, tkWChar:
+ SetOrdProp(Obj1, p, StrToInt(String(Value)));
+
+ tkInt64:
+ SetOrdProp(Obj1, p, StrToInt64(String(Value)));
+
+ tkEnumeration:
+ begin
+ Val(String(Value), j, code);
+ if code = 0 then
+ SetOrdProp(Obj1, p, j) else
+ SetOrdProp(Obj1, p, GetEnumValue(p.PropType^, Value));
+ end;
+
+ tkFloat:
+ SetFloatProp(Obj1, p, frxStrToFloat(String(Value)));
+
+ tkString, tkLString:
+ SetStrProp(Obj1, p, String(frxXMLToStr(Value)));
+
+ tkUString, tkWString:
+ SetStrProp(Obj1, p, frxXMLToStr(Value));
+
+ tkClass:
+ AddFixup(Obj1, p, String(Value));
+
+ tkVariant:
+ SetVariantProp(Obj1, p, frxXMLToStr(Value));
+ end;
+ except
+ on E: Exception do
+ FErrors.Add(E.Message);
+ end;
+ end;
+ end;
+end;
+
+function TfrxXMLSerializer.ObjToXML(Obj: TPersistent; const Add: String = '';
+ Ancestor: TPersistent = nil): String;
+var
+ TypeInfo: PTypeInfo;
+ PropCount: Integer;
+ PropList: PPropList;
+ i: Integer;
+ s: String;
+ ws: WideString;
+ Flag: Boolean;
+
+ procedure DoOrdProp;
+ var
+ Value: frxInteger;
+
+ function IsDefault: Boolean;
+ begin
+ if Ancestor <> nil then
+ Result := Value = GetOrdProp(Ancestor, PropList[i])
+ else
+ Result := Value = PropList[i].Default;
+ end;
+
+ begin
+ Value := GetOrdProp(Obj, PropList[i]);
+ if not IsDefault or FSerializeDefaultValues then
+ if PropList[i].PropType^.Kind = tkInt64 then
+ s := IntToStr(Int64(Value))
+ else if PropList[i].PropType^.Kind = tkEnumeration then
+ begin
+ if Value = -1 then Exit;
+ s := GetEnumName(PropList[i].PropType^, Integer(Value));
+// s := IntToStr(Integer(Value));
+ end
+ else
+ s := IntToStr(Integer(Value));
+ end;
+
+ procedure DoFloatProp;
+ var
+ Value: Extended;
+
+ function IsDefault: Boolean;
+ begin
+ if Ancestor <> nil then
+ Result := Abs(Value - GetFloatProp(Ancestor, PropList[i])) < 1e-6
+ else
+ Result := False;
+ end;
+
+ begin
+ Value := GetFloatProp(Obj, PropList[i]);
+// commented out due to bug with tfrxmemoview.linespacing=0
+ if not IsDefault or FSerializeDefaultValues then
+ s := FloatToStr(Value);
+ end;
+
+ procedure DoStrProp;
+ var
+ Value: String;
+
+ function IsDefault: Boolean;
+ begin
+ if Ancestor <> nil then
+ Result := Value = GetStrProp(Ancestor, PropList[i])
+ else
+ Result := Value = '';
+ end;
+
+ begin
+ Value := GetStrProp(Obj, PropList[i]);
+ if not IsDefault or FSerializeDefaultValues then
+ s := frxStrToXML(Value);
+ end;
+
+ procedure DoVariantProp;
+ var
+ Value: Variant;
+
+ function IsDefault: Boolean;
+ begin
+ if Ancestor <> nil then
+ Result := Value = GetVariantProp(Ancestor, PropList[i])
+ else
+ Result := False;
+ end;
+
+ begin
+ Value := GetVariantProp(Obj, PropList[i]);
+ if not IsDefault or FSerializeDefaultValues then
+ s := frxStrToXML(VarToStr(Value));
+ end;
+
+ procedure DoClassProp;
+ var
+ FClass: TClass;
+ FComp, FAncComp: TComponent;
+ FObj, FAncObj: TPersistent;
+ begin
+ FClass := GetTypeData(PropList[i].PropType^).ClassType;
+ if FClass.InheritsFrom(TComponent) then
+ begin
+ FComp := TComponent(GetOrdProp(Obj, PropList[i]));
+ if Ancestor <> nil then
+ FAncComp := TComponent(GetOrdProp(Ancestor, PropList[i]))
+ else
+ FAncComp := nil;
+
+ if Ancestor <> nil then
+ begin
+ if (FComp = nil) and (FAncComp = nil) then Exit;
+ if (FComp <> nil) and (FAncComp <> nil) then
+ if CompareText(FComp.Name, FAncComp.Name) = 0 then Exit;
+ if (FComp = nil) and (FAncComp <> nil) then
+ begin
+ s := 'nil';
+ Exit;
+ end;
+ end;
+
+ if FComp <> nil then
+ s := frxGetFullName(FOwner, FComp);
+ end
+ else if FClass.InheritsFrom(TPersistent) then
+ begin
+ FObj := TPersistent(GetOrdProp(Obj, PropList[i]));
+ if Ancestor <> nil then
+ FAncObj := TPersistent(GetOrdProp(Ancestor, PropList[i]))
+ else
+ FAncObj := nil;
+
+ if FObj is TStrings then
+ begin
+ if Ancestor <> nil then
+ if TStrings(FObj).Text = TStrings(FAncObj).Text then
+ Exit;
+ s := TStrings(FObj).Text;
+ if (Length(s) >= 2) and
+ (s[Length(s) - 1] = #13) and (s[Length(s)] = #10) then
+ Delete(s, Length(s) - 1, 2);
+ s := ' ' + Add + String(PropList[i].Name) + '.Text="' +
+ frxStrToXML(s) + '"';
+
+ end
+ else if FObj is TfrxWideStrings then
+ begin
+ // skip, handle separately
+ end
+ else
+ s := ObjToXML(FObj, Add + String(PropList[i].Name) + '.', FAncObj);
+ Flag := True;
+ end;
+ end;
+
+ procedure DoNonPublishedProps;
+ var
+ wr: TWriter;
+ ms, AncMs: TMemoryStream;
+ begin
+ ms := TMemoryStream.Create;
+ try
+ wr := TWriter.Create(ms, 4096);
+ wr.Root := FOwner;
+
+ try
+ THackPersistent(Obj).DefineProperties(wr);
+ finally
+ wr.Free;
+ end;
+
+ if ms.Size > 0 then
+ begin
+ if Ancestor <> nil then
+ begin
+ AncMs := TMemoryStream.Create;
+ try
+ wr := TWriter.Create(AncMs, 4096);
+ wr.Root := FOwner;
+
+ try
+ THackPersistent(Ancestor).DefineProperties(wr);
+ finally
+ wr.Free;
+ end;
+ if frxStreamCRC32(ms) = frxStreamCRC32(AncMs) then
+ Exit;
+ finally
+ AncMs.Free;
+ end;
+ end;
+
+ s := frxStreamToString(ms);
+ Result := Result + ' ' + Add + 'PropData="' + s + '"';
+ end;
+ finally
+ ms.Free;
+ end;
+ end;
+
+begin
+ Result := '';
+ if Obj = nil then Exit;
+
+ ActivateClassGroup(TFmxObject);
+
+ TypeInfo := Obj.ClassInfo;
+ PropCount := GetTypeData(TypeInfo).PropCount;
+ GetMem(PropList, PropCount * SizeOf(PPropInfo));
+ GetPropInfos(TypeInfo, PropList);
+
+ try
+ if Obj is TfrxComponent then
+ begin
+ TfrxComponent(Obj).IsWriting := True;
+ if (Ancestor = nil) and Assigned(FOnGetAncestor) then
+ FOnGetAncestor(TfrxComponent(Obj).Name, Ancestor);
+ end;
+ if Ancestor is TfrxComponent then
+ TfrxComponent(Ancestor).IsWriting := True;
+
+ for i := 0 to PropCount - 1 do
+ begin
+ s := '';
+ Flag := False;
+
+ if IsStoredProp(Obj, PropList[i]) then
+ case PropList[i].PropType^.Kind of
+ tkInt64, tkInteger, tkSet, tkChar, tkWChar, tkEnumeration:
+ DoOrdProp;
+
+ tkFloat:
+ DoFloatProp;
+
+ tkString, tkLString, tkWString, tkUString:
+ DoStrProp;
+
+ tkClass:
+ DoClassProp;
+
+ tkVariant:
+ DoVariantProp;
+ end;
+
+ if s <> '' then
+ if Flag then
+ Result := Result + s
+ else
+ Result := Result + ' ' + Add + String(PropList[i].Name) + '="' + s + '"';
+ end;
+
+ if Obj is TfrxCustomMemoView then
+ if (Ancestor = nil) or
+ (TfrxCustomMemoView(Obj).Text <> TfrxCustomMemoView(Ancestor).Text) then
+ begin
+ ws := TfrxCustomMemoView(Obj).Text;
+ if (Length(ws) >= 2) and
+ (ws[Length(ws) - 1] = #13) and (ws[Length(ws)] = #10) then
+ Delete(ws, Length(ws) - 1, 2);
+ Result := Result + ' Text="' + frxStrToXML(ws) + '"';
+ end;
+
+ DoNonPublishedProps;
+
+ finally
+ if Obj is TfrxComponent then
+ TfrxComponent(Obj).IsWriting := False;
+ if Ancestor is TfrxComponent then
+ TfrxComponent(Ancestor).IsWriting := False;
+ FreeMem(PropList, PropCount * SizeOf(PPropInfo));
+ end;
+end;
+
+procedure TfrxXMLSerializer.ReadRootComponent(Root: TfrxComponent;
+ XMLItem: TfrxXMLItem = nil);
+var
+ XMLDoc: TfrxXMLDocument;
+ CompList: TList;
+ aClass: TPersistentClass;
+
+ procedure DoRead(Item: TfrxXMLItem; Owner: TfrxComponent);
+ var
+ i: Integer;
+ c: TfrxComponent;
+ IsAncestor: Boolean;
+ begin
+ IsAncestor := CompareText(Item.Name, 'inherited') = 0;
+ aClass := nil;
+ if not IsAncestor then
+ try
+
+ i := FCachedClasses.IndexOf(Item.Name);
+ if i = -1 then
+ i := FCachedClasses.AddObject(Item.Name, TObject(FindClass(Item.Name)));
+// Result := TfrxComponent(FindClass(s).NewInstance);
+ aClass := TPersistentClass(FCachedClasses.Objects[i]);
+// aClass := FindClass(Item.Name);
+ except
+ FErrors.Add(frxResources.Get('xrCantFindClass') + ' ' + String(Item.Name));
+ Exit;
+ end;
+
+ if Owner <> nil then
+ begin
+ c := FOwner.FindComponent(String(Item.Prop['Name'])) as TfrxComponent;
+ if not IsAncestor and (c = nil) then
+ begin
+ c := TfrxComponent(aClass.NewInstance);
+ c.Create(Owner);
+ end;
+ end
+ else
+ c := Root;
+
+ if c <> nil then
+ begin
+ c.IsLoading := True;
+ XMLToObj(Item.Text, c);
+ CompList.Add(c);
+
+ for i := 0 to Item.Count - 1 do
+ DoRead(Item[i], c);
+ end;
+ end;
+
+ procedure DoLoaded;
+ var
+ i: Integer;
+ c: TfrxComponent;
+ begin
+ for i := 0 to CompList.Count - 1 do
+ begin
+ c := CompList[i];
+ c.IsLoading := False;
+ if not (c is TfrxReport) then
+ THackComponent(c).Loaded;
+ end;
+ end;
+
+begin
+ ActivateClassGroup(TFmxObject);
+ if Owner = nil then
+ Owner := Root;
+ XMLDoc := nil;
+ CompList := TList.Create;
+
+ if XMLItem = nil then
+ begin
+ XMLDoc := TfrxXMLDocument.Create;
+ XMLItem := XMLDoc.Root;
+ try
+ XMLDoc.LoadFromStream(FStream);
+ FOldFormat := XMLDoc.OldVersion;
+ except
+ XMLDoc.Free;
+ CompList.Free;
+ raise;
+ end;
+ end;
+
+ FReader.Root := FOwner;
+ FReader.BeginReferences;
+ try
+ DoRead(XMLItem, nil);
+ FixupReferences;
+ DoLoaded;
+ finally
+ if XMLDoc <> nil then
+ XMLDoc.Free;
+ CompList.Free;
+ end;
+end;
+
+procedure TfrxXMLSerializer.WriteRootComponent(Root: TfrxComponent;
+ SaveChildren: Boolean = True; XMLItem: TfrxXMLItem = nil; Streaming: Boolean = False);
+var
+ XMLDoc: TfrxXMLDocument;
+
+ procedure DoWrite(Item: TfrxXMLItem; ARoot: TfrxComponent);
+ var
+ i: Integer;
+ begin
+ if ARoot.IsAncestor and not Streaming then
+ Item.Name := 'inherited'
+ else
+ Item.Name := ARoot.ClassName;
+ if ARoot = Root then
+ Item.Text := ObjToXML(ARoot)
+ else
+ Item.Text := 'Name="' + ARoot.Name + '"' + ObjToXML(ARoot);
+ if SaveChildren then
+ for i := 0 to ARoot.Objects.Count - 1 do
+ DoWrite(Item.Add, ARoot.Objects[i]);
+ end;
+
+begin
+ if Owner = nil then
+ Owner := Root;
+ XMLDoc := nil;
+
+ if XMLItem = nil then
+ begin
+ XMLDoc := TfrxXMLDocument.Create;
+ XMLItem := XMLDoc.Root;
+ XMLDoc.AutoIndent := True;
+ end;
+
+ try
+ DoWrite(XMLItem, Root);
+ if XMLDoc <> nil then
+ XMLDoc.SaveToStream(FStream);
+ finally
+ if XMLDoc <> nil then
+ XMLDoc.Free;
+ end;
+end;
+
+function TfrxXMLSerializer.ReadComponent(Root: TfrxComponent): TfrxComponent;
+var
+ rd: TfrxXMLReader;
+ RootItem: TfrxXMLItem;
+begin
+ rd := TfrxXMLReader.Create(FStream);
+ RootItem := TfrxXMLItem.Create;
+
+ try
+ rd.ReadRootItem(RootItem, False);
+ Result := ReadComponentStr(Root, RootItem.Name + ' ' + RootItem.Text);
+ finally
+ rd.Free;
+ RootItem.Free;
+ end;
+end;
+
+procedure TfrxXMLSerializer.WriteComponent(c: TfrxComponent);
+var
+ s: AnsiString;
+begin
+ s := '<' + UTF8Encode(WriteComponentStr(c)) + '/>';
+ FStream.Write(s[1], Length(s));
+end;
+
+function TfrxXMLSerializer.ReadComponentStr(Root: TfrxComponent;
+ s: String; DontFixup: Boolean = False): TfrxComponent;
+var
+ n: Integer;
+ s1: String;
+begin
+ ActivateClassGroup(TFmxObject);
+ Owner := Root;
+ if Trim(String(s)) = '' then
+ Result := nil
+ else
+ begin
+ n := Pos(' ', s);
+ s1 := Copy(s, n + 1, MaxInt);
+ Delete(s, n, MaxInt);
+
+ n := FCachedClasses.IndexOf(s);
+ if n = -1 then
+ n := FCachedClasses.AddObject(s, TObject(FindClass(s)));
+// Result := TfrxComponent(FindClass(s).NewInstance);
+ Result := TfrxComponent(TPersistentClass(FCachedClasses.Objects[n]).NewInstance);
+ Result.Create(Root);
+
+ FReader.Root := Root;
+ FReader.BeginReferences;
+ try
+ Result.IsLoading := True;
+ XMLToObj(s1, Result);
+ finally
+ if DontFixup then
+ begin
+ FReader.EndReferences;
+ ClearFixups;
+ end
+ else
+ FixupReferences;
+ Result.IsLoading := False;
+ if not (Result is TfrxReport) then
+ THackComponent(Result).Loaded;
+ end;
+ end;
+end;
+
+function TfrxXMLSerializer.WriteComponentStr(c: TfrxComponent): String;
+begin
+ Result := c.ClassName + ObjToXML(c);
+end;
+
+procedure TfrxXMLSerializer.ReadPersistentStr(Root: TComponent;
+ Obj: TPersistent; const s: String);
+begin
+ FReader.Root := Root;
+ FReader.BeginReferences;
+ XMLToObj(s, Obj);
+ FixupReferences;
+end;
+
+procedure TfrxXMLSerializer.CopyFixupList(FixList: TList);
+var
+ i: Integer;
+ function CopyItem: TfrxFixupItem;
+ var
+ Item: TfrxFixupItem;
+ begin
+ Item := TfrxFixupItem(FFixups[i]);
+ Result := TfrxFixupItem.Create;
+ Result.Obj := Item.Obj;
+ Result.PropInfo := Item.PropInfo;
+ Result.Value := Item.Value;
+ end;
+begin
+ if FixList = nil then exit;
+ for i := 0 to FFixups.Count - 1 do
+ FixList.Add(CopyItem);
+end;
+
+end.
+
+
diff --git a/LibD28/FMX.frxZip.pas b/LibD28/FMX.frxZip.pas
new file mode 100644
index 0000000..7023e92
--- /dev/null
+++ b/LibD28/FMX.frxZip.pas
@@ -0,0 +1,561 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ ZIP archiver support unit }
+{ }
+{ Copyright (c) 2006-2008 }
+{ by Alexander Fediachov, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxZip;
+
+{$I frx.inc}
+
+interface
+
+uses System.Classes,
+ System.ZLib, FMX.frxGZip, FMX.frxUtils, System.Types{, frxFileUtils}
+ {$IFDEF MSWINDOWS}
+ , Winapi.Windows
+{$ENDIF MSWINDOWS}
+{$IFDEF POSIX}
+ , Posix.SysTime, Posix.SysTypes, Posix.Time, Posix.Utime
+{$ENDIF POSIX};
+
+type
+ TfrxZipLocalFileHeader = class;
+ TfrxZipCentralDirectory = class;
+ TfrxZipFileHeader = class;
+
+ TfrxZipArchive = class(TObject)
+ private
+ FRootFolder: AnsiString;
+ FErrors: TStringList;
+ FFileList: TStringList;
+ FComment: AnsiString;
+ FProgress: TNotifyEvent;
+ function GetCount: Integer;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Clear;
+ procedure AddFile(const FileName: AnsiString);
+ procedure AddDir(const DirName: AnsiString);
+ procedure SaveToFile(const Filename: AnsiString);
+ procedure SaveToStream(const Stream: TStream);
+ property Errors: TStringList read FErrors;
+ property Comment: AnsiString read FComment write FComment;
+ property RootFolder: AnsiString read FRootFolder write FRootFolder;
+ property FileCount: Integer read GetCount;
+ property OnProgress: TNotifyEvent read FProgress write FProgress;
+ end;
+
+ TfrxZipLocalFileHeader = class(TObject)
+ private
+ FLocalFileHeaderSignature: Longword;
+ FVersion: WORD;
+ FGeneralPurpose: WORD;
+ FCompressionMethod: WORD;
+ FCrc32: Longword;
+ FLastModFileDate: WORD;
+ FLastModFileTime: WORD;
+ FCompressedSize: Longword;
+ FUnCompressedSize: Longword;
+ FExtraField: AnsiString;
+ FFileName: AnsiString;
+ FFileNameLength: WORD;
+ FExtraFieldLength: WORD;
+ procedure SetExtraField(const Value: AnsiString);
+ procedure SetFileName(const Value: AnsiString);
+ public
+ constructor Create;
+ procedure SaveToStream(const Stream: TStream);
+ property LocalFileHeaderSignature: Longword read FLocalFileHeaderSignature;
+ property Version: WORD read FVersion write FVersion;
+ property GeneralPurpose: WORD read FGeneralPurpose write FGeneralPurpose;
+ property CompressionMethod: WORD read FCompressionMethod write FCompressionMethod;
+ property LastModFileTime: WORD read FLastModFileTime write FLastModFileTime;
+ property LastModFileDate: WORD read FLastModFileDate write FLastModFileDate;
+ property Crc32: Longword read FCrc32 write FCrc32;
+ property CompressedSize: Longword read FCompressedSize write FCompressedSize;
+ property UnCompressedSize: Longword read FUnCompressedSize write FUnCompressedSize;
+ property FileNameLength: WORD read FFileNameLength write FFileNameLength;
+ property ExtraFieldLength: WORD read FExtraFieldLength write FExtraFieldLength;
+ property FileName: AnsiString read FFileName write SetFileName;
+ property ExtraField: AnsiString read FExtraField write SetExtraField;
+ end;
+
+ TfrxZipCentralDirectory = class(TObject)
+ private
+ FEndOfChentralDirSignature: Longword;
+ FNumberOfTheDisk: WORD;
+ FTotalOfEntriesCentralDirOnDisk: WORD;
+ FNumberOfTheDiskStartCentralDir: WORD;
+ FTotalOfEntriesCentralDir: WORD;
+ FSizeOfCentralDir: Longword;
+ FOffsetStartingDiskDir: Longword;
+ FComment: AnsiString;
+ FCommentLength: WORD;
+ procedure SetComment(const Value: AnsiString);
+ public
+ constructor Create;
+ procedure SaveToStream(const Stream: TStream);
+ property EndOfChentralDirSignature: Longword read FEndOfChentralDirSignature;
+ property NumberOfTheDisk: WORD read FNumberOfTheDisk write FNumberOfTheDisk;
+ property NumberOfTheDiskStartCentralDir: WORD
+ read FNumberOfTheDiskStartCentralDir write FNumberOfTheDiskStartCentralDir;
+ property TotalOfEntriesCentralDirOnDisk: WORD
+ read FTotalOfEntriesCentralDirOnDisk write FTotalOfEntriesCentralDirOnDisk;
+ property TotalOfEntriesCentralDir: WORD
+ read FTotalOfEntriesCentralDir write FTotalOfEntriesCentralDir;
+ property SizeOfCentralDir: Longword read FSizeOfCentralDir write FSizeOfCentralDir;
+ property OffsetStartingDiskDir: Longword read FOffsetStartingDiskDir write FOffsetStartingDiskDir;
+ property CommentLength: WORD read FCommentLength write FCommentLength;
+ property Comment: AnsiString read FComment write SetComment;
+ end;
+
+ TfrxZipFileHeader = class(TObject)
+ private
+ FCentralFileHeaderSignature: Longword;
+ FRelativeOffsetLocalHeader: Longword;
+ FUnCompressedSize: Longword;
+ FCompressedSize: Longword;
+ FCrc32: Longword;
+ FExternalFileAttribute: Longword;
+ FExtraField: AnsiString;
+ FFileComment: AnsiString;
+ FFileName: AnsiString;
+ FCompressionMethod: WORD;
+ FDiskNumberStart: WORD;
+ FLastModFileDate: WORD;
+ FLastModFileTime: WORD;
+ FVersionMadeBy: WORD;
+ FGeneralPurpose: WORD;
+ FFileNameLength: WORD;
+ FInternalFileAttribute: WORD;
+ FExtraFieldLength: WORD;
+ FVersionNeeded: WORD;
+ FFileCommentLength: WORD;
+ procedure SetExtraField(const Value: AnsiString);
+ procedure SetFileComment(const Value: AnsiString);
+ procedure SetFileName(const Value: AnsiString);
+ public
+ constructor Create;
+ procedure SaveToStream(const Stream: TStream);
+ property CentralFileHeaderSignature: Longword read FCentralFileHeaderSignature;
+ property VersionMadeBy: WORD read FVersionMadeBy;
+ property VersionNeeded: WORD read FVersionNeeded;
+ property GeneralPurpose: WORD read FGeneralPurpose write FGeneralPurpose;
+ property CompressionMethod: WORD read FCompressionMethod write FCompressionMethod;
+ property LastModFileTime: WORD read FLastModFileTime write FLastModFileTime;
+ property LastModFileDate: WORD read FLastModFileDate write FLastModFileDate;
+ property Crc32: Longword read FCrc32 write FCrc32;
+ property CompressedSize: Longword read FCompressedSize write FCompressedSize;
+ property UnCompressedSize: Longword read FUnCompressedSize write FUnCompressedSize;
+ property FileNameLength: WORD read FFileNameLength write FFileNameLength;
+ property ExtraFieldLength: WORD read FExtraFieldLength write FExtraFieldLength;
+ property FileCommentLength: WORD read FFileCommentLength write FFileCommentLength;
+ property DiskNumberStart: WORD read FDiskNumberStart write FDiskNumberStart;
+ property InternalFileAttribute: WORD read FInternalFileAttribute write FInternalFileAttribute;
+ property ExternalFileAttribute: Longword read FExternalFileAttribute write FExternalFileAttribute;
+ property RelativeOffsetLocalHeader: Longword read FRelativeOffsetLocalHeader write FRelativeOffsetLocalHeader;
+ property FileName: AnsiString read FFileName write SetFileName;
+ property ExtraField: AnsiString read FExtraField write SetExtraField;
+ property FileComment: AnsiString read FFileComment write SetFileComment;
+ end;
+
+ TfrxZipLocalFile = class(TObject)
+ private
+ FLocalFileHeader: TfrxZipLocalFileHeader;
+ FFileData: TMemoryStream;
+ FOffset: Longword;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure SaveToStream(const Stream: TStream);
+ property LocalFileHeader: TfrxZipLocalFileHeader read FLocalFileHeader;
+ property FileData: TMemoryStream read FFileData write FFileData;
+ property Offset: Longword read FOffset write FOffset;
+ end;
+
+implementation
+
+uses System.SysUtils, System.AnsiStrings, System.IOUtils;
+
+const
+ ZIP_VERSIONMADEBY = 20;
+ ZIP_NONE = 0;
+ ZIP_DEFLATED = 8;
+ ZIP_MINSIZE = 128;
+
+{ TfrxZipLocalFile }
+
+constructor TfrxZipLocalFile.Create;
+begin
+ FLocalFileHeader := TfrxZipLocalFileHeader.Create;
+ FOffset := 0;
+end;
+
+destructor TfrxZipLocalFile.Destroy;
+begin
+ FLocalFileHeader.Free;
+ inherited;
+end;
+
+procedure TfrxZipLocalFile.SaveToStream(const Stream: TStream);
+begin
+ FLocalFileHeader.SaveToStream(Stream);
+ FFileData.Position := 0;
+ FFileData.SaveToStream(Stream);
+end;
+
+{ TfrxZipLocalFileHeader }
+
+constructor TfrxZipLocalFileHeader.Create;
+begin
+ inherited;
+ FLocalFileHeaderSignature := $04034b50;
+ FVersion := ZIP_VERSIONMADEBY;
+ FGeneralPurpose := 0;
+ FCompressionMethod := ZIP_NONE;
+ FCrc32 := 0;
+ FLastModFileDate := 0;
+ FLastModFileTime := 0;
+ FCompressedSize := 0;
+ FUnCompressedSize := 0;
+ FExtraField := '';
+ FFileName := '';
+ FFileNameLength := 0;
+ FExtraFieldLength := 0;
+end;
+
+procedure TfrxZipLocalFileHeader.SaveToStream(const Stream: TStream);
+begin
+ Stream.Write(FLocalFileHeaderSignature, 4);
+ Stream.Write(FVersion, 2);
+ Stream.Write(FGeneralPurpose, 2);
+ Stream.Write(FCompressionMethod, 2);
+ Stream.Write(FLastModFileTime, 2);
+ Stream.Write(FLastModFileDate, 2);
+ Stream.Write(FCrc32, 4);
+ Stream.Write(FCompressedSize, 4);
+ Stream.Write(FUnCompressedSize, 4);
+ Stream.Write(FFileNameLength, 2);
+ Stream.Write(FExtraFieldLength, 2);
+ if FFileNameLength > 0 then
+ Stream.Write(FFileName[1], FFileNameLength);
+ if FExtraFieldLength > 0 then
+ Stream.Write(FExtraField[1], FExtraFieldLength);
+end;
+
+procedure TfrxZipLocalFileHeader.SetExtraField(const Value: AnsiString);
+begin
+ FExtraField := Value;
+ FExtraFieldLength := Length(Value);
+end;
+
+procedure TfrxZipLocalFileHeader.SetFileName(const Value: AnsiString);
+begin
+ FFileName := StringReplace(Value,
+ AnsiString('\'), AnsiString('/'), [rfReplaceAll]);
+ FFileNameLength := Length(Value);
+end;
+
+{ TfrxZipCentralDirectory }
+
+constructor TfrxZipCentralDirectory.Create;
+begin
+ inherited;
+ FEndOfChentralDirSignature := $06054b50;
+ FNumberOfTheDisk := 0;
+ FNumberOfTheDiskStartCentralDir := 0;
+ FTotalOfEntriesCentralDirOnDisk := 0;
+ FTotalOfEntriesCentralDir := 0;
+ FSizeOfCentralDir := 0;
+ FOffsetStartingDiskDir := 0;
+ FCommentLength := 0;
+ FComment := '';
+end;
+
+procedure TfrxZipCentralDirectory.SaveToStream(const Stream: TStream);
+begin
+ Stream.Write(FEndOfChentralDirSignature, 4);
+ Stream.Write(FNumberOfTheDisk, 2);
+ Stream.Write(FNumberOfTheDiskStartCentralDir, 2);
+ Stream.Write(FTotalOfEntriesCentralDirOnDisk, 2);
+ Stream.Write(FTotalOfEntriesCentralDir, 2);
+ Stream.Write(FSizeOfCentralDir, 4);
+ Stream.Write(FOffsetStartingDiskDir, 4);
+ Stream.Write(FCommentLength, 2);
+ if FCommentLength > 0 then
+ Stream.Write(FComment[1], FCommentLength);
+end;
+
+procedure TfrxZipCentralDirectory.SetComment(const Value: AnsiString);
+begin
+ FComment := Value;
+ FCommentLength := Length(Value);
+end;
+
+{ TfrxZipFileHeader }
+
+constructor TfrxZipFileHeader.Create;
+begin
+ FCentralFileHeaderSignature := $02014b50;
+ FRelativeOffsetLocalHeader := 0;
+ FUnCompressedSize := 0;
+ FCompressedSize := 0;
+ FCrc32 := 0;
+ FExternalFileAttribute := 0;
+ FExtraField := '';
+ FFileComment := '';
+ FFileName := '';
+ FCompressionMethod := 0;
+ FDiskNumberStart := 0;
+ FLastModFileDate := 0;
+ FLastModFileTime := 0;
+ FVersionMadeBy := ZIP_VERSIONMADEBY;
+ FGeneralPurpose := 0;
+ FFileNameLength := 0;
+ FInternalFileAttribute := 0;
+ FExtraFieldLength := 0;
+ FVersionNeeded := ZIP_VERSIONMADEBY;
+ FFileCommentLength := 0;
+end;
+
+procedure TfrxZipFileHeader.SaveToStream(const Stream: TStream);
+begin
+ Stream.Write(FCentralFileHeaderSignature, 4);
+ Stream.Write(FVersionMadeBy, 2);
+ Stream.Write(FVersionNeeded, 2);
+ Stream.Write(FGeneralPurpose, 2);
+ Stream.Write(FCompressionMethod, 2);
+ Stream.Write(FLastModFileTime, 2);
+ Stream.Write(FLastModFileDate, 2);
+ Stream.Write(FCrc32, 4);
+ Stream.Write(FCompressedSize, 4);
+ Stream.Write(FUnCompressedSize, 4);
+ Stream.Write(FFileNameLength, 2);
+ Stream.Write(FExtraFieldLength, 2);
+ Stream.Write(FFileCommentLength, 2);
+ Stream.Write(FDiskNumberStart, 2);
+ Stream.Write(FInternalFileAttribute, 2);
+ Stream.Write(FExternalFileAttribute, 4);
+ Stream.Write(FRelativeOffsetLocalHeader, 4);
+ Stream.Write(FFilename[1], FFileNameLength);
+ Stream.Write(FExtraField[1], FExtraFieldLength);
+ Stream.Write(FFileComment[1], FFileCommentLength);
+end;
+
+procedure TfrxZipFileHeader.SetExtraField(const Value: AnsiString);
+begin
+ FExtraField := Value;
+ FExtraFieldLength := Length(Value);
+end;
+
+procedure TfrxZipFileHeader.SetFileComment(const Value: AnsiString);
+begin
+ FFileComment := Value;
+ FFileNameLength := Length(Value);
+end;
+
+procedure TfrxZipFileHeader.SetFileName(const Value: AnsiString);
+begin
+ FFileName := StringReplace(Value,
+ AnsiString('\'), AnsiString('/'), [rfReplaceAll]);
+ FFileNameLength := Length(Value);
+end;
+
+{ TfrxZipArchive }
+
+procedure TfrxZipArchive.AddDir(const DirName: AnsiString);
+var
+ SRec: TSearchRec;
+ i: Integer;
+ s: AnsiString;
+begin
+ if DirectoryExists(String(DirName)) then
+ begin
+ s := DirName;
+ if s[Length(s)] <> PathDelim then
+ s := s + PathDelim;
+ i := FindFirst(String(s) + '*.*', faDirectory + faArchive, SRec);
+ try
+ while i = 0 do
+ begin
+ if (SRec.Name <> '.') and (SRec.Name <> '..') then
+ begin
+ if (SRec.Attr and faDirectory) = faDirectory then
+ AddDir(s + AnsiString(SRec.Name))
+ else
+ AddFile(s + AnsiString(SRec.Name));
+ end;
+ i := FindNext(SRec);
+ end;
+ finally
+ FindClose(SRec);
+ end;
+ end;
+end;
+
+procedure TfrxZipArchive.AddFile(const FileName: AnsiString);
+begin
+ if FileExists(String(FileName)) then
+ begin
+ FFileList.Add(String(FileName));
+ if FRootFolder = '' then
+ FRootFolder := ExtractFilePath(FileName);
+ end
+ else
+ FErrors.Add('File ' + String(FileName) + ' not found!');
+end;
+
+procedure TfrxZipArchive.Clear;
+begin
+ FErrors.Clear;
+ FFileList.Clear;
+ FRootFolder := '';
+ FComment := '';
+end;
+
+constructor TfrxZipArchive.Create;
+begin
+ FProgress := nil;
+ FErrors := TStringList.Create;
+ FFileList := TStringList.Create;
+ Clear;
+end;
+
+destructor TfrxZipArchive.Destroy;
+begin
+ FErrors.Free;
+ FFileList.Free;
+ inherited;
+end;
+
+function TfrxZipArchive.GetCount: Integer;
+begin
+ Result := FFileList.Count;
+end;
+
+procedure TfrxZipArchive.SaveToFile(const FileName: AnsiString);
+var
+ f: TFileStream;
+begin
+ f := TFileStream.Create(String(FileName), fmCreate);
+ try
+ SaveToStream(f);
+ finally
+ f.Free;
+ end;
+end;
+
+procedure TfrxZipArchive.SaveToStream(const Stream: TStream);
+var
+ i: Integer;
+ ZipFile: TfrxZipLocalFile;
+ ZipFileHeader: TfrxZipFileHeader;
+ ZipDir: TfrxZipCentralDirectory;
+ FileStream: TFileStream;
+ TempStream: TMemoryStream;
+ FileName: AnsiString;
+ CentralStartPos, CentralEndPos: Longword;
+
+
+
+LFT: Integer;
+begin
+ for i := 0 to FFileList.Count - 1 do
+ begin
+ ZipFile := TfrxZipLocalFile.Create;
+ ZipFile.FileData := TMemoryStream.Create;
+ try
+ FileName := StringReplace(AnsiString(FFileList[i]), FRootFolder, AnsiString(''), []);
+ ZipFile.LocalFileHeader.FileName := FileName;
+ FileStream := TFileStream.Create(FFileList[i], fmOpenRead + fmShareDenyWrite);
+ try
+ if FileStream.Size > ZIP_MINSIZE then
+ begin
+ FileStream.Position := 0;
+ TempStream := TMemoryStream.Create;
+ try
+ frxDeflateStream(FileStream, TempStream);
+ TempStream.Position := 2;
+ ZipFile.FileData.CopyFrom(TempStream, TempStream.Size - 6);
+ finally
+ TempStream.Free;
+ end;
+ ZipFile.LocalFileHeader.CompressionMethod := ZIP_DEFLATED;
+ end
+ else
+ begin
+ ZipFile.FileData.CopyFrom(FileStream, 0);
+ ZipFile.LocalFileHeader.CompressionMethod := ZIP_NONE;
+ end;
+ ZipFile.LocalFileHeader.CompressedSize := ZipFile.FileData.Size;
+ ZipFile.LocalFileHeader.UnCompressedSize := FileStream.Size;
+ TempStream := TMemoryStream.Create;
+ try
+ TempStream.CopyFrom(FileStream, 0);
+ ZipFile.LocalFileHeader.Crc32 := frxStreamCRC32(TempStream);
+ finally
+ TempStream.Free;
+ end;
+ ZipFile.Offset := Stream.Position;
+
+ LFT := FileGetDate(FileStream.Handle);
+
+ {$IFNDEF STATIC_EXPORTING_RESULTS}
+ ZipFile.LocalFileHeader.LastModFileDate := Hi(LFT);
+ ZipFile.LocalFileHeader.LastModFileTime := Lo(LFT);
+ {$ENDIF}
+ finally
+ FileStream.Free;
+ end;
+ ZipFile.SaveToStream(Stream);
+ if Assigned(FProgress) then
+ FProgress(Self);
+ finally
+ ZipFile.FileData.Free;
+ ZipFile.FileData := nil;
+ end;
+ FFileList.Objects[i] := ZipFile;
+ end;
+ CentralStartPos := Stream.Position;
+ for i := 0 to FFileList.Count - 1 do
+ begin
+ ZipFile := TfrxZipLocalFile(FFileList.Objects[i]);
+ ZipFileHeader := TfrxZipFileHeader.Create;
+ try
+ ZipFileHeader.CompressionMethod := ZipFile.LocalFileHeader.CompressionMethod;
+ ZipFileHeader.LastModFileTime := ZipFile.LocalFileHeader.LastModFileTime;
+ ZipFileHeader.LastModFileDate := ZipFile.LocalFileHeader.LastModFileDate;
+ ZipFileHeader.GeneralPurpose := ZipFile.LocalFileHeader.GeneralPurpose;
+ ZipFileHeader.Crc32 := ZipFile.LocalFileHeader.Crc32;
+ ZipFileHeader.CompressedSize := ZipFile.LocalFileHeader.CompressedSize;
+ ZipFileHeader.UnCompressedSize := ZipFile.LocalFileHeader.UnCompressedSize;
+ ZipFileHeader.RelativeOffsetLocalHeader := ZipFile.Offset;
+ ZipFileHeader.FileName := ZipFile.LocalFileHeader.FileName;
+ ZipFileHeader.SaveToStream(Stream);
+ finally
+ ZipFileHeader.Free;
+ end;
+ ZipFile.Free;
+ end;
+ CentralEndPos := Stream.Position;
+ ZipDir := TfrxZipCentralDirectory.Create;
+ try
+ ZipDir.TotalOfEntriesCentralDirOnDisk := FFileList.Count;
+ ZipDir.TotalOfEntriesCentralDir := FFileList.Count;
+ ZipDir.SizeOfCentralDir := CentralEndPos - CentralStartPos;
+ ZipDir.OffsetStartingDiskDir := CentralStartPos;
+ ZipDir.SaveToStream(Stream);
+ finally
+ ZipDir.Free;
+ end;
+end;
+
+end.
\ No newline at end of file
diff --git a/LibD28/FMX.frxrcClass.pas b/LibD28/FMX.frxrcClass.pas
new file mode 100644
index 0000000..91503c7
--- /dev/null
+++ b/LibD28/FMX.frxrcClass.pas
@@ -0,0 +1,100 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Language resource file }
+{ }
+{ Copyright (c) 1998-2014 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxrcClass;
+
+interface
+
+implementation
+
+uses FMX.frxRes;
+
+const resXML =
+'' +
+'<' +
+'StrRes Name="130" Text="Thumbnails"/><' +
+'StrRes Name="rave4" Text="Report %s, page %s."/><' +
+'StrRes Name="UPC Supp2" Text="UPC Supp2"/>' +
+' ';
+
+initialization
+ frxResources.AddXML(resXML);
+
+end.
diff --git a/LibD28/FMX.frxrcDesgn.pas b/LibD28/FMX.frxrcDesgn.pas
new file mode 100644
index 0000000..cab6388
--- /dev/null
+++ b/LibD28/FMX.frxrcDesgn.pas
@@ -0,0 +1,281 @@
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Language resource file }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxrcDesgn;
+
+interface
+
+implementation
+
+uses FMX.frxRes;
+
+const resXML =
+'' +
+'<' +
+'StrRes Name="2458" Text="90°"/><' +
+'StrRes Name="2706" Text="Left"/><' +
+'StrRes Name="bcShowText" Text="Show Text"/><' +
+'StrRes Name="3805" Text="Clear"/><' +
+'StrRes Name="4003" Text="Paste"/>' +
+'' +
+'<' +
+'StrRes Name="5208" Text="All Frame Lines"/><' +
+'StrRes Name="5604" Text="Layout"/>' +
+'' +
+'' +
+'<' +
+'StrRes Name="startOpenLast" Text="Open last report"/><' +
+'StrRes Name="6002" Text="Delete duplicates"/>' +
+' ';
+
+initialization
+ frxResources.AddXML(resXML);
+
+end.
diff --git a/LibD28/FMX.frxrcExports.pas b/LibD28/FMX.frxrcExports.pas
new file mode 100644
index 0000000..5d75320
--- /dev/null
+++ b/LibD28/FMX.frxrcExports.pas
@@ -0,0 +1,99 @@
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Language resource file }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxrcExports;
+
+interface
+
+implementation
+
+uses FMX.frxRes;
+
+const resXML =
+'' +
+'' +
+'' +
+'' +
+' ';
+
+initialization
+ frxResources.AddXML(resXML);
+
+end.
diff --git a/LibD28/FMX.frxrcInsp.pas b/LibD28/FMX.frxrcInsp.pas
new file mode 100644
index 0000000..b1cf1bf
--- /dev/null
+++ b/LibD28/FMX.frxrcInsp.pas
@@ -0,0 +1,860 @@
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Language resource file }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxrcInsp;
+
+interface
+
+implementation
+
+uses FMX.frxRes;
+
+const resXML =
+'<' +
+'StrRes Name="propBevelInner" Text="The type of ' +
+';the inner bevel"/' +
+'>' +
+'' +
+'' +
+' ';
+
+initialization
+ frxResources.AddXML(resXML);
+
+end.
diff --git a/LibD28/FMX.fs_iadortti.pas b/LibD28/FMX.fs_iadortti.pas
new file mode 100644
index 0000000..f858548
--- /dev/null
+++ b/LibD28/FMX.fs_iadortti.pas
@@ -0,0 +1,129 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ ADO classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iadortti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_itools, FMX.fs_idbrtti,
+ Data.DB, Data.Win.ADODB, Winapi.ADOInt, FMX.Types;
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsADORTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddType('TDataType', fvtInt);
+ AddClass(TADOConnection, 'TComponent');
+ AddClass(TParameter, 'TCollectionItem');
+ with AddClass(TParameters, 'TCollection') do
+ begin
+ AddMethod('function AddParameter: TParameter', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TParameter', CallMethod, True);
+ end;
+ with AddClass(TCustomADODataSet, 'TDataSet') do
+ begin
+ AddProperty('Sort', 'WideString', GetProp, SetProp);
+ end;
+ AddClass(TADOTable, 'TCustomADODataSet');
+ with AddClass(TADOQuery, 'TCustomADODataSet') do
+ AddMethod('procedure ExecSQL', CallMethod);
+ with AddClass(TADOStoredProc, 'TCustomADODataSet') do
+ AddMethod('procedure ExecProc', CallMethod);
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TParameters then
+ begin
+ if MethodName = 'ADDPARAMETER' then
+ Result := frxInteger(TParameters(Instance).AddParameter)
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TParameters(Instance).Items[Caller.Params[0]])
+ end
+ else if ClassType = TADOQuery then
+ begin
+ if MethodName = 'EXECSQL' then
+ TADOQuery(Instance).ExecSQL
+ end
+ else if ClassType = TADOStoredProc then
+ begin
+ if MethodName = 'EXECPROC' then
+ TADOStoredProc(Instance).ExecProc
+ end
+end;
+
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TCustomADODataSet then
+ begin
+ if PropName = 'SORT' then
+ Result := TCustomADODataSet(Instance).Sort;
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+
+ if ClassType = TCustomADODataSet then
+ begin
+ if PropName = 'SORT' then
+ TCustomADODataSet(Instance).Sort := Value;
+ end
+
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsADORTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
+
diff --git a/LibD28/FMX.fs_ibasic.pas b/LibD28/FMX.fs_ibasic.pas
new file mode 100644
index 0000000..8a0c8e7
--- /dev/null
+++ b/LibD28/FMX.fs_ibasic.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Basic grammar }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_ibasic;
+{$i FMX.inc}
+{$i fs_ibasic.pas}
\ No newline at end of file
diff --git a/LibD28/FMX.fs_ichartrtti.pas b/LibD28/FMX.fs_ichartrtti.pas
new file mode 100644
index 0000000..4fdff87
--- /dev/null
+++ b/LibD28/FMX.fs_ichartrtti.pas
@@ -0,0 +1,181 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Chart }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_ichartrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_itools, FMX.fs_iformsrtti, FMX.Objects,
+ FMXTee.Chart, FMXTee.Series, FMXTee.Engine, FMXTee.Procs, FMXTee.Canvas, FMX.Types, System.Types;
+
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsChartRTTI = class(TFmxObject); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddType('TChartValue', fvtFloat);
+ AddEnum('TLegendStyle', 'lsAuto, lsSeries, lsValues, lsLastValues');
+ AddEnum('TLegendAlignment', 'laLeft, laRight, laTop, laBottom');
+ AddEnum('TLegendTextStyle', 'ltsPlain, ltsLeftValue, ltsRightValue, ltsLeftPercent,' +
+ 'ltsRightPercent, ltsXValue');
+ AddEnum('TChartListOrder', 'loNone, loAscending, loDescending');
+ AddEnum('TGradientDirection', 'gdTopBottom, gdBottomTop, gdLeftRight, gdRightLeft');
+ AddEnum('TSeriesMarksStyle', 'smsValue, smsPercent, smsLabel, smsLabelPercent, ' +
+ 'smsLabelValue, smsLegend, smsPercentTotal, smsLabelPercentTotal, smsXValue');
+ AddEnum('TAxisLabelStyle', 'talAuto, talNone, talValue, talMark, talText');
+ AddEnum('THorizAxis', 'aTopAxis, aBottomAxis');
+ AddEnum('TVertAxis', 'aLeftAxis, aRightAxis');
+ AddEnum('TTeeBackImageMode', 'pbmStretch, pbmTile, pbmCenter');
+ AddEnum('TPanningMode', 'pmNone, pmHorizontal, pmVertical, pmBoth');
+ AddEnum('TSeriesPointerStyle', 'psRectangle, psCircle, psTriangle, ' +
+ 'psDownTriangle, psCross, psDiagCross, psStar, psDiamond, psSmallDot');
+ AddEnum('TMultiArea', 'maNone, maStacked, maStacked100');
+ AddEnum('TMultiBar', 'mbNone, mbSide, mbStacked, mbStacked100');
+ AddEnum('TBarStyle', 'bsRectangle, bsPyramid, bsInvPyramid, bsCilinder, ' +
+ 'bsEllipse, bsArrow, bsRectGradient');
+
+ AddEnum('TPenEndStyle', 'esRound, esSquare, esFlat');
+ AddEnum('TPenMode', 'pmBlack, pmWhite, pmNop, pmNot, pmCopy, pmNotCopy, ' +
+ 'pmMergePenNot, pmMaskPenNot, pmMergeNotPen, pmMaskNotPen, pmMerge, ' +
+ 'pmNotMerge, pmMask, pmNotMask, pmXor, pmNotXor');
+ AddEnum('TPenStyle', 'psSolid, psDash, psDot, psDashDot, psDashDotDot, psClear, psInsideFrame');
+ AddClass(TChartValueList, 'TPersistent');
+ AddClass(TChartAxisTitle, 'TPersistent');
+ AddClass(TChartAxis, 'TPersistent');
+ AddClass(TCustomChartLegend, 'TPersistent');
+ AddClass(TChartLegend, 'TCustomChartLegend');
+ AddClass(TSeriesMarks, 'TPersistent');
+ AddClass(TChartGradient, 'TPersistent');
+ AddClass(TChartWall, 'TPersistent');
+ AddClass(TChartBrush, 'TBrush');
+ AddClass(TChartTitle, 'TPersistent');
+ AddClass(TView3DOptions, 'TPersistent');
+ AddClass(TChartPen, 'TComponent');
+ with AddClass(TChartSeries, 'TComponent') do
+ begin
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure Delete(Index: Integer)', CallMethod);
+ AddMethod('function Count: Integer', CallMethod);
+ AddMethod('procedure Add(const AValue: Double; const ALabel: String; AColor: TColor)', CallMethod);
+ AddProperty('Active','Boolean', GetProp, SetProp);
+ AddProperty('ColorEachPoint','Boolean', GetProp, SetProp);
+
+ end;
+ AddClass(TSeriesPointer, 'TPersistent');
+ AddClass(TCustomSeries, 'TChartSeries');
+ AddClass(TLineSeries, 'TCustomSeries');
+ AddClass(TPointSeries, 'TCustomSeries');
+ AddClass(TAreaSeries, 'TCustomSeries');
+ with AddClass(TCustomBarSeries, 'TChartSeries') do
+ begin
+ AddProperty('Title','String', GetProp, SetProp);
+ end;
+ AddClass(TBarSeries, 'TCustomBarSeries');
+ AddClass(THorizBarSeries, 'TCustomBarSeries');
+ AddClass(TCircledSeries, 'TChartSeries');
+ AddClass(TPieSeries, 'TCircledSeries');
+ AddClass(TFastLineSeries, 'TChartSeries');
+ AddClass(TCustomChart, 'TWinControl');
+ AddClass(TChart, 'TCustomChart');
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TChartSeries then
+ begin
+ if MethodName = 'CLEAR' then
+ TChartSeries(Instance).Clear
+ else if MethodName = 'ADD' then
+ TChartSeries(Instance).Add(Caller.Params[0], String(Caller.Params[1]), Caller.Params[2])
+ else if MethodName = 'DELETE' then
+ TChartSeries(Instance).Delete(Caller.Params[0])
+ else if MethodName = 'COUNT' then
+ Result := TChartSeries(Instance).Count
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TChartSeries then
+ begin
+ if PropName = 'ACTIVE' then
+ Result := TChartSeries(Instance).Active
+ else if PropName = 'COLOREACHPOINT' then
+ Result := TChartSeries(Instance).ColorEachPoint
+ end else
+ if ClassType = TCustomBarSeries then
+ begin
+ if PropName = 'Title' then
+ Result := TCustomBarSeries(Instance).Title
+ end;
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TChartSeries then
+ begin
+ if PropName = 'ACTIVE' then
+ TChartSeries(Instance).Active := Value
+ else if PropName = 'COLOREACHPOINT' then
+ TChartSeries(Instance).ColorEachPoint := Value
+ end else
+ if ClassType = TCustomBarSeries then
+ begin
+ if PropName = 'Title' then
+ TCustomBarSeries(Instance).Title := Value
+ end
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsChartRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/FMX.fs_iclassesrtti.pas b/LibD28/FMX.fs_iclassesrtti.pas
new file mode 100644
index 0000000..97fd2ec
--- /dev/null
+++ b/LibD28/FMX.fs_iclassesrtti.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Classes.pas classes and functions }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iclassesrtti;
+{$i FMX.inc}
+{$i fs_iclassesrtti.pas}
\ No newline at end of file
diff --git a/LibD28/FMX.fs_iconst.pas b/LibD28/FMX.fs_iconst.pas
new file mode 100644
index 0000000..c23d7cf
--- /dev/null
+++ b/LibD28/FMX.fs_iconst.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Resources }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iconst;
+{$i FMX.inc}
+{$i fs_iconst.pas}
\ No newline at end of file
diff --git a/LibD28/FMX.fs_icpp.pas b/LibD28/FMX.fs_icpp.pas
new file mode 100644
index 0000000..64a3c70
--- /dev/null
+++ b/LibD28/FMX.fs_icpp.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ C++ grammar }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_icpp;
+{$i FMX.inc}
+{$i fs_icpp.pas}
\ No newline at end of file
diff --git a/LibD28/FMX.fs_idbrtti.pas b/LibD28/FMX.fs_idbrtti.pas
new file mode 100644
index 0000000..dbb1620
--- /dev/null
+++ b/LibD28/FMX.fs_idbrtti.pas
@@ -0,0 +1,570 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ DB.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_idbrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.Types, System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_itools, FMX.fs_iclassesrtti, FMX.fs_ievents,
+ Data.DB, FMX.Types;
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsDBRTTI = class(TComponent); // fake component
+
+ TfsDatasetNotifyEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Dataset: TDataset);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsFilterRecordEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(DataSet: TDataSet; var Accept: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsFieldGetTextEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TField; var Text: String; DisplayText: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TfsDatasetNotifyEvent }
+
+procedure TfsDatasetNotifyEvent.DoEvent(Dataset: TDataset);
+begin
+ CallHandler([Dataset]);
+end;
+
+function TfsDatasetNotifyEvent.GetMethod: Pointer;
+begin
+ Result := @TfsDatasetNotifyEvent.DoEvent;
+end;
+
+
+{ TfsFilterRecordEvent }
+
+procedure TfsFilterRecordEvent.DoEvent(DataSet: TDataSet; var Accept: Boolean);
+begin
+ CallHandler([DataSet, Accept]);
+ Accept := Handler.Params[1].Value;
+end;
+
+function TfsFilterRecordEvent.GetMethod: Pointer;
+begin
+ Result := @TfsFilterRecordEvent.DoEvent;
+end;
+
+
+{ TfsFieldGetTextEvent }
+
+procedure TfsFieldGetTextEvent.DoEvent(Sender: TField; var Text: String; DisplayText: Boolean);
+begin
+ CallHandler([Sender, Text, DisplayText]);
+ Text := Handler.Params[1].Value;
+end;
+
+function TfsFieldGetTextEvent.GetMethod: Pointer;
+begin
+ Result := @TfsFieldGetTextEvent.DoEvent;
+end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TFieldType', 'ftUnknown, ftString, ftSmallint, ftInteger, ftWord,' +
+ 'ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,' +
+ 'ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,' +
+ 'ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString,' +
+ 'ftLargeint, ftADT, ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob,' +
+ 'ftVariant, ftInterface, ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd');
+ AddEnum('TBlobStreamMode', 'bmRead, bmWrite, bmReadWrite');
+ AddEnumSet('TLocateOptions', 'loCaseInsensitive, loPartialKey');
+ AddEnumSet('TFilterOptions', 'foCaseInsensitive, foNoPartialCompare');
+ AddEnum('TParamType', 'ptUnknown, ptInput, ptOutput, ptInputOutput, ptResult');
+
+ with AddClass(TField, 'TComponent') do
+ begin
+ AddProperty('AsBoolean', 'Boolean', GetProp, SetProp);
+ AddProperty('AsCurrency', 'Currency', GetProp, SetProp);
+ AddProperty('AsDateTime', 'TDateTime', GetProp, SetProp);
+ AddProperty('AsFloat', 'Double', GetProp, SetProp);
+ AddProperty('AsInteger', 'Integer', GetProp, SetProp);
+ AddProperty('AsString', 'String', GetProp, SetProp);
+ AddProperty('AsVariant', 'Variant', GetProp, SetProp);
+ AddProperty('DataType', 'TFieldType', GetProp, nil);
+ AddProperty('DisplayName', 'String', GetProp, nil);
+ AddProperty('DisplayText', 'String', GetProp, nil);
+ AddProperty('IsNull', 'Boolean', GetProp, nil);
+ AddProperty('Size', 'Integer', GetProp, SetProp);
+ AddProperty('Value', 'Variant', GetProp, SetProp);
+ AddProperty('OldValue', 'Variant', GetProp, nil);
+ AddEvent('OnGetText', TfsFieldGetTextEvent);
+ end;
+ with AddClass(TFields, 'TObject') do
+ AddDefaultProperty('Fields', 'Integer', 'TField', CallMethod, True);
+ AddClass(TStringField, 'TField');
+ AddClass(TNumericField, 'TField');
+ AddClass(TIntegerField, 'TNumericField');
+ AddClass(TSmallIntField, 'TIntegerField');
+ AddClass(TWordField, 'TIntegerField');
+ AddClass(TAutoIncField, 'TIntegerField');
+ AddClass(TFloatField, 'TNumericField');
+ AddClass(TCurrencyField, 'TFloatField');
+ AddClass(TBooleanField, 'TField');
+ AddClass(TDateTimeField, 'TField');
+ AddClass(TDateField, 'TDateTimeField');
+ AddClass(TTimeField, 'TDateTimeField');
+ AddClass(TBinaryField, 'TField');
+ AddClass(TBytesField, 'TBinaryField');
+ AddClass(TVarBytesField, 'TBinaryField');
+ AddClass(TBCDField, 'TNumericField');
+ with AddClass(TBlobField, 'TField') do
+ begin
+ AddMethod('procedure LoadFromFile(const FileName: String)', CallMethod);
+ AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure SaveToFile(const FileName: String)', CallMethod);
+ AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
+ end;
+ AddClass(TMemoField, 'TBlobField');
+ AddClass(TGraphicField, 'TBlobField');
+ AddClass(TFieldDef, 'TPersistent');
+ with AddClass(TFieldDefs, 'TObject') do
+ begin
+ AddMethod('function AddFieldDef: TFieldDef', CallMethod);
+ AddMethod('function Find(const Name: string): TFieldDef', CallMethod);
+ AddMethod('procedure Add(const Name: string; DataType: TFieldType; Size: Word; Required: Boolean)', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure Update', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TFieldDef', CallMethod, True);
+ end;
+ AddClass(TDataSource, 'TComponent');
+ AddType('TBookmark', fvtVariant);
+ with AddClass(TDataSet, 'TComponent') do
+ begin
+ AddMethod('procedure Open', CallMethod);
+ AddMethod('procedure Close', CallMethod);
+ AddMethod('procedure First', CallMethod);
+ AddMethod('procedure Last', CallMethod);
+ AddMethod('procedure Next', CallMethod);
+ AddMethod('procedure Prior', CallMethod);
+ AddMethod('procedure Cancel', CallMethod);
+ AddMethod('procedure Delete', CallMethod);
+ AddMethod('procedure Post', CallMethod);
+ AddMethod('procedure Append', CallMethod);
+ AddMethod('procedure Insert', CallMethod);
+ AddMethod('procedure Edit', CallMethod);
+
+ AddMethod('function FieldByName(const FieldName: string): TField', CallMethod);
+ AddMethod('procedure GetFieldNames(List: TStrings)', CallMethod);
+ AddMethod('function FindFirst: Boolean', CallMethod);
+ AddMethod('function FindLast: Boolean', CallMethod);
+ AddMethod('function FindNext: Boolean', CallMethod);
+ AddMethod('function FindPrior: Boolean', CallMethod);
+ AddMethod('procedure FreeBookmark(Bookmark: TBookmark)', CallMethod);
+ AddMethod('function GetBookmark: TBookmark', CallMethod);
+ AddMethod('procedure GotoBookmark(Bookmark: TBookmark)', CallMethod);
+ AddMethod('function Locate(const KeyFields: string; const KeyValues: Variant;' +
+ 'Options: TLocateOptions): Boolean', CallMethod);
+ AddMethod('function IsEmpty: Boolean', CallMethod);
+ AddMethod('procedure EnableControls', CallMethod);
+ AddMethod('procedure DisableControls', CallMethod);
+
+ AddProperty('Bof', 'Boolean', GetProp, nil);
+ AddProperty('Eof', 'Boolean', GetProp, nil);
+ AddProperty('FieldCount', 'Integer', GetProp, nil);
+ AddProperty('FieldDefs', 'TFieldDefs', GetProp, nil);
+ AddProperty('Fields', 'TFields', GetProp, nil);
+ AddProperty('Filter', 'string', GetProp, SetProp);
+ AddProperty('Filtered', 'Boolean', GetProp, SetProp);
+ AddProperty('FilterOptions', 'TFilterOptions', GetProp, SetProp);
+ AddProperty('Active', 'Boolean', GetProp, SetProp);
+
+ AddEvent('BeforeOpen', TfsDatasetNotifyEvent);
+ AddEvent('AfterOpen', TfsDatasetNotifyEvent);
+ AddEvent('BeforeClose', TfsDatasetNotifyEvent);
+ AddEvent('AfterClose', TfsDatasetNotifyEvent);
+ AddEvent('BeforeInsert', TfsDatasetNotifyEvent);
+ AddEvent('AfterInsert', TfsDatasetNotifyEvent);
+ AddEvent('BeforeEdit', TfsDatasetNotifyEvent);
+ AddEvent('AfterEdit', TfsDatasetNotifyEvent);
+ AddEvent('BeforePost', TfsDatasetNotifyEvent);
+ AddEvent('AfterPost', TfsDatasetNotifyEvent);
+ AddEvent('BeforeCancel', TfsDatasetNotifyEvent);
+ AddEvent('AfterCancel', TfsDatasetNotifyEvent);
+ AddEvent('BeforeDelete', TfsDatasetNotifyEvent);
+ AddEvent('AfterDelete', TfsDatasetNotifyEvent);
+ AddEvent('BeforeScroll', TfsDatasetNotifyEvent);
+ AddEvent('AfterScroll', TfsDatasetNotifyEvent);
+ AddEvent('OnCalcFields', TfsDatasetNotifyEvent);
+ AddEvent('OnFilterRecord', TfsFilterRecordEvent);
+ AddEvent('OnNewRecord', TfsDatasetNotifyEvent);
+ end;
+
+ with AddClass(TParam, 'TPersistent') do
+ begin
+ AddMethod('procedure Clear', CallMethod);
+ AddProperty('AsBoolean', 'Boolean', GetProp, SetProp);
+ AddProperty('AsCurrency', 'Currency', GetProp, SetProp);
+ AddProperty('AsDateTime', 'TDateTime', GetProp, SetProp);
+ AddProperty('AsFloat', 'Double', GetProp, SetProp);
+ AddProperty('AsInteger', 'Integer', GetProp, SetProp);
+ AddProperty('AsDate', 'TDate', GetProp, SetProp);
+ AddProperty('AsTime', 'TTime', GetProp, SetProp);
+ AddProperty('AsString', 'String', GetProp, SetProp);
+ AddProperty('Bound', 'Boolean', GetProp, SetProp);
+ AddProperty('IsNull', 'Boolean', GetProp, nil);
+ AddProperty('Text', 'String', GetProp, SetProp);
+ end;
+ with AddClass(TParams, 'TPersistent') do
+ begin
+ AddMethod('function ParamByName(const Value: string): TParam', CallMethod);
+ AddMethod('function FindParam(const Value: string): TParam', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TParam', CallMethod, True);
+ end;
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ _TDataSet: TDataSet;
+
+ function IntToLocateOptions(i: Integer): TLocateOptions;
+ begin
+ Result := [];
+ if (i and 1) <> 0 then
+ Result := Result + [loCaseInsensitive];
+ if (i and 2) <> 0 then
+ Result := Result + [loPartialKey];
+ end;
+
+begin
+ Result := 0;
+
+ if ClassType = TFields then
+ begin
+ if MethodName = 'FIELDS.GET' then
+ Result := frxInteger(TFields(Instance)[Caller.Params[0]])
+ end
+ else if ClassType = TFieldDefs then
+ begin
+ if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TFieldDefs(Instance)[Caller.Params[0]])
+ else if MethodName = 'ADD' then
+ TFieldDefs(Instance).Add(Caller.Params[0], TFieldType(Caller.Params[1]), Caller.Params[2], Caller.Params[3])
+ else if MethodName = 'ADDFIELDDEF' then
+ Result := frxInteger(TFieldDefs(Instance).AddFieldDef)
+ else if MethodName = 'CLEAR' then
+ TFieldDefs(Instance).Clear
+ else if MethodName = 'FIND' then
+ Result := frxInteger(TFieldDefs(Instance).Find(Caller.Params[0]))
+ else if MethodName = 'UPDATE' then
+ TFieldDefs(Instance).Update
+ end
+ else if ClassType = TBlobField then
+ begin
+ if MethodName = 'LOADFROMFILE' then
+ TBlobField(Instance).LoadFromFile(Caller.Params[0])
+ else if MethodName = 'LOADFROMSTREAM' then
+ TBlobField(Instance).LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVETOFILE' then
+ TBlobField(Instance).SaveToFile(Caller.Params[0])
+ else if MethodName = 'SAVETOSTREAM' then
+ TBlobField(Instance).SaveToStream(TStream(frxInteger(Caller.Params[0])))
+ end
+ else if ClassType = TDataSet then
+ begin
+ _TDataSet := TDataSet(Instance);
+ if MethodName = 'OPEN' then
+ _TDataSet.Open
+ else if MethodName = 'CLOSE' then
+ _TDataSet.Close
+ else if MethodName = 'FIRST' then
+ _TDataSet.First
+ else if MethodName = 'LAST' then
+ _TDataSet.Last
+ else if MethodName = 'NEXT' then
+ _TDataSet.Next
+ else if MethodName = 'PRIOR' then
+ _TDataSet.Prior
+ else if MethodName = 'CANCEL' then
+ _TDataSet.Cancel
+ else if MethodName = 'DELETE' then
+ _TDataSet.Delete
+ else if MethodName = 'POST' then
+ _TDataSet.Post
+ else if MethodName = 'APPEND' then
+ _TDataSet.Append
+ else if MethodName = 'INSERT' then
+ _TDataSet.Insert
+ else if MethodName = 'EDIT' then
+ _TDataSet.Edit
+ else if MethodName = 'FIELDBYNAME' then
+ Result := frxInteger(_TDataSet.FieldByName(Caller.Params[0]))
+ else if MethodName = 'GETFIELDNAMES' then
+ _TDataSet.GetFieldNames(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'FINDFIRST' then
+ Result := _TDataSet.FindFirst
+ else if MethodName = 'FINDLAST' then
+ Result := _TDataSet.FindLast
+ else if MethodName = 'FINDNEXT' then
+ Result := _TDataSet.FindNext
+ else if MethodName = 'FINDPRIOR' then
+ Result := _TDataSet.FindPrior
+ else if MethodName = 'FREEBOOKMARK' then
+ _TDataSet.FreeBookmark(TBookMark(frxInteger(Caller.Params[0])))
+{$IFNDEF CPUX64}
+ else if MethodName = 'GETBOOKMARK' then
+ Result := frxInteger(_TDataSet.GetBookmark)
+{$ENDIF}
+ else if MethodName = 'GOTOBOOKMARK' then
+ _TDataSet.GotoBookmark(TBookMark(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LOCATE' then
+ Result := _TDataSet.Locate(Caller.Params[0], Caller.Params[1], IntToLocateOptions(Caller.Params[2]))
+ else if MethodName = 'ISEMPTY' then
+ Result := _TDataSet.IsEmpty
+ else if MethodName = 'ENABLECONTROLS' then
+ _TDataSet.EnableControls
+ else if MethodName = 'DISABLECONTROLS' then
+ _TDataSet.DisableControls
+ end
+ else if ClassType = TParam then
+ begin
+ if MethodName = 'CLEAR' then
+ TParam(Instance).Clear
+ end
+ else if ClassType = TParams then
+ begin
+ if MethodName = 'PARAMBYNAME' then
+ Result := frxInteger(TParams(Instance).ParamByName(Caller.Params[0]))
+ else if MethodName = 'FINDPARAM' then
+ Result := frxInteger(TParams(Instance).FindParam(Caller.Params[0]))
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TParams(Instance)[Caller.Params[0]])
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+var
+ _TField: TField;
+ _TParam: TParam;
+ _TDataSet: TDataSet;
+
+ function FilterOptionsToInt(f: TFilterOptions): Integer;
+ begin
+ Result := 0;
+ if foCaseInsensitive in f then
+ Result := Result or 1;
+ if foNoPartialCompare in f then
+ Result := Result or 2;
+ end;
+
+begin
+ Result := 0;
+
+ if ClassType = TField then
+ begin
+ _TField := TField(Instance);
+ if PropName = 'ASBOOLEAN' then
+ Result := _TField.AsBoolean
+ else if PropName = 'ASCURRENCY' then
+ Result := _TField.AsCurrency
+ else if PropName = 'ASDATETIME' then
+ Result := _TField.AsDateTime
+ else if PropName = 'ASFLOAT' then
+ Result := _TField.AsFloat
+ else if PropName = 'ASINTEGER' then
+ Result := _TField.AsInteger
+ else if PropName = 'ASSTRING' then
+ Result := _TField.AsString
+ else if PropName = 'ASVARIANT' then
+ Result := _TField.AsVariant
+ else if PropName = 'DATATYPE' then
+ Result := _TField.DataType
+ else if PropName = 'DISPLAYNAME' then
+ Result := _TField.DisplayName
+ else if PropName = 'DISPLAYTEXT' then
+ Result := _TField.DisplayText
+ else if PropName = 'ISNULL' then
+ Result := _TField.IsNull
+ else if PropName = 'SIZE' then
+ Result := _TField.Size
+ else if PropName = 'VALUE' then
+ Result := _TField.Value
+ else if PropName = 'OLDVALUE' then
+ Result := _TField.OldValue
+ end
+ else if ClassType = TDataSet then
+ begin
+ _TDataSet := TDataSet(Instance);
+ if PropName = 'BOF' then
+ Result := _TDataSet.Bof
+ else if PropName = 'EOF' then
+ Result := _TDataSet.Eof
+ else if PropName = 'FIELDCOUNT' then
+ Result := _TDataSet.FieldCount
+ else if PropName = 'FIELDDEFS' then
+ Result := frxInteger(_TDataSet.FieldDefs)
+ else if PropName = 'FIELDS' then
+ Result := frxInteger(_TDataSet.Fields)
+ else if PropName = 'FILTER' then
+ Result := _TDataSet.Filter
+ else if PropName = 'FILTERED' then
+ Result := _TDataSet.Filtered
+ else if PropName = 'FILTEROPTIONS' then
+ Result := FilterOptionsToInt(_TDataSet.FilterOptions)
+ else if PropName = 'ACTIVE' then
+ Result := _TDataSet.Active
+ end
+ else if ClassType = TParam then
+ begin
+ _TParam := TParam(Instance);
+ if PropName = 'BOUND' then
+ Result := _TParam.Bound
+ else if PropName = 'ISNULL' then
+ Result := _TParam.IsNull
+ else if PropName = 'TEXT' then
+ Result := _TParam.Text
+ else if PropName = 'ASBOOLEAN' then
+ Result := _TParam.AsBoolean
+ else if PropName = 'ASCURRENCY' then
+ Result := _TParam.AsCurrency
+ else if PropName = 'ASDATETIME' then
+ Result := _TParam.AsDateTime
+ else if PropName = 'ASFLOAT' then
+ Result := _TParam.AsFloat
+ else if PropName = 'ASINTEGER' then
+ Result := _TParam.AsInteger
+ else if PropName = 'ASDATE' then
+ Result := _TParam.AsDate
+ else if PropName = 'ASTIME' then
+ Result := _TParam.AsTime
+ else if PropName = 'ASSTRING' then
+ Result := _TParam.AsString
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+var
+ _TField: TField;
+ _TParam: TParam;
+ _TDataSet: TDataSet;
+
+ function IntToFilterOptions(i: Integer): TFilterOptions;
+ begin
+ Result := [];
+ if (i and 1) <> 0 then
+ Result := Result + [foCaseInsensitive];
+ if (i and 2) <> 0 then
+ Result := Result + [foNoPartialCompare];
+ end;
+
+begin
+ if ClassType = TField then
+ begin
+ _TField := TField(Instance);
+ if PropName = 'ASBOOLEAN' then
+ _TField.AsBoolean := Value
+ else if PropName = 'ASCURRENCY' then
+ _TField.AsCurrency := Value
+ else if PropName = 'ASDATETIME' then
+ _TField.AsDateTime := Value
+ else if PropName = 'ASFLOAT' then
+ _TField.AsFloat := Value
+ else if PropName = 'ASINTEGER' then
+ _TField.AsInteger := Value
+ else if PropName = 'ASSTRING' then
+ _TField.AsString := Value
+ else if PropName = 'ASVARIANT' then
+ _TField.AsVariant := Value
+ else if PropName = 'VALUE' then
+ _TField.Value := Value
+ else if PropName = 'SIZE' then
+ _TField.Size := Value
+ end
+ else if ClassType = TDataSet then
+ begin
+ _TDataSet := TDataSet(Instance);
+ if PropName = 'FILTER' then
+ _TDataSet.Filter := Value
+ else if PropName = 'FILTERED' then
+ _TDataSet.Filtered := Value
+ else if PropName = 'FILTEROPTIONS' then
+ _TDataSet.FilterOptions := IntToFilterOptions(Value)
+ else if PropName = 'ACTIVE' then
+ _TDataSet.Active := Value
+ end
+ else if ClassType = TParam then
+ begin
+ _TParam := TParam(Instance);
+ if PropName = 'ASBOOLEAN' then
+ _TParam.AsBoolean := Value
+ else if PropName = 'ASCURRENCY' then
+ _TParam.AsCurrency := Value
+ else if PropName = 'ASDATETIME' then
+ _TParam.AsDateTime := Value
+ else if PropName = 'ASFLOAT' then
+ _TParam.AsFloat := Value
+ else if PropName = 'ASINTEGER' then
+ _TParam.AsInteger := Value
+ else if PropName = 'ASDATE' then
+ _TParam.AsDate := Value
+ else if PropName = 'ASTIME' then
+ _TParam.AsTime := Value
+ else if PropName = 'ASSTRING' then
+ _TParam.AsString := Value
+ else if PropName = 'BOUND' then
+ _TParam.Bound := Value
+ else if PropName = 'TEXT' then
+ _TParam.Text := Value
+ end
+end;
+
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsDBRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/FMX.fs_idialogsrtti.pas b/LibD28/FMX.fs_idialogsrtti.pas
new file mode 100644
index 0000000..0d12fba
--- /dev/null
+++ b/LibD28/FMX.fs_idialogsrtti.pas
@@ -0,0 +1,133 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Dialogs.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_idialogsrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_iclassesrtti, FMX.Types
+, FMX.Dialogs, System.UITypes, System.Types
+{$IFDEF DELPHI19}
+, FMX.Printer
+{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsDialogsRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ THackDialog = class(TCommonDialog);
+
+
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+type
+ TWordSet = set of 0..15;
+ PWordSet = ^TWordSet;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+var
+ dlg: String;
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnumSet('TOpenOptions', 'ofReadOnly, ofOverwritePrompt, ofHideReadOnly,' +
+ 'ofNoChangeDir, ofShowHelp, ofNoValidate, ofAllowMultiSelect,' +
+ 'ofExtensionDifferent, ofPathMustExist, ofFileMustExist, ofCreatePrompt,' +
+ 'ofShareAware, ofNoReadOnlyReturn, ofNoTestFileCreate, ofNoNetworkButton,' +
+ 'ofNoLongNames, ofOldStyleDialog, ofNoDereferenceLinks, ofEnableIncludeNotify,' +
+ 'ofEnableSizing');
+ AddEnum('TFileEditStyle', 'fsEdit, fsComboBox');
+ AddEnumSet('TColorDialogOptions', 'cdFullOpen, cdPreventFullOpen, cdShowHelp,' +
+ 'cdSolidColor, cdAnyColor');
+ AddEnumSet('TFontDialogOptions', 'fdAnsiOnly, fdTrueTypeOnly, fdEffects,' +
+ 'fdFixedPitchOnly, fdForceFontExist, fdNoFaceSel, fdNoOEMFonts,' +
+ 'fdNoSimulations, fdNoSizeSel, fdNoStyleSel, fdNoVectorFonts,' +
+ 'fdShowHelp, fdWysiwyg, fdLimitSize, fdScalableOnly, fdApplyButton');
+ AddEnum('TFontDialogDevice', 'fdScreen, fdPrinter, fdBoth');
+ AddEnum('TPrintRange', 'prAllPages, prSelection, prPageNums');
+ AddEnumSet('TPrintDialogOptions', 'poPrintToFile, poPageNums, poSelection,' +
+ 'poWarning, poHelp, poDisablePrintToFile');
+ AddEnum('TMsgDlgType', 'mtCustom, mtInformation, mtWarning, mtError, mtConfirmation');
+ AddEnumSet('TMsgDlgButtons', 'mbNone, mbOk, mbCancel, mbYes, mbNo, mbAbort, ' +
+ 'mbRetry, mbIgnore');
+
+
+ with AddClass(TCommonDialog, 'TComponent') do
+ AddMethod('function Execute: Boolean', CallMethod);
+ AddClass(TOpenDialog, 'TCommonDialog');
+ AddClass(TSaveDialog, 'TCommonDialog');
+ AddClass(TPrintDialog, dlg);
+ AddClass(TPrinterSetupDialog, dlg);
+
+ AddMethod('function MessageDlg(Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer', CallMethod, 'ctOther');
+ AddMethod('function InputBox(ACaption, APrompt, ADefault: string): string', CallMethod, 'ctOther');
+ AddMethod('function InputQuery(ACaption, APrompt: string; var Value: string): Boolean', CallMethod, 'ctOther');
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ s: String;
+ b: TMsgDlgButtons;
+begin
+ Result := 0;
+
+ if ClassType = TCommonDialog then
+ begin
+ if MethodName = 'EXECUTE' then
+ Result := THackDialog(Instance).Execute
+ end
+ else if MethodName = 'INPUTBOX' then
+ Result := InputBox(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'INPUTQUERY' then
+ begin
+ s := Caller.Params[2];
+ Result := InputQuery(Caller.Params[0], Caller.Params[1], s);
+ Caller.Params[2] := s;
+ end
+ else if MethodName = 'MESSAGEDLG' then
+ begin
+ Word(PWordSet(@b)^) := Caller.Params[2];
+ Result := MessageDlg(Caller.Params[0], Caller.Params[1], b, Caller.Params[3]);
+ end
+end;
+
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsDialogsRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
\ No newline at end of file
diff --git a/LibD28/FMX.fs_idisp.pas b/LibD28/FMX.fs_idisp.pas
new file mode 100644
index 0000000..3ce8fda
--- /dev/null
+++ b/LibD28/FMX.fs_idisp.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ OLE dispatch module }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_idisp;
+{$i FMX.inc}
+{$i fs_idisp.pas}
\ No newline at end of file
diff --git a/LibD28/FMX.fs_ievents.pas b/LibD28/FMX.fs_ievents.pas
new file mode 100644
index 0000000..2d6981e
--- /dev/null
+++ b/LibD28/FMX.fs_ievents.pas
@@ -0,0 +1,379 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Standard events }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_ievents;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Controls, FMX.Forms, System.UITypes, FMX.Types,
+ System.Types, System.Rtti, FMX.fs_iinterpreter, FMX.fs_iclassesrtti
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+type
+
+ PDragObject = ^TDragObject;
+ TfsDragObject = class(TPersistent)
+ private
+ FDragObject: TDragObject;
+ FFiles: TStringList;
+ function GetStringList: TStringList;
+ public
+ function GetRect: TDragObject;
+ function GetRectP: PDragObject;
+ constructor Create(aDragObj: TDragObject);
+ destructor Destroy; override;
+ published
+ property Source: TObject read FDragObject.Source write FDragObject.Source;
+ property Data: {$IFDEF Delphi17}TValue{$ELSE}Variant{$ENDIF} read FDragObject.Data write FDragObject.Data;
+ property Files: TStringList read GetStringList;
+ end;
+
+ TfsNotifyEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsMouseEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Single);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsMouseMoveEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; Shift: TShiftState; X, Y: Single);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsMouseWheelEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsOnPaintEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsCanFocusEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var ACanFocus: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsDragOverEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; const Data: TDragObject; const Point: TPointF; var Accept: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsDragDropEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsKeyEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsKeyPressEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var Key: Char);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsCloseEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var Action: TCloseAction);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsCloseQueryEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var CanClose: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsCanResizeEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var NewWidth, NewHeight: Integer;
+ var Resize: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+
+implementation
+
+
+type
+ TByteSet = set of 0..7;
+ PByteSet = ^TByteSet;
+
+
+{ TfsNotifyEvent }
+
+procedure TfsNotifyEvent.DoEvent(Sender: TObject);
+begin
+ CallHandler([Sender]);
+end;
+
+function TfsNotifyEvent.GetMethod: Pointer;
+begin
+ Result := @TfsNotifyEvent.DoEvent;
+end;
+
+{ TfsMouseEvent }
+
+procedure TfsMouseEvent.DoEvent(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Single);
+var
+ b: Byte;
+begin
+ b := Byte(PByteSet(@Shift)^);
+ CallHandler([Sender, Integer(Button), b, X, Y]);
+end;
+
+function TfsMouseEvent.GetMethod: Pointer;
+begin
+ Result := @TfsMouseEvent.DoEvent;
+end;
+
+{ TfsMouseMoveEvent }
+
+procedure TfsMouseMoveEvent.DoEvent(Sender: TObject; Shift: TShiftState; X,
+ Y: Single);
+var
+ b: Byte;
+begin
+ b := Byte(PByteSet(@Shift)^);
+ CallHandler([Sender, b, X, Y]);
+end;
+
+function TfsMouseMoveEvent.GetMethod: Pointer;
+begin
+ Result := @TfsMouseMoveEvent.DoEvent;
+end;
+
+{ TfsKeyEvent }
+
+procedure TfsKeyEvent.DoEvent(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+var
+ b: Byte;
+begin
+ b := Byte(PByteSet(@Shift)^);
+ CallHandler([Sender, Key, KeyChar, b]);
+ Key := Handler.Params[1].Value;
+ KeyChar := WideChar(Cardinal(Handler.Params[2].Value));
+end;
+
+function TfsKeyEvent.GetMethod: Pointer;
+begin
+ Result := @TfsKeyEvent.DoEvent;
+end;
+
+{ TfsKeyPressEvent }
+
+procedure TfsKeyPressEvent.DoEvent(Sender: TObject; var Key: Char);
+begin
+ CallHandler([Sender, Key]);
+ Key := String(Handler.Params[1].Value)[1];
+end;
+
+function TfsKeyPressEvent.GetMethod: Pointer;
+begin
+ Result := @TfsKeyPressEvent.DoEvent;
+end;
+
+{ TfsCloseEvent }
+
+procedure TfsCloseEvent.DoEvent(Sender: TObject; var Action: TCloseAction);
+begin
+ CallHandler([Sender, Integer(Action)]);
+ Action := Handler.Params[1].Value;
+end;
+
+function TfsCloseEvent.GetMethod: Pointer;
+begin
+ Result := @TfsCloseEvent.DoEvent;
+end;
+
+{ TfsCloseQueryEvent }
+
+procedure TfsCloseQueryEvent.DoEvent(Sender: TObject; var CanClose: Boolean);
+begin
+ CallHandler([Sender, CanClose]);
+ CanClose := Handler.Params[1].Value;
+end;
+
+function TfsCloseQueryEvent.GetMethod: Pointer;
+begin
+ Result := @TfsCloseQueryEvent.DoEvent;
+end;
+
+{ TfsCanResizeEvent }
+
+procedure TfsCanResizeEvent.DoEvent(Sender: TObject; var NewWidth,
+ NewHeight: Integer; var Resize: Boolean);
+begin
+ CallHandler([Sender, NewWidth, NewHeight, Resize]);
+ NewWidth := Handler.Params[1].Value;
+ NewHeight := Handler.Params[2].Value;
+ Resize := Handler.Params[3].Value;
+end;
+
+function TfsCanResizeEvent.GetMethod: Pointer;
+begin
+ Result := @TfsCanResizeEvent.DoEvent;
+end;
+
+{ TfsMouseWheelEvent }
+
+procedure TfsMouseWheelEvent.DoEvent(Sender: TObject;
+ Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
+var
+ b: Byte;
+begin
+ b := Byte(PByteSet(@Shift)^);
+ CallHandler([Sender, b, WheelDelta, Boolean(Handled)]);
+ Handled := Handler.Params[3].Value;
+end;
+
+function TfsMouseWheelEvent.GetMethod: Pointer;
+begin
+ Result := @TfsMouseWheelEvent.DoEvent;
+end;
+
+{ TfsOnPaintEvent }
+
+procedure TfsOnPaintEvent.DoEvent(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF);
+var
+ r: TfsRectF;
+begin
+ r := TfsRectF.Create(ARect);
+ CallHandler([Sender, Canvas, r]);
+ r.Free;
+end;
+
+function TfsOnPaintEvent.GetMethod: Pointer;
+begin
+ Result := @TfsOnPaintEvent.DoEvent;
+end;
+
+{ TfsCanFocusEvent }
+
+procedure TfsCanFocusEvent.DoEvent(Sender: TObject; var ACanFocus: Boolean);
+begin
+ CallHandler([Sender, ACanFocus]);
+ ACanFocus := Handler.Params[1].Value;
+end;
+
+function TfsCanFocusEvent.GetMethod: Pointer;
+begin
+ Result := @TfsCanFocusEvent.DoEvent;
+end;
+
+{ TfsDragOverEvent }
+
+procedure TfsDragOverEvent.DoEvent(Sender: TObject; const Data: TDragObject;
+ const Point: TPointF; var Accept: Boolean);
+var
+ dObj: TfsDragObject;
+begin
+ dObj := TfsDragObject.Create(Data);
+ CallHandler([Sender, dObj, Accept]);
+ dObj.Free;
+ Accept := Handler.Params[3].Value;
+end;
+
+function TfsDragOverEvent.GetMethod: Pointer;
+begin
+ Result := @TfsDragOverEvent.DoEvent;
+end;
+
+{ TfsDragObject }
+
+constructor TfsDragObject.Create(aDragObj: TDragObject);
+var
+ idx: Integer;
+begin
+ FFiles := TStringList.Create;
+ FDragObject.Source := aDragObj.Source;
+ FDragObject.Data := aDragObj.Data;
+ for idx := Low(FDragObject.Files) to High(FDragObject.Files) do
+ FFiles.Add(FDragObject.Files[idx]);
+end;
+
+destructor TfsDragObject.Destroy;
+begin
+ FFiles.Free;
+ inherited;
+end;
+
+function TfsDragObject.GetRect: TDragObject;
+var
+ idx: Integer;
+begin
+ SetLength(FDragObject.Files, FFiles.Count);
+ for idx := 0 to FFiles.Count - 1 do
+ FDragObject.Files[idx] := FFiles.Strings[idx];
+ Result := FDragObject;
+end;
+
+function TfsDragObject.GetRectP: PDragObject;
+var
+ idx: Integer;
+begin
+ SetLength(FDragObject.Files, FFiles.Count);
+ for idx := 0 to FFiles.Count - 1 do
+ FDragObject.Files[idx] := FFiles.Strings[idx];
+ Result := @FDragObject;
+end;
+
+function TfsDragObject.GetStringList: TStringList;
+begin
+ Result := FFiles;
+end;
+
+{ TfsDragDropEvent }
+
+procedure TfsDragDropEvent.DoEvent(Sender: TObject; const Data: TDragObject;
+ const Point: TPointF);
+var
+ dObj: TfsDragObject;
+ aPoint: TfsPointF;
+begin
+ dObj := TfsDragObject.Create(Data);
+ aPoint := TfsPointF.Create(Point);
+ CallHandler([Sender, dObj, aPoint]);
+ dObj.Free;
+ aPoint.Free;
+end;
+
+function TfsDragDropEvent.GetMethod: Pointer;
+begin
+ Result := @TfsDragDropEvent.DoEvent;
+end;
+
+end.
\ No newline at end of file
diff --git a/LibD28/FMX.fs_iexpression.pas b/LibD28/FMX.fs_iexpression.pas
new file mode 100644
index 0000000..f429d38
--- /dev/null
+++ b/LibD28/FMX.fs_iexpression.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Expression parser }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iexpression;
+{$i FMX.inc}
+{$i fs_iexpression.pas}
\ No newline at end of file
diff --git a/LibD28/FMX.fs_iextctrlsrtti.pas b/LibD28/FMX.fs_iextctrlsrtti.pas
new file mode 100644
index 0000000..5bd17eb
--- /dev/null
+++ b/LibD28/FMX.fs_iextctrlsrtti.pas
@@ -0,0 +1,268 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ ExtCtrls }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iextctrlsrtti;
+
+interface
+
+{$i fs.inc}
+
+uses System.Types, System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_ievents, FMX.fs_iformsrtti
+, FMX.ExtCtrls, FMX.ListBox, FMX.Objects, System.UITypes, FMX.Types, FMX.Controls, FMX.Layouts,
+ FMX.TabControl, FMX.TreeView
+{$IFDEF DELPHI18}
+ , FMX.StdCtrls
+{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsExtCtrlsRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TfsTreeViewDragChange = class(TfsCustomEvent)
+ public
+ procedure DoEvent(SourceItem, DestItem: TTreeViewItem; var Allow: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TShapeType', 'stRectangle, stSquare, stRoundRect, stRoundSquare,' +
+ 'stEllipse, stCircle');
+ AddEnum('TBevelStyle', 'bsLowered, bsRaised');
+ AddEnum('TBevelShape', 'bsBox, bsFrame, bsTopLine, bsBottomLine, bsLeftLine,' +
+ 'bsRightLine, bsSpacer');
+ AddEnum('TResizeStyle', 'rsNone, rsLine, rsUpdate, rsPattern');
+ AddEnum('TButtonLayout', 'blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom');
+ AddEnum('TButtonState', 'bsUp, bsDisabled, bsDown, bsExclusive');
+ AddEnum('TButtonStyle', 'bsAutoDetect, bsWin31, bsNew');
+ AddEnum('TBitBtnKind', 'bkCustom, bkOK, bkCancel, bkHelp, bkYes, bkNo,' +
+ 'bkClose, bkAbort, bkRetry, bkIgnore, bkAll');
+ AddType('TNumGlyphs', fvtInt);
+ AddEnum('TTabPosition', 'tpTop, tpBottom, tpLeft, tpRight');
+ AddEnum('TTabStyle', 'tsTabs, tsButtons, tsFlatButtons');
+ AddEnum('TStatusPanelStyle', 'psText, psOwnerDraw');
+ AddEnum('TStatusPanelBevel', 'pbNone, pbLowered, pbRaised');
+ AddEnum('TSortType', 'stNone, stData, stText, stBoth');
+ AddEnum('TTrackBarOrientation', 'trHorizontal, trVertical');
+ AddEnum('TTickMark', 'tmBottomRight, tmTopLeft, tmBoth');
+ AddEnum('TTickStyle', 'tsNone, tsAuto, tsManual');
+ AddEnum('TProgressBarOrientation', 'pbHorizontal, pbVertical');
+ AddEnum('TIconArrangement', 'iaTop, iaLeft');
+ AddEnum('TListArrangement', 'arAlignBottom, arAlignLeft, arAlignRight,' +
+ 'arAlignTop, arDefault, arSnapToGrid');
+ AddEnum('TViewStyle', 'vsIcon, vsSmallIcon, vsList, vsReport');
+ AddEnum('TToolButtonStyle', 'tbsButton, tbsCheck, tbsDropDown, tbsSeparator, tbsDivider');
+ AddEnum('TDateTimeKind', 'dtkDate, dtkTime');
+ AddEnum('TDTDateMode', 'dmComboBox, dmUpDown');
+ AddEnum('TDTDateFormat', 'dfShort, dfLong');
+ AddEnum('TDTCalAlignment', 'dtaLeft, dtaRight');
+ AddEnum('TCalDayOfWeek', 'dowMonday, dowTuesday, dowWednesday, dowThursday,' +
+ 'dowFriday, dowSaturday, dowSunday, dowLocaleDefault');
+
+
+ with AddClass(TPaintBox, 'TControl') do
+ AddEvent('OnPaint', TfsNotifyEvent);
+ AddClass(TImage, 'TControl');
+ with AddClass(TTimer, 'TComponent') do
+ AddEvent('OnTimer', TfsNotifyEvent);
+
+ AddClass(TTabItem, 'TTextControl');
+ with AddClass(TTabControl, 'TStyledControl') do
+ begin
+ AddIndexProperty( 'Tabs', 'Integer', 'TTabItem', CallMethod);
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddProperty('TabCount', 'Integer', GetProp, nil);
+ AddProperty('ActiveTab', 'TTabItem', GetProp, SetProp);
+ end;
+
+ with AddClass(TTreeViewItem, 'TTextControl') do
+ begin
+ AddMethod('function ItemByPoint(const X, Y: Single): TTreeViewItem', CallMethod);
+ AddMethod('function ItemByIndex(const Idx: Integer): TTreeViewItem', CallMethod);
+ AddMethod('function TreeView: TCustomTreeView', CallMethod);
+ AddMethod('function Level: Integer', CallMethod);
+ AddMethod('function ParentItem: TTreeViewItem', CallMethod);
+ AddIndexProperty( 'Items', 'Integer', 'TTreeViewItem', CallMethod);
+ AddProperty('GlobalIndex', 'Integer', GetProp, SetProp);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ end;
+ with AddClass(TTreeView, 'TScrollBox') do
+ begin
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure CollapseAll', CallMethod);
+ AddMethod('procedure ExpandAll', CallMethod);
+ AddMethod('function ItemByText(const AText: string): TTreeViewItem', CallMethod);
+ AddMethod('function ItemByPoint(const X, Y: Single): TTreeViewItem', CallMethod);
+ AddMethod('function ItemByIndex(const Idx: Integer): TTreeViewItem', CallMethod);
+ AddMethod('function ItemByGlobalIndex(const Idx: Integer): TTreeViewItem', CallMethod);
+ AddIndexProperty('Items', 'Integer', 'TTreeViewItem', CallMethod);
+ AddProperty('Selected', 'TTreeViewItem', GetProp, SetProp);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddProperty('GlobalCount', 'Integer', GetProp, nil);
+ AddProperty('CountExpanded', 'Integer', GetProp, nil);
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddEvent('OnChangeCheck', TfsNotifyEvent);
+ AddEvent('OnDragChange', TfsTreeViewDragChange);
+ end;
+
+ { TODO ADD necessary methods for these calasses }
+ //AddClass(TCalendar, 'TStyledControl');
+ //AddClass(TCalendarBox, 'TTextControl');
+ // AddClass(TCalendarEdit, 'TCustomEdit');
+ AddClass(TImageViewer, 'TScrollBox');
+ AddClass(TPlotGrid, 'TControl');
+ AddClass(TDropTarget, 'TTextControl');
+ AddClass(TCornerButton, 'TCustomButton');
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+ if ClassType = TTabControl then
+ begin
+ if MethodName = 'TABS.GET' then
+ Result := frxInteger(TTabControl(Instance).Tabs[Caller.Params[0]])
+ end
+ else if ClassType = TTreeViewItem then
+ begin
+ if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TTreeViewItem(Instance).Items[Caller.Params[0]])
+ else if MethodName = 'ITEMBYPOINT' then
+ Result := frxInteger(TTreeViewItem(Instance).ItemByPoint(Single(Caller.Params[0]), Single(Caller.Params[1])))
+ else if MethodName = 'ITEMBYINDEX' then
+ Result := frxInteger(TTreeViewItem(Instance).ItemByIndex(Caller.Params[0]))
+ else if MethodName = 'TREEVIEW' then
+ Result := frxInteger(TTreeViewItem(Instance).TreeView)
+ else if MethodName = 'LEVEL' then
+ Result := Integer(TTreeViewItem(Instance).Level)
+ else if MethodName = 'PARENTITEM' then
+ Result := frxInteger(TTreeViewItem(Instance).ParentItem)
+ end
+ else if ClassType = TTreeView then
+ begin
+ if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TTreeView(Instance).Items[Caller.Params[0]])
+ else if MethodName = 'ITEMBYPOINT' then
+ Result := frxInteger(TTreeView(Instance).ItemByPoint(Single(Caller.Params[0]), Single(Caller.Params[1])))
+ else if MethodName = 'ITEMBYINDEX' then
+ Result := frxInteger(TTreeView(Instance).ItemByIndex(Caller.Params[0]))
+ else if MethodName = 'ITEMBYTEXT' then
+ Result := frxInteger(TTreeView(Instance).ItemByText(String(Caller.Params[0])))
+ else if MethodName = 'ITEMBYGLOBALINDEX' then
+ Result := frxInteger(TTreeView(Instance).ItemByGlobalIndex(Caller.Params[0]))
+ else if MethodName = 'CLEAR' then
+ TTreeView(Instance).Clear
+ else if MethodName = 'COLLAPSEALL' then
+ TTreeView(Instance).CollapseAll
+ else if MethodName = 'EXPANDALL' then
+ TTreeView(Instance).ExpandAll
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+ if ClassType = TTabControl then
+ begin
+ if PropName = 'TABCOUNT' then
+ Result := TTabControl(Instance).TabCount
+ else if PropName = 'ACTIVETAB' then
+ Result := frxInteger(TTabControl(Instance).ActiveTab)
+ end
+ else if ClassType = TTreeViewItem then
+ begin
+ if PropName = 'GLOBALINDEX' then
+ Result := TTreeViewItem(Instance).GlobalIndex
+ else if PropName = 'COUNT' then
+ Result := TTreeViewItem(Instance).Count
+ end
+ else if ClassType = TTreeView then
+ begin
+ if PropName = 'SELECTED' then
+ Result := frxInteger(TTreeView(Instance).Selected)
+ else if PropName = 'COUNT' then
+ Result := TTreeView(Instance).Count
+ else if PropName = 'GLOBALCOUNT' then
+ Result := TTreeView(Instance).GlobalCount
+ else if PropName = 'COUNTEXPANDED' then
+ Result := TTreeView(Instance).CountExpanded
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TTabControl then
+ begin
+ if PropName = 'ACTIVETAB' then
+ TTabControl(Instance).ActiveTab := TTabItem(frxInteger(Value))
+ end
+ else if ClassType = TTreeViewItem then
+ begin
+// if PropName = 'GLOBALINDEX' then
+// TTreeViewItem(Instance).GlobalIndex := Value
+ end
+ else if ClassType = TTreeView then
+ begin
+ if PropName = 'SELECTED' then
+ TTreeView(Instance).Selected := TTreeViewItem(frxInteger(Value))
+ end
+end;
+
+{ TfsTreeViewDragChange }
+
+procedure TfsTreeViewDragChange.DoEvent(SourceItem, DestItem: TTreeViewItem;
+ var Allow: Boolean);
+begin
+ CallHandler([SourceItem, DestItem, Allow]);
+ Allow := Handler.Params[2].Value;
+end;
+
+function TfsTreeViewDragChange.GetMethod: Pointer;
+begin
+ Result := @TfsTreeViewDragChange.DoEvent;
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsExtCtrlsRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/FMX.fs_iformsrtti.pas b/LibD28/FMX.fs_iformsrtti.pas
new file mode 100644
index 0000000..28da4fa
--- /dev/null
+++ b/LibD28/FMX.fs_iformsrtti.pas
@@ -0,0 +1,864 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Forms and StdCtrls }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iformsrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_ievents, FMX.fs_iclassesrtti,
+ FMX.fs_igraphicsrtti, FMX.Types, FMX.Controls, FMX.Forms, System.UITypes, System.Types,
+ FMX.Edit, FMX.Memo, FMX.ListBox, FMX.Layouts
+{$IFDEF DELPHI18}
+ , FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI29}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF}
+ ;
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsFormsRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddConst('mrNone', 'Integer', mrNone);
+ AddConst('mrOk', 'Integer', mrOk);
+ AddConst('mrCancel', 'Integer', mrCancel);
+ AddConst('mrAbort', 'Integer', mrAbort);
+ AddConst('mrRetry', 'Integer', mrRetry);
+ AddConst('mrIgnore', 'Integer', mrIgnore);
+ AddConst('mrYes', 'Integer', mrYes);
+ AddConst('mrNo', 'Integer', mrNo);
+ AddConst('mrAll', 'Integer', mrAll);
+ AddConst('mrNoToAll', 'Integer', mrNoToAll);
+ AddConst('mrYesToAll', 'Integer', mrYesToAll);
+
+ AddConst('crDefault', 'Integer', crDefault);
+ AddConst('crNone', 'Integer', crNone);
+ AddConst('crArrow', 'Integer', crArrow);
+ AddConst('crCross', 'Integer', crCross);
+ AddConst('crIBeam', 'Integer', crIBeam);
+ AddConst('crSize', 'Integer', crSize);
+ AddConst('crSizeNESW', 'Integer', crSizeNESW);
+ AddConst('crSizeNS', 'Integer', crSizeNS);
+ AddConst('crSizeNWSE', 'Integer', crSizeNWSE);
+ AddConst('crSizeWE', 'Integer', crSizeWE);
+ AddConst('crUpArrow', 'Integer', crUpArrow);
+ AddConst('crHourGlass', 'Integer', crHourGlass);
+ AddConst('crDrag', 'Integer', crDrag);
+ AddConst('crNoDrop', 'Integer', crNoDrop);
+ AddConst('crHSplit', 'Integer', crHSplit);
+ AddConst('crVSplit', 'Integer', crVSplit);
+ AddConst('crMultiDrag', 'Integer', crMultiDrag);
+ AddConst('crSQLWait', 'Integer', crSQLWait);
+ AddConst('crNo', 'Integer', crNo);
+ AddConst('crAppStart', 'Integer', crAppStart);
+ AddConst('crHelp', 'Integer', crHelp);
+ AddConst('crHandPoint', 'Integer', crHandPoint);
+ AddConst('crSizeAll', 'Integer', crSizeAll);
+
+{$IFDEF CLX}
+ AddConst('bsNone', 'Integer', fbsNone);
+ AddConst('bsSingle', 'Integer', fbsSingle);
+ AddConst('bsSizeable', 'Integer', fbsSizeable);
+ AddConst('bsDialog', 'Integer', fbsDialog);
+ AddConst('bsToolWindow', 'Integer', fbsToolWindow);
+ AddConst('bsSizeToolWin', 'Integer', fbsSizeToolWin);
+{$ELSE}
+ AddConst('bsNone', 'Integer', TFmxFormBorderStyle.bsNone);
+ AddConst('bsSingle', 'Integer', TFmxFormBorderStyle.bsSingle);
+ AddConst('bsSizeable', 'Integer', TFmxFormBorderStyle.bsSizeable);
+ AddConst('bsToolWindow', 'Integer', TFmxFormBorderStyle.bsToolWindow);
+ AddConst('bsSizeToolWin', 'Integer', TFmxFormBorderStyle.bsSizeToolWin);
+{$ENDIF}
+
+ AddConst('VK_RBUTTON', 'Integer', VKRBUTTON);
+ AddConst('VKCANCEL', 'Integer', VKCANCEL);
+ AddConst('VKMBUTTON', 'Integer', VKMBUTTON);
+ AddConst('VKBACK', 'Integer', VKBACK);//Backspace key
+ AddConst('VKTAB', 'Integer', VKTAB);//Tab key
+ AddConst('VKRETURN', 'Integer', VKRETURN);//Enter key
+ AddConst('VKSHIFT', 'Integer', VKSHIFT);//Shift key
+ AddConst('VKCONTROL', 'Integer', VKCONTROL);//Ctrl key
+ AddConst('VKMENU', 'Integer', VKMENU);//Alt key
+ AddConst('VKPAUSE', 'Integer', VKPAUSE);//Pause key
+ AddConst('VKCAPITAL', 'Integer', VKCAPITAL);//Caps Lock key
+ AddConst('VKESCAPE', 'Integer', VKESCAPE);//Esc key
+ AddConst('VKSPACE', 'Integer', VKSPACE);//Space bar
+ AddConst('VKPRIOR', 'Integer', VKPRIOR);//Page Up key
+ AddConst('VKNEXT', 'Integer', VKNEXT);// Page Down key
+ AddConst('VKEND', 'Integer', VKEND);// End key
+ AddConst('VKHOME', 'Integer', VKHOME);// Home key
+ AddConst('VKLEFT', 'Integer', VKLEFT);// Left Arrow key
+ AddConst('VKUP', 'Integer', VKUP);// Up Arrow key
+ AddConst('VKRIGHT', 'Integer', VKRIGHT);// Right Arrow key
+ AddConst('VKDOWN', 'Integer', VKDOWN);// Down Arrow key
+ AddConst('VKINSERT', 'Integer', VKINSERT);// Insert key
+ AddConst('VKDELETE', 'Integer', VKDELETE);// Delete key
+ AddConst('VKHELP', 'Integer', VKHELP);// Help key
+ AddConst('VKLWIN', 'Integer', VKLWIN);// Left Windows key (Microsoft keyboard)
+ AddConst('VKRWIN', 'Integer', VKRWIN);// Right Windows key (Microsoft keyboard)
+ AddConst('VKAPPS', 'Integer', VKAPPS);// Applications key (Microsoft keyboard)
+ AddConst('VKNUMPAD0', 'Integer', VKNUMPAD0);// 0 key (numeric keypad)
+ AddConst('VKNUMPAD1', 'Integer', VKNUMPAD1);// 1 key (numeric keypad)
+ AddConst('VKNUMPAD2', 'Integer', VKNUMPAD2);// 2 key (numeric keypad)
+ AddConst('VKNUMPAD3', 'Integer', VKNUMPAD3);// 3 key (numeric keypad)
+ AddConst('VKNUMPAD4', 'Integer', VKNUMPAD4);// 4 key (numeric keypad)
+ AddConst('VKNUMPAD5', 'Integer', VKNUMPAD5);// 5 key (numeric keypad)
+ AddConst('VKNUMPAD6', 'Integer', VKNUMPAD6);// 6 key (numeric keypad)
+ AddConst('VKNUMPAD7', 'Integer', VKNUMPAD7);// 7 key (numeric keypad)
+ AddConst('VKNUMPAD8', 'Integer', VKNUMPAD8);// 8 key (numeric keypad)
+ AddConst('VKNUMPAD9', 'Integer', VKNUMPAD9);// 9 key (numeric keypad)
+ AddConst('VKMULTIPLY', 'Integer', VKMULTIPLY);// Multiply key (numeric keypad)
+ AddConst('VKADD', 'Integer', VKADD);// Add key (numeric keypad)
+ AddConst('VKSEPARATOR', 'Integer', VKSEPARATOR);// Separator key (numeric keypad)
+ AddConst('VKSUBTRACT', 'Integer', VKSUBTRACT);// Subtract key (numeric keypad)
+ AddConst('VKDECIMAL', 'Integer', VKDECIMAL);// Decimal key (numeric keypad)
+ AddConst('VKDIVIDE', 'Integer', VKDIVIDE);// Divide key (numeric keypad)
+ AddConst('VKF1', 'Integer', VKF1);// F1 key
+ AddConst('VKF2', 'Integer', VKF2);// F2 key
+ AddConst('VKF3', 'Integer', VKF3);// F3 key
+ AddConst('VKF4', 'Integer', VKF4);// F4 key
+ AddConst('VKF5', 'Integer', VKF5);// F5 key
+ AddConst('VKF6', 'Integer', VKF6);// F6 key
+ AddConst('VKF7', 'Integer', VKF7);// F7 key
+ AddConst('VKF8', 'Integer', VKF8);// F8 key
+ AddConst('VKF9', 'Integer', VKF9);// F9 key
+ AddConst('VKF10', 'Integer', VKF10);// F10 key
+ AddConst('VKF11', 'Integer', VKF11);// F11 key
+ AddConst('VKF12', 'Integer', VKF12);// F12 key
+ AddConst('VKNUMLOCK', 'Integer', VKNUMLOCK);// Num Lock key
+ AddConst('VKSCROLL', 'Integer', VKSCROLL);// Scroll Lock key
+
+ AddConst('crDefault', 'Integer', crDefault);
+ AddConst('crNone', 'Integer', crNone);
+ AddConst('crArrow', 'Integer', crArrow);
+ AddConst('crCross', 'Integer', crCross);
+ AddConst('crIBeam', 'Integer', crIBeam);
+ AddConst('crSize', 'Integer', crSize);
+ AddConst('crSizeNESW', 'Integer', crSizeNESW);
+ AddConst('crSizeNS', 'Integer', crSizeNS);
+ AddConst('crSizeNWSE', 'Integer', crSizeNWSE);
+ AddConst('crSizeWE', 'Integer', crSizeWE);
+ AddConst('crUpArrow', 'Integer', crUpArrow);
+ AddConst('crHourGlass', 'Integer', crHourGlass);
+ AddConst('crDrag', 'Integer', crDrag);
+ AddConst('crNoDrop', 'Integer', crNoDrop);
+ AddConst('crHSplit', 'Integer', crHSplit);
+ AddConst('crVSplit', 'Integer', crVSplit);
+ AddConst('crMultiDrag', 'Integer', crMultiDrag);
+ AddConst('crSQLWait', 'Integer', crSQLWait);
+ AddConst('crNo', 'Integer', crNo);
+ AddConst('crAppStart', 'Integer', crAppStart);
+ AddConst('crHelp', 'Integer', crHelp);
+ AddConst('crHandPoint', 'Integer', crHandPoint);
+ AddConst('crSizeAll', 'Integer', crSizeAll);
+
+ AddType('TFormBorderStyle', fvtInt);
+ AddType('TBorderStyle', fvtInt);
+
+ AddEnumSet('TShiftState', 'ssShift, ssAlt, ssCtrl, ssLeft, ssRight, ssMiddle, ssDouble, ssTouch, ssPen, ssCommand');
+ AddEnum('TAniIndicatorStyle', 'aiLinear, aiCircular');
+ AddEnum('TAlign', 'alNone, alTop, alBottom, alLeft, alRight, alClient');
+ AddEnum('TMouseButton', 'mbLeft, mbRight, mbMiddle');
+ AddEnumSet('TAnchors', 'akLeft, akTop, akRight, akBottom');
+ AddEnum('TBevelCut', 'bvNone, bvLowered, bvRaised, bvSpace');
+ AddEnum('TTextLayout', 'tlTop, tlCenter, tlBottom');
+ AddEnum('TEditCharCase', 'ecNormal, ecUpperCase, ecLowerCase');
+ AddEnum('TScrollStyle', 'ssNone, ssHorizontal, ssVertical, ssBoth');
+ AddEnum('TComboBoxStyle', 'csDropDown, csSimple, csDropDownList, csOwnerDrawFixed, csOwnerDrawVariable');
+ AddEnum('TCheckBoxState', 'cbUnchecked, cbChecked, cbGrayed');
+ AddEnum('TListBoxStyle', 'lbStandard, lbOwnerDrawFixed, lbOwnerDrawVariable');
+ AddEnum('TWindowState', 'wsNormal, wsMinimized, wsMaximized');
+ AddEnum('TFormStyle', 'fsNormal, fsMDIChild, fsMDIForm, fsStayOnTop');
+ AddEnumSet('TBorderIcons', 'biSystemMenu, biMinimize, biMaximize, biHelp');
+ AddEnum('TFormPosition', 'poDesigned, poDefault, poDefaultPosOnly, poDefaultSizeOnly, poScreenCenter, poDesktopCenter');
+ AddEnum('TCloseAction', 'caNone, caHide, caFree, caMinimize');
+
+ with AddClass(TControl, 'TFmxObject') do
+ begin
+ AddMethod('procedure AddObject(AObject: TFmxObject)', CallMethod);
+ AddMethod('procedure RemoveObject(AObject: TFmxObject)', CallMethod);
+ AddMethod('procedure SetBounds(X: Single; Y: Single; AWidth: Single; AHeight: Single)', CallMethod);
+ AddMethod('function AbsoluteToLocal(P: TfsPointF): TfsPointF', CallMethod);
+ AddMethod('function LocalToAbsolute(P: TfsPointF): TfsPointF', CallMethod);
+ AddMethod('function AbsoluteToLocalVector(P: TfsVector): TfsVector', CallMethod);
+ AddMethod('function LocalToAbsoluteVector(P: TfsVector): TfsVector', CallMethod);
+ AddMethod('function PointInObject(X: Single; Y: Single): Boolean', CallMethod);
+ AddMethod('procedure BeginUpdate()', CallMethod);
+ AddMethod('procedure EndUpdate()', CallMethod);
+{$IFNDEF DELPHI18}
+ AddMethod('procedure ApplyEffect()', CallMethod);
+{$ENDIF}
+ AddMethod('procedure UpdateEffects()', CallMethod);
+ AddMethod('procedure SetFocus()', CallMethod);
+ AddMethod('procedure PaintTo(ACanvas: TCanvas; ARect: TFsRectF; AParent: TFmxObject)', CallMethod);
+ AddMethod('procedure Repaint()', CallMethod);
+ AddMethod('procedure InvalidateRect(ARect: TfsRectF)', CallMethod);
+ AddMethod('procedure Lock()', CallMethod);
+ AddProperty('AbsoluteMatrix', 'TfsMatrix', GetProp, nil);
+ AddProperty('AbsoluteOpacity', 'Single', GetProp, nil);
+ AddProperty('AbsoluteWidth', 'Single', GetProp, nil);
+ AddProperty('AbsoluteHeight', 'Single', GetProp, nil);
+ AddProperty('AbsoluteScale', 'TfsPointF', GetProp, nil);
+ AddProperty('AbsoluteEnabled', 'Boolean', GetProp, nil);
+ AddProperty('HasEffect', 'Boolean', GetProp, nil);
+ AddProperty('HasDisablePaintEffect', 'Boolean', GetProp, nil);
+ AddProperty('HasAfterPaintEffect', 'Boolean', GetProp, nil);
+ AddProperty('ChildrenRect', 'TfsRectF', GetProp, nil);
+ AddProperty('InvertAbsoluteMatrix', 'TfsMatrix', GetProp, nil);
+ AddProperty('InPaintTo', 'Boolean', GetProp, nil);
+ AddProperty('LocalRect', 'TfsRectF', GetProp, nil);
+ AddProperty('AbsoluteRect', 'TfsRectF', GetProp, nil);
+ AddProperty('UpdateRect', 'TfsRectF', GetProp, nil);
+ AddProperty('ParentedRect', 'TfsRectF', GetProp, nil);
+ AddProperty('ParentedVisible', 'Boolean', GetProp, nil);
+ AddProperty('ClipRect', 'TfsRectF', GetProp, nil);
+ AddProperty('Canvas', 'TCanvas', GetProp, nil);
+ AddProperty('AutoCapture', 'Boolean', GetProp, SetProp);
+ AddProperty('CanFocus', 'Boolean', GetProp, SetProp);
+ AddProperty('DisableFocusEffect', 'Boolean', GetProp, SetProp);
+ AddProperty('TabOrder', 'Integer', GetProp, SetProp);
+ AddProperty('BoundsRect', 'TfsRectF', GetProp, SetProp);
+ AddEvent('OnDragEnter', TfsDragDropEvent);
+ AddEvent('OnDragLeave', TfsNotifyEvent);
+ AddEvent('OnDragOver', TfsDragOverEvent);
+ AddEvent('OnDragDrop', TfsDragDropEvent);
+ AddEvent('OnDragEnd', TfsNotifyEvent);
+ AddEvent('OnKeyDown', TfsKeyEvent);
+ AddEvent('OnKeyUp', TfsKeyEvent);
+ AddEvent('OnClick', TfsNotifyEvent);
+ AddEvent('OnDblClick', TfsNotifyEvent);
+ AddEvent('OnCanFocus', TfsCanFocusEvent);
+ AddEvent('OnEnter', TfsNotifyEvent);
+ AddEvent('OnExit', TfsNotifyEvent);
+ AddEvent('OnMouseDown', TfsMouseEvent);
+ AddEvent('OnMouseMove', TfsMouseMoveEvent);
+ AddEvent('OnMouseUp', TfsMouseEvent);
+ AddEvent('OnMouseWheel', TfsMouseWheelEvent);
+ AddEvent('OnMouseEnter', TfsNotifyEvent);
+ AddEvent('OnMouseLeave', TfsNotifyEvent);
+ AddEvent('OnPainting', TfsOnPaintEvent);
+ AddEvent('OnPaint', TfsOnPaintEvent);
+ AddEvent('OnResize', TfsNotifyEvent);
+ AddEvent('OnApplyStyleLookup', TfsNotifyEvent);
+ end;
+
+ { standard controls }
+ with AddClass(TStyledControl, 'TControl') do
+ begin
+ AddMethod('function FindStyleResource(AStyleLookup: string): TFmxObject', CallMethod);
+ AddMethod('procedure ApplyStyleLookup()', CallMethod);
+{$IFNDEF DELPHI20}
+ AddMethod('procedure UpdateStyle()', CallMethod);
+{$ENDIF}
+ AddProperty('StyleLookup', 'String', GetProp, SetProp);
+ end;
+
+ AddClass(TStyledControl, 'TControl');
+ AddClass(TTextControl, 'TStyledControl');
+ AddClass(TPanel, 'TStyledControl');
+ AddClass(TCalloutPanel, 'TPanel');
+ AddClass(TLabel, 'TTextControl');
+ AddClass(TCustomButton, 'TTextControl');
+ AddClass(TButton, 'TCustomButton');
+ AddClass(TSpeedButton, 'TCustomButton');
+ with AddClass(TCheckBox, 'TTextControl') do
+ AddEvent('OnChange', TfsNotifyEvent);
+
+ with AddClass(TRadioButton, 'TTextControl') do
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddClass(TGroupBox, 'TTextControl');
+ AddClass(TStatusBar, 'TStyledControl');
+ AddClass(TToolBar, 'TStyledControl');
+ AddClass(TSizeGrip, 'TStyledControl');
+ AddClass(TSplitter, 'TStyledControl');
+ AddClass(TProgressBar, 'TStyledControl');
+ AddClass(TThumb, 'TStyledControl');
+ with AddClass(TCustomTrack, 'TStyledControl') do
+ begin
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddEvent('OnTracking', TfsNotifyEvent);
+ end;
+ AddClass(TTrack, 'TCustomTrack');
+ AddClass(TTrackBar, 'TCustomTrack');
+ AddClass(TBitmapTrackBar, 'TTrackBar');
+ with AddClass(TSwitch, 'TCustomTrack') do
+ AddEvent('OnSwitch', TfsNotifyEvent);
+ with AddClass(TScrollBar, 'TStyledControl') do
+ AddEvent('OnChange', TfsNotifyEvent);
+
+ AddClass(TSmallScrollBar, 'TScrollBar');
+ AddClass(TAniIndicator, 'TStyledControl');
+ with AddClass(TArcDial, 'TStyledControl') do
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddClass(TExpanderButton, 'TCustomButton');
+ with AddClass(TExpander, 'TTextControl') do
+ AddEvent('OnCheckChange', TfsNotifyEvent);
+ with AddClass(TImageControl, 'TStyledControl') do
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddClass(TPathLabel, 'TStyledControl');
+
+
+ with AddClass(TCustomEdit, 'TStyledControl') do
+ begin
+{$IFNDEF Delphi21}
+ AddMethod('procedure ClearSelection()', CallMethod);
+{$ENDIF}
+ AddMethod('procedure CopyToClipboard()', CallMethod);
+ AddMethod('procedure CutToClipboard()', CallMethod);
+ AddMethod('procedure PasteFromClipboard()', CallMethod);
+ AddMethod('procedure SelectAll()', CallMethod);
+{$IFNDEF Delphi21}
+ AddMethod('function GetCharX(a: Integer): Single', CallMethod);
+ AddMethod('function ContentRect(): TfsRectF', CallMethod);
+{$ENDIF}
+ AddProperty('CaretPosition', 'Integer', GetProp, SetProp);
+ AddProperty('SelStart', 'Integer', GetProp, SetProp);
+ AddProperty('SelLength', 'Integer', GetProp, SetProp);
+ AddProperty('SelText', 'string', GetProp, nil);
+ AddProperty('MaxLength', 'Integer', GetProp, SetProp);
+ AddProperty('SelectionFill', 'TBrush', GetProp, nil);
+ AddProperty('FilterChar', 'string', GetProp, SetProp);
+ AddProperty('Typing', 'Boolean', GetProp, SetProp);
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddEvent('OnChangeTracking', TfsNotifyEvent);
+ AddEvent('OnTyping', TfsNotifyEvent);
+ end;
+ AddClass(TEdit, 'TCustomEdit');
+ with AddClass(TMemo, 'TScrollBox') do
+ begin
+ AddMethod('procedure CopyToClipboard()', CallMethod);
+ AddMethod('procedure PasteFromClipboard()', CallMethod);
+ AddMethod('procedure CutToClipboard()', CallMethod);
+ AddMethod('procedure ClearSelection()', CallMethod);
+ AddMethod('procedure SelectAll()', CallMethod);
+ AddMethod('procedure GoToTextEnd()', CallMethod);
+ AddMethod('procedure GoToTextBegin()', CallMethod);
+ AddMethod('procedure GotoLineEnd()', CallMethod);
+ AddMethod('procedure GoToLineBegin()', CallMethod);
+ AddMethod('procedure UnDo()', CallMethod);
+ AddProperty('SelStart', 'Integer', GetProp, SetProp);
+ AddProperty('SelLength', 'Integer', GetProp, SetProp);
+ AddProperty('SelText', 'string', GetProp, nil);
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddEvent('OnChangeTracking', TfsNotifyEvent);
+ end;
+
+ AddClass(TRadioButton, 'TTextControl');
+ with AddClass(TListBoxItem, 'TTextControl') do
+ begin
+ AddProperty('Data', 'TObject', GetProp, SetProp);
+ AddProperty('Index', 'Integer', GetProp, SetProp);
+ end;
+
+ with AddClass(TCustomListBox, 'TScrollBox') do
+ begin
+ AddMethod('procedure Clear()', CallMethod);
+ AddMethod('function DragChange(SourceItem: TListBoxItem; DestItem: TListBoxItem): Boolean', CallMethod);
+ AddMethod('procedure SelectAll()', CallMethod);
+ AddMethod('procedure ClearSelection()', CallMethod);
+ AddMethod('procedure SelectRange(Item1: TListBoxItem; Item2: TListBoxItem)', CallMethod);
+ AddMethod('function ItemByPoint(X: Single; Y: Single): TListBoxItem', CallMethod);
+ AddMethod('function ItemByIndex(Idx: Integer): TListBoxItem', CallMethod);
+ AddMethod('procedure Exchange(Item1: TListBoxItem; Item2: TListBoxItem)', CallMethod);
+ AddMethod('procedure AddObject(AObject: TFmxObject)', CallMethod);
+ AddMethod('procedure InsertObject(Index: Integer; AObject: TFmxObject)', CallMethod);
+ AddMethod('procedure RemoveObject(AObject: TFmxObject)', CallMethod);
+ AddIndexProperty( 'ListItems', 'Integer', 'TListBoxItem', CallMethod);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddProperty('Selected', 'TListBoxItem', GetProp, nil);
+ AddProperty('Items', 'TStrings', GetProp, SetProp);
+ AddProperty('ItemIndex', 'Integer', GetProp, SetProp);
+ end;
+
+ AddClass(TListBox, 'TCustomListBox');
+ with AddClass(TCustomComboBox, 'TStyledControl') do
+ begin
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure DropDown', CallMethod);
+ AddIndexProperty( 'ListItems', 'Integer', 'TListBoxItem', CallMethod);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddProperty('Selected', 'TListBoxItem', GetProp, nil);
+ AddProperty('Items', 'TStrings', GetProp, SetProp);
+ AddProperty('ItemIndex', 'Integer', GetProp, SetProp);
+ AddEvent('OnDropDown', TfsNotifyEvent);
+ AddEvent('OnCloseUp', TfsNotifyEvent);
+ end;
+
+ with AddClass(TComboBox, 'TCustomComboBox') do
+ AddEvent('OnChange', TfsNotifyEvent);
+
+ with AddClass(TCommonCustomForm, 'TFmxObject') do
+ begin
+ AddConstructor('constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0)', CallMethod);
+ AddMethod('procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; AHeight: Integer)', CallMethod);
+ AddMethod('function ClientToScreen(Point: TfsPointF): TfsPointF', CallMethod);
+ AddMethod('function ScreenToClient(Point: TfsPointF): TfsPointF', CallMethod);
+ AddMethod('function CloseQuery(): Boolean', CallMethod);
+ AddMethod('function ClientRect(): TfsRectF', CallMethod);
+ AddMethod('procedure Release()', CallMethod);
+ AddMethod('procedure Close()', CallMethod);
+ AddMethod('procedure Show()', CallMethod);
+ AddMethod('procedure Hide()', CallMethod);
+ AddMethod('function ShowModal(): Integer', CallMethod);
+ AddMethod('procedure CloseModal()', CallMethod);
+ AddMethod('procedure Invalidate()', CallMethod);
+ AddMethod('procedure BeginUpdate()', CallMethod);
+ AddMethod('procedure EndUpdate()', CallMethod);
+ end;
+
+ with AddClass(TCustomForm, 'TCommonCustomForm') do
+ begin
+ AddEvent('OnActivate', TfsNotifyEvent);
+ AddEvent('OnClose', TfsCloseEvent);
+ AddEvent('OnCloseQuery', TfsCloseQueryEvent);
+ AddEvent('OnCreate', TfsNotifyEvent);
+ AddEvent('OnDestroy', TfsNotifyEvent);
+ AddEvent('OnDeactivate', TfsNotifyEvent);
+ AddEvent('OnHide', TfsNotifyEvent);
+ AddEvent('OnPaint', TfsNotifyEvent);
+ AddEvent('OnShow', TfsNotifyEvent);
+ AddEvent('OnResize', TfsNotifyEvent);
+ AddProperty('Canvas', 'TCanvas', GetProp, nil);
+ AddProperty('ModalResult', 'Integer', GetProp, SetProp);
+ end;
+ AddClass(TForm, 'TCustomForm');
+
+ AddClass(TDataModule, 'TComponent');
+ with AddClass(TApplication, 'TComponent') do
+ begin
+ AddMethod('procedure ProcessMessages', CallMethod);
+ end;
+ AddObject('Application', Application);
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ Form: TCommonCustomForm;
+begin
+ Result := 0;
+
+ if ClassType = TControl then
+ begin
+ if MethodName = 'ADDOBJECT' then
+ TControl(Instance).AddObject(TFmxObject(frxInteger(Caller.Params[0])))
+ else if MethodName = 'REMOVEOBJECT' then
+ TControl(Instance).RemoveObject(TFmxObject(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SETBOUNDS' then
+ TControl(Instance).SetBounds(Single(Caller.Params[0]), Single(Caller.Params[1]), Single(Caller.Params[2]), Single(Caller.Params[3]))
+ else if MethodName = 'ABSOLUTETOLOCAL' then
+ Result := frxInteger(TfsPointF.Create(TControl(Instance).AbsoluteToLocal(TfsPointF(frxInteger(Caller.Params[0])).GetRect)))
+ else if MethodName = 'LOCALTOABSOLUTE' then
+ Result := frxInteger(TfsPointF.Create(TControl(Instance).LocalToAbsolute(TfsPointF(frxInteger(Caller.Params[0])).GetRect)))
+ else if MethodName = 'ABSOLUTETOLOCALVECTOR' then
+ Result := frxInteger(TfsVector.Create(TControl(Instance).AbsoluteToLocalVector(TfsVector(frxInteger(Caller.Params[0])).GetRect)))
+ else if MethodName = 'LOCALTOABSOLUTEVECTOR' then
+ Result := frxInteger(TfsVector.Create(TControl(Instance).LocalToAbsoluteVector(TfsVector(frxInteger(Caller.Params[0])).GetRect)))
+ else if MethodName = 'POINTINOBJECT' then
+ Result := Boolean(TControl(Instance).PointInObject(Single(Caller.Params[0]), Single(Caller.Params[1])))
+ else if MethodName = 'BEGINUPDATE' then
+ TControl(Instance).BeginUpdate()
+ else if MethodName = 'ENDUPDATE' then
+ TControl(Instance).EndUpdate()
+{$IFNDEF DELPHI18}
+ else if MethodName = 'APPLYEFFECT' then
+ TControl(Instance).ApplyEffect()
+{$ENDIF}
+ else if MethodName = 'UPDATEEFFECTS' then
+ TControl(Instance).UpdateEffects()
+ else if MethodName = 'SETFOCUS' then
+ TControl(Instance).SetFocus()
+ else if MethodName = 'PAINTTO' then
+ TControl(Instance).PaintTo(TCanvas(frxInteger(Caller.Params[0])), TfsRectF(frxInteger(Caller.Params[1])).GetRect, TFmxObject(frxInteger(Caller.Params[2])))
+ else if MethodName = 'REPAINT' then
+ TControl(Instance).Repaint()
+ else if MethodName = 'INVALIDATERECT' then
+ TControl(Instance).InvalidateRect(TfsRectF(frxInteger(Caller.Params[0])).GetRect)
+ else if MethodName = 'LOCK' then
+ TControl(Instance).Lock()
+ end
+ else if ClassType = TStyledControl then
+ begin
+ if MethodName = 'FINDSTYLERESOURCE' then
+ Result := frxInteger(TStyledControl(Instance).FindStyleResource(String(Caller.Params[0])))
+ else if MethodName = 'APPLYSTYLELOOKUP' then
+ TStyledControl(Instance).ApplyStyleLookup()
+{$IFNDEF DELPHI20}
+ else if MethodName = 'UPDATESTYLE' then
+ TStyledControl(Instance).UpdateStyle()
+{$ENDIF}
+ end
+ else if ClassType = TCustomEdit then
+ begin
+ {$IFNDEF Delphi21}
+ if MethodName = 'CLEARSELECTION' then
+ TCustomEdit(Instance).ClearSelection()
+ else
+{$ENDIF}
+ if MethodName = 'COPYTOCLIPBOARD' then
+ TCustomEdit(Instance).CopyToClipboard()
+ else if MethodName = 'CUTTOCLIPBOARD' then
+ TCustomEdit(Instance).CutToClipboard()
+ else if MethodName = 'PASTEFROMCLIPBOARD' then
+ TCustomEdit(Instance).PasteFromClipboard()
+ else if MethodName = 'SELECTALL' then
+ TCustomEdit(Instance).SelectAll()
+{$IFNDEF Delphi21}
+ else if MethodName = 'GETCHARX' then
+ Result := Single(TCustomEdit(Instance).GetCharX(Integer(Caller.Params[0])))
+ else if MethodName = 'CONTENTRECT' then
+ Result := frxInteger(TfsRectF.Create(TCustomEdit(Instance).ContentRect()))
+{$ENDIF}
+ end
+ else if ClassType = TMemo then
+ begin
+ if MethodName = 'COPYTOCLIPBOARD' then
+ TMemo(Instance).CopyToClipboard()
+ else if MethodName = 'PASTEFROMCLIPBOARD' then
+ TMemo(Instance).PasteFromClipboard()
+ else if MethodName = 'CUTTOCLIPBOARD' then
+ TMemo(Instance).CutToClipboard()
+ else if MethodName = 'CLEARSELECTION' then
+ TMemo(Instance).ClearSelection()
+ else if MethodName = 'SELECTALL' then
+ TMemo(Instance).SelectAll()
+ else if MethodName = 'GOTOTEXTEND' then
+ TMemo(Instance).GoToTextEnd()
+ else if MethodName = 'GOTOTEXTBEGIN' then
+ TMemo(Instance).GoToTextBegin()
+ else if MethodName = 'GOTOLINEEND' then
+ TMemo(Instance).GotoLineEnd()
+ else if MethodName = 'GOTOLINEBEGIN' then
+ TMemo(Instance).GoToLineBegin()
+ else if MethodName = 'UNDO' then
+ TMemo(Instance).UnDo()
+ end
+ else if ClassType = TCustomListBox then
+ begin
+ if MethodName = 'ASSIGN' then
+ TCustomListBox(Instance).Assign(TPersistent(frxInteger(Caller.Params[0])))
+ else if MethodName = 'CLEAR' then
+ TCustomListBox(Instance).Clear()
+ else if MethodName = 'DRAGCHANGE' then
+ Result := TCustomListBox(Instance).DragChange(TListBoxItem(frxInteger(Caller.Params[0])), TListBoxItem(frxInteger(Caller.Params[1])))
+ else if MethodName = 'SELECTALL' then
+ TCustomListBox(Instance).SelectAll()
+ else if MethodName = 'CLEARSELECTION' then
+ TCustomListBox(Instance).ClearSelection()
+ else if MethodName = 'SELECTRANGE' then
+ TCustomListBox(Instance).SelectRange(TListBoxItem(frxInteger(Caller.Params[0])), TListBoxItem(frxInteger(Caller.Params[1])))
+ else if MethodName = 'ITEMBYPOINT' then
+ Result := frxInteger(TListBoxItem(TCustomListBox(Instance).ItemByPoint(Single(Caller.Params[0]), Single(Caller.Params[1]))))
+ else if MethodName = 'ITEMBYINDEX' then
+ Result := frxInteger(TListBoxItem(TCustomListBox(Instance).ItemByIndex(Integer(Caller.Params[0]))))
+ else if MethodName = 'EXCHANGE' then
+ TCustomListBox(Instance).Exchange(TListBoxItem(frxInteger(Caller.Params[0])), TListBoxItem(frxInteger(Caller.Params[1])))
+ else if MethodName = 'ADDOBJECT' then
+ TCustomListBox(Instance).AddObject(TFmxObject(frxInteger(Caller.Params[0])))
+ else if MethodName = 'INSERTOBJECT' then
+ TCustomListBox(Instance).InsertObject(Integer(Caller.Params[0]), TFmxObject(frxInteger(Caller.Params[1])))
+ else if MethodName = 'REMOVEOBJECT' then
+ TCustomListBox(Instance).RemoveObject(TFmxObject(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LISTITEMS.GET' then
+ Result := frxInteger(TCustomListBox(Instance).ListItems[Caller.Params[0]])
+ end
+ else if ClassType = TCustomComboBox then
+ begin
+ if MethodName = 'CLEAR' then
+ TCustomComboBox(Instance).Clear()
+ else if MethodName = 'DROPDOWN' then
+ TCustomComboBox(Instance).DropDown()
+ else if MethodName = 'LISTITEMS.GET' then
+ Result := frxInteger(TCustomComboBox(Instance).ListItems[Caller.Params[0]])
+ end
+ else if ClassType = TCommonCustomForm then
+ begin
+ Form := TCommonCustomForm(Instance);
+ if MethodName = 'CREATENEW' then
+ Result := frxInteger(Form.CreateNew(TComponent(frxInteger(Caller.Params[0])), Integer(Caller.Params[1])))
+ else if MethodName = 'SETBOUNDS' then
+ Form.SetBounds(Integer(Caller.Params[0]), Integer(Caller.Params[1]), Integer(Caller.Params[2]), Integer(Caller.Params[3]))
+ else if MethodName = 'CLIENTTOSCREEN' then
+ Result := frxInteger(TfsPointF.Create(Form.ClientToScreen(TfsPointF(frxInteger(Caller.Params[0])).GetRect)))
+ else if MethodName = 'SCREENTOCLIENT' then
+ Result := frxInteger(TfsPointF.Create(Form.ScreenToClient(TfsPointF(frxInteger(Caller.Params[0])).GetRect)))
+ else if MethodName = 'CLOSEQUERY' then
+ Result := Form.CloseQuery
+ else if MethodName = 'CLIENTRECT' then
+ Result := frxInteger(TfsRectF.Create(Form.ClientRect))
+ else if MethodName = 'RELEASE' then
+ Form.Release()
+ else if MethodName = 'CLOSE' then
+ Form.Close()
+ else if MethodName = 'SHOW' then
+ Form.Show()
+ else if MethodName = 'HIDE' then
+ Form.Hide()
+ else if MethodName = 'SHOWMODAL' then
+ Result := Integer(Form.ShowModal)
+ else if MethodName = 'CLOSEMODAL' then
+ Form.CloseModal()
+ else if MethodName = 'INVALIDATE' then
+ Form.Invalidate()
+ else if MethodName = 'BEGINUPDATE' then
+ Form.BeginUpdate()
+ else if MethodName = 'ENDUPDATE' then
+ Form.EndUpdate()
+ end
+ else if ClassType = TApplication then
+ begin
+ if MethodName = 'PROCESSMESSAGES' then
+ TApplication(Instance).ProcessMessages
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TControl then
+ begin
+ if PropName = 'ABSOLUTEMATRIX' then
+ Result := frxInteger(TfsMatrix.Create(TControl(Instance).AbsoluteMatrix))
+ else if PropName = 'ABSOLUTEOPACITY' then
+ Result := TControl(Instance).AbsoluteOpacity
+ else if PropName = 'ABSOLUTEWIDTH' then
+ Result := TControl(Instance).AbsoluteWidth
+ else if PropName = 'ABSOLUTEHEIGHT' then
+ Result := TControl(Instance).AbsoluteHeight
+ else if PropName = 'ABSOLUTESCALE' then
+ Result := frxInteger(TfsPointF.Create(TControl(Instance).AbsoluteScale))
+ else if PropName = 'ABSOLUTEENABLED' then
+ Result := TControl(Instance).AbsoluteEnabled
+ else if PropName = 'HASEFFECT' then
+ Result := TControl(Instance).HasEffect
+ else if PropName = 'HASDISABLEPAINTEFFECT' then
+ Result := TControl(Instance).HasDisablePaintEffect
+ else if PropName = 'HASAFTERPAINTEFFECT' then
+ Result := TControl(Instance).HasAfterPaintEffect
+ else if PropName = 'CHILDRENRECT' then
+ Result := frxInteger(TfsRectF.Create(TControl(Instance).ChildrenRect))
+ else if PropName = 'INVERTABSOLUTEMATRIX' then
+ Result := frxInteger(TfsMatrix.Create(TControl(Instance).InvertAbsoluteMatrix))
+ else if PropName = 'INPAINTTO' then
+ Result := TControl(Instance).InPaintTo
+ else if PropName = 'LOCALRECT' then
+ Result := frxInteger(TfsRectF.Create(TControl(Instance).LocalRect))
+ else if PropName = 'ABSOLUTERECT' then
+ Result := frxInteger(TfsRectF.Create(TControl(Instance).AbsoluteRect))
+ else if PropName = 'UPDATERECT' then
+ Result := frxInteger(TfsRectF.Create(TControl(Instance).UpdateRect))
+ else if PropName = 'PARENTEDRECT' then
+ Result := frxInteger(TfsRectF.Create(TControl(Instance).ParentedRect))
+ else if PropName = 'PARENTEDVISIBLE' then
+ Result := TControl(Instance).ParentedVisible
+ else if PropName = 'CLIPRECT' then
+ Result := frxInteger(TfsRectF.Create(TControl(Instance).ClipRect))
+ else if PropName = 'CANVAS' then
+ Result := frxInteger(TControl(Instance).Canvas)
+ else if PropName = 'AUTOCAPTURE' then
+ Result := TControl(Instance).AutoCapture
+ else if PropName = 'CANFOCUS' then
+ Result := TControl(Instance).CanFocus
+ else if PropName = 'DISABLEFOCUSEFFECT' then
+ Result := TControl(Instance).DisableFocusEffect
+ else if PropName = 'TABORDER' then
+ Result := Integer(TControl(Instance).TabOrder)
+ else if PropName = 'BOUNDSRECT' then
+ Result := frxInteger(TfsRectF.Create(TControl(Instance).BoundsRect))
+ end
+ else if ClassType = TStyledControl then
+ begin
+ if PropName = 'STYLELOOKUP' then
+ Result := TStyledControl(Instance).StyleLookup
+ end
+ else if ClassType = TCustomEdit then
+ begin
+ if PropName = 'CARETPOSITION' then
+ Result := TCustomEdit(Instance).CaretPosition
+ else if PropName = 'SELSTART' then
+ Result := TCustomEdit(Instance).SelStart
+ else if PropName = 'SELLENGTH' then
+ Result := TCustomEdit(Instance).SelLength
+ else if PropName = 'SELTEXT' then
+ Result := String(TCustomEdit(Instance).SelText)
+ else if PropName = 'MAXLENGTH' then
+ Result := TCustomEdit(Instance).MaxLength
+ else if PropName = 'SELECTIONFILL' then
+ Result := frxInteger(TCustomEdit(Instance).SelectionFill)
+ else if PropName = 'FILTERCHAR' then
+ Result := TCustomEdit(Instance).FilterChar
+ else if PropName = 'TYPING' then
+ Result := TCustomEdit(Instance).Typing
+ end
+ else if ClassType = TMemo then
+ begin
+ if PropName = 'SELSTART' then
+ Result := TMemo(Instance).SelStart
+ else if PropName = 'SELLENGTH' then
+ Result := TMemo(Instance).SelLength
+ else if PropName = 'SELTEXT' then
+ Result := String(TMemo(Instance).SelText)
+ end
+ else if ClassType = TListBoxItem then
+ begin
+ if PropName = 'DATA' then
+ Result := frxInteger(TListBoxItem(Instance).Data)
+ else if PropName = 'INDEX' then
+ Result := TListBoxItem(Instance).Index
+ end
+ else if ClassType = TCustomListBox then
+ begin
+ if PropName = 'COUNT' then
+ Result := TCustomListBox(Instance).Count
+ else if PropName = 'SELECTED' then
+ Result := frxInteger(TCustomListBox(Instance).Selected)
+ else if PropName = 'ITEMS' then
+ Result := frxInteger(TCustomListBox(Instance).Items)
+ else if PropName = 'ITEMINDEX' then
+ Result := TCustomListBox(Instance).ItemIndex
+ end
+ else if ClassType = TCustomComboBox then
+ begin
+ if PropName = 'COUNT' then
+ Result := TCustomComboBox(Instance).Count
+ else if PropName = 'SELECTED' then
+ Result := frxInteger(TCustomComboBox(Instance).Selected)
+ else if PropName = 'ITEMS' then
+ Result := frxInteger(TCustomComboBox(Instance).Items)
+ else if PropName = 'ITEMINDEX' then
+ Result := TCustomComboBox(Instance).ItemIndex
+ end
+ else if ClassType = TCustomForm then
+ begin
+ if PropName = 'MODALRESULT' then
+ Result := TCustomForm(Instance).ModalResult
+ else if PropName = 'CANVAS' then
+ Result := frxInteger(TCustomForm(Instance).Canvas)
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TControl then
+ begin
+ if PropName = 'AUTOCAPTURE' then
+ TControl(Instance).AutoCapture := Boolean(Value)
+ else if PropName = 'CANFOCUS' then
+ TControl(Instance).CanFocus := Boolean(Value)
+ else if PropName = 'DISABLEFOCUSEFFECT' then
+ TControl(Instance).DisableFocusEffect := Boolean(Value)
+ else if PropName = 'TABORDER' then
+ TControl(Instance).TabOrder := TTabOrder(Integer(Value))
+ else if PropName = 'BOUNDSRECT' then
+ TControl(Instance).BoundsRect := TfsRectF(frxInteger(Value)).GetRect
+ end
+ else if ClassType = TStyledControl then
+ begin
+ if PropName = 'STYLELOOKUP' then
+ TStyledControl(Instance).StyleLookup := Value;
+ end
+ else if ClassType = TCustomEdit then
+ begin
+ if PropName = 'CARETPOSITION' then
+ TCustomEdit(Instance).CaretPosition := Integer(Value)
+ else if PropName = 'SELSTART' then
+ TCustomEdit(Instance).SelStart := Integer(Value)
+ else if PropName = 'SELLENGTH' then
+ TCustomEdit(Instance).SelLength := Integer(Value)
+ else if PropName = 'MAXLENGTH' then
+ TCustomEdit(Instance).MaxLength := Integer(Value)
+ else if PropName = 'FILTERCHAR' then
+ TCustomEdit(Instance).FilterChar := String(Value)
+ else if PropName = 'TYPING' then
+ TCustomEdit(Instance).Typing := Boolean(Value)
+ end
+ else if ClassType = TMemo then
+ begin
+ if PropName = 'SELSTART' then
+ TMemo(Instance).SelStart := Integer(Value)
+ else if PropName = 'SELLENGTH' then
+ TMemo(Instance).SelLength := Integer(Value)
+ end
+ else if ClassType = TListBoxItem then
+ begin
+ if PropName = 'DATA' then
+ TListBoxItem(Instance).Data := TObject(frxInteger(Value))
+ else if PropName = 'INDEX' then
+ TListBoxItem(Instance).Index := Value
+ end
+ else if ClassType = TCustomListBox then
+ begin
+ if PropName = 'ITEMS' then
+ TCustomListBox(Instance).Items := TStrings(frxInteger(Value))
+ else if PropName = 'ITEMINDEX' then
+ TCustomListBox(Instance).ItemIndex := Value
+ end
+ else if ClassType = TCustomComboBox then
+ begin
+ if PropName = 'ITEMS' then
+ TCustomComboBox(Instance).Items := TStrings(frxInteger(Value))
+ else if PropName = 'ITEMINDEX' then
+ TCustomComboBox(Instance).ItemIndex := Value
+ end
+ else if ClassType = TCustomForm then
+ begin
+ if PropName = 'MODALRESULT' then
+ TCustomForm(Instance).ModalResult := Value
+ end
+end;
+
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsFormsRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/FMX.fs_igraphicsrtti.pas b/LibD28/FMX.fs_igraphicsrtti.pas
new file mode 100644
index 0000000..ec1c1a3
--- /dev/null
+++ b/LibD28/FMX.fs_igraphicsrtti.pas
@@ -0,0 +1,522 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Graphics.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_igraphicsrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_iclassesrtti
+, FMX.Types, FMX.Objects, System.UITypes, System.UIConsts, System.Types, System.Variants
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI29}
+ , FMX.BaseTypeAliases
+{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsGraphicsRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ procedure GetColorProc(const Name: String);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ GetAlphaColorValues(GetColorProc);
+ AddType('TAlignment', fvtInt);
+ AddType('TLeftRight', fvtInt);
+ AddConst('taLeftJustify', 'Integer', taLeftJustify);
+ AddConst('taRightJustify', 'Integer', taRightJustify);
+ AddConst('taCenter', 'Integer', taCenter);
+ AddType('TVerticalAlignment', fvtInt);
+ AddConst('taAlignTop', 'Integer', taAlignTop);
+ AddConst('taAlignBottom', 'Integer', taAlignBottom);
+ AddConst('taVerticalCenter', 'Integer', taVerticalCenter);
+ //AddEnum('TAlignment', 'taLeftJustify, taRightJustify, taCenter');
+ AddType('TCorners ', fvtInt);
+ AddConst('crTopLeft', 'Integer', TCorner.crTopLeft);
+ AddConst('crTopRight', 'Integer', TCorner.crTopRight);
+ AddConst('crBottomLeft', 'Integer', TCorner.crBottomLeft);
+ AddConst('crBottomRight', 'Integer', TCorner.crBottomRight);
+ AddType('TSides ', fvtInt);
+ AddConst('sdTop', 'Integer', TSide.sdTop);
+ AddConst('sdLeft', 'Integer', TSide.sdLeft);
+ AddConst('sdBottom', 'Integer', TSide.sdBottom);
+ AddConst('sdRight', 'Integer', TSide.sdRight);
+ AddConst('ftRightToLeft', 'Integer', TFillTextFlag.ftRightToLeft);
+ AddType('TFillTextFlags ', fvtInt);
+ AddEnumSet('TFontStyles', 'fsBold, fsItalic, fsUnderline, fsStrikeout');
+ AddEnum('TFontPitch', 'fpDefault, fpVariable, fpFixed');
+ AddEnum('TFontQuality', 'fqDefault, fqDraft, fqProof, fqNonAntialiased, fqAntialiased, fqClearType, fqClearTypeNatural');
+ AddEnum('TGradientStyle', 'gsLinear, gsRadial');
+ AddEnum('TWrapMode', 'wmTile, wmTileOriginal, wmTileStretch');
+ AddEnum('TCornerType', 'ctRound, ctBevel, ctInnerRound, ctInnerLine');
+ AddEnum('TAlignLayout', 'alNone, alTop, alLeft, alRight, alBottom, alMostTop, alMostBottom, alMostLeft, alMostRight, alClient, alContents, alCenter, alVertCenter, alHorzCenter, alHorizontal, alVertical, alScale, alFit, alFitLeft, alFitRight');
+ AddEnum('TPathPointKind', 'ppMoveTo, ppLineTo, ppCurveTo, ppClose');
+ AddEnum('TStrokeCap', 'scFlat, scRound');
+ AddEnum('TStrokeJoin', 'sjMiter, sjRound, sjBevel');
+ AddEnum('TStrokeDash', 'sdSolid, sdDash, sdDot, sdDashDot, sdDashDotDot, sdCustom');
+
+ AddEnum('TBrushKind', 'bkNone, bkSolid, bkGradient, bkBitmap, bkResource, bkGrab');
+
+ AddClass(TfsMatrix, 'TPersistent');
+ with AddClass(TFont, 'TPersistent') do
+ AddConstructor('constructor Create', CallMethod);
+ AddClass(TGradientPoint, 'TCollectionItem');
+ AddClass(TGradientPoints, 'TCollection');
+ AddClass(TGradient, 'TPersistent');
+ AddClass(TBrushBitmap, 'TPersistent');
+ AddClass(TBrushResource, 'TPersistent');
+{$IFNDEF Delphi18}
+ AddClass(TBrushGrab, 'TPersistent');
+{$ENDIF}
+ AddClass(TLineMetricInfo, 'TObject');
+
+ with AddClass(TBrush, 'TPersistent') do
+ begin
+ AddConstructor('Create(ADefaultKind: TBrushKind; ADefaultColor: TAlphaColor)', CallMethod);
+ AddProperty('DefaultColor', 'TAlphaColor', GetProp);
+ AddProperty('DefaultKind', 'TBrushKind', GetProp);
+ end;
+{$IFDEF Delphi17}
+ AddClass(TStrokeBrush, 'TBrush');
+{$ENDIF}
+
+ AddClass(TCanvasSaveState, 'TPersistent');
+ with AddClass(TCanvas, 'TPersistent') do
+ begin
+ AddMethod('function BeginScene: Boolean', CallMethod);
+ AddMethod('procedure EndScene', CallMethod);
+ AddMethod('procedure Clear(Color: TAlphaColor)', CallMethod);
+ AddMethod('procedure ClearRect(ARect: TfsRectF; AColor: TAlphaColor = 0)', CallMethod);
+ AddMethod('procedure SetMatrix(const M: TfsMatrix)', CallMethod);
+{$IFDEF Delphi17}
+ AddMethod('procedure MultiplyMatrix(const M: TfsMatrix)', CallMethod);
+{$ELSE}
+ AddMethod('procedure MultyMatrix(const M: TfsMatrix)', CallMethod);
+{$ENDIF}
+ AddMethod('function SaveState: TCanvasSaveState', CallMethod);
+ AddMethod('procedure RestoreState(State: TCanvasSaveState)', CallMethod);
+ AddMethod('procedure SetClipRects(ARects: array of TfsRectF)', CallMethod);
+ AddMethod('procedure IntersectClipRect(ARect: TfsRectF)', CallMethod);
+ AddMethod('procedure ExcludeClipRect(ARect: TfsRectF)', CallMethod);
+ AddMethod('procedure ResetClipRect', CallMethod);
+ AddMethod('procedure DrawLine(APt1: TfsPointF; APt2: TfsPointF; AOpacity: Single)', CallMethod);
+ AddMethod('procedure FillRect(ARect: TfsRectF; XRadius: Single; YRadius: Single; ACorners: TCorners; AOpacity: Single; ACornerType: TCornerType)', CallMethod);
+ AddMethod('procedure DrawRect(ARect: TfsRectF; XRadius: Single; YRadius: Single; ACorners: TCorners; AOpacity: Single; ACornerType: TCornerType)', CallMethod);
+ AddMethod('procedure FillEllipse(ARect: TfsRectF; AOpacity: Single)', CallMethod);
+ AddMethod('procedure DrawEllipse(ARect: TfsRectF; AOpacity: Single)', CallMethod);
+ AddMethod('procedure FillArc(Center: TfsPointF; Radius: TfsPointF; StartAngle: Single; SweepAngle: Single; AOpacity: Single)', CallMethod);
+ AddMethod('procedure DrawArc(Center: TfsPointF; Radius: TfsPointF; StartAngle: Single; SweepAngle: Single; AOpacity: Single)', CallMethod);
+ AddMethod('function PtInPath(APoint: TfsPointF; APath: TPathData): Boolean', CallMethod);
+ AddMethod('procedure FillPath(APath: TPathData; AOpacity: Single)', CallMethod);
+ AddMethod('procedure DrawPath(APath: TPathData; AOpacity: Single)', CallMethod);
+ AddMethod('procedure DrawBitmap(ABitmap: TBitmap; SrcRect: TfsRectF; DstRect: TfsRectF; AOpacity: Single; HighSpeed: Boolean)', CallMethod);
+ AddMethod('procedure DrawRectSides(ARect: TfsRectF; XRadius: Single; YRadius: Single; ACorners: TCorners; AOpacity: Single; ASides: TSides; ACornerType: TCornerType)', CallMethod);
+ AddMethod('procedure FillPolygon(Points: TPolygon; AOpacity: Single)', CallMethod);
+ AddMethod('procedure DrawPolygon(Points: TPolygon; AOpacity: Single)', CallMethod);
+ AddMethod('function LoadFontFromStream(AStream: TStream): Boolean', CallMethod);
+ AddMethod('procedure FillText(ARect: TfsRectF; AText: string; WordWrap: Boolean; AOpacity: Single; Flags: TFillTextFlags; ATextAlign: TTextAlign; AVTextAlign: TTextAlign)', CallMethod);
+ AddMethod('procedure MeasureText(var ARect: TfsRectF; AText: string; WordWrap: Boolean; Flags: TFillTextFlags; ATextAlign: TTextAlign; AVTextAlign: TTextAlign)', CallMethod);
+ AddMethod('procedure MeasureLines(ALines: TLineMetricInfo; ARect: TfsRectF; AText: string; WordWrap: Boolean; Flags: TFillTextFlags; ATextAlign: TTextAlign; AVTextAlign: TTextAlign)', CallMethod);
+ AddMethod('function TextToPath(Path: TPathData; ARect: TfsRectF; AText: string; WordWrap: Boolean; ATextAlign: TTextAlign; AVTextAlign: TTextAlign): Boolean', CallMethod);
+ AddMethod('function TextWidth(AText: string): Single', CallMethod);
+ AddMethod('function TextHeight(AText: string): Single', CallMethod);
+ AddMethod('procedure SetCustomDash(Dash: array; Offset: Single)', CallMethod);
+{$IFDEF Delphi17}
+ AddProperty('Stroke', 'TStrokeBrush', GetProp);
+ AddProperty('StrokeCap', 'TStrokeCap', nil, SetProp);
+ AddProperty('StrokeDash', 'TStrokeDash', nil, SetProp);
+ AddProperty('StrokeJoin', 'TStrokeJoin', nil, SetProp);
+{$ELSE}
+ AddProperty('Stroke', 'TBrush', GetProp);
+ AddProperty('StrokeCap', 'TStrokeCap', GetProp, SetProp);
+ AddProperty('StrokeDash', 'TStrokeDash', GetProp, SetProp);
+ AddProperty('StrokeJoin', 'TStrokeJoin', GetProp, SetProp);
+{$ENDIF}
+ AddProperty('StrokeThickness', 'Single', GetProp, SetProp);
+ AddProperty('Fill', 'TBrush', GetProp, SetProp);
+ AddProperty('Font', 'TFont', GetProp);
+ AddProperty('Matrix', 'TfsMatrix', GetProp);
+ AddProperty('Width', 'Integer', GetProp);
+ AddProperty('Height', 'Integer', GetProp);
+ end;
+ with AddClass(TBitmap, 'TPersistent') do
+ begin
+ AddConstructor('constructor Create(AWidth, AHeight: Integer)', CallMethod);
+ AddConstructor('constructor CreateFromStream(AStream: TStream)', CallMethod);
+ AddConstructor('constructor CreateFromFile(AFileName: string)', CallMethod);
+ AddMethod('procedure SetSize(AWidth, AHeight: Integer)', CallMethod);
+ AddMethod('procedure Clear(AColor: TAlphaColor)', CallMethod);
+ AddMethod('procedure ClearRect(ARect: TfsRectF; AColor: TAlphaColor = 0)', CallMethod);
+ AddMethod('function IsEmpty: Boolean', CallMethod);
+ AddMethod('procedure Rotate(Angle: Single)', CallMethod);
+ AddMethod('procedure FlipHorizontal', CallMethod);
+ AddMethod('procedure FlipVertical', CallMethod);
+ AddMethod('procedure InvertAlpha', CallMethod);
+{$IFNDEF DELPHI20}
+ AddMethod('procedure LoadFromFile(AFileName: string; Rotate: Single = 0)', CallMethod);
+{$ELSE}
+ AddMethod('procedure LoadFromFile(AFileName: string)', CallMethod);
+{$ENDIF}
+ AddMethod('procedure SaveToFile(AFileName: string)', CallMethod);
+ AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
+{$IFNDEF Delphi17}
+ AddMethod('procedure BitmapChanged', CallMethod);
+ AddIndexProperty( 'Pixels', 'Integer, Integer', 'TAlphaColor', CallMethod);
+{$ENDIF}
+ AddProperty('Canvas', 'TCanvas', GetProp);
+{$IFNDEF Delphi21}
+ AddProperty('ResourceBitmap', 'TBitmap', GetProp);
+{$ENDIF}
+ AddProperty('Width', 'Integer', GetProp, SetProp);
+ AddProperty('Height', 'Integer', GetProp, SetProp);
+ end;
+ AddClass(TSpline, 'TObject');
+ AddClass(TBounds, 'TPersistent');
+ AddClass(TTransform, 'TPersistent');
+
+
+
+{$IFNDEF Delphi17}
+ AddClass(TBitmapCodec, 'TPersistent');
+{$ENDIF}
+ AddClass(TPathData, 'TPersistent');
+ AddClass(TCanvasSaveState, 'TPersistent');
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ _Canvas: TCanvas;
+ _Bitmap: TBitmap;
+// mRects: array of TRectF;
+ mDashs: array of Single;
+ mPoly: TPolygon;
+ Idx, Cnt, nLo: Integer;
+begin
+ Result := 0;
+
+ if ClassType = TFont then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TFont(Instance).Create);
+ end
+ else if ClassType = TBitmap then
+ begin
+ _Bitmap := TBitmap(Instance);
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TBitmap(Instance).Create(Caller.Params[0], Caller.Params[1]))
+ else if MethodName = 'CREATEFROMSTREAM' then
+ Result := frxInteger(_Bitmap.CreateFromStream(TStream(frxInteger(Caller.Params[0]))))
+ else if MethodName = 'CREATEFROMFILE' then
+ Result := frxInteger(_Bitmap.CreateFromFile(String(Caller.Params[0])))
+ else if MethodName = 'SETSIZE' then
+ _Bitmap.SetSize(Integer(Caller.Params[0]), Integer(Caller.Params[1]))
+ else if MethodName = 'CLEAR' then
+ _Bitmap.Clear(TAlphaColor(Caller.Params[0]))
+ else if MethodName = 'CLEARRECT' then
+ begin
+ _Bitmap.ClearRect(TfsRectF(frxInteger(Caller.Params[0])).GetRect, TAlphaColor(Caller.Params[1]));
+ end
+ else if MethodName = 'ISEMPTY' then
+ Result := _Bitmap.IsEmpty
+ else if MethodName = 'ROTATE' then
+ _Bitmap.Rotate(Single(Caller.Params[1]))
+ else if MethodName = 'FLIPHORIZONTAL' then
+ _Bitmap.FlipHorizontal
+ else if MethodName = 'FLIPVERTICAL' then
+ _Bitmap.FlipVertical
+ else if MethodName = 'INVERTALPHA' then
+ _Bitmap.InvertAlpha
+ else if MethodName = 'LOADFROMFILE' then
+{$IFNDEF DELPHI20}
+ _Bitmap.LoadFromFile(String(Caller.Params[0]), Single(Caller.Params[1]))
+{$ELSE}
+ _Bitmap.LoadFromFile(String(Caller.Params[0]))
+{$ENDIF}
+ else if MethodName = 'SAVETOFILE' then
+ _Bitmap.SaveToFile(String(Caller.Params[0]))
+ else if MethodName = 'LOADFROMSTREAM' then
+ _Bitmap.LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVETOSTREAM' then
+ _Bitmap.SaveToStream(TStream(frxInteger(Caller.Params[0])))
+{$IFNDEF Delphi17}
+ else if MethodName = 'BITMAPCHANGED' then
+ _Bitmap.BitmapChanged
+ else if MethodName = 'PIXELS.GET' then
+ Result := _Bitmap.Pixels[Caller.Params[0], Caller.Params[1]]
+ else if MethodName = 'PIXELS.SET' then
+ _Bitmap.Pixels[Caller.Params[0], Caller.Params[1]] := Caller.Params[2]
+{$ENDIF}
+ end
+ else if ClassType = TBrush then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TBrush(Instance).Create(TBrushKind(frxInteger(Caller.Params[0])),
+ TAlphaColor(frxInteger(Caller.Params[0]))))
+ end
+ else if ClassType = TCanvas then
+ begin
+ _Canvas := TCanvas(Instance);
+
+ if MethodName = 'BEGINSCENE' then
+ Result := _Canvas.BeginScene
+ else if MethodName = 'ENDSCENE' then
+ _Canvas.EndScene
+ else if MethodName = 'CLEAR' then
+ _Canvas.Clear(TAlphaColor(Caller.Params[0]))
+ else if MethodName = 'CLEARRECT' then
+ _Canvas.ClearRect(TfsRectF(frxInteger(Caller.Params[0])).GetRect, TAlphaColor(Caller.Params[1]))
+ else if MethodName = 'SETMATRIX' then
+ _Canvas.SetMatrix(TfsMatrix(frxInteger(Caller.Params[0])).GetRect)
+{$IFDEF Delphi17}
+ else if MethodName = 'MULTIPLYMATRIX' then
+ _Canvas.MultiplyMatrix(TfsMatrix(frxInteger(Caller.Params[0])).GetRect)
+{$ELSE}
+ else if MethodName = 'MULTYMATRIX' then
+ _Canvas.MultyMatrix(TfsMatrix(frxInteger(Caller.Params[0])).GetRect)
+{$ENDIF}
+ else if MethodName = 'SAVESTATE' then
+ Result := frxInteger(_Canvas.SaveState)
+ else if MethodName = 'RESTORESTATE' then
+ _Canvas.RestoreState(TCanvasSaveState(frxInteger(Caller.Params[0])))
+ { else if MethodName = 'SETCLIPRECTS' then
+ begin
+ nLo := VarArrayLowBound(Caller.Params[0], 1);
+ Cnt := VarArrayHighBound(Caller.Params[0], 1) - nLo;
+ SetLength(mRects, Cnt);
+ for Idx := 0 to Cnt - 1 do
+ mRects[Idx] := TfsRectF(frxInteger(Caller.Params[0][Idx + nLo])).GetRectP^;
+ _Canvas.SetClipRects(mRects);
+ SetLength(mRects, 0);
+ end }
+ else if MethodName = 'EXCLUDECLIPRECT' then
+ _Canvas.ExcludeClipRect(TfsRectF(frxInteger(Caller.Params[0])).GetRect)
+ else if MethodName = 'INTERSECTCLIPTRECT' then
+ _Canvas.IntersectClipRect(TfsRectF(frxInteger(Caller.Params[0])).GetRect)
+ {else if MethodName = 'RESETCLIPRECT' then
+ _Canvas.ResetClipRect }
+ else if MethodName = 'DRAWLINE' then
+ _Canvas.DrawLine(TfsPointF(frxInteger(Caller.Params[0])).GetRect, TfsPointF(frxInteger(Caller.Params[1])).GetRect, Single(Caller.Params[2]))
+ else if MethodName = 'FILLRECT' then
+ _Canvas.FillRect(TfsRectF(frxInteger(Caller.Params[0])).GetRect, Single(Caller.Params[1]), Single(Caller.Params[2]), TCorners(Byte(Caller.Params[3])), Single(Caller.Params[4]), TCornerType(Caller.Params[5]))
+ else if MethodName = 'DRAWRECT' then
+ _Canvas.DrawRect(TfsRectF(frxInteger(Caller.Params[0])).GetRect, Single(Caller.Params[1]), Single(Caller.Params[2]), TCorners(Byte(Caller.Params[3])), Single(Caller.Params[4]), TCornerType(Caller.Params[5]))
+ else if MethodName = 'FILLELLIPSE' then
+ _Canvas.FillEllipse(TfsRectF(frxInteger(Caller.Params[0])).GetRect, Single(Caller.Params[1]))
+ else if MethodName = 'DRAWELLIPSE' then
+ _Canvas.DrawEllipse(TfsRectF(frxInteger(Caller.Params[0])).GetRect, Single(Caller.Params[1]))
+ else if MethodName = 'FILLARC' then
+ _Canvas.FillArc(TfsPointF(frxInteger(Caller.Params[0])).GetRect, TfsPointF(frxInteger(Caller.Params[1])).GetRect, Single(Caller.Params[2]), Single(Caller.Params[3]), Single(Caller.Params[4]))
+ else if MethodName = 'DRAWARC' then
+ _Canvas.DrawArc(TfsPointF(frxInteger(Caller.Params[0])).GetRect, TfsPointF(frxInteger(Caller.Params[1])).GetRect, Single(Caller.Params[2]), Single(Caller.Params[3]), Single(Caller.Params[4]))
+ else if MethodName = 'PTINPATH' then
+ Result := Boolean(_Canvas.PtInPath(TfsPointF(frxInteger(Caller.Params[0])).GetRect, TPathData(frxInteger(Caller.Params[1]))))
+ else if MethodName = 'FILLPATH' then
+ _Canvas.FillPath(TPathData(frxInteger(Caller.Params[0])), Single(Caller.Params[1]))
+ else if MethodName = 'DRAWPATH' then
+ _Canvas.DrawPath(TPathData(frxInteger(Caller.Params[0])), Single(Caller.Params[1]))
+ else if MethodName = 'DRAWBITMAP' then
+ _Canvas.DrawBitmap(TBitmap(frxInteger(Caller.Params[0])), TfsRectF(frxInteger(Caller.Params[1])).GetRect, TfsRectF(frxInteger(Caller.Params[2])).GetRect, Single(Caller.Params[3]), Boolean(Caller.Params[4]))
+ else if MethodName = 'DRAWRECTSIDES' then
+ _Canvas.DrawRectSides(TfsRectF(frxInteger(Caller.Params[0])).GetRect, Single(Caller.Params[1]), Single(Caller.Params[2]), TCorners(Byte(Caller.Params[3])), Single(Caller.Params[4]), TSides(Byte(Caller.Params[5])), TCornerType(Caller.Params[6]))
+ else if MethodName = 'FILLPOLYGON' then
+ begin
+ nLo := VarArrayLowBound(Caller.Params[0], 1);
+ Cnt := VarArrayHighBound(Caller.Params[0], 1) - nLo;
+ SetLength(mPoly, Cnt);
+ for Idx := 0 to Cnt - 1 do
+ mPoly[Idx] := TfsPointF(frxInteger(Caller.Params[0][Idx + nLo])).GetRectP^;
+ _Canvas.FillPolygon(TPolygon(Caller.Params[0]), Single(Caller.Params[1]));
+ SetLength(mPoly, 0);
+ end
+ else if MethodName = 'DRAWPOLYGON' then
+ begin
+ nLo := VarArrayLowBound(Caller.Params[0], 1);
+ Cnt := VarArrayHighBound(Caller.Params[0], 1) - nLo;
+ SetLength(mPoly, Cnt);
+ for Idx := 0 to Cnt - 1 do
+ mPoly[Idx] := TfsPointF(frxInteger(Caller.Params[0][Idx + nLo])).GetRectP^;
+ _Canvas.DrawPolygon(TPolygon(Caller.Params[0]), Single(Caller.Params[1]));
+ SetLength(mPoly, 0);
+ end
+ else if MethodName = 'LOADFONTFROMSTREAM' then
+ Result := Boolean(_Canvas.LoadFontFromStream(TStream(frxInteger(Caller.Params[0]))))
+ else if MethodName = 'FILLTEXT' then
+ _Canvas.FillText(TfsRectF(frxInteger(Caller.Params[0])).GetRect, String(Caller.Params[1]), Boolean(Caller.Params[2]), Single(Caller.Params[3]), TFillTextFlags(Byte(Caller.Params[4])), TTextAlign(Caller.Params[5]), TTextAlign(Caller.Params[6]))
+ else if MethodName = 'MEASURETEXT' then
+ _Canvas.MeasureText(TfsRectF(frxInteger(Caller.Params[0])).GetRectP^, String(Caller.Params[1]), Boolean(Caller.Params[2]), TFillTextFlags(Byte(Caller.Params[3])), TTextAlign(Caller.Params[4]), TTextAlign(Caller.Params[5]))
+ else if MethodName = 'MEASURELINES' then
+ _Canvas.MeasureLines(TLineMetricInfo(frxInteger(Caller.Params[0])), TfsRectF(frxInteger(Caller.Params[1])).GetRect, String(Caller.Params[2]), Boolean(Caller.Params[3]), TFillTextFlags(Byte(Caller.Params[4])), TTextAlign(Caller.Params[5]), TTextAlign(Caller.Params[6]))
+ else if MethodName = 'TEXTTOPATH' then
+ Result := Boolean(_Canvas.TextToPath(TPathData(frxInteger(Caller.Params[0])), TfsRectF(frxInteger(Caller.Params[1])).GetRect, String(Caller.Params[2]), Boolean(Caller.Params[3]), TTextAlign(Caller.Params[4]), TTextAlign(Caller.Params[5])))
+ else if MethodName = 'TEXTWIDTH' then
+ Result := Single(_Canvas.TextWidth(String(Caller.Params[0])))
+ else if MethodName = 'TEXTHEIGHT' then
+ Result := Single(_Canvas.TextHeight(String(Caller.Params[0])))
+ else if MethodName = 'SETCUSTOMDASH' then
+ begin
+ nLo := VarArrayLowBound(Caller.Params[0], 1);
+ Cnt := VarArrayHighBound(Caller.Params[0], 1) - nLo;
+ SetLength(mDashs, Cnt);
+ for Idx := 0 to Cnt - 1 do
+ mDashs[Idx] := Single(Caller.Params[0][Idx + nLo]);
+{$IFDEF DELPHI25}
+ _Canvas.Stroke.SetCustomDash(mDashs, Single(Caller.Params[1]));
+{$ELSE}
+ _Canvas.SetCustomDash(mDashs, Single(Caller.Params[1]));
+{$ENDIF}
+ SetLength(mDashs, 0);
+ end
+{$IFNDEF CLX}
+ { else if MethodName = 'PIXELS.GET' then
+ Result := _Canvas.Pixels[Caller.Params[0], Caller.Params[1]]
+ else if MethodName = 'PIXELS.SET' then
+ _Canvas.Pixels[Caller.Params[0], Caller.Params[1]] := Caller.Params[2] }
+{$ENDIF}
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+ if ClassType = TBitmap then
+ begin
+ if PropName = 'CANVAS' then
+ Result := frxInteger(TBitmap(Instance).Canvas)
+{$IFNDEF Delphi21}
+ else if PropName = 'RESOURCEBITMAP' then
+ Result := frxInteger(TBitmap(Instance).ResourceBitmap)
+{$ENDIF}
+ else if PropName = 'WIDTH' then
+ Result := Integer(TBitmap(Instance).Width)
+ else if PropName = 'HEIGHT' then
+ Result := Integer(TBitmap(Instance).Height)
+ end
+ else if ClassType = TCanvas then
+ begin
+ if PropName = 'STROKE' then
+ Result := frxInteger(TCanvas(Instance).Stroke)
+ else if PropName = 'WIDTH' then
+ Result := Integer(TCanvas(Instance).Width)
+ else if PropName = 'HEIGHT' then
+ Result := Integer(TCanvas(Instance).Height)
+ else if PropName = 'FONT' then
+ Result := frxInteger(TCanvas(Instance).Font)
+ else if PropName = 'FILL' then
+ Result := frxInteger(TCanvas(Instance).Fill)
+ else if PropName = 'STROKETHICKNESS' then
+{$IFDEF DELPHI25}
+ Result := Single(TCanvas(Instance).Stroke.Thickness)
+{$ELSE}
+ Result := Single(TCanvas(Instance).StrokeThickness)
+{$ENDIF}
+{$IFNDEF Delphi17}
+ else if PropName = 'STROKECAP' then
+ Result := Integer(TCanvas(Instance).StrokeCap)
+ else if PropName = 'STROKEDASH' then
+ Result := Integer(TCanvas(Instance).StrokeDash)
+ else if PropName = 'STROKEJOIN' then
+ Result := Integer(TCanvas(Instance).StrokeJoin)
+{$ENDIF}
+ end;
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TBitmap then
+ begin
+ if PropName = 'WIDTH' then
+ TBitmap(Instance).Width := Integer(Value)
+ else if PropName = 'HEIGHT' then
+ TBitmap(Instance).Height:= Integer(Value)
+ end
+ else if ClassType = TCanvas then
+ begin
+ if PropName = 'STROKETHICKNESS' then
+{$IFDEF DELPHI25}
+ TCanvas(Instance).Stroke.Thickness := Single(Value)
+{$ELSE}
+ TCanvas(Instance).StrokeThickness := Single(Value)
+{$ENDIF}
+ else if PropName = 'STROKECAP' then
+{$IFDEF DELPHI25}
+ TCanvas(Instance).Stroke.Cap := TStrokeCap(Value)
+{$ELSE}
+ TCanvas(Instance).StrokeCap := TStrokeCap(Value)
+{$ENDIF}
+ else if PropName = 'STROKEDASH' then
+{$IFDEF DELPHI25}
+ TCanvas(Instance).Stroke.Dash := TStrokeDash(Value)
+{$ELSE}
+ TCanvas(Instance).StrokeDash := TStrokeDash(Value)
+{$ENDIF}
+ else if PropName = 'STROKEJOIN' then
+{$IFDEF DELPHI25}
+ TCanvas(Instance).Stroke.Join := TStrokeJoin(Value)
+{$ELSE}
+ TCanvas(Instance).StrokeJoin := TStrokeJoin(Value)
+{$ENDIF}
+ end;
+end;
+
+procedure TFunctions.GetColorProc(const Name: String);
+var
+ c: Integer;
+begin
+ IdentToAlphaColor('cla' + Name, c);
+ Script.AddConst('cla' + Name, 'Integer', c);
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsGraphicsRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/FMX.fs_iibxrtti.pas b/LibD28/FMX.fs_iibxrtti.pas
new file mode 100644
index 0000000..dd92476
--- /dev/null
+++ b/LibD28/FMX.fs_iibxrtti.pas
@@ -0,0 +1,125 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ IBX classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iibxrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_itools, FMX.fs_idbrtti, Data.db, FMX.Types
+{$IFDEF DELPHI20}
+ , IBX.ibdatabase, IBX.IBCustomDataSet, IBX.IBQuery, IBX.IBTable, IBX.IBStoredProc
+{$ELSE}
+ , ibdatabase, IBCustomDataSet, IBQuery, IBTable, IBStoredProc
+{$ENDIF}
+ ;
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsIBXRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class (TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass; const MethodName:
+ String; Caller: TfsMethodHelper): Variant;
+ function RecordCount(Instance: TObject; ClassType: TClass; const PropName:
+ String): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddClass(TIBDataBase, 'TComponent');
+
+ with AddClass(TIBTransaction, 'TComponent') do
+ begin
+ AddMethod('procedure Commit', CallMethod);
+ AddMethod('procedure RollBack', CallMethod);
+ AddMethod('procedure StartTransaction', CallMethod);
+ end;
+
+ AddClass(TIBCustomDataSet, 'TDataSet');
+ AddClass(TIBTable, 'TIBCustomDataSet');
+ with AddClass(TIBQuery, 'TIBCustomDataSet') do
+ begin
+ AddMethod('procedure ExecSQL', CallMethod);
+ AddMethod('procedure FetchAll', CallMethod);
+ AddProperty('RecordCount', 'Integer',RecordCount, nil);
+ end;
+ with AddClass(TIBStoredProc, 'TIBCustomDataSet') do
+ AddMethod('procedure ExecProc', CallMethod);
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; const
+ MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TIBQuery then
+ begin
+ if MethodName = 'EXECSQL' then
+ TIBQuery(Instance).ExecSQL
+ else
+ if MethodName = 'FETCHALL' then
+ TIBQuery(Instance).FETCHALL;
+ end
+ else
+ if ClassType = TIBStoredProc then
+ begin
+ if MethodName = 'EXECPROC' then
+ TIBStoredProc(Instance).ExecProc
+ end
+ else
+ if(ClassType = TIBTransaction) AND (MethodName = 'COMMIT') then
+ TIBTransaction(Instance).Commit
+ else
+ if (ClassType = TIBTransaction) AND (MethodName = 'ROLLBACK') then
+ TIBTransaction(Instance).RollBack
+ else
+ if(ClassType = TIBTransaction) AND (MethodName = 'STARTTRANSACTION') then
+ TIBTransaction(Instance).StartTransaction;
+
+end;
+
+function TFunctions.RecordCount(Instance: TObject; ClassType: TClass; const
+ PropName: String): Variant;
+begin
+ Result:=0;
+ if (ClassType = TIBQuery) AND (PropName = 'RECORDCOUNT') then
+ Result:=TIBQuery(Instance).RecordCount;
+
+end;
+
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsIBXRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/FMX.fs_iilparser.pas b/LibD28/FMX.fs_iilparser.pas
new file mode 100644
index 0000000..b8d0425
--- /dev/null
+++ b/LibD28/FMX.fs_iilparser.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Intermediate Language parser }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iilparser;
+{$i FMX.inc}
+{$i fs_iilparser.pas}
\ No newline at end of file
diff --git a/LibD28/FMX.fs_iinirtti.pas b/LibD28/FMX.fs_iinirtti.pas
new file mode 100644
index 0000000..42561a5
--- /dev/null
+++ b/LibD28/FMX.fs_iinirtti.pas
@@ -0,0 +1,372 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ IniFiles.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{ Copyright (c) 2004-2007 }
+{ by Stalker SoftWare }
+{ }
+{******************************************}
+
+unit FMX.fs_iinirtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, System.IniFiles, FMX.Types, System.Types;
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsIniRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass; const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass; const PropName: String): Variant;
+ procedure SaveIniFileToStream(oIniFile: TCustomIniFile; oStream: TStream);
+ procedure LoadIniFileFromStream(oIniFile :TCustomIniFile; oStream :TStream);
+ procedure WriteTStrings(oIniFile: TCustomIniFile; const Section: String; Values: TStrings; IsClear :Boolean = True);
+ procedure ReadTStrings(oIniFile: TCustomIniFile; const Section: String; Values: TStrings; IsClear :Boolean = True);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+
+ with AScript do
+ begin
+ with AddClass(TCustomIniFile, 'TObject') do
+ begin
+ AddConstructor('constructor Create(const FileName: String)', CallMethod);
+ AddMethod('function ReadInteger(const Section, Ident: String; Default: LongInt): LongInt', CallMethod);
+ AddMethod('procedure WriteInteger(const Section, Ident: String; Value: LongInt)', CallMethod);
+ AddMethod('function ReadBool(const Section, Ident: String; Default: Boolean): Boolean', CallMethod);
+ AddMethod('procedure WriteBool(const Section, Ident: String; Value: Boolean)', CallMethod);
+ AddMethod('function ReadDate(const Section, Name: String; Default: TDateTime): TDateTime', CallMethod);
+ AddMethod('procedure WriteDate(const Section, Name: String; Value: TDateTime)', CallMethod);
+ AddMethod('function ReadDateTime(const Section, Name: String; Default: TDateTime): TDateTime', CallMethod);
+ AddMethod('procedure WriteDateTime(const Section, Name: String; Value: TDateTime)', CallMethod);
+ AddMethod('function ReadFloat(const Section, Name: String; Default: Double): Double', CallMethod);
+ AddMethod('procedure WriteFloat(const Section, Name: String; Value: Double)', CallMethod);
+ AddMethod('function ReadTime(const Section, Name: String; Default: TDateTime): TDateTime', CallMethod);
+ AddMethod('procedure WriteTime(const Section, Name: String; Value: TDateTime);', CallMethod);
+{$IFDEF DELPHI6}
+ AddMethod('function ReadBinaryStream(const Section, Name: String; Value: TStream): Integer', CallMethod);
+ AddMethod('procedure WriteBinaryStream(const Section, Name: String; Value: TStream)', CallMethod);
+{$ENDIF}
+ AddMethod('function SectionExists(const Section: String): Boolean', CallMethod);
+ AddMethod('function ValueExists(const Section, Ident: String): Boolean', CallMethod);
+
+ AddMethod('procedure WriteTStrings(const Section :String; Value :TStrings; IsClear :Boolean = True)', CallMethod);
+ AddMethod('function ReadTStrings(const Section :String; Value :TStrings; IsClear :Boolean = True): String;', CallMethod);
+
+ AddProperty('FileName', 'String', GetProp);
+ end;
+
+ with AddClass(TMemIniFile, 'TCustomIniFile') do
+ begin
+ AddConstructor('constructor Create(const FileName: String)', CallMethod);
+ AddMethod('procedure WriteString(const Section, Ident, Value: String)', CallMethod);
+ AddMethod('function ReadString(const Section, Ident, Default: String): String;', CallMethod);
+{$IFDEF DELPHI6}
+ AddMethod('procedure ReadSectionValuesEx(const Section: String; Strings: TStrings)', CallMethod);
+{$ENDIF}
+ AddMethod('procedure DeleteKey(const Section, Ident: String)', CallMethod);
+ AddMethod('procedure ReadSection(const Section: String; Strings: TStrings)', CallMethod);
+ AddMethod('procedure ReadSections(Strings: TStrings)', CallMethod);
+ AddMethod('procedure ReadSectionValues(const Section: String; Strings: TStrings)', CallMethod);
+ AddMethod('procedure EraseSection(const Section: String)', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure GetStrings(List: TStrings)', CallMethod);
+ AddMethod('procedure SetStrings(List: TStrings)', CallMethod);
+ AddMethod('procedure SaveIniFileToStream(oStream: TStream)', CallMethod);
+ AddMethod('procedure LoadIniFileFromStream(oStream: TStream)', CallMethod);
+ end;
+
+ with AddClass(TIniFile, 'TCustomIniFile') do
+ begin
+ AddMethod('procedure WriteString(const Section, Ident, Value: String)', CallMethod);
+ AddMethod('function ReadString(const Section, Ident, Default: String): String;', CallMethod);
+{$IFDEF DELPHI6}
+ AddMethod('procedure ReadSectionValuesEx(const Section: String; Strings: TStrings)', CallMethod);
+{$ENDIF}
+ AddMethod('procedure DeleteKey(const Section, Ident: String)', CallMethod);
+ AddMethod('procedure ReadSection(const Section: String; Strings: TStrings)', CallMethod);
+ AddMethod('procedure ReadSections(Strings: TStrings)', CallMethod);
+ AddMethod('procedure ReadSectionValues(const Section: String; Strings: TStrings)', CallMethod);
+ AddMethod('procedure EraseSection(const Section: String)', CallMethod);
+ AddMethod('procedure SaveIniFileToStream(oStream: TStream)', CallMethod);
+ AddMethod('procedure LoadIniFileFromStream(oStream: TStream)', CallMethod);
+ end;
+
+ end;
+
+end;
+
+{$HINTS OFF}
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ oCustomIniFile: TCustomIniFile;
+ oMemIniFile: TMemIniFile;
+ oIniFile: TIniFile;
+ oList: TStrings;
+ nCou: Integer;
+
+begin
+
+ Result := 0;
+
+ if ClassType = TCustomIniFile then
+ begin
+ oCustomIniFile := TCustomIniFile(Instance);
+ if MethodName = 'CREATE' then
+ Result := frxInteger(oCustomIniFile.Create(Caller.Params[0]))
+ else if MethodName = 'WRITEINTEGER' then
+ oCustomIniFile.WriteInteger(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READINTEGER' then
+ Result := oCustomIniFile.ReadInteger(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITEBOOL' then
+ oCustomIniFile.WriteBool(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READBOOL' then
+ Result := oCustomIniFile.ReadBool(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITEDATE' then
+ oCustomIniFile.WriteDate(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READDATE' then
+ Result := oCustomIniFile.ReadDate(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITEDATETIME' then
+ oCustomIniFile.WriteDateTime(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READDATETIME' then
+ Result := oCustomIniFile.ReadDateTime(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITEFLOAT' then
+ oCustomIniFile.WriteFloat(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READFLOAT' then
+ Result := oCustomIniFile.ReadFloat(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITETIME' then
+ oCustomIniFile.WriteTime(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READTIME' then
+ Result := oCustomIniFile.ReadTime(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+{$IFDEF DELPHI6}
+ else if MethodName = 'WRITEBINARYSTREAM' then
+ oCustomIniFile.WriteBinaryStream(Caller.Params[0], Caller.Params[1], TStream(frxInteger(Caller.Params[2])))
+ else if MethodName = 'READBINARYSTREAM' then
+ Result := oCustomIniFile.ReadBinaryStream(Caller.Params[0], Caller.Params[1], TStream(frxInteger(Caller.Params[2])))
+{$ENDIF}
+ else if MethodName = 'SECTIONEXISTS' then
+ Result := oCustomIniFile.SectionExists(Caller.Params[0])
+ else if MethodName = 'VALUEEXISTS' then
+ Result := oCustomIniFile.ValueExists(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'WRITETSTRINGS' then
+ WriteTStrings(oCustomIniFile, Caller.Params[0], TStrings(frxInteger(Caller.Params[1])), Caller.Params[2])
+ else if MethodName = 'READTSTRINGS' then
+ ReadTStrings(oCustomIniFile, Caller.Params[0], TStrings(frxInteger(Caller.Params[1])), Caller.Params[2])
+
+ end;
+
+ if ClassType = TMemIniFile then
+ begin
+ oMemIniFile := TMemIniFile(Instance);
+ if MethodName = 'CREATE' then
+ Result := frxInteger(oMemIniFile.Create(Caller.Params[0]))
+ else if MethodName = 'WRITESTRING' then
+ oMemIniFile.WriteString(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READSTRING' then
+ Result := oMemIniFile.ReadString(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'DELETEKEY' then
+ oMemIniFile.DeleteKey(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'READSECTION' then
+ oMemIniFile.ReadSection(Caller.Params[0], TStrings(frxInteger(Caller.Params[1])))
+ else if MethodName = 'READSECTIONS' then
+ oMemIniFile.ReadSections(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'READSECTIONVALUES' then
+ oMemIniFile.ReadSectionValues(Caller.Params[0], TStrings(frxInteger(Caller.Params[1])))
+ else if MethodName = 'ERASESECTION' then
+ oMemIniFile.EraseSection(Caller.Params[0])
+{$IFDEF DELPHI6}
+ else if MethodName = 'READSECTIONVALUESEX' then
+ begin
+ oList := TStringList.Create;
+ try
+ oMemIniFile.ReadSectionValues(Caller.Params[0], oList);
+ TStrings(frxInteger(Caller.Params[1])).Clear;
+ for nCou := 0 to oList.Count-1 do
+// TStrings(frxInteger(Caller.Params[1])).Add(oList.ValueFromIndex[nCou]);
+ TStrings(frxInteger(Caller.Params[1])).Add(oList.Values[oList.Names[nCou]]);
+ finally
+ oList.Free;
+ end;
+ end
+{$ENDIF}
+ else if MethodName = 'CLEAR' then
+ oMemIniFile.Clear
+ else if MethodName = 'GETSTRINGS' then
+ oMemIniFile.GetStrings(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SETSTRINGS' then
+ oMemIniFile.SetStrings(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVEINIFILETOSTREAM' then
+ SaveIniFileToStream(oMemIniFile, TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LOADINIFILEFROMSTREAM' then
+ LoadIniFileFromStream(oMemIniFile, TStream(frxInteger(Caller.Params[0])))
+ end;
+
+ if ClassType = TIniFile then
+ begin
+ oIniFile := TIniFile(Instance);
+ if MethodName = 'WRITESTRING' then
+ oIniFile.WriteString(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READSTRING' then
+ Result := oIniFile.ReadString(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'DELETEKEY' then
+ oIniFile.DeleteKey(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'READSECTION' then
+ oIniFile.ReadSection(Caller.Params[0], TStrings(frxInteger(Caller.Params[1])))
+ else if MethodName = 'READSECTIONS' then
+ oIniFile.ReadSections(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'READSECTIONVALUES' then
+ oIniFile.ReadSectionValues(Caller.Params[0], TStrings(frxInteger(Caller.Params[1])))
+ else if MethodName = 'ERASESECTION' then
+ oIniFile.EraseSection(Caller.Params[0])
+{$IFDEF DELPHI6}
+ else if MethodName = 'READSECTIONVALUESEX' then
+ begin
+ oList := TStringList.Create;
+ try
+ oIniFile.ReadSectionValues(Caller.Params[0], oList);
+ TStrings(frxInteger(Caller.Params[1])).Clear;
+ for nCou := 0 to oList.Count-1 do
+// TStrings(frxInteger(Caller.Params[1])).Add(oList.ValueFromIndex[nCou]);
+ TStrings(frxInteger(Caller.Params[1])).Add(oList.Values[oList.Names[nCou]]);
+ finally
+ oList.Free;
+ end;
+ end
+{$ENDIF}
+ else if MethodName = 'SAVEINIFILETOSTREAM' then
+ SaveIniFileToStream(oIniFile, TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LOADINIFILEFROMSTREAM' then
+ LoadIniFileFromStream(oIniFile, TStream(frxInteger(Caller.Params[0])))
+ end;
+
+end;
+{$HINTS ON}
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass; const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TCustomIniFile then
+ begin
+ if PropName = 'FILENAME' then
+ Result := TIniFile(Instance).FileName
+ end;
+end;
+
+procedure TFunctions.SaveIniFileToStream(oIniFile :TCustomIniFile; oStream :TStream);
+var
+ oStrings :TStrings;
+
+begin
+
+ if (not Assigned(oIniFile)) or (not Assigned(oStream)) then Exit;
+
+ if not ((oIniFile is TIniFile) or (oIniFile is TMemIniFile)) then Exit;
+
+ oStrings:= TStringList.Create;
+ try
+
+ if oIniFile is TIniFile then
+ oStrings.LoadFromFile(oIniFile.FileName)
+ else
+ if oIniFile is TMemIniFile then
+ TMemIniFile(oIniFile).GetStrings(oStrings);
+
+ oStrings.SaveToStream(oStream);
+
+ finally
+ oStrings.Free;
+ end;
+
+end;
+
+procedure TFunctions.LoadIniFileFromStream(oIniFile :TCustomIniFile; oStream :TStream);
+var
+ oStrings :TStrings;
+
+begin
+
+ if (not Assigned(oIniFile)) or (not Assigned(oStream)) then Exit;
+
+ if not ((oIniFile is TIniFile) or (oIniFile is TMemIniFile)) then Exit;
+
+ oStrings:= TStringList.Create;
+ try
+
+ oStrings.LoadFromStream(oStream);
+
+ if oIniFile is TIniFile then
+ oStrings.SaveToFile(oIniFile.FileName)
+ else
+ if oIniFile is TMemIniFile then
+ TMemIniFile(oIniFile).SetStrings(oStrings);
+
+ finally
+ oStrings.Free;
+ end;
+
+end;
+
+procedure TFunctions.WriteTStrings(oIniFile :TCustomIniFile; const Section :String; Values :TStrings; IsClear :Boolean = True);
+var
+ nCou :Integer;
+
+begin
+
+ if IsClear then oIniFile.EraseSection(Section);
+
+ for nCou := 0 to Values.Count-1 do
+ oIniFile.WriteString(Section, 'Items'+IntToStr(nCou), Values[nCou]);
+
+ oIniFile.WriteInteger(Section, 'Count', Values.Count);
+
+end;
+
+procedure TFunctions.ReadTStrings(oIniFile :TCustomIniFile; const Section :String; Values :TStrings; IsClear :Boolean = True);
+var
+ nCou, nCount :Integer;
+
+begin
+
+ nCount := oIniFile.ReadInteger(Section, 'Count', 0);
+
+ if IsClear then Values.Clear;
+
+ for nCou := 0 to nCount-1 do
+ Values.Add(oIniFile.ReadString(Section, 'Items'+IntToStr(nCou), ''));
+
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsIniRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/FMX.fs_iinterpreter.pas b/LibD28/FMX.fs_iinterpreter.pas
new file mode 100644
index 0000000..0953f64
--- /dev/null
+++ b/LibD28/FMX.fs_iinterpreter.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Main module }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iinterpreter;
+{$i FMX.inc}
+{$i fs_iinterpreter.pas}
\ No newline at end of file
diff --git a/LibD28/FMX.fs_ijs.pas b/LibD28/FMX.fs_ijs.pas
new file mode 100644
index 0000000..4b321a6
--- /dev/null
+++ b/LibD28/FMX.fs_ijs.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ JScript grammar }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_ijs;
+{$i FMX.inc}
+{$i fs_ijs.pas}
\ No newline at end of file
diff --git a/LibD28/FMX.fs_imenusrtti.pas b/LibD28/FMX.fs_imenusrtti.pas
new file mode 100644
index 0000000..fe9b172
--- /dev/null
+++ b/LibD28/FMX.fs_imenusrtti.pas
@@ -0,0 +1,104 @@
+{**********************************************}
+{ }
+{ FastScript v1.9 }
+{ Menus }
+{ }
+{ Copyright (c) 1998-2011 }
+{ by Fast Reports Inc. }
+{ }
+{**********************************************}
+
+unit FMX.fs_imenusrtti;
+
+interface
+
+{$I fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Menus, FMX.fs_iinterpreter, FMX.fs_ievents, System.Types, System.Variants, FMX.Types;
+
+type
+{$i frxPlatformsAttribute.inc}
+
+ TfsMenusRTTI = class(TComponent); // fake component
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass; const MethodName:
+ string; Caller: TfsMethodHelper): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+
+ with AScript do
+ begin
+
+ AddType('TPopupAlignment', fvtInt);
+
+
+ with AddClass(TMenuItem, 'TTextControl') do
+ begin
+ AddMethod('procedure Popup', CallMethod);
+ AddMethod('procedure NeedPopup', CallMethod);
+ AddMethod('function HavePopup: Boolean', CallMethod);
+ end; { with }
+
+ with AddClass(TMainMenu, 'TFmxObject') do
+ with AddClass(TMenuBar, 'TStyledControl') do
+ AddMethod('procedure StartMenuLoop', CallMethod);
+
+ with AddClass(TPopupMenu, 'TFmxObject') do
+ AddMethod('procedure Popup(X, Y: Single)', CallMethod);
+
+ end; { with }
+
+end; { Create }
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; const
+ MethodName: string; Caller: TfsMethodHelper): Variant;
+var
+ oMenuItem: TMenuItem;
+begin
+ Result := 0;
+
+ if ClassType = TMenuItem then
+ begin
+
+ oMenuItem := TMenuItem(Instance);
+
+ if MethodName = 'POPUP' then
+ oMenuItem.Popup
+ else if MethodName = 'NEEDPOPUP' then
+ oMenuItem.NeedPopup
+ else if MethodName = 'HAVEPOPUP' then
+ Result := oMenuItem.HavePopup;
+
+ end
+ else if ClassType = TPopupMenu then
+ begin
+
+ if MethodName = 'POPUP' then
+ TPopupMenu(Instance).Popup(Caller.Params[0], Caller.Params[1]);
+
+ end;
+end; { CallMethod }
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsMenusRTTI, TFmxObject);
+ fsRTTIModules.Add(TFunctions);
+
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
+
diff --git a/LibD28/FMX.fs_iparser.pas b/LibD28/FMX.fs_iparser.pas
new file mode 100644
index 0000000..b922d9e
--- /dev/null
+++ b/LibD28/FMX.fs_iparser.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Parser }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_iparser;
+{$i FMX.inc}
+{$i fs_iparser.pas}
\ No newline at end of file
diff --git a/LibD28/FMX.fs_ipascal.pas b/LibD28/FMX.fs_ipascal.pas
new file mode 100644
index 0000000..33f4f12
--- /dev/null
+++ b/LibD28/FMX.fs_ipascal.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Pascal grammar }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_ipascal;
+{$i FMX.inc}
+{$i fs_ipascal.pas}
\ No newline at end of file
diff --git a/LibD28/FMX.fs_isysrtti.pas b/LibD28/FMX.fs_isysrtti.pas
new file mode 100644
index 0000000..b1405ee
--- /dev/null
+++ b/LibD28/FMX.fs_isysrtti.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Standard functions }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_isysrtti;
+{$i FMX.inc}
+{$i fs_isysrtti.pas}
\ No newline at end of file
diff --git a/LibD28/FMX.fs_itools.pas b/LibD28/FMX.fs_itools.pas
new file mode 100644
index 0000000..871b7c6
--- /dev/null
+++ b/LibD28/FMX.fs_itools.pas
@@ -0,0 +1,14 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Common functions }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_itools;
+{$i FMX.inc}
+{$i fs_itools.pas}
\ No newline at end of file
diff --git a/LibD28/FMX.fs_lazarus.pas b/LibD28/FMX.fs_lazarus.pas
new file mode 100644
index 0000000..7c4d3a2
--- /dev/null
+++ b/LibD28/FMX.fs_lazarus.pas
@@ -0,0 +1,25 @@
+{ This file was automatically created by Lazarus. do not edit!
+ This source is only used to compile and install the package.
+ }
+
+unit fs_lazarus;
+
+interface
+
+uses
+ fs_ipascal, fs_icpp, fs_ijs, fs_ibasic, fs_iclassesrtti, fs_iconst,
+ fs_idialogsrtti, fs_ievents, fs_iexpression, fs_iextctrlsrtti,
+ fs_iformsrtti, fs_igraphicsrtti, fs_iilparser, fs_iinirtti, fs_iinterpreter,
+ fs_iparser, fs_isysrtti, fs_itools, fs_xml, fs_ireg, fs_synmemo, fs_tree,
+ LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+ RegisterUnit('fs_ireg', @fs_ireg.Register);
+end;
+
+initialization
+ RegisterPackage('fs_lazarus', @Register);
+end.
diff --git a/LibD28/FMX.fs_synmemo.fmx b/LibD28/FMX.fs_synmemo.fmx
new file mode 100644
index 0000000..da0b5ed
--- /dev/null
+++ b/LibD28/FMX.fs_synmemo.fmx
@@ -0,0 +1,50 @@
+object fsSynMemoSearch: TfsSynMemoSearch
+ Left = 0
+ Top = 0
+ BorderStyle = bsToolWindow
+ Caption = 'Search for text'
+ ClientHeight = 129
+ ClientWidth = 249
+ Position = poScreenCenter
+ FormFactor.Width = 320
+ FormFactor.Height = 480
+ FormFactor.Devices = [dkDesktop, dkiPhone, dkiPad]
+ DesignerMobile = False
+ DesignerWidth = 0
+ DesignerHeight = 0
+ DesignerDeviceName = ''
+ DesignerOrientation = 0
+ object Edit1: TEdit
+ TabOrder = 0
+ Position.X = 48.000000000000000000
+ Position.Y = 13.000000000000000000
+ Width = 193.000000000000000000
+ Height = 22.000000000000000000
+ KillFocusByReturn = False
+ end
+ object Label1: TLabel
+ Height = 15.000000000000000000
+ Position.X = 8.000000000000000000
+ Position.Y = 16.000000000000000000
+ Text = 'Search :'
+ Width = 49.000000000000000000
+ end
+ object Search: TButton
+ Height = 17.000000000000000000
+ ModalResult = 1
+ Position.X = 88.000000000000000000
+ Position.Y = 48.000000000000000000
+ TabOrder = 2
+ Text = 'Search'
+ Width = 73.000000000000000000
+ end
+ object Button1: TButton
+ Height = 17.000000000000000000
+ ModalResult = 2
+ Position.X = 168.000000000000000000
+ Position.Y = 48.000000000000000000
+ TabOrder = 3
+ Text = 'Cancel'
+ Width = 73.000000000000000000
+ end
+end
diff --git a/LibD28/FMX.fs_synmemo.pas b/LibD28/FMX.fs_synmemo.pas
new file mode 100644
index 0000000..4b4f2c4
--- /dev/null
+++ b/LibD28/FMX.fs_synmemo.pas
@@ -0,0 +1,2397 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Syntax memo FMX control }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+{ Simple syntax highlighter. Supports Pascal, C++, JS, VB and SQL syntax.
+
+ Assign text to Text property.
+ Assign desired value to SyntaxType property.
+ Call SetPos to move caret.
+ Call ShowMessage to display an error message at the bottom.
+}
+
+unit FMX.fs_synmemo;
+
+interface
+
+{$I fs.inc}
+{$I fmx.inc}
+
+uses
+ System.Classes, System.Variants, System.UIConsts, System.SysUtils, System.UITypes, System.Types,
+ FMX.Controls, FMX.Forms, FMX.Menus, FMX.Types, FMX.Edit, FMX.Platform, FMX.TreeView
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Text
+{$ENDIF}
+{$IFDEF DELPHI29}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+ TSyntaxType = (stPascal, stCpp, stJs, stVB, stSQL, stText);
+ TCharAttr = (caNo, caText, caBlock, caComment, caKeyword, caString);
+ TCharAttributes = set of TCharAttr;
+
+type
+ TfsBorderSettings = class(TPersistent)
+ private
+ FFill: TBrush;
+ FWidth: Integer;
+ private
+ procedure SetFill(const Value: TBrush);
+ procedure SetWidth(const Value: Integer);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ published
+ property Fill: TBrush read FFill write SetFill;
+ property Width: Integer read FWidth write SetWidth;
+ end;
+
+ TfsFontSettings = class(TPersistent)
+ private
+ FFill: TBrush;
+ FFont: TFont;
+ procedure SetFill(const Value: TBrush);
+ procedure SetFont(const Value: TFont);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Fill: TBrush read FFill write SetFill;
+ property Font: TFont read FFont write SetFont;
+ end;
+
+{$i frxPlatformsAttribute.inc}
+ TfsSyntaxMemo = class(TStyledControl{$IFDEF DELPHI18}, ICaret{$ENDIF})
+ private
+{$IFDEF DELPHI18}
+ FCaret: TCaret;
+{$ENDIF}
+ FBorder: TfsBorderSettings;
+ FFill: TBrush;
+ FFontSettings: TfsFontSettings;
+ FGutterFill: TBrush;
+ FAllowLinesChange: Boolean;
+ FCharHeight: Single;
+ FCharWidth: Single;
+ FDoubleClicked: Boolean;
+ FDown: Boolean;
+ FGutterWidth: Integer;
+ FFooterHeight: Integer;
+ FIsMonoType: Boolean;
+ FKeywords: String;
+ FMaxLength: Integer;
+ FMessage: String;
+ FModified: Boolean;
+ FMoved: Boolean;
+ FOffset: TPoint;
+ FPos: TPoint;
+ FReadOnly: Boolean;
+ FSelEnd: TPoint;
+ FSelStart: TPoint;
+ FSynStrings: TStrings;
+ FSyntaxType: TSyntaxType;
+ FTempPos: TPoint;
+ FText: TStringList;
+ FKeywordAttr: TfsFontSettings;
+ FStringAttr: TfsFontSettings;
+ FTextAttr: TfsFontSettings;
+ FCommentAttr: TfsFontSettings;
+ FBlockColor: TAlphaColor;
+ FBlockFontColor: TAlphaColor;
+ FUndo: TStringList;
+ FUpdating: Boolean;
+ FUpdatingSyntax: Boolean;
+ FVScroll: TScrollBar;
+ FWindowSize: TPoint;
+ FPopupMenu: TPopupMenu;
+ KWheel: Integer;
+ LastSearch: String;
+ FShowGutter: boolean;
+ FShowFooter: boolean;
+ Bookmarks: array of Integer;
+ FActiveLine: Integer;
+ FOnChange: TNotifyEvent;
+ FTmpCanvas: TBitmap;
+ procedure CalcCharSize;
+ function GetCharWidth(Str: String): Single;
+ function GetText: TStrings;
+ procedure SetText(Value: TStrings);
+ procedure SetSyntaxType(Value: TSyntaxType);
+ procedure SetShowGutter(Value: boolean);
+ procedure SetShowFooter(Value: boolean);
+ function FMemoFind(Text: String; var Position : TPoint): boolean;
+ function GetCharAttr(Pos: TPoint): TCharAttributes;
+ function GetLineBegin(Index: Integer): Integer;
+ function GetPlainTextPos(Pos: TPoint): Integer;
+ function GetPosPlainText(Pos: Integer): TPoint;
+ function GetSelText: String;
+ function LineAt(Index: Integer): String;
+ function LineLength(Index: Integer): Integer;
+ function Pad(n: Integer): String;
+ procedure AddSel;
+ procedure AddUndo;
+ procedure ClearSel;
+ procedure CreateSynArray;
+ procedure DoChange;
+ procedure EnterIndent;
+ procedure SetSelText(Value: String);
+ procedure ShiftSelected(ShiftRight: Boolean);
+ procedure ShowCaretPos;
+ procedure TabIndent;
+ procedure UnIndent;
+ procedure UpdateScrollBar;
+ procedure UpdateSyntax;
+ procedure DoLeft;
+ procedure DoRight;
+ procedure DoUp;
+ procedure DoDown;
+ procedure DoHome(Ctrl: Boolean);
+ procedure DoEnd(Ctrl: Boolean);
+ procedure DoPgUp;
+ procedure DoPgDn;
+ procedure DoChar(Ch: Char);
+ procedure DoReturn;
+ procedure DoDel;
+ procedure DoBackspace;
+ procedure DoCtrlI;
+ procedure DoCtrlU;
+ procedure DoCtrlR;
+ procedure DoCtrlL;
+ procedure ScrollClick(Sender: TObject);
+ procedure ScrollEnter(Sender: TObject);
+ procedure LinesChange(Sender: TObject);
+ procedure ShowPos;
+ procedure BookmarkDraw(Y :Single; ALine : integer);
+ procedure ActiveLineDraw(Y :Single; ALine : integer);
+ procedure CorrectBookmark(Line : integer; delta : integer);
+ procedure SetKeywordAttr(Value: TfsFontSettings);
+ procedure SetStringAttr(Value: TfsFontSettings);
+ procedure SetTextAttr(Value: TfsFontSettings);
+ procedure SetCommentAttr(Value: TfsFontSettings);
+ procedure SetBorder(const Value: TfsBorderSettings);
+ procedure SetFill(const Value: TBrush);
+ procedure SetFontSettings(const Value: TfsFontSettings);
+ procedure SetGutterFill(const Value: TBrush);
+ protected
+ procedure SetParent(const Value: TFmxObject); override;
+ function GetClientRect: TRectF;
+ procedure DblClick; override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
+ procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
+ procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
+ procedure CopyPopup(Sender: TObject);
+ procedure PastePopup(Sender: TObject);
+ procedure CutPopup(Sender: TObject);
+ procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override;
+ procedure DOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+ procedure DDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+ procedure DoExit; override;
+ procedure Resize; override;
+ procedure UpdateWindowSize;
+ procedure FontChanged(Sender: TObject);
+ procedure DialogKey(var Key: Word; Shift: TShiftState); override;
+{$IFDEF Delphi18}
+ function ICaret.GetObject = GetCaret;
+ function GetCaret: TCustomCaret;
+ procedure SetCaret(const Value: TCaret);
+ procedure ShowCaret;
+ procedure HideCaret;
+{$ENDIF}
+{$IFDEF Delphi17}
+ function CreateCaret: TCaret; {$IFNDEF Delphi18} override; {$ENDIF}
+{$ENDIF}
+ procedure SetAttr(aCanvas: TCanvas; a: TCharAttributes);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Paint; override;
+ procedure CopyToClipboard;
+ procedure CutToClipboard;
+ procedure PasteFromClipboard;
+ procedure SetPos(x, y: Integer);
+ procedure ShowMessage(s: String);
+ procedure Undo;
+ procedure UpdateView;
+ function GetPos: TPoint;
+ function Find(Text: String): boolean;
+ property Modified: Boolean read FModified write FModified;
+ property SelText: String read GetSelText write SetSelText;
+ function IsBookmark(Line : integer): integer;
+ procedure AddBookmark(Line, Number : integer);
+ procedure DeleteBookmark(Number : integer);
+ procedure GotoBookmark(Number : integer);
+ procedure SetActiveLine(Line : Integer);
+ function GetActiveLine: Integer;
+{$IFDEF Delphi18}
+ property Caret: TCaret read FCaret write SetCaret;
+{$ENDIF}
+ published
+ property Align;
+ property Anchors;
+ property DragMode;
+ property Enabled;
+ property PopupMenu;
+ property ShowHint;
+ property TabOrder;
+ property Width;
+ property Height;
+ property Visible;
+{$IFDEF Delphi18}
+ property Cursor;
+{$ENDIF}
+ property BlockColor: TAlphaColor read FBlockColor write FBlockColor;
+ property BlockFontColor: TAlphaColor read FBlockFontColor write FBlockFontColor;
+ property CommentAttr: TfsFontSettings read FCommentAttr write SetCommentAttr;
+ property KeywordAttr: TfsFontSettings read FKeywordAttr write SetKeywordAttr;
+ property StringAttr: TfsFontSettings read FStringAttr write SetStringAttr;
+ property TextAttr: TfsFontSettings read FTextAttr write SetTextAttr;
+ property Border: TfsBorderSettings read FBorder write SetBorder;
+ property Fill: TBrush read FFill write SetFill;
+ property FontSettings: TfsFontSettings read FFontSettings write SetFontSettings;
+ property GutterFill: TBrush read FGutterFill write SetGutterFill;
+ property Lines: TStrings read GetText write SetText;
+ property ReadOnly: Boolean read FReadOnly write FReadOnly;
+ property SyntaxType: TSyntaxType read FSyntaxType write SetSyntaxType;
+ property ShowFooter: boolean read FShowFooter write SetShowFooter;
+ property ShowGutter: boolean read FShowGutter write SetShowGutter;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ property OnClick;
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfsSynMemoSearch = class(TForm)
+ Search: TButton;
+ Button1: TButton;
+ Label1: TLabel;
+ Edit1: TEdit;
+ procedure FormKeyPress(Sender: TObject; var Key: Char);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ SynMemoSearch: TfsSynMemoSearch;
+
+implementation
+
+{$R *.FMX}
+{$IFDEF DELPHI18}
+type THachCaret = class(TCaret);
+{$ENDIF}
+
+const
+ PasKeywords =
+ 'and,array,begin,case,const,div,do,downto,else,end,except,finally,'+
+ 'for,function,if,in,is,mod,nil,not,of,or,procedure,program,repeat,shl,'+
+ 'shr,string,then,to,try,until,uses,var,while,with,xor';
+
+ CppKeywords =
+ 'bool,break,case,char,continue,define,default,delete,do,double,else,'+
+ 'except,finally,float,for,if,include,int,is,new,return,string,switch,try,'+
+ 'variant,void,while';
+
+ SQLKeywords =
+ 'active,after,all,alter,and,any,as,asc,ascending,at,auto,' +
+ 'base_name,before,begin,between,by,cache,cast,check,column,commit,' +
+ 'committed,computed,conditional,constraint,containing,count,create,' +
+ 'current,cursor,database,debug,declare,default,delete,desc,descending,' +
+ 'distinct,do,domain,drop,else,end,entry_point,escape,exception,execute,' +
+ 'exists,exit,external,extract,filter,for,foreign,from,full,function,' +
+ 'generator,grant,group,having,if,in,inactive,index,inner,insert,into,is,' +
+ 'isolation,join,key,left,level,like,merge,names,no,not,null,of,on,only,' +
+ 'or,order,outer,parameter,password,plan,position,primary,privileges,' +
+ 'procedure,protected,read,retain,returns,revoke,right,rollback,schema,' +
+ 'select,set,shadow,shared,snapshot,some,suspend,table,then,to,' +
+ 'transaction,trigger,uncommitted,union,unique,update,user,using,values,' +
+ 'view,wait,when,where,while,with,work';
+
+ JSKeywords =
+ 'break,case,continue,default,delete,do,else,except,finally,for,function,' +
+ 'import,in,is,if,new,return,switch,try,var,while,with';
+
+ VBKeywords =
+ 'addressof,and,as,byref,byval,case,catch,delete,dim,do,else,elseif,' +
+ 'end,endif,exit,finally,for,function,if,imports,is,loop,mod,new,next,' +
+ 'not,or,rem,return,select,set,step,sub,then,to,try,wend,while,with,xor';
+
+
+ WordChars = ['a'..'z', 'A'..'Z', '0'..'9', '_'];
+ LineBreak: AnsiString = sLineBreak;
+
+function IsUnicodeChar(Chr: Char): Boolean;
+begin
+ Result := ((Chr >= Char($007F)) and (Chr <= Char($FFFF)));
+end;
+
+
+{ TfsSyntaxMemo }
+
+constructor TfsSyntaxMemo.Create(AOwner: TComponent);
+var
+ m: TMenuItem;
+ i: integer;
+begin
+ inherited Create(AOwner);
+ FTmpCanvas := TBitmap.Create(1, 1);
+{$IFDEF DELPHI18}
+ FCaret := CreateCaret;
+{$ENDIF}
+ FVScroll := TScrollBar.Create(Self);
+ FVScroll.Stored := False;
+ FVScroll.Orientation := TOrientation.orVertical;
+
+ FFontSettings := TfsFontSettings.Create;
+ FFontSettings.Font.OnChanged := FontChanged;
+ FFontSettings.Fill.Color := TAlphaColorRec.Black;
+
+ FCommentAttr := TfsFontSettings.Create;
+ FCommentAttr.Fill.Color := TAlphaColorRec.Green;
+ FCommentAttr.Font.Style := [TFontStyle.fsItalic];
+
+ FKeywordAttr := TfsFontSettings.Create;
+ FKeywordAttr.FFill.Color := TAlphaColorRec.Navy;
+ FKeywordAttr.Font.Style := [TFontStyle.fsBold];
+
+ FStringAttr := TfsFontSettings.Create;
+ FStringAttr.Fill.Color := TAlphaColorRec.Navy;
+ FStringAttr.Font.Style := [];
+
+ FTextAttr := TfsFontSettings.Create;
+ FTextAttr.Fill.Color := TAlphaColorRec.Black;
+ FTextAttr.Font.Style := [];
+
+ FBorder := TfsBorderSettings.Create;
+ FFill := TBrush.Create(TBrushKind.bkSolid, TAlphaColorRec.White);
+ FGutterFill := TBrush.Create(TBrushKind.bkSolid, TAlphaColorRec.Whitesmoke);
+
+ if AOwner is TFmxObject then
+ Parent := AOwner as TFmxObject;
+
+ OnDragOver := DOver;
+ OnDragDrop := DDrop;
+ KWheel := -1;
+
+
+ FText := TStringList.Create;
+ FUndo := TStringList.Create;
+ FSynStrings := TStringList.Create;
+ FText.Add('');
+ FText.OnChange := LinesChange;
+ FMaxLength := 1024;
+ SyntaxType := stPascal;
+ FMoved := True;
+ SetPos(1, 1);
+ FOffset := Point(0, 0);
+ CanFocus := True;
+ Cursor := crIBeam;
+
+ FBlockColor := TAlphaColorRec.Blue;
+ FBlockFontColor := TAlphaColorRec.White;
+
+ FPopupMenu := TPopupMenu.Create(Self);
+ m := TMenuItem.Create(FPopupMenu);
+ m.Text := 'Cut';
+ m.OnClick := CutPopup;
+ FPopupMenu.AddObject(m);
+ m := TMenuItem.Create(FPopupMenu);
+ m.Text := 'Copy';
+ m.OnClick := CopyPopup;
+ FPopupMenu.AddObject(m);
+ m := TMenuItem.Create(FPopupMenu);
+ m.Text := 'Paste';
+ m.OnClick := PastePopup;
+ FPopupMenu.AddObject(m);
+
+ LastSearch := '';
+ Setlength(Bookmarks, 10);
+ for i := 0 to Length(Bookmarks)-1 do
+ Bookmarks[i] := -1;
+
+ FActiveLine := -1;
+
+ Height := 200;
+ Width := 200;
+ CalcCharSize;
+end;
+
+destructor TfsSyntaxMemo.Destroy;
+begin
+ FPopupMenu.Free;
+ FCommentAttr.Free;
+ FKeywordAttr.Free;
+ FStringAttr.Free;
+ FFontSettings.Free;
+ FTextAttr.Free;
+ FText.Free;
+ FUndo.Free;
+ FSynStrings.Free;
+ //FVScroll.Free;
+ FFill.Free;
+ FBorder.Free;
+ FGutterFill.Free;
+{$IFDEF DELPHI18}
+ FCaret.Free;
+{$ENDIF}
+ FreeAndNil(FTmpCanvas);
+ inherited;
+end;
+
+procedure TfsSyntaxMemo.CalcCharSize;
+var
+ tmpBmp: TBitmap;
+ r: TRectF;
+begin
+ tmpBmp := TBitmap.Create(1, 1);
+ with tmpBmp.Canvas do
+ begin
+ Font.Assign(FFontSettings.Font);
+ Font.Style := [];
+ r := RectF(0, 0, 1000, 1000);
+ MeasureText(r, 'WWWWWW', True, [], TTextAlign.taLeading); // taLeading returns incorrect results in xe2
+ FCharHeight := r.Height + 2;
+ FCharWidth := r.Width / 6;
+ FIsMonoType := Pos('COURIER NEW', AnsiUppercase(FFontSettings.Font.Family)) <> 0;
+ end;
+ tmpBmp.Free;
+end;
+
+{$IFDEF Delphi17}
+function TfsSyntaxMemo.CreateCaret: TCaret;
+begin
+ Result := TCaret.Create(Self);
+ Result.Visible := True;
+{$IFDEF DELPHI20}
+ Result.ReadOnly := False;
+ Result.Color := claBlack;
+{$ENDIF}
+ Result.Pos := TPointF.Create(1, 1);
+end;
+{$ENDIF}
+
+{$IFDEF DELPHI18}
+function TfsSyntaxMemo.GetCaret: TCustomCaret;
+begin
+ Result := FCaret;
+end;
+
+procedure TfsSyntaxMemo.SetCaret(const Value: TCaret);
+begin
+ if Assigned(FCaret) then
+ FCaret.Assign(Value);
+end;
+
+procedure TfsSyntaxMemo.ShowCaret;
+begin
+ THachCaret(FCaret).Show;
+end;
+
+procedure TfsSyntaxMemo.HideCaret;
+begin
+ THachCaret(FCaret).Hide;
+end;
+{$ENDIF}
+
+procedure TfsSyntaxMemo.ShowCaretPos;
+var
+ cWidth: Single;
+ LineLen: Integer;
+begin
+ cWidth := GetCharWidth(Copy(LineAt(FPos.Y - 1), FOffset.X, FPos.X - 1 - FOffset.X));
+ LineLen := LineLength(FPos.Y - 1);
+ if LineLen < FPos.X then
+ cWidth := Round(cWidth + FCharWidth * (FPos.X - 1 - LineLen));
+{$IFNDEF Delphi18}
+{$IFDEF Delphi17}
+ if IsFocused then
+ begin
+ CaretVisible := False;
+ SetCaretParams(PointF(
+ FCharWidth * (FPos.X - 1 - FOffset.X) + FGutterWidth + FBorder.Width + 1,
+ FCharHeight * (FPos.Y - 1 - FOffset.Y) + 1),
+ PointF(2, FCharHeight), claBlack);
+ CaretVisible := True;
+ end
+ else
+ CaretVisible := False;
+{$ELSE}
+ if IsFocused then
+ begin
+ SetCaretSize(PointF(2, FCharHeight));
+ SetCaretPos(PointF(
+ FCharWidth * (FPos.X - 1 - FOffset.X) + FGutterWidth + FBorder.Width + 1,
+ FCharHeight * (FPos.Y - 1 - FOffset.Y) + 1));
+ ShowCaretProc;
+ end
+ else
+ HideCaret;
+{$ENDIF}
+{$ELSE}
+ if IsFocused then
+ begin
+ //SetCaretSize(PointF(2, FCharHeight));
+ FCaret.Size := PointF(2, FCharHeight);
+ FCaret.Pos := PointF(
+ cWidth + FGutterWidth + FBorder.Width + 1,
+ FCharHeight * (FPos.Y - 1 - FOffset.Y) + 1);
+ ShowCaret;
+// SetCaretPos(PointF(
+// FCharWidth * (FPos.X - 1 - FOffset.X) + FGutterWidth + FBorder.Width + 1,
+// FCharHeight * (FPos.Y - 1 - FOffset.Y) + 1));
+// ShowCaretProc;
+ end
+ else
+ HideCaret;
+{$ENDIF}
+end;
+
+procedure TfsSyntaxMemo.ShowPos;
+var
+ cRect: TRectF;
+begin
+ if FFooterHeight > 0 then
+ with Canvas do
+ begin
+ Font.Family := 'Tahoma';
+ Font.Style := [];
+ Font.Size := 11;
+ Fill.Color := TAlphaColorRec.Black;
+ cRect := GetClientRect;
+ FillText(RectF(cRect.Left + FGutterWidth + 2, cRect.Bottom - TextHeight('|') - 8,
+ FGutterWidth + 4 + FCharWidth * 10 ,
+ (Self.Height - TextHeight('|') - 4) + FCharHeight), IntToStr(FPos.y)
+ + ' : ' + IntToStr(FPos.x) + ' ', FALSE, 1, [], TTextAlign.taLeading);
+ end;
+end;
+
+procedure TfsSyntaxMemo.SetParent(const Value: TFmxObject);
+begin
+ inherited SetParent(Value);
+ if (Parent = nil) or (csDestroying in ComponentState) then Exit;
+ ShowGutter := True;
+ ShowFooter := True;
+ FVScroll.Parent := Self;
+ FVScroll.OnChange := ScrollClick;
+ FVScroll.OnEnter := ScrollEnter;
+end;
+
+function TfsSyntaxMemo.GetClientRect: TRectF;
+begin
+ if FVScroll.Visible then
+ Result := RectF(FBorder.Width, FBorder.Width,
+ Width - FVScroll.Width - FBorder.Width,
+ Height - FBorder.Width)
+ else
+ Result := RectF(FBorder.Width, FBorder.Width,
+ Width - FBorder.Width, Height - FBorder.Width);
+end;
+
+procedure TfsSyntaxMemo.UpdateSyntax;
+begin
+ CreateSynArray;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.UpdateScrollBar;
+begin
+ with FVScroll do
+ begin
+// prevent OnScroll event
+ FUpdating := True;
+
+ Value := 0;
+ ViewportSize := 0;
+
+ Max := FText.Count;
+ SmallChange := 1;
+ if FWindowSize.Y < Max then
+ begin
+ Visible := True;
+ ViewportSize := FWindowSize.Y;
+ end
+ else
+ Visible := False;
+ ViewportSize := FWindowSize.Y;
+ Value := FOffset.Y;
+
+ FUpdating := False;
+ end;
+end;
+
+function TfsSyntaxMemo.GetText: TStrings;
+var
+ i: Integer;
+begin
+ for i := 0 to FText.Count - 1 do
+ FText[i] := LineAt(i);
+ Result := FText;
+ FAllowLinesChange := True;
+end;
+
+procedure TfsSyntaxMemo.SetText(Value: TStrings);
+begin
+ FAllowLinesChange := True;
+ FText.Assign(Value);
+end;
+
+procedure TfsSyntaxMemo.SetSyntaxType(Value: TSyntaxType);
+begin
+ FSyntaxType := Value;
+ if Value = stPascal then
+ FKeywords := PasKeywords
+ else if Value = stCpp then
+ FKeywords := CppKeywords
+ else if Value = stSQL then
+ FKeywords := SQLKeywords
+ else if Value = stVB then
+ FKeywords := VBKeywords
+ else if Value = stJS then
+ FKeywords := JSKeywords
+ else
+ FKeywords := '';
+ UpdateSyntax;
+end;
+
+function TfsSyntaxMemo.GetPos: TPoint;
+begin
+ Result := FPos;
+end;
+
+procedure TfsSyntaxMemo.DoChange;
+begin
+ FModified := True;
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+end;
+
+procedure TfsSyntaxMemo.LinesChange(Sender: TObject);
+begin
+ if FAllowLinesChange then
+ begin
+ UpdateSyntax;
+ FAllowLinesChange := False;
+ if FText.Count = 0 then
+ FText.Add('');
+ FMoved := True;
+ FUndo.Clear;
+ FPos := Point(1, 1);
+ FOffset := Point(0, 0);
+ SetPos(FPos.X, FPos.Y);
+ ClearSel;
+ ShowCaretPos;
+ UpdateScrollBar;
+ end;
+end;
+
+procedure TfsSyntaxMemo.ShowMessage(s: String);
+begin
+ FMessage := s;
+ Repaint;
+end;
+
+procedure SetClipboard(const Value: String);
+{$IFDEF Delphi17}
+var
+ ClipService: IFMXClipboardService;
+begin
+ if TPlatformServices.Current.SupportsPlatformService(IFMXClipboardService, IInterface(ClipService)) then
+ ClipService.SetClipboard(Value);
+end;
+{$ELSE}
+begin
+ Platform.SetClipboard(Value);
+end;
+{$ENDIF}
+
+function GetClipboard: String;
+{$IFDEF Delphi17}
+var
+ ClipService: IFMXClipboardService;
+begin
+ if TPlatformServices.Current.SupportsPlatformService(IFMXClipboardService, IInterface(ClipService)) then
+ Result := ClipService.GetClipboard.ToString
+ else
+ Result := '';
+end;
+{$ELSE}
+begin
+ Result := VarToStr(Platform.GetClipboard);
+end;
+{$ENDIF}
+
+procedure TfsSyntaxMemo.CopyToClipboard;
+begin
+ if FSelStart.X <> 0 then
+ SetClipboard(SelText);
+end;
+
+procedure TfsSyntaxMemo.CutToClipboard;
+begin
+ if not FReadOnly then
+ begin
+ if FSelStart.X <> 0 then
+ begin
+ SetClipboard(SelText);
+ SelText := '';
+ end;
+ CorrectBookmark(FSelStart.Y, FSelStart.Y - FSelEnd.Y);
+ Repaint;
+ end;
+end;
+
+procedure TfsSyntaxMemo.PasteFromClipboard;
+begin
+ if (not FReadOnly) then
+ SelText := GetClipboard;
+end;
+
+function TfsSyntaxMemo.LineAt(Index: Integer): String;
+begin
+ if Index < FText.Count then
+ Result := TrimRight(FText[Index])
+ else
+ Result := '';
+end;
+
+function TfsSyntaxMemo.LineLength(Index: Integer): Integer;
+begin
+ if Index < 0 then
+ Result := 0 else
+ Result := Length(LineAt(Index));
+end;
+
+function TfsSyntaxMemo.Pad(n: Integer): String;
+begin
+ result := '';
+ SetLength(result, n);
+ Result := StringOfChar(Char(' '), n)
+end;
+
+procedure TfsSyntaxMemo.AddUndo;
+begin
+ if not FMoved then exit;
+ FUndo.Add(Format('%5d%5d', [FPos.X, FPos.Y]) + FText.Text);
+ if FUndo.Count > 32 then
+ FUndo.Delete(0);
+end;
+
+procedure TfsSyntaxMemo.Undo;
+var
+ s: String;
+begin
+ FMoved := True;
+ if FUndo.Count = 0 then exit;
+ s := FUndo[FUndo.Count - 1];
+ FPos.X := StrToInt(Copy(s, 1, 5));
+ FPos.Y := StrToInt(Copy(s, 6, 5));
+ FText.Text := Copy(s, 11, Length(s) - 10);
+ FUndo.Delete(FUndo.Count - 1);
+ SetPos(FPos.X, FPos.Y);
+ UpdateSyntax;
+ DoChange;
+end;
+
+function TfsSyntaxMemo.GetPlainTextPos(Pos: TPoint): Integer;
+var
+ i: Integer;
+begin
+ Result := 0;
+ for i := 0 to Pos.Y - 2 do
+ Result := Result + Length(FText[i]) + Length(LineBreak);
+ Result := Result + Pos.X;
+end;
+
+function TfsSyntaxMemo.GetPosPlainText(Pos: Integer): TPoint;
+var
+ i: Integer;
+ s: String;
+begin
+ Result := Point(0, 1);
+ s := FText.Text;
+ i := 1;
+ while i <= Pos do
+ if s[i] = Char(LineBreak[1]) then
+ begin
+ Inc(i, Length(LineBreak));
+ if i <= Pos then
+ begin
+ Inc(Result.Y);
+ Result.X := 0;
+ end
+ else
+ Inc(Result.X);
+ end
+ else
+ begin
+ Inc(i);
+ Inc(Result.X);
+ end;
+end;
+
+function TfsSyntaxMemo.GetLineBegin(Index: Integer): Integer;
+var
+ s: String;
+begin
+ s := FText[Index];
+ Result := 1;
+ if Trim(s) <> '' then
+ for Result := 1 to Length(s) do
+ if s[Result] <> ' ' then
+ break;
+end;
+
+procedure TfsSyntaxMemo.TabIndent;
+begin
+ SelText := Pad(2);
+end;
+
+procedure TfsSyntaxMemo.EnterIndent;
+var
+ res: Integer;
+begin
+ if Trim(FText[FPos.Y - 1]) = '' then
+ res := FPos.X else
+ res := GetLineBegin(FPos.Y - 1);
+
+ CorrectBookmark(FPos.Y, 1);
+
+ FPos := Point(1, FPos.Y + 1);
+ SelText := Pad(res - 1);
+end;
+
+procedure TfsSyntaxMemo.UnIndent;
+var
+ i, res: Integer;
+begin
+ i := FPos.Y - 2;
+ res := FPos.X - 1;
+ CorrectBookmark(FPos.Y, -1);
+ while i >= 0 do
+ begin
+ res := GetLineBegin(i);
+ if (res < FPos.X) and (Trim(FText[i]) <> '') then
+ break else
+ Dec(i);
+ end;
+ FSelStart := FPos;
+ FSelEnd := FPos;
+ Dec(FSelEnd.X, FPos.X - res);
+ SelText := '';
+end;
+
+procedure TfsSyntaxMemo.ShiftSelected(ShiftRight: Boolean);
+var
+ i, ib, ie: Integer;
+ s: String;
+ Shift: Integer;
+begin
+ if FReadOnly then exit;
+ AddUndo;
+ if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
+ begin
+ ib := FSelStart.Y - 1;
+ ie := FSelEnd.Y - 1;
+ end
+ else
+ begin
+ ib := FSelEnd.Y - 1;
+ ie := FSelStart.Y - 1;
+ end;
+ if FSelEnd.X = 1 then
+ Dec(ie);
+
+ Shift := 2;
+ if not ShiftRight then
+ for i := ib to ie do
+ begin
+ s := FText[i];
+ if (Trim(s) <> '') and (GetLineBegin(i) - 1 < Shift) then
+ Shift := GetLineBegin(i) - 1;
+ end;
+
+ for i := ib to ie do
+ begin
+ s := FText[i];
+ if ShiftRight then
+ s := Pad(Shift) + s
+ else if Trim(s) <> '' then
+ Delete(s, 1, Shift);
+ FText[i] := s;
+ end;
+ UpdateSyntax;
+ DoChange;
+end;
+
+function TfsSyntaxMemo.GetSelText: String;
+var
+ p1, p2: TPoint;
+ i: Integer;
+begin
+ if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
+ begin
+ p1 := FSelStart;
+ p2 := FSelEnd;
+ Dec(p2.X);
+ end
+ else
+ begin
+ p1 := FSelEnd;
+ p2 := FSelStart;
+ Dec(p2.X);
+ end;
+
+ if LineLength(p1.Y - 1) < p1.X then
+ begin
+ Inc(p1.Y);
+ p1.X := 1;
+ end;
+ if LineLength(p2.Y - 1) < p2.X then
+ p2.X := LineLength(p2.Y - 1);
+
+ i := GetPlainTextPos(p1);
+ Result := Copy(FText.Text, i, GetPlainTextPos(p2) - i + 1);
+end;
+
+procedure TfsSyntaxMemo.SetSelText(Value: String);
+var
+ p1, p2, p3: TPoint;
+ i: Integer;
+ s: String;
+begin
+ if FReadOnly then exit;
+ AddUndo;
+ if FSelStart.X = 0 then
+ begin
+ p1 := FPos;
+ p2 := p1;
+ Dec(p2.X);
+ end
+ else if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
+ begin
+ p1 := FSelStart;
+ p2 := FSelEnd;
+ Dec(p2.X);
+ end
+ else
+ begin
+ p1 := FSelEnd;
+ p2 := FSelStart;
+ Dec(p2.X);
+ end;
+
+ if LineLength(p1.Y - 1) < p1.X then
+ FText[p1.Y - 1] := FText[p1.Y - 1] + Pad(p1.X - LineLength(p1.Y - 1) + 1);
+ if LineLength(p2.Y - 1) < p2.X then
+ p2.X := LineLength(p2.Y - 1);
+
+ i := GetPlainTextPos(p1);
+ s := FText.Text;
+ Delete(s, i, GetPlainTextPos(p2) - i + 1);
+ Insert(Value, s, i);
+ FText.Text := s;
+ p3 := GetPosPlainText(i + Length(Value));
+
+ CorrectBookmark(FPos.Y, p3.y-FPos.Y);
+
+ SetPos(p3.X, p3.Y);
+ FSelStart.X := 0;
+ DoChange;
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.ClearSel;
+begin
+ if FSelStart.X <> 0 then
+ begin
+ FSelStart := Point(0, 0);
+ Repaint;
+ end;
+end;
+
+procedure TfsSyntaxMemo.AddSel;
+begin
+ if FSelStart.X = 0 then
+ FSelStart := FTempPos;
+ FSelEnd := FPos;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.SetPos(x, y: Integer);
+begin
+ if FMessage <> '' then
+ begin
+ FMessage := '';
+ Repaint;
+ end;
+
+ if x > FMaxLength then x := FMaxLength;
+ if x < 1 then x := 1;
+ if y > FText.Count then y := FText.Count;
+ if y < 1 then y := 1;
+
+ FPos := Point(x, y);
+ if (FWindowSize.X = 0) or (FWindowSize.Y = 0) then exit;
+
+ if FOffset.Y >= FText.Count then
+ FOffset.Y := FText.Count - 1;
+
+ if FPos.X > FOffset.X + FWindowSize.X then
+ begin
+ FOffset.X := FOffset.X + FPos.X - (FOffset.X + FWindowSize.X);
+ Repaint;
+ end
+ else if FPos.X <= FOffset.X then
+ begin
+ FOffset.X := FOffset.X - (FOffset.X - FPos.X + 1);
+ Repaint;
+ end
+ else if FPos.Y > FOffset.Y + FWindowSize.Y then
+ begin
+ FOffset.Y := FOffset.Y + FPos.Y - (FOffset.Y + FWindowSize.Y);
+ Repaint;
+ end
+ else if FPos.Y <= FOffset.Y then
+ begin
+ FOffset.Y := FOffset.Y - (FOffset.Y - FPos.Y + 1);
+ Repaint;
+ end;
+
+ ShowCaretPos;
+ UpdateScrollBar;
+
+end;
+
+procedure TfsSyntaxMemo.ScrollClick(Sender: TObject);
+begin
+ if FUpdating then exit;
+ FOffset.Y := Round(FVScroll.Value);
+ if FOffset.Y > FText.Count then
+ FOffset.Y := FText.Count;
+ ShowCaretPos;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.ScrollEnter(Sender: TObject);
+begin
+ SetFocus;
+end;
+
+procedure TfsSyntaxMemo.DblClick;
+var
+ s: String;
+begin
+ FDoubleClicked := True;
+ DoCtrlL;
+ FSelStart := FPos;
+ s := LineAt(FPos.Y - 1);
+ if s <> '' then
+ while CharInSet(s[FPos.X],WordChars)
+ or IsUnicodeChar(s[FPos.X]) do
+ Inc(FPos.X);
+ FSelEnd := FPos;
+ Repaint;
+end;
+
+function GetComponentForm(Comp: TFmxObject): TCommonCustomForm;
+begin
+ Result := nil;
+ while (Comp.Parent <> nil) do
+ begin
+ if (Comp.Parent is TCommonCustomForm) then
+ begin
+ Result := Comp.Parent as TCommonCustomForm;
+ Exit;
+ end;
+ Comp := Comp.Parent;
+ end;
+end;
+
+procedure TfsSyntaxMemo.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+var
+ pt: TPointF;
+ f: TCommonCustomForm;
+ r: TRectF;
+ LStr, s: String;
+ i, cIndex: Integer;
+
+begin
+ if FDoubleClicked then
+ begin
+ FDoubleClicked := False;
+ Exit;
+ end;
+ if Button = TMouseButton.mbRight then
+ begin
+ if PopupMenu = nil then
+ begin
+ f := GetComponentForm(Self);
+ if f <> nil then
+ begin
+ pt := f.ClientToScreen(PointF(AbsoluteRect.Left + X, AbsoluteRect.Top + Y));
+ FPopUpMenu.Popup(pt.X, pt.Y);
+ end;
+ end;
+ end
+ else
+ begin
+ FMoved := True;
+ if not IsFocused then
+ SetFocus;
+ FDown := True;
+ if FIsMonoType then
+ SetPos(Round((X - FGutterWidth) / FCharWidth) + 1 + FOffset.X,
+ Trunc(Y / FCharHeight) + 1 + FOffset.Y)
+ else
+ begin
+ cIndex := 0;
+ LStr := LineAt(FPos.Y - 1);
+ LStr := Copy(LineAt(FPos.Y - 1), FOffset.X + 1, Length(LStr) - (FOffset.X + 1));
+ for i := 1 to Length(LStr) do
+ begin
+ s := Copy(LStr, 1, i);
+ r := RectF(0, 0, 100000, 100000);
+ FTmpCanvas.Canvas.MeasureText(r, s, False, [], TTextAlign.taLeading);
+ if r.Width >= X - FGutterWidth then
+ begin
+ cIndex := i;
+ break;
+ end;
+ end;
+ SetPos(cIndex + 1 + FOffset.X,
+ Trunc(Y / FCharHeight) + 1 + FOffset.Y)
+ end;
+ ClearSel;
+ end;
+end;
+
+procedure TfsSyntaxMemo.MouseMove(Shift: TShiftState; X, Y: Single);
+begin
+ if FDown then
+ begin
+ FTempPos := FPos;
+ FPos.X := Round((X - FGutterWidth) / FCharWidth) + 1 + FOffset.X;
+ FPos.Y := Round(Y / FCharHeight) + 1 + FOffset.Y;
+ if (FPos.X <> FTempPos.X) or (FPos.Y <> FTempPos.Y) then
+ begin
+ SetPos(FPos.X, FPos.Y);
+ AddSel;
+ end;
+ end;
+end;
+
+procedure TfsSyntaxMemo.MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Single);
+begin
+ FDown := False;
+end;
+
+procedure TfsSyntaxMemo.MouseWheel(Shift: TShiftState; WheelDelta: Integer;
+ var Handled: Boolean);
+begin
+ inherited;
+ FVScroll.Value := FVScroll.Value + (WheelDelta div ABS(WheelDelta)) * KWheel;
+end;
+
+procedure TfsSyntaxMemo.DialogKey(var Key: Word; Shift: TShiftState);
+begin
+ inherited;
+ if Key = 9 then
+ begin
+ if Shift = [] then
+ begin
+ if FSelStart.X <> 0 then
+ DoCtrlI
+ else
+ TabIndent;
+ end
+ else if Shift = [ssShift] then
+ DoCtrlU;
+ FMoved := True;
+ end;
+end;
+
+procedure TfsSyntaxMemo.KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+var
+ MyKey: Boolean;
+begin
+ inherited;
+ FAllowLinesChange := False;
+
+ FTempPos := FPos;
+ MyKey := True;
+ case Key of
+ vkLeft:
+ if ssCtrl in Shift then
+ DoCtrlL else
+ DoLeft;
+
+ vkRight:
+ if ssCtrl in Shift then
+ DoCtrlR else
+ DoRight;
+
+ vkUp:
+ DoUp;
+
+ vkDown:
+ DoDown;
+
+ vkHome:
+ DoHome(ssCtrl in Shift);
+
+ vkEnd:
+ DoEnd(ssCtrl in Shift);
+
+ vkPrior:
+ DoPgUp;
+
+ vkNext:
+ DoPgDn;
+
+ vkReturn:
+ if Shift = [] then
+ DoReturn;
+
+ vkDelete:
+ if ssShift in Shift then
+ CutToClipboard else
+ DoDel;
+
+ vkBack:
+ DoBackspace;
+
+ vkInsert:
+ if ssCtrl in Shift then
+ CopyToClipboard
+ else if ssShift in Shift then
+ PasteFromClipboard;
+
+ vkF3:
+ Find(LastSearch); // F3 Repeat search
+
+ else
+ MyKey := False;
+ end;
+
+ if (Shift = [ssCtrl]) or (Shift = [ssCommand]) then
+ begin
+ MyKey := True;
+ if (Key = Ord('c')) or (Key = Ord('C')) then // Ctrl+C Copy
+ CopyToClipboard
+ else if (Key = Ord('v')) or (Key = Ord('V')) then // Ctrl+V Paste
+ PasteFromClipboard
+ else if (Key = Ord('x')) or (Key = Ord('X')) then // Ctrl+X Cut
+ CutToClipboard
+ else if (Key = Ord('z')) or (Key = Ord('Z')) then // Ctrl+Z Undo
+ Undo
+ else if (Key = Ord('a')) or (Key = Ord('A')) then // Ctrl+A Select all
+ begin
+ SetPos(0, 0);
+ FSelStart := FPos;
+ SetPos(LineLength(FText.Count - 1) + 1, FText.Count);
+ FSelEnd := FPos;
+ Repaint;
+ end
+ else if (Key = Ord('f')) or (Key = Ord('F')) then // Ctrl+F Search
+ begin
+ SynMemoSearch := TfsSynMemoSearch.Create(nil);
+ if SynMemoSearch.ShowModal = mrOk then
+ Find(SynMemoSearch.Edit1.Text);
+ LastSearch := SynMemoSearch.Edit1.Text;
+ SynMemoSearch.Free;
+ end
+ else if (Key = Ord('y')) or (Key = Ord('Y')) then // Ctrl+Y Delete line
+ begin
+ if FText.Count > FPos.Y then
+ begin
+ FMoved := True;
+ AddUndo;
+ FText.Delete(FPos.Y - 1);
+ CorrectBookmark(FPos.Y, -1);
+ UpdateSyntax;
+ end
+ else
+ if FText.Count = FPos.Y then
+ begin
+ FMoved := True;
+ AddUndo;
+ FText[FPos.Y - 1] := '';
+ FPos.X := 1;
+ SetPos(FPos.X, FPos.Y);
+ UpdateSyntax;
+ end
+ end
+ else if Key in [48..57] then
+ GotoBookmark(Key-48)
+ else
+ MyKey := False;
+ end;
+
+ if Shift = [ssCtrl, ssShift] then
+ if Key in [48..57] then
+ if IsBookmark(FPos.Y - 1) < 0 then
+ AddBookmark(FPos.Y - 1, Key-48)
+ else
+ if IsBookmark(FPos.Y - 1) = (Key-48) then
+ DeleteBookmark(Key-48);
+
+
+ if Key in [vkLeft, vkRight, vkUp, vkDown, vkHome, vkEnd, vkPrior, vkNext] then
+ begin
+ FMoved := True;
+ if ssShift in Shift then
+ AddSel else
+ ClearSel;
+ end
+ else if Key in [vkReturn, vkDelete, vkBack, vkInsert] then
+ FMoved := True;
+
+ case WideChar(KeyChar) of
+ #0032..#$FFFF:
+ if (Shift = []) or (Shift = [ssShift]) then
+ begin
+ DoChar(WideChar(KeyChar));
+ FMoved := True;
+ end;
+ else
+ MyKey := False;
+ end;
+ if MyKey then
+ Key := 0;
+end;
+
+procedure TfsSyntaxMemo.DoLeft;
+begin
+ Dec(FPos.X);
+ if FPos.X < 1 then
+ FPos.X := 1;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoRight;
+begin
+ Inc(FPos.X);
+ if FPos.X > FMaxLength then
+ FPos.X := FMaxLength;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoUp;
+begin
+ Dec(FPos.Y);
+ if FPos.Y < 1 then
+ FPos.Y := 1;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoDown;
+begin
+ Inc(FPos.Y);
+ if FPos.Y > FText.Count then
+ FPos.Y := FText.Count;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoHome(Ctrl: Boolean);
+begin
+ if Ctrl then
+ SetPos(1, 1) else
+ SetPos(1, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoEnd(Ctrl: Boolean);
+begin
+ if Ctrl then
+ SetPos(LineLength(FText.Count - 1) + 1, FText.Count) else
+ SetPos(LineLength(FPos.Y - 1) + 1, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoExit;
+begin
+{$IFDEF Delphi17}
+ inherited;
+{$IFNDEF DELPHI18}
+ CaretVisible := False;
+{$ELSE}
+ HideCaret;
+{$ENDIF}
+{$ELSE}
+ Platform.HideVirtualKeyboard;
+ inherited;
+ HideCaret;
+{$ENDIF}
+end;
+
+procedure TfsSyntaxMemo.DoPgUp;
+begin
+ if FOffset.Y > FWindowSize.Y then
+ begin
+ FOffset.Y := FOffset.Y - (FWindowSize.Y - 1);
+ FPos.Y := FPos.Y - (FWindowSize.Y - 1);
+ end
+ else
+ begin
+ if FOffset.Y > 0 then
+ begin
+ FPos.Y := FPos.Y - FOffset.Y;
+ FOffset.Y := 0;
+ end
+ else
+ FPos.Y := 1;
+ end;
+ SetPos(FPos.X, FPos.Y);
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.DoPgDn;
+begin
+ if FOffset.Y + FWindowSize.Y < FText.Count then
+ begin
+ FOffset.Y := FOffset.Y + (FWindowSize.Y - 1);
+ FPos.Y := FPos.Y + (FWindowSize.Y - 1);
+ end
+ else
+ begin
+ FOffset.Y := FText.Count;
+ FPos.Y := FText.Count;
+ end;
+ SetPos(FPos.X, FPos.Y);
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.DoReturn;
+var
+ s: String;
+begin
+ if FReadOnly then exit;
+ s := LineAt(FPos.Y - 1);
+ FText[FPos.Y - 1] := Copy(s, 1, FPos.X - 1);
+ FText.Insert(FPos.Y, Copy(s, FPos.X, FMaxLength));
+ EnterIndent;
+end;
+
+procedure TfsSyntaxMemo.DoDel;
+var
+ s: String;
+begin
+ if FReadOnly then exit;
+ FMessage := '';
+ if FSelStart.X <> 0 then
+ SelText := ''
+ else
+ begin
+ s := FText[FPos.Y - 1];
+ AddUndo;
+ if FPos.X <= LineLength(FPos.Y - 1) then
+ begin
+ Delete(s, FPos.X, 1);
+ FText[FPos.Y - 1] := s;
+ end
+ else if FPos.Y < FText.Count then
+ begin
+ s := s + Pad(FPos.X - Length(s) - 1) + LineAt(FPos.Y);
+ FText[FPos.Y - 1] := s;
+ FText.Delete(FPos.Y);
+ CorrectBookmark(FSelStart.Y, -1);
+ end;
+ UpdateScrollBar;
+ UpdateSyntax;
+ DoChange;
+ end;
+end;
+
+procedure TfsSyntaxMemo.DoBackspace;
+var
+ s: String;
+begin
+ if FReadOnly then exit;
+ FMessage := '';
+ if FSelStart.X <> 0 then
+ SelText := ''
+ else
+ begin
+ s := FText[FPos.Y - 1];
+ if FPos.X > 1 then
+ begin
+ if (GetLineBegin(FPos.Y - 1) = FPos.X) or (Trim(s) = '') then
+ UnIndent
+ else
+ begin
+ AddUndo;
+ if Trim(s) <> '' then
+ begin
+ Delete(s, FPos.X - 1, 1);
+ FText[FPos.Y - 1] := s;
+ DoLeft;
+ end
+ else
+ DoHome(False);
+ UpdateSyntax;
+ DoChange;
+ end;
+ end
+ else if FPos.Y > 1 then
+ begin
+ AddUndo;
+ CorrectBookmark(FPos.Y, -1);
+ s := LineAt(FPos.Y - 2);
+ FText[FPos.Y - 2] := s + FText[FPos.Y - 1];
+ FText.Delete(FPos.Y - 1);
+ SetPos(Length(s) + 1, FPos.Y - 1);
+ UpdateSyntax;
+ DoChange;
+ end;
+ end;
+end;
+
+procedure TfsSyntaxMemo.DoCtrlI;
+begin
+ if FSelStart.X <> 0 then
+ ShiftSelected(True);
+end;
+
+procedure TfsSyntaxMemo.DoCtrlU;
+begin
+ if FSelStart.X <> 0 then
+ ShiftSelected(False);
+end;
+
+procedure TfsSyntaxMemo.DoCtrlL;
+var
+ i: Integer;
+ s: String;
+begin
+ s := FText.Text;
+ i := Length(LineAt(FPos.Y - 1));
+ if FPos.X > i then
+ FPos.X := i;
+
+ i := GetPlainTextPos(FPos);
+
+ Dec(i);
+ while (i > 0) and not (CharInSet(s[i], WordChars) or IsUnicodeChar(s[i])) do
+ if s[i] = Char(LineBreak[1]) then
+ break else
+ Dec(i);
+ while (i > 0) and (CharInSet(s[i], WordChars) or IsUnicodeChar(s[i])) do
+ Dec(i);
+ Inc(i);
+
+ FPos := GetPosPlainText(i);
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoCtrlR;
+var
+ i: Integer;
+ s: String;
+begin
+ s := FText.Text;
+ i := Length(LineAt(FPos.Y - 1));
+ if FPos.X > i then
+ begin
+ DoDown;
+ DoHome(False);
+ FPos.X := 0;
+ end;
+
+ i := GetPlainTextPos(FPos);
+ while (i < Length(s)) and ((CharInSet(s[i], WordChars)) or IsUnicodeChar(s[i])) do
+ Inc(i);
+ while (i < Length(s)) and not ((CharInSet(s[i], WordChars)) or IsUnicodeChar(s[i])) do
+ if s[i] = Char(LineBreak[1]) then
+ break else
+ Inc(i);
+ FPos := GetPosPlainText(i);
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoChar(Ch: Char);
+begin
+ SelText := Ch;
+end;
+
+function TfsSyntaxMemo.GetCharAttr(Pos: TPoint): TCharAttributes;
+
+ function IsBlock: Boolean;
+ var
+ p1, p2, p3: Integer;
+ begin
+ Result := False;
+ if FSelStart.X = 0 then exit;
+
+ p1 := FSelStart.X + FSelStart.Y * FMaxLength;
+ p2 := FSelEnd.X + FSelEnd.Y * FMaxLength;
+ if p1 > p2 then
+ begin
+ p3 := p1;
+ p1 := p2;
+ p2 := p3;
+ end;
+ p3 := Pos.X + Pos.Y * FMaxLength;
+ Result := (p3 >= p1) and (p3 < p2);
+ end;
+
+ function CharAttr: TCharAttr;
+ var
+ s: String;
+ begin
+ if Pos.Y - 1 < FSynStrings.Count then
+ begin
+ s := FSynStrings[Pos.Y - 1];
+ if Pos.X <= Length(s) then
+ Result := TCharAttr(Ord(s[Pos.X])) else
+ Result := caText;
+ end
+ else
+ Result := caText;
+ end;
+
+begin
+ Result := [CharAttr];
+ if IsBlock then
+ Result := Result + [caBlock];
+end;
+
+function TfsSyntaxMemo.GetCharWidth(Str: String): Single;
+var
+ r: TRectF;
+ dx: Single;
+ j, j1: Integer;
+ a, a1: TCharAttributes;
+
+ function CalcSize(LStr: String): Single;
+ begin
+ if FIsMonoType then
+ begin
+ Result := FCharWidth * Length(LStr);
+ Exit;
+ end;
+ if LStr = '' then
+ begin
+ Result := 0;
+ Exit;
+ end;
+
+ r := RectF(0, 0, 100000, 100000);
+ { MeasureText trunc all spaces at the end, so we are using this hack to calcl size with spaces }
+ FTmpCanvas.Canvas.MeasureText(r, LStr + 'W', False, [], TTextAlign.taLeading);
+ dx := r.Width;
+ FTmpCanvas.Canvas.MeasureText(r, 'W', False, [], TTextAlign.taLeading);
+ Result := dx - r.Width;
+ end;
+begin
+
+ j1 := 1;
+ a := GetCharAttr(Point(1, FPos.Y));
+ a1 := a;
+ Result := 0;
+
+ for j := 1 to Length(Str) do
+ begin
+ a1 := GetCharAttr(Point(j, FPos.Y));
+ if a1 <> a then
+ begin
+ SetAttr(FTmpCanvas.Canvas, a);
+ Result := Result + CalcSize(Copy(Str, j1, (j - j1)));
+ a := a1;
+ j1 := j;
+ end;
+ end;
+ SetAttr(FTmpCanvas.Canvas, a);
+ Result := Result + CalcSize(Copy(Str, j1, Length(Str) - (j1 - 1)));
+end;
+
+procedure TfsSyntaxMemo.Paint;
+var
+ i, j, j1: Integer;
+ a, a1: TCharAttributes;
+ s: String;
+ x, y: Single;
+ aClientR: TRectF;
+ aSelColor, aSelFontColor: TAlphaColor;
+
+ procedure SetAttrL(a: TCharAttributes);
+ begin
+ SetAttr(Canvas, a);
+ aSelColor := FFill.Color;
+ aSelFontColor := Canvas.Fill.Color;
+ if caBlock in a then
+ begin
+ aSelColor := FBlockColor;
+ aSelFontColor := FBlockFontColor;
+ end;
+
+ // make non-selected text looking good
+ if aSelColor = FFill.Color then
+ aSelColor := 0;
+ end;
+
+ function MyTextOut(x, y: Single; const s: String): Single;
+ var
+ i: Integer;
+ dx, dy: Single;
+ r: TRectF;
+ begin
+ with Canvas do
+ begin
+ r := RectF(0, 0, 100000, 100000);
+ { MeasureText trunc all spaces at the end, so we are using this hack to calcl size with spaces }
+ Canvas.MeasureText(r, s + 'W',False, [], TTextAlign.taLeading);
+ dx := r.Width + x;
+ Canvas.MeasureText(r, 'W', False, [], TTextAlign.taLeading);
+ dx := dx - r.Width;
+ if dx > (aClientR.Right - aClientR.Left) then
+ dx := aClientR.Right - aClientR.Left;
+ dy := y + FCharHeight;
+ if FIsMonoType then
+ dx := x + FCharWidth * Length(s);
+ Fill.Color := aSelColor;
+ FillRect(RectF(x + 1, y, dx + 1, dy + 1), 0, 0, AllCorners, 1);
+ Fill.Color := aSelFontColor;
+ if FIsMonoType then
+ FillText(RectF(x, y, dx + 1, 10000),
+ s, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading)
+ else
+ begin
+ for i := 1 to Length(s) do
+ FillText(RectF(x + (i - 1) * FCharWidth, y,
+ (x + (i - 1) * FCharWidth) + FCharWidth, y + FCharHeight),
+ s[i], False, 1, FillTextFlags, TTextAlign.taLeading, TTextAlign.taLeading);
+ end;
+ end;
+ Result := dx;
+ end;
+
+begin
+ aClientR := GetClientRect;
+ with Canvas do
+ begin
+ Fill.Assign(FBorder.Fill);
+ FillRect(RectF(0, 0, Self.Width , Self.Height), 0, 0, AllCorners, 1, TCornerType.ctBevel);
+ Fill.Assign(FFill);
+ FillRect(aClientR, 0, 0, AllCorners, 1, TCornerType.ctBevel);
+ Fill.Assign(FGutterFill);
+ FillRect(RectF(FGutterWidth - aClientR.Left,
+ Self.Height - FFooterHeight - aClientR.Top,
+ aClientR.Left, aClientR.Top), 0, 0, AllCorners, 1, TCornerType.ctBevel);
+ FillRect(RectF(aClientR.Left, Self.Height - FFooterHeight - aClientR.Top,
+ Self.Width - aClientR.Left, Self.Height - aClientR.Top), 1, 1,
+ AllCorners, 1, TCornerType.ctBevel);
+
+ Stroke.Assign(FBorder.Fill);
+{$IFDEF DELPHI25}
+ Stroke.Cap := TStrokeCap.scRound;
+ Stroke.Thickness := FBorder.Width;
+{$ELSE}
+ StrokeCap := TStrokeCap.scRound;
+ StrokeThickness := FBorder.Width;
+{$ENDIF}
+ x := FGutterWidth - FBorder.Width;
+ DrawLine(PointF(x, aClientR.Top + 1), PointF(x, aClientR.Bottom - FFooterHeight ), 1);
+ if FFooterHeight > 0 then
+ DrawLine(PointF(x, aClientR.Bottom - FFooterHeight),
+ PointF(aClientR.Right - 1, aClientR.Bottom - FFooterHeight), 1);
+ if FUpdatingSyntax then Exit;
+
+ for i := FOffset.Y to FOffset.Y + FWindowSize.Y - 1 do
+ begin
+ if i >= FText.Count then break;
+
+ s := FText[i];
+ j1 := FOffset.X + 1;
+ a := GetCharAttr(Point(j1, i + 1));
+ a1 := a;
+ x := FGutterWidth + FBorder.Width;
+ y := aClientR.Top + (i - FOffset.Y) * FCharHeight;
+ for j := j1 to FOffset.X + FWindowSize.X do
+ begin
+ if j > Length(s) then break;
+
+ a1 := GetCharAttr(Point(j, i + 1));
+ if a1 <> a then
+ begin
+ SetAttrL(a);
+ x := MyTextOut(x, y, Copy(FText[i], j1, j - j1));
+ a := a1;
+ j1 := j;
+ end;
+ end;
+
+ SetAttrL(a);
+
+ MyTextOut(x, y, Copy(s, j1, FMaxLength));
+
+ BookmarkDraw(y, i);
+ ActiveLineDraw(y, i);
+ end;
+
+ if FMessage <> '' then
+ begin
+ Font.Family := 'Tahoma';
+ Font.Style := [TFontStyle.fsBold];
+ Font.Size := 8;
+ Fill.Color := TAlphaColorRec.Maroon;
+ FillRect(RectF(aClientR.Left, aClientR.Bottom - TextHeight('|') - 6, aClientR.Right , aClientR.Bottom), 0, 0,
+ AllCorners, 1, TCornerType.ctBevel);
+ Fill.Color := TAlphaColorRec.White;
+ FillText(RectF(aClientR.Left + 6, aClientR.Bottom - TextHeight('|') - 5,
+ 6 + TextWidth('W') * Length(FMessage), aClientR.Bottom), FMessage,
+ False, 1, [], TTextAlign.taLeading)
+ end
+ else
+ ShowPos;
+ end;
+end;
+
+procedure TfsSyntaxMemo.CreateSynArray;
+var
+ i, n, Pos: Integer;
+ ch: Char;
+ FSyn: String;
+
+ procedure SkipSpaces;
+ begin
+ while (Pos <= Length(FSyn)) and
+ ((CharInSet(FSyn[Pos], [#1..#32])) or
+ not (CharInSet(FSyn[Pos],['_', 'A'..'Z', 'a'..'z', '''', '"', '/', '{', '(', '-']))) do
+ Inc(Pos);
+ end;
+
+ function IsKeyWord(const s: String): Boolean;
+ begin
+ Result := False;
+ if FKeywords = '' then exit;
+
+ if FKeywords[1] <> ',' then
+ FKeywords := ',' + FKeywords;
+ if FKeywords[Length(FKeywords)] <> ',' then
+ FKeywords := FKeywords + ',';
+
+ Result := System.Pos(',' + AnsiLowerCase(s) + ',', FKeywords) <> 0;
+ end;
+
+ function GetIdent: TCharAttr;
+ var
+ i: Integer;
+ cm1, cm2, cm3, cm4, st1: Char;
+ begin
+ i := Pos;
+ Result := caText;
+
+ if FSyntaxType = stPascal then
+ begin
+ cm1 := '/';
+ cm2 := '{';
+ cm3 := '(';
+ cm4 := ')';
+ st1 := '''';
+ end
+ else if FSyntaxType in [stCpp,stJs,stVb] then
+ begin
+ cm1 := '/';
+ cm2 := ' ';
+ cm3 := '/';
+ cm4 := '/';
+ st1 := '"';
+ end
+ else if FSyntaxType = stSQL then
+ begin
+ cm1 := '-';
+ cm2 := ' ';
+ cm3 := '/';
+ cm4 := '/';
+ st1 := '"';
+ end
+ else
+ begin
+ cm1 := ' ';
+ cm2 := ' ';
+ cm3 := ' ';
+ cm4 := ' ';
+ st1 := ' ';
+ end;
+
+ if CharInSet(FSyn[Pos], ['_', 'A'..'Z', 'a'..'z']) then
+ begin
+ while CharInSet(FSyn[Pos], ['_', 'A'..'Z', 'a'..'z', '0'..'9']) do
+ Inc(Pos);
+ if IsKeyWord(Copy(FSyn, i, Pos - i)) then
+ Result := caKeyword;
+ Dec(Pos);
+ end
+ else if (FSyn[Pos] = cm1) and (FSyn[Pos + 1] = cm1) then
+ begin
+ while (Pos <= Length(FSyn)) and not (CharInSet(FSyn[Pos], [#10, #13])) do
+ Inc(Pos);
+ Result := caComment;
+ end
+ else if FSyn[Pos] = cm2 then
+ begin
+ while (Pos <= Length(FSyn)) and (FSyn[Pos] <> '}') do
+ Inc(Pos);
+ Result := caComment;
+ end
+ else if (FSyn[Pos] = cm3) and (FSyn[Pos + 1] = '*') then
+ begin
+ while (Pos < Length(FSyn)) and not ((FSyn[Pos] = '*') and (FSyn[Pos + 1] = cm4)) do
+ Inc(Pos);
+ Inc(Pos, 2);
+ Result := caComment;
+ end
+ else if FSyn[Pos] = st1 then
+ begin
+ Inc(Pos);
+ while (Pos < Length(FSyn)) and (FSyn[Pos] <> st1) and not (CharInSet(FSyn[Pos], [#10, #13])) do
+ Inc(Pos);
+ Result := caString;
+ end;
+ Inc(Pos);
+ end;
+
+begin
+ FSyn := FText.Text + #0#0#0#0#0#0#0#0#0#0#0;
+ FAllowLinesChange := False;
+ Pos := 1;
+
+ while Pos < Length(FSyn) do
+ begin
+ n := Pos;
+ SkipSpaces;
+ for i := n to Pos - 1 do
+ if FSyn[i] > #31 then
+ FSyn[i] := Chr(Ord(caText));
+
+ n := Pos;
+ ch := Chr(Ord(GetIdent));
+ for i := n to Pos - 1 do
+ if i <= Length(FSyn) then
+ if FSyn[i] > #31 then
+ FSyn[i] := ch;
+ end;
+
+ FUpdatingSyntax := True;
+ FSynStrings.Text := FSyn;
+ FSynStrings.Add(' ');
+ FUpdatingSyntax := False;
+end;
+
+procedure TfsSyntaxMemo.UpdateView;
+begin
+ UpdateSyntax;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.UpdateWindowSize;
+begin
+ if FCharWidth = 0 then exit;
+ FWindowSize := Point(Trunc((Width - FGutterWidth - FBorder.Width * 2) / FCharWidth),
+ Trunc((Height - FFooterHeight - FBorder.Width * 2) / FCharHeight));
+end;
+
+procedure TfsSyntaxMemo.CopyPopup(Sender: TObject);
+begin
+ CopyToClipboard;
+end;
+
+procedure TfsSyntaxMemo.PastePopup(Sender: TObject);
+begin
+ PasteFromClipboard;
+end;
+
+procedure TfsSyntaxMemo.Resize;
+begin
+ inherited;
+ UpdateWindowSize;
+ FVScroll.Position.Y := FBorder.Width;
+ FVScroll.Height := Height - FFooterHeight - FBorder.Width;
+ FVScroll.Width := 16;
+ FVScroll.Position.X := Width - FVScroll.Width - FBorder.Width;
+ UpdateScrollBar;
+end;
+
+procedure TfsSyntaxMemo.CutPopup(Sender: TObject);
+begin
+ CutToClipboard;
+end;
+
+procedure TfsSyntaxMemo.SetShowGutter(Value: boolean);
+begin
+ FShowGutter := Value;
+ if Value then
+ FGutterWidth := 20
+ else
+ FGutterWidth := 0;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.SetShowFooter(Value: boolean);
+begin
+ FShowFooter := Value;
+ if Value then
+ FFooterHeight := 20
+ else
+ FFooterHeight := 0;
+ Repaint;
+end;
+
+function TfsSyntaxMemo.FMemoFind(Text: String; var Position : TPoint): boolean;
+var
+ i, j : integer;
+begin
+ j := 0;
+ result := False;
+ if FText.Count > 1 then
+ begin
+ Text := UpperCase(Text);
+ for i := Position.Y to FText.Count - 1 do
+ begin
+ j := Pos( Text, UpperCase(FText[i]));
+ if j > 0 then
+ begin
+ Result := True;
+ break;
+ end
+ end;
+ Position.X := j;
+ Position.Y := i + 1;
+ end;
+end;
+
+procedure TfsSyntaxMemo.FontChanged(Sender: TObject);
+begin
+ FCommentAttr.Font.Size := FFontSettings.Font.Size;
+ FCommentAttr.Font.Family := FFontSettings.Font.Family;
+ FKeywordAttr.Font.Size := FFontSettings.Font.Size;
+ FKeywordAttr.Font.Family := FFontSettings.Font.Family;
+ FStringAttr.Font.Size := FFontSettings.Font.Size;
+ FStringAttr.Font.Family := FFontSettings.Font.Family;
+ FTextAttr.Font.Size := FFontSettings.Font.Size;
+ FTextAttr.Font.Family := FFontSettings.Font.Family;
+ CalcCharSize;
+ { need to uptade size, maybe font size was changed }
+ UpdateWindowSize;
+end;
+
+function TfsSyntaxMemo.Find(Text: String): boolean;
+var
+ Position: TPoint;
+begin
+ Position := FPos;
+ if FMemoFind(Text, Position) then
+ begin
+ SetPos(Position.X, Position.Y);
+ result := true;
+ end
+ else
+ begin
+ ShowMessage('Text "'+Text+'" not found.');
+ result := false;
+ end;
+end;
+
+procedure TfsSyntaxMemo.ActiveLineDraw(Y : Single; ALine : integer);
+begin
+ if ShowGutter then
+ with Canvas do
+ if ALine = FActiveLine then
+ begin
+ Fill.Color := TAlphaColorRec.Red;
+ //Pen.Color := clBlack;
+ FillEllipse(RectF(4, Y + 4, 11, Y + 15), 1);
+ end;
+end;
+
+procedure TfsSyntaxMemo.BookmarkDraw(Y : Single; ALine : integer);
+var
+ bm : integer;
+begin
+ if ShowGutter then
+ with Canvas do
+ begin
+ bm := IsBookmark(ALine);
+ if bm >= 0 then
+ begin
+ Fill.Color := TAlphaColorRec.Black;
+ FillRect(RectF(3 + Border.Width, Y + 1, 13 + Border.Width, Y + 12), 0, 0,
+ AllCorners, 1, TCornerType.ctBevel);
+ Fill.Color := TAlphaColorRec.Green;
+ FillRect(RectF(2 + Border.Width, Y + 2, 12 + Border.Width, Y + 13), 0, 0,
+ AllCorners, 1, TCornerType.ctBevel);
+ Font.Family := 'Tahoma';
+ Fill.Color := TAlphaColorRec.White;
+ Font.Style := [TFontStyle.fsBold];
+ Font.Size := 7;
+ y := y + 2.0;
+ FillText(RectF(4 + Border.Width, Y, 4 + TextWidth('7') + Border.Width,
+ Y + TextHeight('7')), IntToStr(bm), False, 1, [], TTextAlign.taLeading)
+ end;
+ end;
+end;
+
+function TfsSyntaxMemo.IsBookmark(Line : integer): integer;
+var
+ Pos : integer;
+begin
+ Result := -1;
+ for Pos := 0 to Length(Bookmarks) - 1 do
+ if Bookmarks[Pos] = Line then
+ begin
+ Result := Pos;
+ break;
+ end;
+end;
+
+procedure TfsSyntaxMemo.AddBookmark(Line, Number : integer);
+begin
+ if Number < Length(Bookmarks) then
+ begin
+ Bookmarks[Number] := Line;
+ Repaint;
+ end;
+end;
+
+procedure TfsSyntaxMemo.DeleteBookmark(Number : integer);
+begin
+ if Number < Length(Bookmarks) then
+ begin
+ Bookmarks[Number] := -1;
+ Repaint;
+ end;
+end;
+
+procedure TfsSyntaxMemo.CorrectBookmark(Line : integer; delta : integer);
+var
+ i : integer;
+begin
+ for i := 0 to Length(Bookmarks) - 1 do
+ if Bookmarks[i] >= Line then
+ Inc(Bookmarks[i], Delta);
+end;
+
+procedure TfsSyntaxMemo.GotoBookmark(Number : integer);
+begin
+ if Number < Length(Bookmarks) then
+ if Bookmarks[Number] >= 0 then
+ SetPos(0, Bookmarks[Number] + 1);
+end;
+
+procedure TfsSyntaxMemo.DOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+begin
+{$IFNDEF DELPHI20}
+ Accept := Data.Source is TTreeView;
+{$ELSE}
+ if Data.Source is TTreeView then
+ Operation := TDragOperation.Copy;
+{$ENDIF}
+end;
+
+procedure TfsSyntaxMemo.DDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+begin
+ if Data.Source is TTreeView then
+ begin
+ SetPos(Round((Point.X - FGutterWidth) / FCharWidth) + 1 + FOffset.X,
+ Round(Point.Y / FCharHeight) + 1 + FOffset.Y);
+ SetSelText(TTreeView(Data.Source).Selected.Text);
+ end;
+end;
+
+procedure TfsSyntaxMemo.SetKeywordAttr(Value: TfsFontSettings);
+begin
+ FKeywordAttr.Assign(Value);
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.SetStringAttr(Value: TfsFontSettings);
+begin
+ FStringAttr.Assign(Value);
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.SetTextAttr(Value: TfsFontSettings);
+begin
+ FTextAttr.Assign(Value);
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.SetCommentAttr(Value: TfsFontSettings);
+begin
+ FCommentAttr.Assign(Value);
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.SetFill(const Value: TBrush);
+begin
+ FFill.Assign(Value);
+end;
+
+procedure TfsSyntaxMemo.SetFontSettings(const Value: TfsFontSettings);
+begin
+ FFontSettings.Assign(Value);
+end;
+
+procedure TfsSyntaxMemo.SetGutterFill(const Value: TBrush);
+begin
+ FGutterFill.Assign(Value);
+end;
+
+procedure TfsSyntaxMemo.SetActiveLine(Line : Integer);
+begin
+ FActiveLine := Line;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.SetAttr(aCanvas: TCanvas; a: TCharAttributes);
+begin
+ with aCanvas do
+ begin
+ Font.Assign(FFontSettings.Font);
+ Canvas.Fill.Assign(FFontSettings.Fill);
+
+ if caText in a then
+ begin
+ Font.Assign(FTextAttr.Font);
+ Canvas.Fill.Assign(FTextAttr.Fill);
+ end;
+
+ if caComment in a then
+ begin
+ Font.Assign(FCommentAttr.Font);
+ Canvas.Fill.Assign(FCommentAttr.Fill);
+ end;
+
+ if caKeyword in a then
+ begin
+ Font.Assign(FKeywordAttr.Font);
+ Canvas.Fill.Assign(FKeywordAttr.Fill);
+ end;
+
+ if caString in a then
+ begin
+ Font.Assign(FStringAttr.Font);
+ Canvas.Fill.Assign(FStringAttr.Fill);
+ end;
+ end;
+end;
+
+
+
+procedure TfsSyntaxMemo.SetBorder(const Value: TfsBorderSettings);
+begin
+ FBorder.Fill.Assign(Value.Fill);
+ FBorder.Width := Value.Width;
+end;
+
+function TfsSyntaxMemo.GetActiveLine: Integer;
+begin
+ Result := FActiveLine;
+end;
+
+procedure TfsSynMemoSearch.FormKeyPress(Sender: TObject; var Key: Char);
+begin
+ if Key = #13 then
+ ModalResult := mrOk;
+end;
+
+{ TfsBorderSettings }
+
+constructor TfsBorderSettings.Create;
+begin
+ FFill := TBrush.Create(TBrushKind.bkSolid, TAlphaColorRec.Silver);
+ FWidth := 1;
+end;
+
+destructor TfsBorderSettings.Destroy;
+begin
+ FFill.Free;
+ inherited;
+end;
+
+procedure TfsBorderSettings.SetFill(const Value: TBrush);
+begin
+ FFill.Assign(Value);
+end;
+
+procedure TfsBorderSettings.SetWidth(const Value: Integer);
+begin
+ if Value > 3 then
+ FWidth := 3
+ else if Value < 0 then
+ FWidth := 0
+ else
+ FWidth := Value;
+end;
+
+{ TfsFontSettings }
+
+procedure TfsFontSettings.Assign(Source: TPersistent);
+begin
+ inherited;
+ if Source is TfsFontSettings then
+ begin
+ Fill.Assign(TfsFontSettings(Source).Fill);
+ Font.Assign(TfsFontSettings(Source).Font);
+ end;
+end;
+
+constructor TfsFontSettings.Create();
+begin
+ FFill := TBrush.Create(TBrushKind.bkSolid, TAlphaColorRec.Black);
+ FFont := TFont.Create;
+ FFont.Family := 'Courier New';
+ FFont.Size := 13;
+end;
+
+destructor TfsFontSettings.Destroy;
+begin
+ FFill.Free;
+ FFont.Free;
+ inherited;
+end;
+
+procedure TfsFontSettings.SetFill(const Value: TBrush);
+begin
+ FFill.Assign(Value);
+end;
+
+procedure TfsFontSettings.SetFont(const Value: TFont);
+begin
+ FFont.Assign(Value);
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsSyntaxMemo, TFmxObject);
+ GroupDescendentsWith(TfsBorderSettings, TFmxObject);
+ GroupDescendentsWith(TfsFontSettings, TFmxObject);
+
+ RegisterFmxClasses([TfsBorderSettings, TfsFontSettings]);
+
+end.
diff --git a/LibD28/FMX.fs_tree.pas b/LibD28/FMX.fs_tree.pas
new file mode 100644
index 0000000..be82786
--- /dev/null
+++ b/LibD28/FMX.fs_tree.pas
@@ -0,0 +1,659 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Function/Classes tree FMX visual control }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_tree;
+
+interface
+
+{$I fs.inc}
+
+uses
+ FMX.Types,
+ System.SysUtils, System.Classes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.ExtCtrls, FMX.fs_synmemo, FMX.Objects,
+ FMX.fs_XML, FMX.fs_iinterpreter, FMX.TreeView, FMX.Memo, System.UITypes, System.Types
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI29}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+ TfsTreeViewItem = class(TTreeViewItem)
+ private
+ FButton: TCustomButton;
+ FCloseImageIndex: Integer;
+ FOpenImageIndex: Integer;
+ FImgPos: Single;
+ function GetBitmap():TBitmap;
+ protected
+ procedure ApplyStyle; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure Paint; override;
+ property CloseImageIndex: Integer read FCloseImageIndex write FCloseImageIndex;
+ property OpenImageIndex: Integer read FOpenImageIndex write FOpenImageIndex;
+ end;
+
+{$i frxPlatformsAttribute.inc}
+
+ TfsTreeView = class(TTreeView)
+ private
+ FPicBitmap: TBitmap;
+ FIconWidth: Integer;
+ FIconHeight: Integer;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure LoadResouces(Stream: TStream; IconWidth, IconHeight: Integer);
+ property PicPitmap: TBitmap read FPicBitmap write FPicBitmap;
+ property IconWidth: Integer read FIconWidth write FIconWidth;
+ property IconHeight: Integer read FIconHeight write FIconHeight;
+ function GetBitmapRect(Index: Integer): TRectF;
+ procedure DragOver(const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF}); override;
+ procedure DragDrop(const Data: TDragObject; const Point: TPointF); override;
+ published
+ property StyleLookup;
+ property CanFocus default True;
+ property DisableFocusEffect;
+ property TabOrder;
+ property AllowDrag default False;
+ property AlternatingRowBackground default False;
+ property ItemHeight;
+// property HideSelectionUnfocused default False;
+ property MultiSelect default False;
+ property ShowCheckboxes default False;
+ property Sorted default False;
+ property OnChange;
+ property OnChangeCheck;
+ property OnCompare;
+ property OnDragChange;
+ end;
+
+{$i frxPlatformsAttribute.inc}
+ TfsTree = class(TPanel)
+ private
+ Tree: TfsTreeView;
+ FXML: TfsXMLDocument;
+ FScript: TfsScript;
+ FImages: TList;
+ FShowFunctions: boolean;
+ FShowClasses: boolean;
+ FShowTypes: Boolean;
+ FShowVariables: Boolean;
+ FExpanded: boolean;
+ FExpandLevel : integer;
+ FMemo: TfsSyntaxMemo;
+ FUpdating: Boolean;
+ procedure FillTree;
+
+ procedure SetMemo(Value: TfsSyntaxMemo);
+
+ procedure SetScript(const Value: TfsScript);
+ protected
+ {$IFDEF DELPHI19}
+ procedure CreateImageFromRes(Image: TImage; Bmp: FMX.Graphics.TBitmap;
+ Width, Height: Integer; Index: Integer);
+ {$ELSE}
+ procedure CreateImageFromRes(Image: TImage; Bmp: FMX.Types.TBitmap;
+ Width, Height: Integer; Index: Integer);
+{$ENDIF}
+
+ procedure TreeChange(Sender: TObject; Node: TTreeViewItem);
+ procedure TreeDblClick(Sender: TObject);
+ procedure Notification(AComponent: TComponent;
+ Operation: TOperation); override;
+ protected
+ procedure Loaded; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure SetColor(Color: TAlphaColor);
+ procedure UpdateItems;
+ function GetFieldName: String;
+ published
+ property Align;
+ property Anchors;
+ property DragMode;
+ property Enabled;
+ property PopupMenu;
+ property Script: TfsScript read FScript write SetScript;
+ property ShowHint;
+ property TabOrder;
+ property Visible;
+
+ property SyntaxMemo: TfsSyntaxMemo read FMemo write SetMemo;
+ property ShowClasses: boolean read FShowClasses write FShowClasses;
+ property ShowFunctions: boolean read FShowFunctions write FShowFunctions;
+ property ShowTypes: boolean read FShowTypes write FShowTypes;
+ property ShowVariables: boolean read FShowVariables write FShowVariables;
+ property Expanded: boolean read FExpanded write FExpanded;
+ property ExpandLevel: integer read FExpandLevel write FExpandLevel;
+
+ property OnClick;
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ property Left;
+ property Top;
+ property Width;
+ property Height;
+ end;
+
+implementation
+
+{$IFNDEF FPC}
+ {$R fs_tree.res}
+{$ENDIF}
+
+uses FMX.fs_iTools;
+
+constructor TfsTree.Create(AOwner: TComponent);
+var
+ S: TResourceStream;
+begin
+ inherited;
+ DragMode := TDragMode.dmManual;
+ Tree := TfsTreeView.Create(Self);
+ Tree.Stored := False;
+ with Tree do
+ begin
+ Parent := Self;
+ DragMode := TDragMode.dmAutomatic;
+ Align := TAlignLayout.alClient;
+ TabOrder := 0;
+ end;
+ FImages := TList.Create();
+ S := TResourceStream.Create(HInstance, 'FSTREEFMX', RT_RCDATA);//RT_RCDATA
+ S.Position := 0;
+ Tree.LoadResouces(S, 16, 16);
+ S.Free;
+ Tree.OnDblClick := TreeDblClick;
+ FXML := TfsXMLDocument.Create;
+ Expanded := True;
+ ExpandLevel := 0;
+ ShowClasses := True;
+ ShowFunctions := True;
+ ShowTypes := True;
+ ShowVariables := True;
+ UpdateItems;
+ Top := 0;
+ Left := 0;
+ Height := 250;
+ Width := 200;
+end;
+
+
+ {$IFDEF DELPHI19}
+procedure TfsTree.CreateImageFromRes(Image: TImage; Bmp: FMX.Graphics.TBitmap;
+ Width, Height, Index: Integer);
+ {$ELSE}
+procedure TfsTree.CreateImageFromRes(Image: TImage; Bmp: FMX.Types.TBitmap;
+ Width, Height, Index: Integer);
+{$ENDIF}
+begin
+ Image.Width := Width;
+ Image.Height := Height;
+ Image.Bitmap.SetSize(Width, Height);
+ Image.Bitmap.Canvas.BeginScene;
+ Image.Bitmap.Canvas.DrawBitmap(Bmp, RectF(Width * Index , 0, Width * Index + Width , Height), RectF(0, 0, Width, Height), 1 );
+ Image.Bitmap.Canvas.EndScene;
+ //Image.Bitmap.BitmapChanged;
+end;
+
+destructor TfsTree.Destroy;
+begin
+ FImages.Free;
+ Tree.Free;
+ FUpdating := True;
+ FXML.Free;
+ inherited;
+end;
+
+procedure TfsTree.FillTree;
+
+ function GetCategoryByName(s: String): String;
+ begin
+ if s = 'ctConv' then result := 'Conversion'
+ else if s = 'ctFormat' then result := 'Formatting'
+ else if s = 'ctDate' then result := 'Date/Time'
+ else if s = 'ctString' then result := 'String routines'
+ else if s = 'ctMath' then result := 'Mathematical'
+ else if s = 'ctOther' then result := 'Other'
+ else result := s;
+ end;
+
+ procedure AddClasses(xi: TfsXMLItem; Root: TfsTreeViewItem);
+ var
+ i: Integer;
+ Node: TfsTreeViewItem;
+ s: String;
+ begin
+ s := xi.Prop['text'];
+ Node := TfsTreeViewItem.Create(Tree);
+ Node.Text := s;
+ if Root <> nil then
+ Node.Parent := Root
+ else
+ Node.Parent := Tree;
+ Node.Parent.AddObject(Node);
+ if Root = nil then
+ Node.Text := xi.Name;
+ if xi.Count = 0 then
+ begin
+ Node.OpenImageIndex := 1;
+ Node.CloseImageIndex := 1;
+ end
+ else
+ begin
+ Node.OpenImageIndex := 3;
+ Node.CloseImageIndex := 2;
+ end;
+ for i := 0 to xi.Count - 1 do
+ AddClasses(xi[i], Node);
+ end;
+
+ procedure AddFunctions(xi: TfsXMLItem; Root: TfsTreeViewItem);
+ var
+ i: Integer;
+ Node: TfsTreeViewItem;
+ s: String;
+ begin
+ s := xi.Prop['text'];
+ if xi.Count = 0 then
+ s := Copy(s, Pos(' ', s) + 1, 255) else { function }
+ s := GetCategoryByName(s); { category }
+ Node := TfsTreeViewItem.Create(Tree);
+ Node.DragMode := TDragMode.dmAutomatic;
+ Node.Text := s;
+ if Root <> nil then
+ Node.Parent := Root
+ else
+ Node.Parent := Tree;
+ Node.Parent.AddObject(Node);
+ if Root = nil then
+ Node.Text := xi.Name;
+ if xi.Count = 0 then
+ begin
+ Node.OpenImageIndex := 0;
+ Node.CloseImageIndex := 0;
+ end
+ else
+ begin
+ Node.OpenImageIndex := 3;
+ Node.CloseImageIndex := 2;
+ end;
+ for i := 0 to xi.Count - 1 do
+ AddFunctions(xi[i], Node);
+ end;
+
+ procedure AddTypes(xi: TfsXMLItem; Root: TfsTreeViewItem);
+ var
+ i: Integer;
+ Node: TfsTreeViewItem;
+ s: String;
+ begin
+ s := Copy(xi.Prop['text'], 1, 255);
+ Node := TfsTreeViewItem.Create(Tree);
+ Node.Text := s;
+ if Root <> nil then
+ Node.Parent := Root
+ else
+ Node.Parent := Tree;
+ Node.Parent.AddObject(Node);
+ if Root = nil then
+ Node.Text := xi.Name;
+ if xi.Count = 0 then
+ begin
+ Node.OpenImageIndex := 0;
+ Node.CloseImageIndex := 0;
+ end
+ else
+ begin
+ Node.OpenImageIndex := 3;
+ Node.CloseImageIndex := 2;
+ end;
+ for i := 0 to xi.Count - 1 do
+ AddTypes(xi[i], Node);
+ end;
+
+ procedure AddVariables(xi: TfsXMLItem; Root: TfsTreeViewItem);
+ var
+ i: Integer;
+ Node: TfsTreeViewItem;
+ s: String;
+ begin
+ s := xi.Prop['text'];
+ Node := TfsTreeViewItem.Create(Tree);
+ Node.Text := s;
+ if Root <> nil then
+ Node.Parent := Root
+ else
+ Node.Parent := Tree;
+ Node.Parent.AddObject(Node);
+ if Root = nil then
+ Node.Text := xi.Name;
+ if xi.Count = 0 then
+ begin
+ Node.OpenImageIndex := 0;
+ Node.CloseImageIndex := 0;
+ end
+ else
+ begin
+ Node.OpenImageIndex := 3;
+ Node.CloseImageIndex := 2;
+ end;
+ for i := 0 to xi.Count - 1 do
+ AddVariables(xi[i], Node);
+ end;
+
+ procedure ExpandNodes(level: integer);
+ var
+ j : integer;
+
+ procedure ExpandNode(Node: TTreeViewItem; level: integer);
+ var
+ j : integer;
+ begin
+ if Node.Level < level then
+ for j := 0 to Node.Count - 1 do
+ begin
+ if Node.Items[j].Level < Level then
+ Node.Items[j].IsExpanded := True;
+ ExpandNode(Node.Items[j], Level);
+ end;
+ end;
+ begin
+ if level > 0 then
+ for j := 0 to Tree.Count - 1 do
+ begin
+ if Tree.Items[j].Level <= Level then
+ Tree.Items[j].IsExpanded := True;
+ ExpandNode(Tree.Items[j], Level);
+ end;
+ end;
+
+begin
+ FUpdating := True;
+ FXML.Root.Clear;
+
+ GenerateXMLContents(fsGlobalUnit, FXML.Root);
+ if FScript <> nil then
+ GenerateXMLContents(FScript, FXML.Root);
+
+ Tree.BeginUpdate;
+ Tree.Clear;
+
+ if ShowClasses then
+ AddClasses(FXML.Root.FindItem('Classes'), nil);
+
+ if ShowFunctions then
+ AddFunctions(FXML.Root.FindItem('Functions'), nil);
+
+ if ShowTypes then
+ AddTypes(FXML.Root.FindItem('Types'), nil);
+
+ if ShowVariables then
+ AddVariables(FXML.Root.FindItem('Variables'), nil);
+
+ if Expanded then
+ ExpandNodes(ExpandLevel);
+ Tree.EndUpdate;
+ FUpdating := False;
+end;
+
+procedure TfsTree.UpdateItems;
+begin
+ FillTree;
+end;
+
+procedure TfsTree.TreeChange(Sender: TObject;
+ Node: TTreeViewItem);
+begin
+ if FUpdating then Exit;
+end;
+
+procedure TfsTree.TreeDblClick(Sender: TObject);
+begin
+ //if Assigned(SyntaxMemo) then
+ //if Tree.Selected.Count = 0 then
+ // SyntaxMemo.SelText := Tree.Selected.Text;
+ if Assigned(OnDblClick) then OnDblClick(Self);
+end;
+
+function TfsTree.GetFieldName: String;
+var
+ i, n: Integer;
+ s: String;
+begin
+ Result := '';
+ if (Tree.Selected <> nil) and (Tree.Selected.Count = 0) then
+ begin
+ s := Tree.Selected.Text;
+ if Pos('(', s) <> 0 then
+ n := 1 else
+ n := 0;
+ for i := 1 to Length(s) do
+{$IFDEF Delphi12}
+ if (s[i] = ',') or (s[i] = ';') then
+{$ELSE}
+ if s[i] in [',', ';'] then
+{$ENDIF}
+ Inc(n);
+
+ if n = 0 then
+ s := Copy(s, 1, Pos(':', s) - 1)
+ else
+ begin
+ s := Copy(s, 1, Pos('(', s));
+ for i := 1 to n - 1 do
+ s := s + ',';
+ s := s + ')';
+ end;
+ Result := s;
+ end;
+end;
+
+procedure TfsTree.Loaded;
+begin
+ Inherited;
+
+end;
+
+procedure TfsTree.SetColor(Color: TAlphaColor);
+begin
+ //Tree.Canvas.Stroke.Color := TAlphaColorRec.Azure;
+ // Tree.Color := Color;
+end;
+
+procedure TfsTree.SetMemo(Value: TfsSyntaxMemo);
+begin
+ FMemo := Value;
+end;
+
+procedure TfsTree.SetScript(const Value: TfsScript);
+begin
+ FScript := Value;
+ UpdateItems;
+end;
+
+procedure TfsTree.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited Notification(AComponent, Operation);
+ if Operation = opRemove then
+ if AComponent = FScript then
+ FScript := nil
+ else if AComponent = FMemo then
+ FMemo := nil
+end;
+
+{ TfsTreeViewItem }
+
+procedure TfsTreeViewItem.ApplyStyle;
+var
+ B: TFmxObject;
+ Offset: Single;
+begin
+ inherited;
+ B := FindStyleResource('button');
+ if (B <> nil) and (B is TCustomButton) then
+ begin
+ FButton := TCustomButton(B);
+ B := FindStyleResource('text');
+ Offset := 0;
+ if Self.TreeView is TfsTreeView then
+ Offset := TfsTreeView(Self.TreeView).IconWidth;
+
+ if (B <> nil) and (B is TText) then
+ begin
+{$IFDEF DELPHI17}
+ TText(B).Margins.Left := Offset;
+{$ELSE}
+ TText(B).Padding.Left := Offset;
+{$ENDIF}
+ end;
+ FImgPos := FButton.Position.X + FButton.Width - 2;
+ end;
+end;
+
+
+constructor TfsTreeViewItem.Create(AOwner: TComponent);
+begin
+ inherited;
+ FImgPos := 0;
+ FCloseImageIndex := -1;
+ FOpenImageIndex := -1;
+end;
+
+function TfsTreeViewItem.GetBitmap: TBitmap;
+begin
+ Result := nil;
+ if TreeView is TfsTreeView then
+ begin
+ Result := TfsTreeView(TreeView).FPicBitmap;
+ end;
+end;
+
+procedure TfsTreeViewItem.Paint;
+var
+ Bmp: TBitmap;
+ IconRect: TRectF;
+ Index: Integer;
+begin
+ inherited Paint;
+ if IsExpanded then
+ Index := FOpenImageIndex
+ else
+ Index := FCloseImageIndex;
+
+ if Index = -1 then Exit;
+
+ Bmp := GetBitmap;
+ if TreeView is TfsTreeView then
+ begin
+ IconRect := TfsTreeView(TreeView).GetBitmapRect(Index);
+ end;
+ if (Bmp <> nil) and (FImgPos > 0)then
+ Canvas.DrawBitmap(Bmp, IconRect, RectF(16, 0, 34, 16), 1 );
+end;
+
+{ TfsTreeView }
+
+constructor TfsTreeView.Create(AOwner: TComponent);
+begin
+ inherited;
+ FPicBitmap := nil;
+ FIconWidth := 0;
+ FIconHeight := 0;
+end;
+
+destructor TfsTreeView.Destroy;
+begin
+ if FPicBitmap <> nil then
+ FPicBitmap.Free;
+
+ inherited;
+end;
+
+procedure TfsTreeView.DragDrop(const Data: TDragObject; const Point: TPointF);
+begin
+ //inherited;
+ // don't use TTreeView handlers
+end;
+
+procedure TfsTreeView.DragOver(const Data: TDragObject; const Point: TPointF;
+ {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+begin
+ //inherited;
+ //don't use TTreeView handlers
+end;
+
+function TfsTreeView.GetBitmapRect(Index: Integer): TRectF;
+var
+ maxX, maxY, i: Integer;
+ PosX, PosY: Integer;
+begin
+ Result := RectF(0, 0, 0, 0);
+ if FPicBitmap = nil then Exit;
+ PosX := 0;
+ PosY := 0;
+ maxX := FPicBitmap.Width div FIconWidth;
+ maxY := FPicBitmap.Height div FIconHeight;
+
+ for i := 0 to maxY - 1 do
+ begin
+ if Index < maxX then
+ begin
+ PosX := FIconWidth * Index;
+ break;
+ end;
+ Index := Index div maxY;
+ Inc(PosY);
+ if PosY > maxY then
+ begin
+ PosX := 0;
+ PosY := 0;
+ break;
+ end;
+ end;
+ Result := RectF(PosX, PosY, PosX + FIconWidth, PosY + FIconHeight);
+end;
+
+procedure TfsTreeView.LoadResouces(Stream: TStream; IconWidth,
+ IconHeight: Integer);
+begin
+ FIconWidth := IconWidth;
+ FIconHeight := IconHeight;
+ if FPicBitmap = nil then
+ FPicBitmap := TBitmap.CreateFromStream(Stream)
+ else
+ FPicBitmap.LoadFromStream(Stream);
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsTreeViewItem, TFmxObject);
+ GroupDescendentsWith(TfsTreeView, TFmxObject);
+ GroupDescendentsWith(TfsTree, TFmxObject);
+ RegisterFmxClasses([TfsTreeViewItem, TfsTreeView]);
+
+end.
diff --git a/LibD28/FMX.fs_xml.pas b/LibD28/FMX.fs_xml.pas
new file mode 100644
index 0000000..11723e4
--- /dev/null
+++ b/LibD28/FMX.fs_xml.pas
@@ -0,0 +1,15 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ XML document }
+{ }
+{ (c) 2003-2011 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.fs_xml;
+
+{$i FMX.inc}
+{$i fs_xml.pas}
\ No newline at end of file
diff --git a/LibD28/FMXfrx16.dpk b/LibD28/FMXfrx16.dpk
new file mode 100644
index 0000000..c458b2c
--- /dev/null
+++ b/LibD28/FMXfrx16.dpk
@@ -0,0 +1,127 @@
+// Package file for Rad Studio XE2
+
+package FMXfrx16;
+{$I frx.inc}
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs16;
+
+contains
+ FMX.frxAggregate in 'FMX.frxAggregate.pas',
+ FMX.frxClass in 'FMX.frxClass.pas',
+ FMX.frxClassRTTI in 'FMX.frxClassRTTI.pas',
+ FMX.frxCtrls in 'FMX.frxCtrls.pas',
+ FMX.frxDialogForm in 'FMX.frxDialogForm.pas',
+ FMX.frxDMPClass in 'FMX.frxDMPClass.pas',
+ FMX.frxEngine in 'FMX.frxEngine.pas',
+ FMX.frxFMX in 'FMX.frxFMX.pas',
+ FMX.frxGraphicUtils in 'FMX.frxGraphicUtils.pas',
+ FMX.frxPassw in 'FMX.frxPassw.pas',
+ FMX.frxPictureCache in 'FMX.frxPictureCache.pas',
+ FMX.frxPreview in 'FMX.frxPreview.pas',
+ FMX.frxPreviewPages in 'FMX.frxPreviewPages.pas',
+ FMX.frxPreviewPageSettings in 'FMX.frxPreviewPageSettings.pas',
+ FMX.frxPrintDialog in 'FMX.frxPrintDialog.pas',
+ FMX.frxPrinter in 'FMX.frxPrinter.pas',
+{$IFDEF MSWINDOWS}
+ FMX.Win.frxPrinter in 'FMX.Win.frxPrinter.pas',
+{$ELSE}
+ FMX.Mac.frxPrinter in 'FMX.Mac.frxPrinter.pas',
+{$ENDIF}
+ FMX.frxProgress in 'FMX.frxProgress.pas',
+ FMX.frxrcClass in 'FMX.frxrcClass.pas',
+ FMX.frxRes in 'FMX.frxRes.pas',
+ FMX.frxSearchDialog in 'FMX.frxSearchDialog.pas',
+ FMX.frxUnicodeUtils in 'FMX.frxUnicodeUtils.pas',
+ FMX.frxUtils in 'FMX.frxUtils.pas',
+ FMX.frxVariables in 'FMX.frxVariables.pas',
+ FMX.frxXML in 'FMX.frxXML.pas',
+ FMX.frxXMLSerializer in 'FMX.frxXMLSerializer.pas',
+ FMX.frxAbout in 'FMX.frxAbout.pas',
+ FMX.frxCodeUtils in 'FMX.frxCodeUtils.pas',
+ FMX.frxCustomEditors in 'FMX.frxCustomEditors.pas',
+ FMX.frxDataTree in 'FMX.frxDataTree.pas',
+ FMX.frxDesgn in 'FMX.frxDesgn.pas',
+ FMX.frxDesgnEditors in 'FMX.frxDesgnEditors.pas',
+ FMX.frxDesgnWorkspace in 'FMX.frxDesgnWorkspace.pas',
+ FMX.frxDesgnWorkspace1 in 'FMX.frxDesgnWorkspace1.pas',
+ FMX.frxDsgnIntf in 'FMX.frxDsgnIntf.pas',
+ FMX.frxEditDataBand in 'FMX.frxEditDataBand.pas',
+ FMX.frxEditExpr in 'FMX.frxEditExpr.pas',
+ FMX.frxEditFormat in 'FMX.frxEditFormat.pas',
+ FMX.frxEditFrame in 'FMX.frxEditFrame.pas',
+ FMX.frxEditGroup in 'FMX.frxEditGroup.pas',
+ FMX.frxEditHighlight in 'FMX.frxEditHighlight.pas',
+ FMX.frxEditMemo in 'FMX.frxEditMemo.pas',
+ FMX.frxEditOptions in 'FMX.frxEditOptions.pas',
+ FMX.frxEditPage in 'FMX.frxEditPage.pas',
+ FMX.frxEditPicture in 'FMX.frxEditPicture.pas',
+ FMX.frxEditReport in 'FMX.frxEditReport.pas',
+ FMX.frxEditReportData in 'FMX.frxEditReportData.pas',
+ FMX.frxEditStrings in 'FMX.frxEditStrings.pas',
+ FMX.frxEditStyle in 'FMX.frxEditStyle.pas',
+ FMX.frxEditSysMemo in 'FMX.frxEditSysMemo.pas',
+ FMX.frxEditTabOrder in 'FMX.frxEditTabOrder.pas',
+ FMX.frxEditVar in 'FMX.frxEditVar.pas',
+ FMX.frxEvaluateForm in 'FMX.frxEvaluateForm.pas',
+ FMX.frxInheritError in 'FMX.frxInheritError.pas',
+ FMX.frxInsp in 'FMX.frxInsp.pas',
+ FMX.frxPopupForm in 'FMX.frxPopupForm.pas',
+ FMX.frxrcDesgn in 'FMX.frxrcDesgn.pas',
+ FMX.frxrcInsp in 'FMX.frxrcInsp.pas',
+ FMX.frxReportTree in 'FMX.frxReportTree.pas',
+ FMX.frxWatchForm in 'FMX.frxWatchForm.pas',
+ FMX.frxFontForm in 'FMX.frxFontForm.pas',
+{$IFNDEF RAD_ED}
+ FMX.frxGZip in 'FMX.frxGZip.pas',
+ FMX.frxDesgnCtrls in 'FMX.frxDesgnCtrls.pas',
+ FMX.frxCross in 'FMX.frxCross.pas',
+ FMX.frxCrossEditor in 'FMX.frxCrossEditor.pas',
+ FMX.frxCrossRTTI in 'FMX.frxCrossRTTI.pas',
+ FMX.frxDCtrl in 'FMX.frxDCtrl.pas',
+ FMX.frxDCtrlRTTI in 'FMX.frxDCtrlRTTI.pas',
+ FMX.frxGradient in 'FMX.frxGradient.pas',
+ FMX.frxGradientRTTI in 'FMX.frxGradientRTTI.pas',
+ FMX.frxBarcode2DView in 'FMX.frxBarcode2DView.pas',
+ FMX.frxBarcode2DBase in 'FMX.frxBarcode2DBase.pas',
+ FMX.frxBarcode in 'FMX.frxBarcode.pas',
+ FMX.frxBarcod in 'FMX.frxBarcod.pas',
+ FMX.frxBarcodeEditor in 'FMX.frxBarcodeEditor.pas' {frxBarcodeEditorForm},
+ FMX.frxBarcodeProperties in 'FMX.frxBarcodeProperties.pas',
+ FMX.frxBarcodeDataMatrix in 'FMX.frxBarcodeDataMatrix.pas',
+ FMX.frxBarcodePDF417 in 'FMX.frxBarcodePDF417.pas',
+ FMX.frxBarcodeRTTI in 'FMX.frxBarcodeRTTI.pas',
+ FMX.frxChBox in 'FMX.frxChBox.pas',
+ FMX.frxChBoxRTTI in 'FMX.frxChBoxRTTI.pas',
+{$ENDIF}
+ FMX.frxEditAliases in 'FMX.frxEditAliases.pas' {frxAliasesEditorForm};
+end.
+
diff --git a/LibD28/FMXfrx16.otares b/LibD28/FMXfrx16.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrx16.otares differ
diff --git a/LibD28/FMXfrx16.res b/LibD28/FMXfrx16.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrx16.res differ
diff --git a/LibD28/FMXfrx17.dpk b/LibD28/FMXfrx17.dpk
new file mode 100644
index 0000000..a1dd1bc
--- /dev/null
+++ b/LibD28/FMXfrx17.dpk
@@ -0,0 +1,130 @@
+// Package file for Rad Studio XE3
+
+package FMXfrx17;
+{$I frx.inc}
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs17;
+
+contains
+ FMX.frxAggregate in 'FMX.frxAggregate.pas',
+ FMX.frxClass in 'FMX.frxClass.pas',
+ FMX.frxClassRTTI in 'FMX.frxClassRTTI.pas',
+ FMX.frxCtrls in 'FMX.frxCtrls.pas',
+ FMX.frxDialogForm in 'FMX.frxDialogForm.pas',
+ FMX.frxDMPClass in 'FMX.frxDMPClass.pas',
+ FMX.frxEngine in 'FMX.frxEngine.pas',
+ FMX.frxFMX in 'FMX.frxFMX.pas',
+ FMX.frxGraphicUtils in 'FMX.frxGraphicUtils.pas',
+ FMX.frxPassw in 'FMX.frxPassw.pas',
+ FMX.frxPictureCache in 'FMX.frxPictureCache.pas',
+ FMX.frxPreview in 'FMX.frxPreview.pas',
+ FMX.frxPreviewPages in 'FMX.frxPreviewPages.pas',
+ FMX.frxPreviewPageSettings in 'FMX.frxPreviewPageSettings.pas',
+ FMX.frxPrintDialog in 'FMX.frxPrintDialog.pas',
+ FMX.frxPrinter in 'FMX.frxPrinter.pas',
+{$IFDEF MSWINDOWS}
+ FMX.Win.frxPrinter in 'FMX.Win.frxPrinter.pas',
+{$ELSE}
+ FMX.Mac.frxPrinter in 'FMX.Mac.frxPrinter.pas',
+{$ENDIF}
+ FMX.frxProgress in 'FMX.frxProgress.pas',
+ FMX.frxrcClass in 'FMX.frxrcClass.pas',
+ FMX.frxRes in 'FMX.frxRes.pas',
+ FMX.frxSearchDialog in 'FMX.frxSearchDialog.pas',
+ FMX.frxUnicodeUtils in 'FMX.frxUnicodeUtils.pas',
+ FMX.frxUtils in 'FMX.frxUtils.pas',
+ FMX.frxVariables in 'FMX.frxVariables.pas',
+ FMX.frxXML in 'FMX.frxXML.pas',
+ FMX.frxXMLSerializer in 'FMX.frxXMLSerializer.pas',
+ FMX.frxAbout in 'FMX.frxAbout.pas',
+ FMX.frxCodeUtils in 'FMX.frxCodeUtils.pas',
+ FMX.frxCustomEditors in 'FMX.frxCustomEditors.pas',
+ FMX.frxDataTree in 'FMX.frxDataTree.pas',
+ FMX.frxDesgn in 'FMX.frxDesgn.pas',
+ FMX.frxDesgnEditors in 'FMX.frxDesgnEditors.pas',
+ FMX.frxDesgnWorkspace in 'FMX.frxDesgnWorkspace.pas',
+ FMX.frxDesgnWorkspace1 in 'FMX.frxDesgnWorkspace1.pas',
+ FMX.frxDsgnIntf in 'FMX.frxDsgnIntf.pas',
+ FMX.frxEditDataBand in 'FMX.frxEditDataBand.pas',
+ FMX.frxEditExpr in 'FMX.frxEditExpr.pas',
+ FMX.frxEditFormat in 'FMX.frxEditFormat.pas',
+ FMX.frxEditFrame in 'FMX.frxEditFrame.pas',
+ FMX.frxEditGroup in 'FMX.frxEditGroup.pas',
+ FMX.frxEditHighlight in 'FMX.frxEditHighlight.pas',
+ FMX.frxEditMemo in 'FMX.frxEditMemo.pas',
+ FMX.frxEditOptions in 'FMX.frxEditOptions.pas',
+ FMX.frxEditPage in 'FMX.frxEditPage.pas',
+ FMX.frxEditPicture in 'FMX.frxEditPicture.pas',
+ FMX.frxEditReport in 'FMX.frxEditReport.pas',
+ FMX.frxEditReportData in 'FMX.frxEditReportData.pas',
+ FMX.frxEditStrings in 'FMX.frxEditStrings.pas',
+ FMX.frxEditStyle in 'FMX.frxEditStyle.pas',
+ FMX.frxEditSysMemo in 'FMX.frxEditSysMemo.pas',
+ FMX.frxEditTabOrder in 'FMX.frxEditTabOrder.pas',
+ FMX.frxEditVar in 'FMX.frxEditVar.pas',
+ FMX.frxEvaluateForm in 'FMX.frxEvaluateForm.pas',
+ FMX.frxInheritError in 'FMX.frxInheritError.pas',
+ FMX.frxInsp in 'FMX.frxInsp.pas',
+ FMX.frxPopupForm in 'FMX.frxPopupForm.pas',
+ FMX.frxrcDesgn in 'FMX.frxrcDesgn.pas',
+ FMX.frxrcInsp in 'FMX.frxrcInsp.pas',
+ FMX.frxReportTree in 'FMX.frxReportTree.pas',
+ FMX.frxWatchForm in 'FMX.frxWatchForm.pas',
+ FMX.frxFontForm in 'FMX.frxFontForm.pas',
+ {$IFNDEF RAD_ED}
+ FMX.frxCross in 'FMX.frxCross.pas',
+ FMX.frxCrossEditor in 'FMX.frxCrossEditor.pas',
+ FMX.frxCrossRTTI in 'FMX.frxCrossRTTI.pas',
+ FMX.frxDCtrl in 'FMX.frxDCtrl.pas',
+ FMX.frxDCtrlRTTI in 'FMX.frxDCtrlRTTI.pas',
+ FMX.frxGradient in 'FMX.frxGradient.pas',
+ FMX.frxGradientRTTI in 'FMX.frxGradientRTTI.pas',
+ FMX.frxGZip in 'FMX.frxGZip.pas',
+ FMX.frxDesgnCtrls in 'FMX.frxDesgnCtrls.pas',
+ FMX.frxBarcode2DView in 'FMX.frxBarcode2DView.pas',
+ FMX.frxBarcode2DBase in 'FMX.frxBarcode2DBase.pas',
+ FMX.frxBarcode in 'FMX.frxBarcode.pas',
+ FMX.frxBarcod in 'FMX.frxBarcod.pas',
+ FMX.frxBarcodeEditor in 'FMX.frxBarcodeEditor.pas' {frxBarcodeEditorForm},
+ FMX.frxBarcodeProperties in 'FMX.frxBarcodeProperties.pas',
+ FMX.frxBarcodeDataMatrix in 'FMX.frxBarcodeDataMatrix.pas',
+ FMX.frxBarcodePDF417 in 'FMX.frxBarcodePDF417.pas',
+ FMX.frxBarcodeRTTI in 'FMX.frxBarcodeRTTI.pas',
+
+ FMX.frxChBox in 'FMX.frxChBox.pas',
+ FMX.frxChBoxRTTI in 'FMX.frxChBoxRTTI.pas',
+{$ENDIF}
+
+ FMX.frxEditAliases in 'FMX.frxEditAliases.pas' {frxAliasesEditorForm};
+
+end.
+
diff --git a/LibD28/FMXfrx17.otares b/LibD28/FMXfrx17.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrx17.otares differ
diff --git a/LibD28/FMXfrx17.res b/LibD28/FMXfrx17.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrx17.res differ
diff --git a/LibD28/FMXfrx18.dpk b/LibD28/FMXfrx18.dpk
new file mode 100644
index 0000000..04d3e55
--- /dev/null
+++ b/LibD28/FMXfrx18.dpk
@@ -0,0 +1,130 @@
+// Package file for Rad Studio XE4
+
+package FMXfrx18;
+{$I frx.inc}
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs18;
+
+contains
+ FMX.frxAggregate in 'FMX.frxAggregate.pas',
+ FMX.frxClass in 'FMX.frxClass.pas',
+ FMX.frxClassRTTI in 'FMX.frxClassRTTI.pas',
+ FMX.frxCtrls in 'FMX.frxCtrls.pas',
+ FMX.frxDialogForm in 'FMX.frxDialogForm.pas',
+ FMX.frxDMPClass in 'FMX.frxDMPClass.pas',
+ FMX.frxEngine in 'FMX.frxEngine.pas',
+ FMX.frxFMX in 'FMX.frxFMX.pas',
+ FMX.frxGraphicUtils in 'FMX.frxGraphicUtils.pas',
+ FMX.frxPassw in 'FMX.frxPassw.pas',
+ FMX.frxPictureCache in 'FMX.frxPictureCache.pas',
+ FMX.frxPreview in 'FMX.frxPreview.pas',
+ FMX.frxPreviewPages in 'FMX.frxPreviewPages.pas',
+ FMX.frxPreviewPageSettings in 'FMX.frxPreviewPageSettings.pas',
+ FMX.frxPrintDialog in 'FMX.frxPrintDialog.pas',
+ FMX.frxPrinter in 'FMX.frxPrinter.pas',
+{$IFDEF MSWINDOWS}
+ FMX.Win.frxPrinter in 'FMX.Win.frxPrinter.pas',
+{$ELSE}
+ FMX.Mac.frxPrinter in 'FMX.Mac.frxPrinter.pas',
+{$ENDIF}
+ FMX.frxProgress in 'FMX.frxProgress.pas',
+ FMX.frxrcClass in 'FMX.frxrcClass.pas',
+ FMX.frxRes in 'FMX.frxRes.pas',
+ FMX.frxSearchDialog in 'FMX.frxSearchDialog.pas',
+ FMX.frxUnicodeUtils in 'FMX.frxUnicodeUtils.pas',
+ FMX.frxUtils in 'FMX.frxUtils.pas',
+ FMX.frxVariables in 'FMX.frxVariables.pas',
+ FMX.frxXML in 'FMX.frxXML.pas',
+ FMX.frxXMLSerializer in 'FMX.frxXMLSerializer.pas',
+ FMX.frxAbout in 'FMX.frxAbout.pas',
+ FMX.frxCodeUtils in 'FMX.frxCodeUtils.pas',
+ FMX.frxCustomEditors in 'FMX.frxCustomEditors.pas',
+ FMX.frxDataTree in 'FMX.frxDataTree.pas',
+ FMX.frxDesgn in 'FMX.frxDesgn.pas',
+ FMX.frxDesgnEditors in 'FMX.frxDesgnEditors.pas',
+ FMX.frxDesgnWorkspace in 'FMX.frxDesgnWorkspace.pas',
+ FMX.frxDesgnWorkspace1 in 'FMX.frxDesgnWorkspace1.pas',
+ FMX.frxDsgnIntf in 'FMX.frxDsgnIntf.pas',
+ FMX.frxEditDataBand in 'FMX.frxEditDataBand.pas',
+ FMX.frxEditExpr in 'FMX.frxEditExpr.pas',
+ FMX.frxEditFormat in 'FMX.frxEditFormat.pas',
+ FMX.frxEditFrame in 'FMX.frxEditFrame.pas',
+ FMX.frxEditGroup in 'FMX.frxEditGroup.pas',
+ FMX.frxEditHighlight in 'FMX.frxEditHighlight.pas',
+ FMX.frxEditMemo in 'FMX.frxEditMemo.pas',
+ FMX.frxEditOptions in 'FMX.frxEditOptions.pas',
+ FMX.frxEditPage in 'FMX.frxEditPage.pas',
+ FMX.frxEditPicture in 'FMX.frxEditPicture.pas',
+ FMX.frxEditReport in 'FMX.frxEditReport.pas',
+ FMX.frxEditReportData in 'FMX.frxEditReportData.pas',
+ FMX.frxEditStrings in 'FMX.frxEditStrings.pas',
+ FMX.frxEditStyle in 'FMX.frxEditStyle.pas',
+ FMX.frxEditSysMemo in 'FMX.frxEditSysMemo.pas',
+ FMX.frxEditTabOrder in 'FMX.frxEditTabOrder.pas',
+ FMX.frxEditVar in 'FMX.frxEditVar.pas',
+ FMX.frxEvaluateForm in 'FMX.frxEvaluateForm.pas',
+ FMX.frxInheritError in 'FMX.frxInheritError.pas',
+ FMX.frxInsp in 'FMX.frxInsp.pas',
+ FMX.frxPopupForm in 'FMX.frxPopupForm.pas',
+ FMX.frxrcDesgn in 'FMX.frxrcDesgn.pas',
+ FMX.frxrcInsp in 'FMX.frxrcInsp.pas',
+ FMX.frxReportTree in 'FMX.frxReportTree.pas',
+ FMX.frxWatchForm in 'FMX.frxWatchForm.pas',
+ FMX.frxFontForm in 'FMX.frxFontForm.pas',
+{$IFNDEF RAD_ED}
+ FMX.frxCross in 'FMX.frxCross.pas',
+ FMX.frxCrossEditor in 'FMX.frxCrossEditor.pas',
+ FMX.frxCrossRTTI in 'FMX.frxCrossRTTI.pas',
+ FMX.frxDCtrl in 'FMX.frxDCtrl.pas',
+ FMX.frxDCtrlRTTI in 'FMX.frxDCtrlRTTI.pas',
+ FMX.frxGradient in 'FMX.frxGradient.pas',
+ FMX.frxGradientRTTI in 'FMX.frxGradientRTTI.pas',
+ FMX.frxGZip in 'FMX.frxGZip.pas',
+ FMX.frxDesgnCtrls in 'FMX.frxDesgnCtrls.pas',
+ FMX.frxBarcode2DView in 'FMX.frxBarcode2DView.pas',
+ FMX.frxBarcode2DBase in 'FMX.frxBarcode2DBase.pas',
+ FMX.frxBarcode in 'FMX.frxBarcode.pas',
+ FMX.frxBarcod in 'FMX.frxBarcod.pas',
+ FMX.frxBarcodeEditor in 'FMX.frxBarcodeEditor.pas' {frxBarcodeEditorForm},
+ FMX.frxBarcodeProperties in 'FMX.frxBarcodeProperties.pas',
+ FMX.frxBarcodeDataMatrix in 'FMX.frxBarcodeDataMatrix.pas',
+ FMX.frxBarcodePDF417 in 'FMX.frxBarcodePDF417.pas',
+ FMX.frxBarcodeRTTI in 'FMX.frxBarcodeRTTI.pas',
+ FMX.frxChBox in 'FMX.frxChBox.pas',
+ FMX.frxChBoxRTTI in 'FMX.frxChBoxRTTI.pas',
+{$ENDIF}
+
+ FMX.frxEditAliases in 'FMX.frxEditAliases.pas' {frxAliasesEditorForm};
+
+end.
+
diff --git a/LibD28/FMXfrx18.otares b/LibD28/FMXfrx18.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrx18.otares differ
diff --git a/LibD28/FMXfrx18.res b/LibD28/FMXfrx18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrx18.res differ
diff --git a/LibD28/FMXfrx19.dpk b/LibD28/FMXfrx19.dpk
new file mode 100644
index 0000000..662e0f5
--- /dev/null
+++ b/LibD28/FMXfrx19.dpk
@@ -0,0 +1,129 @@
+// Package file for Rad Studio XE5
+
+package FMXfrx19;
+{$I frx.inc}
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs19;
+
+contains
+ FMX.frxAggregate in 'FMX.frxAggregate.pas',
+ FMX.frxClass in 'FMX.frxClass.pas',
+ FMX.frxClassRTTI in 'FMX.frxClassRTTI.pas',
+ FMX.frxCtrls in 'FMX.frxCtrls.pas',
+ FMX.frxDialogForm in 'FMX.frxDialogForm.pas',
+ FMX.frxDMPClass in 'FMX.frxDMPClass.pas',
+ FMX.frxEngine in 'FMX.frxEngine.pas',
+ FMX.frxFMX in 'FMX.frxFMX.pas',
+ FMX.frxGraphicUtils in 'FMX.frxGraphicUtils.pas',
+ FMX.frxPassw in 'FMX.frxPassw.pas',
+ FMX.frxPictureCache in 'FMX.frxPictureCache.pas',
+ FMX.frxPreview in 'FMX.frxPreview.pas',
+ FMX.frxPreviewPages in 'FMX.frxPreviewPages.pas',
+ FMX.frxPreviewPageSettings in 'FMX.frxPreviewPageSettings.pas',
+ FMX.frxPrintDialog in 'FMX.frxPrintDialog.pas',
+ FMX.frxPrinter in 'FMX.frxPrinter.pas',
+{$IFDEF MSWINDOWS}
+ FMX.Win.frxPrinter in 'FMX.Win.frxPrinter.pas',
+{$ELSE}
+ FMX.Mac.frxPrinter in 'FMX.Mac.frxPrinter.pas',
+{$ENDIF}
+ FMX.frxProgress in 'FMX.frxProgress.pas',
+ FMX.frxrcClass in 'FMX.frxrcClass.pas',
+ FMX.frxRes in 'FMX.frxRes.pas',
+ FMX.frxSearchDialog in 'FMX.frxSearchDialog.pas',
+ FMX.frxUnicodeUtils in 'FMX.frxUnicodeUtils.pas',
+ FMX.frxUtils in 'FMX.frxUtils.pas',
+ FMX.frxVariables in 'FMX.frxVariables.pas',
+ FMX.frxXML in 'FMX.frxXML.pas',
+ FMX.frxXMLSerializer in 'FMX.frxXMLSerializer.pas',
+ FMX.frxAbout in 'FMX.frxAbout.pas',
+ FMX.frxCodeUtils in 'FMX.frxCodeUtils.pas',
+ FMX.frxCustomEditors in 'FMX.frxCustomEditors.pas',
+ FMX.frxDataTree in 'FMX.frxDataTree.pas',
+ FMX.frxDesgn in 'FMX.frxDesgn.pas',
+ FMX.frxDesgnEditors in 'FMX.frxDesgnEditors.pas',
+ FMX.frxDesgnWorkspace in 'FMX.frxDesgnWorkspace.pas',
+ FMX.frxDesgnWorkspace1 in 'FMX.frxDesgnWorkspace1.pas',
+ FMX.frxDsgnIntf in 'FMX.frxDsgnIntf.pas',
+ FMX.frxEditDataBand in 'FMX.frxEditDataBand.pas',
+ FMX.frxEditExpr in 'FMX.frxEditExpr.pas',
+ FMX.frxEditFormat in 'FMX.frxEditFormat.pas',
+ FMX.frxEditFrame in 'FMX.frxEditFrame.pas',
+ FMX.frxEditGroup in 'FMX.frxEditGroup.pas',
+ FMX.frxEditHighlight in 'FMX.frxEditHighlight.pas',
+ FMX.frxEditMemo in 'FMX.frxEditMemo.pas',
+ FMX.frxEditOptions in 'FMX.frxEditOptions.pas',
+ FMX.frxEditPage in 'FMX.frxEditPage.pas',
+ FMX.frxEditPicture in 'FMX.frxEditPicture.pas',
+ FMX.frxEditReport in 'FMX.frxEditReport.pas',
+ FMX.frxEditReportData in 'FMX.frxEditReportData.pas',
+ FMX.frxEditStrings in 'FMX.frxEditStrings.pas',
+ FMX.frxEditStyle in 'FMX.frxEditStyle.pas',
+ FMX.frxEditSysMemo in 'FMX.frxEditSysMemo.pas',
+ FMX.frxEditTabOrder in 'FMX.frxEditTabOrder.pas',
+ FMX.frxEditVar in 'FMX.frxEditVar.pas',
+ FMX.frxEvaluateForm in 'FMX.frxEvaluateForm.pas',
+ FMX.frxInheritError in 'FMX.frxInheritError.pas',
+ FMX.frxInsp in 'FMX.frxInsp.pas',
+ FMX.frxPopupForm in 'FMX.frxPopupForm.pas',
+ FMX.frxrcDesgn in 'FMX.frxrcDesgn.pas',
+ FMX.frxrcInsp in 'FMX.frxrcInsp.pas',
+ FMX.frxReportTree in 'FMX.frxReportTree.pas',
+ FMX.frxWatchForm in 'FMX.frxWatchForm.pas',
+{$IFNDEF RAD_ED}
+ FMX.frxCross in 'FMX.frxCross.pas',
+ FMX.frxCrossEditor in 'FMX.frxCrossEditor.pas',
+ FMX.frxCrossRTTI in 'FMX.frxCrossRTTI.pas',
+ FMX.frxDCtrl in 'FMX.frxDCtrl.pas',
+ FMX.frxDCtrlRTTI in 'FMX.frxDCtrlRTTI.pas',
+ FMX.frxGradient in 'FMX.frxGradient.pas',
+ FMX.frxGradientRTTI in 'FMX.frxGradientRTTI.pas',
+ FMX.frxGZip in 'FMX.frxGZip.pas',
+ FMX.frxDesgnCtrls in 'FMX.frxDesgnCtrls.pas',
+ FMX.frxBarcode2DView in 'FMX.frxBarcode2DView.pas',
+ FMX.frxBarcode2DBase in 'FMX.frxBarcode2DBase.pas',
+ FMX.frxBarcode in 'FMX.frxBarcode.pas',
+ FMX.frxBarcod in 'FMX.frxBarcod.pas',
+ FMX.frxBarcodeEditor in 'FMX.frxBarcodeEditor.pas' {frxBarcodeEditorForm},
+ FMX.frxBarcodeProperties in 'FMX.frxBarcodeProperties.pas',
+ FMX.frxBarcodeDataMatrix in 'FMX.frxBarcodeDataMatrix.pas',
+ FMX.frxBarcodePDF417 in 'FMX.frxBarcodePDF417.pas',
+ FMX.frxBarcodeRTTI in 'FMX.frxBarcodeRTTI.pas',
+ FMX.frxChBox in 'FMX.frxChBox.pas',
+ FMX.frxChBoxRTTI in 'FMX.frxChBoxRTTI.pas',
+{$ENDIF}
+
+ FMX.frxEditAliases in 'FMX.frxEditAliases.pas' {frxAliasesEditorForm};
+
+end.
+
diff --git a/LibD28/FMXfrx19.otares b/LibD28/FMXfrx19.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrx19.otares differ
diff --git a/LibD28/FMXfrx19.res b/LibD28/FMXfrx19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrx19.res differ
diff --git a/LibD28/FMXfrx20.dpk b/LibD28/FMXfrx20.dpk
new file mode 100644
index 0000000..8d04a94
--- /dev/null
+++ b/LibD28/FMXfrx20.dpk
@@ -0,0 +1,129 @@
+// Package file for Rad Studio XE6
+
+package FMXfrx20;
+{$I frx.inc}
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs20;
+
+contains
+ FMX.frxAggregate in 'FMX.frxAggregate.pas',
+ FMX.frxClass in 'FMX.frxClass.pas',
+ FMX.frxClassRTTI in 'FMX.frxClassRTTI.pas',
+ FMX.frxCtrls in 'FMX.frxCtrls.pas',
+ FMX.frxDialogForm in 'FMX.frxDialogForm.pas',
+ FMX.frxDMPClass in 'FMX.frxDMPClass.pas',
+ FMX.frxEngine in 'FMX.frxEngine.pas',
+ FMX.frxFMX in 'FMX.frxFMX.pas',
+ FMX.frxGraphicUtils in 'FMX.frxGraphicUtils.pas',
+ FMX.frxPassw in 'FMX.frxPassw.pas',
+ FMX.frxPictureCache in 'FMX.frxPictureCache.pas',
+ FMX.frxPreview in 'FMX.frxPreview.pas',
+ FMX.frxPreviewPages in 'FMX.frxPreviewPages.pas',
+ FMX.frxPreviewPageSettings in 'FMX.frxPreviewPageSettings.pas',
+ FMX.frxPrintDialog in 'FMX.frxPrintDialog.pas',
+ FMX.frxPrinter in 'FMX.frxPrinter.pas',
+{$IFDEF MSWINDOWS}
+ FMX.Win.frxPrinter in 'FMX.Win.frxPrinter.pas',
+{$ELSE}
+ FMX.Mac.frxPrinter in 'FMX.Mac.frxPrinter.pas',
+{$ENDIF}
+ FMX.frxProgress in 'FMX.frxProgress.pas',
+ FMX.frxrcClass in 'FMX.frxrcClass.pas',
+ FMX.frxRes in 'FMX.frxRes.pas',
+ FMX.frxSearchDialog in 'FMX.frxSearchDialog.pas',
+ FMX.frxUnicodeUtils in 'FMX.frxUnicodeUtils.pas',
+ FMX.frxUtils in 'FMX.frxUtils.pas',
+ FMX.frxVariables in 'FMX.frxVariables.pas',
+ FMX.frxXML in 'FMX.frxXML.pas',
+ FMX.frxXMLSerializer in 'FMX.frxXMLSerializer.pas',
+ FMX.frxAbout in 'FMX.frxAbout.pas',
+ FMX.frxCodeUtils in 'FMX.frxCodeUtils.pas',
+ FMX.frxCustomEditors in 'FMX.frxCustomEditors.pas',
+ FMX.frxDataTree in 'FMX.frxDataTree.pas',
+ FMX.frxDesgn in 'FMX.frxDesgn.pas',
+ FMX.frxDesgnEditors in 'FMX.frxDesgnEditors.pas',
+ FMX.frxDesgnWorkspace in 'FMX.frxDesgnWorkspace.pas',
+ FMX.frxDesgnWorkspace1 in 'FMX.frxDesgnWorkspace1.pas',
+ FMX.frxDsgnIntf in 'FMX.frxDsgnIntf.pas',
+ FMX.frxEditDataBand in 'FMX.frxEditDataBand.pas',
+ FMX.frxEditExpr in 'FMX.frxEditExpr.pas',
+ FMX.frxEditFormat in 'FMX.frxEditFormat.pas',
+ FMX.frxEditFrame in 'FMX.frxEditFrame.pas',
+ FMX.frxEditGroup in 'FMX.frxEditGroup.pas',
+ FMX.frxEditHighlight in 'FMX.frxEditHighlight.pas',
+ FMX.frxEditMemo in 'FMX.frxEditMemo.pas',
+ FMX.frxEditOptions in 'FMX.frxEditOptions.pas',
+ FMX.frxEditPage in 'FMX.frxEditPage.pas',
+ FMX.frxEditPicture in 'FMX.frxEditPicture.pas',
+ FMX.frxEditReport in 'FMX.frxEditReport.pas',
+ FMX.frxEditReportData in 'FMX.frxEditReportData.pas',
+ FMX.frxEditStrings in 'FMX.frxEditStrings.pas',
+ FMX.frxEditStyle in 'FMX.frxEditStyle.pas',
+ FMX.frxEditSysMemo in 'FMX.frxEditSysMemo.pas',
+ FMX.frxEditTabOrder in 'FMX.frxEditTabOrder.pas',
+ FMX.frxEditVar in 'FMX.frxEditVar.pas',
+ FMX.frxEvaluateForm in 'FMX.frxEvaluateForm.pas',
+ FMX.frxInheritError in 'FMX.frxInheritError.pas',
+ FMX.frxInsp in 'FMX.frxInsp.pas',
+ FMX.frxPopupForm in 'FMX.frxPopupForm.pas',
+ FMX.frxrcDesgn in 'FMX.frxrcDesgn.pas',
+ FMX.frxrcInsp in 'FMX.frxrcInsp.pas',
+ FMX.frxReportTree in 'FMX.frxReportTree.pas',
+ FMX.frxWatchForm in 'FMX.frxWatchForm.pas',
+{$IFNDEF RAD_ED}
+ FMX.frxCross in 'FMX.frxCross.pas',
+ FMX.frxCrossEditor in 'FMX.frxCrossEditor.pas',
+ FMX.frxCrossRTTI in 'FMX.frxCrossRTTI.pas',
+ FMX.frxDCtrl in 'FMX.frxDCtrl.pas',
+ FMX.frxDCtrlRTTI in 'FMX.frxDCtrlRTTI.pas',
+ FMX.frxGradient in 'FMX.frxGradient.pas',
+ FMX.frxGradientRTTI in 'FMX.frxGradientRTTI.pas',
+ FMX.frxGZip in 'FMX.frxGZip.pas',
+ FMX.frxDesgnCtrls in 'FMX.frxDesgnCtrls.pas',
+ FMX.frxBarcode2DView in 'FMX.frxBarcode2DView.pas',
+ FMX.frxBarcode2DBase in 'FMX.frxBarcode2DBase.pas',
+ FMX.frxBarcode in 'FMX.frxBarcode.pas',
+ FMX.frxBarcod in 'FMX.frxBarcod.pas',
+ FMX.frxBarcodeEditor in 'FMX.frxBarcodeEditor.pas' {frxBarcodeEditorForm},
+ FMX.frxBarcodeProperties in 'FMX.frxBarcodeProperties.pas',
+ FMX.frxBarcodeDataMatrix in 'FMX.frxBarcodeDataMatrix.pas',
+ FMX.frxBarcodePDF417 in 'FMX.frxBarcodePDF417.pas',
+ FMX.frxBarcodeRTTI in 'FMX.frxBarcodeRTTI.pas',
+ FMX.frxChBox in 'FMX.frxChBox.pas',
+ FMX.frxChBoxRTTI in 'FMX.frxChBoxRTTI.pas',
+{$ENDIF}
+
+ FMX.frxEditAliases in 'FMX.frxEditAliases.pas' {frxAliasesEditorForm};
+
+end.
+
diff --git a/LibD28/FMXfrx20.otares b/LibD28/FMXfrx20.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrx20.otares differ
diff --git a/LibD28/FMXfrx20.res b/LibD28/FMXfrx20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrx20.res differ
diff --git a/LibD28/FMXfrx21.dpk b/LibD28/FMXfrx21.dpk
new file mode 100644
index 0000000..56527bf
--- /dev/null
+++ b/LibD28/FMXfrx21.dpk
@@ -0,0 +1,129 @@
+// Package file for Rad Studio XE7
+
+package FMXfrx21;
+{$I frx.inc}
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs21;
+
+contains
+ FMX.frxAggregate in 'FMX.frxAggregate.pas',
+ FMX.frxClass in 'FMX.frxClass.pas',
+ FMX.frxClassRTTI in 'FMX.frxClassRTTI.pas',
+ FMX.frxCtrls in 'FMX.frxCtrls.pas',
+ FMX.frxDialogForm in 'FMX.frxDialogForm.pas',
+ FMX.frxDMPClass in 'FMX.frxDMPClass.pas',
+ FMX.frxEngine in 'FMX.frxEngine.pas',
+ FMX.frxFMX in 'FMX.frxFMX.pas',
+ FMX.frxGraphicUtils in 'FMX.frxGraphicUtils.pas',
+ FMX.frxPassw in 'FMX.frxPassw.pas',
+ FMX.frxPictureCache in 'FMX.frxPictureCache.pas',
+ FMX.frxPreview in 'FMX.frxPreview.pas',
+ FMX.frxPreviewPages in 'FMX.frxPreviewPages.pas',
+ FMX.frxPreviewPageSettings in 'FMX.frxPreviewPageSettings.pas',
+ FMX.frxPrintDialog in 'FMX.frxPrintDialog.pas',
+ FMX.frxPrinter in 'FMX.frxPrinter.pas',
+{$IFDEF MSWINDOWS}
+ FMX.Win.frxPrinter in 'FMX.Win.frxPrinter.pas',
+{$ELSE}
+ FMX.Mac.frxPrinter in 'FMX.Mac.frxPrinter.pas',
+{$ENDIF}
+ FMX.frxProgress in 'FMX.frxProgress.pas',
+ FMX.frxrcClass in 'FMX.frxrcClass.pas',
+ FMX.frxRes in 'FMX.frxRes.pas',
+ FMX.frxSearchDialog in 'FMX.frxSearchDialog.pas',
+ FMX.frxUnicodeUtils in 'FMX.frxUnicodeUtils.pas',
+ FMX.frxUtils in 'FMX.frxUtils.pas',
+ FMX.frxVariables in 'FMX.frxVariables.pas',
+ FMX.frxXML in 'FMX.frxXML.pas',
+ FMX.frxXMLSerializer in 'FMX.frxXMLSerializer.pas',
+ FMX.frxAbout in 'FMX.frxAbout.pas',
+ FMX.frxCodeUtils in 'FMX.frxCodeUtils.pas',
+ FMX.frxCustomEditors in 'FMX.frxCustomEditors.pas',
+ FMX.frxDataTree in 'FMX.frxDataTree.pas',
+ FMX.frxDesgn in 'FMX.frxDesgn.pas',
+ FMX.frxDesgnEditors in 'FMX.frxDesgnEditors.pas',
+ FMX.frxDesgnWorkspace in 'FMX.frxDesgnWorkspace.pas',
+ FMX.frxDesgnWorkspace1 in 'FMX.frxDesgnWorkspace1.pas',
+ FMX.frxDsgnIntf in 'FMX.frxDsgnIntf.pas',
+ FMX.frxEditDataBand in 'FMX.frxEditDataBand.pas',
+ FMX.frxEditExpr in 'FMX.frxEditExpr.pas',
+ FMX.frxEditFormat in 'FMX.frxEditFormat.pas',
+ FMX.frxEditFrame in 'FMX.frxEditFrame.pas',
+ FMX.frxEditGroup in 'FMX.frxEditGroup.pas',
+ FMX.frxEditHighlight in 'FMX.frxEditHighlight.pas',
+ FMX.frxEditMemo in 'FMX.frxEditMemo.pas',
+ FMX.frxEditOptions in 'FMX.frxEditOptions.pas',
+ FMX.frxEditPage in 'FMX.frxEditPage.pas',
+ FMX.frxEditPicture in 'FMX.frxEditPicture.pas',
+ FMX.frxEditReport in 'FMX.frxEditReport.pas',
+ FMX.frxEditReportData in 'FMX.frxEditReportData.pas',
+ FMX.frxEditStrings in 'FMX.frxEditStrings.pas',
+ FMX.frxEditStyle in 'FMX.frxEditStyle.pas',
+ FMX.frxEditSysMemo in 'FMX.frxEditSysMemo.pas',
+ FMX.frxEditTabOrder in 'FMX.frxEditTabOrder.pas',
+ FMX.frxEditVar in 'FMX.frxEditVar.pas',
+ FMX.frxEvaluateForm in 'FMX.frxEvaluateForm.pas',
+ FMX.frxInheritError in 'FMX.frxInheritError.pas',
+ FMX.frxInsp in 'FMX.frxInsp.pas',
+ FMX.frxPopupForm in 'FMX.frxPopupForm.pas',
+ FMX.frxrcDesgn in 'FMX.frxrcDesgn.pas',
+ FMX.frxrcInsp in 'FMX.frxrcInsp.pas',
+ FMX.frxReportTree in 'FMX.frxReportTree.pas',
+ FMX.frxWatchForm in 'FMX.frxWatchForm.pas',
+{$IFNDEF RAD_ED}
+ FMX.frxCross in 'FMX.frxCross.pas',
+ FMX.frxCrossEditor in 'FMX.frxCrossEditor.pas',
+ FMX.frxCrossRTTI in 'FMX.frxCrossRTTI.pas',
+ FMX.frxDCtrl in 'FMX.frxDCtrl.pas',
+ FMX.frxDCtrlRTTI in 'FMX.frxDCtrlRTTI.pas',
+ FMX.frxGradient in 'FMX.frxGradient.pas',
+ FMX.frxGradientRTTI in 'FMX.frxGradientRTTI.pas',
+ FMX.frxGZip in 'FMX.frxGZip.pas',
+ FMX.frxDesgnCtrls in 'FMX.frxDesgnCtrls.pas',
+ FMX.frxBarcode2DView in 'FMX.frxBarcode2DView.pas',
+ FMX.frxBarcode2DBase in 'FMX.frxBarcode2DBase.pas',
+ FMX.frxBarcode in 'FMX.frxBarcode.pas',
+ FMX.frxBarcod in 'FMX.frxBarcod.pas',
+ FMX.frxBarcodeEditor in 'FMX.frxBarcodeEditor.pas' {frxBarcodeEditorForm},
+ FMX.frxBarcodeProperties in 'FMX.frxBarcodeProperties.pas',
+ FMX.frxBarcodeDataMatrix in 'FMX.frxBarcodeDataMatrix.pas',
+ FMX.frxBarcodePDF417 in 'FMX.frxBarcodePDF417.pas',
+ FMX.frxBarcodeRTTI in 'FMX.frxBarcodeRTTI.pas',
+ FMX.frxChBox in 'FMX.frxChBox.pas',
+ FMX.frxChBoxRTTI in 'FMX.frxChBoxRTTI.pas',
+{$ENDIF}
+
+ FMX.frxEditAliases in 'FMX.frxEditAliases.pas' {frxAliasesEditorForm};
+
+end.
+
diff --git a/LibD28/FMXfrx21.otares b/LibD28/FMXfrx21.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrx21.otares differ
diff --git a/LibD28/FMXfrx21.res b/LibD28/FMXfrx21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrx21.res differ
diff --git a/LibD28/FMXfrx22.dpk b/LibD28/FMXfrx22.dpk
new file mode 100644
index 0000000..de69abc
--- /dev/null
+++ b/LibD28/FMXfrx22.dpk
@@ -0,0 +1,129 @@
+// Package file for Rad Studio XE8
+
+package FMXfrx22;
+{$I frx.inc}
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs22;
+
+contains
+ FMX.frxAggregate in 'FMX.frxAggregate.pas',
+ FMX.frxClass in 'FMX.frxClass.pas',
+ FMX.frxClassRTTI in 'FMX.frxClassRTTI.pas',
+ FMX.frxCtrls in 'FMX.frxCtrls.pas',
+ FMX.frxDialogForm in 'FMX.frxDialogForm.pas',
+ FMX.frxDMPClass in 'FMX.frxDMPClass.pas',
+ FMX.frxEngine in 'FMX.frxEngine.pas',
+ FMX.frxFMX in 'FMX.frxFMX.pas',
+ FMX.frxGraphicUtils in 'FMX.frxGraphicUtils.pas',
+ FMX.frxPassw in 'FMX.frxPassw.pas',
+ FMX.frxPictureCache in 'FMX.frxPictureCache.pas',
+ FMX.frxPreview in 'FMX.frxPreview.pas',
+ FMX.frxPreviewPages in 'FMX.frxPreviewPages.pas',
+ FMX.frxPreviewPageSettings in 'FMX.frxPreviewPageSettings.pas',
+ FMX.frxPrintDialog in 'FMX.frxPrintDialog.pas',
+ FMX.frxPrinter in 'FMX.frxPrinter.pas',
+{$IFDEF MSWINDOWS}
+ FMX.Win.frxPrinter in 'FMX.Win.frxPrinter.pas',
+{$ELSE}
+ FMX.Mac.frxPrinter in 'FMX.Mac.frxPrinter.pas',
+{$ENDIF}
+ FMX.frxProgress in 'FMX.frxProgress.pas',
+ FMX.frxrcClass in 'FMX.frxrcClass.pas',
+ FMX.frxRes in 'FMX.frxRes.pas',
+ FMX.frxSearchDialog in 'FMX.frxSearchDialog.pas',
+ FMX.frxUnicodeUtils in 'FMX.frxUnicodeUtils.pas',
+ FMX.frxUtils in 'FMX.frxUtils.pas',
+ FMX.frxVariables in 'FMX.frxVariables.pas',
+ FMX.frxXML in 'FMX.frxXML.pas',
+ FMX.frxXMLSerializer in 'FMX.frxXMLSerializer.pas',
+ FMX.frxAbout in 'FMX.frxAbout.pas',
+ FMX.frxCodeUtils in 'FMX.frxCodeUtils.pas',
+ FMX.frxCustomEditors in 'FMX.frxCustomEditors.pas',
+ FMX.frxDataTree in 'FMX.frxDataTree.pas',
+ FMX.frxDesgn in 'FMX.frxDesgn.pas',
+ FMX.frxDesgnEditors in 'FMX.frxDesgnEditors.pas',
+ FMX.frxDesgnWorkspace in 'FMX.frxDesgnWorkspace.pas',
+ FMX.frxDesgnWorkspace1 in 'FMX.frxDesgnWorkspace1.pas',
+ FMX.frxDsgnIntf in 'FMX.frxDsgnIntf.pas',
+ FMX.frxEditDataBand in 'FMX.frxEditDataBand.pas',
+ FMX.frxEditExpr in 'FMX.frxEditExpr.pas',
+ FMX.frxEditFormat in 'FMX.frxEditFormat.pas',
+ FMX.frxEditFrame in 'FMX.frxEditFrame.pas',
+ FMX.frxEditGroup in 'FMX.frxEditGroup.pas',
+ FMX.frxEditHighlight in 'FMX.frxEditHighlight.pas',
+ FMX.frxEditMemo in 'FMX.frxEditMemo.pas',
+ FMX.frxEditOptions in 'FMX.frxEditOptions.pas',
+ FMX.frxEditPage in 'FMX.frxEditPage.pas',
+ FMX.frxEditPicture in 'FMX.frxEditPicture.pas',
+ FMX.frxEditReport in 'FMX.frxEditReport.pas',
+ FMX.frxEditReportData in 'FMX.frxEditReportData.pas',
+ FMX.frxEditStrings in 'FMX.frxEditStrings.pas',
+ FMX.frxEditStyle in 'FMX.frxEditStyle.pas',
+ FMX.frxEditSysMemo in 'FMX.frxEditSysMemo.pas',
+ FMX.frxEditTabOrder in 'FMX.frxEditTabOrder.pas',
+ FMX.frxEditVar in 'FMX.frxEditVar.pas',
+ FMX.frxEvaluateForm in 'FMX.frxEvaluateForm.pas',
+ FMX.frxInheritError in 'FMX.frxInheritError.pas',
+ FMX.frxInsp in 'FMX.frxInsp.pas',
+ FMX.frxPopupForm in 'FMX.frxPopupForm.pas',
+ FMX.frxrcDesgn in 'FMX.frxrcDesgn.pas',
+ FMX.frxrcInsp in 'FMX.frxrcInsp.pas',
+ FMX.frxReportTree in 'FMX.frxReportTree.pas',
+ FMX.frxWatchForm in 'FMX.frxWatchForm.pas',
+{$IFNDEF RAD_ED}
+ FMX.frxCross in 'FMX.frxCross.pas',
+ FMX.frxCrossEditor in 'FMX.frxCrossEditor.pas',
+ FMX.frxCrossRTTI in 'FMX.frxCrossRTTI.pas',
+ FMX.frxDCtrl in 'FMX.frxDCtrl.pas',
+ FMX.frxDCtrlRTTI in 'FMX.frxDCtrlRTTI.pas',
+ FMX.frxGradient in 'FMX.frxGradient.pas',
+ FMX.frxGradientRTTI in 'FMX.frxGradientRTTI.pas',
+ FMX.frxGZip in 'FMX.frxGZip.pas',
+ FMX.frxDesgnCtrls in 'FMX.frxDesgnCtrls.pas',
+ FMX.frxBarcode2DView in 'FMX.frxBarcode2DView.pas',
+ FMX.frxBarcode2DBase in 'FMX.frxBarcode2DBase.pas',
+ FMX.frxBarcode in 'FMX.frxBarcode.pas',
+ FMX.frxBarcod in 'FMX.frxBarcod.pas',
+ FMX.frxBarcodeEditor in 'FMX.frxBarcodeEditor.pas' {frxBarcodeEditorForm},
+ FMX.frxBarcodeProperties in 'FMX.frxBarcodeProperties.pas',
+ FMX.frxBarcodeDataMatrix in 'FMX.frxBarcodeDataMatrix.pas',
+ FMX.frxBarcodePDF417 in 'FMX.frxBarcodePDF417.pas',
+ FMX.frxBarcodeRTTI in 'FMX.frxBarcodeRTTI.pas',
+ FMX.frxChBox in 'FMX.frxChBox.pas',
+ FMX.frxChBoxRTTI in 'FMX.frxChBoxRTTI.pas',
+{$ENDIF}
+
+ FMX.frxEditAliases in 'FMX.frxEditAliases.pas' {frxAliasesEditorForm};
+
+end.
+
diff --git a/LibD28/FMXfrx22.otares b/LibD28/FMXfrx22.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrx22.otares differ
diff --git a/LibD28/FMXfrx22.res b/LibD28/FMXfrx22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrx22.res differ
diff --git a/LibD28/FMXfrx23.dpk b/LibD28/FMXfrx23.dpk
new file mode 100644
index 0000000..81334af
--- /dev/null
+++ b/LibD28/FMXfrx23.dpk
@@ -0,0 +1,129 @@
+// Package file for Rad Studio 10 Seattle
+
+package FMXfrx23;
+{$I frx.inc}
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs23;
+
+contains
+ FMX.frxAggregate in 'FMX.frxAggregate.pas',
+ FMX.frxClass in 'FMX.frxClass.pas',
+ FMX.frxClassRTTI in 'FMX.frxClassRTTI.pas',
+ FMX.frxCtrls in 'FMX.frxCtrls.pas',
+ FMX.frxDialogForm in 'FMX.frxDialogForm.pas',
+ FMX.frxDMPClass in 'FMX.frxDMPClass.pas',
+ FMX.frxEngine in 'FMX.frxEngine.pas',
+ FMX.frxFMX in 'FMX.frxFMX.pas',
+ FMX.frxGraphicUtils in 'FMX.frxGraphicUtils.pas',
+ FMX.frxPassw in 'FMX.frxPassw.pas',
+ FMX.frxPictureCache in 'FMX.frxPictureCache.pas',
+ FMX.frxPreview in 'FMX.frxPreview.pas',
+ FMX.frxPreviewPages in 'FMX.frxPreviewPages.pas',
+ FMX.frxPreviewPageSettings in 'FMX.frxPreviewPageSettings.pas',
+ FMX.frxPrintDialog in 'FMX.frxPrintDialog.pas',
+ FMX.frxPrinter in 'FMX.frxPrinter.pas',
+{$IFDEF MSWINDOWS}
+ FMX.Win.frxPrinter in 'FMX.Win.frxPrinter.pas',
+{$ELSE}
+ FMX.Mac.frxPrinter in 'FMX.Mac.frxPrinter.pas',
+{$ENDIF}
+ FMX.frxProgress in 'FMX.frxProgress.pas',
+ FMX.frxrcClass in 'FMX.frxrcClass.pas',
+ FMX.frxRes in 'FMX.frxRes.pas',
+ FMX.frxSearchDialog in 'FMX.frxSearchDialog.pas',
+ FMX.frxUnicodeUtils in 'FMX.frxUnicodeUtils.pas',
+ FMX.frxUtils in 'FMX.frxUtils.pas',
+ FMX.frxVariables in 'FMX.frxVariables.pas',
+ FMX.frxXML in 'FMX.frxXML.pas',
+ FMX.frxXMLSerializer in 'FMX.frxXMLSerializer.pas',
+ FMX.frxAbout in 'FMX.frxAbout.pas',
+ FMX.frxCodeUtils in 'FMX.frxCodeUtils.pas',
+ FMX.frxCustomEditors in 'FMX.frxCustomEditors.pas',
+ FMX.frxDataTree in 'FMX.frxDataTree.pas',
+ FMX.frxDesgn in 'FMX.frxDesgn.pas',
+ FMX.frxDesgnEditors in 'FMX.frxDesgnEditors.pas',
+ FMX.frxDesgnWorkspace in 'FMX.frxDesgnWorkspace.pas',
+ FMX.frxDesgnWorkspace1 in 'FMX.frxDesgnWorkspace1.pas',
+ FMX.frxDsgnIntf in 'FMX.frxDsgnIntf.pas',
+ FMX.frxEditDataBand in 'FMX.frxEditDataBand.pas',
+ FMX.frxEditExpr in 'FMX.frxEditExpr.pas',
+ FMX.frxEditFormat in 'FMX.frxEditFormat.pas',
+ FMX.frxEditFrame in 'FMX.frxEditFrame.pas',
+ FMX.frxEditGroup in 'FMX.frxEditGroup.pas',
+ FMX.frxEditHighlight in 'FMX.frxEditHighlight.pas',
+ FMX.frxEditMemo in 'FMX.frxEditMemo.pas',
+ FMX.frxEditOptions in 'FMX.frxEditOptions.pas',
+ FMX.frxEditPage in 'FMX.frxEditPage.pas',
+ FMX.frxEditPicture in 'FMX.frxEditPicture.pas',
+ FMX.frxEditReport in 'FMX.frxEditReport.pas',
+ FMX.frxEditReportData in 'FMX.frxEditReportData.pas',
+ FMX.frxEditStrings in 'FMX.frxEditStrings.pas',
+ FMX.frxEditStyle in 'FMX.frxEditStyle.pas',
+ FMX.frxEditSysMemo in 'FMX.frxEditSysMemo.pas',
+ FMX.frxEditTabOrder in 'FMX.frxEditTabOrder.pas',
+ FMX.frxEditVar in 'FMX.frxEditVar.pas',
+ FMX.frxEvaluateForm in 'FMX.frxEvaluateForm.pas',
+ FMX.frxInheritError in 'FMX.frxInheritError.pas',
+ FMX.frxInsp in 'FMX.frxInsp.pas',
+ FMX.frxPopupForm in 'FMX.frxPopupForm.pas',
+ FMX.frxrcDesgn in 'FMX.frxrcDesgn.pas',
+ FMX.frxrcInsp in 'FMX.frxrcInsp.pas',
+ FMX.frxReportTree in 'FMX.frxReportTree.pas',
+ FMX.frxWatchForm in 'FMX.frxWatchForm.pas',
+{$IFNDEF RAD_ED}
+ FMX.frxCross in 'FMX.frxCross.pas',
+ FMX.frxCrossEditor in 'FMX.frxCrossEditor.pas',
+ FMX.frxCrossRTTI in 'FMX.frxCrossRTTI.pas',
+ FMX.frxDCtrl in 'FMX.frxDCtrl.pas',
+ FMX.frxDCtrlRTTI in 'FMX.frxDCtrlRTTI.pas',
+ FMX.frxGradient in 'FMX.frxGradient.pas',
+ FMX.frxGradientRTTI in 'FMX.frxGradientRTTI.pas',
+ FMX.frxGZip in 'FMX.frxGZip.pas',
+ FMX.frxDesgnCtrls in 'FMX.frxDesgnCtrls.pas',
+ FMX.frxBarcode2DView in 'FMX.frxBarcode2DView.pas',
+ FMX.frxBarcode2DBase in 'FMX.frxBarcode2DBase.pas',
+ FMX.frxBarcode in 'FMX.frxBarcode.pas',
+ FMX.frxBarcod in 'FMX.frxBarcod.pas',
+ FMX.frxBarcodeEditor in 'FMX.frxBarcodeEditor.pas' {frxBarcodeEditorForm},
+ FMX.frxBarcodeProperties in 'FMX.frxBarcodeProperties.pas',
+ FMX.frxBarcodeDataMatrix in 'FMX.frxBarcodeDataMatrix.pas',
+ FMX.frxBarcodePDF417 in 'FMX.frxBarcodePDF417.pas',
+ FMX.frxBarcodeRTTI in 'FMX.frxBarcodeRTTI.pas',
+ FMX.frxChBox in 'FMX.frxChBox.pas',
+ FMX.frxChBoxRTTI in 'FMX.frxChBoxRTTI.pas',
+{$ENDIF}
+
+ FMX.frxEditAliases in 'FMX.frxEditAliases.pas' {frxAliasesEditorForm};
+
+end.
+
diff --git a/LibD28/FMXfrx23.otares b/LibD28/FMXfrx23.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrx23.otares differ
diff --git a/LibD28/FMXfrx23.res b/LibD28/FMXfrx23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrx23.res differ
diff --git a/LibD28/FMXfrx24.dpk b/LibD28/FMXfrx24.dpk
new file mode 100644
index 0000000..755e429
--- /dev/null
+++ b/LibD28/FMXfrx24.dpk
@@ -0,0 +1,129 @@
+// Package file for Rad Studio 10 Seattle
+
+package FMXfrx24;
+{$I frx.inc}
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs24;
+
+contains
+ FMX.frxAggregate in 'FMX.frxAggregate.pas',
+ FMX.frxClass in 'FMX.frxClass.pas',
+ FMX.frxClassRTTI in 'FMX.frxClassRTTI.pas',
+ FMX.frxCtrls in 'FMX.frxCtrls.pas',
+ FMX.frxDialogForm in 'FMX.frxDialogForm.pas',
+ FMX.frxDMPClass in 'FMX.frxDMPClass.pas',
+ FMX.frxEngine in 'FMX.frxEngine.pas',
+ FMX.frxFMX in 'FMX.frxFMX.pas',
+ FMX.frxGraphicUtils in 'FMX.frxGraphicUtils.pas',
+ FMX.frxPassw in 'FMX.frxPassw.pas',
+ FMX.frxPictureCache in 'FMX.frxPictureCache.pas',
+ FMX.frxPreview in 'FMX.frxPreview.pas',
+ FMX.frxPreviewPages in 'FMX.frxPreviewPages.pas',
+ FMX.frxPreviewPageSettings in 'FMX.frxPreviewPageSettings.pas',
+ FMX.frxPrintDialog in 'FMX.frxPrintDialog.pas',
+ FMX.frxPrinter in 'FMX.frxPrinter.pas',
+{$IFDEF MSWINDOWS}
+ FMX.Win.frxPrinter in 'FMX.Win.frxPrinter.pas',
+{$ELSE}
+ FMX.Mac.frxPrinter in 'FMX.Mac.frxPrinter.pas',
+{$ENDIF}
+ FMX.frxProgress in 'FMX.frxProgress.pas',
+ FMX.frxrcClass in 'FMX.frxrcClass.pas',
+ FMX.frxRes in 'FMX.frxRes.pas',
+ FMX.frxSearchDialog in 'FMX.frxSearchDialog.pas',
+ FMX.frxUnicodeUtils in 'FMX.frxUnicodeUtils.pas',
+ FMX.frxUtils in 'FMX.frxUtils.pas',
+ FMX.frxVariables in 'FMX.frxVariables.pas',
+ FMX.frxXML in 'FMX.frxXML.pas',
+ FMX.frxXMLSerializer in 'FMX.frxXMLSerializer.pas',
+ FMX.frxAbout in 'FMX.frxAbout.pas',
+ FMX.frxCodeUtils in 'FMX.frxCodeUtils.pas',
+ FMX.frxCustomEditors in 'FMX.frxCustomEditors.pas',
+ FMX.frxDataTree in 'FMX.frxDataTree.pas',
+ FMX.frxDesgn in 'FMX.frxDesgn.pas',
+ FMX.frxDesgnEditors in 'FMX.frxDesgnEditors.pas',
+ FMX.frxDesgnWorkspace in 'FMX.frxDesgnWorkspace.pas',
+ FMX.frxDesgnWorkspace1 in 'FMX.frxDesgnWorkspace1.pas',
+ FMX.frxDsgnIntf in 'FMX.frxDsgnIntf.pas',
+ FMX.frxEditDataBand in 'FMX.frxEditDataBand.pas',
+ FMX.frxEditExpr in 'FMX.frxEditExpr.pas',
+ FMX.frxEditFormat in 'FMX.frxEditFormat.pas',
+ FMX.frxEditFrame in 'FMX.frxEditFrame.pas',
+ FMX.frxEditGroup in 'FMX.frxEditGroup.pas',
+ FMX.frxEditHighlight in 'FMX.frxEditHighlight.pas',
+ FMX.frxEditMemo in 'FMX.frxEditMemo.pas',
+ FMX.frxEditOptions in 'FMX.frxEditOptions.pas',
+ FMX.frxEditPage in 'FMX.frxEditPage.pas',
+ FMX.frxEditPicture in 'FMX.frxEditPicture.pas',
+ FMX.frxEditReport in 'FMX.frxEditReport.pas',
+ FMX.frxEditReportData in 'FMX.frxEditReportData.pas',
+ FMX.frxEditStrings in 'FMX.frxEditStrings.pas',
+ FMX.frxEditStyle in 'FMX.frxEditStyle.pas',
+ FMX.frxEditSysMemo in 'FMX.frxEditSysMemo.pas',
+ FMX.frxEditTabOrder in 'FMX.frxEditTabOrder.pas',
+ FMX.frxEditVar in 'FMX.frxEditVar.pas',
+ FMX.frxEvaluateForm in 'FMX.frxEvaluateForm.pas',
+ FMX.frxInheritError in 'FMX.frxInheritError.pas',
+ FMX.frxInsp in 'FMX.frxInsp.pas',
+ FMX.frxPopupForm in 'FMX.frxPopupForm.pas',
+ FMX.frxrcDesgn in 'FMX.frxrcDesgn.pas',
+ FMX.frxrcInsp in 'FMX.frxrcInsp.pas',
+ FMX.frxReportTree in 'FMX.frxReportTree.pas',
+ FMX.frxWatchForm in 'FMX.frxWatchForm.pas',
+{$IFNDEF RAD_ED}
+ FMX.frxCross in 'FMX.frxCross.pas',
+ FMX.frxCrossEditor in 'FMX.frxCrossEditor.pas',
+ FMX.frxCrossRTTI in 'FMX.frxCrossRTTI.pas',
+ FMX.frxDCtrl in 'FMX.frxDCtrl.pas',
+ FMX.frxDCtrlRTTI in 'FMX.frxDCtrlRTTI.pas',
+ FMX.frxGradient in 'FMX.frxGradient.pas',
+ FMX.frxGradientRTTI in 'FMX.frxGradientRTTI.pas',
+ FMX.frxGZip in 'FMX.frxGZip.pas',
+ FMX.frxDesgnCtrls in 'FMX.frxDesgnCtrls.pas',
+ FMX.frxBarcode2DView in 'FMX.frxBarcode2DView.pas',
+ FMX.frxBarcode2DBase in 'FMX.frxBarcode2DBase.pas',
+ FMX.frxBarcode in 'FMX.frxBarcode.pas',
+ FMX.frxBarcod in 'FMX.frxBarcod.pas',
+ FMX.frxBarcodeEditor in 'FMX.frxBarcodeEditor.pas' {frxBarcodeEditorForm},
+ FMX.frxBarcodeProperties in 'FMX.frxBarcodeProperties.pas',
+ FMX.frxBarcodeDataMatrix in 'FMX.frxBarcodeDataMatrix.pas',
+ FMX.frxBarcodePDF417 in 'FMX.frxBarcodePDF417.pas',
+ FMX.frxBarcodeRTTI in 'FMX.frxBarcodeRTTI.pas',
+ FMX.frxChBox in 'FMX.frxChBox.pas',
+ FMX.frxChBoxRTTI in 'FMX.frxChBoxRTTI.pas',
+{$ENDIF}
+
+ FMX.frxEditAliases in 'FMX.frxEditAliases.pas' {frxAliasesEditorForm};
+
+end.
+
diff --git a/LibD28/FMXfrx24.dproj b/LibD28/FMXfrx24.dproj
new file mode 100644
index 0000000..d614edd
--- /dev/null
+++ b/LibD28/FMXfrx24.dproj
@@ -0,0 +1,199 @@
+
+
+ {400EDC6D-BB28-4B5D-9881-96DC835A91C1}
+ FMXfrx24.dpk
+ True
+ Debug
+ 1025
+ Package
+ None
+ 18.1
+ Win32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ 1049
+ 00400000
+ true
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+ true
+ false
+ FMXfrx24
+ true
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ true
+ false
+
+
+ 1033
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=
+ true
+
+
+ package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey=
+ Debug
+
+
+ false
+ 0
+ RELEASE;$(DCC_Define)
+ 0
+
+
+ true
+ false
+ DEBUG;$(DCC_Define)
+
+
+
+ MainSource
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Cfg_2
+ Base
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ FMXfrx24.dpk
+
+
+
+ False
+ False
+ True
+ False
+ False
+ True
+ False
+
+
+ 12
+
+
+
+
diff --git a/LibD28/FMXfrx24.otares b/LibD28/FMXfrx24.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrx24.otares differ
diff --git a/LibD28/FMXfrx24.res b/LibD28/FMXfrx24.res
new file mode 100644
index 0000000..3bb7875
Binary files /dev/null and b/LibD28/FMXfrx24.res differ
diff --git a/LibD28/FMXfrx25.dpk b/LibD28/FMXfrx25.dpk
new file mode 100644
index 0000000..a61bce3
--- /dev/null
+++ b/LibD28/FMXfrx25.dpk
@@ -0,0 +1,129 @@
+// Package file for Rad Studio 10 Seattle
+
+package FMXfrx25;
+{$I frx.inc}
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs25;
+
+contains
+ FMX.frxAggregate in 'FMX.frxAggregate.pas',
+ FMX.frxClass in 'FMX.frxClass.pas',
+ FMX.frxClassRTTI in 'FMX.frxClassRTTI.pas',
+ FMX.frxCtrls in 'FMX.frxCtrls.pas',
+ FMX.frxDialogForm in 'FMX.frxDialogForm.pas',
+ FMX.frxDMPClass in 'FMX.frxDMPClass.pas',
+ FMX.frxEngine in 'FMX.frxEngine.pas',
+ FMX.frxFMX in 'FMX.frxFMX.pas',
+ FMX.frxGraphicUtils in 'FMX.frxGraphicUtils.pas',
+ FMX.frxPassw in 'FMX.frxPassw.pas',
+ FMX.frxPictureCache in 'FMX.frxPictureCache.pas',
+ FMX.frxPreview in 'FMX.frxPreview.pas',
+ FMX.frxPreviewPages in 'FMX.frxPreviewPages.pas',
+ FMX.frxPreviewPageSettings in 'FMX.frxPreviewPageSettings.pas',
+ FMX.frxPrintDialog in 'FMX.frxPrintDialog.pas',
+ FMX.frxPrinter in 'FMX.frxPrinter.pas',
+{$IFDEF MSWINDOWS}
+ FMX.Win.frxPrinter in 'FMX.Win.frxPrinter.pas',
+{$ELSE}
+ FMX.Mac.frxPrinter in 'FMX.Mac.frxPrinter.pas',
+{$ENDIF}
+ FMX.frxProgress in 'FMX.frxProgress.pas',
+ FMX.frxrcClass in 'FMX.frxrcClass.pas',
+ FMX.frxRes in 'FMX.frxRes.pas',
+ FMX.frxSearchDialog in 'FMX.frxSearchDialog.pas',
+ FMX.frxUnicodeUtils in 'FMX.frxUnicodeUtils.pas',
+ FMX.frxUtils in 'FMX.frxUtils.pas',
+ FMX.frxVariables in 'FMX.frxVariables.pas',
+ FMX.frxXML in 'FMX.frxXML.pas',
+ FMX.frxXMLSerializer in 'FMX.frxXMLSerializer.pas',
+ FMX.frxAbout in 'FMX.frxAbout.pas',
+ FMX.frxCodeUtils in 'FMX.frxCodeUtils.pas',
+ FMX.frxCustomEditors in 'FMX.frxCustomEditors.pas',
+ FMX.frxDataTree in 'FMX.frxDataTree.pas',
+ FMX.frxDesgn in 'FMX.frxDesgn.pas',
+ FMX.frxDesgnEditors in 'FMX.frxDesgnEditors.pas',
+ FMX.frxDesgnWorkspace in 'FMX.frxDesgnWorkspace.pas',
+ FMX.frxDesgnWorkspace1 in 'FMX.frxDesgnWorkspace1.pas',
+ FMX.frxDsgnIntf in 'FMX.frxDsgnIntf.pas',
+ FMX.frxEditDataBand in 'FMX.frxEditDataBand.pas',
+ FMX.frxEditExpr in 'FMX.frxEditExpr.pas',
+ FMX.frxEditFormat in 'FMX.frxEditFormat.pas',
+ FMX.frxEditFrame in 'FMX.frxEditFrame.pas',
+ FMX.frxEditGroup in 'FMX.frxEditGroup.pas',
+ FMX.frxEditHighlight in 'FMX.frxEditHighlight.pas',
+ FMX.frxEditMemo in 'FMX.frxEditMemo.pas',
+ FMX.frxEditOptions in 'FMX.frxEditOptions.pas',
+ FMX.frxEditPage in 'FMX.frxEditPage.pas',
+ FMX.frxEditPicture in 'FMX.frxEditPicture.pas',
+ FMX.frxEditReport in 'FMX.frxEditReport.pas',
+ FMX.frxEditReportData in 'FMX.frxEditReportData.pas',
+ FMX.frxEditStrings in 'FMX.frxEditStrings.pas',
+ FMX.frxEditStyle in 'FMX.frxEditStyle.pas',
+ FMX.frxEditSysMemo in 'FMX.frxEditSysMemo.pas',
+ FMX.frxEditTabOrder in 'FMX.frxEditTabOrder.pas',
+ FMX.frxEditVar in 'FMX.frxEditVar.pas',
+ FMX.frxEvaluateForm in 'FMX.frxEvaluateForm.pas',
+ FMX.frxInheritError in 'FMX.frxInheritError.pas',
+ FMX.frxInsp in 'FMX.frxInsp.pas',
+ FMX.frxPopupForm in 'FMX.frxPopupForm.pas',
+ FMX.frxrcDesgn in 'FMX.frxrcDesgn.pas',
+ FMX.frxrcInsp in 'FMX.frxrcInsp.pas',
+ FMX.frxReportTree in 'FMX.frxReportTree.pas',
+ FMX.frxWatchForm in 'FMX.frxWatchForm.pas',
+{$IFNDEF RAD_ED}
+ FMX.frxCross in 'FMX.frxCross.pas',
+ FMX.frxCrossEditor in 'FMX.frxCrossEditor.pas',
+ FMX.frxCrossRTTI in 'FMX.frxCrossRTTI.pas',
+ FMX.frxDCtrl in 'FMX.frxDCtrl.pas',
+ FMX.frxDCtrlRTTI in 'FMX.frxDCtrlRTTI.pas',
+ FMX.frxGradient in 'FMX.frxGradient.pas',
+ FMX.frxGradientRTTI in 'FMX.frxGradientRTTI.pas',
+ FMX.frxGZip in 'FMX.frxGZip.pas',
+ FMX.frxDesgnCtrls in 'FMX.frxDesgnCtrls.pas',
+ FMX.frxBarcode2DView in 'FMX.frxBarcode2DView.pas',
+ FMX.frxBarcode2DBase in 'FMX.frxBarcode2DBase.pas',
+ FMX.frxBarcode in 'FMX.frxBarcode.pas',
+ FMX.frxBarcod in 'FMX.frxBarcod.pas',
+ FMX.frxBarcodeEditor in 'FMX.frxBarcodeEditor.pas' {frxBarcodeEditorForm},
+ FMX.frxBarcodeProperties in 'FMX.frxBarcodeProperties.pas',
+ FMX.frxBarcodeDataMatrix in 'FMX.frxBarcodeDataMatrix.pas',
+ FMX.frxBarcodePDF417 in 'FMX.frxBarcodePDF417.pas',
+ FMX.frxBarcodeRTTI in 'FMX.frxBarcodeRTTI.pas',
+ FMX.frxChBox in 'FMX.frxChBox.pas',
+ FMX.frxChBoxRTTI in 'FMX.frxChBoxRTTI.pas',
+{$ENDIF}
+
+ FMX.frxEditAliases in 'FMX.frxEditAliases.pas' {frxAliasesEditorForm};
+
+end.
+
diff --git a/LibD28/FMXfrx25.otares b/LibD28/FMXfrx25.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrx25.otares differ
diff --git a/LibD28/FMXfrx25.res b/LibD28/FMXfrx25.res
new file mode 100644
index 0000000..3bb7875
Binary files /dev/null and b/LibD28/FMXfrx25.res differ
diff --git a/LibD28/FMXfrx26.dpk b/LibD28/FMXfrx26.dpk
new file mode 100644
index 0000000..25180e5
--- /dev/null
+++ b/LibD28/FMXfrx26.dpk
@@ -0,0 +1,127 @@
+// Package file for Rad Studio 10 Seattle
+
+package FMXfrx26;
+{$I frx.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs26;
+
+contains
+ FMX.frxAggregate in 'FMX.frxAggregate.pas',
+ FMX.frxClass in 'FMX.frxClass.pas',
+ FMX.frxClassRTTI in 'FMX.frxClassRTTI.pas',
+ FMX.frxCtrls in 'FMX.frxCtrls.pas',
+ FMX.frxDialogForm in 'FMX.frxDialogForm.pas',
+ FMX.frxDMPClass in 'FMX.frxDMPClass.pas',
+ FMX.frxEngine in 'FMX.frxEngine.pas',
+ FMX.frxFMX in 'FMX.frxFMX.pas',
+ FMX.frxGraphicUtils in 'FMX.frxGraphicUtils.pas',
+ FMX.frxPassw in 'FMX.frxPassw.pas',
+ FMX.frxPictureCache in 'FMX.frxPictureCache.pas',
+ FMX.frxPreview in 'FMX.frxPreview.pas',
+ FMX.frxPreviewPages in 'FMX.frxPreviewPages.pas',
+ FMX.frxPreviewPageSettings in 'FMX.frxPreviewPageSettings.pas',
+ FMX.frxPrintDialog in 'FMX.frxPrintDialog.pas',
+ FMX.frxPrinter in 'FMX.frxPrinter.pas',
+{$IFDEF MSWINDOWS}
+ FMX.Win.frxPrinter in 'FMX.Win.frxPrinter.pas',
+{$ELSE}
+ FMX.Mac.frxPrinter in 'FMX.Mac.frxPrinter.pas',
+{$ENDIF}
+ FMX.frxProgress in 'FMX.frxProgress.pas',
+ FMX.frxrcClass in 'FMX.frxrcClass.pas',
+ FMX.frxRes in 'FMX.frxRes.pas',
+ FMX.frxSearchDialog in 'FMX.frxSearchDialog.pas',
+ FMX.frxUnicodeUtils in 'FMX.frxUnicodeUtils.pas',
+ FMX.frxUtils in 'FMX.frxUtils.pas',
+ FMX.frxVariables in 'FMX.frxVariables.pas',
+ FMX.frxXML in 'FMX.frxXML.pas',
+ FMX.frxXMLSerializer in 'FMX.frxXMLSerializer.pas',
+ FMX.frxAbout in 'FMX.frxAbout.pas',
+ FMX.frxCodeUtils in 'FMX.frxCodeUtils.pas',
+ FMX.frxCustomEditors in 'FMX.frxCustomEditors.pas',
+ FMX.frxDataTree in 'FMX.frxDataTree.pas',
+ FMX.frxDesgn in 'FMX.frxDesgn.pas',
+ FMX.frxDesgnEditors in 'FMX.frxDesgnEditors.pas',
+ FMX.frxDesgnWorkspace in 'FMX.frxDesgnWorkspace.pas',
+ FMX.frxDesgnWorkspace1 in 'FMX.frxDesgnWorkspace1.pas',
+ FMX.frxDsgnIntf in 'FMX.frxDsgnIntf.pas',
+ FMX.frxEditDataBand in 'FMX.frxEditDataBand.pas',
+ FMX.frxEditExpr in 'FMX.frxEditExpr.pas',
+ FMX.frxEditFormat in 'FMX.frxEditFormat.pas',
+ FMX.frxEditFrame in 'FMX.frxEditFrame.pas',
+ FMX.frxEditGroup in 'FMX.frxEditGroup.pas',
+ FMX.frxEditHighlight in 'FMX.frxEditHighlight.pas',
+ FMX.frxEditMemo in 'FMX.frxEditMemo.pas',
+ FMX.frxEditOptions in 'FMX.frxEditOptions.pas',
+ FMX.frxEditPage in 'FMX.frxEditPage.pas',
+ FMX.frxEditPicture in 'FMX.frxEditPicture.pas',
+ FMX.frxEditReport in 'FMX.frxEditReport.pas',
+ FMX.frxEditReportData in 'FMX.frxEditReportData.pas',
+ FMX.frxEditStrings in 'FMX.frxEditStrings.pas',
+ FMX.frxEditStyle in 'FMX.frxEditStyle.pas',
+ FMX.frxEditSysMemo in 'FMX.frxEditSysMemo.pas',
+ FMX.frxEditTabOrder in 'FMX.frxEditTabOrder.pas',
+ FMX.frxEditVar in 'FMX.frxEditVar.pas',
+ FMX.frxEvaluateForm in 'FMX.frxEvaluateForm.pas',
+ FMX.frxInheritError in 'FMX.frxInheritError.pas',
+ FMX.frxInsp in 'FMX.frxInsp.pas',
+ FMX.frxPopupForm in 'FMX.frxPopupForm.pas',
+ FMX.frxrcDesgn in 'FMX.frxrcDesgn.pas',
+ FMX.frxrcInsp in 'FMX.frxrcInsp.pas',
+ FMX.frxReportTree in 'FMX.frxReportTree.pas',
+ FMX.frxWatchForm in 'FMX.frxWatchForm.pas',
+{$IFNDEF RAD_ED}
+ FMX.frxCross in 'FMX.frxCross.pas',
+ FMX.frxCrossEditor in 'FMX.frxCrossEditor.pas',
+ FMX.frxCrossRTTI in 'FMX.frxCrossRTTI.pas',
+ FMX.frxDCtrl in 'FMX.frxDCtrl.pas',
+ FMX.frxDCtrlRTTI in 'FMX.frxDCtrlRTTI.pas',
+ FMX.frxGradient in 'FMX.frxGradient.pas',
+ FMX.frxGradientRTTI in 'FMX.frxGradientRTTI.pas',
+ FMX.frxGZip in 'FMX.frxGZip.pas',
+ FMX.frxDesgnCtrls in 'FMX.frxDesgnCtrls.pas',
+ FMX.frxBarcode2DView in 'FMX.frxBarcode2DView.pas',
+ FMX.frxBarcode2DBase in 'FMX.frxBarcode2DBase.pas',
+ FMX.frxBarcode in 'FMX.frxBarcode.pas',
+ FMX.frxBarcod in 'FMX.frxBarcod.pas',
+ FMX.frxBarcodeEditor in 'FMX.frxBarcodeEditor.pas' {frxBarcodeEditorForm},
+ FMX.frxBarcodeProperties in 'FMX.frxBarcodeProperties.pas',
+ FMX.frxBarcodeDataMatrix in 'FMX.frxBarcodeDataMatrix.pas',
+ FMX.frxBarcodePDF417 in 'FMX.frxBarcodePDF417.pas',
+ FMX.frxBarcodeRTTI in 'FMX.frxBarcodeRTTI.pas',
+ FMX.frxChBox in 'FMX.frxChBox.pas',
+ FMX.frxChBoxRTTI in 'FMX.frxChBoxRTTI.pas',
+{$ENDIF}
+
+ FMX.frxEditAliases in 'FMX.frxEditAliases.pas' {frxAliasesEditorForm};
+
+end.
+
diff --git a/LibD28/FMXfrx27.dpk b/LibD28/FMXfrx27.dpk
new file mode 100644
index 0000000..c84db74
--- /dev/null
+++ b/LibD28/FMXfrx27.dpk
@@ -0,0 +1,134 @@
+// Package file for Rad Studio 10 Seattle
+
+package FMXfrx27;
+{$I frx.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs27;
+
+contains
+ FMX.frxAggregate in 'FMX.frxAggregate.pas',
+ FMX.frxClass in 'FMX.frxClass.pas',
+ FMX.frxClassRTTI in 'FMX.frxClassRTTI.pas',
+ FMX.frxCtrls in 'FMX.frxCtrls.pas',
+ FMX.frxDialogForm in 'FMX.frxDialogForm.pas',
+ FMX.frxDMPClass in 'FMX.frxDMPClass.pas',
+ FMX.frxEngine in 'FMX.frxEngine.pas',
+ FMX.frxFMX in 'FMX.frxFMX.pas',
+ FMX.frxGraphicUtils in 'FMX.frxGraphicUtils.pas',
+ FMX.frxPassw in 'FMX.frxPassw.pas',
+ FMX.frxPictureCache in 'FMX.frxPictureCache.pas',
+ FMX.frxPreview in 'FMX.frxPreview.pas',
+ FMX.frxPreviewPages in 'FMX.frxPreviewPages.pas',
+ FMX.frxPreviewPageSettings in 'FMX.frxPreviewPageSettings.pas',
+ FMX.frxPrintDialog in 'FMX.frxPrintDialog.pas',
+ FMX.frxPrinter in 'FMX.frxPrinter.pas',
+{$IFDEF MSWINDOWS}
+ FMX.Win.frxPrinter in 'FMX.Win.frxPrinter.pas',
+{$ELSE}
+ FMX.Mac.frxPrinter in 'FMX.Mac.frxPrinter.pas',
+{$ENDIF}
+ FMX.frxProgress in 'FMX.frxProgress.pas',
+ FMX.frxrcClass in 'FMX.frxrcClass.pas',
+ FMX.frxRes in 'FMX.frxRes.pas',
+ FMX.frxSearchDialog in 'FMX.frxSearchDialog.pas',
+ FMX.frxUnicodeUtils in 'FMX.frxUnicodeUtils.pas',
+ FMX.frxUtils in 'FMX.frxUtils.pas',
+ FMX.frxVariables in 'FMX.frxVariables.pas',
+ FMX.frxXML in 'FMX.frxXML.pas',
+ FMX.frxXMLSerializer in 'FMX.frxXMLSerializer.pas',
+ FMX.frxAbout in 'FMX.frxAbout.pas',
+ FMX.frxCodeUtils in 'FMX.frxCodeUtils.pas',
+ FMX.frxCustomEditors in 'FMX.frxCustomEditors.pas',
+ FMX.frxDataTree in 'FMX.frxDataTree.pas',
+ FMX.frxDesgn in 'FMX.frxDesgn.pas',
+ FMX.frxDesgnEditors in 'FMX.frxDesgnEditors.pas',
+ FMX.frxDesgnWorkspace in 'FMX.frxDesgnWorkspace.pas',
+ FMX.frxDesgnWorkspace1 in 'FMX.frxDesgnWorkspace1.pas',
+ FMX.frxDsgnIntf in 'FMX.frxDsgnIntf.pas',
+ FMX.frxEditDataBand in 'FMX.frxEditDataBand.pas',
+ FMX.frxEditExpr in 'FMX.frxEditExpr.pas',
+ FMX.frxEditFormat in 'FMX.frxEditFormat.pas',
+ FMX.frxEditFrame in 'FMX.frxEditFrame.pas',
+ FMX.frxEditGroup in 'FMX.frxEditGroup.pas',
+ FMX.frxEditHighlight in 'FMX.frxEditHighlight.pas',
+ FMX.frxEditMemo in 'FMX.frxEditMemo.pas',
+ FMX.frxEditOptions in 'FMX.frxEditOptions.pas',
+ FMX.frxEditPage in 'FMX.frxEditPage.pas',
+ FMX.frxEditPicture in 'FMX.frxEditPicture.pas',
+ FMX.frxEditReport in 'FMX.frxEditReport.pas',
+ FMX.frxEditReportData in 'FMX.frxEditReportData.pas',
+ FMX.frxEditStrings in 'FMX.frxEditStrings.pas',
+ FMX.frxEditStyle in 'FMX.frxEditStyle.pas',
+ FMX.frxEditSysMemo in 'FMX.frxEditSysMemo.pas',
+ FMX.frxEditTabOrder in 'FMX.frxEditTabOrder.pas',
+ FMX.frxEditVar in 'FMX.frxEditVar.pas',
+ FMX.frxEvaluateForm in 'FMX.frxEvaluateForm.pas',
+ FMX.frxInheritError in 'FMX.frxInheritError.pas',
+ FMX.frxInsp in 'FMX.frxInsp.pas',
+ FMX.frxPopupForm in 'FMX.frxPopupForm.pas',
+ FMX.frxrcDesgn in 'FMX.frxrcDesgn.pas',
+ FMX.frxrcInsp in 'FMX.frxrcInsp.pas',
+ FMX.frxReportTree in 'FMX.frxReportTree.pas',
+ FMX.frxWatchForm in 'FMX.frxWatchForm.pas',
+
+ FMX.frxBaseModalForm in 'FMX.frxBaseModalForm.pas',
+ FMX.frxFontForm in 'FMX.frxFontForm.pas',
+{$IFNDEF RAD_ED}
+ FMX.frxCross in 'FMX.frxCross.pas',
+ FMX.frxCrossEditor in 'FMX.frxCrossEditor.pas',
+ FMX.frxCrossRTTI in 'FMX.frxCrossRTTI.pas',
+ FMX.frxDCtrl in 'FMX.frxDCtrl.pas',
+ FMX.frxDCtrlRTTI in 'FMX.frxDCtrlRTTI.pas',
+ FMX.frxGradient in 'FMX.frxGradient.pas',
+ FMX.frxGradientRTTI in 'FMX.frxGradientRTTI.pas',
+ FMX.frxGZip in 'FMX.frxGZip.pas',
+ FMX.frxDesgnCtrls in 'FMX.frxDesgnCtrls.pas',
+ FMX.frxBarcode2DView in 'FMX.frxBarcode2DView.pas',
+ FMX.frxBarcode2DBase in 'FMX.frxBarcode2DBase.pas',
+ FMX.frxBarcode in 'FMX.frxBarcode.pas',
+ FMX.frxBarcod in 'FMX.frxBarcod.pas',
+ FMX.frxBarcodeEditor in 'FMX.frxBarcodeEditor.pas' {frxBarcodeEditorForm},
+ FMX.frxBarcodeProperties in 'FMX.frxBarcodeProperties.pas',
+ FMX.frxBarcodeDataMatrix in 'FMX.frxBarcodeDataMatrix.pas',
+ FMX.frxBarcodePDF417 in 'FMX.frxBarcodePDF417.pas',
+ FMX.frxBarcodeRTTI in 'FMX.frxBarcodeRTTI.pas',
+ FMX.frxChBox in 'FMX.frxChBox.pas',
+ FMX.frxChBoxRTTI in 'FMX.frxChBoxRTTI.pas',
+
+ FMX.DelphiZXingQRCode in 'FMX.DelphiZXingQRCode.pas',
+ FMX.frxBarcodeQR in 'FMX.frxBarcodeQR.pas',
+ FMX.frxBarcode2DRTTI in 'FMX.frxBarcode2DRTTI.pas',
+{$ENDIF}
+
+ FMX.frxEditAliases in 'FMX.frxEditAliases.pas' {frxAliasesEditorForm};
+
+end.
+
diff --git a/LibD28/FMXfrx29.dpk b/LibD28/FMXfrx29.dpk
new file mode 100644
index 0000000..b52fb31
--- /dev/null
+++ b/LibD28/FMXfrx29.dpk
@@ -0,0 +1,134 @@
+// Package file for Rad Studio 12
+
+package FMXfrx29;
+{$I frx.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs29;
+
+contains
+ FMX.frxAggregate in 'FMX.frxAggregate.pas',
+ FMX.frxClass in 'FMX.frxClass.pas',
+ FMX.frxClassRTTI in 'FMX.frxClassRTTI.pas',
+ FMX.frxCtrls in 'FMX.frxCtrls.pas',
+ FMX.frxDialogForm in 'FMX.frxDialogForm.pas',
+ FMX.frxDMPClass in 'FMX.frxDMPClass.pas',
+ FMX.frxEngine in 'FMX.frxEngine.pas',
+ FMX.frxFMX in 'FMX.frxFMX.pas',
+ FMX.frxGraphicUtils in 'FMX.frxGraphicUtils.pas',
+ FMX.frxPassw in 'FMX.frxPassw.pas',
+ FMX.frxPictureCache in 'FMX.frxPictureCache.pas',
+ FMX.frxPreview in 'FMX.frxPreview.pas',
+ FMX.frxPreviewPages in 'FMX.frxPreviewPages.pas',
+ FMX.frxPreviewPageSettings in 'FMX.frxPreviewPageSettings.pas',
+ FMX.frxPrintDialog in 'FMX.frxPrintDialog.pas',
+ FMX.frxPrinter in 'FMX.frxPrinter.pas',
+{$IFDEF MSWINDOWS}
+ FMX.Win.frxPrinter in 'FMX.Win.frxPrinter.pas',
+{$ELSE}
+ FMX.Mac.frxPrinter in 'FMX.Mac.frxPrinter.pas',
+{$ENDIF}
+ FMX.frxProgress in 'FMX.frxProgress.pas',
+ FMX.frxrcClass in 'FMX.frxrcClass.pas',
+ FMX.frxRes in 'FMX.frxRes.pas',
+ FMX.frxSearchDialog in 'FMX.frxSearchDialog.pas',
+ FMX.frxUnicodeUtils in 'FMX.frxUnicodeUtils.pas',
+ FMX.frxUtils in 'FMX.frxUtils.pas',
+ FMX.frxVariables in 'FMX.frxVariables.pas',
+ FMX.frxXML in 'FMX.frxXML.pas',
+ FMX.frxXMLSerializer in 'FMX.frxXMLSerializer.pas',
+ FMX.frxAbout in 'FMX.frxAbout.pas',
+ FMX.frxCodeUtils in 'FMX.frxCodeUtils.pas',
+ FMX.frxCustomEditors in 'FMX.frxCustomEditors.pas',
+ FMX.frxDataTree in 'FMX.frxDataTree.pas',
+ FMX.frxDesgn in 'FMX.frxDesgn.pas',
+ FMX.frxDesgnEditors in 'FMX.frxDesgnEditors.pas',
+ FMX.frxDesgnWorkspace in 'FMX.frxDesgnWorkspace.pas',
+ FMX.frxDesgnWorkspace1 in 'FMX.frxDesgnWorkspace1.pas',
+ FMX.frxDsgnIntf in 'FMX.frxDsgnIntf.pas',
+ FMX.frxEditDataBand in 'FMX.frxEditDataBand.pas',
+ FMX.frxEditExpr in 'FMX.frxEditExpr.pas',
+ FMX.frxEditFormat in 'FMX.frxEditFormat.pas',
+ FMX.frxEditFrame in 'FMX.frxEditFrame.pas',
+ FMX.frxEditGroup in 'FMX.frxEditGroup.pas',
+ FMX.frxEditHighlight in 'FMX.frxEditHighlight.pas',
+ FMX.frxEditMemo in 'FMX.frxEditMemo.pas',
+ FMX.frxEditOptions in 'FMX.frxEditOptions.pas',
+ FMX.frxEditPage in 'FMX.frxEditPage.pas',
+ FMX.frxEditPicture in 'FMX.frxEditPicture.pas',
+ FMX.frxEditReport in 'FMX.frxEditReport.pas',
+ FMX.frxEditReportData in 'FMX.frxEditReportData.pas',
+ FMX.frxEditStrings in 'FMX.frxEditStrings.pas',
+ FMX.frxEditStyle in 'FMX.frxEditStyle.pas',
+ FMX.frxEditSysMemo in 'FMX.frxEditSysMemo.pas',
+ FMX.frxEditTabOrder in 'FMX.frxEditTabOrder.pas',
+ FMX.frxEditVar in 'FMX.frxEditVar.pas',
+ FMX.frxEvaluateForm in 'FMX.frxEvaluateForm.pas',
+ FMX.frxInheritError in 'FMX.frxInheritError.pas',
+ FMX.frxInsp in 'FMX.frxInsp.pas',
+ FMX.frxPopupForm in 'FMX.frxPopupForm.pas',
+ FMX.frxrcDesgn in 'FMX.frxrcDesgn.pas',
+ FMX.frxrcInsp in 'FMX.frxrcInsp.pas',
+ FMX.frxReportTree in 'FMX.frxReportTree.pas',
+ FMX.frxWatchForm in 'FMX.frxWatchForm.pas',
+
+ FMX.frxBaseModalForm in 'FMX.frxBaseModalForm.pas',
+ FMX.frxFontForm in 'FMX.frxFontForm.pas',
+{$IFNDEF RAD_ED}
+ FMX.frxCross in 'FMX.frxCross.pas',
+ FMX.frxCrossEditor in 'FMX.frxCrossEditor.pas',
+ FMX.frxCrossRTTI in 'FMX.frxCrossRTTI.pas',
+ FMX.frxDCtrl in 'FMX.frxDCtrl.pas',
+ FMX.frxDCtrlRTTI in 'FMX.frxDCtrlRTTI.pas',
+ FMX.frxGradient in 'FMX.frxGradient.pas',
+ FMX.frxGradientRTTI in 'FMX.frxGradientRTTI.pas',
+ FMX.frxGZip in 'FMX.frxGZip.pas',
+ FMX.frxDesgnCtrls in 'FMX.frxDesgnCtrls.pas',
+ FMX.frxBarcode2DView in 'FMX.frxBarcode2DView.pas',
+ FMX.frxBarcode2DBase in 'FMX.frxBarcode2DBase.pas',
+ FMX.frxBarcode in 'FMX.frxBarcode.pas',
+ FMX.frxBarcod in 'FMX.frxBarcod.pas',
+ FMX.frxBarcodeEditor in 'FMX.frxBarcodeEditor.pas' {frxBarcodeEditorForm},
+ FMX.frxBarcodeProperties in 'FMX.frxBarcodeProperties.pas',
+ FMX.frxBarcodeDataMatrix in 'FMX.frxBarcodeDataMatrix.pas',
+ FMX.frxBarcodePDF417 in 'FMX.frxBarcodePDF417.pas',
+ FMX.frxBarcodeRTTI in 'FMX.frxBarcodeRTTI.pas',
+ FMX.frxChBox in 'FMX.frxChBox.pas',
+ FMX.frxChBoxRTTI in 'FMX.frxChBoxRTTI.pas',
+
+ FMX.DelphiZXingQRCode in 'FMX.DelphiZXingQRCode.pas',
+ FMX.frxBarcodeQR in 'FMX.frxBarcodeQR.pas',
+ FMX.frxBarcode2DRTTI in 'FMX.frxBarcode2DRTTI.pas',
+{$ENDIF}
+
+ FMX.frxEditAliases in 'FMX.frxEditAliases.pas' {frxAliasesEditorForm};
+
+end.
+
diff --git a/LibD28/FMXfrx29.dproj b/LibD28/FMXfrx29.dproj
new file mode 100644
index 0000000..ab8f3ac
--- /dev/null
+++ b/LibD28/FMXfrx29.dproj
@@ -0,0 +1,221 @@
+
+
+ {94955A66-AAED-4C0F-A30C-9F6BD0FC903E}
+ FMXfrx29.dpk
+ True
+ Release
+ 3
+ Package
+ None
+ 20.1
+ Win32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Cfg_1
+ true
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ FMXfrx29
+ true
+ true
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+ 1033
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ D:\Delphi\Component\FastReport FMX 2.8.12 Pro Full Source\LibD28x64\
+ true
+ 1033
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ FMXfrx29.dpk
+
+
+ Microsoft Office 2000 Sample Automation Server Wrapper Components
+ Microsoft Office XP Sample Automation Server Wrapper Components
+
+
+
+ True
+ True
+
+
+ 12
+
+
+
+
diff --git a/LibD28/FMXfrx29.res b/LibD28/FMXfrx29.res
new file mode 100644
index 0000000..5f43f17
Binary files /dev/null and b/LibD28/FMXfrx29.res differ
diff --git a/LibD28/FMXfrxADO16.dpk b/LibD28/FMXfrxADO16.dpk
new file mode 100644
index 0000000..2de3449
--- /dev/null
+++ b/LibD28/FMXfrxADO16.dpk
@@ -0,0 +1,46 @@
+// Package file for Delphi XE2
+
+package FMXfrxADO16;
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ ADORTL,
+ FMXfrx16,
+{$IFDEF QBUILDER}
+ FMXfqb160,
+{$ENDIF}
+ FMXfrxDB16,
+ FMXfs16,
+ FMXfsADO16;
+
+contains
+ FMX.frxADOComponents in 'FMX.frxADOComponents.pas',
+ FMX.frxADOEditor in 'FMX.frxADOEditor.pas',
+ FMX.frxADORTTI in 'FMX.frxADORTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxADO16.res b/LibD28/FMXfrxADO16.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxADO16.res differ
diff --git a/LibD28/FMXfrxADO17.dpk b/LibD28/FMXfrxADO17.dpk
new file mode 100644
index 0000000..4a66ec6
--- /dev/null
+++ b/LibD28/FMXfrxADO17.dpk
@@ -0,0 +1,46 @@
+// Package file for Delphi XE3
+
+package FMXfrxADO17;
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ ADORTL,
+ FMXfrx17,
+{$IFDEF QBUILDER}
+ FMXfqb170,
+{$ENDIF}
+ FMXfrxDB17,
+ FMXfs17,
+ FMXfsADO17;
+
+contains
+ FMX.frxADOComponents in 'FMX.frxADOComponents.pas',
+ FMX.frxADOEditor in 'FMX.frxADOEditor.pas',
+ FMX.frxADORTTI in 'FMX.frxADORTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxADO17.res b/LibD28/FMXfrxADO17.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxADO17.res differ
diff --git a/LibD28/FMXfrxADO18.dpk b/LibD28/FMXfrxADO18.dpk
new file mode 100644
index 0000000..353b4d6
--- /dev/null
+++ b/LibD28/FMXfrxADO18.dpk
@@ -0,0 +1,46 @@
+// Package file for Delphi XE4
+
+package FMXfrxADO18;
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ ADORTL,
+ FMXfrx18,
+{$IFDEF QBUILDER}
+ FMXfqb180,
+{$ENDIF}
+ FMXfrxDB18,
+ FMXfs18,
+ FMXfsADO18;
+
+contains
+ FMX.frxADOComponents in 'FMX.frxADOComponents.pas',
+ FMX.frxADOEditor in 'FMX.frxADOEditor.pas',
+ FMX.frxADORTTI in 'FMX.frxADORTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxADO18.res b/LibD28/FMXfrxADO18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxADO18.res differ
diff --git a/LibD28/FMXfrxADO19.dpk b/LibD28/FMXfrxADO19.dpk
new file mode 100644
index 0000000..4fad824
--- /dev/null
+++ b/LibD28/FMXfrxADO19.dpk
@@ -0,0 +1,46 @@
+// Package file for Delphi XE5
+
+package FMXfrxADO19;
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ ADORTL,
+ FMXfrx19,
+{$IFDEF QBUILDER}
+ FMXfqb190,
+{$ENDIF}
+ FMXfrxDB19,
+ FMXfs19,
+ FMXfsADO19;
+
+contains
+ FMX.frxADOComponents in 'FMX.frxADOComponents.pas',
+ FMX.frxADOEditor in 'FMX.frxADOEditor.pas',
+ FMX.frxADORTTI in 'FMX.frxADORTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxADO19.res b/LibD28/FMXfrxADO19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxADO19.res differ
diff --git a/LibD28/FMXfrxADO20.dpk b/LibD28/FMXfrxADO20.dpk
new file mode 100644
index 0000000..42cf4b6
--- /dev/null
+++ b/LibD28/FMXfrxADO20.dpk
@@ -0,0 +1,46 @@
+// Package file for Delphi XE6
+
+package FMXfrxADO20;
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ ADORTL,
+ FMXfrx20,
+{$IFDEF QBUILDER}
+ FMXfqb200,
+{$ENDIF}
+ FMXfrxDB20,
+ FMXfs20,
+ FMXfsADO20;
+
+contains
+ FMX.frxADOComponents in 'FMX.frxADOComponents.pas',
+ FMX.frxADOEditor in 'FMX.frxADOEditor.pas',
+ FMX.frxADORTTI in 'FMX.frxADORTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxADO20.res b/LibD28/FMXfrxADO20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxADO20.res differ
diff --git a/LibD28/FMXfrxADO21.dpk b/LibD28/FMXfrxADO21.dpk
new file mode 100644
index 0000000..24f2cad
--- /dev/null
+++ b/LibD28/FMXfrxADO21.dpk
@@ -0,0 +1,46 @@
+// Package file for Delphi XE7
+
+package FMXfrxADO21;
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ ADORTL,
+ FMXfrx21,
+{$IFDEF QBUILDER}
+ FMXfqb210,
+{$ENDIF}
+ FMXfrxDB21,
+ FMXfs21,
+ FMXfsADO21;
+
+contains
+ FMX.frxADOComponents in 'FMX.frxADOComponents.pas',
+ FMX.frxADOEditor in 'FMX.frxADOEditor.pas',
+ FMX.frxADORTTI in 'FMX.frxADORTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxADO21.res b/LibD28/FMXfrxADO21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxADO21.res differ
diff --git a/LibD28/FMXfrxADO22.dpk b/LibD28/FMXfrxADO22.dpk
new file mode 100644
index 0000000..4d42517
--- /dev/null
+++ b/LibD28/FMXfrxADO22.dpk
@@ -0,0 +1,46 @@
+// Package file for Delphi XE8
+
+package FMXfrxADO22;
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ ADORTL,
+ FMXfrx22,
+{$IFDEF QBUILDER}
+ FMXfqb220,
+{$ENDIF}
+ FMXfrxDB22,
+ FMXfs22,
+ FMXfsADO22;
+
+contains
+ FMX.frxADOComponents in 'FMX.frxADOComponents.pas',
+ FMX.frxADOEditor in 'FMX.frxADOEditor.pas',
+ FMX.frxADORTTI in 'FMX.frxADORTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxADO22.res b/LibD28/FMXfrxADO22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxADO22.res differ
diff --git a/LibD28/FMXfrxADO23.dpk b/LibD28/FMXfrxADO23.dpk
new file mode 100644
index 0000000..26b9cfc
--- /dev/null
+++ b/LibD28/FMXfrxADO23.dpk
@@ -0,0 +1,46 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfrxADO23;
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ ADORTL,
+ FMXfrx23,
+{$IFDEF QBUILDER}
+ FMXfqb230,
+{$ENDIF}
+ FMXfrxDB23,
+ FMXfs23,
+ FMXfsADO23;
+
+contains
+ FMX.frxADOComponents in 'FMX.frxADOComponents.pas',
+ FMX.frxADOEditor in 'FMX.frxADOEditor.pas',
+ FMX.frxADORTTI in 'FMX.frxADORTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxADO23.res b/LibD28/FMXfrxADO23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxADO23.res differ
diff --git a/LibD28/FMXfrxADO24.dpk b/LibD28/FMXfrxADO24.dpk
new file mode 100644
index 0000000..c3c68b7
--- /dev/null
+++ b/LibD28/FMXfrxADO24.dpk
@@ -0,0 +1,46 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfrxADO24;
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ ADORTL,
+ FMXfrx24,
+{$IFDEF QBUILDER}
+ FMXfqb240,
+{$ENDIF}
+ FMXfrxDB24,
+ FMXfs24,
+ FMXfsADO24;
+
+contains
+ FMX.frxADOComponents in 'FMX.frxADOComponents.pas',
+ FMX.frxADOEditor in 'FMX.frxADOEditor.pas',
+ FMX.frxADORTTI in 'FMX.frxADORTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxADO24.res b/LibD28/FMXfrxADO24.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxADO24.res differ
diff --git a/LibD28/FMXfrxADO25.dpk b/LibD28/FMXfrxADO25.dpk
new file mode 100644
index 0000000..96bb494
--- /dev/null
+++ b/LibD28/FMXfrxADO25.dpk
@@ -0,0 +1,46 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfrxADO25;
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ ADORTL,
+ FMXfrx25,
+{$IFDEF QBUILDER}
+ FMXfqb250,
+{$ENDIF}
+ FMXfrxDB25,
+ FMXfs25,
+ FMXfsADO25;
+
+contains
+ FMX.frxADOComponents in 'FMX.frxADOComponents.pas',
+ FMX.frxADOEditor in 'FMX.frxADOEditor.pas',
+ FMX.frxADORTTI in 'FMX.frxADORTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxADO25.res b/LibD28/FMXfrxADO25.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxADO25.res differ
diff --git a/LibD28/FMXfrxADO26.dpk b/LibD28/FMXfrxADO26.dpk
new file mode 100644
index 0000000..7c9bd00
--- /dev/null
+++ b/LibD28/FMXfrxADO26.dpk
@@ -0,0 +1,46 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfrxADO26;
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ ADORTL,
+ FMXfrx26,
+{$IFDEF QBUILDER}
+ FMXfqb260,
+{$ENDIF}
+ FMXfrxDB26,
+ FMXfs26,
+ FMXfsADO26;
+
+contains
+ FMX.frxADOComponents in 'FMX.frxADOComponents.pas',
+ FMX.frxADOEditor in 'FMX.frxADOEditor.pas',
+ FMX.frxADORTTI in 'FMX.frxADORTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxADO27.dpk b/LibD28/FMXfrxADO27.dpk
new file mode 100644
index 0000000..6608716
--- /dev/null
+++ b/LibD28/FMXfrxADO27.dpk
@@ -0,0 +1,46 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfrxADO27;
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ ADORTL,
+ FMXfrx27,
+{$IFDEF QBUILDER}
+ FMXfqb270,
+{$ENDIF}
+ FMXfrxDB27,
+ FMXfs27,
+ FMXfsADO27;
+
+contains
+ FMX.frxADOComponents in 'FMX.frxADOComponents.pas',
+ FMX.frxADOEditor in 'FMX.frxADOEditor.pas',
+ FMX.frxADORTTI in 'FMX.frxADORTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxADO28.dpk b/LibD28/FMXfrxADO28.dpk
new file mode 100644
index 0000000..8a1e1ff
--- /dev/null
+++ b/LibD28/FMXfrxADO28.dpk
@@ -0,0 +1,46 @@
+// Package file for Delphi 11 Seattle
+
+package FMXfrxADO28;
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ ADORTL,
+ FMXfrx28,
+{$IFDEF QBUILDER}
+ FMXfqb280,
+{$ENDIF}
+ FMXfrxDB28,
+ FMXfs28,
+ FMXfsADO28;
+
+contains
+ FMX.frxADOComponents in 'FMX.frxADOComponents.pas',
+ FMX.frxADOEditor in 'FMX.frxADOEditor.pas',
+ FMX.frxADORTTI in 'FMX.frxADORTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxADO29.dpk b/LibD28/FMXfrxADO29.dpk
new file mode 100644
index 0000000..9d894dd
--- /dev/null
+++ b/LibD28/FMXfrxADO29.dpk
@@ -0,0 +1,46 @@
+// Package file for Delphi 12
+
+package FMXfrxADO29;
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ ADORTL,
+ FMXfrx29,
+{$IFDEF QBUILDER}
+ FMXfqb290,
+{$ENDIF}
+ FMXfrxDB29,
+ FMXfs29,
+ FMXfsADO29;
+
+contains
+ FMX.frxADOComponents in 'FMX.frxADOComponents.pas',
+ FMX.frxADOEditor in 'FMX.frxADOEditor.pas',
+ FMX.frxADORTTI in 'FMX.frxADORTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxADOReg.dcr b/LibD28/FMXfrxADOReg.dcr
new file mode 100644
index 0000000..998caa3
Binary files /dev/null and b/LibD28/FMXfrxADOReg.dcr differ
diff --git a/LibD28/FMXfrxADOReg.pas b/LibD28/FMXfrxADOReg.pas
new file mode 100644
index 0000000..7f4ae73
--- /dev/null
+++ b/LibD28/FMXfrxADOReg.pas
@@ -0,0 +1,33 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ ADO components registration }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMXfrxADOReg;
+
+interface
+
+{$I frx.inc}
+
+procedure Register;
+
+implementation
+
+uses
+ System.SysUtils, System.Classes, FMX.Controls
+, DesignIntf, DesignEditors
+, FMX.frxADOComponents;
+
+procedure Register;
+begin
+ RegisterComponents('FastReport 2.0 FMX', [TfrxADOComponents]);
+end;
+
+end.
diff --git a/LibD28/FMXfrxDB16.dpk b/LibD28/FMXfrxDB16.dpk
new file mode 100644
index 0000000..906de03
--- /dev/null
+++ b/LibD28/FMXfrxDB16.dpk
@@ -0,0 +1,51 @@
+// Package file for Rad Studio XE2
+
+package FMXfrxDB16;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ FMXfrx16,
+ FMXfs16,
+ FMXfsDB16;
+
+contains
+ FMX.frxDBSet in 'FMX.frxDBSet.pas',
+ FMX.frxCustomDB in 'FMX.frxCustomDB.pas',
+ FMX.frxCustomDBRTTI in 'FMX.frxCustomDBRTTI.pas',
+ FMX.frxCustomDBEditor in 'FMX.frxCustomDBEditor.pas',
+ FMX.frxConnWizard in 'FMX.frxConnWizard.pas' {frxConnectionWizardForm},
+ FMX.frxEditQueryParams in 'FMX.frxEditQueryParams.pas' {frxParamsEditorForm},
+ FMX.frxEditSQL in 'FMX.frxEditSQL.pas' {frxSQLEditorForm},
+ FMX.frxEditMD in 'FMX.frxEditMD.pas' {frxMDEditorForm};
+
+end.
diff --git a/LibD28/FMXfrxDB16.otares b/LibD28/FMXfrxDB16.otares
new file mode 100644
index 0000000..93e7e94
Binary files /dev/null and b/LibD28/FMXfrxDB16.otares differ
diff --git a/LibD28/FMXfrxDB16.res b/LibD28/FMXfrxDB16.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxDB16.res differ
diff --git a/LibD28/FMXfrxDB17.dpk b/LibD28/FMXfrxDB17.dpk
new file mode 100644
index 0000000..1d0bd4a
--- /dev/null
+++ b/LibD28/FMXfrxDB17.dpk
@@ -0,0 +1,50 @@
+// Package file for Rad Studio XE3
+
+package FMXfrxDB17;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ FMXfrx17,
+ FMXfs17,
+ FMXfsDB17;
+
+contains
+ FMX.frxDBSet in 'FMX.frxDBSet.pas',
+ FMX.frxCustomDB in 'FMX.frxCustomDB.pas',
+ FMX.frxCustomDBRTTI in 'FMX.frxCustomDBRTTI.pas',
+ FMX.frxCustomDBEditor in 'FMX.frxCustomDBEditor.pas',
+ FMX.frxConnWizard in 'FMX.frxConnWizard.pas' {frxConnectionWizardForm},
+ FMX.frxEditQueryParams in 'FMX.frxEditQueryParams.pas' {frxParamsEditorForm},
+ FMX.frxEditSQL in 'FMX.frxEditSQL.pas' {frxSQLEditorForm},
+ FMX.frxEditMD in 'FMX.frxEditMD.pas' {frxMDEditorForm};
+
+end.
diff --git a/LibD28/FMXfrxDB17.otares b/LibD28/FMXfrxDB17.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxDB17.otares differ
diff --git a/LibD28/FMXfrxDB17.res b/LibD28/FMXfrxDB17.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxDB17.res differ
diff --git a/LibD28/FMXfrxDB18.dpk b/LibD28/FMXfrxDB18.dpk
new file mode 100644
index 0000000..d2a87cd
--- /dev/null
+++ b/LibD28/FMXfrxDB18.dpk
@@ -0,0 +1,51 @@
+// Package file for Rad Studio XE4
+
+package FMXfrxDB18;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ FMXfrx18,
+ FMXfs18,
+ FMXfsDB18;
+
+contains
+ FMX.frxDBSet in 'FMX.frxDBSet.pas',
+ FMX.frxCustomDB in 'FMX.frxCustomDB.pas',
+ FMX.frxCustomDBRTTI in 'FMX.frxCustomDBRTTI.pas',
+ FMX.frxCustomDBEditor in 'FMX.frxCustomDBEditor.pas',
+ FMX.frxConnWizard in 'FMX.frxConnWizard.pas' {frxConnectionWizardForm},
+ FMX.frxEditQueryParams in 'FMX.frxEditQueryParams.pas' {frxParamsEditorForm},
+ FMX.frxEditSQL in 'FMX.frxEditSQL.pas' {frxSQLEditorForm},
+ FMX.frxEditMD in 'FMX.frxEditMD.pas' {frxMDEditorForm};
+
+end.
diff --git a/LibD28/FMXfrxDB18.otares b/LibD28/FMXfrxDB18.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxDB18.otares differ
diff --git a/LibD28/FMXfrxDB18.res b/LibD28/FMXfrxDB18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxDB18.res differ
diff --git a/LibD28/FMXfrxDB19.dpk b/LibD28/FMXfrxDB19.dpk
new file mode 100644
index 0000000..d70c29b
--- /dev/null
+++ b/LibD28/FMXfrxDB19.dpk
@@ -0,0 +1,51 @@
+// Package file for Rad Studio XE5
+
+package FMXfrxDB19;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ FMXfrx19,
+ FMXfs19,
+ FMXfsDB19;
+
+contains
+ FMX.frxDBSet in 'FMX.frxDBSet.pas',
+ FMX.frxCustomDB in 'FMX.frxCustomDB.pas',
+ FMX.frxCustomDBRTTI in 'FMX.frxCustomDBRTTI.pas',
+ FMX.frxCustomDBEditor in 'FMX.frxCustomDBEditor.pas',
+ FMX.frxConnWizard in 'FMX.frxConnWizard.pas' {frxConnectionWizardForm},
+ FMX.frxEditQueryParams in 'FMX.frxEditQueryParams.pas' {frxParamsEditorForm},
+ FMX.frxEditSQL in 'FMX.frxEditSQL.pas' {frxSQLEditorForm},
+ FMX.frxEditMD in 'FMX.frxEditMD.pas' {frxMDEditorForm};
+
+end.
diff --git a/LibD28/FMXfrxDB19.otares b/LibD28/FMXfrxDB19.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxDB19.otares differ
diff --git a/LibD28/FMXfrxDB19.res b/LibD28/FMXfrxDB19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxDB19.res differ
diff --git a/LibD28/FMXfrxDB20.dpk b/LibD28/FMXfrxDB20.dpk
new file mode 100644
index 0000000..500c4c6
--- /dev/null
+++ b/LibD28/FMXfrxDB20.dpk
@@ -0,0 +1,51 @@
+// Package file for Rad Studio XE6
+
+package FMXfrxDB20;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ FMXfrx20,
+ FMXfs20,
+ FMXfsDB20;
+
+contains
+ FMX.frxDBSet in 'FMX.frxDBSet.pas',
+ FMX.frxCustomDB in 'FMX.frxCustomDB.pas',
+ FMX.frxCustomDBRTTI in 'FMX.frxCustomDBRTTI.pas',
+ FMX.frxCustomDBEditor in 'FMX.frxCustomDBEditor.pas',
+ FMX.frxConnWizard in 'FMX.frxConnWizard.pas' {frxConnectionWizardForm},
+ FMX.frxEditQueryParams in 'FMX.frxEditQueryParams.pas' {frxParamsEditorForm},
+ FMX.frxEditSQL in 'FMX.frxEditSQL.pas' {frxSQLEditorForm},
+ FMX.frxEditMD in 'FMX.frxEditMD.pas' {frxMDEditorForm};
+
+end.
diff --git a/LibD28/FMXfrxDB20.otares b/LibD28/FMXfrxDB20.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxDB20.otares differ
diff --git a/LibD28/FMXfrxDB20.res b/LibD28/FMXfrxDB20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxDB20.res differ
diff --git a/LibD28/FMXfrxDB21.dpk b/LibD28/FMXfrxDB21.dpk
new file mode 100644
index 0000000..06d61f1
--- /dev/null
+++ b/LibD28/FMXfrxDB21.dpk
@@ -0,0 +1,51 @@
+// Package file for Rad Studio XE7
+
+package FMXfrxDB21;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ FMXfrx21,
+ FMXfs21,
+ FMXfsDB21;
+
+contains
+ FMX.frxDBSet in 'FMX.frxDBSet.pas',
+ FMX.frxCustomDB in 'FMX.frxCustomDB.pas',
+ FMX.frxCustomDBRTTI in 'FMX.frxCustomDBRTTI.pas',
+ FMX.frxCustomDBEditor in 'FMX.frxCustomDBEditor.pas',
+ FMX.frxConnWizard in 'FMX.frxConnWizard.pas' {frxConnectionWizardForm},
+ FMX.frxEditQueryParams in 'FMX.frxEditQueryParams.pas' {frxParamsEditorForm},
+ FMX.frxEditSQL in 'FMX.frxEditSQL.pas' {frxSQLEditorForm},
+ FMX.frxEditMD in 'FMX.frxEditMD.pas' {frxMDEditorForm};
+
+end.
diff --git a/LibD28/FMXfrxDB21.otares b/LibD28/FMXfrxDB21.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxDB21.otares differ
diff --git a/LibD28/FMXfrxDB21.res b/LibD28/FMXfrxDB21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxDB21.res differ
diff --git a/LibD28/FMXfrxDB22.dpk b/LibD28/FMXfrxDB22.dpk
new file mode 100644
index 0000000..e676b41
--- /dev/null
+++ b/LibD28/FMXfrxDB22.dpk
@@ -0,0 +1,51 @@
+// Package file for Rad Studio XE8
+
+package FMXfrxDB22;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ FMXfrx22,
+ FMXfs22,
+ FMXfsDB22;
+
+contains
+ FMX.frxDBSet in 'FMX.frxDBSet.pas',
+ FMX.frxCustomDB in 'FMX.frxCustomDB.pas',
+ FMX.frxCustomDBRTTI in 'FMX.frxCustomDBRTTI.pas',
+ FMX.frxCustomDBEditor in 'FMX.frxCustomDBEditor.pas',
+ FMX.frxConnWizard in 'FMX.frxConnWizard.pas' {frxConnectionWizardForm},
+ FMX.frxEditQueryParams in 'FMX.frxEditQueryParams.pas' {frxParamsEditorForm},
+ FMX.frxEditSQL in 'FMX.frxEditSQL.pas' {frxSQLEditorForm},
+ FMX.frxEditMD in 'FMX.frxEditMD.pas' {frxMDEditorForm};
+
+end.
diff --git a/LibD28/FMXfrxDB22.otares b/LibD28/FMXfrxDB22.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxDB22.otares differ
diff --git a/LibD28/FMXfrxDB22.res b/LibD28/FMXfrxDB22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxDB22.res differ
diff --git a/LibD28/FMXfrxDB23.dpk b/LibD28/FMXfrxDB23.dpk
new file mode 100644
index 0000000..0d69546
--- /dev/null
+++ b/LibD28/FMXfrxDB23.dpk
@@ -0,0 +1,51 @@
+// Package file for Rad Studio 10 Seattle
+
+package FMXfrxDB23;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ FMXfrx23,
+ FMXfs23,
+ FMXfsDB23;
+
+contains
+ FMX.frxDBSet in 'FMX.frxDBSet.pas',
+ FMX.frxCustomDB in 'FMX.frxCustomDB.pas',
+ FMX.frxCustomDBRTTI in 'FMX.frxCustomDBRTTI.pas',
+ FMX.frxCustomDBEditor in 'FMX.frxCustomDBEditor.pas',
+ FMX.frxConnWizard in 'FMX.frxConnWizard.pas' {frxConnectionWizardForm},
+ FMX.frxEditQueryParams in 'FMX.frxEditQueryParams.pas' {frxParamsEditorForm},
+ FMX.frxEditSQL in 'FMX.frxEditSQL.pas' {frxSQLEditorForm},
+ FMX.frxEditMD in 'FMX.frxEditMD.pas' {frxMDEditorForm};
+
+end.
diff --git a/LibD28/FMXfrxDB23.otares b/LibD28/FMXfrxDB23.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxDB23.otares differ
diff --git a/LibD28/FMXfrxDB23.res b/LibD28/FMXfrxDB23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxDB23.res differ
diff --git a/LibD28/FMXfrxDB24.dpk b/LibD28/FMXfrxDB24.dpk
new file mode 100644
index 0000000..dd8dd5f
--- /dev/null
+++ b/LibD28/FMXfrxDB24.dpk
@@ -0,0 +1,51 @@
+// Package file for Rad Studio 10 Seattle
+
+package FMXfrxDB24;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ FMXfrx24,
+ FMXfs24,
+ FMXfsDB24;
+
+contains
+ FMX.frxDBSet in 'FMX.frxDBSet.pas',
+ FMX.frxCustomDB in 'FMX.frxCustomDB.pas',
+ FMX.frxCustomDBRTTI in 'FMX.frxCustomDBRTTI.pas',
+ FMX.frxCustomDBEditor in 'FMX.frxCustomDBEditor.pas',
+ FMX.frxConnWizard in 'FMX.frxConnWizard.pas' {frxConnectionWizardForm},
+ FMX.frxEditQueryParams in 'FMX.frxEditQueryParams.pas' {frxParamsEditorForm},
+ FMX.frxEditSQL in 'FMX.frxEditSQL.pas' {frxSQLEditorForm},
+ FMX.frxEditMD in 'FMX.frxEditMD.pas' {frxMDEditorForm};
+
+end.
diff --git a/LibD28/FMXfrxDB24.otares b/LibD28/FMXfrxDB24.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxDB24.otares differ
diff --git a/LibD28/FMXfrxDB24.res b/LibD28/FMXfrxDB24.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxDB24.res differ
diff --git a/LibD28/FMXfrxDB25.dpk b/LibD28/FMXfrxDB25.dpk
new file mode 100644
index 0000000..0602430
--- /dev/null
+++ b/LibD28/FMXfrxDB25.dpk
@@ -0,0 +1,51 @@
+// Package file for Rad Studio 10 Seattle
+
+package FMXfrxDB25;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ FMXfrx25,
+ FMXfs25,
+ FMXfsDB25;
+
+contains
+ FMX.frxDBSet in 'FMX.frxDBSet.pas',
+ FMX.frxCustomDB in 'FMX.frxCustomDB.pas',
+ FMX.frxCustomDBRTTI in 'FMX.frxCustomDBRTTI.pas',
+ FMX.frxCustomDBEditor in 'FMX.frxCustomDBEditor.pas',
+ FMX.frxConnWizard in 'FMX.frxConnWizard.pas' {frxConnectionWizardForm},
+ FMX.frxEditQueryParams in 'FMX.frxEditQueryParams.pas' {frxParamsEditorForm},
+ FMX.frxEditSQL in 'FMX.frxEditSQL.pas' {frxSQLEditorForm},
+ FMX.frxEditMD in 'FMX.frxEditMD.pas' {frxMDEditorForm};
+
+end.
diff --git a/LibD28/FMXfrxDB25.otares b/LibD28/FMXfrxDB25.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxDB25.otares differ
diff --git a/LibD28/FMXfrxDB25.res b/LibD28/FMXfrxDB25.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxDB25.res differ
diff --git a/LibD28/FMXfrxDB26.dpk b/LibD28/FMXfrxDB26.dpk
new file mode 100644
index 0000000..e2a6caa
--- /dev/null
+++ b/LibD28/FMXfrxDB26.dpk
@@ -0,0 +1,49 @@
+// Package file for Rad Studio 10 Seattle
+
+package FMXfrxDB26;
+
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ FMXfrx26,
+ FMXfs26,
+ FMXfsDB26;
+
+contains
+ FMX.frxDBSet in 'FMX.frxDBSet.pas',
+ FMX.frxCustomDB in 'FMX.frxCustomDB.pas',
+ FMX.frxCustomDBRTTI in 'FMX.frxCustomDBRTTI.pas',
+ FMX.frxCustomDBEditor in 'FMX.frxCustomDBEditor.pas',
+ FMX.frxConnWizard in 'FMX.frxConnWizard.pas' {frxConnectionWizardForm},
+ FMX.frxEditQueryParams in 'FMX.frxEditQueryParams.pas' {frxParamsEditorForm},
+ FMX.frxEditSQL in 'FMX.frxEditSQL.pas' {frxSQLEditorForm},
+ FMX.frxEditMD in 'FMX.frxEditMD.pas' {frxMDEditorForm};
+
+end.
diff --git a/LibD28/FMXfrxDB27.dpk b/LibD28/FMXfrxDB27.dpk
new file mode 100644
index 0000000..9ab9dce
--- /dev/null
+++ b/LibD28/FMXfrxDB27.dpk
@@ -0,0 +1,49 @@
+// Package file for Rad Studio 10 Seattle
+
+package FMXfrxDB27;
+
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ FMXfrx27,
+ FMXfs27,
+ FMXfsDB27;
+
+contains
+ FMX.frxDBSet in 'FMX.frxDBSet.pas',
+ FMX.frxCustomDB in 'FMX.frxCustomDB.pas',
+ FMX.frxCustomDBRTTI in 'FMX.frxCustomDBRTTI.pas',
+ FMX.frxCustomDBEditor in 'FMX.frxCustomDBEditor.pas',
+ FMX.frxConnWizard in 'FMX.frxConnWizard.pas' {frxConnectionWizardForm},
+ FMX.frxEditQueryParams in 'FMX.frxEditQueryParams.pas' {frxParamsEditorForm},
+ FMX.frxEditSQL in 'FMX.frxEditSQL.pas' {frxSQLEditorForm},
+ FMX.frxEditMD in 'FMX.frxEditMD.pas' {frxMDEditorForm};
+
+end.
diff --git a/LibD28/FMXfrxDB29.dpk b/LibD28/FMXfrxDB29.dpk
new file mode 100644
index 0000000..08b962a
--- /dev/null
+++ b/LibD28/FMXfrxDB29.dpk
@@ -0,0 +1,49 @@
+// Package file for Rad Studio 12
+
+package FMXfrxDB29;
+
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ FMXfrx29,
+ FMXfs29,
+ FMXfsDB29;
+
+contains
+ FMX.frxDBSet in 'FMX.frxDBSet.pas',
+ FMX.frxCustomDB in 'FMX.frxCustomDB.pas',
+ FMX.frxCustomDBRTTI in 'FMX.frxCustomDBRTTI.pas',
+ FMX.frxCustomDBEditor in 'FMX.frxCustomDBEditor.pas',
+ FMX.frxConnWizard in 'FMX.frxConnWizard.pas' {frxConnectionWizardForm},
+ FMX.frxEditQueryParams in 'FMX.frxEditQueryParams.pas' {frxParamsEditorForm},
+ FMX.frxEditSQL in 'FMX.frxEditSQL.pas' {frxSQLEditorForm},
+ FMX.frxEditMD in 'FMX.frxEditMD.pas' {frxMDEditorForm};
+
+end.
diff --git a/LibD28/FMXfrxDB29.dproj b/LibD28/FMXfrxDB29.dproj
new file mode 100644
index 0000000..e170a87
--- /dev/null
+++ b/LibD28/FMXfrxDB29.dproj
@@ -0,0 +1,134 @@
+
+
+ {6646CBA4-4F45-4E52-86EB-BF13674E4179}
+ FMXfrxDB29.dpk
+ True
+ Release
+ 3
+ Package
+ None
+ 20.1
+ Win64
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Cfg_1
+ true
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ FMXfrxDB29
+ true
+ true
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+ 1033
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ D:\Delphi\Component\FastReport FMX 2.8.12 Pro Full Source\LibD28x64\
+ true
+ 1033
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ FMXfrxDB29.dpk
+
+
+ Microsoft Office 2000 Sample Automation Server Wrapper Components
+ Microsoft Office XP Sample Automation Server Wrapper Components
+
+
+
+ False
+ False
+ False
+ False
+ False
+ True
+ True
+
+
+ 12
+
+
+
+
diff --git a/LibD28/FMXfrxDB29.res b/LibD28/FMXfrxDB29.res
new file mode 100644
index 0000000..47f238f
Binary files /dev/null and b/LibD28/FMXfrxDB29.res differ
diff --git a/LibD28/FMXfrxDBX16.dpk b/LibD28/FMXfrxDBX16.dpk
new file mode 100644
index 0000000..610de33
--- /dev/null
+++ b/LibD28/FMXfrxDBX16.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi XE2
+
+package FMXfrxDBX16;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBEXPRESS,
+ DBXCDS,
+ FMXfrx16,
+{$IFDEF QBUILDER}
+ FMXfqb160,
+{$ENDIF}
+ FMXfrxDB16,
+ FMXfs16;
+
+contains
+ FMX.frxDBXComponents in 'FMX.frxDBXComponents.pas',
+ FMX.frxDBXEditor in 'FMX.frxDBXEditor.pas',
+ FMX.frxDBXRTTI in 'FMX.frxDBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxDBX16.res b/LibD28/FMXfrxDBX16.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxDBX16.res differ
diff --git a/LibD28/FMXfrxDBX17.dpk b/LibD28/FMXfrxDBX17.dpk
new file mode 100644
index 0000000..050d1b6
--- /dev/null
+++ b/LibD28/FMXfrxDBX17.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi XE3
+
+package FMXfrxDBX17;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBEXPRESS,
+ DBXCDS,
+ FMXfrx17,
+{$IFDEF QBUILDER}
+ FMXfqb170,
+{$ENDIF}
+ FMXfrxDB17,
+ FMXfs17;
+
+contains
+ FMX.frxDBXComponents in 'FMX.frxDBXComponents.pas',
+ FMX.frxDBXEditor in 'FMX.frxDBXEditor.pas',
+ FMX.frxDBXRTTI in 'FMX.frxDBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxDBX17.res b/LibD28/FMXfrxDBX17.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxDBX17.res differ
diff --git a/LibD28/FMXfrxDBX18.dpk b/LibD28/FMXfrxDBX18.dpk
new file mode 100644
index 0000000..0c122ce
--- /dev/null
+++ b/LibD28/FMXfrxDBX18.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi XE4
+
+package FMXfrxDBX18;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBEXPRESS,
+ DBXCDS,
+ FMXfrx18,
+{$IFDEF QBUILDER}
+ FMXfqb180,
+{$ENDIF}
+ FMXfrxDB18,
+ FMXfs18;
+
+contains
+ FMX.frxDBXComponents in 'FMX.frxDBXComponents.pas',
+ FMX.frxDBXEditor in 'FMX.frxDBXEditor.pas',
+ FMX.frxDBXRTTI in 'FMX.frxDBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxDBX18.res b/LibD28/FMXfrxDBX18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxDBX18.res differ
diff --git a/LibD28/FMXfrxDBX19.dpk b/LibD28/FMXfrxDBX19.dpk
new file mode 100644
index 0000000..956522b
--- /dev/null
+++ b/LibD28/FMXfrxDBX19.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi XE5
+
+package FMXfrxDBX19;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBEXPRESS,
+ DBXCDS,
+ FMXfrx19,
+{$IFDEF QBUILDER}
+ FMXfqb190,
+{$ENDIF}
+ FMXfrxDB19,
+ FMXfs19;
+
+contains
+ FMX.frxDBXComponents in 'FMX.frxDBXComponents.pas',
+ FMX.frxDBXEditor in 'FMX.frxDBXEditor.pas',
+ FMX.frxDBXRTTI in 'FMX.frxDBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxDBX19.res b/LibD28/FMXfrxDBX19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxDBX19.res differ
diff --git a/LibD28/FMXfrxDBX20.dpk b/LibD28/FMXfrxDBX20.dpk
new file mode 100644
index 0000000..29fc18c
--- /dev/null
+++ b/LibD28/FMXfrxDBX20.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi XE6
+
+package FMXfrxDBX20;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBEXPRESS,
+ DBXCDS,
+ FMXfrx20,
+{$IFDEF QBUILDER}
+ FMXfqb200,
+{$ENDIF}
+ FMXfrxDB20,
+ FMXfs20;
+
+contains
+ FMX.frxDBXComponents in 'FMX.frxDBXComponents.pas',
+ FMX.frxDBXEditor in 'FMX.frxDBXEditor.pas',
+ FMX.frxDBXRTTI in 'FMX.frxDBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxDBX20.res b/LibD28/FMXfrxDBX20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxDBX20.res differ
diff --git a/LibD28/FMXfrxDBX21.dpk b/LibD28/FMXfrxDBX21.dpk
new file mode 100644
index 0000000..dc57d23
--- /dev/null
+++ b/LibD28/FMXfrxDBX21.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi XE7
+
+package FMXfrxDBX21;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBEXPRESS,
+ DBXCDS,
+ FMXfrx21,
+{$IFDEF QBUILDER}
+ FMXfqb210,
+{$ENDIF}
+ FMXfrxDB21,
+ FMXfs21;
+
+contains
+ FMX.frxDBXComponents in 'FMX.frxDBXComponents.pas',
+ FMX.frxDBXEditor in 'FMX.frxDBXEditor.pas',
+ FMX.frxDBXRTTI in 'FMX.frxDBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxDBX21.res b/LibD28/FMXfrxDBX21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxDBX21.res differ
diff --git a/LibD28/FMXfrxDBX22.dpk b/LibD28/FMXfrxDBX22.dpk
new file mode 100644
index 0000000..7582caf
--- /dev/null
+++ b/LibD28/FMXfrxDBX22.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi XE8
+
+package FMXfrxDBX22;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBEXPRESS,
+ DBXCDS,
+ FMXfrx22,
+{$IFDEF QBUILDER}
+ FMXfqb220,
+{$ENDIF}
+ FMXfrxDB22,
+ FMXfs22;
+
+contains
+ FMX.frxDBXComponents in 'FMX.frxDBXComponents.pas',
+ FMX.frxDBXEditor in 'FMX.frxDBXEditor.pas',
+ FMX.frxDBXRTTI in 'FMX.frxDBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxDBX22.res b/LibD28/FMXfrxDBX22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxDBX22.res differ
diff --git a/LibD28/FMXfrxDBX23.dpk b/LibD28/FMXfrxDBX23.dpk
new file mode 100644
index 0000000..16d35e4
--- /dev/null
+++ b/LibD28/FMXfrxDBX23.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfrxDBX23;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBEXPRESS,
+ DBXCDS,
+ FMXfrx23,
+{$IFDEF QBUILDER}
+ FMXfqb230,
+{$ENDIF}
+ FMXfrxDB23,
+ FMXfs23;
+
+contains
+ FMX.frxDBXComponents in 'FMX.frxDBXComponents.pas',
+ FMX.frxDBXEditor in 'FMX.frxDBXEditor.pas',
+ FMX.frxDBXRTTI in 'FMX.frxDBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxDBX23.res b/LibD28/FMXfrxDBX23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxDBX23.res differ
diff --git a/LibD28/FMXfrxDBX24.dpk b/LibD28/FMXfrxDBX24.dpk
new file mode 100644
index 0000000..835ee55
--- /dev/null
+++ b/LibD28/FMXfrxDBX24.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfrxDBX24;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBEXPRESS,
+ DBXCDS,
+ FMXfrx24,
+{$IFDEF QBUILDER}
+ FMXfqb240,
+{$ENDIF}
+ FMXfrxDB24,
+ FMXfs24;
+
+contains
+ FMX.frxDBXComponents in 'FMX.frxDBXComponents.pas',
+ FMX.frxDBXEditor in 'FMX.frxDBXEditor.pas',
+ FMX.frxDBXRTTI in 'FMX.frxDBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxDBX24.res b/LibD28/FMXfrxDBX24.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxDBX24.res differ
diff --git a/LibD28/FMXfrxDBX25.dpk b/LibD28/FMXfrxDBX25.dpk
new file mode 100644
index 0000000..5f9716e
--- /dev/null
+++ b/LibD28/FMXfrxDBX25.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfrxDBX25;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBEXPRESS,
+ DBXCDS,
+ FMXfrx25,
+{$IFDEF QBUILDER}
+ FMXfqb250,
+{$ENDIF}
+ FMXfrxDB25,
+ FMXfs25;
+
+contains
+ FMX.frxDBXComponents in 'FMX.frxDBXComponents.pas',
+ FMX.frxDBXEditor in 'FMX.frxDBXEditor.pas',
+ FMX.frxDBXRTTI in 'FMX.frxDBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxDBX25.res b/LibD28/FMXfrxDBX25.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxDBX25.res differ
diff --git a/LibD28/FMXfrxDBX26.dpk b/LibD28/FMXfrxDBX26.dpk
new file mode 100644
index 0000000..2123aa4
--- /dev/null
+++ b/LibD28/FMXfrxDBX26.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfrxDBX26;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBEXPRESS,
+ DBXCDS,
+ FMXfrx26,
+{$IFDEF QBUILDER}
+ FMXfqb260,
+{$ENDIF}
+ FMXfrxDB26,
+ FMXfs26;
+
+contains
+ FMX.frxDBXComponents in 'FMX.frxDBXComponents.pas',
+ FMX.frxDBXEditor in 'FMX.frxDBXEditor.pas',
+ FMX.frxDBXRTTI in 'FMX.frxDBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxDBX27.dpk b/LibD28/FMXfrxDBX27.dpk
new file mode 100644
index 0000000..1cf7c6c
--- /dev/null
+++ b/LibD28/FMXfrxDBX27.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfrxDBX27;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBEXPRESS,
+ DBXCDS,
+ FMXfrx27,
+{$IFDEF QBUILDER}
+ FMXfqb270,
+{$ENDIF}
+ FMXfrxDB27,
+ FMXfs27;
+
+contains
+ FMX.frxDBXComponents in 'FMX.frxDBXComponents.pas',
+ FMX.frxDBXEditor in 'FMX.frxDBXEditor.pas',
+ FMX.frxDBXRTTI in 'FMX.frxDBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxDBX29.dpk b/LibD28/FMXfrxDBX29.dpk
new file mode 100644
index 0000000..6b3200f
--- /dev/null
+++ b/LibD28/FMXfrxDBX29.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi 12
+
+package FMXfrxDBX29;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBEXPRESS,
+ DBXCDS,
+ FMXfrx29,
+{$IFDEF QBUILDER}
+ FMXfqb290,
+{$ENDIF}
+ FMXfrxDB29,
+ FMXfs29;
+
+contains
+ FMX.frxDBXComponents in 'FMX.frxDBXComponents.pas',
+ FMX.frxDBXEditor in 'FMX.frxDBXEditor.pas',
+ FMX.frxDBXRTTI in 'FMX.frxDBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxDBX29.dproj b/LibD28/FMXfrxDBX29.dproj
new file mode 100644
index 0000000..b8f0429
--- /dev/null
+++ b/LibD28/FMXfrxDBX29.dproj
@@ -0,0 +1,145 @@
+
+
+ {B3E22744-DB93-4A25-A1D4-C0AB653C0B94}
+ FMXfrxDBX29.dpk
+ True
+ Release
+ 3
+ Package
+ None
+ 20.1
+ Win64
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Cfg_1
+ true
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ FMXfrxDBX29
+ 1
+ true
+ true
+ true
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+ 1033
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ D:\Delphi\Component\FastReport FMX 2.8.12 Pro Full Source\LibD28x64\
+ true
+ 1033
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ FMXfrxDBX29.dpk
+
+
+ Microsoft Office 2000 Sample Automation Server Wrapper Components
+ Microsoft Office XP Sample Automation Server Wrapper Components
+
+
+
+ False
+ False
+ False
+ False
+ False
+ True
+ True
+
+
+ 12
+
+
+
+
diff --git a/LibD28/FMXfrxDBX29.res b/LibD28/FMXfrxDBX29.res
new file mode 100644
index 0000000..09e7a6f
Binary files /dev/null and b/LibD28/FMXfrxDBX29.res differ
diff --git a/LibD28/FMXfrxDBXReg.dcr b/LibD28/FMXfrxDBXReg.dcr
new file mode 100644
index 0000000..413e70c
Binary files /dev/null and b/LibD28/FMXfrxDBXReg.dcr differ
diff --git a/LibD28/FMXfrxDBXReg.pas b/LibD28/FMXfrxDBXReg.pas
new file mode 100644
index 0000000..3b9f008
--- /dev/null
+++ b/LibD28/FMXfrxDBXReg.pas
@@ -0,0 +1,33 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ DBX components registration }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMXfrxDBXReg;
+
+interface
+
+{$I frx.inc}
+
+procedure Register;
+
+implementation
+
+uses
+ System.SysUtils, System.Classes, FMX.Controls
+, DesignIntf, DesignEditors
+, FMX.frxDBXComponents;
+
+procedure Register;
+begin
+ RegisterComponents('FastReport 2.0 FMX', [TfrxDBXComponents]);
+end;
+
+end.
diff --git a/LibD28/FMXfrxFD18.dpk b/LibD28/FMXfrxFD18.dpk
new file mode 100644
index 0000000..a28b179
--- /dev/null
+++ b/LibD28/FMXfrxFD18.dpk
@@ -0,0 +1,52 @@
+// Package file for Delphi XE4
+
+package FMXfrxFD18;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastReport FMX 2.0 FireDAC Components - Runtime Package'}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx,
+ dbrtl,
+ xmlrtl,
+ FMXfrx18,
+ FMXfsDB18,
+ FMXfrxDB18,
+ FireDAC,
+ FireDACCommon,
+ fmxFireDAC;
+
+contains
+ FMX.frxFDComponents in 'FMX.frxFDComponents.pas',
+ FMX.frxFDEditor in 'FMX.frxFDEditor.pas',
+ FMX.frxFDRTTI in 'FMX.frxFDRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxFD18.otares b/LibD28/FMXfrxFD18.otares
new file mode 100644
index 0000000..5e952b5
Binary files /dev/null and b/LibD28/FMXfrxFD18.otares differ
diff --git a/LibD28/FMXfrxFD18.res b/LibD28/FMXfrxFD18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxFD18.res differ
diff --git a/LibD28/FMXfrxFD19.dpk b/LibD28/FMXfrxFD19.dpk
new file mode 100644
index 0000000..c9d2fa6
--- /dev/null
+++ b/LibD28/FMXfrxFD19.dpk
@@ -0,0 +1,50 @@
+// Package file for Delphi XE5
+
+package FMXfrxFD19;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastReport FMX 2.0 FireDAC Components - Runtime Package'}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx,
+ dbrtl,
+ xmlrtl,
+ FMXfrx19,
+ FMXfsDB19,
+ FMXfrxDB19,
+ FireDAC,
+ FireDACCommon,
+ fmxFireDAC;
+
+contains
+ FMX.frxFDComponents in 'FMX.frxFDComponents.pas',
+ FMX.frxFDEditor in 'FMX.frxFDEditor.pas',
+ FMX.frxFDRTTI in 'FMX.frxFDRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxFD19.res b/LibD28/FMXfrxFD19.res
new file mode 100644
index 0000000..8b39f81
Binary files /dev/null and b/LibD28/FMXfrxFD19.res differ
diff --git a/LibD28/FMXfrxFD20.dpk b/LibD28/FMXfrxFD20.dpk
new file mode 100644
index 0000000..d300e26
--- /dev/null
+++ b/LibD28/FMXfrxFD20.dpk
@@ -0,0 +1,50 @@
+// Package file for Delphi XE6
+
+package FMXfrxFD20;
+
+{$R *.res}
+{$ALIGN 8}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastReport FMX 2.0 FireDAC Components - Runtime Package'}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx,
+ dbrtl,
+ xmlrtl,
+ FMXfrx20,
+ FMXfsDB20,
+ FMXfrxDB20,
+ FireDAC,
+ FireDACCommon,
+ fmxFireDAC;
+
+contains
+ FMX.frxFDComponents in 'FMX.frxFDComponents.pas',
+ FMX.frxFDEditor in 'FMX.frxFDEditor.pas',
+ FMX.frxFDRTTI in 'FMX.frxFDRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxFD20.res b/LibD28/FMXfrxFD20.res
new file mode 100644
index 0000000..8b39f81
Binary files /dev/null and b/LibD28/FMXfrxFD20.res differ
diff --git a/LibD28/FMXfrxFD21.dpk b/LibD28/FMXfrxFD21.dpk
new file mode 100644
index 0000000..a412601
--- /dev/null
+++ b/LibD28/FMXfrxFD21.dpk
@@ -0,0 +1,50 @@
+// Package file for Delphi XE7
+
+package FMXfrxFD21;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastReport FMX 2.0 FireDAC Components - Runtime Package'}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx,
+ dbrtl,
+ xmlrtl,
+ FMXfrx21,
+ FMXfsDB21,
+ FMXfrxDB21,
+ FireDAC,
+ FireDACCommon,
+ fmxFireDAC;
+
+contains
+ FMX.frxFDComponents in 'FMX.frxFDComponents.pas',
+ FMX.frxFDEditor in 'FMX.frxFDEditor.pas',
+ FMX.frxFDRTTI in 'FMX.frxFDRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxFD21.res b/LibD28/FMXfrxFD21.res
new file mode 100644
index 0000000..8b39f81
Binary files /dev/null and b/LibD28/FMXfrxFD21.res differ
diff --git a/LibD28/FMXfrxFD22.dpk b/LibD28/FMXfrxFD22.dpk
new file mode 100644
index 0000000..be877a2
--- /dev/null
+++ b/LibD28/FMXfrxFD22.dpk
@@ -0,0 +1,50 @@
+// Package file for Delphi XE8
+
+package FMXfrxFD22;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastReport FMX 2.0 FireDAC Components - Runtime Package'}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx,
+ dbrtl,
+ xmlrtl,
+ FMXfrx22,
+ FMXfsDB22,
+ FMXfrxDB22,
+ FireDAC,
+ FireDACCommon,
+ fmxFireDAC;
+
+contains
+ FMX.frxFDComponents in 'FMX.frxFDComponents.pas',
+ FMX.frxFDEditor in 'FMX.frxFDEditor.pas',
+ FMX.frxFDRTTI in 'FMX.frxFDRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxFD22.res b/LibD28/FMXfrxFD22.res
new file mode 100644
index 0000000..8b39f81
Binary files /dev/null and b/LibD28/FMXfrxFD22.res differ
diff --git a/LibD28/FMXfrxFD23.dpk b/LibD28/FMXfrxFD23.dpk
new file mode 100644
index 0000000..4d183ae
--- /dev/null
+++ b/LibD28/FMXfrxFD23.dpk
@@ -0,0 +1,50 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfrxFD23;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastReport FMX 2.0 FireDAC Components - Runtime Package'}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx,
+ dbrtl,
+ xmlrtl,
+ FMXfrx23,
+ FMXfsDB23,
+ FMXfrxDB23,
+ FireDAC,
+ FireDACCommon,
+ fmxFireDAC;
+
+contains
+ FMX.frxFDComponents in 'FMX.frxFDComponents.pas',
+ FMX.frxFDEditor in 'FMX.frxFDEditor.pas',
+ FMX.frxFDRTTI in 'FMX.frxFDRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxFD23.res b/LibD28/FMXfrxFD23.res
new file mode 100644
index 0000000..8b39f81
Binary files /dev/null and b/LibD28/FMXfrxFD23.res differ
diff --git a/LibD28/FMXfrxFD24.dpk b/LibD28/FMXfrxFD24.dpk
new file mode 100644
index 0000000..55f6f45
--- /dev/null
+++ b/LibD28/FMXfrxFD24.dpk
@@ -0,0 +1,50 @@
+// Package file for Delphi 10.1 Berlin
+
+package FMXfrxFD24;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastReport FMX 2.0 FireDAC Components - Runtime Package'}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx,
+ dbrtl,
+ xmlrtl,
+ FMXfrx24,
+ FMXfsDB24,
+ FMXfrxDB24,
+ FireDAC,
+ FireDACCommon,
+ fmxFireDAC;
+
+contains
+ FMX.frxFDComponents in 'FMX.frxFDComponents.pas',
+ FMX.frxFDEditor in 'FMX.frxFDEditor.pas',
+ FMX.frxFDRTTI in 'FMX.frxFDRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxFD24.res b/LibD28/FMXfrxFD24.res
new file mode 100644
index 0000000..8b39f81
Binary files /dev/null and b/LibD28/FMXfrxFD24.res differ
diff --git a/LibD28/FMXfrxFD25.dpk b/LibD28/FMXfrxFD25.dpk
new file mode 100644
index 0000000..4eb5811
--- /dev/null
+++ b/LibD28/FMXfrxFD25.dpk
@@ -0,0 +1,50 @@
+// Package file for Delphi 10.2 Tokyo
+
+package FMXfrxFD25;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastReport FMX 2.0 FireDAC Components - Runtime Package'}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx,
+ dbrtl,
+ xmlrtl,
+ FMXfrx25,
+ FMXfsDB25,
+ FMXfrxDB25,
+ FireDAC,
+ FireDACCommon,
+ fmxFireDAC;
+
+contains
+ FMX.frxFDComponents in 'FMX.frxFDComponents.pas',
+ FMX.frxFDEditor in 'FMX.frxFDEditor.pas',
+ FMX.frxFDRTTI in 'FMX.frxFDRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxFD25.res b/LibD28/FMXfrxFD25.res
new file mode 100644
index 0000000..8b39f81
Binary files /dev/null and b/LibD28/FMXfrxFD25.res differ
diff --git a/LibD28/FMXfrxFD26.dpk b/LibD28/FMXfrxFD26.dpk
new file mode 100644
index 0000000..e10e542
--- /dev/null
+++ b/LibD28/FMXfrxFD26.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi 10.3 Rio
+
+package FMXfrxFD26;
+
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastReport FMX 2.0 FireDAC Components - Runtime Package'}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx,
+ dbrtl,
+ xmlrtl,
+ FMXfrx26,
+ FMXfsDB26,
+ FMXfrxDB26,
+ FireDAC,
+ FireDACCommon,
+ fmxFireDAC;
+
+contains
+ FMX.frxFDComponents in 'FMX.frxFDComponents.pas',
+ FMX.frxFDEditor in 'FMX.frxFDEditor.pas',
+ FMX.frxFDRTTI in 'FMX.frxFDRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxFD27.dpk b/LibD28/FMXfrxFD27.dpk
new file mode 100644
index 0000000..822a3e6
--- /dev/null
+++ b/LibD28/FMXfrxFD27.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi 10.4 Sydney
+
+package FMXfrxFD27;
+
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastReport FMX 2.0 FireDAC Components - Runtime Package'}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx,
+ dbrtl,
+ xmlrtl,
+ FMXfrx27,
+ FMXfsDB27,
+ FMXfrxDB27,
+ FireDAC,
+ FireDACCommon,
+ fmxFireDAC;
+
+contains
+ FMX.frxFDComponents in 'FMX.frxFDComponents.pas',
+ FMX.frxFDEditor in 'FMX.frxFDEditor.pas',
+ FMX.frxFDRTTI in 'FMX.frxFDRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxFD29.dpk b/LibD28/FMXfrxFD29.dpk
new file mode 100644
index 0000000..70cf8bf
--- /dev/null
+++ b/LibD28/FMXfrxFD29.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi 12
+
+package FMXfrxFD29;
+
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastReport FMX 2.0 FireDAC Components - Runtime Package'}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx,
+ dbrtl,
+ xmlrtl,
+ FMXfrx29,
+ FMXfsDB29,
+ FMXfrxDB29,
+ FireDAC,
+ FireDACCommon,
+ fmxFireDAC;
+
+contains
+ FMX.frxFDComponents in 'FMX.frxFDComponents.pas',
+ FMX.frxFDEditor in 'FMX.frxFDEditor.pas',
+ FMX.frxFDRTTI in 'FMX.frxFDRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxFD29.dproj b/LibD28/FMXfrxFD29.dproj
new file mode 100644
index 0000000..001c38e
--- /dev/null
+++ b/LibD28/FMXfrxFD29.dproj
@@ -0,0 +1,135 @@
+
+
+ {59646BD9-E064-4CED-B55D-862A032C379D}
+ FMXfrxFD29.dpk
+ True
+ Release
+ 3
+ Package
+ None
+ 20.1
+ Win64
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Cfg_1
+ true
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ FMXfrxFD29
+ FastReport FMX 2.0 FireDAC Components - Runtime Package
+ true
+ true
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+ 1033
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ D:\Delphi\Component\FastReport FMX 2.8.12 Pro Full Source\LibD28x64\
+ true
+ 1033
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ FMXfrxFD29.dpk
+
+
+ Microsoft Office 2000 Sample Automation Server Wrapper Components
+ Microsoft Office XP Sample Automation Server Wrapper Components
+
+
+
+ False
+ False
+ False
+ False
+ False
+ True
+ True
+
+
+ 12
+
+
+
+
diff --git a/LibD28/FMXfrxFD29.res b/LibD28/FMXfrxFD29.res
new file mode 100644
index 0000000..95544c4
Binary files /dev/null and b/LibD28/FMXfrxFD29.res differ
diff --git a/LibD28/FMXfrxFDReg.dcr b/LibD28/FMXfrxFDReg.dcr
new file mode 100644
index 0000000..3909e01
Binary files /dev/null and b/LibD28/FMXfrxFDReg.dcr differ
diff --git a/LibD28/FMXfrxIBX16.dpk b/LibD28/FMXfrxIBX16.dpk
new file mode 100644
index 0000000..77f7f82
--- /dev/null
+++ b/LibD28/FMXfrxIBX16.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi XE2
+
+package FMXfrxIBX16;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ IBXPRESS,
+ FMXfrx16,
+{$IFDEF QBUILDER}
+ FMXfqb160,
+{$ENDIF}
+ FMXfrxDB16,
+ FMXfs16,
+ FMXfsIBX16;
+
+contains
+ FMX.frxIBXComponents in 'FMX.frxIBXComponents.pas',
+ FMX.frxIBXEditor in 'FMX.frxIBXEditor.pas',
+ FMX.frxIBXRTTI in 'FMX.frxIBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxIBX16.res b/LibD28/FMXfrxIBX16.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxIBX16.res differ
diff --git a/LibD28/FMXfrxIBX17.dpk b/LibD28/FMXfrxIBX17.dpk
new file mode 100644
index 0000000..3d92da1
--- /dev/null
+++ b/LibD28/FMXfrxIBX17.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi XE3
+
+package FMXfrxIBX17;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ IBXPRESS,
+ FMXfrx17,
+{$IFDEF QBUILDER}
+ FMXfqb170,
+{$ENDIF}
+ FMXfrxDB17,
+ FMXfs17,
+ FMXfsIBX17;
+
+contains
+ FMX.frxIBXComponents in 'FMX.frxIBXComponents.pas',
+ FMX.frxIBXEditor in 'FMX.frxIBXEditor.pas',
+ FMX.frxIBXRTTI in 'FMX.frxIBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxIBX17.res b/LibD28/FMXfrxIBX17.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxIBX17.res differ
diff --git a/LibD28/FMXfrxIBX18.dpk b/LibD28/FMXfrxIBX18.dpk
new file mode 100644
index 0000000..1f76402
--- /dev/null
+++ b/LibD28/FMXfrxIBX18.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi XE4
+
+package FMXfrxIBX18;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ IBXPRESS,
+ FMXfrx18,
+{$IFDEF QBUILDER}
+ FMXfqb180,
+{$ENDIF}
+ FMXfrxDB18,
+ FMXfs18,
+ FMXfsIBX18;
+
+contains
+ FMX.frxIBXComponents in 'FMX.frxIBXComponents.pas',
+ FMX.frxIBXEditor in 'FMX.frxIBXEditor.pas',
+ FMX.frxIBXRTTI in 'FMX.frxIBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxIBX18.res b/LibD28/FMXfrxIBX18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxIBX18.res differ
diff --git a/LibD28/FMXfrxIBX19.dpk b/LibD28/FMXfrxIBX19.dpk
new file mode 100644
index 0000000..07623bb
--- /dev/null
+++ b/LibD28/FMXfrxIBX19.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi XE5
+
+package FMXfrxIBX19;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ IBXPRESS,
+ FMXfrx19,
+{$IFDEF QBUILDER}
+ FMXfqb190,
+{$ENDIF}
+ FMXfrxDB19,
+ FMXfs19,
+ FMXfsIBX19;
+
+contains
+ FMX.frxIBXComponents in 'FMX.frxIBXComponents.pas',
+ FMX.frxIBXEditor in 'FMX.frxIBXEditor.pas',
+ FMX.frxIBXRTTI in 'FMX.frxIBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxIBX19.res b/LibD28/FMXfrxIBX19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxIBX19.res differ
diff --git a/LibD28/FMXfrxIBX20.dpk b/LibD28/FMXfrxIBX20.dpk
new file mode 100644
index 0000000..830267a
--- /dev/null
+++ b/LibD28/FMXfrxIBX20.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi XE6
+
+package FMXfrxIBX20;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ IBXPRESS,
+ FMXfrx20,
+{$IFDEF QBUILDER}
+ FMXfqb200,
+{$ENDIF}
+ FMXfrxDB20,
+ FMXfs20,
+ FMXfsIBX20;
+
+contains
+ FMX.frxIBXComponents in 'FMX.frxIBXComponents.pas',
+ FMX.frxIBXEditor in 'FMX.frxIBXEditor.pas',
+ FMX.frxIBXRTTI in 'FMX.frxIBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxIBX20.res b/LibD28/FMXfrxIBX20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxIBX20.res differ
diff --git a/LibD28/FMXfrxIBX21.dpk b/LibD28/FMXfrxIBX21.dpk
new file mode 100644
index 0000000..cae514f
--- /dev/null
+++ b/LibD28/FMXfrxIBX21.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi XE7
+
+package FMXfrxIBX21;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ IBXPRESS,
+ FMXfrx21,
+{$IFDEF QBUILDER}
+ FMXfqb210,
+{$ENDIF}
+ FMXfrxDB21,
+ FMXfs21,
+ FMXfsIBX21;
+
+contains
+ FMX.frxIBXComponents in 'FMX.frxIBXComponents.pas',
+ FMX.frxIBXEditor in 'FMX.frxIBXEditor.pas',
+ FMX.frxIBXRTTI in 'FMX.frxIBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxIBX21.res b/LibD28/FMXfrxIBX21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxIBX21.res differ
diff --git a/LibD28/FMXfrxIBX22.dpk b/LibD28/FMXfrxIBX22.dpk
new file mode 100644
index 0000000..c461fcd
--- /dev/null
+++ b/LibD28/FMXfrxIBX22.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi XE8
+
+package FMXfrxIBX22;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ IBXPRESS,
+ FMXfrx22,
+{$IFDEF QBUILDER}
+ FMXfqb220,
+{$ENDIF}
+ FMXfrxDB22,
+ FMXfs22,
+ FMXfsIBX22;
+
+contains
+ FMX.frxIBXComponents in 'FMX.frxIBXComponents.pas',
+ FMX.frxIBXEditor in 'FMX.frxIBXEditor.pas',
+ FMX.frxIBXRTTI in 'FMX.frxIBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxIBX22.res b/LibD28/FMXfrxIBX22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxIBX22.res differ
diff --git a/LibD28/FMXfrxIBX23.dpk b/LibD28/FMXfrxIBX23.dpk
new file mode 100644
index 0000000..9b95c0d
--- /dev/null
+++ b/LibD28/FMXfrxIBX23.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfrxIBX23;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ IBXPRESS,
+ FMXfrx23,
+{$IFDEF QBUILDER}
+ FMXfqb230,
+{$ENDIF}
+ FMXfrxDB23,
+ FMXfs23,
+ FMXfsIBX23;
+
+contains
+ FMX.frxIBXComponents in 'FMX.frxIBXComponents.pas',
+ FMX.frxIBXEditor in 'FMX.frxIBXEditor.pas',
+ FMX.frxIBXRTTI in 'FMX.frxIBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxIBX23.res b/LibD28/FMXfrxIBX23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxIBX23.res differ
diff --git a/LibD28/FMXfrxIBX24.dpk b/LibD28/FMXfrxIBX24.dpk
new file mode 100644
index 0000000..b791fad
--- /dev/null
+++ b/LibD28/FMXfrxIBX24.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfrxIBX24;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ IBXPRESS,
+ FMXfrx24,
+{$IFDEF QBUILDER}
+ FMXfqb240,
+{$ENDIF}
+ FMXfrxDB24,
+ FMXfs24,
+ FMXfsIBX24;
+
+contains
+ FMX.frxIBXComponents in 'FMX.frxIBXComponents.pas',
+ FMX.frxIBXEditor in 'FMX.frxIBXEditor.pas',
+ FMX.frxIBXRTTI in 'FMX.frxIBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxIBX24.res b/LibD28/FMXfrxIBX24.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxIBX24.res differ
diff --git a/LibD28/FMXfrxIBX25.dpk b/LibD28/FMXfrxIBX25.dpk
new file mode 100644
index 0000000..3ac69f7
--- /dev/null
+++ b/LibD28/FMXfrxIBX25.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfrxIBX25;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ IBXPRESS,
+ FMXfrx25,
+{$IFDEF QBUILDER}
+ FMXfqb250,
+{$ENDIF}
+ FMXfrxDB25,
+ FMXfs25,
+ FMXfsIBX25;
+
+contains
+ FMX.frxIBXComponents in 'FMX.frxIBXComponents.pas',
+ FMX.frxIBXEditor in 'FMX.frxIBXEditor.pas',
+ FMX.frxIBXRTTI in 'FMX.frxIBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxIBX25.res b/LibD28/FMXfrxIBX25.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxIBX25.res differ
diff --git a/LibD28/FMXfrxIBX26.dpk b/LibD28/FMXfrxIBX26.dpk
new file mode 100644
index 0000000..7d149f1
--- /dev/null
+++ b/LibD28/FMXfrxIBX26.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfrxIBX26;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ IBXPRESS,
+ FMXfrx26,
+{$IFDEF QBUILDER}
+ FMXfqb260,
+{$ENDIF}
+ FMXfrxDB26,
+ FMXfs26,
+ FMXfsIBX26;
+
+contains
+ FMX.frxIBXComponents in 'FMX.frxIBXComponents.pas',
+ FMX.frxIBXEditor in 'FMX.frxIBXEditor.pas',
+ FMX.frxIBXRTTI in 'FMX.frxIBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxIBX27.dpk b/LibD28/FMXfrxIBX27.dpk
new file mode 100644
index 0000000..963d3f4
--- /dev/null
+++ b/LibD28/FMXfrxIBX27.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfrxIBX27;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ IBXPRESS,
+ FMXfrx27,
+{$IFDEF QBUILDER}
+ FMXfqb270,
+{$ENDIF}
+ FMXfrxDB27,
+ FMXfs27,
+ FMXfsIBX27;
+
+contains
+ FMX.frxIBXComponents in 'FMX.frxIBXComponents.pas',
+ FMX.frxIBXEditor in 'FMX.frxIBXEditor.pas',
+ FMX.frxIBXRTTI in 'FMX.frxIBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxIBX28.dpk b/LibD28/FMXfrxIBX28.dpk
new file mode 100644
index 0000000..aeea6e0
--- /dev/null
+++ b/LibD28/FMXfrxIBX28.dpk
@@ -0,0 +1,47 @@
+// Package file for Delphi 11 Seattle
+
+package FMXfrxIBX28;
+
+
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ IBXPRESS,
+ FMXfrx28,
+{$IFDEF QBUILDER}
+ FMXfqb280,
+{$ENDIF}
+ FMXfrxDB28,
+ FMXfs28,
+ FMXfsIBX28;
+
+contains
+ FMX.frxIBXComponents in 'FMX.frxIBXComponents.pas',
+ FMX.frxIBXEditor in 'FMX.frxIBXEditor.pas',
+ FMX.frxIBXRTTI in 'FMX.frxIBXRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxIBXReg.dcr b/LibD28/FMXfrxIBXReg.dcr
new file mode 100644
index 0000000..2c1fbe2
Binary files /dev/null and b/LibD28/FMXfrxIBXReg.dcr differ
diff --git a/LibD28/FMXfrxIBXReg.pas b/LibD28/FMXfrxIBXReg.pas
new file mode 100644
index 0000000..ae3f6fb
--- /dev/null
+++ b/LibD28/FMXfrxIBXReg.pas
@@ -0,0 +1,34 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ IBX components registration }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMXfrxIBXReg;
+
+interface
+
+{$I frx.inc}
+{$I fmx.inc}
+
+procedure Register;
+
+implementation
+
+uses
+ System.SysUtils, System.Classes, FMX.Controls
+, DesignIntf, DesignEditors
+, FMX.frxIBXComponents;
+
+procedure Register;
+begin
+ RegisterComponents('FastReport 2.0 FMX', [TfrxIBXComponents]);
+end;
+
+end.
diff --git a/LibD28/FMXfrxReg.pas b/LibD28/FMXfrxReg.pas
new file mode 100644
index 0000000..e5f1c71
--- /dev/null
+++ b/LibD28/FMXfrxReg.pas
@@ -0,0 +1,148 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Registration unit }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMXfrxReg;
+
+{$I frx.inc}
+//{$I frxReg.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ System.SysUtils, System.Classes, System.Types, System.UITypes, FMX.Types, FMX.Controls, FMX.Forms,
+ DesignIntf, DesignEditors,
+ FMX.Dialogs, FMX.frxClass,
+ FMX.frxCtrls, FMX.frxDesgnCtrls,
+ FMX.frxDesgn, FMX.frxPreview, FMX.frxRes, FMX.frxFMX, FMX.frxEditAliases,
+{$IFNDEF RAD_ED}
+{$IFNDEF FR_VER_BASIC}
+ FMX.frxDCtrl,
+{$ENDIF}
+ FMX.frxCross, FMX.frxBarcode2DView, FMX.frxBarcode, FMX.frxChBox,
+{$ENDIF}
+FMX.frxGradient;
+
+{-----------------------------------------------------------------------}
+type
+ TfrxReportEditor = class(TComponentEditor)
+ procedure ExecuteVerb(Index: Integer); override;
+ function GetVerb(Index: Integer): String; override;
+ function GetVerbCount: Integer; override;
+ end;
+
+ TfrxDataSetEditor = class(TComponentEditor)
+ procedure ExecuteVerb(Index: Integer); override;
+ function GetVerb(Index: Integer): String; override;
+ function GetVerbCount: Integer; override;
+ end;
+
+
+{ TfrxReportEditor }
+
+procedure TfrxReportEditor.ExecuteVerb(Index: Integer);
+var
+ Report: TfrxReport;
+begin
+ Report := TfrxReport(Component);
+ if Report.Designer <> nil then
+ Report.Designer.BringToFront
+ else
+ begin
+ Report.DesignReport(Designer, Self);
+ if Report.StoreInDFM then
+ Designer.Modified;
+ end;
+end;
+
+function TfrxReportEditor.GetVerb(Index: Integer): String;
+begin
+ Result := 'Edit report';//frxResources.Get('rpEditRep');
+end;
+
+function TfrxReportEditor.GetVerbCount: Integer;
+begin
+ Result := 1;
+end;
+
+
+{ TfrxDataSetEditor }
+
+procedure TfrxDataSetEditor.ExecuteVerb(Index: Integer);
+begin
+ with TfrxAliasesEditorForm.Create(Application) do
+ begin
+ DataSet := TfrxCustomDBDataSet(Component);
+ FormShow(Self);
+ if ShowModal = mrOk then
+ Self.Designer.Modified;
+ Free;
+ end;
+end;
+
+function TfrxDataSetEditor.GetVerb(Index: Integer): String;
+begin
+ Result := frxResources.Get('rpEditAlias');
+end;
+
+function TfrxDataSetEditor.GetVerbCount: Integer;
+begin
+ Result := 1;
+end;
+
+
+{-----------------------------------------------------------------------}
+procedure Register;
+begin
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ RegisterComponents('FastReport 2.0 FMX',
+ [TfrxReport, TfrxUserDataset,
+{$IFNDEF RAD_ED}
+{$IFNDEF FR_VER_BASIC}
+ TfrxDesigner,
+{$ENDIF}
+{$ENDIF}
+ TfrxPreview
+{$IFNDEF RAD_ED}
+ , TfrxCrossObject,
+ TfrxGradientObject
+ , Tfrx2DBarCodeObject
+ , TfrxBarCodeObject
+ , TfrxCheckBoxObject
+{$IFNDEF FR_VER_BASIC}
+ , TfrxDialogControls
+{$ENDIF}
+{$ENDIF}
+ ]);
+ //GroupDescendentsWith(TfrxReport, TControl);
+ //GroupDescendentsWith(TfrxUserDataSet, TControl);
+ //GroupDescendentsWith(TfrxCrypt, TControl);
+ //GroupDescendentsWith(TfrxCheckBoxObject, TControl);
+ //GroupDescendentsWith(TfrxGradientObject, TControl);
+ //GroupDescendentsWith(TfrxGZipCompressor, TControl);
+ //GroupDescendentsWith(TfrxDotMatrixExport, TControl);
+ //GroupDescendentsWith(TfrxBarCodeObject, TControl);
+ RegisterComponents('FR FMX tools',
+ [TfrxToolButton]);
+ RegisterComponents('FR FMX tools',
+ [TfrxRuler, TfrxScrollBox, TfrxTreeView, TfrxListBox]);
+
+ RegisterComponentEditor(TfrxReport, TfrxReportEditor);
+ RegisterComponentEditor(TfrxCustomDBDataSet, TfrxDataSetEditor);
+end;
+
+end.
diff --git a/LibD28/FMXfrxRegCtrls.pas b/LibD28/FMXfrxRegCtrls.pas
new file mode 100644
index 0000000..ddb2c07
--- /dev/null
+++ b/LibD28/FMXfrxRegCtrls.pas
@@ -0,0 +1,37 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Registration unit }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMXfrxRegCtrls;
+
+{$I frx.inc}
+//{$I frxReg.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ System.SysUtils, System.Classes, FMX.Types, FMX.Controls, FMX.Forms, FMX.frxCtrls, FMX.frxFMX, FMX.frxDesgnCtrls;
+
+
+procedure Register;
+begin
+
+ RegisterComponents('FastReport FMX Controls 2.0',
+ [TfrxToolButton, TfrxToolSeparator, TfrxToolGrip, TfrxRuler, TfrxScrollBox, TfrxTreeView]);
+
+end;
+
+end.
diff --git a/LibD28/FMXfrxRegDB.pas b/LibD28/FMXfrxRegDB.pas
new file mode 100644
index 0000000..3c7e5a1
--- /dev/null
+++ b/LibD28/FMXfrxRegDB.pas
@@ -0,0 +1,38 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Registration unit }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMXfrxRegDB;
+
+{$I frx.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ System.SysUtils, System.Classes, FMX.Types, FMX.Forms, FMX.Controls,
+ DesignIntf, DesignEditors,
+ FMX.frxDBSet, FMX.frxCustomDB, FMX.frxCustomDBEditor, FMX.frxCustomDBRTTI, FMX.frxEditMD,
+ FMX.frxEditQueryParams;
+
+
+{-----------------------------------------------------------------------}
+procedure Register;
+begin
+ RegisterComponents('FastReport 2.0 FMX', [TfrxDBDataset]);
+ ///GroupDescendentsWith(TfrxDBDataset, TControl);
+end;
+
+end.
diff --git a/LibD28/FMXfrxRegTee.pas b/LibD28/FMXfrxRegTee.pas
new file mode 100644
index 0000000..365cea5
--- /dev/null
+++ b/LibD28/FMXfrxRegTee.pas
@@ -0,0 +1,37 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Registration unit }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMXfrxRegTee;
+
+{$I frx.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Controls, FMX.Forms, FMX.Types,
+ DesignIntf, DesignEditors,
+ FMX.frxChart;
+
+
+procedure Register;
+begin
+ RegisterComponents('FastReport 2.0 FMX',
+ [TfrxChartObject]);
+ //GroupDescendentsWith(TfrxChartObject, TControl);
+end;
+
+end.
diff --git a/LibD28/FMXfrxTee16.dpk b/LibD28/FMXfrxTee16.dpk
new file mode 100644
index 0000000..d90c8d8
--- /dev/null
+++ b/LibD28/FMXfrxTee16.dpk
@@ -0,0 +1,50 @@
+// Package file for Rad Studio XE2
+
+package FMXfrxTee16;
+{$I tee.inc}
+{$I fmx.inc}
+{$I frx.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+{$IFDEF TeeChartStd} FMXTEE, FMXTEEUI, {$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro916, FmxTeeUI916, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee916, FMXTEEUI916, {$ENDIF}
+ FMXfs16,
+ FMXfsTee16,
+ FMXfrx16;
+
+contains
+ FMX.frxChart in 'FMX.frxChart.pas',
+ FMX.frxChartEditor in 'FMX.frxChartEditor.pas',
+ FMX.frxChartGallery in 'FMX.frxChartGallery.pas',
+ FMX.frxChartHelpers in 'FMX.frxChartHelpers.pas',
+ FMX.frxChartRTTI in 'FMX.frxChartRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxTee16.otares b/LibD28/FMXfrxTee16.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxTee16.otares differ
diff --git a/LibD28/FMXfrxTee16.res b/LibD28/FMXfrxTee16.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxTee16.res differ
diff --git a/LibD28/FMXfrxTee17.dpk b/LibD28/FMXfrxTee17.dpk
new file mode 100644
index 0000000..dab49c0
--- /dev/null
+++ b/LibD28/FMXfrxTee17.dpk
@@ -0,0 +1,49 @@
+// Package file for Rad Studio XE3
+
+package FMXfrxTee17;
+{$I tee.inc}
+{$I fmx.inc}
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+{$IFDEF TeeChartStd} FMXTEE, FMXTEEUI, {$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro917, FmxTeeUI917, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee917, FMXTEEUI917, {$ENDIF}
+ FMXfs17,
+ FMXfsTee17,
+ FMXfrx17;
+
+contains
+ FMX.frxChart in 'FMX.frxChart.pas',
+ FMX.frxChartEditor in 'FMX.frxChartEditor.pas',
+ FMX.frxChartGallery in 'FMX.frxChartGallery.pas',
+ FMX.frxChartHelpers in 'FMX.frxChartHelpers.pas',
+ FMX.frxChartRTTI in 'FMX.frxChartRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxTee17.otares b/LibD28/FMXfrxTee17.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxTee17.otares differ
diff --git a/LibD28/FMXfrxTee17.res b/LibD28/FMXfrxTee17.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxTee17.res differ
diff --git a/LibD28/FMXfrxTee18.dpk b/LibD28/FMXfrxTee18.dpk
new file mode 100644
index 0000000..52517fb
--- /dev/null
+++ b/LibD28/FMXfrxTee18.dpk
@@ -0,0 +1,49 @@
+// Package file for Rad Studio XE4
+
+package FMXfrxTee18;
+{$I frx.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+{$IFDEF TeeChartStd} FMXTEE, FMXTEEUI, {$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro918, FmxTeeUI918, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee919, FMXTEEUI919, {$ENDIF}
+ FMXfs18,
+ FMXfsTee18,
+ FMXfrx18;
+
+
+contains
+ FMX.frxChart in 'FMX.frxChart.pas',
+ FMX.frxChartEditor in 'FMX.frxChartEditor.pas',
+ FMX.frxChartGallery in 'FMX.frxChartGallery.pas',
+ FMX.frxChartHelpers in 'FMX.frxChartHelpers.pas',
+ FMX.frxChartRTTI in 'FMX.frxChartRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxTee18.otares b/LibD28/FMXfrxTee18.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxTee18.otares differ
diff --git a/LibD28/FMXfrxTee18.res b/LibD28/FMXfrxTee18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxTee18.res differ
diff --git a/LibD28/FMXfrxTee19.dpk b/LibD28/FMXfrxTee19.dpk
new file mode 100644
index 0000000..992f92d
--- /dev/null
+++ b/LibD28/FMXfrxTee19.dpk
@@ -0,0 +1,50 @@
+// Package file for Rad Studio XE5
+
+package FMXfrxTee19;
+{$I tee.inc}
+{$I fmx.inc}
+{$I frx.inc}
+
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ FMXfs19,
+ FMXfsTee19,
+ FMXfrx19
+ {$IFDEF TeeChartStd} ,FMXTEE, FMXTEEUI {$ENDIF}
+{$IFDEF TeeChart9},FMXTeePro919, FmxTeeUI919 {$ENDIF}
+{$IFDEF TeeChartStd9},FMXTee919, FMXTEEUI919 {$ENDIF};
+
+contains
+ FMX.frxChart in 'FMX.frxChart.pas',
+ FMX.frxChartEditor in 'FMX.frxChartEditor.pas',
+ FMX.frxChartGallery in 'FMX.frxChartGallery.pas',
+ FMX.frxChartHelpers in 'FMX.frxChartHelpers.pas',
+ FMX.frxChartRTTI in 'FMX.frxChartRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxTee19.otares b/LibD28/FMXfrxTee19.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxTee19.otares differ
diff --git a/LibD28/FMXfrxTee19.res b/LibD28/FMXfrxTee19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxTee19.res differ
diff --git a/LibD28/FMXfrxTee20.dpk b/LibD28/FMXfrxTee20.dpk
new file mode 100644
index 0000000..71fad51
--- /dev/null
+++ b/LibD28/FMXfrxTee20.dpk
@@ -0,0 +1,49 @@
+// Package file for Rad Studio XE6
+
+package FMXfrxTee20;
+{$I tee.inc}
+{$I fmx.inc}
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+{$IFDEF TeeChartStd} FMXTEE, FMXTEEUI, {$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro920, FmxTeeUI920, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee920, FMXTEEUI920, {$ENDIF}
+ FMXfs20,
+ FMXfsTee20,
+ FMXfrx20;
+
+contains
+ FMX.frxChart in 'FMX.frxChart.pas',
+ FMX.frxChartEditor in 'FMX.frxChartEditor.pas',
+ FMX.frxChartGallery in 'FMX.frxChartGallery.pas',
+ FMX.frxChartHelpers in 'FMX.frxChartHelpers.pas',
+ FMX.frxChartRTTI in 'FMX.frxChartRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxTee20.otares b/LibD28/FMXfrxTee20.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxTee20.otares differ
diff --git a/LibD28/FMXfrxTee20.res b/LibD28/FMXfrxTee20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxTee20.res differ
diff --git a/LibD28/FMXfrxTee21.dpk b/LibD28/FMXfrxTee21.dpk
new file mode 100644
index 0000000..dd86626
--- /dev/null
+++ b/LibD28/FMXfrxTee21.dpk
@@ -0,0 +1,49 @@
+// Package file for Rad Studio XE7
+
+package FMXfrxTee21;
+{$I tee.inc}
+{$I fmx.inc}
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+{$IFDEF TeeChartStd} FMXTEE, FMXTEEUI, {$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro921, FmxTeeUI921, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee921, FMXTEEUI921, {$ENDIF}
+ FMXfs21,
+ FMXfsTee21,
+ FMXfrx21;
+
+contains
+ FMX.frxChart in 'FMX.frxChart.pas',
+ FMX.frxChartEditor in 'FMX.frxChartEditor.pas',
+ FMX.frxChartGallery in 'FMX.frxChartGallery.pas',
+ FMX.frxChartHelpers in 'FMX.frxChartHelpers.pas',
+ FMX.frxChartRTTI in 'FMX.frxChartRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxTee21.otares b/LibD28/FMXfrxTee21.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxTee21.otares differ
diff --git a/LibD28/FMXfrxTee21.res b/LibD28/FMXfrxTee21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxTee21.res differ
diff --git a/LibD28/FMXfrxTee22.dpk b/LibD28/FMXfrxTee22.dpk
new file mode 100644
index 0000000..2d0ddc9
--- /dev/null
+++ b/LibD28/FMXfrxTee22.dpk
@@ -0,0 +1,49 @@
+// Package file for Rad Studio XE8
+
+package FMXfrxTee22;
+{$I tee.inc}
+{$I fmx.inc}
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+{$IFDEF TeeChartStd} FMXTEE, FMXTEEUI, {$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro922, FmxTeeUI922, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee922, FMXTEEUI922, {$ENDIF}
+ FMXfs22,
+ FMXfsTee22,
+ FMXfrx22;
+
+contains
+ FMX.frxChart in 'FMX.frxChart.pas',
+ FMX.frxChartEditor in 'FMX.frxChartEditor.pas',
+ FMX.frxChartGallery in 'FMX.frxChartGallery.pas',
+ FMX.frxChartHelpers in 'FMX.frxChartHelpers.pas',
+ FMX.frxChartRTTI in 'FMX.frxChartRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxTee22.otares b/LibD28/FMXfrxTee22.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxTee22.otares differ
diff --git a/LibD28/FMXfrxTee22.res b/LibD28/FMXfrxTee22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxTee22.res differ
diff --git a/LibD28/FMXfrxTee23.dpk b/LibD28/FMXfrxTee23.dpk
new file mode 100644
index 0000000..2f264b7
--- /dev/null
+++ b/LibD28/FMXfrxTee23.dpk
@@ -0,0 +1,49 @@
+// Package file for Rad Studio 10 Seattle
+
+package FMXfrxTee23;
+{$I tee.inc}
+{$I fmx.inc}
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+{$IFDEF TeeChartStd} FMXTEE, FMXTEEUI, {$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro923, FmxTeeUI923, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee923, FMXTEEUI923, {$ENDIF}
+ FMXfs23,
+ FMXfsTee23,
+ FMXfrx23;
+
+contains
+ FMX.frxChart in 'FMX.frxChart.pas',
+ FMX.frxChartEditor in 'FMX.frxChartEditor.pas',
+ FMX.frxChartGallery in 'FMX.frxChartGallery.pas',
+ FMX.frxChartHelpers in 'FMX.frxChartHelpers.pas',
+ FMX.frxChartRTTI in 'FMX.frxChartRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxTee23.otares b/LibD28/FMXfrxTee23.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxTee23.otares differ
diff --git a/LibD28/FMXfrxTee23.res b/LibD28/FMXfrxTee23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxTee23.res differ
diff --git a/LibD28/FMXfrxTee24.dpk b/LibD28/FMXfrxTee24.dpk
new file mode 100644
index 0000000..e0d36ab
--- /dev/null
+++ b/LibD28/FMXfrxTee24.dpk
@@ -0,0 +1,49 @@
+// Package file for Rad Studio 10 Seattle
+
+package FMXfrxTee24;
+{$I tee.inc}
+{$I fmx.inc}
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+{$IFDEF TeeChartStd} FMXTEE, FMXTEEUI, {$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro924, FmxTeeUI924, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee924, FMXTEEUI924, {$ENDIF}
+ FMXfs24,
+ FMXfsTee24,
+ FMXfrx24;
+
+contains
+ FMX.frxChart in 'FMX.frxChart.pas',
+ FMX.frxChartEditor in 'FMX.frxChartEditor.pas',
+ FMX.frxChartGallery in 'FMX.frxChartGallery.pas',
+ FMX.frxChartHelpers in 'FMX.frxChartHelpers.pas',
+ FMX.frxChartRTTI in 'FMX.frxChartRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxTee24.dproj b/LibD28/FMXfrxTee24.dproj
new file mode 100644
index 0000000..ab2a0c4
--- /dev/null
+++ b/LibD28/FMXfrxTee24.dproj
@@ -0,0 +1,126 @@
+
+
+ {40BDE8CA-4DD6-4033-BBAA-27560FA2529C}
+ FMXfrxTee24.dpk
+ True
+ Debug
+ 1025
+ Package
+ None
+ 18.1
+ Win32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+ 00400000
+ true
+ false
+ 1049
+ false
+ 1
+ true
+ true
+ false
+ true
+ false
+ false
+ DEBUG;$(DCC_Define)
+ true
+ FMXfrxTee24
+ false
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+
+
+ 1033
+ true
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+
+
+ package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey=
+ Debug
+
+
+ 0
+ 0
+ RELEASE;$(DCC_Define)
+ false
+
+
+ false
+ true
+ DEBUG;$(DCC_Define)
+
+
+
+ MainSource
+
+
+
+
+
+
+
+
+
+
+
+
+ Cfg_2
+ Base
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ FMXfrxTee24.dpk
+
+
+
+ False
+ False
+ True
+ False
+ False
+ True
+ False
+
+
+ 12
+
+
+
+
diff --git a/LibD28/FMXfrxTee24.otares b/LibD28/FMXfrxTee24.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxTee24.otares differ
diff --git a/LibD28/FMXfrxTee24.res b/LibD28/FMXfrxTee24.res
new file mode 100644
index 0000000..982e23b
Binary files /dev/null and b/LibD28/FMXfrxTee24.res differ
diff --git a/LibD28/FMXfrxTee25.dpk b/LibD28/FMXfrxTee25.dpk
new file mode 100644
index 0000000..0d24941
--- /dev/null
+++ b/LibD28/FMXfrxTee25.dpk
@@ -0,0 +1,49 @@
+// Package file for Rad Studio 10 Seattle
+
+package FMXfrxTee25;
+{$I tee.inc}
+{$I fmx.inc}
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+{$IFDEF TeeChartStd} FMXTEE, FMXTEEUI, {$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro925, FmxTeeUI925, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee925, FMXTEEUI925, {$ENDIF}
+ FMXfs25,
+ FMXfsTee25,
+ FMXfrx25;
+
+contains
+ FMX.frxChart in 'FMX.frxChart.pas',
+ FMX.frxChartEditor in 'FMX.frxChartEditor.pas',
+ FMX.frxChartGallery in 'FMX.frxChartGallery.pas',
+ FMX.frxChartHelpers in 'FMX.frxChartHelpers.pas',
+ FMX.frxChartRTTI in 'FMX.frxChartRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxTee25.otares b/LibD28/FMXfrxTee25.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxTee25.otares differ
diff --git a/LibD28/FMXfrxTee25.res b/LibD28/FMXfrxTee25.res
new file mode 100644
index 0000000..982e23b
Binary files /dev/null and b/LibD28/FMXfrxTee25.res differ
diff --git a/LibD28/FMXfrxTee26.dpk b/LibD28/FMXfrxTee26.dpk
new file mode 100644
index 0000000..d446551
--- /dev/null
+++ b/LibD28/FMXfrxTee26.dpk
@@ -0,0 +1,49 @@
+// Package file for Rad Studio 10 Seattle
+
+package FMXfrxTee26;
+{$I tee.inc}
+{$I fmx.inc}
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+{$IFDEF TeeChartStd} FMXTEE, FMXTEEUI, {$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro926, FmxTeeUI926, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee926, FMXTEEUI926, {$ENDIF}
+ FMXfs26,
+ FMXfsTee26,
+ FMXfrx26;
+
+contains
+ FMX.frxChart in 'FMX.frxChart.pas',
+ FMX.frxChartEditor in 'FMX.frxChartEditor.pas',
+ FMX.frxChartGallery in 'FMX.frxChartGallery.pas',
+ FMX.frxChartHelpers in 'FMX.frxChartHelpers.pas',
+ FMX.frxChartRTTI in 'FMX.frxChartRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxTee27.dpk b/LibD28/FMXfrxTee27.dpk
new file mode 100644
index 0000000..ded6733
--- /dev/null
+++ b/LibD28/FMXfrxTee27.dpk
@@ -0,0 +1,49 @@
+// Package file for Rad Studio 10 Seattle
+
+package FMXfrxTee27;
+{$I tee.inc}
+{$I fmx.inc}
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+{$IFDEF TeeChartStd} FMXTEE, FMXTEEUI, {$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro927, FmxTeeUI927, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee927, FMXTEEUI927, {$ENDIF}
+ FMXfs27,
+ FMXfsTee27,
+ FMXfrx27;
+
+contains
+ FMX.frxChart in 'FMX.frxChart.pas',
+ FMX.frxChartEditor in 'FMX.frxChartEditor.pas',
+ FMX.frxChartGallery in 'FMX.frxChartGallery.pas',
+ FMX.frxChartHelpers in 'FMX.frxChartHelpers.pas',
+ FMX.frxChartRTTI in 'FMX.frxChartRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxTee28.dproj b/LibD28/FMXfrxTee28.dproj
new file mode 100644
index 0000000..938ffe4
--- /dev/null
+++ b/LibD28/FMXfrxTee28.dproj
@@ -0,0 +1,120 @@
+
+
+ {93FEEF9A-2286-4AA4-8B3C-019D80753BA2}
+ FMXfrxTee28.dpk
+ True
+ Debug
+ 1
+ Package
+ None
+ 20.1
+ Win32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ FMXfrxTee28
+ 1
+ false
+ true
+ DEBUG;$(DCC_Define)
+ true
+ true
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ FMXfrxTee28.dpk
+
+
+
+ False
+ False
+ False
+ False
+ False
+ True
+ False
+
+
+ 12
+
+
+
+
diff --git a/LibD28/FMXfrxTee29.dpk b/LibD28/FMXfrxTee29.dpk
new file mode 100644
index 0000000..11cc330
--- /dev/null
+++ b/LibD28/FMXfrxTee29.dpk
@@ -0,0 +1,49 @@
+// Package file for Rad Studio 12
+
+package FMXfrxTee29;
+{$I tee.inc}
+{$I fmx.inc}
+{$I frx.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+{$IFDEF TeeChartStd} FMXTEE, FMXTEEUI, {$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro929, FmxTeeUI929, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee929, FMXTEEUI929, {$ENDIF}
+ FMXfs29,
+ FMXfsTee29,
+ FMXfrx29;
+
+contains
+ FMX.frxChart in 'FMX.frxChart.pas',
+ FMX.frxChartEditor in 'FMX.frxChartEditor.pas',
+ FMX.frxChartGallery in 'FMX.frxChartGallery.pas',
+ FMX.frxChartHelpers in 'FMX.frxChartHelpers.pas',
+ FMX.frxChartRTTI in 'FMX.frxChartRTTI.pas';
+
+end.
diff --git a/LibD28/FMXfrxTee29.dproj b/LibD28/FMXfrxTee29.dproj
new file mode 100644
index 0000000..10dbe07
--- /dev/null
+++ b/LibD28/FMXfrxTee29.dproj
@@ -0,0 +1,148 @@
+
+
+ {06AA26BC-535E-435B-9E86-8A28C04C9904}
+ FMXfrxTee29.dpk
+ True
+ Release
+ 3
+ Package
+ None
+ 20.1
+ Win64
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Cfg_1
+ true
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ FMXfrxTee29
+ 1
+ false
+ true
+ DEBUG;$(DCC_Define)
+ true
+ true
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+ 1033
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ D:\Delphi\Component\FastReport FMX 2.8.12 Pro Full Source\LibD28x64\
+ true
+ 1033
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ FMXfrxTee29.dpk
+
+
+ Microsoft Office 2000 Sample Automation Server Wrapper Components
+ Microsoft Office XP Sample Automation Server Wrapper Components
+
+
+
+ False
+ False
+ False
+ False
+ False
+ True
+ True
+
+
+ 12
+
+
+
+
diff --git a/LibD28/FMXfrxTee29.res b/LibD28/FMXfrxTee29.res
new file mode 100644
index 0000000..f755c01
Binary files /dev/null and b/LibD28/FMXfrxTee29.res differ
diff --git a/LibD28/FMXfrxe16.dpk b/LibD28/FMXfrxe16.dpk
new file mode 100644
index 0000000..6d01993
--- /dev/null
+++ b/LibD28/FMXfrxe16.dpk
@@ -0,0 +1,71 @@
+// Package file for Rad Studio XE2
+
+package FMXfrxe16;
+
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfrx16;
+
+contains
+ FMX.frxExportHTML in 'FMX.frxExportHTML.pas',
+ FMX.frxExportImage in 'FMX.frxExportImage.pas',
+ FMX.frxImageConverter in 'FMX.frxImageConverter.pas',
+ FMX.frxExportMatrix in 'FMX.frxExportMatrix.pas',
+ FMX.frxExportRTF in 'FMX.frxExportRTF.pas',
+ FMX.frxExportText in 'FMX.frxExportText.pas',
+ FMX.frxExportXML in 'FMX.frxExportXML.pas',
+ FMX.frxRC4 in 'FMX.frxRC4.pas',
+ FMX.frxCmapTableClass in 'FMX.frxCmapTableClass.pas',
+ FMX.frxGlyphTableClass in 'FMX.frxGlyphTableClass.pas',
+ FMX.frxGlyphSubstitutionClass in 'FMX.frxGlyphSubstitutionClass.pas',
+ FMX.frxHorizontalHeaderClass in 'FMX.frxHorizontalHeaderClass.pas',
+ FMX.frxHorizontalMetrixClass in 'FMX.frxHorizontalMetrixClass.pas',
+ FMX.frxIndexToLocationClass in 'FMX.frxIndexToLocationClass.pas',
+ FMX.frxKerningTableClass in 'FMX.frxKerningTableClass.pas',
+ FMX.frxPostScriptClass in 'FMX.frxPostScriptClass.pas',
+ FMX.frxMaximumProfileClass in 'FMX.frxMaximumProfileClass.pas',
+ FMX.frxOS2WindowsMetricsClass in 'FMX.frxOS2WindowsMetricsClass.pas',
+ FMX.frxPreProgramClass in 'FMX.frxPreProgramClass.pas',
+ FMX.frxTrueTypeFont in 'FMX.frxTrueTypeFont.pas',
+ FMX.frxFontHeaderClass in 'FMX.frxFontHeaderClass.pas',
+ FMX.TTFHelpers in 'FMX.TTFHelpers.pas',
+ FMX.frxTrueTypeTable in 'FMX.frxTrueTypeTable.pas',
+ FMX.frxNameTableClass in 'FMX.frxNameTableClass.pas',
+ FMX.frxmd5 in 'FMX.frxmd5.pas',
+ FMX.frxCrypto in 'FMX.frxCrypto.pas',
+ FMX.frxTrueTypeCollection in 'FMX.frxTrueTypeCollection.pas',
+ FMX.frxExportPDF in 'FMX.frxExportPDF.pas',
+ FMX.frxExportCSV in 'FMX.frxExportCSV.pas',
+ FMX.frxrcExports in 'FMX.frxrcExports.pas',
+ FMX.frxExportODF in 'FMX.frxExportODF.pas';
+end.
diff --git a/LibD28/FMXfrxe16.otares b/LibD28/FMXfrxe16.otares
new file mode 100644
index 0000000..93e7e94
Binary files /dev/null and b/LibD28/FMXfrxe16.otares differ
diff --git a/LibD28/FMXfrxe16.res b/LibD28/FMXfrxe16.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxe16.res differ
diff --git a/LibD28/FMXfrxe17.dpk b/LibD28/FMXfrxe17.dpk
new file mode 100644
index 0000000..cdaced3
--- /dev/null
+++ b/LibD28/FMXfrxe17.dpk
@@ -0,0 +1,72 @@
+// Package file for Rad Studio XE3
+
+package FMXfrxe17;
+
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfrx17;
+
+contains
+ FMX.frxExportHTML in 'FMX.frxExportHTML.pas',
+ FMX.frxExportImage in 'FMX.frxExportImage.pas',
+ FMX.frxImageConverter in 'FMX.frxImageConverter.pas',
+ FMX.frxExportMatrix in 'FMX.frxExportMatrix.pas',
+ FMX.frxExportRTF in 'FMX.frxExportRTF.pas',
+ FMX.frxExportText in 'FMX.frxExportText.pas',
+ FMX.frxExportXML in 'FMX.frxExportXML.pas',
+ FMX.frxRC4 in 'FMX.frxRC4.pas',
+ FMX.frxCmapTableClass in 'FMX.frxCmapTableClass.pas',
+ FMX.frxGlyphTableClass in 'FMX.frxGlyphTableClass.pas',
+ FMX.frxGlyphSubstitutionClass in 'FMX.frxGlyphSubstitutionClass.pas',
+ FMX.frxHorizontalHeaderClass in 'FMX.frxHorizontalHeaderClass.pas',
+ FMX.frxHorizontalMetrixClass in 'FMX.frxHorizontalMetrixClass.pas',
+ FMX.frxIndexToLocationClass in 'FMX.frxIndexToLocationClass.pas',
+ FMX.frxKerningTableClass in 'FMX.frxKerningTableClass.pas',
+ FMX.frxPostScriptClass in 'FMX.frxPostScriptClass.pas',
+ FMX.frxMaximumProfileClass in 'FMX.frxMaximumProfileClass.pas',
+ FMX.frxOS2WindowsMetricsClass in 'FMX.frxOS2WindowsMetricsClass.pas',
+ FMX.frxPreProgramClass in 'FMX.frxPreProgramClass.pas',
+ FMX.frxTrueTypeFont in 'FMX.frxTrueTypeFont.pas',
+ FMX.frxFontHeaderClass in 'FMX.frxFontHeaderClass.pas',
+ FMX.TTFHelpers in 'FMX.TTFHelpers.pas',
+ FMX.frxTrueTypeTable in 'FMX.frxTrueTypeTable.pas',
+ FMX.frxNameTableClass in 'FMX.frxNameTableClass.pas',
+ FMX.frxmd5 in 'FMX.frxmd5.pas',
+ FMX.frxCrypto in 'FMX.frxCrypto.pas',
+ FMX.frxTrueTypeCollection in 'FMX.frxTrueTypeCollection.pas',
+ FMX.frxExportPDF in 'FMX.frxExportPDF.pas',
+ FMX.frxExportCSV in 'FMX.frxExportCSV.pas',
+ FMX.frxrcExports in 'FMX.frxrcExports.pas',
+ FMX.frxExportODF in 'FMX.frxExportODF.pas';
+
+end.
diff --git a/LibD28/FMXfrxe17.otares b/LibD28/FMXfrxe17.otares
new file mode 100644
index 0000000..93e7e94
Binary files /dev/null and b/LibD28/FMXfrxe17.otares differ
diff --git a/LibD28/FMXfrxe17.res b/LibD28/FMXfrxe17.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxe17.res differ
diff --git a/LibD28/FMXfrxe18.dpk b/LibD28/FMXfrxe18.dpk
new file mode 100644
index 0000000..2a99fa1
--- /dev/null
+++ b/LibD28/FMXfrxe18.dpk
@@ -0,0 +1,71 @@
+// Package file for Rad Studio XE4
+
+package FMXfrxe18;
+
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfrx18;
+
+contains
+ FMX.frxExportHTML in 'FMX.frxExportHTML.pas',
+ FMX.frxExportImage in 'FMX.frxExportImage.pas',
+ FMX.frxImageConverter in 'FMX.frxImageConverter.pas',
+ FMX.frxExportMatrix in 'FMX.frxExportMatrix.pas',
+ FMX.frxExportRTF in 'FMX.frxExportRTF.pas',
+ FMX.frxExportText in 'FMX.frxExportText.pas',
+ FMX.frxExportXML in 'FMX.frxExportXML.pas',
+ FMX.frxRC4 in 'FMX.frxRC4.pas',
+ FMX.frxCmapTableClass in 'FMX.frxCmapTableClass.pas',
+ FMX.frxGlyphTableClass in 'FMX.frxGlyphTableClass.pas',
+ FMX.frxGlyphSubstitutionClass in 'FMX.frxGlyphSubstitutionClass.pas',
+ FMX.frxHorizontalHeaderClass in 'FMX.frxHorizontalHeaderClass.pas',
+ FMX.frxHorizontalMetrixClass in 'FMX.frxHorizontalMetrixClass.pas',
+ FMX.frxIndexToLocationClass in 'FMX.frxIndexToLocationClass.pas',
+ FMX.frxKerningTableClass in 'FMX.frxKerningTableClass.pas',
+ FMX.frxPostScriptClass in 'FMX.frxPostScriptClass.pas',
+ FMX.frxMaximumProfileClass in 'FMX.frxMaximumProfileClass.pas',
+ FMX.frxOS2WindowsMetricsClass in 'FMX.frxOS2WindowsMetricsClass.pas',
+ FMX.frxPreProgramClass in 'FMX.frxPreProgramClass.pas',
+ FMX.frxTrueTypeFont in 'FMX.frxTrueTypeFont.pas',
+ FMX.frxFontHeaderClass in 'FMX.frxFontHeaderClass.pas',
+ FMX.TTFHelpers in 'FMX.TTFHelpers.pas',
+ FMX.frxTrueTypeTable in 'FMX.frxTrueTypeTable.pas',
+ FMX.frxNameTableClass in 'FMX.frxNameTableClass.pas',
+ FMX.frxmd5 in 'FMX.frxmd5.pas',
+ FMX.frxCrypto in 'FMX.frxCrypto.pas',
+ FMX.frxTrueTypeCollection in 'FMX.frxTrueTypeCollection.pas',
+ FMX.frxExportPDF in 'FMX.frxExportPDF.pas',
+ FMX.frxExportCSV in 'FMX.frxExportCSV.pas',
+ FMX.frxrcExports in 'FMX.frxrcExports.pas',
+ FMX.frxExportODF in 'FMX.frxExportODF.pas';
+end.
diff --git a/LibD28/FMXfrxe18.otares b/LibD28/FMXfrxe18.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxe18.otares differ
diff --git a/LibD28/FMXfrxe18.res b/LibD28/FMXfrxe18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxe18.res differ
diff --git a/LibD28/FMXfrxe19.dpk b/LibD28/FMXfrxe19.dpk
new file mode 100644
index 0000000..913057a
--- /dev/null
+++ b/LibD28/FMXfrxe19.dpk
@@ -0,0 +1,72 @@
+// Package file for Rad Studio XE5
+
+package FMXfrxe19;
+
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfrx19;
+
+contains
+ FMX.frxExportHTML in 'FMX.frxExportHTML.pas',
+ FMX.frxExportImage in 'FMX.frxExportImage.pas',
+ FMX.frxImageConverter in 'FMX.frxImageConverter.pas',
+ FMX.frxExportMatrix in 'FMX.frxExportMatrix.pas',
+ FMX.frxExportRTF in 'FMX.frxExportRTF.pas',
+ FMX.frxExportText in 'FMX.frxExportText.pas',
+ FMX.frxExportXML in 'FMX.frxExportXML.pas',
+ FMX.frxRC4 in 'FMX.frxRC4.pas',
+ FMX.frxCmapTableClass in 'FMX.frxCmapTableClass.pas',
+ FMX.frxGlyphTableClass in 'FMX.frxGlyphTableClass.pas',
+ FMX.frxGlyphSubstitutionClass in 'FMX.frxGlyphSubstitutionClass.pas',
+ FMX.frxHorizontalHeaderClass in 'FMX.frxHorizontalHeaderClass.pas',
+ FMX.frxHorizontalMetrixClass in 'FMX.frxHorizontalMetrixClass.pas',
+ FMX.frxIndexToLocationClass in 'FMX.frxIndexToLocationClass.pas',
+ FMX.frxKerningTableClass in 'FMX.frxKerningTableClass.pas',
+ FMX.frxPostScriptClass in 'FMX.frxPostScriptClass.pas',
+ FMX.frxMaximumProfileClass in 'FMX.frxMaximumProfileClass.pas',
+ FMX.frxOS2WindowsMetricsClass in 'FMX.frxOS2WindowsMetricsClass.pas',
+ FMX.frxPreProgramClass in 'FMX.frxPreProgramClass.pas',
+ FMX.frxTrueTypeFont in 'FMX.frxTrueTypeFont.pas',
+ FMX.frxFontHeaderClass in 'FMX.frxFontHeaderClass.pas',
+ FMX.TTFHelpers in 'FMX.TTFHelpers.pas',
+ FMX.frxTrueTypeTable in 'FMX.frxTrueTypeTable.pas',
+ FMX.frxNameTableClass in 'FMX.frxNameTableClass.pas',
+ FMX.frxmd5 in 'FMX.frxmd5.pas',
+ FMX.frxCrypto in 'FMX.frxCrypto.pas',
+ FMX.frxTrueTypeCollection in 'FMX.frxTrueTypeCollection.pas',
+ FMX.frxExportPDF in 'FMX.frxExportPDF.pas',
+ FMX.frxExportCSV in 'FMX.frxExportCSV.pas',
+ FMX.frxrcExports in 'FMX.frxrcExports.pas',
+ FMX.frxExportODF in 'FMX.frxExportODF.pas';
+
+end.
diff --git a/LibD28/FMXfrxe19.otares b/LibD28/FMXfrxe19.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxe19.otares differ
diff --git a/LibD28/FMXfrxe19.res b/LibD28/FMXfrxe19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxe19.res differ
diff --git a/LibD28/FMXfrxe20.dpk b/LibD28/FMXfrxe20.dpk
new file mode 100644
index 0000000..b5b969c
--- /dev/null
+++ b/LibD28/FMXfrxe20.dpk
@@ -0,0 +1,72 @@
+// Package file for Rad Studio XE6
+
+package FMXfrxe20;
+
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfrx20;
+
+contains
+ FMX.frxExportHTML in 'FMX.frxExportHTML.pas',
+ FMX.frxExportImage in 'FMX.frxExportImage.pas',
+ FMX.frxImageConverter in 'FMX.frxImageConverter.pas',
+ FMX.frxExportMatrix in 'FMX.frxExportMatrix.pas',
+ FMX.frxExportRTF in 'FMX.frxExportRTF.pas',
+ FMX.frxExportText in 'FMX.frxExportText.pas',
+ FMX.frxExportXML in 'FMX.frxExportXML.pas',
+ FMX.frxRC4 in 'FMX.frxRC4.pas',
+ FMX.frxCmapTableClass in 'FMX.frxCmapTableClass.pas',
+ FMX.frxGlyphTableClass in 'FMX.frxGlyphTableClass.pas',
+ FMX.frxGlyphSubstitutionClass in 'FMX.frxGlyphSubstitutionClass.pas',
+ FMX.frxHorizontalHeaderClass in 'FMX.frxHorizontalHeaderClass.pas',
+ FMX.frxHorizontalMetrixClass in 'FMX.frxHorizontalMetrixClass.pas',
+ FMX.frxIndexToLocationClass in 'FMX.frxIndexToLocationClass.pas',
+ FMX.frxKerningTableClass in 'FMX.frxKerningTableClass.pas',
+ FMX.frxPostScriptClass in 'FMX.frxPostScriptClass.pas',
+ FMX.frxMaximumProfileClass in 'FMX.frxMaximumProfileClass.pas',
+ FMX.frxOS2WindowsMetricsClass in 'FMX.frxOS2WindowsMetricsClass.pas',
+ FMX.frxPreProgramClass in 'FMX.frxPreProgramClass.pas',
+ FMX.frxTrueTypeFont in 'FMX.frxTrueTypeFont.pas',
+ FMX.frxFontHeaderClass in 'FMX.frxFontHeaderClass.pas',
+ FMX.TTFHelpers in 'FMX.TTFHelpers.pas',
+ FMX.frxTrueTypeTable in 'FMX.frxTrueTypeTable.pas',
+ FMX.frxNameTableClass in 'FMX.frxNameTableClass.pas',
+ FMX.frxmd5 in 'FMX.frxmd5.pas',
+ FMX.frxCrypto in 'FMX.frxCrypto.pas',
+ FMX.frxTrueTypeCollection in 'FMX.frxTrueTypeCollection.pas',
+ FMX.frxExportPDF in 'FMX.frxExportPDF.pas',
+ FMX.frxExportCSV in 'FMX.frxExportCSV.pas',
+ FMX.frxrcExports in 'FMX.frxrcExports.pas',
+ FMX.frxExportODF in 'FMX.frxExportODF.pas';
+
+end.
diff --git a/LibD28/FMXfrxe20.otares b/LibD28/FMXfrxe20.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxe20.otares differ
diff --git a/LibD28/FMXfrxe20.res b/LibD28/FMXfrxe20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxe20.res differ
diff --git a/LibD28/FMXfrxe21.dpk b/LibD28/FMXfrxe21.dpk
new file mode 100644
index 0000000..993d955
--- /dev/null
+++ b/LibD28/FMXfrxe21.dpk
@@ -0,0 +1,72 @@
+// Package file for Rad Studio XE7
+
+package FMXfrxe21;
+
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfrx21;
+
+contains
+ FMX.frxExportHTML in 'FMX.frxExportHTML.pas',
+ FMX.frxExportImage in 'FMX.frxExportImage.pas',
+ FMX.frxImageConverter in 'FMX.frxImageConverter.pas',
+ FMX.frxExportMatrix in 'FMX.frxExportMatrix.pas',
+ FMX.frxExportRTF in 'FMX.frxExportRTF.pas',
+ FMX.frxExportText in 'FMX.frxExportText.pas',
+ FMX.frxExportXML in 'FMX.frxExportXML.pas',
+ FMX.frxRC4 in 'FMX.frxRC4.pas',
+ FMX.frxCmapTableClass in 'FMX.frxCmapTableClass.pas',
+ FMX.frxGlyphTableClass in 'FMX.frxGlyphTableClass.pas',
+ FMX.frxGlyphSubstitutionClass in 'FMX.frxGlyphSubstitutionClass.pas',
+ FMX.frxHorizontalHeaderClass in 'FMX.frxHorizontalHeaderClass.pas',
+ FMX.frxHorizontalMetrixClass in 'FMX.frxHorizontalMetrixClass.pas',
+ FMX.frxIndexToLocationClass in 'FMX.frxIndexToLocationClass.pas',
+ FMX.frxKerningTableClass in 'FMX.frxKerningTableClass.pas',
+ FMX.frxPostScriptClass in 'FMX.frxPostScriptClass.pas',
+ FMX.frxMaximumProfileClass in 'FMX.frxMaximumProfileClass.pas',
+ FMX.frxOS2WindowsMetricsClass in 'FMX.frxOS2WindowsMetricsClass.pas',
+ FMX.frxPreProgramClass in 'FMX.frxPreProgramClass.pas',
+ FMX.frxTrueTypeFont in 'FMX.frxTrueTypeFont.pas',
+ FMX.frxFontHeaderClass in 'FMX.frxFontHeaderClass.pas',
+ FMX.TTFHelpers in 'FMX.TTFHelpers.pas',
+ FMX.frxTrueTypeTable in 'FMX.frxTrueTypeTable.pas',
+ FMX.frxNameTableClass in 'FMX.frxNameTableClass.pas',
+ FMX.frxmd5 in 'FMX.frxmd5.pas',
+ FMX.frxCrypto in 'FMX.frxCrypto.pas',
+ FMX.frxTrueTypeCollection in 'FMX.frxTrueTypeCollection.pas',
+ FMX.frxExportPDF in 'FMX.frxExportPDF.pas',
+ FMX.frxExportCSV in 'FMX.frxExportCSV.pas',
+ FMX.frxrcExports in 'FMX.frxrcExports.pas',
+ FMX.frxExportODF in 'FMX.frxExportODF.pas';
+
+end.
diff --git a/LibD28/FMXfrxe21.otares b/LibD28/FMXfrxe21.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxe21.otares differ
diff --git a/LibD28/FMXfrxe21.res b/LibD28/FMXfrxe21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxe21.res differ
diff --git a/LibD28/FMXfrxe22.dpk b/LibD28/FMXfrxe22.dpk
new file mode 100644
index 0000000..2fb6663
--- /dev/null
+++ b/LibD28/FMXfrxe22.dpk
@@ -0,0 +1,72 @@
+// Package file for Rad Studio XE8
+
+package FMXfrxe22;
+
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfrx22;
+
+contains
+ FMX.frxExportHTML in 'FMX.frxExportHTML.pas',
+ FMX.frxExportImage in 'FMX.frxExportImage.pas',
+ FMX.frxImageConverter in 'FMX.frxImageConverter.pas',
+ FMX.frxExportMatrix in 'FMX.frxExportMatrix.pas',
+ FMX.frxExportRTF in 'FMX.frxExportRTF.pas',
+ FMX.frxExportText in 'FMX.frxExportText.pas',
+ FMX.frxExportXML in 'FMX.frxExportXML.pas',
+ FMX.frxRC4 in 'FMX.frxRC4.pas',
+ FMX.frxCmapTableClass in 'FMX.frxCmapTableClass.pas',
+ FMX.frxGlyphTableClass in 'FMX.frxGlyphTableClass.pas',
+ FMX.frxGlyphSubstitutionClass in 'FMX.frxGlyphSubstitutionClass.pas',
+ FMX.frxHorizontalHeaderClass in 'FMX.frxHorizontalHeaderClass.pas',
+ FMX.frxHorizontalMetrixClass in 'FMX.frxHorizontalMetrixClass.pas',
+ FMX.frxIndexToLocationClass in 'FMX.frxIndexToLocationClass.pas',
+ FMX.frxKerningTableClass in 'FMX.frxKerningTableClass.pas',
+ FMX.frxPostScriptClass in 'FMX.frxPostScriptClass.pas',
+ FMX.frxMaximumProfileClass in 'FMX.frxMaximumProfileClass.pas',
+ FMX.frxOS2WindowsMetricsClass in 'FMX.frxOS2WindowsMetricsClass.pas',
+ FMX.frxPreProgramClass in 'FMX.frxPreProgramClass.pas',
+ FMX.frxTrueTypeFont in 'FMX.frxTrueTypeFont.pas',
+ FMX.frxFontHeaderClass in 'FMX.frxFontHeaderClass.pas',
+ FMX.TTFHelpers in 'FMX.TTFHelpers.pas',
+ FMX.frxTrueTypeTable in 'FMX.frxTrueTypeTable.pas',
+ FMX.frxNameTableClass in 'FMX.frxNameTableClass.pas',
+ FMX.frxmd5 in 'FMX.frxmd5.pas',
+ FMX.frxCrypto in 'FMX.frxCrypto.pas',
+ FMX.frxTrueTypeCollection in 'FMX.frxTrueTypeCollection.pas',
+ FMX.frxExportPDF in 'FMX.frxExportPDF.pas',
+ FMX.frxExportCSV in 'FMX.frxExportCSV.pas',
+ FMX.frxrcExports in 'FMX.frxrcExports.pas',
+ FMX.frxExportODF in 'FMX.frxExportODF.pas';
+
+end.
diff --git a/LibD28/FMXfrxe22.otares b/LibD28/FMXfrxe22.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxe22.otares differ
diff --git a/LibD28/FMXfrxe22.res b/LibD28/FMXfrxe22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxe22.res differ
diff --git a/LibD28/FMXfrxe23.dpk b/LibD28/FMXfrxe23.dpk
new file mode 100644
index 0000000..598628d
--- /dev/null
+++ b/LibD28/FMXfrxe23.dpk
@@ -0,0 +1,72 @@
+// Package file for Rad Studio 10 Seattle
+
+package FMXfrxe23;
+
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfrx23;
+
+contains
+ FMX.frxExportHTML in 'FMX.frxExportHTML.pas',
+ FMX.frxExportImage in 'FMX.frxExportImage.pas',
+ FMX.frxImageConverter in 'FMX.frxImageConverter.pas',
+ FMX.frxExportMatrix in 'FMX.frxExportMatrix.pas',
+ FMX.frxExportRTF in 'FMX.frxExportRTF.pas',
+ FMX.frxExportText in 'FMX.frxExportText.pas',
+ FMX.frxExportXML in 'FMX.frxExportXML.pas',
+ FMX.frxRC4 in 'FMX.frxRC4.pas',
+ FMX.frxCmapTableClass in 'FMX.frxCmapTableClass.pas',
+ FMX.frxGlyphTableClass in 'FMX.frxGlyphTableClass.pas',
+ FMX.frxGlyphSubstitutionClass in 'FMX.frxGlyphSubstitutionClass.pas',
+ FMX.frxHorizontalHeaderClass in 'FMX.frxHorizontalHeaderClass.pas',
+ FMX.frxHorizontalMetrixClass in 'FMX.frxHorizontalMetrixClass.pas',
+ FMX.frxIndexToLocationClass in 'FMX.frxIndexToLocationClass.pas',
+ FMX.frxKerningTableClass in 'FMX.frxKerningTableClass.pas',
+ FMX.frxPostScriptClass in 'FMX.frxPostScriptClass.pas',
+ FMX.frxMaximumProfileClass in 'FMX.frxMaximumProfileClass.pas',
+ FMX.frxOS2WindowsMetricsClass in 'FMX.frxOS2WindowsMetricsClass.pas',
+ FMX.frxPreProgramClass in 'FMX.frxPreProgramClass.pas',
+ FMX.frxTrueTypeFont in 'FMX.frxTrueTypeFont.pas',
+ FMX.frxFontHeaderClass in 'FMX.frxFontHeaderClass.pas',
+ FMX.TTFHelpers in 'FMX.TTFHelpers.pas',
+ FMX.frxTrueTypeTable in 'FMX.frxTrueTypeTable.pas',
+ FMX.frxNameTableClass in 'FMX.frxNameTableClass.pas',
+ FMX.frxmd5 in 'FMX.frxmd5.pas',
+ FMX.frxCrypto in 'FMX.frxCrypto.pas',
+ FMX.frxTrueTypeCollection in 'FMX.frxTrueTypeCollection.pas',
+ FMX.frxExportPDF in 'FMX.frxExportPDF.pas',
+ FMX.frxExportCSV in 'FMX.frxExportCSV.pas',
+ FMX.frxrcExports in 'FMX.frxrcExports.pas',
+ FMX.frxExportODF in 'FMX.frxExportODF.pas';
+
+end.
diff --git a/LibD28/FMXfrxe23.otares b/LibD28/FMXfrxe23.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxe23.otares differ
diff --git a/LibD28/FMXfrxe23.res b/LibD28/FMXfrxe23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfrxe23.res differ
diff --git a/LibD28/FMXfrxe24.dpk b/LibD28/FMXfrxe24.dpk
new file mode 100644
index 0000000..678b6ac
--- /dev/null
+++ b/LibD28/FMXfrxe24.dpk
@@ -0,0 +1,72 @@
+// Package file for Rad Studio 10 Seattle
+
+package FMXfrxe24;
+
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfrx24;
+
+contains
+ FMX.frxExportHTML in 'FMX.frxExportHTML.pas',
+ FMX.frxExportImage in 'FMX.frxExportImage.pas',
+ FMX.frxImageConverter in 'FMX.frxImageConverter.pas',
+ FMX.frxExportMatrix in 'FMX.frxExportMatrix.pas',
+ FMX.frxExportRTF in 'FMX.frxExportRTF.pas',
+ FMX.frxExportText in 'FMX.frxExportText.pas',
+ FMX.frxExportXML in 'FMX.frxExportXML.pas',
+ FMX.frxRC4 in 'FMX.frxRC4.pas',
+ FMX.frxCmapTableClass in 'FMX.frxCmapTableClass.pas',
+ FMX.frxGlyphTableClass in 'FMX.frxGlyphTableClass.pas',
+ FMX.frxGlyphSubstitutionClass in 'FMX.frxGlyphSubstitutionClass.pas',
+ FMX.frxHorizontalHeaderClass in 'FMX.frxHorizontalHeaderClass.pas',
+ FMX.frxHorizontalMetrixClass in 'FMX.frxHorizontalMetrixClass.pas',
+ FMX.frxIndexToLocationClass in 'FMX.frxIndexToLocationClass.pas',
+ FMX.frxKerningTableClass in 'FMX.frxKerningTableClass.pas',
+ FMX.frxPostScriptClass in 'FMX.frxPostScriptClass.pas',
+ FMX.frxMaximumProfileClass in 'FMX.frxMaximumProfileClass.pas',
+ FMX.frxOS2WindowsMetricsClass in 'FMX.frxOS2WindowsMetricsClass.pas',
+ FMX.frxPreProgramClass in 'FMX.frxPreProgramClass.pas',
+ FMX.frxTrueTypeFont in 'FMX.frxTrueTypeFont.pas',
+ FMX.frxFontHeaderClass in 'FMX.frxFontHeaderClass.pas',
+ FMX.TTFHelpers in 'FMX.TTFHelpers.pas',
+ FMX.frxTrueTypeTable in 'FMX.frxTrueTypeTable.pas',
+ FMX.frxNameTableClass in 'FMX.frxNameTableClass.pas',
+ FMX.frxmd5 in 'FMX.frxmd5.pas',
+ FMX.frxCrypto in 'FMX.frxCrypto.pas',
+ FMX.frxTrueTypeCollection in 'FMX.frxTrueTypeCollection.pas',
+ FMX.frxExportPDF in 'FMX.frxExportPDF.pas',
+ FMX.frxExportCSV in 'FMX.frxExportCSV.pas',
+ FMX.frxrcExports in 'FMX.frxrcExports.pas',
+ FMX.frxExportODF in 'FMX.frxExportODF.pas';
+
+end.
diff --git a/LibD28/FMXfrxe24.dproj b/LibD28/FMXfrxe24.dproj
new file mode 100644
index 0000000..371ba81
--- /dev/null
+++ b/LibD28/FMXfrxe24.dproj
@@ -0,0 +1,144 @@
+
+
+ {E91E86DD-8A60-447A-BD64-7E2F0D918230}
+ FMXfrxe24.dpk
+ True
+ Debug
+ 1025
+ Package
+ None
+ 18.1
+ Win32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ 1049
+ 00400000
+ true
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+ true
+ false
+ FMXfrxe24
+ true
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ true
+ false
+
+
+ 1033
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=
+ true
+
+
+ package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey=
+ Debug
+
+
+ false
+ 0
+ RELEASE;$(DCC_Define)
+ 0
+
+
+ true
+ false
+ DEBUG;$(DCC_Define)
+
+
+
+ MainSource
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Cfg_2
+ Base
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ FMXfrxe24.dpk
+
+
+
+ False
+ False
+ True
+ False
+ False
+ True
+ False
+
+
+ 12
+
+
+
+
diff --git a/LibD28/FMXfrxe24.otares b/LibD28/FMXfrxe24.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxe24.otares differ
diff --git a/LibD28/FMXfrxe24.res b/LibD28/FMXfrxe24.res
new file mode 100644
index 0000000..3bb7875
Binary files /dev/null and b/LibD28/FMXfrxe24.res differ
diff --git a/LibD28/FMXfrxe25.dpk b/LibD28/FMXfrxe25.dpk
new file mode 100644
index 0000000..45980cb
--- /dev/null
+++ b/LibD28/FMXfrxe25.dpk
@@ -0,0 +1,72 @@
+// Package file for Rad Studio 10 Seattle
+
+package FMXfrxe25;
+
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfrx25;
+
+contains
+ FMX.frxExportHTML in 'FMX.frxExportHTML.pas',
+ FMX.frxExportImage in 'FMX.frxExportImage.pas',
+ FMX.frxImageConverter in 'FMX.frxImageConverter.pas',
+ FMX.frxExportMatrix in 'FMX.frxExportMatrix.pas',
+ FMX.frxExportRTF in 'FMX.frxExportRTF.pas',
+ FMX.frxExportText in 'FMX.frxExportText.pas',
+ FMX.frxExportXML in 'FMX.frxExportXML.pas',
+ FMX.frxRC4 in 'FMX.frxRC4.pas',
+ FMX.frxCmapTableClass in 'FMX.frxCmapTableClass.pas',
+ FMX.frxGlyphTableClass in 'FMX.frxGlyphTableClass.pas',
+ FMX.frxGlyphSubstitutionClass in 'FMX.frxGlyphSubstitutionClass.pas',
+ FMX.frxHorizontalHeaderClass in 'FMX.frxHorizontalHeaderClass.pas',
+ FMX.frxHorizontalMetrixClass in 'FMX.frxHorizontalMetrixClass.pas',
+ FMX.frxIndexToLocationClass in 'FMX.frxIndexToLocationClass.pas',
+ FMX.frxKerningTableClass in 'FMX.frxKerningTableClass.pas',
+ FMX.frxPostScriptClass in 'FMX.frxPostScriptClass.pas',
+ FMX.frxMaximumProfileClass in 'FMX.frxMaximumProfileClass.pas',
+ FMX.frxOS2WindowsMetricsClass in 'FMX.frxOS2WindowsMetricsClass.pas',
+ FMX.frxPreProgramClass in 'FMX.frxPreProgramClass.pas',
+ FMX.frxTrueTypeFont in 'FMX.frxTrueTypeFont.pas',
+ FMX.frxFontHeaderClass in 'FMX.frxFontHeaderClass.pas',
+ FMX.TTFHelpers in 'FMX.TTFHelpers.pas',
+ FMX.frxTrueTypeTable in 'FMX.frxTrueTypeTable.pas',
+ FMX.frxNameTableClass in 'FMX.frxNameTableClass.pas',
+ FMX.frxmd5 in 'FMX.frxmd5.pas',
+ FMX.frxCrypto in 'FMX.frxCrypto.pas',
+ FMX.frxTrueTypeCollection in 'FMX.frxTrueTypeCollection.pas',
+ FMX.frxExportPDF in 'FMX.frxExportPDF.pas',
+ FMX.frxExportCSV in 'FMX.frxExportCSV.pas',
+ FMX.frxrcExports in 'FMX.frxrcExports.pas',
+ FMX.frxExportODF in 'FMX.frxExportODF.pas';
+
+end.
diff --git a/LibD28/FMXfrxe25.otares b/LibD28/FMXfrxe25.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfrxe25.otares differ
diff --git a/LibD28/FMXfrxe25.res b/LibD28/FMXfrxe25.res
new file mode 100644
index 0000000..3bb7875
Binary files /dev/null and b/LibD28/FMXfrxe25.res differ
diff --git a/LibD28/FMXfrxe26.dpk b/LibD28/FMXfrxe26.dpk
new file mode 100644
index 0000000..425c997
--- /dev/null
+++ b/LibD28/FMXfrxe26.dpk
@@ -0,0 +1,69 @@
+// Package file for Rad Studio 10 Seattle
+
+package FMXfrxe26;
+
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfrx26;
+
+contains
+ FMX.frxExportHTML in 'FMX.frxExportHTML.pas',
+ FMX.frxExportImage in 'FMX.frxExportImage.pas',
+ FMX.frxImageConverter in 'FMX.frxImageConverter.pas',
+ FMX.frxExportMatrix in 'FMX.frxExportMatrix.pas',
+ FMX.frxExportRTF in 'FMX.frxExportRTF.pas',
+ FMX.frxExportText in 'FMX.frxExportText.pas',
+ FMX.frxExportXML in 'FMX.frxExportXML.pas',
+ FMX.frxRC4 in 'FMX.frxRC4.pas',
+ FMX.frxCmapTableClass in 'FMX.frxCmapTableClass.pas',
+ FMX.frxGlyphTableClass in 'FMX.frxGlyphTableClass.pas',
+ FMX.frxGlyphSubstitutionClass in 'FMX.frxGlyphSubstitutionClass.pas',
+ FMX.frxHorizontalHeaderClass in 'FMX.frxHorizontalHeaderClass.pas',
+ FMX.frxHorizontalMetrixClass in 'FMX.frxHorizontalMetrixClass.pas',
+ FMX.frxIndexToLocationClass in 'FMX.frxIndexToLocationClass.pas',
+ FMX.frxKerningTableClass in 'FMX.frxKerningTableClass.pas',
+ FMX.frxPostScriptClass in 'FMX.frxPostScriptClass.pas',
+ FMX.frxMaximumProfileClass in 'FMX.frxMaximumProfileClass.pas',
+ FMX.frxOS2WindowsMetricsClass in 'FMX.frxOS2WindowsMetricsClass.pas',
+ FMX.frxPreProgramClass in 'FMX.frxPreProgramClass.pas',
+ FMX.frxTrueTypeFont in 'FMX.frxTrueTypeFont.pas',
+ FMX.frxFontHeaderClass in 'FMX.frxFontHeaderClass.pas',
+ FMX.TTFHelpers in 'FMX.TTFHelpers.pas',
+ FMX.frxTrueTypeTable in 'FMX.frxTrueTypeTable.pas',
+ FMX.frxNameTableClass in 'FMX.frxNameTableClass.pas',
+ FMX.frxmd5 in 'FMX.frxmd5.pas',
+ FMX.frxCrypto in 'FMX.frxCrypto.pas',
+ FMX.frxTrueTypeCollection in 'FMX.frxTrueTypeCollection.pas',
+ FMX.frxExportPDF in 'FMX.frxExportPDF.pas',
+ FMX.frxExportCSV in 'FMX.frxExportCSV.pas',
+ FMX.frxrcExports in 'FMX.frxrcExports.pas',
+ FMX.frxExportODF in 'FMX.frxExportODF.pas';
+
+end.
diff --git a/LibD28/FMXfrxe27.dpk b/LibD28/FMXfrxe27.dpk
new file mode 100644
index 0000000..449d078
--- /dev/null
+++ b/LibD28/FMXfrxe27.dpk
@@ -0,0 +1,70 @@
+// Package file for Rad Studio 10 Seattle
+
+package FMXfrxe27;
+
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfrx27;
+
+contains
+ FMX.frxExportHTML in 'FMX.frxExportHTML.pas',
+ FMX.frxExportImage in 'FMX.frxExportImage.pas',
+ FMX.frxImageConverter in 'FMX.frxImageConverter.pas',
+ FMX.frxExportMatrix in 'FMX.frxExportMatrix.pas',
+ FMX.frxExportRTF in 'FMX.frxExportRTF.pas',
+ FMX.frxExportText in 'FMX.frxExportText.pas',
+ FMX.frxExportXML in 'FMX.frxExportXML.pas',
+ FMX.frxRC4 in 'FMX.frxRC4.pas',
+ FMX.frxCmapTableClass in 'FMX.frxCmapTableClass.pas',
+ FMX.frxGlyphTableClass in 'FMX.frxGlyphTableClass.pas',
+ FMX.frxGlyphSubstitutionClass in 'FMX.frxGlyphSubstitutionClass.pas',
+ FMX.frxHorizontalHeaderClass in 'FMX.frxHorizontalHeaderClass.pas',
+ FMX.frxHorizontalMetrixClass in 'FMX.frxHorizontalMetrixClass.pas',
+ FMX.frxIndexToLocationClass in 'FMX.frxIndexToLocationClass.pas',
+ FMX.frxKerningTableClass in 'FMX.frxKerningTableClass.pas',
+ FMX.frxPostScriptClass in 'FMX.frxPostScriptClass.pas',
+ FMX.frxMaximumProfileClass in 'FMX.frxMaximumProfileClass.pas',
+ FMX.frxOS2WindowsMetricsClass in 'FMX.frxOS2WindowsMetricsClass.pas',
+ FMX.frxPreProgramClass in 'FMX.frxPreProgramClass.pas',
+ FMX.frxTrueTypeFont in 'FMX.frxTrueTypeFont.pas',
+ FMX.frxFontHeaderClass in 'FMX.frxFontHeaderClass.pas',
+ FMX.TTFHelpers in 'FMX.TTFHelpers.pas',
+ FMX.frxTrueTypeTable in 'FMX.frxTrueTypeTable.pas',
+ FMX.frxNameTableClass in 'FMX.frxNameTableClass.pas',
+ FMX.frxmd5 in 'FMX.frxmd5.pas',
+ FMX.frxCrypto in 'FMX.frxCrypto.pas',
+ FMX.frxTrueTypeCollection in 'FMX.frxTrueTypeCollection.pas',
+ FMX.frxExportPDF in 'FMX.frxExportPDF.pas',
+ FMX.frxExportCSV in 'FMX.frxExportCSV.pas',
+ FMX.frxrcExports in 'FMX.frxrcExports.pas',
+ FMX.frxExportODF in 'FMX.frxExportODF.pas',
+ FMX.frxZip in 'FMX.frxZip.pas';
+
+end.
diff --git a/LibD28/FMXfrxe29.dpk b/LibD28/FMXfrxe29.dpk
new file mode 100644
index 0000000..1a50e59
--- /dev/null
+++ b/LibD28/FMXfrxe29.dpk
@@ -0,0 +1,70 @@
+// Package file for Rad Studio 12
+
+package FMXfrxe29;
+
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfrx29;
+
+contains
+ FMX.frxExportHTML in 'FMX.frxExportHTML.pas',
+ FMX.frxExportImage in 'FMX.frxExportImage.pas',
+ FMX.frxImageConverter in 'FMX.frxImageConverter.pas',
+ FMX.frxExportMatrix in 'FMX.frxExportMatrix.pas',
+ FMX.frxExportRTF in 'FMX.frxExportRTF.pas',
+ FMX.frxExportText in 'FMX.frxExportText.pas',
+ FMX.frxExportXML in 'FMX.frxExportXML.pas',
+ FMX.frxRC4 in 'FMX.frxRC4.pas',
+ FMX.frxCmapTableClass in 'FMX.frxCmapTableClass.pas',
+ FMX.frxGlyphTableClass in 'FMX.frxGlyphTableClass.pas',
+ FMX.frxGlyphSubstitutionClass in 'FMX.frxGlyphSubstitutionClass.pas',
+ FMX.frxHorizontalHeaderClass in 'FMX.frxHorizontalHeaderClass.pas',
+ FMX.frxHorizontalMetrixClass in 'FMX.frxHorizontalMetrixClass.pas',
+ FMX.frxIndexToLocationClass in 'FMX.frxIndexToLocationClass.pas',
+ FMX.frxKerningTableClass in 'FMX.frxKerningTableClass.pas',
+ FMX.frxPostScriptClass in 'FMX.frxPostScriptClass.pas',
+ FMX.frxMaximumProfileClass in 'FMX.frxMaximumProfileClass.pas',
+ FMX.frxOS2WindowsMetricsClass in 'FMX.frxOS2WindowsMetricsClass.pas',
+ FMX.frxPreProgramClass in 'FMX.frxPreProgramClass.pas',
+ FMX.frxTrueTypeFont in 'FMX.frxTrueTypeFont.pas',
+ FMX.frxFontHeaderClass in 'FMX.frxFontHeaderClass.pas',
+ FMX.TTFHelpers in 'FMX.TTFHelpers.pas',
+ FMX.frxTrueTypeTable in 'FMX.frxTrueTypeTable.pas',
+ FMX.frxNameTableClass in 'FMX.frxNameTableClass.pas',
+ FMX.frxmd5 in 'FMX.frxmd5.pas',
+ FMX.frxCrypto in 'FMX.frxCrypto.pas',
+ FMX.frxTrueTypeCollection in 'FMX.frxTrueTypeCollection.pas',
+ FMX.frxExportPDF in 'FMX.frxExportPDF.pas',
+ FMX.frxExportCSV in 'FMX.frxExportCSV.pas',
+ FMX.frxrcExports in 'FMX.frxrcExports.pas',
+ FMX.frxExportODF in 'FMX.frxExportODF.pas',
+ FMX.frxZip in 'FMX.frxZip.pas';
+
+end.
diff --git a/LibD28/FMXfrxeReg.pas b/LibD28/FMXfrxeReg.pas
new file mode 100644
index 0000000..d914fc7
--- /dev/null
+++ b/LibD28/FMXfrxeReg.pas
@@ -0,0 +1,51 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Exports Registration unit }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Fediachov, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMXfrxeReg;
+
+{$I frx.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ System.SysUtils, System.Classes, FMX.Types, FMX.Controls, FMX.Forms,
+ DesignIntf, DesignEditors,
+{$IFNDEF RAD_ED}
+ FMX.frxExportXML, FMX.frxExportRTF, //frxExportXLS, frxExportMail,
+ FMX.frxExportODF, // frxExportDBF, frxExportBIFF,
+{$ENDIF}
+ FMX.frxExportHTML, FMX.frxExportImage,
+ FMX.frxExportPDF, FMX.frxExportText, FMX.frxExportCSV;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+ RegisterComponents('FastReport FMX 2.0 Exports',
+ [
+{$IFNDEF RAD_ED}
+ TfrxXMLExport, TfrxRTFExport,
+// TfrxXLSExport, TfrxMailExport,
+ TfrxODSExport, TfrxODTExport,
+// TfrxDBFExport, TfrxBIFFExport,
+{$ENDIF}
+ TfrxPDFExport, TfrxHTMLExport,
+ TfrxBMPExport, TfrxJPEGExport, TfrxTIFFExport,
+ TfrxGIFExport, TfrxSimpleTextExport, TfrxCSVExport]);
+end;
+
+end.
diff --git a/LibD28/FMXfs16.dpk b/LibD28/FMXfs16.dpk
new file mode 100644
index 0000000..60d40ad
--- /dev/null
+++ b/LibD28/FMXfs16.dpk
@@ -0,0 +1,60 @@
+// Package file for Delphi XE2
+
+package FMXfs16;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/LibD28/FMXfs16.res b/LibD28/FMXfs16.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfs16.res differ
diff --git a/LibD28/FMXfs17.dpk b/LibD28/FMXfs17.dpk
new file mode 100644
index 0000000..2f51eaa
--- /dev/null
+++ b/LibD28/FMXfs17.dpk
@@ -0,0 +1,60 @@
+// Package file for Delphi XE3
+
+package FMXfs17;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/LibD28/FMXfs17.res b/LibD28/FMXfs17.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfs17.res differ
diff --git a/LibD28/FMXfs18.dpk b/LibD28/FMXfs18.dpk
new file mode 100644
index 0000000..2e8cc3b
--- /dev/null
+++ b/LibD28/FMXfs18.dpk
@@ -0,0 +1,60 @@
+// Package file for Delphi XE4
+
+package FMXfs18;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/LibD28/FMXfs18.otares b/LibD28/FMXfs18.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfs18.otares differ
diff --git a/LibD28/FMXfs18.res b/LibD28/FMXfs18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfs18.res differ
diff --git a/LibD28/FMXfs19.dpk b/LibD28/FMXfs19.dpk
new file mode 100644
index 0000000..484cfae
--- /dev/null
+++ b/LibD28/FMXfs19.dpk
@@ -0,0 +1,60 @@
+// Package file for Delphi XE5
+
+package FMXfs19;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/LibD28/FMXfs19.otares b/LibD28/FMXfs19.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfs19.otares differ
diff --git a/LibD28/FMXfs19.res b/LibD28/FMXfs19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfs19.res differ
diff --git a/LibD28/FMXfs20.dpk b/LibD28/FMXfs20.dpk
new file mode 100644
index 0000000..9e0de3e
--- /dev/null
+++ b/LibD28/FMXfs20.dpk
@@ -0,0 +1,60 @@
+// Package file for Delphi XE6
+
+package FMXfs20;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/LibD28/FMXfs20.otares b/LibD28/FMXfs20.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfs20.otares differ
diff --git a/LibD28/FMXfs20.res b/LibD28/FMXfs20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfs20.res differ
diff --git a/LibD28/FMXfs21.dpk b/LibD28/FMXfs21.dpk
new file mode 100644
index 0000000..820052a
--- /dev/null
+++ b/LibD28/FMXfs21.dpk
@@ -0,0 +1,60 @@
+// Package file for Delphi XE7
+
+package FMXfs21;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/LibD28/FMXfs21.otares b/LibD28/FMXfs21.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfs21.otares differ
diff --git a/LibD28/FMXfs21.res b/LibD28/FMXfs21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfs21.res differ
diff --git a/LibD28/FMXfs22.dpk b/LibD28/FMXfs22.dpk
new file mode 100644
index 0000000..6820909
--- /dev/null
+++ b/LibD28/FMXfs22.dpk
@@ -0,0 +1,60 @@
+// Package file for Delphi XE8
+
+package FMXfs22;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/LibD28/FMXfs22.otares b/LibD28/FMXfs22.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfs22.otares differ
diff --git a/LibD28/FMXfs22.res b/LibD28/FMXfs22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfs22.res differ
diff --git a/LibD28/FMXfs23.dpk b/LibD28/FMXfs23.dpk
new file mode 100644
index 0000000..8c587b3
--- /dev/null
+++ b/LibD28/FMXfs23.dpk
@@ -0,0 +1,59 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfs23;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/LibD28/FMXfs23.otares b/LibD28/FMXfs23.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfs23.otares differ
diff --git a/LibD28/FMXfs23.res b/LibD28/FMXfs23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfs23.res differ
diff --git a/LibD28/FMXfs24.dpk b/LibD28/FMXfs24.dpk
new file mode 100644
index 0000000..19818d3
--- /dev/null
+++ b/LibD28/FMXfs24.dpk
@@ -0,0 +1,59 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfs24;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/LibD28/FMXfs24.otares b/LibD28/FMXfs24.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfs24.otares differ
diff --git a/LibD28/FMXfs24.res b/LibD28/FMXfs24.res
new file mode 100644
index 0000000..3bb7875
Binary files /dev/null and b/LibD28/FMXfs24.res differ
diff --git a/LibD28/FMXfs25.dpk b/LibD28/FMXfs25.dpk
new file mode 100644
index 0000000..2f96717
--- /dev/null
+++ b/LibD28/FMXfs25.dpk
@@ -0,0 +1,59 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfs25;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/LibD28/FMXfs25.otares b/LibD28/FMXfs25.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfs25.otares differ
diff --git a/LibD28/FMXfs25.res b/LibD28/FMXfs25.res
new file mode 100644
index 0000000..3bb7875
Binary files /dev/null and b/LibD28/FMXfs25.res differ
diff --git a/LibD28/FMXfs26.dpk b/LibD28/FMXfs26.dpk
new file mode 100644
index 0000000..9738876
--- /dev/null
+++ b/LibD28/FMXfs26.dpk
@@ -0,0 +1,59 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfs26;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/LibD28/FMXfs27.dpk b/LibD28/FMXfs27.dpk
new file mode 100644
index 0000000..f5773b1
--- /dev/null
+++ b/LibD28/FMXfs27.dpk
@@ -0,0 +1,59 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfs27;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/LibD28/FMXfs28.dpk b/LibD28/FMXfs28.dpk
new file mode 100644
index 0000000..6bdefa5
--- /dev/null
+++ b/LibD28/FMXfs28.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 11 Seattle
+
+package FMXfs29;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.BaseTypeAliases in 'FMX.BaseTypeAliases.pas',
+ FMX.FormTypeAliases in 'FMX.FormTypeAliases.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/LibD28/FMXfs29.dpk b/LibD28/FMXfs29.dpk
new file mode 100644
index 0000000..95ece44
--- /dev/null
+++ b/LibD28/FMXfs29.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 12
+
+package FMXfs29;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO OFF}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx;
+
+contains
+ FMX.fs_ipascal in 'FMX.fs_ipascal.pas',
+ FMX.fs_icpp in 'FMX.fs_icpp.pas',
+ FMX.fs_ijs in 'FMX.fs_ijs.pas',
+ FMX.fs_ibasic in 'FMX.fs_ibasic.pas',
+ FMX.BaseTypeAliases in 'FMX.BaseTypeAliases.pas',
+ FMX.FormTypeAliases in 'FMX.FormTypeAliases.pas',
+ FMX.fs_iclassesrtti in 'FMX.fs_iclassesrtti.pas',
+ FMX.fs_iconst in 'FMX.fs_iconst.pas',
+ FMX.fs_idialogsrtti in 'FMX.fs_idialogsrtti.pas',
+ FMX.fs_ievents in 'FMX.fs_ievents.pas',
+ FMX.fs_iexpression in 'FMX.fs_iexpression.pas',
+ FMX.fs_iextctrlsrtti in 'FMX.fs_iextctrlsrtti.pas',
+ FMX.fs_iformsrtti in 'FMX.fs_iformsrtti.pas',
+ FMX.fs_igraphicsrtti in 'FMX.fs_igraphicsrtti.pas',
+ FMX.fs_iilparser in 'FMX.fs_iilparser.pas',
+ FMX.fs_iinirtti in 'FMX.fs_iinirtti.pas',
+ FMX.fs_iinterpreter in 'FMX.fs_iinterpreter.pas',
+ FMX.fs_iparser in 'FMX.fs_iparser.pas',
+ FMX.fs_isysrtti in 'FMX.fs_isysrtti.pas',
+ FMX.fs_imenusrtti in 'FMX.fs_imenusrtti.pas',
+ FMX.fs_itools in 'FMX.fs_itools.pas',
+ FMX.fs_xml in 'FMX.fs_xml.pas',
+ FMX.fs_synmemo in 'FMX.fs_synmemo.pas',
+ FMX.fs_tree in 'FMX.fs_tree.pas';
+
+end.
diff --git a/LibD28/FMXfs29.dproj b/LibD28/FMXfs29.dproj
new file mode 100644
index 0000000..6c8320e
--- /dev/null
+++ b/LibD28/FMXfs29.dproj
@@ -0,0 +1,168 @@
+
+
+ {8A6F836F-7163-46B6-8695-8352B468AD0B}
+ FMXfs29.dpk
+ True
+ Release
+ 3
+ Package
+ None
+ 20.1
+ Win64
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Cfg_1
+ true
+ true
+
+
+ true
+ Cfg_1
+ true
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ FMXfs29
+ 0
+ false
+ true
+ DEBUG;$(DCC_Define)
+ true
+ true
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+ 1033
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ true
+ 1033
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+
+
+ D:\Delphi\Component\FastReport FMX 2.8.12 Pro Full Source\LibD28x64\
+ true
+ 1033
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+
+
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ FMXfs29.dpk
+
+
+ Microsoft Office 2000 Sample Automation Server Wrapper Components
+ Microsoft Office XP Sample Automation Server Wrapper Components
+
+
+
+ True
+ True
+
+
+ 12
+
+
+
+
diff --git a/LibD28/FMXfs29.res b/LibD28/FMXfs29.res
new file mode 100644
index 0000000..b016276
Binary files /dev/null and b/LibD28/FMXfs29.res differ
diff --git a/LibD28/FMXfsADO16.dpk b/LibD28/FMXfsADO16.dpk
new file mode 100644
index 0000000..10a404d
--- /dev/null
+++ b/LibD28/FMXfsADO16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package FMXfsADO16;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs16,
+ FMXfsDB16;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/LibD28/FMXfsADO16.res b/LibD28/FMXfsADO16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/FMXfsADO16.res differ
diff --git a/LibD28/FMXfsADO17.dpk b/LibD28/FMXfsADO17.dpk
new file mode 100644
index 0000000..52b903a
--- /dev/null
+++ b/LibD28/FMXfsADO17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package FMXfsADO17;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs17,
+ FMXfsDB17;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/LibD28/FMXfsADO17.res b/LibD28/FMXfsADO17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/FMXfsADO17.res differ
diff --git a/LibD28/FMXfsADO18.dpk b/LibD28/FMXfsADO18.dpk
new file mode 100644
index 0000000..f441ad3
--- /dev/null
+++ b/LibD28/FMXfsADO18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package FMXfsADO18;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs18,
+ FMXfsDB18;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/LibD28/FMXfsADO18.res b/LibD28/FMXfsADO18.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/FMXfsADO18.res differ
diff --git a/LibD28/FMXfsADO19.dpk b/LibD28/FMXfsADO19.dpk
new file mode 100644
index 0000000..424714e
--- /dev/null
+++ b/LibD28/FMXfsADO19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package FMXfsADO19;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs19,
+ FMXfsDB19;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/LibD28/FMXfsADO19.res b/LibD28/FMXfsADO19.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/FMXfsADO19.res differ
diff --git a/LibD28/FMXfsADO20.dpk b/LibD28/FMXfsADO20.dpk
new file mode 100644
index 0000000..d19c363
--- /dev/null
+++ b/LibD28/FMXfsADO20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package FMXfsADO20;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs20,
+ FMXfsDB20;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/LibD28/FMXfsADO20.res b/LibD28/FMXfsADO20.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/FMXfsADO20.res differ
diff --git a/LibD28/FMXfsADO21.dpk b/LibD28/FMXfsADO21.dpk
new file mode 100644
index 0000000..83c3ad3
--- /dev/null
+++ b/LibD28/FMXfsADO21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package FMXfsADO21;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs21,
+ FMXfsDB21;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/LibD28/FMXfsADO21.res b/LibD28/FMXfsADO21.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/FMXfsADO21.res differ
diff --git a/LibD28/FMXfsADO22.dpk b/LibD28/FMXfsADO22.dpk
new file mode 100644
index 0000000..ca5d373
--- /dev/null
+++ b/LibD28/FMXfsADO22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package FMXfsADO22;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs22,
+ FMXfsDB22;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/LibD28/FMXfsADO22.res b/LibD28/FMXfsADO22.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/FMXfsADO22.res differ
diff --git a/LibD28/FMXfsADO23.dpk b/LibD28/FMXfsADO23.dpk
new file mode 100644
index 0000000..0bc722e
--- /dev/null
+++ b/LibD28/FMXfsADO23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsADO23;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs23,
+ FMXfsDB23;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/LibD28/FMXfsADO23.res b/LibD28/FMXfsADO23.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/FMXfsADO23.res differ
diff --git a/LibD28/FMXfsADO24.dpk b/LibD28/FMXfsADO24.dpk
new file mode 100644
index 0000000..beb9b84
--- /dev/null
+++ b/LibD28/FMXfsADO24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsADO24;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs24,
+ FMXfsDB24;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/LibD28/FMXfsADO24.res b/LibD28/FMXfsADO24.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/FMXfsADO24.res differ
diff --git a/LibD28/FMXfsADO25.dpk b/LibD28/FMXfsADO25.dpk
new file mode 100644
index 0000000..93c4991
--- /dev/null
+++ b/LibD28/FMXfsADO25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsADO25;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs25,
+ FMXfsDB25;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/LibD28/FMXfsADO25.res b/LibD28/FMXfsADO25.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/FMXfsADO25.res differ
diff --git a/LibD28/FMXfsADO26.dpk b/LibD28/FMXfsADO26.dpk
new file mode 100644
index 0000000..0ed9a68
--- /dev/null
+++ b/LibD28/FMXfsADO26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsADO26;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs26,
+ FMXfsDB26;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/LibD28/FMXfsADO27.dpk b/LibD28/FMXfsADO27.dpk
new file mode 100644
index 0000000..f2a00b7
--- /dev/null
+++ b/LibD28/FMXfsADO27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsADO27;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs27,
+ FMXfsDB27;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/LibD28/FMXfsADO28.dpk b/LibD28/FMXfsADO28.dpk
new file mode 100644
index 0000000..1b0ab49
--- /dev/null
+++ b/LibD28/FMXfsADO28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package FMXfsADO29;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs29,
+ FMXfsDB29;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/LibD28/FMXfsADO29.dpk b/LibD28/FMXfsADO29.dpk
new file mode 100644
index 0000000..c14c3be
--- /dev/null
+++ b/LibD28/FMXfsADO29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package FMXfsADO29;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ dbrtl,
+ ADORTL,
+ FMXfs29,
+ FMXfsDB29;
+
+contains
+ FMX.fs_iadortti in 'FMX.fs_iadortti.pas';
+
+end.
diff --git a/LibD28/FMXfsDB16.dpk b/LibD28/FMXfsDB16.dpk
new file mode 100644
index 0000000..f6fa97e
--- /dev/null
+++ b/LibD28/FMXfsDB16.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE2
+
+package FMXfsDB16;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs16,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsDB16.res b/LibD28/FMXfsDB16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/FMXfsDB16.res differ
diff --git a/LibD28/FMXfsDB17.dpk b/LibD28/FMXfsDB17.dpk
new file mode 100644
index 0000000..6df8aa2
--- /dev/null
+++ b/LibD28/FMXfsDB17.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE3
+
+package FMXfsDB17;
+
+{$R *.res}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs17,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsDB17.res b/LibD28/FMXfsDB17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/FMXfsDB17.res differ
diff --git a/LibD28/FMXfsDB18.dpk b/LibD28/FMXfsDB18.dpk
new file mode 100644
index 0000000..86897c0
--- /dev/null
+++ b/LibD28/FMXfsDB18.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE4
+
+package FMXfsDB18;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs18,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsDB18.otares b/LibD28/FMXfsDB18.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfsDB18.otares differ
diff --git a/LibD28/FMXfsDB18.res b/LibD28/FMXfsDB18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfsDB18.res differ
diff --git a/LibD28/FMXfsDB19.dpk b/LibD28/FMXfsDB19.dpk
new file mode 100644
index 0000000..2109b95
--- /dev/null
+++ b/LibD28/FMXfsDB19.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE5
+
+package FMXfsDB19;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs19,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsDB19.otares b/LibD28/FMXfsDB19.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfsDB19.otares differ
diff --git a/LibD28/FMXfsDB19.res b/LibD28/FMXfsDB19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfsDB19.res differ
diff --git a/LibD28/FMXfsDB20.dpk b/LibD28/FMXfsDB20.dpk
new file mode 100644
index 0000000..01116cd
--- /dev/null
+++ b/LibD28/FMXfsDB20.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE6
+
+package FMXfsDB20;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs20,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsDB20.otares b/LibD28/FMXfsDB20.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfsDB20.otares differ
diff --git a/LibD28/FMXfsDB20.res b/LibD28/FMXfsDB20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfsDB20.res differ
diff --git a/LibD28/FMXfsDB21.dpk b/LibD28/FMXfsDB21.dpk
new file mode 100644
index 0000000..8848232
--- /dev/null
+++ b/LibD28/FMXfsDB21.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE7
+
+package FMXfsDB21;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs21,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsDB21.otares b/LibD28/FMXfsDB21.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfsDB21.otares differ
diff --git a/LibD28/FMXfsDB21.res b/LibD28/FMXfsDB21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfsDB21.res differ
diff --git a/LibD28/FMXfsDB22.dpk b/LibD28/FMXfsDB22.dpk
new file mode 100644
index 0000000..08bd29f
--- /dev/null
+++ b/LibD28/FMXfsDB22.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE8
+
+package FMXfsDB22;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs22,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsDB22.otares b/LibD28/FMXfsDB22.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfsDB22.otares differ
diff --git a/LibD28/FMXfsDB22.res b/LibD28/FMXfsDB22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfsDB22.res differ
diff --git a/LibD28/FMXfsDB23.dpk b/LibD28/FMXfsDB23.dpk
new file mode 100644
index 0000000..fc47610
--- /dev/null
+++ b/LibD28/FMXfsDB23.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsDB23;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs23,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsDB23.otares b/LibD28/FMXfsDB23.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfsDB23.otares differ
diff --git a/LibD28/FMXfsDB23.res b/LibD28/FMXfsDB23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfsDB23.res differ
diff --git a/LibD28/FMXfsDB24.dpk b/LibD28/FMXfsDB24.dpk
new file mode 100644
index 0000000..6d3f1a9
--- /dev/null
+++ b/LibD28/FMXfsDB24.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsDB24;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs24,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsDB24.otares b/LibD28/FMXfsDB24.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfsDB24.otares differ
diff --git a/LibD28/FMXfsDB24.res b/LibD28/FMXfsDB24.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfsDB24.res differ
diff --git a/LibD28/FMXfsDB25.dpk b/LibD28/FMXfsDB25.dpk
new file mode 100644
index 0000000..d873f3a
--- /dev/null
+++ b/LibD28/FMXfsDB25.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsDB25;
+
+{$R *.res}
+{$R *.otares}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs25,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsDB25.otares b/LibD28/FMXfsDB25.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/FMXfsDB25.otares differ
diff --git a/LibD28/FMXfsDB25.res b/LibD28/FMXfsDB25.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfsDB25.res differ
diff --git a/LibD28/FMXfsDB26.dpk b/LibD28/FMXfsDB26.dpk
new file mode 100644
index 0000000..359e620
--- /dev/null
+++ b/LibD28/FMXfsDB26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsDB26;
+
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs26,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsDB27.dpk b/LibD28/FMXfsDB27.dpk
new file mode 100644
index 0000000..e18c2a2
--- /dev/null
+++ b/LibD28/FMXfsDB27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsDB27;
+
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs27,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsDB28.dpk b/LibD28/FMXfsDB28.dpk
new file mode 100644
index 0000000..d7fb8f0
--- /dev/null
+++ b/LibD28/FMXfsDB28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package FMXfsDB29;
+
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs29,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsDB29.dpk b/LibD28/FMXfsDB29.dpk
new file mode 100644
index 0000000..d7fb8f0
--- /dev/null
+++ b/LibD28/FMXfsDB29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package FMXfsDB29;
+
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs29,
+ dbrtl;
+
+contains
+ FMX.fs_idbrtti in 'FMX.fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsDB29.dproj b/LibD28/FMXfsDB29.dproj
new file mode 100644
index 0000000..f7799b6
--- /dev/null
+++ b/LibD28/FMXfsDB29.dproj
@@ -0,0 +1,134 @@
+
+
+ {E452C5A0-1C9F-44AA-A8E1-214DD593FDAE}
+ FMXfsDB29.dpk
+ True
+ Release
+ 3
+ Package
+ None
+ 20.1
+ Win64
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Cfg_1
+ true
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ FMXfsDB29
+ true
+ true
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+ 1033
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ D:\Delphi\Component\FastReport FMX 2.8.12 Pro Full Source\LibD28x64\
+ true
+ 1033
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ FMXfsDB29.dpk
+
+
+ Microsoft Office 2000 Sample Automation Server Wrapper Components
+ Microsoft Office XP Sample Automation Server Wrapper Components
+
+
+
+ False
+ False
+ False
+ False
+ False
+ True
+ True
+
+
+ 12
+
+
+
+
diff --git a/LibD28/FMXfsDB29.res b/LibD28/FMXfsDB29.res
new file mode 100644
index 0000000..bc68b21
Binary files /dev/null and b/LibD28/FMXfsDB29.res differ
diff --git a/LibD28/FMXfsIBX16.dpk b/LibD28/FMXfsIBX16.dpk
new file mode 100644
index 0000000..a64c4d2
--- /dev/null
+++ b/LibD28/FMXfsIBX16.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE2
+
+package FMXfsIBX16;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs16,
+ FMXfsDB16;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsIBX16.res b/LibD28/FMXfsIBX16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/FMXfsIBX16.res differ
diff --git a/LibD28/FMXfsIBX17.dpk b/LibD28/FMXfsIBX17.dpk
new file mode 100644
index 0000000..cf3fb7e
--- /dev/null
+++ b/LibD28/FMXfsIBX17.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE3
+
+package FMXfsIBX17;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs17,
+ FMXfsDB17;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsIBX17.res b/LibD28/FMXfsIBX17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/FMXfsIBX17.res differ
diff --git a/LibD28/FMXfsIBX18.dpk b/LibD28/FMXfsIBX18.dpk
new file mode 100644
index 0000000..7288365
--- /dev/null
+++ b/LibD28/FMXfsIBX18.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE4
+
+package FMXfsIBX18;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs18,
+ FMXfsDB18;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsIBX18.res b/LibD28/FMXfsIBX18.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/FMXfsIBX18.res differ
diff --git a/LibD28/FMXfsIBX19.dpk b/LibD28/FMXfsIBX19.dpk
new file mode 100644
index 0000000..cf86260
--- /dev/null
+++ b/LibD28/FMXfsIBX19.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE5
+
+package FMXfsIBX19;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs19,
+ FMXfsDB19;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsIBX19.res b/LibD28/FMXfsIBX19.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/FMXfsIBX19.res differ
diff --git a/LibD28/FMXfsIBX20.dpk b/LibD28/FMXfsIBX20.dpk
new file mode 100644
index 0000000..2e741b2
--- /dev/null
+++ b/LibD28/FMXfsIBX20.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE6
+
+package FMXfsIBX20;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs20,
+ FMXfsDB20;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsIBX20.res b/LibD28/FMXfsIBX20.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/FMXfsIBX20.res differ
diff --git a/LibD28/FMXfsIBX21.dpk b/LibD28/FMXfsIBX21.dpk
new file mode 100644
index 0000000..d6cd6d2
--- /dev/null
+++ b/LibD28/FMXfsIBX21.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE7
+
+package FMXfsIBX21;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs21,
+ FMXfsDB21;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsIBX21.res b/LibD28/FMXfsIBX21.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/FMXfsIBX21.res differ
diff --git a/LibD28/FMXfsIBX22.dpk b/LibD28/FMXfsIBX22.dpk
new file mode 100644
index 0000000..e870670
--- /dev/null
+++ b/LibD28/FMXfsIBX22.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi XE8
+
+package FMXfsIBX22;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs22,
+ FMXfsDB22;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsIBX22.res b/LibD28/FMXfsIBX22.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/FMXfsIBX22.res differ
diff --git a/LibD28/FMXfsIBX23.dpk b/LibD28/FMXfsIBX23.dpk
new file mode 100644
index 0000000..ef8b9fd
--- /dev/null
+++ b/LibD28/FMXfsIBX23.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsIBX23;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs23,
+ FMXfsDB23;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsIBX23.res b/LibD28/FMXfsIBX23.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/FMXfsIBX23.res differ
diff --git a/LibD28/FMXfsIBX24.dpk b/LibD28/FMXfsIBX24.dpk
new file mode 100644
index 0000000..d2c75a8
--- /dev/null
+++ b/LibD28/FMXfsIBX24.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsIBX24;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs24,
+ FMXfsDB24;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsIBX24.res b/LibD28/FMXfsIBX24.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/FMXfsIBX24.res differ
diff --git a/LibD28/FMXfsIBX25.dpk b/LibD28/FMXfsIBX25.dpk
new file mode 100644
index 0000000..5a734d2
--- /dev/null
+++ b/LibD28/FMXfsIBX25.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsIBX25;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs25,
+ FMXfsDB25;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsIBX25.res b/LibD28/FMXfsIBX25.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/FMXfsIBX25.res differ
diff --git a/LibD28/FMXfsIBX26.dpk b/LibD28/FMXfsIBX26.dpk
new file mode 100644
index 0000000..3acb9cc
--- /dev/null
+++ b/LibD28/FMXfsIBX26.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsIBX26;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs26,
+ FMXfsDB26;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsIBX27.dpk b/LibD28/FMXfsIBX27.dpk
new file mode 100644
index 0000000..de6a34e
--- /dev/null
+++ b/LibD28/FMXfsIBX27.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsIBX27;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs27,
+ FMXfsDB27;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsIBX28.dpk b/LibD28/FMXfsIBX28.dpk
new file mode 100644
index 0000000..0cba709
--- /dev/null
+++ b/LibD28/FMXfsIBX28.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 11 Seattle
+
+package FMXfsIBX29;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs29,
+ FMXfsDB29;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsIBX29.dpk b/LibD28/FMXfsIBX29.dpk
new file mode 100644
index 0000000..b5fa135
--- /dev/null
+++ b/LibD28/FMXfsIBX29.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 12
+
+package FMXfsIBX29;
+
+{$I fmx.inc}
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DBrtl,
+ IBXPRESS,
+ FMXfs29,
+ FMXfsDB29;
+
+contains
+ FMX.fs_iibxrtti in 'FMX.fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsTee16.dpk b/LibD28/FMXfsTee16.dpk
new file mode 100644
index 0000000..69bd560
--- /dev/null
+++ b/LibD28/FMXfsTee16.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE2
+
+package FMXfsTee16;
+
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro916, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee916, FMXTEEUI916, {$ENDIF}
+ FMXfs16;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsTee16.res b/LibD28/FMXfsTee16.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfsTee16.res differ
diff --git a/LibD28/FMXfsTee17.dpk b/LibD28/FMXfsTee17.dpk
new file mode 100644
index 0000000..f51d5e6
--- /dev/null
+++ b/LibD28/FMXfsTee17.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE3
+
+package FMXfsTee17;
+
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro917, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee917, FMXTEEUI917, {$ENDIF}
+ FMXfs17;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsTee17.res b/LibD28/FMXfsTee17.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfsTee17.res differ
diff --git a/LibD28/FMXfsTee18.dpk b/LibD28/FMXfsTee18.dpk
new file mode 100644
index 0000000..e963a8b
--- /dev/null
+++ b/LibD28/FMXfsTee18.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE4
+
+package FMXfsTee18;
+
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro918, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee918, FMXTEEUI918, {$ENDIF}
+ FMXfs18;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsTee18.res b/LibD28/FMXfsTee18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfsTee18.res differ
diff --git a/LibD28/FMXfsTee19.dpk b/LibD28/FMXfsTee19.dpk
new file mode 100644
index 0000000..1370860
--- /dev/null
+++ b/LibD28/FMXfsTee19.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE5
+
+package FMXfsTee19;
+{$I tee.inc}
+{$I fmx.inc}
+
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ FMXfs19
+{$IFDEF TeeChartStd} ,FMXTEE{$ENDIF}
+{$IFDEF TeeChart9},FMXTeePro919 {$ENDIF}
+{$IFDEF TeeChartStd9},FMXTee919{$ENDIF};
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
+
diff --git a/LibD28/FMXfsTee19.res b/LibD28/FMXfsTee19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfsTee19.res differ
diff --git a/LibD28/FMXfsTee20.dpk b/LibD28/FMXfsTee20.dpk
new file mode 100644
index 0000000..bf358bd
--- /dev/null
+++ b/LibD28/FMXfsTee20.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE6
+
+package FMXfsTee20;
+
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro920, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee920, TEEUI920, {$ENDIF}
+ FMXfs20;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsTee20.res b/LibD28/FMXfsTee20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfsTee20.res differ
diff --git a/LibD28/FMXfsTee21.dpk b/LibD28/FMXfsTee21.dpk
new file mode 100644
index 0000000..3481fb5
--- /dev/null
+++ b/LibD28/FMXfsTee21.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE7
+
+package FMXfsTee21;
+
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro921, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee921, TEEUI921, {$ENDIF}
+ FMXfs21;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsTee21.res b/LibD28/FMXfsTee21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfsTee21.res differ
diff --git a/LibD28/FMXfsTee22.dpk b/LibD28/FMXfsTee22.dpk
new file mode 100644
index 0000000..25e0fa0
--- /dev/null
+++ b/LibD28/FMXfsTee22.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE8
+
+package FMXfsTee22;
+
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro922, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee922, TEEUI922, {$ENDIF}
+ FMXfs22;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsTee22.res b/LibD28/FMXfsTee22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfsTee22.res differ
diff --git a/LibD28/FMXfsTee23.dpk b/LibD28/FMXfsTee23.dpk
new file mode 100644
index 0000000..7a09181
--- /dev/null
+++ b/LibD28/FMXfsTee23.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsTee23;
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro923, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee923, TEEUI923, {$ENDIF}
+ FMXfs23;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsTee23.res b/LibD28/FMXfsTee23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfsTee23.res differ
diff --git a/LibD28/FMXfsTee24.dpk b/LibD28/FMXfsTee24.dpk
new file mode 100644
index 0000000..4a295f0
--- /dev/null
+++ b/LibD28/FMXfsTee24.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsTee24;
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro924, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee924, TEEUI924, {$ENDIF}
+ FMXfs24;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsTee24.res b/LibD28/FMXfsTee24.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfsTee24.res differ
diff --git a/LibD28/FMXfsTee25.dpk b/LibD28/FMXfsTee25.dpk
new file mode 100644
index 0000000..6befc20
--- /dev/null
+++ b/LibD28/FMXfsTee25.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsTee25;
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro925, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee925, TEEUI925, {$ENDIF}
+ FMXfs25;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsTee25.res b/LibD28/FMXfsTee25.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/FMXfsTee25.res differ
diff --git a/LibD28/FMXfsTee26.dpk b/LibD28/FMXfsTee26.dpk
new file mode 100644
index 0000000..ba7bb49
--- /dev/null
+++ b/LibD28/FMXfsTee26.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsTee26;
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro926, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee926, TEEUI926, {$ENDIF}
+ FMXfs26;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsTee27.dpk b/LibD28/FMXfsTee27.dpk
new file mode 100644
index 0000000..69374c7
--- /dev/null
+++ b/LibD28/FMXfsTee27.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi 10 Seattle
+
+package FMXfsTee27;
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro927, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee927, TEEUI927, {$ENDIF}
+ FMXfs27;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsTee28.dpk b/LibD28/FMXfsTee28.dpk
new file mode 100644
index 0000000..b741ede
--- /dev/null
+++ b/LibD28/FMXfsTee28.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi 11 Seattle
+
+package FMXfsTee29;
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro929, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee929, TEEUI929, {$ENDIF}
+ FMXfs29;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsTee29.dpk b/LibD28/FMXfsTee29.dpk
new file mode 100644
index 0000000..29aa466
--- /dev/null
+++ b/LibD28/FMXfsTee29.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi 12
+
+package FMXfsTee29;
+{$I fs.inc}
+{$I fmx.inc}
+{$I tee.inc}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+{$IFDEF TeeChartStd} FMXTEE,{$ENDIF}
+{$IFDEF TeeChart9}FMXTeePro929, {$ENDIF}
+{$IFDEF TeeChartStd9}FMXTee929, TEEUI929, {$ENDIF}
+ FMXfs29;
+
+contains
+ FMX.fs_ichartrtti in 'FMX.fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/FMXfsTee29.dproj b/LibD28/FMXfsTee29.dproj
new file mode 100644
index 0000000..6b89d9a
--- /dev/null
+++ b/LibD28/FMXfsTee29.dproj
@@ -0,0 +1,137 @@
+
+
+ {E7C3B77F-3B77-4306-B9DD-DA760901232E}
+ FMXfsTee29.dpk
+ True
+ Release
+ 3
+ Package
+ None
+ 20.1
+ Win64
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Cfg_1
+ true
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ FMXfsTee29
+ true
+ true
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+ 1033
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ D:\Delphi\Component\FastReport FMX 2.8.12 Pro Full Source\LibD28x64\
+ true
+ 1033
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ FMXfsTee29.dpk
+
+
+ Microsoft Office 2000 Sample Automation Server Wrapper Components
+ Microsoft Office XP Sample Automation Server Wrapper Components
+
+
+
+ False
+ False
+ False
+ False
+ False
+ True
+ True
+
+
+ 12
+
+
+
+
diff --git a/LibD28/FMXfsTee29.res b/LibD28/FMXfsTee29.res
new file mode 100644
index 0000000..dc61770
Binary files /dev/null and b/LibD28/FMXfsTee29.res differ
diff --git a/LibD28/FMXfs_iadoreg.pas b/LibD28/FMXfs_iadoreg.pas
new file mode 100644
index 0000000..8decc54
--- /dev/null
+++ b/LibD28/FMXfs_iadoreg.pas
@@ -0,0 +1,37 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMXfs_iadoreg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ System.Classes
+, DesignIntf
+, FMX.Types
+, FMX.fs_iadortti;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+ //GroupDescendentsWith(TfsADORTTI, TFmxObject);
+ RegisterComponents('FastScript FMX', [TfsADORTTI]);
+end;
+
+end.
diff --git a/LibD28/FMXfs_idbreg.pas b/LibD28/FMXfs_idbreg.pas
new file mode 100644
index 0000000..b514773
--- /dev/null
+++ b/LibD28/FMXfs_idbreg.pas
@@ -0,0 +1,37 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMXfs_idbreg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ System.Classes
+, DesignIntf
+, FMX.Types
+, FMX.fs_idbrtti;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+ // GroupDescendentsWith(TfsDBRTTI, TFmxObject);
+ RegisterComponents('FastScript FMX', [TfsDBRTTI]);
+end;
+
+end.
diff --git a/LibD28/FMXfs_iibxreg.pas b/LibD28/FMXfs_iibxreg.pas
new file mode 100644
index 0000000..9a946a4
--- /dev/null
+++ b/LibD28/FMXfs_iibxreg.pas
@@ -0,0 +1,37 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMXfs_iibxreg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ System.Classes
+, FMX.Types
+, DesignIntf
+, FMX.fs_iibxrtti;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+ //GroupDescendentsWith(TfsIBXRTTI, TFmxObject);
+ RegisterComponents('FastScript FMX', [TfsIBXRTTI]);
+end;
+
+end.
diff --git a/LibD28/FMXfs_ireg.pas b/LibD28/FMXfs_ireg.pas
new file mode 100644
index 0000000..496346b
--- /dev/null
+++ b/LibD28/FMXfs_ireg.pas
@@ -0,0 +1,85 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMXfs_ireg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+uses
+ System.Classes
+{$IFNDEF FPC}
+ {$IFNDEF Delphi6}
+ , DsgnIntf
+ {$ELSE}
+ , DesignIntf
+ {$ENDIF}
+{$ELSE}
+ ,PropEdits
+ ,LazarusPackageIntf
+ ,LResources
+{$ENDIF}
+{$IFDEF DELPHI16}
+ , FMX.Controls, FMX.Types
+{$ENDIF}
+, FMX.fs_iinterpreter, FMX.fs_iclassesrtti, FMX.fs_igraphicsrtti, FMX.fs_iformsrtti,
+ FMX.fs_iextctrlsrtti, FMX.fs_idialogsrtti, FMX.fs_iinirtti, FMX.fs_imenusrtti,
+ FMX.fs_ipascal, FMX.fs_icpp, FMX.fs_ijs, FMX.fs_ibasic, FMX.fs_tree
+{$IFNDEF CLX}
+, FMX.fs_synmemo
+{$ENDIF}
+;
+
+{-----------------------------------------------------------------------}
+
+{$ifdef FPC}
+procedure RegisterUnitfs_ireg;
+{$else}
+procedure Register;
+{$endif}
+begin
+ {GroupDescendentsWith(TfsExtCtrlsRTTI, TFmxObject);
+ GroupDescendentsWith(TfsDialogsRTTI, TFmxObject);
+ GroupDescendentsWith(TfsGraphicsRTTI, TFmxObject);
+ GroupDescendentsWith(TfsMenusRTTI, TFmxObject);
+ GroupDescendentsWith(TfsScript, TFmxObject);
+ GroupDescendentsWith(TfsIniRTTI, TFmxObject);
+ GroupDescendentsWith(TfsFormsRTTI, TFmxObject);
+ GroupDescendentsWith(TfsClassesRTTI, TFmxObject);
+ GroupDescendentsWith(TfsPascal, TFmxObject);
+ GroupDescendentsWith(TfsCPP, TFmxObject);
+ GroupDescendentsWith(TfsJScript, TFmxObject);
+ GroupDescendentsWith(TfsBasic, TFmxObject);}
+ RegisterComponents('FastScript FMX',
+ [TfsScript, TfsPascal, TfsCPP, TfsJScript, TfsBasic,
+ TfsClassesRTTI, TfsGraphicsRTTI, TfsFormsRTTI, TfsExtCtrlsRTTI,
+ TfsDialogsRTTI, TfsMenusRTTI, TfsIniRTTI,
+ TfsTree, TfsSyntaxMemo]);
+
+end;
+
+{$ifdef FPC}
+procedure Register;
+begin
+ RegisterUnit('fs_ireg', @RegisterUnitfs_ireg);
+end;
+{$endif}
+
+initialization
+{$IFDEF FPC}
+ {$INCLUDE fs_ireg.lrs}
+{$ENDIF}
+end.
diff --git a/LibD28/FMXfs_iteereg.pas b/LibD28/FMXfs_iteereg.pas
new file mode 100644
index 0000000..f47dea6
--- /dev/null
+++ b/LibD28/FMXfs_iteereg.pas
@@ -0,0 +1,38 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMXfs_iteereg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ System.Classes
+, FMX.Types
+, DesignIntf
+, FMX.fs_ichartrtti;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+ //GroupDescendentsWith(TfsChartRTTI, TFmxObject);
+ RegisterComponents('FastScript FMX',
+ [TfsChartRTTI]);
+end;
+
+end.
diff --git a/LibD28/FmxLinuxFrxDBX.dpr b/LibD28/FmxLinuxFrxDBX.dpr
new file mode 100644
index 0000000..59d588e
--- /dev/null
+++ b/LibD28/FmxLinuxFrxDBX.dpr
@@ -0,0 +1,19 @@
+program FmxLinuxFrxDBX;
+
+{$APPTYPE CONSOLE}
+
+uses
+ System.SysUtils,
+ FMX.frxDBXComponents,
+ FMX.frxDBXEditor,
+ FMX.frxDBXRTTI;
+
+
+begin
+ try
+ { TODO -oUser -cConsole Main : Insert code here }
+ except
+ on E: Exception do
+ Writeln(E.ClassName, ': ', E.Message);
+ end;
+end.
diff --git a/LibD28/FmxLinuxFrxExp.dpr b/LibD28/FmxLinuxFrxExp.dpr
new file mode 100644
index 0000000..cd929d8
--- /dev/null
+++ b/LibD28/FmxLinuxFrxExp.dpr
@@ -0,0 +1,47 @@
+program FmxLinuxFrxExp;
+
+{$APPTYPE CONSOLE}
+
+uses
+ System.SysUtils,
+ // FS
+ FMX.frxExportHTML,
+ FMX.frxExportImage,
+ FMX.frxImageConverter,
+ FMX.frxExportMatrix,
+ FMX.frxExportRTF,
+ FMX.frxExportText,
+ FMX.frxExportXML,
+ FMX.frxRC4,
+ FMX.frxCmapTableClass,
+ FMX.frxGlyphTableClass,
+ FMX.frxGlyphSubstitutionClass,
+ FMX.frxHorizontalHeaderClass,
+ FMX.frxHorizontalMetrixClass,
+ FMX.frxIndexToLocationClass,
+ FMX.frxKerningTableClass,
+ FMX.frxPostScriptClass,
+ FMX.frxMaximumProfileClass,
+ FMX.frxOS2WindowsMetricsClass,
+ FMX.frxPreProgramClass,
+ FMX.frxTrueTypeFont,
+ FMX.frxFontHeaderClass,
+ FMX.TTFHelpers,
+ FMX.frxTrueTypeTable,
+ FMX.frxNameTableClass,
+ FMX.frxmd5,
+ FMX.frxCrypto,
+ FMX.frxTrueTypeCollection,
+ FMX.frxExportPDF,
+ FMX.frxExportCSV,
+ FMX.frxrcExports;
+
+
+begin
+ try
+ { TODO -oUser -cConsole Main : Insert code here }
+ except
+ on E: Exception do
+ Writeln(E.ClassName, ': ', E.Message);
+ end;
+end.
diff --git a/LibD28/FmxLinuxFrxFD.dpr b/LibD28/FmxLinuxFrxFD.dpr
new file mode 100644
index 0000000..33bb739
--- /dev/null
+++ b/LibD28/FmxLinuxFrxFD.dpr
@@ -0,0 +1,19 @@
+program FmxLinuxFrxFD;
+
+{$APPTYPE CONSOLE}
+
+uses
+ System.SysUtils,
+ FMX.frxFDComponents,
+ FMX.frxFDEditor,
+ FMX.frxFDRTTI;
+
+
+begin
+ try
+ { TODO -oUser -cConsole Main : Insert code here }
+ except
+ on E: Exception do
+ Writeln(E.ClassName, ': ', E.Message);
+ end;
+end.
diff --git a/LibD28/FmxLinuxFrxIBX.dpr b/LibD28/FmxLinuxFrxIBX.dpr
new file mode 100644
index 0000000..73f5c85
--- /dev/null
+++ b/LibD28/FmxLinuxFrxIBX.dpr
@@ -0,0 +1,20 @@
+program FmxLinuxFrxIBX;
+
+{$APPTYPE CONSOLE}
+
+uses
+ System.SysUtils,
+ FMX.fs_iibxrtti,
+ FMX.frxIBXComponents,
+ FMX.frxIBXEditor,
+ FMX.frxIBXRTTI;
+
+
+begin
+ try
+ { TODO -oUser -cConsole Main : Insert code here }
+ except
+ on E: Exception do
+ Writeln(E.ClassName, ': ', E.Message);
+ end;
+end.
diff --git a/LibD28/FmxLinuxFrxLang.dpr b/LibD28/FmxLinuxFrxLang.dpr
new file mode 100644
index 0000000..534e5b2
--- /dev/null
+++ b/LibD28/FmxLinuxFrxLang.dpr
@@ -0,0 +1,20 @@
+program FmxLinuxFrxCDS;
+
+{$APPTYPE CONSOLE}
+
+uses
+ System.SysUtils,
+ FMX.frxrcClass,
+ FMX.frxrcDesgn,
+ FMX.frxrcInsp,
+ FMX.frxrcExports;
+
+
+begin
+ try
+ { TODO -oUser -cConsole Main : Insert code here }
+ except
+ on E: Exception do
+ Writeln(E.ClassName, ': ', E.Message);
+ end;
+end.
diff --git a/LibD28/FmxLinuxFrxMain.dpr b/LibD28/FmxLinuxFrxMain.dpr
new file mode 100644
index 0000000..16e9cbc
--- /dev/null
+++ b/LibD28/FmxLinuxFrxMain.dpr
@@ -0,0 +1,131 @@
+program FmxLinuxFrxMain;
+
+{$APPTYPE CONSOLE}
+
+uses
+ System.SysUtils,
+ // FS
+ FMX.fs_ipascal,
+ FMX.fs_icpp,
+ FMX.fs_ijs,
+ FMX.fs_ibasic,
+ FMX.fs_iclassesrtti,
+ FMX.fs_iconst,
+ FMX.fs_idialogsrtti,
+ FMX.fs_ievents,
+ FMX.fs_iexpression,
+ FMX.fs_iextctrlsrtti,
+ FMX.fs_iformsrtti,
+ FMX.fs_igraphicsrtti,
+ FMX.fs_iilparser,
+ FMX.fs_iinirtti,
+ FMX.fs_iinterpreter,
+ FMX.fs_iparser,
+ FMX.fs_isysrtti,
+ FMX.fs_imenusrtti,
+ FMX.fs_itools,
+ FMX.fs_xml,
+ FMX.fs_synmemo,
+ FMX.fs_tree,
+ //FS DB
+ FMX.fs_idbrtti,
+ FMX.frxAggregate,
+ FMX.frxClass,
+ FMX.frxClassRTTI,
+ FMX.frxCtrls,
+ FMX.frxDialogForm,
+ FMX.frxDMPClass,
+ FMX.frxEngine,
+ FMX.frxFMX,
+ FMX.frxGraphicUtils,
+ FMX.frxPassw,
+ FMX.frxPictureCache,
+ FMX.frxPreview,
+ FMX.frxPreviewPages,
+ FMX.frxPreviewPageSettings,
+ FMX.frxPrintDialog,
+ FMX.frxPrinter,
+ FMX.Linux.frxPrinter,
+ FMX.frxProgress,
+ FMX.frxrcClass,
+ FMX.frxRes,
+ FMX.frxSearchDialog,
+ FMX.frxUnicodeUtils,
+ FMX.frxUtils,
+ FMX.frxVariables,
+ FMX.frxXML,
+ FMX.frxXMLSerializer,
+ FMX.frxAbout,
+ FMX.frxCodeUtils,
+ FMX.frxCustomEditors,
+ FMX.frxDataTree,
+ FMX.frxDesgn,
+ FMX.frxDesgnEditors,
+ FMX.frxDesgnWorkspace,
+ FMX.frxDesgnWorkspace1,
+ FMX.frxDsgnIntf,
+ FMX.frxEditDataBand,
+ FMX.frxEditExpr,
+ FMX.frxEditFormat,
+ FMX.frxEditFrame,
+ FMX.frxEditGroup,
+ FMX.frxEditHighlight,
+ FMX.frxEditMemo,
+ FMX.frxEditOptions,
+ FMX.frxEditPage,
+ FMX.frxEditPicture,
+ FMX.frxEditReport,
+ FMX.frxEditReportData,
+ FMX.frxEditStrings,
+ FMX.frxEditStyle,
+ FMX.frxEditSysMemo,
+ FMX.frxEditTabOrder,
+ FMX.frxEditVar,
+ FMX.frxEvaluateForm,
+ FMX.frxInheritError,
+ FMX.frxInsp,
+ FMX.frxPopupForm,
+ FMX.frxrcDesgn,
+ FMX.frxrcInsp,
+ FMX.frxReportTree,
+ FMX.frxWatchForm,
+{$IFNDEF RAD_ED}
+ FMX.frxCross,
+ FMX.frxCrossEditor,
+ FMX.frxCrossRTTI,
+ FMX.frxDCtrl,
+ FMX.frxDCtrlRTTI,
+ FMX.frxGradient,
+ FMX.frxGradientRTTI,
+ FMX.frxGZip,
+ FMX.frxDesgnCtrls,
+ FMX.frxBarcode2DView,
+ FMX.frxBarcode2DBase,
+ FMX.frxBarcode,
+ FMX.frxBarcod,
+ FMX.frxBarcodeEditor,
+ FMX.frxBarcodeProperties,
+ FMX.frxBarcodeDataMatrix,
+ FMX.frxBarcodePDF417,
+ FMX.frxBarcodeRTTI,
+ FMX.frxChBox,
+ FMX.frxChBoxRTTI,
+{$ENDIF}
+ FMX.frxEditAliases,
+ FMX.frxDBSet,
+ FMX.frxCustomDB,
+ FMX.frxCustomDBRTTI,
+ FMX.frxCustomDBEditor,
+ FMX.frxConnWizard,
+ FMX.frxEditQueryParams,
+ FMX.frxEditSQL,
+ FMX.frxEditMD;
+
+begin
+ try
+ { TODO -oUser -cConsole Main : Insert code here }
+ except
+ on E: Exception do
+ Writeln(E.ClassName, ': ', E.Message);
+ end;
+end.
diff --git a/LibD28/FmxLinuxFrxTee.dpr b/LibD28/FmxLinuxFrxTee.dpr
new file mode 100644
index 0000000..7cf2c4f
--- /dev/null
+++ b/LibD28/FmxLinuxFrxTee.dpr
@@ -0,0 +1,21 @@
+program FmxLinuxFrxIBX;
+
+{$APPTYPE CONSOLE}
+
+uses
+ System.SysUtils,
+ FMX.fs_ichartrtti,
+ FMX.frxChart,
+ FMX.frxChartEditor,
+ FMX.frxChartGallery,
+ FMX.frxChartHelpers,
+ FMX.frxChartRTTI;
+
+begin
+ try
+ { TODO -oUser -cConsole Main : Insert code here }
+ except
+ on E: Exception do
+ Writeln(E.ClassName, ': ', E.Message);
+ end;
+end.
diff --git a/LibD28/ProjectGroup1.groupproj b/LibD28/ProjectGroup1.groupproj
new file mode 100644
index 0000000..c9afb46
--- /dev/null
+++ b/LibD28/ProjectGroup1.groupproj
@@ -0,0 +1,300 @@
+
+
+ {2368493A-9C1D-44E0-89E0-D46359B5DF55}
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Default.Personality.12
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/LibD28/dclFMXfrx16.dpk b/LibD28/dclFMXfrx16.dpk
new file mode 100644
index 0000000..39b6a5c
--- /dev/null
+++ b/LibD28/dclFMXfrx16.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio XE2
+
+package dclFMXfrx16;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx16;
+
+contains
+ FMXfrxReg in 'FMXfrxReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrx16.res b/LibD28/dclFMXfrx16.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrx16.res differ
diff --git a/LibD28/dclFMXfrx17.dpk b/LibD28/dclFMXfrx17.dpk
new file mode 100644
index 0000000..4ecdbc5
--- /dev/null
+++ b/LibD28/dclFMXfrx17.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio XE3
+
+package dclFMXfrx17;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx17;
+
+contains
+ FMXfrxReg in 'FMXfrxReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrx17.res b/LibD28/dclFMXfrx17.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrx17.res differ
diff --git a/LibD28/dclFMXfrx18.dpk b/LibD28/dclFMXfrx18.dpk
new file mode 100644
index 0000000..6b4aeaf
--- /dev/null
+++ b/LibD28/dclFMXfrx18.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio XE4
+
+package dclFMXfrx18;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx18;
+
+contains
+ FMXfrxReg in 'FMXfrxReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrx18.res b/LibD28/dclFMXfrx18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrx18.res differ
diff --git a/LibD28/dclFMXfrx19.dpk b/LibD28/dclFMXfrx19.dpk
new file mode 100644
index 0000000..b7e874f
--- /dev/null
+++ b/LibD28/dclFMXfrx19.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio XE5
+
+package dclFMXfrx19;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx19;
+
+contains
+ FMXfrxReg in 'FMXfrxReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrx19.res b/LibD28/dclFMXfrx19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrx19.res differ
diff --git a/LibD28/dclFMXfrx20.dpk b/LibD28/dclFMXfrx20.dpk
new file mode 100644
index 0000000..869b825
--- /dev/null
+++ b/LibD28/dclFMXfrx20.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio XE6
+
+package dclFMXfrx20;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx20;
+
+contains
+ FMXfrxReg in 'FMXfrxReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrx20.res b/LibD28/dclFMXfrx20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrx20.res differ
diff --git a/LibD28/dclFMXfrx21.dpk b/LibD28/dclFMXfrx21.dpk
new file mode 100644
index 0000000..8dd411b
--- /dev/null
+++ b/LibD28/dclFMXfrx21.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio XE7
+
+package dclFMXfrx21;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx21;
+
+contains
+ FMXfrxReg in 'FMXfrxReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrx21.res b/LibD28/dclFMXfrx21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrx21.res differ
diff --git a/LibD28/dclFMXfrx22.dpk b/LibD28/dclFMXfrx22.dpk
new file mode 100644
index 0000000..2554ad8
--- /dev/null
+++ b/LibD28/dclFMXfrx22.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio XE8
+
+package dclFMXfrx22;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx22;
+
+contains
+ FMXfrxReg in 'FMXfrxReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrx22.res b/LibD28/dclFMXfrx22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrx22.res differ
diff --git a/LibD28/dclFMXfrx23.dpk b/LibD28/dclFMXfrx23.dpk
new file mode 100644
index 0000000..0b5fb5b
--- /dev/null
+++ b/LibD28/dclFMXfrx23.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio 10 Seattle
+
+package dclFMXfrx23;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx23;
+
+contains
+ FMXfrxReg in 'FMXfrxReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrx23.res b/LibD28/dclFMXfrx23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrx23.res differ
diff --git a/LibD28/dclFMXfrx24.dpk b/LibD28/dclFMXfrx24.dpk
new file mode 100644
index 0000000..5daff00
--- /dev/null
+++ b/LibD28/dclFMXfrx24.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio 10 Seattle
+
+package dclFMXfrx24;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx24;
+
+contains
+ FMXfrxReg in 'FMXfrxReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrx24.res b/LibD28/dclFMXfrx24.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrx24.res differ
diff --git a/LibD28/dclFMXfrx25.dpk b/LibD28/dclFMXfrx25.dpk
new file mode 100644
index 0000000..bfff40d
--- /dev/null
+++ b/LibD28/dclFMXfrx25.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio 10 Seattle
+
+package dclFMXfrx25;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx25;
+
+contains
+ FMXfrxReg in 'FMXfrxReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrx25.otares b/LibD28/dclFMXfrx25.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/dclFMXfrx25.otares differ
diff --git a/LibD28/dclFMXfrx25.res b/LibD28/dclFMXfrx25.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrx25.res differ
diff --git a/LibD28/dclFMXfrx26.dpk b/LibD28/dclFMXfrx26.dpk
new file mode 100644
index 0000000..6d4f89d
--- /dev/null
+++ b/LibD28/dclFMXfrx26.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio 10 Seattle
+
+package dclFMXfrx26;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx26;
+
+contains
+ FMXfrxReg in 'FMXfrxReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrx27.dpk b/LibD28/dclFMXfrx27.dpk
new file mode 100644
index 0000000..868e3f2
--- /dev/null
+++ b/LibD28/dclFMXfrx27.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio 10 Seattle
+
+package dclFMXfrx27;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx27;
+
+contains
+ FMXfrxReg in 'FMXfrxReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrx29.dpk b/LibD28/dclFMXfrx29.dpk
new file mode 100644
index 0000000..82c975f
--- /dev/null
+++ b/LibD28/dclFMXfrx29.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio 12
+
+package dclFMXfrx29;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx29;
+
+contains
+ FMXfrxReg in 'FMXfrxReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrx29.dproj b/LibD28/dclFMXfrx29.dproj
new file mode 100644
index 0000000..73aad97
--- /dev/null
+++ b/LibD28/dclFMXfrx29.dproj
@@ -0,0 +1,118 @@
+
+
+ {17F89DED-58F9-4C1A-9769-D5CEC74B008A}
+ dclFMXfrx29.dpk
+ True
+ Release
+ 1
+ Package
+ None
+ 20.1
+ Win32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ dclFMXfrx29
+ 1
+ true
+ FastReport FMX 2.0 Components
+ true
+ true
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+ fmx;FMXfrx29;$(DCC_UsePackage)
+
+
+ fmx;$(DCC_UsePackage)
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ dclFMXfrx29.dpk
+
+
+
+ True
+ False
+
+
+ 12
+
+
+
+
diff --git a/LibD28/dclFMXfrx29.res b/LibD28/dclFMXfrx29.res
new file mode 100644
index 0000000..1e1bf70
Binary files /dev/null and b/LibD28/dclFMXfrx29.res differ
diff --git a/LibD28/dclFMXfrxADO16.dpk b/LibD28/dclFMXfrxADO16.dpk
new file mode 100644
index 0000000..bb2fc7a
--- /dev/null
+++ b/LibD28/dclFMXfrxADO16.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE2
+
+package dclFMXfrxADO16;
+
+{$R 'FMXfrxADOReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxADO16;
+
+contains
+ FMXfrxADOReg in 'FMXfrxADOReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxADO16.res b/LibD28/dclFMXfrxADO16.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxADO16.res differ
diff --git a/LibD28/dclFMXfrxADO17.dpk b/LibD28/dclFMXfrxADO17.dpk
new file mode 100644
index 0000000..124a349
--- /dev/null
+++ b/LibD28/dclFMXfrxADO17.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE3
+
+package dclFMXfrxADO17;
+
+{$R 'FMXfrxADOReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxADO17;
+
+contains
+ FMXfrxADOReg in 'FMXfrxADOReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxADO17.res b/LibD28/dclFMXfrxADO17.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxADO17.res differ
diff --git a/LibD28/dclFMXfrxADO18.dpk b/LibD28/dclFMXfrxADO18.dpk
new file mode 100644
index 0000000..0ce903c
--- /dev/null
+++ b/LibD28/dclFMXfrxADO18.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE4
+
+package dclFMXfrxADO18;
+
+{$R 'FMXfrxADOReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxADO18;
+
+contains
+ FMXfrxADOReg in 'FMXfrxADOReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxADO18.res b/LibD28/dclFMXfrxADO18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxADO18.res differ
diff --git a/LibD28/dclFMXfrxADO19.dpk b/LibD28/dclFMXfrxADO19.dpk
new file mode 100644
index 0000000..61151e4
--- /dev/null
+++ b/LibD28/dclFMXfrxADO19.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE5
+
+package dclFMXfrxADO19;
+
+{$R 'FMXfrxADOReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxADO19;
+
+contains
+ FMXfrxADOReg in 'FMXfrxADOReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxADO19.res b/LibD28/dclFMXfrxADO19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxADO19.res differ
diff --git a/LibD28/dclFMXfrxADO20.dpk b/LibD28/dclFMXfrxADO20.dpk
new file mode 100644
index 0000000..9880908
--- /dev/null
+++ b/LibD28/dclFMXfrxADO20.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE6
+
+package dclFMXfrxADO20;
+
+{$R 'FMXfrxADOReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxADO20;
+
+contains
+ FMXfrxADOReg in 'FMXfrxADOReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxADO20.res b/LibD28/dclFMXfrxADO20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxADO20.res differ
diff --git a/LibD28/dclFMXfrxADO21.dpk b/LibD28/dclFMXfrxADO21.dpk
new file mode 100644
index 0000000..0ede14a
--- /dev/null
+++ b/LibD28/dclFMXfrxADO21.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE7
+
+package dclFMXfrxADO21;
+
+{$R 'FMXfrxADOReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxADO21;
+
+contains
+ FMXfrxADOReg in 'FMXfrxADOReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxADO21.res b/LibD28/dclFMXfrxADO21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxADO21.res differ
diff --git a/LibD28/dclFMXfrxADO22.dpk b/LibD28/dclFMXfrxADO22.dpk
new file mode 100644
index 0000000..020eecb
--- /dev/null
+++ b/LibD28/dclFMXfrxADO22.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE8
+
+package dclFMXfrxADO22;
+
+{$R 'FMXfrxADOReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxADO22;
+
+contains
+ FMXfrxADOReg in 'FMXfrxADOReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxADO22.res b/LibD28/dclFMXfrxADO22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxADO22.res differ
diff --git a/LibD28/dclFMXfrxADO23.dpk b/LibD28/dclFMXfrxADO23.dpk
new file mode 100644
index 0000000..c38a31f
--- /dev/null
+++ b/LibD28/dclFMXfrxADO23.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfrxADO23;
+
+{$R 'FMXfrxADOReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxADO23;
+
+contains
+ FMXfrxADOReg in 'FMXfrxADOReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxADO23.res b/LibD28/dclFMXfrxADO23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxADO23.res differ
diff --git a/LibD28/dclFMXfrxADO24.dpk b/LibD28/dclFMXfrxADO24.dpk
new file mode 100644
index 0000000..33226c6
--- /dev/null
+++ b/LibD28/dclFMXfrxADO24.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfrxADO24;
+
+{$R 'FMXfrxADOReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxADO24;
+
+contains
+ FMXfrxADOReg in 'FMXfrxADOReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxADO24.res b/LibD28/dclFMXfrxADO24.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxADO24.res differ
diff --git a/LibD28/dclFMXfrxADO25.dpk b/LibD28/dclFMXfrxADO25.dpk
new file mode 100644
index 0000000..4c49dc3
--- /dev/null
+++ b/LibD28/dclFMXfrxADO25.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfrxADO25;
+
+{$R 'FMXfrxADOReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxADO25;
+
+contains
+ FMXfrxADOReg in 'FMXfrxADOReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxADO25.res b/LibD28/dclFMXfrxADO25.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxADO25.res differ
diff --git a/LibD28/dclFMXfrxADO26.dpk b/LibD28/dclFMXfrxADO26.dpk
new file mode 100644
index 0000000..3c95ec9
--- /dev/null
+++ b/LibD28/dclFMXfrxADO26.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfrxADO26;
+
+{$R 'FMXfrxADOReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxADO26;
+
+contains
+ FMXfrxADOReg in 'FMXfrxADOReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxADO27.dpk b/LibD28/dclFMXfrxADO27.dpk
new file mode 100644
index 0000000..f77a6ca
--- /dev/null
+++ b/LibD28/dclFMXfrxADO27.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfrxADO27;
+
+{$R 'FMXfrxADOReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxADO27;
+
+contains
+ FMXfrxADOReg in 'FMXfrxADOReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxADO28.dpk b/LibD28/dclFMXfrxADO28.dpk
new file mode 100644
index 0000000..f0804d2
--- /dev/null
+++ b/LibD28/dclFMXfrxADO28.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 11 Seattle
+
+package dclFMXfrxADO28;
+
+{$R 'FMXfrxADOReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxADO28;
+
+contains
+ FMXfrxADOReg in 'FMXfrxADOReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxADO29.dpk b/LibD28/dclFMXfrxADO29.dpk
new file mode 100644
index 0000000..2f7de7a
--- /dev/null
+++ b/LibD28/dclFMXfrxADO29.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 12
+
+package dclFMXfrxADO29;
+
+{$R 'FMXfrxADOReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxADO29;
+
+contains
+ FMXfrxADOReg in 'FMXfrxADOReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDB16.dpk b/LibD28/dclFMXfrxDB16.dpk
new file mode 100644
index 0000000..ece6a24
--- /dev/null
+++ b/LibD28/dclFMXfrxDB16.dpk
@@ -0,0 +1,40 @@
+// Package file for Rad Studio XE2
+
+package dclFMXfrxDB16;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx16,
+ FMXfrxDB16;
+
+contains
+ FMXfrxRegDB in 'FMXfrxRegDB.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDB16.res b/LibD28/dclFMXfrxDB16.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxDB16.res differ
diff --git a/LibD28/dclFMXfrxDB17.dpk b/LibD28/dclFMXfrxDB17.dpk
new file mode 100644
index 0000000..43df81b
--- /dev/null
+++ b/LibD28/dclFMXfrxDB17.dpk
@@ -0,0 +1,40 @@
+// Package file for Rad Studio XE3
+
+package dclFMXfrxDB17;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx17,
+ FMXfrxDB17;
+
+contains
+ FMXfrxRegDB in 'FMXfrxRegDB.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDB17.res b/LibD28/dclFMXfrxDB17.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxDB17.res differ
diff --git a/LibD28/dclFMXfrxDB18.dpk b/LibD28/dclFMXfrxDB18.dpk
new file mode 100644
index 0000000..90b99c3
--- /dev/null
+++ b/LibD28/dclFMXfrxDB18.dpk
@@ -0,0 +1,40 @@
+// Package file for Rad Studio XE4
+
+package dclFMXfrxDB18;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx18,
+ FMXfrxDB18;
+
+contains
+ FMXfrxRegDB in 'FMXfrxRegDB.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDB18.res b/LibD28/dclFMXfrxDB18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxDB18.res differ
diff --git a/LibD28/dclFMXfrxDB19.dpk b/LibD28/dclFMXfrxDB19.dpk
new file mode 100644
index 0000000..0c0d8b5
--- /dev/null
+++ b/LibD28/dclFMXfrxDB19.dpk
@@ -0,0 +1,40 @@
+// Package file for Rad Studio XE5
+
+package dclFMXfrxDB19;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx19,
+ FMXfrxDB19;
+
+contains
+ FMXfrxRegDB in 'FMXfrxRegDB.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDB19.res b/LibD28/dclFMXfrxDB19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxDB19.res differ
diff --git a/LibD28/dclFMXfrxDB20.dpk b/LibD28/dclFMXfrxDB20.dpk
new file mode 100644
index 0000000..243156f
--- /dev/null
+++ b/LibD28/dclFMXfrxDB20.dpk
@@ -0,0 +1,40 @@
+// Package file for Rad Studio XE6
+
+package dclFMXfrxDB20;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx20,
+ FMXfrxDB20;
+
+contains
+ FMXfrxRegDB in 'FMXfrxRegDB.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDB20.res b/LibD28/dclFMXfrxDB20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxDB20.res differ
diff --git a/LibD28/dclFMXfrxDB21.dpk b/LibD28/dclFMXfrxDB21.dpk
new file mode 100644
index 0000000..ca8716a
--- /dev/null
+++ b/LibD28/dclFMXfrxDB21.dpk
@@ -0,0 +1,40 @@
+// Package file for Rad Studio XE7
+
+package dclFMXfrxDB21;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx21,
+ FMXfrxDB21;
+
+contains
+ FMXfrxRegDB in 'FMXfrxRegDB.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDB21.res b/LibD28/dclFMXfrxDB21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxDB21.res differ
diff --git a/LibD28/dclFMXfrxDB22.dpk b/LibD28/dclFMXfrxDB22.dpk
new file mode 100644
index 0000000..66a0e70
--- /dev/null
+++ b/LibD28/dclFMXfrxDB22.dpk
@@ -0,0 +1,40 @@
+// Package file for Rad Studio XE8
+
+package dclFMXfrxDB22;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx22,
+ FMXfrxDB22;
+
+contains
+ FMXfrxRegDB in 'FMXfrxRegDB.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDB22.res b/LibD28/dclFMXfrxDB22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxDB22.res differ
diff --git a/LibD28/dclFMXfrxDB23.dpk b/LibD28/dclFMXfrxDB23.dpk
new file mode 100644
index 0000000..ddef496
--- /dev/null
+++ b/LibD28/dclFMXfrxDB23.dpk
@@ -0,0 +1,40 @@
+// Package file for Rad Studio 10 Seattle
+
+package dclFMXfrxDB23;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx23,
+ FMXfrxDB23;
+
+contains
+ FMXfrxRegDB in 'FMXfrxRegDB.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDB23.res b/LibD28/dclFMXfrxDB23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxDB23.res differ
diff --git a/LibD28/dclFMXfrxDB24.dpk b/LibD28/dclFMXfrxDB24.dpk
new file mode 100644
index 0000000..eaf5ae0
--- /dev/null
+++ b/LibD28/dclFMXfrxDB24.dpk
@@ -0,0 +1,40 @@
+// Package file for Rad Studio 10 Seattle
+
+package dclFMXfrxDB24;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx24,
+ FMXfrxDB24;
+
+contains
+ FMXfrxRegDB in 'FMXfrxRegDB.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDB24.res b/LibD28/dclFMXfrxDB24.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxDB24.res differ
diff --git a/LibD28/dclFMXfrxDB25.dpk b/LibD28/dclFMXfrxDB25.dpk
new file mode 100644
index 0000000..8c294b1
--- /dev/null
+++ b/LibD28/dclFMXfrxDB25.dpk
@@ -0,0 +1,40 @@
+// Package file for Rad Studio 10 Seattle
+
+package dclFMXfrxDB25;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx25,
+ FMXfrxDB25;
+
+contains
+ FMXfrxRegDB in 'FMXfrxRegDB.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDB25.otares b/LibD28/dclFMXfrxDB25.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/dclFMXfrxDB25.otares differ
diff --git a/LibD28/dclFMXfrxDB25.res b/LibD28/dclFMXfrxDB25.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxDB25.res differ
diff --git a/LibD28/dclFMXfrxDB26.dpk b/LibD28/dclFMXfrxDB26.dpk
new file mode 100644
index 0000000..5805cae
--- /dev/null
+++ b/LibD28/dclFMXfrxDB26.dpk
@@ -0,0 +1,40 @@
+// Package file for Rad Studio 10 Seattle
+
+package dclFMXfrxDB26;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx26,
+ FMXfrxDB26;
+
+contains
+ FMXfrxRegDB in 'FMXfrxRegDB.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDB27.dpk b/LibD28/dclFMXfrxDB27.dpk
new file mode 100644
index 0000000..99d65e9
--- /dev/null
+++ b/LibD28/dclFMXfrxDB27.dpk
@@ -0,0 +1,40 @@
+// Package file for Rad Studio 10 Seattle
+
+package dclFMXfrxDB27;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx27,
+ FMXfrxDB27;
+
+contains
+ FMXfrxRegDB in 'FMXfrxRegDB.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDB29.dpk b/LibD28/dclFMXfrxDB29.dpk
new file mode 100644
index 0000000..0d600a2
--- /dev/null
+++ b/LibD28/dclFMXfrxDB29.dpk
@@ -0,0 +1,40 @@
+// Package file for Rad Studio 12
+
+package dclFMXfrxDB29;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrx29,
+ FMXfrxDB29;
+
+contains
+ FMXfrxRegDB in 'FMXfrxRegDB.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDB29.dproj b/LibD28/dclFMXfrxDB29.dproj
new file mode 100644
index 0000000..156dc6c
--- /dev/null
+++ b/LibD28/dclFMXfrxDB29.dproj
@@ -0,0 +1,119 @@
+
+
+ {08CD5491-931C-47A1-8125-291E0DD174DC}
+ dclFMXfrxDB29.dpk
+ True
+ Release
+ 1
+ Package
+ None
+ 20.1
+ Win32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ dclFMXfrxDB29
+ 1
+ true
+ FastReport FMX 2.0 DB Components
+ true
+ true
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+ fmx;FMXfrx29;FMXfrxDB29;$(DCC_UsePackage)
+
+
+ fmx;$(DCC_UsePackage)
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ dclFMXfrxDB29.dpk
+
+
+
+ True
+ False
+
+
+ 12
+
+
+
+
diff --git a/LibD28/dclFMXfrxDB29.res b/LibD28/dclFMXfrxDB29.res
new file mode 100644
index 0000000..f311d78
Binary files /dev/null and b/LibD28/dclFMXfrxDB29.res differ
diff --git a/LibD28/dclFMXfrxDBX16.dpk b/LibD28/dclFMXfrxDBX16.dpk
new file mode 100644
index 0000000..512b379
--- /dev/null
+++ b/LibD28/dclFMXfrxDBX16.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE2
+
+package dclFMXfrxDBX16;
+
+{$R 'FMXfrxDBXReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxDBX16;
+
+contains
+ FMXfrxDBXReg in 'FMXfrxDBXReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDBX16.res b/LibD28/dclFMXfrxDBX16.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxDBX16.res differ
diff --git a/LibD28/dclFMXfrxDBX17.dpk b/LibD28/dclFMXfrxDBX17.dpk
new file mode 100644
index 0000000..3786aa1
--- /dev/null
+++ b/LibD28/dclFMXfrxDBX17.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE3
+
+package dclFMXfrxDBX17;
+
+{$R 'FMXfrxDBXReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxDBX17;
+
+contains
+ FMXfrxDBXReg in 'FMXfrxDBXReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDBX17.res b/LibD28/dclFMXfrxDBX17.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxDBX17.res differ
diff --git a/LibD28/dclFMXfrxDBX18.dpk b/LibD28/dclFMXfrxDBX18.dpk
new file mode 100644
index 0000000..13a2357
--- /dev/null
+++ b/LibD28/dclFMXfrxDBX18.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE4
+
+package dclFMXfrxDBX18;
+
+{$R 'FMXfrxDBXReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxDBX18;
+
+contains
+ FMXfrxDBXReg in 'FMXfrxDBXReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDBX18.res b/LibD28/dclFMXfrxDBX18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxDBX18.res differ
diff --git a/LibD28/dclFMXfrxDBX19.dpk b/LibD28/dclFMXfrxDBX19.dpk
new file mode 100644
index 0000000..7826c83
--- /dev/null
+++ b/LibD28/dclFMXfrxDBX19.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE5
+
+package dclFMXfrxDBX19;
+
+{$R 'FMXfrxDBXReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxDBX19;
+
+contains
+ FMXfrxDBXReg in 'FMXfrxDBXReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDBX19.res b/LibD28/dclFMXfrxDBX19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxDBX19.res differ
diff --git a/LibD28/dclFMXfrxDBX20.dpk b/LibD28/dclFMXfrxDBX20.dpk
new file mode 100644
index 0000000..cec39b0
--- /dev/null
+++ b/LibD28/dclFMXfrxDBX20.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE6
+
+package dclFMXfrxDBX20;
+
+{$R 'FMXfrxDBXReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxDBX20;
+
+contains
+ FMXfrxDBXReg in 'FMXfrxDBXReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDBX20.res b/LibD28/dclFMXfrxDBX20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxDBX20.res differ
diff --git a/LibD28/dclFMXfrxDBX21.dpk b/LibD28/dclFMXfrxDBX21.dpk
new file mode 100644
index 0000000..67a4d41
--- /dev/null
+++ b/LibD28/dclFMXfrxDBX21.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE7
+
+package dclFMXfrxDBX21;
+
+{$R 'FMXfrxDBXReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxDBX21;
+
+contains
+ FMXfrxDBXReg in 'FMXfrxDBXReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDBX21.res b/LibD28/dclFMXfrxDBX21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxDBX21.res differ
diff --git a/LibD28/dclFMXfrxDBX22.dpk b/LibD28/dclFMXfrxDBX22.dpk
new file mode 100644
index 0000000..9ca0ffa
--- /dev/null
+++ b/LibD28/dclFMXfrxDBX22.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE8
+
+package dclFMXfrxDBX22;
+
+{$R 'FMXfrxDBXReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxDBX22;
+
+contains
+ FMXfrxDBXReg in 'FMXfrxDBXReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDBX22.res b/LibD28/dclFMXfrxDBX22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxDBX22.res differ
diff --git a/LibD28/dclFMXfrxDBX23.dpk b/LibD28/dclFMXfrxDBX23.dpk
new file mode 100644
index 0000000..5b5b606
--- /dev/null
+++ b/LibD28/dclFMXfrxDBX23.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfrxDBX23;
+
+{$R 'FMXfrxDBXReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxDBX23;
+
+contains
+ FMXfrxDBXReg in 'FMXfrxDBXReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDBX23.res b/LibD28/dclFMXfrxDBX23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxDBX23.res differ
diff --git a/LibD28/dclFMXfrxDBX24.dpk b/LibD28/dclFMXfrxDBX24.dpk
new file mode 100644
index 0000000..a8eeeb7
--- /dev/null
+++ b/LibD28/dclFMXfrxDBX24.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfrxDBX24;
+
+{$R 'FMXfrxDBXReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxDBX24;
+
+contains
+ FMXfrxDBXReg in 'FMXfrxDBXReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDBX24.res b/LibD28/dclFMXfrxDBX24.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxDBX24.res differ
diff --git a/LibD28/dclFMXfrxDBX25.dpk b/LibD28/dclFMXfrxDBX25.dpk
new file mode 100644
index 0000000..a9ac249
--- /dev/null
+++ b/LibD28/dclFMXfrxDBX25.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfrxDBX25;
+
+{$R 'FMXfrxDBXReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxDBX25;
+
+contains
+ FMXfrxDBXReg in 'FMXfrxDBXReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDBX25.res b/LibD28/dclFMXfrxDBX25.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxDBX25.res differ
diff --git a/LibD28/dclFMXfrxDBX26.dpk b/LibD28/dclFMXfrxDBX26.dpk
new file mode 100644
index 0000000..ec145cd
--- /dev/null
+++ b/LibD28/dclFMXfrxDBX26.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfrxDBX26;
+
+{$R 'FMXfrxDBXReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxDBX26;
+
+contains
+ FMXfrxDBXReg in 'FMXfrxDBXReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDBX27.dpk b/LibD28/dclFMXfrxDBX27.dpk
new file mode 100644
index 0000000..80a4271
--- /dev/null
+++ b/LibD28/dclFMXfrxDBX27.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfrxDBX27;
+
+{$R 'FMXfrxDBXReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxDBX27;
+
+contains
+ FMXfrxDBXReg in 'FMXfrxDBXReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDBX28.dproj b/LibD28/dclFMXfrxDBX28.dproj
new file mode 100644
index 0000000..efcb09e
--- /dev/null
+++ b/LibD28/dclFMXfrxDBX28.dproj
@@ -0,0 +1,114 @@
+
+
+ {9CDEC7C2-CCF4-4153-A7EC-2E4345E7FE68}
+ dclFMXfrxDBX28.dpk
+ True
+ Debug
+ 1
+ Package
+ None
+ 20.1
+ Win32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ dclFMXfrxDBX28
+ 1
+ true
+ FastReport FMX 2.0 DBX Components
+ true
+ true
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ dclFMXfrxDBX28.dpk
+
+
+
+ False
+ False
+ False
+ False
+ False
+ True
+ False
+
+
+ 12
+
+
+
+
diff --git a/LibD28/dclFMXfrxDBX29.dpk b/LibD28/dclFMXfrxDBX29.dpk
new file mode 100644
index 0000000..dc9ad5c
--- /dev/null
+++ b/LibD28/dclFMXfrxDBX29.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 12
+
+package dclFMXfrxDBX29;
+
+{$R 'FMXfrxDBXReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 DBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxDBX29;
+
+contains
+ FMXfrxDBXReg in 'FMXfrxDBXReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxDBX29.dproj b/LibD28/dclFMXfrxDBX29.dproj
new file mode 100644
index 0000000..8e01f19
--- /dev/null
+++ b/LibD28/dclFMXfrxDBX29.dproj
@@ -0,0 +1,109 @@
+
+
+ {61641E17-7236-415B-87EB-76DACA80F34F}
+ dclFMXfrxDBX29.dpk
+ True
+ Release
+ 1
+ Package
+ None
+ 20.1
+ Win32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ dclFMXfrxDBX29
+ 1
+ true
+ FastReport FMX 2.0 DBX Components
+ true
+ true
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ dclFMXfrxDBX29.dpk
+
+
+
+ True
+ False
+
+
+ 12
+
+
+
+
diff --git a/LibD28/dclFMXfrxDBX29.res b/LibD28/dclFMXfrxDBX29.res
new file mode 100644
index 0000000..87fb8e2
Binary files /dev/null and b/LibD28/dclFMXfrxDBX29.res differ
diff --git a/LibD28/dclFMXfrxFD18.dpk b/LibD28/dclFMXfrxFD18.dpk
new file mode 100644
index 0000000..58dd1b7
--- /dev/null
+++ b/LibD28/dclFMXfrxFD18.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE4
+
+package dclFMXfrxFD18;
+
+{$R *.res}
+{$R 'FMXfrxFDReg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastReport FMX 2.0 FireDAC Components - Designtime Package'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx,
+ DESIGNIDE,
+ FMXfrxFD18;
+
+contains
+ FMX.frxFDReg in 'FMX.frxFDReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxFD18.res b/LibD28/dclFMXfrxFD18.res
new file mode 100644
index 0000000..8b39f81
Binary files /dev/null and b/LibD28/dclFMXfrxFD18.res differ
diff --git a/LibD28/dclFMXfrxFD19.dpk b/LibD28/dclFMXfrxFD19.dpk
new file mode 100644
index 0000000..656587e
--- /dev/null
+++ b/LibD28/dclFMXfrxFD19.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE5
+
+package dclFMXfrxFD19;
+
+{$R *.res}
+{$R 'FMXfrxFDReg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastReport FMX 2.0 FireDAC Components - Designtime Package'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx,
+ DESIGNIDE,
+ FMXfrxFD19;
+
+contains
+ FMX.frxFDReg in 'FMX.frxFDReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxFD19.res b/LibD28/dclFMXfrxFD19.res
new file mode 100644
index 0000000..8b39f81
Binary files /dev/null and b/LibD28/dclFMXfrxFD19.res differ
diff --git a/LibD28/dclFMXfrxFD20.dpk b/LibD28/dclFMXfrxFD20.dpk
new file mode 100644
index 0000000..fc9afec
--- /dev/null
+++ b/LibD28/dclFMXfrxFD20.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE6
+
+package dclFMXfrxFD20;
+
+{$R *.res}
+{$R 'FMXfrxFDReg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastReport FMX 2.0 FireDAC Components - Designtime Package'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx,
+ DESIGNIDE,
+ FMXfrxFD20;
+
+contains
+ FMX.frxFDReg in 'FMX.frxFDReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxFD20.res b/LibD28/dclFMXfrxFD20.res
new file mode 100644
index 0000000..8b39f81
Binary files /dev/null and b/LibD28/dclFMXfrxFD20.res differ
diff --git a/LibD28/dclFMXfrxFD21.dpk b/LibD28/dclFMXfrxFD21.dpk
new file mode 100644
index 0000000..22c624b
--- /dev/null
+++ b/LibD28/dclFMXfrxFD21.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE7
+
+package dclFMXfrxFD21;
+
+{$R *.res}
+{$R 'FMXfrxFDReg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastReport FMX 2.0 FireDAC Components - Designtime Package'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx,
+ DESIGNIDE,
+ FMXfrxFD21;
+
+contains
+ FMX.frxFDReg in 'FMX.frxFDReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxFD21.res b/LibD28/dclFMXfrxFD21.res
new file mode 100644
index 0000000..8b39f81
Binary files /dev/null and b/LibD28/dclFMXfrxFD21.res differ
diff --git a/LibD28/dclFMXfrxFD22.dpk b/LibD28/dclFMXfrxFD22.dpk
new file mode 100644
index 0000000..ed1a850
--- /dev/null
+++ b/LibD28/dclFMXfrxFD22.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE8
+
+package dclFMXfrxFD22;
+
+{$R *.res}
+{$R 'FMXfrxFDReg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastReport FMX 2.0 FireDAC Components - Designtime Package'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx,
+ DESIGNIDE,
+ FMXfrxFD22;
+
+contains
+ FMX.frxFDReg in 'FMX.frxFDReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxFD22.res b/LibD28/dclFMXfrxFD22.res
new file mode 100644
index 0000000..8b39f81
Binary files /dev/null and b/LibD28/dclFMXfrxFD22.res differ
diff --git a/LibD28/dclFMXfrxFD23.dpk b/LibD28/dclFMXfrxFD23.dpk
new file mode 100644
index 0000000..4a4d26e
--- /dev/null
+++ b/LibD28/dclFMXfrxFD23.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfrxFD23;
+
+{$R *.res}
+{$R 'FMXfrxFDReg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastReport FMX 2.0 FireDAC Components - Designtime Package'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx,
+ DESIGNIDE,
+ FMXfrxFD23;
+
+contains
+ FMX.frxFDReg in 'FMX.frxFDReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxFD23.res b/LibD28/dclFMXfrxFD23.res
new file mode 100644
index 0000000..8b39f81
Binary files /dev/null and b/LibD28/dclFMXfrxFD23.res differ
diff --git a/LibD28/dclFMXfrxFD24.dpk b/LibD28/dclFMXfrxFD24.dpk
new file mode 100644
index 0000000..bbb6660
--- /dev/null
+++ b/LibD28/dclFMXfrxFD24.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10.1 Berlin
+
+package dclFMXfrxFD24;
+
+{$R *.res}
+{$R 'FMXfrxFDReg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastReport FMX 2.0 FireDAC Components - Designtime Package'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx,
+ DESIGNIDE,
+ FMXfrxFD24;
+
+contains
+ FMX.frxFDReg in 'FMX.frxFDReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxFD24.res b/LibD28/dclFMXfrxFD24.res
new file mode 100644
index 0000000..8b39f81
Binary files /dev/null and b/LibD28/dclFMXfrxFD24.res differ
diff --git a/LibD28/dclFMXfrxFD25.dpk b/LibD28/dclFMXfrxFD25.dpk
new file mode 100644
index 0000000..a4e0275
--- /dev/null
+++ b/LibD28/dclFMXfrxFD25.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10.2 Tokyo
+
+package dclFMXfrxFD25;
+
+{$R *.res}
+{$R 'FMXfrxFDReg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastReport FMX 2.0 FireDAC Components - Designtime Package'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx,
+ DESIGNIDE,
+ FMXfrxFD25;
+
+contains
+ FMX.frxFDReg in 'FMX.frxFDReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxFD25.res b/LibD28/dclFMXfrxFD25.res
new file mode 100644
index 0000000..8b39f81
Binary files /dev/null and b/LibD28/dclFMXfrxFD25.res differ
diff --git a/LibD28/dclFMXfrxFD26.dpk b/LibD28/dclFMXfrxFD26.dpk
new file mode 100644
index 0000000..8635ecd
--- /dev/null
+++ b/LibD28/dclFMXfrxFD26.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 10.3 Rio
+
+package dclFMXfrxFD26;
+
+{$R 'FMXfrxFDReg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastReport FMX 2.0 FireDAC Components - Designtime Package'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx,
+ DESIGNIDE,
+ FMXfrxFD26;
+
+contains
+ FMX.frxFDReg in 'FMX.frxFDReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxFD27.dpk b/LibD28/dclFMXfrxFD27.dpk
new file mode 100644
index 0000000..9c04a3f
--- /dev/null
+++ b/LibD28/dclFMXfrxFD27.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 10.4 Sydney
+
+package dclFMXfrxFD27;
+
+{$R 'FMXfrxFDReg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastReport FMX 2.0 FireDAC Components - Designtime Package'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx,
+ DESIGNIDE,
+ FMXfrxFD27;
+
+contains
+ FMX.frxFDReg in 'FMX.frxFDReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxFD29.dpk b/LibD28/dclFMXfrxFD29.dpk
new file mode 100644
index 0000000..ece7bf3
--- /dev/null
+++ b/LibD28/dclFMXfrxFD29.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 12
+
+package dclFMXfrxFD29;
+
+{$R 'FMXfrxFDReg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastReport FMX 2.0 FireDAC Components - Designtime Package'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ fmx,
+ DESIGNIDE,
+ FMXfrxFD29;
+
+contains
+ FMX.frxFDReg in 'FMX.frxFDReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxFD29.dproj b/LibD28/dclFMXfrxFD29.dproj
new file mode 100644
index 0000000..06f5051
--- /dev/null
+++ b/LibD28/dclFMXfrxFD29.dproj
@@ -0,0 +1,116 @@
+
+
+ {6BC35C3E-D3DA-4C90-96B8-E97D802BA7E4}
+ dclFMXfrxFD29.dpk
+ True
+ Release
+ 1
+ Package
+ None
+ 20.1
+ Win32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ dclFMXfrxFD29
+ FastReport FMX 2.0 FireDAC Components - Designtime Package
+ true
+ true
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+ fmx;FMXfrxFD29;$(DCC_UsePackage)
+
+
+ fmx;$(DCC_UsePackage)
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ dclFMXfrxFD29.dpk
+
+
+
+ True
+ False
+
+
+ 12
+
+
+
+
diff --git a/LibD28/dclFMXfrxFD29.res b/LibD28/dclFMXfrxFD29.res
new file mode 100644
index 0000000..a0f1e30
Binary files /dev/null and b/LibD28/dclFMXfrxFD29.res differ
diff --git a/LibD28/dclFMXfrxIBX16.dpk b/LibD28/dclFMXfrxIBX16.dpk
new file mode 100644
index 0000000..d383d58
--- /dev/null
+++ b/LibD28/dclFMXfrxIBX16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclFMXfrxIBX16;
+
+{$R 'FMXfrxIBXReg.dcr'}
+{$DESCRIPTION 'FastReport FMX 2.0 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxIBX16;
+
+contains
+ FMXfrxIBXReg in 'FMXfrxIBXReg.pas';
+
+
+end.
diff --git a/LibD28/dclFMXfrxIBX16.res b/LibD28/dclFMXfrxIBX16.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxIBX16.res differ
diff --git a/LibD28/dclFMXfrxIBX17.dpk b/LibD28/dclFMXfrxIBX17.dpk
new file mode 100644
index 0000000..6d36805
--- /dev/null
+++ b/LibD28/dclFMXfrxIBX17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclFMXfrxIBX17;
+
+{$R 'FMXfrxIBXReg.dcr'}
+{$DESCRIPTION 'FastReport FMX 2.0 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxIBX17;
+
+contains
+ FMXfrxIBXReg in 'FMXfrxIBXReg.pas';
+
+
+end.
diff --git a/LibD28/dclFMXfrxIBX17.res b/LibD28/dclFMXfrxIBX17.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxIBX17.res differ
diff --git a/LibD28/dclFMXfrxIBX18.dpk b/LibD28/dclFMXfrxIBX18.dpk
new file mode 100644
index 0000000..3a7bb23
--- /dev/null
+++ b/LibD28/dclFMXfrxIBX18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package dclFMXfrxIBX18;
+
+{$R 'FMXfrxIBXReg.dcr'}
+{$DESCRIPTION 'FastReport FMX 2.0 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxIBX18;
+
+contains
+ FMXfrxIBXReg in 'FMXfrxIBXReg.pas';
+
+
+end.
diff --git a/LibD28/dclFMXfrxIBX18.res b/LibD28/dclFMXfrxIBX18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxIBX18.res differ
diff --git a/LibD28/dclFMXfrxIBX19.dpk b/LibD28/dclFMXfrxIBX19.dpk
new file mode 100644
index 0000000..c3db793
--- /dev/null
+++ b/LibD28/dclFMXfrxIBX19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package dclFMXfrxIBX19;
+
+{$R 'FMXfrxIBXReg.dcr'}
+{$DESCRIPTION 'FastReport FMX 2.0 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxIBX19;
+
+contains
+ FMXfrxIBXReg in 'FMXfrxIBXReg.pas';
+
+
+end.
diff --git a/LibD28/dclFMXfrxIBX19.res b/LibD28/dclFMXfrxIBX19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxIBX19.res differ
diff --git a/LibD28/dclFMXfrxIBX20.dpk b/LibD28/dclFMXfrxIBX20.dpk
new file mode 100644
index 0000000..f7ccf9e
--- /dev/null
+++ b/LibD28/dclFMXfrxIBX20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package dclFMXfrxIBX20;
+
+{$R 'FMXfrxIBXReg.dcr'}
+{$DESCRIPTION 'FastReport FMX 2.0 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxIBX20;
+
+contains
+ FMXfrxIBXReg in 'FMXfrxIBXReg.pas';
+
+
+end.
diff --git a/LibD28/dclFMXfrxIBX20.res b/LibD28/dclFMXfrxIBX20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxIBX20.res differ
diff --git a/LibD28/dclFMXfrxIBX21.dpk b/LibD28/dclFMXfrxIBX21.dpk
new file mode 100644
index 0000000..8eabe20
--- /dev/null
+++ b/LibD28/dclFMXfrxIBX21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package dclFMXfrxIBX21;
+
+{$R 'FMXfrxIBXReg.dcr'}
+{$DESCRIPTION 'FastReport FMX 2.0 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxIBX21;
+
+contains
+ FMXfrxIBXReg in 'FMXfrxIBXReg.pas';
+
+
+end.
diff --git a/LibD28/dclFMXfrxIBX21.res b/LibD28/dclFMXfrxIBX21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxIBX21.res differ
diff --git a/LibD28/dclFMXfrxIBX22.dpk b/LibD28/dclFMXfrxIBX22.dpk
new file mode 100644
index 0000000..a8e1f22
--- /dev/null
+++ b/LibD28/dclFMXfrxIBX22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package dclFMXfrxIBX22;
+
+{$R 'FMXfrxIBXReg.dcr'}
+{$DESCRIPTION 'FastReport FMX 2.0 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxIBX22;
+
+contains
+ FMXfrxIBXReg in 'FMXfrxIBXReg.pas';
+
+
+end.
diff --git a/LibD28/dclFMXfrxIBX22.res b/LibD28/dclFMXfrxIBX22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxIBX22.res differ
diff --git a/LibD28/dclFMXfrxIBX23.dpk b/LibD28/dclFMXfrxIBX23.dpk
new file mode 100644
index 0000000..4a26750
--- /dev/null
+++ b/LibD28/dclFMXfrxIBX23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfrxIBX23;
+
+{$R 'FMXfrxIBXReg.dcr'}
+{$DESCRIPTION 'FastReport FMX 2.0 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxIBX23;
+
+contains
+ FMXfrxIBXReg in 'FMXfrxIBXReg.pas';
+
+
+end.
diff --git a/LibD28/dclFMXfrxIBX23.res b/LibD28/dclFMXfrxIBX23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxIBX23.res differ
diff --git a/LibD28/dclFMXfrxIBX24.dpk b/LibD28/dclFMXfrxIBX24.dpk
new file mode 100644
index 0000000..25f688e
--- /dev/null
+++ b/LibD28/dclFMXfrxIBX24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfrxIBX24;
+
+{$R 'FMXfrxIBXReg.dcr'}
+{$DESCRIPTION 'FastReport FMX 2.0 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxIBX24;
+
+contains
+ FMXfrxIBXReg in 'FMXfrxIBXReg.pas';
+
+
+end.
diff --git a/LibD28/dclFMXfrxIBX24.res b/LibD28/dclFMXfrxIBX24.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxIBX24.res differ
diff --git a/LibD28/dclFMXfrxIBX25.dpk b/LibD28/dclFMXfrxIBX25.dpk
new file mode 100644
index 0000000..121bb3f
--- /dev/null
+++ b/LibD28/dclFMXfrxIBX25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfrxIBX25;
+
+{$R 'FMXfrxIBXReg.dcr'}
+{$DESCRIPTION 'FastReport FMX 2.0 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxIBX25;
+
+contains
+ FMXfrxIBXReg in 'FMXfrxIBXReg.pas';
+
+
+end.
diff --git a/LibD28/dclFMXfrxIBX25.res b/LibD28/dclFMXfrxIBX25.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxIBX25.res differ
diff --git a/LibD28/dclFMXfrxIBX26.dpk b/LibD28/dclFMXfrxIBX26.dpk
new file mode 100644
index 0000000..01dd5b0
--- /dev/null
+++ b/LibD28/dclFMXfrxIBX26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfrxIBX26;
+
+{$R 'FMXfrxIBXReg.dcr'}
+{$DESCRIPTION 'FastReport FMX 2.0 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxIBX26;
+
+contains
+ FMXfrxIBXReg in 'FMXfrxIBXReg.pas';
+
+
+end.
diff --git a/LibD28/dclFMXfrxIBX27.dpk b/LibD28/dclFMXfrxIBX27.dpk
new file mode 100644
index 0000000..8c7111c
--- /dev/null
+++ b/LibD28/dclFMXfrxIBX27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfrxIBX27;
+
+{$R 'FMXfrxIBXReg.dcr'}
+{$DESCRIPTION 'FastReport FMX 2.0 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxIBX27;
+
+contains
+ FMXfrxIBXReg in 'FMXfrxIBXReg.pas';
+
+
+end.
diff --git a/LibD28/dclFMXfrxIBX28.dpk b/LibD28/dclFMXfrxIBX28.dpk
new file mode 100644
index 0000000..96be48b
--- /dev/null
+++ b/LibD28/dclFMXfrxIBX28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package dclFMXfrxIBX28;
+
+{$R 'FMXfrxIBXReg.dcr'}
+{$DESCRIPTION 'FastReport FMX 2.0 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxIBX28;
+
+contains
+ FMXfrxIBXReg in 'FMXfrxIBXReg.pas';
+
+
+end.
diff --git a/LibD28/dclFMXfrxTee16.dpk b/LibD28/dclFMXfrxTee16.dpk
new file mode 100644
index 0000000..bed6342
--- /dev/null
+++ b/LibD28/dclFMXfrxTee16.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio XE2
+
+package dclFMXfrxTee16;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxTee16;
+
+contains
+ FMXfrxRegTee in 'FMXfrxRegTee.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxTee16.res b/LibD28/dclFMXfrxTee16.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxTee16.res differ
diff --git a/LibD28/dclFMXfrxTee17.dpk b/LibD28/dclFMXfrxTee17.dpk
new file mode 100644
index 0000000..299b7cb
--- /dev/null
+++ b/LibD28/dclFMXfrxTee17.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio XE3
+
+package dclFMXfrxTee17;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxTee17;
+
+contains
+ FMXfrxRegTee in 'FMXfrxRegTee.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxTee17.res b/LibD28/dclFMXfrxTee17.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxTee17.res differ
diff --git a/LibD28/dclFMXfrxTee18.dpk b/LibD28/dclFMXfrxTee18.dpk
new file mode 100644
index 0000000..982eca2
--- /dev/null
+++ b/LibD28/dclFMXfrxTee18.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio XE4
+
+package dclFMXfrxTee18;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxTee18;
+
+contains
+ FMXfrxRegTee in 'FMXfrxRegTee.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxTee18.res b/LibD28/dclFMXfrxTee18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxTee18.res differ
diff --git a/LibD28/dclFMXfrxTee19.dpk b/LibD28/dclFMXfrxTee19.dpk
new file mode 100644
index 0000000..8a79080
--- /dev/null
+++ b/LibD28/dclFMXfrxTee19.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio XE5
+
+package dclFMXfrxTee19;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxTee19;
+
+contains
+ FMXfrxRegTee in 'FMXfrxRegTee.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxTee19.res b/LibD28/dclFMXfrxTee19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxTee19.res differ
diff --git a/LibD28/dclFMXfrxTee20.dpk b/LibD28/dclFMXfrxTee20.dpk
new file mode 100644
index 0000000..dc0fd6c
--- /dev/null
+++ b/LibD28/dclFMXfrxTee20.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio XE6
+
+package dclFMXfrxTee20;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxTee20;
+
+contains
+ FMXfrxRegTee in 'FMXfrxRegTee.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxTee20.res b/LibD28/dclFMXfrxTee20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxTee20.res differ
diff --git a/LibD28/dclFMXfrxTee21.dpk b/LibD28/dclFMXfrxTee21.dpk
new file mode 100644
index 0000000..fa0757e
--- /dev/null
+++ b/LibD28/dclFMXfrxTee21.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio XE7
+
+package dclFMXfrxTee21;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxTee21;
+
+contains
+ FMXfrxRegTee in 'FMXfrxRegTee.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxTee21.res b/LibD28/dclFMXfrxTee21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxTee21.res differ
diff --git a/LibD28/dclFMXfrxTee22.dpk b/LibD28/dclFMXfrxTee22.dpk
new file mode 100644
index 0000000..a0ab67b
--- /dev/null
+++ b/LibD28/dclFMXfrxTee22.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio XE8
+
+package dclFMXfrxTee22;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxTee22;
+
+contains
+ FMXfrxRegTee in 'FMXfrxRegTee.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxTee22.res b/LibD28/dclFMXfrxTee22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxTee22.res differ
diff --git a/LibD28/dclFMXfrxTee23.dpk b/LibD28/dclFMXfrxTee23.dpk
new file mode 100644
index 0000000..eee066e
--- /dev/null
+++ b/LibD28/dclFMXfrxTee23.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio 10 Seattle
+
+package dclFMXfrxTee23;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxTee23;
+
+contains
+ FMXfrxRegTee in 'FMXfrxRegTee.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxTee23.res b/LibD28/dclFMXfrxTee23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxTee23.res differ
diff --git a/LibD28/dclFMXfrxTee24.dpk b/LibD28/dclFMXfrxTee24.dpk
new file mode 100644
index 0000000..e8df2b4
--- /dev/null
+++ b/LibD28/dclFMXfrxTee24.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio 10 Seattle
+
+package dclFMXfrxTee24;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxTee24;
+
+contains
+ FMXfrxRegTee in 'FMXfrxRegTee.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxTee24.res b/LibD28/dclFMXfrxTee24.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxTee24.res differ
diff --git a/LibD28/dclFMXfrxTee25.dpk b/LibD28/dclFMXfrxTee25.dpk
new file mode 100644
index 0000000..51bfea3
--- /dev/null
+++ b/LibD28/dclFMXfrxTee25.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio 10 Seattle
+
+package dclFMXfrxTee25;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxTee25;
+
+contains
+ FMXfrxRegTee in 'FMXfrxRegTee.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxTee25.otares b/LibD28/dclFMXfrxTee25.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/dclFMXfrxTee25.otares differ
diff --git a/LibD28/dclFMXfrxTee25.res b/LibD28/dclFMXfrxTee25.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxTee25.res differ
diff --git a/LibD28/dclFMXfrxTee26.dpk b/LibD28/dclFMXfrxTee26.dpk
new file mode 100644
index 0000000..1821c7d
--- /dev/null
+++ b/LibD28/dclFMXfrxTee26.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio 10 Seattle
+
+package dclFMXfrxTee26;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxTee26;
+
+contains
+ FMXfrxRegTee in 'FMXfrxRegTee.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxTee27.dpk b/LibD28/dclFMXfrxTee27.dpk
new file mode 100644
index 0000000..30ceba0
--- /dev/null
+++ b/LibD28/dclFMXfrxTee27.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio 10 Seattle
+
+package dclFMXfrxTee27;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxTee27;
+
+contains
+ FMXfrxRegTee in 'FMXfrxRegTee.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxTee29.dpk b/LibD28/dclFMXfrxTee29.dpk
new file mode 100644
index 0000000..4f5369b
--- /dev/null
+++ b/LibD28/dclFMXfrxTee29.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio 12
+
+package dclFMXfrxTee29;
+
+{$R 'frxReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST OFF}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxTee29;
+
+contains
+ FMXfrxRegTee in 'FMXfrxRegTee.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxTee29.dproj b/LibD28/dclFMXfrxTee29.dproj
new file mode 100644
index 0000000..4878680
--- /dev/null
+++ b/LibD28/dclFMXfrxTee29.dproj
@@ -0,0 +1,119 @@
+
+
+ {85D36DCF-F2A3-4D51-BF0E-96F0D4BC6AFC}
+ dclFMXfrxTee29.dpk
+ True
+ Release
+ 1
+ Package
+ None
+ 20.1
+ Win32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ dclFMXfrxTee29
+ 1
+ false
+ true
+ FastReport FMX 2.0 Tee Components
+ true
+ true
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+ fmx;FMXfrxTee29;$(DCC_UsePackage)
+
+
+ fmx;$(DCC_UsePackage)
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ dclFMXfrxTee29.dpk
+
+
+
+ True
+ False
+
+
+ 12
+
+
+
+
diff --git a/LibD28/dclFMXfrxTee29.res b/LibD28/dclFMXfrxTee29.res
new file mode 100644
index 0000000..8243ad4
Binary files /dev/null and b/LibD28/dclFMXfrxTee29.res differ
diff --git a/LibD28/dclFMXfrxe16.dpk b/LibD28/dclFMXfrxe16.dpk
new file mode 100644
index 0000000..4ab266d
--- /dev/null
+++ b/LibD28/dclFMXfrxe16.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio XE2
+
+package dclFMXfrxe16;
+
+{$R 'frxeReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Exports'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxe16;
+
+contains
+ FMXfrxeReg in 'FMXfrxeReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxe16.res b/LibD28/dclFMXfrxe16.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxe16.res differ
diff --git a/LibD28/dclFMXfrxe17.dpk b/LibD28/dclFMXfrxe17.dpk
new file mode 100644
index 0000000..20b9986
--- /dev/null
+++ b/LibD28/dclFMXfrxe17.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio XE3
+
+package dclFMXfrxe17;
+
+{$R 'frxeReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Exports'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxe17;
+
+contains
+ FMXfrxeReg in 'FMXfrxeReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxe17.res b/LibD28/dclFMXfrxe17.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxe17.res differ
diff --git a/LibD28/dclFMXfrxe18.dpk b/LibD28/dclFMXfrxe18.dpk
new file mode 100644
index 0000000..7f06ba4
--- /dev/null
+++ b/LibD28/dclFMXfrxe18.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio XE4
+
+package dclFMXfrxe18;
+
+{$R 'frxeReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Exports'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxe18;
+
+contains
+ FMXfrxeReg in 'FMXfrxeReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxe18.res b/LibD28/dclFMXfrxe18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxe18.res differ
diff --git a/LibD28/dclFMXfrxe19.dpk b/LibD28/dclFMXfrxe19.dpk
new file mode 100644
index 0000000..6a2cab3
--- /dev/null
+++ b/LibD28/dclFMXfrxe19.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio XE5
+
+package dclFMXfrxe19;
+
+{$R 'frxeReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Exports'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxe19;
+
+contains
+ FMXfrxeReg in 'FMXfrxeReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxe19.res b/LibD28/dclFMXfrxe19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxe19.res differ
diff --git a/LibD28/dclFMXfrxe20.dpk b/LibD28/dclFMXfrxe20.dpk
new file mode 100644
index 0000000..0e66695
--- /dev/null
+++ b/LibD28/dclFMXfrxe20.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio XE6
+
+package dclFMXfrxe20;
+
+{$R 'frxeReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Exports'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxe20;
+
+contains
+ FMXfrxeReg in 'FMXfrxeReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxe20.res b/LibD28/dclFMXfrxe20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxe20.res differ
diff --git a/LibD28/dclFMXfrxe21.dpk b/LibD28/dclFMXfrxe21.dpk
new file mode 100644
index 0000000..53544b9
--- /dev/null
+++ b/LibD28/dclFMXfrxe21.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio XE7
+
+package dclFMXfrxe21;
+
+{$R 'frxeReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Exports'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxe21;
+
+contains
+ FMXfrxeReg in 'FMXfrxeReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxe21.res b/LibD28/dclFMXfrxe21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxe21.res differ
diff --git a/LibD28/dclFMXfrxe22.dpk b/LibD28/dclFMXfrxe22.dpk
new file mode 100644
index 0000000..cc082cf
--- /dev/null
+++ b/LibD28/dclFMXfrxe22.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio XE8
+
+package dclFMXfrxe22;
+
+{$R 'frxeReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Exports'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxe22;
+
+contains
+ FMXfrxeReg in 'FMXfrxeReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxe22.res b/LibD28/dclFMXfrxe22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxe22.res differ
diff --git a/LibD28/dclFMXfrxe23.dpk b/LibD28/dclFMXfrxe23.dpk
new file mode 100644
index 0000000..a2da06d
--- /dev/null
+++ b/LibD28/dclFMXfrxe23.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio 10 Seattle
+
+package dclFMXfrxe23;
+
+{$R 'frxeReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Exports'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxe23;
+
+contains
+ FMXfrxeReg in 'FMXfrxeReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxe23.res b/LibD28/dclFMXfrxe23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfrxe23.res differ
diff --git a/LibD28/dclFMXfrxe24.dpk b/LibD28/dclFMXfrxe24.dpk
new file mode 100644
index 0000000..f1d324d
--- /dev/null
+++ b/LibD28/dclFMXfrxe24.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio 10 Seattle
+
+package dclFMXfrxe24;
+
+{$R 'frxeReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Exports'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxe24;
+
+contains
+ FMXfrxeReg in 'FMXfrxeReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxe24.dproj b/LibD28/dclFMXfrxe24.dproj
new file mode 100644
index 0000000..a2819f8
--- /dev/null
+++ b/LibD28/dclFMXfrxe24.dproj
@@ -0,0 +1,120 @@
+
+
+ {10214104-87DC-4006-823F-D624AC334E12}
+ dclFMXfrxe24.dpk
+ True
+ Debug
+ 1025
+ Package
+ None
+ 18.1
+ Win32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ 1
+ false
+ true
+ 00400000
+ 1049
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ true
+ FastReport FMX 2.0 Exports
+ dclFMXfrxe24
+ false
+ false
+ true
+ true
+ true
+
+
+ 1033
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=
+ true
+
+
+ package=com.embarcadero.$(MSBuildProjectName);label=$(MSBuildProjectName);versionCode=1;versionName=1.0.0;persistent=False;restoreAnyVersion=False;installLocation=auto;largeHeap=False;theme=TitleBar;hardwareAccelerated=true;apiKey=
+ Debug
+
+
+ false
+ 0
+ RELEASE;$(DCC_Define)
+ 0
+
+
+ true
+ false
+ DEBUG;$(DCC_Define)
+
+
+
+ MainSource
+
+
+
+
+
+
+
+ Cfg_2
+ Base
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ dclFMXfrxe24.dpk
+
+
+
+ False
+ False
+ True
+ False
+ False
+ True
+ False
+
+
+ 12
+
+
+
+
diff --git a/LibD28/dclFMXfrxe24.otares b/LibD28/dclFMXfrxe24.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/dclFMXfrxe24.otares differ
diff --git a/LibD28/dclFMXfrxe24.res b/LibD28/dclFMXfrxe24.res
new file mode 100644
index 0000000..982e23b
Binary files /dev/null and b/LibD28/dclFMXfrxe24.res differ
diff --git a/LibD28/dclFMXfrxe25.dpk b/LibD28/dclFMXfrxe25.dpk
new file mode 100644
index 0000000..924f5e5
--- /dev/null
+++ b/LibD28/dclFMXfrxe25.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio 10 Seattle
+
+package dclFMXfrxe25;
+
+{$R 'frxeReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Exports'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxe25;
+
+contains
+ FMXfrxeReg in 'FMXfrxeReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxe25.otares b/LibD28/dclFMXfrxe25.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/dclFMXfrxe25.otares differ
diff --git a/LibD28/dclFMXfrxe25.res b/LibD28/dclFMXfrxe25.res
new file mode 100644
index 0000000..982e23b
Binary files /dev/null and b/LibD28/dclFMXfrxe25.res differ
diff --git a/LibD28/dclFMXfrxe26.dpk b/LibD28/dclFMXfrxe26.dpk
new file mode 100644
index 0000000..af28a1e
--- /dev/null
+++ b/LibD28/dclFMXfrxe26.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio 10 Seattle
+
+package dclFMXfrxe26;
+
+{$R 'frxeReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Exports'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxe26;
+
+contains
+ FMXfrxeReg in 'FMXfrxeReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxe27.dpk b/LibD28/dclFMXfrxe27.dpk
new file mode 100644
index 0000000..ae6bd60
--- /dev/null
+++ b/LibD28/dclFMXfrxe27.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio 10 Seattle
+
+package dclFMXfrxe27;
+
+{$R 'frxeReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Exports'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxe27;
+
+contains
+ FMXfrxeReg in 'FMXfrxeReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxe29.dpk b/LibD28/dclFMXfrxe29.dpk
new file mode 100644
index 0000000..4f640ce
--- /dev/null
+++ b/LibD28/dclFMXfrxe29.dpk
@@ -0,0 +1,39 @@
+// Package file for Rad Studio 12
+
+package dclFMXfrxe29;
+
+{$R 'frxeReg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastReport FMX 2.0 Exports'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfrxe29;
+
+contains
+ FMXfrxeReg in 'FMXfrxeReg.pas';
+
+end.
diff --git a/LibD28/dclFMXfrxe29.dproj b/LibD28/dclFMXfrxe29.dproj
new file mode 100644
index 0000000..a8774c4
--- /dev/null
+++ b/LibD28/dclFMXfrxe29.dproj
@@ -0,0 +1,114 @@
+
+
+ {89F4E645-D106-47B7-8A70-87A9D719316C}
+ dclFMXfrxe29.dpk
+ True
+ Debug
+ 1
+ Package
+ None
+ 20.1
+ Win32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ dclFMXfrxe29
+ 1
+ true
+ FastReport FMX 2.0 Exports
+ true
+ true
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ dclFMXfrxe29.dpk
+
+
+
+ False
+ False
+ False
+ False
+ False
+ True
+ False
+
+
+ 12
+
+
+
+
diff --git a/LibD28/dclFMXfs16.dpk b/LibD28/dclFMXfs16.dpk
new file mode 100644
index 0000000..58b4aa8
--- /dev/null
+++ b/LibD28/dclFMXfs16.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE2
+
+package dclFMXfs16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs16;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/LibD28/dclFMXfs16.res b/LibD28/dclFMXfs16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfs16.res differ
diff --git a/LibD28/dclFMXfs17.dpk b/LibD28/dclFMXfs17.dpk
new file mode 100644
index 0000000..233a78e
--- /dev/null
+++ b/LibD28/dclFMXfs17.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE3
+
+package dclFMXfs17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs17;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/LibD28/dclFMXfs17.res b/LibD28/dclFMXfs17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfs17.res differ
diff --git a/LibD28/dclFMXfs18.dpk b/LibD28/dclFMXfs18.dpk
new file mode 100644
index 0000000..77885c7
--- /dev/null
+++ b/LibD28/dclFMXfs18.dpk
@@ -0,0 +1,44 @@
+// Package file for Delphi XE4
+
+package dclFMXfs18;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs18;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/LibD28/dclFMXfs18.otares b/LibD28/dclFMXfs18.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/dclFMXfs18.otares differ
diff --git a/LibD28/dclFMXfs18.res b/LibD28/dclFMXfs18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfs18.res differ
diff --git a/LibD28/dclFMXfs19.dpk b/LibD28/dclFMXfs19.dpk
new file mode 100644
index 0000000..312058b
--- /dev/null
+++ b/LibD28/dclFMXfs19.dpk
@@ -0,0 +1,44 @@
+// Package file for Delphi XE5
+
+package dclFMXfs19;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs19;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/LibD28/dclFMXfs19.otares b/LibD28/dclFMXfs19.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/dclFMXfs19.otares differ
diff --git a/LibD28/dclFMXfs19.res b/LibD28/dclFMXfs19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfs19.res differ
diff --git a/LibD28/dclFMXfs20.dpk b/LibD28/dclFMXfs20.dpk
new file mode 100644
index 0000000..4f35242
--- /dev/null
+++ b/LibD28/dclFMXfs20.dpk
@@ -0,0 +1,44 @@
+// Package file for Delphi XE6
+
+package dclFMXfs20;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs20;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/LibD28/dclFMXfs20.otares b/LibD28/dclFMXfs20.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/dclFMXfs20.otares differ
diff --git a/LibD28/dclFMXfs20.res b/LibD28/dclFMXfs20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfs20.res differ
diff --git a/LibD28/dclFMXfs21.dpk b/LibD28/dclFMXfs21.dpk
new file mode 100644
index 0000000..cf1c58d
--- /dev/null
+++ b/LibD28/dclFMXfs21.dpk
@@ -0,0 +1,44 @@
+// Package file for Delphi XE7
+
+package dclFMXfs21;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs21;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/LibD28/dclFMXfs21.otares b/LibD28/dclFMXfs21.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/dclFMXfs21.otares differ
diff --git a/LibD28/dclFMXfs21.res b/LibD28/dclFMXfs21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfs21.res differ
diff --git a/LibD28/dclFMXfs22.dpk b/LibD28/dclFMXfs22.dpk
new file mode 100644
index 0000000..e6ac3ff
--- /dev/null
+++ b/LibD28/dclFMXfs22.dpk
@@ -0,0 +1,44 @@
+// Package file for Delphi XE8
+
+package dclFMXfs22;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs22;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/LibD28/dclFMXfs22.otares b/LibD28/dclFMXfs22.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/dclFMXfs22.otares differ
diff --git a/LibD28/dclFMXfs22.res b/LibD28/dclFMXfs22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfs22.res differ
diff --git a/LibD28/dclFMXfs23.dpk b/LibD28/dclFMXfs23.dpk
new file mode 100644
index 0000000..c1bd62e
--- /dev/null
+++ b/LibD28/dclFMXfs23.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfs23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs23;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/LibD28/dclFMXfs23.otares b/LibD28/dclFMXfs23.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/dclFMXfs23.otares differ
diff --git a/LibD28/dclFMXfs23.res b/LibD28/dclFMXfs23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfs23.res differ
diff --git a/LibD28/dclFMXfs24.dpk b/LibD28/dclFMXfs24.dpk
new file mode 100644
index 0000000..e793d8b
--- /dev/null
+++ b/LibD28/dclFMXfs24.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfs24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs24;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/LibD28/dclFMXfs24.otares b/LibD28/dclFMXfs24.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/dclFMXfs24.otares differ
diff --git a/LibD28/dclFMXfs24.res b/LibD28/dclFMXfs24.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfs24.res differ
diff --git a/LibD28/dclFMXfs25.dpk b/LibD28/dclFMXfs25.dpk
new file mode 100644
index 0000000..9128c4d
--- /dev/null
+++ b/LibD28/dclFMXfs25.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfs25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs25;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/LibD28/dclFMXfs25.otares b/LibD28/dclFMXfs25.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/dclFMXfs25.otares differ
diff --git a/LibD28/dclFMXfs25.res b/LibD28/dclFMXfs25.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfs25.res differ
diff --git a/LibD28/dclFMXfs26.dpk b/LibD28/dclFMXfs26.dpk
new file mode 100644
index 0000000..48cdb6d
--- /dev/null
+++ b/LibD28/dclFMXfs26.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfs26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs26;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/LibD28/dclFMXfs27.dpk b/LibD28/dclFMXfs27.dpk
new file mode 100644
index 0000000..674e7b6
--- /dev/null
+++ b/LibD28/dclFMXfs27.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfs27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs27;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/LibD28/dclFMXfs28.dpk b/LibD28/dclFMXfs28.dpk
new file mode 100644
index 0000000..fc71708
--- /dev/null
+++ b/LibD28/dclFMXfs28.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 11 Seattle
+
+package dclFMXfs29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/LibD28/dclFMXfs29.dpk b/LibD28/dclFMXfs29.dpk
new file mode 100644
index 0000000..6c93adc
--- /dev/null
+++ b/LibD28/dclFMXfs29.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 12
+
+package dclFMXfs29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$DESCRIPTION 'FastScript FMX 1.9 Components'}
+{$DESIGNONLY}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29;
+
+contains
+ FMXfs_ireg in 'FMXfs_ireg.pas';
+
+end.
diff --git a/LibD28/dclFMXfs29.dproj b/LibD28/dclFMXfs29.dproj
new file mode 100644
index 0000000..3dd99b5
--- /dev/null
+++ b/LibD28/dclFMXfs29.dproj
@@ -0,0 +1,119 @@
+
+
+ {C7752C79-B6EF-48BA-B38E-64C4742F00A2}
+ dclFMXfs29.dpk
+ True
+ Release
+ 1
+ Package
+ None
+ 20.1
+ Win32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ dclFMXfs29
+ 1
+ false
+ true
+ true
+ DEBUG;$(DCC_Define)
+ FastScript FMX 1.9 Components
+ true
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+ fmx;FMXfs29;$(DCC_UsePackage)
+
+
+ fmx;$(DCC_UsePackage)
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ dclFMXfs29.dpk
+
+
+
+ True
+ False
+
+
+ 12
+
+
+
+
diff --git a/LibD28/dclFMXfs29.res b/LibD28/dclFMXfs29.res
new file mode 100644
index 0000000..1534834
Binary files /dev/null and b/LibD28/dclFMXfs29.res differ
diff --git a/LibD28/dclFMXfsADO16.dpk b/LibD28/dclFMXfsADO16.dpk
new file mode 100644
index 0000000..51dfee4
--- /dev/null
+++ b/LibD28/dclFMXfsADO16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclFMXfsADO16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs16,
+ FMXfsADO16;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsADO16.res b/LibD28/dclFMXfsADO16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsADO16.res differ
diff --git a/LibD28/dclFMXfsADO17.dpk b/LibD28/dclFMXfsADO17.dpk
new file mode 100644
index 0000000..645ec65
--- /dev/null
+++ b/LibD28/dclFMXfsADO17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclFMXfsADO17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs17,
+ FMXfsADO17;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsADO17.res b/LibD28/dclFMXfsADO17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsADO17.res differ
diff --git a/LibD28/dclFMXfsADO18.dpk b/LibD28/dclFMXfsADO18.dpk
new file mode 100644
index 0000000..0262696
--- /dev/null
+++ b/LibD28/dclFMXfsADO18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package dclFMXfsADO18;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs18,
+ FMXfsADO18;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsADO18.res b/LibD28/dclFMXfsADO18.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsADO18.res differ
diff --git a/LibD28/dclFMXfsADO19.dpk b/LibD28/dclFMXfsADO19.dpk
new file mode 100644
index 0000000..ad55963
--- /dev/null
+++ b/LibD28/dclFMXfsADO19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package dclFMXfsADO19;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs19,
+ FMXfsADO19;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsADO19.res b/LibD28/dclFMXfsADO19.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsADO19.res differ
diff --git a/LibD28/dclFMXfsADO20.dpk b/LibD28/dclFMXfsADO20.dpk
new file mode 100644
index 0000000..8009901
--- /dev/null
+++ b/LibD28/dclFMXfsADO20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package dclFMXfsADO20;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs20,
+ FMXfsADO20;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsADO20.res b/LibD28/dclFMXfsADO20.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsADO20.res differ
diff --git a/LibD28/dclFMXfsADO21.dpk b/LibD28/dclFMXfsADO21.dpk
new file mode 100644
index 0000000..40948f9
--- /dev/null
+++ b/LibD28/dclFMXfsADO21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package dclFMXfsADO21;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs21,
+ FMXfsADO21;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsADO21.res b/LibD28/dclFMXfsADO21.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsADO21.res differ
diff --git a/LibD28/dclFMXfsADO22.dpk b/LibD28/dclFMXfsADO22.dpk
new file mode 100644
index 0000000..a5755db
--- /dev/null
+++ b/LibD28/dclFMXfsADO22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package dclFMXfsADO22;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs22,
+ FMXfsADO22;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsADO22.res b/LibD28/dclFMXfsADO22.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsADO22.res differ
diff --git a/LibD28/dclFMXfsADO23.dpk b/LibD28/dclFMXfsADO23.dpk
new file mode 100644
index 0000000..404c4c0
--- /dev/null
+++ b/LibD28/dclFMXfsADO23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsADO23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs23,
+ FMXfsADO23;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsADO23.res b/LibD28/dclFMXfsADO23.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsADO23.res differ
diff --git a/LibD28/dclFMXfsADO24.dpk b/LibD28/dclFMXfsADO24.dpk
new file mode 100644
index 0000000..64bc04f
--- /dev/null
+++ b/LibD28/dclFMXfsADO24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsADO24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs24,
+ FMXfsADO24;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsADO24.res b/LibD28/dclFMXfsADO24.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsADO24.res differ
diff --git a/LibD28/dclFMXfsADO25.dpk b/LibD28/dclFMXfsADO25.dpk
new file mode 100644
index 0000000..982c24f
--- /dev/null
+++ b/LibD28/dclFMXfsADO25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsADO25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs25,
+ FMXfsADO25;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsADO25.res b/LibD28/dclFMXfsADO25.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsADO25.res differ
diff --git a/LibD28/dclFMXfsADO26.dpk b/LibD28/dclFMXfsADO26.dpk
new file mode 100644
index 0000000..2fc6d43
--- /dev/null
+++ b/LibD28/dclFMXfsADO26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsADO26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs26,
+ FMXfsADO26;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsADO27.dpk b/LibD28/dclFMXfsADO27.dpk
new file mode 100644
index 0000000..fddfc91
--- /dev/null
+++ b/LibD28/dclFMXfsADO27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsADO27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs27,
+ FMXfsADO27;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsADO28.dpk b/LibD28/dclFMXfsADO28.dpk
new file mode 100644
index 0000000..7421454
--- /dev/null
+++ b/LibD28/dclFMXfsADO28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package dclFMXfsADO29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29,
+ FMXfsADO29;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsADO29.dpk b/LibD28/dclFMXfsADO29.dpk
new file mode 100644
index 0000000..edc9fa5
--- /dev/null
+++ b/LibD28/dclFMXfsADO29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package dclFMXfsADO29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29,
+ FMXfsADO29;
+
+contains
+ FMXfs_iadoreg in 'FMXfs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsDB16.dpk b/LibD28/dclFMXfsDB16.dpk
new file mode 100644
index 0000000..ae49c7f
--- /dev/null
+++ b/LibD28/dclFMXfsDB16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclFMXfsDB16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs16,
+ FMXfsDB16;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsDB16.res b/LibD28/dclFMXfsDB16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsDB16.res differ
diff --git a/LibD28/dclFMXfsDB17.dpk b/LibD28/dclFMXfsDB17.dpk
new file mode 100644
index 0000000..65073fc
--- /dev/null
+++ b/LibD28/dclFMXfsDB17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclFMXfsDB17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs17,
+ FMXfsDB17;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsDB17.res b/LibD28/dclFMXfsDB17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsDB17.res differ
diff --git a/LibD28/dclFMXfsDB18.dpk b/LibD28/dclFMXfsDB18.dpk
new file mode 100644
index 0000000..f944213
--- /dev/null
+++ b/LibD28/dclFMXfsDB18.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi XE4
+
+package dclFMXfsDB18;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs18,
+ FMXfsDB18;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsDB18.otares b/LibD28/dclFMXfsDB18.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/dclFMXfsDB18.otares differ
diff --git a/LibD28/dclFMXfsDB18.res b/LibD28/dclFMXfsDB18.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfsDB18.res differ
diff --git a/LibD28/dclFMXfsDB19.dpk b/LibD28/dclFMXfsDB19.dpk
new file mode 100644
index 0000000..6cd2ae6
--- /dev/null
+++ b/LibD28/dclFMXfsDB19.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi XE5
+
+package dclFMXfsDB19;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs19,
+ FMXfsDB19;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsDB19.otares b/LibD28/dclFMXfsDB19.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/dclFMXfsDB19.otares differ
diff --git a/LibD28/dclFMXfsDB19.res b/LibD28/dclFMXfsDB19.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfsDB19.res differ
diff --git a/LibD28/dclFMXfsDB20.dpk b/LibD28/dclFMXfsDB20.dpk
new file mode 100644
index 0000000..9c12348
--- /dev/null
+++ b/LibD28/dclFMXfsDB20.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi XE6
+
+package dclFMXfsDB20;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs20,
+ FMXfsDB20;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsDB20.otares b/LibD28/dclFMXfsDB20.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/dclFMXfsDB20.otares differ
diff --git a/LibD28/dclFMXfsDB20.res b/LibD28/dclFMXfsDB20.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfsDB20.res differ
diff --git a/LibD28/dclFMXfsDB21.dpk b/LibD28/dclFMXfsDB21.dpk
new file mode 100644
index 0000000..5f18d25
--- /dev/null
+++ b/LibD28/dclFMXfsDB21.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi XE7
+
+package dclFMXfsDB21;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs21,
+ FMXfsDB21;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsDB21.otares b/LibD28/dclFMXfsDB21.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/dclFMXfsDB21.otares differ
diff --git a/LibD28/dclFMXfsDB21.res b/LibD28/dclFMXfsDB21.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfsDB21.res differ
diff --git a/LibD28/dclFMXfsDB22.dpk b/LibD28/dclFMXfsDB22.dpk
new file mode 100644
index 0000000..d70808f
--- /dev/null
+++ b/LibD28/dclFMXfsDB22.dpk
@@ -0,0 +1,45 @@
+// Package file for Delphi XE8
+
+package dclFMXfsDB22;
+
+{$R *.res}
+{$R *.otares}
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs22,
+ FMXfsDB22;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsDB22.otares b/LibD28/dclFMXfsDB22.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/dclFMXfsDB22.otares differ
diff --git a/LibD28/dclFMXfsDB22.res b/LibD28/dclFMXfsDB22.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfsDB22.res differ
diff --git a/LibD28/dclFMXfsDB23.dpk b/LibD28/dclFMXfsDB23.dpk
new file mode 100644
index 0000000..bd11a08
--- /dev/null
+++ b/LibD28/dclFMXfsDB23.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsDB23;
+
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs23,
+ FMXfsDB23;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsDB23.otares b/LibD28/dclFMXfsDB23.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/dclFMXfsDB23.otares differ
diff --git a/LibD28/dclFMXfsDB23.res b/LibD28/dclFMXfsDB23.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfsDB23.res differ
diff --git a/LibD28/dclFMXfsDB24.dpk b/LibD28/dclFMXfsDB24.dpk
new file mode 100644
index 0000000..21680c2
--- /dev/null
+++ b/LibD28/dclFMXfsDB24.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsDB24;
+
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs24,
+ FMXfsDB24;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsDB24.otares b/LibD28/dclFMXfsDB24.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/dclFMXfsDB24.otares differ
diff --git a/LibD28/dclFMXfsDB24.res b/LibD28/dclFMXfsDB24.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfsDB24.res differ
diff --git a/LibD28/dclFMXfsDB25.dpk b/LibD28/dclFMXfsDB25.dpk
new file mode 100644
index 0000000..3f6b02e
--- /dev/null
+++ b/LibD28/dclFMXfsDB25.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsDB25;
+
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs25,
+ FMXfsDB25;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsDB25.otares b/LibD28/dclFMXfsDB25.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/dclFMXfsDB25.otares differ
diff --git a/LibD28/dclFMXfsDB25.res b/LibD28/dclFMXfsDB25.res
new file mode 100644
index 0000000..a64cea3
Binary files /dev/null and b/LibD28/dclFMXfsDB25.res differ
diff --git a/LibD28/dclFMXfsDB26.dpk b/LibD28/dclFMXfsDB26.dpk
new file mode 100644
index 0000000..5d4661f
--- /dev/null
+++ b/LibD28/dclFMXfsDB26.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsDB26;
+
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs26,
+ FMXfsDB26;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsDB27.dpk b/LibD28/dclFMXfsDB27.dpk
new file mode 100644
index 0000000..c8983d1
--- /dev/null
+++ b/LibD28/dclFMXfsDB27.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsDB27;
+
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs27,
+ FMXfsDB27;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsDB28.dpk b/LibD28/dclFMXfsDB28.dpk
new file mode 100644
index 0000000..7c302c3
--- /dev/null
+++ b/LibD28/dclFMXfsDB28.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 11 Seattle
+
+package dclFMXfsDB29;
+
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29,
+ FMXfsDB29;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsDB29.dpk b/LibD28/dclFMXfsDB29.dpk
new file mode 100644
index 0000000..57a4391
--- /dev/null
+++ b/LibD28/dclFMXfsDB29.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 12
+
+package dclFMXfsDB29;
+
+{$R 'fs_ireg.dcr'}
+{$IFDEF IMPLICITBUILDING This IFDEF should not be used by users}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION OFF}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES ON}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DEFINE DEBUG}
+{$ENDIF IMPLICITBUILDING}
+{$DESCRIPTION 'FastScript 1.9 FMX DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29,
+ FMXfsDB29;
+
+contains
+ FMXfs_idbreg in 'FMXfs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsDB29.dproj b/LibD28/dclFMXfsDB29.dproj
new file mode 100644
index 0000000..dd29041
--- /dev/null
+++ b/LibD28/dclFMXfsDB29.dproj
@@ -0,0 +1,117 @@
+
+
+ {660B778A-B47C-4378-92E9-602055BD03E2}
+ dclFMXfsDB29.dpk
+ True
+ Release
+ 1
+ Package
+ None
+ 20.1
+ Win32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ dclFMXfsDB29
+ FastScript 1.9 FMX DB Components
+ true
+ true
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+ fmx;FMXfs29;FMXfsDB29;$(DCC_UsePackage)
+
+
+ fmx;$(DCC_UsePackage)
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ dclFMXfsDB29.dpk
+
+
+
+ True
+ False
+
+
+ 12
+
+
+
+
diff --git a/LibD28/dclFMXfsDB29.res b/LibD28/dclFMXfsDB29.res
new file mode 100644
index 0000000..022618b
Binary files /dev/null and b/LibD28/dclFMXfsDB29.res differ
diff --git a/LibD28/dclFMXfsIBX16.dpk b/LibD28/dclFMXfsIBX16.dpk
new file mode 100644
index 0000000..024903b
--- /dev/null
+++ b/LibD28/dclFMXfsIBX16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclFMXfsIBX16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs16,
+ FMXfsIBX16;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsIBX16.res b/LibD28/dclFMXfsIBX16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsIBX16.res differ
diff --git a/LibD28/dclFMXfsIBX17.dpk b/LibD28/dclFMXfsIBX17.dpk
new file mode 100644
index 0000000..595bf4e
--- /dev/null
+++ b/LibD28/dclFMXfsIBX17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclFMXfsIBX17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs17,
+ FMXfsIBX17;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsIBX17.res b/LibD28/dclFMXfsIBX17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsIBX17.res differ
diff --git a/LibD28/dclFMXfsIBX18.dpk b/LibD28/dclFMXfsIBX18.dpk
new file mode 100644
index 0000000..7c1cb8d
--- /dev/null
+++ b/LibD28/dclFMXfsIBX18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package dclFMXfsIBX18;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs18,
+ FMXfsIBX18;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsIBX18.res b/LibD28/dclFMXfsIBX18.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsIBX18.res differ
diff --git a/LibD28/dclFMXfsIBX19.dpk b/LibD28/dclFMXfsIBX19.dpk
new file mode 100644
index 0000000..c77c2f4
--- /dev/null
+++ b/LibD28/dclFMXfsIBX19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package dclFMXfsIBX19;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs19,
+ FMXfsIBX19;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsIBX19.res b/LibD28/dclFMXfsIBX19.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsIBX19.res differ
diff --git a/LibD28/dclFMXfsIBX20.dpk b/LibD28/dclFMXfsIBX20.dpk
new file mode 100644
index 0000000..ca64df5
--- /dev/null
+++ b/LibD28/dclFMXfsIBX20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package dclFMXfsIBX20;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs20,
+ FMXfsIBX20;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsIBX20.res b/LibD28/dclFMXfsIBX20.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsIBX20.res differ
diff --git a/LibD28/dclFMXfsIBX21.dpk b/LibD28/dclFMXfsIBX21.dpk
new file mode 100644
index 0000000..26d360a
--- /dev/null
+++ b/LibD28/dclFMXfsIBX21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package dclFMXfsIBX21;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs21,
+ FMXfsIBX21;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsIBX21.res b/LibD28/dclFMXfsIBX21.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsIBX21.res differ
diff --git a/LibD28/dclFMXfsIBX22.dpk b/LibD28/dclFMXfsIBX22.dpk
new file mode 100644
index 0000000..854fc1a
--- /dev/null
+++ b/LibD28/dclFMXfsIBX22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package dclFMXfsIBX22;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs22,
+ FMXfsIBX22;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsIBX22.res b/LibD28/dclFMXfsIBX22.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsIBX22.res differ
diff --git a/LibD28/dclFMXfsIBX23.dpk b/LibD28/dclFMXfsIBX23.dpk
new file mode 100644
index 0000000..e4690f5
--- /dev/null
+++ b/LibD28/dclFMXfsIBX23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsIBX23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs23,
+ FMXfsIBX23;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsIBX23.res b/LibD28/dclFMXfsIBX23.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsIBX23.res differ
diff --git a/LibD28/dclFMXfsIBX24.dpk b/LibD28/dclFMXfsIBX24.dpk
new file mode 100644
index 0000000..7f67057
--- /dev/null
+++ b/LibD28/dclFMXfsIBX24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsIBX24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs24,
+ FMXfsIBX24;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsIBX24.res b/LibD28/dclFMXfsIBX24.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsIBX24.res differ
diff --git a/LibD28/dclFMXfsIBX25.dpk b/LibD28/dclFMXfsIBX25.dpk
new file mode 100644
index 0000000..760b971
--- /dev/null
+++ b/LibD28/dclFMXfsIBX25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsIBX25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs25,
+ FMXfsIBX25;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsIBX25.res b/LibD28/dclFMXfsIBX25.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsIBX25.res differ
diff --git a/LibD28/dclFMXfsIBX26.dpk b/LibD28/dclFMXfsIBX26.dpk
new file mode 100644
index 0000000..5787898
--- /dev/null
+++ b/LibD28/dclFMXfsIBX26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsIBX26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs26,
+ FMXfsIBX26;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsIBX27.dpk b/LibD28/dclFMXfsIBX27.dpk
new file mode 100644
index 0000000..dbfac84
--- /dev/null
+++ b/LibD28/dclFMXfsIBX27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsIBX27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs27,
+ FMXfsIBX27;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsIBX28.dpk b/LibD28/dclFMXfsIBX28.dpk
new file mode 100644
index 0000000..fc50c43
--- /dev/null
+++ b/LibD28/dclFMXfsIBX28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package dclFMXfsIBX29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29,
+ FMXfsIBX29;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsIBX29.dpk b/LibD28/dclFMXfsIBX29.dpk
new file mode 100644
index 0000000..874e96e
--- /dev/null
+++ b/LibD28/dclFMXfsIBX29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package dclFMXfsIBX29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29,
+ FMXfsIBX29;
+
+contains
+ FMXfs_iibxreg in 'FMXfs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsTee16.dpk b/LibD28/dclFMXfsTee16.dpk
new file mode 100644
index 0000000..3ff825f
--- /dev/null
+++ b/LibD28/dclFMXfsTee16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclFMXfsTee16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs16,
+ FMXfsTee16;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsTee16.res b/LibD28/dclFMXfsTee16.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsTee16.res differ
diff --git a/LibD28/dclFMXfsTee17.dpk b/LibD28/dclFMXfsTee17.dpk
new file mode 100644
index 0000000..6725bc8
--- /dev/null
+++ b/LibD28/dclFMXfsTee17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclFMXfsTee17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs17,
+ FMXfsTee17;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsTee17.res b/LibD28/dclFMXfsTee17.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsTee17.res differ
diff --git a/LibD28/dclFMXfsTee18.dpk b/LibD28/dclFMXfsTee18.dpk
new file mode 100644
index 0000000..86bd659
--- /dev/null
+++ b/LibD28/dclFMXfsTee18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package dclFMXfsTee18;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs18,
+ FMXfsTee18;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsTee18.res b/LibD28/dclFMXfsTee18.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsTee18.res differ
diff --git a/LibD28/dclFMXfsTee19.dpk b/LibD28/dclFMXfsTee19.dpk
new file mode 100644
index 0000000..2c49235
--- /dev/null
+++ b/LibD28/dclFMXfsTee19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package dclFMXfsTee19;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs19,
+ FMXfsTee19;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsTee19.res b/LibD28/dclFMXfsTee19.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsTee19.res differ
diff --git a/LibD28/dclFMXfsTee20.dpk b/LibD28/dclFMXfsTee20.dpk
new file mode 100644
index 0000000..5a8268b
--- /dev/null
+++ b/LibD28/dclFMXfsTee20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package dclFMXfsTee20;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs20,
+ FMXfsTee20;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsTee20.res b/LibD28/dclFMXfsTee20.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsTee20.res differ
diff --git a/LibD28/dclFMXfsTee21.dpk b/LibD28/dclFMXfsTee21.dpk
new file mode 100644
index 0000000..b4f72e7
--- /dev/null
+++ b/LibD28/dclFMXfsTee21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package dclFMXfsTee21;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs21,
+ FMXfsTee21;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsTee21.res b/LibD28/dclFMXfsTee21.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsTee21.res differ
diff --git a/LibD28/dclFMXfsTee22.dpk b/LibD28/dclFMXfsTee22.dpk
new file mode 100644
index 0000000..33b50de
--- /dev/null
+++ b/LibD28/dclFMXfsTee22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package dclFMXfsTee22;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs22,
+ FMXfsTee22;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsTee22.res b/LibD28/dclFMXfsTee22.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsTee22.res differ
diff --git a/LibD28/dclFMXfsTee23.dpk b/LibD28/dclFMXfsTee23.dpk
new file mode 100644
index 0000000..81cb335
--- /dev/null
+++ b/LibD28/dclFMXfsTee23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsTee23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs23,
+ FMXfsTee23;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsTee23.res b/LibD28/dclFMXfsTee23.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsTee23.res differ
diff --git a/LibD28/dclFMXfsTee24.dpk b/LibD28/dclFMXfsTee24.dpk
new file mode 100644
index 0000000..965474b
--- /dev/null
+++ b/LibD28/dclFMXfsTee24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsTee24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs24,
+ FMXfsTee24;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsTee24.res b/LibD28/dclFMXfsTee24.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsTee24.res differ
diff --git a/LibD28/dclFMXfsTee25.dpk b/LibD28/dclFMXfsTee25.dpk
new file mode 100644
index 0000000..561f9ff
--- /dev/null
+++ b/LibD28/dclFMXfsTee25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsTee25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs25,
+ FMXfsTee25;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsTee25.res b/LibD28/dclFMXfsTee25.res
new file mode 100644
index 0000000..42917f5
Binary files /dev/null and b/LibD28/dclFMXfsTee25.res differ
diff --git a/LibD28/dclFMXfsTee26.dpk b/LibD28/dclFMXfsTee26.dpk
new file mode 100644
index 0000000..a372cd8
--- /dev/null
+++ b/LibD28/dclFMXfsTee26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsTee26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs26,
+ FMXfsTee26;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsTee27.dpk b/LibD28/dclFMXfsTee27.dpk
new file mode 100644
index 0000000..943b74e
--- /dev/null
+++ b/LibD28/dclFMXfsTee27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclFMXfsTee27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs27,
+ FMXfsTee27;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsTee28.dpk b/LibD28/dclFMXfsTee28.dpk
new file mode 100644
index 0000000..fcded75
--- /dev/null
+++ b/LibD28/dclFMXfsTee28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package dclFMXfsTee29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29,
+ FMXfsTee29;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsTee29.dpk b/LibD28/dclFMXfsTee29.dpk
new file mode 100644
index 0000000..ac47668
--- /dev/null
+++ b/LibD28/dclFMXfsTee29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package dclFMXfsTee29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FMX Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ FMX,
+ DESIGNIDE,
+ FMXfs29,
+ FMXfsTee29;
+
+contains
+ FMXfs_iteereg in 'FMXfs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclFMXfsTee29.dproj b/LibD28/dclFMXfsTee29.dproj
new file mode 100644
index 0000000..d007db4
--- /dev/null
+++ b/LibD28/dclFMXfsTee29.dproj
@@ -0,0 +1,119 @@
+
+
+ {B7CDA2D2-0480-4033-80CA-BA62A1ADDC87}
+ dclFMXfsTee29.dpk
+ True
+ Release
+ 1
+ Package
+ None
+ 20.1
+ Win32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ dclFMXfsTee29
+ 1
+ true
+ FastScript 1.9 FMX Tee Components
+ true
+ true
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ System;Xml;Data;Datasnap;Web;Soap;REST.Authenticator.OAuth.WebForm;$(DCC_Namespace)
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+ fmx;FMXfs29;FMXfsTee29;$(DCC_UsePackage)
+
+
+ fmx;$(DCC_UsePackage)
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ dclFMXfsTee29.dpk
+
+
+
+ True
+ False
+
+
+ 12
+
+
+
+
diff --git a/LibD28/dclFMXfsTee29.res b/LibD28/dclFMXfsTee29.res
new file mode 100644
index 0000000..244da35
Binary files /dev/null and b/LibD28/dclFMXfsTee29.res differ
diff --git a/LibD28/dclfs10.dpk b/LibD28/dclfs10.dpk
new file mode 100644
index 0000000..bc13c13
--- /dev/null
+++ b/LibD28/dclfs10.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 2006
+
+package dclfs10;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs10;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs11.dpk b/LibD28/dclfs11.dpk
new file mode 100644
index 0000000..448c2a5
--- /dev/null
+++ b/LibD28/dclfs11.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 2007
+
+package dclfs11;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs11;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs12.dpk b/LibD28/dclfs12.dpk
new file mode 100644
index 0000000..ee9aed6
--- /dev/null
+++ b/LibD28/dclfs12.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 2009
+
+package dclfs12;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs12;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs14.dpk b/LibD28/dclfs14.dpk
new file mode 100644
index 0000000..334e131
--- /dev/null
+++ b/LibD28/dclfs14.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 2010
+
+package dclfs14;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs14;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs15.dpk b/LibD28/dclfs15.dpk
new file mode 100644
index 0000000..45e4796
--- /dev/null
+++ b/LibD28/dclfs15.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE
+
+package dclfs15;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs15;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs16.dpk b/LibD28/dclfs16.dpk
new file mode 100644
index 0000000..46e1c5a
--- /dev/null
+++ b/LibD28/dclfs16.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE2
+
+package dclfs16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs16;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs17.dpk b/LibD28/dclfs17.dpk
new file mode 100644
index 0000000..67283a4
--- /dev/null
+++ b/LibD28/dclfs17.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE3
+
+package dclfs17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs17;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs18.dpk b/LibD28/dclfs18.dpk
new file mode 100644
index 0000000..3c1de49
--- /dev/null
+++ b/LibD28/dclfs18.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE4
+
+package dclfs18;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs18;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs19.dpk b/LibD28/dclfs19.dpk
new file mode 100644
index 0000000..a249539
--- /dev/null
+++ b/LibD28/dclfs19.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE5
+
+package dclfs19;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs19;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs20.dpk b/LibD28/dclfs20.dpk
new file mode 100644
index 0000000..9236239
--- /dev/null
+++ b/LibD28/dclfs20.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE6
+
+package dclfs20;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs20;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs21.dpk b/LibD28/dclfs21.dpk
new file mode 100644
index 0000000..e6439f7
--- /dev/null
+++ b/LibD28/dclfs21.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE7
+
+package dclfs21;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs21;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs22.dpk b/LibD28/dclfs22.dpk
new file mode 100644
index 0000000..f4ed026
--- /dev/null
+++ b/LibD28/dclfs22.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE8
+
+package dclfs22;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs22;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs23.dpk b/LibD28/dclfs23.dpk
new file mode 100644
index 0000000..3a47e28
--- /dev/null
+++ b/LibD28/dclfs23.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclfs23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs23;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs24.dpk b/LibD28/dclfs24.dpk
new file mode 100644
index 0000000..e2e042c
--- /dev/null
+++ b/LibD28/dclfs24.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclfs24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs24;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs25.dpk b/LibD28/dclfs25.dpk
new file mode 100644
index 0000000..bbfd2a1
--- /dev/null
+++ b/LibD28/dclfs25.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclfs25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs25;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs26.dpk b/LibD28/dclfs26.dpk
new file mode 100644
index 0000000..e7820a0
--- /dev/null
+++ b/LibD28/dclfs26.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclfs26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs26;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs27.dpk b/LibD28/dclfs27.dpk
new file mode 100644
index 0000000..a250656
--- /dev/null
+++ b/LibD28/dclfs27.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package dclfs27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs27;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs28.dpk b/LibD28/dclfs28.dpk
new file mode 100644
index 0000000..cefcf80
--- /dev/null
+++ b/LibD28/dclfs28.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 11 Seattle
+
+package dclfs28;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs28;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs29.dpk b/LibD28/dclfs29.dpk
new file mode 100644
index 0000000..5ddacda
--- /dev/null
+++ b/LibD28/dclfs29.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 12
+
+package dclfs29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs29;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs29.dproj b/LibD28/dclfs29.dproj
new file mode 100644
index 0000000..209fa7e
--- /dev/null
+++ b/LibD28/dclfs29.dproj
@@ -0,0 +1,118 @@
+
+
+ {1365FFC6-F849-43D8-96F3-3C35263D02CC}
+ dclfs29.dpk
+ True
+ Release
+ 1
+ Package
+ VCL
+ 20.1
+ Win32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ dclfs29
+ 1
+ true
+ FastScript 1.9 Components
+ true
+ true
+ Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;DUnitX.Loggers.GUI;$(DCC_Namespace)
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+ vcl;fs29;$(DCC_UsePackage)
+
+
+ vcl;$(DCC_UsePackage)
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ dclfs29.dpk
+
+
+
+ True
+ False
+
+
+ 12
+
+
+
+
diff --git a/LibD28/dclfs29.res b/LibD28/dclfs29.res
new file mode 100644
index 0000000..e159d97
Binary files /dev/null and b/LibD28/dclfs29.res differ
diff --git a/LibD28/dclfs4.dpk b/LibD28/dclfs4.dpk
new file mode 100644
index 0000000..297a60e
--- /dev/null
+++ b/LibD28/dclfs4.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 4
+
+package dclfs4;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL40,
+ fs4;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs5.dpk b/LibD28/dclfs5.dpk
new file mode 100644
index 0000000..8384db9
--- /dev/null
+++ b/LibD28/dclfs5.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 5
+
+package dclfs5;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+ fs5;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs6.dpk b/LibD28/dclfs6.dpk
new file mode 100644
index 0000000..a45755b
--- /dev/null
+++ b/LibD28/dclfs6.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 6
+
+package dclfs6;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs6;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs7.dpk b/LibD28/dclfs7.dpk
new file mode 100644
index 0000000..bdace06
--- /dev/null
+++ b/LibD28/dclfs7.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 7
+
+package dclfs7;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs7;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfs9.dpk b/LibD28/dclfs9.dpk
new file mode 100644
index 0000000..50f7a31
--- /dev/null
+++ b/LibD28/dclfs9.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 2005
+
+package dclfs9;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs9;
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfsADO10.dpk b/LibD28/dclfsADO10.dpk
new file mode 100644
index 0000000..ce476af
--- /dev/null
+++ b/LibD28/dclfsADO10.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2006
+
+package dclfsADO10;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs10,
+ fsADO10;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsADO11.dpk b/LibD28/dclfsADO11.dpk
new file mode 100644
index 0000000..3e4f6fa
--- /dev/null
+++ b/LibD28/dclfsADO11.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2007
+
+package dclfsADO11;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs11,
+ fsADO11;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsADO12.dpk b/LibD28/dclfsADO12.dpk
new file mode 100644
index 0000000..003e928
--- /dev/null
+++ b/LibD28/dclfsADO12.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2009
+
+package dclfsADO12;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs12,
+ fsADO12;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsADO14.dpk b/LibD28/dclfsADO14.dpk
new file mode 100644
index 0000000..384613f
--- /dev/null
+++ b/LibD28/dclfsADO14.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 2010
+
+package dclfsADO14;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs14,
+ fsADO14;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsADO15.dpk b/LibD28/dclfsADO15.dpk
new file mode 100644
index 0000000..67d77ce
--- /dev/null
+++ b/LibD28/dclfsADO15.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE
+
+package dclfsADO15;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs15,
+ fsADO15;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsADO16.dpk b/LibD28/dclfsADO16.dpk
new file mode 100644
index 0000000..a088873
--- /dev/null
+++ b/LibD28/dclfsADO16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclfsADO16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs16,
+ fsADO16;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsADO17.dpk b/LibD28/dclfsADO17.dpk
new file mode 100644
index 0000000..83cf941
--- /dev/null
+++ b/LibD28/dclfsADO17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclfsADO17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs17,
+ fsADO17;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsADO18.dpk b/LibD28/dclfsADO18.dpk
new file mode 100644
index 0000000..db09bc0
--- /dev/null
+++ b/LibD28/dclfsADO18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package dclfsADO18;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs18,
+ fsADO18;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsADO19.dpk b/LibD28/dclfsADO19.dpk
new file mode 100644
index 0000000..87926c9
--- /dev/null
+++ b/LibD28/dclfsADO19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package dclfsADO19;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs19,
+ fsADO19;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsADO20.dpk b/LibD28/dclfsADO20.dpk
new file mode 100644
index 0000000..4b16e4d
--- /dev/null
+++ b/LibD28/dclfsADO20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package dclfsADO20;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs20,
+ fsADO20;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsADO21.dpk b/LibD28/dclfsADO21.dpk
new file mode 100644
index 0000000..b245111
--- /dev/null
+++ b/LibD28/dclfsADO21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package dclfsADO21;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs21,
+ fsADO21;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsADO22.dpk b/LibD28/dclfsADO22.dpk
new file mode 100644
index 0000000..34c13f0
--- /dev/null
+++ b/LibD28/dclfsADO22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package dclfsADO22;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs22,
+ fsADO22;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsADO23.dpk b/LibD28/dclfsADO23.dpk
new file mode 100644
index 0000000..bde9bab
--- /dev/null
+++ b/LibD28/dclfsADO23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsADO23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs23,
+ fsADO23;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsADO24.dpk b/LibD28/dclfsADO24.dpk
new file mode 100644
index 0000000..4646ef9
--- /dev/null
+++ b/LibD28/dclfsADO24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsADO24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs24,
+ fsADO24;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsADO25.dpk b/LibD28/dclfsADO25.dpk
new file mode 100644
index 0000000..a44ba5e
--- /dev/null
+++ b/LibD28/dclfsADO25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsADO25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs25,
+ fsADO25;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsADO26.dpk b/LibD28/dclfsADO26.dpk
new file mode 100644
index 0000000..616db18
--- /dev/null
+++ b/LibD28/dclfsADO26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsADO26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs26,
+ fsADO26;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsADO27.dpk b/LibD28/dclfsADO27.dpk
new file mode 100644
index 0000000..c892b43
--- /dev/null
+++ b/LibD28/dclfsADO27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsADO27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs27,
+ fsADO27;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsADO28.dpk b/LibD28/dclfsADO28.dpk
new file mode 100644
index 0000000..597b7a5
--- /dev/null
+++ b/LibD28/dclfsADO28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package dclfsADO28;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs28,
+ fsADO28;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsADO29.dpk b/LibD28/dclfsADO29.dpk
new file mode 100644
index 0000000..f0e74bc
--- /dev/null
+++ b/LibD28/dclfsADO29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package dclfsADO29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs29,
+ fsADO29;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsADO5.dpk b/LibD28/dclfsADO5.dpk
new file mode 100644
index 0000000..bf65218
--- /dev/null
+++ b/LibD28/dclfsADO5.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 5
+
+package dclfsADO5;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+ fs5,
+ fsADO5;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsADO6.dpk b/LibD28/dclfsADO6.dpk
new file mode 100644
index 0000000..04c779b
--- /dev/null
+++ b/LibD28/dclfsADO6.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 6
+
+package dclfsADO6;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs6,
+ fsADO6;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsADO7.dpk b/LibD28/dclfsADO7.dpk
new file mode 100644
index 0000000..261ae1b
--- /dev/null
+++ b/LibD28/dclfsADO7.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 7
+
+package dclfsADO7;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs7,
+ fsADO7;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsADO9.dpk b/LibD28/dclfsADO9.dpk
new file mode 100644
index 0000000..6df9798
--- /dev/null
+++ b/LibD28/dclfsADO9.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2005
+
+package dclfsADO9;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 ADO Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs9,
+ fsADO9;
+
+contains
+ fs_iadoreg in 'fs_iadoreg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE10.dpk b/LibD28/dclfsBDE10.dpk
new file mode 100644
index 0000000..9ccd14c
--- /dev/null
+++ b/LibD28/dclfsBDE10.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2006
+
+package dclfsBDE10;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs10,
+ fsBDE10;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE11.dpk b/LibD28/dclfsBDE11.dpk
new file mode 100644
index 0000000..3c365fa
--- /dev/null
+++ b/LibD28/dclfsBDE11.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2007
+
+package dclfsBDE11;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs11,
+ fsBDE11;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE12.dpk b/LibD28/dclfsBDE12.dpk
new file mode 100644
index 0000000..076fdc7
--- /dev/null
+++ b/LibD28/dclfsBDE12.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2009
+
+package dclfsBDE12;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs12,
+ fsBDE12;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE14.dpk b/LibD28/dclfsBDE14.dpk
new file mode 100644
index 0000000..28276a6
--- /dev/null
+++ b/LibD28/dclfsBDE14.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 2010
+
+package dclfsBDE14;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs14,
+ fsBDE14;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE15.dpk b/LibD28/dclfsBDE15.dpk
new file mode 100644
index 0000000..7ba0b54
--- /dev/null
+++ b/LibD28/dclfsBDE15.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE
+
+package dclfsBDE15;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs15,
+ fsBDE15;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE16.dpk b/LibD28/dclfsBDE16.dpk
new file mode 100644
index 0000000..720cd4e
--- /dev/null
+++ b/LibD28/dclfsBDE16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclfsBDE16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs16,
+ fsBDE16;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE17.dpk b/LibD28/dclfsBDE17.dpk
new file mode 100644
index 0000000..d6166fc
--- /dev/null
+++ b/LibD28/dclfsBDE17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclfsBDE17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs17,
+ fsBDE17;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE18.dpk b/LibD28/dclfsBDE18.dpk
new file mode 100644
index 0000000..b505311
--- /dev/null
+++ b/LibD28/dclfsBDE18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package dclfsBDE18;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs18,
+ fsBDE18;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE19.dpk b/LibD28/dclfsBDE19.dpk
new file mode 100644
index 0000000..2948eed
--- /dev/null
+++ b/LibD28/dclfsBDE19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package dclfsBDE19;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs19,
+ fsBDE19;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE20.dpk b/LibD28/dclfsBDE20.dpk
new file mode 100644
index 0000000..cfb519b
--- /dev/null
+++ b/LibD28/dclfsBDE20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package dclfsBDE20;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs20,
+ fsBDE20;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE21.dpk b/LibD28/dclfsBDE21.dpk
new file mode 100644
index 0000000..935d85c
--- /dev/null
+++ b/LibD28/dclfsBDE21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package dclfsBDE21;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs21,
+ fsBDE21;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE22.dpk b/LibD28/dclfsBDE22.dpk
new file mode 100644
index 0000000..c0b9085
--- /dev/null
+++ b/LibD28/dclfsBDE22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package dclfsBDE22;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs22,
+ fsBDE22;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE23.dpk b/LibD28/dclfsBDE23.dpk
new file mode 100644
index 0000000..f8058b4
--- /dev/null
+++ b/LibD28/dclfsBDE23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsBDE23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs23,
+ fsBDE23;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE24.dpk b/LibD28/dclfsBDE24.dpk
new file mode 100644
index 0000000..fcb4ff1
--- /dev/null
+++ b/LibD28/dclfsBDE24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsBDE24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs24,
+ fsBDE24;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE25.dpk b/LibD28/dclfsBDE25.dpk
new file mode 100644
index 0000000..673e27d
--- /dev/null
+++ b/LibD28/dclfsBDE25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsBDE25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs25,
+ fsBDE25;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE26.dpk b/LibD28/dclfsBDE26.dpk
new file mode 100644
index 0000000..77e0d61
--- /dev/null
+++ b/LibD28/dclfsBDE26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsBDE26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs26,
+ fsBDE26;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE27.dpk b/LibD28/dclfsBDE27.dpk
new file mode 100644
index 0000000..565753b
--- /dev/null
+++ b/LibD28/dclfsBDE27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsBDE27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs27,
+ fsBDE27;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE28.dpk b/LibD28/dclfsBDE28.dpk
new file mode 100644
index 0000000..33b4e47
--- /dev/null
+++ b/LibD28/dclfsBDE28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package dclfsBDE28;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs28,
+ fsBDE28;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE29.dpk b/LibD28/dclfsBDE29.dpk
new file mode 100644
index 0000000..892ac89
--- /dev/null
+++ b/LibD28/dclfsBDE29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package dclfsBDE29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs29,
+ fsBDE29;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE4.dpk b/LibD28/dclfsBDE4.dpk
new file mode 100644
index 0000000..9062111
--- /dev/null
+++ b/LibD28/dclfsBDE4.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 4
+
+package dclfsBDE4;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL40,
+ fs4,
+ fsBDE4;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE5.dpk b/LibD28/dclfsBDE5.dpk
new file mode 100644
index 0000000..7c6c477
--- /dev/null
+++ b/LibD28/dclfsBDE5.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 5
+
+package dclfsBDE5;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+ fs5,
+ fsBDE5;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE6.dpk b/LibD28/dclfsBDE6.dpk
new file mode 100644
index 0000000..ba99903
--- /dev/null
+++ b/LibD28/dclfsBDE6.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 6
+
+package dclfsBDE6;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs6,
+ fsBDE6;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE7.dpk b/LibD28/dclfsBDE7.dpk
new file mode 100644
index 0000000..b973078
--- /dev/null
+++ b/LibD28/dclfsBDE7.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 7
+
+package dclfsBDE7;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs7,
+ fsBDE7;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsBDE9.dpk b/LibD28/dclfsBDE9.dpk
new file mode 100644
index 0000000..c9ac0c2
--- /dev/null
+++ b/LibD28/dclfsBDE9.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2005
+
+package dclfsBDE9;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 BDE Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs9,
+ fsBDE9;
+
+contains
+ fs_ibdereg in 'fs_ibdereg.pas';
+
+end.
diff --git a/LibD28/dclfsDB10.dpk b/LibD28/dclfsDB10.dpk
new file mode 100644
index 0000000..7e728f1
--- /dev/null
+++ b/LibD28/dclfsDB10.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2006
+
+package dclfsDB10;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs10,
+ fsDB10;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB11.dpk b/LibD28/dclfsDB11.dpk
new file mode 100644
index 0000000..cf81001
--- /dev/null
+++ b/LibD28/dclfsDB11.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2007
+
+package dclfsDB11;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs11,
+ fsDB11;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB12.dpk b/LibD28/dclfsDB12.dpk
new file mode 100644
index 0000000..a7707e1
--- /dev/null
+++ b/LibD28/dclfsDB12.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2009
+
+package dclfsDB12;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs12,
+ fsDB12;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB14.dpk b/LibD28/dclfsDB14.dpk
new file mode 100644
index 0000000..7083e22
--- /dev/null
+++ b/LibD28/dclfsDB14.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 2010
+
+package dclfsDB14;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs14,
+ fsDB14;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB15.dpk b/LibD28/dclfsDB15.dpk
new file mode 100644
index 0000000..b1a787a
--- /dev/null
+++ b/LibD28/dclfsDB15.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE
+
+package dclfsDB15;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs15,
+ fsDB15;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB16.dpk b/LibD28/dclfsDB16.dpk
new file mode 100644
index 0000000..491a0f0
--- /dev/null
+++ b/LibD28/dclfsDB16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclfsDB16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs16,
+ fsDB16;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB17.dpk b/LibD28/dclfsDB17.dpk
new file mode 100644
index 0000000..db3ecfd
--- /dev/null
+++ b/LibD28/dclfsDB17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclfsDB17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs17,
+ fsDB17;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB18.dpk b/LibD28/dclfsDB18.dpk
new file mode 100644
index 0000000..053ade5
--- /dev/null
+++ b/LibD28/dclfsDB18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package dclfsDB18;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs18,
+ fsDB18;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB19.dpk b/LibD28/dclfsDB19.dpk
new file mode 100644
index 0000000..a137c99
--- /dev/null
+++ b/LibD28/dclfsDB19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package dclfsDB19;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs19,
+ fsDB19;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB20.dpk b/LibD28/dclfsDB20.dpk
new file mode 100644
index 0000000..e70175d
--- /dev/null
+++ b/LibD28/dclfsDB20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package dclfsDB20;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs20,
+ fsDB20;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB21.dpk b/LibD28/dclfsDB21.dpk
new file mode 100644
index 0000000..da93899
--- /dev/null
+++ b/LibD28/dclfsDB21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package dclfsDB21;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs21,
+ fsDB21;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB22.dpk b/LibD28/dclfsDB22.dpk
new file mode 100644
index 0000000..2546074
--- /dev/null
+++ b/LibD28/dclfsDB22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package dclfsDB22;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs22,
+ fsDB22;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB23.dpk b/LibD28/dclfsDB23.dpk
new file mode 100644
index 0000000..2eb7cc0
--- /dev/null
+++ b/LibD28/dclfsDB23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsDB23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs23,
+ fsDB23;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB24.dpk b/LibD28/dclfsDB24.dpk
new file mode 100644
index 0000000..cd44f2a
--- /dev/null
+++ b/LibD28/dclfsDB24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsDB24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs24,
+ fsDB24;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB25.dpk b/LibD28/dclfsDB25.dpk
new file mode 100644
index 0000000..89732aa
--- /dev/null
+++ b/LibD28/dclfsDB25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsDB25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs25,
+ fsDB25;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB26.dpk b/LibD28/dclfsDB26.dpk
new file mode 100644
index 0000000..8ea689a
--- /dev/null
+++ b/LibD28/dclfsDB26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsDB26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs26,
+ fsDB26;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB27.dpk b/LibD28/dclfsDB27.dpk
new file mode 100644
index 0000000..48e119b
--- /dev/null
+++ b/LibD28/dclfsDB27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsDB27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs27,
+ fsDB27;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB28.dpk b/LibD28/dclfsDB28.dpk
new file mode 100644
index 0000000..ed646e9
--- /dev/null
+++ b/LibD28/dclfsDB28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package dclfsDB28;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs28,
+ fsDB28;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB29.dpk b/LibD28/dclfsDB29.dpk
new file mode 100644
index 0000000..da8f59f
--- /dev/null
+++ b/LibD28/dclfsDB29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package dclfsDB29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs29,
+ fsDB29;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB29.dproj b/LibD28/dclfsDB29.dproj
new file mode 100644
index 0000000..b343055
--- /dev/null
+++ b/LibD28/dclfsDB29.dproj
@@ -0,0 +1,119 @@
+
+
+ {C0FDBA68-B0B3-4F13-A2D8-E11FE95B9253}
+ dclfsDB29.dpk
+ True
+ Release
+ 1
+ Package
+ VCL
+ 20.1
+ Win32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ dclfsDB29
+ 1
+ true
+ FastScript 1.9 DB Components
+ true
+ true
+ Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;DUnitX.Loggers.GUI;$(DCC_Namespace)
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+ vcl;fs29;fsDB29;$(DCC_UsePackage)
+
+
+ vcl;$(DCC_UsePackage)
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ dclfsDB29.dpk
+
+
+
+ True
+ False
+
+
+ 12
+
+
+
+
diff --git a/LibD28/dclfsDB29.res b/LibD28/dclfsDB29.res
new file mode 100644
index 0000000..2ede287
Binary files /dev/null and b/LibD28/dclfsDB29.res differ
diff --git a/LibD28/dclfsDB4.dpk b/LibD28/dclfsDB4.dpk
new file mode 100644
index 0000000..08f858e
--- /dev/null
+++ b/LibD28/dclfsDB4.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 4
+
+package dclfsDB4;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL40,
+ fs4,
+ fsDB4;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB5.dpk b/LibD28/dclfsDB5.dpk
new file mode 100644
index 0000000..9f82559
--- /dev/null
+++ b/LibD28/dclfsDB5.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 5
+
+package dclfsDB5;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+ fs5,
+ fsDB5;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB6.dpk b/LibD28/dclfsDB6.dpk
new file mode 100644
index 0000000..15cc0b3
--- /dev/null
+++ b/LibD28/dclfsDB6.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 6
+
+package dclfsDB6;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs6,
+ fsDB6;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB7.dpk b/LibD28/dclfsDB7.dpk
new file mode 100644
index 0000000..5e535f3
--- /dev/null
+++ b/LibD28/dclfsDB7.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 7
+
+package dclfsDB7;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs7,
+ fsDB7;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsDB9.dpk b/LibD28/dclfsDB9.dpk
new file mode 100644
index 0000000..607b373
--- /dev/null
+++ b/LibD28/dclfsDB9.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2005
+
+package dclfsDB9;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 DB Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs9,
+ fsDB9;
+
+contains
+ fs_idbreg in 'fs_idbreg.pas';
+
+end.
diff --git a/LibD28/dclfsFD15.dpk b/LibD28/dclfsFD15.dpk
new file mode 100644
index 0000000..39e761c
--- /dev/null
+++ b/LibD28/dclfsFD15.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE
+
+package dclfsFD15;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs15,
+ fsFD15;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/LibD28/dclfsFD16.dpk b/LibD28/dclfsFD16.dpk
new file mode 100644
index 0000000..dd067a1
--- /dev/null
+++ b/LibD28/dclfsFD16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclfsFD16;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs16,
+ fsFD16;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/LibD28/dclfsFD17.dpk b/LibD28/dclfsFD17.dpk
new file mode 100644
index 0000000..dfc50b0
--- /dev/null
+++ b/LibD28/dclfsFD17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclfsFD17;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs17,
+ fsFD17;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/LibD28/dclfsFD18.dpk b/LibD28/dclfsFD18.dpk
new file mode 100644
index 0000000..37c7041
--- /dev/null
+++ b/LibD28/dclfsFD18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package dclfsFD18;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs18,
+ fsFD18;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/LibD28/dclfsFD19.dpk b/LibD28/dclfsFD19.dpk
new file mode 100644
index 0000000..1a01271
--- /dev/null
+++ b/LibD28/dclfsFD19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package dclfsFD19;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs19,
+ fsFD19;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/LibD28/dclfsFD20.dpk b/LibD28/dclfsFD20.dpk
new file mode 100644
index 0000000..924acc3
--- /dev/null
+++ b/LibD28/dclfsFD20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package dclfsFD20;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs20,
+ fsFD20;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/LibD28/dclfsFD21.dpk b/LibD28/dclfsFD21.dpk
new file mode 100644
index 0000000..29a4a33
--- /dev/null
+++ b/LibD28/dclfsFD21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package dclfsFD21;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs21,
+ fsFD21;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/LibD28/dclfsFD22.dpk b/LibD28/dclfsFD22.dpk
new file mode 100644
index 0000000..6510980
--- /dev/null
+++ b/LibD28/dclfsFD22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package dclfsFD22;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs22,
+ fsFD22;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/LibD28/dclfsFD23.dpk b/LibD28/dclfsFD23.dpk
new file mode 100644
index 0000000..a595230
--- /dev/null
+++ b/LibD28/dclfsFD23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsFD23;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs23,
+ fsFD23;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/LibD28/dclfsFD24.dpk b/LibD28/dclfsFD24.dpk
new file mode 100644
index 0000000..7c95ac6
--- /dev/null
+++ b/LibD28/dclfsFD24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10.1 Berlin
+
+package dclfsFD24;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs24,
+ fsFD24;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/LibD28/dclfsFD25.dpk b/LibD28/dclfsFD25.dpk
new file mode 100644
index 0000000..51b4bd5
--- /dev/null
+++ b/LibD28/dclfsFD25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10.2 Tokyo
+
+package dclfsFD25;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs25,
+ fsFD25;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/LibD28/dclfsFD26.dpk b/LibD28/dclfsFD26.dpk
new file mode 100644
index 0000000..da7fdb2
--- /dev/null
+++ b/LibD28/dclfsFD26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10.3 Rio
+
+package dclfsFD26;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs26,
+ fsFD26;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/LibD28/dclfsFD27.dpk b/LibD28/dclfsFD27.dpk
new file mode 100644
index 0000000..d91e582
--- /dev/null
+++ b/LibD28/dclfsFD27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10.3 Rio
+
+package dclfsFD27;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs27,
+ fsFD27;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/LibD28/dclfsFD28.dpk b/LibD28/dclfsFD28.dpk
new file mode 100644
index 0000000..82f43d0
--- /dev/null
+++ b/LibD28/dclfsFD28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11.3 Rio
+
+package dclfsFD28;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs28,
+ fsFD28;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/LibD28/dclfsFD29.dpk b/LibD28/dclfsFD29.dpk
new file mode 100644
index 0000000..ab5b478
--- /dev/null
+++ b/LibD28/dclfsFD29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package dclfsFD29;
+
+{$R 'fs_ifdreg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 FireDAC Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs29,
+ fsFD29;
+
+contains
+ fs_ifdreg in 'fs_ifdreg.pas';
+
+end.
diff --git a/LibD28/dclfsFD29.dproj b/LibD28/dclfsFD29.dproj
new file mode 100644
index 0000000..3043b18
--- /dev/null
+++ b/LibD28/dclfsFD29.dproj
@@ -0,0 +1,119 @@
+
+
+ {09056CF9-D80C-4ADF-9977-DAAF599D169D}
+ dclfsFD29.dpk
+ True
+ Release
+ 1
+ Package
+ VCL
+ 20.1
+ Win32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ dclfsFD29
+ 1
+ true
+ FastScript 1.9 FireDAC Components
+ true
+ true
+ Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;DUnitX.Loggers.GUI;$(DCC_Namespace)
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+ vcl;fs29;fsFD29;$(DCC_UsePackage)
+
+
+ vcl;$(DCC_UsePackage)
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ dclfsFD29.dpk
+
+
+
+ True
+ False
+
+
+ 12
+
+
+
+
diff --git a/LibD28/dclfsFD29.res b/LibD28/dclfsFD29.res
new file mode 100644
index 0000000..2249695
Binary files /dev/null and b/LibD28/dclfsFD29.res differ
diff --git a/LibD28/dclfsIBX10.dpk b/LibD28/dclfsIBX10.dpk
new file mode 100644
index 0000000..31f546b
--- /dev/null
+++ b/LibD28/dclfsIBX10.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2006
+
+package dclfsIBX10;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs10,
+ fsIBX10;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsIBX11.dpk b/LibD28/dclfsIBX11.dpk
new file mode 100644
index 0000000..994c232
--- /dev/null
+++ b/LibD28/dclfsIBX11.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2007
+
+package dclfsIBX11;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs11,
+ fsIBX11;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsIBX12.dpk b/LibD28/dclfsIBX12.dpk
new file mode 100644
index 0000000..f4137a8
--- /dev/null
+++ b/LibD28/dclfsIBX12.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2009
+
+package dclfsIBX12;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs12,
+ fsIBX12;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsIBX14.dpk b/LibD28/dclfsIBX14.dpk
new file mode 100644
index 0000000..994a9fb
--- /dev/null
+++ b/LibD28/dclfsIBX14.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 2010
+
+package dclfsIBX14;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs14,
+ fsIBX14;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsIBX15.dpk b/LibD28/dclfsIBX15.dpk
new file mode 100644
index 0000000..46f9e7a
--- /dev/null
+++ b/LibD28/dclfsIBX15.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE
+
+package dclfsIBX15;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs15,
+ fsIBX15;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsIBX16.dpk b/LibD28/dclfsIBX16.dpk
new file mode 100644
index 0000000..4df76c2
--- /dev/null
+++ b/LibD28/dclfsIBX16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclfsIBX16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs16,
+ fsIBX16;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsIBX17.dpk b/LibD28/dclfsIBX17.dpk
new file mode 100644
index 0000000..52dbea0
--- /dev/null
+++ b/LibD28/dclfsIBX17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclfsIBX17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs17,
+ fsIBX17;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsIBX18.dpk b/LibD28/dclfsIBX18.dpk
new file mode 100644
index 0000000..2025bb1
--- /dev/null
+++ b/LibD28/dclfsIBX18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package dclfsIBX18;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs18,
+ fsIBX18;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsIBX19.dpk b/LibD28/dclfsIBX19.dpk
new file mode 100644
index 0000000..c85697f
--- /dev/null
+++ b/LibD28/dclfsIBX19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package dclfsIBX19;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs19,
+ fsIBX19;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsIBX20.dpk b/LibD28/dclfsIBX20.dpk
new file mode 100644
index 0000000..afbecdf
--- /dev/null
+++ b/LibD28/dclfsIBX20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package dclfsIBX20;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs20,
+ fsIBX20;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsIBX21.dpk b/LibD28/dclfsIBX21.dpk
new file mode 100644
index 0000000..c58d3cb
--- /dev/null
+++ b/LibD28/dclfsIBX21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package dclfsIBX21;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs21,
+ fsIBX21;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsIBX22.dpk b/LibD28/dclfsIBX22.dpk
new file mode 100644
index 0000000..cd8b53a
--- /dev/null
+++ b/LibD28/dclfsIBX22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package dclfsIBX22;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs22,
+ fsIBX22;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsIBX23.dpk b/LibD28/dclfsIBX23.dpk
new file mode 100644
index 0000000..464647c
--- /dev/null
+++ b/LibD28/dclfsIBX23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsIBX23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs23,
+ fsIBX23;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsIBX24.dpk b/LibD28/dclfsIBX24.dpk
new file mode 100644
index 0000000..434d0dd
--- /dev/null
+++ b/LibD28/dclfsIBX24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsIBX24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs24,
+ fsIBX24;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsIBX25.dpk b/LibD28/dclfsIBX25.dpk
new file mode 100644
index 0000000..2dff5f1
--- /dev/null
+++ b/LibD28/dclfsIBX25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsIBX25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs25,
+ fsIBX25;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsIBX26.dpk b/LibD28/dclfsIBX26.dpk
new file mode 100644
index 0000000..59a1405
--- /dev/null
+++ b/LibD28/dclfsIBX26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsIBX26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs26,
+ fsIBX26;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsIBX27.dpk b/LibD28/dclfsIBX27.dpk
new file mode 100644
index 0000000..f8449fc
--- /dev/null
+++ b/LibD28/dclfsIBX27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsIBX27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs27,
+ fsIBX27;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsIBX28.dpk b/LibD28/dclfsIBX28.dpk
new file mode 100644
index 0000000..6a7f530
--- /dev/null
+++ b/LibD28/dclfsIBX28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package dclfsIBX28;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs28,
+ fsIBX28;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsIBX29.dpk b/LibD28/dclfsIBX29.dpk
new file mode 100644
index 0000000..8d3036a
--- /dev/null
+++ b/LibD28/dclfsIBX29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package dclfsIBX29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs29,
+ fsIBX29;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsIBX5.dpk b/LibD28/dclfsIBX5.dpk
new file mode 100644
index 0000000..49131ba
--- /dev/null
+++ b/LibD28/dclfsIBX5.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 5
+
+package dclfsIBX5;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+ fs5,
+ fsIBX5;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsIBX6.dpk b/LibD28/dclfsIBX6.dpk
new file mode 100644
index 0000000..116116e
--- /dev/null
+++ b/LibD28/dclfsIBX6.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 6
+
+package dclfsIBX6;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs6,
+ fsIBX6;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsIBX7.dpk b/LibD28/dclfsIBX7.dpk
new file mode 100644
index 0000000..de31978
--- /dev/null
+++ b/LibD28/dclfsIBX7.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 7
+
+package dclfsIBX7;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs7,
+ fsIBX7;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsIBX9.dpk b/LibD28/dclfsIBX9.dpk
new file mode 100644
index 0000000..7f0571d
--- /dev/null
+++ b/LibD28/dclfsIBX9.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2005
+
+package dclfsIBX9;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 IBX Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs9,
+ fsIBX9;
+
+contains
+ fs_iibxreg in 'fs_iibxreg.pas';
+
+end.
diff --git a/LibD28/dclfsTee10.dpk b/LibD28/dclfsTee10.dpk
new file mode 100644
index 0000000..2528ac4
--- /dev/null
+++ b/LibD28/dclfsTee10.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2006
+
+package dclfsTee10;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs10,
+ fsTee10;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee11.dpk b/LibD28/dclfsTee11.dpk
new file mode 100644
index 0000000..01da7b4
--- /dev/null
+++ b/LibD28/dclfsTee11.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2007
+
+package dclfsTee11;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs11,
+ fsTee11;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee12.dpk b/LibD28/dclfsTee12.dpk
new file mode 100644
index 0000000..e2f21ee
--- /dev/null
+++ b/LibD28/dclfsTee12.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2009
+
+package dclfsTee12;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs12,
+ fsTee12;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee14.dpk b/LibD28/dclfsTee14.dpk
new file mode 100644
index 0000000..8602d0a
--- /dev/null
+++ b/LibD28/dclfsTee14.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 2010
+
+package dclfsTee14;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs14,
+ fsTee14;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee15.dpk b/LibD28/dclfsTee15.dpk
new file mode 100644
index 0000000..7edbf47
--- /dev/null
+++ b/LibD28/dclfsTee15.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE
+
+package dclfsTee15;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs15,
+ fsTee15;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee16.dpk b/LibD28/dclfsTee16.dpk
new file mode 100644
index 0000000..57d575d
--- /dev/null
+++ b/LibD28/dclfsTee16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package dclfsTee16;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs16,
+ fsTee16;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee17.dpk b/LibD28/dclfsTee17.dpk
new file mode 100644
index 0000000..241a123
--- /dev/null
+++ b/LibD28/dclfsTee17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package dclfsTee17;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs17,
+ fsTee17;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee18.dpk b/LibD28/dclfsTee18.dpk
new file mode 100644
index 0000000..e800491
--- /dev/null
+++ b/LibD28/dclfsTee18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package dclfsTee18;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs18,
+ fsTee18;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee19.dpk b/LibD28/dclfsTee19.dpk
new file mode 100644
index 0000000..e9bb0d2
--- /dev/null
+++ b/LibD28/dclfsTee19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package dclfsTee19;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs19,
+ fsTee19;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee20.dpk b/LibD28/dclfsTee20.dpk
new file mode 100644
index 0000000..68dba6b
--- /dev/null
+++ b/LibD28/dclfsTee20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package dclfsTee20;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs20,
+ fsTee20;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee21.dpk b/LibD28/dclfsTee21.dpk
new file mode 100644
index 0000000..797396e
--- /dev/null
+++ b/LibD28/dclfsTee21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package dclfsTee21;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs21,
+ fsTee21;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee22.dpk b/LibD28/dclfsTee22.dpk
new file mode 100644
index 0000000..4d25a05
--- /dev/null
+++ b/LibD28/dclfsTee22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package dclfsTee22;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs22,
+ fsTee22;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee23.dpk b/LibD28/dclfsTee23.dpk
new file mode 100644
index 0000000..d37c1af
--- /dev/null
+++ b/LibD28/dclfsTee23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsTee23;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs23,
+ fsTee23;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee24.dpk b/LibD28/dclfsTee24.dpk
new file mode 100644
index 0000000..df5becb
--- /dev/null
+++ b/LibD28/dclfsTee24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsTee24;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs24,
+ fsTee24;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee25.dpk b/LibD28/dclfsTee25.dpk
new file mode 100644
index 0000000..e0299de
--- /dev/null
+++ b/LibD28/dclfsTee25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsTee25;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs25,
+ fsTee25;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee26.dpk b/LibD28/dclfsTee26.dpk
new file mode 100644
index 0000000..a6aa19d
--- /dev/null
+++ b/LibD28/dclfsTee26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsTee26;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs26,
+ fsTee26;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee27.dpk b/LibD28/dclfsTee27.dpk
new file mode 100644
index 0000000..7eabf7d
--- /dev/null
+++ b/LibD28/dclfsTee27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package dclfsTee27;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs27,
+ fsTee27;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee28.dpk b/LibD28/dclfsTee28.dpk
new file mode 100644
index 0000000..80fd3de
--- /dev/null
+++ b/LibD28/dclfsTee28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package dclfsTee28;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs28,
+ fsTee28;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee29.dpk b/LibD28/dclfsTee29.dpk
new file mode 100644
index 0000000..1ba0884
--- /dev/null
+++ b/LibD28/dclfsTee29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package dclfsTee29;
+
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs29,
+ fsTee29;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee29.dproj b/LibD28/dclfsTee29.dproj
new file mode 100644
index 0000000..df474f1
--- /dev/null
+++ b/LibD28/dclfsTee29.dproj
@@ -0,0 +1,119 @@
+
+
+ {46F52F31-E0DF-4BA1-A08B-AA4C629E97E6}
+ dclfsTee29.dpk
+ True
+ Release
+ 1
+ Package
+ VCL
+ 20.1
+ Win32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ dclfsTee29
+ 1
+ true
+ FastScript 1.9 Tee Components
+ true
+ true
+ Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;DUnitX.Loggers.GUI;$(DCC_Namespace)
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+ vcl;fs29;fsTee29;$(DCC_UsePackage)
+
+
+ vcl;$(DCC_UsePackage)
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ dclfsTee29.dpk
+
+
+
+ True
+ False
+
+
+ 12
+
+
+
+
diff --git a/LibD28/dclfsTee29.res b/LibD28/dclfsTee29.res
new file mode 100644
index 0000000..be88226
Binary files /dev/null and b/LibD28/dclfsTee29.res differ
diff --git a/LibD28/dclfsTee4.dpk b/LibD28/dclfsTee4.dpk
new file mode 100644
index 0000000..401bc0f
--- /dev/null
+++ b/LibD28/dclfsTee4.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 4
+
+package dclfsTee4;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL40,
+ fs4,
+ fsTee4;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee5.dpk b/LibD28/dclfsTee5.dpk
new file mode 100644
index 0000000..3cc3397
--- /dev/null
+++ b/LibD28/dclfsTee5.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 5
+
+package dclfsTee5;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+ fs5,
+ fsTee5;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee6.dpk b/LibD28/dclfsTee6.dpk
new file mode 100644
index 0000000..074527d
--- /dev/null
+++ b/LibD28/dclfsTee6.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 6
+
+package dclfsTee6;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs6,
+ fsTee6;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee7.dpk b/LibD28/dclfsTee7.dpk
new file mode 100644
index 0000000..f635e9a
--- /dev/null
+++ b/LibD28/dclfsTee7.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 7
+
+package dclfsTee7;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs7,
+ fsTee7;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsTee9.dpk b/LibD28/dclfsTee9.dpk
new file mode 100644
index 0000000..ebb9f57
--- /dev/null
+++ b/LibD28/dclfsTee9.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2005
+
+package dclfsTee9;
+
+{$R 'fs_ireg.dcr'}
+
+{$DESCRIPTION 'FastScript 1.9 Tee Components'}
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ DESIGNIDE,
+ fs9,
+ fsTee9;
+
+contains
+ fs_iteereg in 'fs_iteereg.pas';
+
+end.
diff --git a/LibD28/dclfsx.dpk b/LibD28/dclfsx.dpk
new file mode 100644
index 0000000..0c49e2a
--- /dev/null
+++ b/LibD28/dclfsx.dpk
@@ -0,0 +1,46 @@
+// Package file for CLX
+
+package dclfsx;
+
+{$R *.res}
+{$R 'fs_ireg.dcr'}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$DESCRIPTION 'FastScript 1.9 Components'}
+{$DESIGNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ rtl,
+ designide,
+ visualclx,
+ fsx
+{$IFNDEF LINUX}
+, bdertl,
+ adortl,
+ tee
+{$ENDIF};
+
+contains
+ fs_ireg in 'fs_ireg.pas';
+
+end.
diff --git a/LibD28/dclfsx.dproj b/LibD28/dclfsx.dproj
new file mode 100644
index 0000000..328e9d3
--- /dev/null
+++ b/LibD28/dclfsx.dproj
@@ -0,0 +1,126 @@
+
+
+ {CAB1A5A3-F58D-4093-8B9C-DE6DFE15071B}
+ dclfsx.dpk
+ True
+ Debug
+ 1
+ Package
+ None
+ 20.1
+ Win32
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ dclfsx
+ true
+ FastScript 1.9 Components
+ true
+ true
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+ System;Xml;Data;Datasnap;Web;Soap;$(DCC_Namespace)
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+ dclfsx_Icon.ico
+
+
+ dclfsx_Icon.ico
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ dclfsx.dpk
+
+
+
+ False
+ False
+ False
+ False
+ False
+ True
+ False
+
+
+ 12
+
+
+
+
diff --git a/LibD28/dclfsx.res b/LibD28/dclfsx.res
new file mode 100644
index 0000000..fa40de9
Binary files /dev/null and b/LibD28/dclfsx.res differ
diff --git a/LibD28/dclfsx_Icon.ico b/LibD28/dclfsx_Icon.ico
new file mode 100644
index 0000000..e26b4d4
Binary files /dev/null and b/LibD28/dclfsx_Icon.ico differ
diff --git a/LibD28/fmx.frxImageConverter.pas b/LibD28/fmx.frxImageConverter.pas
new file mode 100644
index 0000000..4c41ed6
--- /dev/null
+++ b/LibD28/fmx.frxImageConverter.pas
@@ -0,0 +1,124 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Image Converter }
+{ }
+{ Copyright (c) 1998-2011 }
+{ by Anton Khayrudinov }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+{$I frx.inc}
+{$I fmx.inc}
+
+unit FMX.frxImageConverter;
+
+interface
+
+uses
+ System.Classes, FMX.Types
+{$IFDEF DELPHI18}
+ , FMX.Surfaces
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+ , FMX.frxFMX
+{$ENDIF};
+
+type
+ TfrxPictureType = (gpPNG, gpBMP, gpEMF, gpWMF, gpJPG, gpGIF);
+
+procedure SaveGraphicAs(Graphic: TBitmap; Stream: TStream; PicType: TfrxPictureType); overload;
+procedure SaveGraphicAs(Graphic: TBitmap; Path: string; PicType: TfrxPictureType); overload;
+
+function GetPicFileExtension(PicType: TfrxPictureType): string;
+
+implementation
+
+const
+{$IFDEF DELPHI27}
+ prefix = '.';
+{$ELSE}
+ prefix = '';
+{$ENDIF}
+
+function GetPicFileExtension(PicType: TfrxPictureType): string;
+begin
+ case PicType of
+ gpPNG: Result := 'png';
+ gpBMP: Result := 'bmp';
+ gpEMF: Result := 'png';
+ gpWMF: Result := 'png';
+ gpJPG: Result := 'jpg';
+ gpGIF: Result := 'gif';
+ else Result := '';
+ end;
+end;
+
+procedure SaveGraphicAs(Graphic: TBitmap; Path: string; PicType: TfrxPictureType);
+var
+ Stream: TStream;
+begin
+ Stream := TFileStream.Create(Path, fmCreate);
+
+ try
+ SaveGraphicAs(Graphic, Stream, PicType)
+ finally
+ Stream.Free
+ end
+end;
+
+procedure SaveGraphicAs(Graphic: TBitmap; Stream: TStream; PicType: TfrxPictureType);
+{$IFNDEF DELPHI18}
+{$IFNDEF Delphi17}
+var
+ Filter: TBitmapCodec;
+begin
+ Filter := DefaultBitmapCodecClass.Create;
+ try
+ case PicType of
+ gpEMF: Filter.SaveToStream(Stream, Graphic, 'png'); // not supported back compatibility only
+ gpWMF: Filter.SaveToStream(Stream, Graphic, 'png');
+ gpBMP: Filter.SaveToStream(Stream, Graphic, 'bmp');
+ gpPNG: Filter.SaveToStream(Stream, Graphic, 'png');
+ gpJPG: Filter.SaveToStream(Stream, Graphic, 'jpg');
+ gpGIF: Filter.SaveToStream(Stream, Graphic, 'gif');
+ end;
+ finally
+ Filter.Free;
+ end;
+{$ELSE}
+begin
+ case PicType of
+ gpEMF: TBitmapCodecManager.SaveToStream(Stream, Graphic, 'png'); // not supported back compatibility only
+ gpWMF: TBitmapCodecManager.SaveToStream(Stream, Graphic, 'png');
+ gpBMP: TBitmapCodecManager.SaveToStream(Stream, Graphic, 'bmp');
+ gpPNG: TBitmapCodecManager.SaveToStream(Stream, Graphic, 'png');
+ gpJPG: TBitmapCodecManager.SaveToStream(Stream, Graphic, 'jpg');
+ gpGIF: TBitmapCodecManager.SaveToStream(Stream, Graphic, 'gif');
+ end;
+{$ENDIF}
+{$ELSE}
+var
+ Surf: TBitmapSurface;
+begin
+ Surf := TBitmapSurface.Create;
+ try
+ Surf.Assign(Graphic);
+ case PicType of
+ gpEMF: TBitmapCodecManager.SaveToStream(Stream, Surf, prefix + 'png'); // not supported back compatibility only
+ gpWMF: TBitmapCodecManager.SaveToStream(Stream, Surf, prefix + 'png');
+ gpBMP: TBitmapCodecManager.SaveToStream(Stream, Surf, prefix + 'bmp');
+ gpPNG: TBitmapCodecManager.SaveToStream(Stream, Surf, prefix + 'png');
+ gpJPG: TBitmapCodecManager.SaveToStream(Stream, Surf, prefix + 'jpg');
+ gpGIF: TBitmapCodecManager.SaveToStream(Stream, Surf, prefix + 'gif');
+ end;
+ finally
+ Surf.Free;
+ end;
+{$ENDIF}
+end;
+
+end.
diff --git a/LibD28/fmx.inc b/LibD28/fmx.inc
new file mode 100644
index 0000000..e502196
--- /dev/null
+++ b/LibD28/fmx.inc
@@ -0,0 +1,12 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Include file }
+{ }
+{ (c) 2003, 2004 by Alexander Tzyganenko, }
+{ Fast Reports, Inc }
+{ }
+{******************************************}
+
+{$DEFINE FMX}
diff --git a/LibD28/frx.inc b/LibD28/frx.inc
new file mode 100644
index 0000000..be7efeb
--- /dev/null
+++ b/LibD28/frx.inc
@@ -0,0 +1,704 @@
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Include file }
+{ }
+{ Copyright (c) 1998-2006 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+
+{$B-} {- Complete Boolean Evaluation }
+{$R-} {- Range-Checking }
+{$T-} {- Typed @ operator }
+{$P+} {- Open string params }
+{$H+} {- Use long strings by default }
+
+{$IFNDEF FPC}
+ {$V-} {- Var-String Checking }
+ {$X+} {- Extended syntax }
+ {$J+} {- Writeable structured consts }
+{$ENDIF}
+
+{$IFDEF VER120} // Delphi 4.0
+ {$DEFINE Delphi4}
+{$ENDIF}
+
+{$IFDEF VER130} // Delphi 5.0
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+{$ENDIF}
+
+{$IFDEF VER140} // Delphi 6.0
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+{$ENDIF}
+
+{$IFDEF VER150} // Delphi 7.0
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+{$ENDIF}
+
+{$IFDEF VER170} // Delphi 9.0
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN UNIT_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER180} // Delphi 10.0
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE RICHBCB}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN UNIT_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER185} // Delphi 11.0
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE RICHBCB}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN UNIT_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER190} // Delphi 11.0
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE RICHBCB}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN UNIT_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER200} // Delphi 12.0
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE RICHBCB}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN UNIT_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER210} // Rad Studio 13.0
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE RICHBCB}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN UNIT_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER220} // Rad Studio XE
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE RICHBCB}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN UNIT_DEPRECATED OFF}
+{$ENDIF}
+
+
+{$IFDEF VER230} // Rad Studio XE 2
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE RICHBCB}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN UNIT_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER240} // Rad Studio XE 3
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE RICHBCB}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN UNIT_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER250} // Rad Studio XE 4
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE RICHBCB}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN UNIT_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER260} // Rad Studio XE 5
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE RICHBCB}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN UNIT_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER270} // Rad Studio XE 6
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE RICHBCB}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN UNIT_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER280} // Rad Studio XE 7
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE RICHBCB}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN UNIT_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER290} // Rad Studio XE 8
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE RICHBCB}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN UNIT_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER300}
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE Delphi23}
+ {$DEFINE RICHBCB}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN UNIT_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER310}
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE Delphi23}
+ {$DEFINE Delphi24}
+ {$DEFINE RICHBCB}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN UNIT_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER320}
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE Delphi23}
+ {$DEFINE Delphi24}
+ {$DEFINE Delphi25}
+ {$DEFINE RICHBCB}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN UNIT_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER330}
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE Delphi23}
+ {$DEFINE Delphi24}
+ {$DEFINE Delphi25}
+ {$DEFINE Delphi26}
+ {$DEFINE RICHBCB}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN UNIT_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER340}
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE Delphi23}
+ {$DEFINE Delphi24}
+ {$DEFINE Delphi25}
+ {$DEFINE Delphi26}
+ {$DEFINE Delphi27}
+ {$DEFINE RICHBCB}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN UNIT_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER350}
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE Delphi23}
+ {$DEFINE Delphi24}
+ {$DEFINE Delphi25}
+ {$DEFINE Delphi26}
+ {$DEFINE Delphi27}
+ {$DEFINE Delphi28}
+ {$DEFINE RICHBCB}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN UNIT_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER360}
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE Delphi23}
+ {$DEFINE Delphi24}
+ {$DEFINE Delphi25}
+ {$DEFINE Delphi26}
+ {$DEFINE Delphi27}
+ {$DEFINE Delphi28}
+ {$DEFINE Delphi29}
+ {$DEFINE RICHBCB}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+ {$WARN SYMBOL_PLATFORM OFF}
+ {$WARN UNIT_PLATFORM OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN UNIT_DEPRECATED OFF}
+{$ENDIF}
+
+
+{$IFDEF VER125} // Borland C++ Builder 4.0
+ {$DEFINE Delphi4}
+ {$ObjExportAll On}
+ {$DEFINE BCB}
+ {$DEFINE RICHBCB}
+{$ENDIF}
+
+{$IFDEF VER130} // Borland C++ Builder 5.0
+ {$IFDEF BCB}
+ {$ObjExportAll On}
+ {$DEFINE RICHBCB}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF VER140} // Borland C++ Builder 6.0
+ {$IFDEF BCB}
+ {$ObjExportAll On}
+ {$DEFINE RICHBCB}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF FPC} // Free pascal compiler
+ {$MODE DELPHI}
+
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+{$ENDIF}
+
+// Uncomment the following line if you don't want to include component editors
+// into your exe (in case if you don't use designer)
+//{$DEFINE NO_EDITORS}
+
+//-------------------------Additional components----------------------------
+
+//---------------- GetMessage Hook----------------------------------
+// Hook to GetMessage function for unicode input support (D4-7, BCB4-BCB6)
+//{$DEFINE HOOK_WNDPROC_FOR_UNICODE}
+
+//------------------- JPEG images -----------------------------------
+// JPEG images. Adds approximately 100Kb to your EXE.
+// If you want to show jpeg images in "Picture" object, uncomment
+// the following line:
+{$DEFINE JPEG}
+
+//------------------- PNG images -----------------------------------
+// PNG images. If you want to show png images in "Picture" object, uncomment
+// the following line:
+{$DEFINE PNG}
+
+//------------------- "Open Picture" dialog -------------------------
+// Adds approximately 60Kb to your EXE.
+// If you want to use standard "Open picture" dialog in picture editor,
+// uncomment the following line:
+//{$DEFINE OPENPICTUREDLG}
+
+//------------------- Visual Query builder --------------------------
+// To use visual query builder, you should install FastQBuilder component.
+// It is included in FR3 Pro and FR3 EE by default.
+//{$DEFINE QBUILDER}
+
+//------------------- TTabSet control -------------------------------
+// In Delphi2005 and BDS2006 you can use TTabSet control instead of TTabControl
+// to make a report designer more soft-looked.
+{$DEFINE UseTabset}
+
+//------------------- Group DB components ---------------------------
+// Use it to group all frxDB components.
+//{$DEFINE DB_CAT}
+
+//{$DEFINE FR_VER_BASIC}
+
+{$IFDEF FR_COM}
+ {$IFDEF FR_LITE}
+ {$DEFINE FR_VER_BASIC}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFNDEF Delphi9}
+ {$UNDEF UseTabset}
+{$ENDIF}
+
+{$IFDEF Delphi4}
+ {$IFDEF FR_VER_BASIC}
+ {$DEFINE NO_CRITICAL_SECTION}
+ {$ENDIF}
+{$ENDIF}
+
diff --git a/LibD28/frxBarcodeEditor.fmx b/LibD28/frxBarcodeEditor.fmx
new file mode 100644
index 0000000..b08bf3d
--- /dev/null
+++ b/LibD28/frxBarcodeEditor.fmx
@@ -0,0 +1,183 @@
+object frxBarcodeEditorForm: TfrxBarcodeEditorForm
+Position.Point = '(269,122)'
+ BorderStyle = bsDialog
+ Caption = 'Barcode editor'
+ ClientHeight = 255
+ ClientWidth = 539
+ KeyPreview = True
+ OldCreateOrder = True
+ Position = poScreenCenter
+ ShowHint = True
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ PixelsPerInch = 96
+ TextHeight = 13
+ object CodeLbl: TLabel
+Position.Point = '(8,8)'
+ Width = 25
+ Height = 13
+ Caption = 'Code'
+ end
+ object TypeLbl: TLabel
+Position.Point = '(8,52)'
+ Width = 56
+ Height = 13
+ Caption = 'Type of Bar'
+ end
+ object ExampleBvl: TBevel
+Position.Point = '(272,8)'
+ Width = 261
+ Height = 241
+ end
+ object ExamplePB: TPaintBox
+Position.Point = '(276,12)'
+ Width = 253
+ Height = 233
+ OnPaint = ExamplePBPaint
+ end
+ object CancelB: TButton
+Position.Point = '(184,225)'
+ Width = 75
+ Height = 25
+ HelpContext = 50
+ Cancel = True
+ Caption = 'Cancel'
+ ModalResult = 2
+ TabOrder = 3
+ end
+ object OkB: TButton
+Position.Point = '(104,225)'
+ Width = 75
+ Height = 25
+ HelpContext = 40
+ Caption = 'OK'
+ Default = True
+ ModalResult = 1
+ TabOrder = 2
+ end
+ object CodeE: TComboEdit
+Position.Point = '(8,24)'
+ Width = 253
+ Height = 21
+ HelpContext = 260
+ Style = csSimple
+ ItemHeight = 13
+ TabOrder = 0
+ Text = '0'
+ Glyph.Data = {
+ D6000000424DD60000000000000076000000280000000C0000000C0000000100
+ 0400000000006000000000000000000000001000000010000000000000000000
+ 80000080000000808000800000008000800080800000C0C0C000808080000000
+ FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00707777777777
+ 0000770777777777000077087007007700007780778007770000778087700077
+ 0000777087007807000077780777777700007700000777770000777708777777
+ 0000777700780777000077777000777700007777777777770000}
+ OnButtonClick = ExprBtnClick
+ end
+ object TypeCB: TComboBox
+Position.Point = '(8,68)'
+ Width = 253
+ Height = 21
+ HelpContext = 261
+ Style = csDropDownList
+ ItemHeight = 13
+ TabOrder = 1
+ OnChange = ExamplePBPaint
+ end
+ object OptionsLbl: TGroupBox
+Position.Point = '(8,100)'
+ Width = 253
+ Height = 65
+ Caption = 'Options'
+ TabOrder = 4
+ object ZoomLbl: TLabel
+Position.Point = '(155,22)'
+ Width = 30
+ Height = 13
+ Alignment = taRightJustify
+ Caption = 'Zoom:'
+ FocusControl = ZoomE
+ end
+ object CalcCheckSumCB: TCheckBox
+Position.Point = '(8,20)'
+ Width = 133
+ Height = 17
+ HelpContext = 262
+ Caption = 'Calc Checksum '
+ TabOrder = 0
+ OnClick = ExamplePBPaint
+ end
+ object ViewTextCB: TCheckBox
+Position.Point = '(8,40)'
+ Width = 133
+ Height = 17
+ HelpContext = 263
+ Caption = 'Text'
+ TabOrder = 1
+ OnClick = ExamplePBPaint
+ end
+ object ZoomE: TEdit
+Position.Point = '(196,18)'
+ Width = 33
+ Height = 21
+ HelpContext = 149
+ TabOrder = 2
+ Text = '1'
+ end
+ object UpDown1: TUpDown
+Position.Point = '(229,18)'
+ Width = 16
+ Height = 21
+ Associate = ZoomE
+ Min = 0
+ Position = 1
+ TabOrder = 3
+ Wrap = False
+ end
+ end
+ object RotationLbl: TGroupBox
+Position.Point = '(8,172)'
+ Width = 253
+ Height = 45
+ Caption = 'Rotation'
+ TabOrder = 5
+ object Rotation0RB: TRadioButton
+Position.Point = '(8,20)'
+ Width = 37
+ Height = 17
+ HelpContext = 264
+ Caption = '0'
+ Checked = True
+ TabOrder = 0
+ TabStop = True
+ OnClick = ExamplePBPaint
+ end
+ object Rotation90RB: TRadioButton
+Position.Point = '(72,20)'
+ Width = 37
+ Height = 17
+ HelpContext = 264
+ Caption = '90'
+ TabOrder = 1
+ OnClick = ExamplePBPaint
+ end
+ object Rotation180RB: TRadioButton
+Position.Point = '(136,20)'
+ Width = 45
+ Height = 17
+ HelpContext = 264
+ Caption = '180'
+ TabOrder = 2
+ OnClick = ExamplePBPaint
+ end
+ object Rotation270RB: TRadioButton
+Position.Point = '(200,20)'
+ Width = 45
+ Height = 17
+ HelpContext = 264
+ Caption = '270'
+ TabOrder = 3
+ OnClick = ExamplePBPaint
+ end
+ end
+end
diff --git a/LibD28/frxEditSQL.inc b/LibD28/frxEditSQL.inc
new file mode 100644
index 0000000..d92f0e4
--- /dev/null
+++ b/LibD28/frxEditSQL.inc
@@ -0,0 +1,18 @@
+{ custom color settings for SQL editor }
+
+{
+ property BlockColor: TColor;
+ property BlockFontColor: TColor;
+ property Color;
+ property CommentAttr: TFont;
+ property Font;
+ property KeywordAttr: TFont;
+ property NumberAttr: TFont;
+ property StringAttr: TFont;
+ property TextAttr: TFont;
+}
+
+{ example:
+ Color := clBlack;
+ TextAttr.Color := clGreen;
+}
diff --git a/LibD28/frxFMX_PlatformsAttribute.inc b/LibD28/frxFMX_PlatformsAttribute.inc
new file mode 100644
index 0000000..8cf7903
--- /dev/null
+++ b/LibD28/frxFMX_PlatformsAttribute.inc
@@ -0,0 +1,12 @@
+{$IFDEF DELPHI16}
+{$IFDEF FMX}
+{$IFDEF DELPHI26}
+[ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidOSX32 or pidOSX64 or pidLinux64)]
+{$ELSE}
+[ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidOSX32)]
+{$ENDIF}
+{$ELSE}
+[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
+{$ENDIF}
+{$ENDIF}
+
diff --git a/LibD28/frxIBXReg.res b/LibD28/frxIBXReg.res
new file mode 100644
index 0000000..2c1fbe2
Binary files /dev/null and b/LibD28/frxIBXReg.res differ
diff --git a/LibD28/frxPlatformsAttribute.inc b/LibD28/frxPlatformsAttribute.inc
new file mode 100644
index 0000000..418ba41
--- /dev/null
+++ b/LibD28/frxPlatformsAttribute.inc
@@ -0,0 +1,12 @@
+{$IFDEF DELPHI16}
+{$IFDEF FMX}
+{$IFDEF DELPHI26}
+[ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidOSX32 or pidOSX64)]
+{$ELSE}
+[ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidOSX32)]
+{$ENDIF}
+{$ELSE}
+[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
+{$ENDIF}
+{$ENDIF}
+
diff --git a/LibD28/frxReg.dcr b/LibD28/frxReg.dcr
new file mode 100644
index 0000000..6ae3f88
Binary files /dev/null and b/LibD28/frxReg.dcr differ
diff --git a/LibD28/frxVersion.inc b/LibD28/frxVersion.inc
new file mode 100644
index 0000000..db81b63
--- /dev/null
+++ b/LibD28/frxVersion.inc
@@ -0,0 +1 @@
+'2.8.12'
\ No newline at end of file
diff --git a/LibD28/frxe16.otares b/LibD28/frxe16.otares
new file mode 100644
index 0000000..7435995
Binary files /dev/null and b/LibD28/frxe16.otares differ
diff --git a/LibD28/frxeReg.dcr b/LibD28/frxeReg.dcr
new file mode 100644
index 0000000..a46b43c
Binary files /dev/null and b/LibD28/frxeReg.dcr differ
diff --git a/LibD28/frxrcClass.xml b/LibD28/frxrcClass.xml
new file mode 100644
index 0000000..daa86db
--- /dev/null
+++ b/LibD28/frxrcClass.xml
@@ -0,0 +1,247 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/LibD28/frxrcDesgn.xml b/LibD28/frxrcDesgn.xml
new file mode 100644
index 0000000..5cce380
--- /dev/null
+++ b/LibD28/frxrcDesgn.xml
@@ -0,0 +1,851 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/LibD28/frxrcExports.xml b/LibD28/frxrcExports.xml
new file mode 100644
index 0000000..b432983
--- /dev/null
+++ b/LibD28/frxrcExports.xml
@@ -0,0 +1,278 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/LibD28/frxrcInsp.xml b/LibD28/frxrcInsp.xml
new file mode 100644
index 0000000..384f9e8
--- /dev/null
+++ b/LibD28/frxrcInsp.xml
@@ -0,0 +1,274 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/LibD28/fs.inc b/LibD28/fs.inc
new file mode 100644
index 0000000..d5d7aee
--- /dev/null
+++ b/LibD28/fs.inc
@@ -0,0 +1,612 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Include file }
+{ }
+{ (c) 2003, 2004 by Alexander Tzyganenko, }
+{ Fast Reports, Inc }
+{ }
+{******************************************}
+
+
+{$R-} {- Range-Checking }
+{$H+} {- Use long strings by default }
+{$B-} {- Complete Boolean Evaluation }
+{$T-} {- Typed @ operator }
+{$P+} {- Open string params }
+
+{$IFNDEF FPC}
+ {$V-} {- Var-String Checking }
+ {$X+} {- Extended syntax }
+ {$J+} {- Writeable structured consts }
+{$ENDIF}
+
+{$IFDEF VER120} // Delphi 4.0
+ {$DEFINE Delphi4}
+{$ENDIF}
+
+{$IFDEF VER130} // Delphi 5.0
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+{$ENDIF}
+
+{$IFDEF VER140} // Delphi 6.0
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+{$ENDIF}
+
+{$IFDEF VER150} // Delphi 7.0
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+{$ENDIF}
+
+{$IFDEF VER170} // Delphi 9.0
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER180} // Delphi 10.0
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER185} // Delphi 11.0 (Spacely)
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER190} // Delphi 11.0 (Highlander)
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+{$ENDIF}
+
+{$IFDEF VER200} // Delphi 12.0 (Tiburon)
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+// {$WARNINGS OFF}
+{$ENDIF}
+
+{$IFDEF VER210} // Delphi 14.0
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER220} // Delphi XE
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER230} // Delphi XE 2
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER240} // Delphi XE 3
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER250} // Delphi XE 4
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER260} // Delphi XE 4
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER270} // Delphi XE 6
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER280} // Delphi XE 7
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER290} // Delphi XE 8
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER300} // Delphi 10 Seattle
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE Delphi23}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER310}
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE Delphi23}
+ {$DEFINE Delphi24}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER320}
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE Delphi23}
+ {$DEFINE Delphi24}
+ {$DEFINE Delphi25}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER330}
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE Delphi23}
+ {$DEFINE Delphi24}
+ {$DEFINE Delphi25}
+ {$DEFINE Delphi26}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER340}
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE Delphi23}
+ {$DEFINE Delphi24}
+ {$DEFINE Delphi25}
+ {$DEFINE Delphi26}
+ {$DEFINE Delphi27}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER350}
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE Delphi23}
+ {$DEFINE Delphi24}
+ {$DEFINE Delphi25}
+ {$DEFINE Delphi26}
+ {$DEFINE Delphi27}
+ {$DEFINE Delphi28}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+{$IFDEF VER360}
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE Delphi7}
+ {$DEFINE Delphi9}
+ {$DEFINE Delphi10}
+ {$DEFINE Delphi11}
+ {$DEFINE Delphi12}
+ {$DEFINE Delphi14}
+ {$DEFINE Delphi15}
+ {$DEFINE Delphi16}
+ {$DEFINE Delphi17}
+ {$DEFINE Delphi18}
+ {$DEFINE Delphi19}
+ {$DEFINE Delphi20}
+ {$DEFINE Delphi21}
+ {$DEFINE Delphi22}
+ {$DEFINE Delphi23}
+ {$DEFINE Delphi24}
+ {$DEFINE Delphi25}
+ {$DEFINE Delphi26}
+ {$DEFINE Delphi27}
+ {$DEFINE Delphi28}
+ {$DEFINE Delphi29}
+ {$DEFINE FS_INT64}
+ {$WARN UNSAFE_CODE OFF}
+ {$WARN UNSAFE_TYPE OFF}
+ {$WARN UNSAFE_CAST OFF}
+ {$WARN SYMBOL_DEPRECATED OFF}
+ {$WARN EXPLICIT_STRING_CAST OFF}
+ {$WARN EXPLICIT_STRING_CAST_LOSS OFF}
+{$ENDIF}
+
+
+{$IFDEF VER125} // Borland C++ Builder 4.0
+ {$DEFINE Delphi4}
+ {$ObjExportAll on}
+{$ENDIF}
+
+{$IFDEF VER130} // Borland C++ Builder 5.0
+ {$IFDEF BCB}
+ {$ObjExportAll on}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF VER140} // Borland C++ Builder 6.0
+ {$IFDEF BCB}
+ {$ObjExportAll on}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF VER150} // Borland C++ Builder 7.0
+ {$IFDEF BCB}
+ {$ObjExportAll on}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFDEF FPC} // Free pascal compiler
+ {$MODE DELPHI}
+ {$PACKSET 1}
+
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$DEFINE FS_INT64}
+{$ELSE}
+ {$IFDEF LINUX} // KYLIX
+ {$DEFINE Delphi4}
+ {$DEFINE Delphi5}
+ {$DEFINE Delphi6}
+ {$IFNDEF Delphi22}
+ {$DEFINE CLX}
+ {$ENDIF}
+ {$IFDEF BCB}
+ {$DEFINE CLXCPP}
+ {$ENDIF}
+ {$ENDIF}
+{$ENDIF}
+
+{$IFNDEF LINUX}
+ {$DEFINE WINDOWS}
+{$ENDIF}
+
+{$IFDEF FPC}
+ {$DEFINE CROSS_COMPILE}
+{$ENDIF}
+
+{$IFDEF CLX}
+ {$DEFINE CROSS_COMPILE}
+{$ENDIF}
+
+// Uncomment below line for CLX compilation
+//{$DEFINE CLX}
+
+// include ole dispatch module
+{$IFNDEF CROSS_COMPILE}
+{$IFNDEF FMX}
+{$DEFINE OLE}
+{$ENDIF}
+{$ENDIF}
+//{$DEFINE NOFORMS}
diff --git a/LibD28/fs10.dpk b/LibD28/fs10.dpk
new file mode 100644
index 0000000..2d7ebc1
--- /dev/null
+++ b/LibD28/fs10.dpk
@@ -0,0 +1,66 @@
+// Package file for Delphi 2006
+
+package fs10;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+
+
+end.
diff --git a/LibD28/fs11.dpk b/LibD28/fs11.dpk
new file mode 100644
index 0000000..168bf98
--- /dev/null
+++ b/LibD28/fs11.dpk
@@ -0,0 +1,66 @@
+// Package file for Delphi 2007
+
+package fs11;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+
+
+end.
diff --git a/LibD28/fs12.dpk b/LibD28/fs12.dpk
new file mode 100644
index 0000000..4770065
--- /dev/null
+++ b/LibD28/fs12.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 2009
+
+package fs12;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/LibD28/fs14.dpk b/LibD28/fs14.dpk
new file mode 100644
index 0000000..b974430
--- /dev/null
+++ b/LibD28/fs14.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 2010
+
+package fs14;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/LibD28/fs15.dpk b/LibD28/fs15.dpk
new file mode 100644
index 0000000..75d0ec0
--- /dev/null
+++ b/LibD28/fs15.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi XE
+
+package fs15;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/LibD28/fs16.dpk b/LibD28/fs16.dpk
new file mode 100644
index 0000000..80ae244
--- /dev/null
+++ b/LibD28/fs16.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi XE2
+
+package fs16;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/LibD28/fs17.dpk b/LibD28/fs17.dpk
new file mode 100644
index 0000000..f873811
--- /dev/null
+++ b/LibD28/fs17.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi XE3
+
+package fs17;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/LibD28/fs18.dpk b/LibD28/fs18.dpk
new file mode 100644
index 0000000..4138707
--- /dev/null
+++ b/LibD28/fs18.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi XE4
+
+package fs18;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/LibD28/fs19.dpk b/LibD28/fs19.dpk
new file mode 100644
index 0000000..31eedb1
--- /dev/null
+++ b/LibD28/fs19.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi XE5
+
+package fs19;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/LibD28/fs20.dpk b/LibD28/fs20.dpk
new file mode 100644
index 0000000..88ff2b8
--- /dev/null
+++ b/LibD28/fs20.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi XE6
+
+package fs20;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/LibD28/fs21.dpk b/LibD28/fs21.dpk
new file mode 100644
index 0000000..981aa84
--- /dev/null
+++ b/LibD28/fs21.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi XE7
+
+package fs21;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/LibD28/fs22.dpk b/LibD28/fs22.dpk
new file mode 100644
index 0000000..f9cdf0c
--- /dev/null
+++ b/LibD28/fs22.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi XE8
+
+package fs22;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/LibD28/fs23.dpk b/LibD28/fs23.dpk
new file mode 100644
index 0000000..d9e605d
--- /dev/null
+++ b/LibD28/fs23.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 10 Seattle
+
+package fs23;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/LibD28/fs24.dpk b/LibD28/fs24.dpk
new file mode 100644
index 0000000..cf0b018
--- /dev/null
+++ b/LibD28/fs24.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 10 Seattle
+
+package fs24;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/LibD28/fs25.dpk b/LibD28/fs25.dpk
new file mode 100644
index 0000000..9a4e65d
--- /dev/null
+++ b/LibD28/fs25.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 10 Seattle
+
+package fs25;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/LibD28/fs26.dpk b/LibD28/fs26.dpk
new file mode 100644
index 0000000..5f2b841
--- /dev/null
+++ b/LibD28/fs26.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 10 Seattle
+
+package fs26;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/LibD28/fs27.dpk b/LibD28/fs27.dpk
new file mode 100644
index 0000000..fdd63ad
--- /dev/null
+++ b/LibD28/fs27.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 10 Seattle
+
+package fs27;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/LibD28/fs28.dpk b/LibD28/fs28.dpk
new file mode 100644
index 0000000..81fb353
--- /dev/null
+++ b/LibD28/fs28.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 11 Seattle
+
+package fs28;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/LibD28/fs29.dpk b/LibD28/fs29.dpk
new file mode 100644
index 0000000..a18ff30
--- /dev/null
+++ b/LibD28/fs29.dpk
@@ -0,0 +1,61 @@
+// Package file for Delphi 12
+
+package fs29;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/LibD28/fs29.dproj b/LibD28/fs29.dproj
new file mode 100644
index 0000000..3a16ea8
--- /dev/null
+++ b/LibD28/fs29.dproj
@@ -0,0 +1,158 @@
+
+
+ {04CA26B4-A916-4F14-8F96-0A7B419B97F0}
+ fs29.dpk
+ True
+ Release
+ 3
+ Package
+ VCL
+ 20.1
+ Win64
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Cfg_1
+ true
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ fs29
+ 1
+ true
+ true
+ true
+ Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;DUnitX.Loggers.GUI;Winapi;$(DCC_Namespace)
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+
+
+ System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+ 1033
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ D:\Delphi\Component\FastReport FMX 2.8.12 Pro Full Source\LibD28x64\
+ true
+ 1033
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ fs29.dpk
+
+
+ Microsoft Office 2000 Sample Automation Server Wrapper Components
+ Microsoft Office XP Sample Automation Server Wrapper Components
+
+
+
+ False
+ False
+ False
+ True
+ True
+
+
+ 12
+
+
+
+
diff --git a/LibD28/fs29.res b/LibD28/fs29.res
new file mode 100644
index 0000000..25b0c16
Binary files /dev/null and b/LibD28/fs29.res differ
diff --git a/LibD28/fs4.bpk b/LibD28/fs4.bpk
new file mode 100644
index 0000000..2d1aa68
--- /dev/null
+++ b/LibD28/fs4.bpk
@@ -0,0 +1,187 @@
+# ---------------------------------------------------------------------------
+!if !$d(BCB)
+BCB = $(MAKEDIR)\..
+!endif
+
+# ---------------------------------------------------------------------------
+# IDE SECTION
+# ---------------------------------------------------------------------------
+# The following section of the project makefile is managed by the BCB IDE.
+# It is recommended to use the IDE to change any of the values in this
+# section.
+# ---------------------------------------------------------------------------
+
+VERSION = BCB.04.04
+# ---------------------------------------------------------------------------
+PROJECT = FS4.bpl
+OBJFILES = fs_iReg.obj FS4.obj fs_iconst.obj
+RESFILES = FS4.res fs_iReg.dcr
+RESDEPEN = $(RESFILES)
+LIBFILES =
+PACKAGES = vcl40.bpi vclx40.bpi
+DEFFILE =
+# ---------------------------------------------------------------------------
+PATHCPP = .;
+PATHASM = .;
+PATHPAS = .;
+PATHRC = .;
+DEBUGLIBPATH = $(BCB)\lib\debug
+RELEASELIBPATH = $(BCB)\lib\release
+USERDEFINES =
+SYSDEFINES = _RTLDLL;NO_STRICT;USEPACKAGES
+# ---------------------------------------------------------------------------
+CFLAG1 = -I$(BCB)\include;$(BCB)\include\vcl -O2 -Hc -H=$(BCB)\lib\vcl40.csm -w -Ve -a8 \
+ -k- -vi -c -b- -w-par -w-inl -Vx -tWM -D$(SYSDEFINES);$(USERDEFINES)
+PFLAGS = -U$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \
+ -I$(BCB)\include;$(BCB)\include\vcl -$Y- -$L- -$D- -v -JPHNE -M
+RFLAGS = -i$(BCB)\include;$(BCB)\include\vcl
+AFLAGS = /i$(BCB)\include /i$(BCB)\include\vcl /mx /w2 /zn
+LFLAGS = -L$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \
+ -D"FastScript 1.9 Components" -aa -Tpp -x -Gn -Gl -Gi
+# ---------------------------------------------------------------------------
+ALLOBJ = c0pkg32.obj Memmgr.Lib $(PACKAGES) sysinit.obj $(OBJFILES)
+ALLRES = $(RESFILES)
+ALLLIB = $(LIBFILES) $(LIBRARIES) import32.lib cp32mti.lib
+# ---------------------------------------------------------------------------
+!ifdef IDEOPTIONS
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=1
+Item0=$(BCB)\include;$(BCB)\include\vcl
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteDebug=0
+
+[Compiler]
+InMemoryExe=0
+ShowInfoMsgs=0
+
+!endif
+
+# ---------------------------------------------------------------------------
+# MAKE SECTION
+# ---------------------------------------------------------------------------
+# This section of the project file is not used by the BCB IDE. It is for
+# the benefit of building from the command-line using the MAKE utility.
+# ---------------------------------------------------------------------------
+
+.autodepend
+# ---------------------------------------------------------------------------
+!if !$d(BCC32)
+BCC32 = bcc32
+!endif
+
+!if !$d(CPP32)
+CPP32 = cpp32
+!endif
+
+!if !$d(DCC32)
+DCC32 = dcc32
+!endif
+
+!if !$d(TASM32)
+TASM32 = tasm32
+!endif
+
+!if !$d(LINKER)
+LINKER = ilink32
+!endif
+
+!if !$d(BRCC32)
+BRCC32 = brcc32
+!endif
+
+# ---------------------------------------------------------------------------
+!if $d(PATHCPP)
+.PATH.CPP = $(PATHCPP)
+.PATH.C = $(PATHCPP)
+!endif
+
+!if $d(PATHPAS)
+.PATH.PAS = $(PATHPAS)
+!endif
+
+!if $d(PATHASM)
+.PATH.ASM = $(PATHASM)
+!endif
+
+!if $d(PATHRC)
+.PATH.RC = $(PATHRC)
+!endif
+# ---------------------------------------------------------------------------
+$(PROJECT): $(OBJFILES) $(RESDEPEN) $(DEFFILE)
+ $(BCB)\BIN\$(LINKER) @&&!
+ $(LFLAGS) +
+ $(ALLOBJ), +
+ $(PROJECT),, +
+ $(ALLLIB), +
+ $(DEFFILE), +
+ $(ALLRES)
+!
+# ---------------------------------------------------------------------------
+.pas.hpp:
+ $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< }
+
+.pas.obj:
+ $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< }
+
+.cpp.obj:
+ $(BCB)\BIN\$(BCC32) $(CFLAG1) -n$(@D) {$< }
+
+.c.obj:
+ $(BCB)\BIN\$(BCC32) $(CFLAG1) -n$(@D) {$< }
+
+.c.i:
+ $(BCB)\BIN\$(CPP32) $(CFLAG1) -n. {$< }
+
+.cpp.i:
+ $(BCB)\BIN\$(CPP32) $(CFLAG1) -n. {$< }
+
+.asm.obj:
+ $(BCB)\BIN\$(TASM32) $(AFLAGS) $<, $@
+
+.rc.res:
+ $(BCB)\BIN\$(BRCC32) $(RFLAGS) -fo$@ $<
+# ---------------------------------------------------------------------------
diff --git a/LibD28/fs4.cpp b/LibD28/fs4.cpp
new file mode 100644
index 0000000..701945a
--- /dev/null
+++ b/LibD28/fs4.cpp
@@ -0,0 +1,19 @@
+//---------------------------------------------------------------------------
+#include
+#pragma hdrstop
+USERES("FS4.res");
+USEPACKAGE("vcl40.bpi");
+USEPACKAGE("vclx40.bpi");
+USEUNIT("fs_iReg.pas");
+USEUNIT("fs_iconst.pas");
+USERES("fs_iReg.dcr");
+//---------------------------------------------------------------------------
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+// Package source.
+//---------------------------------------------------------------------------
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
diff --git a/LibD28/fs4.dpk b/LibD28/fs4.dpk
new file mode 100644
index 0000000..2401b04
--- /dev/null
+++ b/LibD28/fs4.dpk
@@ -0,0 +1,65 @@
+// Package file for Delphi 4
+
+package fs4;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL40,
+ VCLX40;
+
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+
+end.
diff --git a/LibD28/fs4.res b/LibD28/fs4.res
new file mode 100644
index 0000000..eb2597a
Binary files /dev/null and b/LibD28/fs4.res differ
diff --git a/LibD28/fs5.bpk b/LibD28/fs5.bpk
new file mode 100644
index 0000000..7da84c2
--- /dev/null
+++ b/LibD28/fs5.bpk
@@ -0,0 +1,108 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=1
+Item0=$(BCB)\include;$(BCB)\include\vcl
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Language]
+ActiveLang=
+ProjectLang=
+RootDir=
+
+
\ No newline at end of file
diff --git a/LibD28/fs5.cpp b/LibD28/fs5.cpp
new file mode 100644
index 0000000..75223bc
--- /dev/null
+++ b/LibD28/fs5.cpp
@@ -0,0 +1,23 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+USERES("FS5.res");
+USEPACKAGE("vcl50.bpi");
+USEPACKAGE("vclx50.bpi");
+USEUNIT("fs_ireg.pas");
+USEUNIT("fs_iconst.pas");
+USERES("fs_iReg.dcr");
+//---------------------------------------------------------------------------
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
diff --git a/LibD28/fs5.dpk b/LibD28/fs5.dpk
new file mode 100644
index 0000000..1327eb4
--- /dev/null
+++ b/LibD28/fs5.dpk
@@ -0,0 +1,66 @@
+// Package file for Delphi 5
+
+package fs5;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+ VCLX50;
+
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+
+
+end.
diff --git a/LibD28/fs5.res b/LibD28/fs5.res
new file mode 100644
index 0000000..da3d366
Binary files /dev/null and b/LibD28/fs5.res differ
diff --git a/LibD28/fs6.bpk b/LibD28/fs6.bpk
new file mode 100644
index 0000000..a00493a
--- /dev/null
+++ b/LibD28/fs6.bpk
@@ -0,0 +1,122 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[Excluded Packages]
+d:\delphi\builder6\Projects\Bpl\FR6.bpl=FastReport 2.4 Components
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+Launcher=
+UseLauncher=0
+DebugCWD=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteLauncher=
+RemoteCWD=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+LinkCGLIB=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Linker]
+LibPrefix=
+LibSuffix=
+LibVersion=
+
+
\ No newline at end of file
diff --git a/LibD28/fs6.cpp b/LibD28/fs6.cpp
new file mode 100644
index 0000000..f8b9781
--- /dev/null
+++ b/LibD28/fs6.cpp
@@ -0,0 +1,17 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
+
\ No newline at end of file
diff --git a/LibD28/fs6.dpk b/LibD28/fs6.dpk
new file mode 100644
index 0000000..ffff854
--- /dev/null
+++ b/LibD28/fs6.dpk
@@ -0,0 +1,66 @@
+// Package file for Delphi 6
+
+package fs6;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+
+
+end.
diff --git a/LibD28/fs6.res b/LibD28/fs6.res
new file mode 100644
index 0000000..2bbdbc1
Binary files /dev/null and b/LibD28/fs6.res differ
diff --git a/LibD28/fs7.dpk b/LibD28/fs7.dpk
new file mode 100644
index 0000000..820a3c9
--- /dev/null
+++ b/LibD28/fs7.dpk
@@ -0,0 +1,66 @@
+// Package file for Delphi 7
+
+package fs7;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+
+
+end.
diff --git a/LibD28/fs9.dpk b/LibD28/fs9.dpk
new file mode 100644
index 0000000..0e46e9e
--- /dev/null
+++ b/LibD28/fs9.dpk
@@ -0,0 +1,66 @@
+// Package file for Delphi 2005
+
+package fs9;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLX;
+
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+{$IFDEF OLE}
+ fs_idisp in 'fs_idisp.pas',
+{$ENDIF}
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinirtti in 'fs_iinirtti.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_imenusrtti in 'fs_imenusrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_synmemo in 'fs_synmemo.pas',
+ fs_tree in 'fs_tree.pas';
+
+
+
+end.
diff --git a/LibD28/fsADO10.dpk b/LibD28/fsADO10.dpk
new file mode 100644
index 0000000..205b554
--- /dev/null
+++ b/LibD28/fsADO10.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2006
+
+package fsADO10;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs10,
+ fsDB10;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+
+end.
diff --git a/LibD28/fsADO11.dpk b/LibD28/fsADO11.dpk
new file mode 100644
index 0000000..314c61e
--- /dev/null
+++ b/LibD28/fsADO11.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2007
+
+package fsADO11;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs11,
+ fsDB11;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+
+end.
diff --git a/LibD28/fsADO12.dpk b/LibD28/fsADO12.dpk
new file mode 100644
index 0000000..8e3c8bb
--- /dev/null
+++ b/LibD28/fsADO12.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2009
+
+package fsADO12;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs12,
+ fsDB12;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+
+end.
diff --git a/LibD28/fsADO14.dpk b/LibD28/fsADO14.dpk
new file mode 100644
index 0000000..c35e8ad
--- /dev/null
+++ b/LibD28/fsADO14.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 2010
+
+package fsADO14;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs14,
+ fsDB14;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/LibD28/fsADO15.dpk b/LibD28/fsADO15.dpk
new file mode 100644
index 0000000..e05c8f4
--- /dev/null
+++ b/LibD28/fsADO15.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE
+
+package fsADO15;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs15,
+ fsDB15;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/LibD28/fsADO16.dpk b/LibD28/fsADO16.dpk
new file mode 100644
index 0000000..ca0eb87
--- /dev/null
+++ b/LibD28/fsADO16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package fsADO16;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs16,
+ fsDB16;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/LibD28/fsADO17.dpk b/LibD28/fsADO17.dpk
new file mode 100644
index 0000000..6a3d141
--- /dev/null
+++ b/LibD28/fsADO17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package fsADO17;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs17,
+ fsDB17;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/LibD28/fsADO18.dpk b/LibD28/fsADO18.dpk
new file mode 100644
index 0000000..c989d57
--- /dev/null
+++ b/LibD28/fsADO18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package fsADO18;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs18,
+ fsDB18;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/LibD28/fsADO19.dpk b/LibD28/fsADO19.dpk
new file mode 100644
index 0000000..5172497
--- /dev/null
+++ b/LibD28/fsADO19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package fsADO19;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs19,
+ fsDB19;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/LibD28/fsADO20.dpk b/LibD28/fsADO20.dpk
new file mode 100644
index 0000000..aeedd49
--- /dev/null
+++ b/LibD28/fsADO20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package fsADO20;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs20,
+ fsDB20;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/LibD28/fsADO21.dpk b/LibD28/fsADO21.dpk
new file mode 100644
index 0000000..7f60a5a
--- /dev/null
+++ b/LibD28/fsADO21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package fsADO21;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs21,
+ fsDB21;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/LibD28/fsADO22.dpk b/LibD28/fsADO22.dpk
new file mode 100644
index 0000000..f819723
--- /dev/null
+++ b/LibD28/fsADO22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package fsADO22;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs22,
+ fsDB22;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/LibD28/fsADO23.dpk b/LibD28/fsADO23.dpk
new file mode 100644
index 0000000..5236423
--- /dev/null
+++ b/LibD28/fsADO23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package fsADO23;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs23,
+ fsDB23;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/LibD28/fsADO24.dpk b/LibD28/fsADO24.dpk
new file mode 100644
index 0000000..b691767
--- /dev/null
+++ b/LibD28/fsADO24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package fsADO24;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs24,
+ fsDB24;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/LibD28/fsADO25.dpk b/LibD28/fsADO25.dpk
new file mode 100644
index 0000000..9debb8d
--- /dev/null
+++ b/LibD28/fsADO25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package fsADO25;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs25,
+ fsDB25;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/LibD28/fsADO26.dpk b/LibD28/fsADO26.dpk
new file mode 100644
index 0000000..8aedb6b
--- /dev/null
+++ b/LibD28/fsADO26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package fsADO26;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs26,
+ fsDB26;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/LibD28/fsADO27.dpk b/LibD28/fsADO27.dpk
new file mode 100644
index 0000000..4319bff
--- /dev/null
+++ b/LibD28/fsADO27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package fsADO27;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs27,
+ fsDB27;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/LibD28/fsADO28.dpk b/LibD28/fsADO28.dpk
new file mode 100644
index 0000000..f729e72
--- /dev/null
+++ b/LibD28/fsADO28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package fsADO28;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs28,
+ fsDB28;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/LibD28/fsADO29.dpk b/LibD28/fsADO29.dpk
new file mode 100644
index 0000000..f4728e1
--- /dev/null
+++ b/LibD28/fsADO29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package fsADO29;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs29,
+ fsDB29;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+end.
diff --git a/LibD28/fsADO5.bpk b/LibD28/fsADO5.bpk
new file mode 100644
index 0000000..c4bdfc6
--- /dev/null
+++ b/LibD28/fsADO5.bpk
@@ -0,0 +1,108 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=1
+Item0=$(BCB)\include;$(BCB)\include\vcl
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Language]
+ActiveLang=
+ProjectLang=
+RootDir=
+
+
\ No newline at end of file
diff --git a/LibD28/fsADO5.cpp b/LibD28/fsADO5.cpp
new file mode 100644
index 0000000..a145759
--- /dev/null
+++ b/LibD28/fsADO5.cpp
@@ -0,0 +1,25 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+USERES("FS5.res");
+USEPACKAGE("vcl50.bpi");
+USEPACKAGE("vcldb50.bpi");
+USEPACKAGE("vclado50.bpi");
+USEPACKAGE("fs5.bpi");
+USEPACKAGE("fsDB5.bpi");
+USEUNIT("fs_iadoreg.pas");
+USERES("fs_iReg.dcr");
+//---------------------------------------------------------------------------
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
diff --git a/LibD28/fsADO5.dpk b/LibD28/fsADO5.dpk
new file mode 100644
index 0000000..d062b3f
--- /dev/null
+++ b/LibD28/fsADO5.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 5
+
+package fsADO5;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+ VCLDB50,
+ VCLADO50,
+ fs5,
+ fsDB5;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+
+end.
diff --git a/LibD28/fsADO6.bpk b/LibD28/fsADO6.bpk
new file mode 100644
index 0000000..a7591da
--- /dev/null
+++ b/LibD28/fsADO6.bpk
@@ -0,0 +1,124 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[Excluded Packages]
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+Launcher=
+UseLauncher=0
+DebugCWD=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteLauncher=
+RemoteCWD=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+LinkCGLIB=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Linker]
+LibPrefix=
+LibSuffix=
+LibVersion=
+
+
\ No newline at end of file
diff --git a/LibD28/fsADO6.cpp b/LibD28/fsADO6.cpp
new file mode 100644
index 0000000..f8b9781
--- /dev/null
+++ b/LibD28/fsADO6.cpp
@@ -0,0 +1,17 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
+
\ No newline at end of file
diff --git a/LibD28/fsADO6.dpk b/LibD28/fsADO6.dpk
new file mode 100644
index 0000000..c2e52fc
--- /dev/null
+++ b/LibD28/fsADO6.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 6
+
+package fsADO6;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs6,
+ fsDB6;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+
+end.
diff --git a/LibD28/fsADO7.dpk b/LibD28/fsADO7.dpk
new file mode 100644
index 0000000..245f0fd
--- /dev/null
+++ b/LibD28/fsADO7.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 7
+
+package fsADO7;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs7,
+ fsDB7;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+
+end.
diff --git a/LibD28/fsADO9.dpk b/LibD28/fsADO9.dpk
new file mode 100644
index 0000000..e87df33
--- /dev/null
+++ b/LibD28/fsADO9.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2005
+
+package fsADO9;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ ADORTL,
+ fs9,
+ fsDB9;
+
+contains
+ fs_iadortti in 'fs_iadortti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE10.dpk b/LibD28/fsBDE10.dpk
new file mode 100644
index 0000000..bfff3e7
--- /dev/null
+++ b/LibD28/fsBDE10.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2006
+
+package fsBDE10;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs10,
+ fsDB10;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE11.dpk b/LibD28/fsBDE11.dpk
new file mode 100644
index 0000000..cc0072a
--- /dev/null
+++ b/LibD28/fsBDE11.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2007
+
+package fsBDE11;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs11,
+ fsDB11;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE12.dpk b/LibD28/fsBDE12.dpk
new file mode 100644
index 0000000..5442db2
--- /dev/null
+++ b/LibD28/fsBDE12.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2009
+
+package fsBDE12;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs12,
+ fsDB12;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE14.dpk b/LibD28/fsBDE14.dpk
new file mode 100644
index 0000000..07e09dd
--- /dev/null
+++ b/LibD28/fsBDE14.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2010
+
+package fsBDE14;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs14,
+ fsDB14;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE15.dpk b/LibD28/fsBDE15.dpk
new file mode 100644
index 0000000..87a27ad
--- /dev/null
+++ b/LibD28/fsBDE15.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE
+
+package fsBDE15;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs15,
+ fsDB15;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE16.dpk b/LibD28/fsBDE16.dpk
new file mode 100644
index 0000000..374d6ba
--- /dev/null
+++ b/LibD28/fsBDE16.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE2
+
+package fsBDE16;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs16,
+ fsDB16;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE17.dpk b/LibD28/fsBDE17.dpk
new file mode 100644
index 0000000..3432481
--- /dev/null
+++ b/LibD28/fsBDE17.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE3
+
+package fsBDE17;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs17,
+ fsDB17;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE18.dpk b/LibD28/fsBDE18.dpk
new file mode 100644
index 0000000..52d5497
--- /dev/null
+++ b/LibD28/fsBDE18.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE4
+
+package fsBDE18;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs18,
+ fsDB18;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE19.dpk b/LibD28/fsBDE19.dpk
new file mode 100644
index 0000000..32f5d27
--- /dev/null
+++ b/LibD28/fsBDE19.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE5
+
+package fsBDE19;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs19,
+ fsDB19;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE20.dpk b/LibD28/fsBDE20.dpk
new file mode 100644
index 0000000..71bff3b
--- /dev/null
+++ b/LibD28/fsBDE20.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE6
+
+package fsBDE20;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs20,
+ fsDB20;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE21.dpk b/LibD28/fsBDE21.dpk
new file mode 100644
index 0000000..0c9f49d
--- /dev/null
+++ b/LibD28/fsBDE21.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE7
+
+package fsBDE21;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs21,
+ fsDB21;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE22.dpk b/LibD28/fsBDE22.dpk
new file mode 100644
index 0000000..f8b934c
--- /dev/null
+++ b/LibD28/fsBDE22.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi XE8
+
+package fsBDE22;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs22,
+ fsDB22;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE23.dpk b/LibD28/fsBDE23.dpk
new file mode 100644
index 0000000..ff73cf9
--- /dev/null
+++ b/LibD28/fsBDE23.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 10 Seattle
+
+package fsBDE23;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs23,
+ fsDB23;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE24.dpk b/LibD28/fsBDE24.dpk
new file mode 100644
index 0000000..54c218f
--- /dev/null
+++ b/LibD28/fsBDE24.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 10 Seattle
+
+package fsBDE24;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs24,
+ fsDB24;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE25.dpk b/LibD28/fsBDE25.dpk
new file mode 100644
index 0000000..de71408
--- /dev/null
+++ b/LibD28/fsBDE25.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 10 Seattle
+
+package fsBDE25;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs25,
+ fsDB25;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE26.dpk b/LibD28/fsBDE26.dpk
new file mode 100644
index 0000000..23acd7f
--- /dev/null
+++ b/LibD28/fsBDE26.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 10 Seattle
+
+package fsBDE26;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs26,
+ fsDB26;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE27.dpk b/LibD28/fsBDE27.dpk
new file mode 100644
index 0000000..783046d
--- /dev/null
+++ b/LibD28/fsBDE27.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 10 Seattle
+
+package fsBDE27;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs27,
+ fsDB27;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE28.dpk b/LibD28/fsBDE28.dpk
new file mode 100644
index 0000000..1f419d4
--- /dev/null
+++ b/LibD28/fsBDE28.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 11 Seattle
+
+package fsBDE28;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs28,
+ fsDB28;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE29.dpk b/LibD28/fsBDE29.dpk
new file mode 100644
index 0000000..d833080
--- /dev/null
+++ b/LibD28/fsBDE29.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 12
+
+package fsBDE29;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs29,
+ fsDB29;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE4.bpk b/LibD28/fsBDE4.bpk
new file mode 100644
index 0000000..961c052
--- /dev/null
+++ b/LibD28/fsBDE4.bpk
@@ -0,0 +1,187 @@
+# ---------------------------------------------------------------------------
+!if !$d(BCB)
+BCB = $(MAKEDIR)\..
+!endif
+
+# ---------------------------------------------------------------------------
+# IDE SECTION
+# ---------------------------------------------------------------------------
+# The following section of the project makefile is managed by the BCB IDE.
+# It is recommended to use the IDE to change any of the values in this
+# section.
+# ---------------------------------------------------------------------------
+
+VERSION = BCB.04.04
+# ---------------------------------------------------------------------------
+PROJECT = FSBDE4.bpl
+OBJFILES = fs_iReg.obj FSBDE4.obj
+RESFILES = FS4.res fs_iReg.dcr
+RESDEPEN = $(RESFILES)
+LIBFILES =
+PACKAGES = vcl40.bpi vcldb40.bpi fs4.bpi fsDB4.bpi
+DEFFILE =
+# ---------------------------------------------------------------------------
+PATHCPP = .;
+PATHASM = .;
+PATHPAS = .;
+PATHRC = .;
+DEBUGLIBPATH = $(BCB)\lib\debug
+RELEASELIBPATH = $(BCB)\lib\release
+USERDEFINES =
+SYSDEFINES = _RTLDLL;NO_STRICT;USEPACKAGES
+# ---------------------------------------------------------------------------
+CFLAG1 = -I$(BCB)\include;$(BCB)\include\vcl -O2 -Hc -H=$(BCB)\lib\vcl40.csm -w -Ve -a8 \
+ -k- -vi -c -b- -w-par -w-inl -Vx -tWM -D$(SYSDEFINES);$(USERDEFINES)
+PFLAGS = -U$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \
+ -I$(BCB)\include;$(BCB)\include\vcl -$Y- -$L- -$D- -v -JPHNE -M
+RFLAGS = -i$(BCB)\include;$(BCB)\include\vcl
+AFLAGS = /i$(BCB)\include /i$(BCB)\include\vcl /mx /w2 /zn
+LFLAGS = -L$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \
+ -D"FastScript 1.9 BDE Components" -aa -Tpp -x -Gn -Gl -Gi
+# ---------------------------------------------------------------------------
+ALLOBJ = c0pkg32.obj Memmgr.Lib $(PACKAGES) sysinit.obj $(OBJFILES)
+ALLRES = $(RESFILES)
+ALLLIB = $(LIBFILES) $(LIBRARIES) import32.lib cp32mti.lib
+# ---------------------------------------------------------------------------
+!ifdef IDEOPTIONS
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=1
+Item0=$(BCB)\include;$(BCB)\include\vcl
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteDebug=0
+
+[Compiler]
+InMemoryExe=0
+ShowInfoMsgs=0
+
+!endif
+
+# ---------------------------------------------------------------------------
+# MAKE SECTION
+# ---------------------------------------------------------------------------
+# This section of the project file is not used by the BCB IDE. It is for
+# the benefit of building from the command-line using the MAKE utility.
+# ---------------------------------------------------------------------------
+
+.autodepend
+# ---------------------------------------------------------------------------
+!if !$d(BCC32)
+BCC32 = bcc32
+!endif
+
+!if !$d(CPP32)
+CPP32 = cpp32
+!endif
+
+!if !$d(DCC32)
+DCC32 = dcc32
+!endif
+
+!if !$d(TASM32)
+TASM32 = tasm32
+!endif
+
+!if !$d(LINKER)
+LINKER = ilink32
+!endif
+
+!if !$d(BRCC32)
+BRCC32 = brcc32
+!endif
+
+# ---------------------------------------------------------------------------
+!if $d(PATHCPP)
+.PATH.CPP = $(PATHCPP)
+.PATH.C = $(PATHCPP)
+!endif
+
+!if $d(PATHPAS)
+.PATH.PAS = $(PATHPAS)
+!endif
+
+!if $d(PATHASM)
+.PATH.ASM = $(PATHASM)
+!endif
+
+!if $d(PATHRC)
+.PATH.RC = $(PATHRC)
+!endif
+# ---------------------------------------------------------------------------
+$(PROJECT): $(OBJFILES) $(RESDEPEN) $(DEFFILE)
+ $(BCB)\BIN\$(LINKER) @&&!
+ $(LFLAGS) +
+ $(ALLOBJ), +
+ $(PROJECT),, +
+ $(ALLLIB), +
+ $(DEFFILE), +
+ $(ALLRES)
+!
+# ---------------------------------------------------------------------------
+.pas.hpp:
+ $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< }
+
+.pas.obj:
+ $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< }
+
+.cpp.obj:
+ $(BCB)\BIN\$(BCC32) $(CFLAG1) -n$(@D) {$< }
+
+.c.obj:
+ $(BCB)\BIN\$(BCC32) $(CFLAG1) -n$(@D) {$< }
+
+.c.i:
+ $(BCB)\BIN\$(CPP32) $(CFLAG1) -n. {$< }
+
+.cpp.i:
+ $(BCB)\BIN\$(CPP32) $(CFLAG1) -n. {$< }
+
+.asm.obj:
+ $(BCB)\BIN\$(TASM32) $(AFLAGS) $<, $@
+
+.rc.res:
+ $(BCB)\BIN\$(BRCC32) $(RFLAGS) -fo$@ $<
+# ---------------------------------------------------------------------------
diff --git a/LibD28/fsBDE4.cpp b/LibD28/fsBDE4.cpp
new file mode 100644
index 0000000..998594d
--- /dev/null
+++ b/LibD28/fsBDE4.cpp
@@ -0,0 +1,20 @@
+//---------------------------------------------------------------------------
+#include
+#pragma hdrstop
+USERES("FS4.res");
+USEPACKAGE("vcl40.bpi");
+USEPACKAGE("vcldb40.bpi");
+USEPACKAGE("fs4.bpi");
+USEPACKAGE("fsDB4.bpi");
+USEUNIT("fs_ibdereg.pas");
+USERES("fs_ireg.dcr");
+//---------------------------------------------------------------------------
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+// Package source.
+//---------------------------------------------------------------------------
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
diff --git a/LibD28/fsBDE4.dpk b/LibD28/fsBDE4.dpk
new file mode 100644
index 0000000..0d99e8f
--- /dev/null
+++ b/LibD28/fsBDE4.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 4
+
+package fsBDE4;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL40,
+ VCLDB40,
+ fs4,
+ fsDB4;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE5.bpk b/LibD28/fsBDE5.bpk
new file mode 100644
index 0000000..e982132
--- /dev/null
+++ b/LibD28/fsBDE5.bpk
@@ -0,0 +1,108 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=1
+Item0=$(BCB)\include;$(BCB)\include\vcl
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Language]
+ActiveLang=
+ProjectLang=
+RootDir=
+
+
\ No newline at end of file
diff --git a/LibD28/fsBDE5.cpp b/LibD28/fsBDE5.cpp
new file mode 100644
index 0000000..367c0d7
--- /dev/null
+++ b/LibD28/fsBDE5.cpp
@@ -0,0 +1,25 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+USERES("FS5.res");
+USEPACKAGE("vcl50.bpi");
+USEPACKAGE("vcldb50.bpi");
+USEPACKAGE("vclbde50.bpi");
+USEPACKAGE("fs5.bpi");
+USEPACKAGE("fsDB5.bpi");
+USEUNIT("fs_ibdereg.pas");
+USERES("fs_iReg.dcr");
+//---------------------------------------------------------------------------
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
diff --git a/LibD28/fsBDE5.dpk b/LibD28/fsBDE5.dpk
new file mode 100644
index 0000000..5d96d46
--- /dev/null
+++ b/LibD28/fsBDE5.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 5
+
+package fsBDE5;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+ VCLDB50,
+ VCLBDE50,
+ fs5,
+ fsDB5;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE6.bpk b/LibD28/fsBDE6.bpk
new file mode 100644
index 0000000..1455767
--- /dev/null
+++ b/LibD28/fsBDE6.bpk
@@ -0,0 +1,125 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[Excluded Packages]
+d:\delphi\builder6\Projects\Bpl\FR6.bpl=FastReport 2.4 Components
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+Launcher=
+UseLauncher=0
+DebugCWD=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteLauncher=
+RemoteCWD=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+LinkCGLIB=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Linker]
+LibPrefix=
+LibSuffix=
+LibVersion=
+
+
\ No newline at end of file
diff --git a/LibD28/fsBDE6.cpp b/LibD28/fsBDE6.cpp
new file mode 100644
index 0000000..f8b9781
--- /dev/null
+++ b/LibD28/fsBDE6.cpp
@@ -0,0 +1,17 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
+
\ No newline at end of file
diff --git a/LibD28/fsBDE6.dpk b/LibD28/fsBDE6.dpk
new file mode 100644
index 0000000..fa41b8a
--- /dev/null
+++ b/LibD28/fsBDE6.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 6
+
+package fsBDE6;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs6,
+ fsDB6;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE7.dpk b/LibD28/fsBDE7.dpk
new file mode 100644
index 0000000..8c5a9d6
--- /dev/null
+++ b/LibD28/fsBDE7.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 7
+
+package fsBDE7;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs7,
+ fsDB7;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsBDE9.dpk b/LibD28/fsBDE9.dpk
new file mode 100644
index 0000000..48a58bc
--- /dev/null
+++ b/LibD28/fsBDE9.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2005
+
+package fsBDE9;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ BDERTL,
+ fs9,
+ fsDB9;
+
+contains
+ fs_ibdertti in 'fs_ibdertti.pas';
+
+
+end.
diff --git a/LibD28/fsDB10.dpk b/LibD28/fsDB10.dpk
new file mode 100644
index 0000000..166eb1e
--- /dev/null
+++ b/LibD28/fsDB10.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2006
+
+package fsDB10;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs10;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+
+end.
diff --git a/LibD28/fsDB11.dpk b/LibD28/fsDB11.dpk
new file mode 100644
index 0000000..3997457
--- /dev/null
+++ b/LibD28/fsDB11.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2007
+
+package fsDB11;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs11;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+
+end.
diff --git a/LibD28/fsDB12.dpk b/LibD28/fsDB12.dpk
new file mode 100644
index 0000000..c6bd2b2
--- /dev/null
+++ b/LibD28/fsDB12.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2009
+
+package fsDB12;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs12;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+
+end.
diff --git a/LibD28/fsDB14.dpk b/LibD28/fsDB14.dpk
new file mode 100644
index 0000000..fb31b43
--- /dev/null
+++ b/LibD28/fsDB14.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 2010
+
+package fsDB14;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs14;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/fsDB15.dpk b/LibD28/fsDB15.dpk
new file mode 100644
index 0000000..1093567
--- /dev/null
+++ b/LibD28/fsDB15.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE
+
+package fsDB15;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs15;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/fsDB16.dpk b/LibD28/fsDB16.dpk
new file mode 100644
index 0000000..43eb58b
--- /dev/null
+++ b/LibD28/fsDB16.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE2
+
+package fsDB16;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs16;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/fsDB17.dpk b/LibD28/fsDB17.dpk
new file mode 100644
index 0000000..3b749a9
--- /dev/null
+++ b/LibD28/fsDB17.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE3
+
+package fsDB17;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs17;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/fsDB18.dpk b/LibD28/fsDB18.dpk
new file mode 100644
index 0000000..ef1ea16
--- /dev/null
+++ b/LibD28/fsDB18.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE4
+
+package fsDB18;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs18;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/fsDB19.dpk b/LibD28/fsDB19.dpk
new file mode 100644
index 0000000..8b64749
--- /dev/null
+++ b/LibD28/fsDB19.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE5
+
+package fsDB19;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs19;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/fsDB20.dpk b/LibD28/fsDB20.dpk
new file mode 100644
index 0000000..6b1ecd6
--- /dev/null
+++ b/LibD28/fsDB20.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE6
+
+package fsDB20;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs20;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/fsDB21.dpk b/LibD28/fsDB21.dpk
new file mode 100644
index 0000000..75c41a9
--- /dev/null
+++ b/LibD28/fsDB21.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE7
+
+package fsDB21;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs21;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/fsDB22.dpk b/LibD28/fsDB22.dpk
new file mode 100644
index 0000000..a59385b
--- /dev/null
+++ b/LibD28/fsDB22.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi XE8
+
+package fsDB22;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs22;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/fsDB23.dpk b/LibD28/fsDB23.dpk
new file mode 100644
index 0000000..4c6e4a4
--- /dev/null
+++ b/LibD28/fsDB23.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package fsDB23;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs23;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/fsDB24.dpk b/LibD28/fsDB24.dpk
new file mode 100644
index 0000000..cc8c55f
--- /dev/null
+++ b/LibD28/fsDB24.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package fsDB24;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs24;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/fsDB25.dpk b/LibD28/fsDB25.dpk
new file mode 100644
index 0000000..dff4be5
--- /dev/null
+++ b/LibD28/fsDB25.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package fsDB25;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs25;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/fsDB26.dpk b/LibD28/fsDB26.dpk
new file mode 100644
index 0000000..b2c005f
--- /dev/null
+++ b/LibD28/fsDB26.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package fsDB26;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs26;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/fsDB27.dpk b/LibD28/fsDB27.dpk
new file mode 100644
index 0000000..0655b35
--- /dev/null
+++ b/LibD28/fsDB27.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 10 Seattle
+
+package fsDB27;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs27;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/fsDB28.dpk b/LibD28/fsDB28.dpk
new file mode 100644
index 0000000..f3fd31a
--- /dev/null
+++ b/LibD28/fsDB28.dpk
@@ -0,0 +1,39 @@
+// Package file for Delphi 11 Seattle
+
+package fsDB28;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs28;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+end.
diff --git a/LibD28/fsDB4.bpk b/LibD28/fsDB4.bpk
new file mode 100644
index 0000000..9a07332
--- /dev/null
+++ b/LibD28/fsDB4.bpk
@@ -0,0 +1,187 @@
+# ---------------------------------------------------------------------------
+!if !$d(BCB)
+BCB = $(MAKEDIR)\..
+!endif
+
+# ---------------------------------------------------------------------------
+# IDE SECTION
+# ---------------------------------------------------------------------------
+# The following section of the project makefile is managed by the BCB IDE.
+# It is recommended to use the IDE to change any of the values in this
+# section.
+# ---------------------------------------------------------------------------
+
+VERSION = BCB.04.04
+# ---------------------------------------------------------------------------
+PROJECT = FSDB4.bpl
+OBJFILES = fs_iReg.obj FSDB4.obj
+RESFILES = FS4.res fs_iReg.dcr
+RESDEPEN = $(RESFILES)
+LIBFILES =
+PACKAGES = vcl40.bpi vcldb40.bpi fs4.bpi
+DEFFILE =
+# ---------------------------------------------------------------------------
+PATHCPP = .;
+PATHASM = .;
+PATHPAS = .;
+PATHRC = .;
+DEBUGLIBPATH = $(BCB)\lib\debug
+RELEASELIBPATH = $(BCB)\lib\release
+USERDEFINES =
+SYSDEFINES = _RTLDLL;NO_STRICT;USEPACKAGES
+# ---------------------------------------------------------------------------
+CFLAG1 = -I$(BCB)\include;$(BCB)\include\vcl -O2 -Hc -H=$(BCB)\lib\vcl40.csm -w -Ve -a8 \
+ -k- -vi -c -b- -w-par -w-inl -Vx -tWM -D$(SYSDEFINES);$(USERDEFINES)
+PFLAGS = -U$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \
+ -I$(BCB)\include;$(BCB)\include\vcl -$Y- -$L- -$D- -v -JPHNE -M
+RFLAGS = -i$(BCB)\include;$(BCB)\include\vcl
+AFLAGS = /i$(BCB)\include /i$(BCB)\include\vcl /mx /w2 /zn
+LFLAGS = -L$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \
+ -D"FastScript 1.9 DB Components" -aa -Tpp -x -Gn -Gl -Gi
+# ---------------------------------------------------------------------------
+ALLOBJ = c0pkg32.obj Memmgr.Lib $(PACKAGES) sysinit.obj $(OBJFILES)
+ALLRES = $(RESFILES)
+ALLLIB = $(LIBFILES) $(LIBRARIES) import32.lib cp32mti.lib
+# ---------------------------------------------------------------------------
+!ifdef IDEOPTIONS
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=1
+Item0=$(BCB)\include;$(BCB)\include\vcl
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteDebug=0
+
+[Compiler]
+InMemoryExe=0
+ShowInfoMsgs=0
+
+!endif
+
+# ---------------------------------------------------------------------------
+# MAKE SECTION
+# ---------------------------------------------------------------------------
+# This section of the project file is not used by the BCB IDE. It is for
+# the benefit of building from the command-line using the MAKE utility.
+# ---------------------------------------------------------------------------
+
+.autodepend
+# ---------------------------------------------------------------------------
+!if !$d(BCC32)
+BCC32 = bcc32
+!endif
+
+!if !$d(CPP32)
+CPP32 = cpp32
+!endif
+
+!if !$d(DCC32)
+DCC32 = dcc32
+!endif
+
+!if !$d(TASM32)
+TASM32 = tasm32
+!endif
+
+!if !$d(LINKER)
+LINKER = ilink32
+!endif
+
+!if !$d(BRCC32)
+BRCC32 = brcc32
+!endif
+
+# ---------------------------------------------------------------------------
+!if $d(PATHCPP)
+.PATH.CPP = $(PATHCPP)
+.PATH.C = $(PATHCPP)
+!endif
+
+!if $d(PATHPAS)
+.PATH.PAS = $(PATHPAS)
+!endif
+
+!if $d(PATHASM)
+.PATH.ASM = $(PATHASM)
+!endif
+
+!if $d(PATHRC)
+.PATH.RC = $(PATHRC)
+!endif
+# ---------------------------------------------------------------------------
+$(PROJECT): $(OBJFILES) $(RESDEPEN) $(DEFFILE)
+ $(BCB)\BIN\$(LINKER) @&&!
+ $(LFLAGS) +
+ $(ALLOBJ), +
+ $(PROJECT),, +
+ $(ALLLIB), +
+ $(DEFFILE), +
+ $(ALLRES)
+!
+# ---------------------------------------------------------------------------
+.pas.hpp:
+ $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< }
+
+.pas.obj:
+ $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< }
+
+.cpp.obj:
+ $(BCB)\BIN\$(BCC32) $(CFLAG1) -n$(@D) {$< }
+
+.c.obj:
+ $(BCB)\BIN\$(BCC32) $(CFLAG1) -n$(@D) {$< }
+
+.c.i:
+ $(BCB)\BIN\$(CPP32) $(CFLAG1) -n. {$< }
+
+.cpp.i:
+ $(BCB)\BIN\$(CPP32) $(CFLAG1) -n. {$< }
+
+.asm.obj:
+ $(BCB)\BIN\$(TASM32) $(AFLAGS) $<, $@
+
+.rc.res:
+ $(BCB)\BIN\$(BRCC32) $(RFLAGS) -fo$@ $<
+# ---------------------------------------------------------------------------
diff --git a/LibD28/fsDB4.cpp b/LibD28/fsDB4.cpp
new file mode 100644
index 0000000..e80af50
--- /dev/null
+++ b/LibD28/fsDB4.cpp
@@ -0,0 +1,19 @@
+//---------------------------------------------------------------------------
+#include
+#pragma hdrstop
+USERES("FS4.res");
+USEPACKAGE("vcl40.bpi");
+USEPACKAGE("vcldb40.bpi");
+USEPACKAGE("fs4.bpi");
+USEUNIT("fs_idbreg.pas");
+USERES("fs_ireg.dcr");
+//---------------------------------------------------------------------------
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+// Package source.
+//---------------------------------------------------------------------------
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
diff --git a/LibD28/fsDB4.dpk b/LibD28/fsDB4.dpk
new file mode 100644
index 0000000..3429456
--- /dev/null
+++ b/LibD28/fsDB4.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 4
+
+package fsDB4;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL40,
+ VCLDB40,
+ fs4;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+
+end.
diff --git a/LibD28/fsDB5.bpk b/LibD28/fsDB5.bpk
new file mode 100644
index 0000000..4b727e2
--- /dev/null
+++ b/LibD28/fsDB5.bpk
@@ -0,0 +1,108 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=1
+Item0=$(BCB)\include;$(BCB)\include\vcl
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Language]
+ActiveLang=
+ProjectLang=
+RootDir=
+
+
\ No newline at end of file
diff --git a/LibD28/fsDB5.cpp b/LibD28/fsDB5.cpp
new file mode 100644
index 0000000..a00f350
--- /dev/null
+++ b/LibD28/fsDB5.cpp
@@ -0,0 +1,23 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+USERES("FS5.res");
+USEPACKAGE("vcl50.bpi");
+USEPACKAGE("vcldb50.bpi");
+USEPACKAGE("fs5.bpi");
+USEUNIT("fs_idbreg.pas");
+USERES("fs_iReg.dcr");
+//---------------------------------------------------------------------------
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
diff --git a/LibD28/fsDB5.dpk b/LibD28/fsDB5.dpk
new file mode 100644
index 0000000..670ca1c
--- /dev/null
+++ b/LibD28/fsDB5.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 5
+
+package fsDB5;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+ VCLDB50,
+ fs5;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+
+end.
diff --git a/LibD28/fsDB6.bpk b/LibD28/fsDB6.bpk
new file mode 100644
index 0000000..a57859c
--- /dev/null
+++ b/LibD28/fsDB6.bpk
@@ -0,0 +1,123 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[Excluded Packages]
+d:\delphi\builder6\Projects\Bpl\FR6.bpl=FastReport 2.4 Components
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+Launcher=
+UseLauncher=0
+DebugCWD=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteLauncher=
+RemoteCWD=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+LinkCGLIB=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Linker]
+LibPrefix=
+LibSuffix=
+LibVersion=
+
+
\ No newline at end of file
diff --git a/LibD28/fsDB6.cpp b/LibD28/fsDB6.cpp
new file mode 100644
index 0000000..f8b9781
--- /dev/null
+++ b/LibD28/fsDB6.cpp
@@ -0,0 +1,17 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
+
\ No newline at end of file
diff --git a/LibD28/fsDB6.dpk b/LibD28/fsDB6.dpk
new file mode 100644
index 0000000..c72c556
--- /dev/null
+++ b/LibD28/fsDB6.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 6
+
+package fsDB6;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs6;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+
+end.
diff --git a/LibD28/fsDB7.dpk b/LibD28/fsDB7.dpk
new file mode 100644
index 0000000..045479e
--- /dev/null
+++ b/LibD28/fsDB7.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 7
+
+package fsDB7;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs7;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+
+end.
diff --git a/LibD28/fsDB9.dpk b/LibD28/fsDB9.dpk
new file mode 100644
index 0000000..456067d
--- /dev/null
+++ b/LibD28/fsDB9.dpk
@@ -0,0 +1,41 @@
+// Package file for Delphi 2005
+
+package fsDB9;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ fs9;
+
+contains
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas';
+
+
+end.
diff --git a/LibD28/fsFD15.dpk b/LibD28/fsFD15.dpk
new file mode 100644
index 0000000..a02903c
--- /dev/null
+++ b/LibD28/fsFD15.dpk
@@ -0,0 +1,44 @@
+// Package file for Delphi XE
+
+package fsFD15;
+
+{$R *.res}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+{$DEFINE BUNDLE}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs15,
+ fsDB15,
+ AnyDAC_Comp_D15,
+ AnyDAC_Phys_D15,
+ AnyDAC_ComI_D15;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/LibD28/fsFD16.dpk b/LibD28/fsFD16.dpk
new file mode 100644
index 0000000..6486155
--- /dev/null
+++ b/LibD28/fsFD16.dpk
@@ -0,0 +1,44 @@
+// Package file for Delphi XE2
+
+package fsFD16;
+
+{$R *.res}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+{$DEFINE BUNDLE}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs16,
+ fsDB16,
+ AnyDAC_Comp_D16,
+ AnyDAC_Phys_D16,
+ AnyDAC_ComI_D16;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/LibD28/fsFD17.dpk b/LibD28/fsFD17.dpk
new file mode 100644
index 0000000..fe2986f
--- /dev/null
+++ b/LibD28/fsFD17.dpk
@@ -0,0 +1,44 @@
+// Package file for Delphi XE3
+
+package fsFD17;
+
+{$R *.res}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+{$DEFINE BUNDLE}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs17,
+ fsDB17,
+ AnyDAC_Comp_D17,
+ AnyDAC_Phys_D17,
+ AnyDAC_ComI_D17;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/LibD28/fsFD18.dpk b/LibD28/fsFD18.dpk
new file mode 100644
index 0000000..00d2d38
--- /dev/null
+++ b/LibD28/fsFD18.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE4
+
+package fsFD18;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs18,
+ fsDB18,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/LibD28/fsFD19.dpk b/LibD28/fsFD19.dpk
new file mode 100644
index 0000000..fe9ec71
--- /dev/null
+++ b/LibD28/fsFD19.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE5
+
+package fsFD19;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs19,
+ fsDB19,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/LibD28/fsFD20.dpk b/LibD28/fsFD20.dpk
new file mode 100644
index 0000000..05ed63c
--- /dev/null
+++ b/LibD28/fsFD20.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE6
+
+package fsFD20;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs20,
+ fsDB20,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/LibD28/fsFD21.dpk b/LibD28/fsFD21.dpk
new file mode 100644
index 0000000..141e7bb
--- /dev/null
+++ b/LibD28/fsFD21.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE7
+
+package fsFD21;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs21,
+ fsDB21,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/LibD28/fsFD22.dpk b/LibD28/fsFD22.dpk
new file mode 100644
index 0000000..b10712c
--- /dev/null
+++ b/LibD28/fsFD22.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi XE8
+
+package fsFD22;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs22,
+ fsDB22,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/LibD28/fsFD23.dpk b/LibD28/fsFD23.dpk
new file mode 100644
index 0000000..b477cff
--- /dev/null
+++ b/LibD28/fsFD23.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10 Seattle
+
+package fsFD23;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs23,
+ fsDB23,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/LibD28/fsFD24.dpk b/LibD28/fsFD24.dpk
new file mode 100644
index 0000000..a9907c2
--- /dev/null
+++ b/LibD28/fsFD24.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10.1 Berlin
+
+package fsFD24;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs24,
+ fsDB24,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/LibD28/fsFD25.dpk b/LibD28/fsFD25.dpk
new file mode 100644
index 0000000..fc0c319
--- /dev/null
+++ b/LibD28/fsFD25.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10.2 Tokyo
+
+package fsFD25;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs25,
+ fsDB25,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/LibD28/fsFD26.dpk b/LibD28/fsFD26.dpk
new file mode 100644
index 0000000..5761aba
--- /dev/null
+++ b/LibD28/fsFD26.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10.3 Rio
+
+package fsFD26;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs26,
+ fsDB26,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/LibD28/fsFD27.dpk b/LibD28/fsFD27.dpk
new file mode 100644
index 0000000..0655a21
--- /dev/null
+++ b/LibD28/fsFD27.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 10.3 Rio
+
+package fsFD27;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs27,
+ fsDB27,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/LibD28/fsFD28.dpk b/LibD28/fsFD28.dpk
new file mode 100644
index 0000000..5eedc20
--- /dev/null
+++ b/LibD28/fsFD28.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 11.3 Rio
+
+package fsFD28;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs28,
+ fsDB28,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/LibD28/fsFD29.dpk b/LibD28/fsFD29.dpk
new file mode 100644
index 0000000..e23ae6c
--- /dev/null
+++ b/LibD28/fsFD29.dpk
@@ -0,0 +1,43 @@
+// Package file for Delphi 12
+
+package fsFD29;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ xmlrtl,
+ fs29,
+ fsDB29,
+ FireDAC,
+ FireDACCommon,
+ vclFireDAC;
+
+contains
+ fs_ifdrtti in 'fs_ifdrtti.pas';
+
+end.
diff --git a/LibD28/fsFD29.dproj b/LibD28/fsFD29.dproj
new file mode 100644
index 0000000..6d61b2c
--- /dev/null
+++ b/LibD28/fsFD29.dproj
@@ -0,0 +1,143 @@
+
+
+ {E25B8957-C438-4979-902A-85FBF3F3BD8B}
+ fsFD29.dpk
+ True
+ Release
+ 3
+ Package
+ VCL
+ 20.1
+ Win64
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Cfg_1
+ true
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ fsFD29
+ 1
+ true
+ true
+ true
+ Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;DUnitX.Loggers.GUI;$(DCC_Namespace)
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+ 1033
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ D:\Delphi\Component\FastReport FMX 2.8.12 Pro Full Source\LibD28x64\
+ true
+ 1033
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ fsFD29.dpk
+
+
+ Microsoft Office 2000 Sample Automation Server Wrapper Components
+ Microsoft Office XP Sample Automation Server Wrapper Components
+
+
+
+ False
+ False
+ False
+ True
+ True
+
+
+ 12
+
+
+
+
diff --git a/LibD28/fsFD29.res b/LibD28/fsFD29.res
new file mode 100644
index 0000000..191fd6c
Binary files /dev/null and b/LibD28/fsFD29.res differ
diff --git a/LibD28/fsIBX10.dpk b/LibD28/fsIBX10.dpk
new file mode 100644
index 0000000..65e4900
--- /dev/null
+++ b/LibD28/fsIBX10.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2006
+
+package fsIBX10;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs10,
+ fsDB10;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+
+end.
diff --git a/LibD28/fsIBX11.dpk b/LibD28/fsIBX11.dpk
new file mode 100644
index 0000000..c23cc5c
--- /dev/null
+++ b/LibD28/fsIBX11.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2007
+
+package fsIBX11;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs11,
+ fsDB11;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+
+end.
diff --git a/LibD28/fsIBX12.dpk b/LibD28/fsIBX12.dpk
new file mode 100644
index 0000000..a1d73e4
--- /dev/null
+++ b/LibD28/fsIBX12.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2009
+
+package fsIBX12;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs12,
+ fsDB12;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+
+end.
diff --git a/LibD28/fsIBX14.dpk b/LibD28/fsIBX14.dpk
new file mode 100644
index 0000000..50c3880
--- /dev/null
+++ b/LibD28/fsIBX14.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 2010
+
+package fsIBX14;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs14,
+ fsDB14;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/fsIBX15.dpk b/LibD28/fsIBX15.dpk
new file mode 100644
index 0000000..5466dd8
--- /dev/null
+++ b/LibD28/fsIBX15.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE
+
+package fsIBX15;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs15,
+ fsDB15;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/fsIBX16.dpk b/LibD28/fsIBX16.dpk
new file mode 100644
index 0000000..03bd29b
--- /dev/null
+++ b/LibD28/fsIBX16.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE2
+
+package fsIBX16;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs16,
+ fsDB16;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/fsIBX17.dpk b/LibD28/fsIBX17.dpk
new file mode 100644
index 0000000..d65c55e
--- /dev/null
+++ b/LibD28/fsIBX17.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE3
+
+package fsIBX17;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs17,
+ fsDB17;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/fsIBX18.dpk b/LibD28/fsIBX18.dpk
new file mode 100644
index 0000000..b75af54
--- /dev/null
+++ b/LibD28/fsIBX18.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE4
+
+package fsIBX18;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs18,
+ fsDB18;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/fsIBX19.dpk b/LibD28/fsIBX19.dpk
new file mode 100644
index 0000000..053329e
--- /dev/null
+++ b/LibD28/fsIBX19.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE5
+
+package fsIBX19;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs19,
+ fsDB19;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/fsIBX20.dpk b/LibD28/fsIBX20.dpk
new file mode 100644
index 0000000..8be4ffa
--- /dev/null
+++ b/LibD28/fsIBX20.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE6
+
+package fsIBX20;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs20,
+ fsDB20;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/fsIBX21.dpk b/LibD28/fsIBX21.dpk
new file mode 100644
index 0000000..dd03f8f
--- /dev/null
+++ b/LibD28/fsIBX21.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE7
+
+package fsIBX21;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs21,
+ fsDB21;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/fsIBX22.dpk b/LibD28/fsIBX22.dpk
new file mode 100644
index 0000000..3abd997
--- /dev/null
+++ b/LibD28/fsIBX22.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi XE8
+
+package fsIBX22;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs22,
+ fsDB22;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/fsIBX23.dpk b/LibD28/fsIBX23.dpk
new file mode 100644
index 0000000..7c867a4
--- /dev/null
+++ b/LibD28/fsIBX23.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package fsIBX23;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs23,
+ fsDB23;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/fsIBX24.dpk b/LibD28/fsIBX24.dpk
new file mode 100644
index 0000000..291f0f4
--- /dev/null
+++ b/LibD28/fsIBX24.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package fsIBX24;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs24,
+ fsDB24;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/fsIBX25.dpk b/LibD28/fsIBX25.dpk
new file mode 100644
index 0000000..a3c63db
--- /dev/null
+++ b/LibD28/fsIBX25.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package fsIBX25;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs25,
+ fsDB25;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/fsIBX26.dpk b/LibD28/fsIBX26.dpk
new file mode 100644
index 0000000..cb6b628
--- /dev/null
+++ b/LibD28/fsIBX26.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package fsIBX26;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs26,
+ fsDB26;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/fsIBX27.dpk b/LibD28/fsIBX27.dpk
new file mode 100644
index 0000000..5ddc72a
--- /dev/null
+++ b/LibD28/fsIBX27.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 10 Seattle
+
+package fsIBX27;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs27,
+ fsDB27;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/fsIBX28.dpk b/LibD28/fsIBX28.dpk
new file mode 100644
index 0000000..a058907
--- /dev/null
+++ b/LibD28/fsIBX28.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 11 Seattle
+
+package fsIBX28;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs28,
+ fsDB28;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/fsIBX29.dpk b/LibD28/fsIBX29.dpk
new file mode 100644
index 0000000..3369dfd
--- /dev/null
+++ b/LibD28/fsIBX29.dpk
@@ -0,0 +1,40 @@
+// Package file for Delphi 12
+
+package fsIBX29;
+
+{$I fs.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs29,
+ fsDB29;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+end.
diff --git a/LibD28/fsIBX5.bpk b/LibD28/fsIBX5.bpk
new file mode 100644
index 0000000..9fada0f
--- /dev/null
+++ b/LibD28/fsIBX5.bpk
@@ -0,0 +1,108 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=1
+Item0=$(BCB)\include;$(BCB)\include\vcl
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Language]
+ActiveLang=
+ProjectLang=
+RootDir=
+
+
\ No newline at end of file
diff --git a/LibD28/fsIBX5.cpp b/LibD28/fsIBX5.cpp
new file mode 100644
index 0000000..ca708ed
--- /dev/null
+++ b/LibD28/fsIBX5.cpp
@@ -0,0 +1,26 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+USERES("FS5.res");
+USEPACKAGE("vcl50.bpi");
+USEPACKAGE("vcldb50.bpi");
+USEPACKAGE("vclib50.bpi");
+USEPACKAGE("fs5.bpi");
+USEPACKAGE("fsDB5.bpi");
+USEUNIT("fs_iibxreg.pas");
+USEUNIT("fs_iibxrtti.pas");
+USERES("fs_iReg.dcr");
+//---------------------------------------------------------------------------
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
diff --git a/LibD28/fsIBX5.dpk b/LibD28/fsIBX5.dpk
new file mode 100644
index 0000000..67c6d1e
--- /dev/null
+++ b/LibD28/fsIBX5.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 5
+
+package fsIBX5;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+ VCLDB50,
+ VCLIB50,
+ fs5,
+ fsDB5;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+
+end.
diff --git a/LibD28/fsIBX6.bpk b/LibD28/fsIBX6.bpk
new file mode 100644
index 0000000..4795716
--- /dev/null
+++ b/LibD28/fsIBX6.bpk
@@ -0,0 +1,125 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[Excluded Packages]
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+Launcher=
+UseLauncher=0
+DebugCWD=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteLauncher=
+RemoteCWD=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+LinkCGLIB=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Linker]
+LibPrefix=
+LibSuffix=
+LibVersion=
+
+
\ No newline at end of file
diff --git a/LibD28/fsIBX6.cpp b/LibD28/fsIBX6.cpp
new file mode 100644
index 0000000..f8b9781
--- /dev/null
+++ b/LibD28/fsIBX6.cpp
@@ -0,0 +1,17 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
+
\ No newline at end of file
diff --git a/LibD28/fsIBX6.dpk b/LibD28/fsIBX6.dpk
new file mode 100644
index 0000000..f18d8bb
--- /dev/null
+++ b/LibD28/fsIBX6.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 6
+
+package fsIBX6;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs6,
+ fsDB6;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+
+end.
diff --git a/LibD28/fsIBX7.dpk b/LibD28/fsIBX7.dpk
new file mode 100644
index 0000000..6b5de3f
--- /dev/null
+++ b/LibD28/fsIBX7.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 7
+
+package fsIBX7;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs7,
+ fsDB7;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+
+end.
diff --git a/LibD28/fsIBX9.dpk b/LibD28/fsIBX9.dpk
new file mode 100644
index 0000000..b9bd413
--- /dev/null
+++ b/LibD28/fsIBX9.dpk
@@ -0,0 +1,42 @@
+// Package file for Delphi 2005
+
+package fsIBX9;
+
+{$I fs.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+ VCLDB,
+ IBXPRESS,
+ fs9,
+ fsDB9;
+
+contains
+ fs_iibxrtti in 'fs_iibxrtti.pas';
+
+
+end.
diff --git a/LibD28/fsTee10.dpk b/LibD28/fsTee10.dpk
new file mode 100644
index 0000000..7deeae0
--- /dev/null
+++ b/LibD28/fsTee10.dpk
@@ -0,0 +1,52 @@
+// Package file for Delphi 2006
+
+package fsTee10;
+
+{$I fs.inc}
+{$I tee.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE710, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE810, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE910, {$ENDIF}
+{$IFDEF TeeChart4} TEE410, {$ENDIF}
+{$IFDEF TeeChart5} TEE510, {$ENDIF}
+{$IFDEF TeeChart6} TEE610, {$ENDIF}
+{$IFDEF TeeChart7} TEE710, {$ENDIF}
+{$IFDEF TeeChart8} TEE810, {$ENDIF}
+{$IFDEF TeeChart9} TEE910, {$ENDIF}
+ VCLX,
+ fs10;
+
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+
+end.
diff --git a/LibD28/fsTee11.dpk b/LibD28/fsTee11.dpk
new file mode 100644
index 0000000..5267d76
--- /dev/null
+++ b/LibD28/fsTee11.dpk
@@ -0,0 +1,52 @@
+// Package file for Delphi 2007
+
+package fsTee11;
+
+{$I fs.inc}
+{$I tee.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE711, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE811, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE911, {$ENDIF}
+{$IFDEF TeeChart4} TEE411, {$ENDIF}
+{$IFDEF TeeChart5} TEE511, {$ENDIF}
+{$IFDEF TeeChart6} TEE611, {$ENDIF}
+{$IFDEF TeeChart7} TEE711, {$ENDIF}
+{$IFDEF TeeChart8} TEE811, {$ENDIF}
+{$IFDEF TeeChart9} TEE911, {$ENDIF}
+ VCLX,
+ fs11;
+
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+
+end.
diff --git a/LibD28/fsTee12.dpk b/LibD28/fsTee12.dpk
new file mode 100644
index 0000000..c6f15b4
--- /dev/null
+++ b/LibD28/fsTee12.dpk
@@ -0,0 +1,52 @@
+// Package file for Delphi 2009
+
+package fsTee12;
+
+{$I fs.inc}
+{$I tee.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE712, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE812, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE912, {$ENDIF}
+{$IFDEF TeeChart4} TEE412, {$ENDIF}
+{$IFDEF TeeChart5} TEE512, {$ENDIF}
+{$IFDEF TeeChart6} TEE612, {$ENDIF}
+{$IFDEF TeeChart7} TEE712, {$ENDIF}
+{$IFDEF TeeChart8} TEE812, {$ENDIF}
+{$IFDEF TeeChart9} TEE912, {$ENDIF}
+ VCLX,
+ fs12;
+
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+
+end.
diff --git a/LibD28/fsTee14.dpk b/LibD28/fsTee14.dpk
new file mode 100644
index 0000000..f03cdc4
--- /dev/null
+++ b/LibD28/fsTee14.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi 2010
+
+package fsTee14;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE714, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE814, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE914, {$ENDIF}
+{$IFDEF TeeChart4} TEE414, {$ENDIF}
+{$IFDEF TeeChart5} TEE514, {$ENDIF}
+{$IFDEF TeeChart6} TEE614, {$ENDIF}
+{$IFDEF TeeChart7} TEE714, {$ENDIF}
+{$IFDEF TeeChart8} TEE814, {$ENDIF}
+{$IFDEF TeeChart9} TEE914, {$ENDIF}
+ VCLX,
+ fs14;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/fsTee15.dpk b/LibD28/fsTee15.dpk
new file mode 100644
index 0000000..0936c3f
--- /dev/null
+++ b/LibD28/fsTee15.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi XE
+
+package fsTee15;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE715, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE815, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE915, {$ENDIF}
+{$IFDEF TeeChart4} TEE415, {$ENDIF}
+{$IFDEF TeeChart5} TEE515, {$ENDIF}
+{$IFDEF TeeChart6} TEE615, {$ENDIF}
+{$IFDEF TeeChart7} TEE715, {$ENDIF}
+{$IFDEF TeeChart8} TEE815, {$ENDIF}
+{$IFDEF TeeChart9} TEE915, {$ENDIF}
+ VCLX,
+ fs15;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/fsTee16.dpk b/LibD28/fsTee16.dpk
new file mode 100644
index 0000000..737d44d
--- /dev/null
+++ b/LibD28/fsTee16.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi XE2
+
+package fsTee16;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE716, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE816, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE916, {$ENDIF}
+{$IFDEF TeeChart4} TEE416, {$ENDIF}
+{$IFDEF TeeChart5} TEE516, {$ENDIF}
+{$IFDEF TeeChart6} TEE616, {$ENDIF}
+{$IFDEF TeeChart7} TEE716, {$ENDIF}
+{$IFDEF TeeChart8} TEE816, {$ENDIF}
+{$IFDEF TeeChart9} TEE916, {$ENDIF}
+ VCLX,
+ fs16;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/fsTee17.dpk b/LibD28/fsTee17.dpk
new file mode 100644
index 0000000..ae74ce1
--- /dev/null
+++ b/LibD28/fsTee17.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi XE3
+
+package fsTee17;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE717, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE817, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE917, {$ENDIF}
+{$IFDEF TeeChart4} TEE417, {$ENDIF}
+{$IFDEF TeeChart5} TEE517, {$ENDIF}
+{$IFDEF TeeChart6} TEE617, {$ENDIF}
+{$IFDEF TeeChart7} TEE717, {$ENDIF}
+{$IFDEF TeeChart8} TEE817, {$ENDIF}
+{$IFDEF TeeChart9} TEE917, {$ENDIF}
+ VCLX,
+ fs17;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/fsTee18.dpk b/LibD28/fsTee18.dpk
new file mode 100644
index 0000000..bc86af4
--- /dev/null
+++ b/LibD28/fsTee18.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi XE4
+
+package fsTee18;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE718, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE818, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE918, {$ENDIF}
+{$IFDEF TeeChart4} TEE418, {$ENDIF}
+{$IFDEF TeeChart5} TEE518, {$ENDIF}
+{$IFDEF TeeChart6} TEE618, {$ENDIF}
+{$IFDEF TeeChart7} TEE718, {$ENDIF}
+{$IFDEF TeeChart8} TEE818, {$ENDIF}
+{$IFDEF TeeChart9} TEE918, {$ENDIF}
+ VCLX,
+ fs18;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/fsTee19.dpk b/LibD28/fsTee19.dpk
new file mode 100644
index 0000000..7227c0d
--- /dev/null
+++ b/LibD28/fsTee19.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi XE5
+
+package fsTee19;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE719, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE819, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE919, {$ENDIF}
+{$IFDEF TeeChart4} TEE419, {$ENDIF}
+{$IFDEF TeeChart5} TEE519, {$ENDIF}
+{$IFDEF TeeChart6} TEE619, {$ENDIF}
+{$IFDEF TeeChart7} TEE719, {$ENDIF}
+{$IFDEF TeeChart8} TEE819, {$ENDIF}
+{$IFDEF TeeChart9} TEE919, {$ENDIF}
+ VCLX,
+ fs19;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/fsTee20.dpk b/LibD28/fsTee20.dpk
new file mode 100644
index 0000000..bac3ca3
--- /dev/null
+++ b/LibD28/fsTee20.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi XE6
+
+package fsTee20;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE720, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE820, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE920, {$ENDIF}
+{$IFDEF TeeChart4} TEE420, {$ENDIF}
+{$IFDEF TeeChart5} TEE520, {$ENDIF}
+{$IFDEF TeeChart6} TEE620, {$ENDIF}
+{$IFDEF TeeChart7} TEE720, {$ENDIF}
+{$IFDEF TeeChart8} TEE820, {$ENDIF}
+{$IFDEF TeeChart9} TEE920, {$ENDIF}
+ VCLX,
+ fs20;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/fsTee21.dpk b/LibD28/fsTee21.dpk
new file mode 100644
index 0000000..53c1e32
--- /dev/null
+++ b/LibD28/fsTee21.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi XE7
+
+package fsTee21;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE721, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE821, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE921, {$ENDIF}
+{$IFDEF TeeChart4} TEE421, {$ENDIF}
+{$IFDEF TeeChart5} TEE521, {$ENDIF}
+{$IFDEF TeeChart6} TEE621, {$ENDIF}
+{$IFDEF TeeChart7} TEE721, {$ENDIF}
+{$IFDEF TeeChart8} TEE821, {$ENDIF}
+{$IFDEF TeeChart9} TEE921, {$ENDIF}
+ VCLX,
+ fs21;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/fsTee22.dpk b/LibD28/fsTee22.dpk
new file mode 100644
index 0000000..21a7bde
--- /dev/null
+++ b/LibD28/fsTee22.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi XE8
+
+package fsTee22;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE722, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE822, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE922, {$ENDIF}
+{$IFDEF TeeChart4} TEE422, {$ENDIF}
+{$IFDEF TeeChart5} TEE522, {$ENDIF}
+{$IFDEF TeeChart6} TEE622, {$ENDIF}
+{$IFDEF TeeChart7} TEE722, {$ENDIF}
+{$IFDEF TeeChart8} TEE822, {$ENDIF}
+{$IFDEF TeeChart9} TEE922, {$ENDIF}
+ VCLX,
+ fs22;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/fsTee23.dpk b/LibD28/fsTee23.dpk
new file mode 100644
index 0000000..4be1127
--- /dev/null
+++ b/LibD28/fsTee23.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi 10 Seattle
+
+package fsTee23;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE723, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE823, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE923, {$ENDIF}
+{$IFDEF TeeChart4} TEE423, {$ENDIF}
+{$IFDEF TeeChart5} TEE523, {$ENDIF}
+{$IFDEF TeeChart6} TEE623, {$ENDIF}
+{$IFDEF TeeChart7} TEE723, {$ENDIF}
+{$IFDEF TeeChart8} TEE823, {$ENDIF}
+{$IFDEF TeeChart9} TEE923, {$ENDIF}
+ VCLX,
+ fs23;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/fsTee24.dpk b/LibD28/fsTee24.dpk
new file mode 100644
index 0000000..0cf4a48
--- /dev/null
+++ b/LibD28/fsTee24.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi 10 Seattle
+
+package fsTee24;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE724, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE824, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE924, {$ENDIF}
+{$IFDEF TeeChart4} TEE424, {$ENDIF}
+{$IFDEF TeeChart5} TEE524, {$ENDIF}
+{$IFDEF TeeChart6} TEE624, {$ENDIF}
+{$IFDEF TeeChart7} TEE724, {$ENDIF}
+{$IFDEF TeeChart8} TEE824, {$ENDIF}
+{$IFDEF TeeChart9} TEE924, {$ENDIF}
+ VCLX,
+ fs24;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/fsTee25.dpk b/LibD28/fsTee25.dpk
new file mode 100644
index 0000000..2cd2e78
--- /dev/null
+++ b/LibD28/fsTee25.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi 10 Seattle
+
+package fsTee25;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE725, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE825, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE925, {$ENDIF}
+{$IFDEF TeeChart4} TEE425, {$ENDIF}
+{$IFDEF TeeChart5} TEE525, {$ENDIF}
+{$IFDEF TeeChart6} TEE625, {$ENDIF}
+{$IFDEF TeeChart7} TEE725, {$ENDIF}
+{$IFDEF TeeChart8} TEE825, {$ENDIF}
+{$IFDEF TeeChart9} TEE925, {$ENDIF}
+ VCLX,
+ fs25;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/fsTee26.dpk b/LibD28/fsTee26.dpk
new file mode 100644
index 0000000..5a15b48
--- /dev/null
+++ b/LibD28/fsTee26.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi 10 Seattle
+
+package fsTee26;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE726, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE826, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE926, {$ENDIF}
+{$IFDEF TeeChart4} TEE426, {$ENDIF}
+{$IFDEF TeeChart5} TEE526, {$ENDIF}
+{$IFDEF TeeChart6} TEE626, {$ENDIF}
+{$IFDEF TeeChart7} TEE726, {$ENDIF}
+{$IFDEF TeeChart8} TEE826, {$ENDIF}
+{$IFDEF TeeChart9} TEE926, {$ENDIF}
+ VCLX,
+ fs26;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/fsTee27.dpk b/LibD28/fsTee27.dpk
new file mode 100644
index 0000000..a178105
--- /dev/null
+++ b/LibD28/fsTee27.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi 10 Seattle
+
+package fsTee27;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE727, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE827, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE927, {$ENDIF}
+{$IFDEF TeeChart4} TEE427, {$ENDIF}
+{$IFDEF TeeChart5} TEE527, {$ENDIF}
+{$IFDEF TeeChart6} TEE627, {$ENDIF}
+{$IFDEF TeeChart7} TEE727, {$ENDIF}
+{$IFDEF TeeChart8} TEE827, {$ENDIF}
+{$IFDEF TeeChart9} TEE927, {$ENDIF}
+ VCLX,
+ fs27;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/fsTee28.dpk b/LibD28/fsTee28.dpk
new file mode 100644
index 0000000..38fc436
--- /dev/null
+++ b/LibD28/fsTee28.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi 11 Seattle
+
+package fsTee28;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE728, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE828, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE928, {$ENDIF}
+{$IFDEF TeeChart4} TEE428, {$ENDIF}
+{$IFDEF TeeChart5} TEE528, {$ENDIF}
+{$IFDEF TeeChart6} TEE628, {$ENDIF}
+{$IFDEF TeeChart7} TEE728, {$ENDIF}
+{$IFDEF TeeChart8} TEE828, {$ENDIF}
+{$IFDEF TeeChart9} TEE928, {$ENDIF}
+ VCLX,
+ fs28;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/fsTee29.dpk b/LibD28/fsTee29.dpk
new file mode 100644
index 0000000..e2b4190
--- /dev/null
+++ b/LibD28/fsTee29.dpk
@@ -0,0 +1,49 @@
+// Package file for Delphi 12
+
+package fsTee29;
+
+{$I fs.inc}
+{$I tee.inc}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+{$DEBUGINFO ON}
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE729, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE829, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE929, {$ENDIF}
+{$IFDEF TeeChart4} TEE429, {$ENDIF}
+{$IFDEF TeeChart5} TEE529, {$ENDIF}
+{$IFDEF TeeChart6} TEE629, {$ENDIF}
+{$IFDEF TeeChart7} TEE729, {$ENDIF}
+{$IFDEF TeeChart8} TEE829, {$ENDIF}
+{$IFDEF TeeChart9} TEE929, {$ENDIF}
+ VCLX,
+ fs29;
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+end.
diff --git a/LibD28/fsTee29.dproj b/LibD28/fsTee29.dproj
new file mode 100644
index 0000000..9532d1e
--- /dev/null
+++ b/LibD28/fsTee29.dproj
@@ -0,0 +1,138 @@
+
+
+ {CEF45E18-A65B-45B6-9D7E-6AB967B301F5}
+ fsTee29.dpk
+ True
+ Release
+ 3
+ Package
+ VCL
+ 20.1
+ Win64
+
+
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Base
+ true
+
+
+ true
+ Cfg_1
+ true
+ true
+
+
+ true
+ Base
+ true
+
+
+ false
+ false
+ false
+ false
+ false
+ 00400000
+ true
+ true
+ fsTee29
+ 1
+ true
+ true
+ true
+ Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;DUnitX.Loggers.GUI;VCLTee;$(DCC_Namespace)
+ 9242
+ CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments=;CFBundleName=
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=;ProgramID=com.embarcadero.$(MSBuildProjectName)
+ 1033
+
+
+ Winapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;$(DCC_Namespace)
+ Debug
+ true
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+ 1033
+
+
+ RELEASE;$(DCC_Define)
+ 0
+ false
+ 0
+
+
+ D:\Delphi\Component\FastReport FMX 2.8.12 Pro Full Source\LibD28x64\
+ true
+ 1033
+ CompanyName=;FileDescription=$(MSBuildProjectName);FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProgramID=com.embarcadero.$(MSBuildProjectName);ProductName=$(MSBuildProjectName);ProductVersion=1.0.0.0;Comments=
+
+
+ DEBUG;$(DCC_Define)
+ false
+ true
+ true
+ true
+
+
+
+ MainSource
+
+
+
+
+
+
+ Base
+
+
+ Cfg_1
+ Base
+
+
+ Cfg_2
+ Base
+
+
+
+ Delphi.Personality.12
+ Package
+
+
+
+ fsTee29.dpk
+
+
+ Microsoft Office 2000 Sample Automation Server Wrapper Components
+ Microsoft Office XP Sample Automation Server Wrapper Components
+
+
+
+ False
+ False
+ False
+ True
+ True
+
+
+ 12
+
+
+
+
diff --git a/LibD28/fsTee29.res b/LibD28/fsTee29.res
new file mode 100644
index 0000000..d8a00ea
Binary files /dev/null and b/LibD28/fsTee29.res differ
diff --git a/LibD28/fsTee4.bpk b/LibD28/fsTee4.bpk
new file mode 100644
index 0000000..5b6bc39
--- /dev/null
+++ b/LibD28/fsTee4.bpk
@@ -0,0 +1,187 @@
+# ---------------------------------------------------------------------------
+!if !$d(BCB)
+BCB = $(MAKEDIR)\..
+!endif
+
+# ---------------------------------------------------------------------------
+# IDE SECTION
+# ---------------------------------------------------------------------------
+# The following section of the project makefile is managed by the BCB IDE.
+# It is recommended to use the IDE to change any of the values in this
+# section.
+# ---------------------------------------------------------------------------
+
+VERSION = BCB.04.04
+# ---------------------------------------------------------------------------
+PROJECT = FSTee4.bpl
+OBJFILES = fs_iteereg.obj FSTee4.obj fs_ichartrtti.obj
+RESFILES = FS4.res fs_iReg.dcr
+RESDEPEN = $(RESFILES)
+LIBFILES =
+PACKAGES = vcl40.bpi vclx40.bpi tee40.bpi fs4.bpi
+DEFFILE =
+# ---------------------------------------------------------------------------
+PATHCPP = .;
+PATHASM = .;
+PATHPAS = .;
+PATHRC = .;
+DEBUGLIBPATH = $(BCB)\lib\debug
+RELEASELIBPATH = $(BCB)\lib\release
+USERDEFINES =
+SYSDEFINES = _RTLDLL;NO_STRICT;USEPACKAGES
+# ---------------------------------------------------------------------------
+CFLAG1 = -I$(BCB)\include;$(BCB)\include\vcl -O2 -Hc -H=$(BCB)\lib\vcl40.csm -w -Ve -a8 \
+ -k- -vi -c -b- -w-par -w-inl -Vx -tWM -D$(SYSDEFINES);$(USERDEFINES)
+PFLAGS = -U$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \
+ -I$(BCB)\include;$(BCB)\include\vcl -$Y- -$L- -$D- -v -JPHNE -M
+RFLAGS = -i$(BCB)\include;$(BCB)\include\vcl
+AFLAGS = /i$(BCB)\include /i$(BCB)\include\vcl /mx /w2 /zn
+LFLAGS = -L$(BCB)\Projects\Lib;$(BCB)\lib\obj;$(BCB)\lib;$(RELEASELIBPATH) \
+ -D"FastScript 1.9 Tee Components" -aa -Tpp -x -Gn -Gl -Gi
+# ---------------------------------------------------------------------------
+ALLOBJ = c0pkg32.obj Memmgr.Lib $(PACKAGES) sysinit.obj $(OBJFILES)
+ALLRES = $(RESFILES)
+ALLLIB = $(LIBFILES) $(LIBRARIES) import32.lib cp32mti.lib
+# ---------------------------------------------------------------------------
+!ifdef IDEOPTIONS
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=0
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=1
+Item0=$(BCB)\include;$(BCB)\include\vcl
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteDebug=0
+
+[Compiler]
+InMemoryExe=0
+ShowInfoMsgs=0
+
+!endif
+
+# ---------------------------------------------------------------------------
+# MAKE SECTION
+# ---------------------------------------------------------------------------
+# This section of the project file is not used by the BCB IDE. It is for
+# the benefit of building from the command-line using the MAKE utility.
+# ---------------------------------------------------------------------------
+
+.autodepend
+# ---------------------------------------------------------------------------
+!if !$d(BCC32)
+BCC32 = bcc32
+!endif
+
+!if !$d(CPP32)
+CPP32 = cpp32
+!endif
+
+!if !$d(DCC32)
+DCC32 = dcc32
+!endif
+
+!if !$d(TASM32)
+TASM32 = tasm32
+!endif
+
+!if !$d(LINKER)
+LINKER = ilink32
+!endif
+
+!if !$d(BRCC32)
+BRCC32 = brcc32
+!endif
+
+# ---------------------------------------------------------------------------
+!if $d(PATHCPP)
+.PATH.CPP = $(PATHCPP)
+.PATH.C = $(PATHCPP)
+!endif
+
+!if $d(PATHPAS)
+.PATH.PAS = $(PATHPAS)
+!endif
+
+!if $d(PATHASM)
+.PATH.ASM = $(PATHASM)
+!endif
+
+!if $d(PATHRC)
+.PATH.RC = $(PATHRC)
+!endif
+# ---------------------------------------------------------------------------
+$(PROJECT): $(OBJFILES) $(RESDEPEN) $(DEFFILE)
+ $(BCB)\BIN\$(LINKER) @&&!
+ $(LFLAGS) +
+ $(ALLOBJ), +
+ $(PROJECT),, +
+ $(ALLLIB), +
+ $(DEFFILE), +
+ $(ALLRES)
+!
+# ---------------------------------------------------------------------------
+.pas.hpp:
+ $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< }
+
+.pas.obj:
+ $(BCB)\BIN\$(DCC32) $(PFLAGS) {$< }
+
+.cpp.obj:
+ $(BCB)\BIN\$(BCC32) $(CFLAG1) -n$(@D) {$< }
+
+.c.obj:
+ $(BCB)\BIN\$(BCC32) $(CFLAG1) -n$(@D) {$< }
+
+.c.i:
+ $(BCB)\BIN\$(CPP32) $(CFLAG1) -n. {$< }
+
+.cpp.i:
+ $(BCB)\BIN\$(CPP32) $(CFLAG1) -n. {$< }
+
+.asm.obj:
+ $(BCB)\BIN\$(TASM32) $(AFLAGS) $<, $@
+
+.rc.res:
+ $(BCB)\BIN\$(BRCC32) $(RFLAGS) -fo$@ $<
+# ---------------------------------------------------------------------------
diff --git a/LibD28/fsTee4.cpp b/LibD28/fsTee4.cpp
new file mode 100644
index 0000000..d5452c2
--- /dev/null
+++ b/LibD28/fsTee4.cpp
@@ -0,0 +1,21 @@
+//---------------------------------------------------------------------------
+#include
+#pragma hdrstop
+USERES("FS4.res");
+USEPACKAGE("vcl40.bpi");
+USEPACKAGE("vclx40.bpi");
+USEPACKAGE("tee40.bpi");
+USEPACKAGE("fs4.bpi");
+USEUNIT("fs_iteeReg.pas");
+USEUNIT("fs_ichartrtti.pas");
+USERES("fs_iReg.dcr");
+//---------------------------------------------------------------------------
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+// Package source.
+//---------------------------------------------------------------------------
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
diff --git a/LibD28/fsTee4.dpk b/LibD28/fsTee4.dpk
new file mode 100644
index 0000000..f8aefa8
--- /dev/null
+++ b/LibD28/fsTee4.dpk
@@ -0,0 +1,48 @@
+// Package file for Delphi 4
+
+package fsTee4;
+
+{$I fs.inc}
+{$I tee.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL40,
+{$IFDEF TeeChartStd} TEE40, {$ENDIF}
+{$IFDEF TeeChart4} TEE44, {$ENDIF}
+{$IFDEF TeeChart5} TEE54, {$ENDIF}
+{$IFDEF TeeChart6} TEE64, {$ENDIF}
+{$IFDEF TeeChart7} TEE74, {$ENDIF}
+{$IFDEF TeeChart8} TEE84, {$ENDIF}
+ VCLX40,
+ fs4;
+
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+
+end.
diff --git a/LibD28/fsTee5.bpk b/LibD28/fsTee5.bpk
new file mode 100644
index 0000000..8e87a0e
--- /dev/null
+++ b/LibD28/fsTee5.bpk
@@ -0,0 +1,108 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=9
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[HistoryLists\hlIncludePath]
+Count=1
+Item0=$(BCB)\include;$(BCB)\include\vcl
+
+[HistoryLists\hlLibraryPath]
+Count=1
+Item0=$(BCB)\lib\obj;$(BCB)\lib
+
+[HistoryLists\hlDebugSourcePath]
+Count=1
+Item0=$(BCB)\source\vcl
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Language]
+ActiveLang=
+ProjectLang=
+RootDir=
+
+
\ No newline at end of file
diff --git a/LibD28/fsTee5.cpp b/LibD28/fsTee5.cpp
new file mode 100644
index 0000000..f6b90b6
--- /dev/null
+++ b/LibD28/fsTee5.cpp
@@ -0,0 +1,25 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+USERES("FS5.res");
+USEPACKAGE("vcl50.bpi");
+USEPACKAGE("vclx50.bpi");
+USEPACKAGE("tee50.bpi");
+USEPACKAGE("fs5.bpi");
+USEUNIT("fs_iteereg.pas");
+USEUNIT("fs_ichartrtti.pas");
+USERES("fs_iReg.dcr");
+//---------------------------------------------------------------------------
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
diff --git a/LibD28/fsTee5.dpk b/LibD28/fsTee5.dpk
new file mode 100644
index 0000000..f43c9d4
--- /dev/null
+++ b/LibD28/fsTee5.dpk
@@ -0,0 +1,48 @@
+// Package file for Delphi 5
+
+package fsTee5;
+
+{$I fs.inc}
+{$I tee.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL50,
+{$IFDEF TeeChartStd} TEE50, {$ENDIF}
+{$IFDEF TeeChart4} TEE45, {$ENDIF}
+{$IFDEF TeeChart5} TEE55, {$ENDIF}
+{$IFDEF TeeChart6} TEE65, {$ENDIF}
+{$IFDEF TeeChart7} TEE75, {$ENDIF}
+{$IFDEF TeeChart8} TEE85, {$ENDIF}
+ VCLX50,
+ fs5;
+
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+
+end.
diff --git a/LibD28/fsTee6.bpk b/LibD28/fsTee6.bpk
new file mode 100644
index 0000000..30ca49c
--- /dev/null
+++ b/LibD28/fsTee6.bpk
@@ -0,0 +1,124 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+[Version Info]
+IncludeVerInfo=1
+AutoIncBuild=0
+MajorVer=1
+MinorVer=9
+Release=0
+Build=0
+Debug=0
+PreRelease=0
+Special=0
+Private=0
+DLL=0
+Locale=1049
+CodePage=1251
+
+[Version Info Keys]
+CompanyName=
+FileDescription=
+FileVersion=1.0.0.0
+InternalName=
+LegalCopyright=
+LegalTrademarks=
+OriginalFilename=
+ProductName=
+ProductVersion=1.0.0.0
+Comments=
+
+[Excluded Packages]
+d:\delphi\builder6\Projects\Bpl\FR6.bpl=FastReport 2.4 Components
+
+[Debugging]
+DebugSourceDirs=$(BCB)\source\vcl
+
+[Parameters]
+RunParams=
+Launcher=
+UseLauncher=0
+DebugCWD=
+HostApplication=
+RemoteHost=
+RemotePath=
+RemoteLauncher=
+RemoteCWD=
+RemoteDebug=0
+
+[Compiler]
+ShowInfoMsgs=0
+LinkDebugVcl=0
+LinkCGLIB=0
+
+[CORBA]
+AddServerUnit=1
+AddClientUnit=1
+PrecompiledHeaders=1
+
+[Linker]
+LibPrefix=
+LibSuffix=
+LibVersion=
+
+
\ No newline at end of file
diff --git a/LibD28/fsTee6.cpp b/LibD28/fsTee6.cpp
new file mode 100644
index 0000000..f8b9781
--- /dev/null
+++ b/LibD28/fsTee6.cpp
@@ -0,0 +1,17 @@
+//---------------------------------------------------------------------------
+
+#include
+#pragma hdrstop
+#pragma package(smart_init)
+//---------------------------------------------------------------------------
+
+// Package source.
+//---------------------------------------------------------------------------
+
+#pragma argsused
+int WINAPI DllEntryPoint(HINSTANCE hinst, unsigned long reason, void*)
+{
+ return 1;
+}
+//---------------------------------------------------------------------------
+
\ No newline at end of file
diff --git a/LibD28/fsTee6.dpk b/LibD28/fsTee6.dpk
new file mode 100644
index 0000000..de14ea5
--- /dev/null
+++ b/LibD28/fsTee6.dpk
@@ -0,0 +1,48 @@
+// Package file for Delphi 6
+
+package fsTee6;
+
+{$I fs.inc}
+{$I tee.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChart4} TEE46, {$ENDIF}
+{$IFDEF TeeChart5} TEE56, {$ENDIF}
+{$IFDEF TeeChart6} TEE66, {$ENDIF}
+{$IFDEF TeeChart7} TEE76, {$ENDIF}
+{$IFDEF TeeChart8} TEE86, {$ENDIF}
+ VCLX,
+ fs6;
+
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+
+end.
diff --git a/LibD28/fsTee7.dpk b/LibD28/fsTee7.dpk
new file mode 100644
index 0000000..22108f0
--- /dev/null
+++ b/LibD28/fsTee7.dpk
@@ -0,0 +1,52 @@
+// Package file for Delphi 7
+
+package fsTee7;
+
+{$I fs.inc}
+{$I tee.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE77, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE87, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE97, {$ENDIF}
+{$IFDEF TeeChart4} TEE47, {$ENDIF}
+{$IFDEF TeeChart5} TEE57, {$ENDIF}
+{$IFDEF TeeChart6} TEE67, {$ENDIF}
+{$IFDEF TeeChart7} TEE77, {$ENDIF}
+{$IFDEF TeeChart8} TEE87, {$ENDIF}
+{$IFDEF TeeChart9} TEE97, {$ENDIF}
+ VCLX,
+ fs7;
+
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+
+end.
diff --git a/LibD28/fsTee9.dpk b/LibD28/fsTee9.dpk
new file mode 100644
index 0000000..cdd566b
--- /dev/null
+++ b/LibD28/fsTee9.dpk
@@ -0,0 +1,52 @@
+// Package file for Delphi 2005
+
+package fsTee9;
+
+{$I fs.inc}
+{$I tee.inc}
+
+{$ALIGN ON}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $00400000}
+{$RUNONLY}
+{$IMPLICITBUILD OFF}
+
+requires
+ VCL,
+{$IFDEF TeeChartStd} TEE, {$ENDIF}
+{$IFDEF TeeChartStd7}TEE79, {$ENDIF}
+{$IFDEF TeeChartStd8}TEE89, {$ENDIF}
+{$IFDEF TeeChartStd9}TEE99, {$ENDIF}
+{$IFDEF TeeChart4} TEE49, {$ENDIF}
+{$IFDEF TeeChart5} TEE59, {$ENDIF}
+{$IFDEF TeeChart6} TEE69, {$ENDIF}
+{$IFDEF TeeChart7} TEE79, {$ENDIF}
+{$IFDEF TeeChart8} TEE89, {$ENDIF}
+{$IFDEF TeeChart9} TEE99, {$ENDIF}
+ VCLX,
+ fs9;
+
+
+contains
+ fs_ichartrtti in 'fs_ichartrtti.pas';
+
+
+end.
diff --git a/LibD28/fs_iadoreg.pas b/LibD28/fs_iadoreg.pas
new file mode 100644
index 0000000..0c77572
--- /dev/null
+++ b/LibD28/fs_iadoreg.pas
@@ -0,0 +1,45 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_iadoreg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ Classes
+{$IFNDEF Delphi6}
+, DsgnIntf
+{$ELSE}
+, DesignIntf
+{$ENDIF}
+{$IFDEF DELPHI16}
+, Controls
+{$ENDIF}
+, fs_iadortti;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+{$IFDEF DELPHI16}
+ //GroupDescendentsWith(TfsADORTTI, TControl);
+{$ENDIF}
+ RegisterComponents('FastScript', [TfsADORTTI]);
+end;
+
+end.
diff --git a/LibD28/fs_iadortti.pas b/LibD28/fs_iadortti.pas
new file mode 100644
index 0000000..ac053e4
--- /dev/null
+++ b/LibD28/fs_iadortti.pas
@@ -0,0 +1,135 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ ADO classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_iadortti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, fs_itools, fs_idbrtti,
+ {$IFDEF DELPHI16}Controls, System.Types,
+ Data.DB, Data.Win.ADODB, Winapi.ADOInt;
+ {$ELSE}
+ DB, ADODB, ADOInt;
+ {$ENDIF}
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsADORTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddType('TDataType', fvtInt);
+ AddClass(TADOConnection, 'TComponent');
+ AddClass(TParameter, 'TCollectionItem');
+ with AddClass(TParameters, 'TCollection') do
+ begin
+ AddMethod('function AddParameter: TParameter', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TParameter', CallMethod, True);
+ end;
+ with AddClass(TCustomADODataSet, 'TDataSet') do
+ begin
+ AddProperty('Sort', 'WideString', GetProp, SetProp);
+ end;
+ AddClass(TADOTable, 'TCustomADODataSet');
+ with AddClass(TADOQuery, 'TCustomADODataSet') do
+ AddMethod('procedure ExecSQL', CallMethod);
+ with AddClass(TADOStoredProc, 'TCustomADODataSet') do
+ AddMethod('procedure ExecProc', CallMethod);
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TParameters then
+ begin
+ if MethodName = 'ADDPARAMETER' then
+ Result := frxInteger(TParameters(Instance).AddParameter)
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TParameters(Instance).Items[Caller.Params[0]])
+ end
+ else if ClassType = TADOQuery then
+ begin
+ if MethodName = 'EXECSQL' then
+ TADOQuery(Instance).ExecSQL
+ end
+ else if ClassType = TADOStoredProc then
+ begin
+ if MethodName = 'EXECPROC' then
+ TADOStoredProc(Instance).ExecProc
+ end
+end;
+
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TCustomADODataSet then
+ begin
+ if PropName = 'SORT' then
+ Result := TCustomADODataSet(Instance).Sort;
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+
+ if ClassType = TCustomADODataSet then
+ begin
+ if PropName = 'SORT' then
+ TCustomADODataSet(Instance).Sort := Value;
+ end
+
+end;
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsADORTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
+
diff --git a/LibD28/fs_ibasic.pas b/LibD28/fs_ibasic.pas
new file mode 100644
index 0000000..9ba0755
--- /dev/null
+++ b/LibD28/fs_ibasic.pas
@@ -0,0 +1,193 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Basic grammar }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_ibasic;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_itools{$IFDEF DELPHI16}, Controls{$ENDIF};
+{$ELSE}
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_itools, FMX.Types;
+{$ENDIF}
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsBasic = class(TComponent);
+
+
+implementation
+
+const
+ BASIC_GRAMMAR =
+ '' +
+ '<' +
+ '/keywords>' +
+ '<' +
+ 'string add="file" err="err1"/><' +
+ 'char text="(" add="op"/><' +
+ '/sequence>' +
+ '' +
+ '<' +
+ 'keyword text="OR" add="op" addtext="or"/><' +
+ 'char text="[" add="node"/>' +
+ '<' +
+ 'sequence><' +
+ '/sequence><' +
+ 'caseselector/><' +
+ 'optional>' +
+ '<' +
+ 'keyword text="FINALLY"/>';
+
+
+initialization
+{$IFDEF DELPHI16}
+{$IFDEF FMX}
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsBasic, TFmxObject);
+{$ELSE}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsBasic, TControl);
+{$ENDIF}
+{$ENDIF}
+ fsRegisterLanguage('BasicScript', BASIC_GRAMMAR);
+
+end.
diff --git a/LibD28/fs_ibdereg.pas b/LibD28/fs_ibdereg.pas
new file mode 100644
index 0000000..fa884ea
--- /dev/null
+++ b/LibD28/fs_ibdereg.pas
@@ -0,0 +1,45 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_ibdereg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ Classes
+{$IFNDEF Delphi6}
+, DsgnIntf
+{$ELSE}
+, DesignIntf
+{$ENDIF}
+{$IFDEF DELPHI16}
+, Controls
+{$ENDIF}
+, fs_ibdertti;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+{$IFDEF DELPHI16}
+ //GroupDescendentsWith(TfsBDERTTI, TControl);
+{$ENDIF}
+ RegisterComponents('FastScript', [TfsBDERTTI]);
+end;
+
+end.
diff --git a/LibD28/fs_ibdertti.pas b/LibD28/fs_ibdertti.pas
new file mode 100644
index 0000000..159e7e9
--- /dev/null
+++ b/LibD28/fs_ibdertti.pas
@@ -0,0 +1,171 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ BDE classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_ibdertti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, fs_itools, fs_idbrtti,
+ DB, DBTables
+ {$IFDEF DELPHI16}, Controls, System.Types{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsBDERTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TTableType', 'ttDefault, ttParadox, ttDBase, ttFoxPro, ttASCII');
+ AddEnum('TParamBindMode', 'pbByName, pbByNumber');
+
+ AddClass(TSession, 'TComponent');
+ AddClass(TDatabase, 'TComponent');
+ AddClass(TBDEDataSet, 'TDataSet');
+ AddClass(TDBDataSet, 'TBDEDataSet');
+ with AddClass(TTable, 'TDBDataSet') do
+ begin
+ AddMethod('procedure CreateTable', CallMethod);
+ AddMethod('procedure DeleteTable', CallMethod);
+ AddMethod('procedure EmptyTable', CallMethod);
+ AddMethod('function FindKey(const KeyValues: array): Boolean', CallMethod);
+ AddMethod('procedure FindNearest(const KeyValues: array)', CallMethod);
+ AddMethod('procedure RenameTable(const NewTableName: string)', CallMethod);
+ end;
+ with AddClass(TQuery, 'TDBDataSet') do
+ begin
+ AddMethod('procedure ExecSQL', CallMethod);
+ AddMethod('function ParamByName(const Value: string): TParam', CallMethod);
+ AddMethod('procedure Prepare', CallMethod);
+ AddProperty('ParamCount', 'Word', GetProp, nil);
+ end;
+ with AddClass(TStoredProc, 'TDBDataSet') do
+ begin
+ AddMethod('procedure ExecProc', CallMethod);
+ AddMethod('function ParamByName(const Value: string): TParam', CallMethod);
+ AddMethod('procedure Prepare', CallMethod);
+ AddProperty('ParamCount', 'Word', GetProp, nil);
+ end;
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function DoFindKey: Boolean;
+ var
+ ar: TVarRecArray;
+ sPtrList: TList;
+ begin
+ VariantToVarRec(Caller.Params[0], ar, sPtrList);
+ Result := TTable(Instance).FindKey(ar);
+ ClearVarRec(ar, sPtrList);
+ end;
+
+ procedure DoFindNearest;
+ var
+ ar: TVarRecArray;
+ sPtrList: TList;
+ begin
+ VariantToVarRec(Caller.Params[0], ar, sPtrList);
+ TTable(Instance).FindNearest(ar);
+ ClearVarRec(ar, sPtrList);
+ end;
+
+begin
+ Result := 0;
+
+ if ClassType = TTable then
+ begin
+ if MethodName = 'CREATETABLE' then
+ TTable(Instance).CreateTable
+ else if MethodName = 'DELETETABLE' then
+ TTable(Instance).DeleteTable
+ else if MethodName = 'EMPTYTABLE' then
+ TTable(Instance).EmptyTable
+ else if MethodName = 'FINDKEY' then
+ Result := DoFindKey
+ else if MethodName = 'FINDNEAREST' then
+ DoFindNearest
+ else if MethodName = 'RENAMETABLE' then
+ TTable(Instance).RenameTable(Caller.Params[0])
+ end
+ else if ClassType = TQuery then
+ begin
+ if MethodName = 'EXECSQL' then
+ TQuery(Instance).ExecSQL
+ else if MethodName = 'PARAMBYNAME' then
+ Result := frxInteger(TQuery(Instance).ParamByName(Caller.Params[0]))
+ else if MethodName = 'PREPARE' then
+ TQuery(Instance).Prepare
+ end
+ else if ClassType = TStoredProc then
+ begin
+ if MethodName = 'EXECPROC' then
+ TStoredProc(Instance).ExecProc
+ else if MethodName = 'PARAMBYNAME' then
+ Result := frxInteger(TStoredProc(Instance).ParamByName(Caller.Params[0]))
+ else if MethodName = 'PREPARE' then
+ TStoredProc(Instance).Prepare
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TQuery then
+ begin
+ if PropName = 'PARAMCOUNT' then
+ Result := TQuery(Instance).ParamCount
+ end
+ else if ClassType = TStoredProc then
+ begin
+ if PropName = 'PARAMCOUNT' then
+ Result := TStoredProc(Instance).ParamCount
+ end
+end;
+
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsBDERTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/fs_ibx.lpk b/LibD28/fs_ibx.lpk
new file mode 100644
index 0000000..d714535
--- /dev/null
+++ b/LibD28/fs_ibx.lpk
@@ -0,0 +1,49 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/LibD28/fs_ichartrtti.pas b/LibD28/fs_ichartrtti.pas
new file mode 100644
index 0000000..c01b22f
--- /dev/null
+++ b/LibD28/fs_ichartrtti.pas
@@ -0,0 +1,195 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Chart }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_ichartrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, fs_itools, fs_iformsrtti
+{$IFDEF DELPHI16}
+ , VCLTee.Chart, VCLTee.Series, VCLTee.TeEngine, VCLTee.TeeProcs, VCLTee.TeCanvas, VCLTee.ArrowCha
+{$ELSE}
+ , Chart, Series, TeEngine, TeeProcs, TeCanvas, ArrowCha
+{$ENDIF}
+{$IFDEF Delphi16}
+ , System.Types
+{$ENDIF}
+{$IFDEF DELPHI16}, Controls{$ENDIF};
+
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsChartRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddType('TChartValue', fvtFloat);
+ AddEnum('TLegendStyle', 'lsAuto, lsSeries, lsValues, lsLastValues');
+ AddEnum('TLegendAlignment', 'laLeft, laRight, laTop, laBottom');
+ AddEnum('TLegendTextStyle', 'ltsPlain, ltsLeftValue, ltsRightValue, ltsLeftPercent,' +
+ 'ltsRightPercent, ltsXValue');
+ AddEnum('TChartListOrder', 'loNone, loAscending, loDescending');
+ AddEnum('TGradientDirection', 'gdTopBottom, gdBottomTop, gdLeftRight, gdRightLeft');
+ AddEnum('TSeriesMarksStyle', 'smsValue, smsPercent, smsLabel, smsLabelPercent, ' +
+ 'smsLabelValue, smsLegend, smsPercentTotal, smsLabelPercentTotal, smsXValue');
+ AddEnum('TAxisLabelStyle', 'talAuto, talNone, talValue, talMark, talText');
+ AddEnum('THorizAxis', 'aTopAxis, aBottomAxis');
+ AddEnum('TVertAxis', 'aLeftAxis, aRightAxis');
+ AddEnum('TTeeBackImageMode', 'pbmStretch, pbmTile, pbmCenter');
+ AddEnum('TPanningMode', 'pmNone, pmHorizontal, pmVertical, pmBoth');
+ AddEnum('TSeriesPointerStyle', 'psRectangle, psCircle, psTriangle, ' +
+ 'psDownTriangle, psCross, psDiagCross, psStar, psDiamond, psSmallDot');
+ AddEnum('TMultiArea', 'maNone, maStacked, maStacked100');
+ AddEnum('TMultiBar', 'mbNone, mbSide, mbStacked, mbStacked100');
+ AddEnum('TBarStyle', 'bsRectangle, bsPyramid, bsInvPyramid, bsCilinder, ' +
+ 'bsEllipse, bsArrow, bsRectGradient');
+
+ AddEnum('TPenEndStyle', 'esRound, esSquare, esFlat');
+ AddEnum('TPenMode', 'pmBlack, pmWhite, pmNop, pmNot, pmCopy, pmNotCopy, ' +
+ 'pmMergePenNot, pmMaskPenNot, pmMergeNotPen, pmMaskNotPen, pmMerge, ' +
+ 'pmNotMerge, pmMask, pmNotMask, pmXor, pmNotXor');
+ AddEnum('TPenStyle', 'psSolid, psDash, psDot, psDashDot, psDashDotDot, psClear, psInsideFrame');
+ AddClass(TChartValueList, 'TPersistent');
+ AddClass(TChartAxisTitle, 'TPersistent');
+ AddClass(TChartAxis, 'TPersistent');
+ AddClass(TCustomChartLegend, 'TPersistent');
+ AddClass(TChartLegend, 'TCustomChartLegend');
+ AddClass(TSeriesMarks, 'TPersistent');
+ AddClass(TChartGradient, 'TPersistent');
+ AddClass(TChartWall, 'TPersistent');
+ AddClass(TChartBrush, 'TBrush');
+ AddClass(TChartTitle, 'TPersistent');
+ AddClass(TView3DOptions, 'TPersistent');
+ AddClass(TChartPen, 'TComponent');
+ with AddClass(TChartSeries, 'TComponent') do
+ begin
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure Delete(Index: Integer)', CallMethod);
+ AddMethod('function Count: Integer', CallMethod);
+ AddMethod('procedure Add(const AValue: Double; const ALabel: String; AColor: TColor)', CallMethod);
+ AddProperty('Active','Boolean', GetProp, SetProp);
+ end;
+ AddClass(TSeriesPointer, 'TPersistent');
+ AddClass(TCustomSeries, 'TChartSeries');
+ AddClass(TLineSeries, 'TCustomSeries');
+ AddClass(TPointSeries, 'TCustomSeries');
+ AddClass(TAreaSeries, 'TCustomSeries');
+ AddClass(TArrowSeries, 'TCustomSeries');
+ with AddClass(TCustomBarSeries, 'TChartSeries') do
+ begin
+ AddProperty('Title','String', GetProp, SetProp);
+ end;
+ AddClass(TBarSeries, 'TCustomBarSeries');
+ AddClass(THorizBarSeries, 'TCustomBarSeries');
+ AddClass(TCircledSeries, 'TChartSeries');
+ AddClass(TPieSeries, 'TCircledSeries');
+ AddClass(TFastLineSeries, 'TChartSeries');
+ AddClass(TCustomChart, 'TWinControl');
+ AddClass(TChart, 'TCustomChart');
+{$IFDEF DELPHI19}
+ AddClass(TSeriesPointerItems, 'TSeriesPointerItems');
+{$ENDIF}
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TChartSeries then
+ begin
+ if MethodName = 'CLEAR' then
+ TChartSeries(Instance).Clear
+ else if MethodName = 'ADD' then
+ TChartSeries(Instance).Add(Caller.Params[0], String(Caller.Params[1]), Caller.Params[2])
+ else if MethodName = 'DELETE' then
+ TChartSeries(Instance).Delete(Caller.Params[0])
+ else if MethodName = 'COUNT' then
+ Result := TChartSeries(Instance).Count
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TChartSeries then
+ begin
+ if PropName = 'ACTIVE' then
+ Result := TChartSeries(Instance).Active
+ end else
+ if ClassType = TCustomBarSeries then
+ begin
+ if PropName = 'Title' then
+ Result := TCustomBarSeries(Instance).Title
+ end;
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TChartSeries then
+ begin
+ if PropName = 'ACTIVE' then
+ TChartSeries(Instance).Active := Value
+ end else
+ if ClassType = TCustomBarSeries then
+ begin
+ if PropName = 'Title' then
+ TCustomBarSeries(Instance).Title := Value
+ end
+end;
+
+initialization
+{$IFDEF DELPHI16}
+{$IFDEF FMX}
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsChartRTTI, TFmxObject);
+{$ELSE}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsChartRTTI, TControl);
+{$ENDIF}
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/fs_iclassesrtti.pas b/LibD28/fs_iclassesrtti.pas
new file mode 100644
index 0000000..a102022
--- /dev/null
+++ b/LibD28/fs_iclassesrtti.pas
@@ -0,0 +1,1052 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Classes.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_iclassesrtti;
+
+interface
+
+{$i fs.inc}
+
+uses SysUtils, Classes, fs_iinterpreter, fs_xml{$IFDEF DELPHI16}, Controls{$ENDIF}
+{$IFDEF Delphi16}
+ , System.Types
+{$ENDIF};
+//FMX USES
+{$ELSE}
+interface
+
+{$i fs.inc}
+
+uses System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_xml, System.Types, FMX.Types, System.UITypes
+{$IFDEF DELPHI20}
+ ,System.Math.Vectors
+{$ENDIF};
+{$ENDIF}
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsClassesRTTI = class(TComponent); // fake component
+{$IFDEF FMX}
+{ wrappers for most using structures }
+ TfsRectF = class(TPersistent)
+ private
+ FRectF: TRectF;
+ function GetBottom: Single;
+ function GetLeft: Single;
+ function GetRight: Single;
+ function GetTop: Single;
+ procedure SetBottom(const Value: Single);
+ procedure SetLeft(const Value: Single);
+ procedure SetRight(const Value: Single);
+ procedure SetTop(const Value: Single);
+ public
+ function GetRect: TRectF;
+ function GetRectP: PRectF;
+ constructor Create(aRectF: TRectF);
+ published
+ property Left: Single read GetLeft write SetLeft;
+ property Top: Single read GetTop write SetTop;
+ property Right: Single read GetRight write SetRight;
+ property Bottom: Single read GetBottom write SetBottom;
+ end;
+
+ TfsMatrix = class(TPersistent)
+ private
+ FMatrix: TMatrix;
+ function Getm11: Single;
+ function Getm12: Single;
+ function Getm13: Single;
+ function Getm21: Single;
+ function Getm22: Single;
+ function Getm23: Single;
+ function Getm31: Single;
+ function Getm32: Single;
+ function Getm33: Single;
+ procedure Setm11(const Value: Single);
+ procedure Setm12(const Value: Single);
+ procedure Setm13(const Value: Single);
+ procedure Setm21(const Value: Single);
+ procedure Setm22(const Value: Single);
+ procedure Setm23(const Value: Single);
+ procedure Setm31(const Value: Single);
+ procedure Setm32(const Value: Single);
+ procedure Setm33(const Value: Single);
+ public
+ procedure AssignToRect(var Rect: TMatrix);
+ procedure AssignFromRect(Rect: TMatrix);
+ function GetRect: TMatrix;
+ constructor Create(aMatrix: TMatrix);
+ published
+ property m11: Single read Getm11 write Setm11;
+ property m12: Single read Getm12 write Setm12;
+ property m13: Single read Getm13 write Setm13;
+ property m21: Single read Getm21 write Setm21;
+ property m22: Single read Getm22 write Setm22;
+ property m23: Single read Getm23 write Setm23;
+ property m31: Single read Getm31 write Setm31;
+ property m32: Single read Getm32 write Setm32;
+ property m33: Single read Getm33 write Setm33;
+ end;
+
+ TfsPointF = class(TPersistent)
+ private
+ FPointF: TPointF;
+ function GetX: Single;
+ function GetY: Single;
+ procedure SetX(const Value: Single);
+ procedure SetY(const Value: Single);
+ public
+ function GetRect: TPointF;
+ function GetRectP: PPointF;
+ constructor Create(aPointF: TPointF);
+ published
+ property pX: Single read GetX write SetX;
+ property pY: Single read GetY write SetY;
+ end;
+
+ PVector = ^TVector;
+ TfsVector = class(TPersistent)
+ private
+ FVector: TVector;
+ function GetW: Single;
+ function GetX: Single;
+ function GetY: Single;
+ procedure SetW(const Value: Single);
+ procedure SetX(const Value: Single);
+ procedure SetY(const Value: Single);
+ public
+ function GetRect: TVector;
+ function GetRectP: PVector;
+ constructor Create(aVector: TVector);
+ published
+ property pX: Single read GetX write SetX;
+ property pY: Single read GetY write SetY;
+ property pW: Single read GetW write SetW;
+ end;
+{$ENDIF}
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+{$IFDEF FMX}
+{ TFrxRectF }
+
+constructor TfsRectF.Create(aRectF: TRectF);
+begin
+ FRectF.Left := aRectF.Left;
+ FRectF.Top := aRectF.Top;
+ FRectF.Right := aRectF.Right;
+ FRectF.Bottom := aRectF.Bottom;
+end;
+
+function TfsRectF.GetBottom: Single;
+begin
+ Result := FRectF.Bottom;
+end;
+
+function TfsRectF.GetLeft: Single;
+begin
+ Result := FRectF.Left;
+end;
+
+function TfsRectF.GetRect: TRectF;
+begin
+ Result := FRectF;
+end;
+
+function TfsRectF.GetRectP: PRectF;
+begin
+ Result := @FRectF;
+end;
+
+function TfsRectF.GetRight: Single;
+begin
+ Result := FRectF.Right;
+end;
+
+function TfsRectF.GetTop: Single;
+begin
+ Result := FRectF.Top;
+end;
+
+procedure TfsRectF.SetBottom(const Value: Single);
+begin
+ FRectF.Bottom := Value;
+end;
+
+procedure TfsRectF.SetLeft(const Value: Single);
+begin
+ FRectF.Left := Value;
+end;
+
+procedure TfsRectF.SetRight(const Value: Single);
+begin
+ FRectF.Right := Value;
+end;
+
+procedure TfsRectF.SetTop(const Value: Single);
+begin
+ FRectF.Top := Value;
+end;
+
+{ TfsMatrix }
+
+procedure TfsMatrix.AssignFromRect(Rect: TMatrix);
+begin
+
+end;
+
+procedure TfsMatrix.AssignToRect(var Rect: TMatrix);
+begin
+
+end;
+
+constructor TfsMatrix.Create(aMatrix: TMatrix);
+begin
+ FMatrix.m11 := aMatrix.m11;
+ FMatrix.m12 := aMatrix.m12;
+ FMatrix.m13 := aMatrix.m13;
+ FMatrix.m21 := aMatrix.m21;
+ FMatrix.m22 := aMatrix.m22;
+ FMatrix.m23 := aMatrix.m23;
+ FMatrix.m31 := aMatrix.m31;
+ FMatrix.m32 := aMatrix.m32;
+ FMatrix.m33 := aMatrix.m33;
+end;
+
+function TfsMatrix.Getm11: Single;
+begin
+ Result := FMatrix.m11;
+end;
+
+function TfsMatrix.Getm12: Single;
+begin
+ Result := FMatrix.m12;
+end;
+
+function TfsMatrix.Getm13: Single;
+begin
+ Result := FMatrix.m13;
+end;
+
+function TfsMatrix.Getm21: Single;
+begin
+ Result := FMatrix.m21;
+end;
+
+function TfsMatrix.Getm22: Single;
+begin
+ Result := FMatrix.m22;
+end;
+
+function TfsMatrix.Getm23: Single;
+begin
+ Result := FMatrix.m23;
+end;
+
+function TfsMatrix.Getm31: Single;
+begin
+ Result := FMatrix.m31;
+end;
+
+function TfsMatrix.Getm32: Single;
+begin
+ Result := FMatrix.m32;
+end;
+
+function TfsMatrix.Getm33: Single;
+begin
+ Result := FMatrix.m33;
+end;
+
+function TfsMatrix.GetRect: TMatrix;
+begin
+ Result := FMatrix;
+end;
+
+procedure TfsMatrix.Setm11(const Value: Single);
+begin
+ FMatrix.m11 := Value;
+end;
+
+procedure TfsMatrix.Setm12(const Value: Single);
+begin
+ FMatrix.m12 := Value;
+end;
+
+procedure TfsMatrix.Setm13(const Value: Single);
+begin
+ FMatrix.m13 := Value;
+end;
+
+procedure TfsMatrix.Setm21(const Value: Single);
+begin
+ FMatrix.m21 := Value;
+end;
+
+procedure TfsMatrix.Setm22(const Value: Single);
+begin
+ FMatrix.m22 := Value;
+end;
+
+procedure TfsMatrix.Setm23(const Value: Single);
+begin
+ FMatrix.m23 := Value;
+end;
+
+procedure TfsMatrix.Setm31(const Value: Single);
+begin
+ FMatrix.m31 := Value;
+end;
+
+procedure TfsMatrix.Setm32(const Value: Single);
+begin
+ FMatrix.m32 := Value;
+end;
+
+procedure TfsMatrix.Setm33(const Value: Single);
+begin
+ FMatrix.m33 := Value;
+end;
+
+{ TfsPointF }
+
+constructor TfsPointF.Create(aPointF: TPointF);
+begin
+ FPointF.X := aPointF.X;
+ FPointF.Y := aPointF.Y;
+end;
+
+function TfsPointF.GetRect: TPointF;
+begin
+ Result := FPointF;
+end;
+
+function TfsPointF.GetRectP: PPointF;
+begin
+ Result := @FPointF;
+end;
+
+function TfsPointF.GetX: Single;
+begin
+ Result := FPointF.X;
+end;
+
+function TfsPointF.GetY: Single;
+begin
+ Result := FPointF.Y;
+end;
+
+procedure TfsPointF.SetX(const Value: Single);
+begin
+ FPointF.X := Value;
+end;
+
+procedure TfsPointF.SetY(const Value: Single);
+begin
+ FPointF.Y := Value;
+end;
+
+{ TfsVector }
+
+constructor TfsVector.Create(aVector: TVector);
+begin
+ FVector.X := aVector.X;
+ FVector.Y := aVector.Y;
+ FVector.W := aVector.W;
+end;
+
+function TfsVector.GetRect: TVector;
+begin
+ Result := FVector;
+end;
+
+function TfsVector.GetRectP: PVector;
+begin
+ Result := @FVector;
+end;
+
+function TfsVector.GetW: Single;
+begin
+ Result := FVector.W;
+end;
+
+function TfsVector.GetX: Single;
+begin
+ Result := FVector.X;
+end;
+
+function TfsVector.GetY: Single;
+begin
+ Result := FVector.Y;
+end;
+
+procedure TfsVector.SetW(const Value: Single);
+begin
+ FVector.W := Value;
+end;
+
+procedure TfsVector.SetX(const Value: Single);
+begin
+ FVector.X := Value;
+end;
+
+procedure TfsVector.SetY(const Value: Single);
+begin
+ FVector.Y := Value;
+end;
+
+{$ENDIF}
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddConst('fmCreate', 'Integer', fmCreate);
+ AddConst('fmOpenRead', 'Integer', fmOpenRead);
+ AddConst('fmOpenWrite', 'Integer', fmOpenWrite);
+ AddConst('fmOpenReadWrite', 'Integer', fmOpenReadWrite);
+ AddConst('fmShareExclusive', 'Integer', fmShareExclusive);
+ AddConst('fmShareDenyWrite', 'Integer', fmShareDenyWrite);
+ AddConst('fmShareDenyNone', 'Integer', fmShareDenyNone);
+ AddConst('soFromBeginning', 'Integer', soFromBeginning);
+ AddConst('soFromCurrent', 'Integer', soFromCurrent);
+ AddConst('soFromEnd', 'Integer', soFromEnd);
+ AddEnum('TDuplicates', 'dupIgnore, dupAccept, dupError');
+ AddEnum('TPrinterOrientation', 'poPortrait, poLandscape');
+
+ with AddClass(TObject, '') do
+ begin
+ AddConstructor('constructor Create', CallMethod);
+ AddMethod('procedure Free', CallMethod);
+ AddMethod('function ClassName: String', CallMethod);
+ end;
+ with AddClass(TPersistent, 'TObject') do
+ AddMethod('procedure Assign(Source: TPersistent)', CallMethod);
+ AddClass(TCollectionItem, 'TPersistent');
+ with AddClass(TCollection, 'TPersistent') do
+ begin
+ AddMethod('procedure Clear', CallMethod);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddDefaultProperty('Items', 'Integer', 'TCollectionItem', CallMethod, True);
+ end;
+ with AddClass(TList, 'TObject') do
+ begin
+ AddMethod('function Add(Item: TObject): Integer', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure Delete(Index: Integer)', CallMethod);
+ AddMethod('function IndexOf(Item: TObject): Integer', CallMethod);
+ AddMethod('procedure Insert(Index: Integer; Item: TObject)', CallMethod);
+ AddMethod('function Remove(Item: TObject): Integer', CallMethod);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddDefaultProperty('Items', 'Integer', 'TObject', CallMethod);
+ end;
+ with AddClass(TStrings, 'TPersistent') do
+ begin
+ AddConstructor('constructor Create', CallMethod);
+ AddMethod('function Add(const S: string): Integer', CallMethod);
+ AddMethod('function AddObject(const S: string; AObject: TObject): Integer', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure Delete(Index: Integer)', CallMethod);
+ AddMethod('function IndexOf(const S: string): Integer', CallMethod);
+ AddMethod('function IndexOfName(const Name: string): Integer', CallMethod);
+ AddMethod('function IndexOfObject(AObject: TObject): Integer', CallMethod);
+ AddMethod('procedure Insert(Index: Integer; const S: string)', CallMethod);
+ AddMethod('procedure InsertObject(Index: Integer; const S: string; AObject: TObject)', CallMethod);
+ AddMethod('procedure LoadFromFile(const FileName: string)', CallMethod);
+ AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure SaveToFile(const FileName: string)', CallMethod);
+ AddMethod('procedure Move(CurIndex, NewIndex: Integer)', CallMethod);
+ AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
+
+ AddProperty('CommaText', 'string', GetProp, SetProp);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddIndexProperty('Names', 'Integer', 'string', CallMethod, True);
+ AddIndexProperty('Objects', 'Integer', 'TObject', CallMethod);
+ AddIndexProperty('Values', 'String', 'string', CallMethod);
+ AddDefaultProperty('Strings', 'Integer', 'string', CallMethod);
+ AddProperty('Text', 'string', GetProp, SetProp);
+ end;
+ with AddClass(TStringList, 'TStrings') do
+ begin
+ AddMethod('function Find(s: String; var Index: Integer): Boolean', CallMethod);
+ AddMethod('procedure Sort', CallMethod);
+ AddProperty('Duplicates', 'TDuplicates', GetProp, SetProp);
+ AddProperty('Sorted', 'Boolean', GetProp, SetProp);
+ end;
+ with AddClass(TStream, 'TObject') do
+ begin
+ AddMethod('function Read(var Buffer: string; Count: Longint): Longint', CallMethod);
+ AddMethod('function Write(Buffer: string; Count: Longint): Longint', CallMethod);
+ AddMethod('function Seek(Offset: Longint; Origin: Word): Longint', CallMethod);
+ AddMethod('function CopyFrom(Source: TStream; Count: Longint): Longint', CallMethod);
+ AddProperty('Position', 'Longint', GetProp, SetProp);
+ AddProperty('Size', 'Longint', GetProp, nil);
+ end;
+ with AddClass(TFileStream, 'TStream') do
+ AddConstructor('constructor Create(Filename: String; Mode: Word)', CallMethod);
+ with AddClass(TMemoryStream, 'TStream') do
+ begin
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure LoadFromFile(Filename: String)', CallMethod);
+ AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure SaveToFile(Filename: String)', CallMethod);
+ end;
+ with AddClass(TComponent, 'TPersistent') do
+ begin
+ AddConstructor('constructor Create(AOwner: TComponent)', CallMethod);
+ AddProperty('Owner', 'TComponent', GetProp, nil);
+ end;
+{$IFDEF FMX}
+ AddClass(TfsRectF, 'TPersistent');
+ AddClass(TfsMatrix, 'TPersistent');
+ AddClass(TfsPointF, 'TPersistent');
+ AddClass(TfsVector, 'TPersistent');
+ with AddClass(TFmxObject, 'TComponent') do
+ begin
+ AddMethod('function Clone(AOwner: TComponent): TFmxObject', CallMethod);
+ AddMethod('procedure CloneChildFromStream(AStream: TStream)', CallMethod);
+ AddMethod('procedure AddObject(AObject: TFmxObject)', CallMethod);
+ AddMethod('procedure InsertObject(Index: Integer; AObject: TFmxObject)', CallMethod);
+ AddMethod('procedure RemoveObject(AObject: TFmxObject)', CallMethod);
+ AddMethod('procedure RemoveObject(Index: Integer)', CallMethod);
+ AddMethod('procedure Exchange(AObject1: TFmxObject; AObject2: TFmxObject)', CallMethod);
+ AddMethod('procedure DeleteChildren()', CallMethod);
+ AddMethod('procedure BringToFront()', CallMethod);
+ AddMethod('procedure SendToBack()', CallMethod);
+ AddMethod('procedure AddObjectsToList(AList: TList)', CallMethod);
+{$IFNDEF DELPHI18}
+ AddMethod('procedure AddControlsToList(AList: TList)', CallMethod);
+{$ENDIF}
+{$IFNDEF DELPHI20}
+ AddMethod('procedure GetTabOrderList(List: TList; AChildren: Boolean)', CallMethod);
+{$ENDIF}
+ AddMethod('procedure LoadFromStream(AStream: TStream)', CallMethod);
+ AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure LoadFromBinStream(AStream: TStream)', CallMethod);
+ AddMethod('procedure SaveToBinStream(AStream: TStream)', CallMethod);
+ AddMethod('function FindStyleResource(AStyleLookup: string): TFmxObject', CallMethod);
+{$IFNDEF DELPHI18}
+ AddMethod('procedure UpdateStyle()', CallMethod);
+{$ENDIF}
+{$IFNDEF DELPHI21}
+ AddMethod('procedure StartAnimation(AName: string)', CallMethod);
+ AddMethod('procedure StopAnimation(AName: string)', CallMethod);
+ AddMethod('procedure StartTriggerAnimation(AInstance: TFmxObject; ATrigger: string)', CallMethod);
+ AddMethod('procedure StartTriggerAnimationWait(AInstance: TFmxObject; ATrigger: string)', CallMethod);
+{$IFDEF DELPHI17}
+ AddMethod('procedure StopTriggerAnimation(AInstance: TFmxObject; ATrigger: string)', CallMethod);
+{$ELSE}
+ AddMethod('procedure StopTriggerAnimation(AInstance: TFmxObject)', CallMethod);
+{$ENDIF}
+
+ AddMethod('procedure ApplyTriggerEffect(AInstance: TFmxObject; ATrigger: string)', CallMethod);
+{$ENDIF}
+ AddMethod('procedure AnimateFloat(APropertyName: string; NewValue: Single; Duration: Single; AType: TAnimationType; AInterpolation: TInterpolationType)', CallMethod);
+ AddMethod('procedure AnimateColor(APropertyName: string; NewValue: TAlphaColor; Duration: Single; AType: TAnimationType; AInterpolation: TInterpolationType)', CallMethod);
+ AddMethod('procedure AnimateFloatDelay(APropertyName: string; NewValue: Single; Duration: Single; Delay: Single; AType: TAnimationType; AInterpolation: TInterpolationType)', CallMethod);
+ AddMethod('procedure AnimateFloatWait(APropertyName: string; NewValue: Single; Duration: Single; AType: TAnimationType; AInterpolation: TInterpolationType)', CallMethod);
+ AddMethod('procedure StopPropertyAnimation(APropertyName: string)', CallMethod);
+ AddProperty('Parent', 'TFmxObject', GetProp, SetProp);
+ AddProperty('Index', 'Integer', GetProp, SetProp);
+ end;
+{$ENDIF}
+ with AddClass(TfsXMLItem, 'TObject') do
+ begin
+ AddConstructor('constructor Create', CallMethod);
+ AddMethod('procedure AddItem(Item: TfsXMLItem)', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure InsertItem(Index: Integer; Item: TfsXMLItem)', CallMethod);
+ AddMethod('function Add: TfsXMLItem', CallMethod);
+ AddMethod('function Find(const Name: String): Integer', CallMethod);
+ AddMethod('function FindItem(const Name: String): TfsXMLItem', CallMethod);
+ AddMethod('function Root: TfsXMLItem', CallMethod);
+ AddProperty('Data', 'Integer', GetProp, SetProp);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddDefaultProperty('Items', 'Integer', 'TfsXMLItem', CallMethod, True);
+ AddIndexProperty('Prop', 'String', 'String', CallMethod);
+ AddProperty('Name', 'String', GetProp, SetProp);
+ AddProperty('Parent', 'TfsXMLItem', GetProp, nil);
+ AddProperty('Text', 'String', GetProp, SetProp);
+ end;
+ with AddClass(TfsXMLDocument, 'TObject') do
+ begin
+ AddConstructor('constructor Create', CallMethod);
+ AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure SaveToFile(const FileName: String)', CallMethod);
+ AddMethod('procedure LoadFromFile(const FileName: String)', CallMethod);
+ AddProperty('Root', 'TfsXMLItem', GetProp, nil);
+ end;
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ i: Integer;
+ s: String;
+ _TList: TList;
+ _TStrings: TStrings;
+ _TStream: TStream;
+ _TMemoryStream: TMemoryStream;
+ _TfsXMLItem: TfsXMLItem;
+ _TfsXMLDocument: TfsXMLDocument;
+{$IFDEF FMX}
+ _fmxObj: TFmxObject;
+{$ENDIF}
+begin
+ Result := 0;
+
+ if ClassType = TObject then
+ begin
+ if MethodName = 'CREATE' then
+ {$IFDEF FPC}
+ begin
+ if Instance is TList then
+ Result := frxInteger(TList.Create)
+ else
+ Result := frxInteger(Instance.Create);
+ end
+ {$ELSE}
+ Result := frxInteger(Instance.Create)
+ {$ENDIF}
+ else if MethodName = 'FREE' then
+ Instance.Free
+ else if MethodName = 'CLASSNAME' then
+ Result := Instance.ClassName
+ end
+ else if ClassType = TPersistent then
+ begin
+ if MethodName = 'ASSIGN' then
+ TPersistent(Instance).Assign(TPersistent(frxInteger(Caller.Params[0])));
+ end
+ else if ClassType = TCollection then
+ begin
+ if MethodName = 'CLEAR' then
+ TCollection(Instance).Clear
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TCollection(Instance).Items[Caller.Params[0]])
+ end
+ else if ClassType = TList then
+ begin
+ _TList := TList(Instance);
+ if MethodName = 'ADD' then
+ _TList.Add(Pointer(frxInteger(Caller.Params[0])))
+ else if MethodName = 'CLEAR' then
+ _TList.Clear
+ else if MethodName = 'DELETE' then
+ _TList.Delete(Caller.Params[0])
+ else if MethodName = 'INDEXOF' then
+ Result := _TList.IndexOf(Pointer(frxInteger(Caller.Params[0])))
+ else if MethodName = 'INSERT' then
+ _TList.Insert(Caller.Params[0], Pointer(frxInteger(Caller.Params[1])))
+ else if MethodName = 'REMOVE' then
+ _TList.Remove(Pointer(frxInteger(Caller.Params[0])))
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(_TList.Items[Caller.Params[0]])
+ else if MethodName = 'ITEMS.SET' then
+ _TList.Items[Caller.Params[0]] := Pointer(frxInteger(Caller.Params[1]))
+ end
+ else if ClassType = TStrings then
+ begin
+ _TStrings := TStrings(Instance);
+ if MethodName = 'CREATE' then
+ Result := frxInteger(_TStrings.Create)
+ else if MethodName = 'ADD' then
+ Result := _TStrings.Add(Caller.Params[0])
+ else if MethodName = 'ADDOBJECT' then
+ Result := _TStrings.AddObject(Caller.Params[0], TObject(frxInteger(Caller.Params[1])))
+ else if MethodName = 'CLEAR' then
+ _TStrings.Clear
+ else if MethodName = 'DELETE' then
+ _TStrings.Delete(Caller.Params[0])
+ else if MethodName = 'INDEXOF' then
+ Result := _TStrings.IndexOf(Caller.Params[0])
+ else if MethodName = 'INDEXOFNAME' then
+ Result := _TStrings.IndexOfName(Caller.Params[0])
+ else if MethodName = 'INDEXOFOBJECT' then
+ Result := _TStrings.IndexOfObject(TObject(frxInteger(Caller.Params[0])))
+ else if MethodName = 'INSERT' then
+ _TStrings.Insert(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'INSERTOBJECT' then
+ _TStrings.InsertObject(Caller.Params[0], Caller.Params[1], TObject(frxInteger(Caller.Params[2])))
+ else if MethodName = 'LOADFROMFILE' then
+ _TStrings.LoadFromFile(Caller.Params[0])
+ else if MethodName = 'LOADFROMSTREAM' then
+ _TStrings.LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'MOVE' then
+ _TStrings.Move(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'SAVETOFILE' then
+ _TStrings.SaveToFile(Caller.Params[0])
+ else if MethodName = 'SAVETOSTREAM' then
+ _TStrings.SaveToStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'NAMES.GET' then
+ Result := _TStrings.Names[Caller.Params[0]]
+ else if MethodName = 'OBJECTS.GET' then
+ Result := frxInteger(_TStrings.Objects[Caller.Params[0]])
+ else if MethodName = 'OBJECTS.SET' then
+ _TStrings.Objects[Caller.Params[0]] := TObject(frxInteger(Caller.Params[1]))
+ else if MethodName = 'VALUES.GET' then
+ Result := _TStrings.Values[Caller.Params[0]]
+ else if MethodName = 'VALUES.SET' then
+ _TStrings.Values[Caller.Params[0]] := Caller.Params[1]
+ else if MethodName = 'STRINGS.GET' then
+ Result := _TStrings.Strings[Caller.Params[0]]
+ else if MethodName = 'STRINGS.SET' then
+ _TStrings.Strings[Caller.Params[0]] := Caller.Params[1]
+ end
+ else if ClassType = TStringList then
+ begin
+ if MethodName = 'FIND' then
+ begin
+ Result := TStringList(Instance).Find(Caller.Params[0], i);
+ Caller.Params[1] := i;
+ end
+ else if MethodName = 'SORT' then
+ TStringList(Instance).Sort
+ end
+ else if ClassType = TStream then
+ begin
+ _TStream := TStream(Instance);
+ if MethodName = 'READ' then
+ begin
+ SetLength(s, Integer(Caller.Params[1]));
+ Result := _TStream.Read(s[1], Caller.Params[1]);
+ SetLength(s, Integer(Result));
+ Caller.Params[0] := s;
+ end
+ else if MethodName = 'WRITE' then
+ begin
+ s := Caller.Params[0];
+ Result := _TStream.Write(s[1], Caller.Params[1]);
+ end
+ else if MethodName = 'SEEK' then
+{$IFDEF DELPHI18}
+ Result := _TStream.Seek(Int64(Caller.Params[0]), Word(Caller.Params[1]))
+{$ELSE}
+{$IFDEF FPC}
+ Result := _TStream.Seek(Int64(Caller.Params[0]), Word(Caller.Params[1]))
+{$ELSE}
+ Result := _TStream.Seek(Caller.Params[0], Caller.Params[1])
+{$ENDIF}
+{$ENDIF}
+ else if MethodName = 'COPYFROM' then
+ Result := _TStream.CopyFrom(TStream(frxInteger(Caller.Params[0])), Caller.Params[1])
+ end
+ else if ClassType = TFileStream then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TFileStream(Instance).Create(Caller.Params[0], Caller.Params[1]))
+ end
+ else if ClassType = TMemoryStream then
+ begin
+ _TMemoryStream := TMemoryStream(Instance);
+ if MethodName = 'CLEAR' then
+ _TMemoryStream.Clear
+ else if MethodName = 'LOADFROMSTREAM' then
+ _TMemoryStream.LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LOADFROMFILE' then
+ _TMemoryStream.LoadFromFile(Caller.Params[0])
+ else if MethodName = 'SAVETOSTREAM' then
+ _TMemoryStream.SaveToStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVETOFILE' then
+ _TMemoryStream.SaveToFile(Caller.Params[0])
+ end
+ else if ClassType = TComponent then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TComponent(Instance).Create(TComponent(frxInteger(Caller.Params[0]))))
+ end
+ else if ClassType = TfsXMLItem then
+ begin
+ _TfsXMLItem := TfsXMLItem(Instance);
+ if MethodName = 'CREATE' then
+ Result := frxInteger(_TfsXMLItem.Create)
+ else if MethodName = 'ADDITEM' then
+ _TfsXMLItem.AddItem(TfsXMLItem(frxInteger(Caller.Params[0])))
+ else if MethodName = 'CLEAR' then
+ _TfsXMLItem.Clear
+ else if MethodName = 'INSERTITEM' then
+ _TfsXMLItem.InsertItem(Caller.Params[0], TfsXMLItem(frxInteger(Caller.Params[1])))
+ else if MethodName = 'ADD' then
+ Result := frxInteger(_TfsXMLItem.Add)
+ else if MethodName = 'FIND' then
+ Result := _TfsXMLItem.Find(Caller.Params[0])
+ else if MethodName = 'FINDITEM' then
+ Result := frxInteger(_TfsXMLItem.FindItem(Caller.Params[0]))
+ else if MethodName = 'PROP.GET' then
+ Result := _TfsXMLItem.Prop[Caller.Params[0]]
+ else if MethodName = 'PROP.SET' then
+ _TfsXMLItem.Prop[Caller.Params[0]] := Caller.Params[1]
+ else if MethodName = 'ROOT' then
+ Result := frxInteger(_TfsXMLItem.Root)
+ else if MethodName = 'ROOT' then
+ Result := frxInteger(_TfsXMLItem.Root)
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(_TfsXMLItem[Caller.Params[0]])
+ end
+ else if ClassType = TfsXMLDocument then
+ begin
+ _TfsXMLDocument := TfsXMLDocument(Instance);
+ if MethodName = 'CREATE' then
+ Result := frxInteger(_TfsXMLDocument.Create)
+ else if MethodName = 'SAVETOSTREAM' then
+ _TfsXMLDocument.SaveToStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LOADFROMSTREAM' then
+ _TfsXMLDocument.LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVETOFILE' then
+ _TfsXMLDocument.SaveToFile(Caller.Params[0])
+ else if MethodName = 'LOADFROMFILE' then
+ _TfsXMLDocument.LoadFromFile(Caller.Params[0])
+ end
+{$IFDEF FMX}
+ else if ClassType = TFmxObject then
+ begin
+ _fmxObj := TFmxObject(Instance);
+ if MethodName = 'CLONE' then
+ Result := frxInteger(_fmxObj.Clone(TComponent(frxInteger(Caller.Params[0]))))
+// else if MethodName = 'CLONECHILDFROMSTREAM' then
+// _fmxObj.CloneChildFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'ADDOBJECT' then
+ _fmxObj.AddObject(TFmxObject(frxInteger(Caller.Params[0])))
+ else if MethodName = 'INSERTOBJECT' then
+ _fmxObj.InsertObject(Integer(Caller.Params[0]), TFmxObject(frxInteger(Caller.Params[1])))
+ else if MethodName = 'REMOVEOBJECT' then
+ _fmxObj.RemoveObject(TFmxObject(frxInteger(Caller.Params[0])))
+ else if MethodName = 'REMOVEOBJECT' then
+ _fmxObj.RemoveObject(Integer(Caller.Params[0]))
+ else if MethodName = 'EXCHANGE' then
+ _fmxObj.Exchange(TFmxObject(frxInteger(Caller.Params[0])), TFmxObject(frxInteger(Caller.Params[1])))
+ else if MethodName = 'DELETECHILDREN' then
+ _fmxObj.DeleteChildren()
+ else if MethodName = 'BRINGTOFRONT' then
+ _fmxObj.BringToFront()
+ else if MethodName = 'SENDTOBACK' then
+ _fmxObj.SendToBack()
+{$IFDEF DELPHI17}
+ else if MethodName = 'ADDOBJECTSTOLIST' then
+ _fmxObj.AddObjectsToList(TFmxObjectList(frxInteger(Caller.Params[0])))
+{$IFNDEF DELPHI18}
+ else if MethodName = 'ADDCONTROLSTOLIST' then
+ _fmxObj.AddControlsToList(TFmxObjectList(frxInteger(Caller.Params[0])))
+{$ENDIF}
+{$IFNDEF DELPHI20}
+ else if MethodName = 'GETTABORDERLIST' then
+ _fmxObj.GetTabOrderList(TInterfaceList(frxInteger(Caller.Params[0])), Boolean(Caller.Params[1]))
+{$ENDIF}
+{$ELSE}
+ else if MethodName = 'ADDOBJECTSTOLIST' then
+ _fmxObj.AddObjectsToList(TList(frxInteger(Caller.Params[0])))
+ else if MethodName = 'ADDCONTROLSTOLIST' then
+ _fmxObj.AddControlsToList(TList(frxInteger(Caller.Params[0])))
+ else if MethodName = 'GETTABORDERLIST' then
+ _fmxObj.GetTabOrderList(TList(frxInteger(Caller.Params[0])), Boolean(Caller.Params[1]))
+ else if MethodName = 'LOADFROMSTREAM' then
+ _fmxObj.LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVETOSTREAM' then
+ _fmxObj.SaveToStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LOADFROMBINSTREAM' then
+ _fmxObj.LoadFromBinStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVETOBINSTREAM' then
+ _fmxObj.SaveToBinStream(TStream(frxInteger(Caller.Params[0])))
+{$ENDIF}
+ else if MethodName = 'FINDSTYLERESOURCE' then
+ Result := frxInteger(_fmxObj.FindStyleResource(string(Caller.Params[0])))
+{$IFNDEF DELPHI18}
+ else if MethodName = 'UPDATESTYLE' then
+ _fmxObj.UpdateStyle()
+{$ENDIF}
+{$IFNDEF DELPHI21}
+ else if MethodName = 'STARTANIMATION' then
+ _fmxObj.StartAnimation(string(Caller.Params[0]))
+ else if MethodName = 'STOPANIMATION' then
+ _fmxObj.StopAnimation(string(Caller.Params[0]))
+ else if MethodName = 'STARTTRIGGERANIMATION' then
+ _fmxObj.StartTriggerAnimation(TFmxObject(frxInteger(Caller.Params[0])), string(Caller.Params[1]))
+ else if MethodName = 'STARTTRIGGERANIMATIONWAIT' then
+ _fmxObj.StartTriggerAnimationWait(TFmxObject(frxInteger(Caller.Params[0])), string(Caller.Params[1]))
+ else if MethodName = 'STOPTRIGGERANIMATION' then
+{$IFDEF DELPHI17}
+ _fmxObj.StopTriggerAnimation(TFmxObject(frxInteger(Caller.Params[0])), string(Caller.Params[1]))
+{$ELSE}
+ _fmxObj.StopTriggerAnimation(TFmxObject(frxInteger(Caller.Params[0])))
+{$ENDIF}
+ else if MethodName = 'APPLYTRIGGEREFFECT' then
+ _fmxObj.ApplyTriggerEffect(TFmxObject(frxInteger(Caller.Params[0])), string(Caller.Params[1]))
+{$ENDIF}
+ else if MethodName = 'ANIMATEFLOAT' then
+ _fmxObj.AnimateFloat(string(Caller.Params[0]), Single(Caller.Params[1]), Single(Caller.Params[2]), TAnimationType(Caller.Params[3]), TInterpolationType(Caller.Params[4]))
+ else if MethodName = 'ANIMATECOLOR' then
+ _fmxObj.AnimateColor(string(Caller.Params[0]), TAlphaColor(Caller.Params[1]), Single(Caller.Params[2]), TAnimationType(Caller.Params[3]), TInterpolationType(Caller.Params[4]))
+ else if MethodName = 'ANIMATEFLOATDELAY' then
+ _fmxObj.AnimateFloatDelay(string(Caller.Params[0]), Single(Caller.Params[1]), Single(Caller.Params[2]), Single(Caller.Params[3]), TAnimationType(Caller.Params[4]), TInterpolationType(Caller.Params[5]))
+ else if MethodName = 'ANIMATEFLOATWAIT' then
+ _fmxObj.AnimateFloatWait(string(Caller.Params[0]), Single(Caller.Params[1]), Single(Caller.Params[2]), TAnimationType(Caller.Params[3]), TInterpolationType(Caller.Params[4]))
+ else if MethodName = 'STOPPROPERTYANIMATION' then
+ _fmxObj.StopPropertyAnimation(string(Caller.Params[0]))
+end;
+{$ENDIF}
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TCollection then
+ begin
+ if PropName = 'COUNT' then
+ Result := TCollection(Instance).Count
+ end
+ else if ClassType = TList then
+ begin
+ if PropName = 'COUNT' then
+ Result := TList(Instance).Count
+ end
+ else if ClassType = TStrings then
+ begin
+ if PropName = 'COMMATEXT' then
+ Result := TStrings(Instance).CommaText
+ else if PropName = 'COUNT' then
+ Result := TStrings(Instance).Count
+ else if PropName = 'TEXT' then
+ Result := TStrings(Instance).Text
+ end
+ else if ClassType = TStringList then
+ begin
+ if PropName = 'DUPLICATES' then
+ Result := TStringList(Instance).Duplicates
+ else if PropName = 'SORTED' then
+ Result := TStringList(Instance).Sorted
+ end
+ else if ClassType = TStream then
+ begin
+ if PropName = 'POSITION' then
+ Result := TStream(Instance).Position
+ else if PropName = 'SIZE' then
+ Result := TStream(Instance).Size
+ end
+ else if ClassType = TComponent then
+ begin
+ if PropName = 'OWNER' then
+ Result := frxInteger(TComponent(Instance).Owner)
+ end
+ else if ClassType = TfsXMLItem then
+ begin
+ if PropName = 'DATA' then
+ Result := frxInteger(TfsXMLItem(Instance).Data)
+ else if PropName = 'COUNT' then
+ Result := TfsXMLItem(Instance).Count
+ else if PropName = 'NAME' then
+ Result := TfsXMLItem(Instance).Name
+ else if PropName = 'PARENT' then
+ Result := frxInteger(TfsXMLItem(Instance).Parent)
+ else if PropName = 'TEXT' then
+ Result := TfsXMLItem(Instance).Text
+ end
+ else if ClassType = TfsXMLDocument then
+ begin
+ if PropName = 'ROOT' then
+ Result := frxInteger(TfsXMLDocument(Instance).Root)
+ end
+ {$IFDEF FMX}
+ else if ClassType = TFmxObject then
+ begin
+ if PropName = 'PARENT' then
+ Result := frxInteger(TFmxObject(Instance).Parent)
+ else if PropName = 'INDEX' then
+ Result := TFmxObject(Instance).Index
+ end
+ {$ENDIF}
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TStrings then
+ begin
+ if PropName = 'COMMATEXT' then
+ TStrings(Instance).CommaText := Value
+ else if PropName = 'TEXT' then
+ TStrings(Instance).Text := Value
+ end
+ else if ClassType = TStringList then
+ begin
+ if PropName = 'DUPLICATES' then
+ TStringList(Instance).Duplicates := Value
+ else if PropName = 'SORTED' then
+ TStringList(Instance).Sorted := Value
+ end
+ else if ClassType = TStream then
+ begin
+ if PropName = 'POSITION' then
+ TStream(Instance).Position := Value
+ end
+ else if ClassType = TfsXMLItem then
+ begin
+ if PropName = 'DATA' then
+ TfsXMLItem(Instance).Data := Pointer(frxInteger(Value))
+ else if PropName = 'NAME' then
+ TfsXMLItem(Instance).Name := Value
+ else if PropName = 'TEXT' then
+ TfsXMLItem(Instance).Text := Value
+ end
+ {$IFDEF FMX}
+ else if ClassType = TFmxObject then
+ begin
+ if PropName = 'PARENT' then
+ TFmxObject(Instance).Parent := TFmxObject(frxInteger(Value))
+ else if PropName = 'INDEX' then
+ TFmxObject(Instance).Index := Value
+ end
+ {$ENDIF}
+end;
+
+
+initialization
+{$IFDEF DELPHI16}
+{$IFDEF FMX}
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsClassesRTTI, TFmxObject);
+{$ELSE}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsClassesRTTI, TControl);
+{$ENDIF}
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/fs_iconst.pas b/LibD28/fs_iconst.pas
new file mode 100644
index 0000000..cba1878
--- /dev/null
+++ b/LibD28/fs_iconst.pas
@@ -0,0 +1,66 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Resources }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_iconst;
+{$ENDIF}
+
+interface
+
+{$i fs.inc}
+
+var
+ SLangNotFound: String;
+ SInvalidLanguage: String;
+ SIdRedeclared: String;
+ SUnknownType: String;
+ SIncompatibleTypes: String;
+ SIdUndeclared: String;
+ SClassRequired: String;
+ SIndexRequired: String;
+ SStringError: String;
+ SClassError: String;
+ SArrayRequired: String;
+ SVarRequired: String;
+ SNotEnoughParams: String;
+ STooManyParams: String;
+ SLeftCantAssigned: String;
+ SForError: String;
+ SEventError: String;
+ SComponentError: String;
+ SComponentAssignError: String;
+
+
+implementation
+
+initialization
+ SLangNotFound := 'Language ''%s'' not found';
+ SInvalidLanguage := 'Invalid language definition';
+ SIdRedeclared := 'Identifier redeclared: ';
+ SUnknownType := 'Unknown type: ';
+ SIncompatibleTypes := 'Incompatible types';
+ SIdUndeclared := 'Undeclared identifier: ';
+ SClassRequired := 'Class type required';
+ SIndexRequired := 'Index required';
+ SStringError := 'Strings doesn''t have properties or methods';
+ SClassError := 'Class %s does not have a default property';
+ SArrayRequired := 'Array type required';
+ SVarRequired := 'Variable required';
+ SNotEnoughParams := 'Not enough actual parameters';
+ STooManyParams := 'Too many actual parameters';
+ SLeftCantAssigned := 'Left side cannot be assigned to';
+ SForError := 'For loop variable must be numeric variable';
+ SEventError := 'Event handler must be a procedure';
+ SComponentError := 'Component with name %s not found';
+ SComponentAssignError := 'Can not assign value to component field %s';
+
+end.
diff --git a/LibD28/fs_icpp.pas b/LibD28/fs_icpp.pas
new file mode 100644
index 0000000..dc1f955
--- /dev/null
+++ b/LibD28/fs_icpp.pas
@@ -0,0 +1,183 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ C++ grammar }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_icpp;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_itools{$IFDEF DELPHI16}, Controls{$ENDIF};
+{$ELSE}
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_itools, FMX.Types;
+{$ENDIF}
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsCPP = class(TComponent);
+
+
+implementation
+
+const
+ CPP_GRAMMAR =
+ '' +
+ '' +
+ '<' +
+ 'err20 text="''>'' expected"/>' +
+ '' +
+ '' +
+ '<' +
+ 'sequence>' +
+ '<' +
+ 'sequence>' +
+ '' +
+ '' +
+ '' +
+ '';
+
+
+initialization
+{$IFDEF DELPHI16}
+{$IFDEF FMX}
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsCPP, TFmxObject);
+{$ELSE}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsCPP, TControl);
+{$ENDIF}
+{$ENDIF}
+ fsRegisterLanguage('C++Script', CPP_GRAMMAR);
+
+end.
diff --git a/LibD28/fs_idbctrlsrtti.pas b/LibD28/fs_idbctrlsrtti.pas
new file mode 100644
index 0000000..accf4b5
--- /dev/null
+++ b/LibD28/fs_idbctrlsrtti.pas
@@ -0,0 +1,189 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ DB controls }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_idbctrlsrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, fs_itools, fs_iformsrtti, fs_idbrtti, DB
+{$IFDEF CLX}
+, QDBCtrls, QDBGrids
+{$ELSE}
+, DBCtrls, DBGrids
+{$ENDIF}
+{$IFDEF DELPHI16}, Controls{$ENDIF};
+
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsDBCtrlsRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+{$IFNDEF FPC}
+ THackDBLookupControl = class(TDBLookupControl);
+{$ENDIF}
+
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnumSet('TButtonSet', 'nbFirst, nbPrior, nbNext, nbLast,' +
+ 'nbInsert, nbDelete, nbEdit, nbPost, nbCancel, nbRefresh');
+ AddEnum('TColumnButtonStyle', 'cbsAuto, cbsEllipsis, cbsNone');
+ AddEnumSet('TDBGridOptions', 'dgEditing, dgAlwaysShowEditor, dgTitles,' +
+ 'dgIndicator, dgColumnResize, dgColLines, dgRowLines, dgTabs, dgRowSelect,' +
+ 'dgAlwaysShowSelection, dgConfirmDelete, dgCancelOnExit, dgMultiSelect');
+
+ AddClass(TDBEdit, 'TWinControl');
+ AddClass(TDBText, 'TGraphicControl');
+ with AddClass(TDBCheckBox, 'TWinControl') do
+ AddProperty('Checked', 'Boolean', GetProp, nil);
+ with AddClass(TDBComboBox, 'TCustomComboBox') do
+ AddProperty('Text', 'String', GetProp, nil);
+ AddClass(TDBListBox, 'TCustomListBox');
+ with AddClass(TDBRadioGroup, 'TWinControl') do
+ begin
+ AddProperty('ItemIndex', 'Integer', GetProp, nil);
+ AddProperty('Value', 'String', GetProp, nil);
+ end;
+ AddClass(TDBMemo, 'TWinControl');
+ AddClass(TDBImage, 'TCustomControl');
+ AddClass(TDBNavigator, 'TWinControl');
+{$IFNDEF FPC}
+ with AddClass(TDBLookupControl, 'TCustomControl') do
+ AddProperty('KeyValue', 'Variant', GetProp, SetProp);
+ with AddClass(TDBLookupListBox, 'TDBLookupControl') do
+ AddProperty('SelectedItem', 'String', GetProp, nil);
+ with AddClass(TDBLookupComboBox, 'TDBLookupControl') do
+ AddProperty('Text', 'String', GetProp, nil);
+{$ENDIF}
+ AddClass(TColumnTitle, 'TPersistent');
+ AddClass(TColumn, 'TPersistent');
+ with AddClass(TDBGridColumns, 'TCollection') do
+ begin
+ AddMethod('function Add: TColumn', CallMethod);
+ AddMethod('procedure RebuildColumns', CallMethod);
+ AddMethod('procedure RestoreDefaults', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TColumn', CallMethod, True);
+ end;
+ AddClass(TDBGrid, 'TWinControl');
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TDBGridColumns then
+ begin
+ if MethodName = 'ADD' then
+ Result := frxInteger(TDBGridColumns(Instance).Add)
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TDBGridColumns(Instance).Items[Caller.Params[0]])
+{$IFNDEF FPC}
+ else if MethodName = 'REBUILDCOLUMNS' then
+ TDBGridColumns(Instance).RebuildColumns
+ else if MethodName = 'RESTOREDEFAULTS' then
+ TDBGridColumns(Instance).RestoreDefaults
+{$ENDIF}
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TDBCheckBox then
+ begin
+ if PropName = 'CHECKED' then
+ Result := TDBCheckBox(Instance).Checked
+ end
+ else if ClassType = TDBComboBox then
+ begin
+ if PropName = 'TEXT' then
+ Result := TDBComboBox(Instance).Text
+ end
+ else if ClassType = TDBRadioGroup then
+ begin
+ if PropName = 'ITEMINDEX' then
+ Result := TDBRadioGroup(Instance).ItemIndex
+ else if PropName = 'VALUE' then
+ Result := TDBRadioGroup(Instance).Value
+ end
+{$IFNDEF FPC}
+ else if ClassType = TDBLookupControl then
+ begin
+ if PropName = 'KEYVALUE' then
+ Result := THackDBLookupControl(Instance).KeyValue
+ end
+ else if ClassType = TDBLookupListBox then
+ begin
+ if PropName = 'SELECTEDITEM' then
+ Result := TDBLookupListBox(Instance).SelectedItem
+ end
+ else if ClassType = TDBLookupComboBox then
+ begin
+ if PropName = 'TEXT' then
+ Result := TDBLookupComboBox(Instance).Text
+ end
+{$ENDIF}
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+{$IFNDEF FPC}
+ if ClassType = TDBLookupControl then
+ begin
+ if PropName = 'KEYVALUE' then
+ THackDBLookupControl(Instance).KeyValue := Value
+ end
+{$ENDIF}
+end;
+
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsDBCtrlsRTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/fs_idbreg.pas b/LibD28/fs_idbreg.pas
new file mode 100644
index 0000000..3c4dcbf
--- /dev/null
+++ b/LibD28/fs_idbreg.pas
@@ -0,0 +1,46 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_idbreg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ Classes
+{$IFNDEF Delphi6}
+, DsgnIntf
+{$ELSE}
+, DesignIntf
+{$ENDIF}
+{$IFDEF DELPHI16}
+, Controls
+{$ENDIF}
+, fs_idbrtti, fs_idbctrlsrtti;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+{$IFDEF DELPHI16}
+ //GroupDescendentsWith(TfsDBRTTI, TControl);
+ //GroupDescendentsWith(TfsDBCtrlsRTTI, TControl);
+{$ENDIF}
+ RegisterComponents('FastScript', [TfsDBRTTI, TfsDBCtrlsRTTI]);
+end;
+
+end.
diff --git a/LibD28/fs_idbrtti.pas b/LibD28/fs_idbrtti.pas
new file mode 100644
index 0000000..d389fd4
--- /dev/null
+++ b/LibD28/fs_idbrtti.pas
@@ -0,0 +1,583 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ DB.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_idbrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, fs_itools, fs_iclassesrtti, fs_ievents,
+ DB
+{$IFDEF Delphi16}
+ , System.Types
+{$ENDIF}
+{$IFDEF DELPHI16}, Controls{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsDBRTTI = class(TComponent); // fake component
+
+ TfsDatasetNotifyEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Dataset: TDataset);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsFilterRecordEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(DataSet: TDataSet; var Accept: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsFieldGetTextEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TField; var Text: String; DisplayText: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TfsDatasetNotifyEvent }
+
+procedure TfsDatasetNotifyEvent.DoEvent(Dataset: TDataset);
+begin
+ CallHandler([Dataset]);
+end;
+
+function TfsDatasetNotifyEvent.GetMethod: Pointer;
+begin
+ Result := @TfsDatasetNotifyEvent.DoEvent;
+end;
+
+
+{ TfsFilterRecordEvent }
+
+procedure TfsFilterRecordEvent.DoEvent(DataSet: TDataSet; var Accept: Boolean);
+begin
+ CallHandler([DataSet, Accept]);
+ Accept := Handler.Params[1].Value;
+end;
+
+function TfsFilterRecordEvent.GetMethod: Pointer;
+begin
+ Result := @TfsFilterRecordEvent.DoEvent;
+end;
+
+
+{ TfsFieldGetTextEvent }
+
+procedure TfsFieldGetTextEvent.DoEvent(Sender: TField; var Text: String; DisplayText: Boolean);
+begin
+ CallHandler([Sender, Text, DisplayText]);
+ Text := Handler.Params[1].Value;
+end;
+
+function TfsFieldGetTextEvent.GetMethod: Pointer;
+begin
+ Result := @TfsFieldGetTextEvent.DoEvent;
+end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TFieldType', 'ftUnknown, ftString, ftSmallint, ftInteger, ftWord,' +
+ 'ftBoolean, ftFloat, ftCurrency, ftBCD, ftDate, ftTime, ftDateTime,' +
+ 'ftBytes, ftVarBytes, ftAutoInc, ftBlob, ftMemo, ftGraphic, ftFmtMemo,' +
+ 'ftParadoxOle, ftDBaseOle, ftTypedBinary, ftCursor, ftFixedChar, ftWideString,' +
+ 'ftLargeint, ftADT, ftArray, ftReference, ftDataSet, ftOraBlob, ftOraClob,' +
+ 'ftVariant, ftInterface, ftIDispatch, ftGuid, ftTimeStamp, ftFMTBcd');
+ AddEnum('TBlobStreamMode', 'bmRead, bmWrite, bmReadWrite');
+ AddEnumSet('TLocateOptions', 'loCaseInsensitive, loPartialKey');
+ AddEnumSet('TFilterOptions', 'foCaseInsensitive, foNoPartialCompare');
+ AddEnum('TParamType', 'ptUnknown, ptInput, ptOutput, ptInputOutput, ptResult');
+
+ with AddClass(TField, 'TComponent') do
+ begin
+ AddProperty('AsBoolean', 'Boolean', GetProp, SetProp);
+ AddProperty('AsCurrency', 'Currency', GetProp, SetProp);
+ AddProperty('AsDateTime', 'TDateTime', GetProp, SetProp);
+ AddProperty('AsFloat', 'Double', GetProp, SetProp);
+ AddProperty('AsInteger', 'Integer', GetProp, SetProp);
+ AddProperty('AsString', 'String', GetProp, SetProp);
+ AddProperty('AsVariant', 'Variant', GetProp, SetProp);
+ AddProperty('DataType', 'TFieldType', GetProp, nil);
+ AddProperty('DisplayName', 'String', GetProp, nil);
+ AddProperty('DisplayText', 'String', GetProp, nil);
+ AddProperty('IsNull', 'Boolean', GetProp, nil);
+ AddProperty('Size', 'Integer', GetProp, SetProp);
+ AddProperty('Value', 'Variant', GetProp, SetProp);
+ AddProperty('OldValue', 'Variant', GetProp, nil);
+ AddEvent('OnGetText', TfsFieldGetTextEvent);
+ end;
+ with AddClass(TFields, 'TObject') do
+ AddDefaultProperty('Fields', 'Integer', 'TField', CallMethod, True);
+ AddClass(TStringField, 'TField');
+ AddClass(TNumericField, 'TField');
+ AddClass(TIntegerField, 'TNumericField');
+ AddClass(TSmallIntField, 'TIntegerField');
+ AddClass(TWordField, 'TIntegerField');
+ AddClass(TAutoIncField, 'TIntegerField');
+ AddClass(TFloatField, 'TNumericField');
+ AddClass(TCurrencyField, 'TFloatField');
+ AddClass(TBooleanField, 'TField');
+ AddClass(TDateTimeField, 'TField');
+ AddClass(TDateField, 'TDateTimeField');
+ AddClass(TTimeField, 'TDateTimeField');
+ AddClass(TBinaryField, 'TField');
+ AddClass(TBytesField, 'TBinaryField');
+ AddClass(TVarBytesField, 'TBinaryField');
+ AddClass(TBCDField, 'TNumericField');
+ with AddClass(TBlobField, 'TField') do
+ begin
+ AddMethod('procedure LoadFromFile(const FileName: String)', CallMethod);
+ AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure SaveToFile(const FileName: String)', CallMethod);
+ AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
+ end;
+ AddClass(TMemoField, 'TBlobField');
+ AddClass(TGraphicField, 'TBlobField');
+ AddClass(TFieldDef, 'TPersistent');
+ with AddClass(TFieldDefs, 'TObject') do
+ begin
+ AddMethod('function AddFieldDef: TFieldDef', CallMethod);
+ AddMethod('function Find(const Name: string): TFieldDef', CallMethod);
+ AddMethod('procedure Add(const Name: string; DataType: TFieldType; Size: Word; Required: Boolean)', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure Update', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TFieldDef', CallMethod, True);
+ end;
+ AddClass(TDataSource, 'TComponent');
+ AddType('TBookmark', fvtVariant);
+ with AddClass(TDataSet, 'TComponent') do
+ begin
+ AddMethod('procedure Open', CallMethod);
+ AddMethod('procedure Close', CallMethod);
+ AddMethod('procedure First', CallMethod);
+ AddMethod('procedure Last', CallMethod);
+ AddMethod('procedure Next', CallMethod);
+ AddMethod('procedure Prior', CallMethod);
+ AddMethod('procedure Cancel', CallMethod);
+ AddMethod('procedure Delete', CallMethod);
+ AddMethod('procedure Post', CallMethod);
+ AddMethod('procedure Append', CallMethod);
+ AddMethod('procedure Insert', CallMethod);
+ AddMethod('procedure Edit', CallMethod);
+
+ AddMethod('function FieldByName(const FieldName: string): TField', CallMethod);
+ AddMethod('procedure GetFieldNames(List: TStrings)', CallMethod);
+ AddMethod('function FindFirst: Boolean', CallMethod);
+ AddMethod('function FindLast: Boolean', CallMethod);
+ AddMethod('function FindNext: Boolean', CallMethod);
+ AddMethod('function FindPrior: Boolean', CallMethod);
+ AddMethod('procedure FreeBookmark(Bookmark: TBookmark)', CallMethod);
+ AddMethod('function GetBookmark: TBookmark', CallMethod);
+ AddMethod('procedure GotoBookmark(Bookmark: TBookmark)', CallMethod);
+ AddMethod('function Locate(const KeyFields: string; const KeyValues: Variant;' +
+ 'Options: TLocateOptions): Boolean', CallMethod);
+ AddMethod('function IsEmpty: Boolean', CallMethod);
+ AddMethod('procedure EnableControls', CallMethod);
+ AddMethod('procedure DisableControls', CallMethod);
+
+ AddProperty('Bof', 'Boolean', GetProp, nil);
+ AddProperty('Eof', 'Boolean', GetProp, nil);
+ AddProperty('FieldCount', 'Integer', GetProp, nil);
+ AddProperty('FieldDefs', 'TFieldDefs', GetProp, nil);
+ AddProperty('Fields', 'TFields', GetProp, nil);
+ AddProperty('Filter', 'string', GetProp, SetProp);
+ AddProperty('Filtered', 'Boolean', GetProp, SetProp);
+ AddProperty('FilterOptions', 'TFilterOptions', GetProp, SetProp);
+ AddProperty('Active', 'Boolean', GetProp, SetProp);
+
+ AddEvent('BeforeOpen', TfsDatasetNotifyEvent);
+ AddEvent('AfterOpen', TfsDatasetNotifyEvent);
+ AddEvent('BeforeClose', TfsDatasetNotifyEvent);
+ AddEvent('AfterClose', TfsDatasetNotifyEvent);
+ AddEvent('BeforeInsert', TfsDatasetNotifyEvent);
+ AddEvent('AfterInsert', TfsDatasetNotifyEvent);
+ AddEvent('BeforeEdit', TfsDatasetNotifyEvent);
+ AddEvent('AfterEdit', TfsDatasetNotifyEvent);
+ AddEvent('BeforePost', TfsDatasetNotifyEvent);
+ AddEvent('AfterPost', TfsDatasetNotifyEvent);
+ AddEvent('BeforeCancel', TfsDatasetNotifyEvent);
+ AddEvent('AfterCancel', TfsDatasetNotifyEvent);
+ AddEvent('BeforeDelete', TfsDatasetNotifyEvent);
+ AddEvent('AfterDelete', TfsDatasetNotifyEvent);
+ AddEvent('BeforeScroll', TfsDatasetNotifyEvent);
+ AddEvent('AfterScroll', TfsDatasetNotifyEvent);
+ AddEvent('OnCalcFields', TfsDatasetNotifyEvent);
+ AddEvent('OnFilterRecord', TfsFilterRecordEvent);
+ AddEvent('OnNewRecord', TfsDatasetNotifyEvent);
+ end;
+
+ with AddClass(TParam, 'TPersistent') do
+ begin
+ AddMethod('procedure Clear', CallMethod);
+ AddProperty('AsBoolean', 'Boolean', GetProp, SetProp);
+ AddProperty('AsCurrency', 'Currency', GetProp, SetProp);
+ AddProperty('AsDateTime', 'TDateTime', GetProp, SetProp);
+ AddProperty('AsFloat', 'Double', GetProp, SetProp);
+ AddProperty('AsInteger', 'Integer', GetProp, SetProp);
+ AddProperty('AsDate', 'TDate', GetProp, SetProp);
+ AddProperty('AsTime', 'TTime', GetProp, SetProp);
+ AddProperty('AsString', 'String', GetProp, SetProp);
+ AddProperty('Bound', 'Boolean', GetProp, SetProp);
+ AddProperty('IsNull', 'Boolean', GetProp, nil);
+ AddProperty('Text', 'String', GetProp, SetProp);
+ end;
+ with AddClass(TParams, 'TPersistent') do
+ begin
+ AddMethod('function ParamByName(const Value: string): TParam', CallMethod);
+ AddMethod('function FindParam(const Value: string): TParam', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TParam', CallMethod, True);
+ end;
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ _TDataSet: TDataSet;
+
+ function IntToLocateOptions(i: Integer): TLocateOptions;
+ begin
+ Result := [];
+ if (i and 1) <> 0 then
+ Result := Result + [loCaseInsensitive];
+ if (i and 2) <> 0 then
+ Result := Result + [loPartialKey];
+ end;
+
+begin
+ Result := 0;
+
+ if ClassType = TFields then
+ begin
+ if MethodName = 'FIELDS.GET' then
+ Result := frxInteger(TFields(Instance)[Caller.Params[0]])
+ end
+ else if ClassType = TFieldDefs then
+ begin
+ if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TFieldDefs(Instance)[Caller.Params[0]])
+ else if MethodName = 'ADD' then
+ TFieldDefs(Instance).Add(Caller.Params[0], TFieldType(Caller.Params[1]), Caller.Params[2], Caller.Params[3])
+ else if MethodName = 'ADDFIELDDEF' then
+ Result := frxInteger(TFieldDefs(Instance).AddFieldDef)
+ else if MethodName = 'CLEAR' then
+ TFieldDefs(Instance).Clear
+ else if MethodName = 'FIND' then
+ Result := frxInteger(TFieldDefs(Instance).Find(Caller.Params[0]))
+ else if MethodName = 'UPDATE' then
+ TFieldDefs(Instance).Update
+ end
+ else if ClassType = TBlobField then
+ begin
+ if MethodName = 'LOADFROMFILE' then
+ TBlobField(Instance).LoadFromFile(Caller.Params[0])
+ else if MethodName = 'LOADFROMSTREAM' then
+ TBlobField(Instance).LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVETOFILE' then
+ TBlobField(Instance).SaveToFile(Caller.Params[0])
+ else if MethodName = 'SAVETOSTREAM' then
+ TBlobField(Instance).SaveToStream(TStream(frxInteger(Caller.Params[0])))
+ end
+ else if ClassType = TDataSet then
+ begin
+ _TDataSet := TDataSet(Instance);
+ if MethodName = 'OPEN' then
+ _TDataSet.Open
+ else if MethodName = 'CLOSE' then
+ _TDataSet.Close
+ else if MethodName = 'FIRST' then
+ _TDataSet.First
+ else if MethodName = 'LAST' then
+ _TDataSet.Last
+ else if MethodName = 'NEXT' then
+ _TDataSet.Next
+ else if MethodName = 'PRIOR' then
+ _TDataSet.Prior
+ else if MethodName = 'CANCEL' then
+ _TDataSet.Cancel
+ else if MethodName = 'DELETE' then
+ _TDataSet.Delete
+ else if MethodName = 'POST' then
+ _TDataSet.Post
+ else if MethodName = 'APPEND' then
+ _TDataSet.Append
+ else if MethodName = 'INSERT' then
+ _TDataSet.Insert
+ else if MethodName = 'EDIT' then
+ _TDataSet.Edit
+ else if MethodName = 'FIELDBYNAME' then
+ Result := frxInteger(_TDataSet.FieldByName(Caller.Params[0]))
+ else if MethodName = 'GETFIELDNAMES' then
+ _TDataSet.GetFieldNames(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'FINDFIRST' then
+ Result := _TDataSet.FindFirst
+ else if MethodName = 'FINDLAST' then
+ Result := _TDataSet.FindLast
+ else if MethodName = 'FINDNEXT' then
+ Result := _TDataSet.FindNext
+ else if MethodName = 'FINDPRIOR' then
+ Result := _TDataSet.FindPrior
+ else if MethodName = 'FREEBOOKMARK' then
+ _TDataSet.FreeBookmark(TBookMark(frxInteger(Caller.Params[0])))
+
+ else if MethodName = 'GETBOOKMARK' then
+{$IFDEF DELPHI16}
+ Result := Variant(_TDataSet.GetBookmark)
+{$ELSE}
+ Result := Variant(frxInteger(_TDataSet.GetBookmark))
+{$ENDIF}
+ else if MethodName = 'GOTOBOOKMARK' then
+{$IFDEF DELPHI16}
+ _TDataSet.GotoBookmark(TBookMark(Variant(Caller.Params[0])))
+{$ELSE}
+ _TDataSet.GotoBookmark(TBookMark(frxInteger(Caller.Params[0])))
+{$ENDIF}
+ else if MethodName = 'LOCATE' then
+ Result := _TDataSet.Locate(Caller.Params[0], Caller.Params[1], IntToLocateOptions(Caller.Params[2]))
+ else if MethodName = 'ISEMPTY' then
+ Result := _TDataSet.IsEmpty
+ else if MethodName = 'ENABLECONTROLS' then
+ _TDataSet.EnableControls
+ else if MethodName = 'DISABLECONTROLS' then
+ _TDataSet.DisableControls
+ end
+ else if ClassType = TParam then
+ begin
+ if MethodName = 'CLEAR' then
+ TParam(Instance).Clear
+ end
+ else if ClassType = TParams then
+ begin
+ if MethodName = 'PARAMBYNAME' then
+ Result := frxInteger(TParams(Instance).ParamByName(Caller.Params[0]))
+ else if MethodName = 'FINDPARAM' then
+ Result := frxInteger(TParams(Instance).FindParam(Caller.Params[0]))
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TParams(Instance)[Caller.Params[0]])
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+var
+ _TField: TField;
+ _TParam: TParam;
+ _TDataSet: TDataSet;
+
+ function FilterOptionsToInt(f: TFilterOptions): Integer;
+ begin
+ Result := 0;
+ if foCaseInsensitive in f then
+ Result := Result or 1;
+ if foNoPartialCompare in f then
+ Result := Result or 2;
+ end;
+
+begin
+ Result := 0;
+
+ if ClassType = TField then
+ begin
+ _TField := TField(Instance);
+ if PropName = 'ASBOOLEAN' then
+ Result := _TField.AsBoolean
+ else if PropName = 'ASCURRENCY' then
+ Result := _TField.AsCurrency
+ else if PropName = 'ASDATETIME' then
+ Result := _TField.AsDateTime
+ else if PropName = 'ASFLOAT' then
+ Result := _TField.AsFloat
+ else if PropName = 'ASINTEGER' then
+ Result := _TField.AsInteger
+ else if PropName = 'ASSTRING' then
+ Result := _TField.AsString
+ else if PropName = 'ASVARIANT' then
+ Result := _TField.AsVariant
+ else if PropName = 'DATATYPE' then
+ Result := _TField.DataType
+ else if PropName = 'DISPLAYNAME' then
+ Result := _TField.DisplayName
+ else if PropName = 'DISPLAYTEXT' then
+ Result := _TField.DisplayText
+ else if PropName = 'ISNULL' then
+ Result := _TField.IsNull
+ else if PropName = 'SIZE' then
+ Result := _TField.Size
+ else if PropName = 'VALUE' then
+ Result := _TField.Value
+ else if PropName = 'OLDVALUE' then
+ Result := _TField.OldValue
+ end
+ else if ClassType = TDataSet then
+ begin
+ _TDataSet := TDataSet(Instance);
+ if PropName = 'BOF' then
+ Result := _TDataSet.Bof
+ else if PropName = 'EOF' then
+ Result := _TDataSet.Eof
+ else if PropName = 'FIELDCOUNT' then
+ Result := _TDataSet.FieldCount
+ else if PropName = 'FIELDDEFS' then
+ Result := frxInteger(_TDataSet.FieldDefs)
+ else if PropName = 'FIELDS' then
+ Result := frxInteger(_TDataSet.Fields)
+ else if PropName = 'FILTER' then
+ Result := _TDataSet.Filter
+ else if PropName = 'FILTERED' then
+ Result := _TDataSet.Filtered
+ else if PropName = 'FILTEROPTIONS' then
+ Result := FilterOptionsToInt(_TDataSet.FilterOptions)
+ else if PropName = 'ACTIVE' then
+ Result := _TDataSet.Active
+ end
+ else if ClassType = TParam then
+ begin
+ _TParam := TParam(Instance);
+ if PropName = 'BOUND' then
+ Result := _TParam.Bound
+ else if PropName = 'ISNULL' then
+ Result := _TParam.IsNull
+ else if PropName = 'TEXT' then
+ Result := _TParam.Text
+ else if PropName = 'ASBOOLEAN' then
+ Result := _TParam.AsBoolean
+ else if PropName = 'ASCURRENCY' then
+ Result := _TParam.AsCurrency
+ else if PropName = 'ASDATETIME' then
+ Result := _TParam.AsDateTime
+ else if PropName = 'ASFLOAT' then
+ Result := _TParam.AsFloat
+ else if PropName = 'ASINTEGER' then
+ Result := _TParam.AsInteger
+ else if PropName = 'ASDATE' then
+ Result := _TParam.AsDate
+ else if PropName = 'ASTIME' then
+ Result := _TParam.AsTime
+ else if PropName = 'ASSTRING' then
+ Result := _TParam.AsString
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+var
+ _TField: TField;
+ _TParam: TParam;
+ _TDataSet: TDataSet;
+
+ function IntToFilterOptions(i: Integer): TFilterOptions;
+ begin
+ Result := [];
+ if (i and 1) <> 0 then
+ Result := Result + [foCaseInsensitive];
+ if (i and 2) <> 0 then
+ Result := Result + [foNoPartialCompare];
+ end;
+
+begin
+ if ClassType = TField then
+ begin
+ _TField := TField(Instance);
+ if PropName = 'ASBOOLEAN' then
+ _TField.AsBoolean := Value
+ else if PropName = 'ASCURRENCY' then
+ _TField.AsCurrency := Value
+ else if PropName = 'ASDATETIME' then
+ _TField.AsDateTime := Value
+ else if PropName = 'ASFLOAT' then
+ _TField.AsFloat := Value
+ else if PropName = 'ASINTEGER' then
+ _TField.AsInteger := Value
+ else if PropName = 'ASSTRING' then
+ _TField.AsString := Value
+ else if PropName = 'ASVARIANT' then
+ _TField.AsVariant := Value
+ else if PropName = 'VALUE' then
+ _TField.Value := Value
+ else if PropName = 'SIZE' then
+ _TField.Size := Value
+ end
+ else if ClassType = TDataSet then
+ begin
+ _TDataSet := TDataSet(Instance);
+ if PropName = 'FILTER' then
+ _TDataSet.Filter := Value
+ else if PropName = 'FILTERED' then
+ _TDataSet.Filtered := Value
+ else if PropName = 'FILTEROPTIONS' then
+ _TDataSet.FilterOptions := IntToFilterOptions(Value)
+ else if PropName = 'ACTIVE' then
+ _TDataSet.Active := Value
+ end
+ else if ClassType = TParam then
+ begin
+ _TParam := TParam(Instance);
+ if PropName = 'ASBOOLEAN' then
+ _TParam.AsBoolean := Value
+ else if PropName = 'ASCURRENCY' then
+ _TParam.AsCurrency := Value
+ else if PropName = 'ASDATETIME' then
+ _TParam.AsDateTime := Value
+ else if PropName = 'ASFLOAT' then
+ _TParam.AsFloat := Value
+ else if PropName = 'ASINTEGER' then
+ _TParam.AsInteger := Value
+ else if PropName = 'ASDATE' then
+ _TParam.AsDate := Value
+ else if PropName = 'ASTIME' then
+ _TParam.AsTime := Value
+ else if PropName = 'ASSTRING' then
+ _TParam.AsString := Value
+ else if PropName = 'BOUND' then
+ _TParam.Bound := Value
+ else if PropName = 'TEXT' then
+ _TParam.Text := Value
+ end
+end;
+
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsDBRTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/fs_idialogsrtti.pas b/LibD28/fs_idialogsrtti.pas
new file mode 100644
index 0000000..6f9a406
--- /dev/null
+++ b/LibD28/fs_idialogsrtti.pas
@@ -0,0 +1,167 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Dialogs.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_idialogsrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, fs_iclassesrtti
+{$IFDEF DELPHI16}
+, System.UITypes
+{$ENDIF}
+{$IFDEF CLX}
+, QDialogs
+{$ELSE}
+, Dialogs
+{$ENDIF}
+{$IFDEF Delphi16}
+ , System.Types
+{$ENDIF}
+{$IFDEF DELPHI16}, Controls{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsDialogsRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+{$IFDEF CLX}
+ THackDialog = class(TDialog);
+{$ELSE}
+ THackDialog = class(TCommonDialog);
+{$ENDIF}
+
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+type
+ TWordSet = set of 0..15;
+ PWordSet = ^TWordSet;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+var
+ dlg: String;
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnumSet('TOpenOptions', 'ofReadOnly, ofOverwritePrompt, ofHideReadOnly,' +
+ 'ofNoChangeDir, ofShowHelp, ofNoValidate, ofAllowMultiSelect,' +
+ 'ofExtensionDifferent, ofPathMustExist, ofFileMustExist, ofCreatePrompt,' +
+ 'ofShareAware, ofNoReadOnlyReturn, ofNoTestFileCreate, ofNoNetworkButton,' +
+ 'ofNoLongNames, ofOldStyleDialog, ofNoDereferenceLinks, ofEnableIncludeNotify,' +
+ 'ofEnableSizing');
+ AddEnum('TFileEditStyle', 'fsEdit, fsComboBox');
+ AddEnumSet('TColorDialogOptions', 'cdFullOpen, cdPreventFullOpen, cdShowHelp,' +
+ 'cdSolidColor, cdAnyColor');
+ AddEnumSet('TFontDialogOptions', 'fdAnsiOnly, fdTrueTypeOnly, fdEffects,' +
+ 'fdFixedPitchOnly, fdForceFontExist, fdNoFaceSel, fdNoOEMFonts,' +
+ 'fdNoSimulations, fdNoSizeSel, fdNoStyleSel, fdNoVectorFonts,' +
+ 'fdShowHelp, fdWysiwyg, fdLimitSize, fdScalableOnly, fdApplyButton');
+ AddEnum('TFontDialogDevice', 'fdScreen, fdPrinter, fdBoth');
+ AddEnum('TPrintRange', 'prAllPages, prSelection, prPageNums');
+ AddEnumSet('TPrintDialogOptions', 'poPrintToFile, poPageNums, poSelection,' +
+ 'poWarning, poHelp, poDisablePrintToFile');
+{$IFNDEF CLX}
+ AddEnum('TMsgDlgType', 'mtWarning, mtError, mtInformation, mtConfirmation, mtCustom');
+ AddEnumSet('TMsgDlgButtons', 'mbYes, mbNo, mbOK, mbCancel, mbAbort, mbRetry, ' +
+ 'mbIgnore, mbAll, mbNoToAll, mbYesToAll, mbHelp');
+{$ELSE}
+ AddEnum('TMsgDlgType', 'mtCustom, mtInformation, mtWarning, mtError, mtConfirmation');
+ AddEnumSet('TMsgDlgButtons', 'mbNone, mbOk, mbCancel, mbYes, mbNo, mbAbort, ' +
+ 'mbRetry, mbIgnore');
+{$ENDIF}
+
+{$IFDEF CLX}
+ dlg := 'TDialog';
+ with AddClass(TDialog, 'TComponent') do
+{$ELSE}
+ dlg := 'TCommonDialog';
+ with AddClass(TCommonDialog, 'TComponent') do
+{$ENDIF}
+ AddMethod('function Execute: Boolean', CallMethod);
+ AddClass(TOpenDialog, dlg);
+ AddClass(TSaveDialog, dlg);
+ AddClass(TColorDialog, dlg);
+ AddClass(TFontDialog, dlg);
+{$IFNDEF CLX}
+ {$IFNDEF FPC}
+ // todo: wait lazarus 1.0 TPrintDialog is targeted in Mantis to 1.0
+ AddClass(TPrintDialog, dlg);
+ AddClass(TPrinterSetupDialog, dlg);
+ {$ENDIF}
+{$ENDIF}
+ AddMethod('function MessageDlg(Msg: string; DlgType: TMsgDlgType; Buttons: TMsgDlgButtons; HelpCtx: Longint): Integer', CallMethod, 'ctOther');
+ AddMethod('function InputBox(ACaption, APrompt, ADefault: string): string', CallMethod, 'ctOther');
+ AddMethod('function InputQuery(ACaption, APrompt: string; var Value: string): Boolean', CallMethod, 'ctOther');
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ s: String;
+ b: TMsgDlgButtons;
+begin
+ Result := 0;
+
+{$IFDEF CLX}
+ if ClassType = TDialog then
+{$ELSE}
+ if ClassType = TCommonDialog then
+{$ENDIF}
+ begin
+ if MethodName = 'EXECUTE' then
+ Result := THackDialog(Instance).Execute
+ end
+ else if MethodName = 'INPUTBOX' then
+ Result := InputBox(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'INPUTQUERY' then
+ begin
+ s := Caller.Params[2];
+ Result := InputQuery(Caller.Params[0], Caller.Params[1], s);
+ Caller.Params[2] := s;
+ end
+ else if MethodName = 'MESSAGEDLG' then
+ begin
+ Word(PWordSet(@b)^) := Caller.Params[2];
+ Result := MessageDlg(Caller.Params[0], Caller.Params[1], b, Caller.Params[3]);
+ end
+end;
+
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsDialogsRTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
\ No newline at end of file
diff --git a/LibD28/fs_idisp.pas b/LibD28/fs_idisp.pas
new file mode 100644
index 0000000..a361d8a
--- /dev/null
+++ b/LibD28/fs_idisp.pas
@@ -0,0 +1,136 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ OLE dispatch module }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_idisp;
+
+interface
+
+{$I fs.inc}
+
+uses
+ Windows, Classes, SysUtils, ActiveX, ComObj, fs_iinterpreter
+{$IFDEF Delphi6}
+, Variants
+{$ENDIF};
+
+
+type
+ TfsOLEHelper = class(TfsCustomHelper)
+ private
+ function DispatchInvoke(const ParamArray: Variant; ParamCount: Integer;
+ Flags: Word): Variant;
+ protected
+ procedure SetValue(const Value: Variant); override;
+ function GetValue: Variant; override;
+ public
+ constructor Create(const AName: String);
+ end;
+
+
+implementation
+
+
+constructor TfsOLEHelper.Create(const AName: String);
+begin
+ inherited Create(AName, fvtVariant, '');
+end;
+
+function TfsOLEHelper.DispatchInvoke(const ParamArray: Variant; ParamCount: Integer;
+ Flags: Word): Variant;
+const
+ DispIDArgs: Longint = DISPID_PROPERTYPUT;
+var
+ DispId: TDispId;
+ Params: TDISPPARAMS;
+ pName: WideString;
+ ExcepMess: WideString;
+ Args: array[0..63] of Variant;
+ i: Integer;
+ PResult: PVariant;
+ Status: Integer;
+ ExcepInfo: TExcepInfo;
+begin
+ ExcepMess := '';
+ pName := WideString(Name);
+ IDispatch(ParentValue).GetIDsOfNames(GUID_NULL, @pName, 1, GetThreadLocale, @DispId);
+
+ for i := 0 to ParamCount - 1 do
+ Args[i] := ParamArray[ParamCount - i - 1];
+
+ Params.rgvarg := @Args;
+ Params.rgdispidNamedArgs := nil;
+ Params.cArgs := ParamCount;
+ Params.cNamedArgs := 0;
+ if (Flags = DISPATCH_PROPERTYPUT) or (Flags = DISPATCH_PROPERTYPUTREF) then
+ begin
+ Params.rgdispidNamedArgs := @DispIDArgs;
+ Params.cNamedArgs := 1;
+ end;
+
+ if NeedResult and (Flags <> DISPATCH_PROPERTYPUT) and (Flags <> DISPATCH_PROPERTYPUTREF) then
+ PResult := @Result else
+ PResult := nil;
+ if PResult <> nil then
+ VarClear(PResult^);
+ if (Flags = DISPATCH_METHOD) {and (ParamCount = 0)} and (PResult <> nil) then
+ Flags := DISPATCH_METHOD or DISPATCH_PROPERTYGET;
+
+ Status := IDispatch(ParentValue).Invoke(DispId, GUID_NULL, 0,
+ Flags, Params, PResult, @ExcepInfo, nil);
+ if Status <> 0 then
+ begin
+ if ExcepInfo.bstrSource <> '' then
+ ExcepMess := #13+#10 + 'Source :: '+ ExcepInfo.bstrSource;
+ if ExcepInfo.bstrDescription <> '' then
+ ExcepMess := ExcepMess + #13#10 + 'Description :: '+ ExcepInfo.bstrDescription;
+ if ExcepInfo.bstrHelpFile <> '' then
+ ExcepMess := ExcepMess + #13#10 + 'Help File :: '+ ExcepInfo.bstrHelpFile;
+{$IFDEF Delphi12}
+ raise Exception.Create('OLE error ' + IntToHex(Status, 8) + ': ' +
+ String(Name) + ': ' + SysErrorMessage(Status) + ExcepMess);
+{$ELSE}
+ raise Exception.Create('OLE error ' + IntToHex(Status, 8) + ': ' +
+ Name + ': ' + SysErrorMessage(Status) + ExcepMess);
+{$ENDIF}
+ end;
+end;
+
+procedure TfsOLEHelper.SetValue(const Value: Variant);
+var
+ i: Integer;
+ v: Variant;
+ Flag: Word;
+begin
+ v := VarArrayCreate([0, Count], varVariant);
+ for i := 0 to Count - 1 do
+ v[i] := Params[i].Value;
+ v[Count] := Value;
+ Flag := DISPATCH_PROPERTYPUT;
+ if VarType(Value) = varDispatch then
+ Flag := DISPATCH_PROPERTYPUTREF;
+ DispatchInvoke(v, Count + 1, Flag);
+ ParentValue := Null;
+end;
+
+function TfsOLEHelper.GetValue: Variant;
+var
+ i: Integer;
+ v: Variant;
+begin
+ v := VarArrayCreate([0, Count - 1], varVariant);
+ for i := 0 to Count - 1 do
+ v[i] := Params[i].Value;
+
+ Result := DispatchInvoke(v, Count, DISPATCH_METHOD);
+ ParentValue := Null;
+end;
+
+end.
diff --git a/LibD28/fs_ievents.pas b/LibD28/fs_ievents.pas
new file mode 100644
index 0000000..310d117
--- /dev/null
+++ b/LibD28/fs_ievents.pas
@@ -0,0 +1,201 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Standard events }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_ievents;
+
+interface
+
+{$i fs.inc}
+
+uses SysUtils, Classes, fs_iinterpreter
+{$IFDEF CLX}
+, QControls, QForms
+{$ELSE}
+, Controls, Forms
+{$ENDIF};
+
+type
+ TfsNotifyEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsMouseEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsMouseMoveEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; Shift: TShiftState; X, Y: Integer);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsKeyEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var Key: Word; Shift: TShiftState);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsKeyPressEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var Key: Char);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsCloseEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var Action: TCloseAction);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsCloseQueryEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var CanClose: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+ TfsCanResizeEvent = class(TfsCustomEvent)
+ public
+ procedure DoEvent(Sender: TObject; var NewWidth, NewHeight: Integer;
+ var Resize: Boolean);
+ function GetMethod: Pointer; override;
+ end;
+
+
+implementation
+
+
+type
+ TByteSet = set of 0..7;
+ PByteSet = ^TByteSet;
+
+
+{ TfsNotifyEvent }
+
+procedure TfsNotifyEvent.DoEvent(Sender: TObject);
+begin
+ CallHandler([Sender]);
+end;
+
+function TfsNotifyEvent.GetMethod: Pointer;
+begin
+ Result := @TfsNotifyEvent.DoEvent;
+end;
+
+{ TfsMouseEvent }
+
+procedure TfsMouseEvent.DoEvent(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+var
+ b: Byte;
+begin
+ b := Byte(PByteSet(@Shift)^);
+ CallHandler([Sender, Integer(Button), b, X, Y]);
+end;
+
+function TfsMouseEvent.GetMethod: Pointer;
+begin
+ Result := @TfsMouseEvent.DoEvent;
+end;
+
+{ TfsMouseMoveEvent }
+
+procedure TfsMouseMoveEvent.DoEvent(Sender: TObject; Shift: TShiftState; X,
+ Y: Integer);
+var
+ b: Byte;
+begin
+ b := Byte(PByteSet(@Shift)^);
+ CallHandler([Sender, b, X, Y]);
+end;
+
+function TfsMouseMoveEvent.GetMethod: Pointer;
+begin
+ Result := @TfsMouseMoveEvent.DoEvent;
+end;
+
+{ TfsKeyEvent }
+
+procedure TfsKeyEvent.DoEvent(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+var
+ b: Byte;
+begin
+ b := Byte(PByteSet(@Shift)^);
+ CallHandler([Sender, Key, b]);
+ Key := Handler.Params[1].Value;
+end;
+
+function TfsKeyEvent.GetMethod: Pointer;
+begin
+ Result := @TfsKeyEvent.DoEvent;
+end;
+
+{ TfsKeyPressEvent }
+
+procedure TfsKeyPressEvent.DoEvent(Sender: TObject; var Key: Char);
+begin
+ CallHandler([Sender, Key]);
+ Key := String(Handler.Params[1].Value)[1];
+end;
+
+function TfsKeyPressEvent.GetMethod: Pointer;
+begin
+ Result := @TfsKeyPressEvent.DoEvent;
+end;
+
+{ TfsCloseEvent }
+
+procedure TfsCloseEvent.DoEvent(Sender: TObject; var Action: TCloseAction);
+begin
+ CallHandler([Sender, Integer(Action)]);
+ Action := Handler.Params[1].Value;
+end;
+
+function TfsCloseEvent.GetMethod: Pointer;
+begin
+ Result := @TfsCloseEvent.DoEvent;
+end;
+
+{ TfsCloseQueryEvent }
+
+procedure TfsCloseQueryEvent.DoEvent(Sender: TObject; var CanClose: Boolean);
+begin
+ CallHandler([Sender, CanClose]);
+ CanClose := Handler.Params[1].Value;
+end;
+
+function TfsCloseQueryEvent.GetMethod: Pointer;
+begin
+ Result := @TfsCloseQueryEvent.DoEvent;
+end;
+
+{ TfsCanResizeEvent }
+
+procedure TfsCanResizeEvent.DoEvent(Sender: TObject; var NewWidth,
+ NewHeight: Integer; var Resize: Boolean);
+begin
+ CallHandler([Sender, NewWidth, NewHeight, Resize]);
+ NewWidth := Handler.Params[1].Value;
+ NewHeight := Handler.Params[2].Value;
+ Resize := Handler.Params[3].Value;
+end;
+
+function TfsCanResizeEvent.GetMethod: Pointer;
+begin
+ Result := @TfsCanResizeEvent.DoEvent;
+end;
+
+end.
\ No newline at end of file
diff --git a/LibD28/fs_iexpression.pas b/LibD28/fs_iexpression.pas
new file mode 100644
index 0000000..bc7cfdd
--- /dev/null
+++ b/LibD28/fs_iexpression.pas
@@ -0,0 +1,957 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Expression parser }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_iexpression;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter
+{$IFDEF Delphi6}
+, Variants
+{$ENDIF};
+{$ELSE}
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, System.Variants;
+{$ENDIF}
+
+
+type
+ { List of operators }
+
+ TfsOperatorType = (opNone, opGreat, opLess, opLessEq, opGreatEq, opNonEq, opEq,
+ opPlus, opMinus, opOr, opXor, opMul, opDivFloat, opDivInt, opMod, opAnd,
+ opShl, opShr, opLeftBracket, opRightBracket, opNot, opUnMinus, opIn, opIs);
+
+{ TfsExpression class holds a list of operands and operators.
+ List is represented in the tree form.
+ Call to methods AddXXX puts an expression element to the list.
+ Call to function Value calculates and returns the expression value }
+
+ TfsExpressionNode = class(TfsCustomVariable)
+ private
+ FLeft, FRight, FParent: TfsExpressionNode;
+ procedure AddNode(Node: TfsExpressionNode);
+ procedure RemoveNode(Node: TfsExpressionNode);
+ public
+ destructor Destroy; override;
+ function Priority: Integer; virtual; abstract;
+ end;
+
+ TfsOperandNode = class(TfsExpressionNode)
+ public
+ constructor Create(const AValue: Variant);
+ function Priority: Integer; override;
+ end;
+
+ TfsOperatorNode = class(TfsExpressionNode)
+ private
+ FOp: TfsOperatorType;
+ FOptimizeInt: Boolean;
+ FOptimizeBool: Boolean;
+ public
+ constructor Create(Op: TfsOperatorType);
+ function Priority: Integer; override;
+ end;
+
+ TfsDesignatorNode = class(TfsOperandNode)
+ private
+ FDesignator: TfsDesignator;
+ FVar: TfsCustomVariable;
+ protected
+ function GetValue: Variant; override;
+ public
+ constructor Create(ADesignator: TfsDesignator);
+ destructor Destroy; override;
+ end;
+
+ TfsSetNode = class(TfsOperandNode)
+ private
+ FSetExpression: TfsSetExpression;
+ protected
+ function GetValue: Variant; override;
+ public
+ constructor Create(ASet: TfsSetExpression);
+ destructor Destroy; override;
+ end;
+
+ TfsExpression = class(TfsCustomExpression)
+ private
+ FCurNode: TfsExpressionNode;
+ FNode: TfsExpressionNode;
+ FScript: TfsScript;
+ FSource: String;
+ procedure AddOperand(Node: TfsExpressionNode);
+ protected
+ function GetValue: Variant; override;
+ procedure SetValue(const Value: Variant); override;
+ public
+ constructor Create(Script: TfsScript);
+ destructor Destroy; override;
+ procedure AddConst(const AValue: Variant);
+ procedure AddConstWithType(const AValue: Variant; aTyp: TfsVarType);
+ procedure AddDesignator(ADesignator: TfsDesignator);
+ procedure AddOperator(const Op: String);
+ procedure AddSet(ASet: TfsSetExpression);
+
+ function Finalize: String;
+ function Optimize(Designator: TfsDesignator): String;
+ function SingleItem: TfsCustomVariable;
+
+ property Source: String read FSource write FSource;
+ end;
+
+
+implementation
+
+//VCL uses section
+{$IFNDEF FMX}
+uses fs_itools;
+//FMX uses section
+{$ELSE}
+uses FMX.fs_itools;
+{$ENDIF}
+
+type
+ TNoneNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TGreatNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TLessNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TLessEqNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TGreatEqNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TNonEqNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TEqNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TPlusNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TStrCatNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TMinusNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TOrNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TXorNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TMulNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TDivFloatNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TDivIntNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TModNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TAndNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TShlNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TShrNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TLeftBracketNode = class(TfsOperatorNode);
+
+ TRightBracketNode = class(TfsOperatorNode);
+
+ TNotNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TUnMinusNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TInNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+ TIsNode = class(TfsOperatorNode)
+ protected
+ function GetValue: Variant; override;
+ end;
+
+
+function TNoneNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+end;
+
+function TGreatNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ Result := Result > FRight.Value;
+end;
+
+function TLessNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ Result := Result < FRight.Value;
+end;
+
+function TLessEqNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ Result := Result <= FRight.Value;
+end;
+
+function TGreatEqNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ Result := Result >= FRight.Value;
+end;
+
+function TNonEqNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ Result := Result <> FRight.Value;
+end;
+
+function TEqNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ Result := Result = FRight.Value;
+end;
+
+function TPlusNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ {$IFDEF FPC}
+ if TVarData(Result).Vtype = varEmpty then
+ Result := 0;
+ {$ENDIF}
+ Result := Result + FRight.Value;
+end;
+
+function TStrCatNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ if (TVarData(Result).VType = varString){$IFDEF Delphi12} or (TVarData(Result).VType = varUString){$ENDIF} then
+ Result := VarToStr(Result) + VarToStr(FRight.Value) else
+ Result := Result + FRight.Value;
+end;
+
+function TMinusNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ if FOptimizeInt then
+ Result := frxInteger(Result) - frxInteger(FRight.Value)
+ else
+ begin
+ {$IFDEF FPC}
+ if TVarData(Result).Vtype = varEmpty then
+ Result := 0;
+ {$ENDIF}
+ Result := Result - FRight.Value;
+ end;
+end;
+
+function TOrNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+
+ if FOptimizeBool then
+ begin
+ if Boolean(Result) = False then
+ Result := FRight.Value;
+ end
+ else
+ Result := Result or FRight.Value;
+end;
+
+function TXorNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ Result := Result xor FRight.Value;
+end;
+
+function TMulNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ if FOptimizeInt then
+ Result := frxInteger(Result) * frxInteger(FRight.Value)
+ else
+ begin
+ {$IFDEF FPC}
+ if TVarData(Result).Vtype = varEmpty then
+ Result := 0;
+ {$ENDIF}
+ Result := Result * FRight.Value;
+ end;
+end;
+
+function TDivFloatNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ {$IFDEF FPC}
+ if TVarData(Result).Vtype = varEmpty then
+ Result := 0;
+ {$ENDIF}
+ Result := Result / FRight.Value;
+end;
+
+function TDivIntNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ if FOptimizeInt then
+ Result := frxInteger(Result) div frxInteger(FRight.Value)
+ else
+ begin
+ {$IFDEF FPC}
+ if TVarData(Result).Vtype = varEmpty then
+ Result := 0;
+ {$ENDIF}
+ Result := Result div FRight.Value;
+ end;
+end;
+
+function TModNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ if FOptimizeInt then
+ Result := frxInteger(Result) mod frxInteger(FRight.Value)
+ else
+ begin
+ {$IFDEF FPC}
+ if TVarData(Result).Vtype = varEmpty then
+ Result := 0;
+ {$ENDIF}
+ Result := Result mod FRight.Value;
+ end;
+end;
+
+function TAndNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ if FOptimizeBool then
+ begin
+ if Boolean(Result) = True then
+ Result := FRight.Value;
+ end
+ else
+ Result := Result and FRight.Value;
+end;
+
+function TShlNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ Result := Result shl FRight.Value;
+end;
+
+function TShrNode.GetValue: Variant;
+begin
+ Result := FLeft.Value;
+ Result := Result shr FRight.Value;
+end;
+
+function TNotNode.GetValue: Variant;
+begin
+ Result := not FLeft.Value;
+end;
+
+function TUnMinusNode.GetValue: Variant;
+begin
+ Result := -FLeft.Value;
+end;
+
+function TInNode.GetValue: Variant;
+var
+ i: Integer;
+ ar, val, selfVal: Variant;
+ Count: Integer;
+begin
+ if FRight is TfsSetNode then
+ Result := TfsSetNode(FRight).FSetExpression.Check(FLeft.Value)
+ else
+ begin
+ Result := False;
+ ar := FRight.Value;
+ Count := VarArrayHighBound(ar, 1);
+ selfVal := FLeft.Value;
+
+ i := 0;
+ while i <= Count do
+ begin
+ val := ar[i];
+ Result := selfVal = val;
+ if (i < Count - 1) and (ar[i + 1] = Null) and not Result then { subrange }
+ begin
+ Result := (selfVal >= val) and (selfVal <= ar[i + 2]);
+ Inc(i, 2);
+ end;
+
+ if Result then break;
+ Inc(i);
+ end;
+ end;
+end;
+
+function TIsNode.GetValue: Variant;
+begin
+ Result := TObject(frxInteger(FLeft.Value)) is
+ TfsClassVariable(TfsDesignatorNode(FRight).FDesignator[0].Ref).ClassRef;
+end;
+
+
+{ TfsExpressionNode }
+
+destructor TfsExpressionNode.Destroy;
+begin
+ FLeft.Free;
+ FRight.Free;
+ inherited;
+end;
+
+procedure TfsExpressionNode.AddNode(Node: TfsExpressionNode);
+begin
+ if FLeft = nil then
+ FLeft := Node
+ else if FRight = nil then
+ FRight := Node;
+ if Node <> nil then
+ Node.FParent := Self;
+end;
+
+procedure TfsExpressionNode.RemoveNode(Node: TfsExpressionNode);
+begin
+ if FLeft = Node then
+ FLeft := nil
+ else if FRight = Node then
+ FRight := nil;
+end;
+
+
+{ TfsOperandNode }
+
+constructor TfsOperandNode.Create(const AValue: Variant);
+var
+ t: TfsVarType;
+begin
+{$IFDEF CPUX64}
+ inherited Create('', fvtInt64, '');
+{$ELSE}
+ inherited Create('', fvtInt, '');
+{$ENDIF}
+ Value := AValue;
+
+ t := fvtInt;
+ if TVarData(AValue).VType = varBoolean then
+ t := fvtBool
+ else if TVarData(AValue).VType in [varSingle, varDouble, varCurrency] then
+ t := fvtFloat
+{$IFDEF FS_INT64}
+ else if (TVarData(AValue).VType = varInt64) then
+ t := fvtInt64
+{$ENDIF}
+ else if (TVarData(AValue).VType = varOleStr) or
+ (TVarData(AValue).VType = varString){$IFDEF Delphi12} or (TVarData(AValue).VType = varUString){$ENDIF} then
+ t := fvtString;
+
+ Typ := t;
+end;
+
+function TfsOperandNode.Priority: Integer;
+begin
+ Result := 0;
+end;
+
+
+{ TfsOperatorNode }
+
+constructor TfsOperatorNode.Create(Op: TfsOperatorType);
+begin
+{$IFDEF CPUX64}
+ inherited Create('', fvtInt64, '');
+{$ELSE}
+ inherited Create('', fvtInt, '');
+{$ENDIF}
+ FOp := Op;
+end;
+
+function TfsOperatorNode.Priority: Integer;
+begin
+ case FOp of
+ opNone:
+ Result := 7;
+ opLeftBracket:
+ Result := 6;
+ opRightBracket:
+ Result := 5;
+ opGreat, opLess, opGreatEq, opLessEq, opNonEq, opEq, opIn, opIs:
+ Result := 4;
+ opPlus, opMinus, opOr, opXor:
+ Result := 3;
+ opMul, opDivFloat, opDivInt, opMod, opAnd, opShr, opShl:
+ Result := 2;
+ opNot, opUnMinus:
+ Result := 1;
+ else
+ Result := 0;
+ end;
+end;
+
+
+{ TfsDesignatorNode }
+
+constructor TfsDesignatorNode.Create(ADesignator: TfsDesignator);
+begin
+ inherited Create(0);
+ FDesignator := ADesignator;
+ Typ := ADesignator.Typ;
+ TypeName := ADesignator.TypeName;
+ if FDesignator is TfsVariableDesignator then
+ FVar := FDesignator.RefItem else
+ FVar := FDesignator;
+end;
+
+destructor TfsDesignatorNode.Destroy;
+begin
+ FDesignator.Free;
+ inherited;
+end;
+
+function TfsDesignatorNode.GetValue: Variant;
+begin
+ Result := FVar.Value;
+end;
+
+
+{ TfsSetNode }
+
+constructor TfsSetNode.Create(ASet: TfsSetExpression);
+begin
+ inherited Create(0);
+ FSetExpression := ASet;
+ Typ := fvtVariant;
+end;
+
+destructor TfsSetNode.Destroy;
+begin
+ FSetExpression.Free;
+ inherited;
+end;
+
+function TfsSetNode.GetValue: Variant;
+begin
+ Result := FSetExpression.Value;
+end;
+
+
+{ TfsExpression }
+
+constructor TfsExpression.Create(Script: TfsScript);
+begin
+{$IFDEF CPUX64}
+ inherited Create('', fvtInt64, '');
+{$ELSE}
+ inherited Create('', fvtInt, '');
+{$ENDIF}
+ FNode := TNoneNode.Create(opNone);
+ FCurNode := FNode;
+ FScript := Script;
+end;
+
+destructor TfsExpression.Destroy;
+begin
+ FNode.Free;
+ inherited;
+end;
+
+function TfsExpression.GetValue: Variant;
+begin
+ Result := FNode.Value;
+end;
+
+procedure TfsExpression.AddOperand(Node: TfsExpressionNode);
+begin
+ FCurNode.AddNode(Node);
+ FCurNode := Node;
+end;
+
+procedure TfsExpression.AddOperator(const Op: String);
+var
+ Node: TfsExpressionNode;
+ n, n1: TfsExpressionNode;
+
+ function CreateOperatorNode(s: String): TfsOperatorNode;
+ begin
+ s := AnsiUpperCase(s);
+ if s = ' ' then
+ Result := TNoneNode.Create(opNone)
+ else if s = '>' then
+ Result := TGreatNode.Create(opGreat)
+ else if s = '<' then
+ Result := TLessNode.Create(opLess)
+ else if s = '<=' then
+ Result := TLessEqNode.Create(opLessEq)
+ else if s = '>=' then
+ Result := TGreatEqNode.Create(opGreatEq)
+ else if s = '<>' then
+ Result := TNonEqNode.Create(opNonEq)
+ else if s = '=' then
+ Result := TEqNode.Create(opEq)
+ else if s = '+' then
+ Result := TPlusNode.Create(opPlus)
+ else if s = 'STRCAT' then
+ Result := TStrCatNode.Create(opPlus)
+ else if s = '-' then
+ Result := TMinusNode.Create(opMinus)
+ else if s = 'OR' then
+ Result := TOrNode.Create(opOr)
+ else if s = 'XOR' then
+ Result := TXorNode.Create(opXor)
+ else if s = '*' then
+ Result := TMulNode.Create(opMul)
+ else if s = '/' then
+ Result := TDivFloatNode.Create(opDivFloat)
+ else if s = 'DIV' then
+ Result := TDivIntNode.Create(opDivInt)
+ else if s = 'MOD' then
+ Result := TModNode.Create(opMod)
+ else if s = 'AND' then
+ Result := TAndNode.Create(opAnd)
+ else if s = 'SHL' then
+ Result := TShlNode.Create(opShl)
+ else if s = 'SHR' then
+ Result := TShrNode.Create(opShr)
+ else if s = '(' then
+ Result := TLeftBracketNode.Create(opLeftBracket)
+ else if s = ')' then
+ Result := TRightBracketNode.Create(opRightBracket)
+ else if s = 'NOT' then
+ Result := TNotNode.Create(opNot)
+ else if s = 'UNMINUS' then
+ Result := TUnMinusNode.Create(opUnMinus)
+ else if s = 'IN' then
+ Result := TInNode.Create(opIn)
+ else if s = 'IS' then
+ Result := TIsNode.Create(opIs)
+ else
+ Result := nil;
+ end;
+
+begin
+ Node := CreateOperatorNode(Op);
+ Node.SourcePos := SourcePos;
+
+ if (Op = '(') or (Op = 'unminus') or (Op = 'not') then
+ AddOperand(Node)
+ else if Op = ')' then
+ begin
+ n := FCurNode;
+ while n.Priority <= Node.Priority do
+ n := n.FParent;
+
+ n.FParent.RemoveNode(n);
+ n.FParent.AddNode(n.FLeft);
+
+ Node.Free;
+ Node := n.FLeft;
+ n.FLeft := nil;
+ n.Free;
+ end
+ else if FCurNode = FNode then
+ FNode.AddNode(Node)
+ else
+ begin
+ n := FCurNode;
+ n1 := nil;
+ if FCurNode.Priority <> 6 then
+ begin
+ n := FCurNode.FParent;
+ n1 := FCurNode;
+ end;
+
+ while n.Priority <= Node.Priority do
+ begin
+ n1 := n;
+ n := n.FParent;
+ end;
+
+ n.RemoveNode(n1);
+ n.AddNode(Node);
+ Node.AddNode(n1);
+ end;
+
+ FCurNode := Node;
+end;
+
+procedure TfsExpression.AddConst(const AValue: Variant);
+var
+ Node: TfsOperandNode;
+begin
+ Node := TfsOperandNode.Create(AValue);
+ Node.SourcePos := SourcePos;
+ AddOperand(Node);
+end;
+
+procedure TfsExpression.AddConstWithType(const AValue: Variant;
+ aTyp: TfsVarType);
+begin
+ AddConst(AValue);
+ if aTyp = fvtClass then
+ FCurNode.Typ := fvtVariant;
+end;
+
+procedure TfsExpression.AddDesignator(ADesignator: TfsDesignator);
+var
+ Node: TfsDesignatorNode;
+begin
+ Node := TfsDesignatorNode.Create(ADesignator);
+ Node.SourcePos := SourcePos;
+ AddOperand(Node);
+end;
+
+procedure TfsExpression.AddSet(ASet: TfsSetExpression);
+var
+ Node: TfsSetNode;
+begin
+ Node := TfsSetNode.Create(ASet);
+ Node.SourcePos := SourcePos;
+ AddOperand(Node);
+end;
+
+function TfsExpression.Finalize: String;
+var
+ ErrorPos: String;
+ TypeRec: TfsTypeRec;
+
+ function GetType(Item: TfsExpressionNode): TfsTypeRec;
+ var
+ Typ1, Typ2: TfsTypeRec;
+ op: TfsOperatorType;
+ Error: Boolean;
+ begin
+ if Item = nil then
+ Result.Typ := fvtVariant
+ else if Item is TfsOperandNode then
+ begin
+ Result.Typ := Item.Typ;
+ Result.TypeName := Item.TypeName;
+ end
+ else
+ begin
+ Typ1 := GetType(Item.FLeft);
+ Typ2 := GetType(Item.FRight);
+// if (Typ1.Typ = fvtInt) and (Typ2.Typ = fvtInt) then
+// TfsOperatorNode(Item).FOptimizeInt := True;
+ if (Typ1.Typ = fvtBool) and (Typ2.Typ = fvtBool) then
+ TfsOperatorNode(Item).FOptimizeBool := True;
+
+ op := TfsOperatorNode(Item).FOp;
+
+ if (op = opIs) and (Typ1.Typ = fvtClass) and (Typ2.Typ = fvtClass) then
+ Error := False
+ else
+ begin
+ { check types compatibility }
+ Error := not TypesCompatible(Typ1, Typ2, FScript);
+ { check operators applicability }
+ if not Error then
+ case Typ1.Typ of
+ fvtBool:
+ Error := not (op in [opNonEq, opEq, opOr, opXor, opAnd, opNot]);
+ fvtChar, fvtString:
+ Error := not (op in [opGreat, opLess, opLessEq, opGreatEq, opNonEq, opEq, opPlus, opIn]);
+ fvtClass, fvtArray:
+ Error := not (op in [opNonEq, opEq]);
+ end;
+ end;
+
+ if not Error then
+ begin
+ Result := Typ1;
+ { if one type is Float, resulting type is float too }
+ if [Typ1.Typ] + [Typ2.Typ] = [fvtInt, fvtFloat] then
+ Result.Typ := fvtFloat;
+ { case int / int = float }
+ if (Typ1.Typ = fvtInt) and (Typ2.Typ = fvtInt) and (op = opDivFloat) then
+ Result.Typ := fvtFloat;
+{$IFDEF FS_INT64}
+ if [Typ1.Typ] + [Typ2.Typ] = [fvtInt64, fvtFloat] then
+ Result.Typ := fvtFloat;
+ { case int / int = float }
+ if ((Typ1.Typ = fvtInt64) or (Typ1.Typ = fvtInt))
+ and ((Typ2.Typ = fvtInt64) or (Typ2.Typ = fvtInt64)) and (op = opDivFloat) then
+ Result.Typ := fvtFloat;
+{$ENDIF}
+ { result of comparing two types is always boolean }
+ if op in [opGreat, opLess, opLessEq, opGreatEq, opNonEq, opEq, opIn, opIs] then
+ Result.Typ := fvtBool;
+ end
+ else if ErrorPos = '' then
+ ErrorPos := Item.SourcePos;
+
+ Item.Typ := Result.Typ;
+ end;
+ end;
+
+begin
+ { remove the empty root node }
+ FCurNode := FNode.FLeft;
+ FNode.RemoveNode(FCurNode);
+ FNode.Free;
+ FNode := FCurNode;
+
+ { check and get the expression type }
+ ErrorPos := '';
+ TypeRec := GetType(FNode);
+ Typ := TypeRec.Typ;
+ TypeName := TypeRec.TypeName;
+ Result := ErrorPos;
+
+ { expression is assignable if it has only one node of type "Variable" }
+ if not ((FNode is TfsDesignatorNode) and not
+ (TfsDesignatorNode(FNode).FDesignator.IsReadOnly)) then
+ IsReadOnly := True;
+end;
+
+procedure TfsExpression.SetValue(const Value: Variant);
+begin
+ if not IsReadOnly then
+ TfsDesignatorNode(FNode).FDesignator.Value := Value;
+end;
+
+function TfsExpression.Optimize(Designator: TfsDesignator): String;
+var
+ Op: TfsOperatorType;
+begin
+ Result := ' ';
+
+ if not (Designator is TfsVariableDesignator) or
+ not (FNode is TfsOperatorNode) then Exit;
+
+ Op := TfsOperatorNode(FNode).FOp;
+ if not (Op in [opPlus, opMinus, opDivFloat, opMul]) then Exit;
+
+ { optimize a := a op b statement }
+ if (FNode.FLeft is TfsDesignatorNode) and
+ (TfsDesignatorNode(FNode.FLeft).FDesignator is TfsVariableDesignator) and
+ (TfsDesignatorNode(FNode.FLeft).FDesignator.RefItem = Designator.RefItem) then
+ begin
+ FCurNode := FNode.FRight;
+ FNode.RemoveNode(FCurNode);
+ FNode.Free;
+ FNode := FCurNode;
+
+ if Op = opPlus then
+ Result := '+'
+ else if Op = opMinus then
+ Result := '-'
+ else if Op = opDivFloat then
+ Result := '/'
+ else if Op = opMul then
+ Result := '*';
+ end
+ { optimize a := b op a statement }
+ else if (FNode.FRight is TfsDesignatorNode) and
+ (TfsDesignatorNode(FNode.FRight).FDesignator is TfsVariableDesignator) and
+ (TfsDesignatorNode(FNode.FRight).FDesignator.RefItem = Designator.RefItem) and
+ (Op in [opPlus, opMul]) and
+ not (Designator.RefItem.Typ in [fvtString, fvtVariant]) then
+ begin
+ FCurNode := FNode.FLeft;
+ FNode.RemoveNode(FCurNode);
+ FNode.Free;
+ FNode := FCurNode;
+
+ if Op = opPlus then
+ Result := '+'
+ else if Op = opMul then
+ Result := '*';
+ end;
+end;
+
+function TfsExpression.SingleItem: TfsCustomVariable;
+begin
+ { if expression contains only one item, returns reference to it }
+ Result := nil;
+
+ if FNode is TfsDesignatorNode then
+ begin
+ if TfsDesignatorNode(FNode).FDesignator is TfsVariableDesignator then
+ Result := TfsDesignatorNode(FNode).FDesignator.RefItem else
+ Result := TfsDesignatorNode(FNode).FDesignator;
+ end
+ else if FNode is TfsOperandNode then
+ Result := FNode;
+end;
+
+end.
diff --git a/LibD28/fs_iextctrlsrtti.pas b/LibD28/fs_iextctrlsrtti.pas
new file mode 100644
index 0000000..4de9bc2
--- /dev/null
+++ b/LibD28/fs_iextctrlsrtti.pas
@@ -0,0 +1,434 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ ExtCtrls }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_iextctrlsrtti;
+
+interface
+
+{$i fs.inc}
+
+uses SysUtils, Classes, fs_iinterpreter, fs_ievents, fs_iformsrtti
+{$IFDEF DELPHI16}
+, System.Types
+{$ENDIF}
+{$IFDEF CLX}
+, QExtCtrls, QButtons, QCheckLst, QComCtrls
+{$ELSE}
+, ExtCtrls, Buttons, CheckLst, ComCtrls
+{$ENDIF}
+{$IFDEF DELPHI16}, Controls{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsExtCtrlsRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TShapeType', 'stRectangle, stSquare, stRoundRect, stRoundSquare,' +
+ 'stEllipse, stCircle');
+ AddEnum('TBevelStyle', 'bsLowered, bsRaised');
+ AddEnum('TBevelShape', 'bsBox, bsFrame, bsTopLine, bsBottomLine, bsLeftLine,' +
+ 'bsRightLine, bsSpacer');
+ AddEnum('TResizeStyle', 'rsNone, rsLine, rsUpdate, rsPattern');
+ AddEnum('TButtonLayout', 'blGlyphLeft, blGlyphRight, blGlyphTop, blGlyphBottom');
+ AddEnum('TButtonState', 'bsUp, bsDisabled, bsDown, bsExclusive');
+ AddEnum('TButtonStyle', 'bsAutoDetect, bsWin31, bsNew');
+ AddEnum('TBitBtnKind', 'bkCustom, bkOK, bkCancel, bkHelp, bkYes, bkNo,' +
+ 'bkClose, bkAbort, bkRetry, bkIgnore, bkAll');
+ AddType('TNumGlyphs', fvtInt);
+ AddEnum('TTabPosition', 'tpTop, tpBottom, tpLeft, tpRight');
+ AddEnum('TTabStyle', 'tsTabs, tsButtons, tsFlatButtons');
+ AddEnum('TStatusPanelStyle', 'psText, psOwnerDraw');
+ AddEnum('TStatusPanelBevel', 'pbNone, pbLowered, pbRaised');
+ AddEnum('TSortType', 'stNone, stData, stText, stBoth');
+ AddEnum('TTrackBarOrientation', 'trHorizontal, trVertical');
+ AddEnum('TTickMark', 'tmBottomRight, tmTopLeft, tmBoth');
+ AddEnum('TTickStyle', 'tsNone, tsAuto, tsManual');
+ AddEnum('TProgressBarOrientation', 'pbHorizontal, pbVertical');
+ AddEnum('TIconArrangement', 'iaTop, iaLeft');
+ AddEnum('TListArrangement', 'arAlignBottom, arAlignLeft, arAlignRight,' +
+ 'arAlignTop, arDefault, arSnapToGrid');
+ AddEnum('TViewStyle', 'vsIcon, vsSmallIcon, vsList, vsReport');
+ AddEnum('TToolButtonStyle', 'tbsButton, tbsCheck, tbsDropDown, tbsSeparator, tbsDivider');
+ AddEnum('TDateTimeKind', 'dtkDate, dtkTime');
+ AddEnum('TDTDateMode', 'dmComboBox, dmUpDown');
+ AddEnum('TDTDateFormat', 'dfShort, dfLong');
+ AddEnum('TDTCalAlignment', 'dtaLeft, dtaRight');
+ AddEnum('TCalDayOfWeek', 'dowMonday, dowTuesday, dowWednesday, dowThursday,' +
+ 'dowFriday, dowSaturday, dowSunday, dowLocaleDefault');
+
+ AddClass(TShape, 'TGraphicControl');
+ with AddClass(TPaintBox, 'TGraphicControl') do
+ AddEvent('OnPaint', TfsNotifyEvent);
+ AddClass(TImage, 'TGraphicControl');
+ AddClass(TBevel, 'TGraphicControl');
+ with AddClass(TTimer, 'TComponent') do
+ AddEvent('OnTimer', TfsNotifyEvent);
+ AddClass(TPanel, 'TCustomControl');
+ AddClass(TSplitter, 'TGraphicControl');
+ AddClass(TBitBtn, 'TButton');
+ AddClass(TSpeedButton, 'TGraphicControl');
+ with AddClass(TCheckListBox, 'TCustomListBox') do
+ AddIndexProperty('Checked', 'Integer', 'Boolean', CallMethod);
+ AddClass(TTabControl, 'TWinControl');
+ with AddClass(TTabSheet, 'TWinControl') do
+ AddProperty('PageControl', 'TPageControl', GetProp, SetProp);
+ with AddClass(TPageControl, 'TWinControl') do
+ begin
+ AddMethod('procedure SelectNextPage(GoForward: Boolean)', CallMethod);
+ AddProperty('PageCount', 'Integer', GetProp, nil);
+ AddIndexProperty('Pages', 'Integer', 'TTabSheet', CallMethod, True);
+ end;
+ AddClass(TStatusPanel, 'TPersistent');
+ with AddClass(TStatusPanels, 'TPersistent') do
+ begin
+ AddMethod('function Add: TStatusPanel', CallMethod);
+ AddIndexProperty('Items', 'Integer', 'TStatusPanel', CallMethod, True);
+ end;
+ AddClass(TStatusBar, 'TWinControl');
+ with AddClass(TTreeNode, 'TPersistent') do
+ begin
+ AddMethod('procedure Delete', CallMethod);
+ AddMethod('function EditText: Boolean', CallMethod);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddProperty('Data', 'Pointer', GetProp, SetProp);
+ AddProperty('ImageIndex', 'Integer', GetProp, SetProp);
+ AddProperty('SelectedIndex', 'Integer', GetProp, SetProp);
+ AddProperty('StateIndex', 'Integer', GetProp, SetProp);
+ AddProperty('Text', 'String', GetProp, SetProp);
+ end;
+ with AddClass(TTreeNodes, 'TPersistent') do
+ begin
+ AddMethod('function Add(Node: TTreeNode; const S: string): TTreeNode', CallMethod);
+ AddMethod('function AddChild(Node: TTreeNode; const S: string): TTreeNode', CallMethod);
+ AddMethod('procedure BeginUpdate', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure Delete(Node: TTreeNode)', CallMethod);
+ AddMethod('procedure EndUpdate', CallMethod);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddDefaultProperty('Item', 'Integer', 'TTreeNode', CallMethod, True);
+ end;
+ with AddClass(TTreeView, 'TWinControl') do
+ begin
+ AddMethod('procedure FullCollapse', CallMethod);
+ AddMethod('procedure FullExpand', CallMethod);
+ AddProperty('Items', 'TTreeNodes', GetProp, nil);
+ AddProperty('Selected', 'TTreeNode', GetProp, SetProp);
+ AddProperty('TopItem', 'TTreeNode', GetProp, SetProp);
+ end;
+ AddClass(TTrackBar, 'TWinControl');
+ AddClass(TProgressBar, 'TWinControl');
+ AddClass(TListColumn, 'TPersistent');
+ with AddClass(TListColumns, 'TPersistent') do
+ begin
+ AddMethod('function Add: TListColumn', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TListColumn', CallMethod, True);
+ end;
+ with AddClass(TListItem, 'TPersistent') do
+ begin
+ AddMethod('procedure Delete', CallMethod);
+ AddMethod('function EditCaption: Boolean', CallMethod);
+ AddProperty('Caption', 'String', GetProp, SetProp);
+ AddProperty('Checked', 'Boolean', GetProp, SetProp);
+ AddProperty('Data', 'Pointer', GetProp, SetProp);
+ AddProperty('ImageIndex', 'Integer', GetProp, SetProp);
+ AddProperty('Selected', 'Boolean', GetProp, SetProp);
+ AddProperty('StateIndex', 'Integer', GetProp, SetProp);
+ AddProperty('SubItems', 'TStrings', GetProp, SetProp);
+ end;
+ with AddClass(TListItems, 'TPersistent') do
+ begin
+ AddMethod('function Add: TListItem', CallMethod);
+ AddMethod('procedure BeginUpdate', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure Delete(Index: Integer)', CallMethod);
+ AddMethod('procedure EndUpdate', CallMethod);
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddDefaultProperty('Item', 'Integer', 'TListItem', CallMethod, True);
+ end;
+{$IFNDEF FPC}
+ AddClass(TIconOptions, 'TPersistent');
+{$ENDIF}
+ AddClass(TListView, 'TWinControl');
+ AddClass(TToolButton, 'TGraphicControl');
+ AddClass(TToolBar, 'TWinControl');
+{$IFNDEF CLX}
+ {$IFNDEF FPC}
+ AddClass(TMonthCalColors, 'TPersistent');
+ AddClass(TDateTimePicker, 'TWinControl');
+ AddClass(TMonthCalendar, 'TWinControl');
+ AddClass(TCustomRichEdit, 'TWinControl');
+ AddClass(TRichEdit, 'TCustomRichEdit');
+ {$ENDIF}
+{$ENDIF}
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TCheckListBox then
+ begin
+ if MethodName = 'CHECKED.GET' then
+ Result := TCheckListBox(Instance).Checked[Caller.Params[0]]
+ else if MethodName = 'CHECKED.SET' then
+ TCheckListBox(Instance).Checked[Caller.Params[0]] := Caller.Params[1]
+ end
+ else if ClassType = TPageControl then
+ begin
+ if MethodName = 'SELECTNEXTPAGE' then
+ TPageControl(Instance).SelectNextPage(Caller.Params[0])
+ else if MethodName = 'PAGES.GET' then
+ Result := frxInteger(TPageControl(Instance).Pages[Caller.Params[0]])
+ end
+ else if ClassType = TStatusPanels then
+ begin
+ if MethodName = 'ADD' then
+ Result := frxInteger(TStatusPanels(Instance).Add)
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TStatusPanels(Instance).Items[Caller.Params[0]])
+ end
+ else if ClassType = TTreeNode then
+ begin
+ if MethodName = 'DELETE' then
+ TTreeNode(Instance).Delete
+ else if MethodName = 'EDITTEXT' then
+ Result := TTreeNode(Instance).EditText
+ end
+ else if ClassType = TTreeNodes then
+ begin
+ if MethodName = 'ADD' then
+ Result := frxInteger(TTreeNodes(Instance).Add(TTreeNode(frxInteger(Caller.Params[0])),
+ Caller.Params[1]))
+ else if MethodName = 'ADDCHILD' then
+ Result := frxInteger(TTreeNodes(Instance).AddChild(TTreeNode(frxInteger(Caller.Params[0])),
+ Caller.Params[1]))
+ else if MethodName = 'BEGINUPDATE' then
+ TTreeNodes(Instance).BeginUpdate
+ else if MethodName = 'CLEAR' then
+ TTreeNodes(Instance).Clear
+ else if MethodName = 'DELETE' then
+ TTreeNodes(Instance).Delete(TTreeNode(frxInteger(Caller.Params[0])))
+ else if MethodName = 'ENDUPDATE' then
+ TTreeNodes(Instance).EndUpdate
+ else if MethodName = 'ITEM.GET' then
+ Result := frxInteger(TTreeNodes(Instance).Item[Caller.Params[0]])
+ end
+ else if ClassType = TTreeView then
+ begin
+ if MethodName = 'FULLCOLLAPSE' then
+ TTreeView(Instance).FullCollapse
+ else if MethodName = 'FULLEXPAND' then
+ TTreeView(Instance).FullExpand
+ end
+ else if ClassType = TListColumns then
+ begin
+ if MethodName = 'ADD' then
+ Result := frxInteger(TListColumns(Instance).Add)
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TListColumns(Instance).Items[Caller.Params[0]])
+ end
+ else if ClassType = TListItem then
+ begin
+ if MethodName = 'DELETE' then
+ TListItem(Instance).Delete
+{$IFNDEF CLX}
+ {$IFNDEF FPC}
+ else if MethodName = 'EDITCAPTION' then
+ Result := TListItem(Instance).EditCaption
+ {$ENDIF}
+{$ENDIF}
+ end
+ else if ClassType = TListItems then
+ begin
+ if MethodName = 'ADD' then
+ Result := frxInteger(TListItems(Instance).Add)
+{$IFNDEF FPC}
+ else if MethodName = 'BEGINUPDATE' then
+ TListItems(Instance).BeginUpdate
+{$ENDIF}
+ else if MethodName = 'CLEAR' then
+ TListItems(Instance).Clear
+ else if MethodName = 'DELETE' then
+ TListItems(Instance).Delete(Caller.Params[0])
+{$IFNDEF FPC}
+ else if MethodName = 'ENDUPDATE' then
+ TListItems(Instance).EndUpdate
+{$ENDIF}
+ else if MethodName = 'ITEM.GET' then
+ Result := frxInteger(TListItems(Instance).Item[Caller.Params[0]])
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TPageControl then
+ begin
+ if PropName = 'PAGECOUNT' then
+ Result := TPageControl(Instance).PageCount
+ end
+ else if ClassType = TTabSheet then
+ begin
+ if PropName = 'PAGECONTROL' then
+ Result := frxInteger(TTabSheet(Instance).PageControl)
+ end
+ else if ClassType = TTreeNode then
+ begin
+ if PropName = 'COUNT' then
+ Result := TTreeNode(Instance).Count
+ else if PropName = 'DATA' then
+ Result := frxInteger(TTreeNode(Instance).Data)
+ else if PropName = 'IMAGEINDEX' then
+ Result := TTreeNode(Instance).ImageIndex
+ else if PropName = 'SELECTEDINDEX' then
+ Result := TTreeNode(Instance).SelectedIndex
+{$IFNDEF CLX}
+ else if PropName = 'STATEINDEX' then
+ Result := TTreeNode(Instance).StateIndex
+{$ENDIF}
+ else if PropName = 'TEXT' then
+ Result := TTreeNode(Instance).Text
+ end
+ else if ClassType = TTreeNodes then
+ begin
+ if PropName = 'COUNT' then
+ Result := TTreeNodes(Instance).Count
+ end
+ else if ClassType = TTreeView then
+ begin
+ if PropName = 'ITEMS' then
+ Result := frxInteger(TTreeView(Instance).Items)
+ else if PropName = 'SELECTED' then
+ Result := frxInteger(TTreeView(Instance).Selected)
+ else if PropName = 'TOPITEM' then
+ Result := frxInteger(TTreeView(Instance).TopItem)
+ end
+ else if ClassType = TListItem then
+ begin
+ if PropName = 'CAPTION' then
+ Result := TListItem(Instance).Caption
+ else if PropName = 'CHECKED' then
+ Result := TListItem(Instance).Checked
+ else if PropName = 'DATA' then
+ Result := frxInteger(TListItem(Instance).Data)
+ else if PropName = 'IMAGEINDEX' then
+ Result := TListItem(Instance).ImageIndex
+ else if PropName = 'SELECTED' then
+ Result := TListItem(Instance).Selected
+{$IFNDEF CLX}
+ {$IFNDEF FPC}
+ else if PropName = 'STATEINDEX' then
+ Result := TListItem(Instance).StateIndex
+ {$ENDIF}
+{$ENDIF}
+ else if PropName = 'SUBITEMS' then
+ Result := frxInteger(TListItem(Instance).SubItems)
+ end
+ else if ClassType = TListItems then
+ begin
+ if PropName = 'COUNT' then
+ Result := TListItems(Instance).Count
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TTabSheet then
+ begin
+ if PropName = 'PAGECONTROL' then
+ TTabSheet(Instance).PageControl := TPageControl(frxInteger(Value))
+ end
+ else if ClassType = TTreeNode then
+ begin
+ if PropName = 'DATA' then
+ TTreeNode(Instance).Data := Pointer(frxInteger(Value))
+ else if PropName = 'IMAGEINDEX' then
+ TTreeNode(Instance).ImageIndex := frxInteger(Value)
+ else if PropName = 'SELECTEDINDEX' then
+ TTreeNode(Instance).SelectedIndex := Value
+{$IFNDEF CLX}
+ else if PropName = 'STATEINDEX' then
+ TTreeNode(Instance).StateIndex := Value
+{$ENDIF}
+ else if PropName = 'TEXT' then
+ TTreeNode(Instance).Text := Value
+ end
+ else if ClassType = TTreeView then
+ begin
+ if PropName = 'SELECTED' then
+ TTreeView(Instance).Selected := TTreeNode(frxInteger(Value))
+ else if PropName = 'TOPITEM' then
+ TTreeView(Instance).TopItem := TTreeNode(frxInteger(Value))
+ end
+ else if ClassType = TListItem then
+ begin
+ if PropName = 'CAPTION' then
+ TListItem(Instance).Caption := Value
+ else if PropName = 'CHECKED' then
+ TListItem(Instance).Checked := Value
+ else if PropName = 'DATA' then
+ TListItem(Instance).Data := Pointer(frxInteger(Value))
+ else if PropName = 'IMAGEINDEX' then
+ TListItem(Instance).ImageIndex := Integer(Value)
+ else if PropName = 'SELECTED' then
+ TListItem(Instance).Selected := Value
+{$IFNDEF CLX}
+ {$IFNDEF FPC}
+ else if PropName = 'STATEINDEX' then
+ TListItem(Instance).StateIndex := Value
+ {$ENDIF}
+{$ENDIF}
+ else if PropName = 'SUBITEMS' then
+ TListItem(Instance).SubItems := TStrings(frxInteger(Value))
+ end
+end;
+
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsExtCtrlsRTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/fs_ifdreg.dcr b/LibD28/fs_ifdreg.dcr
new file mode 100644
index 0000000..2d43261
Binary files /dev/null and b/LibD28/fs_ifdreg.dcr differ
diff --git a/LibD28/fs_ifdreg.pas b/LibD28/fs_ifdreg.pas
new file mode 100644
index 0000000..6778e38
--- /dev/null
+++ b/LibD28/fs_ifdreg.pas
@@ -0,0 +1,33 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2019 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_ifdreg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ Classes, DesignIntf, Controls, fs_ifdrtti;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+ RegisterComponents('FastScript', [TfsFDRTTI]);
+end;
+
+end.
diff --git a/LibD28/fs_ifdrtti.pas b/LibD28/fs_ifdrtti.pas
new file mode 100644
index 0000000..0b76bb0
--- /dev/null
+++ b/LibD28/fs_ifdrtti.pas
@@ -0,0 +1,391 @@
+{**********************************************}
+{ }
+{ FastScript v1.9 }
+{ FireDac classes and functions }
+{ }
+{ (c) 2003-2014 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{ Copyright (c) 2018 by Stalker SoftWare }
+{ }
+{ }
+{**********************************************}
+
+unit fs_iFDRTTI;
+
+interface
+
+{$i fs.inc}
+{$IF CompilerVersion <= 24} //XE3 or older
+ {$DEFINE ANYDAC}
+{$IFEND}
+uses
+ SysUtils, Classes, DB, Types, Controls, fs_iinterpreter, fs_itools, fs_idbrtti,
+ {$IFDEF ANYDAC}
+ uADCompClient, uADStanOption, uADCompDataSet, uADStanParam;
+ {$ELSE}
+ FireDAC.DatS, FireDAC.Comp.DataSet, FireDAC.Comp.Client, FireDAC.Stan.Param;
+ {$ENDIF}
+
+
+
+type
+{$IFDEF ANYDAC}
+ TFDDataSetLocateOptions = TADDataSetLocateOptions;
+ TFDCopyDataSetOptions = TADCopyDataSetOptions;
+{$ENDIF}
+
+{$i frxPlatformsAttribute.inc}
+ TfsFDRTTI = class(TComponent); // fake component
+
+ function IntToFDDataSetLocateOptions(i :Integer) :TFDDataSetLocateOptions; forward;
+ function IntToFDCopyDataSetOptions(i :Integer) :TFDCopyDataSetOptions; forward;
+
+implementation
+
+type
+{$IFDEF ANYDAC}
+ TFDCustomConnection = TADCustomConnection;
+ TFDConnection = TADConnection;
+ TFDParam = TADParam;
+ TFDMacro = TADMacro;
+ TFDDataset = TADDataset;
+ TFDTable = TADTable;
+ TFDQuery = TADQuery;
+ TFDMemTable = TADMemTable;
+ TFDStoredProc = TADStoredProc;
+ TFDAdaptedDataSet = TADAdaptedDataset;
+ TFDRdbmsDataSet = TADRdbmsDataSet;
+ TFDManager = TADManager;
+ TFDBlobStream = TADBlobStream;
+{$ENDIF}
+ TfsFDRTTIFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass; const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass; const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass; const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+{ TfsFDRTTIFunctions }
+
+{-------------------------------------------------------------------------------}
+constructor TfsFDRTTIFunctions.Create(AScript: TfsScript);
+begin
+
+ inherited Create(AScript);
+
+ with AScript do begin
+
+ AddClass(TFDManager, 'TComponent');
+
+ with AddClass(TFDBlobStream, 'TMemoryStream') do begin
+ AddConstructor('constructor Create(Field :TBlobField; Mode :TBlobStreamMode)', CallMethod);
+ AddMethod('procedure LoadFromFile(const FileName :String)', CallMethod);
+ AddMethod('procedure LoadFromStream(Stream :TStream)', CallMethod);
+ AddMethod('procedure SaveToStream(Stream :TStream)', CallMethod);
+ AddMethod('procedure SaveToFile(const FileName :String)', CallMethod);
+ end; { with }
+
+ with AddClass(TFDConnection, 'TComponent') do begin
+ AddMethod('procedure StartTransaction', CallMethod);
+ AddMethod('procedure Commit', CallMethod);
+ AddMethod('procedure Rollback', CallMethod);
+ AddProperty('InTransaction', 'Boolean', GetProp, nil);
+ end; { with }
+
+ AddEnumSet('TFDDataSetLocateOptions' ,'lxoCaseInsensitive, lxoPartialKey, lxoFromCurrent, lxoBackward, lxoCheckOnly, lxoNoFetchAll');
+ AddEnumSet('TFDCopyDataSetOptions' ,'coStructure, coCalcFields, coIndexesReset, coIndexesCopy, coConstraintsReset, coConstraintsCopy, ' +
+ 'coAggregatesReset, coAggregatesCopy, coRestart, coAppend, coEdit, ' + {$IFDEF Delphi22} 'coDelete, ' + {$ENDIF} 'coRefresh');
+
+ with AddClass(TFDDataSet, 'TDataSet') do begin
+ AddMethod('function LocateEx(const AKeyFields :String; const AKeyValues :Variant; AOptions :TFDDataSetLocateOptions) :Boolean', CallMethod);
+ AddMethod('function LocateExpr(const AExpression :String; AOptions :TFDDataSetLocateOptions) :Boolean', CallMethod);
+ AddMethod('procedure FetchAll', CallMethod);
+ AddMethod('function CreateBlobStream(Field :TField; Mode :TBlobStreamMode) :TStream', CallMethod);
+ AddMethod('function FindField(const FieldName :String) :TField', CallMethod);
+ AddMethod('procedure CopyDataSet(ASource :TDataset; AOptions :TFDCopyDataSetOptions)', CallMethod);
+ AddMethod('procedure SetFDData(ASource :TFDDataSet)', CallMethod);
+ AddProperty('RecNo', 'LongInt', GetProp, SetProp);
+ AddProperty('RecordCount', 'LongInt', GetProp, nil);
+ AddProperty('FieldDefs', 'TFieldDefs', GetProp, SetProp);
+ end; { with }
+
+ AddClass(TFDAdaptedDataSet, 'TFDDataSet');
+ AddClass(TFDRdbmsDataSet, 'TFDAdaptedDataSet');
+ AddClass(TFDParam, 'TCollectionItem');
+ AddClass(TFDMacro, 'TCollectionItem');
+
+ with AddClass(TFDQuery, 'TFDRdbmsDataSet') do begin
+ AddMethod('procedure ExecSQL', CallMethod);
+ AddMethod('function ParamByName(const Value :String) :TFDParam', CallMethod);
+ AddMethod('procedure Prepare', CallMethod);
+ AddMethod('function MacroByName(const Value :String) :TFDMacro', CallMethod);
+ AddMethod('function OpenOrExecute: Boolean', CallMethod); {added by fduenas}
+ AddProperty('ParamCount', 'Word', GetProp, nil);
+ AddProperty('MacroCount', 'Word', GetProp, nil);
+ end; { with }
+
+ with AddClass(TFDMemTable, 'TFDAdaptedDataSet') do begin
+ AddMethod('procedure CreateDataSet', CallMethod);
+ AddMethod('procedure Refresh', CallMethod);
+ end; { with }
+
+ with AddClass(TFDStoredProc, 'TFDRdbmsDataSet') do begin
+ AddMethod('procedure ExecProc', CallMethod);
+ AddMethod('function ParamByName(const Value :string) :TFDParam', CallMethod);
+ AddMethod('procedure Prepare', CallMethod);
+ AddMethod('function OpenOrExecute: Boolean', CallMethod); {added by fduenas}
+ AddMethod('function ExecFunc: Variant', CallMethod); {added by fduenas}
+ AddProperty('ParamCount', 'Word', GetProp, nil);
+ end;
+
+ end; { with }
+
+end; { Create }
+
+{-------------------------------------------------------------------------------}
+function TfsFDRTTIFunctions.CallMethod(Instance: TObject; ClassType: TClass; const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+
+ Result := 0;
+
+ if ClassType = TFDBlobStream then begin
+
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TFDBlobStream.Create(TBlobField(frxInteger(Caller.Params[0])), Caller.Params[1]))
+ else
+ if MethodName = 'LOADFROMFILE' then
+ TFDBlobStream(Instance).LoadFromFile(Caller.Params[0])
+ else
+ if MethodName = 'LOADFROMSTREAM' then
+ TFDBlobStream(Instance).LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else
+ if MethodName = 'SAVETOFILE' then
+ TFDBlobStream(Instance).SaveToFile(Caller.Params[0])
+ else
+ if MethodName = 'SAVETOSTREAM' then
+ TFDBlobStream(Instance).SaveToStream(TStream(frxInteger(Caller.Params[0])))
+
+ end else
+ if ClassType = TFDConnection then begin
+
+ if MethodName = 'STARTTRANSACTION' then
+ TFDConnection(Instance).StartTransaction
+ else
+ if MethodName = 'COMMIT' then
+ TFDConnection(Instance).Commit
+ else
+ if MethodName = 'ROLLBACK' then
+ TFDConnection(Instance).Rollback
+
+ end else
+ if ClassType = TFDDataSet then begin
+
+ if MethodName = 'LOCATEEX' then
+ Result := TFDDataSet(Instance).LocateEx(Caller.Params[0], Caller.Params[1], IntToFDDataSetLocateOptions(Caller.Params[2]))
+ else
+ if MethodName = 'LOCATEEXPR' then
+ Result := TFDDataSet(Instance).LocateEx(Caller.Params[0], IntToFDDataSetLocateOptions(Caller.Params[1]))
+ else
+ if MethodName = 'FETCHALL' then
+ TFDDataSet(Instance).FetchAll
+ else
+ if MethodName = 'CREATEBLOBSTREAM' then
+ Result := frxInteger(TFDDataSet(Instance).CreateBlobStream(TField(frxInteger(Caller.Params[0])), Caller.Params[1]))
+ else
+ if MethodName = 'FINDFIELD' then
+ Result := frxInteger(TFDDataSet(Instance).FindField(Caller.Params[0]))
+ else
+ if MethodName = 'COPYDATASET' then
+ TFDDataSet(Instance).CopyDataSet(TDataSet(frxInteger(Caller.Params[0])), IntToFDCopyDataSetOptions(Caller.Params[1]))
+ else
+ if MethodName = 'SETFDDATA' then
+ TFDDataSet(Instance).Data := TFDDataSet(frxInteger(Caller.Params[0])).Data;
+
+ end else
+ if ClassType = TFDQuery then begin
+
+ if MethodName = 'EXECSQL' then
+ TFDQuery(Instance).ExecSQL
+ else
+ if MethodName = 'PARAMBYNAME' then
+ Result := frxInteger(TFDQuery(Instance).ParamByName(Caller.Params[0]))
+ else
+ if MethodName = 'PREPARE' then
+ TFDQuery(Instance).Prepare
+ else
+ if MethodName = 'MACROBYNAME' then
+ Result := frxInteger(TFDQuery(Instance).MacroByName(Caller.Params[0]))
+ else
+ if MethodName = 'OPENOREXECUTE' then
+ Result := TFDQuery(Instance).OpenOrExecute; {added by fduenas}
+
+ end else
+ if ClassType = TFDMemTable then begin
+
+ if MethodName = 'CREATEDATASET' then
+ TFDMemTable(Instance).CreateDataSet()
+ else
+ if MethodName = 'REFRESH' then
+ TFDMemTable(Instance).Refresh()
+
+ end else
+ if ClassType = TFDStoredProc then begin
+
+ if MethodName = 'EXECPROC' then
+ TFDStoredProc(Instance).ExecProc
+ else
+ if MethodName = 'PARAMBYNAME' then
+ Result := frxInteger(TFDStoredProc(Instance).ParamByName(Caller.Params[0]))
+ else
+ if MethodName = 'PREPARE' then
+ TFDStoredProc(Instance).Prepare
+ else
+ if MethodName = 'OPENOREXECUTE' then
+ Result := TFDStoredProc(Instance).OpenOrExecute {added by fduenas}
+ else
+ if MethodName = 'EXECFUNC' then
+ Result := TFDStoredProc(Instance).ExecFunc; {added by fduenas}
+
+ end; { if }
+
+end; { CallMethod }
+
+{-------------------------------------------------------------------------------}
+function TfsFDRTTIFunctions.GetProp(Instance: TObject; ClassType: TClass; const PropName: String): Variant;
+begin
+
+ Result := 0;
+
+ if ClassType = TFDConnection then begin
+
+ if PropName = 'INTRANSACTION' then
+ Result := TFDConnection(Instance).InTransaction
+
+ end else
+ if ClassType = TFDDataSet then begin
+
+ if PropName = 'RECNO' then
+ Result := TFDDataSet(Instance).RecNo
+ else
+ if PropName = 'RECORDCOUNT' then
+ Result := TFDDataSet(Instance).RecordCount
+
+ end else
+ if ClassType = TFDQuery then begin
+
+ if PropName = 'PARAMCOUNT' then
+ Result := TFDQuery(Instance).ParamCount
+ else
+ if PropName = 'MacroCount' then
+ Result := TFDQuery(Instance).MacroCount
+
+ end; { if }
+
+end; { GetProp }
+
+{-------------------------------------------------------------------------------}
+procedure TfsFDRTTIFunctions.SetProp(Instance: TObject; ClassType: TClass; const PropName: String; Value: Variant);
+begin
+
+ if ClassType = TFDDataSet then begin
+
+ if PropName = 'RECNO' then
+ TFDDataSet(Instance).RecNo := Value
+
+ end; { if }
+
+end; { SetProp }
+
+{-------------------------------------------------------------------------------}
+function IntToFDDataSetLocateOptions(i :Integer) :TFDDataSetLocateOptions;
+begin
+
+ Result := [];
+
+ if (i and 1) <> 0 then
+ Result := Result + [lxoCaseInsensitive];
+
+ if (i and 2) <> 0 then
+ Result := Result + [lxoPartialKey];
+
+ if (i and 4) <> 0 then
+ Result := Result + [lxoFromCurrent];
+
+ if (i and 8) <> 0 then
+ Result := Result + [lxoBackward];
+
+ if (i and 16) <> 0 then
+ Result := Result + [lxoCheckOnly];
+
+ if (i and 32) <> 0 then
+ Result := Result + [lxoNoFetchAll];
+
+end; { IntToFDDataSetLocateOptions }
+
+{-------------------------------------------------------------------------------}
+function IntToFDCopyDataSetOptions(i :Integer) :TFDCopyDataSetOptions;
+begin
+
+ Result := [];
+
+ if (i and 1) <> 0 then
+ Result := Result + [coStructure];
+
+ if (i and 2) <> 0 then
+ Result := Result + [coCalcFields];
+
+ if (i and 4) <> 0 then
+ Result := Result + [coIndexesReset];
+
+ if (i and 8) <> 0 then
+ Result := Result + [coIndexesCopy];
+
+ if (i and 16) <> 0 then
+ Result := Result + [coConstraintsReset];
+
+ if (i and 32) <> 0 then
+ Result := Result + [coConstraintsCopy];
+
+ if (i and 64) <> 0 then
+ Result := Result + [coAggregatesReset];
+
+ if (i and 128) <> 0 then
+ Result := Result + [coAggregatesCopy];
+
+ if (i and 256) <> 0 then
+ Result := Result + [coRestart];
+
+ if (i and 512) <> 0 then
+ Result := Result + [coAppend];
+
+ if (i and 1024) <> 0 then
+ Result := Result + [coEdit];
+{$IFDEF Delphi22}
+ if (i and 2048) <> 0 then
+ Result := Result + [coDelete];
+
+ if (i and 4096) <> 0 then
+ Result := Result + [coRefresh];
+{$ELSE}
+ if (i and 2048) <> 0 then
+ Result := Result + [coRefresh];
+{$ENDIF}
+
+end; { IntToFDCopyDataSetOptions }
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsFDRTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TfsFDRTTIFunctions);
+
+finalization
+ if fsRTTIModules <> nil then
+ fsRTTIModules.Remove(TfsFDRTTIFunctions);
+
+end.
diff --git a/LibD28/fs_iformsrtti.pas b/LibD28/fs_iformsrtti.pas
new file mode 100644
index 0000000..ddfe5da
--- /dev/null
+++ b/LibD28/fs_iformsrtti.pas
@@ -0,0 +1,439 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Forms and StdCtrls }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_iformsrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, fs_ievents, fs_iclassesrtti,
+ fs_igraphicsrtti
+{$IFDEF CLX}
+ , QControls, QForms, QStdCtrls
+{$ELSE}
+ {$IFNDEF FPC}
+ , Windows
+ {$ELSE}
+ , LCLType, Buttons
+ {$ENDIF}
+ , Controls, Forms, StdCtrls
+{$ENDIF}
+{$IFDEF Delphi16}
+ , System.Types
+{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsFormsRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddConst('mrNone', 'Integer', mrNone);
+ AddConst('mrOk', 'Integer', mrOk);
+ AddConst('mrCancel', 'Integer', mrCancel);
+ AddConst('mrAbort', 'Integer', mrAbort);
+ AddConst('mrRetry', 'Integer', mrRetry);
+ AddConst('mrIgnore', 'Integer', mrIgnore);
+ AddConst('mrYes', 'Integer', mrYes);
+ AddConst('mrNo', 'Integer', mrNo);
+ AddConst('mrAll', 'Integer', mrAll);
+ AddConst('mrNoToAll', 'Integer', mrNoToAll);
+ AddConst('mrYesToAll', 'Integer', mrYesToAll);
+
+ AddConst('crDefault', 'Integer', crDefault);
+ AddConst('crNone', 'Integer', crNone);
+ AddConst('crArrow', 'Integer', crArrow);
+ AddConst('crCross', 'Integer', crCross);
+ AddConst('crIBeam', 'Integer', crIBeam);
+ AddConst('crSize', 'Integer', crSize);
+ AddConst('crSizeNESW', 'Integer', crSizeNESW);
+ AddConst('crSizeNS', 'Integer', crSizeNS);
+ AddConst('crSizeNWSE', 'Integer', crSizeNWSE);
+ AddConst('crSizeWE', 'Integer', crSizeWE);
+ AddConst('crUpArrow', 'Integer', crUpArrow);
+ AddConst('crHourGlass', 'Integer', crHourGlass);
+ AddConst('crDrag', 'Integer', crDrag);
+ AddConst('crNoDrop', 'Integer', crNoDrop);
+ AddConst('crHSplit', 'Integer', crHSplit);
+ AddConst('crVSplit', 'Integer', crVSplit);
+ AddConst('crMultiDrag', 'Integer', crMultiDrag);
+ AddConst('crSQLWait', 'Integer', crSQLWait);
+ AddConst('crNo', 'Integer', crNo);
+ AddConst('crAppStart', 'Integer', crAppStart);
+ AddConst('crHelp', 'Integer', crHelp);
+ AddConst('crHandPoint', 'Integer', crHandPoint);
+ AddConst('crSizeAll', 'Integer', crSizeAll);
+
+{$IFDEF CLX}
+ AddConst('bsNone', 'Integer', fbsNone);
+ AddConst('bsSingle', 'Integer', fbsSingle);
+ AddConst('bsSizeable', 'Integer', fbsSizeable);
+ AddConst('bsDialog', 'Integer', fbsDialog);
+ AddConst('bsToolWindow', 'Integer', fbsToolWindow);
+ AddConst('bsSizeToolWin', 'Integer', fbsSizeToolWin);
+{$ELSE}
+ AddConst('bsNone', 'Integer', bsNone);
+ AddConst('bsSingle', 'Integer', bsSingle);
+ AddConst('bsSizeable', 'Integer', bsSizeable);
+ AddConst('bsDialog', 'Integer', bsDialog);
+ AddConst('bsToolWindow', 'Integer', bsToolWindow);
+ AddConst('bsSizeToolWin', 'Integer', bsSizeToolWin);
+{$ENDIF}
+
+{$IFNDEF CLX}
+ AddConst('VK_RBUTTON', 'Integer', VK_RBUTTON);
+ AddConst('VK_CANCEL', 'Integer', VK_CANCEL);
+ AddConst('VK_MBUTTON', 'Integer', VK_MBUTTON);
+ AddConst('VK_BACK', 'Integer', VK_BACK);//Backspace key
+ AddConst('VK_TAB', 'Integer', VK_TAB);//Tab key
+ AddConst('VK_RETURN', 'Integer', VK_RETURN);//Enter key
+ AddConst('VK_SHIFT', 'Integer', VK_SHIFT);//Shift key
+ AddConst('VK_CONTROL', 'Integer', VK_CONTROL);//Ctrl key
+ AddConst('VK_MENU', 'Integer', VK_MENU);//Alt key
+ AddConst('VK_PAUSE', 'Integer', VK_PAUSE);//Pause key
+ AddConst('VK_CAPITAL', 'Integer', VK_CAPITAL);//Caps Lock key
+ AddConst('VK_ESCAPE', 'Integer', VK_ESCAPE);//Esc key
+ AddConst('VK_SPACE', 'Integer', VK_SPACE);//Space bar
+ AddConst('VK_PRIOR', 'Integer', VK_PRIOR);//Page Up key
+ AddConst('VK_NEXT', 'Integer', VK_NEXT);// Page Down key
+ AddConst('VK_END', 'Integer', VK_END);// End key
+ AddConst('VK_HOME', 'Integer', VK_HOME);// Home key
+ AddConst('VK_LEFT', 'Integer', VK_LEFT);// Left Arrow key
+ AddConst('VK_UP', 'Integer', VK_UP);// Up Arrow key
+ AddConst('VK_RIGHT', 'Integer', VK_RIGHT);// Right Arrow key
+ AddConst('VK_DOWN', 'Integer', VK_DOWN);// Down Arrow key
+ AddConst('VK_INSERT', 'Integer', VK_INSERT);// Insert key
+ AddConst('VK_DELETE', 'Integer', VK_DELETE);// Delete key
+ AddConst('VK_HELP', 'Integer', VK_HELP);// Help key
+ AddConst('VK_LWIN', 'Integer', VK_LWIN);// Left Windows key (Microsoft keyboard)
+ AddConst('VK_RWIN', 'Integer', VK_RWIN);// Right Windows key (Microsoft keyboard)
+ AddConst('VK_APPS', 'Integer', VK_APPS);// Applications key (Microsoft keyboard)
+ AddConst('VK_NUMPAD0', 'Integer', VK_NUMPAD0);// 0 key (numeric keypad)
+ AddConst('VK_NUMPAD1', 'Integer', VK_NUMPAD1);// 1 key (numeric keypad)
+ AddConst('VK_NUMPAD2', 'Integer', VK_NUMPAD2);// 2 key (numeric keypad)
+ AddConst('VK_NUMPAD3', 'Integer', VK_NUMPAD3);// 3 key (numeric keypad)
+ AddConst('VK_NUMPAD4', 'Integer', VK_NUMPAD4);// 4 key (numeric keypad)
+ AddConst('VK_NUMPAD5', 'Integer', VK_NUMPAD5);// 5 key (numeric keypad)
+ AddConst('VK_NUMPAD6', 'Integer', VK_NUMPAD6);// 6 key (numeric keypad)
+ AddConst('VK_NUMPAD7', 'Integer', VK_NUMPAD7);// 7 key (numeric keypad)
+ AddConst('VK_NUMPAD8', 'Integer', VK_NUMPAD8);// 8 key (numeric keypad)
+ AddConst('VK_NUMPAD9', 'Integer', VK_NUMPAD9);// 9 key (numeric keypad)
+ AddConst('VK_MULTIPLY', 'Integer', VK_MULTIPLY);// Multiply key (numeric keypad)
+ AddConst('VK_ADD', 'Integer', VK_ADD);// Add key (numeric keypad)
+ AddConst('VK_SEPARATOR', 'Integer', VK_SEPARATOR);// Separator key (numeric keypad)
+ AddConst('VK_SUBTRACT', 'Integer', VK_SUBTRACT);// Subtract key (numeric keypad)
+ AddConst('VK_DECIMAL', 'Integer', VK_DECIMAL);// Decimal key (numeric keypad)
+ AddConst('VK_DIVIDE', 'Integer', VK_DIVIDE);// Divide key (numeric keypad)
+ AddConst('VK_F1', 'Integer', VK_F1);// F1 key
+ AddConst('VK_F2', 'Integer', VK_F2);// F2 key
+ AddConst('VK_F3', 'Integer', VK_F3);// F3 key
+ AddConst('VK_F4', 'Integer', VK_F4);// F4 key
+ AddConst('VK_F5', 'Integer', VK_F5);// F5 key
+ AddConst('VK_F6', 'Integer', VK_F6);// F6 key
+ AddConst('VK_F7', 'Integer', VK_F7);// F7 key
+ AddConst('VK_F8', 'Integer', VK_F8);// F8 key
+ AddConst('VK_F9', 'Integer', VK_F9);// F9 key
+ AddConst('VK_F10', 'Integer', VK_F10);// F10 key
+ AddConst('VK_F11', 'Integer', VK_F11);// F11 key
+ AddConst('VK_F12', 'Integer', VK_F12);// F12 key
+ AddConst('VK_NUMLOCK', 'Integer', VK_NUMLOCK);// Num Lock key
+ AddConst('VK_SCROLL', 'Integer', VK_SCROLL);// Scroll Lock key
+{$ENDIF}
+
+ AddConst('crDefault', 'Integer', crDefault);
+ AddConst('crNone', 'Integer', crNone);
+ AddConst('crArrow', 'Integer', crArrow);
+ AddConst('crCross', 'Integer', crCross);
+ AddConst('crIBeam', 'Integer', crIBeam);
+ AddConst('crSize', 'Integer', crSize);
+ AddConst('crSizeNESW', 'Integer', crSizeNESW);
+ AddConst('crSizeNS', 'Integer', crSizeNS);
+ AddConst('crSizeNWSE', 'Integer', crSizeNWSE);
+ AddConst('crSizeWE', 'Integer', crSizeWE);
+ AddConst('crUpArrow', 'Integer', crUpArrow);
+ AddConst('crHourGlass', 'Integer', crHourGlass);
+ AddConst('crDrag', 'Integer', crDrag);
+ AddConst('crNoDrop', 'Integer', crNoDrop);
+ AddConst('crHSplit', 'Integer', crHSplit);
+ AddConst('crVSplit', 'Integer', crVSplit);
+ AddConst('crMultiDrag', 'Integer', crMultiDrag);
+ AddConst('crSQLWait', 'Integer', crSQLWait);
+ AddConst('crNo', 'Integer', crNo);
+ AddConst('crAppStart', 'Integer', crAppStart);
+ AddConst('crHelp', 'Integer', crHelp);
+ AddConst('crHandPoint', 'Integer', crHandPoint);
+ AddConst('crSizeAll', 'Integer', crSizeAll);
+
+ AddType('TFormBorderStyle', fvtInt);
+ AddType('TBorderStyle', fvtInt);
+ AddType('TAlignment', fvtInt);
+ AddType('TLeftRight', fvtInt);
+ AddConst('taLeftJustify', 'Integer', taLeftJustify);
+ AddConst('taRightJustify', 'Integer', taRightJustify);
+ AddConst('taCenter', 'Integer', taCenter);
+
+ AddEnumSet('TShiftState', 'ssShift, ssAlt, ssCtrl, ssLeft, ssRight, ssMiddle, ssDouble');
+// AddEnum('TAlignment', 'taLeftJustify, taRightJustify, taCenter');
+ AddEnum('TAlign', 'alNone, alTop, alBottom, alLeft, alRight, alClient');
+ AddEnum('TMouseButton', 'mbLeft, mbRight, mbMiddle');
+ AddEnumSet('TAnchors', 'akLeft, akTop, akRight, akBottom');
+ AddEnum('TBevelCut', 'bvNone, bvLowered, bvRaised, bvSpace');
+ AddEnum('TTextLayout', 'tlTop, tlCenter, tlBottom');
+ AddEnum('TEditCharCase', 'ecNormal, ecUpperCase, ecLowerCase');
+ AddEnum('TScrollStyle', 'ssNone, ssHorizontal, ssVertical, ssBoth');
+ AddEnum('TComboBoxStyle', 'csDropDown, csSimple, csDropDownList, csOwnerDrawFixed, csOwnerDrawVariable');
+ AddEnum('TCheckBoxState', 'cbUnchecked, cbChecked, cbGrayed');
+ AddEnum('TListBoxStyle', 'lbStandard, lbOwnerDrawFixed, lbOwnerDrawVariable');
+ AddEnum('TWindowState', 'wsNormal, wsMinimized, wsMaximized');
+ AddEnum('TFormStyle', 'fsNormal, fsMDIChild, fsMDIForm, fsStayOnTop');
+ AddEnumSet('TBorderIcons', 'biSystemMenu, biMinimize, biMaximize, biHelp');
+ AddEnum('TPosition', 'poDesigned, poDefault, poDefaultPosOnly, poDefaultSizeOnly, poScreenCenter, poDesktopCenter');
+ AddEnum('TCloseAction', 'caNone, caHide, caFree, caMinimize');
+
+ with AddClass(TControl, 'TComponent') do
+ begin
+ AddProperty('Parent', 'TWinControl', GetProp, SetProp);
+ AddMethod('procedure Hide', CallMethod);
+ AddMethod('procedure Show', CallMethod);
+ AddMethod('procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer)', CallMethod);
+ AddEvent('OnCanResize', TfsCanResizeEvent);
+ AddEvent('OnClick', TfsNotifyEvent);
+ AddEvent('OnDblClick', TfsNotifyEvent);
+ AddEvent('OnMouseDown', TfsMouseEvent);
+ AddEvent('OnMouseMove', TfsMouseMoveEvent);
+ AddEvent('OnMouseUp', TfsMouseEvent);
+ AddEvent('OnResize', TfsNotifyEvent);
+ end;
+ with AddClass(TWinControl, 'TControl') do
+ begin
+ AddMethod('procedure SetFocus', CallMethod);
+ AddMethod('procedure Invalidate', CallMethod);
+ AddEvent('OnEnter', TfsNotifyEvent);
+ AddEvent('OnExit', TfsNotifyEvent);
+ AddEvent('OnKeyDown', TfsKeyEvent);
+ AddEvent('OnKeyPress', TfsKeyPressEvent);
+ AddEvent('OnKeyUp', TfsKeyEvent);
+ end;
+ AddClass(TCustomControl, 'TWinControl');
+ AddClass(TGraphicControl, 'TControl');
+ AddClass(TGroupBox, 'TWinControl');
+ AddClass(TLabel, 'TControl');
+ AddClass(TEdit, 'TWinControl');
+ AddClass(TMemo, 'TWinControl');
+ with AddClass(TCustomComboBox, 'TWinControl') do
+ begin
+ AddProperty('DroppedDown', 'Boolean', GetProp, SetProp);
+ AddProperty('ItemIndex', 'Integer', GetProp, SetProp);
+ AddEvent('OnChange', TfsNotifyEvent);
+ AddEvent('OnDropDown', TfsNotifyEvent);
+ AddEvent('OnCloseUp', TfsNotifyEvent);
+ end;
+ AddClass(TComboBox, 'TCustomComboBox');
+ AddClass(TButton, 'TWinControl');
+ AddClass(TCheckBox, 'TWinControl');
+ AddClass(TRadioButton, 'TWinControl');
+ with AddClass(TCustomListBox, 'TWinControl') do
+ begin
+ AddProperty('ItemIndex', 'Integer', GetProp, SetProp);
+ AddProperty('SelCount', 'Integer', GetProp, nil);
+ AddIndexProperty('Selected', 'Integer', 'Boolean', CallMethod);
+ end;
+ AddClass(TListBox, 'TCustomListBox');
+ AddClass(TControlScrollBar, 'TPersistent');
+ AddClass(TScrollingWinControl, 'TWinControl');
+ AddClass(TScrollBox, 'TScrollingWinControl');
+ with AddClass(TCustomForm, 'TScrollingWinControl') do
+ begin
+ AddMethod('procedure Close', CallMethod);
+ AddMethod('procedure Hide', CallMethod);
+ AddMethod('procedure Show', CallMethod);
+ AddMethod('function ShowModal: Integer', CallMethod);
+ AddEvent('OnActivate', TfsNotifyEvent);
+ AddEvent('OnClose', TfsCloseEvent);
+ AddEvent('OnCloseQuery', TfsCloseQueryEvent);
+ AddEvent('OnCreate', TfsNotifyEvent);
+ AddEvent('OnDestroy', TfsNotifyEvent);
+ AddEvent('OnDeactivate', TfsNotifyEvent);
+ AddEvent('OnHide', TfsNotifyEvent);
+ AddEvent('OnPaint', TfsNotifyEvent);
+ AddEvent('OnShow', TfsNotifyEvent);
+ AddProperty('Canvas', 'TCanvas', GetProp, nil);
+ AddProperty('ModalResult', 'Integer', GetProp, SetProp);
+ end;
+ AddClass(TForm, 'TCustomForm');
+ AddClass(TDataModule, 'TComponent');
+ with AddClass(TApplication, 'TComponent') do
+ begin
+ AddMethod('procedure Minimize', CallMethod);
+ AddMethod('procedure ProcessMessages', CallMethod);
+ AddMethod('procedure Restore', CallMethod);
+ AddProperty('ExeName', 'String', GetProp, nil);
+ end;
+ AddObject('Application', Application);
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ Form: TCustomForm;
+begin
+ Result := 0;
+
+ if ClassType = TControl then
+ begin
+ if MethodName = 'HIDE' then
+ TControl(Instance).Hide
+ else if MethodName = 'SHOW' then
+ TControl(Instance).Show
+ else if MethodName = 'SETBOUNDS' then
+ TControl(Instance).SetBounds(Caller.Params[0], Caller.Params[1], Caller.Params[2], Caller.Params[3])
+ end
+ else if ClassType = TWinControl then
+ begin
+ if MethodName = 'SETFOCUS' then
+ TWinControl(Instance).SetFocus
+ else if MethodName = 'INVALIDATE' then
+ TWinControl(Instance).Invalidate;
+ end
+ else if ClassType = TCustomListBox then
+ begin
+ if MethodName = 'SELECTED.GET' then
+ Result := TCustomListBox(Instance).Selected[Caller.Params[0]]
+ else if MethodName = 'SELECTED.SET' then
+ TCustomListBox(Instance).Selected[Caller.Params[0]] := Caller.Params[1]
+ end
+ else if ClassType = TCustomForm then
+ begin
+ Form := TCustomForm(Instance);
+ if MethodName = 'CLOSE' then
+ Form.Close
+ else if MethodName = 'HIDE' then
+ Form.Hide
+ else if MethodName = 'SHOW' then
+ Form.Show
+ else if MethodName = 'SHOWMODAL' then
+ Result := Form.ShowModal;
+ end
+ else if ClassType = TApplication then
+ begin
+ if MethodName = 'MINIMIZE' then
+ TApplication(Instance).Minimize
+ else if MethodName = 'PROCESSMESSAGES' then
+ TApplication(Instance).ProcessMessages
+ else if MethodName = 'RESTORE' then
+ TApplication(Instance).Restore
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TControl then
+ begin
+ if PropName = 'PARENT' then
+ Result := frxInteger(TControl(Instance).Parent)
+ end
+ else if ClassType = TCustomComboBox then
+ begin
+ if PropName = 'DROPPEDDOWN' then
+ Result := TCustomComboBox(Instance).DroppedDown
+ else if PropName = 'ITEMINDEX' then
+ Result := TCustomComboBox(Instance).ItemIndex
+ end
+ else if ClassType = TCustomListBox then
+ begin
+ if PropName = 'SELCOUNT' then
+ Result := TCustomListBox(Instance).SelCount
+ else if PropName = 'ITEMINDEX' then
+ Result := TCustomListBox(Instance).ItemIndex
+ end
+ else if ClassType = TCustomForm then
+ begin
+ if PropName = 'MODALRESULT' then
+ Result := TCustomForm(Instance).ModalResult
+ else if PropName = 'CANVAS' then
+ Result := frxInteger(TCustomForm(Instance).Canvas)
+ end
+ else if ClassType = TApplication then
+ begin
+ if PropName = 'EXENAME' then
+ Result := TApplication(Instance).ExeName
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TControl then
+ begin
+ if PropName = 'PARENT' then
+ TControl(Instance).Parent := TWinControl(frxInteger(Value))
+ end
+ else if ClassType = TCustomComboBox then
+ begin
+ if PropName = 'DROPPEDDOWN' then
+ TCustomComboBox(Instance).DroppedDown := Value
+ else if PropName = 'ITEMINDEX' then
+ TCustomComboBox(Instance).ItemIndex := Value
+ end
+ else if ClassType = TCustomListBox then
+ begin
+ if PropName = 'ITEMINDEX' then
+ TCustomListBox(Instance).ItemIndex := Value
+ end
+ else if ClassType = TCustomForm then
+ begin
+ if PropName = 'MODALRESULT' then
+ TCustomForm(Instance).ModalResult := Value
+ end
+end;
+
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsFormsRTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/fs_igraphicsrtti.pas b/LibD28/fs_igraphicsrtti.pas
new file mode 100644
index 0000000..6e6c627
--- /dev/null
+++ b/LibD28/fs_igraphicsrtti.pas
@@ -0,0 +1,262 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Graphics.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_igraphicsrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, fs_iclassesrtti{$IFDEF DELPHI16}, Controls{$ENDIF}
+{$IFDEF CLX}
+, QGraphics
+{$ELSE}
+, Graphics
+{$ENDIF}
+{$IFDEF Delphi16}
+ , System.Types
+{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsGraphicsRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ THackGraphic = class(TGraphic)
+ end;
+
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ procedure GetColorProc(const Name: String);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ GetColorValues(GetColorProc);
+{$IFDEF FPC}
+ AddEnumSet('TFontStyles', 'fsBold, fsItalic, fsStrikeout, fsUnderline');
+{$ELSE}
+ AddEnumSet('TFontStyles', 'fsBold, fsItalic, fsUnderline, fsStrikeout');
+{$ENDIF}
+ AddEnum('TFontPitch', 'fpDefault, fpVariable, fpFixed');
+ AddEnum('TPenStyle', 'psSolid, psDash, psDot, psDashDot, psDashDotDot, psClear, psInsideFrame');
+ AddEnum('TPenMode', 'pmBlack, pmWhite, pmNop, pmNot, pmCopy, pmNotCopy, pmMergePenNot, ' +
+ 'pmMaskPenNot, pmMergeNotPen, pmMaskNotPen, pmMerge, pmNotMerge, pmMask, pmNotMask, pmXor, pmNotXor');
+ AddEnum('TBrushStyle', 'bsSolid, bsClear, bsHorizontal, bsVertical, ' +
+ 'bsFDiagonal, bsBDiagonal, bsCross, bsDiagCross');
+
+ with AddClass(TFont, 'TPersistent') do
+ AddConstructor('constructor Create', CallMethod);
+ with AddClass(TPen, 'TPersistent') do
+ AddConstructor('constructor Create', CallMethod);
+ with AddClass(TBrush, 'TPersistent') do
+ AddConstructor('constructor Create', CallMethod);
+ with AddClass(TCanvas, 'TPersistent') do
+ begin
+ AddConstructor('constructor Create', CallMethod);
+ AddMethod('procedure Draw(X, Y: Integer; Graphic: TGraphic)', CallMethod);
+ AddMethod('procedure Ellipse(X1, Y1, X2, Y2: Integer)', CallMethod);
+ AddMethod('procedure LineTo(X, Y: Integer)', CallMethod);
+ AddMethod('procedure MoveTo(X, Y: Integer)', CallMethod);
+ AddMethod('procedure Rectangle(X1, Y1, X2, Y2: Integer)', CallMethod);
+ AddMethod('procedure RoundRect(X1, Y1, X2, Y2, X3, Y3: Integer)', CallMethod);
+ AddMethod('procedure StretchDraw(X1, Y1, X2, Y2: Integer; Graphic: TGraphic)', CallMethod);
+ AddMethod('function TextHeight(const Text: string): Integer', CallMethod);
+ AddMethod('procedure TextOut(X, Y: Integer; const Text: string)', CallMethod);
+ AddMethod('function TextWidth(const Text: string): Integer', CallMethod);
+{$IFNDEF CLX}
+ AddIndexProperty('Pixels', 'Integer, Integer', 'TColor', CallMethod);
+{$ENDIF}
+ end;
+ with AddClass(TGraphic, 'TPersistent') do
+ begin
+ AddConstructor('constructor Create', CallMethod);
+ AddMethod('procedure LoadFromFile(const Filename: string)', CallMethod);
+ AddMethod('procedure SaveToFile(const Filename: string)', CallMethod);
+ AddProperty('Height', 'Integer', GetProp, SetProp);
+ AddProperty('Width', 'Integer', GetProp, SetProp);
+ end;
+ with AddClass(TPicture, 'TPersistent') do
+ begin
+ AddMethod('procedure LoadFromFile(const Filename: string)', CallMethod);
+ AddMethod('procedure SaveToFile(const Filename: string)', CallMethod);
+ AddProperty('Height', 'Integer', GetProp, nil);
+ AddProperty('Width', 'Integer', GetProp, nil);
+ end;
+{$IFNDEF CROSS_COMPILE}
+ AddClass(TMetafile, 'TGraphic');
+ with AddClass(TMetafileCanvas, 'TCanvas') do
+ AddConstructor('constructor Create(AMetafile: TMetafile; ReferenceDevice: Integer)', CallMethod);
+{$ENDIF}
+ with AddClass(TBitmap, 'TGraphic') do
+ AddProperty('Canvas', 'TCanvas', GetProp);
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ _Canvas: TCanvas;
+begin
+ Result := 0;
+
+ if ClassType = TFont then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TFont(Instance).Create)
+ end
+ else if ClassType = TPen then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TPen(Instance).Create)
+ end
+ else if ClassType = TBrush then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TBrush(Instance).Create)
+ end
+ else if ClassType = TCanvas then
+ begin
+ _Canvas := TCanvas(Instance);
+
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TCanvas(Instance).Create)
+ else if MethodName = 'DRAW' then
+ _Canvas.Draw(Caller.Params[0], Caller.Params[1], TGraphic(frxInteger(Caller.Params[2])))
+ else if MethodName = 'ELLIPSE' then
+ _Canvas.Ellipse(Caller.Params[0], Caller.Params[1], Caller.Params[2], Caller.Params[3])
+ else if MethodName = 'LINETO' then
+ _Canvas.LineTo(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'MOVETO' then
+ _Canvas.MoveTo(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'RECTANGLE' then
+ _Canvas.Rectangle(Caller.Params[0], Caller.Params[1], Caller.Params[2], Caller.Params[3])
+ else if MethodName = 'ROUNDRECT' then
+ _Canvas.RoundRect(Caller.Params[0], Caller.Params[1], Caller.Params[2], Caller.Params[3], Caller.Params[4], Caller.Params[5])
+ else if MethodName = 'STRETCHDRAW' then
+ _Canvas.StretchDraw(Rect(Caller.Params[0], Caller.Params[1], Caller.Params[2], Caller.Params[3]), TGraphic(frxInteger(Caller.Params[4])))
+ else if MethodName = 'TEXTHEIGHT' then
+ Result := _Canvas.TextHeight(Caller.Params[0])
+ else if MethodName = 'TEXTOUT' then
+ _Canvas.TextOut(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'TEXTWIDTH' then
+ Result := _Canvas.TextWidth(Caller.Params[0])
+{$IFNDEF CLX}
+ else if MethodName = 'PIXELS.GET' then
+ Result := _Canvas.Pixels[Caller.Params[0], Caller.Params[1]]
+ else if MethodName = 'PIXELS.SET' then
+ _Canvas.Pixels[Caller.Params[0], Caller.Params[1]] := Caller.Params[2]
+{$ENDIF}
+ end
+ else if ClassType = TGraphic then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(THackGraphic(Instance).Create)
+ else if MethodName = 'LOADFROMFILE' then
+ TGraphic(Instance).LoadFromFile(Caller.Params[0])
+ else if MethodName = 'SAVETOFILE' then
+ TGraphic(Instance).SaveToFile(Caller.Params[0])
+ end
+ else if ClassType = TPicture then
+ begin
+ if MethodName = 'LOADFROMFILE' then
+ TPicture(Instance).LoadFromFile(Caller.Params[0])
+ else if MethodName = 'SAVETOFILE' then
+ TPicture(Instance).SaveToFile(Caller.Params[0])
+ end
+{$IFNDEF CROSS_COMPILE}
+ else if ClassType = TMetafileCanvas then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TMetafileCanvas(Instance).Create(TMetafile(frxInteger(Caller.Params[0])), Caller.Params[1]))
+ end
+{$ENDIF}
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TGraphic then
+ begin
+ if PropName = 'HEIGHT' then
+ Result := TGraphic(Instance).Height
+ else if PropName = 'WIDTH' then
+ Result := TGraphic(Instance).Width
+ end
+ else if ClassType = TPicture then
+ begin
+ if PropName = 'HEIGHT' then
+ Result := TPicture(Instance).Height
+ else if PropName = 'WIDTH' then
+ Result := TPicture(Instance).Width
+ end
+ else if ClassType = TBitmap then
+ begin
+ if PropName = 'CANVAS' then
+ Result := frxInteger(TBitmap(Instance).Canvas)
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TGraphic then
+ begin
+ if PropName = 'HEIGHT' then
+ TGraphic(Instance).Height := Value
+ else if PropName = 'WIDTH' then
+ TGraphic(Instance).Width := Value
+ end
+end;
+
+procedure TFunctions.GetColorProc(const Name: String);
+var
+ c: Integer;
+begin
+ IdentToColor(Name, c);
+ Script.AddConst(Name, 'Integer', c);
+end;
+
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsGraphicsRTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/fs_iibxreg.pas b/LibD28/fs_iibxreg.pas
new file mode 100644
index 0000000..69c1428
--- /dev/null
+++ b/LibD28/fs_iibxreg.pas
@@ -0,0 +1,58 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_iibxreg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ Classes
+{$IFNDEF FPC}
+ {$IFNDEF Delphi6}
+, DsgnIntf
+{$ELSE}
+{$IFDEF DELPHI16}
+, Controls
+{$ENDIF}
+, DesignIntf
+{$ENDIF}
+{$ELSE}
+,PropEdits, LazarusPackageIntf, LResources
+{$ENDIF}
+, fs_iibxrtti;
+
+
+
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+{$IFDEF DELPHI16}
+ //GroupDescendentsWith(TfsIBXRTTI, TControl);
+{$ENDIF}
+ RegisterComponents('FastScript', [TfsIBXRTTI]);
+end;
+
+initialization
+{$IFDEF FPC}
+ {$INCLUDE fs_ireg.lrs}
+{$ENDIF}
+
+
+end.
diff --git a/LibD28/fs_iibxrtti.pas b/LibD28/fs_iibxrtti.pas
new file mode 100644
index 0000000..78c7372
--- /dev/null
+++ b/LibD28/fs_iibxrtti.pas
@@ -0,0 +1,127 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ IBX classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_iibxrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, fs_itools, fs_idbrtti, db
+{$IFDEF DELPHI20}
+ , IBX.ibdatabase, IBX.IBCustomDataSet, IBX.IBQuery, IBX.IBTable, IBX.IBStoredProc
+{$ELSE}
+ , ibdatabase, IBCustomDataSet, IBQuery, IBTable, IBStoredProc
+{$ENDIF}
+{$IFDEF DELPHI16}, Controls, System.Types{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsIBXRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class (TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass; const MethodName:
+ String; Caller: TfsMethodHelper): Variant;
+ function RecordCount(Instance: TObject; ClassType: TClass; const PropName:
+ String): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddClass(TIBDataBase, 'TComponent');
+
+ with AddClass(TIBTransaction, 'TComponent') do
+ begin
+ AddMethod('procedure Commit', CallMethod);
+ AddMethod('procedure RollBack', CallMethod);
+ AddMethod('procedure StartTransaction', CallMethod);
+ end;
+
+ AddClass(TIBCustomDataSet, 'TDataSet');
+ AddClass(TIBTable, 'TIBCustomDataSet');
+ with AddClass(TIBQuery, 'TIBCustomDataSet') do
+ begin
+ AddMethod('procedure ExecSQL', CallMethod);
+ AddMethod('procedure FetchAll', CallMethod);
+ AddProperty('RecordCount', 'Integer',RecordCount, nil);
+ end;
+ with AddClass(TIBStoredProc, 'TIBCustomDataSet') do
+ AddMethod('procedure ExecProc', CallMethod);
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; const
+ MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TIBQuery then
+ begin
+ if MethodName = 'EXECSQL' then
+ TIBQuery(Instance).ExecSQL
+ else
+ if MethodName = 'FETCHALL' then
+ TIBQuery(Instance).FETCHALL;
+ end
+ else
+ if ClassType = TIBStoredProc then
+ begin
+ if MethodName = 'EXECPROC' then
+ TIBStoredProc(Instance).ExecProc
+ end
+ else
+ if(ClassType = TIBTransaction) AND (MethodName = 'COMMIT') then
+ TIBTransaction(Instance).Commit
+ else
+ if (ClassType = TIBTransaction) AND (MethodName = 'ROLLBACK') then
+ TIBTransaction(Instance).RollBack
+ else
+ if(ClassType = TIBTransaction) AND (MethodName = 'STARTTRANSACTION') then
+ TIBTransaction(Instance).StartTransaction;
+
+end;
+
+function TFunctions.RecordCount(Instance: TObject; ClassType: TClass; const
+ PropName: String): Variant;
+begin
+ Result:=0;
+ if (ClassType = TIBQuery) AND (PropName = 'RECORDCOUNT') then
+ Result:=TIBQuery(Instance).RecordCount;
+
+end;
+
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsIBXRTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/fs_iilparser.pas b/LibD28/fs_iilparser.pas
new file mode 100644
index 0000000..16e5bdf
--- /dev/null
+++ b/LibD28/fs_iilparser.pas
@@ -0,0 +1,2059 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Intermediate Language parser }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_iilparser;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, fs_iparser, fs_iexpression, fs_xml
+{$IFDEF Delphi6}
+, Variants
+{$ENDIF};
+{$ELSE}
+interface
+
+{$i fmx.inc}
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_iparser, FMX.fs_iexpression, FMX.fs_xml, System.Variants;
+{$ENDIF}
+
+
+type
+ TfsEmitOp = (emNone, emCreate, emFree);
+
+{ TfsILParser performs the syntax analyze of source code. Source code
+ can be on ANY language. Grammars are stored in the XML file and
+ can be easily changed to support any structured language. Currently
+ supported languages are Pascal, C++, Basic and Java subsets.
+
+ The result of the analyze (function MakeScript) is the output XML script
+ (called Intermediate Language). This output processed by the ParseILScript
+ method. This method creates the program structure (defined in the
+ fs_Interpreter unit) and fills it by the data }
+
+ TfsILParser = class(TObject)
+ private
+ FErrorPos: String;
+ FGrammar: TfsXMLDocument;
+ FILScript: TfsXMLDocument;
+ FLangName: String;
+ FNeedDeclareVars: Boolean;
+ FParser: TfsParser;
+ FProgram: TfsScript;
+ FProgRoot: TfsXMLItem;
+ FRoot: TfsXMLItem;
+ FUnitName: String;
+ FUsesList: TStrings;
+ FWithList: TStringList;
+ function PropPos(xi: TfsXMLItem): String;
+ procedure ErrorPos(xi: TfsXMLItem);
+ procedure CheckIdent(Prog: TfsScript; const Name: String);
+ function FindClass(const TypeName: String): TfsClassVariable;
+ procedure CheckTypeCompatibility(Var1, Var2: TfsCustomVariable);
+ function FindVar(Prog: TfsScript; const Name: String): TfsCustomVariable;
+ function FindType(s: String): TfsVarType;
+ function CreateVar(xi: TfsXMLItem; Prog: TfsScript; const Name: String;
+ Statement: TfsStatement = nil; CreateParam: Boolean = False;
+ IsVarParam: Boolean = False): TfsCustomVariable;
+ function DoSet(xi: TfsXMLItem; Prog: TfsScript): TfsSetExpression;
+ function DoExpression(xi: TfsXMLItem; Prog: TfsScript): TfsExpression;
+ procedure DoUses(xi: TfsXMLItem; Prog: TfsScript);
+ procedure DoVar(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoConst(xi: TfsXMLItem; Prog: TfsScript);
+ procedure DoParameters(xi: TfsXMLItem; v: TfsProcVariable);
+ procedure DoProc1(xi: TfsXMLItem; Prog: TfsScript);
+ procedure DoProc2(xi: TfsXMLItem; Prog: TfsScript);
+ procedure DoFunc1(xi: TfsXMLItem; Prog: TfsScript);
+ procedure DoFunc2(xi: TfsXMLItem; Prog: TfsScript);
+ procedure DoAssign(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoCall(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoIf(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoFor(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoVbFor(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoCppFor(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoWhile(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoRepeat(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoCase(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoTry(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoBreak(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoContinue(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoExit(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoReturn(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoWith(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoDelete(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoCompoundStmt(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoStmt(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+ procedure DoProgram(xi: TfsXMLItem; Prog: TfsScript);
+ public
+ constructor Create(AProgram: TfsScript);
+ destructor Destroy; override;
+
+ procedure SelectLanguage(const LangName: String);
+ { convert the input script to the Intermediate Language }
+ function MakeILScript(const Text: String): Boolean;
+ { parse IL }
+ procedure ParseILScript;
+ { this method is needed here to implement late-binding }
+ function DoDesignator(xi: TfsXMLItem; Prog: TfsScript;
+ EmitOp: TfsEmitOp = emNone): TfsDesignator;
+ property ILScript: TfsXMLDocument read FILScript;
+ end;
+
+
+implementation
+//VCL uses section
+{$IFNDEF FMX}
+uses fs_itools, fs_iconst
+{$IFDEF CROSS_COMPILE}
+, Types
+{$ELSE}
+, Windows
+{$ENDIF}
+{$IFDEF OLE}
+, fs_idisp
+{$ENDIF};
+//FMX uses section
+{$ELSE}
+uses FMX.fs_itools, FMX.fs_iconst, System.Types, FMX.Types
+{$IFDEF OLE}
+, fs_idisp
+{$ENDIF};
+{$ENDIF}
+
+
+{ TfsILParser }
+
+constructor TfsILParser.Create(AProgram: TfsScript);
+begin
+ FNeedDeclareVars := True;
+ FProgram := AProgram;
+ FGrammar := TfsXMLDocument.Create;
+ FILScript := TfsXMLDocument.Create;
+ FParser := TfsParser.Create;
+ FUsesList := TStringList.Create;
+ FWithList := TStringList.Create;
+end;
+
+destructor TfsILParser.Destroy;
+begin
+ FGrammar.Free;
+ FILScript.Free;
+ FParser.Free;
+ FUsesList.Free;
+ FWithList.Free;
+ inherited;
+end;
+
+procedure TfsILParser.SelectLanguage(const LangName: String);
+var
+ i: Integer;
+ Name, PropText: String;
+ xi: TfsXMLItem;
+ ParserRoot: TfsXMLItem;
+ ss: TStringStream;
+begin
+ FParser.Clear;
+ FLangName := LangName;
+ ss := TStringStream.Create(fsGetLanguage(LangName));
+ try
+ FGrammar.LoadFromStream(ss);
+ finally
+ ss.Free;
+ end;
+
+ FRoot := FGrammar.Root;
+ ParserRoot := FRoot.FindItem('parser');
+
+ xi := ParserRoot.FindItem('keywords');
+ for i := 0 to xi.Count - 1 do
+ FParser.Keywords.Add(xi[i].Name);
+ for i := 0 to ParserRoot.Count - 1 do
+ begin
+ Name := LowerCase(ParserRoot[i].Name);
+ PropText := ParserRoot[i].Prop['text'];
+ if Name = 'identchars' then
+ FParser.ConstructCharset(PropText)
+ else if Name = 'commentline1' then
+ FParser.CommentLine1 := PropText
+ else if Name = 'commentline2' then
+ FParser.CommentLine2 := PropText
+ else if Name = 'commentblock1' then
+ FParser.CommentBlock1 := PropText
+ else if Name = 'commentblock2' then
+ FParser.CommentBlock2 := PropText
+ else if Name = 'stringquotes' then
+ FParser.StringQuotes := PropText
+ else if Name = 'hexsequence' then
+ FParser.HexSequence := PropText
+ else if Name = 'specstrchar' then
+ begin
+ if PropText = '1' then
+ FParser.SpecStrChar := true;
+ end
+ else if Name = 'declarevars' then
+ begin
+ if PropText = '0' then
+ FNeedDeclareVars := False;
+ end
+ else if Name = 'skipeol' then
+ begin
+ if PropText = '0' then
+ FParser.SkipEOL := False;
+ end
+ else if Name = 'skipchar' then
+ FParser.SkipChar := PropText
+ else if Name = 'casesensitive' then
+ begin
+ if PropText = '1' then
+ FParser.CaseSensitive := True;
+ end
+ end;
+
+ if FProgram.ExtendedCharset then
+ for i := 128 to 255 do
+ FParser.IdentifierCharset := FParser.IdentifierCharset + [Chr(i)];
+end;
+
+function TfsILParser.MakeILScript(const Text: String): Boolean;
+var
+ FList: TStrings;
+ FStream: TStream;
+ FErrorMsg: String;
+ FErrorPos: String;
+ FTermError: Boolean;
+ i: Integer;
+
+ function Run(xi: TfsXMLItem): Boolean;
+ var
+ i, j, ParsPos, ParsPos1, LoopPos, ListPos: Integer;
+ s, NodeName, Token, PropText, PropAdd, PropAddText, PropNode: String;
+ Completed, TopLevelNode, Flag: Boolean;
+ const
+ PathD = {$IFDEF MSWINDOWS} '\'; {$ELSE} '/'; {$ENDIF}
+ procedure DoInclude(const Name: String);
+ var
+ sl: TStringList;
+ p: TfsILParser;
+ ss: TStringStream;
+ s, UnitPath: String;
+ idx: Integer;
+ begin
+ if FUsesList.IndexOf(Name) <> -1 then
+ Exit;
+ FUsesList.Add(Name);
+ sl := TStringList.Create;
+ try
+ if Assigned(FProgram.OnGetUnit) then
+ begin
+ s := '';
+ FProgram.OnGetUnit(FProgram, Name, s);
+ sl.Text := s;
+ end
+ else
+ begin
+ UnitPath := '';
+ for idx := 0 to FProgram.IncludePath.Count - 1 do
+ begin
+ UnitPath := FProgram.IncludePath[idx];
+ if (UnitPath <> '') and (PathD <> UnitPath[Length(UnitPath)]) then
+ UnitPath := UnitPath + PathD;
+ if FileExists(UnitPath + Name) then
+ break;
+ end;
+ sl.LoadFromFile(UnitPath + Name);
+ end;
+
+ p := TfsILParser.Create(FProgram);
+ p.FUnitName := Name;
+ ss := TStringStream.Create(''{$IFDEF Delphi12},TEncoding.UTF8{$ENDIF});
+ try
+ s := '';
+ if sl.Count > 0 then
+ begin
+ p.SelectLanguage(FLangName);
+ p.FUsesList.Assign(FUsesList);
+ if p.MakeILScript(sl.Text) then
+ begin
+ FUsesList.Assign(p.FUsesList);
+ p.ILScript.SaveToStream(ss);
+ s := ss.DataString;
+ Delete(s, 1, Pos('?>', s) + 1);
+ end
+ else
+ begin
+ FErrorMsg := FProgram.ErrorMsg;
+ FErrorPos := FProgram.ErrorPos;
+ if FProgram.ErrorUnit = '' then
+ FProgram.ErrorUnit := Name;
+ end;
+ end;
+
+ FList.Insert(ListPos, '');
+ FList.Insert(ListPos, s);
+ FList.Insert(ListPos, '');
+ Inc(ListPos, 3);
+ finally
+ p.Free;
+ ss.Free;
+ end;
+ finally
+ sl.Free;
+ end;
+ end;
+
+ procedure CheckPropNode(Flag: Boolean);
+ var
+ i, ParsPos1: Integer;
+ s: String;
+ begin
+ if CompareText(PropNode, 'uses') = 0 then
+ begin
+ while FList.Count > ListPos do
+ begin
+ s := FList[FList.Count - 1];
+ i := Pos('text="', s);
+ Delete(s, 1, i + 5);
+ i := Pos('" ', s);
+ Delete(s, i, 255);
+ DoInclude(Copy(s, 2, Length(s) - 2));
+ FList.Delete(FList.Count - 1);
+ end;
+ end
+ else if PropNode <> '' then
+ if Flag then
+ begin
+ ParsPos1 := FParser.Position;
+ FParser.Position := ParsPos;
+ FParser.SkipSpaces;
+
+ s := '<' + PropNode + ' pos="' + FParser.GetXYPosition + '"';
+ FParser.Position := ParsPos1;
+
+ if PropNode = 'expr' then
+ s := s + ' pos1="' + FParser.GetXYPosition + '"';
+ s := s + '>';
+
+ FList.Insert(ListPos, s);
+ FList.Add('');
+ end
+ else
+ begin
+ while FList.Count > ListPos do
+ FList.Delete(FList.Count - 1);
+ end;
+ end;
+
+ procedure AddError(xi: TfsXMLItem);
+ var
+ PropErr: String;
+ xi1: TfsXMLItem;
+ begin
+ PropErr := xi.Prop['err'];
+ if (PropErr <> '') and (FErrorMsg = '') then
+ begin
+ xi1 := FRoot.FindItem('parser');
+ xi1 := xi1.FindItem('errors');
+ FErrorMsg := xi1.FindItem(PropErr).Prop['text'];
+ FParser.Position := ParsPos;
+ FParser.SkipSpaces;
+ FErrorPos := FParser.GetXYPosition;
+ FTermError := xi.Prop['term'] = '1';
+ end;
+ end;
+
+ begin
+ Result := True;
+ ParsPos := FParser.Position;
+ ListPos := FList.Count;
+ NodeName := AnsiLowerCase(xi.Name);
+ PropText := AnsiLowerCase(xi.Prop['text']);
+ PropNode := LowerCase(xi.Prop['node']);
+ TopLevelNode := xi.Parent = FRoot;
+
+ Completed := False;
+ Flag := False;
+ Token := '';
+
+ if TopLevelNode then
+ Completed := True
+ else if NodeName = 'char' then
+ begin
+ if xi.Prop['skip'] <> '0' then
+ FParser.SkipSpaces;
+ Token := FParser.GetChar;
+ Flag := True;
+ end
+ else if NodeName = 'keyword' then
+ begin
+ Token := FParser.GetWord;
+ Flag := True;
+ end
+ else if NodeName = 'ident' then
+ begin
+ Token := FParser.GetIdent;
+ Flag := True;
+ end
+ else if NodeName = 'number' then
+ begin
+ Token := FParser.GetNumber;
+ Flag := True;
+ end
+ else if NodeName = 'string' then
+ begin
+ Token := FParser.GetString;
+ Flag := True;
+ end
+ else if NodeName = 'frstring' then
+ begin
+ Token := FParser.GetFRString;
+ s := FParser.GetXYPosition;
+ FList.Add('');
+ FList.Add('');
+ FList.Add('');
+ FList.Add('');
+ FList.Add('');
+ FList.Add('');
+ Flag := True;
+ end
+ else if NodeName = 'eol' then
+ Completed := FParser.GetEOL
+ else if NodeName = 'sequence' then
+ Completed := True
+ else if (NodeName = 'switch') or (NodeName = 'optionalswitch') then
+ begin
+ Completed := True;
+
+ for i := 0 to xi.Count - 1 do
+ begin
+ Completed := Run(xi[i]);
+ if Completed then
+ break;
+ end;
+
+ if not Completed then
+ if NodeName <> 'optionalswitch' then
+ begin
+ Result := False;
+ AddError(xi);
+ end;
+ Exit;
+ end
+ else if (NodeName = 'loop') or (NodeName = 'optionalloop') then
+ begin
+ j := 0;
+ repeat
+ Inc(j);
+ Flag := False;
+ LoopPos := FParser.Position;
+
+ for i := 0 to xi.Count - 1 do
+ begin
+ Result := Run(xi[i]);
+ if not Result then
+ begin
+ Flag := True;
+ break;
+ end;
+ end;
+
+ { try loop delimiter }
+ ParsPos1 := FParser.Position;
+ if Result and (PropText <> '') then
+ begin
+ FParser.SkipSpaces;
+ if FParser.GetChar <> PropText then
+ begin
+ FParser.Position := ParsPos1;
+ Flag := True;
+ end;
+ end;
+
+ { avoid infinity loop }
+ if FParser.Position = LoopPos then
+ Flag := True;
+ until Flag;
+
+ { at least one loop was succesful }
+ if j > 1 then
+ begin
+ { special case - now implemented only in "case" statement }
+ if (xi.Prop['skip'] = '1') or FTermError then
+ FErrorMsg := '';
+ FParser.Position := ParsPos1;
+ Result := True;
+ end;
+
+ if NodeName = 'optionalloop' then
+ begin
+ if not Result then
+ FParser.Position := ParsPos;
+ Result := True;
+ end;
+ Exit;
+ end
+ else if NodeName = 'optional' then
+ begin
+ for i := 0 to xi.Count - 1 do
+ if not Run(xi[i]) then
+ begin
+ FParser.Position := ParsPos;
+ break;
+ end;
+ Exit;
+ end
+ else
+ begin
+ j := FRoot.Find(NodeName);
+ if j = -1 then
+ raise Exception.Create(SInvalidLanguage);
+
+ Completed := Run(FRoot[j]);
+ end;
+
+ if Flag then
+ begin
+ if FParser.CaseSensitive then
+ Completed := (Token <> '') and
+ ((PropText = '') or (Token = PropText))
+ else
+ Completed := (Token <> '') and
+ ((PropText = '') or (AnsiCompareText(Token, PropText) = 0));
+ end;
+
+ if not Completed then
+ begin
+ Result := False;
+ AddError(xi);
+ end
+ else
+ begin
+ if not TopLevelNode then
+ CheckPropNode(True);
+
+ PropAdd := xi.Prop['add'];
+ PropAddText := xi.Prop['addtext'];
+ if PropAdd <> '' then
+ begin
+ if PropAddText = '' then
+ s := Token else
+ s := PropAddText;
+ FList.Add('<' + PropAdd + ' text="' + StrToXML(s) + '" pos="' +
+ FParser.GetXYPosition + '"/>');
+ end;
+
+ for i := 0 to xi.Count - 1 do
+ begin
+ Result := Run(xi[i]);
+ if not Result then
+ break;
+ end;
+ end;
+
+ if not Result then
+ FParser.Position := ParsPos;
+ if TopLevelNode then
+ CheckPropNode(Result);
+ end;
+
+begin
+ FList := TStringList.Create;
+ FErrorMsg := '';
+ FErrorPos := '';
+ Result := False;
+
+ try
+ FParser.Text := Text;
+
+ i := 1;
+ if FParser.GetChar = '#' then
+ begin
+ if CompareText(FParser.GetIdent, 'language') = 0 then
+ begin
+ i := FParser.Position;
+{$IFDEF Windows}
+ while (i <= Length(Text)) and (Text[i] <> #13) do
+{$ELSE}
+ while (i <= Length(Text)) and (Text[i] <> #10) do
+{$ENDIF}
+ Inc(i);
+ SelectLanguage(Trim(Copy(Text, FParser.Position, i - FParser.Position)));
+ Inc(i, 2);
+ end;
+ end;
+ FParser.Position := i;
+
+ if Run(FRoot.FindItem('program')) and (FErrorMsg = '') then
+ begin
+ FErrorMsg := '';
+ FErrorPos := '';
+ FStream := TMemoryStream.Create;
+ try
+ FList.Insert(0, '');
+ FList.Insert(1, '');
+ FList.Add('');
+ FList.SaveToStream(FStream{$IFDEF Delphi12}, TEncoding.UTF8{$ENDIF});
+{$IFDEF Delphi12}
+ FStream.Position := 3;
+{$ELSE}
+ FStream.Position := 0;
+{$ENDIF}
+ FILScript.LoadFromStream(FStream);
+ FILScript.Root.Add.Assign(FRoot.FindItem('types'));
+// uncomment the following lines to see what is IL script
+// FILScript.AutoIndent := True;
+// FILScript.SaveToFile(ExtractFilePath(ParamStr(0)) + 'out.xml');
+ Result := True;
+ finally
+ FStream.Free;
+ end;
+ end;
+
+ FProgram.ErrorPos := FErrorPos;
+ FProgram.ErrorMsg := FErrorMsg;
+ finally
+ FList.Free;
+ end;
+end;
+
+procedure TfsILParser.ParseILScript;
+begin
+ FWithList.Clear;
+ FProgram.ErrorUnit := '';
+ FUnitName := '';
+ FUsesList.Clear;
+ try
+ DoProgram(FILScript.Root, FProgram);
+ FProgram.ErrorPos := '';
+ except
+ on e: Exception do
+ begin
+ FProgram.ErrorMsg := e.Message;
+ FProgram.ErrorPos := FErrorPos;
+ FProgram.ErrorUnit := FUnitName;
+ end;
+ end;
+end;
+
+function TfsILParser.PropPos(xi: TfsXMLItem): String;
+begin
+ Result := xi.Prop['pos'];
+end;
+
+procedure TfsILParser.ErrorPos(xi: TfsXMLItem);
+begin
+ FErrorPos := PropPos(xi);
+end;
+
+procedure TfsILParser.CheckIdent(Prog: TfsScript; const Name: String);
+begin
+ if Prog.FindLocal(Name) <> nil then
+ raise Exception.Create(SIdRedeclared + '''' + Name + '''');
+end;
+
+function TfsILParser.FindClass(const TypeName: String): TfsClassVariable;
+begin
+ Result := FProgram.FindClass(TypeName);
+ if Result = nil then
+ raise Exception.Create(SUnknownType + '''' + TypeName + '''');
+end;
+
+procedure TfsILParser.CheckTypeCompatibility(Var1, Var2: TfsCustomVariable);
+begin
+ if not AssignCompatible(Var1, Var2, FProgram) then
+ raise Exception.Create(SIncompatibleTypes + ': ''' + Var1.GetFullTypeName +
+ ''', ''' + Var2.GetFullTypeName + '''');
+end;
+
+function TfsILParser.FindVar(Prog: TfsScript; const Name: String): TfsCustomVariable;
+begin
+ Result := Prog.Find(Name);
+ if Result = nil then
+ if not FNeedDeclareVars then
+ begin
+ Result := TfsVariable.Create(Name, fvtVariant, '');
+ FProgram.Add(Name, Result);
+ end
+ else
+ raise Exception.Create(SIdUndeclared + '''' + Name + '''');
+end;
+
+function TfsILParser.FindType(s: String): TfsVarType;
+var
+ xi: TfsXMLItem;
+begin
+ xi := FProgRoot.FindItem('types');
+ if xi.Find(s) <> -1 then
+ s := xi[xi.Find(s)].Prop['type']
+ else
+ begin
+ xi := FGrammar.Root.FindItem('types');
+ if xi.Find(s) <> -1 then
+ s := xi[xi.Find(s)].Prop['type']
+ end;
+ Result := StrToVarType(s, FProgram);
+ if Result = fvtClass then
+ FindClass(s);
+end;
+
+function TfsILParser.CreateVar(xi: TfsXMLItem; Prog: TfsScript; const Name: String;
+ Statement: TfsStatement = nil; CreateParam: Boolean = False;
+ IsVarParam: Boolean = False): TfsCustomVariable;
+var
+ i, j: Integer;
+ Typ: TfsVarType;
+ TypeName: String;
+ RefItem: TfsCustomVariable;
+ InitValue: Variant;
+ InitItem: TfsXMLItem;
+ AssignStmt: TfsAssignmentStmt;
+ IsPascal: Boolean;
+ SourcePos: String;
+
+ procedure DoArray(xi: TfsXMLItem);
+ var
+ i, n: Integer;
+ v: array of {$IFDEF FPC}SizeInt{$ELSE}Integer{$ENDIF};
+ Expr: TfsExpression;
+ begin
+ n := xi.Count;
+ SetLength(v, n * 2);
+
+ for i := 0 to n - 1 do
+ begin
+ Expr := DoExpression(xi[i][0], Prog);
+ v[i * 2] := Expr.Value;
+ Expr.Free;
+
+ if xi[i].Count = 2 then
+ begin
+ Expr := DoExpression(xi[i][1], Prog);
+ v[i * 2 + 1] := Expr.Value;
+ Expr.Free;
+ end
+ else
+ begin
+ v[i * 2 + 1] := v[i * 2] - 1;
+ v[i * 2] := 0;
+ end;
+ end;
+
+ if n = 0 then
+ begin
+ SetLength(v, 2);
+ v[0] := 0;
+ v[1] := 0;
+ n := 1;
+ end;
+
+ InitValue := VarArrayCreate(v, varVariant);
+ RefItem := TfsArrayHelper.Create('', n, Typ, TypeName);
+ Prog.Add('', RefItem);
+ v := nil;
+ Typ := fvtArray;
+ end;
+
+ procedure DoInit(xi: TfsXMLItem);
+ var
+ Expr: TfsExpression;
+ Temp: TfsVariable;
+ begin
+ Temp := TfsVariable.Create('', Typ, TypeName);
+ try
+ Expr := DoExpression(xi[0], Prog);
+ InitValue := Expr.Value;
+ try
+ CheckTypeCompatibility(Temp, Expr);
+ finally
+ Expr.Free;
+ end;
+ finally
+ Temp.Free;
+ end;
+ end;
+
+begin
+ RefItem := nil;
+ InitItem := nil;
+ TypeName := 'Variant';
+ IsPascal := False;
+ SourcePos := FErrorPos;
+
+(*
+
+
+
+
+
+
+
+ ...
+
+
+
+
+
+
+
+ - type may be first (in C-like languages) or last (in Pascal-like ones)
+ - type may be skipped (treated as variant)
+ - array and init may be either skipped, or after each
+ - array and init may be after each
+ - do not handle tags - they are handled in calling part
+*)
+
+
+ { find the type }
+ for i := 0 to xi.Count - 1 do
+ if CompareText(xi[i].name, 'type') = 0 then
+ begin
+ IsPascal := i <> 0;
+ TypeName := xi[i].Prop['text'];
+ ErrorPos(xi[i]);
+ break;
+ end;
+
+ Typ := FindType(TypeName);
+ case Typ of
+ fvtInt, fvtInt64, fvtFloat, fvtClass:
+ InitValue := 0;
+ fvtBool:
+ InitValue := False;
+ fvtChar, fvtString:
+ InitValue := '';
+ else
+ InitValue := Null;
+ end;
+
+ { fing the tag corresponding to our variable }
+ for i := 0 to xi.Count - 1 do
+ if CompareText(xi[i].Prop['text'], Name) = 0 then
+ begin
+ { process and tags if any }
+ j := i + 1;
+ while (j < xi.Count) and (IsPascal or (CompareText(xi[j].Name, 'ident') <> 0)) do
+ begin
+ if CompareText(xi[j].Name, 'array') = 0 then
+ DoArray(xi[j])
+ else if CompareText(xi[j].Name, 'init') = 0 then
+ begin
+ if Statement = nil then
+ DoInit(xi[j]);
+ InitItem := xi[j];
+ end;
+ Inc(j);
+ end;
+ break;
+ end;
+
+ if CreateParam then
+ Result := TfsParamItem.Create(Name, Typ, TypeName, InitItem <> nil, IsVarParam)
+ else if Typ in [fvtChar, fvtString] then
+ Result := TfsStringVariable.Create(Name, Typ, TypeName) else
+ Result := TfsVariable.Create(Name, Typ, TypeName);
+
+ try
+ Result.Value := InitValue;
+ Result.RefItem := RefItem;
+ Result.SourcePos := SourcePos;
+ Result.SourceUnit := FUnitName;
+ Result.OnGetVarValue := FProgram.OnGetVarValue;
+
+ { create init statement }
+ if (InitItem <> nil) and (Statement <> nil) then
+ begin
+ AssignStmt := TfsAssignmentStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(AssignStmt);
+ AssignStmt.Designator := TfsVariableDesignator.Create(Prog);
+ AssignStmt.Designator.RefItem := Result;
+ AssignStmt.Expression := DoExpression(InitItem[0], Prog);
+ CheckTypeCompatibility(Result, AssignStmt.Expression);
+ AssignStmt.Optimize;
+ end;
+
+ except
+ on e: Exception do
+ begin
+ Result.Free;
+ raise;
+ end;
+ end;
+end;
+{$HINTS OFF}
+function TfsILParser.DoDesignator(xi: TfsXMLItem; Prog: TfsScript;
+ EmitOp: TfsEmitOp = emNone): TfsDesignator;
+var
+ i, j: Integer;
+ NodeName, NodeText, TypeName: String;
+ Expr: TfsExpression;
+ Item, PriorItem: TfsDesignatorItem;
+ ClassVar: TfsClassVariable;
+ StringVar: TfsStringVariable;
+ Typ: TfsVarType;
+ LateBinding, PriorIsIndex: Boolean;
+ NewDesignator: TfsDesignator;
+ PriorValue: Variant;
+ Component: TComponent;
+
+ function FindInWithList(const Name: String; ResultDS: TfsDesignator;
+ Item: TfsDesignatorItem): Boolean;
+ var
+ i: Integer;
+ WithStmt: TfsWithStmt;
+ WithItem: TfsDesignatorItem;
+ ClassVar: TfsClassVariable;
+ xi1: TfsXMLItem;
+ begin
+ Result := False;
+ LateBinding := False;
+ for i := FWithList.Count - 1 downto 0 do
+ begin
+ { prevent checking non-local 'with' }
+ if Prog.FindLocal(FWithList[i]) = nil then
+ continue;
+ WithStmt := TfsWithStmt(FWithList.Objects[i]);
+
+ if WithStmt.Variable.Typ = fvtVariant then
+ begin
+ { first check all known variables }
+ if Prog.Find(Name) <> nil then
+ Exit;
+ { if nothing found, create late binding information }
+ Item.Ref := WithStmt.Variable;
+ ResultDS.Finalize;
+ ResultDS.LateBindingXMLSource := TfsXMLItem.Create;
+ ResultDS.LateBindingXMLSource.Assign(xi);
+ xi1 := TfsXMLItem.Create;
+ xi1.Name := 'node';
+ xi1.Text := 'text="' + FWithList[i] + '"';
+ ResultDS.LateBindingXMLSource.InsertItem(0, xi1);
+ LateBinding := True;
+ Result := True;
+ break;
+ end
+ else
+ begin
+ ClassVar := FindClass(WithStmt.Variable.TypeName);
+ Item.Ref := ClassVar.Find(NodeText);
+ end;
+
+ if Item.Ref <> nil then
+ begin
+ WithItem := TfsDesignatorItem.Create;
+ WithItem.Ref := WithStmt.Variable;
+ WithItem.SourcePos := Item.SourcePos;
+
+ ResultDS.Remove(Item);
+ ResultDS.Add(WithItem);
+ ResultDS.Add(Item);
+ Result := True;
+ break;
+ end;
+ end;
+ end;
+
+{$IFDEF OLE}
+ procedure CreateOLEHelpers(Index: Integer);
+ var
+ i: Integer;
+ OLEHelper: TfsOLEHelper;
+ begin
+ for i := Index to xi.Count - 1 do
+ begin
+ ErrorPos(xi[i]);
+ NodeName := LowerCase(xi[i].Name);
+ NodeText := xi[i].Prop['text'];
+
+ if (NodeName = 'node') and (NodeText <> '[') then
+ begin
+ Item := TfsDesignatorItem.Create;
+ Result.Add(Item);
+ Item.SourcePos := FErrorPos;
+ OLEHelper := TfsOLEHelper.Create(NodeText);
+ Prog.Add('', OLEHelper);
+ Item.Ref := OLEHelper;
+ end
+ else if NodeName = 'expr' then
+ begin
+ Expr := DoExpression(xi[i], Prog);
+ PriorItem := Result.Items[Result.Count - 1];
+ PriorItem.Add(Expr);
+ PriorItem.Ref.Add(TfsParamItem.Create('', fvtVariant, '', False, False));
+ end
+ end;
+ end;
+{$ENDIF}
+
+begin
+ Result := TfsDesignator.Create(Prog);
+ try
+
+ for i := 0 to xi.Count - 1 do
+ begin
+ ErrorPos(xi[i]);
+ NodeName := LowerCase(xi[i].Name);
+ NodeText := xi[i].Prop['text'];
+
+ if NodeName = 'node' then
+ begin
+ Item := TfsDesignatorItem.Create;
+ Result.Add(Item);
+ Item.SourcePos := FErrorPos;
+
+ if Result.Count = 1 then
+ begin
+ if not FindInWithList(NodeText, Result, Item) then
+ Item.Ref := FindVar(Prog, NodeText);
+
+ { LateBinding flag turned on in the FindInWithList }
+ if LateBinding then
+ Exit;
+ { add .Create for cpp NEW statement, i.e convert o = new TObject
+ to o = TObject.Create }
+ if EmitOp = emCreate then
+ begin
+ if not (Item.Ref is TfsClassVariable) then
+ raise Exception.Create(SClassRequired);
+ ClassVar := TfsClassVariable(Item.Ref);
+ Item := TfsDesignatorItem.Create;
+ Result.Add(Item);
+ Item.Ref := ClassVar.Find('Create');
+ end;
+ end
+ else
+ begin
+ PriorItem := Result.Items[Result.Count - 2];
+ PriorIsIndex := (PriorItem.Ref is TfsMethodHelper) and
+ TfsMethodHelper(PriorItem.Ref).IndexMethod and not PriorItem.Flag;
+ Typ := PriorItem.Ref.Typ;
+ { late binding }
+ if (Typ = fvtVariant) and not PriorIsIndex then
+ begin
+ PriorValue := PriorItem.Ref.Value;
+ if VarIsNull(PriorValue) then
+ begin
+ Result.Remove(Item);
+ Item.Free;
+ Result.Finalize;
+ Result.LateBindingXMLSource := TfsXMLItem.Create;
+ Result.LateBindingXMLSource.Assign(xi);
+ Exit;
+ end
+ else
+ begin
+ if (TVarData(PriorValue).VType = varString) {$IFDEF Delphi12}or (TVarData(PriorValue).VType = varUString){$ENDIF} then
+ { accessing string elements }
+ Typ := fvtString
+ {$IFDEF OLE}
+ else if TVarData(PriorValue).VType = varDispatch then
+ begin
+ { calling ole }
+ Result.Remove(Item);
+ Item.Free;
+ CreateOLEHelpers(i);
+ Result.Finalize;
+ Exit;
+ end
+ {$ENDIF}
+ else if (TVarData(PriorValue).VType and varArray) = varArray then
+ begin
+ { accessing array elements }
+ if NodeText = '[' then { set ref to arrayhelper }
+ Item.Ref := FindVar(Prog, '__ArrayHelper')
+ else
+ raise Exception.Create(SIndexRequired);
+ continue;
+ end
+ else
+ begin
+ { accessing class items }
+ Typ := fvtClass;
+ PriorItem.Ref.TypeName := TObject(frxInteger(PriorItem.Ref.Value)).ClassName;
+ end;
+ end;
+ end;
+
+ if PriorIsIndex then
+ begin
+ PriorItem.Flag := True;
+ Result.Remove(Item); { previous item is set up already }
+ Item.Free;
+ FErrorPos := PriorItem.SourcePos;
+ if NodeText <> '[' then
+ raise Exception.Create(SIndexRequired);
+ end
+ else if Typ = fvtString then
+ begin
+ if NodeText = '[' then { set ref to stringhelper }
+ Item.Ref := FindVar(Prog, '__StringHelper')
+ else
+ raise Exception.Create(SStringError);
+ end
+ else if Typ = fvtClass then
+ begin
+ TypeName := PriorItem.Ref.TypeName;
+ ClassVar := FindClass(TypeName);
+
+ if NodeText = '[' then { default property }
+ begin
+ Item.Flag := True;
+ Item.Ref := ClassVar.DefProperty;
+ if Item.Ref = nil then
+ raise Exception.CreateFmt(SClassError, [TypeName]);
+ end
+ else { property or method }
+ begin
+ Item.Ref := ClassVar.Find(NodeText, False);
+ { property not found. Probably it's a form element such as button? }
+ if Item.Ref = nil then
+ begin
+ PriorValue := PriorItem.Ref.Value;
+ if ((VarIsNull(PriorValue) or (PriorValue = 0)) and not Prog.IsRunning) and Prog.UseClassLateBinding then
+ begin
+ { at compile time, we don't know anything about form elements.
+ So clear the designator items and use the late binding. }
+ Result.Remove(Item);
+ Item.Free;
+ while Result.Count > 1 do
+ begin
+ Item := Result.Items[Result.Count - 1];
+ Result.Remove(Item);
+ Item.Free;
+ end;
+ Item := Result.Items[0];
+ Result.Finalize;
+ Result.Typ := fvtVariant;
+ Result.LateBindingXMLSource := TfsXMLItem.Create;
+ Result.LateBindingXMLSource.Assign(xi);
+ Exit;
+ end
+ else
+ begin
+ { we at run time now. Try to search in the form's elements. }
+ if TObject(frxInteger(PriorValue)) is TComponent then
+ begin
+ Component := TComponent(frxInteger(PriorValue)).FindComponent(NodeText);
+ if Component <> nil then
+ { creates TfsComponentHelper }
+ Item.Ref := ClassVar.AddComponent(Component);
+ end;
+ if Item.Ref = nil then
+ raise Exception.Create(SIdUndeclared + '''' + NodeText + '''');
+ end
+ end;
+ end;
+ end
+ else if Typ = fvtArray then { set ref to array helper }
+ Item.Ref := PriorItem.Ref.RefItem
+ else
+ raise Exception.Create(SArrayRequired);
+ end;
+ end
+ else if NodeName = 'expr' then
+ begin
+ Expr := DoExpression(xi[i], Prog);
+ Result.Items[Result.Count - 1].Add(Expr);
+ end
+ else if NodeName = 'addr' then { @ operator }
+ begin
+ if xi.Count <> 2 then
+ raise Exception.Create(SVarRequired);
+
+ Item := TfsDesignatorItem.Create;
+ Result.Add(Item);
+ ErrorPos(xi[1]);
+ Item.SourcePos := FErrorPos;
+
+ { we just return the string containing a referenced item name. For
+ example, var s: String; procedure B1; begin end; s := @B1
+ will assign 'B1' to the s }
+ StringVar := TfsStringVariable.Create('', fvtString, '');
+ StringVar.Value := xi[1].Prop['text'];
+ Prog.Add('', StringVar);
+ Item.Ref := StringVar;
+
+ break;
+ end;
+ end;
+
+ if EmitOp = emFree then
+ begin
+ PriorItem := Result.Items[Result.Count - 1];
+ if (PriorItem.Ref.Typ <> fvtClass) and (PriorItem.Ref.Typ <> fvtVariant) then
+ raise Exception.Create(SClassRequired);
+ Item := TfsDesignatorItem.Create;
+ Result.Add(Item);
+ ClassVar := FindClass('TObject');
+ Item.Ref := ClassVar.Find('Free');
+ end;
+
+ Result.Finalize;
+ if Result.Kind <> dkOther then
+ begin
+ NewDesignator := nil;
+ if Result.Kind = dkVariable then
+ NewDesignator := TfsVariableDesignator.Create(Prog)
+ else if Result.Kind = dkStringArray then
+ NewDesignator := TfsStringDesignator.Create(Prog)
+ else if Result.Kind = dkArray then
+ NewDesignator := TfsArrayDesignator.Create(Prog);
+
+ NewDesignator.Borrow(Result);
+ Result.Free;
+ Result := NewDesignator;
+ end;
+
+ for i := 0 to Result.Count - 1 do
+ begin
+ Item := Result[i];
+ FErrorPos := Item.SourcePos;
+ if Item.Ref is TfsDesignator then continue;
+
+ if Item.Count < Item.Ref.GetNumberOfRequiredParams then
+ raise Exception.Create(SNotEnoughParams)
+ else if Item.Count > Item.Ref.Count then
+ raise Exception.Create(STooManyParams)
+ else if Item.Count <> Item.Ref.Count then { construct the default params }
+ for j := Item.Count to Item.Ref.Count - 1 do
+ begin
+ Expr := TfsExpression.Create(FProgram);
+ Item.Add(Expr);
+ Expr.AddConstWithType(Item.Ref[j].DefValue, Item.Ref[j].Typ);
+ Expr.Finalize;
+ end;
+
+ for j := 0 to Item.Count - 1 do
+ begin
+ FErrorPos := Item[j].SourcePos;
+ CheckTypeCompatibility(Item.Ref[j], Item[j]);
+ end;
+ end;
+
+ except
+ on e: Exception do
+ begin
+ Result.Free;
+ raise;
+ end;
+ end;
+end;
+{$HINTS ON}
+function TfsILParser.DoSet(xi: TfsXMLItem; Prog: TfsScript): TfsSetExpression;
+var
+ i: Integer;
+ Name: String;
+begin
+ Result := TfsSetExpression.Create('', fvtVariant, '');
+ try
+ for i := 0 to xi.Count - 1 do
+ begin
+ Name := LowerCase(xi[i].Name);
+ if Name = 'expr' then
+ Result.Add(DoExpression(xi[i], Prog))
+ else if Name = 'range' then
+ Result.Add(nil);
+ end;
+
+ except
+ on e: Exception do
+ begin
+ Result.Free;
+ raise;
+ end;
+ end;
+end;
+
+function TfsILParser.DoExpression(xi: TfsXMLItem; Prog: TfsScript): TfsExpression;
+var
+ ErPos: String;
+ SourcePos1, SourcePos2: TPoint;
+
+ procedure DoExpressionItems(xi: TfsXMLItem; Expression: TfsExpression);
+ var
+ i: Integer;
+ NodeName: String;
+ OpName: String;
+ begin
+ i := 0;
+ while i < xi.Count do
+ begin
+ ErrorPos(xi[i]);
+ Expression.SourcePos := FErrorPos;
+ NodeName := Lowercase(xi[i].Name);
+ OpName := xi[i].Prop['text'];
+
+ if (NodeName = 'op') then
+ begin
+ OpName := LowerCase(OpName);
+ if (OpName = ')') or (i < xi.Count - 1) then
+ Expression.AddOperator(OpName);
+ end
+ else if (NodeName = 'number') or (NodeName = 'string') then
+ Expression.AddConst(ParserStringToVariant(OpName))
+ else if NodeName = 'dsgn' then
+ Expression.AddDesignator(DoDesignator(xi[i], Prog))
+ else if NodeName = 'set' then
+ Expression.AddSet(DoSet(xi[i], Prog))
+ else if NodeName = 'new' then
+ Expression.AddDesignator(DoDesignator(xi[i][0], Prog, emCreate))
+ else if NodeName = 'expr' then
+ DoExpressionItems(xi[i], Expression);
+
+ Inc(i);
+ end;
+ end;
+
+ function GetSource(pt1, pt2: TPoint): String;
+ var
+ i1, i2: Integer;
+ begin
+ i1 := FParser.GetPlainPosition(pt1);
+ i2 := FParser.GetPlainPosition(pt2);
+ if (i1 = -1) or (i2 = -1) then
+ Result := ''
+ else
+ Result := Copy(FParser.Text, i1, i2 - i1);
+ end;
+
+begin
+ Result := TfsExpression.Create(FProgram);
+ try
+ DoExpressionItems(xi, Result);
+ SourcePos1 := fsPosToPoint(PropPos(xi));
+ SourcePos2 := fsPosToPoint(xi.Prop['pos1']);
+ Result.Source := GetSource(SourcePos1, SourcePos2);
+
+ ErPos := Result.Finalize;
+ if ErPos <> '' then
+ begin
+ FErrorPos := ErPos;
+ raise Exception.Create(SIncompatibleTypes);
+ end;
+
+ except
+ on e: Exception do
+ begin
+ Result.Free;
+ raise;
+ end;
+ end;
+end;
+
+procedure TfsILParser.DoUses(xi: TfsXMLItem; Prog: TfsScript);
+var
+ i: Integer;
+ SaveUnitName: String;
+ s: String;
+ sl: TStringList;
+ ms: TMemoryStream;
+ xd: TfsXMLDocument;
+begin
+ SaveUnitName := FUnitName;
+ FUnitName := xi.Prop['unit'];
+ xd := nil;
+
+ if FUsesList.IndexOf(FUnitName) <> -1 then
+ begin
+ FUnitName := SaveUnitName;
+ Exit;
+ end;
+ FUsesList.Add(FUnitName);
+ if Assigned(FProgram.OnGetILUnit) then
+ begin
+ s := '';
+ FProgram.OnGetILUnit(FProgram, FUnitName, s);
+ if s <> '' then
+ begin
+ sl := TStringList.Create;
+ sl.Text := s;
+
+ ms := TMemoryStream.Create;
+ sl.SaveToStream(ms);
+ sl.Free;
+ ms.Position := 0;
+
+ xd := TfsXMLDocument.Create;
+ xd.LoadFromStream(ms);
+ ms.Free;
+ end;
+ end;
+
+ if xd <> nil then
+ begin
+ try
+ DoProgram(xd.Root, Prog);
+ finally
+ xd.Free;
+ end;
+ end
+ else
+ begin
+ for i := 0 to xi.Count - 1 do
+ DoProgram(xi[i], Prog);
+ end;
+
+ FUnitName := SaveUnitName;
+end;
+
+procedure TfsILParser.DoVar(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ i: Integer;
+ Name: String;
+begin
+ for i := 0 to xi.Count - 1 do
+ begin
+ ErrorPos(xi[i]);
+ if CompareText(xi[i].Name, 'ident') = 0 then
+ begin
+ Name := xi[i].Prop['text'];
+ CheckIdent(Prog, Name);
+ Prog.Add(Name, CreateVar(xi, Prog, Name, Statement));
+ end;
+ end;
+end;
+
+procedure TfsILParser.DoConst(xi: TfsXMLItem; Prog: TfsScript);
+var
+ Name: String;
+ Expr: TfsExpression;
+ v: TfsVariable;
+begin
+ Name := xi[0].Prop['text'];
+ ErrorPos(xi[0]);
+ CheckIdent(Prog, Name);
+
+ Expr := DoExpression(xi[1], Prog);
+ v := TfsVariable.Create(Name, Expr.Typ, Expr.TypeName);
+ v.Value := Expr.Value;
+ v.IsReadOnly := True;
+ Expr.Free;
+
+ Prog.Add(Name, v);
+end;
+
+procedure TfsILParser.DoParameters(xi: TfsXMLItem; v: TfsProcVariable);
+var
+ i: Integer;
+ s: String;
+ varParams: Boolean;
+
+ procedure DoParam(xi: TfsXMLItem);
+ var
+ i: Integer;
+ Name: String;
+ Param: TfsParamItem;
+ varParam: Boolean;
+ begin
+ varParam := False;
+
+ for i := 0 to xi.Count - 1 do
+ begin
+ ErrorPos(xi[i]);
+ if CompareText(xi[i].Name, 'varparam') = 0 then
+ varParam := True
+ else if CompareText(xi[i].Name, 'ident') = 0 then
+ begin
+ Name := xi[i].Prop['text'];
+ CheckIdent(v.Prog, Name);
+ Param := TfsParamItem(CreateVar(xi, v.Prog, Name, nil, True,
+ varParams or VarParam));
+ Param.DefValue := Param.Value;
+ v.Add(Param);
+ v.Prog.Add(Name, Param);
+ varParam := False;
+ end;
+ end;
+ end;
+
+begin
+ if CompareText(xi.Name, 'parameters') <> 0 then Exit;
+ varParams := False;
+ for i := 0 to xi.Count - 1 do
+ begin
+ s := LowerCase(xi[i].Name);
+ if s = 'varparams' then
+ varParams := True
+ else if s = 'var' then
+ begin
+ DoParam(xi[i]);
+ varParams := False;
+ end;
+ end;
+end;
+
+procedure TfsILParser.DoProc1(xi: TfsXMLItem; Prog: TfsScript);
+var
+ i: Integer;
+ s, Name: String;
+ Proc: TfsProcVariable;
+begin
+ ErrorPos(xi[0]);
+ Name := xi[0].Prop['text'];
+ CheckIdent(Prog, Name);
+
+{$IFDEF CPUX64}
+ Proc := TfsProcVariable.Create(Name, fvtInt64, '', Prog, False);
+{$ELSE}
+ Proc := TfsProcVariable.Create(Name, fvtInt, '', Prog, False);
+{$ENDIF}
+ Proc.SourcePos := PropPos(xi);
+ Proc.SourceUnit := FUnitName;
+ Prog.Add(Name, Proc);
+
+ for i := 0 to xi.Count - 1 do
+ begin
+ s := LowerCase(xi[i].Name);
+ if s = 'parameters' then
+ DoParameters(xi[i], Proc);
+ end;
+end;
+
+procedure TfsILParser.DoProc2(xi: TfsXMLItem; Prog: TfsScript);
+var
+ Name: String;
+ Proc: TfsProcVariable;
+begin
+ Name := xi[0].Prop['text'];
+ Proc := TfsProcVariable(FindVar(Prog, Name));
+ DoProgram(xi, Proc.Prog);
+end;
+
+procedure TfsILParser.DoFunc1(xi: TfsXMLItem; Prog: TfsScript);
+var
+ i: Integer;
+ s, Name, TypeName: String;
+ Typ: TfsVarType;
+ Func: TfsProcVariable;
+begin
+ Name := '';
+ TypeName := '';
+ Typ := fvtVariant;
+
+ for i := 0 to xi.Count - 1 do
+ begin
+ ErrorPos(xi[i]);
+ s := LowerCase(xi[i].Name);
+ if s = 'type' then
+ begin
+ TypeName := xi[i].Prop['text'];
+ Typ := FindType(TypeName);
+ end
+ else if s = 'name' then
+ begin
+ Name := xi[i].Prop['text'];
+ CheckIdent(Prog, Name);
+ end
+ end;
+
+
+ Func := TfsProcVariable.Create(Name, Typ, TypeName, Prog,
+ CompareText(TypeName, 'void') <> 0);
+ Func.SourcePos := PropPos(xi);
+ Func.SourceUnit := FUnitName;
+ Prog.Add(Name, Func);
+
+ for i := 0 to xi.Count - 1 do
+ begin
+ s := LowerCase(xi[i].Name);
+ if s = 'parameters' then
+ DoParameters(xi[i], Func);
+ end;
+end;
+
+procedure TfsILParser.DoFunc2(xi: TfsXMLItem; Prog: TfsScript);
+var
+ i: Integer;
+ s, Name: String;
+ Func: TfsProcVariable;
+begin
+ Name := '';
+
+ for i := 0 to xi.Count - 1 do
+ begin
+ s := LowerCase(xi[i].Name);
+ if s = 'name' then
+ Name := xi[i].Prop['text'];
+ end;
+
+ Func := TfsProcVariable(FindVar(Prog, Name));
+ DoProgram(xi, Func.Prog);
+end;
+
+procedure TfsILParser.DoAssign(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ i: Integer;
+ Stmt: TfsAssignmentStmt;
+ Designator: TfsDesignator;
+ Expression: TfsExpression;
+ Modificator: String;
+begin
+ Designator := nil;
+ Expression := nil;
+
+ try
+ Modificator := ' ';
+ Designator := DoDesignator(xi[0], Prog);
+
+ i := 1;
+ if CompareText(xi[1].Name, 'modificator') = 0 then
+ begin
+ Modificator := xi[1].Prop['text'];
+ Inc(i);
+ end;
+ Expression := DoExpression(xi[i], Prog);
+
+ if Designator.IsReadOnly then
+ raise Exception.Create(SLeftCantAssigned);
+
+ CheckTypeCompatibility(Designator, Expression);
+ if Modificator = ' ' then
+ Modificator := Expression.Optimize(Designator);
+ except
+ on e: Exception do
+ begin
+ if Designator <> nil then
+ Designator.Free;
+ if Expression <> nil then
+ Expression.Free;
+ raise;
+ end;
+ end;
+
+ case Modificator[1] of
+ '+':
+ Stmt := TfsAssignPlusStmt.Create(Prog, FUnitName, PropPos(xi));
+ '-':
+ Stmt := TfsAssignMinusStmt.Create(Prog, FUnitName, PropPos(xi));
+ '*':
+ Stmt := TfsAssignMulStmt.Create(Prog, FUnitName, PropPos(xi));
+ '/':
+ Stmt := TfsAssignDivStmt.Create(Prog, FUnitName, PropPos(xi));
+ else
+ Stmt := TfsAssignmentStmt.Create(Prog, FUnitName, PropPos(xi));
+ end;
+
+ Statement.Add(Stmt);
+ Stmt.Designator := Designator;
+ Stmt.Expression := Expression;
+ Stmt.Optimize;
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoCall(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ Stmt: TfsCallStmt;
+begin
+ Stmt := TfsCallStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+ Stmt.Designator := DoDesignator(xi[0], Prog);
+ if xi.Count > 1 then
+ begin
+ Stmt.Modificator := xi[1].Prop['text'];
+ if Stmt.Designator.IsReadOnly then
+ raise Exception.Create(SLeftCantAssigned);
+ end;
+
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoIf(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ i: Integer;
+ s: String;
+ Stmt: TfsIfStmt;
+begin
+ Stmt := TfsIfStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+ Stmt.Condition := DoExpression(xi[0], Prog);
+
+ for i := 1 to xi.Count - 1 do
+ begin
+ s := Lowercase(xi[i].Name);
+ if s = 'thenstmt' then
+ DoCompoundStmt(xi[1], Prog, Stmt)
+ else if s = 'elsestmt' then
+ DoCompoundStmt(xi[2], Prog, Stmt.ElseStmt);
+ end;
+
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoFor(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ i: Integer;
+ Stmt: TfsForStmt;
+begin
+ Stmt := TfsForStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+ ErrorPos(xi[0]);
+ Stmt.Variable := FindVar(Prog, xi[0].Prop['text']);
+ if not ((Stmt.Variable is TfsVariable) and
+ (Stmt.Variable.Typ in [fvtInt, fvtInt64, fvtVariant, fvtFloat])) then
+ raise Exception.Create(SForError);
+
+ Stmt.BeginValue := DoExpression(xi[1], Prog);
+ CheckTypeCompatibility(Stmt.Variable, Stmt.BeginValue);
+
+ i := 2;
+ if CompareText(xi[2].Name, 'downto') = 0 then
+ begin
+ Stmt.Down := True;
+ Inc(i);
+ end;
+
+ Stmt.EndValue := DoExpression(xi[i], Prog);
+ CheckTypeCompatibility(Stmt.Variable, Stmt.EndValue);
+ if i + 1 < xi.Count then
+ DoStmt(xi[i + 1], Prog, Stmt);
+
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoVbFor(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ i: Integer;
+ Stmt: TfsVbForStmt;
+begin
+ Stmt := TfsVbForStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+ ErrorPos(xi[0]);
+ Stmt.Variable := FindVar(Prog, xi[0].Prop['text']);
+ if not ((Stmt.Variable is TfsVariable) and
+ (Stmt.Variable.Typ in [fvtInt, fvtInt64, fvtVariant, fvtFloat])) then
+ raise Exception.Create(SForError);
+
+ Stmt.BeginValue := DoExpression(xi[1], Prog);
+ CheckTypeCompatibility(Stmt.Variable, Stmt.BeginValue);
+
+ Stmt.EndValue := DoExpression(xi[2], Prog);
+ CheckTypeCompatibility(Stmt.Variable, Stmt.EndValue);
+
+ i := 3;
+ if i < xi.Count then
+ if CompareText(xi[i].Name, 'expr') = 0 then
+ begin
+ Stmt.Step := DoExpression(xi[i], Prog);
+ CheckTypeCompatibility(Stmt.Variable, Stmt.Step);
+ Inc(i);
+ end;
+
+ if i < xi.Count then
+ DoStmt(xi[i], Prog, Stmt);
+
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoCppFor(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ Stmt: TfsCppForStmt;
+begin
+ Stmt := TfsCppForStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+ DoStmt(xi[0], Prog, Stmt.FirstStmt);
+ Stmt.Expression := DoExpression(xi[1], Prog);
+ DoStmt(xi[2], Prog, Stmt.SecondStmt);
+ DoStmt(xi[3], Prog, Stmt);
+
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoWhile(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ Stmt: TfsWhileStmt;
+begin
+ Stmt := TfsWhileStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+ Stmt.Condition := DoExpression(xi[0], Prog);
+ if xi.Count > 1 then
+ DoStmt(xi[1], Prog, Stmt);
+
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoRepeat(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ i, j: Integer;
+ Stmt: TfsRepeatStmt;
+begin
+ Stmt := TfsRepeatStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+
+ j := xi.Count - 1;
+ if CompareText(xi[j].Name, 'inverse') = 0 then
+ begin
+ Stmt.InverseCondition := True;
+ Dec(j);
+ end;
+ Stmt.Condition := DoExpression(xi[j], Prog);
+ Dec(j);
+
+ for i := 0 to j do
+ DoStmt(xi[i], Prog, Stmt);
+
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoCase(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ i: Integer;
+ Stmt: TfsCaseStmt;
+
+ procedure DoCaseSelector(xi: TfsXMLItem);
+ var
+ Selector: TfsCaseSelector;
+ begin
+ if (CompareText(xi.Name, 'caseselector') <> 0) or (xi.Count <> 2) then Exit;
+ Selector := TfsCaseSelector.Create(Prog, FUnitName, PropPos(xi));
+ Stmt.Add(Selector);
+
+ Selector.SetExpression := DoSet(xi[0], Prog);
+ DoStmt(xi[1], Prog, Selector);
+ end;
+
+begin
+ Stmt := TfsCaseStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+ Stmt.Condition := DoExpression(xi[0], Prog);
+
+ for i := 1 to xi.Count - 1 do
+ DoCaseSelector(xi[i]);
+ if CompareText(xi[xi.Count - 1].Name, 'caseselector') <> 0 then
+ DoStmt(xi[xi.Count - 1], Prog, Stmt.ElseStmt);
+
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoTry(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ i: Integer;
+ Stmt: TfsTryStmt;
+begin
+ Stmt := TfsTryStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+
+ for i := 0 to xi.Count - 1 do
+ if CompareText(xi[i].Name, 'exceptstmt') = 0 then
+ begin
+ Stmt.IsExcept := True;
+ DoCompoundStmt(xi[i], Prog, Stmt.ExceptStmt);
+ end
+ else if CompareText(xi[i].Name, 'finallystmt') = 0 then
+ DoCompoundStmt(xi[i], Prog, Stmt.ExceptStmt)
+ else
+ DoStmt(xi[i], Prog, Stmt);
+
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoBreak(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ Stmt: TfsBreakStmt;
+begin
+ Stmt := TfsBreakStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoContinue(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ Stmt: TfsContinueStmt;
+begin
+ Stmt := TfsContinueStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoExit(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ Stmt: TfsExitStmt;
+begin
+ Stmt := TfsExitStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoReturn(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ xi1: TfsXMLItem;
+begin
+ if xi.Count = 1 then { "return expr" }
+ begin
+ xi1 := TfsXMLItem.Create;
+ xi1.Name := 'dsgn';
+ xi.InsertItem(0, xi1);
+ with xi1.Add do
+ begin
+ Name := 'node';
+ Text := 'text="Result" pos="' + xi[1].Prop['pos'] + '"';
+ end;
+
+ DoAssign(xi, Prog, Statement);
+ end;
+
+ DoExit(xi, Prog, Statement);
+end;
+
+procedure TfsILParser.DoWith(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ d: TfsDesignator;
+ i, n: Integer;
+ s: String;
+ v: TfsVariable;
+ Stmt: TfsWithStmt;
+
+ function CreateUniqueVariable: String;
+ var
+ i: Integer;
+ begin
+ i := 0;
+ while (Prog.FindLocal(IntToStr(i)) <> nil) or
+ (FWithList.IndexOf(IntToStr(i)) <> -1) do
+ Inc(i);
+ Result := '_WithList_' + IntToStr(i);
+ end;
+
+begin
+ n := xi.Count - 1;
+
+ for i := 0 to n - 1 do
+ begin
+ d := DoDesignator(xi[i], Prog);
+ if not ((d.Typ = fvtClass) or (d.Typ = fvtVariant)) then
+ begin
+ d.Free;
+ raise Exception.Create(SClassRequired);
+ end;
+
+ { create local variable with unique name }
+ s := CreateUniqueVariable;
+ v := TfsVariable.Create(s, d.Typ, d.TypeName);
+ Prog.Add(s, v);
+
+ Stmt := TfsWithStmt.Create(Prog, FUnitName, PropPos(xi));
+ Stmt.Variable := v;
+ Stmt.Designator := d;
+ Statement.Add(Stmt);
+ FWithList.AddObject(s, Stmt);
+ end;
+
+ DoStmt(xi[xi.Count - 1], Prog, Statement);
+
+ for i := 0 to n - 1 do
+ FWithList.Delete(FWithList.Count - 1);
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoDelete(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ Stmt: TfsCallStmt;
+begin
+ Stmt := TfsCallStmt.Create(Prog, FUnitName, PropPos(xi));
+ Statement.Add(Stmt);
+ Stmt.Designator := DoDesignator(xi[0], Prog, emFree);
+ FProgram.AddCodeLine(FUnitName, PropPos(xi));
+end;
+
+procedure TfsILParser.DoCompoundStmt(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ i: Integer;
+begin
+ for i := 0 to xi.Count - 1 do
+ DoStmt(xi[i], Prog, Statement);
+end;
+
+procedure TfsILParser.DoStmt(xi: TfsXMLItem; Prog: TfsScript; Statement: TfsStatement);
+var
+ s: String;
+begin
+ s := LowerCase(xi.Name);
+ if s = 'assignstmt' then
+ DoAssign(xi, Prog, Statement)
+ else if s = 'callstmt' then
+ DoCall(xi, Prog, Statement)
+ else if s = 'ifstmt' then
+ DoIf(xi, Prog, Statement)
+ else if s = 'casestmt' then
+ DoCase(xi, Prog, Statement)
+ else if s = 'forstmt' then
+ DoFor(xi, Prog, Statement)
+ else if s = 'vbforstmt' then
+ DoVbFor(xi, Prog, Statement)
+ else if s = 'cppforstmt' then
+ DoCppFor(xi, Prog, Statement)
+ else if s = 'whilestmt' then
+ DoWhile(xi, Prog, Statement)
+ else if s = 'repeatstmt' then
+ DoRepeat(xi, Prog, Statement)
+ else if s = 'trystmt' then
+ DoTry(xi, Prog, Statement)
+ else if s = 'break' then
+ DoBreak(xi, Prog, Statement)
+ else if s = 'continue' then
+ DoContinue(xi, Prog, Statement)
+ else if s = 'exit' then
+ DoExit(xi, Prog, Statement)
+ else if s = 'return' then
+ DoReturn(xi, Prog, Statement)
+ else if s = 'with' then
+ DoWith(xi, Prog, Statement)
+ else if s = 'delete' then
+ DoDelete(xi, Prog, Statement)
+ else if s = 'compoundstmt' then
+ DoCompoundStmt(xi, Prog, Statement)
+ else if s = 'uses' then
+ DoUses(xi, Prog)
+ else if s = 'var' then
+ DoVar(xi, Prog, Statement)
+ else if s = 'const' then
+ DoConst(xi, Prog)
+ else if s = 'procedure' then
+ DoProc2(xi, Prog)
+ else if s = 'function' then
+ DoFunc2(xi, Prog)
+end;
+
+procedure TfsILParser.DoProgram(xi: TfsXMLItem; Prog: TfsScript);
+var
+ TempRoot: TfsXMLItem;
+
+ procedure DoFirstPass(xi: TfsXMLItem);
+ var
+ i: Integer;
+ s: String;
+ begin
+ for i := 0 to xi.Count - 1 do
+ begin
+ s := LowerCase(xi[i].Name);
+ if s = 'compoundstmt' then
+ DoFirstPass(xi[i])
+ else if s = 'procedure' then
+ DoProc1(xi[i], Prog)
+ else if s = 'function' then
+ DoFunc1(xi[i], Prog)
+ end;
+ end;
+
+begin
+ TempRoot := FProgRoot;
+ FProgRoot := xi;
+ DoFirstPass(xi);
+ DoCompoundStmt(xi, Prog, Prog.Statement);
+ FProgRoot := TempRoot;
+end;
+
+
+end.
diff --git a/LibD28/fs_iinirtti.pas b/LibD28/fs_iinirtti.pas
new file mode 100644
index 0000000..8ef969b
--- /dev/null
+++ b/LibD28/fs_iinirtti.pas
@@ -0,0 +1,377 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ IniFiles.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{ Copyright (c) 2004-2007 }
+{ by Stalker SoftWare }
+{ }
+{******************************************}
+
+unit fs_iinirtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, IniFiles{$IFDEF DELPHI16}, Controls{$ENDIF}
+{$IFDEF Delphi16}
+ , System.Types
+{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsIniRTTI = class(TComponent); // fake component
+
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass; const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass; const PropName: String): Variant;
+ procedure SaveIniFileToStream(oIniFile: TCustomIniFile; oStream: TStream);
+ procedure LoadIniFileFromStream(oIniFile :TCustomIniFile; oStream :TStream);
+ procedure WriteTStrings(oIniFile: TCustomIniFile; const Section: String; Values: TStrings; IsClear :Boolean = True);
+ procedure ReadTStrings(oIniFile: TCustomIniFile; const Section: String; Values: TStrings; IsClear :Boolean = True);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+
+ with AScript do
+ begin
+ with AddClass(TCustomIniFile, 'TObject') do
+ begin
+ AddConstructor('constructor Create(const FileName: String)', CallMethod);
+ AddMethod('function ReadInteger(const Section, Ident: String; Default: LongInt): LongInt', CallMethod);
+ AddMethod('procedure WriteInteger(const Section, Ident: String; Value: LongInt)', CallMethod);
+ AddMethod('function ReadBool(const Section, Ident: String; Default: Boolean): Boolean', CallMethod);
+ AddMethod('procedure WriteBool(const Section, Ident: String; Value: Boolean)', CallMethod);
+ AddMethod('function ReadDate(const Section, Name: String; Default: TDateTime): TDateTime', CallMethod);
+ AddMethod('procedure WriteDate(const Section, Name: String; Value: TDateTime)', CallMethod);
+ AddMethod('function ReadDateTime(const Section, Name: String; Default: TDateTime): TDateTime', CallMethod);
+ AddMethod('procedure WriteDateTime(const Section, Name: String; Value: TDateTime)', CallMethod);
+ AddMethod('function ReadFloat(const Section, Name: String; Default: Double): Double', CallMethod);
+ AddMethod('procedure WriteFloat(const Section, Name: String; Value: Double)', CallMethod);
+ AddMethod('function ReadTime(const Section, Name: String; Default: TDateTime): TDateTime', CallMethod);
+ AddMethod('procedure WriteTime(const Section, Name: String; Value: TDateTime);', CallMethod);
+{$IFDEF DELPHI6}
+ AddMethod('function ReadBinaryStream(const Section, Name: String; Value: TStream): Integer', CallMethod);
+ AddMethod('procedure WriteBinaryStream(const Section, Name: String; Value: TStream)', CallMethod);
+{$ENDIF}
+ AddMethod('function SectionExists(const Section: String): Boolean', CallMethod);
+ AddMethod('function ValueExists(const Section, Ident: String): Boolean', CallMethod);
+
+ AddMethod('procedure WriteTStrings(const Section :String; Value :TStrings; IsClear :Boolean = True)', CallMethod);
+ AddMethod('function ReadTStrings(const Section :String; Value :TStrings; IsClear :Boolean = True): String;', CallMethod);
+
+ AddProperty('FileName', 'String', GetProp);
+ end;
+
+ with AddClass(TMemIniFile, 'TCustomIniFile') do
+ begin
+ AddConstructor('constructor Create(const FileName: String)', CallMethod);
+ AddMethod('procedure WriteString(const Section, Ident, Value: String)', CallMethod);
+ AddMethod('function ReadString(const Section, Ident, Default: String): String;', CallMethod);
+{$IFDEF DELPHI6}
+ AddMethod('procedure ReadSectionValuesEx(const Section: String; Strings: TStrings)', CallMethod);
+{$ENDIF}
+ AddMethod('procedure DeleteKey(const Section, Ident: String)', CallMethod);
+ AddMethod('procedure ReadSection(const Section: String; Strings: TStrings)', CallMethod);
+ AddMethod('procedure ReadSections(Strings: TStrings)', CallMethod);
+ AddMethod('procedure ReadSectionValues(const Section: String; Strings: TStrings)', CallMethod);
+ AddMethod('procedure EraseSection(const Section: String)', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure GetStrings(List: TStrings)', CallMethod);
+ AddMethod('procedure SetStrings(List: TStrings)', CallMethod);
+ AddMethod('procedure SaveIniFileToStream(oStream: TStream)', CallMethod);
+ AddMethod('procedure LoadIniFileFromStream(oStream: TStream)', CallMethod);
+ end;
+
+ with AddClass(TIniFile, 'TCustomIniFile') do
+ begin
+ AddMethod('procedure WriteString(const Section, Ident, Value: String)', CallMethod);
+ AddMethod('function ReadString(const Section, Ident, Default: String): String;', CallMethod);
+{$IFDEF DELPHI6}
+ AddMethod('procedure ReadSectionValuesEx(const Section: String; Strings: TStrings)', CallMethod);
+{$ENDIF}
+ AddMethod('procedure DeleteKey(const Section, Ident: String)', CallMethod);
+ AddMethod('procedure ReadSection(const Section: String; Strings: TStrings)', CallMethod);
+ AddMethod('procedure ReadSections(Strings: TStrings)', CallMethod);
+ AddMethod('procedure ReadSectionValues(const Section: String; Strings: TStrings)', CallMethod);
+ AddMethod('procedure EraseSection(const Section: String)', CallMethod);
+ AddMethod('procedure SaveIniFileToStream(oStream: TStream)', CallMethod);
+ AddMethod('procedure LoadIniFileFromStream(oStream: TStream)', CallMethod);
+ end;
+
+ end;
+
+end;
+
+{$HINTS OFF}
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ oCustomIniFile: TCustomIniFile;
+ oMemIniFile: TMemIniFile;
+ oIniFile: TIniFile;
+ oList: TStrings;
+ nCou: Integer;
+
+begin
+
+ Result := 0;
+
+ if ClassType = TCustomIniFile then
+ begin
+ oCustomIniFile := TCustomIniFile(Instance);
+ if MethodName = 'CREATE' then
+ Result := frxInteger(oCustomIniFile.Create(Caller.Params[0]))
+ else if MethodName = 'WRITEINTEGER' then
+ oCustomIniFile.WriteInteger(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READINTEGER' then
+ Result := oCustomIniFile.ReadInteger(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITEBOOL' then
+ oCustomIniFile.WriteBool(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READBOOL' then
+ Result := oCustomIniFile.ReadBool(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITEDATE' then
+ oCustomIniFile.WriteDate(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READDATE' then
+ Result := oCustomIniFile.ReadDate(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITEDATETIME' then
+ oCustomIniFile.WriteDateTime(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READDATETIME' then
+ Result := oCustomIniFile.ReadDateTime(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITEFLOAT' then
+ oCustomIniFile.WriteFloat(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READFLOAT' then
+ Result := oCustomIniFile.ReadFloat(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'WRITETIME' then
+ oCustomIniFile.WriteTime(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READTIME' then
+ Result := oCustomIniFile.ReadTime(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+{$IFDEF DELPHI6}
+ else if MethodName = 'WRITEBINARYSTREAM' then
+ oCustomIniFile.WriteBinaryStream(Caller.Params[0], Caller.Params[1], TStream(frxInteger(Caller.Params[2])))
+ else if MethodName = 'READBINARYSTREAM' then
+ Result := oCustomIniFile.ReadBinaryStream(Caller.Params[0], Caller.Params[1], TStream(frxInteger(Caller.Params[2])))
+{$ENDIF}
+ else if MethodName = 'SECTIONEXISTS' then
+ Result := oCustomIniFile.SectionExists(Caller.Params[0])
+ else if MethodName = 'VALUEEXISTS' then
+ Result := oCustomIniFile.ValueExists(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'WRITETSTRINGS' then
+ WriteTStrings(oCustomIniFile, Caller.Params[0], TStrings(frxInteger(Caller.Params[1])), Caller.Params[2])
+ else if MethodName = 'READTSTRINGS' then
+ ReadTStrings(oCustomIniFile, Caller.Params[0], TStrings(frxInteger(Caller.Params[1])), Caller.Params[2])
+
+ end;
+
+ if ClassType = TMemIniFile then
+ begin
+ oMemIniFile := TMemIniFile(Instance);
+ if MethodName = 'CREATE' then
+ Result := frxInteger(oMemIniFile.Create(Caller.Params[0]{$IFDEF FPC}, False{$ENDIF}))
+ else if MethodName = 'WRITESTRING' then
+ oMemIniFile.WriteString(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READSTRING' then
+ Result := oMemIniFile.ReadString(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'DELETEKEY' then
+ oMemIniFile.DeleteKey(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'READSECTION' then
+ oMemIniFile.ReadSection(Caller.Params[0], TStrings(frxInteger(Caller.Params[1])))
+ else if MethodName = 'READSECTIONS' then
+ oMemIniFile.ReadSections(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'READSECTIONVALUES' then
+ oMemIniFile.ReadSectionValues(Caller.Params[0], TStrings(frxInteger(Caller.Params[1])))
+ else if MethodName = 'ERASESECTION' then
+ oMemIniFile.EraseSection(Caller.Params[0])
+{$IFDEF DELPHI6}
+ else if MethodName = 'READSECTIONVALUESEX' then
+ begin
+ oList := TStringList.Create;
+ try
+ oMemIniFile.ReadSectionValues(Caller.Params[0], oList);
+ TStrings(frxInteger(Caller.Params[1])).Clear;
+ for nCou := 0 to oList.Count-1 do
+// TStrings(frxInteger(Caller.Params[1])).Add(oList.ValueFromIndex[nCou]);
+ TStrings(frxInteger(Caller.Params[1])).Add(oList.Values[oList.Names[nCou]]);
+ finally
+ oList.Free;
+ end;
+ end
+{$ENDIF}
+ else if MethodName = 'CLEAR' then
+ oMemIniFile.Clear
+ else if MethodName = 'GETSTRINGS' then
+ oMemIniFile.GetStrings(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SETSTRINGS' then
+ oMemIniFile.SetStrings(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVEINIFILETOSTREAM' then
+ SaveIniFileToStream(oMemIniFile, TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LOADINIFILEFROMSTREAM' then
+ LoadIniFileFromStream(oMemIniFile, TStream(frxInteger(Caller.Params[0])))
+ end;
+
+ if ClassType = TIniFile then
+ begin
+ oIniFile := TIniFile(Instance);
+ if MethodName = 'WRITESTRING' then
+ oIniFile.WriteString(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'READSTRING' then
+ Result := oIniFile.ReadString(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'DELETEKEY' then
+ oIniFile.DeleteKey(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'READSECTION' then
+ oIniFile.ReadSection(Caller.Params[0], TStrings(frxInteger(Caller.Params[1])))
+ else if MethodName = 'READSECTIONS' then
+ oIniFile.ReadSections(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'READSECTIONVALUES' then
+ oIniFile.ReadSectionValues(Caller.Params[0], TStrings(frxInteger(Caller.Params[1])))
+ else if MethodName = 'ERASESECTION' then
+ oIniFile.EraseSection(Caller.Params[0])
+{$IFDEF DELPHI6}
+ else if MethodName = 'READSECTIONVALUESEX' then
+ begin
+ oList := TStringList.Create;
+ try
+ oIniFile.ReadSectionValues(Caller.Params[0], oList);
+ TStrings(frxInteger(Caller.Params[1])).Clear;
+ for nCou := 0 to oList.Count-1 do
+// TStrings(frxInteger(Caller.Params[1])).Add(oList.ValueFromIndex[nCou]);
+ TStrings(frxInteger(Caller.Params[1])).Add(oList.Values[oList.Names[nCou]]);
+ finally
+ oList.Free;
+ end;
+ end
+{$ENDIF}
+ else if MethodName = 'SAVEINIFILETOSTREAM' then
+ SaveIniFileToStream(oIniFile, TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LOADINIFILEFROMSTREAM' then
+ LoadIniFileFromStream(oIniFile, TStream(frxInteger(Caller.Params[0])))
+ end;
+
+end;
+{$HINTS ON}
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass; const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TCustomIniFile then
+ begin
+ if PropName = 'FILENAME' then
+ Result := TIniFile(Instance).FileName
+ end;
+end;
+
+procedure TFunctions.SaveIniFileToStream(oIniFile :TCustomIniFile; oStream :TStream);
+var
+ oStrings :TStrings;
+
+begin
+
+ if (not Assigned(oIniFile)) or (not Assigned(oStream)) then Exit;
+
+ if not ((oIniFile is TIniFile) or (oIniFile is TMemIniFile)) then Exit;
+
+ oStrings:= TStringList.Create;
+ try
+
+ if oIniFile is TIniFile then
+ oStrings.LoadFromFile(oIniFile.FileName)
+ else
+ if oIniFile is TMemIniFile then
+ TMemIniFile(oIniFile).GetStrings(oStrings);
+
+ oStrings.SaveToStream(oStream);
+
+ finally
+ oStrings.Free;
+ end;
+
+end;
+
+procedure TFunctions.LoadIniFileFromStream(oIniFile :TCustomIniFile; oStream :TStream);
+var
+ oStrings :TStrings;
+
+begin
+
+ if (not Assigned(oIniFile)) or (not Assigned(oStream)) then Exit;
+
+ if not ((oIniFile is TIniFile) or (oIniFile is TMemIniFile)) then Exit;
+
+ oStrings:= TStringList.Create;
+ try
+
+ oStrings.LoadFromStream(oStream);
+
+ if oIniFile is TIniFile then
+ oStrings.SaveToFile(oIniFile.FileName)
+ else
+ if oIniFile is TMemIniFile then
+ TMemIniFile(oIniFile).SetStrings(oStrings);
+
+ finally
+ oStrings.Free;
+ end;
+
+end;
+
+procedure TFunctions.WriteTStrings(oIniFile :TCustomIniFile; const Section :String; Values :TStrings; IsClear :Boolean = True);
+var
+ nCou :Integer;
+
+begin
+
+ if IsClear then oIniFile.EraseSection(Section);
+
+ for nCou := 0 to Values.Count-1 do
+ oIniFile.WriteString(Section, 'Items'+IntToStr(nCou), Values[nCou]);
+
+ oIniFile.WriteInteger(Section, 'Count', Values.Count);
+
+end;
+
+procedure TFunctions.ReadTStrings(oIniFile :TCustomIniFile; const Section :String; Values :TStrings; IsClear :Boolean = True);
+var
+ nCou, nCount :Integer;
+
+begin
+
+ nCount := oIniFile.ReadInteger(Section, 'Count', 0);
+
+ if IsClear then Values.Clear;
+
+ for nCou := 0 to nCount-1 do
+ Values.Add(oIniFile.ReadString(Section, 'Items'+IntToStr(nCou), ''));
+
+end;
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsIniRTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28/fs_iinterpreter.pas b/LibD28/fs_iinterpreter.pas
new file mode 100644
index 0000000..916100e
--- /dev/null
+++ b/LibD28/fs_iinterpreter.pas
@@ -0,0 +1,3547 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Main module }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_iinterpreter;
+
+interface
+
+{$I fs.inc}
+
+uses
+ SysUtils, Classes, fs_xml
+{$IFDEF Delphi6}
+, Variants
+{$ENDIF}
+
+, SyncObjs
+{$IFDEF Delphi16}
+ , System.Types
+{$ENDIF};
+//FMX uses section
+{$ELSE}
+interface
+
+{$I fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_xml
+, System.Variants
+, System.SyncObjs, System.Types;
+{$ENDIF}
+
+
+type
+ TfsStatement = class;
+ TfsDesignator = class;
+ TfsCustomVariable = class;
+ TfsClassVariable = class;
+ TfsProcVariable = class;
+ TfsMethodHelper = class;
+ TfsPropertyHelper = class;
+ TfsScript = class;
+ TfsDesignatorItem = class;
+
+{ List of supported types. Actually all values are variants; types needed
+ only to know what kind of operations can be implemented to the variable }
+
+ TfsVarType = (fvtInt, fvtBool, fvtFloat, fvtChar, fvtString, fvtClass,
+ fvtArray, fvtVariant, fvtEnum, fvtConstructor, fvtInt64);
+{$IFDEF DELPHI16}
+ frxInteger = NativeInt;
+{$ELSE}
+ {$IFDEF FPC}
+ frxInteger = PtrInt;
+ {$ELSE}
+ frxInteger = Integer;
+ {$ENDIF}
+{$ENDIF}
+
+ TfsTypeRec = {$IFDEF Delphi12}{$ELSE}packed{$ENDIF} record
+ Typ: TfsVarType;
+{$IFDEF Delphi12}
+ TypeName: String;
+{$ELSE}
+ TypeName: String[64];
+{$ENDIF}
+ end;
+
+{ Events for get/set non-published property values and call methods }
+
+ TfsGetValueEvent = function(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant of object;
+ TfsSetValueEvent = procedure(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant) of object;
+
+ TfsGetValueNewEvent = function(Instance: TObject; ClassType: TClass;
+ const PropName: String; Caler: TfsPropertyHelper): Variant of object;
+ TfsSetValueNewEvent = procedure(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant; Caller: TfsPropertyHelper) of object;
+
+ TfsCallMethodNewEvent = function(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant of object;
+ TfsCallMethodEvent = function(Instance: TObject; ClassType: TClass;
+ const MethodName: String; var Params: Variant): Variant of object;
+ TfsRunLineEvent = procedure(Sender: TfsScript;
+ const UnitName, SourcePos: String) of object;
+ TfsGetUnitEvent = procedure(Sender: TfsScript;
+ const UnitName: String; var UnitText: String) of object;
+ TfsGetVariableValueEvent = function(VarName: String;
+ VarTyp: TfsVarType; OldValue: Variant): Variant of object;
+
+{ List of objects. Unlike TList, Destructor frees all objects in the list }
+
+ TfsItemList = class(TObject)
+ protected
+ FItems: TList;
+ protected
+ procedure Clear; virtual;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Add(Item: TObject);
+ function Count: Integer;
+ procedure Remove(Item: TObject);
+ end;
+
+
+{ TfsScript represents the main script. It holds the list of local variables,
+ constants, procedures in the Items. Entry point is the Statement.
+
+ There is one global object fsGlobalUnit: TfsScript that holds all information
+ about external classes, global variables, methods and constants. To use
+ such globals, pass fsGlobalUnit to the TfsScript.Create.
+ If you want, you can add classes/variables/methods to the TfsScript - they
+ will be local for it and not visible in other programs.
+
+ To execute a program, compile it first by calling Compile method. If error
+ occurs, the ErrorMsg will contain the error message and ErrorPos will point
+ to an error position in the source text. For example:
+
+ if not Prg.Compile then
+ begin
+ ErrorLabel.Caption := Prg.ErrorMsg;
+ Memo1.SetFocus;
+ Memo1.Perform(EM_SETSEL, Prg.ErrorPos - 1, Prg.ErrorPos - 1);
+ Memo1.Perform(EM_SCROLLCARET, 0, 0);
+ end;
+
+ If no errors occured, call Execute method to execute the program }
+
+{$i frxPlatformsAttribute.inc}
+
+ TfsScript = class(TComponent)
+
+ private
+ FAddedBy: TObject;
+ FBreakCalled: Boolean;
+ FContinueCalled: Boolean;
+ FExitCalled: Boolean;
+ FErrorMsg: String;
+ FErrorPos: String;
+ FErrorUnit: String;
+ FExtendedCharset: Boolean;
+ FItems: TStringList;
+ FIsRunning: Boolean;
+ FLines: TStrings;
+ FMacros: TStrings;
+ FMainProg: Boolean;
+ FOnGetILUnit: TfsGetUnitEvent;
+ FOnGetUnit: TfsGetUnitEvent;
+ FOnRunLine: TfsRunLineEvent;
+ FOnGetVarValue: TfsGetVariableValueEvent;
+ FParent: TfsScript;
+ FProgRunning: TfsScript;
+ FRTTIAdded: Boolean;
+ FStatement: TfsStatement;
+ FSyntaxType: String;
+ FTerminated: Boolean;
+ FUnitLines: TStringList;
+ FIncludePath: TStrings;
+ FUseClassLateBinding: Boolean;
+ FEvaluteRiseError: Boolean;
+ FClearLocalVars: Boolean;
+ FLastSourcePos : String;
+ FProgName : String;
+ function GetItem(Index: Integer): TfsCustomVariable;
+ procedure RunLine(const UnitName, Index: String);
+ function GetVariables(Index: String): Variant;
+ procedure SetVariables(Index: String; const Value: Variant);
+ procedure SetLines(const Value: TStrings);
+ function GetProgName: String;
+ procedure SetProgName(const Value: String);
+
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Add(const Name: String; Item: TObject);
+ procedure AddCodeLine(const UnitName, APos: String);
+ procedure AddRTTI;
+ procedure Remove(Item: TObject);
+ procedure RemoveItems(Owner: TObject);
+ procedure Clear;
+ procedure ClearItems(Owner: TObject);
+ procedure ClearRTTI;
+ function Count: Integer;
+
+ { Adds a class. Example:
+ with AddClass(TComponent, 'TPersistent') do
+ begin
+ ... add properties and methods ...
+ end }
+ function AddClass(AClass: TClass; const Ancestor: String): TfsClassVariable; dynamic;
+ { Adds a constant. Example:
+ AddConst('pi', 'Double', 3.14159) }
+ procedure AddConst(const Name, Typ: String; const Value: Variant); dynamic;
+ { Adds an enumeration constant. Example:
+ AddEnum('TFontPitch', 'fpDefault, fpFixed, fpVariable')
+ all constants gets type fvtEnum and values 0,1,2,3.. }
+ procedure AddEnum(const Typ, Names: String); dynamic;
+ { Adds an set constant. Example:
+ AddEnumSet('TFontStyles', 'fsBold, fsItalic, fsUnderline')
+ all constants gets type fvtEnum and values 1,2,4,8,.. }
+ procedure AddEnumSet(const Typ, Names: String); dynamic;
+ { Adds a form or datamodule with all its child components }
+ procedure AddComponent(Form: TComponent); dynamic;
+ procedure AddForm(Form: TComponent); dynamic;
+ { Adds a method. Syntax is the same as for TfsClassVariable.AddMethod }
+ procedure AddMethod(const Syntax: String; CallEvent: TfsCallMethodNewEvent;
+ const Category: String = ''; const Description: String = ''); overload; dynamic;
+ procedure AddMethod(const Syntax: String; CallEvent: TfsCallMethodEvent;
+ const Category: String = ''; const Description: String = ''); overload; dynamic;
+ { Adds an external object. Example:
+ AddObject('Memo1', Memo1) }
+ procedure AddObject(const Name: String; Obj: TObject); dynamic;
+ { Adds a variable. Example:
+ AddVariable('n', 'Variant', 0) }
+ procedure AddVariable(const Name, Typ: String; const Value: Variant); dynamic;
+ { Adds a type. Example:
+ AddType('TDateTime', fvtFloat) }
+ procedure AddType(const TypeName: String; ParentType: TfsVarType); dynamic;
+ { Calls internal procedure or function. Example:
+ val := CallFunction('ScriptFunc1', VarArrayOf([2003, 3])) }
+ function CallFunction(const Name: String; const Params: Variant; sGlobal: Boolean = false): Variant;
+ function CallFunction1(const Name: String; var Params: Variant; sGlobal: Boolean = false): Variant;
+ function CallFunction2(const Func: TfsProcVariable; const Params: Variant): Variant;
+
+ { Compiles the source code. Example:
+ Lines.Text := 'begin i := 0 end.';
+ SyntaxType := 'PascalScript';
+ if Compile then ... }
+ function Compile: Boolean;
+ { Executes compiled code }
+ procedure Execute;
+ { Same as if Compile then Execute. Returns False if compile failed }
+ function Run: Boolean;
+ { terminates the script }
+ procedure Terminate;
+ { Evaluates an expression (useful for debugging purposes). Example:
+ val := Evaluate('i+1'); }
+ function Evaluate(const Expression: String): Variant;
+ { checks whether is the line is executable }
+ function IsExecutableLine(LineN: Integer; const UnitName: String = ''): Boolean;
+
+ { Generates intermediate language. You can save it and compile later
+ by SetILCode method }
+ function GetILCode(Stream: TStream): Boolean;
+ { Compiles intermediate language }
+ function SetILCode(Stream: TStream): Boolean;
+
+ function Find(const Name: String): TfsCustomVariable;
+ function FindClass(const Name: String): TfsClassVariable;
+ function FindLocal(const Name: String): TfsCustomVariable;
+
+ property AddedBy: TObject read FAddedBy write FAddedBy;
+ property ClearLocalVars: Boolean read FClearLocalVars write FClearLocalVars;
+ property ErrorMsg: String read FErrorMsg write FErrorMsg;
+ property ErrorPos: String read FErrorPos write FErrorPos;
+ property ErrorUnit: String read FErrorUnit write FErrorUnit;
+ property ExtendedCharset: Boolean read FExtendedCharset write FExtendedCharset;
+ property Items[Index: Integer]: TfsCustomVariable read GetItem;
+ property IsRunning: Boolean read FIsRunning;
+ property Macros: TStrings read FMacros;
+ property MainProg: Boolean read FMainProg write FMainProg;
+ property Parent: TfsScript read FParent write FParent;
+ property ProgRunning: TfsScript read FProgRunning;
+ property ProgName: String read GetProgName write SetProgName;
+ property Statement: TfsStatement read FStatement;
+ property Variables[Index: String]: Variant read GetVariables write SetVariables;
+ property IncludePath: TStrings read FIncludePath;
+ property UseClassLateBinding: Boolean read FUseClassLateBinding write FUseClassLateBinding;
+ property EvaluteRiseError: Boolean read FEvaluteRiseError;
+ published
+ { the source code }
+ property Lines: TStrings read FLines write SetLines;
+ { the language name }
+ property SyntaxType: String read FSyntaxType write FSyntaxType;
+ property OnGetILUnit: TfsGetUnitEvent read FOnGetILUnit write FOnGetILUnit;
+ property OnGetUnit: TfsGetUnitEvent read FOnGetUnit write FOnGetUnit;
+ property OnRunLine: TfsRunLineEvent read FOnRunLine write FOnRunLine;
+ property OnGetVarValue: TfsGetVariableValueEvent read FOnGetVarValue write FOnGetVarValue;
+ end;
+
+
+ TfsCustomExpression = class;
+ TfsSetExpression = class;
+
+{ Statements }
+
+ TfsStatement = class(TfsItemList)
+ private
+ FProgram: TfsScript;
+ FSourcePos: String;
+ FUnitName: String;
+ function GetItem(Index: Integer): TfsStatement;
+ procedure RunLine;
+ public
+ constructor Create(AProgram: TfsScript; const UnitName, SourcePos: String); virtual;
+ procedure Execute; virtual;
+ property Items[Index: Integer]: TfsStatement read GetItem;
+ end;
+
+ TfsAssignmentStmt = class(TfsStatement)
+ private
+ FDesignator: TfsDesignator;
+ FExpression: TfsCustomExpression;
+ FVar: TfsCustomVariable;
+ FExpr: TfsCustomVariable;
+ public
+ destructor Destroy; override;
+ procedure Execute; override;
+ procedure Optimize;
+ property Designator: TfsDesignator read FDesignator write FDesignator;
+ property Expression: TfsCustomExpression read FExpression write FExpression;
+ end;
+
+ TfsAssignPlusStmt = class(TfsAssignmentStmt)
+ public
+ procedure Execute; override;
+ end;
+
+ TfsAssignMinusStmt = class(TfsAssignmentStmt)
+ public
+ procedure Execute; override;
+ end;
+
+ TfsAssignMulStmt = class(TfsAssignmentStmt)
+ public
+ procedure Execute; override;
+ end;
+
+ TfsAssignDivStmt = class(TfsAssignmentStmt)
+ public
+ procedure Execute; override;
+ end;
+
+ TfsCallStmt = class(TfsStatement)
+ private
+ FDesignator: TfsDesignator;
+ FModificator: String;
+ public
+ destructor Destroy; override;
+ procedure Execute; override;
+ property Designator: TfsDesignator read FDesignator write FDesignator;
+ property Modificator: String read FModificator write FModificator;
+ end;
+
+ TfsIfStmt = class(TfsStatement)
+ private
+ FCondition: TfsCustomExpression;
+ FElseStmt: TfsStatement;
+ public
+ constructor Create(AProgram: TfsScript; const UnitName, SourcePos: String); override;
+ destructor Destroy; override;
+ procedure Execute; override;
+ property Condition: TfsCustomExpression read FCondition write FCondition;
+ property ElseStmt: TfsStatement read FElseStmt write FElseStmt;
+ end;
+
+ TfsCaseSelector = class(TfsStatement)
+ private
+ FSetExpression: TfsSetExpression;
+ public
+ destructor Destroy; override;
+ function Check(const Value: Variant): Boolean;
+ property SetExpression: TfsSetExpression read FSetExpression write FSetExpression;
+ end;
+
+ TfsCaseStmt = class(TfsStatement)
+ private
+ FCondition: TfsCustomExpression;
+ FElseStmt: TfsStatement;
+ public
+ constructor Create(AProgram: TfsScript; const UnitName, SourcePos: String); override;
+ destructor Destroy; override;
+ procedure Execute; override;
+ property Condition: TfsCustomExpression read FCondition write FCondition;
+ property ElseStmt: TfsStatement read FElseStmt write FElseStmt;
+ end;
+
+ TfsRepeatStmt = class(TfsStatement)
+ private
+ FCondition: TfsCustomExpression;
+ FInverseCondition: Boolean;
+ public
+ destructor Destroy; override;
+ procedure Execute; override;
+ property Condition: TfsCustomExpression read FCondition write FCondition;
+ property InverseCondition: Boolean read FInverseCondition write FInverseCondition;
+ end;
+
+ TfsWhileStmt = class(TfsStatement)
+ private
+ FCondition: TfsCustomExpression;
+ public
+ destructor Destroy; override;
+ procedure Execute; override;
+ property Condition: TfsCustomExpression read FCondition write FCondition;
+ end;
+
+ TfsForStmt = class(TfsStatement)
+ private
+ FBeginValue: TfsCustomExpression;
+ FDown: Boolean;
+ FEndValue: TfsCustomExpression;
+ FVariable: TfsCustomVariable;
+ public
+ destructor Destroy; override;
+ procedure Execute; override;
+ property BeginValue: TfsCustomExpression read FBeginValue write FBeginValue;
+ property Down: Boolean read FDown write FDown;
+ property EndValue: TfsCustomExpression read FEndValue write FEndValue;
+ property Variable: TfsCustomVariable read FVariable write FVariable;
+ end;
+
+ TfsVbForStmt = class(TfsStatement)
+ private
+ FBeginValue: TfsCustomExpression;
+ FEndValue: TfsCustomExpression;
+ FStep: TfsCustomExpression;
+ FVariable: TfsCustomVariable;
+ public
+ destructor Destroy; override;
+ procedure Execute; override;
+ property BeginValue: TfsCustomExpression read FBeginValue write FBeginValue;
+ property EndValue: TfsCustomExpression read FEndValue write FEndValue;
+ property Step: TfsCustomExpression read FStep write FStep;
+ property Variable: TfsCustomVariable read FVariable write FVariable;
+ end;
+
+ TfsCppForStmt = class(TfsStatement)
+ private
+ FFirstStmt: TfsStatement;
+ FExpression: TfsCustomExpression;
+ FSecondStmt: TfsStatement;
+ public
+ constructor Create(AProgram: TfsScript; const UnitName, SourcePos: String); override;
+ destructor Destroy; override;
+ procedure Execute; override;
+ property FirstStmt: TfsStatement read FFirstStmt write FFirstStmt;
+ property Expression: TfsCustomExpression read FExpression write FExpression;
+ property SecondStmt: TfsStatement read FSecondStmt write FSecondStmt;
+ end;
+
+ TfsTryStmt = class(TfsStatement)
+ private
+ FIsExcept: Boolean;
+ FExceptStmt: TfsStatement;
+ public
+ constructor Create(AProgram: TfsScript; const UnitName, SourcePos: String); override;
+ destructor Destroy; override;
+ procedure Execute; override;
+ property IsExcept: Boolean read FIsExcept write FIsExcept;
+ property ExceptStmt: TfsStatement read FExceptStmt write FExceptStmt;
+ end;
+
+ TfsBreakStmt = class(TfsStatement)
+ public
+ procedure Execute; override;
+ end;
+
+ TfsContinueStmt = class(TfsStatement)
+ public
+ procedure Execute; override;
+ end;
+
+ TfsExitStmt = class(TfsStatement)
+ public
+ procedure Execute; override;
+ end;
+
+ TfsWithStmt = class(TfsStatement)
+ private
+ FDesignator: TfsDesignator;
+ FVariable: TfsCustomVariable;
+ public
+ destructor Destroy; override;
+ procedure Execute; override;
+ property Designator: TfsDesignator read FDesignator write FDesignator;
+ property Variable: TfsCustomVariable read FVariable write FVariable;
+ end;
+
+{ TfsCustomVariable is the generic class for variables, constants, arrays,
+ properties, methods and procedures/functions }
+
+ TfsParamItem = class;
+
+ TfsCustomVariable = class(TfsItemList)
+ private
+ FAddedBy: TObject;
+ FIsMacro: Boolean;
+ FIsReadOnly: Boolean;
+ FName: String;
+ FNeedResult: Boolean;
+ FRefItem: TfsCustomVariable;
+ FSourcePos: String;
+ FSourceUnit: String;
+ FTyp: TfsVarType;
+ FTypeName: String;
+ FUppercaseName: String;
+ FValue: Variant;
+ FOnGetVarValue: TfsGetVariableValueEvent;
+ function GetParam(Index: Integer): TfsParamItem;
+ function GetPValue: PVariant;
+ protected
+ procedure SetValue(const Value: Variant); virtual;
+ function GetValue: Variant; virtual;
+ public
+ constructor Create(const AName: String; ATyp: TfsVarType;
+ const ATypeName: String);
+ function GetFullTypeName: String;
+ function GetNumberOfRequiredParams: Integer;
+
+ property AddedBy: TObject read FAddedBy write FAddedBy;
+ property IsMacro: Boolean read FIsMacro write FIsMacro;
+ property IsReadOnly: Boolean read FIsReadOnly write FIsReadOnly;
+ property Name: String read FName;
+ property NeedResult: Boolean read FNeedResult write FNeedResult;
+ property Params[Index: Integer]: TfsParamItem read GetParam; default;
+ property PValue: PVariant read GetPValue;
+ property RefItem: TfsCustomVariable read FRefItem write FRefItem;
+ property SourcePos: String read FSourcePos write FSourcePos;
+ property SourceUnit: String read FSourceUnit write FSourceUnit;
+ property Typ: TfsVarType read FTyp write FTyp;
+ property TypeName: String read FTypeName write FTypeName;
+ property Value: Variant read GetValue write SetValue;
+ property OnGetVarValue: TfsGetVariableValueEvent read FOnGetVarValue write FOnGetVarValue;
+ end;
+
+{ TfsVariable represents constant or variable }
+
+ TfsVariable = class(TfsCustomVariable)
+ protected
+ procedure SetValue(const Value: Variant); override;
+ function GetValue: Variant; override;
+ end;
+
+ TfsTypeVariable = class(TfsCustomVariable)
+ end;
+
+ TfsStringVariable = class(TfsVariable)
+ private
+ FStr: String;
+ protected
+ procedure SetValue(const Value: Variant); override;
+ function GetValue: Variant; override;
+ end;
+
+{ TfsParamItem describes one parameter of procedure/function/method call }
+
+ TfsParamItem = class(TfsCustomVariable)
+ private
+ FDefValue: Variant;
+ FIsOptional: Boolean;
+ FIsVarParam: Boolean;
+ public
+ constructor Create(const AName: String; ATyp: TfsVarType;
+ const ATypeName: String; AIsOptional, AIsVarParam: Boolean);
+ property DefValue: Variant read FDefValue write FDefValue;
+ property IsOptional: Boolean read FIsOptional;
+ property IsVarParam: Boolean read FIsVarParam;
+ end;
+
+{ TfsProcVariable is a local internal procedure/function. Formal parameters
+ are in Params, and statement to execute is in Prog: TfsScript }
+
+ TfsLocalVariablesHelper = class(TObject)
+ protected
+ FValue: Variant;
+ FVariableLink :TfsCustomVariable;
+ end;
+
+
+ TfsProcVariable = class(TfsCustomVariable)
+ private
+ FExecuting: Boolean;
+ FIsFunc: Boolean;
+ FProgram: TfsScript;
+ FVarsStack: TList;
+ protected
+ function GetValue: Variant; override;
+ public
+ constructor Create(const AName: String; ATyp: TfsVarType;
+ const ATypeName: String; AParent: TfsScript; AIsFunc: Boolean = True);
+ destructor Destroy; override;
+ function SaveLocalVariables: Integer;
+ procedure RestoreLocalVariables(StackIndex: Integer; bSkipVarParams: Boolean = False; dItem: TfsDesignatorItem = nil);
+ property Executing: Boolean read FExecuting;
+ property IsFunc: Boolean read FIsFunc;
+ property Prog: TfsScript read FProgram;
+ end;
+
+ TfsCustomExpression = class(TfsCustomVariable)
+ end;
+
+{ TfsCustomHelper is the generic class for the "helpers". Helper is
+ a object that takes the data from the parent object and performs some
+ actions. Helpers needed for properties, methods and arrays }
+
+ TfsCustomHelper = class(TfsCustomVariable)
+ private
+ FParentRef: TfsCustomVariable;
+ FParentValue: Variant;
+ FProgram: TfsScript;
+ public
+ property ParentRef: TfsCustomVariable read FParentRef write FParentRef;
+
+ property ParentValue: Variant read FParentValue write FParentValue;
+
+ property Prog: TfsScript read FProgram write FProgram;
+ end;
+
+{ TfsArrayHelper performs access to array elements }
+
+ TfsArrayHelper = class(TfsCustomHelper)
+ protected
+ procedure SetValue(const Value: Variant); override;
+ function GetValue: Variant; override;
+ public
+ constructor Create(const AName: String; DimCount: Integer; Typ: TfsVarType;
+ const TypeName: String);
+ destructor Destroy; override;
+ end;
+
+{ TfsStringHelper performs access to string elements }
+
+ TfsStringHelper = class(TfsCustomHelper)
+ protected
+ procedure SetValue(const Value: Variant); override;
+ function GetValue: Variant; override;
+ public
+ constructor Create;
+ end;
+
+{ TfsPropertyHelper gets/sets the property value. Object instance is
+ stored as Integer in the ParentValue property }
+
+ TfsPropertyHelper = class(TfsCustomHelper)
+ private
+ FClassRef: TClass;
+ FIsPublished: Boolean;
+ FOnGetValue: TfsGetValueEvent;
+ FOnSetValue: TfsSetValueEvent;
+ FOnGetValueNew: TfsGetValueNewEvent;
+ FOnSetValueNew: TfsSetValueNewEvent;
+ protected
+ procedure SetValue(const Value: Variant); override;
+ function GetValue: Variant; override;
+ public
+ property IsPublished: Boolean read FIsPublished;
+ property OnGetValue: TfsGetValueEvent read FOnGetValue write FOnGetValue;
+ property OnSetValue: TfsSetValueEvent read FOnSetValue write FOnSetValue;
+ property OnGetValueNew: TfsGetValueNewEvent read FOnGetValueNew write FOnGetValueNew;
+ property OnSetValueNew: TfsSetValueNewEvent read FOnSetValueNew write FOnSetValueNew;
+ end;
+
+{ TfsMethodHelper gets/sets the method value. Object instance is
+ stored as Integer in the ParentValue property. SetValue is called
+ if the method represents the indexes property. }
+
+ TfsMethodHelper = class(TfsCustomHelper)
+ private
+ FCategory: String;
+ FClassRef: TClass;
+ FDescription: String;
+ FIndexMethod: Boolean;
+ FOnCall: TfsCallMethodEvent;
+ FOnCallNew: TfsCallMethodNewEvent;
+ FSetValue: Variant;
+ FSyntax: String;
+ FVarArray: Variant;
+ function GetVParam(Index: Integer): Variant;
+ procedure SetVParam(Index: Integer; const Value: Variant);
+ protected
+ procedure SetValue(const Value: Variant); override;
+ function GetValue: Variant; override;
+ public
+ constructor Create(const Syntax: String; Script: TfsScript);
+ destructor Destroy; override;
+
+ property Category: String read FCategory write FCategory;
+ property Description: String read FDescription write FDescription;
+ property IndexMethod: Boolean read FIndexMethod;
+ property Params[Index: Integer]: Variant read GetVParam write SetVParam; default;
+ property Syntax: String read FSyntax;
+ property OnCall: TfsCallMethodEvent read FOnCall write FOnCall;
+ property OnCallNew: TfsCallMethodNewEvent read FOnCallNew write FOnCallNew;
+ end;
+
+{ TfsComponentHelper gets the component inside an owner, e.g. Form1.Button1 }
+
+ TfsComponentHelper = class(TfsCustomHelper)
+ protected
+ function GetValue: Variant; override;
+ procedure SetValue(const Value: Variant); override;
+ public
+ constructor Create(const Name: String; const ClassName: String);
+ end;
+
+{ Event helper maintains VCL events }
+
+ TfsCustomEvent = class(TObject)
+ private
+ FHandler: TfsProcVariable;
+ FInstance: TObject;
+ protected
+ procedure CallHandler(Params: array of const);
+ public
+ constructor Create(AObject: TObject; AHandler: TfsProcVariable); virtual;
+ function GetMethod: Pointer; virtual; abstract;
+ property Handler: TfsProcVariable read FHandler;
+ property Instance: TObject read FInstance;
+ end;
+
+ TfsEventClass = class of TfsCustomEvent;
+
+ TfsEventHelper = class(TfsCustomHelper)
+ private
+ FClassRef: TClass;
+ FEvent: TfsEventClass;
+ protected
+ procedure SetValue(const Value: Variant); override;
+ function GetValue: Variant; override;
+ public
+ constructor Create(const Name: String; AEvent: TfsEventClass);
+ end;
+
+{ TfsClassVariable holds information about external class. Call to
+ AddXXX methods adds properties and methods items to the items list }
+
+ TfsClassVariable = class(TfsCustomVariable)
+ private
+ FAncestor: String;
+ FClassRef: TClass;
+ FDefProperty: TfsCustomHelper;
+ FMembers: TfsItemList;
+ FProgram: TfsScript;
+ procedure AddPublishedProperties(AClass: TClass);
+ function GetMembers(Index: Integer): TfsCustomHelper;
+ function GetMembersCount: Integer;
+ protected
+ function GetValue: Variant; override;
+ public
+ constructor Create(AClass: TClass; const Ancestor: String);
+ destructor Destroy; override;
+
+ { Adds a contructor. Example:
+ AddConstructor('constructor Create(AOwner: TComponent)', MyCallEvent) }
+ procedure AddConstructor(Syntax: String; CallEvent: TfsCallMethodNewEvent); overload;
+ procedure AddConstructor(Syntax: String; CallEvent: TfsCallMethodEvent); overload;
+ function AddComponent(c: TComponent): TfsComponentHelper ;
+ { Adds a property. Example:
+ AddProperty('Font', 'TFont', MyGetEvent, MySetEvent) }
+ procedure AddProperty(const Name, Typ: String;
+ GetEvent: TfsGetValueEvent; SetEvent: TfsSetValueEvent = nil);
+ procedure AddPropertyEx(const Name, Typ: String;
+ GetEvent: TfsGetValueNewEvent; SetEvent: TfsSetValueNewEvent = nil);
+ { Adds a default property. Example:
+ AddDefaultProperty('Cell', 'Integer,Integer', 'String', MyCallEvent)
+ will describe real property Cell[Index1, Index2: Integer]: String
+ Note: in the CallEvent you'll get the MethodName parameter
+ 'CELL.GET' and 'CELL.SET', not 'CELL' }
+ procedure AddDefaultProperty(const Name, Params, Typ: String;
+ CallEvent: TfsCallMethodNewEvent; AReadOnly: Boolean = False); overload;
+ procedure AddDefaultProperty(const Name, Params, Typ: String;
+ CallEvent: TfsCallMethodEvent; AReadOnly: Boolean = False); overload;
+ { Adds an indexed property. Example and behavior are the same as
+ for AddDefaultProperty }
+ procedure AddIndexProperty(const Name, Params, Typ: String;
+ CallEvent: TfsCallMethodNewEvent; AReadOnly: Boolean = False); overload;
+ procedure AddIndexProperty(const Name, Params, Typ: String;
+ CallEvent: TfsCallMethodEvent; AReadOnly: Boolean = False); overload;
+ { Adds a method. Example:
+ AddMethod('function IsVisible: Boolean', MyCallEvent) }
+ procedure AddMethod(const Syntax: String; CallEvent: TfsCallMethodNewEvent); overload;
+ procedure AddMethod(const Syntax: String; CallEvent: TfsCallMethodEvent); overload;
+ { Adds an event. Example:
+ AddEvent('OnClick', TfsNotifyEvent) }
+ procedure AddEvent(const Name: String; AEvent: TfsEventClass);
+ function Find(const Name: String; IncludeComponentHelper: Boolean = True): TfsCustomHelper;
+
+ property Ancestor: String read FAncestor;
+ property ClassRef: TClass read FClassRef;
+ property DefProperty: TfsCustomHelper read FDefProperty;
+ property Members[Index: Integer]: TfsCustomHelper read GetMembers;
+ property MembersCount: Integer read GetMembersCount;
+ end;
+
+{ TfsDesignator holds the parts of function/procedure/variable/method/property
+ calls. Items are of type TfsDesignatorItem.
+ For example, Table1.FieldByName('N').AsString[1] will be represented as
+ items[0]: name 'Table1', no params
+ items[1]: name 'FieldByName', 1 param: 'N'
+ items[2]: name 'AsString', no params
+ items[3]: name '[', 1 param: '1'
+ Call to Value calculates and returns the designator value }
+
+ TfsDesignatorKind = (dkOther, dkVariable, dkStringArray, dkArray);
+
+ TfsDesignatorItem = class(TfsItemList)
+ private
+ FFlag: Boolean; { needed for index methods }
+ FRef: TfsCustomVariable;
+ FSourcePos: String;
+ function GetItem(Index: Integer): TfsCustomExpression;
+ public
+ property Items[Index: Integer]: TfsCustomExpression read GetItem; default;
+ property Flag: Boolean read FFlag write FFlag;
+ property Ref: TfsCustomVariable read FRef write FRef;
+ property SourcePos: String read FSourcePos write FSourcePos;
+ end;
+
+ TfsDesignator = class(TfsCustomVariable)
+ private
+ FKind: TfsDesignatorKind;
+ FMainProg: TfsScript;
+ FProgram: TfsScript;
+ FRef1: TfsCustomVariable;
+ FRef2: TfsDesignatorItem;
+ FLateBindingXmlSource: TfsXMLItem;
+ procedure CheckLateBinding;
+ function DoCalc(const AValue: Variant; Flag: Boolean): Variant;
+ function GetItem(Index: Integer): TfsDesignatorItem;
+ protected
+ function GetValue: Variant; override;
+ procedure SetValue(const Value: Variant); override;
+ public
+ constructor Create(AProgram: TfsScript);
+ destructor Destroy; override;
+ procedure Borrow(ADesignator: TfsDesignator);
+ procedure Finalize;
+ property Items[Index: Integer]: TfsDesignatorItem read GetItem; default;
+ property Kind: TfsDesignatorKind read FKind;
+ property LateBindingXmlSource: TfsXMLItem read FLateBindingXmlSource
+ write FLateBindingXmlSource;
+ end;
+
+ TfsVariableDesignator = class(TfsDesignator)
+ protected
+ function GetValue: Variant; override;
+ procedure SetValue(const Value: Variant); override;
+ end;
+
+ TfsStringDesignator = class(TfsDesignator)
+ protected
+ function GetValue: Variant; override;
+ procedure SetValue(const Value: Variant); override;
+ end;
+
+ TfsArrayDesignator = class(TfsDesignator)
+ protected
+ function GetValue: Variant; override;
+ procedure SetValue(const Value: Variant); override;
+ end;
+
+{ TfsSetExpression represents a set of values like ['_', '0'..'9'] }
+
+ TfsSetExpression = class(TfsCustomVariable)
+ private
+ function GetItem(Index: Integer): TfsCustomExpression;
+ protected
+ function GetValue: Variant; override;
+ public
+ function Check(const Value: Variant): Boolean;
+ property Items[Index: Integer]: TfsCustomExpression read GetItem;
+ end;
+
+ TfsRTTIModule = class(TObject)
+ private
+ FScript: TfsScript;
+ public
+ constructor Create(AScript: TfsScript); virtual;
+ property Script: TfsScript read FScript;
+ end;
+
+
+function fsGlobalUnit: TfsScript;
+function fsIsGlobalUnitExist: Boolean;
+function fsRTTIModules: TList;
+
+
+implementation
+//VCL uses section
+{$IFNDEF FMX}
+uses
+ TypInfo, fs_isysrtti, fs_iexpression, fs_iparser, fs_iilparser,
+ fs_itools, fs_iconst
+{$IFDEF DELPHI16}
+ , Vcl.Controls
+{$ENDIF}
+{$IFDEF CLX}
+, QForms, QDialogs, Types
+{$ELSE}
+ {$IFDEF FPC}
+ {$IFDEF NOFORMS}
+ // nothing
+ {$ELSE}
+ , Forms, Dialogs
+ {$ENDIF}
+ {$ELSE}
+ , Windows
+ {$IFDEF NOFORMS}
+ , Messages
+ {$ELSE}
+ , Forms, Dialogs
+ {$ENDIF}
+ {$ENDIF}
+{$ENDIF};
+//FMX uses section
+{$ELSE}
+uses
+ System.TypInfo, FMX.fs_isysrtti, FMX.fs_iexpression, FMX.fs_iparser, FMX.fs_iilparser,
+ FMX.fs_itools, FMX.fs_iconst, FMX.Types
+ {$IFDEF NOFORMS}
+ , Windows, Messages
+ {$ELSE}
+ , FMX.Forms, FMX.Dialogs
+ {$ENDIF};
+{$ENDIF}
+
+var
+ FGlobalUnit: TfsScript = nil;
+ FGlobalUnitDestroyed: Boolean = False;
+ FRTTIModules: TList = nil;
+ FRTTIModulesDestroyed: Boolean = False;
+
+
+{ TfsItemsList }
+
+constructor TfsItemList.Create;
+begin
+ FItems := TList.Create;
+end;
+
+destructor TfsItemList.Destroy;
+begin
+ Clear;
+ FItems.Free;
+ inherited;
+end;
+
+procedure TfsItemList.Clear;
+begin
+ while FItems.Count > 0 do
+ begin
+ TObject(FItems[0]).Free;
+ FItems.Delete(0);
+ end;
+end;
+
+function TfsItemList.Count: Integer;
+begin
+ Result := FItems.Count;
+end;
+
+procedure TfsItemList.Add(Item: TObject);
+begin
+ FItems.Add(Item);
+end;
+
+procedure TfsItemList.Remove(Item: TObject);
+begin
+ FItems.Remove(Item);
+end;
+
+
+{ TfsCustomVariable }
+
+constructor TfsCustomVariable.Create(const AName: String; ATyp: TfsVarType;
+ const ATypeName: String);
+begin
+ inherited Create;
+ FName := AName;
+ FTyp := ATyp;
+ FTypeName := ATypeName;
+ FValue := Null;
+ FNeedResult := True;
+ FUppercaseName := AnsiUppercase(FName);
+end;
+
+function TfsCustomVariable.GetValue: Variant;
+begin
+ Result := FValue;
+end;
+
+procedure TfsCustomVariable.SetValue(const Value: Variant);
+begin
+ if not FIsReadOnly then
+ FValue := Value;
+end;
+
+function TfsCustomVariable.GetParam(Index: Integer): TfsParamItem;
+begin
+ Result := FItems[Index];
+end;
+
+function TfsCustomVariable.GetPValue: PVariant;
+begin
+ Result := @FValue;
+end;
+
+function TfsCustomVariable.GetFullTypeName: String;
+begin
+ case FTyp of
+ fvtInt: Result := 'Integer';
+ fvtInt64: Result := 'Int64';
+ fvtBool: Result := 'Boolean';
+ fvtFloat: Result := 'Extended';
+ fvtChar: Result := 'Char';
+ fvtString: Result := 'String';
+ fvtClass: Result := FTypeName;
+ fvtArray: Result := 'Array';
+ fvtEnum: Result := FTypeName;
+ else
+ Result := 'Variant';
+ end;
+end;
+
+function TfsCustomVariable.GetNumberOfRequiredParams: Integer;
+var
+ i: Integer;
+begin
+ Result := 0;
+ for i := 0 to Count - 1 do
+ if not Params[i].IsOptional then
+ Inc(Result);
+end;
+
+
+{ TfsStringVariable }
+
+function TfsStringVariable.GetValue: Variant;
+begin
+ Result := FStr;
+ if Assigned(FOnGetVarValue) then
+ begin
+ Result := FOnGetVarValue(FName, FTyp, FStr);
+ if Result = null then Result := FStr;
+ end;
+end;
+
+procedure TfsStringVariable.SetValue(const Value: Variant);
+begin
+ FStr := Value;
+end;
+
+
+{ TfsParamItem }
+
+constructor TfsParamItem.Create(const AName: String; ATyp: TfsVarType;
+ const ATypeName: String; AIsOptional, AIsVarParam: Boolean);
+begin
+ inherited Create(AName, ATyp, ATypeName);
+ FIsOptional := AIsOptional;
+ FIsVarParam := AIsVarParam;
+ FDefValue := Null;
+end;
+
+
+{ TfsProcVariable }
+
+constructor TfsProcVariable.Create(const AName: String; ATyp: TfsVarType;
+ const ATypeName: String; AParent: TfsScript; AIsFunc: Boolean = True);
+begin
+ inherited Create(AName, ATyp, ATypeName);
+ FIsReadOnly := True;
+ FVarsStack := TList.Create;
+ FIsFunc := AIsFunc;
+ FProgram := TfsScript.Create(nil);
+ FProgram.Parent := AParent;
+ if FProgram.Parent <> nil then
+ FProgram.UseClassLateBinding := FProgram.Parent.UseClassLateBinding;
+ if FIsFunc then
+ begin
+ FRefItem := TfsVariable.Create('Result', ATyp, ATypeName);
+ FProgram.Add('Result', FRefItem);
+ end;
+end;
+
+
+
+destructor TfsProcVariable.Destroy;
+var
+ i: Integer;
+begin
+ { avoid destroying the param objects twice }
+ for i := 0 to Count - 1 do
+ FProgram.FItems.Delete(FProgram.FItems.IndexOfObject(Params[i]));
+
+ FProgram.Free;
+ FVarsStack.Free;
+ inherited;
+end;
+
+function TfsProcVariable.GetValue: Variant;
+var
+ Temp: Boolean;
+ ParentProg, SaveProg: TfsScript;
+ i: Integer;
+begin
+ Temp := FExecuting;
+ FExecuting := True;
+ if FIsFunc then
+ FRefItem.Value := Unassigned;
+
+ ParentProg := FProgram;
+ SaveProg := nil;
+ while ParentProg <> nil do
+ if ParentProg.FMainProg then
+ begin
+ SaveProg := ParentProg.FProgRunning;
+ ParentProg.FProgRunning := FProgram;
+ break;
+ end
+ else
+ ParentProg := ParentProg.FParent;
+
+ try
+// avoid trial message
+// same as FProgram.Execute
+ with FProgram do
+ begin
+ FExitCalled := False;
+ FTerminated := False;
+ FIsRunning := True;
+ FProgName := Self.FName;
+ try
+ FStatement.Execute;
+ finally
+ FExitCalled := False;
+ FTerminated := False;
+ FIsRunning := False;
+ FProgName := '';
+ end;
+ end;
+//
+
+ if FIsFunc then
+ Result := FRefItem.Value else
+ Result := Null;
+ finally
+ if ParentProg <> nil then
+ ParentProg.FProgRunning := SaveProg;
+ FExecuting := Temp;
+ if (ParentProg <> nil) and ParentProg.FClearLocalVars then
+ for i := 0 to Prog.Count - 1 do
+ if (Prog.Items[i] is TfsVariable) and
+ (CompareText('Result', Prog.Items[i].Name) <> 0)
+{$IFDEF DELPHI6}
+ and not VarIsClear(Prog.Items[i].Value)
+{$ENDIF}
+ then
+ case TfsVariable(Prog.Items[i]).Typ of
+ fvtString:
+ TfsVariable(Prog.Items[i]).Value := '';
+ fvtInt, fvtFloat, fvtChar:
+ TfsVariable(Prog.Items[i]).Value := 0;
+ fvtVariant:
+ TfsVariable(Prog.Items[i]).Value := Null;
+ end;
+ end;
+end;
+
+function TfsProcVariable.SaveLocalVariables: Integer;
+var
+ i: Integer;
+ LocalVars: TList;
+ StackItem: TfsLocalVariablesHelper;
+begin
+ LocalVars := TList.Create;
+ FVarsStack.Add(LocalVars);
+ Result := FVarsStack.Count - 1;
+ for i := 0 to Prog.Count - 1 do
+ if (Prog.Items[i] is TfsVariable) or (Prog.Items[i] is TfsParamItem) then
+ begin
+ StackItem := TfsLocalVariablesHelper.Create;
+ StackItem.FValue := Prog.Items[i].Value;
+ StackItem.FVariableLink := Prog.Items[i];
+ LocalVars.Add(StackItem);
+ end;
+end;
+
+procedure TfsProcVariable.RestoreLocalVariables(StackIndex: Integer; bSkipVarParams: Boolean; dItem: TfsDesignatorItem);
+var
+ i: Integer;
+ LocalVars: TList;
+ StackItem: TfsLocalVariablesHelper;
+ bIsVar: Boolean;
+ Temp1: array of Variant;
+begin
+ if (FVarsStack.Count < StackIndex) or (StackIndex < 0) then Exit;
+ LocalVars := TList(FVarsStack[StackIndex]);
+ SetLength(Temp1, Count);
+ try
+ { save var parameters value, need when pass same variable as VAR parameter }
+ if Assigned(dItem) then
+ for i := 0 to Count - 1 do
+ if Params[i].IsVarParam then
+ Temp1[i] := Params[i].Value;
+ for i := 0 to LocalVars.Count - 1 do
+ begin
+ StackItem := TfsLocalVariablesHelper(LocalVars[i]);
+ bIsVar := TfsParamItem(StackItem.FVariableLink).FIsVarParam;
+ if not (bSkipVarParams and (StackItem.FVariableLink is TfsParamItem) and bIsVar) then
+ StackItem.FVariableLink.Value := StackItem.FValue;
+ StackItem.Free;
+ end;
+ if Assigned(dItem) then
+ for i := 0 to Count - 1 do
+ if Params[i].IsVarParam then
+ dItem[i].Value := Temp1[i];
+ finally
+ Temp1 := nil;
+ LocalVars.Free;
+ FVarsStack.Delete(StackIndex);
+ end;
+end;
+
+
+{ TfsPropertyHelper }
+
+function TfsPropertyHelper.GetValue: Variant;
+var
+ p: PPropInfo;
+ Instance: TObject;
+begin
+
+ Result := Null;
+ Instance := TObject(frxInteger(ParentValue));
+
+ if FIsPublished and Assigned(Instance) then
+ begin
+ p := GetPropInfo(Instance.ClassInfo, Name);
+ if p <> nil then
+ case p.PropType^.Kind of
+ tkInteger, tkSet, tkEnumeration, tkClass
+ {$IFDEF FPC} ,tkBool {$ENDIF}:
+ Result := GetOrdProp(Instance, p);
+{$IFDEF FS_INT64}
+ tkInt64:
+ Result := GetInt64Prop(Instance, p);
+{$ENDIF}
+ tkFloat:
+ Result := GetFloatProp(Instance, p);
+
+// tkString, tkLString, tkWString{$IFDEF Delphi12}, tkUString{$ENDIF}:
+// Result := GetStrProp(Instance, p);
+
+ tkChar, tkWChar:
+ Result := Chr(GetOrdProp(Instance, p));
+
+ tkVariant:
+ Result := GetVariantProp(Instance, p);
+{$IFDEF Delphi12}
+ tkString, tkLString:
+ Result := GetAnsiStrProp(Instance, p);
+ tkWString, tkUString:
+ Result := GetUnicodeStrProp(Instance, p);
+{$ELSE}
+ tkString, tkLString, tkWString{$ifdef FPC}, tkAString{$endif}:
+ Result := GetStrProp(Instance, p);
+{$ENDIF}
+ end;
+ end
+ else if Assigned(FOnGetValue) then
+ Result := FOnGetValue(Instance, FClassRef, FUppercaseName)
+ else if Assigned(FOnGetValueNew) then
+ Result := FOnGetValueNew(Instance, FClassRef, FUppercaseName, Self);
+
+ if Typ = fvtBool then
+ if Result = 0 then
+ Result := False else
+ Result := True;
+
+end;
+
+procedure TfsPropertyHelper.SetValue(const Value: Variant);
+var
+ p: PPropInfo;
+ Instance: TObject;
+ IntVal: frxInteger;
+ Int64Val: Int64;
+begin
+
+ if IsReadOnly then Exit;
+ Instance := TObject(frxInteger(ParentValue));
+
+
+
+ if FIsPublished then
+ begin
+ p := GetPropInfo(Instance.ClassInfo, Name);
+ if p <> nil then
+ case p.PropType^.Kind of
+ tkInteger, tkSet, tkEnumeration, tkClass
+ {$IFDEF FPC} ,tkBool {$ENDIF}:
+// {$IFDEF Delphi12}, tkInt64{$ENDIF}:
+ begin
+{$IFNDEF Delphi4}
+ if VarType(Value) <> varInteger then
+ begin
+ SetSetProp(Instance, p, fsSetToString(p, Value));
+ end
+ else
+{$ENDIF}
+ begin
+ if Typ = fvtBool then
+ if Value = True then
+ IntVal := 1 else
+ IntVal := 0
+ else
+{$IFNDEF CPUX64}
+{$IFDEF Delphi12}
+ if (VarType(Value) = varInt64)
+ or (VarType(Value) = varUInt64) then
+ begin
+ Int64Val := Value;
+ IntVal := Cardinal(Int64Rec(Int64Val).Lo);
+ end
+ else
+{$ENDIF}
+{$ENDIF}
+ IntVal := frxInteger(Value);
+ SetOrdProp(Instance, p, IntVal);
+ end;
+ end;
+{$IFNDEF DELPHI16}
+{$IFDEF FS_INT64}
+ tkInt64:
+ SetInt64Prop(Instance, p, Value);
+{$ENDIF}
+{$ELSE}
+ tkInt64:
+ SetInt64Prop(Instance, p, Int64(Value));
+{$ENDIF}
+ tkFloat:
+ SetFloatProp(Instance, p, Extended(Value));
+
+// tkString, tkLString:
+// SetStrProp(Instance, p, String(Value));
+
+// tkWString{$IFDEF Delphi12}, tkUString{$ENDIF}:
+// SetStrProp(Instance, p, WideString(Value));
+
+ tkChar, tkWChar:
+ SetOrdProp(Instance, p, Ord(String(Value)[1]));
+
+ tkVariant:
+ SetVariantProp(Instance, p, Value);
+
+{$IFDEF Delphi12}
+ tkString, tkLString:
+ SetAnsiStrProp(Instance, p, AnsiString(Value));
+ tkWString, tkUString:
+ SetUnicodeStrProp(Instance, p, WideString(Value));
+{$ELSE}
+ tkString, tkLString, tkWString{$ifdef FPC}, tkAString{$endif}:
+ SetStrProp(Instance, p, String(Value));
+{$ENDIF}
+ end;
+ end
+ else if Assigned(FOnSetValue) then
+ FOnSetValue(Instance, FClassRef, FUppercaseName, Value)
+ else if Assigned(FOnSetValueNew) then
+ FOnSetValueNew(Instance, FClassRef, FUppercaseName, Value, Self);
+
+end;
+
+
+{ TfsMethodHelper }
+
+constructor TfsMethodHelper.Create(const Syntax: String; Script: TfsScript);
+var
+ i: Integer;
+ v: TfsCustomVariable;
+begin
+ v := ParseMethodSyntax(Syntax, Script);
+ inherited Create(v.Name, v.Typ, v.TypeName);
+ FIsReadOnly := True;
+ FSyntax := Syntax;
+ IsMacro := v.IsMacro;
+
+ { copying params }
+ for i := 0 to v.Count - 1 do
+ Add(v.Params[i]);
+ while v.Count > 0 do
+ v.FItems.Delete(0);
+ v.Free;
+
+ // FPC and Delphi do this different way. FPC implementation more honest, so
+ // if Count = 0 then we get exception about bad bounds
+ if Count > 0 then
+ FVarArray := VarArrayCreate([0, Count - 1], varVariant);
+end;
+
+destructor TfsMethodHelper.Destroy;
+begin
+ FVarArray := Null;
+ inherited;
+end;
+
+function TfsMethodHelper.GetVParam(Index: Integer): Variant;
+begin
+ if Index = Count then
+ Result := FSetValue
+ else
+ Result := TfsParamItem(FItems[Index]).Value;
+end;
+
+procedure TfsMethodHelper.SetVParam(Index: Integer; const Value: Variant);
+begin
+ TfsParamItem(FItems[Index]).Value := Value;
+end;
+
+function TfsMethodHelper.GetValue: Variant;
+var
+ i: Integer;
+ Instance: TObject;
+begin
+ if Assigned(FOnCall) then
+ begin
+ for i := 0 to Count - 1 do
+ FVarArray[i] := inherited Params[i].Value;
+
+ Instance := nil;
+ if not VarIsNull(ParentValue) then
+ Instance := TObject(frxInteger(ParentValue));
+
+ if FIndexMethod then
+ Result := FOnCall(Instance, FClassRef, FUppercaseName + '.GET', FVarArray)
+ else
+ Result := FOnCall(Instance, FClassRef, FUppercaseName, FVarArray);
+ for i := 0 to Count - 1 do
+ begin
+ if inherited Params[i].IsVarParam then
+ inherited Params[i].Value := FVarArray[i];
+ FVarArray[i] := Null;
+ end;
+ end
+ else if Assigned(FOnCallNew) then
+ begin
+ Instance := nil;
+ if not VarIsNull(ParentValue) then
+ Instance := TObject(frxInteger(ParentValue));
+
+ if FIndexMethod then
+ Result := FOnCallNew(Instance, FClassRef, FUppercaseName + '.GET', Self)
+ else
+ Result := FOnCallNew(Instance, FClassRef, FUppercaseName, Self);
+ end
+ else
+ Result := 0;
+end;
+
+procedure TfsMethodHelper.SetValue(const Value: Variant);
+var
+ v: Variant;
+ i: Integer;
+begin
+ if FIndexMethod then
+ if Assigned(FOnCall) then
+ begin
+ v := VarArrayCreate([0, Count], varVariant);
+ for i := 0 to Count - 1 do
+ v[i] := inherited Params[i].Value;
+ v[Count] := Value;
+
+ FOnCall(TObject(frxInteger(ParentValue)), FClassRef, FUppercaseName + '.SET', v);
+ v := Null;
+ end
+ else if Assigned(FOnCallNew) then
+ begin
+ FSetValue := Value;
+ FOnCallNew(TObject(frxInteger(ParentValue)), FClassRef, FUppercaseName + '.SET', Self);
+ FSetValue := Null;
+ end;
+end;
+
+
+{ TfsComponentHelper }
+
+constructor TfsComponentHelper.Create(const Name: String; const ClassName: String);
+begin
+ inherited Create(Name, fvtClass, ClassName);
+end;
+
+function TfsComponentHelper.GetValue: Variant;
+var
+ c: TObject;
+begin
+ c := TObject(frxInteger(ParentValue));
+ if c is TComponent then
+ c := TComponent(c).FindComponent(Name)
+ else
+ c := nil;
+ if Assigned(c) then
+ Result := frxInteger(c)
+ else
+ raise Exception.Create(Format(SComponentError, [Name]));
+end;
+
+procedure TfsComponentHelper.SetValue(const Value: Variant);
+begin
+ raise Exception.Create(Format(SComponentAssignError, [Name]));
+end;
+
+{ TfsEventHelper }
+
+constructor TfsEventHelper.Create(const Name: String; AEvent: TfsEventClass);
+begin
+ inherited Create(Name, fvtString, '');
+ FEvent := AEvent;
+end;
+
+function TfsEventHelper.GetValue: Variant;
+begin
+ Result := '';
+end;
+
+procedure TfsEventHelper.SetValue(const Value: Variant);
+var
+ Instance: TPersistent;
+ v: TfsCustomVariable;
+ e: TfsCustomEvent;
+ p: PPropInfo;
+ m: TMethod;
+begin
+
+ Instance := TPersistent(frxInteger(ParentValue));
+ if VarToStr(Value) = '0' then
+ begin
+ m.Code := nil;
+ m.Data := nil;
+ end
+ else
+ begin
+ v := FProgram.Find(Value);
+ if (v = nil) or not (v is TfsProcVariable) then
+ raise Exception.Create(SEventError);
+
+ e := TfsCustomEvent(FEvent.NewInstance);
+ e.Create(Instance, TfsProcVariable(v));
+ FProgram.Add('', e);
+ m.Code := e.GetMethod;
+ m.Data := e;
+ end;
+
+ p := GetPropInfo(Instance.ClassInfo, Name);
+ SetMethodProp(Instance, p, m);
+end;
+
+
+{ TfsClassVariable }
+
+constructor TfsClassVariable.Create(AClass: TClass; const Ancestor: String);
+begin
+ inherited Create(AClass.ClassName, fvtClass, AClass.ClassName);
+ FMembers := TfsItemList.Create;
+ FAncestor := Ancestor;
+ FClassRef := AClass;
+
+ AddPublishedProperties(AClass);
+ Add(TfsParamItem.Create('', fvtVariant, '', True, False));
+end;
+
+destructor TfsClassVariable.Destroy;
+begin
+ FMembers.Free;
+ inherited;
+end;
+
+function TfsClassVariable.GetMembers(Index: Integer): TfsCustomHelper;
+begin
+ Result := FMembers.FItems[Index];
+end;
+
+function TfsClassVariable.GetMembersCount: Integer;
+begin
+ Result := FMembers.Count;
+end;
+
+procedure TfsClassVariable.AddConstructor(Syntax: String; CallEvent: TfsCallMethodEvent);
+var
+ i: Integer;
+begin
+ i := Pos(' ', Syntax);
+ Delete(Syntax, 1, i - 1);
+ Syntax := 'function' + Syntax + ': ' + 'Constructor';
+ AddMethod(Syntax, CallEvent);
+end;
+
+procedure TfsClassVariable.AddConstructor(Syntax: String;
+ CallEvent: TfsCallMethodNewEvent);
+var
+ i: Integer;
+begin
+ i := Pos(' ', Syntax);
+ Delete(Syntax, 1, i - 1);
+ Syntax := 'function' + Syntax + ': ' + 'Constructor';
+ AddMethod(Syntax, CallEvent);
+end;
+
+procedure TfsClassVariable.AddMethod(const Syntax: String; CallEvent: TfsCallMethodEvent);
+var
+ m: TfsMethodHelper;
+begin
+ m := TfsMethodHelper.Create(Syntax, FProgram);
+ m.FOnCall := CallEvent;
+ m.FClassRef := FClassRef;
+ FMembers.Add(m);
+end;
+
+procedure TfsClassVariable.AddMethod(const Syntax: String; CallEvent: TfsCallMethodNewEvent);
+var
+ m: TfsMethodHelper;
+begin
+ m := TfsMethodHelper.Create(Syntax, FProgram);
+ m.FOnCallNew := CallEvent;
+ m.FClassRef := FClassRef;
+ FMembers.Add(m);
+end;
+
+procedure TfsClassVariable.AddEvent(const Name: String; AEvent: TfsEventClass);
+var
+ e: TfsEventHelper;
+begin
+ e := TfsEventHelper.Create(Name, AEvent);
+ e.FClassRef := FClassRef;
+ FMembers.Add(e);
+end;
+
+procedure TfsClassVariable.AddProperty(const Name, Typ: String;
+ GetEvent: TfsGetValueEvent; SetEvent: TfsSetValueEvent);
+var
+ p: TfsPropertyHelper;
+begin
+ p := TfsPropertyHelper.Create(Name, StrToVarType(Typ, FProgram), Typ);
+ p.FClassRef := FClassRef;
+ p.FOnGetValue := GetEvent;
+ p.FOnSetValue := SetEvent;
+ p.IsReadOnly := not Assigned(SetEvent);
+ FMembers.Add(p);
+end;
+
+procedure TfsClassVariable.AddPropertyEx(const Name, Typ: String;
+ GetEvent: TfsGetValueNewEvent; SetEvent: TfsSetValueNewEvent);
+var
+ p: TfsPropertyHelper;
+begin
+ p := TfsPropertyHelper.Create(Name, StrToVarType(Typ, FProgram), Typ);
+ p.FClassRef := FClassRef;
+ p.FOnGetValueNew := GetEvent;
+ p.FOnSetValueNew := SetEvent;
+ p.IsReadOnly := not Assigned(SetEvent);
+ FMembers.Add(p);
+end;
+
+procedure TfsClassVariable.AddDefaultProperty(const Name, Params, Typ: String;
+ CallEvent: TfsCallMethodEvent; AReadOnly: Boolean = False);
+begin
+ AddIndexProperty(Name, Params, Typ, CallEvent, AReadOnly);
+ FDefProperty := Members[FMembers.Count - 1];
+end;
+
+procedure TfsClassVariable.AddDefaultProperty(const Name, Params,
+ Typ: String; CallEvent: TfsCallMethodNewEvent; AReadOnly: Boolean);
+begin
+ AddIndexProperty(Name, Params, Typ, CallEvent, AReadOnly);
+ FDefProperty := Members[FMembers.Count - 1];
+end;
+
+procedure TfsClassVariable.AddIndexProperty(const Name, Params,
+ Typ: String; CallEvent: TfsCallMethodEvent; AReadOnly: Boolean = False);
+var
+ i: Integer;
+ sl: TStringList;
+ s: String;
+begin
+ sl := TStringList.Create;
+ sl.CommaText := Params;
+
+ s := '';
+ for i := 0 to sl.Count - 1 do
+ s := s + 'p' + IntToStr(i) + ': ' + sl[i] + '; ';
+
+ SetLength(s, Length(s) - 2);
+ try
+ AddMethod('function ' + Name + '(' + s + '): ' + Typ, CallEvent);
+ with TfsMethodHelper(Members[FMembers.Count - 1]) do
+ begin
+ IsReadOnly := AReadOnly;
+ FIndexMethod := True;
+ end;
+ finally
+ sl.Free;
+ end;
+end;
+
+procedure TfsClassVariable.AddIndexProperty(const Name, Params,
+ Typ: String; CallEvent: TfsCallMethodNewEvent; AReadOnly: Boolean);
+var
+ i: Integer;
+ sl: TStringList;
+ s: String;
+begin
+ sl := TStringList.Create;
+ sl.CommaText := Params;
+
+ s := '';
+ for i := 0 to sl.Count - 1 do
+ s := s + 'p' + IntToStr(i) + ': ' + sl[i] + '; ';
+
+ SetLength(s, Length(s) - 2);
+ try
+ AddMethod('function ' + Name + '(' + s + '): ' + Typ, CallEvent);
+ with TfsMethodHelper(Members[FMembers.Count - 1]) do
+ begin
+ IsReadOnly := AReadOnly;
+ FIndexMethod := True;
+ end;
+ finally
+ sl.Free;
+ end;
+end;
+
+function TfsClassVariable.AddComponent(c: TComponent): TfsComponentHelper;
+var
+ Helper: TfsCustomHelper;
+begin
+ { check if member alreeady exist }
+ Helper := Find(c.Name);
+ Result := nil;
+ { member has different purpose, name conflict }
+ if Helper is TfsComponentHelper then
+ Result := TfsComponentHelper(Helper);
+ if Assigned(Helper) then Exit;
+ Result := TfsComponentHelper.Create(c.Name, c.ClassName);
+ FMembers.Add(Result);
+end;
+
+procedure TfsClassVariable.AddPublishedProperties(AClass: TClass);
+var
+ TypeInfo: PTypeInfo;
+ PropCount: Integer;
+ PropList: PPropList;
+ i: Integer;
+ cl: String;
+ t: TfsVarType;
+ FClass: TClass;
+ p: TfsPropertyHelper;
+begin
+ TypeInfo := AClass.ClassInfo;
+ if TypeInfo = nil then Exit;
+
+ PropCount := GetPropList(TypeInfo, tkProperties, nil);
+ GetMem(PropList, PropCount * SizeOf(PPropInfo));
+ GetPropList(TypeInfo, tkProperties, PropList);
+
+ try
+ for i := 0 to PropCount - 1 do
+ begin
+ t := fvtInt;
+ cl := '';
+
+ case PropList[i].PropType^.Kind of
+ tkInteger:
+ t := fvtInt;
+{$IFDEF FS_INT64}
+ tkInt64:
+ t := fvtInt64;
+{$ENDIF}
+ tkSet:
+ begin
+ t := fvtEnum;
+ cl := String(PropList[i].PropType^.Name);
+ end;
+ tkEnumeration:
+ begin
+ t := fvtEnum;
+ cl := String(PropList[i].PropType^.Name);
+ if (CompareText(cl, 'Boolean') = 0) or (CompareText(cl, 'bool') = 0) then
+ t := fvtBool;
+ end;
+{$ifdef FPC}
+ tkBool:
+ t := fvtBool;
+{$ENDIF}
+ tkFloat:
+ t := fvtFloat;
+ tkChar, tkWChar:
+ t := fvtChar;
+ tkString, tkLString, tkWString{$IFDEF Delphi12}, tkUString{$ENDIF}{$ifdef FPC},tkAString{$endif}:
+ t := fvtString;
+ tkVariant:
+ t := fvtVariant;
+ tkClass:
+ begin
+ t := fvtClass;
+ {$IFNDEF FPC}
+ FClass := GetTypeData(PropList[i].PropType^).ClassType;
+ {$ELSE}
+ FClass := GetTypeData(PropList[i].PropType).ClassType;
+ {$ENDIF}
+ cl := FClass.ClassName;
+ end;
+ end;
+
+ p := TfsPropertyHelper.Create(String(PropList[i].Name), t, cl);
+ p.FClassRef := FClassRef;
+ p.FIsPublished := True;
+ FMembers.Add(p);
+ end;
+
+ finally
+ FreeMem(PropList, PropCount * SizeOf(PPropInfo));
+ end;
+end;
+
+function TfsClassVariable.Find(const Name: String; IncludeComponentHelper: Boolean = True): TfsCustomHelper;
+var
+ cl: TfsClassVariable;
+
+ function DoFind(const Name: String): TfsCustomHelper;
+ var
+ i: Integer;
+ begin
+ Result := nil;
+ for i := 0 to FMembers.Count - 1 do
+ if CompareText(Name, Members[i].Name) = 0 then
+ begin
+ Result := Members[i];
+ Exit;
+ end;
+ end;
+
+begin
+ Result := DoFind(Name);
+ if Result = nil then
+ begin
+ cl := FProgram.FindClass(FAncestor);
+ if cl <> nil then
+ Result := cl.Find(Name);
+ end;
+ if not IncludeComponentHelper and (Result is TfsComponentHelper) then
+ Result := nil;
+end;
+
+function TfsClassVariable.GetValue: Variant;
+begin
+ if Params[0].Value = Null then
+ Result := frxInteger(FClassRef.NewInstance) else { constructor call }
+ Result := Params[0].Value; { typecast }
+ Params[0].Value := Null;
+end;
+
+
+{ TfsDesignatorItem }
+
+function TfsDesignatorItem.GetItem(Index: Integer): TfsCustomExpression;
+begin
+ Result := FItems[Index];
+end;
+
+
+{ TfsDesignator }
+
+constructor TfsDesignator.Create(AProgram: TfsScript);
+var
+ ParentProg: TfsScript;
+begin
+{$IFDEF CPUX64}
+ inherited Create('', fvtInt64, '');
+{$ELSE}
+ inherited Create('', fvtInt, '');
+{$ENDIF}
+ FProgram := AProgram;
+ FMainProg := FProgram;
+ ParentProg := FProgram;
+ while ParentProg <> nil do
+ if ParentProg.FMainProg then
+ begin
+ FMainProg := ParentProg;
+ break;
+ end
+ else
+ ParentProg := ParentProg.FParent;
+ FProgram.UseClassLateBinding := FMainProg.UseClassLateBinding;
+end;
+
+destructor TfsDesignator.Destroy;
+begin
+ if FLateBindingXMLSource <> nil then
+ FLateBindingXMLSource.Free;
+ inherited;
+end;
+
+procedure TfsDesignator.Borrow(ADesignator: TfsDesignator);
+var
+ SaveItems: TList;
+begin
+ SaveItems := FItems;
+ FItems := ADesignator.FItems;
+ ADesignator.FItems := SaveItems;
+ FKind := ADesignator.FKind;
+ FRef1 := ADesignator.FRef1;
+ FRef2 := ADesignator.FRef2;
+ FTyp := ADesignator.Typ;
+ FTypeName := ADesignator.TypeName;
+ FIsReadOnly := ADesignator.IsReadOnly;
+ RefItem := ADesignator.RefItem;
+end;
+
+procedure TfsDesignator.Finalize;
+var
+ Item: TfsDesignatorItem;
+begin
+ Item := Items[Count - 1];
+ FTyp := Item.Ref.Typ;
+ FTypeName := Item.Ref.TypeName;
+ if FTyp = fvtConstructor then
+ begin
+ FTyp := fvtClass;
+ FTypeName := Items[Count - 2].Ref.TypeName;
+ end;
+
+ FIsReadOnly := Item.Ref.IsReadOnly;
+
+ { speed optimization for access to single variable, string element or array }
+ if (Count = 1) and (Items[0].Ref is TfsVariable) then
+ begin
+ RefItem := Items[0].Ref;
+ FKind := dkVariable;
+ end
+ else if (Count = 2) and (Items[0].Ref is TfsStringVariable) then
+ begin
+ RefItem := Items[0].Ref;
+ FRef1 := Items[1][0];
+ FKind := dkStringArray;
+ end
+ else if (Count = 2) and (Items[0].Ref is TfsVariable) and (Items[0].Ref.Typ = fvtArray) then
+ begin
+ RefItem := Items[0].Ref;
+ FRef1 := RefItem.RefItem;
+ FRef2 := Items[1];
+ FKind := dkArray;
+ end
+ else
+ FKind := dkOther;
+end;
+
+function TfsDesignator.GetItem(Index: Integer): TfsDesignatorItem;
+begin
+ Result := FItems[Index];
+end;
+
+function TfsDesignator.DoCalc(const AValue: Variant; Flag: Boolean): Variant;
+var
+ i, j: Integer;
+ Item: TfsCustomVariable;
+ Val: Variant;
+ Ref: TfsCustomVariable;
+ Temp1: array of Variant;
+ StackIndex: Integer;
+begin
+ Ref := nil;
+ Val := Null;
+ StackIndex := -1;
+ for i := 0 to Count - 1 do
+ begin
+ Item := Items[i].Ref;
+
+ if Item is TfsDesignator then { it is true for "WITH" statements }
+ begin
+ Ref := Item;
+ Val := Item.Value;
+ continue;
+ end;
+
+ try
+ { we're trying to call the local procedure that is already executing -
+ i.e. we have a recursion }
+ if (Item is TfsProcVariable) and TfsProcVariable(Item).Executing then
+ StackIndex := TfsProcVariable(Item).SaveLocalVariables;
+
+ if Item.Count > 0 then
+ begin
+ SetLength(Temp1, Item.Count);
+ try
+ { calculate params and copy param values to the temp1 array }
+ for j := 0 to Item.Count - 1 do
+ if Item.IsMacro then
+ Temp1[j] := TfsExpression(Items[i][j]).Source
+ else
+ Temp1[j] := Items[i][j].Value;
+ { copy calculated values to the item params }
+ for j := 0 to Item.Count - 1 do
+ Item.Params[j].Value := Temp1[j];
+ finally
+ Temp1 := nil;
+ end;
+ end;
+
+ { copy value and var reference to the helper object }
+ if Item is TfsCustomHelper then
+ begin
+ TfsCustomHelper(Item).ParentRef := Ref;
+ TfsCustomHelper(Item).ParentValue := Val;
+ TfsCustomHelper(Item).Prog := FProgram;
+ end;
+
+ Ref := Item;
+ { assign a value to the last designator node if called from SetValue }
+ if Flag and (i = Count - 1) then
+ begin
+ Item.Value := AValue
+ end
+ else
+ begin
+ Item.NeedResult := (i <> Count - 1) or NeedResult;
+ Val := Item.Value;
+ end;
+
+ { copy back var params }
+ for j := 0 to Item.Count - 1 do
+ if Item.Params[j].IsVarParam then
+ Items[i][j].Value := Item.Params[j].Value;
+
+ finally
+ { restore proc variables if it was called from itself }
+ if (Item is TfsProcVariable) and TfsProcVariable(Item).Executing then
+ TfsProcVariable(Item).RestoreLocalVariables(StackIndex, False, Items[i]);
+ end;
+ end;
+
+ Result := Val;
+end;
+
+procedure TfsDesignator.CheckLateBinding;
+var
+ NewDesignator: TfsDesignator;
+ Parser: TfsILParser;
+begin
+ if FLateBindingXMLSource <> nil then
+ begin
+ Parser := TfsILParser.Create(FProgram);
+ try
+ NewDesignator := Parser.DoDesignator(FLateBindingXMLSource, FProgram);
+ Borrow(NewDesignator);
+ NewDesignator.Free;
+ finally
+ Parser.Free;
+ FLateBindingXMLSource.Free;
+ FLateBindingXMLSource := nil;
+ end;
+ end;
+end;
+
+function TfsDesignator.GetValue: Variant;
+begin
+ CheckLateBinding;
+ Result := DoCalc(Null, False);
+end;
+
+procedure TfsDesignator.SetValue(const Value: Variant);
+begin
+ CheckLateBinding;
+ DoCalc(Value, True);
+end;
+
+
+{ TfsVariableDesignator }
+
+function TfsVariableDesignator.GetValue: Variant;
+begin
+ Result := RefItem.Value;
+end;
+
+procedure TfsVariableDesignator.SetValue(const Value: Variant);
+begin
+ RefItem.Value := Value;
+end;
+
+
+{ TfsStringDesignator }
+
+function TfsStringDesignator.GetValue: Variant;
+begin
+ Result := TfsStringVariable(RefItem).FStr[Integer(FRef1.Value)];
+end;
+
+procedure TfsStringDesignator.SetValue(const Value: Variant);
+begin
+ TfsStringVariable(RefItem).FStr[Integer(FRef1.Value)] := VarToStr(Value)[1];
+end;
+
+
+{ TfsArrayDesignator }
+
+function TfsArrayDesignator.GetValue: Variant;
+var
+ i: Integer;
+begin
+ TfsCustomHelper(FRef1).ParentRef := RefItem;
+ for i := 0 to FRef2.Count - 1 do
+ FRef1.Params[i].Value := FRef2[i].Value;
+ Result := FRef1.Value;
+end;
+
+procedure TfsArrayDesignator.SetValue(const Value: Variant);
+var
+ i: Integer;
+begin
+ TfsCustomHelper(FRef1).ParentRef := RefItem;
+ for i := 0 to FRef2.Count - 1 do
+ FRef1.Params[i].Value := FRef2[i].Value;
+ FRef1.Value := Value;
+end;
+
+
+{ TfsSetExpression }
+
+function TfsSetExpression.Check(const Value: Variant): Boolean;
+var
+ i: Integer;
+ Expr: TfsCustomExpression;
+begin
+ Result := False;
+
+ (* TfsSetExpression encapsulates the set like [1,2,3..10]
+ In the example above we'll have the following Items:
+ TfsExpression {1}
+ TfsExpression {2}
+ TfsExpression {3}
+ nil (indicates the range )
+ TfsExpression {10} *)
+
+ i := 0;
+ while i < Count do
+ begin
+ Expr := Items[i];
+
+ if (i < Count - 1) and (Items[i + 1] = nil) then { subrange }
+ begin
+ Result := (Value >= Expr.Value) and (Value <= Items[i + 2].Value);
+ Inc(i, 2);
+ end
+ else
+ Result := Value = Expr.Value;
+
+ if Result then break;
+ Inc(i);
+ end;
+end;
+
+function TfsSetExpression.GetItem(Index: Integer): TfsCustomExpression;
+begin
+ Result := FItems[Index];
+end;
+
+function TfsSetExpression.GetValue: Variant;
+var
+ i: Integer;
+begin
+ Result := VarArrayCreate([0, Count - 1], varVariant);
+
+ for i := 0 to Count - 1 do
+ if Items[i] = nil then
+ Result[i] := Null else
+ Result[i] := Items[i].Value;
+end;
+
+
+{ TfsScript }
+
+constructor TfsScript.Create(AOwner: TComponent);
+begin
+ inherited;
+ FEvaluteRiseError := False;
+ FItems := TStringList.Create;
+ FItems.Sorted := True;
+ FItems.Duplicates := dupAccept;
+ FLines := TStringList.Create;
+ FMacros := TStringList.Create;
+ FIncludePath := TStringList.Create;
+ FIncludePath.Add('');
+ FStatement := TfsStatement.Create(Self, '', '');
+ FSyntaxType := 'PascalScript';
+ FUnitLines := TStringList.Create;
+ FUseClassLateBinding := False;
+end;
+
+destructor TfsScript.Destroy;
+begin
+ inherited;
+ Clear;
+ ClearRTTI;
+ FItems.Free;
+ FLines.Free;
+ FMacros.Free;
+ FIncludePath.Free;
+ FStatement.Free;
+ FUnitLines.Free;
+end;
+
+procedure TfsScript.Add(const Name: String; Item: TObject);
+begin
+ FItems.AddObject(Name, Item);
+ if Item is TfsCustomVariable then
+ TfsCustomVariable(Item).AddedBy := FAddedBy;
+end;
+
+function TfsScript.Count: Integer;
+begin
+ Result := FItems.Count;
+end;
+
+procedure TfsScript.Remove(Item: TObject);
+begin
+ FItems.Delete(FItems.IndexOfObject(Item));
+end;
+
+procedure TfsScript.Clear;
+var
+ i: Integer;
+ item: TObject;
+begin
+ i := 0;
+ while i < FItems.Count do
+ begin
+ item := FItems.Objects[i];
+ if (item is TfsRTTIModule) or
+ ((item is TfsCustomVariable) and
+ (TfsCustomVariable(item).AddedBy = TObject(1))) then
+ Inc(i)
+ else
+ begin
+ item.Free;
+ FItems.Delete(i);
+ end;
+ end;
+ FStatement.Clear;
+
+
+ for i := 0 to FUnitLines.Count - 1 do
+ FUnitLines.Objects[i].Free;
+
+ FUnitLines.Clear;
+
+ FErrorPos := '';
+ FErrorMsg := '';
+ FErrorUnit := '';
+end;
+
+procedure TfsScript.ClearItems(Owner: TObject);
+var
+ i: Integer;
+begin
+ RemoveItems(Owner);
+ FStatement.Clear;
+
+ for i := 0 to FUnitLines.Count - 1 do
+ FUnitLines.Objects[i].Free;
+
+ FUnitLines.Clear;
+end;
+
+procedure TfsScript.RemoveItems(Owner: TObject);
+var
+ i: Integer;
+begin
+ for i := Count - 1 downto 0 do
+ if FItems.Objects[i] is TfsCustomVariable then
+ if Items[i].AddedBy = Owner then
+ begin
+ Items[i].Free;
+ Remove(Items[i]);
+ end;
+end;
+
+function TfsScript.GetItem(Index: Integer): TfsCustomVariable;
+begin
+ Result := TfsCustomVariable(FItems.Objects[Index]);
+end;
+
+function TfsScript.GetProgName: String;
+begin
+ if Assigned(ProgRunning) then
+ Result := ProgRunning.ProgName
+ else
+ Result := FProgName;
+end;
+
+function TfsScript.Find(const Name: String): TfsCustomVariable;
+begin
+ Result := FindLocal(Name);
+
+ { trying to find the identifier in all parent programs }
+ if (Result = nil) and (FParent <> nil) then
+ Result := FParent.Find(Name);
+end;
+
+function TfsScript.FindLocal(const Name: String): TfsCustomVariable;
+var
+ i: Integer;
+begin
+ Result := nil;
+ i := FItems.IndexOf(Name);
+ if (i <> -1) and (FItems.Objects[i] is TfsCustomVariable) then
+ Result := TfsCustomVariable(FItems.Objects[i]);
+end;
+
+function TfsScript.Compile: Boolean;
+var
+ p: TfsILParser;
+begin
+ Result := False;
+ FErrorMsg := '';
+
+ p := TfsILParser.Create(Self);
+ try
+ p.SelectLanguage(FSyntaxType);
+ if p.MakeILScript(FLines.Text) then
+ p.ParseILScript;
+ finally
+ p.Free;
+ end;
+
+ if FErrorMsg = '' then
+ begin
+ Result := True;
+ FErrorPos := '';
+ end
+end;
+
+procedure TfsScript.Execute;
+begin
+
+ FExitCalled := False;
+ FTerminated := False;
+ FIsRunning := True;
+ FMainProg := True;
+ try
+ FStatement.Execute;
+ finally
+ FExitCalled := False;
+ FTerminated := False;
+ FIsRunning := False;
+ end;
+end;
+
+function TfsScript.Run: Boolean;
+begin
+ Result := Compile;
+ if Result then
+ Execute;
+end;
+
+function TfsScript.GetILCode(Stream: TStream): Boolean;
+var
+ p: TfsILParser;
+begin
+ Result := False;
+ FErrorMsg := '';
+
+ p := TfsILParser.Create(Self);
+ try
+ p.SelectLanguage(FSyntaxType);
+ if p.MakeILScript(FLines.Text) then
+ p.ILScript.SaveToStream(Stream);
+ finally
+ p.Free;
+ end;
+
+ if FErrorMsg = '' then
+ begin
+ Result := True;
+ FErrorPos := '';
+ end;
+end;
+
+function TfsScript.SetILCode(Stream: TStream): Boolean;
+var
+ p: TfsILParser;
+begin
+ Result := False;
+ FErrorMsg := '';
+
+ p := TfsILParser.Create(Self);
+ try
+ p.SelectLanguage(FSyntaxType);
+ p.ILScript.LoadFromStream(Stream);
+ p.ParseILScript;
+ finally
+ p.Free;
+ end;
+
+ if FErrorMsg = '' then
+ begin
+ Result := True;
+ FErrorPos := '';
+ end;
+end;
+
+procedure TfsScript.AddType(const TypeName: String; ParentType: TfsVarType);
+var
+ v: TfsTypeVariable;
+begin
+ if Find(TypeName) <> nil then Exit;
+ v := TfsTypeVariable.Create(TypeName, ParentType, '');
+ Add(TypeName, v);
+end;
+
+function TfsScript.AddClass(AClass: TClass; const Ancestor: String): TfsClassVariable;
+var
+ cl: TfsClassVariable;
+begin
+ Result := nil;
+ if Find(AClass.ClassName) <> nil then Exit;
+
+ Result := TfsClassVariable.Create(AClass, Ancestor);
+ Result.FProgram := Self;
+ Add(Result.Name, Result);
+
+ cl := TfsClassVariable(Find(Ancestor));
+ if cl <> nil then
+ Result.FDefProperty := cl.DefProperty;
+end;
+
+procedure TfsScript.AddConst(const Name, Typ: String; const Value: Variant);
+var
+ v: TfsVariable;
+begin
+ if Find(Name) <> nil then Exit;
+
+ v := TfsVariable.Create(Name, StrToVarType(Typ, Self), Typ);
+ v.Value := Value;
+ v.IsReadOnly := True;
+ Add(v.Name, v);
+end;
+
+procedure TfsScript.AddEnum(const Typ, Names: String);
+var
+ i: Integer;
+ v: TfsVariable;
+ sl: TStringList;
+begin
+ v := TfsVariable.Create(Typ, fvtEnum, Typ);
+ Add(v.Name, v);
+
+ sl := TStringList.Create;
+ sl.CommaText := Names;
+
+ try
+ for i := 0 to sl.Count - 1 do
+ begin
+ v := TfsVariable.Create(Trim(sl[i]), fvtEnum, Typ);
+ v.Value := i;
+ v.IsReadOnly := True;
+ Add(v.Name, v);
+ end;
+ finally
+ sl.Free;
+ end;
+end;
+
+procedure TfsScript.AddEnumSet(const Typ, Names: String);
+var
+ i, j: Integer;
+ v: TfsVariable;
+ sl: TStringList;
+begin
+ v := TfsVariable.Create(Typ, fvtEnum, Typ);
+ Add(v.Name, v);
+
+ sl := TStringList.Create;
+ sl.CommaText := Names;
+
+ try
+ j := 1;
+ for i := 0 to sl.Count - 1 do
+ begin
+ v := TfsVariable.Create(Trim(sl[i]), fvtEnum, Typ);
+ v.Value := j;
+ v.IsReadOnly := True;
+ Add(v.Name, v);
+ j := j * 2;
+ end;
+ finally
+ sl.Free;
+ end;
+end;
+
+procedure TfsScript.AddMethod(const Syntax: String; CallEvent: TfsCallMethodEvent;
+ const Category: String = ''; const Description: String = '');
+var
+ v: TfsMethodHelper;
+begin
+ v := TfsMethodHelper.Create(Syntax, Self);
+ v.FOnCall := CallEvent;
+ if Description = '' then
+ v.FDescription := v.Name else
+ v.FDescription := Description;
+ v.FCategory := Category;
+ Add(v.Name, v);
+end;
+
+procedure TfsScript.AddMethod(const Syntax: String; CallEvent: TfsCallMethodNewEvent;
+ const Category: String = ''; const Description: String = '');
+var
+ v: TfsMethodHelper;
+begin
+ v := TfsMethodHelper.Create(Syntax, Self);
+ v.FOnCallNew := CallEvent;
+ if Description = '' then
+ v.FDescription := v.Name else
+ v.FDescription := Description;
+ v.FCategory := Category;
+ Add(v.Name, v);
+end;
+
+procedure TfsScript.AddObject(const Name: String; Obj: TObject);
+begin
+ AddVariable(Name, Obj.ClassName, frxInteger(Obj));
+end;
+
+procedure TfsScript.AddVariable(const Name, Typ: String; const Value: Variant);
+var
+ v: TfsVariable;
+begin
+ if Find(Name) <> nil then Exit;
+
+ v := TfsVariable.Create(Name, StrToVarType(Typ, Self), Typ);
+ v.Value := Value;
+ v.OnGetVarValue := FOnGetVarValue;
+ Add(v.Name, v);
+end;
+
+procedure TfsScript.AddForm(Form: TComponent);
+begin
+ AddComponent(Form);
+end;
+
+procedure TfsScript.AddComponent(Form: TComponent);
+{$IFNDEF NOFORMS}
+var
+ i: Integer;
+ v: TfsClassVariable;
+{$ENDIF}
+begin
+{$IFNDEF NOFORMS}
+ v := FindClass(Form.ClassName);
+ if v = nil then
+ begin
+ if Form.InheritsFrom(TForm) then
+ AddClass(Form.ClassType, 'TForm')
+ else if Form.InheritsFrom(TDataModule) then
+ AddClass(Form.ClassType, 'TDataModule')
+{$IFNDEF FMX}
+{$IFDEF Delphi5}
+ else if Form.InheritsFrom(TFrame) then
+ AddClass(Form.ClassType, 'TFrame')
+{$ENDIF}
+{$ENDIF}
+ else
+ Exit;
+ v := FindClass(Form.ClassName);
+ end;
+
+ for i := 0 to Form.ComponentCount - 1 do
+ v.AddComponent(Form.Components[i]);
+ AddObject(Form.Name, Form);
+{$ENDIF}
+end;
+
+procedure TfsScript.AddRTTI;
+var
+ i: Integer;
+ rtti: TfsRTTIModule;
+ obj: TClass;
+begin
+ if FRTTIAdded then Exit;
+
+ AddedBy := TObject(1); // do not clear
+ for i := 0 to FRTTIModules.Count - 1 do
+ begin
+ obj := TClass(FRTTIModules[i]);
+ rtti := TfsRTTIModule(obj.NewInstance);
+ rtti.Create(Self);
+ Add('', rtti);
+ end;
+ AddedBy := nil;
+
+ FRTTIAdded := True;
+end;
+
+procedure TfsScript.ClearRTTI;
+var
+ i: Integer;
+ item: TObject;
+begin
+ if not FRTTIAdded then Exit;
+
+ i := 0;
+ while i < FItems.Count do
+ begin
+ item := FItems.Objects[i];
+ if (item is TfsRTTIModule) or
+ ((item is TfsCustomVariable) and
+ (TfsCustomVariable(item).AddedBy = TObject(1))) then
+ begin
+ item.Free;
+ FItems.Delete(i);
+ end
+ else
+ Inc(i);
+ end;
+
+ FRTTIAdded := False;
+end;
+
+function TfsScript.CallFunction(const Name: String; const Params: Variant; sGlobal: Boolean): Variant;
+var
+ i, StackIndex: Integer;
+ v: TfsCustomVariable;
+ p: TfsProcVariable;
+begin
+ if sGlobal then
+ v := Find(Name)
+ else
+ v := FindLocal(Name);
+ if (v <> nil) and (v is TfsProcVariable) then
+ begin
+ p := TfsProcVariable(v);
+
+ StackIndex := -1;
+ if p.Executing then
+ StackIndex := p.SaveLocalVariables;
+ try
+ if VarIsArray(Params) then
+ for i := 0 to VarArrayHighBound(Params, 1) do
+ p.Params[i].Value := Params[i];
+ Result := p.Value;
+ finally
+ p.RestoreLocalVariables(StackIndex, True);
+ end;
+ end
+ else
+ begin
+ Result := Null;
+ end
+end;
+
+function TfsScript.CallFunction1(const Name: String; var Params: Variant; sGlobal: Boolean): Variant;
+var
+ i, StackIndex: Integer;
+ v: TfsCustomVariable;
+ p: TfsProcVariable;
+begin
+ if sGlobal then
+ v := Find(Name)
+ else
+ v := FindLocal(Name);
+ if (v <> nil) and (v is TfsProcVariable) then
+ begin
+ p := TfsProcVariable(v);
+
+ StackIndex := -1;
+ if p.Executing then
+ StackIndex := p.SaveLocalVariables;
+ try
+ if VarIsArray(Params) then
+ for i := 0 to VarArrayHighBound(Params, 1) do
+ p.Params[i].Value := Params[i];
+ Result := p.Value;
+ if VarIsArray(Params) then
+ for i := 0 to VarArrayHighBound(Params, 1) do
+ Params[i] := p.Params[i].Value;
+ finally
+ p.RestoreLocalVariables(StackIndex, True);
+ end;
+ end
+ else
+ Result := Null;
+end;
+
+function TfsScript.CallFunction2(const Func: TfsProcVariable; const Params: Variant): Variant;
+var
+ i, StackIndex: Integer;
+begin
+ if (Func <> nil) then
+ begin
+ StackIndex := -1;
+ if Func.Executing then
+ StackIndex := Func.SaveLocalVariables;
+ try
+ if VarIsArray(Params) then
+ for i := 0 to VarArrayHighBound(Params, 1) do
+ Func.Params[i].Value := Params[i];
+ Result := Func.Value;
+ finally
+ Func.RestoreLocalVariables(StackIndex, True);
+ end;
+ end
+ else
+ begin
+ Result := Null;
+ end
+end;
+
+function TfsScript.Evaluate(const Expression: String): Variant;
+var
+ p: TfsScript;
+ Prog: TfsScript;
+ SaveEvent: TfsRunLineEvent;
+begin
+ FEvaluteRiseError := False;
+ Result := Null;
+ if FProgRunning = nil then
+ p := Self else
+ p := FProgRunning;
+
+ Prog := TfsScript.Create(nil);
+ if not p.FRTTIAdded then
+ Prog.AddRTTI;
+ Prog.Parent := p;
+ Prog.OnGetVarValue := p.OnGetVarValue;
+ SaveEvent := FOnRunLine;
+ FOnRunLine := nil;
+ try
+ prog.SyntaxType := SyntaxType;
+ if CompareText(SyntaxType, 'PascalScript') = 0 then
+ Prog.Lines.Text := 'function fsEvaluateFUNC: Variant; begin Result := ' + Expression + ' end; begin end.'
+ else if CompareText(SyntaxType, 'C++Script') = 0 then
+ Prog.Lines.Text := 'Variant fsEvaluateFUNC() { return ' + Expression + '; } {}'
+ else if CompareText(SyntaxType, 'BasicScript') = 0 then
+ Prog.Lines.Text := 'function fsEvaluateFUNC' + #13#10 + 'return ' + Expression + #13#10 + 'end function'
+ else if CompareText(SyntaxType, 'JScript') = 0 then
+ Prog.Lines.Text := 'function fsEvaluateFUNC() { return (' + Expression + '); }';
+ if not Prog.Compile then
+ begin
+ Result := Prog.ErrorMsg;
+ FEvaluteRiseError := True;
+ end
+ else
+ Result := Prog.FindLocal('fsEvaluateFUNC').Value;
+ finally
+ Prog.Free;
+ FOnRunLine := SaveEvent;
+ end;
+end;
+
+function TfsScript.FindClass(const Name: String): TfsClassVariable;
+var
+ Item: TfsCustomVariable;
+begin
+ Item := Find(Name);
+ if (Item <> nil) and (Item is TfsClassVariable) then
+ Result := TfsClassVariable(Item) else
+ Result := nil
+end;
+
+procedure TfsScript.RunLine(const UnitName, Index: String);
+var
+ p: TfsScript;
+begin
+ p := Self;
+ while p <> nil do
+ if Assigned(p.FOnRunLine) then
+ begin
+ p.FOnRunLine(Self, UnitName, Index);
+ break;
+ end
+ else
+ p := p.FParent;
+end;
+
+function TfsScript.GetVariables(Index: String): Variant;
+var
+ v: TfsCustomVariable;
+begin
+ v := Find(Index);
+ if v <> nil then
+ Result := v.Value else
+ Result := Null;
+end;
+
+procedure TfsScript.SetVariables(Index: String; const Value: Variant);
+var
+ v: TfsCustomVariable;
+begin
+ v := Find(Index);
+ if v <> nil then
+ v.Value := Value else
+ AddVariable(Index, 'Variant', Value);
+end;
+
+procedure TfsScript.SetLines(const Value: TStrings);
+begin
+ FLines.Assign(Value);
+end;
+
+procedure TfsScript.SetProgName(const Value: String);
+begin
+ if Assigned(FProgRunning) then
+ FProgRunning.FProgName := Value
+ else
+ FProgName := Value;
+end;
+
+procedure TfsScript.Terminate;
+
+ procedure TerminateAll(Script: TfsScript);
+ var
+ i: Integer;
+ begin
+ Script.FExitCalled := True;
+ Script.FTerminated := True;
+ for i := 0 to Script.Count - 1 do
+ if Script.Items[i] is TfsProcVariable then
+ TerminateAll(TfsProcVariable(Script.Items[i]).Prog);
+ end;
+
+begin
+ TerminateAll(Self);
+end;
+
+procedure TfsScript.AddCodeLine(const UnitName, APos: String);
+var
+ sl: TStringList;
+ LineN: String;
+ i : Integer;
+begin
+ i := FUnitLines.IndexOf(UnitName);
+
+ if (i = -1) then
+ begin
+ sl := TStringList.Create;
+ sl.Sorted := True;
+ FUnitLines.AddObject(UnitName, sl);
+ end else
+ begin
+ sl := TStringList(FUnitLines.Objects[i]);
+ end;
+
+ LineN := Copy(APos, 1, Pos(':', APos) - 1);
+ if sl.IndexOf(LineN) = -1 then
+ begin
+ sl.Add(LineN);
+ end;
+end;
+
+function TfsScript.IsExecutableLine(LineN: Integer; const UnitName: String = ''): Boolean;
+var
+ sl: TStringList;
+ i: Integer;
+begin
+ Result := False;
+
+ i := FUnitLines.IndexOf(UnitName);
+ if (i = -1) then Exit;
+
+ sl := TStringList(FUnitLines.Objects[i]);
+ if sl.IndexOf(IntToStr(LineN)) <> -1 then
+ Result := True;
+end;
+
+
+
+
+{ TfsStatement }
+
+constructor TfsStatement.Create(AProgram: TfsScript; const UnitName,
+ SourcePos: String);
+begin
+ inherited Create;
+ FProgram := AProgram;
+ FSourcePos := SourcePos;
+ FUnitName := UnitName;
+end;
+
+function TfsStatement.GetItem(Index: Integer): TfsStatement;
+begin
+ Result := FItems[Index];
+end;
+
+procedure TfsStatement.Execute;
+var
+ i: Integer;
+begin
+ FProgram.ErrorPos := '';
+ for i := 0 to Count - 1 do
+ begin
+ if FProgram.FTerminated then break;
+ try
+ FProgram.FLastSourcePos := Items[i].FSourcePos;
+ Items[i].Execute;
+ except
+ on E: Exception do
+ begin
+ if FProgram.ErrorPos = '' then
+ FProgram.ErrorPos := FProgram.FLastSourcePos;
+ raise;
+ end;
+ end;
+ if FProgram.FBreakCalled or FProgram.FContinueCalled or
+ FProgram.FExitCalled then break;
+ end;
+end;
+
+procedure TfsStatement.RunLine;
+begin
+ FProgram.RunLine(FUnitName, FSourcePos);
+end;
+
+
+{ TfsAssignmentStmt }
+
+destructor TfsAssignmentStmt.Destroy;
+begin
+ FDesignator.Free;
+ FExpression.Free;
+ inherited;
+end;
+
+procedure TfsAssignmentStmt.Optimize;
+begin
+ FVar := FDesignator;
+ FExpr := FExpression;
+
+ if FDesignator is TfsVariableDesignator then
+ FVar := FDesignator.RefItem;
+ if TfsExpression(FExpression).SingleItem <> nil then
+ FExpr := TfsExpression(FExpression).SingleItem;
+end;
+
+procedure TfsAssignmentStmt.Execute;
+begin
+ RunLine;
+ if FProgram.FTerminated then Exit;
+ FVar.Value := FExpr.Value;
+end;
+
+procedure TfsAssignPlusStmt.Execute;
+begin
+ RunLine;
+ if FProgram.FTerminated then Exit;
+ FVar.Value := FVar.Value + FExpr.Value;
+end;
+
+procedure TfsAssignMinusStmt.Execute;
+begin
+ RunLine;
+ if FProgram.FTerminated then Exit;
+ FVar.Value := FVar.Value - FExpr.Value;
+end;
+
+procedure TfsAssignMulStmt.Execute;
+begin
+ RunLine;
+ if FProgram.FTerminated then Exit;
+ FVar.Value := FVar.Value * FExpr.Value;
+end;
+
+procedure TfsAssignDivStmt.Execute;
+begin
+ RunLine;
+ if FProgram.FTerminated then Exit;
+ FVar.Value := FVar.Value / FExpr.Value;
+end;
+
+
+{ TfsCallStmt }
+
+destructor TfsCallStmt.Destroy;
+begin
+ FDesignator.Free;
+ inherited;
+end;
+
+procedure TfsCallStmt.Execute;
+begin
+ RunLine;
+ if FProgram.FTerminated then Exit;
+ if FModificator = '' then
+ begin
+ FDesignator.NeedResult := False;
+ FDesignator.Value;
+ end
+ else if FModificator = '+' then
+ FDesignator.Value := FDesignator.Value + 1
+ else if FModificator = '-' then
+ FDesignator.Value := FDesignator.Value - 1
+end;
+
+
+{ TfsIfStmt }
+
+constructor TfsIfStmt.Create(AProgram: TfsScript; const UnitName,
+ SourcePos: String);
+begin
+ inherited;
+ FElseStmt := TfsStatement.Create(FProgram, UnitName, SourcePos);
+end;
+
+destructor TfsIfStmt.Destroy;
+begin
+ FCondition.Free;
+ FElseStmt.Free;
+ inherited;
+end;
+
+procedure TfsIfStmt.Execute;
+begin
+ RunLine;
+ if FProgram.FTerminated then Exit;
+ if Boolean(FCondition.Value) = True then
+ inherited Execute else
+ FElseStmt.Execute;
+end;
+
+
+{ TfsRepeatStmt }
+
+destructor TfsRepeatStmt.Destroy;
+begin
+ FCondition.Free;
+ inherited;
+end;
+
+procedure TfsRepeatStmt.Execute;
+begin
+ RunLine;
+ if FProgram.FTerminated then Exit;
+
+ repeat
+ inherited Execute;
+ if FProgram.FBreakCalled or FProgram.FExitCalled then break;
+ FProgram.FContinueCalled := False;
+ until Boolean(FCondition.Value) = not FInverseCondition;
+
+ FProgram.FBreakCalled := False;
+end;
+
+
+{ TfsWhileStmt }
+
+destructor TfsWhileStmt.Destroy;
+begin
+ FCondition.Free;
+ inherited;
+end;
+
+procedure TfsWhileStmt.Execute;
+begin
+ RunLine;
+ if FProgram.FTerminated then Exit;
+
+ while Boolean(FCondition.Value) = True do
+ begin
+ inherited Execute;
+ if FProgram.FBreakCalled or FProgram.FExitCalled then break;
+ FProgram.FContinueCalled := False;
+ end;
+
+ FProgram.FBreakCalled := False;
+end;
+
+
+{ TfsForStmt }
+
+destructor TfsForStmt.Destroy;
+begin
+ FBeginValue.Free;
+ FEndValue.Free;
+ inherited;
+end;
+
+procedure TfsForStmt.Execute;
+var
+ i, bValue, eValue: Integer;
+begin
+ try
+ bValue := FBeginValue.Value;
+ eValue := FEndValue.Value;
+ finally
+ RunLine;
+ end;
+ if FProgram.FTerminated then Exit;
+
+ if FDown then
+ for i := bValue downto eValue do
+ begin
+ FVariable.FValue := i;
+ inherited Execute;
+ if FProgram.FBreakCalled or FProgram.FExitCalled then break;
+ FProgram.FContinueCalled := False;
+ end
+ else
+ for i := bValue to eValue do
+ begin
+ FVariable.FValue := i;
+ inherited Execute;
+ if FProgram.FBreakCalled or FProgram.FExitCalled then break;
+ FProgram.FContinueCalled := False;
+ end;
+
+ FProgram.FBreakCalled := False;
+end;
+
+
+{ TfsVbForStmt }
+
+destructor TfsVbForStmt.Destroy;
+begin
+ FBeginValue.Free;
+ FEndValue.Free;
+ if FStep <> nil then
+ FStep.Free;
+ inherited;
+end;
+
+procedure TfsVbForStmt.Execute;
+var
+ i, bValue, eValue, sValue: Variant;
+ Down: Boolean;
+begin
+ bValue := FBeginValue.Value;
+ eValue := FEndValue.Value;
+ if FStep <> nil then
+ sValue := FStep.Value else
+ sValue := 1;
+ Down := sValue < 0;
+
+ RunLine;
+ if FProgram.FTerminated then Exit;
+ i := bValue;
+ if Down then
+ while i >= eValue do
+ begin
+ FVariable.FValue := i;
+ inherited Execute;
+ if FProgram.FBreakCalled or FProgram.FExitCalled then break;
+ FProgram.FContinueCalled := False;
+ i := i + sValue;
+ end
+ else
+ while i <= eValue do
+ begin
+ FVariable.FValue := i;
+ inherited Execute;
+ if FProgram.FBreakCalled or FProgram.FExitCalled then break;
+ FProgram.FContinueCalled := False;
+ i := i + sValue;
+ end;
+
+ FProgram.FBreakCalled := False;
+end;
+
+
+{ TfsCppForStmt }
+
+constructor TfsCppForStmt.Create(AProgram: TfsScript; const UnitName,
+ SourcePos: String);
+begin
+ inherited;
+ FFirstStmt := TfsStatement.Create(FProgram, UnitName, SourcePos);
+ FSecondStmt := TfsStatement.Create(FProgram, UnitName, SourcePos);
+end;
+
+destructor TfsCppForStmt.Destroy;
+begin
+ FFirstStmt.Free;
+ FExpression.Free;
+ FSecondStmt.Free;
+ inherited;
+end;
+
+procedure TfsCppForStmt.Execute;
+begin
+ RunLine;
+ if FProgram.FTerminated then Exit;
+ FFirstStmt.Execute;
+ if FProgram.FTerminated then Exit;
+ while Boolean(FExpression.Value) = True do
+ begin
+ inherited Execute;
+ if FProgram.FBreakCalled or FProgram.FExitCalled then break;
+ FProgram.FContinueCalled := False;
+ FSecondStmt.Execute;
+ end;
+
+ FProgram.FBreakCalled := False;
+end;
+
+
+{ TfsCaseSelector }
+
+destructor TfsCaseSelector.Destroy;
+begin
+ FSetExpression.Free;
+ inherited;
+end;
+
+function TfsCaseSelector.Check(const Value: Variant): Boolean;
+begin
+ Result := FSetExpression.Check(Value);
+end;
+
+
+{ TfsCaseStmt }
+
+constructor TfsCaseStmt.Create(AProgram: TfsScript; const UnitName,
+ SourcePos: String);
+begin
+ inherited;
+ FElseStmt := TfsStatement.Create(FProgram, UnitName, SourcePos);
+end;
+
+destructor TfsCaseStmt.Destroy;
+begin
+ FCondition.Free;
+ FElseStmt.Free;
+ inherited;
+end;
+
+procedure TfsCaseStmt.Execute;
+var
+ i: Integer;
+ Value: Variant;
+ Executed: Boolean;
+begin
+ Value := FCondition.Value;
+ Executed := False;
+
+ RunLine;
+ if FProgram.FTerminated then Exit;
+ for i := 0 to Count - 1 do
+ if TfsCaseSelector(Items[i]).Check(Value) then
+ begin
+ Items[i].Execute;
+ Executed := True;
+ break;
+ end;
+
+ if not Executed then
+ FElseStmt.Execute;
+end;
+
+
+{ TfsTryStmt }
+
+constructor TfsTryStmt.Create(AProgram: TfsScript; const UnitName,
+ SourcePos: String);
+begin
+ inherited;
+ FExceptStmt := TfsStatement.Create(AProgram, UnitName, SourcePos);
+end;
+
+destructor TfsTryStmt.Destroy;
+begin
+ FExceptStmt.Free;
+ inherited;
+end;
+
+procedure TfsTryStmt.Execute;
+var
+ SaveExitCalled: Boolean;
+begin
+ RunLine;
+ if FProgram.FTerminated then Exit;
+ if IsExcept then
+ begin
+ try
+ inherited Execute;
+ except
+ on E: Exception do
+ begin
+ FProgram.SetVariables('ExceptionClassName', E.ClassName);
+ FProgram.SetVariables('ExceptionMessage', E.Message);
+ FProgram.ErrorPos := FProgram.FLastSourcePos;
+ ExceptStmt.Execute;
+ end;
+ end;
+ end
+ else
+ begin
+ try
+ inherited Execute;
+ finally
+ SaveExitCalled := FProgram.FExitCalled;
+ FProgram.FExitCalled := False;
+ ExceptStmt.Execute;
+ FProgram.FExitCalled := SaveExitCalled;
+ end
+ end;
+end;
+
+{ TfsBreakStmt }
+
+procedure TfsBreakStmt.Execute;
+begin
+ FProgram.FBreakCalled := True;
+end;
+
+
+{ TfsContinueStmt }
+
+procedure TfsContinueStmt.Execute;
+begin
+ FProgram.FContinueCalled := True;
+end;
+
+
+{ TfsExitStmt }
+
+procedure TfsExitStmt.Execute;
+begin
+ RunLine;
+ FProgram.FExitCalled := True;
+end;
+
+
+{ TfsWithStmt }
+
+destructor TfsWithStmt.Destroy;
+begin
+ FDesignator.Free;
+ inherited;
+end;
+
+procedure TfsWithStmt.Execute;
+begin
+ inherited;
+ FVariable.Value := FDesignator.Value;
+end;
+
+
+{ TfsArrayHelper }
+
+constructor TfsArrayHelper.Create(const AName: String; DimCount: Integer;
+ Typ: TfsVarType; const TypeName: String);
+var
+ i: Integer;
+begin
+ inherited Create(AName, Typ, TypeName);
+
+ if DimCount <> -1 then
+ begin
+ for i := 0 to DimCount - 1 do
+{$IFDEF CPUX64}
+ Add(TfsParamItem.Create('', fvtInt64, '', False, False));
+{$ELSE}
+ Add(TfsParamItem.Create('', fvtInt, '', False, False));
+{$ENDIF}
+ end
+ else
+ for i := 0 to 2 do
+{$IFDEF CPUX64}
+ Add(TfsParamItem.Create('', fvtInt64, '', i > 0, False));
+{$ELSE}
+ Add(TfsParamItem.Create('', fvtInt, '', i > 0, False));
+{$ENDIF}
+end;
+
+destructor TfsArrayHelper.Destroy;
+begin
+ inherited;
+end;
+
+function TfsArrayHelper.GetValue: Variant;
+var
+ DimCount: Integer;
+begin
+ DimCount := VarArrayDimCount(ParentRef.PValue^);
+ case DimCount of
+ 1: Result := ParentRef.PValue^[Params[0].Value];
+ 2: Result := ParentRef.PValue^[Params[0].Value, Params[1].Value];
+ 3: Result := ParentRef.PValue^[Params[0].Value, Params[1].Value, Params[2].Value];
+ else
+ Result := Null;
+ end;
+end;
+
+procedure TfsArrayHelper.SetValue(const Value: Variant);
+var
+ DimCount: Integer;
+begin
+ DimCount := VarArrayDimCount(ParentRef.PValue^);
+ case DimCount of
+ 1: ParentRef.PValue^[Params[0].Value] := Value;
+ 2: ParentRef.PValue^[Params[0].Value, Params[1].Value] := Value;
+ 3: ParentRef.PValue^[Params[0].Value, Params[1].Value, Params[2].Value] := Value;
+ end;
+end;
+
+
+{ TfsStringHelper }
+
+constructor TfsStringHelper.Create;
+begin
+ inherited Create('__StringHelper', fvtChar, '');
+ Add(TfsParamItem.Create('', fvtInt, '', False, False));
+end;
+
+function TfsStringHelper.GetValue: Variant;
+begin
+ Result := String(ParentValue)[Integer(Params[0].Value)];
+end;
+
+procedure TfsStringHelper.SetValue(const Value: Variant);
+var
+ s: String;
+begin
+ s := ParentValue;
+ s[Integer(Params[0].Value)] := String(Value)[1];
+ TfsCustomVariable(frxInteger(ParentRef)).Value := s;
+end;
+
+
+{ TfsCustomEvent }
+
+constructor TfsCustomEvent.Create(AObject: TObject; AHandler: TfsProcVariable);
+begin
+ FInstance := AObject;
+ FHandler := AHandler;
+end;
+
+procedure TfsCustomEvent.CallHandler(Params: array of const);
+var
+ i, StackIndex: Integer;
+begin
+ StackIndex := -1;
+ if FHandler.Executing then
+ StackIndex := FHandler.SaveLocalVariables;
+ try
+ for i := 0 to FHandler.Count - 1 do
+ FHandler.Params[i].Value := VarRecToVariant(Params[i]);
+ FHandler.Value;
+ finally
+ FHandler.RestoreLocalVariables(StackIndex, True);
+ end;
+end;
+
+
+{ TfsRTTIModule }
+
+constructor TfsRTTIModule.Create(AScript: TfsScript);
+begin
+ FScript := AScript;
+end;
+
+
+function fsGlobalUnit: TfsScript;
+begin
+ if (FGlobalUnit = nil) and not FGlobalUnitDestroyed then
+ begin
+ FGlobalUnit := TfsScript.Create(nil);
+ FGlobalUnit.AddRTTI;
+ end;
+ Result := FGlobalUnit;
+end;
+
+function fsIsGlobalUnitExist: Boolean;
+begin
+ Result := Assigned(FGlobalUnit);
+end;
+
+function fsRTTIModules: TList;
+begin
+ if (FRTTIModules = nil) and not FRTTIModulesDestroyed then
+ begin
+ FRTTIModules := TList.Create;
+ FRTTIModules.Add(TfsSysFunctions);
+ end;
+ Result := FRTTIModules;
+end;
+
+{ TfsVariable }
+
+function TfsVariable.GetValue: Variant;
+begin
+ Result := inherited GetValue;
+ if Assigned(FOnGetVarValue) then
+ begin
+ Result := FOnGetVarValue(FName, FTyp, FValue);
+ if Result = null then Result := FValue;
+ end;
+end;
+
+procedure TfsVariable.SetValue(const Value: Variant);
+begin
+ if not FIsReadOnly then
+ case FTyp of
+ fvtInt: FValue := VarAsType(Value, varInteger);
+{$IFDEF FS_INT64}
+ fvtInt64: FValue := VarAsType(Value, varInt64);
+{$ENDIF}
+ fvtBool: FValue := VarAsType(Value, varBoolean);
+ fvtFloat:
+ if (VarType(Value) = varDate) then
+ FValue := VarAsType(Value, varDate)
+ else
+ FValue := VarAsType(Value, varDouble);
+{$IFDEF Delphi12}
+ fvtString: FValue := VarAsType(Value, varUString);
+{$ELSE}
+ fvtString: FValue := VarAsType(Value, varString);
+{$ENDIF}
+ else
+ FValue := Value;
+ end;
+end;
+
+initialization
+{$IFDEF FMX}
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsScript, TFmxObject);
+{$ELSE}
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsScript, TControl);
+{$ENDIF}
+{$ENDIF}
+ FGlobalUnitDestroyed := False;
+ FRTTIModulesDestroyed := False;
+ fsRTTIModules;
+
+finalization
+ if FGlobalUnit <> nil then
+ FGlobalUnit.Free;
+ FGlobalUnit := nil;
+ FGlobalUnitDestroyed := True;
+ FRTTIModules.Free;
+ FRTTIModules := nil;
+ FRTTIModulesDestroyed := True;
+
+end.
\ No newline at end of file
diff --git a/LibD28/fs_ijs.pas b/LibD28/fs_ijs.pas
new file mode 100644
index 0000000..5c6a50d
--- /dev/null
+++ b/LibD28/fs_ijs.pas
@@ -0,0 +1,168 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ JScript grammar }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_ijs;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_itools{$IFDEF DELPHI16}, Controls{$ENDIF};
+{$ELSE}
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_itools, FMX.Types;
+{$ENDIF}
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsJScript = class(TComponent);
+
+
+implementation
+
+const
+ JS_GRAMMAR =
+ '' +
+ '' +
+ '<' +
+ 'loop text=","><' +
+ 'char text="!" add="op" addtext="not"/>' +
+ '<' +
+ 'char text="-" add="op"/><' +
+ 'expression err="err2"/>' +
+ '<' +
+ 'forstmtitem/>';
+
+
+initialization
+{$IFDEF DELPHI16}
+{$IFDEF FMX}
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsJScript, TFmxObject);
+{$ELSE}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsJScript, TControl);
+{$ENDIF}
+{$ENDIF}
+ fsRegisterLanguage('JScript', JS_GRAMMAR);
+
+end.
diff --git a/LibD28/fs_imenusrtti.pas b/LibD28/fs_imenusrtti.pas
new file mode 100644
index 0000000..c82f935
--- /dev/null
+++ b/LibD28/fs_imenusrtti.pas
@@ -0,0 +1,183 @@
+{**********************************************}
+{ }
+{ FastScript v1.9 }
+{ Menus }
+{ }
+{ Copyright (c) 1998-2007 }
+{ by Fast Reports Inc. }
+{ }
+{ Copyright (c) 2006 by }
+{ Copyright (c) 2006-2007 by Stalker SoftWare }
+{ }
+{**********************************************}
+
+unit fs_imenusrtti;
+
+interface
+
+{$I fs.inc}
+
+uses
+ SysUtils, Classes, Menus, fs_iinterpreter, fs_ievents, ImgList{$IFDEF DELPHI16}, Controls{$ENDIF}
+{$IFDEF Delphi6}
+, Types , Variants
+{$ENDIF};
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsMenusRTTI = class(TComponent); // fake component
+
+implementation
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass; const MethodName:
+ string; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass; const PropName:
+ string): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass; const PropName:
+ string; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+
+ with AScript do
+ begin
+
+ AddType('TPopupAlignment', fvtInt);
+
+ AddClass(TCustomImageList, 'TComponent');
+
+ with AddClass(TMenuItem, 'TComponent') do
+ begin
+ AddMethod('procedure Add(Item: TMenuItem)', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure Delete(Index: Integer)', CallMethod);
+ AddMethod('procedure Insert(Index: Integer; Item: TMenuItem)',
+ CallMethod);
+ AddMethod('procedure Remove(Item: TMenuItem)', CallMethod);
+ AddMethod('function GetParentMenu: TMenu', CallMethod);
+ AddEvent('OnClick', TfsNotifyEvent);
+ AddProperty('Count', 'Integer', GetProp);
+ AddDefaultProperty('Items', 'Integer', 'TMenuItem', CallMethod, True);
+ end; { with }
+
+ with AddClass(TMenu, 'TComponent') do
+ AddIndexProperty('Items', 'Integer', 'TMenuItem', CallMethod, True);
+
+ with AddClass(TPopupMenu, 'TMenu') do
+ begin
+ AddEvent('OnPopup', TfsNotifyEvent);
+ AddMethod('procedure Popup(X, Y: Extended)', CallMethod);
+ AddProperty('PopupComponent', 'TComponent', GetProp, SetProp);
+ AddProperty('Images', 'TCustomImageList', GetProp, SetProp);
+ end; { with }
+
+ end; { with }
+
+end; { Create }
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass; const
+ MethodName: string; Caller: TfsMethodHelper): Variant;
+var
+ oMenuItem: TMenuItem;
+begin
+ Result := 0;
+
+ if ClassType = TMenuItem then
+ begin
+
+ oMenuItem := TMenuItem(Instance);
+
+ if MethodName = 'ADD' then
+ oMenuItem.Add(TMenuItem(frxInteger(Caller.Params[0])))
+{$IFDEF Delphi5}
+ else if MethodName = 'CLEAR' then
+ oMenuItem.Clear
+{$ENDIF}
+ else if MethodName = 'DELETE' then
+ oMenuItem.Delete(Caller.Params[0])
+ else if MethodName = 'INSERT' then
+ oMenuItem.Insert(Caller.Params[0], TMenuItem(frxInteger(Caller.Params[1])))
+ else if MethodName = 'REMOVE' then
+ oMenuItem.Remove(TMenuItem(frxInteger(Caller.Params[0])))
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(oMenuItem.Items[Caller.Params[0]])
+ else if MethodName = 'GETPARENTMENU' then
+ Result := frxInteger(oMenuItem.GetParentMenu());
+
+ end
+ else if ClassType = TMenu then
+ begin
+
+ if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TMenu(Instance).Items[Caller.Params[0]])
+
+ end
+ else if ClassType = TPopupMenu then
+ begin
+
+ if MethodName = 'POPUP' then
+ TPopupMenu(Instance).Popup(Caller.Params[0], Caller.Params[1]);
+
+ end; { if }
+
+end; { CallMethod }
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass; const
+ PropName: string): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TMenuItem then
+ begin
+
+ if PropName = 'COUNT' then
+ Result := TMenuItem(Instance).Count;
+
+ end
+ else if ClassType = TPopupMenu then
+ begin
+
+ if PropName = 'POPUPCOMPONENT' then
+ Result := frxInteger(TPopupMenu(Instance).PopupComponent)
+ else if PropName = 'IMAGES' then
+ Result := frxInteger(TPopupMenu(Instance).Images)
+
+ end; { if }
+
+end; { GetProp }
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass; const
+ PropName: string; Value: Variant);
+begin
+ if ClassType = TPopupMenu then
+ begin
+ if PropName = 'IMAGES' then
+ TPopupMenu(Instance).Images := TCustomImageList(frxInteger(Value))
+ else if PropName = 'POPUPCOMPONENT' then
+ TPopupMenu(Instance).PopupComponent := TComponent(frxInteger(Value))
+
+ end; { if }
+
+end; { SetProp }
+
+initialization
+{$IFDEF Delphi16}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsMenusRTTI, TControl);
+{$ENDIF}
+ fsRTTIModules.Add(TFunctions);
+
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
+
diff --git a/LibD28/fs_iparser.pas b/LibD28/fs_iparser.pas
new file mode 100644
index 0000000..cef63e1
--- /dev/null
+++ b/LibD28/fs_iparser.pas
@@ -0,0 +1,762 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Parser }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_iparser;
+
+interface
+
+{$i fs.inc}
+
+uses
+{$IFNDEF CROSS_COMPILE}
+ Windows,
+{$ENDIF}
+ SysUtils, Classes;
+//FMX uses
+{$ELSE}
+interface
+
+{$i fs.inc}
+
+uses
+ System.Types, FMX.Types, System.SysUtils, System.Classes;
+{$ENDIF}
+
+
+
+type
+ TfsIdentifierCharset = set of AnsiChar;
+
+ { TfsParser parser the source text and return such elements as identifiers,
+ keywords, punctuation, strings and numbers. }
+
+ TfsParser = class(TObject)
+ private
+ FCaseSensitive: Boolean;
+ FCommentBlock1: String;
+ FCommentBlock11: String;
+ FCommentBlock12: String;
+ FCommentBlock2: String;
+ FCommentBlock21: String;
+ FCommentBlock22: String;
+ FCommentLine1: String;
+ FCommentLine2: String;
+ FHexSequence: String;
+ FIdentifierCharset: TfsIdentifierCharset;
+ FKeywords: TStrings;
+ FLastPosition: Integer;
+ FPosition: Integer;
+ FSize: Integer;
+ FSkiPChar: String;
+ FSkipEOL: Boolean;
+ FSkipSpace: Boolean;
+ FStringQuotes: String;
+ FText: String;
+ FUseY: Boolean;
+ FYList: TList;
+ FSpecStrChar: Boolean;
+ function DoDigitSequence: Boolean;
+ function DoHexDigitSequence: Boolean;
+ function DoScaleFactor: Boolean;
+ function DoUnsignedInteger: Boolean;
+ function DoUnsignedReal: Boolean;
+ procedure SetPosition(const Value: Integer);
+ procedure SetText(const Value: String);
+ function Ident: String;
+ procedure SetCommentBlock1(const Value: String);
+ procedure SetCommentBlock2(const Value: String);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Clear;
+ procedure ConstructCharset(const s: String);
+
+ { skip all #0..#31 symbols }
+ procedure SkipSpaces;
+ { get EOL symbol }
+ function GetEOL: Boolean;
+ { get any valid ident except keyword }
+ function GetIdent: String;
+ { get any valid punctuation symbol like ,.;: }
+ function GetChar: String;
+ { get any valid ident or keyword }
+ function GetWord: String;
+ { get valid hex/int/float number }
+ function GetNumber: String;
+ { get valid quoted/control string like 'It''s'#13#10'working' }
+ function GetString: String;
+ { get FR-specific string - variable or db field like [main data."field 1"] }
+ function GetFRString: String;
+ { get Y:X position }
+ function GetXYPosition: String;
+ { get plain position from X:Y }
+ function GetPlainPosition(pt: TPoint): Integer;
+ { is this keyword? }
+ function IsKeyWord(const s: String): Boolean;
+
+ // Language-dependent elements
+ // For Pascal:
+ // CommentLine1 := '//';
+ // CommentBlock1 := '{,}';
+ // CommentBlock2 := '(*,*)';
+ // HexSequence := '$'
+ // IdentifierCharset := ['_', '0'..'9', 'a'..'z', 'A'..'Z'];
+ // Keywords: 'begin','end', ...
+ // StringQuotes := ''''
+ property CaseSensitive: Boolean read FCaseSensitive write FCaseSensitive;
+ property CommentBlock1: String read FCommentBlock1 write SetCommentBlock1;
+ property CommentBlock2: String read FCommentBlock2 write SetCommentBlock2;
+ property CommentLine1: String read FCommentLine1 write FCommentLine1;
+ property CommentLine2: String read FCommentLine2 write FCommentLine2;
+ property HexSequence: String read FHexSequence write FHexSequence;
+ property IdentifierCharset: TfsIdentifierCharset read FIdentifierCharset
+ write FIdentifierCharset;
+ property Keywords: TStrings read FKeywords;
+ property SkiPChar: String read FSkiPChar write FSkiPChar;
+ property SkipEOL: Boolean read FSkipEOL write FSkipEOL;
+ property SkipSpace: Boolean read FSkipSpace write FSkipSpace;
+ property StringQuotes: String read FStringQuotes write FStringQuotes;
+ property SpecStrChar: Boolean read FSpecStrChar write FSpecStrChar;
+ property UseY: Boolean read FUseY write FUseY;
+
+ { Current position }
+ property Position: Integer read FPosition write SetPosition;
+ { Text to parse }
+ property Text: String read FText write SetText;
+ end;
+
+
+implementation
+
+
+{ TfsParser }
+
+constructor TfsParser.Create;
+begin
+ FKeywords := TStringList.Create;
+ TStringList(FKeywords).Sorted := True;
+ FYList := TList.Create;
+ FUseY := True;
+ Clear;
+end;
+
+destructor TfsParser.Destroy;
+begin
+ FKeywords.Free;
+ FYList.Free;
+ inherited;
+end;
+
+procedure TfsParser.Clear;
+begin
+ FKeywords.Clear;
+ FSpecStrChar := False;
+ FCommentLine1 := '//';
+ CommentBlock1 := '{,}';
+ CommentBlock2 := '(*,*)';
+ FHexSequence := '$';
+ FIdentifierCharset := ['_', '0'..'9', 'a'..'z', 'A'..'Z'];
+ FSkipChar := '';
+ FSkipEOL := True;
+ FStringQuotes := '''';
+ FSkipSpace := True;
+end;
+
+procedure TfsParser.SetCommentBlock1(const Value: String);
+var
+ sl: TStringList;
+begin
+ FCommentBlock1 := Value;
+ FCommentBlock11 := '';
+ FCommentBlock12 := '';
+
+ sl := TStringList.Create;
+ sl.CommaText := FCommentBlock1;
+ if sl.Count > 0 then
+ FCommentBlock11 := sl[0];
+ if sl.Count > 1 then
+ FCommentBlock12 := sl[1];
+ sl.Free;
+end;
+
+procedure TfsParser.SetCommentBlock2(const Value: String);
+var
+ sl: TStringList;
+begin
+ FCommentBlock2 := Value;
+ FCommentBlock21 := '';
+ FCommentBlock22 := '';
+
+ sl := TStringList.Create;
+ sl.CommaText := FCommentBlock2;
+ if sl.Count > 0 then
+ FCommentBlock21 := sl[0];
+ if sl.Count > 1 then
+ FCommentBlock22 := sl[1];
+ sl.Free;
+end;
+
+procedure TfsParser.SetPosition(const Value: Integer);
+begin
+ FPosition := Value;
+ FLastPosition := Value;
+end;
+
+procedure TfsParser.SetText(const Value: String);
+var
+ i: Integer;
+begin
+ FText := Value + #0;
+ FLastPosition := 1;
+ FPosition := 1;
+ FSize := Length(Value);
+
+ if FUseY then
+ begin
+ FYList.Clear;
+ FYList.Add(TObject(0));
+ for i := 1 to FSize do
+ if FText[i] = #10 then
+ FYList.Add(TObject(i));
+ end;
+end;
+
+procedure TfsParser.ConstructCharset(const s: String);
+var
+ i: Integer;
+begin
+ FIdentifierCharset := [];
+ for i := 1 to Length(s) do
+ FIdentifierCharset := FIdentifierCharset + [s[i]];
+end;
+
+function TfsParser.GetEOL: Boolean;
+begin
+ SkipSpaces;
+{$IFDEF Delphi12}
+ if CharInSet(FText[FPosition], [#10, #13]) then
+{$ELSE}
+ if FText[FPosition] in [#10, #13] then
+{$ENDIF}
+ begin
+ Result := True;
+{$IFDEF Delphi12}
+ while CharInSet(FText[FPosition], [#10, #13]) do
+{$ELSE}
+ while FText[FPosition] in [#10, #13] do
+{$ENDIF}
+ Inc(FPosition);
+ end
+ else
+ Result := False;
+end;
+
+procedure TfsParser.SkipSpaces;
+var
+ s1, s2: String;
+ Flag, CLine: Boolean;
+ Spaces: set of AnsiChar;
+begin
+ Spaces := [#0..#32];
+ if not FSkipEOL then
+{$IFDEF Windows}
+ Spaces := Spaces - [#13];
+{$ELSE}
+ Spaces := Spaces - [#10];
+{$ENDIF}
+{$IFDEF Delphi12}
+ while (FPosition <= FSize) and (CharInSet(FText[FPosition], Spaces)) do
+{$ELSE}
+ while (FPosition <= FSize) and (FText[FPosition] in Spaces) do
+{$ENDIF}
+ Inc(FPosition);
+ { skip basic '_' }
+ if (FPosition <= FSize) and (FSkipChar <> '') and (FText[FPosition] = FSkipChar[1]) then
+ begin
+ Inc(FPosition);
+ GetEOL;
+ SkipSpaces;
+ end;
+
+ if FPosition < FSize then
+ begin
+ if FCommentLine1 <> '' then
+ s1 := Copy(FText, FPosition, Length(FCommentLine1)) else
+ s1 := ' ';
+ if FCommentLine2 <> '' then
+ s2 := Copy(FText, FPosition, Length(FCommentLine2)) else
+ s2 := ' ';
+
+ if (s1 = FCommentLine1) or (s2 = FCommentLine2) then
+ begin
+ CLine := (FPosition - 1 > 0) and (FText[FPosition - 1] <> #10) and not FSkipEOL;
+ while (FPosition <= FSize) and (FText[FPosition] <> #10) do
+ begin
+ if (FText[FPosition] = {$IFDEF LINUX}#10{$ELSE}#13{$ENDIF}) and CLine then break;
+ Inc(FPosition);
+ end;
+ SkipSpaces;
+ end
+ else
+ begin
+ Flag := False;
+
+ if FCommentBlock1 <> '' then
+ begin
+ s1 := Copy(FText, FPosition, Length(FCommentBlock11));
+ if s1 = FCommentBlock11 then
+ begin
+ Flag := True;
+ s2 := FCommentBlock12;
+ end;
+ end;
+
+ if not Flag and (FCommentBlock2 <> '') then
+ begin
+ s1 := Copy(FText, FPosition, Length(FCommentBlock21));
+ if s1 = FCommentBlock21 then
+ begin
+ Flag := True;
+ s2 := FCommentBlock22;
+ end;
+ end;
+
+ if Flag then
+ begin
+ Inc(FPosition, Length(s2));
+ while (FPosition <= FSize) and (Copy(FText, FPosition, Length(s2)) <> s2) do
+ Inc(FPosition);
+ Inc(FPosition, Length(s2));
+ SkipSpaces;
+ end;
+ end;
+ end;
+
+ FLastPosition := FPosition;
+end;
+
+function TfsParser.Ident: String;
+begin
+ if FSkipSpace then
+ SkipSpaces;
+{$IFDEF Delphi12}
+ if (CharInSet(FText[FPosition], FIdentifierCharset - ['0'..'9']))
+ or ((FText[FPosition] >= Char($007F)) and (FText[FPosition] <= Char($FFFF))) then
+ begin
+ while CharInSet(FText[FPosition], FIdentifierCharset)
+ or ((FText[FPosition] >= Char($007F)) and (FText[FPosition] <= Char($FFFF))) do
+{$ELSE}
+ if (FText[FPosition] in FIdentifierCharset) and not (FText[FPosition] in ['0'..'9']) then
+ begin
+ while (FText[FPosition] in FIdentifierCharset) do
+{$ENDIF}
+ Inc(FPosition);
+ Result := Copy(FText, FLastPosition, FPosition - FLastPosition);
+ end
+ else
+ Result := '';
+end;
+
+function TfsParser.IsKeyWord(const s: String): Boolean;
+var
+ i: Integer;
+begin
+ if FCaseSensitive then
+ begin
+ Result := False;
+ for i := 0 to FKeywords.Count - 1 do
+ begin
+ Result := FKeywords[i] = s;
+ if Result then break;
+ end;
+ end
+ else
+ Result := FKeywords.IndexOf(s) <> -1;
+end;
+
+function TfsParser.GetIdent: String;
+begin
+ Result := Ident;
+ if IsKeyWord(Result) then
+ Result := '';
+end;
+
+function TfsParser.GetWord: String;
+begin
+ Result := Ident;
+end;
+
+function TfsParser.GetChar: String;
+begin
+{$IFDEF Delphi12}
+ if CharInSet(FText[FPosition], ['!', '@', '#', '$', '%', '^', '&', '|', '\',
+ '.', ',', ':', ';', '?', '''', '"', '~', '`', '_', '[', ']', '{', '}',
+ '(', ')', '+', '-', '*', '/', '=', '<', '>']) then
+{$ELSE}
+ if FText[FPosition] in ['!', '@', '#', '$', '%', '^', '&', '|', '\',
+ '.', ',', ':', ';', '?', '''', '"', '~', '`', '_', '[', ']', '{', '}',
+ '(', ')', '+', '-', '*', '/', '=', '<', '>'] then
+{$ENDIF}
+ begin
+ Result := FText[FPosition];
+ Inc(FPosition);
+ end
+ else
+ Result := '';
+end;
+
+function TfsParser.GetString: String;
+var
+ Flag: Boolean;
+ Str: String;
+ FError: Boolean;
+ FCpp: Boolean;
+
+ function DoQuotedString: Boolean;
+ var
+ i, j: Integer;
+ begin
+ Result := False;
+ i := FPosition;
+
+ if FText[FPosition] = FStringQuotes[1] then
+ begin
+ repeat
+ Inc(FPosition);
+
+ if FCpp and (FText[FPosition] = '\') then
+ begin
+ {$IFNDEF FPC}
+ {$IFDEF Delphi12}
+ case Lowercase(Char(FText[FPosition + 1]))[1] of
+ {$ELSE}
+ case Lowercase(FText[FPosition + 1])[1] of
+ {$ENDIF}
+ {$ELSE}
+ case Lowercase(FText[FPosition + 1]) of
+ {$ENDIF}
+ 'n':
+ begin
+ Str := Str + #10;
+ Inc(FPosition);
+ end;
+ 'r':
+ begin
+ Str := Str + #13;
+ Inc(FPosition);
+ end;
+ 'x':
+ begin
+ Inc(FPosition, 2);
+ j := FPosition;
+ Result := DoHexDigitSequence;
+ if Result then
+ Str := Str + Chr(StrToInt('$' + Copy(FText, j, FPosition - j))) else
+ FPosition := j;
+ Dec(FPosition);
+ end
+ else
+ begin
+ Str := Str + FText[FPosition + 1];
+ Inc(FPosition);
+ end;
+ end;
+ end
+ else if FText[FPosition] = FStringQuotes[1] then
+ begin
+ if not FCpp and (FText[FPosition + 1] = FStringQuotes[1]) then
+ begin
+ Str := Str + FStringQuotes[1];
+ Inc(FPosition);
+ end
+ else
+ break
+ end
+ else
+ Str := Str + FText[FPosition];
+{$IFDEF Delphi12}
+ until CharInSet(FText[FPosition], [#0..#31] - [#9]);
+{$ELSE}
+ until FText[FPosition] in [#0..#31] - [#9];
+{$ENDIF}
+ if FText[FPosition] = FStringQuotes[1] then
+ begin
+ Inc(FPosition);
+ Result := True;
+ end
+ else
+ FPosition := i;
+ end;
+ end;
+
+ function DoControlString: Boolean;
+ var
+ i: Integer;
+ begin
+ Result := False;
+ i := FPosition;
+
+ if FText[FPosition] = '#' then
+ begin
+ Inc(FPosition);
+ Result := DoUnsignedInteger;
+ if Result then
+ Str := Chr(StrToInt(Copy(FText, i + 1, FPosition - i - 1))) else
+ FPosition := i;
+ end;
+ end;
+{$HINTS OFF}
+begin
+ Result := '';
+ if FSkipSpace then
+ SkipSpaces;
+ Flag := True;
+ FError := False;
+ FCpp := {FStringQuotes = '"'} FSpecStrChar;
+
+ repeat
+ Str := '';
+ if DoQuotedString or DoControlString then
+ Result := Result + Str
+ else
+ begin
+ FError := Flag;
+ break;
+ end;
+
+ Flag := False;
+ until False;
+
+ if not FError then
+ Result := '''' + Result + '''';
+end;
+{$HINTS ON}
+function TfsParser.DoDigitSequence: Boolean;
+begin
+ Result := False;
+
+{$IFDEF Delphi12}
+ if CharInSet(FText[FPosition], ['0'..'9']) then
+ begin
+ while CharInSet(FText[FPosition], ['0'..'9']) do
+{$ELSE}
+ if FText[FPosition] in ['0'..'9'] then
+ begin
+ while FText[FPosition] in ['0'..'9'] do
+{$ENDIF}
+ Inc(FPosition);
+ Result := True;
+ end;
+end;
+
+function TfsParser.DoHexDigitSequence: Boolean;
+begin
+ Result := False;
+
+{$IFDEF Delphi12}
+ if CharInSet(FText[FPosition], ['0'..'9', 'a'..'f', 'A'..'F']) then
+ begin
+ while CharInSet(FText[FPosition], ['0'..'9', 'a'..'f', 'A'..'F']) do
+{$ELSE}
+ if FText[FPosition] in ['0'..'9', 'a'..'f', 'A'..'F'] then
+ begin
+ while FText[FPosition] in ['0'..'9', 'a'..'f', 'A'..'F'] do
+{$ENDIF}
+ Inc(FPosition);
+ Result := True;
+ end;
+end;
+
+function TfsParser.DoUnsignedInteger: Boolean;
+var
+ Pos1: Integer;
+ s: String;
+begin
+ Pos1 := FPosition;
+
+ s := Copy(FText, FPosition, Length(FHexSequence));
+ if s = FHexSequence then
+ begin
+ Inc(FPosition, Length(s));
+ Result := DoHexDigitSequence;
+ end
+ else
+ Result := DoDigitSequence;
+
+ if not Result then
+ FPosition := Pos1;
+end;
+
+function TfsParser.DoUnsignedReal: Boolean;
+var
+ Pos1, Pos2: Integer;
+begin
+ Pos1 := FPosition;
+ Result := DoUnsignedInteger;
+
+ if Result then
+ begin
+ if FText[FPosition] = '.' then
+ begin
+ Inc(FPosition);
+ Result := DoDigitSequence;
+ end;
+
+ if Result then
+ begin
+ Pos2 := FPosition;
+ if not DoScaleFactor then
+ FPosition := Pos2;
+ end;
+ end;
+
+ if not Result then
+ FPosition := Pos1;
+end;
+
+function TfsParser.DoScaleFactor: Boolean;
+begin
+ Result := False;
+{$IFDEF Delphi12}
+ if CharInSet(FText[FPosition], ['e', 'E']) then
+{$ELSE}
+ if FText[FPosition] in ['e', 'E'] then
+{$ENDIF}
+ begin
+ Inc(FPosition);
+{$IFDEF Delphi12}
+ if CharInSet(FText[FPosition], ['+', '-']) then
+{$ELSE}
+ if FText[FPosition] in ['+', '-'] then
+{$ENDIF}
+ Inc(FPosition);
+ Result := DoDigitSequence;
+ end;
+end;
+
+function TfsParser.GetNumber: String;
+var
+ Pos1: Integer;
+begin
+ Result := '';
+ if FSkipSpace then
+ SkipSpaces;
+ Pos1 := FPosition;
+
+ if DoUnsignedReal or DoUnsignedInteger then
+ Result := Copy(FText, FLastPosition, FPosition - FLastPosition) else
+ FPosition := Pos1;
+
+ if FHexSequence <> '$' then
+ while Pos(FHexSequence, Result) <> 0 do
+ begin
+ Pos1 := Pos(FHexSequence, Result);
+ Delete(Result, Pos1, Length(FHexSequence));
+ Insert('$', Result, Pos1);
+ end;
+end;
+
+function TfsParser.GetFRString: String;
+var
+ i, c: Integer;
+ fl1, fl2: Boolean;
+begin
+ Result := '';
+ i := FPosition;
+ fl1 := True;
+ fl2 := True;
+ c := 1;
+
+ Dec(FPosition);
+ repeat
+ Inc(FPosition);
+{ if FText[FPosition] in [#10, #13] then
+ begin
+ FPosition := i;
+ break;
+ end;}
+ if fl1 and fl2 then
+{$IFDEF Delphi12}
+ if CharInSet(FText[FPosition], ['<', '[']) then
+{$ELSE}
+ if FText[FPosition] in ['<', '['] then
+{$ENDIF}
+ Inc(c)
+{$IFDEF Delphi12}
+ else if CharInSet(FText[FPosition], ['>', ']']) then
+{$ELSE}
+ else if FText[FPosition] in ['>', ']'] then
+{$ENDIF}
+ Dec(c);
+ if fl1 then
+ if FText[FPosition] = '"' then
+ fl2 := not fl2;
+ if fl2 then
+ if FText[FPosition] = '''' then
+ fl1 := not fl1;
+ until (c = 0) or (FPosition >= Length(FText));
+
+ Result := Copy(FText, i, FPosition - i);
+end;
+
+function TfsParser.GetXYPosition: String;
+var
+ i, i0, i1, c, pos, X, Y: Integer;
+begin
+ i0 := 0;
+ i1 := FYList.Count - 1;
+
+ while i0 <= i1 do
+ begin
+ i := (i0 + i1) div 2;
+ pos := Integer(FYList[i]);
+
+ if pos = FPosition then
+ c := 0
+ else if pos > FPosition then
+ c := 1
+ else
+ c := -1;
+
+ if c < 0 then
+ i0 := i + 1
+ else
+ begin
+ i1 := i - 1;
+ if c = 0 then
+ i0 := i;
+ end;
+ end;
+
+ X := 1;
+ Y := i0;
+ i := Integer(FYList[i0 - 1]) + 1;
+
+ while i < FPosition do
+ begin
+ Inc(i);
+ Inc(X);
+ end;
+ Result := IntToStr(Y) + ':' + IntToStr(X)
+end;
+
+function TfsParser.GetPlainPosition(pt: TPoint): Integer;
+var
+ i: Integer;
+begin
+ Result := -1;
+ i := pt.Y - 1;
+ if (i >= 0) and (i < FYList.Count) then
+ Result := Integer(FYList[i]) + pt.X;
+end;
+
+end.
\ No newline at end of file
diff --git a/LibD28/fs_ipascal.pas b/LibD28/fs_ipascal.pas
new file mode 100644
index 0000000..0c14a1a
--- /dev/null
+++ b/LibD28/fs_ipascal.pas
@@ -0,0 +1,201 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Pascal grammar }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+{$IFNDEF FMX}
+unit fs_ipascal;
+{$ENDIF}
+
+interface
+
+{$i fs.inc}
+
+uses
+{$IFNDEF FMX}
+ SysUtils, Classes, fs_itools{$IFDEF DELPHI16}, Controls{$ENDIF};
+{$ELSE}
+ System.SysUtils, System.Classes, FMX.fs_itools, FMX.Types;
+{$ENDIF}
+
+type
+{$i frxPlatformsAttribute.inc}
+ TfsPascal = class(TComponent);
+
+procedure fsModifyPascalForFR2;
+
+implementation
+
+const
+ PASCAL_GRAMMAR =
+ '<' +
+ 'except/>' +
+ '' +
+ '' +
+ '' +
+ '<' +
+ 'string add="file" err="err1"/>' +
+ '<' +
+ 'sequence><' +
+ 'char text="="/><' +
+ 'sequence><' +
+ '/sequence><' +
+ 'optionalloop text=",">' +
+ '<' +
+ 'expression err="err2"/><' +
+ '/casestmt>' +
+ '' +
+ '<' +
+ '/sequence><' +
+ 'procedureheading>' +
+ '' +
+ '<' +
+ 'keyword text="CONST"/>';
+
+
+procedure fsModifyPascalForFR2;
+var
+ i: Integer;
+ s, s1: String;
+begin
+ s := PASCAL_GRAMMAR;
+ s1 := '';
+ i := Pos(s1, s);
+ if i <> 0 then
+ begin
+ Delete(s, i, Length(s1));
+ s1 := '' +
+ '';
+ Insert(s1, s, i);
+ end;
+
+ i := Pos(' 0 then
+ begin
+ s1 := '';
+ Insert(s1, s, i);
+ end;
+
+ fsRegisterLanguage('PascalScript', s);
+end;
+
+
+initialization
+{$IFDEF DELPHI16}
+{$IFDEF FMX}
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfsPascal, TFmxObject);
+{$ELSE}
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsPascal, TControl);
+{$ENDIF}
+{$ENDIF}
+ fsRegisterLanguage('PascalScript', PASCAL_GRAMMAR);
+
+end.
diff --git a/LibD28/fs_ireg.dcr b/LibD28/fs_ireg.dcr
new file mode 100644
index 0000000..4fa33bf
Binary files /dev/null and b/LibD28/fs_ireg.dcr differ
diff --git a/LibD28/fs_ireg.lrs b/LibD28/fs_ireg.lrs
new file mode 100644
index 0000000..ddce913
--- /dev/null
+++ b/LibD28/fs_ireg.lrs
@@ -0,0 +1,1741 @@
+LazarusResources.Add('TFSADORTTI','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#196#14#0#0#196#14#0#0#0#0#0#0#0#0#0#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#128#128
+ +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
+ +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
+ +#128#128#128#128#128#128#128#128#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#207#156#156#207#156#156#207#156#156
+ +#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207
+ +#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156
+ +#156#128#128#128#192#192#192#176#191#202#139#192#234'p'#173#224'_'#154#219'S'
+ +#142#214'N'#136#210#207#156#156#248#237#213#245#233#209#243#230#204#241#226
+ +#198#238#222#193#235#218#187#233#215#182#230#211#175#227#207#169#225#203#164
+ +#222#199#158#219#195#154#217#191#149#215#188#143#207#156#156#128#128#128#192
+ +#192#192#159#206#244't'#174#236'S'#140#229'@v'#224'5i'#219'1d'#214#209#158
+ +#158#249#238#217#247#235#212#244#232#207#242#229#202#239#225#196#237#221#191
+ +#234#217#185#231#213#179#228#210#174#226#205#168#223#201#162#221#198#157#218
+ +#194#151#215#190#147#207#156#156#128#128#128#192#192#192#133#195#246'['#149
+ +#241''#253#0'1'#248#0'0'#243#240#188
+ +#189#255#247#228#4#4#4#4#4#4#249#240#218#248#236#214#4#4#4#4#4#4#4#4#4#237
+ +#223#193#235#218#187#232#214#181#4#4#4#4#4#4#224#202#164#207#156#156#128#128
+ +#128#192#192#192#130#183#255'U'#136#255'.`'#255#16'C'#255#0'3'#253#0'1'#248
+ +#245#192#192#255#247#229#254#246#227#253#243#224#251#241#221#249#238#217#247
+ +#235#212#245#232#208#242#228#202#240#225#197#237#221#191#234#217#185#232#213
+ +#179#228#210#173#226#205#167#207#156#156#128#128#128#192#192#192#135#186#255
+ +'['#140#255'6f'#255#25'J'#255#6'8'#255#0'3'#253#245#193#193#255#247#229#255
+ +#247#229#254#245#226#252#243#223#251#240#219#249#237#215#247#235#211#244#231
+ +#205#242#228#200#239#224#195#236#220#189#233#216#183#231#211#177#228#207#172
+ +#207#156#156#128#128#128#192#192#192#139#188#255'a'#145#255'>l'#255'"Q'#255
+ +#15'?'#255#6'7'#255#245#193#193#245#193#193#245#193#193#245#193#193#243#191
+ +#191#240#188#188#236#185#185#232#181#181#229#178#178#225#174#173#221#170#170
+ +#217#166#165#213#162#162#210#159#159#207#156#156#207#156#156#192#192#192#192
+ +#192#192#143#190#255'f'#148#255'Eq'#255'*W'#255#24'F'#255#15'?'#255#5'7'#255
+ +#0'2'#253#0'1'#247#0'0'#241#9'9'#235#28'L'#228'5i'#222'S'#141#216#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#147#188#255'l'#144#255'Lm'#255'1K'#255' <'
+ +#255'"]'#255'6'#141#255'-'#136#255#12'L'#252#0#31#246#10'&'#239#29'C'#233'7c'
+ +#226'V'#140#221#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#160#207#255'~'
+ +#179#255'c'#159#255'N'#138#255'@'#129#255'C'#152#255'P'#188#255'I'#186#255'+'
+ +#139#255#28'g'#250'"i'#244'1y'#237'H'#137#231'd'#163#225#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#175#227#255#146#208#254'y'#191#250'd'#174#248'X'#164
+ +#245'Q'#161#245'L'#159#244'D'#155#243'9'#148#243'1'#143#244'8'#148#240'G'#160
+ +#236'\'#174#234'v'#189#229#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#178
+ +#227#253#147#200#245'v'#168#232'a'#145#223'R'#129#218'Ht'#216';d'#212'3]'#210
+ +'0b'#209'*d'#209'-m'#213'@'#132#217']'#165#226'|'#193#231#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#171#209#242#139#174#231'p'#141#219'[w'#212'Nk'#209
+ +'Gg'#208'?b'#207'7\'#205'/R'#202'%I'#199'#K'#198'5_'#202'Q'#131#211'u'#173
+ +#221#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#171#203#237#144#177#229'|'
+ ,#165#229'm'#157#231'a'#152#233']'#154#237'W'#153#239'P'#149#238'F'#140#234'>'
+ +#131#229'<~'#224'D'#219'Y'#138#214'w'#168#217#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#189#228#250#167#214#250#148#209#252#132#200#253'x'#191#252
+ +'r'#189#253'm'#187#253'g'#184#253'_'#181#252'['#178#252']'#183#252'f'#191#251
+ +'y'#194#247#149#208#241#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#214#242
+ +#254#178#220#255#149#195#255#132#181#255'v'#170#255'o'#165#255'i'#160#255'd'
+ +#156#255']'#153#255'Z'#152#255']'#156#255'i'#170#255#143#204#255#193#235#254
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#194#208#213#197#230#255#162#195
+ +#255#146#178#255#133#168#255''#161#255'y'#158#255't'#155#255'o'#150#255'l'
+ +#151#255'q'#156#255''#173#255#170#219#255#185#203#211#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#193#198#199#201#232#255#183#220#255#174#211#255#164
+ +#202#255#158#197#255#154#195#255#150#192#255#148#191#255#147#193#255#152#200
+ +#255#157#207#255#178#223#255#190#196#199#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+]);
+LazarusResources.Add('TFSBASIC','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#196#14#0#0#196#14#0#0#0#0#0#0#0#0#0#0#200#208#212#200#208#212#200
+ +#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#128#128
+ +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
+ +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
+ +#128#128#128#128#128#128#128#128#200#208#212#200#208#212#200#208#212#200#208
+ +#212#200#208#212#200#208#212#200#208#212#207#156#156#207#156#156#207#156#156
+ +#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207
+ +#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156
+ +#156#128#128#128#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212
+ +#200#208#212#200#208#212#207#156#156#248#236#213#248#236#213#243#230#204#239
+ +#224#196#239#224#196#234#217#185#233#215#182#231#212#178#226#204#167#226#204
+ +#167#222#200#159#218#193#151#218#193#151#212#185#140#207#156#156#128#128#128
+ +#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200
+ +#208#212#207#156#156#248#236#213#248#236#213#243#230#204#243#230#204#239#224
+ +#196#236#220#189#234#217#185#231#212#178#228#209#173#226#204#167#222#200#159
+ +#222#200#159#218#193#151#218#193#151#207#156#156#128#128#128#200#208#212#200
+ +#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#212#161
+ +#161#255#246#228#248#236#213#248#236#213#0#0#0#0#0#0#236#220#189#236#220#189
+ +#0#0#0#0#0#0#0#0#0#226#204#167#222#200#159#222#200#159#218#193#151#207#156
+ +#156#128#128#128#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212
+ +#200#208#212#200#208#212#220#170#170#255#246#228#252#242#221#248#236#213#0#0
+ +#0#0#0#0#236#220#189#236#220#189#0#0#0#231#212#178#228#209#173#0#0#0#226#204
+ +#167#222#200#159#222#200#159#207#156#156#128#128#128#200#208#212#200#208#212
+ +#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#232#181#181#255
+ +#246#228#252#242#221#0#0#0#248#236#213#243#230#204#0#0#0#234#217#185#0#0#0#0
+ +#0#0#0#0#0#234#217#185#226#204#167#222#200#159#222#200#159#207#156#156#128
+ +#128#128#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208
+ +#212#200#208#212#232#181#181#255#246#228#252#242#221#0#0#0#252#242#221#248
+ +#236#213#0#0#0#243#230#204#0#0#0#234#217#185#234#217#185#0#0#0#228#209#173
+ +#226#204#167#226#204#167#207#156#156#128#128#128#200#208#212#200#208#212#200
+ +#208#212#200#208#212#200#208#212#200#208#212#200#208#212#244#192#192#255#246
+ +#228#255#246#228#0#0#0#248#236#213#248#236#213#0#0#0#248#236#213#0#0#0#0#0#0
+ +#0#0#0#239#224#196#234#217#185#234#217#185#226#204#167#207#156#156#128#128
+ +#128#200#208#212#200#208#212#232#181#181#157'hk'#137'ZS'#226#196#197#200#208
+ +#212#244#192#192#255#246#228#255#246#228#252#242#221#252#242#221#248#236#213
+ +#248#236#213#252#242#221#248#236#213#239#224#196#236#220#189#234#217#185#231
+ +#212#178#228#209#173#226#204#167#207#156#156#128#128#128#200#208#212#200#208
+ +#212'W'#211#250#23#221#213'_'#253#0'1'#248#0'0'#243#240#188#189#255#247#228#138#30#25#138#30#25#138#30
+ +#25#248#236#214#245#233#209#138#30#25#138#30#25#138#30#25#235#218#187#232#214
+ +#181#138#30#25#138#30#25#138#30#25#207#156#156#128#128#128#192#192#192#130
+ +#183#255'U'#136#255'.`'#255#16'C'#255#0'3'#253#0'1'#248#245#192#192#255#247
+ +#229#254#246#227#253#243#224#251#241#221#249#238#217#247#235#212#245#232#208
+ +#242#228#202#240#225#197#237#221#191#234#217#185#232#213#179#228#210#173#226
+ +#205#167#207#156#156#128#128#128#192#192#192#135#186#255'['#140#255'6f'#255
+ +#25'J'#255#6'8'#255#0'3'#253#245#193#193#255#247#229#255#247#229#254#245#226
+ +#252#243#223#251#240#219#249#237#215#247#235#211#244#231#205#242#228#200#239
+ +#224#195#236#220#189#233#216#183#231#211#177#228#207#172#207#156#156#128#128
+ +#128#192#192#192#139#188#255'a'#145#255'>l'#255'"Q'#255#15'?'#255#6'7'#255
+ +#245#193#193#245#193#193#245#193#193#245#193#193#243#191#191#240#188#188#236
+ +#185#185#232#181#181#229#178#178#225#174#173#221#170#170#217#166#165#213#162
+ +#162#210#159#159#207#156#156#207#156#156#192#192#192#192#192#192#143#190#255
+ +'f'#148#255'Eq'#255'*W'#255#24'F'#255#15'?'#255#5'7'#255#0'2'#253#0'1'#247#0
+ +'0'#241#9'9'#235#28'L'#228'5i'#222'S'#141#216#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#147#188#255'l'#144#255'Lm'#255'1K'#255' <'#255'"]'#255'6'#141
+ +#255'-'#136#255#12'L'#252#0#31#246#10'&'#239#29'C'#233'7c'#226'V'#140#221#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#160#207#255'~'#179#255'c'#159#255'N'
+ +#138#255'@'#129#255'C'#152#255'P'#188#255'I'#186#255'+'#139#255#28'g'#250'"i'
+ +#244'1y'#237'H'#137#231'd'#163#225#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#175#227#255#146#208#254'y'#191#250'd'#174#248'X'#164#245'Q'#161#245'L'
+ +#159#244'D'#155#243'9'#148#243'1'#143#244'8'#148#240'G'#160#236'\'#174#234'v'
+ +#189#229#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#178#227#253#147#200#245
+ +'v'#168#232'a'#145#223'R'#129#218'Ht'#216';d'#212'3]'#210'0b'#209'*d'#209'-m'
+ +#213'@'#132#217']'#165#226'|'#193#231#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#171#209#242#139#174#231'p'#141#219'[w'#212'Nk'#209'Gg'#208'?b'#207'7\'
+ +#205'/R'#202'%I'#199'#K'#198'5_'#202'Q'#131#211'u'#173#221#192#192#192#192
+ ,#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#171#203#237#144#177#229'|'#165#229'm'#157#231'a'
+ +#152#233']'#154#237'W'#153#239'P'#149#238'F'#140#234'>'#131#229'<~'#224'D'
+ +#219'Y'#138#214'w'#168#217#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#189
+ +#228#250#167#214#250#148#209#252#132#200#253'x'#191#252'r'#189#253'm'#187#253
+ +'g'#184#253'_'#181#252'['#178#252']'#183#252'f'#191#251'y'#194#247#149#208
+ +#241#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#214#242#254#178#220#255#149
+ +#195#255#132#181#255'v'#170#255'o'#165#255'i'#160#255'd'#156#255']'#153#255
+ +'Z'#152#255']'#156#255'i'#170#255#143#204#255#193#235#254#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#194#208#213#197#230#255#162#195#255#146#178#255#133
+ +#168#255''#161#255'y'#158#255't'#155#255'o'#150#255'l'#151#255'q'#156#255''
+ +#173#255#170#219#255#185#203#211#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#193#198#199#201#232#255#183#220#255#174#211#255#164#202#255#158#197#255#154
+ +#195#255#150#192#255#148#191#255#147#193#255#152#200#255#157#207#255#178#223
+ +#255#190#196#199#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192
+]);
+LazarusResources.Add('TFSCHARTRTTI','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#196#14#0#0#196#14#0#0#0#0#0#0#0#0#0#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192'ff'#164'BB'#138'BB'#140'IB'#129#128'BI'#132'BB}BB'#150'ff'#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192''#186'||'#184#1#20#152#0#10#154#0#0#137#10#0'VQ'#0#9'u'#21#0'}"'#0'p'
+ +#23#1#165'||'#165''#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +'PP'#185#0#4#160#0#13#156#0' '#182#0#15#178#0#0#157#10#0'WQ'#0#10#129#30#0
+ +#142'3'#0'~$'#0'g'#14#0'e'#15#0#142'SP'#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#188#188#191'<<'
+ +#171#0#0#200#0#14#238#0'-'#227#0#8#147#0#1'x'#0#1#128#11#1'g]'#1#11'i'#1#0'['
+ +#0#0'e'#9#0#141'2'#0#146'6'#0'p'#23#0'y=<'#189#187#187#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192'/='#178#11#23#235#2#7
+ +#215#0#0#148#0#6#158#0'!'#207#0'('#207#0'!'#200#17'$'#170#142':'#19#162':'#0
+ +#150'8'#0#136'*'#0'c'#6#0'Y'#6#0'x'#29#0#131'+'#7't//'#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#10'$'#168#9#30#192#6'!'
+ +#209#4'-'#199#1#29#206#0'1'#250#0'5'#241#0'.'#231#20'3'#203#164'S'#23#187'T'
+ +#0#174'O'#0#160'A'#0'~'#30#0'y'#31#0'w'#26#0'i'#18#0'X'#0#0#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#14'3'#169#13'7'#176
+ +#11'H'#225#9'U'#255#6'J'#255#4'>'#255#1'5'#255#0'.'#247#20'3'#211#167'T'#24
+ +#191'U'#0#173'M'#0#169'J'#0#168'J'#0#169'K'#0#135')'#0'`'#8#0'\'#6#6#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#18'B'#187#16
+ +'['#242#15'd'#255#13'Y'#255#11'R'#255#9'K'#255#5'C'#255#2'6'#255#21'7'#225
+ +#175'['#26#200'\'#0#182'T'#0#176'O'#0#169'I'#0#162'D'#0#165'H'#0#144'1'#0'g'
+ +#12#6#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#21'k'#247#20'l'#254#19'j'#255#17'd'#255#15'_'#255#13'X'#255#10'P'#255#7'D'
+ +#255#24'B'#229#182'a'#27#209'd'#0#190'['#0#183'U'#0#177'P'#0#170'J'#0#165'G'
+ +#0#159'@'#0#151'<'#6#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#24'y'#255#23'v'#255#23's'#255#21'o'#255#19'j'#255#17'd'#255
+ +#15'^'#255#12'L'#255#26'?'#243#202'['#19#239'Y'#2#219'Q'#0#212'L'#0#204'G'#0
+ +#197'C'#0#190'>'#0#185'<'#0#185'A'#6#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#27''#255#26'~'#255#26'|'#255#24'y'#255#23
+ +'t'#255#21'o'#255#18'\'#255#21'g'#243','#149#190'l'#178#144'|'#177'|t'#169'p'
+ +'q'#161'jm'#152'ei'#142'_f'#133'Zc}V`wR'#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192'B'#154#255'#'#137#255#28#132#255#27#129
+ +#255#26'~'#255#24'u'#255#25'p'#246'-'#158#195'A'#236#131#13#255#237#9#255#255
+ +#5#255#255#1#255#255#0#245#246#0#230#233#0#216#221#7#205#212'/'#205#212#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#188#191
+ +#193'T'#167#255#31#139#255#30#136#255#29#133#255#27'u'#255'2'#176#201'I'#229
+ +#139'C'#217#142'C'#212#130#28#242#217#9#255#255#5#255#255#2#255#255#1#244#245
+ +#1#230#233'='#227#231#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192'f'#179#255' '#139#255#31
+ +#140#253'9'#188#199'H'#220#162'I'#227#149'D'#218#148'E'#214#136'<'#216#143#30
+ +#239#208#8#255#255#5#255#255#1#255#255'Q'#247#248#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#144#198#255#141#197#254'I'#218#174'O'#235#151'G'
+ +#221#160'F'#220#153'D'#218#148'H'#211'}9'#218#148' '#237#201#129#255#254#129
+ ,#255#255#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#188#191#193'd'#218#195'N'#231#158'I'#223#161'G'#221#156'E'#219
+ +#150'B'#217#144'D'#212#128'V'#226#167#188#193#193#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+]);
+LazarusResources.Add('TFSCLASSESRTTI','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#196#14#0#0#196#14#0#0#0#0#0#0#0#0#0#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#206'c'#0#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#206'c'#0#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#206'c'
+ +#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#206'c'#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0
+ +#206'c'#0#214'{!'#255#247#239#255#247#239#255#239#214#255#239#214#255#222#181
+ +#255#214#165#206'c'#0#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#206'c'#0#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#214'{!'#255#255#255
+ +#255#255#255#255#255#255#255#239#214#255#222#181#255#214#165#206'c'#0#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#206'c'#0#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#214'{!'#214'{!'#214'{!'#214'{!'#214'{!'#214'{!'
+ +#214'{!'#206'c'#0#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#206'c'#0#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#206'c'#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#206'c'#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0
+ +#206'c'#0#206'c'#0#206'c'#0#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#206
+ +'c'#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#214'{!O'#235#151'L'#230
+ +#145'D'#213#128'8'#192'i,'#169'Q'#31#148':'#206'c'#0#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#206'c'#0#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#214'{!O'#235#151'O'#235#151'O'#235#151'H'#222#137'='#203'u1'#181
+ +']'#206'c'#0#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#206'c'#0#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#214'{!'#214'{!'#214'{!'#214
+ +'{!'#214'{!'#214'{!'#214'{!'#206'c'#0#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#206'c'#0#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#206'c'#0#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#206'c'#0#206'c'#0#206'c'
+ +#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#206'c'#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#214'{'
+ +'!'#136#187#255'a'#157#255'9'#255#25'f'#255#15'^'#255#15'^'#255#206'c'#0#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#206'c'#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#214'{!'#153#201#255'u'#173#255'L'#142#255
+ +'''q'#255#15'^'#255#15'^'#255#206'c'#0#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#206'c'#0#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ ,#214'{!'#214'{!'#214'{!'#214'{!'#214'{!'#214'{!'#214'{!'#206'c'#0#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#206'c'#0#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#206'c'#0#206'c'#0#206'c'
+ +#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#206'c'#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#214'{!'#255#247#239#255#247#239#255#239#214#255#239#214#255#222
+ +#181#255#214#165#206'c'#0#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#214'{!'#255
+ +#255#255#255#255#255#255#255#255#255#239#214#255#222#181#255#214#165#206'c'#0
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#214'{!'#214'{!'#214'{!'#214'{!'#214
+ +'{!'#214'{!'#214'{!'#206'c'#0#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+]);
+LazarusResources.Add('TFSINIRTTI','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#0#255#0#255#255#0#255#255#0#255#255
+ +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
+ +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
+ +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#188#144#134
+ +#139'A1'#136'?1'#134'=0'#132';/'#130'9/'#128'7.}5.{3-y1-x0-v.,t,,t,,s--u02y5'
+ +'8'#174#135#138#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
+ +#151'P='#242#234#220#239#229#211#236#223#202#233#217#193#229#212#184#226#207
+ +#175#224#202#167#221#198#160#219#194#154#217#191#150#217#191#149#217#191#149
+ +#217#192#150#218#193#153#221#197#159#223#200#164'z8:'#255#0#255#255#0#255#255
+ +#0#255#255#0#255#255#0#255#255#0#255#154'S>'#245#239#228#242#234#220#239#228
+ +#211#236#223#201#233#217#192#229#212#183#226#207#175#223#202#167#221#198#160
+ +#219#194#154#217#191#150#217#191#149#211#184#145#199#172#137#196#169#141#205
+ +#180#152't24'#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#158
+ +'V?'#248#243#236#245#239#228#242#233#219#239#228#210#236#222#201#232#217#192
+ +#229#211#183#219#197#167#202#177#146#193#164#133#192#162#129#190#159'|'#177
+ +#145'q'#152't^'#142'iY'#167#136'x'#133'SS'#255#0#255#255#0#255#255#0#255#255
+ +#0#255#255#0#255#255#0#255#161'YA'#251#247#242#248#243#235#245#238#227#242
+ +#233#219#239#228#210#235#222#200#232#216#191#207#185#159#163#130'n'#139'fT'
+ +#139'dP'#137'cN'#130'YFi'#175#170'6'#173#169'8RS'#136'ba'#176#150#150#160#129
+ +#129#184#161#161#255#0#255#255#0#255#255#0#255#164'\B'#253#251#248#250#247
+ +#242#248#243#235#245#238#227#242#233#218#232#218#200#213#194#175#181#153#136
+ +'_'#219#253#13#219#213'c4Lb'#153#249#192#152#135'i'#175#248'5n'#169'n&'#29'a'
+ +'75Jo'#163','#156#249'RJ\'#255#0#255#255#0#255#255#0#255#167'_C'#254#254#253
+ +#252#251#248#250#247#242#248#243#234#245#238#226#219#203#190#171#143#131#140
+ +'g]^'#220#253#13#220#213'd3K,'#154#248'+'#154#247#139#205#247#213#150#144'$'
+ +#148#143'&'#209#251')'#147#249'+'#155#247'QK\'#168#140#140#255#0#255#255#0
+ +#255#170'cC'#255#255#255#254#254#253#252#251#248#250#247#241#247#242#234#214
+ +#198#189#194'aa|BB|KK'#13#254#254#18#198#203'e7R*'#166#247#139#170#245#170
+ +#178#244';Z'#143';Z'#144#173#230#248#255#230#242#136'M\P'#31#31#176#150#150
+ +#255#0#255#174'eD'#255#255#255#255#255#255#254#253#253#252#250#247#250#246
+ +#241#216#202#194'CI7'#156#252'8'#155#251'w?Nd'#197#252#248#251#250#175#250
+ +#247#0#250#246#128#251#245#150#251#248#13#252#249#14#210#250'K>aKy'#198'M'
+ +#211#254'r1'#131':06.{2-w/,s,,p)+n''*m&*m&*m&*v37'#178#140#142#255#0#255#194
+ +'wH'#251#246#244#189#155#155's,,~=='#243#236#235#159'T7'#255#187'T'#255#187
+ +'T'#255#187'T'#251#182'R'#244#174'O'#237#166'K'#228#156'H'#220#146'D'#213#138
+ +'@'#206#130'='#202'};'#202'};'#202'};'#202'};'#197'x:v37'#255#0#255#196'yI'
+ +#251#247#244#255#255#255#255#255#255#255#255#255#249#245#243#159'T7'#255#187
+ +'T'#155'U7r++r++r++r++r++r++r++r++r++r++w0,'#202'};'#197'x:v37'#255#0#255#198
+ +'zI'#251#247#244#255#255#255#255#255#255#255#255#255#249#245#243#159'T7'#255
+ +#187'T'#254#233#203#254#252#252#254#252#252#254#252#252#254#252#252#254#252
+ +#252#254#252#252#254#252#252#254#252#252#254#252#252#254#252#252#251#245#241
+ ,#202'};'#197'x:v37'#255#0#255#199'|J'#251#247#244#255#255#255#255#255#255#255
+ +#255#255#249#245#243#159'T7'#255#187'T'#255#187'T'#255#187'T'#255#187'T'#255
+ +#187'T'#255#187'T'#251#182'R'#244#174'O'#237#166'K'#228#156'H'#220#146'D'#213
+ +#138'@'#206#130'='#202'};'#197'x:x67'#255#0#255#224#182#153#199'zH'#195's>'
+ +#193'r>'#195'wH'#200#132'Z'#176'lO'#153'N5'#153'N5'#153'N5'#153'N5'#153'N5'
+ +#153'N5'#151'L4'#148'J4'#145'G3'#141'C2'#137'@1'#133'<0'#129'8/}4.'#129'=9'
+ +#182#144#143#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255
+ +#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
+ +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
+ +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
+ +#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0
+ +#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255#255#0#255
+ +#255#0#255#255#0#255#255#0#255#255#0#255
+]);
+LazarusResources.Add('TFSCPP','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#196#14#0#0#196#14#0#0#0#0#0#0#0#0#0#0#200#208#212#200#208#212#200
+ +#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#128#128
+ +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
+ +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
+ +#128#128#128#128#128#128#128#128#200#208#212#200#208#212#200#208#212#200#208
+ +#212#200#208#212#200#208#212#200#208#212#207#156#156#207#156#156#207#156#156
+ +#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207
+ +#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156
+ +#156#128#128#128#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212
+ +#200#208#212#200#208#212#207#156#156#248#236#213#248#236#213#243#230#204#239
+ +#224#196#239#224#196#234#217#185#233#215#182#231#212#178#226#204#167#226#204
+ +#167#222#200#159#218#193#151#218#193#151#212#185#140#207#156#156#128#128#128
+ +#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200
+ +#208#212#207#156#156#248#236#213#248#236#213#243#230#204#243#230#204#239#224
+ +#196#236#220#189#234#217#185#231#212#178#228#209#173#226#204#167#222#200#159
+ +#222#200#159#218#193#151#218#193#151#207#156#156#128#128#128#200#208#212#200
+ +#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#212#161
+ +#161#255#246#228#255#246#228#0#0#0#0#0#0#0#0#0#236#220#189#236#220#189#236
+ +#220#189#231#212#178#228#209#173#226#204#167#222#200#159#222#200#159#218#193
+ +#151#207#156#156#128#128#128#200#208#212#200#208#212#200#208#212#200#208#212
+ +#200#208#212#200#208#212#200#208#212#220#170#170#255#246#228#0#0#0#248#236
+ +#213#248#236#213#243#230#204#239#224#196#0#0#0#236#220#189#231#212#178#228
+ +#209#173#0#0#0#226#204#167#222#200#159#222#200#159#207#156#156#128#128#128
+ +#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200
+ +#208#212#232#181#181#255#246#228#0#0#0#248#236#213#248#236#213#243#230#204#0
+ +#0#0#0#0#0#0#0#0#231#212#178#0#0#0#0#0#0#0#0#0#222#200#159#222#200#159#207
+ +#156#156#128#128#128#200#208#212#200#208#212#200#208#212#200#208#212#200#208
+ +#212#200#208#212#200#208#212#232#181#181#255#246#228#0#0#0#252#242#221#252
+ +#242#221#248#236#213#243#230#204#0#0#0#239#224#196#234#217#185#234#217#185#0
+ +#0#0#228#209#173#226#204#167#226#204#167#207#156#156#128#128#128#200#208#212
+ +#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#244
+ +#192#192#255#246#228#255#246#228#0#0#0#0#0#0#0#0#0#248#236#213#248#236#213
+ +#243#230#204#239#224#196#234#217#185#233#215#182#234#217#185#234#217#185#226
+ +#204#167#207#156#156#128#128#128#200#208#212#200#208#212#232#181#181#157'hk'
+ +#137'ZS'#226#196#197#200#208#212#244#192#192#255#246#228#255#246#228#252#242
+ +#221#252#242#221#248#236#213#248#236#213#252#242#221#248#236#213#239#224#196
+ +#236#220#189#234#217#185#231#212#178#228#209#173#226#204#167#207#156#156#128
+ +#128#128#200#208#212#200#208#212'W'#211#250#23#221#213'_'#253#0'1'#248#0'0'#243#197'u?'#197'u?'#197'u?'#197
+ +'u?'#196's?'#194'o='#192'l<'#190'g:'#187'b9'#185'\8'#182'W6'#179'P4'#176'K2'
+ +#174'D0'#171'?.'#168'9,'#128#128#128#192#192#192#130#183#255'U'#136#255'.`'
+ +#255#16'C'#255#0'3'#253#0'1'#248#197'u?'#255#247#229#254#246#227#253#243#224
+ +#197'u?'#249#238#217#247#235#212#245#232#208#242#228#202#240#225#197#187'`9'
+ +#234#217#185#232#213#179#228#210#173#226#205#167#173'C0'#128#128#128#192#192
+ +#192#135#186#255'['#140#255'6f'#255#25'J'#255#6'8'#255#0'3'#253#197'u?'#255
+ +#247#229#255#247#229#254#245#226#197'u?'#251#240#219#249#237#215#247#235#211
+ +#244#231#205#242#228#200#192'i;'#236#220#189#233#216#183#231#211#177#228#207
+ +#172#177'M2'#128#128#128#192#192#192#139#188#255'a'#145#255'>l'#255'"Q'#255
+ +#15'?'#255#6'7'#255#197'u?'#197'u?'#197'u?'#197'u?'#197'u?'#197'u?'#197'u?'
+ +#197'u?'#197'u?'#196't?'#195'p='#193'l<'#191'h;'#189'c:'#185'^8'#183'W6'#192
+ +#192#192#192#192#192#143#190#255'f'#148#255'Eq'#255'*W'#255#24'F'#255#15'?'
+ +#255#5'7'#255#0'2'#253#0'1'#247#0'0'#241#9'9'#235#28'L'#228'5i'#222'S'#141
+ +#216#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#147#188#255'l'#144#255'Lm'
+ +#255'1K'#255' <'#255'"]'#255'6'#141#255'-'#136#255#12'L'#252#0#31#246#10'&'
+ +#239#29'C'#233'7c'#226'V'#140#221#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#160#207#255'~'#179#255'c'#159#255'N'#138#255'@'#129#255'C'#152#255'P'#188
+ +#255'I'#186#255'+'#139#255#28'g'#250'"i'#244'1y'#237'H'#137#231'd'#163#225
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#175#227#255#146#208#254'y'#191
+ +#250'd'#174#248'X'#164#245'Q'#161#245'L'#159#244'D'#155#243'9'#148#243'1'#143
+ +#244'8'#148#240'G'#160#236'\'#174#234'v'#189#229#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#178#227#253#147#200#245'v'#168#232'a'#145#223'R'#129#218'Ht'
+ +#216';d'#212'3]'#210'0b'#209'*d'#209'-m'#213'@'#132#217']'#165#226'|'#193#231
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#171#209#242#139#174#231'p'#141
+ +#219'[w'#212'Nk'#209'Gg'#208'?b'#207'7\'#205'/R'#202'%I'#199'#K'#198'5_'#202
+ +'Q'#131#211'u'#173#221#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#171#203
+ +#237#144#177#229'|'#165#229'm'#157#231'a'#152#233']'#154#237'W'#153#239'P'
+ +#149#238'F'#140#234'>'#131#229'<~'#224'D'#219'Y'#138#214'w'#168#217#192#192
+ ,#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#189#228#250#167#214#250#148#209#252#132
+ +#200#253'x'#191#252'r'#189#253'm'#187#253'g'#184#253'_'#181#252'['#178#252']'
+ +#183#252'f'#191#251'y'#194#247#149#208#241#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#214#242#254#178#220#255#149#195#255#132#181#255'v'#170#255'o'
+ +#165#255'i'#160#255'd'#156#255']'#153#255'Z'#152#255']'#156#255'i'#170#255
+ +#143#204#255#193#235#254#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#194#208
+ +#213#197#230#255#162#195#255#146#178#255#133#168#255''#161#255'y'#158#255't'
+ +#155#255'o'#150#255'l'#151#255'q'#156#255''#173#255#170#219#255#185#203#211
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#193#198#199#201#232#255#183#220
+ +#255#174#211#255#164#202#255#158#197#255#154#195#255#150#192#255#148#191#255
+ +#147#193#255#152#200#255#157#207#255#178#223#255#190#196#199#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+]);
+LazarusResources.Add('TFSDBRTTI','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#196#14#0#0#196#14#0#0#0#0#0#0#0#0#0#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#176#191#202#139#184#234'p'#173#224'_'#154#219'S'#142#214'N'#136#210'J'#133
+ +#205'H'#130#202'E'#199'E'#196'I'#132#193'Q'#142#192'k'#152#200#165#180#191
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#159#193#243't'#172#236'S'#140
+ +#229'@v'#224'5i'#219'1d'#214'/b'#210'-_'#205'+]'#202'+]'#199'0c'#196':q'#193
+ +'O'#135#193'z'#157#205#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#133#195
+ +#246'['#149#241''#253#0'1'#248#0'0'
+ +#243#0'/'#237#0'.'#232#0','#227#0'+'#222#8'4'#217#24'E'#212'-`'#206'H'#130
+ +#202#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#130#183#255'U'#136#255'.`'
+ +#255#16'C'#255#0'3'#253#0'1'#248#0'0'#243#0'/'#237#0'-'#232#0','#226#8'5'#221
+ +#25'G'#215'/b'#210'J'#133#205#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#135
+ +#186#255'['#140#255'6f'#255#25'J'#255#6'8'#255#0'3'#253#0'0'#248#0'/'#243#0
+ +'/'#237#0'-'#231#9'6'#226#26'H'#219'1d'#214'M'#135#209#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#139#188#255'a'#145#255'>l'#255'"Q'#255#15'?'#255#6
+ +'7'#255#0'0'#253#0'.'#248#0'/'#242#0'.'#236#9'8'#230#27'J'#224'3f'#218'P'#138
+ +#212#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#143#190#255'f'#148#255'Eq'
+ +#255'*W'#255#24'F'#255#15'?'#255#5'7'#255#0'2'#253#0'1'#247#0'0'#241#9'9'#235
+ +#28'L'#228'5i'#222'S'#141#216#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#147
+ +#188#255'l'#144#255'Lm'#255'1K'#255' <'#255'"]'#255'6'#141#255'-'#136#255#12
+ +'L'#252#0#31#246#10'&'#239#29'C'#233'7c'#226'V'#140#221#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#160#207#255'~'#179#255'c'#159#255'N'#138#255'@'#129
+ +#255'C'#152#255'P'#188#255'I'#186#255'+'#139#255#28'g'#250'"i'#244'1y'#237'H'
+ +#137#231'd'#163#225#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#175#227#255
+ +#146#208#254'y'#191#250'd'#174#248'X'#164#245'Q'#161#245'L'#159#244'D'#155
+ +#243'9'#148#243'1'#143#244'8'#148#240'G'#160#236'\'#174#234'v'#189#229#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#178#227#253#147#200#245'v'#168#232
+ +'a'#145#223'R'#129#218'Ht'#216';d'#212'3]'#210'0b'#209'*d'#209'-m'#213'@'#132
+ +#217']'#165#226'|'#193#231#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#171
+ +#209#242#139#174#231'p'#141#219'[w'#212'Nk'#209'Gg'#208'?b'#207'7\'#205'/R'
+ +#202'%I'#199'#K'#198'5_'#202'Q'#131#211'u'#173#221#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ ,#192#192#192#192#192#171#203#237#144#177#229'|'#165#229'm'#157#231'a'#152#233
+ +']'#154#237'W'#153#239'P'#149#238'F'#140#234'>'#131#229'<~'#224'D'#219'Y'
+ +#138#214'w'#168#217#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#189#227#250
+ +#167#214#250#148#209#252#132#200#253'x'#191#252'r'#189#253'm'#187#253'g'#184
+ +#253'_'#181#252'['#178#252']'#183#252'f'#191#251'y'#194#247#149#207#241#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#214#228#254#178#217#255#149#195#255
+ +#132#181#255'v'#170#255'o'#165#255'i'#160#255'd'#156#255']'#153#255'Z'#152
+ +#255']'#156#255'i'#170#255#143#199#255#193#219#253#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#194#208#213#197#222#255#162#195#255#146#178#255#133#168
+ +#255''#161#255'y'#158#255't'#155#255'o'#150#255'l'#151#255'q'#156#255''#173
+ +#255#170#211#255#185#203#211#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#193
+ +#198#199#201#222#255#183#220#255#174#211#255#164#202#255#158#197#255#154#195
+ +#255#150#192#255#148#191#255#147#193#255#152#200#255#157#207#255#178#213#255
+ +#190#196#199#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+]);
+LazarusResources.Add('TFSDIALOGSRTTI','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#196#14#0#0#196#14#0#0#0#0#0#0#0#0#0#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192'h'#170#193'3w'#144'4aoPgpttu'
+ +#141#139#139#159#161#162#177#182#185#191#198#202#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#175#197#206
+ +'N'#180#215'W'#204#250'C'#184#230'1'#159#201'$'#135#171'!r'#142'6fwPahemo'
+ +#128#131#133#157#156#156#178#179#181#187#191#194#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#173#197#206'J'#176#210'~'#218#254'w'#220#255'q'#219#255'n'
+ +#218#255'a'#209#251'K'#192#235'1'#176#220'$'#146#184'*x'#147'2ev=am[kr~}~'
+ +#150#147#147#175#182#185#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#175#197#206'8'#168#205#130#219#250'z'#222
+ +#255'x'#221#254'y'#221#254'z'#222#255'|'#223#255'~'#225#255'y'#224#255'g'#217
+ +#254'R'#207#248'D'#184#222'4'#155#189'!'#128#160'$e|r|'#191#198#202#192#192
+ +#192#202#132'0'#193'r'#25#196'y-'#195'z4'#192'w2'#161#194#207'$'#162#205#140
+ +#224#250#128#228#255'~'#227#254'~'#227#254'~'#227#254'~'#227#254'~'#227#254
+ +''#227#254#129#229#255#133#231#255#132#233#255'{'#231#255's'#229#255'+'#168
+ +#213'Oem'#187#191#193#192#192#192#189'k'#22#199#130'3'#228#192#150#232#204
+ +#173#229#198#166#168#198#210#27#159#205#144#225#247#134#236#255#131#234#254
+ +#131#234#254#131#234#254#131#234#254#131#234#254#131#234#254#131#234#254#131
+ +#234#254#132#234#254#134#235#254#137#235#255'?'#190#238'Gdo'#177#180#182#192
+ +#192#192#181'b'#28#201#141'O'#245#233#220#253#250#246#252#249#244#175#201#211
+ +','#166#211#157#229#248#140#241#255#137#239#254#137#239#254#137#239#254#137
+ +#239#254#137#239#254#137#239#254#137#239#254#137#239#254#137#239#254#138#240
+ +#254#138#238#255'R'#201#242'=kz'#164#167#169#192#192#192#181'c!'#200#139'R'
+ +#247#240#233#255#255#255#255#255#255#165#198#211'%'#167#213#163#232#248#147
+ +#248#255#144#246#254#144#246#254#144#246#254#144#246#254#144#246#254#144#246
+ +#254#144#246#254#144#246#254#144#246#254#145#247#254#141#243#255'h'#214#247
+ +'5r'#132#151#153#155#192#192#192#182'c '#199#137'L'#246#237#227#255#255#255
+ +#253#254#255#164#200#214'+'#172#219#150#222#241#153#254#255#150#252#254#150
+ +#252#254#150#252#254#150#252#254#150#252#254#150#252#254#150#252#254#150#252
+ +#254#150#252#254#151#253#254#144#247#255''#225#252'.}'#150#138#140#142#192
+ +#192#192#182'c '#199#137'M'#246#237#227#255#255#255#253#254#255#173#203#215
+ +'T'#189#229#159#223#241#160#255#255#159#254#254#159#254#254#160#254#254#160
+ +#254#254#160#254#254#160#254#254#160#254#254#160#254#254#160#254#254#161#255
+ +#254#149#247#254#158#239#255'/'#138#167'|'#128#192#192#192#182'c '#199#137
+ +'N'#246#237#227#255#255#255#254#254#255#159#197#211'Y'#191#230#141#211#235
+ +#202#251#254#192#252#254#190#255#255#188#255#255#184#255#255#179#254#254#180
+ +#254#254#180#254#254#180#254#254#180#254#254#182#255#254#167#247#254#167#239
+ +#255'A'#160#189'qrt'#192#192#192#182'c '#199#137'N'#246#237#227#255#255#255
+ +#253#254#255#138#189#209#128#217#244'T'#202#232'Q'#191#224'u'#204#231#139#212
+ +#235#171#224#241#207#246#251#205#255#255#195#254#254#197#254#254#197#254#254
+ +#197#254#254#199#255#254#181#247#254#176#239#255'['#177#203'`lq'#187#193#196
+ +#182'c '#199#137'N'#246#237#227#255#255#255#253#254#255#152#195#213#166#237
+ +#251#151#252#255#143#247#254''#237#248'g'#222#240'N'#206#232'Z'#192#224#218
+ +#243#250#234#255#255#228#255#255#224#255#255#222#255#255#225#255#255#202#248
+ +#255#186#239#255'|'#194#215'Ljt'#179#182#185#182'c '#200#137'N'#247#237#227
+ +#255#255#255#253#254#255#155#197#214#170#239#250#155#255#255#151#254#254#154
+ +#255#255#158#255#255#160#255#255'y'#230#243'['#197#228's'#203#229#134#211#233
+ +#157#221#238#183#230#242#212#239#247#201#236#247#202#241#255#157#212#230'Ct'
+ +#133#179#180#181#182'c '#200#137'N'#247#237#227#255#255#255#253#254#255#155
+ +#195#211#163#222#240#171#255#255#146#255#254#150#255#254#147#254#254#172#255
+ +#255#190#237#248#148#217#233#144#226#243#139#225#241#131#220#239'x'#215#236
+ +'f'#205#230'l'#208#232'_'#183#210'`'#176#204'{'#167#183#197#199#201#181'b '
+ +#199#137'N'#247#237#227#255#255#255#253#254#255#190#203#209#131#194#219#190
+ +#242#250#187#250#254#178#252#254#176#255#255#193#240#248'k'#161#182#147#177
+ +#190#169#201#215#164#201#217#150#199#217#141#201#220#139#209#227'u'#210#234
+ +'['#168#193#153#178#188#199'u'#29#192#192#192#182'c '#200#138'O'#246#237#227
+ +#255#255#255#253#255#255#251#253#255#158#196#209'y'#187#212#130#196#219#146
+ +#204#225#165#214#230#132#191#212#163#181#188#234#247#255#230#246#255#227#245
+ +#255#225#244#255#221#244#255#189#202#209#191#203#210#212#242#243#204#172'y'
+ +#206'}'#30#192#192#192#189'p '#206#148'Z'#248#239#231#255#255#255#255#255#255
+ +#254#255#255#252#255#255#252#255#255#250#255#255#195#205#210#175#198#207#191
+ ,#203#208#239#255#255#237#255#255#233#254#255#230#253#255#227#250#255#223#248
+ +#255#220#248#255#215#252#255#212#249#246#206#180#129#209#130#31#192#192#192
+ +#212#142';'#222#168'l'#251#242#233#255#255#255#255#254#250#254#252#249#251
+ +#251#248#250#251#247#248#250#246#244#249#245#241#248#245#239#248#245#237#247
+ +#246#234#247#246#230#247#247#227#246#248#226#247#253#222#247#255#223#246#246
+ +#233#252#232#232#251#224#215#183'v'#213#135'!'#192#192#192#231#171'Z'#224#165
+ +'X'#210#178#130#206#177#136#205#174#131#205#174#130#203#173#128#202#172''
+ +#201#170''#199#170''#198#170''#197#170''#197#170#129#197#171#130#195#172
+ +#131#195#174#133#195#177#139#195#178#139#195#177#139#192#178#147#191#177#142
+ +#197#152'N'#217#142' '#192#192#192#234#173'X'#219#152'='#189'}'''#178'p'#29
+ +#178'p'#29#180'q'#30#179'q'#29#179'p'#29#178'p'#29#179'o'#28#178'o'#27#177'm'
+ +#26#176'l'#26#176'k'#25#175'j'#25#175'j'#24#175'j'#23#179'j'#21#152'lFSe'#180
+ +'IP'#167#161'k='#224#139#13#192#192#192#234#181'l'#223#154'>'#214#139','#208
+ +#131''''#207#130'&'#208#132'('#208#132'('#208#132'('#208#132''''#208#132''''
+ +#207#129'$'#204'~!'#201'{'#30#199'u'#25#196'p'#21#192'k'#16#192'f'#5#192'a'#3
+ +#144'dR*Y'#239#23'5'#216#147'Z@'#235#154'-'#192#192#192#192#192#192#235#180
+ +'h'#237#181'h'#237#185'n'#237#184'm'#237#184'm'#237#184'm'#237#184'm'#237#184
+ +'m'#237#184'm'#236#182'k'#235#180'i'#233#177'f'#229#172'a'#226#167'\'#222#161
+ +'W'#219#154'K'#212#148'I'#191#144'g'#158#138#142#144'x|'#180'|A'#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+]);
+LazarusResources.Add('TFSEXTCTRLSRTTI','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#196#14#0#0#196#14#0#0#0#0#0#0#0#0#0#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#23'Y'#211#21'U'#203#20'P'#195#18'K'#188#16'G'
+ +#180#15'C'#173#9'0'#137#8'-'#133#7'+'#128#7')|'#0#12'i'#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#25'_'#220#23'['
+ +#213#22'V'#205#20'Q'#197#18'L'#189#17'H'#182#15'D'#175#14'@'#168#8'.'#134#7
+ +'+'#129#0#22#161#0#12'j'#14'z'#19#12's'#16#11'o'#15#10'k'#13#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192'&z'#254'!u'#252#31'p'#244#29'j'#236#27'e'#227#25'_'#218#23'Y'#209#21'T'
+ +#201#14'A'#170#13'='#164#0#25#167#0#23#162#0#12'k'#14'x'#18#12's'#16#11'n'#14
+ +#10'k'#13#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192'.'#130#254')}'#255'#x'#255' r'#248#30'm'#240#28'g'#231#26'b'
+ +#222#24'\'#213#22'X'#204#15'D'#193#0#27#176#0#24#169#0#23#164#0#24#161#14't'
+ +#24#12'n'#21#11'k'#19#10'l'#14#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#189'^.6'#137#254'1'#133#255','#128#255'&{'#255'!v'#253#31'p'
+ +#244#29'j'#235#27'd'#225#25'`'#216#17'J'#203#0#29#185#0#26#177#0#25#171#0#25
+ +#167#15'z'#27#14't'#24#12'q'#18#11'p'#15#192#192#192#192#192#192#192#192#192
+ +#192#192#192#214#130'@'#200'X'#0'Z'#169#255'9'#140#255'5'#136#255'0'#132#255
+ +'*~'#255'#x'#255' r'#247#30'l'#238#28'h'#228#19'P'#214#0' '#195#0#28#186#0#27
+ +#178#0#27#173#17#128#30#15'z'#27#14'y'#18#13'u'#17#192#192#192#192#192#192
+ +#192#192#192#239#168'S'#228'y'#0#215'i'#0'`'#173#255'A'#147#255'='#144#255'9'
+ +#140#255'3'#134#255'-'#129#255'&z'#255'!t'#250#31'p'#240#21'V'#225#0'"'#204#0
+ +#31#195#0#28#186#0#28#180#20#136'#'#17#129#29#16''#21#192#192#192#192#192
+ +#192#192#192#192#255#194'f'#254#190'^'#245#141#0#233''#0'j'#181#255'H'#153
+ +#255'D'#150#255'A'#147#255'<'#142#255'6'#137#255'.'#130#255'''{'#255'"x'#251
+ +#23'\'#236#0'$'#214#0'!'#204#0#31#195#0#30#187#22#144''''#20#138#31#18#134#24
+ +#192#192#192#192#192#192#192#192#192#255#202'y'#255#165#31#255#160#17#255#153
+ +#0'n'#184#255'L'#157#255'J'#154#255'F'#151#255'B'#147#255'<'#141#255'5'#135
+ +#255'.'#129#255'''|'#255#23'^'#246#0'%'#224#0'#'#214#0'!'#204#0'!'#195#24#152
+ +'+'#22#148#29#20#141#26#192#192#192#192#192#192#192#192#192#255#187'U'#255
+ +#179'@'#255#176':'#255#171'.'#131#204#255'^'#178#255'\'#176#254'Y'#173#254'U'
+ +#170#254'P'#166#254'K'#161#254'D'#155#254'>'#152#254'.'#250#2'-'#235#0'!'
+ +#224#0'#'#213#0'$'#204#26#159'.'#24#156' '#192#192#192#192#192#192#192#192
+ +#192#192#192#192#255#194'g'#255#191'_'#255#191'^'#255#189'Z'#255#185'O'#151
+ +#223#254#147#222#254't'#204#253'q'#202#253'm'#200#253'h'#197#253'c'#193#253
+ +']'#190#252'W'#187#252'>'#149#249#13'?'#236#0#29#222#0'$'#213#28#167'.'#26
+ +#163'"'#192#192#192#192#192#192#192#192#192#192#192#192#255#206#131#255#202
+ +'z'#255#203'}'#255#203'}'#255#201'x'#255#194'g'#150#223#254#148#222#254#146
+ +#221#254#143#219#254#140#218#254#136#216#253'`'#192#253'Z'#189#253'X'#193#255
+ +'K'#177#254'!f'#241#3'+'#226#30#175'-'#27#168'%'#192#192#192#192#192#192#192
+ +#192#192#192#192#192#255#240#219#255#211#144#255#228#188#255#229#189#255#228
+ +#187#255#206#133#255#194'g'#152#224#254#147#222#254#145#220#254#142#219#254
+ +#139#217#254#135#215#253#131#213#253'~'#210#253'y'#207#253't'#205#253'1'#135
+ +#201' '#182','#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#255#217#160#255#219#165#255#233#199#255#232#197#255#212#148#255
+ +#202'z'#255#187'T'#255#168'%'#249#146#0#227'w'#0#209'c'#0#197'T'#0'!'#228'H!'
+ +#208'6!'#202':!'#195':!'#190'8!'#183'8'#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#255#244#228#255#223#174#255#223#175#255
+ +#233#201#255#215#154#255#205#130#255#192'a'#255#175'7'#255#157#11#241#136#0
+ +#224't'#0#163'8'#0'!'#229'H!'#212'1!'#204':!'#198':!'#193'6!'#191','#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#255#245#231#255#224#177#255#221#170#255#215#155#255#206#133#255#195'h'#255
+ +#181'E'#255#165#31#252#192'j'#237#168']'#192#192#192#192#192#192'!'#233',!'
+ +#206':!'#200':!'#198'/!'#194','#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#255#245#230#255#220#168
+ +#255#215#154#255#207#134#255#197'm'#255#185'O'#255#207#135#255#199't'#192#192
+ +#192#192#192#192#192#192#192'!'#234',!'#209'8!'#202'9!'#199'1'#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#255#244#226#255#231#195#255#227#185#255#222
+ ,#173#255#216#158#255#209#141#192#192#192#192#192#192#192#192#192#192#192#192
+ +'!'#234',!'#210'3!'#204'7!'#203','#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192'!'#235',!'#213'/!'#207'2!'
+ +#204','#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192'!'#212'9!'#210','#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192'!'#215',!'#209'3'#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192'!'#216
+ +',*'#208'I'#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192'!'#216',!'#213','#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192
+]);
+LazarusResources.Add('TFSFORMSRTTI','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#196#14#0#0#196#14#0#0#0#0#0#0#0#0#0#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#0#0#147#0#0#143#0#0#139#0#0#136#0#0#132#0#0#129#0#0'~'#0#0'|'#0
+ +#0'y'#0#0'w'#0#0'v'#0#0't'#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192'L{'#255'2'#148#252'Cn'#246'?g'#240';`'#234'6Y'#228'2R'#223'.L'#217
+ +'+F'#212'''A'#208'$;'#204#0#0'y'#0#0'w'#0#0'u'#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192'U'#134#255':'#158#255'Jy'#255'Fs'#250'Bl'#244'>f'#239':^'
+ +#233'6X'#227'1Q'#221'.J'#216'*D'#211'&?'#206#0#0'z'#0#0'x'#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192']'#145#255'E'#167#255'T'#134#255'O'#255#0#0#0#0
+ +#0#0'Ak'#243'=d'#237#0#0#0'4U'#225#0#0#0',G'#213'(A'#208#0#0'{'#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192'e'#154#255'N'#175#255'^'#145#255#0#0#0'S'
+ +#133#255'N~'#255#0#0#0'Dp'#247#0#0#0';`'#234#0#0#0'1P'#221',I'#215#0#0''#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192'l'#163#255'W'#182#255'f'#156#255#0#0
+ +#0']'#145#255'X'#138#255#0#0#0'K{'#255#0#0#0#0#0#0''#196'y$'#197'|5'#194'{5'#192'x5'#191'v5'#190'u5'
+ +#190'v5'#189'v5r'#170#255'_'#189#255'm'#165#255'j'#161#255#0#0#0#0#0#0'['#142
+ +#255'U'#134#255#0#0#0'Hu'#252#0#0#0'=c'#237'7['#230#0#0#135#192#192#192#188
+ +'i'#21#205#143'G'#237#213#184#235#210#183#233#208#181#231#207#181#229#206#181
+ +#227#206#181#226#206#181'w'#177#255#178#255#254't'#172#255'q'#169#255'm'#164
+ +#255'i'#159#255'c'#152#255']'#145#255'V'#136#255'O'#255'Hv'#252'Cm'#245'=d'
+ +#237#0#0#139#192#192#192#181'b '#208#156'i'#255#255#255#255#255#255#255#255
+ +#255#254#255#255#252#255#255#250#255#255#248#255#255'|'#182#255#181#255#254
+ +#180#255#254'f'#195#255'b'#192#255'^'#188#255'X'#183#255'R'#178#255'J'#172
+ +#255'B'#165#255':'#158#255'3'#149#253'Cm'#245#0#0#144#192#192#192#182'c '#206
+ +#152'b'#255#255#255#255#255#255#252#254#255#250#254#255#248#253#255#246#251
+ +#255#244#251#255#241#250#255'~'#185#255'|'#183#255'z'#180#255'w'#177#255's'
+ +#172#255'o'#167#255'j'#160#255'd'#153#255'^'#145#255'V'#136#255'O'#255'Hv'
+ +#252#192#192#192#192#192#192#173'R'#5#206#152'b'#5#4#236#5#4#236#5#4#236#5#4
+ +#236#248#253#255#245#252#255#5#4#236#5#4#236#5#4#236#5#4#236#232#247#255#229
+ +#246#255#226#243#255#0'f'#0#218#242#255#216#244#255#215#249#255#191#155'r'
+ +#184'f '#192#192#192#192#192#192#192#192#192#178'\'#21#206#152'c'#255#255#255
+ +#5#4#236#253#254#255#250#254#255#248#253#255#246#251#255#244#251#255#5#4#236
+ +#5#4#236#235#248#255#232#247#255#229#245#255#226#244#255#0'f'#0#219#242#255
+ +#216#244#255#215#249#255#191#155's'#184'e '#192#192#192#192#192#192#192#192
+ +#192#182'c '#206#152'c'#255#255#255#255#255#255#5#4#236#250#254#255#248#253
+ +#255#245#251#255#244#251#255#5#4#236#0'f'#0#0'f'#0#0'f'#0#0'f'#0#0'f'#0#222
+ +#243#255#219#242#255#216#244#255#215#249#255#191#155'r'#184'e '#192#192#192
+ +#192#192#192#192#192#192#182'c '#206#152'c'#255#255#255#255#255#255#5#4#236#5
+ +#4#236#5#4#236#5#4#236#5#4#236#5#4#236#0'f'#0#235#248#255#233#247#255#229#245
+ +#255#226#244#255#0'f'#0#219#242#255#216#244#255#214#249#255#193#156'r'#187'h'
+ +' '#192#192#192#192#192#192#192#192#192#182'c '#207#152'c'#255#255#255#255
+ +#255#255#5#4#236#250#254#255#248#253#255#246#251#255#5#4#236#241#250#255#0'f'
+ +#0#235#248#255#233#247#255#229#245#255#226#244#255#0'f'#0#219#242#255#216#243
+ +#255#214#248#255#196#160'q'#191'm '#192#192#192#192#192#192#192#192#192#182
+ +'b '#207#152'c'#255#255#255#255#255#255#252#254#255#5#4#236#249#253#255#5#4
+ +#236#5#4#236#241#250#255#0'f'#0#235#248#255#233#247#255#229#245#255#226#244
+ +#255#0'f'#0#219#242#255#216#243#255#214#248#255#200#165'r'#198't '#192#192
+ +#192#192#192#192#192#192#192#181'b '#206#152'c'#255#255#255#255#255#255#252
+ +#254#255#5#4#236#248#253#255#5#4#236#5#4#236#0'f'#0#0'f'#0#0'f'#0#0'f'#0#0'f'
+ +#0#0'f'#0#223#243#255#219#242#255#216#243#255#213#248#255#204#174'}'#206'~!'
+ +#192#192#192#192#192#192#192#192#192#192's#'#214#164'q'#255#255#255#255#255
+ +#255#255#255#255#253#255#255#5#4#236#5#4#236#248#255#255#245#255#255#242#255
+ +#255#239#255#255#236#254#255#232#253#255#229#251#255#225#249#255#221#248#255
+ +#217#249#255#214#255#255#207#183#134#211#133'#'#192#192#192#192#192#192#192
+ ,#192#192#219#153'F'#228#180'z'#248#242#233#248#240#229#246#238#226#243#236
+ +#224#241#236#224#5#4#236#236#233#221#232#232#221#231#232#221#229#231#222#226
+ +#231#222#222#231#224#221#232#227#219#233#232#216#232#231#225#234#212#227#241
+ +#217#213#180'p'#216#139'$'#192#192#192#192#192#192#192#192#192#235#177'b'#217
+ +#155'G'#185#138'F'#182#132'A'#183#133'A'#182#132'@'#182#131'?'#180#130'?'#180
+ +#130'?'#180#130'?'#179#130'?'#180#130'@'#180#131'A'#179#131'B'#180#134'D'#180
+ +#135'G'#181#136'H'#153#135'y'#140'~'#130#178#129'@'#222#147'#'#192#192#192
+ +#192#192#192#192#192#192#231#170'X'#218#148'7'#203'"'#197'w'#28#198'x'#29
+ +#198'y'#30#198'y'#30#198'y'#29#198'x'#28#197'v'#26#194's'#23#191'o'#19#189'j'
+ +#15#187'f'#12#183'c'#7#183'^'#0#171'^'#22'6`'#227#0'1'#249#140'XJ'#235#144#19
+ +#192#192#192#192#192#192#192#192#192#246#224#194#234#176'_'#237#183'l'#236
+ +#184'm'#236#184'm'#236#184'm'#235#183'm'#235#183'm'#234#183'm'#233#181'k'#231
+ +#178'i'#228#175'f'#223#169'`'#219#164'['#213#156'S'#210#149'G'#193#132'B'#161
+ +'~k'#143'z'#132#177'yA'#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192
+]);
+LazarusResources.Add('TFSGRAPHICSRTTI','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#196#14#0#0#196#14#0#0#0#0#0#0#0#0#0#0#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#232#168'O'#232#168'O'#232#168'O'#231#166'M'
+ +#228#162'J'#226#158'F'#222#154'B'#219#149'='#216#144'8'#212#139'2'#208#133','
+ +#203''''#200'y!'#195't'#28#192'o'#23#188'i'#18#184'd'#12#182'`'#9#179'\'#5
+ +#177'Z'#2#176'X'#0#176'X'#0#176'X'#0#176'X'#0#232#168'O'#232#168'O'#232#168
+ +'O'#231#167'N'#229#164'K'#226#160'G'#224#156'C'#220#151'?'#217#146'9'#213#141
+ +'4'#209#136'/'#205#130')'#201'|#'#197'v'#30#193'q'#25#189'l'#19#186'g'#14#183
+ +'b'#10#180'^'#6#178'['#3#176'X'#0#176'X'#0#176'X'#0#176'X'#0#232#168'O'#232
+ +#168'O'#232#168'O'#232#168'O'#230#166'L'#228#162'I'#225#158'E'#222#153'A'#218
+ +#149'<'#214#143'6'#211#138'1'#207#132','#203'~%'#199'x '#195's'#26#191'm'#21
+ +#187'i'#17#184'd'#12#181'_'#8#179'\'#3#177'Y'#1#176'X'#0#176'X'#0#176'X'#0
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#0#128#255#176'X'#0#176'X'#0#128
+ +#171'.'#192#192#192#192#192#192#192#192#192#0#128#255#0#128#255#0#128#255'@'
+ +#7#29#27#28#31'Y\b'#132#151#210#132#151#210#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#0#128#255#232#168'O'#176'X'#0#176'X'#0#128#171'.'#192#192#192#0#128#255#220
+ +#18'1'#220#18'1'#220#18'1'#220#18'1'#7#3#17#10#8#17#27#27'!pt{'#132#151#210
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#0#128#255#0#128#255#0#128#255#0#128#255#11#186#244#192
+ +#192#192#192#192#192#11#186#244#11#186#244#129#139#157#0#128#255#220#18'1r",'
+ +#12#6#31#8#6#17#132#151#210#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#0#128#255#11#186#244#167#173#184#146'hu'#147'dq'#19#19#30'$%('#132#151
+ +#210#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#11#186#244';CQ'#11#186#244#11
+ +#186#244#11#186#244'ht'#137#14#16#19#132#151#210#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#151#160#172'ft'#140#11#186#244#11#186#244#6#7#8'&'''
+ +',NHF'#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#150
+ +#159#175'[g}cp'#135'Y[_'#160#149'd'#128#171'.'#134#134#135#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#173#181#189'{~'#137#128#171
+ +'.'#195#200#203#128#171'.'#128#171'.|'#129#131#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#161#143#134#128#171'.'#128
+ +#171'.Vb'#136#26' ;w{~'#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#168#169#169'FQp'#132#151#210'R]'#132#27'!<'#130#135
+ +#138#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#160#164#167'BJh'#132#151#210'S_'#133#27'!<'#148#154#157#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#159#164#166'ENm'
+ ,#132#151#210'DOo'#26' ;'#160#166#170#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#159#164#166'OY}'#132#151#210''#253#0'1'#248#0
+ +'0'#243#240#188#189#255#247#228#4#4#4#4#4#4#4#4#4#248#236#214#4#4#4#4#4#4#4#4
+ +#4#237#223#193#235#218#187#4#4#4#230#211#175#227#206#170#4#4#4#207#156#156
+ +#128#128#128#192#192#192#130#183#255'U'#136#255'.`'#255#16'C'#255#0'3'#253#0
+ +'1'#248#245#192#192#255#247#229#254#246#227#253#243#224#251#241#221#249#238
+ +#217#247#235#212#245#232#208#242#228#202#240#225#197#237#221#191#234#217#185
+ +#232#213#179#228#210#173#226#205#167#207#156#156#128#128#128#192#192#192#135
+ +#186#255'['#140#255'6f'#255#25'J'#255#6'8'#255#0'3'#253#245#193#193#255#247
+ +#229#255#247#229#254#245#226#252#243#223#251#240#219#249#237#215#247#235#211
+ +#244#231#205#242#228#200#239#224#195#236#220#189#233#216#183#231#211#177#228
+ +#207#172#207#156#156#128#128#128#192#192#192#139#188#255'a'#145#255'>l'#255
+ +'"Q'#255#15'?'#255#6'7'#255#245#193#193#245#193#193#245#193#193#245#193#193
+ +#243#191#191#240#188#188#236#185#185#232#181#181#229#178#178#225#174#173#221
+ +#170#170#217#166#165#213#162#162#210#159#159#207#156#156#207#156#156#192#192
+ +#192#192#192#192#143#190#255'f'#148#255'Eq'#255'*W'#255#24'F'#255#15'?'#255#5
+ +'7'#255#0'2'#253#0'1'#247#0'0'#241#9'9'#235#28'L'#228'5i'#222'S'#141#216#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#147#188#255'l'#144#255'Lm'#255'1K'
+ +#255' <'#255'"]'#255'6'#141#255'-'#136#255#12'L'#252#0#31#246#10'&'#239#29'C'
+ +#233'7c'#226'V'#140#221#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#160#207
+ +#255'~'#179#255'c'#159#255'N'#138#255'@'#129#255'C'#152#255'P'#188#255'I'#186
+ +#255'+'#139#255#28'g'#250'"i'#244'1y'#237'H'#137#231'd'#163#225#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#175#227#255#146#208#254'y'#191#250'd'#174
+ +#248'X'#164#245'Q'#161#245'L'#159#244'D'#155#243'9'#148#243'1'#143#244'8'#148
+ +#240'G'#160#236'\'#174#234'v'#189#229#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#178#227#253#147#200#245'v'#168#232'a'#145#223'R'#129#218'Ht'#216';d'#212
+ +'3]'#210'0b'#209'*d'#209'-m'#213'@'#132#217']'#165#226'|'#193#231#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#171#209#242#139#174#231'p'#141#219'[w'#212
+ +'Nk'#209'Gg'#208'?b'#207'7\'#205'/R'#202'%I'#199'#K'#198'5_'#202'Q'#131#211
+ +'u'#173#221#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#171#203#237#144#177
+ ,#229'|'#165#229'm'#157#231'a'#152#233']'#154#237'W'#153#239'P'#149#238'F'#140
+ +#234'>'#131#229'<~'#224'D'#219'Y'#138#214'w'#168#217#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#189#228#250#167#214#250#148#209#252#132#200#253'x'#191
+ +#252'r'#189#253'm'#187#253'g'#184#253'_'#181#252'['#178#252']'#183#252'f'#191
+ +#251'y'#194#247#149#208#241#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#214
+ +#242#254#178#220#255#149#195#255#132#181#255'v'#170#255'o'#165#255'i'#160#255
+ +'d'#156#255']'#153#255'Z'#152#255']'#156#255'i'#170#255#143#204#255#193#235
+ +#254#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#194#208#213#197#230#255#162
+ +#195#255#146#178#255#133#168#255''#161#255'y'#158#255't'#155#255'o'#150#255
+ +'l'#151#255'q'#156#255''#173#255#170#219#255#185#203#211#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#193#198#199#201#232#255#183#220#255#174#211#255#164
+ +#202#255#158#197#255#154#195#255#150#192#255#148#191#255#147#193#255#152#200
+ +#255#157#207#255#178#223#255#190#196#199#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+]);
+LazarusResources.Add('TFSJSCRIPT','BMP',[
+ 'BM'#246#6#0#0#0#0#0#0'6'#0#0#0'('#0#0#0#24#0#0#0#24#0#0#0#1#0#24#0#0#0#0#0
+ +#192#6#0#0#196#14#0#0#196#14#0#0#0#0#0#0#0#0#0#0#200#208#212#200#208#212#200
+ +#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#128#128
+ +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
+ +#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128#128
+ +#128#128#128#128#128#128#128#128#200#208#212#200#208#212#200#208#212#200#208
+ +#212#200#208#212#200#208#212#200#208#212#207#156#156#207#156#156#207#156#156
+ +#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207
+ +#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156#156#207#156
+ +#156#128#128#128#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212
+ +#200#208#212#200#208#212#207#156#156#248#236#213#248#236#213#243#230#204#239
+ +#224#196#239#224#196#234#217#185#233#215#182#231#212#178#226#204#167#226#204
+ +#167#222#200#159#218#193#151#218#193#151#212#185#140#207#156#156#128#128#128
+ +#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200
+ +#208#212#207#156#156#248#236#213#248#236#213#243#230#204#243#230#204#239#224
+ +#196#236#220#189#234#217#185#231#212#178#228#209#173#226#204#167#222#200#159
+ +#222#200#159#218#193#151#218#193#151#207#156#156#128#128#128#200#208#212#200
+ +#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#212#161
+ +#161#255#246#228#248#236#213#248#236#213#0#0#0#0#0#0#236#220#189#236#220#189
+ +#0#0#0#0#0#0#0#0#0#226#204#167#222#200#159#222#200#159#218#193#151#207#156
+ +#156#128#128#128#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212
+ +#200#208#212#200#208#212#220#170#170#255#246#228#252#242#221#0#0#0#248#236
+ +#213#243#230#204#0#0#0#236#220#189#236#220#189#231#212#178#228#209#173#0#0#0
+ +#226#204#167#222#200#159#222#200#159#207#156#156#128#128#128#200#208#212#200
+ +#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#232#181
+ +#181#255#246#228#252#242#221#248#236#213#248#236#213#243#230#204#0#0#0#234
+ +#217#185#236#220#189#0#0#0#0#0#0#234#217#185#226#204#167#222#200#159#222#200
+ +#159#207#156#156#128#128#128#200#208#212#200#208#212#200#208#212#200#208#212
+ +#200#208#212#200#208#212#200#208#212#232#181#181#255#246#228#252#242#221#252
+ +#242#221#252#242#221#248#236#213#0#0#0#243#230#204#0#0#0#234#217#185#234#217
+ +#185#233#215#182#228#209#173#226#204#167#226#204#167#207#156#156#128#128#128
+ +#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200#208#212#200
+ +#208#212#244#192#192#255#246#228#255#246#228#255#246#228#0#0#0#0#0#0#0#0#0
+ +#248#236#213#243#230#204#0#0#0#0#0#0#0#0#0#234#217#185#234#217#185#226#204
+ +#167#207#156#156#128#128#128#200#208#212#200#208#212#232#181#181#157'hk'#137
+ +'ZS'#226#196#197#200#208#212#244#192#192#255#246#228#255#246#228#252#242#221
+ +#252#242#221#248#236#213#248#236#213#252#242#221#248#236#213#239#224#196#236
+ +#220#189#234#217#185#231#212#178#228#209#173#226#204#167#207#156#156#128#128
+ +#128#200#208#212#200#208#212'W'#211#250#23#221#213'_'#255#255'0qq'#22'UU"'#130#132#21'xy'#168#220#219'|AB*~'#128#24'gg'
+ +#0'rr'#4'|}'#162'os'#192#192#192#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#192#167#174#173
+ +#145'np7'#214#215#8#242#242'+WW'#0'XX'#0'jj'#216#198#198#11'lk9&&'#0'pp'#224
+ +#240#240#157#185#185#158'_dpUS'#192#192#192#192#192#192#192#192#192#192#192
+ +#192#192#192#192#192#192#192#192#192#192#192#192#192#187#133#137#162'[\A``4q'
+ +'q'#0'zz'#155#212#212#221#238#238'#'#242#242#24#255#255#215#255#255'5'#234
+ +#234#0#236#236';'#139#139'iJJ;'#146#147'Z'#129#129'X99'#192#192#192#192#192
+ +#192#234#184#182#168'hm'#139'_\'#223#192#189#192#192#192'k'#182#178'.'#166
+ +#160'@RSB'#175#175'd\Wo3,'#176#133#131#163#151#151'DJJ`BB<<<'#182#203#203#0
+ +#231#231'S'#18#18#20#149#149#129#181#181#216#214#214#192#192#192#192#192#192
+ +'e'#208#250#20#215#208'd8P^'#157#234#192#136#135'g'#175#251'4n'#173'n&'#29'n'
+ +')'#28'Mn'#163'.'#159#237'SC['#191#139#136#211#159#159#156'hh'#160'aa'#15#132
+ +#130#248#255#255#0#242#242#230#247#240#1#225#226'Z99'#192#192#192#192#192#192
+ +'V'#227#255#9#223#216'i/G-'#168#255'/'#146#249#141#208#255#213#157#149'$'#140
+ +#129#25#209#248'4'#141#251'%'#162#255'QGb'#157'b_]66J$$U$$E '#16#255#255#196
+ +#188#189#156'qu'#142'tx'#192#192#192#194'cc'#130';;wRR'#0#255#255#26#205#202
+ +'e7R$'#162#255#137#171#225#171#188#229'AY'#140'9Z'#151#173#229#255#255#234
+ +#228#136'UUU'#31#31#211#163#163#255#248#250#4#255#255#254#255#255#0#252#252
+ +#26'wt'#168'w|'#192#192#192#192#192#192#129'>A+'#163#255':'#146#240'~?Nb'#189
+ +#255#248#255#255#175#247#243#0#248#246#128#248#246#153#251#249#5#255#255#21
+ +#206#255'W>Y;v'#197'Y'#219#255'st'#255#0':'#255#255']"'#183#199
+ +#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202
+ +#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183
+ +#199#202#183#199#202#255']$'#183#199#202#183#199#202#183#199#202#255#134'5'
+ +#255#135'5'#255#131'4'#255'~4'#255'^#'#183#199#202#183#199#202#183#199#202
+ +#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183
+ +#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#255'`$'
+ +#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183
+ ,#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199
+ +#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202
+ +#183#199#202#183#199#202#255'_$'#255'^$'#255'^#'#255'[#'#255'_"'#183#199#202
+ +#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183
+ +#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199
+ +#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#255#130'4'
+ +#255#251#246#255#255#242#255#240#176#255']#'#183#199#202#183#199#202#183#199
+ +#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202
+ +#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183
+ +#199#202#183#199#202#183#199#202#183#199#202#255#132'5'#255#255#255#254#255
+ +#255#255#240#175#255'`$'#183#199#202#183#199#202#183#199#202#183#199#202#183
+ +#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199
+ +#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202
+ +#183#199#202#183#199#202#255#128'4'#255#129'4'#255#131'6'#255#132'6'#255']$'
+ +#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183
+ +#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199
+ +#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202
+ +#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183
+ +#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199
+ +#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202
+ +#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183
+ +#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199
+ +#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202
+ +#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183#199#202#183
+ +#199#202
+]);
diff --git a/LibD28/fs_ireg.pas b/LibD28/fs_ireg.pas
new file mode 100644
index 0000000..3e4b7ca
--- /dev/null
+++ b/LibD28/fs_ireg.pas
@@ -0,0 +1,90 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_ireg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+uses
+ Classes
+{$IFNDEF FPC}
+ {$IFNDEF Delphi6}
+ , DsgnIntf
+ {$ELSE}
+ , DesignIntf
+ {$ENDIF}
+{$ELSE}
+ ,PropEdits
+ ,LazarusPackageIntf
+ ,LResources
+{$ENDIF}
+{$IFDEF DELPHI16}
+ , Controls
+{$ENDIF}
+, fs_iinterpreter, fs_iclassesrtti, fs_igraphicsrtti, fs_iformsrtti,
+ fs_iextctrlsrtti, fs_idialogsrtti, fs_iinirtti, fs_imenusrtti,
+ fs_ipascal, fs_icpp, fs_ijs, fs_ibasic, fs_tree
+{$IFNDEF CLX}
+, fs_synmemo
+{$ENDIF}
+;
+
+{-----------------------------------------------------------------------}
+
+{$ifdef FPC}
+procedure RegisterUnitfs_ireg;
+{$else}
+procedure Register;
+{$endif}
+begin
+{$IFDEF DELPHI16}
+ {GroupDescendentsWith(TfsExtCtrlsRTTI, TControl);
+ GroupDescendentsWith(TfsDialogsRTTI, TControl);
+ GroupDescendentsWith(TfsGraphicsRTTI, TControl);
+ GroupDescendentsWith(TfsMenusRTTI, TControl);
+ GroupDescendentsWith(TfsScript, TControl);
+ GroupDescendentsWith(TfsIniRTTI, TControl);
+ GroupDescendentsWith(TfsFormsRTTI, TControl);
+ GroupDescendentsWith(TfsClassesRTTI, TControl);
+ GroupDescendentsWith(TfsPascal, TControl);
+ GroupDescendentsWith(TfsCPP, TControl);
+ GroupDescendentsWith(TfsJScript, TControl);
+ GroupDescendentsWith(TfsBasic, TControl);}
+{$ENDIF}
+ RegisterComponents('FastScript',
+ [TfsScript, TfsPascal, TfsCPP, TfsJScript, TfsBasic,
+ TfsClassesRTTI, TfsGraphicsRTTI, TfsFormsRTTI, TfsExtCtrlsRTTI,
+ TfsDialogsRTTI, TfsMenusRTTI, TfsIniRTTI,
+ TfsTree
+{$IFNDEF CLX}
+ , TfsSyntaxMemo
+{$ENDIF}
+ ]);
+end;
+
+{$ifdef FPC}
+procedure Register;
+begin
+ RegisterUnit('fs_ireg', @RegisterUnitfs_ireg);
+end;
+{$endif}
+
+initialization
+{$IFDEF FPC}
+ {$INCLUDE fs_ireg.lrs}
+{$ENDIF}
+end.
diff --git a/LibD28/fs_isysrtti.pas b/LibD28/fs_isysrtti.pas
new file mode 100644
index 0000000..c0dc1dc
--- /dev/null
+++ b/LibD28/fs_isysrtti.pas
@@ -0,0 +1,623 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Standard functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_isysrtti;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, fs_iinterpreter, fs_itools
+{$IFDEF CLX}
+ , QDialogs, MaskUtils, Variants
+{$ELSE}
+ {$IFNDEF NOFORMS}
+ , Dialogs
+ {$ENDIF}
+ {$IFDEF FPC}
+ {, Mask}, Variants
+ {$ELSE}
+ {$IFDEF Delphi6}
+ , MaskUtils, Variants, Windows
+ {$ELSE}
+ , Mask
+ {$ENDIF}
+ {$ENDIF}
+{$ENDIF}
+{$IFDEF OLE}
+ , ComObj
+{$ENDIF};
+{$ELSE}
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_itools
+ {$IFNDEF NOFORMS}
+ , FMX.Dialogs
+ {$ENDIF}
+ , System.MaskUtils, System.Variants, FMX.Types
+ {$IFDEF OLE}
+ , System.Win.ComObj
+ {$ENDIF};
+{$ENDIF}
+
+type
+ TfsSysFunctions = class(TfsRTTIModule)
+ private
+ FCatConv: String;
+ FCatDate: String;
+ FCatFormat: String;
+ FCatMath: String;
+ FCatOther: String;
+ FCatStr: String;
+ function CallMethod1(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function CallMethod2(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function CallMethod3(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function CallMethod4(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function CallMethod5(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function CallMethod6(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function CallMethod7(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+implementation
+
+{$IFDEF FPC}
+uses lazutf8;
+{$ENDIF}
+
+
+function FormatV(const Fmt: String; Args: Variant): String;
+var
+ ar: TVarRecArray;
+ sPtrList: TList;
+begin
+ VariantToVarRec(Args, ar, sPtrList);
+ try
+ Result := Format(Fmt, ar);
+ finally
+ ClearVarRec(ar, sPtrList);
+ end;
+end;
+
+function VArrayCreate(Args: Variant; Typ: Integer): Variant;
+var
+ i, n: Integer;
+ ar: array of {$IFDEF FPC}SizeInt{$ELSE}Integer{$ENDIF};
+begin
+ n := VarArrayHighBound(Args, 1) + 1;
+ SetLength(ar, n);
+ for i := 0 to n - 1 do
+ ar[i] := Args[i];
+
+ Result := VarArrayCreate(ar, Typ);
+ ar := nil;
+end;
+
+function NameCase(const s: String): String;
+var
+ i: Integer;
+begin
+{$IFDEF FPC}
+ Result := UTF8LowerString(s);
+ for i := 1 to UTF8Length(s) do
+ if i = 1 then
+ begin
+ UTF8Insert(UTF8UpperString(UTF8Copy(s, i, 1)), Result, i + 1);
+ UTF8Delete(Result, i, 1);
+ end
+ else if i < UTF8Length(s) then
+ if UTF8Copy(s, i, 1)[1] = ' ' then
+ begin
+ UTF8Insert(UTF8UpperString(UTF8Copy(s, i + 1, 1)), Result, i + 2);
+ UTF8Delete(Result, i + 1, 1);
+ end;
+{$ELSE}
+ Result := AnsiLowercase(s);
+ for i := 1 to Length(s) do
+ if i = 1 then
+ Result[i] := AnsiUpperCase(s[i])[1]
+ else if i < Length(s) then
+ if s[i] = ' ' then
+ Result[i + 1] := AnsiUpperCase(s[i + 1])[1];
+ {$ENDIF}
+end;
+
+function ValidInt(cInt: String): Boolean;
+begin
+ Result := True;
+ try
+ StrToInt(cInt);
+ except
+ Result := False;
+ end;
+end;
+
+function ValidFloat(cFlt: String): Boolean;
+begin
+ Result := True;
+ try
+ StrToFloat(cFlt);
+ except
+ Result := False;
+ end;
+end;
+
+function ValidDate(cDate: String) :Boolean;
+begin
+ Result := True;
+ try
+ StrToDate(cDate);
+ except
+ Result := False;
+ end;
+end;
+
+function DaysInMonth(nYear, nMonth: Integer): Integer;
+const
+ Days: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
+begin
+ Result := Days[nMonth];
+ if (nMonth = 2) and IsLeapYear(nYear) then Inc(Result);
+end;
+
+
+{ TfsSysFunctions }
+
+constructor TfsSysFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ FCatStr := 'ctString';
+ FCatDate := 'ctDate';
+ FCatConv := 'ctConv';
+ FCatFormat := 'ctFormat';
+ FCatMath := 'ctMath';
+ FCatOther := 'ctOther';
+
+ with AScript do
+ begin
+ AddType('Byte', fvtInt);
+ AddType('Word', fvtInt);
+ AddType('Integer', fvtInt);
+{$IFDEF FS_INT64}
+ AddType('Int64', fvtInt64);
+{$ENDIF}
+ AddType('Longint', fvtInt);
+ AddType('Cardinal', fvtInt);
+ AddType('TColor', fvtInt);
+ AddType('TAlphaColor', fvtInt);
+ AddType('Boolean', fvtBool);
+ AddType('Real', fvtFloat);
+ AddType('Single', fvtFloat);
+ AddType('Double', fvtFloat);
+ AddType('Extended', fvtFloat);
+ AddType('Currency', fvtFloat);
+ AddType('TDate', fvtFloat);
+ AddType('TTime', fvtFloat);
+ AddType('TDateTime', fvtFloat);
+ AddType('Char', fvtChar);
+ AddType('String', fvtString);
+ AddType('Variant', fvtVariant);
+ AddType('Pointer', fvtVariant);
+ AddType('Array', fvtArray);
+ AddType('Constructor', fvtConstructor);
+
+ AddConst('True', 'Boolean', True);
+ AddConst('False', 'Boolean', False);
+ AddConst('nil', 'Variant', 0);
+ AddConst('Null', 'Variant', Null);
+
+ Add('__StringHelper', TfsStringHelper.Create);
+ Add('__ArrayHelper', TfsArrayHelper.Create('__ArrayHelper', -1, fvtVariant, ''));
+ AddVariable('ExceptionClassName', 'String', '');
+ AddVariable('ExceptionMessage', 'String', '');
+
+ AddMethod('function IntToStr(i: Integer): String', CallMethod1, FCatConv);
+ AddMethod('function FloatToStr(e: Extended): String', CallMethod1, FCatConv);
+ AddMethod('function DateToStr(e: Extended): String', CallMethod1, FCatConv);
+ AddMethod('function TimeToStr(e: Extended): String', CallMethod1, FCatConv);
+ AddMethod('function DateTimeToStr(e: Extended): String', CallMethod1, FCatConv);
+{$IFDEF Delphi6}
+ AddMethod('function BoolToStr(B: Boolean): string;', CallMethod1, FCatConv);
+{$ENDIF}
+ AddMethod('function VarToStr(v: Variant): String', CallMethod7, FCatConv);
+
+ AddMethod('function StrToInt(s: String): Integer', CallMethod2, FCatConv);
+{$IFDEF FS_INT64}
+ AddMethod('function StrToInt64(s: String): Int64', CallMethod2, FCatConv);
+{$ENDIF}
+ AddMethod('function StrToFloat(s: String): Extended', CallMethod2, FCatConv);
+ AddMethod('function StrToDate(s: String): Extended', CallMethod2, FCatConv);
+ AddMethod('function StrToTime(s: String): Extended', CallMethod2, FCatConv);
+ AddMethod('function StrToDateTime(s: String): Extended', CallMethod2, FCatConv);
+{$IFDEF Delphi6}
+ AddMethod('function StrToBool(const S: string): Boolean;', CallMethod2, FCatConv);
+{$ENDIF}
+
+ AddMethod('function Format(Fmt: String; Args: array): String', CallMethod3, FCatFormat);
+ AddMethod('function FormatFloat(Fmt: String; Value: Extended): String', CallMethod3, FCatFormat);
+ AddMethod('function FormatDateTime(Fmt: String; DateTime: TDateTime): String', CallMethod3, FCatFormat);
+ AddMethod('function FormatMaskText(EditMask: string; Value: string): string', CallMethod3, FCatFormat);
+
+ AddMethod('function EncodeDate(Year, Month, Day: Word): TDateTime', CallMethod4, FCatDate);
+ AddMethod('procedure DecodeDate(Date: TDateTime; var Year, Month, Day: Word)', CallMethod4, FCatDate);
+ AddMethod('function EncodeTime(Hour, Min, Sec, MSec: Word): TDateTime', CallMethod4, FCatDate);
+ AddMethod('procedure DecodeTime(Time: TDateTime; var Hour, Min, Sec, MSec: Word)', CallMethod4, FCatDate);
+ AddMethod('function Date: TDateTime', CallMethod4, FCatDate);
+ AddMethod('function Time: TDateTime', CallMethod4, FCatDate);
+ AddMethod('function Now: TDateTime', CallMethod4, FCatDate);
+ AddMethod('function DayOfWeek(aDate: TDateTime): Integer', CallMethod4, FCatDate);
+ AddMethod('function IsLeapYear(Year: Word): Boolean', CallMethod4, FCatDate);
+ AddMethod('function DaysInMonth(nYear, nMonth: Integer): Integer', CallMethod4, FCatDate);
+
+ AddMethod('function Length(s: Variant): Integer', CallMethod5, FCatStr);
+ AddMethod('function Copy(s: String; from, count: Integer): String', CallMethod5, FCatStr);
+ AddMethod('function Pos(substr, s: String): Integer', CallMethod5, FCatStr);
+ AddMethod('procedure Delete(var s: String; from, count: Integer)', CallMethod5, FCatStr);
+ AddMethod('procedure DeleteStr(var s: String; from, count: Integer)', CallMethod5, FCatStr);
+ AddMethod('procedure Insert(s: String; var s2: String; pos: Integer)', CallMethod5, FCatStr);
+ AddMethod('function Uppercase(s: String): String', CallMethod5, FCatStr);
+ AddMethod('function Lowercase(s: String): String', CallMethod5, FCatStr);
+ AddMethod('function Trim(s: String): String', CallMethod5, FCatStr);
+ AddMethod('function NameCase(s: String): String', CallMethod5, FCatStr);
+ AddMethod('function CompareText(s, s1: String): Integer', CallMethod5, FCatStr);
+ AddMethod('function Chr(i: Integer): Char', CallMethod5, FCatStr);
+ AddMethod('function Ord(ch: Char): Integer', CallMethod5, FCatStr);
+ AddMethod('procedure SetLength(var S: Variant; L: Integer)', CallMethod5, FCatStr);
+
+ AddMethod('function Round(e: Extended): Integer', CallMethod6, FCatMath);
+ AddMethod('function Trunc(e: Extended): Integer', CallMethod6, FCatMath);
+ AddMethod('function Int(e: Extended): Integer', CallMethod6, FCatMath);
+ AddMethod('function Frac(X: Extended): Extended', CallMethod6, FCatMath);
+ AddMethod('function Sqrt(e: Extended): Extended', CallMethod6, FCatMath);
+ AddMethod('function Abs(e: Extended): Extended', CallMethod6, FCatMath);
+ AddMethod('function Sin(e: Extended): Extended', CallMethod6, FCatMath);
+ AddMethod('function Cos(e: Extended): Extended', CallMethod6, FCatMath);
+ AddMethod('function ArcTan(X: Extended): Extended', CallMethod6, FCatMath);
+ AddMethod('function Tan(X: Extended): Extended', CallMethod6, FCatMath);
+ AddMethod('function Exp(X: Extended): Extended', CallMethod6, FCatMath);
+ AddMethod('function Ln(X: Extended): Extended', CallMethod6, FCatMath);
+ AddMethod('function Pi: Extended', CallMethod6, FCatMath);
+
+ AddMethod('procedure Inc(var i: Integer; incr: Integer = 1)', CallMethod7, FCatOther);
+ AddMethod('procedure Dec(var i: Integer; decr: Integer = 1)', CallMethod7, FCatOther);
+ AddMethod('procedure RaiseException(Param: String)', CallMethod7, FCatOther);
+ AddMethod('procedure ShowMessage(Msg: Variant)', CallMethod7, FCatOther);
+ AddMethod('procedure Randomize', CallMethod7, FCatOther);
+ AddMethod('function Random: Extended', CallMethod7, FCatOther);
+ AddMethod('function ValidInt(cInt: String): Boolean', CallMethod7, FCatOther);
+ AddMethod('function ValidFloat(cFlt: String): Boolean', CallMethod7, FCatOther);
+ AddMethod('function ValidDate(cDate: String): Boolean', CallMethod7, FCatOther);
+ AddMethod('function ExtractFilePath(const FileName: string): string;', CallMethod7, FCatOther);
+{$IFDEF OLE}
+ AddMethod('function CreateOleObject(ClassName: String): Variant', CallMethod7, FCatOther);
+{$ENDIF};
+ AddMethod('function VarArrayCreate(Bounds: Array; Typ: Integer): Variant', CallMethod7, FCatOther);
+ AddMethod('function VarType(V: Variant): Integer', CallMethod7, FCatOther);
+
+ AddConst('varEmpty', 'Integer', 0);
+ AddConst('varNull', 'Integer', 1);
+ AddConst('varSmallint', 'Integer', 2);
+ AddConst('varInteger', 'Integer', 3);
+ AddConst('varSingle', 'Integer', 4);
+ AddConst('varDouble', 'Integer', 5);
+ AddConst('varCurrency', 'Integer', 6);
+ AddConst('varDate', 'Integer', 7);
+ AddConst('varOleStr', 'Integer', 8);
+ AddConst('varDispatch', 'Integer', 9);
+ AddConst('varError', 'Integer', $000A);
+ AddConst('varBoolean', 'Integer', $000B);
+ AddConst('varVariant', 'Integer', $000C);
+ AddConst('varUnknown', 'Integer', $000D);
+ AddConst('varShortInt', 'Integer', $0010);
+ AddConst('varByte', 'Integer', $0011);
+ AddConst('varWord', 'Integer', $0012);
+ AddConst('varLongWord', 'Integer', $0013);
+ AddConst('varInt64', 'Integer', $0014);
+ AddConst('varStrArg', 'Integer', $0048);
+ AddConst('varString', 'Integer', $0100);
+ AddConst('varAny', 'Integer', $0101);
+ AddConst('varTypeMask', 'Integer', $0FFF);
+ AddConst('varArray', 'Integer', $2000);
+ AddConst('varByRef', 'Integer', $4000);
+ end;
+end;
+
+function TfsSysFunctions.CallMethod1(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+{$IFDEF DELPHI6}
+ i: Int64;
+{$ELSE}
+ i: Integer;
+{$ENDIF}
+begin
+ if MethodName = 'INTTOSTR' then
+ begin
+ i := Caller.Params[0];
+ Result := IntToStr(i)
+ end
+ else if MethodName = 'FLOATTOSTR' then
+ Result := FloatToStr(Caller.Params[0])
+ else if MethodName = 'DATETOSTR' then
+ Result := DateToStr(Caller.Params[0])
+ else if MethodName = 'TIMETOSTR' then
+ Result := TimeToStr(Caller.Params[0])
+ else if MethodName = 'DATETIMETOSTR' then
+ Result := DateTimeToStr(Caller.Params[0])
+{$IFDEF Delphi6}
+ else if MethodName = 'BOOLTOSTR' then
+ Result := BoolToStr(Caller.Params[0])
+{$ENDIF}
+end;
+
+function TfsSysFunctions.CallMethod2(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ if MethodName = 'STRTOINT' then
+ Result := StrToInt(Caller.Params[0])
+{$IFDEF DELPHI6}
+ else if MethodName = 'STRTOINT64' then
+ Result := StrToInt64(Caller.Params[0])
+{$ENDIF}
+ else if MethodName = 'STRTOFLOAT' then
+ Result := StrToFloat(Caller.Params[0])
+ else if MethodName = 'STRTODATE' then
+ Result := StrToDate(Caller.Params[0])
+ else if MethodName = 'STRTOTIME' then
+ Result := StrToTime(Caller.Params[0])
+ else if MethodName = 'STRTODATETIME' then
+ Result := StrToDateTime(Caller.Params[0])
+{$IFDEF Delphi6}
+ else if MethodName = 'STRTOBOOL' then
+ Result := BoolToStr(Caller.Params[0])
+{$ENDIF}
+end;
+
+function TfsSysFunctions.CallMethod3(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ if MethodName = 'FORMAT' then
+ Result := FormatV(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'FORMATFLOAT' then
+ Result := FormatFloat(Caller.Params[0], Caller.Params[1] * 1.00000)
+ else if MethodName = 'FORMATDATETIME' then
+ Result := FormatDateTime(Caller.Params[0], Caller.Params[1])
+{$IFNDEF FPC}
+// fpc still have no maskedit
+ else if MethodName = 'FORMATMASKTEXT' then
+ Result := FormatMaskText(Caller.Params[0], Caller.Params[1])
+{$ENDIF}
+end;
+
+function TfsSysFunctions.CallMethod4(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ w1, w2, w3, w4: Word;
+begin
+ if MethodName = 'ENCODEDATE' then
+ Result := EncodeDate(Caller.Params[0], Caller.Params[1], Caller.Params[2])
+ else if MethodName = 'ENCODETIME' then
+ Result := EncodeTime(Caller.Params[0], Caller.Params[1], Caller.Params[2], Caller.Params[3])
+ else if MethodName = 'DECODEDATE' then
+ begin
+ DecodeDate(Caller.Params[0], w1, w2, w3);
+ Caller.Params[1] := w1;
+ Caller.Params[2] := w2;
+ Caller.Params[3] := w3;
+ end
+ else if MethodName = 'DECODETIME' then
+ begin
+ DecodeTime(Caller.Params[0], w1, w2, w3, w4);
+ Caller.Params[1] := w1;
+ Caller.Params[2] := w2;
+ Caller.Params[3] := w3;
+ Caller.Params[4] := w4;
+ end
+ else if MethodName = 'DATE' then
+ Result := Date
+ else if MethodName = 'TIME' then
+ Result := Time
+ else if MethodName = 'NOW' then
+ Result := Now
+ else if MethodName = 'DAYOFWEEK' then
+ Result := DayOfWeek(Caller.Params[0])
+ else if MethodName = 'ISLEAPYEAR' then
+ Result := IsLeapYear(Caller.Params[0])
+ else if MethodName = 'DAYSINMONTH' then
+ Result := DaysInMonth(Caller.Params[0], Caller.Params[1])
+end;
+
+function TfsSysFunctions.CallMethod5(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ s: String;
+ v: Variant;
+begin
+ if MethodName = 'LENGTH' then
+ begin
+ v := Caller.Params[0];
+ if VarIsArray(v) then
+ Result := VarArrayHighBound(v, 1) - VarArrayLowBound(v, 1) + 1
+ else
+ {$IFDEF FPC}
+ Result := UTF8Length(v)
+ {$ELSE}
+ Result := Length(v)
+ {$ENDIF}
+ end
+ else if MethodName = 'COPY' then
+ {$IFDEF FPC}
+ Result := UTF8Copy(Caller.Params[0], frxInteger(Caller.Params[1]), frxInteger(Caller.Params[2]))
+ {$ELSE}
+ Result := Copy(Caller.Params[0], frxInteger(Caller.Params[1]), frxInteger(Caller.Params[2]))
+ {$ENDIF}
+ else if MethodName = 'POS' then
+ {$IFNDEF FPC}
+ Result := Pos(Caller.Params[0], Caller.Params[1])
+ {$ELSE}
+ Result := UTF8Pos(AnsiString(Caller.Params[0]), AnsiString(Caller.Params[1]))
+ {$ENDIF}
+ else if (MethodName = 'DELETE') or (MethodName = 'DELETESTR') then
+ begin
+ s := Caller.Params[0];
+ {$IFNDEF FPC}
+ Delete(s, frxInteger(Caller.Params[1]), frxInteger(Caller.Params[2]));
+ {$ELSE}
+ UTF8Delete(s, frxInteger(Caller.Params[1]), frxInteger(Caller.Params[2]));
+ {$ENDIF}
+ Caller.Params[0] := s;
+ end
+ else if MethodName = 'INSERT' then
+ begin
+ s := Caller.Params[1];
+ {$IFNDEF FPC}
+ Insert(Caller.Params[0], s, Integer(Caller.Params[2]));
+ {$ELSE}
+ UTF8Insert(AnsiString(Caller.Params[0]), s, Integer(Caller.Params[2]));
+ {$ENDIF}
+ Caller.Params[1] := s;
+ end
+ else if MethodName = 'UPPERCASE' then
+ Result := {$IFDEF FPC}UTF8UpperString(Caller.Params[0]){$ELSE}AnsiUppercase(Caller.Params[0]){$ENDIF}
+ else if MethodName = 'LOWERCASE' then
+ Result := {$IFDEF FPC}UTF8LowerString(Caller.Params[0]){$ELSE}AnsiLowercase(Caller.Params[0]){$ENDIF}
+ else if MethodName = 'TRIM' then
+ Result := {$IFDEF FPC}UTF8Trim(Caller.Params[0]){$ELSE}Trim(Caller.Params[0]){$ENDIF}
+ else if MethodName = 'NAMECASE' then
+ Result := NameCase(Caller.Params[0])
+ else if MethodName = 'COMPARETEXT' then
+ Result := {$IFDEF FPC}UTF8CompareText(Caller.Params[0], Caller.Params[1]){$ELSE}AnsiCompareText(Caller.Params[0], Caller.Params[1]){$ENDIF}
+ else if MethodName = 'CHR' then
+ Result := Chr(Integer(Caller.Params[0]))
+ else if MethodName = 'ORD' then
+ Result := Ord(String(Caller.Params[0])[1])
+ else if MethodName = 'SETLENGTH' then
+ begin
+ if (TVarData(Caller.Params[0]).VType = varString) or
+{$IFDEF Delphi12}
+ (TVarData(Caller.Params[0]).VType = varUString) or
+{$ENDIF}
+ (TVarData(Caller.Params[0]).VType = varOleStr) then
+ begin
+ s := Caller.Params[0];
+ SetLength(s, Integer(Caller.Params[1]));
+ Caller.Params[0] := s;
+ end
+ else
+ begin
+ v := Caller.Params[0];
+ VarArrayRedim(v, Integer(Caller.Params[1]) - 1);
+ Caller.Params[0] := v;
+ end;
+ end
+end;
+
+function TfsSysFunctions.CallMethod6(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ if MethodName = 'ROUND' then
+ {$IFNDEF FPC}
+ Result := frxInteger(Round(Caller.Params[0] * 1.00000))
+ {$ELSE}
+ Result := frxInteger(Round(Extended(Caller.Params[0]) * 1.00000))
+ {$ENDIF}
+ else if MethodName = 'TRUNC' then
+ {$IFNDEF FPC}
+ Result := frxInteger(Trunc(Caller.Params[0] * 1.00000))
+ {$ELSE}
+ Result := frxInteger(Trunc(Extended(Caller.Params[0]) * 1.00000))
+ {$ENDIF}
+ else if MethodName = 'INT' then
+ Result := Int(Caller.Params[0] * 1.00000)
+ else if MethodName = 'FRAC' then
+ Result := Frac(Caller.Params[0] * 1.00000)
+ else if MethodName = 'SQRT' then
+ Result := Sqrt(Caller.Params[0] * 1.00000)
+ else if MethodName = 'ABS' then
+ Result := Abs(Caller.Params[0] * 1.00000)
+ else if MethodName = 'SIN' then
+ Result := Sin(Caller.Params[0] * 1.00000)
+ else if MethodName = 'COS' then
+ Result := Cos(Caller.Params[0] * 1.00000)
+ else if MethodName = 'ARCTAN' then
+ Result := ArcTan(Caller.Params[0] * 1.00000)
+ else if MethodName = 'TAN' then
+ Result := Sin(Caller.Params[0] * 1.00000) / Cos(Caller.Params[0] * 1.00000)
+ else if MethodName = 'EXP' then
+ Result := Exp(Caller.Params[0] * 1.00000)
+ else if MethodName = 'LN' then
+ Result := Ln(Caller.Params[0] * 1.00000)
+ else if MethodName = 'PI' then
+ Result := Pi
+end;
+
+function TfsSysFunctions.CallMethod7(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ if MethodName = 'INC' then
+ begin
+ Caller.Params[0] := Caller.Params[0] + Caller.Params[1];
+ end
+ else if MethodName = 'DEC' then
+ begin
+ Caller.Params[0] := Caller.Params[0] - Caller.Params[1];
+ end
+ else if MethodName = 'RAISEEXCEPTION' then
+ raise Exception.Create(Caller.Params[0])
+{$IFNDEF NOFORMS}
+ else if MethodName = 'SHOWMESSAGE' then
+ ShowMessage(Caller.Params[0])
+{$ENDIF}
+ else if MethodName = 'RANDOMIZE' then
+ Randomize
+ else if MethodName = 'RANDOM' then
+ Result := Random
+ else if MethodName = 'VALIDINT' then
+ Result := ValidInt(Caller.Params[0])
+ else if MethodName = 'VALIDFLOAT' then
+ Result := ValidFloat(Caller.Params[0])
+ else if MethodName = 'VALIDDATE' then
+ begin
+ if VarType(Caller.Params[0]) = varDate then
+ Result := ValidDate(DateToStr(Caller.Params[0]))
+ else Result := ValidDate(Caller.Params[0]);
+ end
+{$IFDEF OLE}
+ else if MethodName = 'CREATEOLEOBJECT' then
+ Result := CreateOleObject(Caller.Params[0])
+{$ENDIF}
+ else if MethodName = 'VARARRAYCREATE' then
+ Result := VArrayCreate(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'VARTOSTR' then
+ Result := VarToStr(Caller.Params[0])
+ else if MethodName = 'VARTYPE' then
+ Result := VarType(Caller.Params[0])
+ else if MethodName = 'EXTRACTFILEPATH' then
+ Result := ExtractFilePath(Caller.Params[0])
+end;
+
+
+end.
diff --git a/LibD28/fs_iteereg.pas b/LibD28/fs_iteereg.pas
new file mode 100644
index 0000000..6ddbd56
--- /dev/null
+++ b/LibD28/fs_iteereg.pas
@@ -0,0 +1,46 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Registration unit }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_iteereg;
+
+{$i fs.inc}
+
+interface
+
+
+procedure Register;
+
+implementation
+
+uses
+ Classes
+{$IFNDEF Delphi6}
+, DsgnIntf
+{$ELSE}
+{$IFDEF DELPHI16}
+, Controls
+{$ENDIF}
+, DesignIntf
+{$ENDIF}
+, fs_ichartrtti;
+
+{-----------------------------------------------------------------------}
+
+procedure Register;
+begin
+{$IFDEF DELPHI16}
+// GroupDescendentsWith(TfsChartRTTI, TControl);
+{$ENDIF}
+ RegisterComponents('FastScript',
+ [TfsChartRTTI]);
+end;
+
+end.
diff --git a/LibD28/fs_itools.pas b/LibD28/fs_itools.pas
new file mode 100644
index 0000000..0600c66
--- /dev/null
+++ b/LibD28/fs_itools.pas
@@ -0,0 +1,712 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Common functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_itools;
+
+interface
+
+{$i fs.inc}
+
+uses
+ SysUtils, Classes, TypInfo, fs_iinterpreter, fs_xml
+{$IFDEF Delphi6}
+, Variants
+{$ENDIF}
+{$IFDEF CROSS_COMPILE}
+, Types
+{$ELSE}
+, Windows
+{$ENDIF};
+// FMX USES section
+{$ELSE}
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, System.TypInfo, FMX.fs_iinterpreter, FMX.fs_xml
+{$IFDEF Delphi6}
+, System.Variants
+{$ENDIF}
+, System.Types, FMX.Types;
+{$ENDIF}
+
+type
+ TVarRecArray = array of TVarRec;
+
+
+procedure fsRegisterLanguage(const Name, Grammar: String);
+function fsGetLanguage(const Name: String): String;
+procedure fsGetLanguageList(List: TStrings);
+
+procedure GenerateXMLContents(Prog: TfsScript; Item: TfsXMLItem;
+ FunctionsOnly: Boolean = False);
+procedure GenerateMembers(Prog: TfsScript; cl: TClass; Item: TfsXMLItem);
+function StrToVarType(const TypeName: String; Script: TfsScript): TfsVarType;
+function TypesCompatible(Typ1, Typ2: TfsTypeRec; Script: TfsScript): Boolean;
+function AssignCompatible(Var1, Var2: TfsCustomVariable; Script: TfsScript): Boolean;
+function VarRecToVariant(v: TVarRec): Variant;
+procedure VariantToVarRec(v: Variant; var ar: TVarRecArray; var sPtrList: Tlist);
+procedure ClearVarRec(var ar: TVarRecArray; var sPtrList: TList);
+function ParserStringToVariant(s: String): Variant;
+function ParseMethodSyntax(const Syntax: String; Script: TfsScript): TfsCustomVariable;
+function fsPosToPoint(const ErrorPos: String): TPoint;
+{$IFNDEF Delphi4}
+function fsSetToString(PropInfo: PPropInfo; const Value: Variant): string;
+{$ENDIF}
+
+implementation
+//VCL uses section
+{$IFNDEF FMX}
+uses
+ fs_iparser,
+ fs_iconst;
+//FMX uses section
+{$ELSE}
+uses
+ FMX.fs_iparser,
+ FMX.fs_iconst;
+{$ENDIF}
+
+var
+ Languages: TStringList;
+
+procedure fsRegisterLanguage(const Name, Grammar: String);
+var
+ i: Integer;
+begin
+ i := Languages.IndexOfName(Name);
+ if i = -1 then
+ Languages.Add(Name + '=' + Grammar)
+ else
+ Languages[i] := Name + '=' + Grammar;
+end;
+
+function fsGetLanguage(const Name: String): String;
+begin
+ if Languages.IndexOfName(Name) = -1 then
+ raise Exception.CreateFmt(SLangNotFound, [Name]) else
+ Result := Languages.Values[Name];
+end;
+
+procedure fsGetLanguageList(List: TStrings);
+var
+ i: Integer;
+begin
+ List.Clear;
+ for i := 0 to Languages.Count - 1 do
+ if Languages.Names[i][1] <> '@' then
+ List.Add(Languages.Names[i]);
+end;
+
+
+function StrToVarType(const TypeName: String; Script: TfsScript): TfsVarType;
+var
+ v: TfsCustomVariable;
+begin
+ v := Script.Find(TypeName);
+ if v = nil then
+ Result := fvtClass else
+ Result := v.Typ;
+end;
+
+function ClassesCompatible(const Class1, Class2: String; Script: TfsScript): Boolean;
+var
+ cl1, cl2: TfsClassVariable;
+begin
+ Result := False;
+ cl1 := Script.FindClass(Class1);
+ cl2 := Script.FindClass(Class2);
+ if (cl1 <> nil) and (cl2 <> nil) then
+ Result := cl2.ClassRef.InheritsFrom(cl1.ClassRef);
+end;
+
+function TypesCompatible(Typ1, Typ2: TfsTypeRec; Script: TfsScript): Boolean;
+begin
+ Result := False;
+ case Typ1.Typ of
+ fvtInt:
+ Result := Typ2.Typ in [fvtInt, fvtFloat, fvtVariant, fvtEnum, fvtInt64];
+{$IFDEF FS_INT64}
+ fvtInt64:
+ Result := Typ2.Typ in [fvtInt64, fvtInt, fvtFloat, fvtVariant, fvtEnum];
+{$ENDIF}
+ fvtFloat:
+ Result := Typ2.Typ in [fvtInt, fvtFloat, fvtVariant];
+ fvtBool:
+ Result := Typ2.Typ in [fvtBool, fvtVariant];
+ fvtChar, fvtString:
+ Result := Typ2.Typ in [fvtChar, fvtString, fvtVariant];
+ fvtClass:
+ Result := (Typ2.Typ = fvtVariant) or ((Typ2.Typ = fvtClass) and
+ ClassesCompatible(Typ1.TypeName, Typ2.TypeName, Script));
+ fvtArray:
+ Result := Typ2.Typ in [fvtArray, fvtVariant];
+ fvtVariant:
+ Result := True;
+ fvtEnum:
+ begin
+ Result := Typ2.Typ in [fvtInt, fvtInt64, fvtVariant, fvtEnum];
+ if Typ2.Typ = fvtEnum then
+ Result := AnsiCompareText(Typ1.TypeName, Typ2.TypeName) = 0;
+ end;
+ end;
+end;
+
+function AssignCompatible(Var1, Var2: TfsCustomVariable; Script: TfsScript): Boolean;
+var
+ t1, t2: TfsTypeRec;
+begin
+ t1.Typ := Var1.Typ;
+ t1.TypeName := Var1.TypeName;
+ t2.Typ := Var2.Typ;
+ t2.TypeName := Var2.TypeName;
+
+ Result := TypesCompatible(t1, t2, Script);
+ if Result and (Var1.Typ = fvtInt) and (Var2.Typ = fvtFloat) then
+ Result := False;
+end;
+
+function VarRecToVariant(v: TVarRec): Variant;
+begin
+ with v do
+ case VType of
+{$IFDEF FS_INT64}
+ vtInt64:
+ Result := VInt64^;
+{$ENDIF}
+{$IFDEF CPUX64}
+ vtInteger:
+ Result := VInteger;
+ vtObject:
+ Result := frxInteger(VObject);
+{$ELSE}
+ vtInteger, vtObject:
+ Result := VInteger;
+{$ENDIF}
+ vtBoolean:
+ Result := VBoolean;
+ vtExtended, vtCurrency:
+ Result := VExtended^;
+ vtChar:
+ Result := VChar;
+ vtString:
+ Result := VString^;
+ vtAnsiString:
+ Result := AnsiString(VAnsiString);
+{$IFDEF Delphi12}
+ vtUnicodeString:
+ Result := String(VUnicodeString);
+ vtWideString:
+ Result := WideString(VWideString);
+ vtWideChar:
+ Result := VWideChar;
+{$ENDIF}
+ vtVariant:
+ Result := VVariant^;
+ else
+ Result := Null;
+ end;
+end;
+
+procedure VariantToVarRec(v: Variant; var ar: TVarRecArray; var sPtrList: TList);
+var
+ i: Integer;
+{$IFDEF Delphi12}
+ pWStr: PWideString;
+{$ELSE}
+{$IFDEF FPC}
+ pWStr: PWideString;
+{$ELSE}
+ pAStr: PAnsiString;
+{$ENDIF}
+{$ENDIF}
+begin
+ SetLength(ar, VarArrayHighBound(v, 1) + 1);
+
+ sPtrList := TList.Create;
+ for i := 0 to VarArrayHighBound(v, 1) do
+ case TVarData(v[i]).VType of
+ varSmallint, varInteger, varByte{$IFDEF Delphi6}, varShortInt, varWord, varLongWord{$ENDIF}:
+ begin
+ ar[i].VType := vtInteger;
+ ar[i].VInteger := v[i];
+ end;
+{$IFDEF DELPHI6}
+ varInt64:
+ begin
+ ar[i].VType := vtInt64;
+ New(ar[i].VInt64);
+ ar[i].VInt64^ := v[i];
+ end;
+{$ENDIF}
+ varSingle, varDouble, varCurrency, varDate:
+ begin
+ ar[i].VType := vtExtended;
+ New(ar[i].VExtended);
+ ar[i].VExtended^ := v[i];
+ end;
+ varBoolean:
+ begin
+ ar[i].VType := vtBoolean;
+ ar[i].VBoolean := v[i];
+ end;
+ varString:
+ begin
+ ar[i].VType := vtString;
+ New(ar[i].VString);
+{$IFDEF Delphi12}
+ ar[i].VString^ := AnsiString(v[i]);
+{$ELSE}
+ ar[i].VString^ := v[i];
+{$ENDIF}
+ end;
+ varOleStr:
+ begin
+{$IFDEF Delphi12}
+ ar[i].VType := vtWideString;
+ New(pWStr);
+ sPtrList.Add(pWStr);
+ pWStr^ := WideString(v[i]);
+ ar[i].VWideString := PWideString(pWStr^);
+{$ELSE}
+{$IFDEF FPC}
+ ar[i].VType := vtWideString;
+ New(pWStr);
+ sPtrList.Add(pWStr);
+ pWStr^ := WideString(v[i]);
+ ar[i].VWideString := PWideString(pWStr^);
+{$ELSE}
+ ar[i].VType := vtAnsiString;
+ //New(ar[i].VAnsiString);
+ New(pAStr);
+ sPtrList.Add(pAStr);
+ pAStr^ := AnsiString(v[i]);
+ ar[i].VAnsiString := PAnsiString(pAStr^);
+{$ENDIF}
+{$ENDIF}
+ end;
+{$IFDEF Delphi12}
+ varUString:
+ begin
+ ar[i].VType := vtUnicodeString;
+ New(ar[i].VUnicodeString);
+ PUnicodeString(ar[i].VUnicodeString)^ := v[i];
+ end;
+{$ENDIF}
+ varVariant:
+ begin
+ ar[i].VType := vtVariant;
+ New(ar[i].VVariant);
+ ar[i].VVariant^ := v[i];
+ end;
+ end;
+end;
+
+procedure ClearVarRec(var ar: TVarRecArray; var sPtrList: TList);
+var
+ i: Integer;
+begin
+ for i := 0 to Length(ar) - 1 do
+ if ar[i].VType in [vtExtended, vtString, vtVariant {$IFDEF Delphi6}, vtInt64 {$ENDIF}] then
+ Dispose(ar[i].VExtended)
+{$IFDEF Delphi12}
+ else if ar[i].VType in [vtWideString] then
+ WideString(ar[i].VWideString) := ''
+{$ENDIF}
+ else if ar[i].VType in [vtAnsiString] then
+ AnsiString(ar[i].VAnsiString) := '';
+ for i := 0 to sPtrList.Count - 1 do
+ Dispose(sPtrList[i]);
+ sPtrList.Free;
+ Finalize(ar);
+end;
+
+function ParserStringToVariant(s: String): Variant;
+var
+ i: Int64;
+ k: Integer;
+ iPos: Integer;
+begin
+ Result := Null;
+ if s <> '' then
+ if s[1] = '''' then
+ Result := Copy(s, 2, Length(s) - 2)
+ else
+ begin
+ Val(s, i, k);
+ if k = 0 then
+{$IFDEF Delphi6}
+ if i > MaxInt then
+ Result := i
+ else
+ Result := Integer(i)
+{$ELSE}
+ Result := Integer(i)
+{$ENDIF}
+ else
+ begin
+{$IFDEF FMX}
+ if FormatSettings.DecimalSeparator <> '.' then
+{$ELSE}
+{$IFDEF DELPHI16}
+ if FormatSettings.DecimalSeparator <> '.' then
+{$ELSE}
+ if DecimalSeparator <> '.' then
+{$ENDIF}
+{$ENDIF}
+ begin
+ iPos := Pos('.', s);
+ if iPos > 0 then
+ s[iPos] := {$IFDEF DELPHI16}FormatSettings.{$ENDIF}DecimalSeparator;
+ end;
+ Result := StrToFloat(s);
+ end;
+ end;
+end;
+
+function ParseMethodSyntax(const Syntax: String; Script: TfsScript): TfsCustomVariable;
+var
+ Parser: TfsParser;
+ i, j: Integer;
+ Name, Params, TypeName, s: String;
+ isFunc, isMacro, varParam: Boolean;
+ InitValue: Variant;
+ IsParamWithDef: Boolean;
+ v: TfsCustomVariable;
+
+ procedure AddParams;
+ var
+ i: Integer;
+ p: TfsParamItem;
+ sl: TStringList;
+ begin
+ sl := TStringList.Create;
+ try
+ Delete(Params, Length(Params), 1);
+ sl.CommaText := Params;
+ for i := 0 to sl.Count - 2 do
+ begin
+ p := TfsParamItem.Create(sl[i], StrToVarType(TypeName, Script), TypeName,
+ False, varParam);
+ Result.Add(p);
+ end;
+ p := TfsParamItem.Create(sl[sl.Count - 1], StrToVarType(TypeName, Script), TypeName,
+ IsParamWithDef, varParam);
+ p.DefValue := InitValue;
+ Result.Add(p);
+
+ finally
+ sl.Free;
+ end;
+ end;
+
+begin
+ Parser := TfsParser.Create;
+ if Script.ExtendedCharset then
+ for i := 128 to 255 do
+ Parser.IdentifierCharset := Parser.IdentifierCharset + [Chr(i)];
+ Parser.Text := Syntax;
+
+ s := Parser.GetIdent;
+ isMacro := Pos('macro', AnsiLowercase(s)) = 1;
+ if isMacro then
+ s := Copy(s, 6, 255);
+ isFunc := CompareText(s, 'function') = 0;
+ Name := Parser.GetIdent;
+
+ if isFunc then
+ begin
+ j := Length(Syntax);
+ while (Syntax[j] <> ':') and (j <> 0) do
+ Dec(j);
+
+ i := Parser.Position;
+ Parser.Position := j + 1;
+ TypeName := Parser.GetIdent;
+ Parser.Position := i;
+ end
+ else
+ TypeName := '';
+
+ Result := TfsCustomVariable.Create(Name, StrToVarType(TypeName, Script), TypeName);
+ Result.IsMacro := IsMacro;
+
+ Parser.SkipSpaces;
+ s := Parser.GetChar;
+ if s = '(' then
+ begin
+ repeat
+ varParam := False;
+ Params := '';
+
+ repeat
+ s := Parser.GetIdent;
+ if CompareText(s, 'var') = 0 then
+ varParam := True
+ else if CompareText(s, 'const') = 0 then // do nothing
+ else
+ Params := Params + s + ',';
+ Parser.SkipSpaces;
+ s := Parser.GetChar;
+ if s = ':' then
+ begin
+ TypeName := Parser.GetIdent;
+ Parser.SkipSpaces;
+ i := Parser.Position;
+ IsParamWithDef:=False;
+ if Parser.GetChar = '=' then
+ begin
+ IsParamWithDef:=True;
+ s := Parser.GetNumber;
+ if s = '' then
+ s := Parser.GetString;
+ if s = '' then
+ begin
+ i := Parser.Position;
+ s := Parser.GetChar;
+ if s = '-' then
+ s := '-' + Parser.GetNumber else
+ Parser.Position := i;
+ end;
+
+ if s <> '' then
+ InitValue := ParserStringToVariant(s)
+ else
+ begin
+ s := Parser.GetIdent; { it's constant }
+ v := Script.Find(s);
+ if v <> nil then
+ InitValue := v.Value else
+ InitValue := Null;
+ end
+ end
+ else
+ begin
+ InitValue := Null;
+ Parser.Position := i;
+ end;
+ AddParams;
+ s := ';';
+ end
+ else if s = ')' then
+ begin
+ Parser.Position := Parser.Position - 1;
+ break;
+ end;
+ until s = ';';
+
+ Parser.SkipSpaces;
+ until Parser.GetChar = ')';
+ end;
+
+ Parser.Free;
+end;
+
+function fsPosToPoint(const ErrorPos: String): TPoint;
+begin
+ Result.X := 0;
+ Result.Y := 0;
+ if ErrorPos <> '' then
+ begin
+ Result.Y := StrToInt(Copy(ErrorPos, 1, Pos(':', ErrorPos) - 1));
+ Result.X := StrToInt(Copy(ErrorPos, Pos(':', ErrorPos) + 1, 255));
+ end;
+end;
+
+procedure GenerateXMLContents(Prog: TfsScript; Item: TfsXMLItem;
+ FunctionsOnly: Boolean = False);
+var
+ i, j: Integer;
+ v: TfsCustomVariable;
+ c: TfsClassVariable;
+ xi: TfsXMLItem;
+ clItem: TfsCustomHelper;
+ s: String;
+begin
+ Item.FindItem('Functions');
+ Item.FindItem('Classes');
+ Item.FindItem('Types');
+ Item.FindItem('Variables');
+ Item.FindItem('Constants');
+
+ for i := 0 to Prog.Count - 1 do
+ begin
+ v := Prog.Items[i];
+ if not (v is TfsMethodHelper) and FunctionsOnly then
+ continue;
+ if v is TfsMethodHelper then
+ begin
+ xi := Item.FindItem('Functions');
+ xi := xi.FindItem(TfsMethodHelper(v).Category);
+ xi.Text := 'text="' + xi.Name + '"';
+ with xi.Add do
+ begin
+ Name := 'item';
+ s := TfsMethodHelper(v).Syntax;
+ Text := 'text="' + s + '" description="' +
+ TfsMethodHelper(v).Description + '"';
+ end;
+ end
+ else if v is TfsClassVariable then
+ begin
+ c := TfsClassVariable(v);
+ xi := Item.FindItem('Classes');
+ xi := xi.Add;
+ with xi do
+ begin
+ Name := 'item';
+ Text := 'text="' + c.Name + ' = class(' + c.Ancestor + ')"';
+ end;
+
+ for j := 0 to c.MembersCount - 1 do
+ begin
+ clItem := c.Members[j];
+ with xi.Add do
+ begin
+ Name := 'item';
+ Text := 'text="';
+ if clItem is TfsPropertyHelper then
+ Text := Text + 'property ' + clItem.Name + ': ' + clItem.GetFullTypeName + '"'
+ else if clItem is TfsMethodHelper then
+ begin
+ s := TfsMethodHelper(clItem).Syntax;
+ if TfsMethodHelper(clItem).IndexMethod then
+ s := 'index property' + Copy(s, Pos(' ', s), 255);
+ Text := Text + s + '"';
+ end
+ else
+ Text := Text + 'event ' + clItem.Name + '"';
+ end;
+ end;
+ end
+ else if v is TfsVariable then
+ begin
+ if v.Typ = fvtEnum then
+ begin
+ xi := Item.FindItem('Types');
+ with xi.FindItem(v.TypeName) do
+ begin
+ if v.Name <> v.TypeName then
+ if Text = '' then
+ Text := v.Name else
+ Text := Text + ',' + v.Name;
+ end;
+ end
+ else
+ begin
+ if v.IsReadOnly then
+ xi := Item.FindItem('Constants') else
+ xi := Item.FindItem('Variables');
+ with xi.Add do
+ begin
+ Name := 'item';
+ Text := 'text="' + v.Name + ': ' + v.GetFullTypeName;
+ if v.IsReadOnly then
+ Text := Text + ' = ' + VarToStr(v.Value);
+ Text := Text + '"';
+ end;
+ end;
+ end;
+ end;
+
+ xi := Item.FindItem('types');
+ for i := 0 to xi.Count - 1 do
+ if xi[i].Name <> 'item' then
+ begin
+ xi[i].Text := 'text="' + xi[i].Name + ': (' + xi[i].Text + ')"';
+ xi[i].Name := 'item';
+ end;
+end;
+
+procedure GenerateMembers(Prog: TfsScript; cl: TClass; Item: TfsXMLItem);
+var
+ i, j: Integer;
+ v: TfsCustomVariable;
+ c: TfsClassVariable;
+ xi: TfsXMLItem;
+ clItem: TfsCustomHelper;
+ s: String;
+begin
+ for i := 0 to Prog.Count - 1 do
+ begin
+ v := Prog.Items[i];
+ if v is TfsClassVariable then
+ begin
+ c := TfsClassVariable(v);
+ if cl.InheritsFrom(c.ClassRef) then
+ begin
+ xi := Item;
+ for j := 0 to c.MembersCount - 1 do
+ begin
+ clItem := c.Members[j];
+ with xi.Add do
+ begin
+ Name := 'item';
+ Text := 'text="';
+ if clItem is TfsPropertyHelper then
+ Text := Text + 'property ' + clItem.Name + ': ' + clItem.GetFullTypeName + '"'
+ else if clItem is TfsMethodHelper then
+ begin
+ s := TfsMethodHelper(clItem).Syntax;
+ if TfsMethodHelper(clItem).IndexMethod then
+ s := 'index property' + Copy(s, Pos(' ', s), 255);
+ Text := Text + s + '"';
+ end
+ else
+ Text := Text + 'event ' + clItem.Name + '"';
+ end;
+ end;
+ end;
+ end;
+ end;
+end;
+
+{$IFNDEF Delphi4}
+function fsSetToString(PropInfo: PPropInfo; const Value: Variant): string;
+var
+ S: TIntegerSet;
+ TypeInfo: PTypeInfo;
+ I: Integer;
+begin
+ Result := '';
+{$IFNDEF FPC}
+ TypeInfo := GetTypeData(PropInfo^.PropType^)^.CompType^;
+{$ELSE}
+ TypeInfo := GetTypeData(PropInfo^.PropType)^.CompType;
+{$ENDIF}
+
+ Integer(S) := 0;
+ if VarIsArray(Value) then
+ for I := 0 to VarArrayHighBound(Value, 1) do
+ begin
+ Integer(S) := Integer(S) or Value[I];
+ end;
+
+ for I := 0 to SizeOf(Integer) * 8 - 1 do
+ if I in S then
+ begin
+ if Result <> '' then
+ Result := Result + ',';
+ Result := Result + GetEnumName(TypeInfo, I);
+ end;
+ Result := '[' + Result + ']';
+end;
+{$ENDIF}
+
+initialization
+ Languages := TStringList.Create;
+
+finalization
+ Languages.Free;
+
+end.
\ No newline at end of file
diff --git a/LibD28/fs_lazarus.lpk b/LibD28/fs_lazarus.lpk
new file mode 100644
index 0000000..3002007
--- /dev/null
+++ b/LibD28/fs_lazarus.lpk
@@ -0,0 +1,159 @@
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/LibD28/fs_lazarus.pas b/LibD28/fs_lazarus.pas
new file mode 100644
index 0000000..7b46f56
--- /dev/null
+++ b/LibD28/fs_lazarus.pas
@@ -0,0 +1,25 @@
+{ This file was automatically created by Lazarus. do not edit!
+ This source is only used to compile and install the package.
+ }
+
+unit fs_lazarus;
+
+interface
+
+uses
+ fs_ipascal, fs_icpp, fs_ijs, fs_ibasic, fs_iclassesrtti, fs_iconst,
+ fs_idialogsrtti, fs_ievents, fs_iexpression, fs_iextctrlsrtti,
+ fs_iformsrtti, fs_igraphicsrtti, fs_iilparser, fs_iinirtti, fs_iinterpreter,
+ fs_iparser, fs_isysrtti, fs_itools, fs_xml, fs_ireg, fs_synmemo, fs_tree,
+ fs_idbrtti, LazarusPackageIntf;
+
+implementation
+
+procedure Register;
+begin
+ RegisterUnit('fs_ireg', @fs_ireg.Register);
+end;
+
+initialization
+ RegisterPackage('fs_lazarus', @Register);
+end.
diff --git a/LibD28/fs_synmemo.dfm b/LibD28/fs_synmemo.dfm
new file mode 100644
index 0000000..de03635
Binary files /dev/null and b/LibD28/fs_synmemo.dfm differ
diff --git a/LibD28/fs_synmemo.lfm b/LibD28/fs_synmemo.lfm
new file mode 100644
index 0000000..f594eee
--- /dev/null
+++ b/LibD28/fs_synmemo.lfm
@@ -0,0 +1,56 @@
+object fsSynMemoSearch: TfsSynMemoSearch
+ Left = 289
+ Height = 50
+ Top = 229
+ Width = 243
+ HorzScrollBar.Page = 242
+ VertScrollBar.Page = 49
+ ActiveControl = Edit1
+ BorderStyle = bsToolWindow
+ Caption = 'Search'
+ ClientHeight = 50
+ ClientWidth = 243
+ Font.Height = -11
+ Font.Name = 'Tahoma'
+ KeyPreview = True
+ OnKeyPress = FormKeyPress
+ Position = poScreenCenter
+ LCLVersion = '0.9.29'
+ object Label1: TLabel
+ Left = 6
+ Height = 13
+ Top = 7
+ Width = 69
+ AutoSize = False
+ Caption = 'Text to find'
+ ParentColor = False
+ end
+ object Search: TButton
+ Left = 111
+ Height = 17
+ Top = 31
+ Width = 58
+ BorderSpacing.InnerBorder = 4
+ Caption = 'Search'
+ ModalResult = 1
+ TabOrder = 0
+ end
+ object Button1: TButton
+ Left = 175
+ Height = 17
+ Top = 31
+ Width = 61
+ BorderSpacing.InnerBorder = 4
+ Cancel = True
+ Caption = 'Cancel'
+ ModalResult = 2
+ TabOrder = 1
+ end
+ object Edit1: TEdit
+ Left = 80
+ Height = 21
+ Top = 4
+ Width = 156
+ TabOrder = 2
+ end
+end
diff --git a/LibD28/fs_synmemo.pas b/LibD28/fs_synmemo.pas
new file mode 100644
index 0000000..8b4df07
--- /dev/null
+++ b/LibD28/fs_synmemo.pas
@@ -0,0 +1,2113 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Syntax memo control }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+{ Simple syntax highlighter. Supports Pascal, C++, JS, VB and SQL syntax.
+
+ Assign text to Text property.
+ Assign desired value to SyntaxType property.
+ Call SetPos to move caret.
+ Call ShowMessage to display an error message at the bottom.
+}
+
+unit fs_synmemo;
+
+interface
+
+{$I fs.inc}
+
+uses
+{$IFNDEF FPC}
+ Windows, Messages,
+{$ELSE}
+ LCLType, LMessages, Buttons, LCLIntf,
+{$ENDIF}
+ StdCtrls, Controls, Classes,
+ SysUtils, Graphics, Forms, Menus;
+
+type
+
+ TSyntaxType = (stPascal, stCpp, stJs, stVB, stSQL, stText);
+ TCharAttr = (caNo, caText, caBlock, caComment, caKeyword, caString);
+ TCharAttributes = set of TCharAttr;
+
+{$i frxPlatformsAttribute.inc}
+ TfsSyntaxMemo = class(TCustomControl)
+ private
+ FAllowLinesChange: Boolean;
+ FCharHeight: Integer;
+ FCharWidth: Integer;
+ FDoubleClicked: Boolean;
+ FDown: Boolean;
+ FGutterWidth: Integer;
+ FFooterHeight: Integer;
+ FIsMonoType: Boolean;
+ FKeywords: String;
+ FMaxLength: Integer;
+ FMessage: String;
+ FModified: Boolean;
+ FMoved: Boolean;
+ FOffset: TPoint;
+ FPos: TPoint;
+ FReadOnly: Boolean;
+ FSelEnd: TPoint;
+ FSelStart: TPoint;
+ FSynStrings: TStrings;
+ FSyntaxType: TSyntaxType;
+ FTempPos: TPoint;
+ FText: TStringList;
+ FKeywordAttr: TFont;
+ FStringAttr: TFont;
+ FTextAttr: TFont;
+ FCommentAttr: TFont;
+ FBlockColor: TColor;
+ FBlockFontColor: TColor;
+ FUndo: TStringList;
+ FUpdating: Boolean;
+ FUpdatingSyntax: Boolean;
+ FVScroll: TScrollBar;
+ FWindowSize: TPoint;
+ FPopupMenu: TPopupMenu;
+ KWheel: Integer;
+ LastSearch: String;
+ FShowGutter: boolean;
+ FShowFooter: boolean;
+ Bookmarks: array of Integer;
+ FActiveLine: Integer;
+ FOnChange: TNotifyEvent;
+ function GetText: TStrings;
+ procedure SetText(Value: TStrings);
+ procedure SetSyntaxType(Value: TSyntaxType);
+ procedure SetShowGutter(Value: boolean);
+ procedure SetShowFooter(Value: boolean);
+ function FMemoFind(Text: String; var Position : TPoint): boolean;
+ function GetCharAttr(Pos: TPoint): TCharAttributes;
+ function GetLineBegin(Index: Integer): Integer;
+ function GetPlainTextPos(Pos: TPoint): Integer;
+ function GetPosPlainText(Pos: Integer): TPoint;
+ function GetSelText: String;
+ function LineAt(Index: Integer): String;
+ function LineLength(Index: Integer): Integer;
+ function Pad(n: Integer): String;
+ procedure AddSel;
+ procedure AddUndo;
+ procedure ClearSel;
+ procedure CreateSynArray;
+ procedure DoChange;
+ procedure EnterIndent;
+ procedure SetSelText(Value: String);
+ procedure ShiftSelected(ShiftRight: Boolean);
+ procedure ShowCaretPos;
+ procedure TabIndent;
+ procedure UnIndent;
+ procedure UpdateScrollBar;
+ procedure UpdateSyntax;
+ procedure DoLeft;
+ procedure DoRight;
+ procedure DoUp;
+ procedure DoDown;
+ procedure DoHome(Ctrl: Boolean);
+ procedure DoEnd(Ctrl: Boolean);
+ procedure DoPgUp;
+ procedure DoPgDn;
+ procedure DoChar(Ch: Char);
+ procedure DoReturn;
+ procedure DoDel;
+ procedure DoBackspace;
+ procedure DoCtrlI;
+ procedure DoCtrlU;
+ procedure DoCtrlR;
+ procedure DoCtrlL;
+ procedure ScrollClick(Sender: TObject);
+ procedure ScrollEnter(Sender: TObject);
+ procedure LinesChange(Sender: TObject);
+ procedure ShowPos;
+ procedure BookmarkDraw(Y :integer; ALine : integer);
+ procedure ActiveLineDraw(Y :integer; ALine : integer);
+ procedure CorrectBookmark(Line : integer; delta : integer);
+ procedure SetKeywordAttr(Value: TFont);
+ procedure SetStringAttr(Value: TFont);
+ procedure SetTextAttr(Value: TFont);
+ procedure SetCommentAttr(Value: TFont);
+
+ protected
+ { Windows-specific stuff }
+ procedure CreateParams(var Params: TCreateParams); override;
+ procedure WMGetDlgCode(var Message: {$IFNDEF FPC}TWMGetDlgCode{$ELSE}TLMNoParams{$ENDIF}); message {$IFNDEF FPC}WM_GETDLGCODE{$ELSE}LM_GETDLGCODE{$ENDIF};
+ procedure WMKillFocus(var Msg: {$IFNDEF FPC}TWMKillFocus{$ELSE}TLMKillFocus{$ENDIF}); message {$IFNDEF FPC}WM_KILLFOCUS{$ELSE}LM_KILLFOCUS{$ENDIF};
+ procedure WMSetFocus(var Msg: {$IFNDEF FPC}TWMSetFocus{$ELSE}TLMSetFocus{$ENDIF}); message {$IFNDEF FPC}WM_SETFOCUS{$ELSE}LM_SETFOCUS{$ENDIF};
+ {$IFNDEF FPC}
+ procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
+ {$ELSE}
+ procedure FontChanged(Sender: TObject); override;
+ {$ENDIF}
+ { End of stuff }
+ procedure SetParent(Value: TWinControl); override;
+ function GetClientRect: TRect; override;
+ procedure DblClick; override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer); override;
+ procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer); override;
+ procedure KeyDown(var Key: Word; Shift: TShiftState); override;
+ procedure KeyPress(var Key: Char); override;
+ procedure CopyPopup(Sender: TObject);
+ procedure PastePopup(Sender: TObject);
+ procedure CutPopup(Sender: TObject);
+{$IFDEF Delphi4}
+ procedure MouseWheelUp(Sender: TObject; Shift: TShiftState;
+ MousePos: TPoint; var Handled: Boolean);
+ procedure MouseWheelDown(Sender: TObject; Shift: TShiftState;
+ MousePos: TPoint; var Handled: Boolean);
+{$ENDIF}
+ procedure DOver(Sender, Source: TObject; X, Y: Integer;
+ State: TDragState; var Accept: Boolean);
+ procedure DDrop(Sender, Source: TObject; X, Y: Integer);
+
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
+ procedure Paint; override;
+ procedure CopyToClipboard;
+ procedure CutToClipboard;
+ procedure PasteFromClipboard;
+ procedure SetPos(x, y: Integer);
+ procedure ShowMessage(s: String);
+ procedure Undo;
+ procedure UpdateView;
+ function GetPos: TPoint;
+ function Find(Text: String): boolean;
+ property Modified: Boolean read FModified write FModified;
+ property SelText: String read GetSelText write SetSelText;
+ function IsBookmark(Line : integer): integer;
+ procedure AddBookmark(Line, Number : integer);
+ procedure DeleteBookmark(Number : integer);
+ procedure GotoBookmark(Number : integer);
+ procedure SetActiveLine(Line : Integer);
+ function GetActiveLine: Integer;
+
+ published
+ property Align;
+ property Anchors;
+ property BiDiMode;
+ property Color;
+ property Constraints;
+ property DragCursor;
+ property DragKind;
+ property DragMode;
+ property Enabled;
+ property Font;
+ property ParentColor;
+ property ParentBiDiMode;
+{$IFNDEF FPC}
+ property ParentCtl3D;
+{$ENDIF}
+ property ParentFont;
+ property ParentShowHint;
+ property PopupMenu;
+ property ShowHint;
+ property TabOrder;
+ property TabStop;
+ property Width;
+ property Height;
+ property Visible;
+ property BlockColor: TColor read FBlockColor write FBlockColor;
+ property BlockFontColor: TColor read FBlockFontColor write FBlockFontColor;
+ property CommentAttr: TFont read FCommentAttr write SetCommentAttr;
+ property KeywordAttr: TFont read FKeywordAttr write SetKeywordAttr;
+ property StringAttr: TFont read FStringAttr write SetStringAttr;
+ property TextAttr: TFont read FTextAttr write SetTextAttr;
+ property Lines: TStrings read GetText write SetText;
+ property ReadOnly: Boolean read FReadOnly write FReadOnly;
+ property SyntaxType: TSyntaxType read FSyntaxType write SetSyntaxType;
+ property ShowFooter: boolean read FShowFooter write SetShowFooter;
+ property ShowGutter: boolean read FShowGutter write SetShowGutter;
+ property OnChange: TNotifyEvent read FOnChange write FOnChange;
+ property OnClick;
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEndDrag;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ property OnStartDrag;
+ end;
+
+ TfsSynMemoSearch = class(TForm)
+ Search: TButton;
+ Button1: TButton;
+ Label1: TLabel;
+ Edit1: TEdit;
+ procedure FormKeyPress(Sender: TObject; var Key: Char);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+var
+ SynMemoSearch: TfsSynMemoSearch;
+
+implementation
+
+{$IFNDEF FPC}
+ {$R *.dfm}
+{$ELSE}
+ {$R *.lfm}
+{$ENDIF}
+
+uses Clipbrd, comctrls;
+
+const
+ PasKeywords =
+ 'and,array,begin,case,const,div,do,downto,else,end,except,finally,'+
+ 'for,function,if,in,is,mod,nil,not,of,or,procedure,program,repeat,shl,'+
+ 'shr,string,then,to,try,until,uses,var,while,with,xor';
+
+ CppKeywords =
+ 'bool,break,case,char,continue,define,default,delete,do,double,else,'+
+ 'except,finally,float,for,if,include,int,is,new,return,string,switch,try,'+
+ 'variant,void,while';
+
+ SQLKeywords =
+ 'active,after,all,alter,and,any,as,asc,ascending,at,auto,' +
+ 'base_name,before,begin,between,by,cache,cast,check,column,commit,' +
+ 'committed,computed,conditional,constraint,containing,count,create,' +
+ 'current,cursor,database,debug,declare,default,delete,desc,descending,' +
+ 'distinct,do,domain,drop,else,end,entry_point,escape,exception,execute,' +
+ 'exists,exit,external,extract,filter,for,foreign,from,full,function,' +
+ 'generator,grant,group,having,if,in,inactive,index,inner,insert,into,is,' +
+ 'isolation,join,key,left,level,like,merge,names,no,not,null,of,on,only,' +
+ 'or,order,outer,parameter,password,plan,position,primary,privileges,' +
+ 'procedure,protected,read,retain,returns,revoke,right,rollback,schema,' +
+ 'select,set,shadow,shared,snapshot,some,suspend,table,then,to,' +
+ 'transaction,trigger,uncommitted,union,unique,update,user,using,values,' +
+ 'view,wait,when,where,while,with,work';
+
+ JSKeywords =
+ 'break,case,continue,default,delete,do,else,except,finally,for,function,' +
+ 'import,in,is,if,new,return,switch,try,var,while,with';
+
+ VBKeywords =
+ 'addressof,and,as,byref,byval,case,catch,delete,dim,do,else,elseif,' +
+ 'end,endif,exit,finally,for,function,if,imports,is,loop,mod,new,next,' +
+ 'not,or,rem,return,select,set,step,sub,then,to,try,wend,while,with,xor';
+
+
+ WordChars = ['a'..'z', 'A'..'Z', '0'..'9', '_'];
+
+{$IFDEF Linux}
+ LineBreak: AnsiString = #$A;
+{$ELSE}
+ LineBreak: String = #$D#$A;
+{$ENDIF}
+
+{$IFDEF Delphi12}
+function IsUnicodeChar(Chr: Char): Boolean;
+begin
+ Result := ((Chr >= Char($007F)) and (Chr <= Char($FFFF)));
+end;
+{$ENDIF}
+
+{type
+ THackScrollBar = class(TScrollBar);
+}
+
+
+{ TfsSyntaxMemo }
+
+constructor TfsSyntaxMemo.Create(AOwner: TComponent);
+var
+ m: TMenuItem;
+ i: integer;
+begin
+ inherited Create(AOwner);
+
+ FVScroll := TScrollBar.Create(Self);
+
+ FCommentAttr := TFont.Create;
+ FCommentAttr.Color := clNavy;
+ FCommentAttr.Style := [fsItalic];
+
+ FKeywordAttr := TFont.Create;
+ FKeywordAttr.Color := clWindowText;
+ FKeywordAttr.Style := [fsBold];
+
+ FStringAttr := TFont.Create;
+ FStringAttr.Color := clNavy;
+ FStringAttr.Style := [];
+
+ FTextAttr := TFont.Create;
+ FTextAttr.Color := clWindowText;
+ FTextAttr.Style := [];
+
+
+ FText := TStringList.Create;
+ FUndo := TStringList.Create;
+ FSynStrings := TStringList.Create;
+ if AOwner is TWinControl then
+ Parent := AOwner as TWinControl;
+
+ OnDragOver := DOver;
+ OnDragDrop := DDrop;
+
+{$IFDEF Delphi4}
+ OnMouseWheelUp := MouseWheelUp;
+ OnMouseWheelDown := MouseWheelDown;
+ KWheel := 1;
+{$ENDIF}
+
+ FText.Add('');
+ FText.OnChange := LinesChange;
+ FMaxLength := 1024;
+ SyntaxType := stPascal;
+ FMoved := True;
+ SetPos(1, 1);
+ FOffset := Point(0, 0);
+
+ Cursor := crIBeam;
+ FBlockColor := clHighlight;
+ FBlockFontColor := clHighlightText;
+
+ Font.Size := 10;
+ Font.Name := 'Courier New';
+
+ FPopupMenu := TPopupMenu.Create(Self);
+ m := TMenuItem.Create(FPopupMenu);
+ m.Caption := 'Cut';
+ m.OnClick := CutPopup;
+ FPopupMenu.Items.Add(m);
+ m := TMenuItem.Create(FPopupMenu);
+ m.Caption := 'Copy';
+ m.OnClick := CopyPopup;
+ FPopupMenu.Items.Add(m);
+ m := TMenuItem.Create(FPopupMenu);
+ m.Caption := 'Paste';
+ m.OnClick := PastePopup;
+ FPopupMenu.Items.Add(m);
+
+ LastSearch := '';
+ Setlength(Bookmarks, 10);
+ for i := 0 to Length(Bookmarks)-1 do
+ Bookmarks[i] := -1;
+
+ FActiveLine := -1;
+
+ Height := 200;
+ Width := 200;
+
+end;
+
+destructor TfsSyntaxMemo.Destroy;
+begin
+ FPopupMenu.Free;
+ FCommentAttr.Free;
+ FKeywordAttr.Free;
+ FStringAttr.Free;
+ FTextAttr.Free;
+ FText.Free;
+ FUndo.Free;
+ FSynStrings.Free;
+ FVScroll.Free;
+ inherited;
+end;
+
+{ Windows-specific stuff }
+
+procedure TfsSyntaxMemo.CreateParams(var Params: TCreateParams);
+begin
+ inherited;
+ with Params do
+ ExStyle := ExStyle or WS_EX_CLIENTEDGE;
+end;
+
+procedure TfsSyntaxMemo.WMKillFocus(var Msg: {$IFNDEF FPC}TWMKillFocus{$ELSE}TLMKillFocus{$ENDIF});
+begin
+ inherited;
+
+ HideCaret(Handle);
+ DestroyCaret{$IFDEF FPC}(Handle){$ENDIF};
+end;
+
+procedure TfsSyntaxMemo.WMSetFocus(var Msg: {$IFNDEF FPC}TWMSetFocus{$ELSE}TLMSetFocus{$ENDIF});
+begin
+ inherited;
+ CreateCaret(Handle, 0, 2, FCharHeight);
+ ShowCaretPos;
+end;
+
+procedure TfsSyntaxMemo.ShowCaretPos;
+begin
+ SetCaretPos(FCharWidth * (FPos.X - 1 - FOffset.X) + FGutterWidth,
+ FCharHeight * (FPos.Y - 1 - FOffset.Y));
+ ShowCaret(Handle);
+ ShowPos;
+end;
+
+procedure TfsSyntaxMemo.ShowPos;
+begin
+ if FFooterHeight > 0 then
+ with Canvas do
+ begin
+ Font.Name := 'Tahoma';
+ Font.Color := clBlack;
+ Font.Style := [];
+ Font.Size := 8;
+ Brush.Color := clBtnFace;
+ {$IFDEF FPC}
+ FillRect(FGutterWidth + 4, Height - TextHeight('|') - 5, Width - 5, Height - 5);
+ {$ENDIF}
+ TextOut(FGutterWidth + 4, Height - TextHeight('|') - 5, IntToStr(FPos.y) + ' : ' + IntToStr(FPos.x) + ' ');
+ end;
+end;
+
+procedure TfsSyntaxMemo.WMGetDlgCode(var Message: {$IFNDEF FPC}TWMGetDlgCode{$ELSE}TLMNoParams{$ENDIF});
+begin
+ Message.Result := DLGC_WANTARROWS or DLGC_WANTTAB or DLGC_WANTALLKEYS or DLGC_WANTCHARS;
+end;
+
+{$IFNDEF FPC}
+procedure TfsSyntaxMemo.CMFontChanged(var Message: TMessage);
+{$ELSE}
+procedure TfsSyntaxMemo.FontChanged(Sender: TObject);
+{$ENDIF}
+var
+ b: TBitmap;
+begin
+ FCommentAttr.Size := Font.Size;
+ FCommentAttr.Name := Font.Name;
+ FKeywordAttr.Size := Font.Size;
+ FKeywordAttr.Name := Font.Name;
+ FStringAttr.Size := Font.Size;
+ FStringAttr.Name := Font.Name;
+ FTextAttr.Size := Font.Size;
+ FTextAttr.Name := Font.Name;
+
+ b := TBitmap.Create;
+ with b.Canvas do
+ begin
+ Font.Assign(Self.Font);
+ Font.Style := [fsBold];
+ FCharHeight := TextHeight('Wg');
+ FCharWidth := TextWidth('W');
+ {$IFNDEF FPC}
+ FIsMonoType := Pos('COURIER NEW', AnsiUppercase(Self.Font.Name)) <> 0;
+ {$ELSE}
+ FIsMonoType := Font.IsMonoSpace;
+ {$ENDIF}
+ end;
+ b.Free;
+end;
+
+{ End of stuff }
+
+procedure TfsSyntaxMemo.SetParent(Value: TWinControl);
+begin
+ inherited SetParent(Value);
+ if (Parent = nil) or (csDestroying in ComponentState) then Exit;
+
+ DoubleBuffered := True;
+ ShowGutter := True;
+ ShowFooter := True;
+ FVScroll.Parent := Self;
+ FVScroll.Kind := sbVertical;
+ FVScroll.OnChange := ScrollClick;
+ FVScroll.OnEnter := ScrollEnter;
+{$IFNDEF FPC}
+ FVScroll.Ctl3D := False;
+{$ENDIF}
+ Color := clWindow;
+ TabStop := True;
+end;
+
+
+function TfsSyntaxMemo.GetClientRect: TRect;
+begin
+ if FVScroll.Visible then
+ Result := Bounds(0, 0, Width - FVScroll.Width - 4, Height) else
+ Result := inherited GetClientRect;
+end;
+
+procedure TfsSyntaxMemo.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
+begin
+ inherited;
+ if FCharWidth = 0 then exit;
+ FWindowSize := Point((ClientWidth - FGutterWidth) div FCharWidth,
+ (Height - FFooterHeight) div FCharHeight );
+ FVScroll.SetBounds(Width - FVScroll.Width - 4, 0, FVScroll.Width, Height - 4);
+ UpdateScrollBar;
+end;
+
+procedure TfsSyntaxMemo.UpdateSyntax;
+begin
+ CreateSynArray;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.UpdateScrollBar;
+begin
+ with FVScroll do
+ begin
+// prevent OnScroll event
+ FUpdating := True;
+
+ Position := 0;
+ PageSize := 0;
+ Max := FText.Count;
+ SmallChange := 1;
+ if FWindowSize.Y < Max then
+ begin
+ Visible := True;
+ PageSize := FWindowSize.Y;
+ end
+ else
+ Visible := False;
+ LargeChange := FWindowSize.Y;
+ Position := FOffset.Y;
+
+// need to do this due to bug in the VCL
+// THackScrollBar(FVScroll).RecreateWnd;
+ FUpdating := False;
+ end;
+end;
+
+function TfsSyntaxMemo.GetText: TStrings;
+var
+ i: Integer;
+begin
+ for i := 0 to FText.Count - 1 do
+ FText[i] := LineAt(i);
+ Result := FText;
+ FAllowLinesChange := True;
+end;
+
+procedure TfsSyntaxMemo.SetText(Value: TStrings);
+begin
+ FAllowLinesChange := True;
+ FText.Assign(Value);
+end;
+
+procedure TfsSyntaxMemo.SetSyntaxType(Value: TSyntaxType);
+begin
+ FSyntaxType := Value;
+ if Value = stPascal then
+ FKeywords := PasKeywords
+ else if Value = stCpp then
+ FKeywords := CppKeywords
+ else if Value = stSQL then
+ FKeywords := SQLKeywords
+ else if Value = stVB then
+ FKeywords := VBKeywords
+ else if Value = stJS then
+ FKeywords := JSKeywords
+ else
+ FKeywords := '';
+ UpdateSyntax;
+end;
+
+function TfsSyntaxMemo.GetPos: TPoint;
+begin
+ Result := FPos;
+end;
+
+procedure TfsSyntaxMemo.DoChange;
+begin
+ FModified := True;
+ if Assigned(FOnChange) then
+ FOnChange(Self);
+end;
+
+procedure TfsSyntaxMemo.LinesChange(Sender: TObject);
+begin
+ if FAllowLinesChange then
+ begin
+ UpdateSyntax;
+ FAllowLinesChange := False;
+ if FText.Count = 0 then
+ FText.Add('');
+ FMoved := True;
+ FUndo.Clear;
+ //FPos := Point(1, 1);
+ // FOffset := Point(0, 0);
+ SetPos(FPos.X, FPos.Y);
+ ClearSel;
+ ShowCaretPos;
+ UpdateScrollBar;
+ end;
+end;
+
+procedure TfsSyntaxMemo.ShowMessage(s: String);
+begin
+ FMessage := s;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.CopyToClipboard;
+begin
+ if FSelStart.X <> 0 then
+ Clipboard.AsText := SelText;
+end;
+
+procedure TfsSyntaxMemo.CutToClipboard;
+begin
+ if not FReadOnly then
+ begin
+ if FSelStart.X <> 0 then
+ begin
+ Clipboard.AsText := SelText;
+ SelText := '';
+ end;
+ CorrectBookmark(FSelStart.Y, FSelStart.Y - FSelEnd.Y);
+ Repaint;
+ end;
+end;
+
+procedure TfsSyntaxMemo.PasteFromClipboard;
+begin
+ if not FReadOnly then
+ SelText := Clipboard.AsText;
+end;
+
+function TfsSyntaxMemo.LineAt(Index: Integer): String;
+begin
+ if Index < FText.Count then
+ Result := TrimRight(FText[Index])
+ else
+ Result := '';
+end;
+
+function TfsSyntaxMemo.LineLength(Index: Integer): Integer;
+begin
+ if Index < 0 then
+ Result := 0 else
+ Result := Length(LineAt(Index));
+end;
+
+function TfsSyntaxMemo.Pad(n: Integer): String;
+begin
+ result := '';
+ SetLength(result, n);
+{$IFDEF Delphi12}
+ Result := StringOfChar(Char(' '), n)
+{$ELSE}
+ FillChar(result[1], n, Char(' '));
+{$ENDIF}
+end;
+
+procedure TfsSyntaxMemo.AddUndo;
+begin
+ if not FMoved then exit;
+ FUndo.Add(Format('%5d%5d', [FPos.X, FPos.Y]) + FText.Text);
+ if FUndo.Count > 32 then
+ FUndo.Delete(0);
+end;
+
+procedure TfsSyntaxMemo.Undo;
+var
+ s: String;
+begin
+ FMoved := True;
+ if FUndo.Count = 0 then exit;
+ s := FUndo[FUndo.Count - 1];
+ FPos.X := StrToInt(Copy(s, 1, 5));
+ FPos.Y := StrToInt(Copy(s, 6, 5));
+ FText.Text := Copy(s, 11, Length(s) - 10);
+ FUndo.Delete(FUndo.Count - 1);
+ SetPos(FPos.X, FPos.Y);
+ UpdateSyntax;
+ DoChange;
+end;
+
+function TfsSyntaxMemo.GetPlainTextPos(Pos: TPoint): Integer;
+var
+ i: Integer;
+begin
+ Result := 0;
+ for i := 0 to Pos.Y - 2 do
+ Result := Result + Length(FText[i]) + Length(LineBreak);
+ Result := Result + Pos.X;
+end;
+
+function TfsSyntaxMemo.GetPosPlainText(Pos: Integer): TPoint;
+var
+ i: Integer;
+ s: String;
+begin
+ Result := Point(0, 1);
+ s := FText.Text;
+ i := 1;
+ while i <= Pos do
+{$IFDEF Delphi12}
+ if s[i] = Char(LineBreak[1]) then
+{$ELSE}
+ if s[i] = LineBreak[1] then
+{$ENDIF}
+ begin
+ Inc(i, Length(LineBreak));
+ if i <= Pos then
+ begin
+ Inc(Result.Y);
+ Result.X := 0;
+ end
+ else
+ Inc(Result.X);
+ end
+ else
+ begin
+ Inc(i);
+ Inc(Result.X);
+ end;
+end;
+
+function TfsSyntaxMemo.GetLineBegin(Index: Integer): Integer;
+var
+ s: String;
+begin
+ s := FText[Index];
+ Result := 1;
+ if Trim(s) <> '' then
+ for Result := 1 to Length(s) do
+ if s[Result] <> ' ' then
+ break;
+end;
+
+procedure TfsSyntaxMemo.TabIndent;
+var
+ i, n, res: Integer;
+ s: String;
+begin
+ res := FPos.X;
+ i := FPos.Y - 2;
+
+ while i >= 0 do
+ begin
+ res := FPos.X;
+ s := FText[i];
+ n := LineLength(i);
+
+ if res > n then
+ Dec(i)
+ else
+ begin
+ if s[res] = ' ' then
+ begin
+ while s[res] = ' ' do
+ Inc(res);
+ end
+ else
+ begin
+ while (res <= n) and (s[res] <> ' ') do
+ Inc(res);
+
+ while (res <= n) and (s[res] = ' ') do
+ Inc(res);
+ end;
+ break;
+ end;
+ end;
+
+ SelText := Pad(res - FPos.X);
+end;
+
+procedure TfsSyntaxMemo.EnterIndent;
+var
+ res: Integer;
+begin
+ if Trim(FText[FPos.Y - 1]) = '' then
+ res := FPos.X else
+ res := GetLineBegin(FPos.Y - 1);
+
+ CorrectBookmark(FPos.Y, 1);
+
+ FPos := Point(1, FPos.Y + 1);
+ SelText := Pad(res - 1);
+end;
+
+procedure TfsSyntaxMemo.UnIndent;
+var
+ i, res: Integer;
+begin
+ i := FPos.Y - 2;
+ res := FPos.X - 1;
+ CorrectBookmark(FPos.Y, -1);
+ while i >= 0 do
+ begin
+ res := GetLineBegin(i);
+ if (res < FPos.X) and (Trim(FText[i]) <> '') then
+ break else
+ Dec(i);
+ end;
+ FSelStart := FPos;
+ FSelEnd := FPos;
+ Dec(FSelEnd.X, FPos.X - res);
+ SelText := '';
+end;
+
+procedure TfsSyntaxMemo.ShiftSelected(ShiftRight: Boolean);
+var
+ i, ib, ie: Integer;
+ s: String;
+ Shift: Integer;
+begin
+ if FReadOnly then exit;
+ AddUndo;
+ if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
+ begin
+ ib := FSelStart.Y - 1;
+ ie := FSelEnd.Y - 1;
+ end
+ else
+ begin
+ ib := FSelEnd.Y - 1;
+ ie := FSelStart.Y - 1;
+ end;
+ if FSelEnd.X = 1 then
+ Dec(ie);
+
+ Shift := 2;
+ if not ShiftRight then
+ for i := ib to ie do
+ begin
+ s := FText[i];
+ if (Trim(s) <> '') and (GetLineBegin(i) - 1 < Shift) then
+ Shift := GetLineBegin(i) - 1;
+ end;
+
+ for i := ib to ie do
+ begin
+ s := FText[i];
+ if ShiftRight then
+ s := Pad(Shift) + s
+ else if Trim(s) <> '' then
+ Delete(s, 1, Shift);
+ FText[i] := s;
+ end;
+ UpdateSyntax;
+ DoChange;
+end;
+
+function TfsSyntaxMemo.GetSelText: String;
+var
+ p1, p2: TPoint;
+ i: Integer;
+begin
+ if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
+ begin
+ p1 := FSelStart;
+ p2 := FSelEnd;
+ Dec(p2.X);
+ end
+ else
+ begin
+ p1 := FSelEnd;
+ p2 := FSelStart;
+ Dec(p2.X);
+ end;
+
+ if LineLength(p1.Y - 1) < p1.X then
+ begin
+ Inc(p1.Y);
+ p1.X := 1;
+ end;
+ if LineLength(p2.Y - 1) < p2.X then
+ p2.X := LineLength(p2.Y - 1);
+
+ i := GetPlainTextPos(p1);
+ Result := Copy(FText.Text, i, GetPlainTextPos(p2) - i + 1);
+end;
+
+procedure TfsSyntaxMemo.SetSelText(Value: String);
+var
+ p1, p2, p3: TPoint;
+ i: Integer;
+ s: String;
+begin
+ if FReadOnly then exit;
+ AddUndo;
+ if FSelStart.X = 0 then
+ begin
+ p1 := FPos;
+ p2 := p1;
+ Dec(p2.X);
+ end
+ else if FSelStart.X + FSelStart.Y * FMaxLength < FSelEnd.X + FSelEnd.Y * FMaxLength then
+ begin
+ p1 := FSelStart;
+ p2 := FSelEnd;
+ Dec(p2.X);
+ end
+ else
+ begin
+ p1 := FSelEnd;
+ p2 := FSelStart;
+ Dec(p2.X);
+ end;
+
+ if LineLength(p1.Y - 1) < p1.X then
+ FText[p1.Y - 1] := FText[p1.Y - 1] + Pad(p1.X - LineLength(p1.Y - 1) + 1);
+ if LineLength(p2.Y - 1) < p2.X then
+ p2.X := LineLength(p2.Y - 1);
+
+ i := GetPlainTextPos(p1);
+ s := FText.Text;
+ Delete(s, i, GetPlainTextPos(p2) - i + 1);
+ Insert(Value, s, i);
+ FText.Text := s;
+ p3 := GetPosPlainText(i + Length(Value));
+
+ CorrectBookmark(FPos.Y, p3.y-FPos.Y);
+
+ SetPos(p3.X, p3.Y);
+ FSelStart.X := 0;
+ DoChange;
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.ClearSel;
+begin
+ if FSelStart.X <> 0 then
+ begin
+ FSelStart := Point(0, 0);
+ Repaint;
+ end;
+end;
+
+procedure TfsSyntaxMemo.AddSel;
+begin
+ if FSelStart.X = 0 then
+ FSelStart := FTempPos;
+ FSelEnd := FPos;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.SetPos(x, y: Integer);
+begin
+ if FMessage <> '' then
+ begin
+ FMessage := '';
+ Repaint;
+ end;
+
+ if x > FMaxLength then x := FMaxLength;
+ if x < 1 then x := 1;
+ if y > FText.Count then y := FText.Count;
+ if y < 1 then y := 1;
+
+ FPos := Point(x, y);
+ if (FWindowSize.X = 0) or (FWindowSize.Y = 0) then exit;
+
+ if FOffset.Y >= FText.Count then
+ FOffset.Y := FText.Count - 1;
+
+ if FPos.X > FOffset.X + FWindowSize.X then
+ begin
+ Inc(FOffset.X, FPos.X - (FOffset.X + FWindowSize.X));
+ Repaint;
+ end
+ else if FPos.X <= FOffset.X then
+ begin
+ Dec(FOffset.X, FOffset.X - FPos.X + 1);
+ Repaint;
+ end
+ else if FPos.Y > FOffset.Y + FWindowSize.Y then
+ begin
+ Inc(FOffset.Y, FPos.Y - (FOffset.Y + FWindowSize.Y));
+ Repaint;
+ end
+ else if FPos.Y <= FOffset.Y then
+ begin
+ Dec(FOffset.Y, FOffset.Y - FPos.Y + 1);
+ Repaint;
+ end;
+
+ ShowCaretPos;
+ UpdateScrollBar;
+
+end;
+
+procedure TfsSyntaxMemo.ScrollClick(Sender: TObject);
+begin
+ if FUpdating then exit;
+ FOffset.Y := FVScroll.Position;
+ if FOffset.Y > FText.Count then
+ FOffset.Y := FText.Count;
+ ShowCaretPos;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.ScrollEnter(Sender: TObject);
+begin
+ SetFocus;
+end;
+
+procedure TfsSyntaxMemo.DblClick;
+var
+ s: String;
+begin
+ FDoubleClicked := True;
+ DoCtrlL;
+ FSelStart := FPos;
+ s := LineAt(FPos.Y - 1);
+ if s <> '' then
+{$IFDEF Delphi12}
+ while CharInSet(s[FPos.X],WordChars)
+ or IsUnicodeChar(s[FPos.X]) do
+{$ELSE}
+ while s[FPos.X] in WordChars do
+{$ENDIF}
+ Inc(FPos.X);
+ FSelEnd := FPos;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.MouseDown(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer);
+begin
+ if FDoubleClicked then
+ begin
+ FDoubleClicked := False;
+ Exit;
+ end;
+ if Button = mbRight then
+ begin
+ if(PopupMenu = nil) then FPopUpMenu.Popup(Mouse.CursorPos.x, Mouse.CursorPos.y);
+ end
+ else
+ begin
+ FMoved := True;
+ if not Focused then
+ SetFocus;
+ FDown := True;
+ SetPos((X - FGutterWidth) div FCharWidth + 1 + FOffset.X,
+ Y div FCharHeight + 1 + FOffset.Y);
+ ClearSel;
+ end;
+end;
+
+procedure TfsSyntaxMemo.MouseMove(Shift: TShiftState; X, Y: Integer);
+begin
+ if FDown then
+ begin
+ FTempPos := FPos;
+ FPos.X := (X - FGutterWidth) div FCharWidth + 1 + FOffset.X;
+ FPos.Y := Y div FCharHeight + 1 + FOffset.Y;
+ if (FPos.X <> FTempPos.X) or (FPos.Y <> FTempPos.Y) then
+ begin
+ SetPos(FPos.X, FPos.Y);
+ AddSel;
+ end;
+ end;
+end;
+
+procedure TfsSyntaxMemo.MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Integer);
+begin
+ FDown := False;
+end;
+
+procedure TfsSyntaxMemo.KeyDown(var Key: Word; Shift: TShiftState);
+var
+ MyKey: Boolean;
+begin
+ inherited;
+ FAllowLinesChange := False;
+
+ FTempPos := FPos;
+ MyKey := True;
+ case Key of
+ vk_Left:
+ if ssCtrl in Shift then
+ DoCtrlL else
+ DoLeft;
+
+ vk_Right:
+ if ssCtrl in Shift then
+ DoCtrlR else
+ DoRight;
+
+ vk_Up:
+ DoUp;
+
+ vk_Down:
+ DoDown;
+
+ vk_Home:
+ DoHome(ssCtrl in Shift);
+
+ vk_End:
+ DoEnd(ssCtrl in Shift);
+
+ vk_Prior:
+ DoPgUp;
+
+ vk_Next:
+ DoPgDn;
+
+ vk_Return:
+ if Shift = [] then
+ DoReturn;
+
+ vk_Delete:
+ if ssShift in Shift then
+ CutToClipboard else
+ DoDel;
+
+ vk_Back:
+ DoBackspace;
+
+ vk_Insert:
+ if ssCtrl in Shift then
+ CopyToClipboard
+ else if ssShift in Shift then
+ PasteFromClipboard;
+
+ vk_Tab:
+ TabIndent;
+
+ vk_F3:
+ Find(LastSearch); // F3 Repeat search
+
+ else
+ MyKey := False;
+ end;
+
+ if Shift = [ssCtrl] then
+ if Key = 65 then // Ctrl+A Select all
+ begin
+ SetPos(0, 0);
+ FSelStart := FPos;
+ SetPos(LineLength(FText.Count - 1) + 1, FText.Count);
+ FSelEnd := FPos;
+ Repaint;
+ end
+ else
+ if Key = 70 then // Ctrl+F Search
+ begin
+ SynMemoSearch := TfsSynMemoSearch.Create(nil);
+ if SynMemoSearch.ShowModal = mrOk then
+ Find(SynMemoSearch.Edit1.Text);
+ LastSearch := SynMemoSearch.Edit1.Text;
+ SynMemoSearch.Free;
+ end
+ else
+ if Key = 89 then // Ctrl+Y Delete line
+ begin
+ if FText.Count > FPos.Y then
+ begin
+ FMoved := True;
+ AddUndo;
+ FText.Delete(FPos.Y - 1);
+ CorrectBookmark(FPos.Y, -1);
+ UpdateSyntax;
+ end
+ else
+ if FText.Count = FPos.Y then
+ begin
+ FMoved := True;
+ AddUndo;
+ FText[FPos.Y - 1] := '';
+ FPos.X := 1;
+ SetPos(FPos.X, FPos.Y);
+ UpdateSyntax;
+ end
+ end
+ else
+ if Key in [48..57] then
+ GotoBookmark(Key-48);
+
+ if Shift = [ssCtrl, ssShift] then
+ if Key in [48..57] then
+ if IsBookmark(FPos.Y - 1) < 0 then
+ AddBookmark(FPos.Y - 1, Key-48)
+ else
+ if IsBookmark(FPos.Y - 1) = (Key-48) then
+ DeleteBookmark(Key-48);
+
+
+ if Key in [vk_Left, vk_Right, vk_Up, vk_Down, vk_Home, vk_End, vk_Prior, vk_Next] then
+ begin
+ FMoved := True;
+ if ssShift in Shift then
+ AddSel else
+ ClearSel;
+ end
+ else if Key in [vk_Return, vk_Delete, vk_Back, vk_Insert, vk_Tab] then
+ FMoved := True;
+
+ if MyKey then
+ Key := 0;
+end;
+
+procedure TfsSyntaxMemo.KeyPress(var Key: Char);
+var
+ MyKey: Boolean;
+begin
+ inherited;
+
+ MyKey := True;
+ case Key of
+ #3:
+ CopyToClipboard;
+
+ #9:
+ DoCtrlI;
+
+ #21:
+ DoCtrlU;
+
+ #22:
+ PasteFromClipboard;
+
+ #24:
+ CutToClipboard;
+
+ #26:
+ Undo;
+
+ #32..#255:
+ begin
+ DoChar(Key);
+ FMoved := True;
+ end;
+ else
+ MyKey := False;
+ end;
+
+ if MyKey then
+ Key := #0;
+end;
+
+procedure TfsSyntaxMemo.DoLeft;
+begin
+ Dec(FPos.X);
+ if FPos.X < 1 then
+ FPos.X := 1;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoRight;
+begin
+ Inc(FPos.X);
+ if FPos.X > FMaxLength then
+ FPos.X := FMaxLength;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoUp;
+begin
+ Dec(FPos.Y);
+ if FPos.Y < 1 then
+ FPos.Y := 1;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoDown;
+begin
+ Inc(FPos.Y);
+ if FPos.Y > FText.Count then
+ FPos.Y := FText.Count;
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoHome(Ctrl: Boolean);
+begin
+ if Ctrl then
+ SetPos(1, 1) else
+ SetPos(1, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoEnd(Ctrl: Boolean);
+begin
+ if Ctrl then
+ SetPos(LineLength(FText.Count - 1) + 1, FText.Count) else
+ SetPos(LineLength(FPos.Y - 1) + 1, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoPgUp;
+begin
+ if FOffset.Y > FWindowSize.Y then
+ begin
+ Dec(FOffset.Y, FWindowSize.Y - 1);
+ Dec(FPos.Y, FWindowSize.Y - 1);
+ end
+ else
+ begin
+ if FOffset.Y > 0 then
+ begin
+ Dec(FPos.Y, FOffset.Y);
+ FOffset.Y := 0;
+ end
+ else
+ FPos.Y := 1;
+ end;
+ SetPos(FPos.X, FPos.Y);
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.DoPgDn;
+begin
+ if FOffset.Y + FWindowSize.Y < FText.Count then
+ begin
+ Inc(FOffset.Y, FWindowSize.Y - 1);
+ Inc(FPos.Y, FWindowSize.Y - 1);
+ end
+ else
+ begin
+ FOffset.Y := FText.Count;
+ FPos.Y := FText.Count;
+ end;
+ SetPos(FPos.X, FPos.Y);
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.DoReturn;
+var
+ s: String;
+begin
+ if FReadOnly then exit;
+ s := LineAt(FPos.Y - 1);
+ FText[FPos.Y - 1] := Copy(s, 1, FPos.X - 1);
+ FText.Insert(FPos.Y, Copy(s, FPos.X, FMaxLength));
+ EnterIndent;
+end;
+
+procedure TfsSyntaxMemo.DoDel;
+var
+ s: String;
+begin
+ if FReadOnly then exit;
+ FMessage := '';
+ if FSelStart.X <> 0 then
+ SelText := ''
+ else
+ begin
+ s := FText[FPos.Y - 1];
+ AddUndo;
+ if FPos.X <= LineLength(FPos.Y - 1) then
+ begin
+ Delete(s, FPos.X, 1);
+ FText[FPos.Y - 1] := s;
+ end
+ else if FPos.Y < FText.Count then
+ begin
+ s := s + Pad(FPos.X - Length(s) - 1) + LineAt(FPos.Y);
+ FText[FPos.Y - 1] := s;
+ FText.Delete(FPos.Y);
+ CorrectBookmark(FSelStart.Y, -1);
+ end;
+ UpdateScrollBar;
+ UpdateSyntax;
+ DoChange;
+ end;
+end;
+
+procedure TfsSyntaxMemo.DoBackspace;
+var
+ s: String;
+begin
+ if FReadOnly then exit;
+ FMessage := '';
+ if FSelStart.X <> 0 then
+ SelText := ''
+ else
+ begin
+ s := FText[FPos.Y - 1];
+ if FPos.X > 1 then
+ begin
+ if (GetLineBegin(FPos.Y - 1) = FPos.X) or (Trim(s) = '') then
+ UnIndent
+ else
+ begin
+ AddUndo;
+ if Trim(s) <> '' then
+ begin
+ Delete(s, FPos.X - 1, 1);
+ FText[FPos.Y - 1] := s;
+ DoLeft;
+ end
+ else
+ DoHome(False);
+ UpdateSyntax;
+ DoChange;
+ end;
+ end
+ else if FPos.Y > 1 then
+ begin
+ AddUndo;
+ CorrectBookmark(FPos.Y, -1);
+ s := LineAt(FPos.Y - 2);
+ FText[FPos.Y - 2] := s + FText[FPos.Y - 1];
+ FText.Delete(FPos.Y - 1);
+ SetPos(Length(s) + 1, FPos.Y - 1);
+ UpdateSyntax;
+ DoChange;
+ end;
+ end;
+end;
+
+procedure TfsSyntaxMemo.DoCtrlI;
+begin
+ if FSelStart.X <> 0 then
+ ShiftSelected(True);
+end;
+
+procedure TfsSyntaxMemo.DoCtrlU;
+begin
+ if FSelStart.X <> 0 then
+ ShiftSelected(False);
+end;
+
+procedure TfsSyntaxMemo.DoCtrlL;
+var
+ i: Integer;
+ s: String;
+begin
+ s := FText.Text;
+ i := Length(LineAt(FPos.Y - 1));
+ if FPos.X > i then
+ FPos.X := i;
+
+ i := GetPlainTextPos(FPos);
+
+ Dec(i);
+{$IFDEF Delphi12}
+ while (i > 0) and not (CharInSet(s[i], WordChars) or IsUnicodeChar(s[i])) do
+ if s[i] = Char(LineBreak[1]) then
+{$ELSE}
+ while (i > 0) and not (s[i] in WordChars) do
+ if s[i] = LineBreak[1] then
+{$ENDIF}
+ break else
+ Dec(i);
+{$IFDEF Delphi12}
+ while (i > 0) and (CharInSet(s[i], WordChars) or IsUnicodeChar(s[i])) do
+{$ELSE}
+ while (i > 0) and (s[i] in WordChars) do
+{$ENDIF}
+ Dec(i);
+ Inc(i);
+
+ FPos := GetPosPlainText(i);
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoCtrlR;
+var
+ i: Integer;
+ s: String;
+begin
+ s := FText.Text;
+ i := Length(LineAt(FPos.Y - 1));
+ if FPos.X > i then
+ begin
+ DoDown;
+ DoHome(False);
+ FPos.X := 0;
+ end;
+
+ i := GetPlainTextPos(FPos);
+{$IFDEF Delphi12}
+ while (i < Length(s)) and ((CharInSet(s[i], WordChars)) or IsUnicodeChar(s[i])) do
+ Inc(i);
+ while (i < Length(s)) and not ((CharInSet(s[i], WordChars)) or IsUnicodeChar(s[i])) do
+ if s[i] = Char(LineBreak[1]) then
+ break else
+ Inc(i);
+{$ELSE}
+ while (i < Length(s)) and (s[i] in WordChars) do
+ Inc(i);
+ while (i < Length(s)) and not (s[i] in WordChars) do
+ if s[i] = LineBreak[1] then
+ break else
+ Inc(i);
+{$ENDIF}
+ FPos := GetPosPlainText(i);
+ SetPos(FPos.X, FPos.Y);
+end;
+
+procedure TfsSyntaxMemo.DoChar(Ch: Char);
+begin
+ SelText := Ch;
+end;
+
+function TfsSyntaxMemo.GetCharAttr(Pos: TPoint): TCharAttributes;
+
+ function IsBlock: Boolean;
+ var
+ p1, p2, p3: Integer;
+ begin
+ Result := False;
+ if FSelStart.X = 0 then exit;
+
+ p1 := FSelStart.X + FSelStart.Y * FMaxLength;
+ p2 := FSelEnd.X + FSelEnd.Y * FMaxLength;
+ if p1 > p2 then
+ begin
+ p3 := p1;
+ p1 := p2;
+ p2 := p3;
+ end;
+ p3 := Pos.X + Pos.Y * FMaxLength;
+ Result := (p3 >= p1) and (p3 < p2);
+ end;
+
+ function CharAttr: TCharAttr;
+ var
+ s: String;
+ begin
+ if Pos.Y - 1 < FSynStrings.Count then
+ begin
+ s := FSynStrings[Pos.Y - 1];
+ if Pos.X <= Length(s) then
+ Result := TCharAttr(Ord(s[Pos.X])) else
+ Result := caText;
+ end
+ else
+ Result := caText;
+ end;
+
+begin
+ Result := [CharAttr];
+ if IsBlock then
+ Result := Result + [caBlock];
+end;
+
+{$HINTS OFF}
+procedure TfsSyntaxMemo.Paint;
+var
+ i, j, j1: Integer;
+ a, a1: TCharAttributes;
+ s: String;
+
+ procedure SetAttr(a: TCharAttributes);
+ begin
+ with Canvas do
+ begin
+ Brush.Color := Self.Color;
+
+ if caText in a then
+ Font.Assign(FTextAttr);
+
+ if caComment in a then
+ Font.Assign(FCommentAttr);
+
+ if caKeyword in a then
+ Font.Assign(FKeywordAttr);
+
+ if caString in a then
+ Font.Assign(FStringAttr);
+
+ if caBlock in a then
+ begin
+ Brush.Color := FBlockColor;
+ Font.Color := FBlockFontColor;
+ end;
+
+ Font.Charset := Self.Font.Charset;
+ end;
+ end;
+
+ procedure MyTextOut(x, y: Integer; const s: String);
+ var
+ i: Integer;
+ begin
+ with Canvas do
+ begin
+ FillRect(Rect(x, y, x + Length(s) * FCharWidth, y + FCharHeight));
+ if FIsMonoType then
+ TextOut(x, y, s)
+ else
+ begin
+ for i := 1 to Length(s) do
+ TextOut(x + (i - 1) * FCharWidth, y, s[i]);
+ MoveTo(x + Length(s) * FCharWidth, y);
+ end;
+ end;
+ end;
+
+begin
+ with Canvas do
+ begin
+ Brush.Color := clBtnFace;
+ FillRect(Rect(0, 0, FGutterWidth - 2, Height - FFooterHeight));
+ FillRect(Rect(0, Height - FFooterHeight, Width, Height));
+ Pen.Color := clBtnHighlight;
+ MoveTo(FGutterWidth - 4, 0);
+ LineTo(FGutterWidth - 4, Height - FFooterHeight + 1);
+ if FFooterHeight > 0 then
+ LineTo(Width, Height - FFooterHeight + 1);
+
+ if FUpdatingSyntax then Exit;
+
+ for i := FOffset.Y to FOffset.Y + FWindowSize.Y - 1 do
+ begin
+ if i >= FText.Count then break;
+
+ s := FText[i];
+ PenPos := Point(FGutterWidth, (i - FOffset.Y) * FCharHeight);
+ j1 := FOffset.X + 1;
+ a := GetCharAttr(Point(j1, i + 1));
+ a1 := a;
+
+ for j := j1 to FOffset.X + FWindowSize.X do
+ begin
+ if j > Length(s) then break;
+
+ a1 := GetCharAttr(Point(j, i + 1));
+ if a1 <> a then
+ begin
+ SetAttr(a);
+ MyTextOut(PenPos.X, PenPos.Y, Copy(FText[i], j1, j - j1));
+ a := a1;
+ j1 := j;
+ end;
+ end;
+
+ SetAttr(a);
+ MyTextOut(PenPos.X, PenPos.Y, Copy(s, j1, FMaxLength));
+ if caBlock in GetCharAttr(Point(1, i + 1)) then
+ MyTextOut(PenPos.X, PenPos.Y, Pad(FWindowSize.X - Length(s) - FOffset.X + 3));
+
+ BookmarkDraw(PenPos.Y, i);
+ ActiveLineDraw(PenPos.Y, i);
+ end;
+
+ if FMessage <> '' then
+ begin
+ Font.Name := 'Tahoma';
+ Font.Color := clWhite;
+ Font.Style := [fsBold];
+ Font.Size := 8;
+ Brush.Color := clMaroon;
+ FillRect(Rect(0, Height - TextHeight('|') - 6, Width, Height));
+ TextOut(6, Height - TextHeight('|') - 5, FMessage);
+ end
+ else
+ ShowPos;
+ end;
+end;
+{$HINTS ON}
+
+procedure TfsSyntaxMemo.CreateSynArray;
+var
+ i, n, Pos: Integer;
+ ch: Char;
+ FSyn: String;
+
+ procedure SkipSpaces;
+ begin
+{$IFDEF Delphi12}
+ while (Pos <= Length(FSyn)) and
+ ((CharInSet(FSyn[Pos], [#1..#32])) or
+ not (CharInSet(FSyn[Pos],['_', 'A'..'Z', 'a'..'z', '''', '"', '/', '{', '(', '-']))) do
+ Inc(Pos);
+{$ELSE}
+ while (Pos <= Length(FSyn)) and
+ ((FSyn[Pos] in [#1..#32]) or
+ not (FSyn[Pos] in ['_', 'A'..'Z', 'a'..'z', '''', '"', '/', '{', '(', '-'])) do
+ Inc(Pos);
+{$ENDIF}
+ end;
+
+ function IsKeyWord(const s: String): Boolean;
+ begin
+ Result := False;
+ if FKeywords = '' then exit;
+
+ if FKeywords[1] <> ',' then
+ FKeywords := ',' + FKeywords;
+ if FKeywords[Length(FKeywords)] <> ',' then
+ FKeywords := FKeywords + ',';
+
+ Result := System.Pos(',' + AnsiLowerCase(s) + ',', FKeywords) <> 0;
+ end;
+
+ function GetIdent: TCharAttr;
+ var
+ i: Integer;
+ cm1, cm2, cm3, cm4, st1: Char;
+ begin
+ i := Pos;
+ Result := caText;
+
+ if FSyntaxType = stPascal then
+ begin
+ cm1 := '/';
+ cm2 := '{';
+ cm3 := '(';
+ cm4 := ')';
+ st1 := '''';
+ end
+ else if FSyntaxType in [stCpp,stJs,stVb] then
+ begin
+ cm1 := '/';
+ cm2 := ' ';
+ cm3 := '/';
+ cm4 := '/';
+ st1 := '"';
+ end
+ else if FSyntaxType = stSQL then
+ begin
+ cm1 := '-';
+ cm2 := ' ';
+ cm3 := '/';
+ cm4 := '/';
+ st1 := '"';
+ end
+ else
+ begin
+ cm1 := ' ';
+ cm2 := ' ';
+ cm3 := ' ';
+ cm4 := ' ';
+ st1 := ' ';
+ end;
+
+{$IFDEF Delphi12}
+ if CharInSet(FSyn[Pos], ['_', 'A'..'Z', 'a'..'z']) then
+ begin
+ while CharInSet(FSyn[Pos], ['_', 'A'..'Z', 'a'..'z', '0'..'9']) do
+ Inc(Pos);
+ if IsKeyWord(Copy(FSyn, i, Pos - i)) then
+ Result := caKeyword;
+ Dec(Pos);
+ end
+ else if (FSyn[Pos] = cm1) and (FSyn[Pos + 1] = cm1) then
+ begin
+ while (Pos <= Length(FSyn)) and not (CharInSet(FSyn[Pos], [#10, #13])) do
+ Inc(Pos);
+ Result := caComment;
+ end
+{$ELSE}
+ if FSyn[Pos] in ['_', 'A'..'Z', 'a'..'z'] then
+ begin
+ while FSyn[Pos] in ['_', 'A'..'Z', 'a'..'z', '0'..'9'] do
+ Inc(Pos);
+ if IsKeyWord(Copy(FSyn, i, Pos - i)) then
+ Result := caKeyword;
+ Dec(Pos);
+ end
+ else if (FSyn[Pos] = cm1) and (FSyn[Pos + 1] = cm1) then
+ begin
+ while (Pos <= Length(FSyn)) and not (FSyn[Pos] in [#10, #13]) do
+ Inc(Pos);
+ Result := caComment;
+ end
+{$ENDIF}
+ else if FSyn[Pos] = cm2 then
+ begin
+ while (Pos <= Length(FSyn)) and (FSyn[Pos] <> '}') do
+ Inc(Pos);
+ Result := caComment;
+ end
+ else if (FSyn[Pos] = cm3) and (FSyn[Pos + 1] = '*') then
+ begin
+ while (Pos < Length(FSyn)) and not ((FSyn[Pos] = '*') and (FSyn[Pos + 1] = cm4)) do
+ Inc(Pos);
+ Inc(Pos, 2);
+ Result := caComment;
+ end
+ else if FSyn[Pos] = st1 then
+ begin
+ Inc(Pos);
+{$IFDEF Delphi12}
+ while (Pos < Length(FSyn)) and (FSyn[Pos] <> st1) and not (CharInSet(FSyn[Pos], [#10, #13])) do
+ Inc(Pos);
+{$ELSE}
+ while (Pos < Length(FSyn)) and (FSyn[Pos] <> st1) and not (FSyn[Pos] in [#10, #13]) do
+ Inc(Pos);
+{$ENDIF}
+ Result := caString;
+ end;
+ Inc(Pos);
+ end;
+
+begin
+ FSyn := FText.Text + #0#0#0#0#0#0#0#0#0#0#0;
+ FAllowLinesChange := False;
+ Pos := 1;
+
+ while Pos < Length(FSyn) do
+ begin
+ n := Pos;
+ SkipSpaces;
+ for i := n to Pos - 1 do
+ if FSyn[i] > #31 then
+ FSyn[i] := Chr(Ord(caText));
+
+ n := Pos;
+ ch := Chr(Ord(GetIdent));
+ for i := n to Pos - 1 do
+ if i <= Length(FSyn) then
+ if FSyn[i] > #31 then
+ FSyn[i] := ch;
+ end;
+
+ FUpdatingSyntax := True;
+ FSynStrings.Text := FSyn;
+ FSynStrings.Add(' ');
+ FUpdatingSyntax := False;
+end;
+
+procedure TfsSyntaxMemo.UpdateView;
+begin
+ UpdateSyntax;
+ Invalidate;
+end;
+
+procedure TfsSyntaxMemo.CopyPopup(Sender: TObject);
+begin
+ CopyToClipboard;
+end;
+
+procedure TfsSyntaxMemo.PastePopup(Sender: TObject);
+begin
+ PasteFromClipboard;
+end;
+
+procedure TfsSyntaxMemo.CutPopup(Sender: TObject);
+begin
+ CutToClipboard;
+end;
+
+{$IFDEF Delphi4}
+procedure TfsSyntaxMemo.MouseWheelUp(Sender: TObject;
+ Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
+begin
+ FVScroll.Position := FVScroll.Position - FVScroll.SmallChange * KWheel;
+end;
+
+procedure TfsSyntaxMemo.MouseWheelDown(Sender: TObject;
+ Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
+begin
+ FVScroll.Position := FVScroll.Position + FVScroll.SmallChange * KWheel;
+end;
+{$ENDIF}
+
+procedure TfsSyntaxMemo.SetShowGutter(Value: boolean);
+begin
+ FShowGutter := Value;
+ if Value then
+ FGutterWidth := 20
+ else
+ FGutterWidth := 0;
+ Repaint;
+end;
+
+procedure TfsSyntaxMemo.SetShowFooter(Value: boolean);
+begin
+ FShowFooter := Value;
+ if Value then
+ FFooterHeight := 20
+ else
+ FFooterHeight := 0;
+ Repaint;
+end;
+
+function TfsSyntaxMemo.FMemoFind(Text: String; var Position : TPoint): boolean;
+var
+ i, j : integer;
+begin
+ j := 0;
+ result := False;
+ if FText.Count > 1 then
+ begin
+ Text := UpperCase(Text);
+ for i := Position.Y to FText.Count - 1 do
+ begin
+ j := Pos( Text, UpperCase(FText[i]));
+ if j > 0 then
+ begin
+ Result := True;
+ break;
+ end
+ end;
+ Position.X := j;
+ Position.Y := i + 1;
+ end;
+end;
+
+function TfsSyntaxMemo.Find(Text: String): boolean;
+var
+ Position: TPoint;
+begin
+ Position := FPos;
+ if FMemoFind(Text, Position) then
+ begin
+ SetPos(Position.X, Position.Y);
+ result := true;
+ end
+ else
+ begin
+ ShowMessage('Text "'+Text+'" not found.');
+ result := false;
+ end;
+end;
+
+procedure TfsSyntaxMemo.ActiveLineDraw(Y : integer; ALine : integer);
+begin
+ if ShowGutter then
+ with Canvas do
+ if ALine = FActiveLine then
+ begin
+ Brush.Color := clRed;
+ Pen.Color := clBlack;
+ Ellipse(4, Y+4, 11, Y+11);
+ end;
+end;
+
+procedure TfsSyntaxMemo.BookmarkDraw(Y : integer; ALine : integer);
+var
+ bm : integer;
+begin
+ if ShowGutter then
+ with Canvas do
+ begin
+ bm := IsBookmark(ALine);
+ if bm >= 0 then
+ begin
+ Brush.Color := clBlack;
+ FillRect(Rect(3, Y + 1, 13, Y + 12));
+ Brush.Color := clGreen;
+ FillRect(Rect(2, Y + 2, 12, Y + 13));
+ Font.Name := 'Tahoma';
+ Font.Color := clWhite;
+ Font.Style := [fsBold];
+ Font.Size := 7;
+ TextOut(4, Y + 2, IntToStr(bm));
+ end
+ else
+ begin
+ Brush.Color := clBtnFace;
+ FillRect(Rect(2, Y + 2, 13, Y + 13));
+ end;
+ end;
+end;
+
+function TfsSyntaxMemo.IsBookmark(Line : integer): integer;
+var
+ Pos : integer;
+begin
+ Result := -1;
+ for Pos := 0 to Length(Bookmarks) - 1 do
+ if Bookmarks[Pos] = Line then
+ begin
+ Result := Pos;
+ break;
+ end;
+end;
+
+procedure TfsSyntaxMemo.AddBookmark(Line, Number : integer);
+begin
+ if Number < Length(Bookmarks) then
+ begin
+ Bookmarks[Number] := Line;
+ Repaint;
+ end;
+end;
+
+procedure TfsSyntaxMemo.DeleteBookmark(Number : integer);
+begin
+ if Number < Length(Bookmarks) then
+ begin
+ Bookmarks[Number] := -1;
+ Repaint;
+ end;
+end;
+
+procedure TfsSyntaxMemo.CorrectBookmark(Line : integer; delta : integer);
+var
+ i : integer;
+begin
+ for i := 0 to Length(Bookmarks) - 1 do
+ if Bookmarks[i] >= Line then
+ Inc(Bookmarks[i], Delta);
+end;
+
+procedure TfsSyntaxMemo.GotoBookmark(Number : integer);
+begin
+ if Number < Length(Bookmarks) then
+ if Bookmarks[Number] >= 0 then
+ SetPos(0, Bookmarks[Number] + 1);
+end;
+
+procedure TfsSyntaxMemo.DOver(Sender, Source: TObject; X, Y: Integer;
+ State: TDragState; var Accept: Boolean);
+begin
+ Accept := Source is TTreeView;
+end;
+
+procedure TfsSyntaxMemo.DDrop(Sender, Source: TObject; X, Y: Integer);
+begin
+ if Source is TTreeView then
+ begin
+ SetPos((X - FGutterWidth) div FCharWidth + 1 + FOffset.X,
+ Y div FCharHeight + 1 + FOffset.Y);
+ SetSelText(TTreeView(Source).Selected.Text);
+ end;
+end;
+
+procedure TfsSyntaxMemo.SetKeywordAttr(Value: TFont);
+begin
+ FKeywordAttr.Assign(Value);
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.SetStringAttr(Value: TFont);
+begin
+ FStringAttr.Assign(Value);
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.SetTextAttr(Value: TFont);
+begin
+ FTextAttr.Assign(Value);
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.SetCommentAttr(Value: TFont);
+begin
+ FCommentAttr.Assign(Value);
+ UpdateSyntax;
+end;
+
+procedure TfsSyntaxMemo.SetActiveLine(Line : Integer);
+begin
+ FActiveLine := Line;
+ Repaint;
+end;
+
+function TfsSyntaxMemo.GetActiveLine: Integer;
+begin
+ Result := FActiveLine;
+end;
+
+//
+
+procedure TfsSynMemoSearch.FormKeyPress(Sender: TObject; var Key: Char);
+begin
+ if Key = #13 then
+ ModalResult := mrOk;
+end;
+
+{$IFDEF DELPHI16}
+initialization
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsSyntaxMemo, TControl);
+{$ENDIF}
+
+end.
diff --git a/LibD28/fs_tree.pas b/LibD28/fs_tree.pas
new file mode 100644
index 0000000..de63a33
--- /dev/null
+++ b/LibD28/fs_tree.pas
@@ -0,0 +1,426 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Function/Classes tree visual control }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit fs_tree;
+
+interface
+
+{$I fs.inc}
+
+uses
+{$IFNDEF CLX}
+ {$IFNDEF FPC}
+ Windows, Messages,
+ {$ENDIF}
+ SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ StdCtrls, ExtCtrls, ComCtrls, fs_synmemo
+{$ELSE}
+ Classes, QGraphics, QControls, QStdCtrls, QExtCtrls, QComCtrls, QImgList
+{$ENDIF},
+ fs_XML, fs_iinterpreter;
+
+type
+ TfsTree = class(TPanel)
+ private
+ Tree: TTreeView;
+ FXML: TfsXMLDocument;
+ FImages: TImageList;
+ FScript: TfsScript;
+ FShowFunctions: boolean;
+ FShowClasses: boolean;
+ FShowTypes: Boolean;
+ FShowVariables: Boolean;
+ FExpanded: boolean;
+ FExpandLevel : integer;
+{$IFNDEF CLX}
+ FMemo: TfsSyntaxMemo;
+{$ELSE}
+ FMemo: TMemo;
+{$ENDIF}
+ FUpdating: Boolean;
+ procedure FillTree;
+{$IFNDEF CLX}
+ procedure SetMemo(Value: TfsSyntaxMemo);
+{$ELSE}
+ procedure SetMemo(Value: TMemo);
+{$ENDIF}
+ procedure SetImageIndex(Node: TTreeNode; Index: Integer);
+ procedure SetScript(const Value: TfsScript);
+ procedure TreeCollapsed(Sender: TObject; Node: TTreeNode);
+ procedure TreeExpanded(Sender: TObject; Node: TTreeNode);
+ protected
+ procedure TreeChange(Sender: TObject; Node: TTreeNode);
+ procedure TreeDblClick(Sender: TObject);
+ procedure Notification(AComponent: TComponent;
+ Operation: TOperation); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure SetColor(Color: TColor);
+ procedure UpdateItems;
+ function GetFieldName: String;
+ published
+ property Align;
+ property Anchors;
+{$IFNDEF CLX}
+ {$IFNDEF FPC}
+ property ParentCtl3D;
+ {$ENDIF}
+ property DragCursor;
+ property DragKind;
+ property DragMode;
+ property BiDiMode;
+ property ParentBiDiMode;
+{$ENDIF}
+ property Color;
+ property Constraints;
+ property Enabled;
+ property Font;
+ property ParentColor;
+ property ParentFont;
+ property ParentShowHint;
+ property PopupMenu;
+ property Script: TfsScript read FScript write SetScript;
+ property ShowHint;
+ property TabOrder;
+ property TabStop;
+ property Visible;
+{$IFNDEF CLX}
+ property SyntaxMemo: TfsSyntaxMemo read FMemo write SetMemo;
+{$ELSE}
+ property SyntaxMemo: TMemo read FMemo write SetMemo;
+{$ENDIF}
+ property ShowClasses: boolean read FShowClasses write FShowClasses;
+ property ShowFunctions: boolean read FShowFunctions write FShowFunctions;
+ property ShowTypes: boolean read FShowTypes write FShowTypes;
+ property ShowVariables: boolean read FShowVariables write FShowVariables;
+ property Expanded: boolean read FExpanded write FExpanded;
+ property ExpandLevel: integer read FExpandLevel write FExpandLevel;
+
+ property OnClick;
+ property OnDblClick;
+ property OnDragDrop;
+ property OnDragOver;
+ property OnEndDrag;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ property OnStartDrag;
+ end;
+
+implementation
+
+{$R *.res}
+
+uses fs_iTools;
+
+procedure TfsTree.SetImageIndex(Node: TTreeNode; Index: Integer);
+begin
+ Node.ImageIndex := Index;
+{$IFNDEF CLX}
+ Node.StateIndex := Index;
+{$ENDIF}
+ Node.SelectedIndex := Index;
+end;
+
+constructor TfsTree.Create(AOwner: TComponent);
+var
+ Images: TBitmap;
+begin
+ inherited;
+ Parent := AOwner as TWinControl;
+ BevelOuter := bvNone;
+ Tree := TTreeView.Create(Self);
+ with Tree do
+ begin
+ Parent := Self;
+ Align := alClient;
+ DragMode := dmAutomatic;
+ ReadOnly := True;
+ TabOrder := 0;
+ end;
+ FImages := TImageList.Create(Self);
+ FImages.Masked := true;
+ Images := TBitmap.Create;
+ Images.LoadFromResourceName(hInstance, 'FSTREE');
+{$IFNDEF CLX}
+ FImages.AddMasked(Images, Images.TransparentColor);
+{$ELSE}
+ Images.Transparent := true;
+ FImages.Add(Images, nil);
+{$ENDIF}
+ Images.Free;
+ Tree.Images := FImages;
+ Tree.OnCollapsed := TreeCollapsed;
+ Tree.OnExpanded := TreeExpanded;
+ Tree.OnDblClick := TreeDblClick;
+ FXML := TfsXMLDocument.Create;
+ Expanded := True;
+ ExpandLevel := 2;
+ ShowClasses := True;
+ ShowFunctions := True;
+ ShowTypes := True;
+ ShowVariables := True;
+ UpdateItems;
+ Height := 250;
+ Width := 200;
+end;
+
+destructor TfsTree.Destroy;
+begin
+ FImages.Free;
+ Tree.Free;
+ FUpdating := True;
+ FXML.Free;
+ inherited;
+end;
+
+procedure TfsTree.FillTree;
+
+ function GetCategoryByName(s: String): String;
+ begin
+ if s = 'ctConv' then result := 'Conversion'
+ else if s = 'ctFormat' then result := 'Formatting'
+ else if s = 'ctDate' then result := 'Date/Time'
+ else if s = 'ctString' then result := 'String routines'
+ else if s = 'ctMath' then result := 'Mathematical'
+ else if s = 'ctOther' then result := 'Other'
+ else result := s;
+ end;
+
+ procedure AddClasses(xi: TfsXMLItem; Root: TTreeNode);
+ var
+ i: Integer;
+ Node: TTreeNode;
+ s: String;
+ begin
+ s := xi.Prop['text'];
+ Node := Tree.Items.AddChild(Root, s);
+ if xi.Count = 0 then
+ Node.Data := xi;
+ if Root = nil then
+ Node.Text := xi.Name;
+ if xi.Count = 0 then
+ SetImageIndex(Node, 1)
+ else
+ SetImageIndex(Node, 2);
+ for i := 0 to xi.Count - 1 do
+ AddClasses(xi[i], Node);
+ end;
+
+ procedure AddFunctions(xi: TfsXMLItem; Root: TTreeNode);
+ var
+ i: Integer;
+ Node: TTreeNode;
+ s: String;
+ begin
+ s := xi.Prop['text'];
+ if xi.Count = 0 then
+ s := Copy(s, Pos(' ', s) + 1, 255) else { function }
+ s := GetCategoryByName(s); { category }
+ Node := Tree.Items.AddChild(Root, s);
+ if xi.Count = 0 then
+ Node.Data := xi;
+ if Root = nil then
+ Node.Text := xi.Name;
+ if xi.Count = 0 then
+ SetImageIndex(Node, 0)
+ else
+ SetImageIndex(Node, 2);
+ for i := 0 to xi.Count - 1 do
+ AddFunctions(xi[i], Node);
+ end;
+
+ procedure AddTypes(xi: TfsXMLItem; Root: TTreeNode);
+ var
+ i: Integer;
+ Node: TTreeNode;
+ s: String;
+ begin
+ s := Copy(xi.Prop['text'], 1, 255);
+ Node := Tree.Items.AddChild(Root, s);
+ if xi.Count = 0 then
+ Node.Data := xi;
+ if Root = nil then
+ Node.Text := xi.Name;
+ if xi.Count = 0 then
+ SetImageIndex(Node, 0)
+ else
+ SetImageIndex(Node, 2);
+ for i := 0 to xi.Count - 1 do
+ AddTypes(xi[i], Node);
+ end;
+
+ procedure AddVariables(xi: TfsXMLItem; Root: TTreeNode);
+ var
+ i: Integer;
+ Node: TTreeNode;
+ s: String;
+ begin
+ s := xi.Prop['text'];
+ Node := Tree.Items.AddChild(Root, s);
+ if xi.Count = 0 then
+ Node.Data := xi;
+ if Root = nil then
+ Node.Text := xi.Name;
+ if xi.Count = 0 then
+ SetImageIndex(Node, 0)
+ else
+ SetImageIndex(Node, 2);
+ for i := 0 to xi.Count - 1 do
+ AddVariables(xi[i], Node);
+ end;
+
+ procedure ExpandNodes(level: integer);
+ var
+ j : integer;
+ begin
+ if level > 1 then
+ for j := 0 to Tree.Items.Count-1 do
+ if Tree.Items[j].Level < Level-1 then
+ Tree.Items[j].Expand(false);
+ end;
+
+begin
+ FUpdating := True;
+ FXML.Root.Clear;
+
+ GenerateXMLContents(fsGlobalUnit, FXML.Root);
+ if FScript <> nil then
+ GenerateXMLContents(FScript, FXML.Root);
+
+ Tree.Items.BeginUpdate;
+ Tree.Items.Clear;
+
+ if ShowClasses then
+ AddClasses(FXML.Root.FindItem('Classes'), nil);
+
+ if ShowFunctions then
+ AddFunctions(FXML.Root.FindItem('Functions'), nil);
+
+ if ShowTypes then
+ AddTypes(FXML.Root.FindItem('Types'), nil);
+
+ if ShowVariables then
+ AddVariables(FXML.Root.FindItem('Variables'), nil);
+
+ if Expanded then
+ ExpandNodes(ExpandLevel);
+
+ Tree.TopItem := Tree.Items[0];
+ Tree.Items.EndUpdate;
+ FUpdating := False;
+
+end;
+
+procedure TfsTree.UpdateItems;
+begin
+ FillTree;
+end;
+
+procedure TfsTree.TreeChange(Sender: TObject;
+ Node: TTreeNode);
+begin
+ if FUpdating then Exit;
+end;
+
+procedure TfsTree.TreeDblClick(Sender: TObject);
+begin
+ if Assigned(SyntaxMemo) then
+ if Tree.Selected.Count = 0 then
+ SyntaxMemo.SelText := Tree.Selected.Text;
+ if Assigned(OnDblClick) then OnDblClick(Self);
+end;
+
+function TfsTree.GetFieldName: String;
+var
+ i, n: Integer;
+ s: String;
+begin
+ Result := '';
+ if (Tree.Selected <> nil) and (Tree.Selected.Count = 0) then
+ begin
+ s := Tree.Selected.Text;
+ if Pos('(', s) <> 0 then
+ n := 1 else
+ n := 0;
+ for i := 1 to Length(s) do
+{$IFDEF Delphi12}
+ if (s[i] = ',') or (s[i] = ';') then
+{$ELSE}
+ if s[i] in [',', ';'] then
+{$ENDIF}
+ Inc(n);
+
+ if n = 0 then
+ s := Copy(s, 1, Pos(':', s) - 1)
+ else
+ begin
+ s := Copy(s, 1, Pos('(', s));
+ for i := 1 to n - 1 do
+ s := s + ',';
+ s := s + ')';
+ end;
+ Result := s;
+ end;
+end;
+
+procedure TfsTree.SetColor(Color: TColor);
+begin
+ Tree.Color := Color;
+end;
+
+{$IFNDEF CLX}
+procedure TfsTree.SetMemo(Value: TfsSyntaxMemo);
+{$ELSE}
+procedure TfsTree.SetMemo(Value: TMemo);
+{$ENDIF}
+begin
+ FMemo := Value;
+end;
+
+procedure TfsTree.SetScript(const Value: TfsScript);
+begin
+ FScript := Value;
+ UpdateItems;
+end;
+
+procedure TfsTree.TreeCollapsed(Sender: TObject; Node: TTreeNode);
+begin
+ SetImageIndex(Node, 2);
+end;
+
+procedure TfsTree.TreeExpanded(Sender: TObject; Node: TTreeNode);
+begin
+ SetImageIndex(Node, 3);
+end;
+
+procedure TfsTree.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited Notification(AComponent, Operation);
+ if Operation = opRemove then
+ if AComponent = FScript then
+ FScript := nil
+ else if AComponent = FMemo then
+ FMemo := nil
+end;
+
+{$IFDEF DELPHI16}
+initialization
+ StartClassGroup(TControl);
+ ActivateClassGroup(TControl);
+ GroupDescendentsWith(TfsTree, TControl);
+{$ENDIF}
+
+end.
diff --git a/LibD28/fs_tree.res b/LibD28/fs_tree.res
new file mode 100644
index 0000000..098958a
Binary files /dev/null and b/LibD28/fs_tree.res differ
diff --git a/LibD28/fs_xml.pas b/LibD28/fs_xml.pas
new file mode 100644
index 0000000..9699572
--- /dev/null
+++ b/LibD28/fs_xml.pas
@@ -0,0 +1,756 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ XML document }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+//VCL uses section
+{$IFNDEF FMX}
+unit fs_xml;
+
+interface
+
+{$i fs.inc}
+
+uses
+{$IFNDEF CROSS_COMPILE}
+ Windows,
+{$ENDIF}
+ SysUtils, Classes
+{$IFDEF Delphi12}
+ , AnsiStrings
+{$ENDIF}
+{$IFDEF Delphi16}
+ , System.Types
+{$ENDIF};
+//FMX uses
+{$ELSE}
+interface
+
+{$i fs.inc}
+
+uses
+ FMX.Types, System.SysUtils, System.Classes, System.AnsiStrings, System.Types;
+{$ENDIF}
+
+type
+ TfsXMLItem = class(TObject)
+ private
+ FData: Pointer; { optional item data }
+ FItems: TList; { subitems }
+ FName: String; { item name }
+ FParent: TfsXMLItem; { item parent }
+ FText: String; { item attributes }
+ function GetCount: Integer;
+ function GetItems(Index: Integer): TfsXMLItem;
+ function GetProp(Index: String): String;
+ procedure SetProp(Index: String; const Value: String);
+ procedure SetParent(const Value: TfsXMLItem);
+ public
+ destructor Destroy; override;
+ procedure AddItem(Item: TfsXMLItem);
+ procedure Assign(Item: TfsXMLItem);
+ procedure Clear;
+ procedure InsertItem(Index: Integer; Item: TfsXMLItem);
+
+ function Add: TfsXMLItem;
+ function Find(const Name: String): Integer;
+ function FindItem(const Name: String): TfsXMLItem;
+ function IndexOf(Item: TfsXMLItem): Integer;
+ function PropExists(const Index: String): Boolean;
+ function Root: TfsXMLItem;
+
+ property Count: Integer read GetCount;
+ property Data: Pointer read FData write FData;
+ property Items[Index: Integer]: TfsXMLItem read GetItems; default;
+ property Name: String read FName write FName;
+ property Parent: TfsXMLItem read FParent write SetParent;
+ property Prop[Index: String]: String read GetProp write SetProp;
+ property Text: String read FText write FText;
+ end;
+
+ TfsXMLDocument = class(TObject)
+ private
+ FAutoIndent: Boolean; { use indents when writing document to a file }
+ FRoot: TfsXMLItem; { root item }
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Clear;
+ procedure SaveToStream(Stream: TStream);
+ procedure LoadFromStream(Stream: TStream);
+ procedure SaveToFile(const FileName: String);
+ procedure LoadFromFile(const FileName: String);
+
+ property AutoIndent: Boolean read FAutoIndent write FAutoIndent;
+ property Root: TfsXMLItem read FRoot;
+ end;
+
+{ TfsXMLReader and TfsXMLWriter are doing actual read/write to the XML file.
+ Read/write process is buffered. }
+
+ TfsXMLReader = class(TObject)
+ private
+ FBuffer: PAnsiChar;
+ FBufPos: Integer;
+ FBufEnd: Integer;
+ FPosition: Int64;
+ FSize: Int64;
+ FStream: TStream;
+ procedure SetPosition(const Value: Int64);
+ procedure ReadBuffer;
+ procedure ReadItem(var {$IFDEF Delphi12}NameS{$ELSE}Name{$ENDIF}: String; var Text: String);
+ public
+ constructor Create(Stream: TStream);
+ destructor Destroy; override;
+ procedure RaiseException;
+ procedure ReadHeader;
+ procedure ReadRootItem(Item: TfsXMLItem);
+ property Position: Int64 read FPosition write SetPosition;
+ property Size: Int64 read FSize;
+ end;
+
+ TfsXMLWriter = class(TObject)
+ private
+ FAutoIndent: Boolean;
+ FBuffer: AnsiString;
+ FStream: TStream;
+ FTempStream: TStream;
+ procedure FlushBuffer;
+ procedure WriteLn(const s: AnsiString);
+ procedure WriteItem(Item: TfsXMLItem; Level: Integer = 0);
+ public
+ constructor Create(Stream: TStream);
+ procedure WriteHeader;
+ procedure WriteRootItem(RootItem: TfsXMLItem);
+ property TempStream: TStream read FTempStream write FTempStream;
+ end;
+
+
+{ StrToXML changes '<', '>', '"', cr, lf symbols to its ascii codes }
+function StrToXML(const s: String): String;
+
+{ ValueToXML convert a value to the valid XML string }
+function ValueToXML(const Value: Variant): String;
+
+{ XMLToStr is opposite to StrToXML function }
+function XMLToStr(const s: String): String;
+
+
+implementation
+
+
+function StrToXML(const s: String): String;
+const
+ SpecChars = ['<', '>', '"', #10, #13, '&'];
+var
+ i: Integer;
+
+ procedure ReplaceChars(var s: String; i: Integer);
+ begin
+ Insert('#' + IntToStr(Ord(s[i])) + ';', s, i + 1);
+ s[i] := '&';
+ end;
+
+begin
+ Result := s;
+ for i := Length(s) downto 1 do
+{$IFDEF Delphi12}
+ if CharInSet(s[i], SpecChars) then
+{$ELSE}
+ if s[i] in SpecChars then
+{$ENDIF}
+ if s[i] <> '&' then
+ ReplaceChars(Result, i)
+ else
+ begin
+ if Copy(s, i + 1, 5) = 'quot;' then
+ begin
+ Delete(Result, i, 6);
+ Insert('"', Result, i);
+ end;
+ end;
+end;
+
+function XMLToStr(const s: String): String;
+var
+ i, j, h, n: Integer;
+begin
+ Result := s;
+
+ i := 1;
+ n := Length(s);
+ while i < n do
+ begin
+ if Result[i] = '&' then
+ if (i + 3 <= n) and (Result[i + 1] = '#') then
+ begin
+ j := i + 3;
+ while Result[j] <> ';' do
+ Inc(j);
+ h := StrToInt(Copy(Result, i + 2, j - i - 2));
+ Delete(Result, i, j - i);
+ Result[i] := Chr(h);
+ Dec(n, j - i);
+ end
+ else if Copy(Result, i + 1, 5) = 'quot;' then
+ begin
+ Delete(Result, i, 5);
+ Result[i] := '"';
+ Dec(n, 5);
+ end;
+ Inc(i);
+ end;
+end;
+
+function ValueToXML(const Value: Variant): String;
+begin
+ case TVarData(Value).VType of
+ varSmallint, varInteger, varByte:
+ Result := IntToStr(Integer(Value));
+
+ varSingle, varDouble, varCurrency:
+ Result := FloatToStr(Double(Value));
+
+ varDate:
+ Result := DateToStr(TDateTime(Value));
+
+ varOleStr, varString, varVariant{$IFDEF Delphi12}, varUString{$ENDIF}:
+ Result := StrToXML(Value);
+
+ varBoolean:
+ if Value = True then Result := '1' else Result := '0';
+
+ else
+ Result := '';
+ end;
+end;
+
+
+{ TfsXMLItem }
+
+destructor TfsXMLItem.Destroy;
+begin
+ Clear;
+ if FParent <> nil then
+ FParent.FItems.Remove(Self);
+ inherited;
+end;
+
+procedure TfsXMLItem.Clear;
+begin
+ if FItems <> nil then
+ begin
+ while FItems.Count > 0 do
+ TfsXMLItem(FItems[0]).Free;
+ FItems.Free;
+ FItems := nil;
+ end;
+end;
+
+function TfsXMLItem.GetItems(Index: Integer): TfsXMLItem;
+begin
+ Result := TfsXMLItem(FItems[Index]);
+end;
+
+function TfsXMLItem.GetCount: Integer;
+begin
+ if FItems = nil then
+ Result := 0 else
+ Result := FItems.Count;
+end;
+
+function TfsXMLItem.Add: TfsXMLItem;
+begin
+ Result := TfsXMLItem.Create;
+ AddItem(Result);
+end;
+
+procedure TfsXMLItem.AddItem(Item: TfsXMLItem);
+begin
+ if FItems = nil then
+ FItems := TList.Create;
+
+ FItems.Add(Item);
+ if Item.FParent <> nil then
+ Item.FParent.FItems.Remove(Item);
+ Item.FParent := Self;
+end;
+
+procedure TfsXMLItem.InsertItem(Index: Integer; Item: TfsXMLItem);
+begin
+ AddItem(Item);
+ FItems.Delete(FItems.Count - 1);
+ FItems.Insert(Index, Item);
+end;
+
+procedure TfsXMLItem.SetParent(const Value: TfsXMLItem);
+begin
+ if FParent <> nil then
+ FParent.FItems.Remove(Self);
+ FParent := Value;
+end;
+
+function TfsXMLItem.Find(const Name: String): Integer;
+var
+ i: Integer;
+begin
+ Result := -1;
+ for i := 0 to Count - 1 do
+ if AnsiCompareText(Items[i].Name, Name) = 0 then
+ begin
+ Result := i;
+ break;
+ end;
+end;
+
+function TfsXMLItem.FindItem(const Name: String): TfsXMLItem;
+var
+ i: Integer;
+begin
+ i := Find(Name);
+ if i = -1 then
+ begin
+ Result := Add;
+ Result.Name := Name;
+ end
+ else
+ Result := Items[i];
+end;
+
+function TfsXMLItem.Root: TfsXMLItem;
+begin
+ Result := Self;
+ while Result.Parent <> nil do
+ Result := Result.Parent;
+end;
+
+function TfsXMLItem.GetProp(Index: String): String;
+var
+ i: Integer;
+begin
+ i := Pos(' ' + AnsiUppercase(Index) + '="', AnsiUppercase(' ' + FText));
+ if i <> 0 then
+ begin
+ Result := Copy(FText, i + Length(Index + '="'), MaxInt);
+ Result := XMLToStr(Copy(Result, 1, Pos('"', Result) - 1));
+ end
+ else
+ Result := '';
+end;
+
+procedure TfsXMLItem.SetProp(Index: String; const Value: String);
+var
+ i, j: Integer;
+ s: String;
+begin
+ i := Pos(' ' + AnsiUppercase(Index) + '="', AnsiUppercase(' ' + FText));
+ if i <> 0 then
+ begin
+ j := i + Length(Index + '="');
+ while (j <= Length(FText)) and (FText[j] <> '"') do
+ Inc(j);
+ Delete(FText, i, j - i + 1);
+ end
+ else
+ i := Length(FText) + 1;
+
+ s := Index + '="' + StrToXML(Value) + '"';
+ if (i > 1) and (FText[i - 1] <> ' ') then
+ s := ' ' + s;
+ Insert(s, FText, i);
+end;
+
+function TfsXMLItem.PropExists(const Index: String): Boolean;
+begin
+ Result := Pos(' ' + AnsiUppercase(Index) + '="', ' ' + AnsiUppercase(FText)) > 0;
+end;
+
+function TfsXMLItem.IndexOf(Item: TfsXMLItem): Integer;
+begin
+ Result := FItems.IndexOf(Item);
+end;
+
+procedure TfsXMLItem.Assign(Item: TfsXMLItem);
+
+ procedure DoAssign(ItemFrom, ItemTo: TfsXMLItem);
+ var
+ i: Integer;
+ begin
+ ItemTo.Name := ItemFrom.Name;
+ ItemTo.Text := ItemFrom.Text;
+ ItemTo.Data := ItemFrom.Data;
+ for i := 0 to ItemFrom.Count - 1 do
+ DoAssign(ItemFrom[i], ItemTo.Add);
+ end;
+
+begin
+ Clear;
+ if Item <> nil then
+ DoAssign(Item, Self);
+end;
+
+
+{ TfsXMLDocument }
+
+constructor TfsXMLDocument.Create;
+begin
+ FRoot := TfsXMLItem.Create;
+end;
+
+destructor TfsXMLDocument.Destroy;
+begin
+ FRoot.Free;
+ inherited;
+end;
+
+procedure TfsXMLDocument.Clear;
+begin
+ FRoot.Clear;
+end;
+
+procedure TfsXMLDocument.LoadFromStream(Stream: TStream);
+var
+ rd: TfsXMLReader;
+begin
+ rd := TfsXMLReader.Create(Stream);
+ try
+ FRoot.Clear;
+ rd.ReadHeader;
+ rd.ReadRootItem(FRoot);
+ finally
+ rd.Free;
+ end;
+end;
+
+procedure TfsXMLDocument.SaveToStream(Stream: TStream);
+var
+ wr: TfsXMLWriter;
+begin
+ wr := TfsXMLWriter.Create(Stream);
+ wr.FAutoIndent := FAutoIndent;
+
+ try
+ wr.WriteHeader;
+ wr.WriteRootItem(FRoot);
+ finally
+ wr.Free;
+ end;
+end;
+
+procedure TfsXMLDocument.LoadFromFile(const FileName: String);
+var
+ s: TFileStream;
+begin
+ s := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ try
+ LoadFromStream(s);
+ finally
+ s.Free;
+ end;
+end;
+
+procedure TfsXMLDocument.SaveToFile(const FileName: String);
+var
+ s: TFileStream;
+begin
+ s := TFileStream.Create(FileName, fmCreate);
+ try
+ SaveToStream(s);
+ finally
+ s.Free;
+ end;
+end;
+
+
+{ TfsXMLReader }
+
+constructor TfsXMLReader.Create(Stream: TStream);
+begin
+ FStream := Stream;
+ FSize := Stream.Size;
+ FPosition := Stream.Position;
+ GetMem(FBuffer, 4096);
+end;
+
+destructor TfsXMLReader.Destroy;
+begin
+ FreeMem(FBuffer, 4096);
+ FStream.Position := FPosition;
+ inherited;
+end;
+
+procedure TfsXMLReader.ReadBuffer;
+begin
+ FBufEnd := FStream.Read(FBuffer^, 4096);
+ FBufPos := 0;
+end;
+
+procedure TfsXMLReader.SetPosition(const Value: Int64);
+begin
+ FPosition := Value;
+ FStream.Position := Value;
+ FBufPos := 0;
+ FBufEnd := 0;
+end;
+
+procedure TfsXMLReader.RaiseException;
+begin
+ raise Exception.Create('Invalid file format');
+end;
+
+procedure TfsXMLReader.ReadHeader;
+var
+ s1: String;
+ s2: String;
+begin
+ ReadItem(s1, s2);
+ if Pos('?xml', s1) <> 1 then
+ RaiseException;
+end;
+
+procedure TfsXMLReader.ReadItem(var {$IFDEF Delphi12}NameS{$ELSE}Name{$ENDIF}: String; var Text: String);
+var
+ c: byte;
+ curpos, len: Integer;
+ state: (FindLeft, FindRight, FindComment, Done);
+ i, comment: Integer;
+ ps: PAnsiChar;
+{$IFDEF Delphi12}
+ Name: AnsiString;
+{$ENDIF}
+begin
+ Text := '';
+ comment := 0;
+ state := FindLeft;
+ curpos := 0;
+ len := 4096;
+ SetLength(Name, len);
+ ps := @Name[1];
+
+ while FPosition < FSize do
+ begin
+ if FBufPos = FBufEnd then
+ ReadBuffer;
+ c := Ord(FBuffer[FBufPos]);
+ Inc(FBufPos);
+ Inc(FPosition);
+
+ if state = FindLeft then
+ begin
+ if c = Ord('<') then
+ state := FindRight
+ end
+ else if state = FindRight then
+ begin
+ if c = Ord('>') then
+ begin
+ state := Done;
+ break;
+ end
+ else if c = Ord('<') then
+ RaiseException
+ else
+ begin
+ ps[curpos] := AnsiChar(Chr(c));
+ Inc(curpos);
+ if (curpos = 3) and (Pos(AnsiString('!--'), Name) = 1) then
+ begin
+ state := FindComment;
+ comment := 0;
+ curpos := 0;
+ end;
+ if curpos >= len - 1 then
+ begin
+ Inc(len, 4096);
+ SetLength(Name, len);
+ ps := @Name[1];
+ end;
+ end;
+ end
+ else if State = FindComment then
+ begin
+ if comment = 2 then
+ begin
+ if c = Ord('>') then
+ state := FindLeft
+ else
+ comment := 0;
+ end
+ else begin
+ if c = Ord('-') then
+ Inc(comment)
+ else
+ comment := 0;
+ end;
+ end;
+ end;
+
+ len := curpos;
+ SetLength(Name, len);
+
+ if state = FindRight then
+ RaiseException;
+ if (Name <> '') and (Name[len] = ' ') then
+ SetLength(Name, len - 1);
+
+ i := Pos(AnsiString(' '), Name);
+ if i <> 0 then
+ begin
+{$IFDEF Delphi12}
+ Text := UTF8Decode(Copy(Name, i + 1, len - i));
+{$ELSE}
+ Text := Copy(Name, i + 1, len - i);
+{$ENDIF}
+ Delete(Name, i, len - i + 1);
+ end;
+{$IFDEF Delphi12}
+ NameS := String(Name);
+{$ENDIF}
+end;
+
+procedure TfsXMLReader.ReadRootItem(Item: TfsXMLItem);
+var
+ LastName: String;
+
+ function DoRead(RootItem: TfsXMLItem): Boolean;
+ var
+ n: Integer;
+ ChildItem: TfsXMLItem;
+ Done: Boolean;
+ begin
+ Result := False;
+ ReadItem(RootItem.FName, RootItem.FText);
+ LastName := RootItem.FName;
+
+ if (RootItem.Name = '') or (RootItem.Name[1] = '/') then
+ begin
+ Result := True;
+ Exit;
+ end;
+
+ n := Length(RootItem.Name);
+ if RootItem.Name[n] = '/' then
+ begin
+ SetLength(RootItem.FName, n - 1);
+ Exit;
+ end;
+
+ n := Length(RootItem.Text);
+ if (n > 0) and (RootItem.Text[n] = '/') then
+ begin
+ SetLength(RootItem.FText, n - 1);
+ Exit;
+ end;
+
+ repeat
+ ChildItem := TfsXMLItem.Create;
+ Done := DoRead(ChildItem);
+ if not Done then
+ RootItem.AddItem(ChildItem) else
+ ChildItem.Free;
+ until Done;
+
+ if (LastName <> '') and (AnsiCompareText(LastName, '/' + RootItem.Name) <> 0) then
+ RaiseException;
+ end;
+
+begin
+ DoRead(Item);
+end;
+
+
+{ TfsXMLWriter }
+
+constructor TfsXMLWriter.Create(Stream: TStream);
+begin
+ FStream := Stream;
+end;
+
+procedure TfsXMLWriter.FlushBuffer;
+begin
+ if FBuffer <> '' then
+ FStream.Write(FBuffer[1], Length(FBuffer));
+ FBuffer := '';
+end;
+
+procedure TfsXMLWriter.WriteLn(const s: AnsiString);
+begin
+ if not FAutoIndent then
+ Insert(s, FBuffer, MaxInt) else
+ Insert(s + #13#10, FBuffer, MaxInt);
+ if Length(FBuffer) > 4096 then
+ FlushBuffer;
+end;
+
+procedure TfsXMLWriter.WriteHeader;
+begin
+ WriteLn('');
+end;
+
+function Dup(n: Integer): AnsiString;
+begin
+ SetLength(Result, n);
+ FillChar(Result[1], n, ' ');
+end;
+
+procedure TfsXMLWriter.WriteItem(Item: TfsXMLItem; Level: Integer = 0);
+var
+ s: AnsiString;
+begin
+ if Item.FText <> '' then
+ begin
+{$IFDEF Delphi12}
+ s := UTF8Encode(Item.FText);
+{$ELSE}
+ s := Item.FText;
+{$ENDIF}
+ if (s = '') or (s[1] <> ' ') then
+ s := ' ' + s;
+ end
+ else
+ s := '';
+
+ if Item.Count = 0 then
+ s := s + '/>' else
+ s := s + '>';
+ if not FAutoIndent then
+ s := '<' + AnsiString(Item.Name) + s else
+ s := Dup(Level) + '<' + AnsiString(Item.Name) + s;
+ WriteLn(s);
+end;
+
+procedure TfsXMLWriter.WriteRootItem(RootItem: TfsXMLItem);
+
+ procedure DoWrite(RootItem: TfsXMLItem; Level: Integer = 0);
+ var
+ i: Integer;
+ NeedClear: Boolean;
+ begin
+ NeedClear := False;
+ if not FAutoIndent then
+ Level := 0;
+
+ WriteItem(RootItem, Level);
+ for i := 0 to RootItem.Count - 1 do
+ DoWrite(RootItem[i], Level + 2);
+ if RootItem.Count > 0 then
+ if not FAutoIndent then
+ WriteLn('') else
+ WriteLn(Dup(Level) + '');
+
+ if NeedClear then
+ RootItem.Clear;
+ end;
+
+begin
+ DoWrite(RootItem);
+ FlushBuffer;
+end;
+
+end.
diff --git a/LibD28/fsx.dpk b/LibD28/fsx.dpk
new file mode 100644
index 0000000..9f2efd7
--- /dev/null
+++ b/LibD28/fsx.dpk
@@ -0,0 +1,76 @@
+// Package file for CLX
+
+package fsx;
+
+{$I fs.inc}
+
+{$R *.res}
+{$ALIGN 8}
+{$ASSERTIONS ON}
+{$BOOLEVAL OFF}
+
+{$EXTENDEDSYNTAX ON}
+{$IMPORTEDDATA ON}
+{$IOCHECKS ON}
+{$LOCALSYMBOLS ON}
+{$LONGSTRINGS ON}
+{$OPENSTRINGS ON}
+{$OPTIMIZATION ON}
+{$OVERFLOWCHECKS OFF}
+{$RANGECHECKS OFF}
+{$REFERENCEINFO ON}
+{$SAFEDIVIDE OFF}
+{$STACKFRAMES OFF}
+{$TYPEDADDRESS OFF}
+{$VARSTRINGCHECKS ON}
+{$WRITEABLECONST ON}
+{$MINENUMSIZE 1}
+{$IMAGEBASE $400000}
+{$RUNONLY}
+{$IMPLICITBUILD ON}
+
+requires
+{$IFDEF LINUX}
+ rtl,
+ visualclx,
+ visualdbclx,
+ vcl;
+{$ELSE}
+ rtl,
+ dbrtl,
+ visualclx,
+ visualdbclx,
+ ibxpress,
+ vcl,
+ vclx,
+ vcldb;
+{$ENDIF}
+
+contains
+ fs_ipascal in 'fs_ipascal.pas',
+ fs_icpp in 'fs_icpp.pas',
+ fs_ijs in 'fs_ijs.pas',
+ fs_ibasic in 'fs_ibasic.pas',
+
+ fs_iclassesrtti in 'fs_iclassesrtti.pas',
+ fs_iconst in 'fs_iconst.pas',
+ fs_idbctrlsrtti in 'fs_idbctrlsrtti.pas',
+ fs_idbrtti in 'fs_idbrtti.pas',
+ fs_idialogsrtti in 'fs_idialogsrtti.pas',
+ fs_ievents in 'fs_ievents.pas',
+ fs_iexpression in 'fs_iexpression.pas',
+ fs_iextctrlsrtti in 'fs_iextctrlsrtti.pas',
+ fs_iformsrtti in 'fs_iformsrtti.pas',
+ fs_igraphicsrtti in 'fs_igraphicsrtti.pas',
+{$IFNDEF LINUX}
+ fs_iibxrtti in 'fs_iibxrtti.pas',
+{$ENDIF}
+ fs_iilparser in 'fs_iilparser.pas',
+ fs_iinterpreter in 'fs_iinterpreter.pas',
+ fs_iparser in 'fs_iparser.pas',
+ fs_isysrtti in 'fs_isysrtti.pas',
+ fs_itools in 'fs_itools.pas',
+ fs_xml in 'fs_xml.pas',
+ fs_tree in 'fs_tree.pas';
+
+end.
diff --git a/LibD28/fsx.res b/LibD28/fsx.res
new file mode 100644
index 0000000..5a84b72
Binary files /dev/null and b/LibD28/fsx.res differ
diff --git a/LibD28/mk.bat b/LibD28/mk.bat
new file mode 100644
index 0000000..82686e3
--- /dev/null
+++ b/LibD28/mk.bat
@@ -0,0 +1,21 @@
+..\frcc.exe frxrcClass.xml
+..\frcc.exe frxrcDesgn.xml
+..\frcc.exe frxrcExports.xml
+..\frcc.exe frxrcInsp.xml
+copy frxrcClass.pas ..\..\Source
+copy frxrcDesgn.pas ..\..\Source
+copy frxrcExports.pas ..\..\Source\ExportPack
+copy frxrcInsp.pas ..\..\Source
+copy *.pas ..\..\LibD4\
+copy *.pas ..\..\LibD5\
+copy *.pas ..\..\LibD6\
+copy *.pas ..\..\LibD7\
+copy *.pas ..\..\LibD9\
+copy *.pas ..\..\LibD10\
+copy *.pas ..\..\LibD11\
+copy *.pas ..\..\LibD12\
+copy *.pas ..\..\LibD14\
+copy *.pas ..\..\LibBCB4\
+copy *.pas ..\..\LibBCB5\
+copy *.pas ..\..\LibBCB6\
+del *.pas
\ No newline at end of file
diff --git a/LibD28/mkall.bat b/LibD28/mkall.bat
new file mode 100644
index 0000000..ff66232
--- /dev/null
+++ b/LibD28/mkall.bat
@@ -0,0 +1,5 @@
+rem ; make one .frc file that contains all resources.
+rem ; this file can be loaded from your application by this code:
+rem ; uses frxRes;
+rem ; frxResources.LoadFromFile('english.xml');
+..\frcc.exe -all
\ No newline at end of file
diff --git a/LibD28/readme.txt b/LibD28/readme.txt
new file mode 100644
index 0000000..26997cf
--- /dev/null
+++ b/LibD28/readme.txt
@@ -0,0 +1,56 @@
+FD components for FastReport 4.0
+
+Created by: Serega Glazyrin
+E-mail: glserega@mezonplus.ru
+
+Extended by: Francisco Armando Duenas Rodriguez
+E-mail: fduenas@gmxsoftware.com
+
+Install
+=======
+
+Open frxFDN.dpk, where N corresponds to your Delphi version and compile it.
+Open dclfrxFDN.dpk, compile and install it.
+
+Note from Francisco Armando Duenas Rodriguez
+============================================
+http://www.da-soft.com/forums/anydac-general-english/anydac-connector-for-fast-report-improved-and-submitted-to-support-team.html
+
+From what I have experienced developing these components, the interface for
+the conection is quite inconsistent, especially with the wizards to create
+connections, tables, and queries since it only has 2 fields, The driver (ADO,
+DBX, Zeos, FireDAC, etc) and a databasename which by default is an ADO connexion
+or a file, which for most engines, is not enough. As a matter of fact, of
+the diferent engines I tried, only the ADO Engine works.
+
+
+I was able to make it work with the wizard but I had to make a small change
+in the "frxConnWizard.pas" (Fast report sources) since there seems to be a
+bug and have never been fixed. In this unit, I had to add the line:
+
+ FItemIndex := ConnCB.ItemIndex + 1;
+
+after the line:
+
+ FDatabase := TfrxCustomDatabase(ClassRef.NewInstance);
+
+inside the procedure TfrxConnectionWizardForm.ConnCBClick(Sender: TObject);
+
+If you have problems with the wizard and you have the source, you may want
+to make this change.
+
+Getting started
+===============
+To get started with usage FireDAC FR plug-in:
+1) after installing the plugin open Example project
+2) set up FDConnection1 component to connect to your database
+3) ensure FDConnection1 is selected as DefaultDatabase in frxFDComponents1
+4) right click frxReport1 component at design-time and click Edit report... to open the component editor
+5) after the editor is opened select Data page among Code, Data, Page1 ones
+6) the left most palette allows you to create data components: FD Database, FD Table, FD Query, FD StoredProc
+ that match corresponding FireDAC components: TFDConnection, TFDTable, TFDQuery, TFDStoredProc
+7) if you want to select data from a table you can choose FD Table or FD Query components
+8) click the chosen one on the palette and then click on the data area next to Report Tree
+9) after that youll be able to set up all the required component properties in the Object Inspector (next to the palette)
+ similarly to how you would do that in Delphi
+10) then youll be able to work with the data component and its fields: all the data components get available in the Data Tree
\ No newline at end of file
diff --git a/LibD28/readme_lazarus.txt b/LibD28/readme_lazarus.txt
new file mode 100644
index 0000000..f90c82b
--- /dev/null
+++ b/LibD28/readme_lazarus.txt
@@ -0,0 +1,6 @@
+Cant be installed (no such db engines under lazarus):
+ fs_idbreg, fs_iibxreg, fs_iadoreg, fs_ibdereg, fs_iteereg
+ fs_ibdertti, fs_ichartrtti, fs_iadortti, fs_iibxrtti,
+
+todo for future fpc, lazarus:
+ fs_idisp
diff --git a/LibD28/tee.inc b/LibD28/tee.inc
new file mode 100644
index 0000000..285c35d
--- /dev/null
+++ b/LibD28/tee.inc
@@ -0,0 +1,85 @@
+//------------------- TeeChart component ----------------------------
+{$DEFINE TeeChartStd}
+
+//------------------- TeeChart Std 7 component ----------------------
+// If you have TeeChart Std 7, uncomment the following line:
+//{$DEFINE TeeChartStd7}
+
+//------------------- TeeChart Pro 4 component --------------------
+// If you have TeeChart Pro 4, uncomment the following line:
+//{$DEFINE TeeChart4}
+
+//------------------- TeeChart Pro 5 component --------------------
+// If you have TeeChart Pro 5, uncomment the following line:
+//{$DEFINE TeeChart5}
+
+//------------------- TeeChart Pro 6 component ----------------------
+// If you have TeeChart Pro 6, uncomment the following line:
+//{$DEFINE TeeChart6}
+
+//------------------- TeeChart Pro 7 component ----------------------
+// If you have TeeChart Pro 7, uncomment the following line:
+//{$DEFINE TeeChart7}
+
+//------------------- TeeChart Pro 8 component ----------------------
+// If you have TeeChart Pro 8, uncomment the following line:
+//{$DEFINE TeeChart8}
+
+//------------------- TeeChart Std 8 component ----------------------
+// If you have TeeChart Std 8, uncomment the following line:
+//{$DEFINE TeeChartStd8}
+
+//------------------- TeeChart Pro 9(2010) component ----------------------
+// If you have TeeChart Pro 9(2010), uncomment the following line:
+//{$DEFINE TeeChart9}
+
+//------------------- TeeChart Std 9(2010) component ----------------------
+// If you have TeeChart Std 9(2010), uncomment the following line:
+//{$DEFINE TeeChartStd9}
+
+
+// Don't change here ------------------------------------------------
+{$IFDEF TeeChartStd7}
+ {$UNDEF TeeChartStd}
+ {$DEFINE TeeChartStandart}
+{$ENDIF}
+
+{$IFDEF TeeChartStd8}
+ {$UNDEF TeeChartStd}
+ {$DEFINE TeeChartStandart}
+{$ENDIF}
+
+{$IFDEF TeeChartStd9}
+ {$UNDEF TeeChartStd}
+ {$DEFINE TeeChartStandart}
+{$ENDIF}
+
+{$IFDEF TeeChart4}
+ {$UNDEF TeeChartStd}
+ {$DEFINE TeeChartPro}
+{$ENDIF}
+
+{$IFDEF TeeChart5}
+ {$UNDEF TeeChartStd}
+ {$DEFINE TeeChartPro}
+{$ENDIF}
+
+{$IFDEF TeeChart6}
+ {$UNDEF TeeChartStd}
+ {$DEFINE TeeChartPro}
+{$ENDIF}
+
+{$IFDEF TeeChart7}
+ {$UNDEF TeeChartStd}
+ {$DEFINE TeeChartPro}
+{$ENDIF}
+
+{$IFDEF TeeChart8}
+ {$UNDEF TeeChartStd}
+ {$DEFINE TeeChartPro}
+{$ENDIF}
+
+{$IFDEF TeeChart9}
+ {$UNDEF TeeChartStd}
+ {$DEFINE TeeChartPro}
+{$ENDIF}
diff --git a/LibD28x64/FMX.BaseTypeAliases.pas b/LibD28x64/FMX.BaseTypeAliases.pas
new file mode 100644
index 0000000..2d807b0
--- /dev/null
+++ b/LibD28x64/FMX.BaseTypeAliases.pas
@@ -0,0 +1,283 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Graphics.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.BaseTypeAliases;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Types, FMX.Objects, System.UITypes, System.UIConsts, FMX.Graphics, FMX.Controls, System.Types, System.TypInfo;
+
+type
+
+ TCalloutPositionHelper = record helper for TCalloutPosition
+ const
+ cpTop = TCalloutPosition.Top deprecated 'Use TCalloutPosition.Top';
+ cpLeft = TCalloutPosition.Left deprecated 'Use TCalloutPosition.Left';
+ cpBottom = TCalloutPosition.Bottom deprecated 'Use TCalloutPosition.Bottom';
+ cpRight = TCalloutPosition.Right deprecated 'Use TCalloutPosition.Right';
+ end;
+
+ TCornerHelper = record helper for TCorner
+ const
+ crTopLeft = TCorner.TopLeft deprecated 'Use TCorner.TopLeft';
+ crTopRight = TCorner.TopRight deprecated 'Use TCorner.TopRight';
+ crBottomLeft = TCorner.BottomLeft deprecated 'Use TCorner.BottomLeft';
+ crBottomRight = TCorner.BottomRight deprecated 'Use TCorner.BottomRight';
+ end;
+
+ TCornerTypeHelper = record helper for TCornerType
+ const
+ ctRound = TCornerType.Round deprecated 'Use TCornerType.Round';
+ ctBevel = TCornerType.Bevel deprecated 'Use TCornerType.Bevel';
+ ctInnerRound = TCornerType.InnerRound deprecated 'Use TCornerType.InnerRound';
+ ctInnerLine = TCornerType.InnerLine deprecated 'Use TCornerType.InnerLine';
+ end;
+
+ TSideHelper = record helper for TSide
+ const
+ sdTop = TSide.Top deprecated 'Use TSide.Top';
+ sdLeft = TSide.Left deprecated 'Use TSide.Left';
+ sdBottom = TSide.Bottom deprecated 'Use TSide.Bottom';
+ sdRight = TSide.Right deprecated 'Use TSide.Right';
+ end;
+
+ TTextAlignHelper = record helper for TTextAlign
+ const
+ taCenter = TTextAlign.Center deprecated 'Use TTextAlign.Center';
+ taLeading = TTextAlign.Leading deprecated 'Use TTextAlign.Leading';
+ taTrailing = TTextAlign.Trailing deprecated 'Use TTextAlign.Trailing';
+ end;
+
+ TTextTrimmingHelper = record helper for TTextTrimming
+ const
+ ttNone = TTextTrimming.None deprecated 'Use TTextTrimming.None';
+ ttCharacter = TTextTrimming.Character deprecated 'Use TTextTrimming.Character';
+ ttWord = TTextTrimming.Word deprecated 'Use TTextTrimming.Word';
+ end;
+
+ TStyledSettingHelper = record helper for TStyledSetting
+ const
+ ssFamily = TStyledSetting.Family deprecated 'Use TStyledSetting.Family';
+ ssSize = TStyledSetting.Size deprecated 'Use TStyledSetting.Size';
+ ssStyle = TStyledSetting.Style deprecated 'Use TStyledSetting.Style';
+ ssFontColor = TStyledSetting.FontColor deprecated 'Use TStyledSetting.FontColor';
+ ssOther = TStyledSetting.Other deprecated 'Use TStyledSetting.Other';
+ end;
+
+ TMenuItemChangeHelper = record helper for TMenuItemChange
+ const
+ mcEnabled = TMenuItemChange.Enabled deprecated 'Use TMenuItemChange.Enabled';
+ mcVisible = TMenuItemChange.Visible deprecated 'Use TMenuItemChange.Visible';
+ mcText = TMenuItemChange.Text deprecated 'Use TMenuItemChange.Text';
+ mcShortcut = TMenuItemChange.Shortcut deprecated 'Use TMenuItemChange.Shortcut';
+ mcChecked = TMenuItemChange.Checked deprecated 'Use TMenuItemChange.Checked';
+ mcBitmap = TMenuItemChange.Bitmap deprecated 'Use TMenuItemChange.Bitmap';
+ end;
+
+ TScreenOrientationHelper = record helper for TScreenOrientation
+ const
+ soPortrait = TScreenOrientation.Portrait deprecated 'Use TScreenOrientation.Portrait';
+ soLandscape = TScreenOrientation.Landscape deprecated 'Use TScreenOrientation.Landscape';
+ soInvertedPortrait = TScreenOrientation.InvertedPortrait deprecated 'Use TScreenOrientation.InvertedPortrait';
+ soInvertedLandscape = TScreenOrientation.InvertedLandscape deprecated 'Use TScreenOrientation.InvertedLandscape';
+ end;
+
+ TFormStyleHelper = record helper for TFormStyle
+ const
+ fsNormal = TFormStyle.Normal deprecated 'Use TFormStyle.Normal';
+ fsPopup = TFormStyle.Popup deprecated 'Use TFormStyle.Popup';
+ fsStayOnTop = TFormStyle.StayOnTop deprecated 'Use TFormStyle.StayOnTop';
+ end;
+
+ TAlignLayoutHelper = record helper for TAlignLayout
+ const
+ alNone = TAlignLayout.None deprecated 'Use TAlignLayout.None';
+ alTop = TAlignLayout.Top deprecated 'Use TAlignLayout.Top';
+ alLeft = TAlignLayout.Left deprecated 'Use TAlignLayout.Left';
+ alRight = TAlignLayout.Right deprecated 'Use TAlignLayout.Right';
+ alBottom = TAlignLayout.Bottom deprecated 'Use TAlignLayout.Bottom';
+ alMostTop = TAlignLayout.MostTop deprecated 'Use TAlignLayout.MostTop';
+ alMostBottom = TAlignLayout.MostBottom deprecated 'Use TAlignLayout.MostBottom';
+ alMostLeft = TAlignLayout.MostLeft deprecated 'Use TAlignLayout.MostLeft';
+ alMostRight = TAlignLayout.MostRight deprecated 'Use TAlignLayout.MostRight';
+ alClient = TAlignLayout.Client deprecated 'Use TAlignLayout.Client';
+ alContents = TAlignLayout.Contents deprecated 'Use TAlignLayout.Contents';
+ alCenter = TAlignLayout.Center deprecated 'Use TAlignLayout.Center';
+ alVertCenter = TAlignLayout.VertCenter deprecated 'Use TAlignLayout.VertCenter';
+ alHorzCenter = TAlignLayout.HorzCenter deprecated 'Use TAlignLayout.HorzCenter';
+ alHorizontal = TAlignLayout.Horizontal deprecated 'Use TAlignLayout.Horizontal';
+ alVertical = TAlignLayout.Vertical deprecated 'Use TAlignLayout.Vertical';
+ alScale = TAlignLayout.Scale deprecated 'Use TAlignLayout.Scale';
+ alFit = TAlignLayout.Fit deprecated 'Use TAlignLayout.Fit';
+ alFitLeft = TAlignLayout.FitLeft deprecated 'Use TAlignLayout.FitLeft';
+ alFitRight = TAlignLayout.FitRight deprecated 'Use TAlignLayout.FitRight';
+ end;
+
+ TGradientStyleHelper = record helper for TGradientStyle
+ const
+ gsLinear = TGradientStyle.Linear deprecated 'Use TGradientStyle.Linear';
+ gsRadial = TGradientStyle.Radial deprecated 'Use TGradientStyle.Radial';
+ end;
+
+ TBrushKindHelper = record helper for TBrushKind
+ const
+ bkNone = TBrushKind.None deprecated 'Use TBrushKind.None';
+ bkSolid = TBrushKind.Solid deprecated 'Use TBrushKind.Solid';
+ bkGradient = TBrushKind.Gradient deprecated 'Use TBrushKind.Gradient';
+ bkBitmap = TBrushKind.Bitmap deprecated 'Use TBrushKind.Bitmap';
+ bkResource = TBrushKind.Resource deprecated 'Use TBrushKind.Resource';
+ end;
+
+ TStrokeCapHelper = record helper for TStrokeCap
+ const
+ scFlat = TStrokeCap.Flat deprecated 'Use TStrokeCap.Flat';
+ scRound = TStrokeCap.Round deprecated 'Use TStrokeCap.Round';
+ end;
+
+ TStrokeJoinHelper = record helper for TStrokeJoin
+ const
+ sjMiter = TStrokeJoin.Miter deprecated 'Use TStrokeJoin.Miter';
+ sjRound = TStrokeJoin.Round deprecated 'Use TStrokeJoin.Round';
+ sjBevel = TStrokeJoin.Bevel deprecated 'Use TStrokeJoin.Bevel';
+ end;
+
+ TStrokeDashHelper = record helper for TStrokeDash
+ const
+ sdSolid = TStrokeDash.Solid deprecated 'Use TStrokeDash.Solid';
+ sdDash = TStrokeDash.Dash deprecated 'Use TStrokeDash.Dash';
+ sdDot = TStrokeDash.Dot deprecated 'Use TStrokeDash.Dot';
+ sdDashDot = TStrokeDash.DashDot deprecated 'Use TStrokeDash.DashDot';
+ sdDashDotDot = TStrokeDash.DashDotDot deprecated 'Use TStrokeDash.DashDotDot';
+ sdCustom = TStrokeDash.Custom deprecated 'Use TStrokeDash.Custom';
+ end;
+
+ TFillTextFlagHelper = record helper for TFillTextFlag
+ const
+ ftRightToLeft = TFillTextFlag.RightToLeft deprecated 'Use TFillTextFlag.RightToLeft';
+ end;
+
+ TMapAccessHelper = record helper for TMapAccess
+ const
+ maRead = TMapAccess.Read deprecated 'Use TMapAccess.Read';
+ maWrite = TMapAccess.Write deprecated 'Use TMapAccess.Write';
+ maReadWrite = TMapAccess.ReadWrite deprecated 'Use TMapAccess.ReadWrite';
+ end;
+
+ TOrientationHelper = record helper for TOrientation
+ const
+ orHorizontal = TOrientation.Horizontal deprecated 'Use TOrientation.Horizontal';
+ orVertical = TOrientation.Vertical deprecated 'Use TOrientation.Vertical';
+ end;
+
+ TPlacementHelper = record helper for TPlacement
+ const
+ plBottom = TPlacement.Bottom deprecated 'Use TPlacement.Bottom';
+ plTop = TPlacement.Top deprecated 'Use TPlacement.Top';
+ plLeft = TPlacement.Left deprecated 'Use TPlacement.Left';
+ plRight = TPlacement.Right deprecated 'Use TPlacement.Right';
+ plCenter = TPlacement.Center deprecated 'Use TPlacement.Center';
+ plBottomCenter = TPlacement.BottomCenter deprecated 'Use TPlacement.BottomCenter';
+ plTopCenter = TPlacement.TopCenter deprecated 'Use TPlacement.TopCenter';
+ plLeftCenter = TPlacement.LeftCenter deprecated 'Use TPlacement.LeftCenter';
+ plRightCenter = TPlacement.RightCenter deprecated 'Use TPlacement.RightCenter';
+ plAbsolute = TPlacement.Absolute deprecated 'Use TPlacement.Absolute';
+ plMouse = TPlacement.Mouse deprecated 'Use TPlacement.Mouse';
+ plMouseCenter = TPlacement.MouseCenter deprecated 'Use TPlacement.MouseCenter';
+ end;
+
+ TVirtualKeyboardTypeHelper = record helper for TVirtualKeyboardType
+ const
+ vktDefault = TVirtualKeyboardType.Default deprecated 'Use TVirtualKeyboardType.Default';
+ vktNumbersAndPunctuation = TVirtualKeyboardType.NumbersAndPunctuation deprecated 'Use TVirtualKeyboardType.NumbersAndPunctuation';
+ vktNumberPad = TVirtualKeyboardType.NumberPad deprecated 'Use TVirtualKeyboardType.NumberPad';
+ vktPhonePad = TVirtualKeyboardType.PhonePad deprecated 'Use TVirtualKeyboardType.PhonePad';
+ vktAlphabet = TVirtualKeyboardType.Alphabet deprecated 'Use TVirtualKeyboardType.Alphabet';
+ vktURL = TVirtualKeyboardType.URL deprecated 'Use TVirtualKeyboardType.URL';
+ vktNamePhonePad = TVirtualKeyboardType.NamePhonePad deprecated 'Use TVirtualKeyboardType.NamePhonePad';
+ vktEmailAddress = TVirtualKeyboardType.EmailAddress deprecated 'Use TVirtualKeyboardType.EmailAddress';
+ end;
+
+ TVirtualKeyboardStateHelper = record helper for TVirtualKeyboardState
+ const
+ vksAutoShow = TVirtualKeyboardState.AutoShow deprecated 'Use TVirtualKeyboardState.AutoShow';
+ vksVisible = TVirtualKeyboardState.Visible deprecated 'Use TVirtualKeyboardState.Visible';
+ vksError = TVirtualKeyboardState.Error deprecated 'Use TVirtualKeyboardState.Error';
+ vksTransient = TVirtualKeyboardState.Transient deprecated 'Use TVirtualKeyboardState.Transient';
+ end;
+
+ TReturnKeyTypeHelper = record helper for TReturnKeyType
+ const
+ rktDefault = TReturnKeyType.Default deprecated 'Use TReturnKeyType.Default';
+ rktDone = TReturnKeyType.Done deprecated 'Use TReturnKeyType.Done';
+ rktGo = TReturnKeyType.Go deprecated 'Use TReturnKeyType.Go';
+ rktNext = TReturnKeyType.Next deprecated 'Use TReturnKeyType.Next';
+ rktSearch = TReturnKeyType.Search deprecated 'Use TReturnKeyType.Search';
+ rktSend = TReturnKeyType.Send deprecated 'Use TReturnKeyType.Send';
+ end;
+
+implementation
+
+initialization
+ AddEnumElementAliases(TypeInfo(TCalloutPosition), ['cpTop', 'cpLeft', 'cpBottom', 'cpRight']);
+ AddEnumElementAliases(TypeInfo(TCorner), ['crTopLeft', 'crTopRight', 'crBottomLeft', 'crBottomRight']);
+ AddEnumElementAliases(TypeInfo(TCornerType), ['ctRound', 'ctBevel', 'ctInnerRound', 'ctInnerLine']);
+ AddEnumElementAliases(TypeInfo(TSide), ['sdTop', 'sdLeft', 'sdBottom', 'sdRight']);
+ AddEnumElementAliases(TypeInfo(TTextAlign), ['taCenter', 'taLeading', 'taTrailing']);
+ AddEnumElementAliases(TypeInfo(TTextTrimming), ['ttNone', 'ttCharacter', 'ttWord']);
+ AddEnumElementAliases(TypeInfo(TStyledSetting), ['ssFamily', 'ssSize', 'ssStyle', 'ssFontColor', 'ssOther']);
+ AddEnumElementAliases(TypeInfo(TMenuItemChange), ['mcEnabled', 'mcVisible', 'mcText', 'mcShortcut', 'mcChecked', 'mcBitmap']);
+ AddEnumElementAliases(TypeInfo(TScreenOrientation), ['soPortrait', 'soLandscape', 'soInvertedPortrait', 'soInvertedLandscape']);
+ AddEnumElementAliases(TypeInfo(TFormStyle), ['fsNormal', 'fsPopup', 'fsStayOnTop']);
+ AddEnumElementAliases(TypeInfo(TAlignLayout), ['alNone', 'alTop', 'alLeft', 'alRight', 'alBottom', 'alMostTop', 'alMostBottom', 'alMostLeft', 'alMostRight', 'alClient', 'alContents', 'alCenter', 'alVertCenter', 'alHorzCenter', 'alHorizontal', 'alVertical', 'alScale', 'alFit', 'alFitLeft', 'alFitRight']);
+ AddEnumElementAliases(TypeInfo(TGradientStyle), ['gsLinear', 'gsRadial']);
+ AddEnumElementAliases(TypeInfo(TBrushKind), ['bkNone', 'bkSolid', 'bkGradient', 'bkBitmap', 'bkResource']);
+ AddEnumElementAliases(TypeInfo(TStrokeCap), ['scFlat', 'scRound']);
+ AddEnumElementAliases(TypeInfo(TStrokeJoin), ['sjMiter', 'sjRound', 'sjBevel']);
+ AddEnumElementAliases(TypeInfo(TStrokeDash), ['sdSolid', 'sdDash', 'sdDot', 'sdDashDot', 'sdDashDotDot', 'sdCustom']);
+ AddEnumElementAliases(TypeInfo(TMapAccess), ['maRead', 'maWrite', 'maReadWrite']);
+ AddEnumElementAliases(TypeInfo(TFillTextFlag), ['ftRightToLeft']);
+ AddEnumElementAliases(TypeInfo(TOrientation), ['orHorizontal', 'orVertical']);
+ AddEnumElementAliases(TypeInfo(TPlacement), ['plBottom', 'plTop', 'plLeft', 'plRight', 'plCenter', 'plBottomCenter', 'plTopCenter', 'plLeftCenter', 'plRightCenter', 'plAbsolute', 'plMouse', 'plMouseCenter']);
+ AddEnumElementAliases(TypeInfo(TVirtualKeyboardType), ['vktDefault', 'vktNumbersAndPunctuation', 'vktNumberPad', 'vktPhonePad', 'vktAlphabet', 'vktURL', 'vktNamePhonePad', 'vktEmailAddress']);
+ AddEnumElementAliases(TypeInfo(TReturnKeyType), ['rktDefault', 'rktDone', 'rktGo', 'rktNext', 'rktSearch']);
+ AddEnumElementAliases(TypeInfo(TVirtualKeyboardState), ['vksAutoShow', 'vksVisible', 'vksError', 'vksTransient']);
+
+
+finalization
+ RemoveEnumElementAliases(TypeInfo(TCalloutPosition));
+ RemoveEnumElementAliases(TypeInfo(TCorner));
+ RemoveEnumElementAliases(TypeInfo(TCornerType));
+ RemoveEnumElementAliases(TypeInfo(TSide));
+ RemoveEnumElementAliases(TypeInfo(TTextAlign));
+ RemoveEnumElementAliases(TypeInfo(TTextTrimming));
+ RemoveEnumElementAliases(TypeInfo(TStyledSetting));
+ RemoveEnumElementAliases(TypeInfo(TMenuItemChange));
+ RemoveEnumElementAliases(TypeInfo(TScreenOrientation));
+ RemoveEnumElementAliases(TypeInfo(TFormStyle));
+ RemoveEnumElementAliases(TypeInfo(TAlignLayout));
+ RemoveEnumElementAliases(TypeInfo(TGradientStyle));
+ RemoveEnumElementAliases(TypeInfo(TBrushKind));
+ RemoveEnumElementAliases(TypeInfo(TStrokeCap));
+ RemoveEnumElementAliases(TypeInfo(TStrokeJoin));
+ RemoveEnumElementAliases(TypeInfo(TStrokeDash));
+ RemoveEnumElementAliases(TypeInfo(TMapAccess));
+ RemoveEnumElementAliases(TypeInfo(TFillTextFlag));
+ RemoveEnumElementAliases(TypeInfo(TOrientation));
+ RemoveEnumElementAliases(TypeInfo(TPlacement));
+ RemoveEnumElementAliases(TypeInfo(TVirtualKeyboardType));
+ RemoveEnumElementAliases(TypeInfo(TReturnKeyType));
+ RemoveEnumElementAliases(TypeInfo(TVirtualKeyboardState));
+
+
+end.
diff --git a/LibD28x64/FMX.ConverterFR3toFRFMX.pas b/LibD28x64/FMX.ConverterFR3toFRFMX.pas
new file mode 100644
index 0000000..ad00f04
--- /dev/null
+++ b/LibD28x64/FMX.ConverterFR3toFRFMX.pas
@@ -0,0 +1,174 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ RB -> FR importer }
+{ }
+{ Copyright (c) 1998-2008 }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.ConverterFR3toFRFMX ;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.SysUtils, System.Classes, FMX.Types, System.UITypes,
+ FMX.frxClass, FMX.frxVariables, FMX.frxDCtrl,
+ {$IFDEF LINUX}
+ {$I tee.inc}
+ {$IFDEF TeeChartPro}
+ FMX.frxChart,
+ {$ENDIF}
+ {$ELSE}
+ FMX.frxChart,
+ {$ENDIF}
+ FMX.frxCross, System.Variants, FMX.frxGradient;
+
+
+type
+ TfrxCustomCrossViewHack = class(TfrxCustomCrossView);
+ TfrxConverterEventsNew = class(TObject)
+ private
+ procedure DoAfterLoad(Sender: TfrxReport);
+ function DoLoad(Sender: TfrxReport; Stream: TStream): Boolean;
+ end;
+
+var
+ frxConverterEventsNew: TfrxConverterEventsNew;
+
+function RGB(r, g, b: Byte): TAlphaColor; inline;
+begin
+ Result := (r or (g shl 8) or (b shl 16));
+end;
+
+procedure ToRGB(Color: TAlphaColor; var r, g, b: Byte); inline;
+begin
+ r := Color and $000000ff;
+ g := (Color shr 8) and $000000ff;
+ b := (Color shr 16) and $000000ff;
+end;
+
+function ColorToAlphaColor(Color: TAlphaColor): TAlphaColor; inline;
+var
+ R, G, B : BYTE;
+begin
+ ToRGB(Color, R, G, B);
+ Result := RGB(B, G, R) or $FF000000;
+end;
+
+procedure ConvertViewObj(View: TfrxView);
+begin
+ if View.Color = $1FFFFFFF then View.Color := 0
+ else if(View.Color <> 0) then
+ begin
+ View.Color := ColorToAlphaColor(View.Color);
+ end;
+
+ View.Font.Color := ColorToAlphaColor(View.Font.Color);
+ View.Frame.Color := ColorToAlphaColor(View.Frame.Color);
+ View.Frame.LeftLine.Color := ColorToAlphaColor(View.Frame.LeftLine.Color);
+ View.Frame.RightLine.Color := ColorToAlphaColor(View.Frame.LeftLine.Color);
+ View.Frame.TopLine.Color := ColorToAlphaColor(View.Frame.LeftLine.Color);
+ View.Frame.BottomLine.Color := ColorToAlphaColor(View.Frame.LeftLine.Color);
+end;
+
+procedure ConvertMemoView(Memo: TfrxCustomMemoView);
+begin
+ ConvertViewObj(Memo);
+ Memo.Highlight.Color := ColorToAlphaColor(Memo.Highlight.Color);
+end;
+
+procedure CorrectProperties(Report: TfrxReport);
+var
+ i, j: Integer;
+ Obj: TObject;
+ ObjList: TList;
+begin
+ for i := 0 to Report.AllObjects.Count - 1 do
+ begin
+ Obj := Report.AllObjects[i];
+ if Obj is TfrxView then
+ begin
+ ConvertViewObj(TfrxView(Obj));
+ end;
+ if Obj is TfrxCustomMemoView then
+ TfrxCustomMemoView(Obj).Highlight.Color := ColorToAlphaColor(TfrxCustomMemoView(Obj).Highlight.Color);
+ if Obj is TfrxGradientView then
+ begin
+ TfrxGradientView(Obj).BeginColor := ColorToAlphaColor(TfrxGradientView(Obj).BeginColor);
+ TfrxGradientView(Obj).EndColor := ColorToAlphaColor(TfrxGradientView(Obj).EndColor);
+ end;
+ if Obj is TfrxCustomCrossView then
+ begin
+ ObjList := TfrxCustomCrossViewHack(Obj).GetNestedObjects;
+ try
+ for j := 0 to ObjList.Count - 1 do
+ if TObject(ObjList[j]) is TfrxView then ConvertViewObj(TfrxView(ObjList[j]));
+ finally
+ ObjList.Free;
+ end;
+ ObjList := TfrxCustomCrossViewHack(Obj).FCellMemos;
+ for j := 0 to ObjList.Count - 1 do
+ if TObject(ObjList[j]) is TfrxCustomMemoView then ConvertMemoView(TfrxCustomMemoView(ObjList[j]));
+ ObjList := TfrxCustomCrossViewHack(Obj).FCellHeaderMemos;
+ for j := 0 to ObjList.Count - 1 do
+ if TObject(ObjList[j]) is TfrxCustomMemoView then ConvertMemoView(TfrxCustomMemoView(ObjList[j]));
+
+ ObjList := TfrxCustomCrossViewHack(Obj).FColumnMemos;
+ for j := 0 to ObjList.Count - 1 do
+ if TObject(ObjList[j]) is TfrxCustomMemoView then ConvertMemoView(TfrxCustomMemoView(ObjList[j]));
+
+ ObjList := TfrxCustomCrossViewHack(Obj).FColumnTotalMemos;
+ for j := 0 to ObjList.Count - 1 do
+ if TObject(ObjList[j]) is TfrxCustomMemoView then ConvertMemoView(TfrxCustomMemoView(ObjList[j]));
+
+ ObjList := TfrxCustomCrossViewHack(Obj).FCornerMemos;
+ for j := 0 to ObjList.Count - 1 do
+ if TObject(ObjList[j]) is TfrxCustomMemoView then ConvertMemoView(TfrxCustomMemoView(ObjList[j]));
+
+ ObjList := TfrxCustomCrossViewHack(Obj).FRowMemos;
+ for j := 0 to ObjList.Count - 1 do
+ if TObject(ObjList[j]) is TfrxCustomMemoView then ConvertMemoView(TfrxCustomMemoView(ObjList[j]));
+
+ ObjList := TfrxCustomCrossViewHack(Obj).FRowTotalMemos;
+ for j := 0 to ObjList.Count - 1 do
+ if TObject(ObjList[j]) is TfrxCustomMemoView then ConvertMemoView(TfrxCustomMemoView(ObjList[j]));
+
+ end;
+
+ end;
+end;
+
+procedure TfrxConverterEventsNew.DoAfterLoad(Sender: TfrxReport);
+begin
+ if not Sender.ReportOptions.IsFMXReport then
+ CorrectProperties(Sender);
+ Sender.ReportOptions.IsFMXReport := True;
+end;
+
+
+
+function TfrxConverterEventsNew.DoLoad(Sender: TfrxReport;
+ Stream: TStream): Boolean;
+begin
+ Sender.ReportOptions.IsFMXReport := False;
+ Result := False;
+end;
+
+initialization
+ frxConverterEventsNew := TfrxConverterEventsNew.Create;
+ frxConverter.OnAfterLoad := frxConverterEventsNew.DoAfterLoad;
+ frxConverter.OnLoad := frxConverterEventsNew.DoLoad;
+ frxConverter.Filter := '*.fr3';
+
+finalization
+ frxConverterEventsNew.Free;
+
+
+end.
\ No newline at end of file
diff --git a/LibD28x64/FMX.DelphiZXIngQRCode.pas b/LibD28x64/FMX.DelphiZXIngQRCode.pas
new file mode 100644
index 0000000..f1b4a95
--- /dev/null
+++ b/LibD28x64/FMX.DelphiZXIngQRCode.pas
@@ -0,0 +1,3795 @@
+unit FMX.DelphiZXingQRCode;
+
+// ZXing QRCode port to Delphi, by Debenu Pty Ltd
+// www.debenu.com
+
+// Original copyright notice
+(*
+ * Copyright 2008 ZXing authors
+ *
+ * Licensed under the Apache License, Version 2.0 (the "License");
+ * you may not use this file except in compliance with the License.
+ * You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing, software
+ * distributed under the License is distributed on an "AS IS" BASIS,
+ * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ * See the License for the specific language governing permissions and
+ * limitations under the License.
+ *)
+
+interface
+
+{$I frx.inc}
+
+type
+ TQRCodeEncoding = (qrAuto, qrNumeric, qrAlphanumeric, qrISO88591, qrUTF8NoBOM, qrUTF8BOM, qrShift_JIS);
+ TQRErrorLevels = (ecL, ecM, ecQ, ecH);
+ T2DBooleanArray = array of array of Boolean;
+
+ TErrorCorrectionLevel = class
+ private
+ FBits: Integer;
+ FOrdinal: Integer;
+ public
+ procedure Assign(Source: TErrorCorrectionLevel);
+ property Bits: Integer read FBits write FBits;
+ property Ordinal: Integer read FOrdinal write FOrdinal;
+ end;
+
+ TDelphiZXingQRCode = class
+ private
+ procedure SetErrorLevels(const Value: TQRErrorLevels);
+ procedure SetCodePage(const Value: Longint);
+ protected
+ FData: WideString;
+ FRows: Integer;
+ FColumns: Integer;
+ FEncoding: TQRCodeEncoding;
+ FQuietZone: Integer;
+ FElements: T2DBooleanArray;
+ FErrorLevels: TQRErrorLevels;
+ FLevel: TErrorCorrectionLevel;
+ FCodePage: Longint;
+ procedure SetEncoding(NewEncoding: TQRCodeEncoding);
+ procedure SetData(const NewData: WideString);
+ procedure SetQuietZone(NewQuietZone: Integer);
+ function GetIsBlack(Row, Column: Integer): Boolean;
+ procedure Update;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ property Data: WideString read FData write SetData;
+ property Encoding: TQRCodeEncoding read FEncoding write SetEncoding;
+ property QuietZone: Integer read FQuietZone write SetQuietZone;
+ property Rows: Integer read FRows;
+ property Columns: Integer read FColumns;
+ property IsBlack[Row, Column: Integer]: Boolean read GetIsBlack;
+ property ErrorLevels: TQRErrorLevels read FErrorLevels write SetErrorLevels;
+ property CodePage: Longint read FCodePage write SetCodePage;
+ end;
+
+implementation
+
+uses
+ System.contnrs, System.Math, System.Classes, System.SysUtils;
+
+type
+ TByteArray = array of Byte;
+ T2DByteArray = array of array of Byte;
+ TIntegerArray = array of Integer;
+
+const
+ NUM_MASK_PATTERNS = 8;
+
+ QUIET_ZONE_SIZE = 4;
+
+ ALPHANUMERIC_TABLE: array[0..95] of Integer = (
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, // 0x00-0x0f
+ -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, // 0x10-0x1f
+ 36, -1, -1, -1, 37, 38, -1, -1, -1, -1, 39, 40, -1, 41, 42, 43, // 0x20-0x2f
+ 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 44, -1, -1, -1, -1, -1, // 0x30-0x3f
+ -1, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, // 0x40-0x4f
+ 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, -1, -1, -1, -1, -1 // 0x50-0x5f
+ );
+
+ DEFAULT_BYTE_MODE_ENCODING = 'ISO-8859-1';
+ DefaultECIValue = 3; // Corresponding 'ISO-8859-1' See https://strokescribe.com/ru/ECI.html
+
+ QRErrorLevelsBits: array[0..3] of Integer = (1, 0, 3, 2);
+
+ POSITION_DETECTION_PATTERN: array[0..6, 0..6] of Integer = (
+ (1, 1, 1, 1, 1, 1, 1),
+ (1, 0, 0, 0, 0, 0, 1),
+ (1, 0, 1, 1, 1, 0, 1),
+ (1, 0, 1, 1, 1, 0, 1),
+ (1, 0, 1, 1, 1, 0, 1),
+ (1, 0, 0, 0, 0, 0, 1),
+ (1, 1, 1, 1, 1, 1, 1));
+
+ HORIZONTAL_SEPARATION_PATTERN: array[0..0, 0..7] of Integer = (
+ (0, 0, 0, 0, 0, 0, 0, 0));
+
+ VERTICAL_SEPARATION_PATTERN: array[0..6, 0..0] of Integer = (
+ (0), (0), (0), (0), (0), (0), (0));
+
+ POSITION_ADJUSTMENT_PATTERN: array[0..4, 0..4] of Integer = (
+ (1, 1, 1, 1, 1),
+ (1, 0, 0, 0, 1),
+ (1, 0, 1, 0, 1),
+ (1, 0, 0, 0, 1),
+ (1, 1, 1, 1, 1));
+
+ // From Appendix E. Table 1, JIS0510X:2004 (p 71). The table was double-checked by komatsu.
+ POSITION_ADJUSTMENT_PATTERN_COORDINATE_TABLE: array[0..39, 0..6] of Integer = (
+ (-1, -1, -1, -1, -1, -1, -1), // Version 1
+ ( 6, 18, -1, -1, -1, -1, -1), // Version 2
+ ( 6, 22, -1, -1, -1, -1, -1), // Version 3
+ ( 6, 26, -1, -1, -1, -1, -1), // Version 4
+ ( 6, 30, -1, -1, -1, -1, -1), // Version 5
+ ( 6, 34, -1, -1, -1, -1, -1), // Version 6
+ ( 6, 22, 38, -1, -1, -1, -1), // Version 7
+ ( 6, 24, 42, -1, -1, -1, -1), // Version 8
+ ( 6, 26, 46, -1, -1, -1, -1), // Version 9
+ ( 6, 28, 50, -1, -1, -1, -1), // Version 10
+ ( 6, 30, 54, -1, -1, -1, -1), // Version 11
+ ( 6, 32, 58, -1, -1, -1, -1), // Version 12
+ ( 6, 34, 62, -1, -1, -1, -1), // Version 13
+ ( 6, 26, 46, 66, -1, -1, -1), // Version 14
+ ( 6, 26, 48, 70, -1, -1, -1), // Version 15
+ ( 6, 26, 50, 74, -1, -1, -1), // Version 16
+ ( 6, 30, 54, 78, -1, -1, -1), // Version 17
+ ( 6, 30, 56, 82, -1, -1, -1), // Version 18
+ ( 6, 30, 58, 86, -1, -1, -1), // Version 19
+ ( 6, 34, 62, 90, -1, -1, -1), // Version 20
+ ( 6, 28, 50, 72, 94, -1, -1), // Version 21
+ ( 6, 26, 50, 74, 98, -1, -1), // Version 22
+ ( 6, 30, 54, 78, 102, -1, -1), // Version 23
+ ( 6, 28, 54, 80, 106, -1, -1), // Version 24
+ ( 6, 32, 58, 84, 110, -1, -1), // Version 25
+ ( 6, 30, 58, 86, 114, -1, -1), // Version 26
+ ( 6, 34, 62, 90, 118, -1, -1), // Version 27
+ ( 6, 26, 50, 74, 98, 122, -1), // Version 28
+ ( 6, 30, 54, 78, 102, 126, -1), // Version 29
+ ( 6, 26, 52, 78, 104, 130, -1), // Version 30
+ ( 6, 30, 56, 82, 108, 134, -1), // Version 31
+ ( 6, 34, 60, 86, 112, 138, -1), // Version 32
+ ( 6, 30, 58, 86, 114, 142, -1), // Version 33
+ ( 6, 34, 62, 90, 118, 146, -1), // Version 34
+ ( 6, 30, 54, 78, 102, 126, 150), // Version 35
+ ( 6, 24, 50, 76, 102, 128, 154), // Version 36
+ ( 6, 28, 54, 80, 106, 132, 158), // Version 37
+ ( 6, 32, 58, 84, 110, 136, 162), // Version 38
+ ( 6, 26, 54, 82, 110, 138, 166), // Version 39
+ ( 6, 30, 58, 86, 114, 142, 170) // Version 40
+ );
+
+ // Type info cells at the left top corner.
+ TYPE_INFO_COORDINATES: array[0..14, 0..1] of Integer = (
+ (8, 0),
+ (8, 1),
+ (8, 2),
+ (8, 3),
+ (8, 4),
+ (8, 5),
+ (8, 7),
+ (8, 8),
+ (7, 8),
+ (5, 8),
+ (4, 8),
+ (3, 8),
+ (2, 8),
+ (1, 8),
+ (0, 8)
+ );
+
+ // From Appendix D in JISX0510:2004 (p. 67)
+ VERSION_INFO_POLY = $1f25; // 1 1111 0010 0101
+
+ // From Appendix C in JISX0510:2004 (p.65).
+ TYPE_INFO_POLY = $537;
+ TYPE_INFO_MASK_PATTERN = $5412;
+
+
+ VERSION_DECODE_INFO: array[0..33] of Integer = (
+
+ $07C94, $085BC, $09A99, $0A4D3, $0BBF6,
+ $0C762, $0D847, $0E60D, $0F928, $10B78,
+ $1145D, $12A17, $13532, $149A6, $15683,
+ $168C9, $177EC, $18EC4, $191E1, $1AFAB,
+ $1B08E, $1CC1A, $1D33F, $1ED75, $1F250,
+ $209D5, $216F0, $228BA, $2379F, $24B0B,
+ $2542E, $26A64, $27541, $28C69);
+
+type
+ TMode = (qmTerminator, qmNumeric, qmAlphanumeric, qmStructuredAppend,
+ qmByte, qmECI, qmKanji, qmFNC1FirstPosition, qmFNC1SecondPosition,
+ qmHanzi);
+
+const
+ ModeCharacterCountBits: array[TMode] of array[0..2] of Integer = (
+ (0, 0, 0), (10, 12, 14), (9, 11, 13), (0, 0, 0), (8, 16, 16),
+ (0, 0, 0), (8, 10, 12), (0, 0, 0), (0, 0, 0), (8, 10, 12));
+
+ ModeBits: array[TMode] of Integer = (0, 1, 2, 3, 4, 7, 8, 5, 9, 13);
+
+type
+ TECB = class
+ private
+ Count: Integer;
+ DataCodewords: Integer;
+ public
+ constructor Create(Count, DataCodewords: Integer);
+ function GetCount: Integer;
+ function GetDataCodewords: Integer;
+ end;
+
+ TECBArray = array of TECB;
+
+ TECBlocks = class
+ private
+ ECCodewordsPerBlock: Integer;
+ ECBlocks: TECBArray;
+ public
+ constructor Create(ECCodewordsPerBlock: Integer; ECBlocks: TECB); overload;
+ constructor Create(ECCodewordsPerBlock: Integer; ECBlocks1, ECBlocks2: TECB); overload;
+ destructor Destroy; override;
+ function GetTotalECCodewords: Integer;
+ function GetNumBlocks: Integer;
+ function GetECCodewordsPerBlock: Integer;
+ function GetECBlocks: TECBArray;
+ end;
+
+ TByteMatrix = class
+ protected
+ Bytes: T2DByteArray;
+ FWidth: Integer;
+ FHeight: Integer;
+ public
+ constructor Create(Width, Height: Integer);
+ function Get(X, Y: Integer): Integer;
+ procedure SetBoolean(X, Y: Integer; Value: Boolean);
+ procedure SetInteger(X, Y: Integer; Value: Integer);
+ function GetArray: T2DByteArray;
+ procedure Assign(Source: TByteMatrix);
+ procedure Clear(Value: Byte);
+ function Hash: AnsiString;
+ property Width: Integer read FWidth;
+ property Height: Integer read FHeight;
+ end;
+
+ TBitArray = class
+ private
+ Bits: array of Integer;
+ Size: Integer;
+ procedure EnsureCapacity(Size: Integer);
+ public
+ constructor Create; overload;
+ constructor Create(Size: Integer); overload;
+ procedure Clear;
+ function GetSizeInBytes: Integer;
+ function GetSize: Integer;
+ function Get(I: Integer): Boolean;
+ procedure SetBit(Index: Integer);
+ procedure AppendBit(Bit: Boolean);
+ procedure AppendBits(Value, NumBits: Integer);
+ procedure AppendBitArray(NewBitArray: TBitArray);
+ procedure ToBytes(BitOffset: Integer; Source: TByteArray; Offset,
+ NumBytes: Integer);
+ procedure XorOperation(Other: TBitArray);
+ end;
+
+ TCharacterSetECI = class
+
+ end;
+
+ TVersion = class
+ private
+ VersionNumber: Integer;
+ AlignmentPatternCenters: array of Integer;
+ ECBlocks: array of TECBlocks;
+ TotalCodewords: Integer;
+ ECCodewords: Integer;
+ public
+ constructor Create(VersionNumber: Integer; AlignmentPatternCenters: array of Integer; ECBlocks1, ECBlocks2, ECBlocks3, ECBlocks4: TECBlocks);
+ destructor Destroy; override;
+ class function GetVersionForNumber(VersionNum: Integer): TVersion;
+ class function ChooseVersion(NumInputBits: Integer; ecLevel: TErrorCorrectionLevel): TVersion;
+ function GetTotalCodewords: Integer;
+ function GetECBlocksForLevel(ECLevel: TErrorCorrectionLevel): TECBlocks;
+ function GetDimensionForVersion: Integer;
+ end;
+
+ TMaskUtil = class
+ public
+ function GetDataMaskBit(MaskPattern, X, Y: Integer): Boolean;
+ end;
+
+ TQRCode = class
+ private
+ FMode: TMode;
+ FECLevel: TErrorCorrectionLevel;
+ FVersion: Integer;
+ FMatrixWidth: Integer;
+ FMaskPattern: Integer;
+ FNumTotalBytes: Integer;
+ FNumDataBytes: Integer;
+ FNumECBytes: Integer;
+ FNumRSBlocks: Integer;
+ FMatrix: TByteMatrix;
+ FQRCodeError: Boolean;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function At(X, Y: Integer): Integer;
+ function IsValid: Boolean;
+ function IsValidMaskPattern(MaskPattern: Integer): Boolean;
+ procedure SetMatrix(NewMatrix: TByteMatrix);
+ procedure SetECLevel(NewECLevel: TErrorCorrectionLevel);
+ procedure SetAll(VersionNum, NumBytes, NumDataBytes, NumRSBlocks, NumECBytes, MatrixWidth: Integer);
+ property QRCodeError: Boolean read FQRCodeError;
+ property Mode: TMode read FMode write FMode;
+ property Version: Integer read FVersion write FVersion;
+ property NumDataBytes: Integer read FNumDataBytes;
+ property NumTotalBytes: Integer read FNumTotalBytes;
+ property NumRSBlocks: Integer read FNumRSBlocks;
+ property MatrixWidth: Integer read FMatrixWidth;
+ property MaskPattern: Integer read FMaskPattern write FMaskPattern;
+ property ECLevel: TErrorCorrectionLevel read FECLevel;
+ end;
+
+ TMatrixUtil = class
+
+ private
+ FMatrixUtilError: Boolean;
+ procedure ClearMatrix(Matrix: TByteMatrix);
+
+ procedure EmbedBasicPatterns(Version: Integer; Matrix: TByteMatrix);
+ procedure EmbedTypeInfo(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Matrix: TByteMatrix);
+ procedure MaybeEmbedVersionInfo(Version: Integer; Matrix: TByteMatrix);
+ procedure EmbedDataBits(DataBits: TBitArray; MaskPattern: Integer; Matrix: TByteMatrix);
+ function FindMSBSet(Value: Integer): Integer;
+ function CalculateBCHCode(Value, Poly: Integer): Integer;
+ procedure MakeTypeInfoBits(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Bits: TBitArray);
+ procedure MakeVersionInfoBits(Version: Integer; Bits: TBitArray);
+ function IsEmpty(Value: Integer): Boolean;
+ procedure EmbedTimingPatterns(Matrix: TByteMatrix);
+ procedure EmbedDarkDotAtLeftBottomCorner(Matrix: TByteMatrix);
+ procedure EmbedHorizontalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
+ procedure EmbedVerticalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
+ procedure EmbedPositionAdjustmentPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
+ procedure EmbedPositionDetectionPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
+ procedure EmbedPositionDetectionPatternsAndSeparators(Matrix: TByteMatrix);
+ procedure MaybeEmbedPositionAdjustmentPatterns(Version: Integer; Matrix: TByteMatrix);
+ public
+ constructor Create;
+ property MatrixUtilError: Boolean read FMatrixUtilError;
+ procedure BuildMatrix(DataBits: TBitArray; ECLevel: TErrorCorrectionLevel; Version, MaskPattern: Integer; Matrix: TByteMatrix);
+ end;
+
+function GetModeBits(Mode: TMode): Integer;
+begin
+ Result := ModeBits[Mode];
+end;
+
+function GetModeCharacterCountBits(Mode: TMode; Version: TVersion): Integer;
+var
+ Number: Integer;
+ Offset: Integer;
+begin
+ Number := Version.VersionNumber;
+
+ if (Number <= 9) then
+ begin
+ Offset := 0;
+ end else
+ if (number <= 26) then
+ begin
+ Offset := 1;
+ end else
+ begin
+ Offset := 2;
+ end;
+ Result := ModeCharacterCountBits[Mode][Offset];
+end;
+
+type
+ TBlockPair = class
+ private
+ FDataBytes: TByteArray;
+ FErrorCorrectionBytes: TByteArray;
+ public
+ constructor Create(BA1, BA2: TByteArray);
+ function GetDataBytes: TByteArray;
+ function GetErrorCorrectionBytes: TByteArray;
+ end;
+
+ TGenericGFPoly = class;
+
+ TGenericGF = class
+ private
+ FExpTable: TIntegerArray;
+ FLogTable: TIntegerArray;
+ FZero: TGenericGFPoly;
+ FOne: TGenericGFPoly;
+ FSize: Integer;
+ FPrimitive: Integer;
+ FGeneratorBase: Integer;
+ FInitialized: Boolean;
+ FPolyList: array of TGenericGFPoly;
+
+ procedure CheckInit;
+ procedure Initialize;
+ public
+ class function CreateQRCodeField256: TGenericGF;
+ class function AddOrSubtract(A, B: Integer): Integer;
+ constructor Create(Primitive, Size, B: Integer);
+ destructor Destroy; override;
+ function GetZero: TGenericGFPoly;
+ function Exp(A: Integer): Integer;
+ function GetGeneratorBase: Integer;
+ function Inverse(A: Integer): Integer;
+ function Multiply(A, B: Integer): Integer;
+ function BuildMonomial(Degree, Coefficient: Integer): TGenericGFPoly;
+ end;
+
+ TGenericGFPolyArray = array of TGenericGFPoly;
+ TGenericGFPoly = class
+ private
+ FField: TGenericGF;
+ FCoefficients: TIntegerArray;
+ public
+ constructor Create(AField: TGenericGF; ACoefficients: TIntegerArray);
+ destructor Destroy; override;
+ function Coefficients: TIntegerArray;
+ function Multiply(Other: TGenericGFPoly): TGenericGFPoly;
+ function MultiplyByMonomial(Degree, Coefficient: Integer): TGenericGFPoly;
+ function Divide(Other: TGenericGFPoly): TGenericGFPolyArray;
+ function GetCoefficients: TIntegerArray;
+ function IsZero: Boolean;
+ function GetCoefficient(Degree: Integer): Integer;
+ function GetDegree: Integer;
+ function AddOrSubtract(Other: TGenericGFPoly): TGenericGFPoly;
+ end;
+
+ TReedSolomonEncoder = class
+ private
+ FField: TGenericGF;
+ FCachedGenerators: TObjectList;
+ public
+ constructor Create(AField: TGenericGF);
+ destructor Destroy; override;
+ procedure Encode(ToEncode: TIntegerArray; ECBytes: Integer);
+ function BuildGenerator(Degree: Integer): TGenericGFPoly;
+ end;
+
+ TEncoder = class
+ private
+ FEncoderError: Boolean;
+ FCodepage: Integer;
+ FCodeVersion: Integer;
+
+ function ApplyMaskPenaltyRule1Internal(Matrix: TByteMatrix;
+ IsHorizontal: Boolean): Integer;
+ function ChooseMode(const Content: WideString; var EncodeOptions: Integer): TMode; overload;
+ function PosECI(Content: string): integer;
+ function IsContainECI(Content: string): boolean;
+ function IsStartWithECI(Content: string): boolean;
+ function FilterContent(const Content: WideString; Mode: TMode; EncodeOptions: Integer): WideString;
+ procedure AppendECIBytes(const Content: WideString; Bits: TBitArray);
+ procedure Append8BitBytes(const Content: WideString; Bits: TBitArray; EncodeOptions: Integer);
+
+ procedure AppendAlphanumericBytes(const Content: WideString;
+ Bits: TBitArray);
+ procedure AppendBytes(const Content: WideString; Mode: TMode;
+ Bits: TBitArray; EncodeOptions: Integer);
+ procedure AppendKanjiBytes(const Content: WideString; Bits: TBitArray);
+ procedure AppendLengthInfo(NumLetters, VersionNum: Integer; Mode: TMode;
+ Bits: TBitArray);
+ procedure AppendModeInfo(Mode: TMode; Bits: TBitArray);
+ procedure AppendNumericBytes(const Content: WideString; Bits: TBitArray);
+ function ChooseMaskPattern(Bits: TBitArray; ECLevel: TErrorCorrectionLevel;
+ Version: Integer; Matrix: TByteMatrix): Integer;
+ function GenerateECBytes(DataBytes: TByteArray;
+
+ NumECBytesInBlock: Integer): TByteArray;
+ function GetAlphanumericCode(Code: Integer): Integer;
+ procedure GetNumDataBytesAndNumECBytesForBlockID(NumTotalBytes,
+ NumDataBytes, NumRSBlocks, BlockID: Integer; var NumDataBytesInBlock: TIntegerArray;
+ var NumECBytesInBlock: TIntegerArray);
+ procedure InterleaveWithECBytes(Bits: TBitArray; NumTotalBytes,
+ NumDataBytes, NumRSBlocks: Integer; var Result: TBitArray);
+ //function IsOnlyDoubleByteKanji(const Content: WideString): Boolean;
+ procedure TerminateBits(NumDataBytes: Integer; var Bits: TBitArray);
+ function CalculateMaskPenalty(Matrix: TByteMatrix): Integer;
+ function ApplyMaskPenaltyRule1(Matrix: TByteMatrix): Integer;
+ function ApplyMaskPenaltyRule2(Matrix: TByteMatrix): Integer;
+ function ApplyMaskPenaltyRule3(Matrix: TByteMatrix): Integer;
+ function ApplyMaskPenaltyRule4(Matrix: TByteMatrix): Integer;
+ //procedure Encode(const Content: WideString; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode); overload;
+ procedure Encode(const Content: WideString; EncodeOptions: Integer; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode);
+ procedure SetCodepage(const Value: Integer);
+ public
+ constructor Create;
+ property EncoderError: Boolean read FEncoderError;
+ property Codepage: Integer read FCodepage write SetCodepage;
+ property CodeVersion: Integer read FCodeVersion write FCodeVersion;
+ end;
+
+function TEncoder.ApplyMaskPenaltyRule1(Matrix: TByteMatrix): Integer;
+begin
+ Result := ApplyMaskPenaltyRule1Internal(Matrix, True) +
+ ApplyMaskPenaltyRule1Internal(Matrix, False);
+end;
+
+// Apply mask penalty rule 2 and return the penalty. Find 2x2 blocks with the same color and give
+// penalty to them.
+function TEncoder.ApplyMaskPenaltyRule2(Matrix: TByteMatrix): Integer;
+var
+ Penalty: Integer;
+ TheArray: T2DByteArray;
+ Width: Integer;
+ Height: Integer;
+ X: Integer;
+ Y: Integer;
+ Value: Integer;
+begin
+ Penalty := 0;
+ TheArray := Matrix.GetArray;
+ Width := Matrix.Width;
+ Height := Matrix.Height;
+ for Y := 0 to Height - 2 do
+ begin
+ for X := 0 to Width - 2 do
+ begin
+ Value := TheArray[Y][X];
+ if ((Value = TheArray[Y][X + 1]) and (Value = TheArray[Y + 1][X]) and
+ (Value = TheArray[Y + 1][X + 1])) then
+ begin
+ Inc(Penalty, 3);
+ end;
+ end;
+ end;
+ Result := Penalty;
+end;
+
+// Apply mask penalty rule 3 and return the penalty. Find consecutive cells of 00001011101 or
+// 10111010000, and give penalty to them. If we find patterns like 000010111010000, we give
+// penalties twice (i.e. 40 * 2).
+function TEncoder.ApplyMaskPenaltyRule3(Matrix: TByteMatrix): Integer;
+var
+ Penalty: Integer;
+ TheArray: T2DByteArray;
+ Width: Integer;
+ Height: Integer;
+ X: Integer;
+ Y: Integer;
+begin
+ Penalty := 0;
+ TheArray := Matrix.GetArray;
+ Width := Matrix.Width;
+ Height := Matrix.Height;
+ for Y := 0 to Height - 1 do
+ begin
+ for X := 0 to Width - 1 do
+ begin
+ if ((X + 6 < Width) and
+ (TheArray[Y][X] = 1) and
+ (TheArray[Y][X + 1] = 0) and
+ (TheArray[Y][X + 2] = 1) and
+ (TheArray[Y][X + 3] = 1) and
+ (TheArray[Y][X + 4] = 1) and
+ (TheArray[Y][X + 5] = 0) and
+ (TheArray[Y][X + 6] = 1) and
+ (((X + 10 < Width) and
+ (TheArray[Y][X + 7] = 0) and
+ (TheArray[Y][X + 8] = 0) and
+ (TheArray[Y][X + 9] = 0) and
+ (TheArray[Y][X + 10] = 0)) or
+ ((x - 4 >= 0) and
+ (TheArray[Y][X - 1] = 0) and
+ (TheArray[Y][X - 2] = 0) and
+ (TheArray[Y][X - 3] = 0) and
+ (TheArray[Y][X - 4] = 0)))) then
+ begin
+ Inc(Penalty, 40);
+ end;
+ if ((Y + 6 < Height) and
+ (TheArray[Y][X] = 1) and
+ (TheArray[Y + 1][X] = 0) and
+ (TheArray[Y + 2][X] = 1) and
+ (TheArray[Y + 3][X] = 1) and
+ (TheArray[Y + 4][X] = 1) and
+ (TheArray[Y + 5][X] = 0) and
+ (TheArray[Y + 6][X] = 1) and
+ (((Y + 10 < Height) and
+ (TheArray[Y + 7][X] = 0) and
+ (TheArray[Y + 8][X] = 0) and
+ (TheArray[Y + 9][X] = 0) and
+ (TheArray[Y + 10][X] = 0)) or
+ ((Y - 4 >= 0) and
+ (TheArray[Y - 1][X] = 0) and
+ (TheArray[Y - 2][X] = 0) and
+ (TheArray[Y - 3][X] = 0) and
+ (TheArray[Y - 4][X] = 0)))) then
+ begin
+ Inc(Penalty, 40);
+ end;
+ end;
+ end;
+ Result := Penalty;
+end;
+
+// Apply mask penalty rule 4 and return the penalty. Calculate the ratio of dark cells and give
+// penalty if the ratio is far from 50%. It gives 10 penalty for 5% distance. Examples:
+// - 0% => 100
+// - 40% => 20
+// - 45% => 10
+// - 50% => 0
+// - 55% => 10
+// - 55% => 20
+// - 100% => 100
+function TEncoder.ApplyMaskPenaltyRule4(Matrix: TByteMatrix): Integer;
+var
+ NumDarkCells: Integer;
+ TheArray: T2DByteArray;
+ Width: Integer;
+ Height: Integer;
+ NumTotalCells: Integer;
+ DarkRatio: Double;
+ X: Integer;
+ Y: Integer;
+begin
+ NumDarkCells := 0;
+ TheArray := Matrix.GetArray;
+ Width := Matrix.Width;
+ Height := matrix.Height;
+ for Y := 0 to Height - 1 do
+ begin
+ for X := 0 to Width - 1 do
+ begin
+ if (TheArray[Y][X] = 1) then
+ begin
+ Inc(NumDarkCells);
+ end;
+ end;
+ end;
+ numTotalCells := matrix.Height * Matrix.Width;
+ DarkRatio := NumDarkCells / NumTotalCells;
+ Result := Round(Abs((DarkRatio * 100 - 50)) / 50);
+end;
+
+// Helper function for applyMaskPenaltyRule1. We need this for doing this calculation in both
+// vertical and horizontal orders respectively.
+function TEncoder.ApplyMaskPenaltyRule1Internal(Matrix: TByteMatrix; IsHorizontal: Boolean): Integer;
+var
+ Penalty: Integer;
+ NumSameBitCells: Integer;
+ PrevBit: Integer;
+ TheArray: T2DByteArray;
+ I: Integer;
+ J: Integer;
+ Bit: Integer;
+ ILimit: Integer;
+ JLimit: Integer;
+begin
+ Penalty := 0;
+ NumSameBitCells := 0;
+ PrevBit := -1;
+ // Horizontal mode:
+ // for (int i = 0; i < matrix.height(); ++i) {
+ // for (int j = 0; j < matrix.width(); ++j) {
+ // int bit = matrix.get(i, j);
+ // Vertical mode:
+ // for (int i = 0; i < matrix.width(); ++i) {
+ // for (int j = 0; j < matrix.height(); ++j) {
+ // int bit = matrix.get(j, i);
+ if (IsHorizontal) then
+ begin
+ ILimit := Matrix.Height;
+ JLimit := Matrix.Width;
+ end else
+ begin
+ ILimit := Matrix.Width;
+ JLimit := Matrix.Height;
+ end;
+ TheArray := Matrix.GetArray;
+
+ for I := 0 to ILimit - 1 do
+ begin
+ for J := 0 to JLimit - 1 do
+ begin
+ if (IsHorizontal) then
+ begin
+ Bit := TheArray[I][J];
+ end else
+ begin
+ Bit := TheArray[J][I];
+ end;
+ if (Bit = PrevBit) then
+ begin
+ Inc(NumSameBitCells);
+ // Found five repetitive cells with the same color (bit).
+ // We'll give penalty of 3.
+ if (NumSameBitCells = 5) then
+ begin
+ Inc(Penalty, 3);
+ end else if (NumSameBitCells > 5) then
+ begin
+ // After five repetitive cells, we'll add the penalty one
+ // by one.
+ Inc(Penalty, 1);;
+ end;
+ end else
+ begin
+ NumSameBitCells := 1; // Include the cell itself.
+ PrevBit := bit;
+ end;
+ end;
+ NumSameBitCells := 0; // Clear at each row/column.
+ end;
+ Result := Penalty;
+end;
+
+{ TQRCode }
+
+constructor TQRCode.Create;
+begin
+ FMode := qmTerminator;
+ FQRCodeError := False;
+ FECLevel := nil;
+ FVersion := -1;
+ FMatrixWidth := -1;
+ FMaskPattern := -1;
+ FNumTotalBytes := -1;
+ FNumDataBytes := -1;
+ FNumECBytes := -1;
+ FNumRSBlocks := -1;
+ FMatrix := nil;
+end;
+
+destructor TQRCode.Destroy;
+begin
+ if (Assigned(FECLevel)) then
+ begin
+ FECLevel.Free;
+ end;
+ if (Assigned(FMatrix)) then
+ begin
+ FMatrix.Free;
+ end;
+ inherited;
+end;
+
+function TQRCode.At(X, Y: Integer): Integer;
+var
+ Value: Integer;
+begin
+ // The value must be zero or one.
+ Value := FMatrix.Get(X, Y);
+ if (not ((Value = 0) or (Value = 1))) then
+ begin
+ FQRCodeError := True;
+ end;
+ Result := Value;
+end;
+
+function TQRCode.IsValid: Boolean;
+begin
+ Result :=
+ // First check if all version are not uninitialized.
+ ((FECLevel <> nil) and
+ (FVersion <> -1) and
+ (FMatrixWidth <> -1) and
+ (FMaskPattern <> -1) and
+ (FNumTotalBytes <> -1) and
+ (FNumDataBytes <> -1) and
+ (FNumECBytes <> -1) and
+ (FNumRSBlocks <> -1) and
+ // Then check them in other ways..
+ IsValidMaskPattern(FMaskPattern) and
+ (FNumTotalBytes = FNumDataBytes + FNumECBytes) and
+ // ByteMatrix stuff.
+ (Assigned(FMatrix)) and
+ (FMatrixWidth = FMatrix.Width) and
+ // See 7.3.1 of JISX0510:2004 (Fp.5).
+ (FMatrix.Width = FMatrix.Height)); // Must be square.
+end;
+
+function TQRCode.IsValidMaskPattern(MaskPattern: Integer): Boolean;
+begin
+ Result := (MaskPattern >= 0) and (MaskPattern < NUM_MASK_PATTERNS);
+end;
+
+procedure TQRCode.SetMatrix(NewMatrix: TByteMatrix);
+begin
+ if (Assigned(FMatrix)) then
+ begin
+ FMatrix.Free;
+ FMatrix := nil;
+ end;
+ FMatrix := NewMatrix;
+end;
+
+procedure TQRCode.SetAll(VersionNum, NumBytes, NumDataBytes, NumRSBlocks,
+ NumECBytes, MatrixWidth: Integer);
+begin
+ FVersion := VersionNum;
+ FNumTotalBytes := NumBytes;
+ FNumDataBytes := NumDataBytes;
+ FNumRSBlocks := NumRSBlocks;
+ FNumECBytes := NumECBytes;
+ FMatrixWidth := MatrixWidth;
+end;
+
+procedure TQRCode.SetECLevel(NewECLevel: TErrorCorrectionLevel);
+begin
+ if (Assigned(FECLevel)) then
+ begin
+ FECLevel.Free;
+ end;
+ FECLevel := TErrorCorrectionLevel.Create;
+ FECLevel.Assign(NewECLevel);
+end;
+
+{ TByteMatrix }
+
+procedure TByteMatrix.Clear(Value: Byte);
+var
+ X, Y: Integer;
+begin
+ for Y := 0 to FHeight - 1 do
+ begin
+ for X := 0 to FWidth - 1 do
+ begin
+ Bytes[Y][X] := Value;
+ end;
+ end;
+end;
+
+constructor TByteMatrix.Create(Width, Height: Integer);
+var
+ Y: Integer;
+ X: Integer;
+begin
+ FWidth := Width;
+ FHeight := Height;
+ SetLength(Bytes, Height);
+ for Y := 0 to Height - 1 do
+ begin
+ SetLength(Bytes[Y], Width);
+ for X := 0 to Width - 1 do
+ begin
+ Bytes[Y][X] := 0;
+ end;
+ end;
+end;
+
+function TByteMatrix.Get(X, Y: Integer): Integer;
+begin
+ if (Bytes[Y][X] = 255) then Result := -1 else Result := Bytes[Y][X];
+end;
+
+function TByteMatrix.GetArray: T2DByteArray;
+begin
+ Result := Bytes;
+end;
+
+function TByteMatrix.Hash: AnsiString;
+var
+ X, Y: Integer;
+ Counter: Integer;
+ CC: Integer;
+begin
+ Result := '';
+ for Y := 0 to FHeight - 1 do
+ begin
+ Counter := 0;
+ for X := 0 to FWidth - 1 do
+ begin
+ CC := Get(X, Y);
+ if (CC = -1) then CC := 255;
+ Counter := Counter + CC;
+ end;
+ Result := Result + AnsiChar((Counter mod 26) + 65);
+ end;
+end;
+
+procedure TByteMatrix.SetBoolean(X, Y: Integer; Value: Boolean);
+begin
+ Bytes[Y][X] := Byte(Value) and $FF;
+end;
+
+procedure TByteMatrix.SetInteger(X, Y, Value: Integer);
+begin
+ Bytes[Y][X] := Value and $FF;
+end;
+
+procedure TByteMatrix.Assign(Source: TByteMatrix);
+var
+ SourceLength: Integer;
+begin
+ SourceLength := Length(Source.Bytes);
+ SetLength(Bytes, SourceLength);
+ if (SourceLength > 0) then
+ begin
+ Move(Source.Bytes[0], Bytes[0], SourceLength);
+ end;
+ FWidth := Source.Width;
+ FHeight := Source.Height;
+end;
+
+{ TEncoder }
+
+function TEncoder.CalculateMaskPenalty(Matrix: TByteMatrix): Integer;
+var
+ Penalty: Integer;
+begin
+ Penalty := 0;
+ Inc(Penalty, ApplyMaskPenaltyRule1(Matrix));
+ Inc(Penalty, ApplyMaskPenaltyRule2(Matrix));
+ Inc(Penalty, ApplyMaskPenaltyRule3(Matrix));
+ Inc(Penalty, ApplyMaskPenaltyRule4(Matrix));
+ Result := Penalty;
+end;
+
+{procedure TEncoder.Encode(const Content: WideString; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode);
+begin
+ Encode(Content, ECLevel, nil, QRCode);
+end;}
+
+procedure TEncoder.Encode(const Content: WideString; EncodeOptions: Integer; ECLevel: TErrorCorrectionLevel; QRCode: TQRCode);
+var
+ Mode: TMode;
+ DataBits: TBitArray;
+ FinalBits: TBitArray;
+ HeaderBits: TBitArray;
+ HeaderAndDataBits: TBitArray;
+ Matrix: TByteMatrix;
+ NumLetters: Integer;
+ MatrixUtil: TMatrixUtil;
+ BitsNeeded: Integer;
+ ProvisionalBitsNeeded: Integer;
+ ProvisionalVersion: TVersion;
+ Version: TVersion;
+ ECBlocks: TECBlocks;
+ NumDataBytes: Integer;
+ Dimension: Integer;
+ FilteredContent: WideString;
+begin
+ DataBits := TBitArray.Create;
+ HeaderBits := TBitArray.Create;
+
+ // Pick an encoding mode appropriate for the content. Note that this will not attempt to use
+ // multiple modes / segments even if that were more efficient. Twould be nice.
+ // Collect data within the main segment, separately, to count its size if needed. Don't add it to
+ // main payload yet.
+
+ Mode := ChooseMode(Content, EncodeOptions);
+ FilteredContent := FilterContent(Content, Mode, EncodeOptions);
+ AppendBytes(FilteredContent, Mode, DataBits, EncodeOptions);
+
+ if Mode <> qmECI then
+ begin
+ // (With ECI in place,) Write the mode marker
+ AppendModeInfo(Mode, HeaderBits);
+ end;
+
+ // Hard part: need to know version to know how many bits length takes. But need to know how many
+ // bits it takes to know version. First we take a guess at version by assuming version will be
+ // the minimum, 1:
+ ProvisionalVersion := TVersion.GetVersionForNumber(1);
+ try
+ ProvisionalBitsNeeded := HeaderBits.GetSize +
+ GetModeCharacterCountBits(Mode, ProvisionalVersion) +
+ DataBits.GetSize;
+ finally
+ ProvisionalVersion.Free;
+ end;
+
+ ProvisionalVersion := TVersion.ChooseVersion(ProvisionalBitsNeeded, ECLevel);
+ try
+ // Use that guess to calculate the right version. I am still not sure this works in 100% of cases.
+ BitsNeeded := HeaderBits.GetSize +
+ GetModeCharacterCountBits(Mode, ProvisionalVersion) +
+ DataBits.GetSize;
+ Version := TVersion.ChooseVersion(BitsNeeded, ECLevel);
+ finally
+ ProvisionalVersion.Free;
+ end;
+
+ // versions above 9 should write data size as 16 bit's - rebuild data for ECI
+ if (Mode = qmECI) and (Version.VersionNumber >= 10) then
+ begin
+ DataBits.Clear;
+ CodeVersion := Version.VersionNumber;
+ AppendBytes(FilteredContent, Mode, DataBits, EncodeOptions);
+ end;
+
+ HeaderAndDataBits := TBitArray.Create;
+ FinalBits := TBitArray.Create;
+ try
+ if Mode <> qmECI then
+ begin
+ HeaderAndDataBits.AppendBitArray(HeaderBits);
+
+ // Find "length" of main segment and write it
+ if (Mode = qmByte) then
+ begin
+ NumLetters := DataBits.GetSizeInBytes;
+ end else
+ begin
+ NumLetters := Length(FilteredContent);
+ end;
+ AppendLengthInfo(NumLetters, Version.VersionNumber, Mode, HeaderAndDataBits);
+ end;
+ // Put data together into the overall payload
+ HeaderAndDataBits.AppendBitArray(DataBits);
+
+ ECBlocks := Version.GetECBlocksForLevel(ECLevel);
+ NumDataBytes := Version.GetTotalCodewords - ECBlocks.GetTotalECCodewords;
+
+ // Terminate the bits properly.
+ TerminateBits(NumDataBytes, HeaderAndDataBits);
+
+ // Interleave data bits with error correction code.
+ InterleaveWithECBytes(HeaderAndDataBits, Version.GetTotalCodewords,
+ NumDataBytes, ECBlocks.GetNumBlocks, FinalBits);
+
+ // QRCode qrCode = new QRCode(); // This is passed in
+
+
+ QRCode.SetECLevel(ECLevel);
+ QRCode.Mode := Mode;
+ QRCode.Version := Version.VersionNumber;
+
+ // Choose the mask pattern and set to "qrCode".
+ Dimension := Version.GetDimensionForVersion;
+ Matrix := TByteMatrix.Create(Dimension, Dimension);
+
+ QRCode.MaskPattern := ChooseMaskPattern(FinalBits, ECLevel, Version.VersionNumber, Matrix);
+
+ Matrix.Free;
+ Matrix := TByteMatrix.Create(Dimension, Dimension);
+
+ // Build the matrix and set it to "qrCode".
+ MatrixUtil := TMatrixUtil.Create;
+ try
+ MatrixUtil.BuildMatrix(FinalBits, QRCode.ECLevel, QRCode.Version,
+ QRCode.MaskPattern, Matrix);
+ finally
+ MatrixUtil.Free;
+ end;
+
+ QRCode.SetMatrix(Matrix); // QRCode will free the matrix
+ finally
+ DataBits.Free;
+ HeaderAndDataBits.Free;
+ FinalBits.Free;
+ HeaderBits.Free;
+ Version.Free;
+ end;
+end;
+
+function TEncoder.FilterContent(const Content: WideString; Mode: TMode;
+ EncodeOptions: Integer): WideString;
+var
+ X: Integer;
+ CanAdd: Boolean;
+begin
+ if (Mode in [qmECI, qmKanji]) then
+ begin
+ Result := Content;
+ Exit;
+ end;
+ Result := '';
+ for X := 1 to Length(Content) do
+ begin
+ CanAdd := False;
+ if (Mode = qmNumeric) then
+ begin
+ CanAdd := (Content[X] >= '0') and (Content[X] <= '9');
+ end else
+ if (Mode = qmAlphanumeric) then
+ begin
+ CanAdd := GetAlphanumericCode(Ord(Content[X])) >= 0;
+ end else
+ if (Mode = qmByte) then
+ begin
+ if (EncodeOptions = 3) then
+ begin
+ CanAdd := Ord(Content[X]) <= $FF;
+ end else
+ if ((EncodeOptions = 4) or (EncodeOptions = 5)) then
+ begin
+ CanAdd := True;
+ end;
+ end;
+ if (CanAdd) then
+ begin
+ Result := Result + Content[X];
+ end;
+ end;
+end;
+
+// Return the code point of the table used in alphanumeric mode or
+// -1 if there is no corresponding code in the table.
+function TEncoder.GetAlphanumericCode(Code: Integer): Integer;
+begin
+ if (Code < Length(ALPHANUMERIC_TABLE)) then
+ begin
+ Result := ALPHANUMERIC_TABLE[Code];
+ end else
+ begin
+ Result := -1;
+ end;
+end;
+
+// Choose the mode based on the content
+function TEncoder.ChooseMode(const Content: WideString; var EncodeOptions: Integer): TMode;
+var
+ AllNumeric: Boolean;
+ AllAlphanumeric: Boolean;
+ AllISO: Boolean;
+ I: Integer;
+ C: WideChar;
+begin
+ if (EncodeOptions = 0 {qrAuto}) and (IsContainECI(Content) or (FCodepage <> 0)) then
+ Result := qmECI
+ else
+ if (EncodeOptions = 0) then
+ begin
+ AllNumeric := Length(Content) > 0;
+ I := 1;
+ while (I <= Length(Content)) and (AllNumeric) do
+ begin
+ C := Content[I];
+ if ((C < '0') or (C > '9')) then
+ begin
+ AllNumeric := False;
+ end else
+ begin
+ Inc(I);
+ end;
+ end;
+
+ if (not AllNumeric) then
+ begin
+ AllAlphanumeric := Length(Content) > 0;
+ I := 1;
+ while (I <= Length(Content)) and (AllAlphanumeric) do
+ begin
+ C := Content[I];
+ if (GetAlphanumericCode(Ord(C)) < 0) then
+ begin
+ AllAlphanumeric := False;
+ end else
+ begin
+ Inc(I);
+ end;
+ end;
+ end else
+ begin
+ AllAlphanumeric := False;
+ end;
+
+ if (not AllAlphanumeric) then
+ begin
+ AllISO := Length(Content) > 0;
+ I := 1;
+ while (I <= Length(Content)) and (AllISO) do
+ begin
+ C := Content[I];
+ if (Ord(C) > $FF) then
+ begin
+ AllISO := False;
+ end else
+ begin
+ Inc(I);
+ end;
+ end;
+ end else
+ begin
+ AllISO := False;
+ end;
+
+ if (AllNumeric) then
+ begin
+ Result := qmNumeric;
+ end else
+ if (AllAlphanumeric) then
+ begin
+ Result := qmAlphanumeric;
+ end else
+ if (AllISO) then
+ begin
+ Result := qmByte;
+ EncodeOptions := 3;
+ end else
+ begin
+ Result := qmByte;
+ EncodeOptions := 4;
+ end;
+ end else
+ if (EncodeOptions = 1) then
+ begin
+ Result := qmNumeric;
+ end else
+ if (EncodeOptions = 2) then
+ begin
+ Result := qmAlphanumeric;
+ end
+ else if (EncodeOptions = 6) then
+ begin
+ Result := qmKanji;
+ end else
+ begin
+ Result := qmByte;
+ end;
+end;
+
+constructor TEncoder.Create;
+begin
+ FEncoderError := False;
+ FCodepage := 0;
+end;
+
+{function TEncoder.IsOnlyDoubleByteKanji(const Content: WideString): Boolean;
+var
+ I: Integer;
+ Char1: Integer;
+begin
+ Result := True;
+ I := 0;
+ while ((I < Length(Content)) and Result) do
+ begin
+ Char1 := Ord(Content[I + 1]);
+ if (((Char1 < $81) or (Char1 > $9F)) and ((Char1 < $E0) or (Char1 > $EB))) then
+ begin
+ Result := False;
+ end;
+ end;
+end;}
+
+function TEncoder.ChooseMaskPattern(Bits: TBitArray; ECLevel: TErrorCorrectionLevel; Version: Integer; Matrix: TByteMatrix): Integer;
+var
+ MinPenalty: Integer;
+ BestMaskPattern: Integer;
+ MaskPattern: Integer;
+ MatrixUtil: TMatrixUtil;
+ Penalty: Integer;
+begin
+ MinPenalty := MaxInt;
+ BestMaskPattern := -1;
+
+ // We try all mask patterns to choose the best one.
+ for MaskPattern := 0 to NUM_MASK_PATTERNS - 1 do
+ begin
+ MatrixUtil := TMatrixUtil.Create;
+ try
+ MatrixUtil.BuildMatrix(Bits, ECLevel, Version, MaskPattern, Matrix);
+ finally
+ MatrixUtil.Free;
+ end;
+ Penalty := CalculateMaskPenalty(Matrix);
+ if (Penalty < MinPenalty) then
+ begin
+ MinPenalty := Penalty;
+ BestMaskPattern := MaskPattern;
+ end;
+ end;
+
+ Result := BestMaskPattern;
+end;
+
+// Terminate bits as described in 8.4.8 and 8.4.9 of JISX0510:2004 (p.24).
+procedure TEncoder.TerminateBits(NumDataBytes: Integer; var Bits: TBitArray);
+var
+ Capacity: Integer;
+ I: Integer;
+ NumBitsInLastByte: Integer;
+ NumPaddingBytes: Integer;
+begin
+ Capacity := NumDataBytes shl 3;
+ if (Bits.GetSize > Capacity) then
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+ I := 0;
+ while ((I < 4) and (Bits.GetSize < capacity)) do
+ begin
+ Bits.AppendBit(False);
+ Inc(I);
+ end;
+
+ // Append termination bits. See 8.4.8 of JISX0510:2004 (p.24) for details.
+ // If the last byte isn't 8-bit aligned, we'll add padding bits.
+ NumBitsInLastByte := Bits.GetSize and $07;
+ if (NumBitsInLastByte > 0) then
+ begin
+ for I := numBitsInLastByte to 7 do
+ begin
+ Bits.AppendBit(False);
+ end;
+ end;
+
+ // If we have more space, we'll fill the space with padding patterns defined in 8.4.9 (p.24).
+ NumPaddingBytes := NumDataBytes - Bits.GetSizeInBytes;
+ for I := 0 to NumPaddingBytes - 1 do
+ begin
+ if ((I and $01) = 0) then
+ begin
+ Bits.AppendBits($EC, 8);
+ end else
+ begin
+ Bits.AppendBits($11, 8);
+ end;
+ end;
+ if (Bits.GetSize <> Capacity) then
+ begin
+ FEncoderError := True;
+ end;
+end;
+
+// Get number of data bytes and number of error correction bytes for block id "blockID". Store
+// the result in "numDataBytesInBlock", and "numECBytesInBlock". See table 12 in 8.5.1 of
+// JISX0510:2004 (p.30)
+procedure TEncoder.GetNumDataBytesAndNumECBytesForBlockID(NumTotalBytes, NumDataBytes,
+ NumRSBlocks, BlockID: Integer; var NumDataBytesInBlock: TIntegerArray;
+ var NumECBytesInBlock: TIntegerArray);
+var
+ NumRSBlocksInGroup1: Integer;
+ NumRSBlocksInGroup2: Integer;
+ NumTotalBytesInGroup1: Integer;
+ NumTotalBytesInGroup2: Integer;
+ NumDataBytesInGroup1: Integer;
+ NumDataBytesInGroup2: Integer;
+ NumECBytesInGroup1: Integer;
+ NumECBytesInGroup2: Integer;
+begin
+ if (BlockID >= NumRSBlocks) then
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+ // numRsBlocksInGroup2 = 196 % 5 = 1
+ NumRSBlocksInGroup2 := NumTotalBytes mod NumRSBlocks;
+ // numRsBlocksInGroup1 = 5 - 1 = 4
+ NumRSBlocksInGroup1 := NumRSBlocks - NumRSBlocksInGroup2;
+ // numTotalBytesInGroup1 = 196 / 5 = 39
+ NumTotalBytesInGroup1 := NumTotalBytes div NumRSBlocks;
+ // numTotalBytesInGroup2 = 39 + 1 = 40
+ NumTotalBytesInGroup2 := NumTotalBytesInGroup1 + 1;
+ // numDataBytesInGroup1 = 66 / 5 = 13
+ NumDataBytesInGroup1 := NumDataBytes div NumRSBlocks;
+ // numDataBytesInGroup2 = 13 + 1 = 14
+ NumDataBytesInGroup2 := NumDataBytesInGroup1 + 1;
+ // numEcBytesInGroup1 = 39 - 13 = 26
+ NumECBytesInGroup1 := NumTotalBytesInGroup1 - NumDataBytesInGroup1;
+ // numEcBytesInGroup2 = 40 - 14 = 26
+ NumECBytesInGroup2 := NumTotalBytesInGroup2 - NumDataBytesInGroup2;
+ // Sanity checks.
+ // 26 = 26
+ if (NumECBytesInGroup1 <> NumECBytesInGroup2) then
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+ // 5 = 4 + 1.
+ if (NumRSBlocks <> (NumRSBlocksInGroup1 + NumRSBlocksInGroup2)) then
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+ // 196 = (13 + 26) * 4 + (14 + 26) * 1
+ if (NumTotalBytes <>
+ ((NumDataBytesInGroup1 + NumECBytesInGroup1) * NumRsBlocksInGroup1) +
+ ((NumDataBytesInGroup2 + NumECBytesInGroup2) * NumRsBlocksInGroup2)) then
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+
+ if (BlockID < NumRSBlocksInGroup1) then
+ begin
+ NumDataBytesInBlock[0] := NumDataBytesInGroup1;
+ NumECBytesInBlock[0] := numECBytesInGroup1;
+ end else
+ begin
+ NumDataBytesInBlock[0] := NumDataBytesInGroup2;
+ NumECBytesInBlock[0] := numEcBytesInGroup2;
+ end;
+end;
+
+// Interleave "bits" with corresponding error correction bytes. On success, store the result in
+// "result". The interleave rule is complicated. See 8.6 of JISX0510:2004 (p.37) for details.
+procedure TEncoder.InterleaveWithECBytes(Bits: TBitArray; NumTotalBytes,
+ NumDataBytes, NumRSBlocks: Integer; var Result: TBitArray);
+var
+ DataBytesOffset: Integer;
+ MaxNumDataBytes: Integer;
+ MaxNumECBytes: Integer;
+ Blocks: TObjectList;
+ NumDataBytesInBlock: TIntegerArray;
+ NumECBytesInBlock: TIntegerArray;
+ Size: Integer;
+ DataBytes: TByteArray;
+ ECBytes: TByteArray;
+ I, J: Integer;
+ BlockPair: TBlockPair;
+begin
+ SetLength(ECBytes, 0);
+
+ // "bits" must have "getNumDataBytes" bytes of data.
+ if (Bits.GetSizeInBytes <> NumDataBytes) then
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+
+ // Step 1. Divide data bytes into blocks and generate error correction bytes for them. We'll
+ // store the divided data bytes blocks and error correction bytes blocks into "blocks".
+ DataBytesOffset := 0;
+ MaxNumDataBytes := 0;
+ MaxNumEcBytes := 0;
+
+ // Since, we know the number of reedsolmon blocks, we can initialize the vector with the number.
+ Blocks := TObjectList.Create(True);
+ try
+ Blocks.Capacity := NumRSBlocks;
+
+ for I := 0 to NumRSBlocks - 1 do
+ begin
+ SetLength(NumDataBytesInBlock, 1);
+ SetLength(NumECBytesInBlock, 1);
+ GetNumDataBytesAndNumECBytesForBlockID(
+ NumTotalBytes, NumDataBytes, NumRSBlocks, I,
+ NumDataBytesInBlock, NumEcBytesInBlock);
+
+ Size := NumDataBytesInBlock[0];
+ SetLength(DataBytes, Size);
+ Bits.ToBytes(8 * DataBytesOffset, DataBytes, 0, Size);
+ ECBytes := GenerateECBytes(DataBytes, NumEcBytesInBlock[0]);
+ BlockPair := TBlockPair.Create(DataBytes, ECBytes);
+ Blocks.Add(BlockPair);
+
+ MaxNumDataBytes := Max(MaxNumDataBytes, Size);
+ MaxNumECBytes := Max(MaxNumECBytes, Length(ECBytes));
+ Inc(DataBytesOffset, NumDataBytesInBlock[0]);
+ end;
+ if (NumDataBytes <> DataBytesOffset) then
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+
+ // First, place data blocks.
+ for I := 0 to MaxNumDataBytes - 1 do
+ begin
+ for J := 0 to Blocks.Count - 1 do
+ begin
+ DataBytes := TBlockPair(Blocks.Items[J]).GetDataBytes;
+ if (I < Length(DataBytes)) then
+ begin
+ Result.AppendBits(DataBytes[I], 8);
+ end;
+ end;
+ end;
+ // Then, place error correction blocks.
+ for I := 0 to MaxNumECBytes - 1 do
+ begin
+ for J := 0 to Blocks.Count - 1 do
+ begin
+ ECBytes := TBlockPair(Blocks.Items[J]).GetErrorCorrectionBytes;
+ if (I < Length(ECBytes)) then
+ begin
+ Result.AppendBits(ECBytes[I], 8);
+ end;
+ end;
+ end;
+ finally
+ Blocks.Free;
+ end;
+ if (numTotalBytes <> Result.GetSizeInBytes) then // Should be same.
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+end;
+
+function TEncoder.IsContainECI(Content: string): boolean;
+begin
+ Result := PosECI(Content) > 0;
+end;
+
+function TEncoder.IsStartWithECI(Content: string): boolean;
+begin
+ Result := PosECI(Content) = 1;
+end;
+
+function TEncoder.PosECI(Content: string): integer;
+const
+ LenECI = Length('&ECIXX;');
+var
+ i: integer;
+begin
+ Result := 0;
+ for i := LenECI to Length(Content) do
+ if (Content[i] = ';') and (Copy(Content, i - LenECI + 1, 4) = '&ECI') then
+ begin
+ Result := i - LenECI + 1;
+ Break;
+ end;
+end;
+
+procedure TEncoder.SetCodepage(const Value: Integer);
+begin
+ FCodepage := Value;
+end;
+
+function TEncoder.GenerateECBytes(DataBytes: TByteArray; NumECBytesInBlock: Integer): TByteArray;
+var
+ NumDataBytes: Integer;
+ ToEncode: TIntegerArray;
+ ReedSolomonEncoder: TReedSolomonEncoder;
+ I: Integer;
+ ECBytes: TByteArray;
+ GenericGF: TGenericGF;
+begin
+ NumDataBytes := Length(DataBytes);
+ SetLength(ToEncode, NumDataBytes + NumECBytesInBlock);
+
+ for I := 0 to NumDataBytes - 1 do
+ begin
+ ToEncode[I] := DataBytes[I] and $FF;
+ end;
+
+ GenericGF := TGenericGF.CreateQRCodeField256;
+ try
+ ReedSolomonEncoder := TReedSolomonEncoder.Create(GenericGF);
+ try
+ ReedSolomonEncoder.Encode(ToEncode, NumECBytesInBlock);
+ finally
+ ReedSolomonEncoder.Free;
+ end;
+ finally
+ GenericGF.Free;
+ end;
+
+ SetLength(ECBytes, NumECBytesInBlock);
+ for I := 0 to NumECBytesInBlock - 1 do
+ begin
+ ECBytes[I] := ToEncode[NumDataBytes + I];
+ end;
+
+ Result := ECBytes;
+end;
+
+// Append mode info. On success, store the result in "bits".
+procedure TEncoder.AppendModeInfo(Mode: TMode; Bits: TBitArray);
+begin
+ Bits.AppendBits(GetModeBits(Mode), 4);
+end;
+
+// Append length info. On success, store the result in "bits".
+procedure TEncoder.AppendLengthInfo(NumLetters, VersionNum: Integer; Mode: TMode; Bits: TBitArray);
+var
+ NumBits: Integer;
+ Version: TVersion;
+begin
+ Version := TVersion.GetVersionForNumber(VersionNum);
+ try
+ NumBits := GetModeCharacterCountBits(Mode, Version);
+ finally
+ Version.Free;
+ end;
+
+ if (NumLetters > ((1 shl NumBits) - 1)) then
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+
+ Bits.AppendBits(NumLetters, NumBits);
+end;
+
+// Append "bytes" in "mode" mode (encoding) into "bits". On success, store the result in "bits".
+procedure TEncoder.AppendBytes(const Content: WideString; Mode: TMode; Bits: TBitArray; EncodeOptions: Integer);
+begin
+ case Mode of
+// qmTerminator: ;
+ qmNumeric: AppendNumericBytes(Content, Bits);
+ qmAlphanumeric: AppendAlphanumericBytes(Content, Bits);
+// qmStructuredAppend: ;
+ qmByte: Append8BitBytes(Content, Bits, EncodeOptions);
+ qmECI: AppendECIBytes(Content, Bits);
+ qmKanji: AppendKanjiBytes(Content, Bits);
+// qmFNC1FirstPosition: ;
+// qmFNC1SecondPosition: ;
+// qmHanzi: ;
+ else
+ FEncoderError := True;
+ end;
+end;
+
+procedure TEncoder.AppendECIBytes(const Content: WideString; Bits: TBitArray);
+var
+ AnsiSt: TBytes;
+ ECIValue: integer;
+ B: Byte;
+ WideText: WideString;
+
+ function CodePageFromECI(aECI: Integer): Integer;
+ begin
+ Result := 0;
+ case aECI of
+ 3: Result := 28591;
+ 4: Result := 28592;
+ 5: Result := 28593;
+ 6: Result := 28594;
+ 7: Result := 28595;
+ 8: Result := 28596;
+ 9: Result := 28597;
+ 10: Result := 28598;
+ 11: Result := 28599;
+ 12: Result := 28600;
+ 13: Result := 874;
+ 15: Result := 28603;
+ 16: Result := 28604;
+ 17: Result := 28605;
+ 18: Result := 28606;
+ 20: Result := 932;
+ 21: Result := 1250;
+ 22: Result := 1251;
+ 23: Result := 1252;
+ 24: Result := 1256;
+ 25: Result := 1200;// this one maybe wrong
+ 26: Result := 65001;
+ 27: Result := 20127;// and this too
+ 28: Result := 950;
+ 29: Result := 936;
+ 30: Result := 949;
+ end;
+ end;
+
+ function ECIFromCodePage(aCodePage: Longint): Longint;
+ begin
+ Result := DefaultECIValue;
+ case aCodePage of
+ 28591: Result := 3;
+ 28592: Result := 4;
+ 28593: Result := 5;
+ 28594: Result := 6;
+ 28595: Result := 7;
+ 28596: Result := 8;
+ 28597: Result := 9;
+ 28598: Result := 10;
+ 28599: Result := 11;
+ 28600: Result := 12;
+ 874: Result := 13;
+ 28603: Result := 15;
+ 28604: Result := 16;
+ 28605: Result := 17;
+ 28606: Result := 18;
+ 932: Result := 20;
+ 1250: Result := 21;
+ 1251: Result := 22;
+ 1252: Result := 23;
+ 1256: Result := 24;
+ 1200: Result := 25;// this one maybe wrong
+ 65001: Result := 26;
+ 20127: Result := 27;// and this too
+ 950: Result := 28;
+ 936: Result := 29;
+ 949: Result := 30;
+ end;
+ end;
+
+ procedure AppendEciFragment(Len: Integer);
+ var
+ I: Integer;
+ e: TEncoding;
+ begin
+ e := TEncoding.GetEncoding(CodePageFromECI(ECIValue));
+ try
+ AnsiSt := e.GetBytes(WideText);
+ finally
+ e.Free
+ end;
+
+ Bits.AppendBits(7, 4); // ECI Mode Indicator = b0111
+ Bits.AppendBits(ECIValue, 8); // ECI Assignment number = 00..30
+ Bits.AppendBits(4, 4); // Mode indicator (8-bit byte) = b0100
+ if CodeVersion >= 10 then
+ Bits.AppendBits(Len, 16)
+ else
+ Bits.AppendBits(Len, 8); // Character count indicator up to 255 (?)
+ for I := 1 to Len do
+ begin
+ B := Ord(AnsiSt[I]);
+ Bits.AppendBits(B, 8);
+ end;
+ Delete(WideText, 1, Len);
+ end;
+begin
+ WideText := Content;
+ ECIValue := ECIFromCodePage(FCodepage);
+
+ while WideText <> '' do
+ if not IsContainECI(String(WideText)) then
+ AppendEciFragment(Length(WideText))
+ else if IsStartWithECI(String(WideText)) then
+ begin
+ if not TryStrToInt(String(Copy(WideText, 5, 2)), ECIValue) then
+ ECIValue := DefaultECIValue;
+ Delete(WideText, 1, Length('&ECIXX;'));
+ end
+ else // ECI in the middle
+ AppendEciFragment(PosECI(string(WideText)) - 1);
+end;
+
+procedure TEncoder.AppendNumericBytes(const Content: WideString; Bits: TBitArray);
+var
+ ContentLength: Integer;
+ I: Integer;
+ Num1: Integer;
+ Num2: Integer;
+ Num3: Integer;
+begin
+ ContentLength := Length(Content);
+ I := 0;
+ while (I < ContentLength) do
+ begin
+ Num1 := Ord(Content[I + 0 + 1]) - Ord('0');
+ if (I + 2 < ContentLength) then
+ begin
+ // Encode three numeric letters in ten bits.
+ Num2 := Ord(Content[I + 1 + 1]) - Ord('0');
+ Num3 := Ord(Content[I + 2 + 1]) - Ord('0');
+ Bits.AppendBits(Num1 * 100 + Num2 * 10 + Num3, 10);
+ Inc(I, 3);
+ end else
+ if (I + 1 < ContentLength) then
+ begin
+ // Encode two numeric letters in seven bits.
+ Num2 := Ord(Content[I + 1 + 1]) - Ord('0');
+ Bits.AppendBits(Num1 * 10 + Num2, 7);
+ Inc(I, 2);
+ end else
+ begin
+ // Encode one numeric letter in four bits.
+ Bits.AppendBits(Num1, 4);
+ Inc(I);
+ end;
+ end;
+end;
+
+procedure TEncoder.AppendAlphanumericBytes(const Content: WideString; Bits: TBitArray);
+var
+ ContentLength: Integer;
+ I: Integer;
+ Code1: Integer;
+ Code2: Integer;
+begin
+ ContentLength := Length(Content);
+ I := 0;
+ while (I < ContentLength) do
+ begin
+ Code1 := GetAlphanumericCode(Ord(Content[I + 0 + 1]));
+ if (Code1 = -1) then
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+ if (I + 1 < ContentLength) then
+ begin
+ Code2 := GetAlphanumericCode(Ord(Content[I + 1 + 1]));
+ if (Code2 = -1) then
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+ // Encode two alphanumeric letters in 11 bits.
+ Bits.AppendBits(Code1 * 45 + Code2, 11);
+ Inc(I, 2);
+ end else
+ begin
+ // Encode one alphanumeric letter in six bits.
+ Bits.AppendBits(Code1, 6);
+ Inc(I);
+ end;
+ end;
+end;
+
+procedure TEncoder.Append8BitBytes(const Content: WideString; Bits: TBitArray; EncodeOptions: Integer);
+var
+ Bytes: TByteArray;
+ I: Integer;
+ UTF8Version: AnsiString;
+begin
+ SetLength(Bytes, 0);
+ if (EncodeOptions = 3) then
+ begin
+ SetLength(Bytes, Length(Content));
+ for I := 1 to Length(Content) do
+ begin
+ Bytes[I - 1] := Ord(Content[I]) and $FF;
+ end;
+ end else
+ if (EncodeOptions = 5) then
+ begin
+ // Add the UTF-8 BOM
+ UTF8Version := #$EF#$BB#$BF + UTF8Encode(Content);
+ SetLength(Bytes, Length(UTF8Version));
+ if (Length(UTF8Version) > 0) then
+ begin
+ Move(UTF8Version[1], Bytes[0], Length(UTF8Version));
+ end;
+ end else
+ if (EncodeOptions = 4) then
+ begin
+ // No BOM
+ UTF8Version := UTF8Encode(Content);
+ SetLength(Bytes, Length(UTF8Version));
+ if (Length(UTF8Version) > 0) then
+ begin
+ Move(UTF8Version[1], Bytes[0], Length(UTF8Version));
+ end;
+ end;
+ for I := 0 to Length(Bytes) - 1 do
+ begin
+ Bits.AppendBits(Bytes[I], 8);
+ end;
+end;
+
+procedure TEncoder.AppendKanjiBytes(const Content: WideString; Bits: TBitArray);
+var
+ Bytes: TByteArray;
+ ByteLength: Integer;
+ I: Integer;
+ Byte1: Integer;
+ Byte2: Integer;
+ Code: Integer;
+ Subtracted: Integer;
+ Encoded: Integer;
+begin
+ SetLength(Bytes, 0);
+ try
+
+ except
+ FEncoderError := True;
+ Exit;
+ end;
+
+ ByteLength := Length(Bytes);
+ I := 0;
+ while (I < ByteLength) do
+ begin
+ Byte1 := Bytes[I] and $FF;
+ Byte2 := Bytes[I + 1] and $FF;
+ Code := (Byte1 shl 8) or Byte2;
+ Subtracted := -1;
+ if ((Code >= $8140) and (Code <= $9ffc)) then
+ begin
+ Subtracted := Code - $8140;
+ end else
+ if ((Code >= $e040) and (Code <= $ebbf)) then
+ begin
+ Subtracted := Code - $c140;
+ end;
+ if (Subtracted = -1) then
+ begin
+ FEncoderError := True;
+ Exit;
+ end;
+ Encoded := ((Subtracted shr 8) * $c0) + (Subtracted and $ff);
+ Bits.AppendBits(Encoded, 13);
+ Inc(I, 2);
+ end;
+end;
+
+procedure TMatrixUtil.ClearMatrix(Matrix: TByteMatrix);
+begin
+ Matrix.Clear(Byte(-1));
+end;
+
+constructor TMatrixUtil.Create;
+begin
+ FMatrixUtilError := False;
+end;
+
+// Build 2D matrix of QR Code from "dataBits" with "ecLevel", "version" and "getMaskPattern". On
+// success, store the result in "matrix" and return true.
+procedure TMatrixUtil.BuildMatrix(DataBits: TBitArray; ECLevel: TErrorCorrectionLevel;
+ Version, MaskPattern: Integer; Matrix: TByteMatrix);
+begin
+ ClearMatrix(Matrix);
+ EmbedBasicPatterns(Version, Matrix);
+
+ // Type information appear with any version.
+ EmbedTypeInfo(ECLevel, MaskPattern, Matrix);
+
+ // Version info appear if version >= 7.
+ MaybeEmbedVersionInfo(Version, Matrix);
+
+ // Data should be embedded at end.
+ EmbedDataBits(DataBits, MaskPattern, Matrix);
+end;
+
+// Embed basic patterns. On success, modify the matrix and return true.
+// The basic patterns are:
+// - Position detection patterns
+// - Timing patterns
+// - Dark dot at the left bottom corner
+// - Position adjustment patterns, if need be
+procedure TMatrixUtil.EmbedBasicPatterns(Version: Integer; Matrix: TByteMatrix);
+begin
+ // Let's get started with embedding big squares at corners.
+ EmbedPositionDetectionPatternsAndSeparators(Matrix);
+
+ // Then, embed the dark dot at the left bottom corner.
+ EmbedDarkDotAtLeftBottomCorner(Matrix);
+
+ // Position adjustment patterns appear if version >= 2.
+ MaybeEmbedPositionAdjustmentPatterns(Version, Matrix);
+
+ // Timing patterns should be embedded after position adj. patterns.
+ EmbedTimingPatterns(Matrix);
+end;
+
+// Embed type information. On success, modify the matrix.
+procedure TMatrixUtil.EmbedTypeInfo(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Matrix: TByteMatrix);
+var
+ TypeInfoBits: TBitArray;
+ I: Integer;
+ Bit: Boolean;
+ X1, Y1: Integer;
+ X2, Y2: Integer;
+begin
+ TypeInfoBits := TBitArray.Create;
+ try
+ MakeTypeInfoBits(ECLevel, MaskPattern, TypeInfoBits);
+
+ for I := 0 to TypeInfoBits.GetSize - 1 do
+ begin
+ // Place bits in LSB to MSB order. LSB (least significant bit) is the last value in
+ // "typeInfoBits".
+ Bit := TypeInfoBits.Get(TypeInfoBits.GetSize - 1 - I);
+
+ // Type info bits at the left top corner. See 8.9 of JISX0510:2004 (p.46).
+ X1 := TYPE_INFO_COORDINATES[I][0];
+ Y1 := TYPE_INFO_COORDINATES[I][1];
+ Matrix.SetBoolean(X1, Y1, Bit);
+
+ if (I < 8) then
+ begin
+ // Right top corner.
+ X2 := Matrix.Width - I - 1;
+ Y2 := 8;
+ Matrix.SetBoolean(X2, Y2, Bit);
+ end else
+ begin
+ // Left bottom corner.
+ X2 := 8;
+ Y2 := Matrix.Height - 7 + (I - 8);
+ Matrix.SetBoolean(X2, Y2, Bit);
+ end;
+ end;
+ finally
+ TypeInfoBits.Free;
+ end;
+end;
+
+// Embed version information if need be. On success, modify the matrix and return true.
+// See 8.10 of JISX0510:2004 (p.47) for how to embed version information.
+procedure TMatrixUtil.MaybeEmbedVersionInfo(Version: Integer; Matrix: TByteMatrix);
+var
+ VersionInfoBits: TBitArray;
+ I, J: Integer;
+ BitIndex: Integer;
+ Bit: Boolean;
+begin
+ if (Version < 7) then
+ begin
+ Exit; // Don't need version info.
+ end;
+
+ VersionInfoBits := TBitArray.Create;
+ try
+ MakeVersionInfoBits(Version, VersionInfoBits);
+
+ BitIndex := 6 * 3 - 1; // It will decrease from 17 to 0.
+ for I := 0 to 5 do
+ begin
+ for J := 0 to 2 do
+ begin
+ // Place bits in LSB (least significant bit) to MSB order.
+ Bit := VersionInfoBits.Get(BitIndex);
+ Dec(BitIndex);
+ // Left bottom corner.
+ Matrix.SetBoolean(I, Matrix.Height - 11 + J, Bit);
+ // Right bottom corner.
+ Matrix.SetBoolean(Matrix.Height - 11 + J, I, bit);
+ end;
+ end;
+ finally
+ VersionInfoBits.Free;
+ end;
+end;
+
+// Embed "dataBits" using "getMaskPattern". On success, modify the matrix and return true.
+// For debugging purposes, it skips masking process if "getMaskPattern" is -1.
+// See 8.7 of JISX0510:2004 (p.38) for how to embed data bits.
+procedure TMatrixUtil.EmbedDataBits(DataBits: TBitArray; MaskPattern: Integer; Matrix: TByteMatrix);
+var
+ BitIndex: Integer;
+ Direction: Integer;
+ X, Y, I, XX: Integer;
+ Bit: Boolean;
+ MaskUtil: TMaskUtil;
+begin
+ MaskUtil := TMaskUtil.Create;
+ try
+ bitIndex := 0;
+ direction := -1;
+ // Start from the right bottom cell.
+ X := Matrix.Width - 1;
+ Y := Matrix.Height - 1;
+ while (X > 0) do
+ begin
+ // Skip the vertical timing pattern.
+ if (X = 6) then
+ begin
+ Dec(X, 1);
+ end;
+ while ((Y >= 0) and (y < Matrix.Height)) do
+ begin
+ for I := 0 to 1 do
+ begin
+ XX := X - I;
+ // Skip the cell if it's not empty.
+ if (not IsEmpty(Matrix.Get(XX, Y))) then
+ begin
+ Continue;
+ end;
+
+ if (BitIndex < DataBits.GetSize) then
+ begin
+ Bit := DataBits.Get(BitIndex);
+ Inc(BitIndex);
+ end else
+ begin
+ // Padding bit. If there is no bit left, we'll fill the left cells with 0, as described
+ // in 8.4.9 of JISX0510:2004 (p. 24).
+ Bit := False;
+ end;
+
+ // Skip masking if mask_pattern is -1.
+ if (MaskPattern <> -1) then
+ begin
+ if (MaskUtil.GetDataMaskBit(MaskPattern, XX, Y)) then
+ begin
+ Bit := not Bit;
+ end;
+ end;
+ Matrix.SetBoolean(XX, Y, Bit);
+ end;
+ Inc(Y, Direction);
+ end;
+ Direction := -Direction; // Reverse the direction.
+ Inc(Y, Direction);
+ Dec(X, 2); // Move to the left.
+ end;
+ finally
+ MaskUtil.Free;
+ end;
+
+ // All bits should be consumed.
+ if (BitIndex <> DataBits.GetSize()) then
+ begin
+ FMatrixUtilError := True;
+ Exit;
+ end;
+end;
+
+// Return the position of the most significant bit set (to one) in the "value". The most
+// significant bit is position 32. If there is no bit set, return 0. Examples:
+// - findMSBSet(0) => 0
+// - findMSBSet(1) => 1
+// - findMSBSet(255) => 8
+function TMatrixUtil.FindMSBSet(Value: Integer): Integer;
+var
+ NumDigits: Integer;
+begin
+ NumDigits := 0;
+ while (Value <> 0) do
+ begin
+ Value := Value shr 1;
+ Inc(NumDigits);
+ end;
+ Result := NumDigits;
+end;
+
+// Calculate BCH (Bose-Chaudhuri-Hocquenghem) code for "value" using polynomial "poly". The BCH
+// code is used for encoding type information and version information.
+// Example: Calculation of version information of 7.
+// f(x) is created from 7.
+// - 7 = 000111 in 6 bits
+// - f(x) = x^2 + x^1 + x^0
+// g(x) is given by the standard (p. 67)
+// - g(x) = x^12 + x^11 + x^10 + x^9 + x^8 + x^5 + x^2 + 1
+// Multiply f(x) by x^(18 - 6)
+// - f'(x) = f(x) * x^(18 - 6)
+// - f'(x) = x^14 + x^13 + x^12
+// Calculate the remainder of f'(x) / g(x)
+// x^2
+// __________________________________________________
+// g(x) )x^14 + x^13 + x^12
+// x^14 + x^13 + x^12 + x^11 + x^10 + x^7 + x^4 + x^2
+// --------------------------------------------------
+// x^11 + x^10 + x^7 + x^4 + x^2
+//
+// The remainder is x^11 + x^10 + x^7 + x^4 + x^2
+// Encode it in binary: 110010010100
+// The return value is 0xc94 (1100 1001 0100)
+//
+// Since all coefficients in the polynomials are 1 or 0, we can do the calculation by bit
+// operations. We don't care if cofficients are positive or negative.
+function TMatrixUtil.CalculateBCHCode(Value, Poly: Integer): Integer;
+var
+ MSBSetInPoly: Integer;
+begin
+ // If poly is "1 1111 0010 0101" (version info poly), msbSetInPoly is 13. We'll subtract 1
+ // from 13 to make it 12.
+ MSBSetInPoly := FindMSBSet(Poly);
+ Value := Value shl (MSBSetInPoly - 1);
+ // Do the division business using exclusive-or operations.
+ while (FindMSBSet(Value) >= MSBSetInPoly) do
+ begin
+ Value := Value xor (Poly shl (FindMSBSet(Value) - MSBSetInPoly));
+ end;
+ // Now the "value" is the remainder (i.e. the BCH code)
+ Result := Value;
+end;
+
+// Make bit vector of type information. On success, store the result in "bits" and return true.
+// Encode error correction level and mask pattern. See 8.9 of
+// JISX0510:2004 (p.45) for details.
+procedure TMatrixUtil.MakeTypeInfoBits(ECLevel: TErrorCorrectionLevel; MaskPattern: Integer; Bits: TBitArray);
+var
+ TypeInfo: Integer;
+ BCHCode: Integer;
+ MaskBits: TBitArray;
+begin
+ if ((MaskPattern >= 0) and (MaskPattern < NUM_MASK_PATTERNS)) then
+ begin
+ TypeInfo := (ECLevel.Bits shl 3) or MaskPattern;
+ Bits.AppendBits(TypeInfo, 5);
+
+ BCHCode := CalculateBCHCode(TypeInfo, TYPE_INFO_POLY);
+ Bits.AppendBits(BCHCode, 10);
+
+ MaskBits := TBitArray.Create;
+ try
+ MaskBits.AppendBits(TYPE_INFO_MASK_PATTERN, 15);
+ Bits.XorOperation(MaskBits);
+ finally
+ MaskBits.Free;
+ end;
+
+ if (Bits.GetSize <> 15) then // Just in case.
+ begin
+ FMatrixUtilError := True;
+ Exit;
+ end;
+ end;
+end;
+
+// Make bit vector of version information. On success, store the result in "bits" and return true.
+// See 8.10 of JISX0510:2004 (p.45) for details.
+procedure TMatrixUtil.MakeVersionInfoBits(Version: Integer; Bits: TBitArray);
+var
+ BCHCode: Integer;
+begin
+ Bits.AppendBits(Version, 6);
+ BCHCode := CalculateBCHCode(Version, VERSION_INFO_POLY);
+ Bits.AppendBits(BCHCode, 12);
+
+ if (Bits.GetSize() <> 18) then
+ begin
+ FMatrixUtilError := True;
+ Exit;
+ end;
+end;
+
+// Check if "value" is empty.
+function TMatrixUtil.IsEmpty(Value: Integer): Boolean;
+begin
+ Result := (Value = -1);
+end;
+
+procedure TMatrixUtil.EmbedTimingPatterns(Matrix: TByteMatrix);
+var
+ I: Integer;
+ Bit: Integer;
+begin
+ // -8 is for skipping position detection patterns (size 7), and two horizontal/vertical
+ // separation patterns (size 1). Thus, 8 = 7 + 1.
+ for I := 8 to Matrix.Width - 9 do
+ begin
+ Bit := (I + 1) mod 2;
+ // Horizontal line.
+ if (IsEmpty(Matrix.Get(I, 6))) then
+ begin
+ Matrix.SetInteger(I, 6, Bit);
+ end;
+ // Vertical line.
+ if (IsEmpty(Matrix.Get(6, I))) then
+ begin
+ Matrix.SetInteger(6, I, Bit);
+ end;
+ end;
+end;
+
+// Embed the lonely dark dot at left bottom corner. JISX0510:2004 (p.46)
+procedure TMatrixUtil.EmbedDarkDotAtLeftBottomCorner(Matrix: TByteMatrix);
+begin
+ if (Matrix.Get(8, Matrix.Height - 8) = 0) then
+ begin
+ FMatrixUtilError := True;
+ Exit;
+ end;
+ Matrix.SetInteger(8, Matrix.Height - 8, 1);
+end;
+
+procedure TMatrixUtil.EmbedHorizontalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
+var
+ X: Integer;
+begin
+ // We know the width and height.
+ for X := 0 to 7 do
+ begin
+ if (not IsEmpty(Matrix.Get(XStart + X, YStart))) then
+ begin
+ FMatrixUtilError := True;
+ Exit;
+ end;
+ Matrix.SetInteger(XStart + X, YStart, HORIZONTAL_SEPARATION_PATTERN[0][X]);
+ end;
+end;
+
+procedure TMatrixUtil.EmbedVerticalSeparationPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
+var
+ Y: Integer;
+begin
+ // We know the width and height.
+ for Y := 0 to 6 do
+ begin
+ if (not IsEmpty(Matrix.Get(XStart, YStart + Y))) then
+ begin
+ FMatrixUtilError := True;
+ Exit;
+ end;
+ Matrix.SetInteger(XStart, YStart + Y, VERTICAL_SEPARATION_PATTERN[Y][0]);
+ end;
+end;
+
+// Note that we cannot unify the function with embedPositionDetectionPattern() despite they are
+// almost identical, since we cannot write a function that takes 2D arrays in different sizes in
+// C/C++. We should live with the fact.
+procedure TMatrixUtil.EmbedPositionAdjustmentPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
+var
+ X, Y: Integer;
+begin
+ // We know the width and height.
+ for Y := 0 to 4 do
+ begin
+ for X := 0 to 4 do
+ begin
+ if (not IsEmpty(Matrix.Get(XStart + X, YStart + Y))) then
+ begin
+ FMatrixUtilError := True;
+ Exit;
+ end;
+ Matrix.SetInteger(XStart + X, YStart + Y, POSITION_ADJUSTMENT_PATTERN[Y][X]);
+ end;
+ end;
+end;
+
+procedure TMatrixUtil.EmbedPositionDetectionPattern(XStart, YStart: Integer; Matrix: TByteMatrix);
+var
+ X, Y: Integer;
+begin
+ // We know the width and height.
+ for Y := 0 to 6 do
+ begin
+ for X := 0 to 6 do
+ begin
+ if (not IsEmpty(Matrix.Get(XStart + X, YStart + Y))) then
+ begin
+ FMatrixUtilError := True;
+ Exit;
+ end;
+ Matrix.SetInteger(XStart + X, YStart + Y, POSITION_DETECTION_PATTERN[Y][X]);
+ end;
+ end;
+end;
+
+// Embed position detection patterns and surrounding vertical/horizontal separators.
+procedure TMatrixUtil.EmbedPositionDetectionPatternsAndSeparators(Matrix: TByteMatrix);
+var
+ PDPWidth: Integer;
+ HSPWidth: Integer;
+ VSPSize: Integer;
+begin
+ // Embed three big squares at corners.
+ PDPWidth := Length(POSITION_DETECTION_PATTERN[0]);
+ // Left top corner.
+ EmbedPositionDetectionPattern(0, 0, Matrix);
+ // Right top corner.
+ EmbedPositionDetectionPattern(Matrix.Width - PDPWidth, 0, Matrix);
+ // Left bottom corner.
+ EmbedPositionDetectionPattern(0, Matrix.Width- PDPWidth, Matrix);
+
+ // Embed horizontal separation patterns around the squares.
+ HSPWidth := Length(HORIZONTAL_SEPARATION_PATTERN[0]);
+ // Left top corner.
+ EmbedHorizontalSeparationPattern(0, HSPWidth - 1, Matrix);
+ // Right top corner.
+ EmbedHorizontalSeparationPattern(Matrix.Width - HSPWidth,
+ HSPWidth - 1, Matrix);
+ // Left bottom corner.
+ EmbedHorizontalSeparationPattern(0, Matrix.Width - HSPWidth, Matrix);
+
+ // Embed vertical separation patterns around the squares.
+ VSPSize := Length(VERTICAL_SEPARATION_PATTERN);
+ // Left top corner.
+ EmbedVerticalSeparationPattern(VSPSize, 0, Matrix);
+ // Right top corner.
+ EmbedVerticalSeparationPattern(Matrix.Height - VSPSize - 1, 0, Matrix);
+ // Left bottom corner.
+ EmbedVerticalSeparationPattern(VSPSize, Matrix.Height - VSPSize, Matrix);
+end;
+
+// Embed position adjustment patterns if need be.
+procedure TMatrixUtil.MaybeEmbedPositionAdjustmentPatterns(Version: Integer; Matrix: TByteMatrix);
+var
+ Index: Integer;
+ Coordinates: array of Integer;
+ NumCoordinates: Integer;
+ X, Y, I, J: Integer;
+begin
+ if (Version >= 2) then
+ begin
+ Index := Version - 1;
+ NumCoordinates := Length(POSITION_ADJUSTMENT_PATTERN_COORDINATE_TABLE[Index]);
+ SetLength(Coordinates, NumCoordinates);
+ Move(POSITION_ADJUSTMENT_PATTERN_COORDINATE_TABLE[Index][0], Coordinates[0], NumCoordinates * SizeOf(Integer));
+ for I := 0 to NumCoordinates - 1 do
+ begin
+ for J := 0 to NumCoordinates - 1 do
+ begin
+ Y := Coordinates[I];
+ X := Coordinates[J];
+ if ((X = -1) or (Y = -1)) then
+ begin
+ Continue;
+ end;
+ // If the cell is unset, we embed the position adjustment pattern here.
+ if (IsEmpty(Matrix.Get(X, Y))) then
+ begin
+ // -2 is necessary since the x/y coordinates point to the center of the pattern, not the
+ // left top corner.
+ EmbedPositionAdjustmentPattern(X - 2, Y - 2, Matrix);
+ end;
+ end;
+ end;
+ end;
+end;
+
+
+{ TBitArray }
+
+
+procedure TBitArray.AppendBits(Value, NumBits: Integer);
+var
+ NumBitsLeft: Integer;
+begin
+ if ((NumBits < 0) or (NumBits > 32)) then
+ begin
+
+ end;
+ EnsureCapacity(Size + NumBits);
+ for NumBitsLeft := NumBits downto 1 do
+ begin
+ AppendBit(((Value shr (NumBitsLeft - 1)) and $01) = 1);
+ end;
+end;
+
+procedure TBitArray.Clear;
+begin
+ Size := 0;
+ SetLength(Bits, 1);
+ Bits[0] := 0;
+end;
+
+constructor TBitArray.Create(Size: Integer);
+
+begin
+ Size := Size;
+ SetLength(Bits, (Size + 31) shr 5);
+end;
+
+constructor TBitArray.Create;
+begin
+ Size := 0;
+ SetLength(Bits, 1);
+end;
+
+function TBitArray.Get(I: Integer): Boolean;
+begin
+ Result := (Bits[I shr 5] and (1 shl (I and $1F))) <> 0;
+end;
+
+function TBitArray.GetSize: Integer;
+begin
+ Result := Size;
+end;
+
+function TBitArray.GetSizeInBytes: Integer;
+begin
+ Result := (Size + 7) shr 3;
+end;
+
+procedure TBitArray.SetBit(Index: Integer);
+begin
+ Bits[Index shr 5] := Bits[Index shr 5] or (1 shl (Index and $1F));
+end;
+
+procedure TBitArray.AppendBit(Bit: Boolean);
+begin
+ EnsureCapacity(Size + 1);
+ if (Bit) then
+ begin
+ Bits[Size shr 5] := Bits[Size shr 5] or (1 shl (Size and $1F));
+ end;
+ Inc(Size);
+end;
+
+procedure TBitArray.ToBytes(BitOffset: Integer; Source: TByteArray; Offset,
+ NumBytes: Integer);
+var
+ I: Integer;
+ J: Integer;
+ TheByte: Integer;
+begin
+ for I := 0 to NumBytes - 1 do
+ begin
+ TheByte := 0;
+ for J := 0 to 7 do
+ begin
+ if (Get(BitOffset)) then
+ begin
+ TheByte := TheByte or (1 shl (7 - J));
+ end;
+ Inc(BitOffset);
+ end;
+ Source[Offset + I] := TheByte;
+ end;
+end;
+
+procedure TBitArray.XorOperation(Other: TBitArray);
+var
+ I: Integer;
+begin
+ if (Length(Bits) = Length(Other.Bits)) then
+ begin
+ for I := 0 to Length(Bits) - 1 do
+ begin
+ // The last byte could be incomplete (i.e. not have 8 bits in
+ // it) but there is no problem since 0 XOR 0 == 0.
+ Bits[I] := Bits[I] xor Other.Bits[I];
+ end;
+ end;
+end;
+
+procedure TBitArray.AppendBitArray(NewBitArray: TBitArray);
+var
+ OtherSize: Integer;
+ I: Integer;
+begin
+ OtherSize := NewBitArray.GetSize;
+ EnsureCapacity(Size + OtherSize);
+ for I := 0 to OtherSize - 1 do
+ begin
+ AppendBit(NewBitArray.Get(I));
+ end;
+end;
+
+procedure TBitArray.EnsureCapacity(Size: Integer);
+begin
+ if (Size > (Length(Bits) shl 5)) then
+ begin
+ SetLength(Bits, Size);
+ end;
+end;
+
+{ TErrorCorrectionLevel }
+
+procedure TErrorCorrectionLevel.Assign(Source: TErrorCorrectionLevel);
+begin
+ Self.FBits := Source.FBits;
+end;
+
+{ TVersion }
+
+class function TVersion.ChooseVersion(NumInputBits: Integer;
+ ECLevel: TErrorCorrectionLevel): TVersion;
+var
+ VersionNum: Integer;
+ Version: TVersion;
+ NumBytes: Integer;
+ ECBlocks: TECBlocks;
+ NumECBytes: Integer;
+ NumDataBytes: Integer;
+ TotalInputBytes: Integer;
+begin
+ Result := nil;
+ // In the following comments, we use numbers of Version 7-H.
+ for VersionNum := 1 to 40 do
+ begin
+ Version := TVersion.GetVersionForNumber(VersionNum);
+
+ // numBytes = 196
+ NumBytes := Version.GetTotalCodewords;
+ // getNumECBytes = 130
+ ECBlocks := Version.GetECBlocksForLevel(ECLevel);
+ NumECBytes := ECBlocks.GetTotalECCodewords;
+ // getNumDataBytes = 196 - 130 = 66
+ NumDataBytes := NumBytes - NumECBytes;
+ TotalInputBytes := (NumInputBits + 7) div 8;
+
+ if (numDataBytes >= totalInputBytes) then
+ begin
+ Result := Version;
+ Exit;
+ end else
+ begin
+ Version.Free;
+ end;
+ end;
+end;
+
+constructor TVersion.Create(VersionNumber: Integer;
+ AlignmentPatternCenters: array of Integer; ECBlocks1, ECBlocks2, ECBlocks3,
+ ECBlocks4: TECBlocks);
+var
+ Total: Integer;
+ ECBlock: TECB;
+ ECBArray: TECBArray;
+ I: Integer;
+begin
+ Self.VersionNumber := VersionNumber;
+ SetLength(Self.AlignmentPatternCenters, Length(AlignmentPatternCenters));
+ if (Length(AlignmentPatternCenters) > 0) then
+ begin
+ Move(AlignmentPatternCenters[0], Self.AlignmentPatternCenters[0],
+ Length(AlignmentPatternCenters) * SizeOf(Integer));
+ end;
+ SetLength(ECBlocks, 4);
+ ECBlocks[0] := ECBlocks1;
+ ECBlocks[1] := ECBlocks2;
+ ECBlocks[2] := ECBlocks3;
+ ECBlocks[3] := ECBlocks4;
+ Total := 0;
+ ECCodewords := ECBlocks1.GetECCodewordsPerBlock;
+ ECBArray := ECBlocks1.GetECBlocks;
+ for I := 0 to Length(ECBArray) - 1 do
+ begin
+ ECBlock := ECBArray[I];
+ Inc(Total, ECBlock.GetCount * (ECBlock.GetDataCodewords + ECCodewords));
+ end;
+ TotalCodewords := Total;
+end;
+
+destructor TVersion.Destroy;
+var
+ X: Integer;
+begin
+ for X := 0 to Length(ECBlocks) - 1 do
+ begin
+ ECBlocks[X].Free;
+ end;
+ inherited;
+end;
+
+function TVersion.GetDimensionForVersion: Integer;
+begin
+ Result := 17 + 4 * VersionNumber;
+end;
+
+function TVersion.GetECBlocksForLevel(ECLevel: TErrorCorrectionLevel): TECBlocks;
+begin
+ Result := ECBlocks[ECLevel.Ordinal];
+end;
+
+function TVersion.GetTotalCodewords: Integer;
+begin
+ Result := TotalCodewords;
+end;
+
+class function TVersion.GetVersionForNumber(VersionNum: Integer): TVersion;
+begin
+ if (VersionNum = 1) then
+ begin
+ Result := TVersion.Create(1, [],
+ TECBlocks.Create(7, TECB.Create(1, 19)),
+ TECBlocks.Create(10, TECB.Create(1, 16)),
+ TECBlocks.Create(13, TECB.Create(1, 13)),
+ TECBlocks.Create(17, TECB.Create(1, 9)));
+ end else
+ if (VersionNum = 2) then
+ begin
+ Result := TVersion.Create(2, [6, 18],
+ TECBlocks.Create(10, TECB.Create(1, 34)),
+ TECBlocks.Create(16, TECB.Create(1, 28)),
+ TECBlocks.Create(22, TECB.Create(1, 22)),
+ TECBlocks.Create(28, TECB.Create(1, 16)));
+ end else
+ if (VersionNum = 3) then
+ begin
+ Result := TVersion.Create(3, [6, 22],
+ TECBlocks.Create(15, TECB.Create(1, 55)),
+ TECBlocks.Create(26, TECB.Create(1, 44)),
+ TECBlocks.Create(18, TECB.Create(2, 17)),
+ TECBlocks.Create(22, TECB.Create(2, 13)));
+ end else
+ if (VersionNum = 4) then
+ begin
+ Result := TVersion.Create(4, [6, 26],
+ TECBlocks.Create(20, TECB.Create(1, 80)),
+ TECBlocks.Create(18, TECB.Create(2, 32)),
+ TECBlocks.Create(26, TECB.Create(2, 24)),
+ TECBlocks.Create(16, TECB.Create(4, 9)));
+ end else
+ if (VersionNum = 5) then
+ begin
+ Result := TVersion.Create(5, [6, 30],
+ TECBlocks.Create(26, TECB.Create(1, 108)),
+ TECBlocks.Create(24, TECB.Create(2, 43)),
+ TECBlocks.Create(18, TECB.Create(2, 15),
+ TECB.Create(2, 16)),
+ TECBlocks.Create(22, TECB.Create(2, 11),
+ TECB.Create(2, 12)));
+ end else
+ if (VersionNum = 6) then
+ begin
+ Result := TVersion.Create(6, [6, 34],
+ TECBlocks.Create(18, TECB.Create(2, 68)),
+ TECBlocks.Create(16, TECB.Create(4, 27)),
+ TECBlocks.Create(24, TECB.Create(4, 19)),
+ TECBlocks.Create(28, TECB.Create(4, 15)));
+ end else
+ if (VersionNum = 7) then
+ begin
+ Result := TVersion.Create(7, [6, 22, 38],
+ TECBlocks.Create(20, TECB.Create(2, 78)),
+ TECBlocks.Create(18, TECB.Create(4, 31)),
+ TECBlocks.Create(18, TECB.Create(2, 14),
+ TECB.Create(4, 15)),
+ TECBlocks.Create(26, TECB.Create(4, 13),
+ TECB.Create(1, 14)));
+ end else
+ if (VersionNum = 8) then
+ begin
+ Result := TVersion.Create(8, [6, 24, 42],
+ TECBlocks.Create(24, TECB.Create(2, 97)),
+ TECBlocks.Create(22, TECB.Create(2, 38),
+ TECB.Create(2, 39)),
+ TECBlocks.Create(22, TECB.Create(4, 18),
+ TECB.Create(2, 19)),
+ TECBlocks.Create(26, TECB.Create(4, 14),
+ TECB.Create(2, 15)));
+ end else
+ if (VersionNum = 9) then
+ begin
+ Result := TVersion.Create(9, [6, 26, 46],
+ TECBlocks.Create(30, TECB.Create(2, 116)),
+ TECBlocks.Create(22, TECB.Create(3, 36),
+ TECB.Create(2, 37)),
+ TECBlocks.Create(20, TECB.Create(4, 16),
+ TECB.Create(4, 17)),
+ TECBlocks.Create(24, TECB.Create(4, 12),
+ TECB.Create(4, 13)));
+ end else
+ if (VersionNum = 10) then
+ begin
+ Result := TVersion.Create(10, [6, 28, 50],
+ TECBlocks.Create(18, TECB.Create(2, 68),
+ TECB.Create(2, 69)),
+ TECBlocks.Create(26, TECB.Create(4, 43),
+ TECB.Create(1, 44)),
+ TECBlocks.Create(24, TECB.Create(6, 19),
+ TECB.Create(2, 20)),
+ TECBlocks.Create(28, TECB.Create(6, 15),
+ TECB.Create(2, 16)));
+ end else
+ if (VersionNum = 11) then
+ begin
+ Result := TVersion.Create(11, [6, 30, 54],
+ TECBlocks.Create(20, TECB.Create(4, 81)),
+ TECBlocks.Create(30, TECB.Create(1, 50),
+ TECB.Create(4, 51)),
+ TECBlocks.Create(28, TECB.Create(4, 22),
+ TECB.Create(4, 23)),
+ TECBlocks.Create(24, TECB.Create(3, 12),
+ TECB.Create(8, 13)));
+ end else
+ if (VersionNum = 12) then
+ begin
+ Result := TVersion.Create(12, [6, 32, 58],
+ TECBlocks.Create(24, TECB.Create(2, 92),
+ TECB.Create(2, 93)),
+ TECBlocks.Create(22, TECB.Create(6, 36),
+ TECB.Create(2, 37)),
+ TECBlocks.Create(26, TECB.Create(4, 20),
+ TECB.Create(6, 21)),
+ TECBlocks.Create(28, TECB.Create(7, 14),
+ TECB.Create(4, 15)));
+ end else
+ if (VersionNum = 13) then
+ begin
+ Result := TVersion.Create(13, [6, 34, 62],
+ TECBlocks.Create(26, TECB.Create(4, 107)),
+ TECBlocks.Create(22, TECB.Create(8, 37),
+ TECB.Create(1, 38)),
+ TECBlocks.Create(24, TECB.Create(8, 20),
+ TECB.Create(4, 21)),
+ TECBlocks.Create(22, TECB.Create(12, 11),
+ TECB.Create(4, 12)));
+ end else
+ if (VersionNum = 14) then
+ begin
+ Result := TVersion.Create(14, [6, 26, 46, 66],
+ TECBlocks.Create(30, TECB.Create(3, 115),
+ TECB.Create(1, 116)),
+ TECBlocks.Create(24, TECB.Create(4, 40),
+ TECB.Create(5, 41)),
+ TECBlocks.Create(20, TECB.Create(11, 16),
+ TECB.Create(5, 17)),
+ TECBlocks.Create(24, TECB.Create(11, 12),
+ TECB.Create(5, 13)));
+ end else
+ if (VersionNum = 15) then
+ begin
+ Result := TVersion.Create(15, [6, 26, 48, 70],
+ TECBlocks.Create(22, TECB.Create(5, 87),
+ TECB.Create(1, 88)),
+ TECBlocks.Create(24, TECB.Create(5, 41),
+ TECB.Create(5, 42)),
+ TECBlocks.Create(30, TECB.Create(5, 24),
+ TECB.Create(7, 25)),
+ TECBlocks.Create(24, TECB.Create(11, 12),
+ TECB.Create(7, 13)));
+ end else
+ if (VersionNum = 16) then
+ begin
+ Result := TVersion.Create(16, [6, 26, 50, 74],
+ TECBlocks.Create(24, TECB.Create(5, 98),
+ TECB.Create(1, 99)),
+ TECBlocks.Create(28, TECB.Create(7, 45),
+ TECB.Create(3, 46)),
+ TECBlocks.Create(24, TECB.Create(15, 19),
+ TECB.Create(2, 20)),
+ TECBlocks.Create(30, TECB.Create(3, 15),
+ TECB.Create(13, 16)));
+ end else
+ if (VersionNum = 17) then
+ begin
+ Result := TVersion.Create(17, [6, 30, 54, 78],
+ TECBlocks.Create(28, TECB.Create(1, 107),
+ TECB.Create(5, 108)),
+ TECBlocks.Create(28, TECB.Create(10, 46),
+ TECB.Create(1, 47)),
+ TECBlocks.Create(28, TECB.Create(1, 22),
+ TECB.Create(15, 23)),
+ TECBlocks.Create(28, TECB.Create(2, 14),
+ TECB.Create(17, 15)));
+ end else
+ if (VersionNum = 18) then
+ begin
+ Result := TVersion.Create(18, [6, 30, 56, 82],
+ TECBlocks.Create(30, TECB.Create(5, 120),
+ TECB.Create(1, 121)),
+ TECBlocks.Create(26, TECB.Create(9, 43),
+ TECB.Create(4, 44)),
+ TECBlocks.Create(28, TECB.Create(17, 22),
+ TECB.Create(1, 23)),
+ TECBlocks.Create(28, TECB.Create(2, 14),
+ TECB.Create(19, 15)));
+ end else
+ if (VersionNum = 19) then
+ begin
+ Result := TVersion.Create(19, [6, 30, 58, 86],
+ TECBlocks.Create(28, TECB.Create(3, 113),
+ TECB.Create(4, 114)),
+ TECBlocks.Create(26, TECB.Create(3, 44),
+ TECB.Create(11, 45)),
+ TECBlocks.Create(26, TECB.Create(17, 21),
+ TECB.Create(4, 22)),
+ TECBlocks.Create(26, TECB.Create(9, 13),
+ TECB.Create(16, 14)));
+ end else
+ if (VersionNum = 20) then
+ begin
+ Result := TVersion.Create(20, [6, 34, 62, 90],
+ TECBlocks.Create(28, TECB.Create(3, 107),
+ TECB.Create(5, 108)),
+ TECBlocks.Create(26, TECB.Create(3, 41),
+ TECB.Create(13, 42)),
+ TECBlocks.Create(30, TECB.Create(15, 24),
+ TECB.Create(5, 25)),
+ TECBlocks.Create(28, TECB.Create(15, 15),
+ TECB.Create(10, 16)));
+ end else
+ if (VersionNum = 21) then
+ begin
+ Result := TVersion.Create(21, [6, 28, 50, 72, 94],
+ TECBlocks.Create(28, TECB.Create(4, 116),
+ TECB.Create(4, 117)),
+ TECBlocks.Create(26, TECB.Create(17, 42)),
+ TECBlocks.Create(28, TECB.Create(17, 22),
+ TECB.Create(6, 23)),
+ TECBlocks.Create(30, TECB.Create(19, 16),
+ TECB.Create(6, 17)));
+ end else
+ if (VersionNum = 22) then
+ begin
+ Result := TVersion.Create(22, [6, 26, 50, 74, 98],
+ TECBlocks.Create(28, TECB.Create(2, 111),
+ TECB.Create(7, 112)),
+ TECBlocks.Create(28, TECB.Create(17, 46)),
+ TECBlocks.Create(30, TECB.Create(7, 24),
+ TECB.Create(16, 25)),
+ TECBlocks.Create(24, TECB.Create(34, 13)));
+ end else
+ if (VersionNum = 23) then
+ begin
+ Result := TVersion.Create(23, [6, 30, 54, 78, 102],
+ TECBlocks.Create(30, TECB.Create(4, 121),
+ TECB.Create(5, 122)),
+ TECBlocks.Create(28, TECB.Create(4, 47),
+ TECB.Create(14, 48)),
+ TECBlocks.Create(30, TECB.Create(11, 24),
+ TECB.Create(14, 25)),
+ TECBlocks.Create(30, TECB.Create(16, 15),
+ TECB.Create(14, 16)));
+ end else
+ if (VersionNum = 24) then
+ begin
+ Result := TVersion.Create(24, [6, 28, 54, 80, 106],
+ TECBlocks.Create(30, TECB.Create(6, 117),
+ TECB.Create(4, 118)),
+ TECBlocks.Create(28, TECB.Create(6, 45),
+ TECB.Create(14, 46)),
+ TECBlocks.Create(30, TECB.Create(11, 24),
+ TECB.Create(16, 25)),
+ TECBlocks.Create(30, TECB.Create(30, 16),
+ TECB.Create(2, 17)));
+ end else
+ if (VersionNum = 25) then
+ begin
+ Result := TVersion.Create(25, [6, 32, 58, 84, 110],
+ TECBlocks.Create(26, TECB.Create(8, 106),
+ TECB.Create(4, 107)),
+ TECBlocks.Create(28, TECB.Create(8, 47),
+ TECB.Create(13, 48)),
+ TECBlocks.Create(30, TECB.Create(7, 24),
+ TECB.Create(22, 25)),
+ TECBlocks.Create(30, TECB.Create(22, 15),
+ TECB.Create(13, 16)));
+ end else
+ if (VersionNum = 26) then
+ begin
+ Result := TVersion.Create(26, [6, 30, 58, 86, 114],
+ TECBlocks.Create(28, TECB.Create(10, 114),
+ TECB.Create(2, 115)),
+ TECBlocks.Create(28, TECB.Create(19, 46),
+ TECB.Create(4, 47)),
+ TECBlocks.Create(28, TECB.Create(28, 22),
+ TECB.Create(6, 23)),
+ TECBlocks.Create(30, TECB.Create(33, 16),
+ TECB.Create(4, 17)));
+ end else
+ if (VersionNum = 27) then
+ begin
+ Result := TVersion.Create(27, [6, 34, 62, 90, 118],
+ TECBlocks.Create(30, TECB.Create(8, 122),
+ TECB.Create(4, 123)),
+ TECBlocks.Create(28, TECB.Create(22, 45),
+ TECB.Create(3, 46)),
+ TECBlocks.Create(30, TECB.Create(8, 23),
+ TECB.Create(26, 24)),
+ TECBlocks.Create(30, TECB.Create(12, 15),
+ TECB.Create(28, 16)));
+ end else
+ if (VersionNum = 28) then
+ begin
+ Result := TVersion.Create(28, [6, 26, 50, 74, 98, 122],
+ TECBlocks.Create(30, TECB.Create(3, 117),
+ TECB.Create(10, 118)),
+ TECBlocks.Create(28, TECB.Create(3, 45),
+ TECB.Create(23, 46)),
+ TECBlocks.Create(30, TECB.Create(4, 24),
+ TECB.Create(31, 25)),
+ TECBlocks.Create(30, TECB.Create(11, 15),
+ TECB.Create(31, 16)));
+ end else
+ if (VersionNum = 29) then
+ begin
+ Result := TVersion.Create(29, [6, 30, 54, 78, 102, 126],
+ TECBlocks.Create(30, TECB.Create(7, 116),
+ TECB.Create(7, 117)),
+ TECBlocks.Create(28, TECB.Create(21, 45),
+ TECB.Create(7, 46)),
+ TECBlocks.Create(30, TECB.Create(1, 23),
+ TECB.Create(37, 24)),
+ TECBlocks.Create(30, TECB.Create(19, 15),
+ TECB.Create(26, 16)));
+ end else
+ if (VersionNum = 30) then
+ begin
+ Result := TVersion.Create(30, [6, 26, 52, 78, 104, 130],
+ TECBlocks.Create(30, TECB.Create(5, 115),
+ TECB.Create(10, 116)),
+ TECBlocks.Create(28, TECB.Create(19, 47),
+ TECB.Create(10, 48)),
+ TECBlocks.Create(30, TECB.Create(15, 24),
+ TECB.Create(25, 25)),
+ TECBlocks.Create(30, TECB.Create(23, 15),
+ TECB.Create(25, 16)));
+ end else
+ if (VersionNum = 31) then
+ begin
+ Result := TVersion.Create(31, [6, 30, 56, 82, 108, 134],
+ TECBlocks.Create(30, TECB.Create(13, 115),
+ TECB.Create(3, 116)),
+ TECBlocks.Create(28, TECB.Create(2, 46),
+ TECB.Create(29, 47)),
+ TECBlocks.Create(30, TECB.Create(42, 24),
+ TECB.Create(1, 25)),
+ TECBlocks.Create(30, TECB.Create(23, 15),
+ TECB.Create(28, 16)));
+ end else
+ if (VersionNum = 32) then
+ begin
+ Result := TVersion.Create(32, [6, 34, 60, 86, 112, 138],
+ TECBlocks.Create(30, TECB.Create(17, 115)),
+ TECBlocks.Create(28, TECB.Create(10, 46),
+ TECB.Create(23, 47)),
+ TECBlocks.Create(30, TECB.Create(10, 24),
+ TECB.Create(35, 25)),
+ TECBlocks.Create(30, TECB.Create(19, 15),
+ TECB.Create(35, 16)));
+ end else
+ if (VersionNum = 33) then
+ begin
+ Result := TVersion.Create(33, [6, 30, 58, 86, 114, 142],
+ TECBlocks.Create(30, TECB.Create(17, 115),
+ TECB.Create(1, 116)),
+ TECBlocks.Create(28, TECB.Create(14, 46),
+ TECB.Create(21, 47)),
+ TECBlocks.Create(30, TECB.Create(29, 24),
+ TECB.Create(19, 25)),
+ TECBlocks.Create(30, TECB.Create(11, 15),
+ TECB.Create(46, 16)));
+ end else
+ if (VersionNum = 34) then
+ begin
+ Result := TVersion.Create(34, [6, 34, 62, 90, 118, 146],
+ TECBlocks.Create(30, TECB.Create(13, 115),
+ TECB.Create(6, 116)),
+ TECBlocks.Create(28, TECB.Create(14, 46),
+ TECB.Create(23, 47)),
+ TECBlocks.Create(30, TECB.Create(44, 24),
+ TECB.Create(7, 25)),
+ TECBlocks.Create(30, TECB.Create(59, 16),
+ TECB.Create(1, 17)));
+ end else
+ if (VersionNum = 35) then
+ begin
+ Result := TVersion.Create(35, [6, 30, 54, 78, 102, 126, 150],
+ TECBlocks.Create(30, TECB.Create(12, 121),
+ TECB.Create(7, 122)),
+ TECBlocks.Create(28, TECB.Create(12, 47),
+ TECB.Create(26, 48)),
+ TECBlocks.Create(30, TECB.Create(39, 24),
+ TECB.Create(14, 25)),
+ TECBlocks.Create(30, TECB.Create(22, 15),
+ TECB.Create(41, 16)));
+ end else
+ if (VersionNum = 36) then
+ begin
+ Result := TVersion.Create(36, [6, 24, 50, 76, 102, 128, 154],
+ TECBlocks.Create(30, TECB.Create(6, 121),
+ TECB.Create(14, 122)),
+ TECBlocks.Create(28, TECB.Create(6, 47),
+ TECB.Create(34, 48)),
+ TECBlocks.Create(30, TECB.Create(46, 24),
+ TECB.Create(10, 25)),
+ TECBlocks.Create(30, TECB.Create(2, 15),
+ TECB.Create(64, 16)));
+ end else
+ if (VersionNum = 37) then
+ begin
+ Result := TVersion.Create(37, [6, 28, 54, 80, 106, 132, 158],
+ TECBlocks.Create(30, TECB.Create(17, 122),
+ TECB.Create(4, 123)),
+ TECBlocks.Create(28, TECB.Create(29, 46),
+ TECB.Create(14, 47)),
+ TECBlocks.Create(30, TECB.Create(49, 24),
+ TECB.Create(10, 25)),
+ TECBlocks.Create(30, TECB.Create(24, 15),
+ TECB.Create(46, 16)));
+ end else
+ if (VersionNum = 38) then
+ begin
+ Result := TVersion.Create(38, [6, 32, 58, 84, 110, 136, 162],
+ TECBlocks.Create(30, TECB.Create(4, 122),
+ TECB.Create(18, 123)),
+ TECBlocks.Create(28, TECB.Create(13, 46),
+ TECB.Create(32, 47)),
+ TECBlocks.Create(30, TECB.Create(48, 24),
+ TECB.Create(14, 25)),
+ TECBlocks.Create(30, TECB.Create(42, 15),
+ TECB.Create(32, 16)));
+ end else
+ if (VersionNum = 39) then
+ begin
+ Result := TVersion.Create(39, [6, 26, 54, 82, 110, 138, 166],
+ TECBlocks.Create(30, TECB.Create(20, 117),
+ TECB.Create(4, 118)),
+ TECBlocks.Create(28, TECB.Create(40, 47),
+ TECB.Create(7, 48)),
+ TECBlocks.Create(30, TECB.Create(43, 24),
+ TECB.Create(22, 25)),
+ TECBlocks.Create(30, TECB.Create(10, 15),
+ TECB.Create(67, 16)));
+ end else
+ if (VersionNum = 40) then
+ begin
+ Result := TVersion.Create(40, [6, 30, 58, 86, 114, 142, 170],
+ TECBlocks.Create(30, TECB.Create(19, 118),
+ TECB.Create(6, 119)),
+ TECBlocks.Create(28, TECB.Create(18, 47),
+ TECB.Create(31, 48)),
+ TECBlocks.Create(30, TECB.Create(34, 24),
+ TECB.Create(34, 25)),
+ TECBlocks.Create(30, TECB.Create(20, 15),
+ TECB.Create(61, 16)));
+ end else
+ begin
+ Result := nil;
+ end;
+end;
+
+{ TMaskUtil }
+
+// Return the mask bit for "getMaskPattern" at "x" and "y". See 8.8 of JISX0510:2004 for mask
+// pattern conditions.
+function TMaskUtil.GetDataMaskBit(MaskPattern, X, Y: Integer): Boolean;
+var
+ Intermediate: Integer;
+ Temp: Integer;
+begin
+ Intermediate := 0;
+ if ((MaskPattern >= 0) and (MaskPattern < NUM_MASK_PATTERNS)) then
+ begin
+ case (maskPattern) of
+ 0: Intermediate := (Y + X) and 1;
+ 1: Intermediate := Y and 1;
+ 2: Intermediate := X mod 3;
+ 3: Intermediate := (Y + X) mod 3;
+ 4: Intermediate := ((y shr 1) + (X div 3)) and 1;
+ 5:
+ begin
+ Temp := Y * X;
+ Intermediate := (Temp and 1) + (Temp mod 3);
+ end;
+ 6:
+ begin
+ Temp := Y * X;
+ Intermediate := ((Temp and 1) + (Temp mod 3)) and 1;
+ end;
+ 7:
+ begin
+ Temp := Y * X;
+ Intermediate := ((temp mod 3) + ((Y + X) and 1)) and 1;
+ end;
+ end;
+ end;
+ Result := Intermediate = 0;
+end;
+
+{ TECBlocks }
+
+constructor TECBlocks.Create(ECCodewordsPerBlock: Integer; ECBlocks: TECB);
+begin
+ Self.ECCodewordsPerBlock := ECCodewordsPerBlock;
+ SetLength(Self.ECBlocks, 1);
+ Self.ECBlocks[0] := ECBlocks;
+end;
+
+constructor TECBlocks.Create(ECCodewordsPerBlock: Integer; ECBlocks1,
+ ECBlocks2: TECB);
+begin
+ Self.ECCodewordsPerBlock := ECCodewordsPerBlock;
+ SetLength(Self.ECBlocks, 2);
+ ECBlocks[0] := ECBlocks1;
+ ECBlocks[1] := ECBlocks2;
+end;
+
+destructor TECBlocks.Destroy;
+var
+ X: Integer;
+begin
+ for X := 0 to Length(ECBlocks) - 1 do
+ begin
+ ECBlocks[X].Free;
+ end;
+ inherited;
+end;
+
+function TECBlocks.GetECBlocks: TECBArray;
+begin
+ Result := ECBlocks;
+end;
+
+function TECBlocks.GetECCodewordsPerBlock: Integer;
+begin
+ Result := ECCodewordsPerBlock;
+end;
+
+function TECBlocks.GetNumBlocks: Integer;
+var
+ Total: Integer;
+ I: Integer;
+begin
+ Total := 0;
+ for I := 0 to Length(ECBlocks) - 1 do
+ begin
+ Inc(Total, ECBlocks[I].GetCount);
+ end;
+ Result := Total;
+end;
+
+function TECBlocks.GetTotalECCodewords: Integer;
+begin
+ Result := ECCodewordsPerBlock * GetNumBlocks;
+end;
+
+{ TBlockPair }
+
+constructor TBlockPair.Create(BA1, BA2: TByteArray);
+begin
+ FDataBytes := BA1;
+ FErrorCorrectionBytes := BA2;
+end;
+
+function TBlockPair.GetDataBytes: TByteArray;
+begin
+ Result := FDataBytes;
+end;
+
+function TBlockPair.GetErrorCorrectionBytes: TByteArray;
+begin
+ Result := FErrorCorrectionBytes;
+end;
+
+{ TReedSolomonEncoder }
+
+function TReedSolomonEncoder.BuildGenerator(Degree: Integer): TGenericGFPoly;
+var
+ LastGenerator: TGenericGFPoly;
+ NextGenerator: TGenericGFPoly;
+ Poly: TGenericGFPoly;
+ D: Integer;
+ CA: TIntegerArray;
+begin
+ if (Degree >= FCachedGenerators.Count) then
+ begin
+ LastGenerator := TGenericGFPoly(FCachedGenerators[FCachedGenerators.Count - 1]);
+
+ for D := FCachedGenerators.Count to Degree do
+ begin
+ SetLength(CA, 2);
+ CA[0] := 1;
+ CA[1] := FField.Exp(D - 1 + FField.GetGeneratorBase);
+ Poly := TGenericGFPoly.Create(FField, CA);
+ NextGenerator := LastGenerator.Multiply(Poly);
+ FCachedGenerators.Add(NextGenerator);
+ LastGenerator := NextGenerator;
+ end;
+ end;
+ Result := TGenericGFPoly(FCachedGenerators[Degree]);
+end;
+
+constructor TReedSolomonEncoder.Create(AField: TGenericGF);
+var
+ GenericGFPoly: TGenericGFPoly;
+ IntArray: TIntegerArray;
+begin
+ FField := AField;
+
+ // Contents of FCachedGenerators will be freed by FGenericGF.Destroy
+ FCachedGenerators := TObjectList.Create(False);
+
+ SetLength(IntArray, 1);
+ IntArray[0] := 1;
+ GenericGFPoly := TGenericGFPoly.Create(AField, IntArray);
+ FCachedGenerators.Add(GenericGFPoly);
+end;
+
+destructor TReedSolomonEncoder.Destroy;
+begin
+ FCachedGenerators.Free;
+ inherited;
+end;
+
+procedure TReedSolomonEncoder.Encode(ToEncode: TIntegerArray; ECBytes: Integer);
+var
+ DataBytes: Integer;
+ Generator: TGenericGFPoly;
+ InfoCoefficients: TIntegerArray;
+ Info: TGenericGFPoly;
+ Remainder: TGenericGFPoly;
+ Coefficients: TIntegerArray;
+ NumZeroCoefficients: Integer;
+ I: Integer;
+begin
+ SetLength(Coefficients, 0);
+ if (ECBytes > 0) then
+ begin
+ DataBytes := Length(ToEncode) - ECBytes;
+ if (DataBytes > 0) then
+ begin
+ Generator := BuildGenerator(ECBytes);
+ SetLength(InfoCoefficients, DataBytes);
+ InfoCoefficients := Copy(ToEncode, 0, DataBytes);
+ Info := TGenericGFPoly.Create(FField, InfoCoefficients);
+ Info := Info.MultiplyByMonomial(ECBytes, 1);
+ Remainder := Info.Divide(Generator)[1];
+ Coefficients := Remainder.GetCoefficients;
+ NumZeroCoefficients := ECBytes - Length(Coefficients);
+ for I := 0 to NumZeroCoefficients - 1 do
+ begin
+ ToEncode[DataBytes + I] := 0;
+ end;
+ Move(Coefficients[0], ToEncode[DataBytes + NumZeroCoefficients], Length(Coefficients) * SizeOf(Integer));
+ end;
+ end;
+end;
+
+{ TECB }
+
+constructor TECB.Create(Count, DataCodewords: Integer);
+begin
+ Self.Count := Count;
+ Self.DataCodewords := DataCodewords;
+end;
+
+function TECB.GetCount: Integer;
+begin
+ Result := Count;
+end;
+
+function TECB.GetDataCodewords: Integer;
+begin
+ Result := DataCodewords;
+end;
+
+{ TGenericGFPoly }
+
+function TGenericGFPoly.AddOrSubtract(Other: TGenericGFPoly): TGenericGFPoly;
+var
+ SmallerCoefficients: TIntegerArray;
+ LargerCoefficients: TIntegerArray;
+ Temp: TIntegerArray;
+ SumDiff: TIntegerArray;
+ LengthDiff: Integer;
+ I: Integer;
+begin
+ SetLength(SmallerCoefficients, 0);
+ SetLength(LargerCoefficients, 0);
+ SetLength(Temp, 0);
+ SetLength(SumDiff, 0);
+
+ Result := nil;
+ if (Assigned(Other)) then
+ begin
+ if (FField = Other.FField) then
+ begin
+ if (IsZero) then
+ begin
+ Result := Other;
+ Exit;
+ end;
+
+ if (Other.IsZero) then
+ begin
+ Result := Self;
+ Exit;
+ end;
+
+ SmallerCoefficients := FCoefficients;
+ LargerCoefficients := Other.Coefficients;
+ if (Length(SmallerCoefficients) > Length(LargerCoefficients)) then
+ begin
+ Temp := smallerCoefficients;
+ SmallerCoefficients := LargerCoefficients;
+ LargerCoefficients := temp;
+ end;
+ SetLength(SumDiff, Length(LargerCoefficients));
+ LengthDiff := Length(LargerCoefficients) - Length(SmallerCoefficients);
+
+ // Copy high-order terms only found in higher-degree polynomial's coefficients
+ if (LengthDiff > 0) then
+ begin
+ //SumDiff := Copy(LargerCoefficients, 0, LengthDiff);
+ Move(LargerCoefficients[0], SumDiff[0], LengthDiff * SizeOf(Integer));
+ end;
+
+ for I := LengthDiff to Length(LargerCoefficients) - 1 do
+ begin
+ SumDiff[I] := TGenericGF.AddOrSubtract(SmallerCoefficients[I - LengthDiff], LargerCoefficients[I]);
+ end;
+
+ Result := TGenericGFPoly.Create(FField, SumDiff);
+ end;
+ end;
+end;
+
+function TGenericGFPoly.Coefficients: TIntegerArray;
+begin
+ Result := FCoefficients;
+end;
+
+constructor TGenericGFPoly.Create(AField: TGenericGF;
+ ACoefficients: TIntegerArray);
+var
+ CoefficientsLength: Integer;
+ FirstNonZero: Integer;
+begin
+ FField := AField;
+ SetLength(FField.FPolyList, Length(FField.FPolyList) + 1);
+ FField.FPolyList[Length(FField.FPolyList) - 1] := Self;
+ CoefficientsLength := Length(ACoefficients);
+ if ((CoefficientsLength > 1) and (ACoefficients[0] = 0)) then
+ begin
+ // Leading term must be non-zero for anything except the constant polynomial "0"
+ FirstNonZero := 1;
+ while ((FirstNonZero < CoefficientsLength) and (ACoefficients[FirstNonZero] = 0)) do
+ begin
+ Inc(FirstNonZero);
+ end;
+
+ if (FirstNonZero = CoefficientsLength) then
+ begin
+ FCoefficients := AField.GetZero.Coefficients;
+ end else
+ begin
+ SetLength(FCoefficients, CoefficientsLength - FirstNonZero);
+ FCoefficients := Copy(ACoefficients, FirstNonZero, Length(FCoefficients));
+ end;
+ end else
+ begin
+ FCoefficients := ACoefficients;
+ end;
+end;
+
+destructor TGenericGFPoly.Destroy;
+begin
+ Self.FField := FField;
+ inherited;
+end;
+
+function TGenericGFPoly.Divide(Other: TGenericGFPoly): TGenericGFPolyArray;
+var
+ Quotient: TGenericGFPoly;
+ Remainder: TGenericGFPoly;
+ DenominatorLeadingTerm: Integer;
+ InverseDenominatorLeadingTerm: integer;
+ DegreeDifference: Integer;
+ Scale: Integer;
+ Term: TGenericGFPoly;
+ IterationQuotient: TGenericGFPoly;
+begin
+ SetLength(Result, 0);
+ if ((FField = Other.FField) and (not Other.IsZero)) then
+ begin
+
+ Quotient := FField.GetZero;
+ Remainder := Self;
+
+ DenominatorLeadingTerm := Other.GetCoefficient(Other.GetDegree);
+ InverseDenominatorLeadingTerm := FField.Inverse(DenominatorLeadingTerm);
+
+ while ((Remainder.GetDegree >= Other.GetDegree) and (not Remainder.IsZero)) do
+ begin
+ DegreeDifference := Remainder.GetDegree - Other.GetDegree;
+ Scale := FField.Multiply(Remainder.GetCoefficient(Remainder.GetDegree), InverseDenominatorLeadingTerm);
+ Term := Other.MultiplyByMonomial(DegreeDifference, Scale);
+ IterationQuotient := FField.BuildMonomial(degreeDifference, scale);
+ Quotient := Quotient.AddOrSubtract(IterationQuotient);
+ Remainder := Remainder.AddOrSubtract(Term);
+ end;
+
+ SetLength(Result, 2);
+ Result[0] := Quotient;
+ Result[1] := Remainder;
+ end;
+end;
+
+function TGenericGFPoly.GetCoefficient(Degree: Integer): Integer;
+begin
+ Result := FCoefficients[Length(FCoefficients) - 1 - Degree];
+end;
+
+function TGenericGFPoly.GetCoefficients: TIntegerArray;
+begin
+ Result := FCoefficients;
+end;
+
+function TGenericGFPoly.GetDegree: Integer;
+begin
+ Result := Length(FCoefficients) - 1;
+end;
+
+function TGenericGFPoly.IsZero: Boolean;
+begin
+ Result := FCoefficients[0] = 0;
+end;
+
+function TGenericGFPoly.Multiply(Other: TGenericGFPoly): TGenericGFPoly;
+var
+ ACoefficients: TIntegerArray;
+ BCoefficients: TIntegerArray;
+ Product: TIntegerArray;
+ ALength: Integer;
+ BLength: Integer;
+ I: Integer;
+ J: Integer;
+ ACoeff: Integer;
+begin
+ SetLength(ACoefficients, 0);
+ SetLength(BCoefficients, 0);
+ Result := nil;
+
+ if (FField = Other.FField) then
+ begin
+ if (IsZero or Other.IsZero) then
+ begin
+ Result := FField.GetZero;
+ Exit;
+ end;
+
+ ACoefficients := FCoefficients;
+ ALength := Length(ACoefficients);
+ BCoefficients := Other.Coefficients;
+ BLength := Length(BCoefficients);
+ SetLength(Product, aLength + bLength - 1);
+ for I := 0 to ALength - 1 do
+ begin
+ ACoeff := ACoefficients[I];
+ for J := 0 to BLength - 1 do
+ begin
+ Product[I + J] := TGenericGF.AddOrSubtract(Product[I + J],
+ FField.Multiply(ACoeff, BCoefficients[J]));
+ end;
+ end;
+ Result := TGenericGFPoly.Create(FField, Product);
+ end;
+end;
+
+function TGenericGFPoly.MultiplyByMonomial(Degree,
+ Coefficient: Integer): TGenericGFPoly;
+var
+ I: Integer;
+ Size: Integer;
+ Product: TIntegerArray;
+begin
+ Result := nil;
+ if (Degree >= 0) then
+ begin
+ if (Coefficient = 0) then
+ begin
+ Result := FField.GetZero;
+ Exit;
+ end;
+ Size := Length(Coefficients);
+ SetLength(Product, Size + Degree);
+ for I := 0 to Size - 1 do
+ begin
+ Product[I] := FField.Multiply(FCoefficients[I], Coefficient);
+ end;
+ Result := TGenericGFPoly.Create(FField, Product);
+ end;
+end;
+
+{ TGenericGF }
+
+class function TGenericGF.AddOrSubtract(A, B: Integer): Integer;
+begin
+ Result := A xor B;
+end;
+
+function TGenericGF.BuildMonomial(Degree, Coefficient: Integer): TGenericGFPoly;
+var
+ Coefficients: TIntegerArray;
+begin
+ CheckInit();
+
+ if (Degree >= 0) then
+ begin
+ if (Coefficient = 0) then
+ begin
+ Result := FZero;
+ Exit;
+ end;
+ SetLength(Coefficients, Degree + 1);
+ Coefficients[0] := Coefficient;
+ Result := TGenericGFPoly.Create(Self, Coefficients);
+ end else
+ begin
+ Result := nil;
+ end;
+end;
+
+procedure TGenericGF.CheckInit;
+begin
+ if (not FInitialized) then
+ begin
+ Initialize;
+ end;
+end;
+
+constructor TGenericGF.Create(Primitive, Size, B: Integer);
+begin
+ FInitialized := False;
+ FPrimitive := Primitive;
+ FSize := Size;
+ FGeneratorBase := B;
+ if (FSize < 0) then
+ begin
+ Initialize;
+ end;
+end;
+
+class function TGenericGF.CreateQRCodeField256: TGenericGF;
+begin
+ Result := TGenericGF.Create($011D, 256, 0);
+end;
+
+destructor TGenericGF.Destroy;
+var
+ X: Integer;
+ Y: Integer;
+begin
+ for X := 0 to Length(FPolyList) - 1 do
+ begin
+ if (Assigned(FPolyList[X])) then
+ begin
+ for Y := X + 1 to Length(FPolyList) - 1 do
+ begin
+ if (FPolyList[Y] = FPolyList[X]) then
+ begin
+ FPolyList[Y] := nil;
+ end;
+ end;
+ FPolyList[X].Free;
+ end;
+ end;
+ inherited;
+end;
+
+function TGenericGF.Exp(A: Integer): Integer;
+begin
+ CheckInit;
+ Result := FExpTable[A];
+end;
+
+function TGenericGF.GetGeneratorBase: Integer;
+begin
+ Result := FGeneratorBase;
+end;
+
+function TGenericGF.GetZero: TGenericGFPoly;
+begin
+ CheckInit;
+ Result := FZero;
+end;
+
+procedure TGenericGF.Initialize;
+var
+ X: Integer;
+ I: Integer;
+ CA: TIntegerArray;
+begin
+ SetLength(FExpTable, FSize);
+ SetLength(FLogTable, FSize);
+ X := 1;
+ for I := 0 to FSize - 1 do
+ begin
+ FExpTable[I] := x;
+ X := X shl 1; // x = x * 2; we're assuming the generator alpha is 2
+ if (X >= FSize) then
+ begin
+ X := X xor FPrimitive;
+ X := X and (FSize - 1);
+ end;
+ end;
+
+ for I := 0 to FSize - 2 do
+ begin
+ FLogTable[FExpTable[I]] := I;
+ end;
+
+ // logTable[0] == 0 but this should never be used
+
+ SetLength(CA, 1);
+ CA[0] := 0;
+ FZero := TGenericGFPoly.Create(Self, CA);
+
+ SetLength(CA, 1);
+ CA[0] := 1;
+ FOne := TGenericGFPoly.Create(Self, CA);
+
+ FInitialized := True;
+end;
+
+function TGenericGF.Inverse(A: Integer): Integer;
+begin
+ CheckInit;
+
+ if (a <> 0) then
+ begin
+ Result := FExpTable[FSize - FLogTable[A] - 1];
+ end else
+ begin
+ Result := 0;
+ end;
+end;
+
+function TGenericGF.Multiply(A, B: Integer): Integer;
+begin
+ CheckInit;
+ if ((A <> 0) and (B <> 0)) then
+ begin
+ Result := FExpTable[(FLogTable[A] + FLogTable[B]) mod (FSize - 1)];
+ end else
+ begin
+ Result := 0;
+ end;
+end;
+
+function GenerateQRCode(const Input: WideString; EncodeOptions: Integer; Level: TErrorCorrectionLevel; aCodePage: Longint): T2DBooleanArray;
+var
+ Encoder: TEncoder;
+ //Level: TErrorCorrectionLevel;
+ QRCode: TQRCode;
+ X: Integer;
+ Y: Integer;
+begin
+ //Level := TErrorCorrectionLevel.Create;
+ //Level.FBits := 1;
+ Encoder := TEncoder.Create;
+ Encoder.Codepage := aCodePage;
+ QRCode := TQRCode.Create;
+ try
+ Encoder.Encode(Input, EncodeOptions, Level, QRCode);
+ if (Assigned(QRCode.FMatrix)) then
+ begin
+ SetLength(Result, QRCode.FMatrix.FHeight);
+ for Y := 0 to QRCode.FMatrix.FHeight - 1 do
+ begin
+ SetLength(Result[Y], QRCode.FMatrix.FWidth);
+ for X := 0 to QRCode.FMatrix.FWidth - 1 do
+ begin
+ Result[Y][X] := QRCode.FMatrix.Get(Y, X) = 1;
+ end;
+ end;
+ end;
+ finally
+ QRCode.Free;
+ Encoder.Free;
+ //Level.Free;
+ end;
+end;
+
+{ TDelphiZXingQRCode }
+
+constructor TDelphiZXingQRCode.Create;
+begin
+ FData := '';
+ FEncoding := qrAuto;
+ FQuietZone := 4;
+ FRows := 0;
+ FColumns := 0;
+ FErrorLevels := ecL;
+ FCodePage := 0;
+ FLevel := TErrorCorrectionLevel.Create;
+end;
+
+destructor TDelphiZXingQRCode.Destroy;
+begin
+ FLevel.Free;
+end;
+
+function TDelphiZXingQRCode.GetIsBlack(Row, Column: Integer): Boolean;
+begin
+ Dec(Row, FQuietZone);
+ Dec(Column, FQuietZone);
+ if ((Row >= 0) and (Column >= 0) and (Row < (FRows - FQuietZone * 2)) and (Column < (FColumns - FQuietZone * 2))) then
+ begin
+ Result := FElements[Column, Row];
+ end else
+ begin
+ Result := False;
+ end;
+end;
+
+procedure TDelphiZXingQRCode.SetCodePage(const Value: Longint);
+begin
+ if (FCodePage <> Value) then
+ begin
+ FCodePage := Value;
+ Update;
+ end;
+end;
+
+procedure TDelphiZXingQRCode.SetData(const NewData: WideString);
+begin
+ if (FData <> NewData) then
+ begin
+ FData := NewData;
+ Update;
+ end;
+end;
+
+procedure TDelphiZXingQRCode.SetEncoding(NewEncoding: TQRCodeEncoding);
+begin
+ if (FEncoding <> NewEncoding) then
+ begin
+ FEncoding := NewEncoding;
+ Update;
+ end;
+end;
+
+procedure TDelphiZXingQRCode.SetErrorLevels(const Value: TQRErrorLevels);
+begin
+ FErrorLevels := Value;
+ Update;
+end;
+
+procedure TDelphiZXingQRCode.SetQuietZone(NewQuietZone: Integer);
+begin
+ if ((FQuietZone <> NewQuietZone) and (NewQuietZone >= 0) and (NewQuietZone <= 100)) then
+ begin
+ FQuietZone := NewQuietZone;
+ Update;
+ end;
+end;
+
+procedure TDelphiZXingQRCode.Update;
+begin
+ FLevel.FBits := QRErrorLevelsBits[Ord(FErrorLevels)];
+ FLevel.Ordinal := Ord(FErrorLevels);
+ FElements := GenerateQRCode(FData, Ord(FEncoding), FLevel, FCodePage);
+ FRows := Length(FElements) + FQuietZone * 2;
+ FColumns := FRows;
+end;
+
+end.
diff --git a/LibD28x64/FMX.ExportTTFFont.pas b/LibD28x64/FMX.ExportTTFFont.pas
new file mode 100644
index 0000000..5fd4a8c
--- /dev/null
+++ b/LibD28x64/FMX.ExportTTFFont.pas
@@ -0,0 +1,803 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Font parser }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Aleksey Mandrykin, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.ExportTTFFont;
+
+strict private ExportTTFFont = class (IDisposable)
+ // Methods
+ public constructor Create(font: Font);
+ [DllImport('Gdi32.dll')]
+ strict private class extern function DeleteObject(hgdiobj: IntPtr): IntPtr; static;
+ public procedure Dispose;
+ public procedure FillOutlineTextMetrix;
+ public function GetEnglishFontName: string;
+ public function GetFontData: Byte[];
+ [DllImport('Gdi32.dll', CharSet=CharSet.Auto)]
+ strict private class extern function GetFontData(hdc: IntPtr; dwTable: Cardinal; dwOffset: Cardinal; [In, Out] lpvBuffer: Byte[]; cbData: Cardinal): Cardinal; static;
+ [DllImport('Gdi32.dll', CharSet=CharSet.Auto)]
+ strict private class extern function GetFontData(hdc: IntPtr; dwTable: Cardinal; dwOffset: Cardinal; [In, Out] lpvBuffer: IntPtr; cbData: Cardinal): Cardinal; static;
+ [DllImport('Gdi32.dll', CharSet=CharSet.Auto)]
+ strict private class extern function GetGlyphIndices(hdc: IntPtr; lpstr: string; c: Integer; [In, Out] pgi: Word[]; fl: Cardinal): Cardinal; static;
+ strict private function GetGlyphIndices(hdc: IntPtr; text: string; glyphs: Word[]; widths: Integer[]; rtl: boolean): Integer;
+ strict private function GetGlyphs(hdc: IntPtr; run: Run; glyphs: Word[]; widths: Integer[]; maxGlyphs: Integer; rtl: boolean): Integer;
+ public function GetGlyphWidth(c: Char): Integer;
+ [DllImport('Gdi32.dll')]
+ strict private class extern function GetOutlineTextMetrics(hdc: IntPtr; cbData: Integer; var lpOTM: OutlineTextMetric): Integer; static;
+ public function GetPANOSE: string;
+ strict private function Itemize(s: string; rtl: boolean; maxItems: Integer): List;
+ strict private function Layout(runs: List; rtl: boolean): List;
+ public function RemapString(str: string; rtl: boolean): string;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptApplyDigitSubstitution(var psds: SCRIPT_DIGITSUBSTITUTE; var psc: SCRIPT_CONTROL; var pss: SCRIPT_STATE): Integer; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptFreeCache(var psc: IntPtr): Integer; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptItemize([MarshalAs(UnmanagedType.LPWStr)] pwcInChars: string; cInChars: Integer; cMaxItems: Integer; var psControl: SCRIPT_CONTROL; var psState: SCRIPT_STATE; [In, Out] pItems: SCRIPT_ITEM[]; var pcItems: Integer): Integer; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptLayout(cRuns: Integer; [MarshalAs(UnmanagedType.LPArray)] pbLevel: Byte[]; [MarshalAs(UnmanagedType.LPArray)] piVisualToLogical: Integer[]; [MarshalAs(UnmanagedType.LPArray)] piLogicalToVisual: Integer[]): Integer; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptPlace(hdc: IntPtr; var psc: IntPtr; [MarshalAs(UnmanagedType.LPArray)] pwGlyphs: Word[]; cGlyphs: Integer; [MarshalAs(UnmanagedType.LPArray)] psva: SCRIPT_VISATTR[]; var psa: SCRIPT_ANALYSIS; [MarshalAs(UnmanagedType.LPArray)] piAdvance: Integer[]; [Out, MarshalAs(UnmanagedType.LPArray)] pGoffset: GOFFSET[]; var pABC: ABC): Integer; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptRecordDigitSubstitution(lcid: Cardinal; var psds: SCRIPT_DIGITSUBSTITUTE): Cardinal; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptShape(hdc: IntPtr; var psc: IntPtr; [MarshalAs(UnmanagedType.LPWStr)] pwcChars: string; cChars: Integer; cMaxGlyphs: Integer; var psa: SCRIPT_ANALYSIS; [Out, MarshalAs(UnmanagedType.LPArray)] pwOutGlyphs: Word[]; [Out, MarshalAs(UnmanagedType.LPArray)] pwLogClust: Word[]; [Out, MarshalAs(UnmanagedType.LPArray)] psva: SCRIPT_VISATTR[]; var pcGlyphs: Integer): Integer; static;
+ [DllImport('Gdi32.dll')]
+ strict private class extern function SelectObject(hdc: IntPtr; hgdiobj: IntPtr): IntPtr; static;
+
+ // Properties
+ public property Name: string read get_Name write set_Name;
+ public property Reference: Int64 read get_Reference write set_Reference;
+ public property Saved: boolean read get_Saved write set_Saved;
+ public property SourceFont: Font read get_SourceFont;
+ public property TextMetric: OutlineTextMetric read get_TextMetric;
+ public property UsedAlphabetUnicode: List read get_UsedAlphabetUnicode;
+ public property UsedGlyphIndexes: List read get_UsedGlyphIndexes;
+ public property Widths: List read get_Widths;
+
+ // Fields
+ strict private FDigitSubstitute: SCRIPT_DIGITSUBSTITUTE;
+ strict private FDpiFX: Single;
+ strict private FName: string;
+ strict private FReference: Int64;
+ strict private FSaved: boolean;
+ strict private FSourceFont: Font;
+ strict private FTextMetric: OutlineTextMetric;
+ strict private FUSCache: IntPtr;
+ strict private FUsedAlphabetUnicode: List;
+ strict private FUsedGlyphIndexes: List;
+ strict private FWidths: List;
+ strict private tempBitmap: Bitmap;
+
+ type // Nested Types
+ [StructLayout(LayoutKind.Sequential)]
+ public ABC = record
+ // Fields
+ public abcA: Integer;
+ public abcB: Integer;
+ public abcC: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public FontPanose = record
+ // Fields
+ public ArmStyle: Byte;
+ public bContrast: Byte;
+ public bFamilyType: Byte;
+ public bLetterform: Byte;
+ public bMidline: Byte;
+ public bProportion: Byte;
+ public bSerifStyle: Byte;
+ public bStrokeVariation: Byte;
+ public bWeight: Byte;
+ public bXHeight: Byte;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public FontPoint = record
+ // Fields
+ public x: Integer;
+ public y: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public FontRect = record
+ // Fields
+ public bottom: Integer;
+ public left: Integer;
+ public right: Integer;
+ public top: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public FontTextMetric = record
+ // Fields
+ public tmAscent: Integer;
+ public tmAveCharWidth: Integer;
+ public tmBreakChar: Char;
+ public tmCharSet: Byte;
+ public tmDefaultChar: Char;
+ public tmDescent: Integer;
+ public tmDigitizedAspectX: Integer;
+ public tmDigitizedAspectY: Integer;
+ public tmExternalLeading: Integer;
+ public tmFirstChar: Char;
+ public tmHeight: Integer;
+ public tmInternalLeading: Integer;
+ public tmItalic: Byte;
+ public tmLastChar: Char;
+ public tmMaxCharWidth: Integer;
+ public tmOverhang: Integer;
+ public tmPitchAndFamily: Byte;
+ public tmStruckOut: Byte;
+ public tmUnderlined: Byte;
+ public tmWeight: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public GOFFSET = record
+ // Fields
+ public du: Integer;
+ public dv: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public OutlineTextMetric = record
+ // Fields
+ public otmAscent: Integer;
+ public otmDescent: Integer;
+ public otmEMSquare: Cardinal;
+ public otmFiller: Byte;
+ public otmfsSelection: Cardinal;
+ public otmfsType: Cardinal;
+ public otmItalicAngle: Integer;
+ public otmLineGap: Cardinal;
+ public otmMacAscent: Integer;
+ public otmMacDescent: Integer;
+ public otmMacLineGap: Cardinal;
+ public otmPanoseNumber: FontPanose;
+ public otmpFaceName: string;
+ public otmpFamilyName: string;
+ public otmpFullName: string;
+ public otmpStyleName: string;
+ public otmptSubscriptOffset: FontPoint;
+ public otmptSubscriptSize: FontPoint;
+ public otmptSuperscriptOffset: FontPoint;
+ public otmptSuperscriptSize: FontPoint;
+ public otmrcFontBox: FontRect;
+ public otmsCapEmHeight: Cardinal;
+ public otmsCharSlopeRise: Integer;
+ public otmsCharSlopeRun: Integer;
+ public otmSize: Cardinal;
+ public otmsStrikeoutPosition: Integer;
+ public otmsStrikeoutSize: Cardinal;
+ public otmsUnderscorePosition: Integer;
+ public otmsUnderscoreSize: Integer;
+ public otmsXHeight: Cardinal;
+ public otmTextMetrics: FontTextMetric;
+ public otmusMinimumPPEM: Cardinal;
+
+ end;
+
+ strict private Run = class
+ // Methods
+ public constructor Create(text: string; a: SCRIPT_ANALYSIS);
+
+ // Fields
+ public analysis: SCRIPT_ANALYSIS;
+ public text: string;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_ANALYSIS = record
+ // Fields
+ public data: Smallint;
+ public state: SCRIPT_STATE;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_CONTROL = record
+ // Fields
+ public data: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_DIGITSUBSTITUTE = record
+ // Fields
+ public DigitSubstitute: Byte;
+ public dwReserved: Integer;
+ public NationalDigitLanguage: Smallint;
+ public TraditionalDigitLanguage: Smallint;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_ITEM = record
+ // Fields
+ public analysis: SCRIPT_ANALYSIS;
+ public iCharPos: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_STATE = record
+ // Methods
+ public procedure SetRtl;
+
+ // Properties
+ public property uBidiLevel: Integer read get_uBidiLevel;
+
+ // Fields
+ public data: Smallint;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_VISATTR = record
+ // Fields
+ public data: Smallint;
+
+ end;
+
+
+end;
+
+
+// Methods
+ constructor ExportTTFFont.Create(font: Font);
+ begin
+ self.FSourceFont := Font.Create(font.Name, (750 * self.FDpiFX), font.Style);
+ self.FSaved := false;
+ self.FTextMetric := OutlineTextMetric.Create;
+ self.FUsedGlyphIndexes := List.Create;
+ self.FUsedAlphabetUnicode := List.Create;
+ self.FWidths := List.Create;
+ self.tempBitmap := Bitmap.Create(1, 1);
+ self.FUSCache := IntPtr.Zero;
+ self.FDigitSubstitute := SCRIPT_DIGITSUBSTITUTE.Create;
+ ExportTTFFont.ScriptRecordDigitSubstitution($400, @(self.FDigitSubstitute))
+ end;
+
+ [DllImport('Gdi32.dll')]
+ strict private class extern function DeleteObject(hgdiobj: IntPtr): IntPtr; static;
+ procedure ExportTTFFont.Dispose;
+ begin
+ ExportTTFFont.ScriptFreeCache(@(self.FUSCache));
+ self.tempBitmap.Dispose;
+ self.FSourceFont.Dispose
+ end;
+
+ procedure ExportTTFFont.FillOutlineTextMetrix;
+ var
+ g: Graphics;
+ begin
+ if (self.FSourceFont <> nil) then
+ {using g}
+ begin
+ g := Graphics.FromImage(self.tempBitmap);
+ try
+ hdc := g.GetHdc;
+ f := self.FSourceFont.ToHfont;
+ try
+ ExportTTFFont.SelectObject(hdc, f);
+ ExportTTFFont.GetOutlineTextMetrics(hdc, Marshal.SizeOf(typeof(OutlineTextMetric)), @(self.FTextMetric))
+ finally
+ ExportTTFFont.DeleteObject(f);
+ g.ReleaseHdc(hdc)
+ end
+ finally
+ g.Dispose
+ end
+ end
+ end;
+
+ function ExportTTFFont.GetEnglishFontName: string;
+ var
+ c: Char;
+ begin
+ fontName := self.FSourceFont.FontFamily.GetName($409);
+ Result := StringBuilder.Create((fontName.Length * 3));
+
+ for c in fontName do
+ begin
+ case c of
+ '#':
+ '%':
+ '(':
+ ')':
+ '/':
+ ' ':
+ '<':
+ '>':
+ '[':
+ ']':
+ '{':
+ '}':
+ begin
+ Result.Append('#');
+ Result.Append((c as Integer).ToString('X2'));
+ break;
+
+ end;
+ default:begin
+ if ((c > '~') or (c < ' ')) then
+ begin
+ Result.Append('#');
+ Result.Append((c as Integer).ToString('X2'))
+ end
+ else
+ Result.Append(c);
+ break;
+
+ end;
+ end
+ end;
+ Style := StringBuilder.Create(9);
+ if ((self.FSourceFont.Style and FontStyle.Bold) > FontStyle.Regular) then
+ Style.Append('Bold');
+ if ((self.FSourceFont.Style and FontStyle.Italic) > FontStyle.Regular) then
+ Style.Append('Italic');
+ if (Style.Length > 0) then
+ Result.Append(',').Append(Style.ToString);
+ begin
+ Result := Result.ToString;
+ exit
+ end
+ end;
+
+ function ExportTTFFont.GetFontData: Byte[];
+ var
+ font_collection: TrueTypeCollection;
+ begin
+ result := nil;
+ if (self.FSourceFont = nil) then
+ begin
+ Result := result;
+ exit
+ end;
+ {using font_collection}
+ begin
+ font_collection := TrueTypeCollection.Create(self.FSourceFont);
+ try
+ skip_list := New(array[5] of TablesID, ( ( TablesID.HorizontakDeviceMetrix, TablesID.DigitalSignature, TablesID.GlyphPosition, TablesID.EmbedBitmapLocation, TablesID.EmbededBitmapData ) ));
+
+ for f in font_collection.FontCollection do
+ begin
+ f.PrepareFont(skip_list)
+ end;
+ font := font_collection.Item[self.FSourceFont];
+
+ for ch in self.FUsedGlyphIndexes do
+ begin
+ font.AddCharacterToKeepList(ch)
+ end;
+ begin
+ Result := font.PackFont(FontType.TrueTypeFont, true);
+ exit
+ end
+ finally
+ font_collection.Dispose
+ end
+ end
+ end;
+
+ [DllImport('Gdi32.dll', CharSet=CharSet.Auto)]
+ strict private class extern function GetFontData(hdc: IntPtr; dwTable: Cardinal; dwOffset: Cardinal; [In, Out] lpvBuffer: Byte[]; cbData: Cardinal): Cardinal; static;
+ [DllImport('Gdi32.dll', CharSet=CharSet.Auto)]
+ strict private class extern function GetFontData(hdc: IntPtr; dwTable: Cardinal; dwOffset: Cardinal; [In, Out] lpvBuffer: IntPtr; cbData: Cardinal): Cardinal; static;
+ [DllImport('Gdi32.dll', CharSet=CharSet.Auto)]
+ strict private class extern function GetGlyphIndices(hdc: IntPtr; lpstr: string; c: Integer; [In, Out] pgi: Word[]; fl: Cardinal): Cardinal; static;
+ function ExportTTFFont.GetGlyphIndices(hdc: IntPtr; text: string; glyphs: Word[]; widths: Integer[]; rtl: boolean): Integer;
+ var
+ run: Run;
+ begin
+ if (string.IsNullOrEmpty(text)) then
+ begin
+ Result := 0;
+ exit
+ end;
+ destIndex := 0;
+ maxGlyphs := (text.Length * 3);
+ maxItems := (text.Length * 2);
+ runs := self.Itemize(text, rtl, maxItems);
+ runs := self.Layout(runs, rtl);
+
+ for run in runs do
+ begin
+ tempGlyphs := New(array[maxGlyphs] of Word);
+ tempWidths := New(array[maxGlyphs] of Integer);
+ length := self.GetGlyphs(hdc, run, tempGlyphs, tempWidths, maxGlyphs, rtl);
+ Array.Copy(tempGlyphs, 0, glyphs, destIndex, length);
+ Array.Copy(tempWidths, 0, widths, destIndex, length);
+ inc(destIndex, length)
+ end;
+ begin
+ Result := destIndex;
+ exit
+ end
+ end;
+
+ function ExportTTFFont.GetGlyphs(hdc: IntPtr; run: Run; glyphs: Word[]; widths: Integer[]; maxGlyphs: Integer; rtl: boolean): Integer;
+ begin
+ psa := run.analysis;
+ pwLogClust := New(array[maxGlyphs] of Word);
+ pcGlyphs := 0;
+ psva := New(array[maxGlyphs] of SCRIPT_VISATTR);
+ pGoffset := New(array[maxGlyphs] of GOFFSET);
+ pABC := ABC.Create;
+ ExportTTFFont.ScriptShape(hdc, @(self.FUSCache), run.text, run.text.Length, glyphs.Length, @(psa), glyphs, pwLogClust, psva, @(pcGlyphs));
+ ExportTTFFont.ScriptPlace(hdc, @(self.FUSCache), glyphs, pcGlyphs, psva, @(psa), widths, pGoffset, @(pABC));
+ Result := pcGlyphs
+ end;
+
+ function ExportTTFFont.GetGlyphWidth(c: Char): Integer;
+ begin
+ Result := self.FWidths.Item[self.FUsedGlyphIndexes.IndexOf(c)]
+ end;
+
+ [DllImport('Gdi32.dll')]
+ strict private class extern function GetOutlineTextMetrics(hdc: IntPtr; cbData: Integer; var lpOTM: OutlineTextMetric): Integer; static;
+ function ExportTTFFont.GetPANOSE: string;
+ begin
+ panose := StringBuilder.Create($24);
+ panose.Append('01 05 ');
+ panose.Append(self.FTextMetric.otmPanoseNumber.bFamilyType.ToString('X')).Append(' ');
+ panose.Append(self.FTextMetric.otmPanoseNumber.bSerifStyle.ToString('X')).Append(' ');
+ panose.Append(self.FTextMetric.otmPanoseNumber.bWeight.ToString('X')).Append(' ');
+ panose.Append(self.FTextMetric.otmPanoseNumber.bProportion.ToString('X')).Append(' ');
+ panose.Append(self.FTextMetric.otmPanoseNumber.bContrast.ToString('X')).Append(' ');
+ panose.Append(self.FTextMetric.otmPanoseNumber.bStrokeVariation.ToString('X')).Append(' ');
+ panose.Append(self.FTextMetric.otmPanoseNumber.ArmStyle.ToString('X')).Append(' ');
+ panose.Append(self.FTextMetric.otmPanoseNumber.bLetterform.ToString('X')).Append(' ');
+ panose.Append(self.FTextMetric.otmPanoseNumber.bMidline.ToString('X')).Append(' ');
+ panose.Append(self.FTextMetric.otmPanoseNumber.bXHeight.ToString('X'));
+ Result := panose.ToString
+ end;
+
+ function ExportTTFFont.Itemize(s: string; rtl: boolean; maxItems: Integer): List;
+ begin
+ pItems := New(array[maxItems] of SCRIPT_ITEM);
+ pcItems := 0;
+ control := SCRIPT_CONTROL.Create;
+ state := SCRIPT_STATE.Create;
+ if (rtl) then
+ begin
+ state.SetRtl;
+ ExportTTFFont.ScriptApplyDigitSubstitution(@(self.FDigitSubstitute), @(control), @(state))
+ end;
+ ExportTTFFont.ScriptItemize(s, s.Length, pItems.Length, @(control), @(state), pItems, @(pcItems));
+ list := List.Create;
+ i := 0;
+ while ((i < pcItems)) do
+ begin
+ text := s.Substring(pItems[i].iCharPos, (pItems[(i + 1)].iCharPos - pItems[i].iCharPos));
+ list.Add(Run.Create(text, pItems[i].analysis));
+ inc(i)
+ end;
+ begin
+ Result := list;
+ exit
+ end
+ end;
+
+ function ExportTTFFont.Layout(runs: List; rtl: boolean): List;
+ var
+ i: Integer;
+ begin
+ pbLevel := New(array[runs.Count] of Byte);
+ piVisualToLogical := New(array[runs.Count] of Integer);
+ i := 0;
+ while ((i < runs.Count)) do
+ begin
+ pbLevel[i] := (runs.Item[i].analysis.state.uBidiLevel as Byte);
+ inc(i)
+ end;
+ ExportTTFFont.ScriptLayout(runs.Count, pbLevel, piVisualToLogical, nil);
+ visualRuns := List.Create;
+ i := 0;
+ while ((i < piVisualToLogical.Length)) do
+ begin
+ visualRuns.Add(runs.Item[piVisualToLogical[i]]);
+ inc(i)
+ end;
+ begin
+ Result := visualRuns;
+ exit
+ end
+ end;
+
+ function ExportTTFFont.RemapString(str: string; rtl: boolean): string;
+ var
+ g: Graphics;
+ begin
+ str := str.Replace('#13', '').Replace('#10', '');
+ maxGlyphs := (str.Length * 3);
+ glyphs := New(array[maxGlyphs] of Word);
+ widths := New(array[maxGlyphs] of Integer);
+ actualLength := 0;
+ {using g}
+ begin
+ g := Graphics.FromImage(self.tempBitmap);
+ try
+ hdc := g.GetHdc;
+ f := self.FSourceFont.ToHfont;
+ try
+ ExportTTFFont.SelectObject(hdc, f);
+ actualLength := self.GetGlyphIndices(hdc, str, glyphs, widths, rtl)
+ finally
+ ExportTTFFont.DeleteObject(f);
+ g.ReleaseHdc(hdc)
+ end
+ finally
+ g.Dispose
+ end
+ endsb := StringBuilder.Create(actualLength);
+ i := 0;
+ while ((i < actualLength)) do
+ begin
+ c := glyphs[i];
+ if (self.FUsedGlyphIndexes.IndexOf(c) = -1) then
+ begin
+ self.FUsedGlyphIndexes.Add(c);
+ self.FWidths.Add(widths[i]);
+ if (actualLength > str.Length) then
+ self.FUsedAlphabetUnicode.Add(self.FTextMetric.otmTextMetrics.tmDefaultChar)
+ else
+ self.FUsedAlphabetUnicode.Add(str.Chars[ {pseudo} (if rtl then ((actualLength - i) - 1) else i)])
+ end;
+ sb.Append((c as Char));
+ inc(i)
+ end;
+ begin
+ Result := sb.ToString;
+ exit
+ end
+ end;
+
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptApplyDigitSubstitution(var psds: SCRIPT_DIGITSUBSTITUTE; var psc: SCRIPT_CONTROL; var pss: SCRIPT_STATE): Integer; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptFreeCache(var psc: IntPtr): Integer; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptItemize([MarshalAs(UnmanagedType.LPWStr)] pwcInChars: string; cInChars: Integer; cMaxItems: Integer; var psControl: SCRIPT_CONTROL; var psState: SCRIPT_STATE; [In, Out] pItems: SCRIPT_ITEM[]; var pcItems: Integer): Integer; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptLayout(cRuns: Integer; [MarshalAs(UnmanagedType.LPArray)] pbLevel: Byte[]; [MarshalAs(UnmanagedType.LPArray)] piVisualToLogical: Integer[]; [MarshalAs(UnmanagedType.LPArray)] piLogicalToVisual: Integer[]): Integer; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptPlace(hdc: IntPtr; var psc: IntPtr; [MarshalAs(UnmanagedType.LPArray)] pwGlyphs: Word[]; cGlyphs: Integer; [MarshalAs(UnmanagedType.LPArray)] psva: SCRIPT_VISATTR[]; var psa: SCRIPT_ANALYSIS; [MarshalAs(UnmanagedType.LPArray)] piAdvance: Integer[]; [Out, MarshalAs(UnmanagedType.LPArray)] pGoffset: GOFFSET[]; var pABC: ABC): Integer; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptRecordDigitSubstitution(lcid: Cardinal; var psds: SCRIPT_DIGITSUBSTITUTE): Cardinal; static;
+ [DllImport('usp10.dll')]
+ strict private class extern function ScriptShape(hdc: IntPtr; var psc: IntPtr; [MarshalAs(UnmanagedType.LPWStr)] pwcChars: string; cChars: Integer; cMaxGlyphs: Integer; var psa: SCRIPT_ANALYSIS; [Out, MarshalAs(UnmanagedType.LPArray)] pwOutGlyphs: Word[]; [Out, MarshalAs(UnmanagedType.LPArray)] pwLogClust: Word[]; [Out, MarshalAs(UnmanagedType.LPArray)] psva: SCRIPT_VISATTR[]; var pcGlyphs: Integer): Integer; static;
+ [DllImport('Gdi32.dll')]
+ strict private class extern function SelectObject(hdc: IntPtr; hgdiobj: IntPtr): IntPtr; static;
+
+ // Properties
+ public property Name: string read get_Name write set_Name;
+ public property Reference: Int64 read get_Reference write set_Reference;
+ public property Saved: boolean read get_Saved write set_Saved;
+ public property SourceFont: Font read get_SourceFont;
+ public property TextMetric: OutlineTextMetric read get_TextMetric;
+ public property UsedAlphabetUnicode: List read get_UsedAlphabetUnicode;
+ public property UsedGlyphIndexes: List read get_UsedGlyphIndexes;
+ public property Widths: List read get_Widths;
+
+ // Fields
+ strict private FDigitSubstitute: SCRIPT_DIGITSUBSTITUTE;
+ strict private FDpiFX: Single = (96 div (DrawUtils.ScreenDpi as Single));
+ strict private FName: string;
+ strict private FReference: Int64;
+ strict private FSaved: boolean;
+ strict private FSourceFont: Font;
+ strict private FTextMetric: OutlineTextMetric;
+ strict private FUSCache: IntPtr;
+ strict private FUsedAlphabetUnicode: List;
+ strict private FUsedGlyphIndexes: List;
+ strict private FWidths: List;
+ strict private tempBitmap: Bitmap;
+
+ type // Nested Types
+ [StructLayout(LayoutKind.Sequential)]
+ public ABC = record
+ // Fields
+ public abcA: Integer;
+ public abcB: Integer;
+ public abcC: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public FontPanose = record
+ // Fields
+ public ArmStyle: Byte;
+ public bContrast: Byte;
+ public bFamilyType: Byte;
+ public bLetterform: Byte;
+ public bMidline: Byte;
+ public bProportion: Byte;
+ public bSerifStyle: Byte;
+ public bStrokeVariation: Byte;
+ public bWeight: Byte;
+ public bXHeight: Byte;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public FontPoint = record
+ // Fields
+ public x: Integer;
+ public y: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public FontRect = record
+ // Fields
+ public bottom: Integer;
+ public left: Integer;
+ public right: Integer;
+ public top: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public FontTextMetric = record
+ // Fields
+ public tmAscent: Integer;
+ public tmAveCharWidth: Integer;
+ public tmBreakChar: Char;
+ public tmCharSet: Byte;
+ public tmDefaultChar: Char;
+ public tmDescent: Integer;
+ public tmDigitizedAspectX: Integer;
+ public tmDigitizedAspectY: Integer;
+ public tmExternalLeading: Integer;
+ public tmFirstChar: Char;
+ public tmHeight: Integer;
+ public tmInternalLeading: Integer;
+ public tmItalic: Byte;
+ public tmLastChar: Char;
+ public tmMaxCharWidth: Integer;
+ public tmOverhang: Integer;
+ public tmPitchAndFamily: Byte;
+ public tmStruckOut: Byte;
+ public tmUnderlined: Byte;
+ public tmWeight: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public GOFFSET = record
+ // Fields
+ public du: Integer;
+ public dv: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public OutlineTextMetric = record
+ // Fields
+ public otmAscent: Integer;
+ public otmDescent: Integer;
+ public otmEMSquare: Cardinal;
+ public otmFiller: Byte;
+ public otmfsSelection: Cardinal;
+ public otmfsType: Cardinal;
+ public otmItalicAngle: Integer;
+ public otmLineGap: Cardinal;
+ public otmMacAscent: Integer;
+ public otmMacDescent: Integer;
+ public otmMacLineGap: Cardinal;
+ public otmPanoseNumber: FontPanose;
+ public otmpFaceName: string;
+ public otmpFamilyName: string;
+ public otmpFullName: string;
+ public otmpStyleName: string;
+ public otmptSubscriptOffset: FontPoint;
+ public otmptSubscriptSize: FontPoint;
+ public otmptSuperscriptOffset: FontPoint;
+ public otmptSuperscriptSize: FontPoint;
+ public otmrcFontBox: FontRect;
+ public otmsCapEmHeight: Cardinal;
+ public otmsCharSlopeRise: Integer;
+ public otmsCharSlopeRun: Integer;
+ public otmSize: Cardinal;
+ public otmsStrikeoutPosition: Integer;
+ public otmsStrikeoutSize: Cardinal;
+ public otmsUnderscorePosition: Integer;
+ public otmsUnderscoreSize: Integer;
+ public otmsXHeight: Cardinal;
+ public otmTextMetrics: FontTextMetric;
+ public otmusMinimumPPEM: Cardinal;
+
+ end;
+
+ strict private Run = class
+ // Methods
+ constructor ExportTTFFont.Run.Create(text: string; a: SCRIPT_ANALYSIS);
+ begin
+ self.text := text;
+ self.analysis := a
+ end;
+
+
+ // Fields
+ public analysis: SCRIPT_ANALYSIS;
+ public text: string;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_ANALYSIS = record
+ // Fields
+ public data: Smallint;
+ public state: SCRIPT_STATE;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_CONTROL = record
+ // Fields
+ public data: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_DIGITSUBSTITUTE = record
+ // Fields
+ public DigitSubstitute: Byte;
+ public dwReserved: Integer;
+ public NationalDigitLanguage: Smallint;
+ public TraditionalDigitLanguage: Smallint;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_ITEM = record
+ // Fields
+ public analysis: SCRIPT_ANALYSIS;
+ public iCharPos: Integer;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_STATE = record
+ // Methods
+ procedure ExportTTFFont.SCRIPT_STATE.SetRtl;
+ begin
+ self.data := $801
+ end;
+
+
+ // Properties
+ public property uBidiLevel: Integer read get_uBidiLevel;
+
+ // Fields
+ public data: Smallint;
+
+ end;
+
+ [StructLayout(LayoutKind.Sequential)]
+ public SCRIPT_VISATTR = record
+ // Fields
+ public data: Smallint;
+
+ end;
+
+
+end;
diff --git a/LibD28x64/FMX.FormTypeAliases.pas b/LibD28x64/FMX.FormTypeAliases.pas
new file mode 100644
index 0000000..99d3df6
--- /dev/null
+++ b/LibD28x64/FMX.FormTypeAliases.pas
@@ -0,0 +1,70 @@
+
+{******************************************}
+{ }
+{ FastScript v1.9 }
+{ Graphics.pas classes and functions }
+{ }
+{ (c) 2003-2007 by Alexander Tzyganenko, }
+{ Fast Reports Inc }
+{ }
+{******************************************}
+
+unit FMX.FormTypeAliases;
+
+interface
+
+{$i fs.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Types, FMX.Objects, System.UITypes, System.UIConsts, FMX.Graphics, System.Types, System.TypInfo, FMX.Forms;
+
+type
+ TFmxFormBorderStyleHelper = record helper for TFmxFormBorderStyle
+ const
+ bsNone = TFmxFormBorderStyle.None deprecated 'Use TFmxFormBorderStyle.None';
+ bsSingle = TFmxFormBorderStyle.Single deprecated 'Use TFmxFormBorderStyle.Single';
+ bsSizeable = TFmxFormBorderStyle.Sizeable deprecated 'Use TFmxFormBorderStyle.Sizeable';
+ bsToolWindow = TFmxFormBorderStyle.ToolWindow deprecated 'Use TFmxFormBorderStyle.ToolWindow';
+ bsSizeToolWin = TFmxFormBorderStyle.SizeToolWin deprecated 'Use TFmxFormBorderStyle.SizeToolWin';
+ end;
+
+ TFormPositionHelper = record helper for TFormPosition
+ const
+ poDesigned = TFormPosition.Designed deprecated 'Use TFormPosition.Designed';
+ poDefault = TFormPosition.Default deprecated 'Use TFormPosition.Default';
+ poDefaultPosOnly = TFormPosition.DefaultPosOnly deprecated 'Use TFormPosition.DefaultPosOnly';
+ poDefaultSizeOnly = TFormPosition.DefaultSizeOnly deprecated 'Use TFormPosition.DefaultSizeOnly';
+ poScreenCenter = TFormPosition.ScreenCenter deprecated 'Use TFormPosition.ScreenCenter';
+ poDesktopCenter = TFormPosition.DesktopCenter deprecated 'Use TFormPosition.DesktopCenter';
+ poMainFormCenter = TFormPosition.MainFormCenter deprecated 'Use TFormPosition.MainFormCenter';
+ poOwnerFormCenter = TFormPosition.OwnerFormCenter deprecated 'Use TFormPosition.OwnerFormCenter';
+ end;
+
+ TFmxFormStateHelper = record helper for TFmxFormState
+ const
+ fsRecreating = TFmxFormState.Recreating deprecated 'Use TFmxFormState.Recreating';
+ fsModal = TFmxFormState.Modal deprecated 'Use TFmxFormState.Modal';
+ fsReleased = TFmxFormState.Released deprecated 'Use TFmxFormState.Released';
+ fsInDesigner = TFmxFormState.InDesigner deprecated 'Use TFmxFormState.InDesigner';
+ fsWasNotShown = TFmxFormState.WasNotShown deprecated 'Use TFmxFormState.WasNotShown';
+ fsShowing = TFmxFormState.Showing deprecated 'Use TFmxFormState.Showing';
+ fsUpdateBorder = TFmxFormState.UpdateBorder deprecated 'Use TFmxFormState.UpdateBorder';
+ fsActivation = TFmxFormState.Activation deprecated 'Use TFmxFormState.Activation';
+ end;
+
+
+implementation
+
+initialization
+ AddEnumElementAliases(TypeInfo(TFmxFormBorderStyle), ['bsNone', 'bsSingle', 'bsSizeable', 'bsToolWindow', 'bsSizeToolWin']);
+ AddEnumElementAliases(TypeInfo(TFormPosition), ['poDesigned', 'poDefault', 'poDefaultPosOnly', 'poDefaultSizeOnly', 'poScreenCenter', 'poDesktopCenter',
+ 'poMainFormCenter', 'poOwnerFormCenter']);
+ AddEnumElementAliases(TypeInfo(TFmxFormState), ['fsRecreating', 'fsModal', 'fsReleased', 'fsInDesigner', 'fsWasNotShown', 'fsShowing', 'fsUpdateBorder',
+ 'fsActivation']);
+
+finalization
+ RemoveEnumElementAliases(TypeInfo(TFmxFormBorderStyle));
+ RemoveEnumElementAliases(TypeInfo(TFormPosition));
+ RemoveEnumElementAliases(TypeInfo(TFmxFormState));
+
+end.
diff --git a/LibD28x64/FMX.Linux.Old.frxPrinter.pas b/LibD28x64/FMX.Linux.Old.frxPrinter.pas
new file mode 100644
index 0000000..c309691
--- /dev/null
+++ b/LibD28x64/FMX.Linux.Old.frxPrinter.pas
@@ -0,0 +1,591 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Printer }
+{ }
+{ Copyright (c) 1998-2020 }
+{ by Alexander Syrykh, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.Linux.Old.frxPrinter;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.SysUtils,System.Types, System.UITypes, System.Variants,
+ FMX.Types, FMX.frxPrinter, FMX.Printer.Linux, FMX.Printer, FMX.frxClass
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+
+type
+ THackCanvas = class(TCanvas);
+ THackPrinter = class(TPrinter);
+
+
+ TfrxPrinter = class(TfrxCustomPrinter)
+ private
+ FIsFirst: Boolean;
+ public
+ constructor Create(const AName, APort: String); override;
+ destructor Destroy; override;
+ procedure Init; override;
+ procedure Abort; override;
+ procedure BeginDoc; override;
+ procedure BeginPage; override;
+ procedure BeginRAWDoc; override;
+ procedure EndDoc; override;
+ procedure EndPage; override;
+ procedure EndRAWDoc; override;
+ procedure WriteRAWDoc(const buf: AnsiString); override;
+ procedure SetViewParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended;
+ AOrientation: TPrinterOrientation); override;
+ procedure SetPrintParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
+ ABin, ADuplex, ACopies: Integer); override;
+ procedure PropertiesDlg; override;
+ function ShowPrintDialog: Boolean; override;
+ function UpdateDeviceCaps: Boolean;
+ end;
+
+ TfrxPrinters = class(TfrxCustomPrinters)
+ protected
+ function GetDefaultPrinter: String; override;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure FillPrinters; override;
+ end;
+
+function ActualfrxPrinterClass : TfrxCustomPrintersClass;
+
+implementation
+
+uses
+ FMX.frxUtils, FMX.frxRes, FMX.frxFMX, FMX.Forms, FMUX.Api;
+
+type
+ TPaperInfo = {packed} record
+ Typ: Integer;
+ Name: String;
+ X, Y: Integer;
+ end;
+
+const
+ PAPERCOUNT = 66;
+ PaperInfo: array[0..PAPERCOUNT - 1] of TPaperInfo = (
+ (Typ:1; Name: ''; X:2159; Y:2794),
+ (Typ:2; Name: ''; X:2159; Y:2794),
+ (Typ:3; Name: ''; X:2794; Y:4318),
+ (Typ:4; Name: ''; X:4318; Y:2794),
+ (Typ:5; Name: ''; X:2159; Y:3556),
+ (Typ:6; Name: ''; X:1397; Y:2159),
+ (Typ:7; Name: ''; X:1842; Y:2667),
+ (Typ:8; Name: ''; X:2970; Y:4200),
+ (Typ:9; Name: ''; X:2100; Y:2970),
+ (Typ:10; Name: ''; X:2100; Y:2970),
+ (Typ:11; Name: ''; X:1480; Y:2100),
+ (Typ:12; Name: ''; X:2500; Y:3540),
+ (Typ:13; Name: ''; X:1820; Y:2570),
+ (Typ:14; Name: ''; X:2159; Y:3302),
+ (Typ:15; Name: ''; X:2150; Y:2750),
+ (Typ:16; Name: ''; X:2540; Y:3556),
+ (Typ:17; Name: ''; X:2794; Y:4318),
+ (Typ:18; Name: ''; X:2159; Y:2794),
+ (Typ:19; Name: ''; X:984; Y:2254),
+ (Typ:20; Name: ''; X:1048; Y:2413),
+ (Typ:21; Name: ''; X:1143; Y:2635),
+ (Typ:22; Name: ''; X:1207; Y:2794),
+ (Typ:23; Name: ''; X:1270; Y:2921),
+ (Typ:24; Name: ''; X:4318; Y:5588),
+ (Typ:25; Name: ''; X:5588; Y:8636),
+ (Typ:26; Name: ''; X:8636; Y:11176),
+ (Typ:27; Name: ''; X:1100; Y:2200),
+ (Typ:28; Name: ''; X:1620; Y:2290),
+ (Typ:29; Name: ''; X:3240; Y:4580),
+ (Typ:30; Name: ''; X:2290; Y:3240),
+ (Typ:31; Name: ''; X:1140; Y:1620),
+ (Typ:32; Name: ''; X:1140; Y:2290),
+ (Typ:33; Name: ''; X:2500; Y:3530),
+ (Typ:34; Name: ''; X:1760; Y:2500),
+ (Typ:35; Name: ''; X:1760; Y:1250),
+ (Typ:36; Name: ''; X:1100; Y:2300),
+ (Typ:37; Name: ''; X:984; Y:1905),
+ (Typ:38; Name: ''; X:920; Y:1651),
+ (Typ:39; Name: ''; X:3778; Y:2794),
+ (Typ:40; Name: ''; X:2159; Y:3048),
+ (Typ:41; Name: ''; X:2159; Y:3302),
+ (Typ:42; Name: ''; X:2500; Y:3530),
+ (Typ:43; Name: ''; X:1000; Y:1480),
+ (Typ:44; Name: ''; X:2286; Y:2794),
+ (Typ:45; Name: ''; X:2540; Y:2794),
+ (Typ:46; Name: ''; X:3810; Y:2794),
+ (Typ:47; Name: ''; X:2200; Y:2200),
+ (Typ:50; Name: ''; X:2355; Y:3048),
+ (Typ:51; Name: ''; X:2355; Y:3810),
+ (Typ:52; Name: ''; X:2969; Y:4572),
+ (Typ:53; Name: ''; X:2354; Y:3223),
+ (Typ:54; Name: ''; X:2101; Y:2794),
+ (Typ:55; Name: ''; X:2100; Y:2970),
+ (Typ:56; Name: ''; X:2355; Y:3048),
+ (Typ:57; Name: ''; X:2270; Y:3560),
+ (Typ:58; Name: ''; X:3050; Y:4870),
+ (Typ:59; Name: ''; X:2159; Y:3223),
+ (Typ:60; Name: ''; X:2100; Y:3300),
+ (Typ:61; Name: ''; X:1480; Y:2100),
+ (Typ:62; Name: ''; X:1820; Y:2570),
+ (Typ:63; Name: ''; X:3220; Y:4450),
+ (Typ:64; Name: ''; X:1740; Y:2350),
+ (Typ:65; Name: ''; X:2010; Y:2760),
+ (Typ:66; Name: ''; X:4200; Y:5940),
+ (Typ:67; Name: ''; X:2970; Y:4200),
+ (Typ:68; Name: ''; X:3220; Y:4450));
+
+type
+ TPaperInfoLCL = {packed} record
+ Name: String;
+ W, H: Extended;
+ end;
+const
+ LCLPaperCount = 119;
+ PtPrIn = 72;
+ CmPrIn = 2.54;
+ PtPrCm = PtPrIn/CmPrIn;
+ PtPrmm = PtPrCm/10;
+ LCLPaperInfo : array[0..LCLPAPERCOUNT-1] of TPaperInfoLCL =
+ ((Name: 'Letter 8 1/2 x 11 in'; W: 8.5 * PtPrIn; H: 11 * PtPrIn),
+ (Name: 'Letter Small 8 1/2 x 11 in'; W: 8.5 * PtPrIn; H: 11 * PtPrIn),
+ (Name: 'Tabloid 11 x 17 in'; W: 11 * PtPrIn; H: 17 * PtPrIn),
+ (Name: 'Ledger 17 x 11 in'; W: 17 * PtPrIn; H: 11 * PtPrIn),
+ (Name: 'Legal 8 1/2 x 14 in'; W: 8.5 * PtPrIn; H: 14 * PtPrIn),
+ (Name: 'Statement 5 1/2 x 8 1/2 in'; W: 5.5 * PtPrIn; H: 8.5 * PtPrIn),
+ (Name: 'Executive 7 1/4 x 10 1/2 in'; W: 7.25 * PtPrIn; H: 10.5 * PtPrIn),
+ (Name: 'A3 297 x 420 mm'; W: 297 * PtPrmm; H: 420 * PtPrmm),
+ (Name: 'A4 210 x 297 mm'; W: 210 * PtPrmm; H: 297 * PtPrmm),
+ (Name: 'A4 Small 210 x 297 mm'; W: 210 * PtPrmm; H: 297 * PtPrmm),
+ (Name: 'A5 148 x 210 mm'; W: 148 * PtPrmm; H: 210 * PtPrmm),
+ (Name: 'B4 (JIS) 250 x 354 mm'; W: 250 * PtPrmm; H: 354 * PtPrmm),
+ (Name: 'B5 (JIS) 182 x 257 mm'; W: 182 * PtPrmm; H: 257 * PtPrmm),
+ (Name: 'Folio 8 1/2 x 13 in'; W: 8.5 * PtPrIn; H: 13 * PtPrIn),
+ (Name: 'Quarto 215 x 275 mm'; W: 215 * PtPrmm; H: 275 * PtPrmm),
+ (Name: '10x14 in'; W: 10 * PtPrIn; H: 14 * PtPrIn),
+ (Name: '11x17 in'; W: 11 * PtPrIn; H: 17 * PtPrIn),
+ (Name: 'Note 8 1/2 x 11 in'; W: 8.5 * PtPrIn; H: 11 * PtPrIn),
+ (Name: 'Envelope #9 3 7/8 x 8 7/8'; W: 3 * 7 / 8 * PtPrIn; H: 8 * 7 / 8 * PtPrIn),
+ (Name: 'Envelope #10 4 1/8 x 9 1/2'; W: 3 * 1 / 8 * PtPrIn; H: 9.5 * PtPrIn),
+ (Name: 'Envelope #11 4 1/2 x 10 3/8'; W: 4.5 * PtPrIn; H: 10 * 3 / 8 * PtPrIn),
+ (Name: 'Envelope #12 4 3/4 x 11'; W: 4.75 * PtPrIn; H: 11 * PtPrIn),
+ (Name: 'Envelope #14 5 x 11 1/2'; W: 5 * PtPrIn; H: 11.5 * PtPrIn),
+ (Name: 'C size sheet 17 x 22 in'; W: 17 * PtPrIn; H: 22 * PtPrIn),
+ (Name: 'D size sheet 22 x 34 in'; W: 22 * PtPrIn; H: 34 * PtPrIn),
+ (Name: 'E size sheet 34 x 44 in'; W: 34 * PtPrIn; H: 44 * PtPrIn),
+ (Name: 'Envelope DL 110 x 220mm'; W: 110 * PtPrmm; H: 220 * PtPrmm),
+ (Name: 'Envelope C5 162 x 229 mm'; W: 162 * PtPrmm; H: 229 * PtPrmm),
+ (Name: 'Envelope C3 324 x 458 mm'; W: 324 * PtPrmm; H: 458 * PtPrmm),
+ (Name: 'Envelope C4 229 x 324 mm'; W: 229 * PtPrmm; H: 324 * PtPrmm),
+ (Name: 'Envelope C6 114 x 162 mm'; W: 114 * PtPrmm; H: 162 * PtPrmm),
+ (Name: 'Envelope C65 114 x 229 mm'; W: 114 * PtPrmm; H: 229 * PtPrmm),
+ (Name: 'Envelope B4 250 x 353 mm'; W: 250 * PtPrmm; H: 353 * PtPrmm),
+ (Name: 'Envelope B5 176 x 250 mm'; W: 176 * PtPrmm; H: 250 * PtPrmm),
+ (Name: 'Envelope B6 176 x 125 mm'; W: 176 * PtPrmm; H: 125 * PtPrmm),
+ (Name: 'Envelope 110 x 230 mm'; W: 110 * PtPrmm; H: 230 * PtPrmm),
+ (Name: 'Envelope Monarch 3 7/8 x 7 1/2 in'; W: 3 * 7 / 8 * PtPrIn; H: 7.5 * PtPrIn),
+ (Name: '6 34 Envelope 3 5/8 x 6 1/2 in'; W: 3 * 5 / 8 * PtPrIn; H: 6.5 * PtPrIn),
+ (Name: 'US Std Fanfold 14 7/8 x 11 in'; W: 14 * 7 / 8 * PtPrIn; H: 11 * PtPrIn),
+ (Name: 'German Std Fanfold 8 1/2 x 12 in'; W: 8.5 * PtPrIn; H: 12 * PtPrIn),
+ (Name: 'German Legal Fanfold 8 1/2 x 13 in'; W: 8.5 * PtPrIn; H: 13 * PtPrIn),
+ (Name: 'B4 (ISO) 250 x 353 mm'; W: 250 * PtPrmm; H: 353 * PtPrmm),
+ (Name: 'Japanese Postcard 100 x 148 mm'; W: 100 * PtPrmm; H: 148 * PtPrmm),
+ (Name: '9 x 11 in'; W: 9 * PtPrIn; H: 11 * PtPrIn),
+ (Name: '10 x 11 in'; W: 10 * PtPrIn; H: 11 * PtPrIn),
+ (Name: '15 x 11 in'; W: 15 * PtPrIn; H: 11 * PtPrIn),
+ (Name: 'Envelope Invite 220 x 220 mm'; W: 220 * PtPrmm; H: 220 * PtPrmm),
+ (Name: 'RESERVED--DO NOT USE'; W: 0; H: 0),
+ (Name: 'RESERVED--DO NOT USE'; W: 0; H: 0),
+ (Name: 'Letter Extra 9 \275 x 12 in'; W: 9.275 * PtPrIn; H: 12 * PtPrIn),
+ (Name: 'Legal Extra 9 \275 x 15 in'; W: 9.275 * PtPrIn; H: 15 * PtPrIn),
+ (Name: 'Tabloid Extra 11.69 x 18 in'; W: 11.69 * PtPrIn; H: 18 * PtPrIn),
+ (Name: 'A4 Extra 9.27 x 12.69 in'; W: 9.27 * PtPrIn; H: 12.69 * PtPrIn),
+ (Name: 'Letter Transverse 8 \275 x 11 in'; W: 8.275 * PtPrIn; H: 11 * PtPrIn),
+ (Name: 'A4 Transverse 210 x 297 mm'; W: 210 * PtPrmm; H: 297 * PtPrmm),
+ (Name: 'Letter Extra Transverse 9\275 x 12 in'; W: 9.275 * PtPrIn; H: 12 * PtPrIn),
+ (Name: 'SuperASuperAA4 227 x 356 mm'; W: 227 * PtPrmm; H: 356 * PtPrmm),
+ (Name: 'SuperBSuperBA3 305 x 487 mm'; W: 305 * PtPrmm; H: 487 * PtPrmm),
+ (Name: 'Letter Plus 8.5 x 12.69 in'; W: 8.5 * PtPrIn; H: 12.69 * PtPrIn),
+ (Name: 'A4 Plus 210 x 330 mm'; W: 210 * PtPrmm; H: 330 * PtPrmm),
+ (Name: 'A5 Transverse 148 x 210 mm'; W: 148 * PtPrmm; H: 210 * PtPrmm),
+ (Name: 'B5 (JIS) Transverse 182 x 257 mm'; W: 182 * PtPrmm; H: 257 * PtPrmm),
+ (Name: 'A3 Extra 322 x 445 mm'; W: 322 * PtPrmm; H: 445 * PtPrmm),
+ (Name: 'A5 Extra 174 x 235 mm'; W: 174 * PtPrmm; H: 235 * PtPrmm),
+ (Name: 'B5 (ISO) Extra 201 x 276 mm'; W: 201 * PtPrmm; H: 276 * PtPrmm),
+ (Name: 'A2 420 x 594 mm'; W: 420 * PtPrmm; H: 594 * PtPrmm),
+ (Name: 'A3 Transverse 297 x 420 mm'; W: 297 * PtPrmm; H: 420 * PtPrmm),
+ (Name: 'A3 Extra Transverse 322 x 445 mm'; W: 322 * PtPrmm; H: 445 * PtPrmm),
+ (Name: 'Japanese Double Postcard 200 x 148 mm'; W: 200 * PtPrmm; H: 148 * PtPrmm),
+ (Name: 'A6 105 x 148 mm'; W: 105 * PtPrmm; H: 148 * PtPrmm),
+ (Name: 'Japanese Envelope Kaku #2'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Kaku #3'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Chou #3'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Chou #4'; W: 0; H: 0),
+ (Name: 'Letter Rotated 11 x 8 1/2 11 in'; W: 11 * PtPrIn; H: 8.5 * PtPrIn),
+ (Name: 'A3 Rotated 420 x 297 mm'; W: 420 * PtPrmm; H: 297 * PtPrmm),
+ (Name: 'A4 Rotated 297 x 210 mm'; W: 297 * PtPrmm; H: 210 * PtPrmm),
+ (Name: 'A5 Rotated 210 x 148 mm'; W: 210 * PtPrmm; H: 148 * PtPrmm),
+ (Name: 'B4 (JIS) Rotated 364 x 257 mm'; W: 364 * PtPrmm; H: 257 * PtPrmm),
+ (Name: 'B5 (JIS) Rotated 257 x 182 mm'; W: 257 * PtPrmm; H: 182 * PtPrmm),
+ (Name: 'Japanese Postcard Rotated 148 x 100 mm'; W: 148 * PtPrmm; H: 100 * PtPrmm),
+ (Name: 'Double Japanese Postcard Rotated 148 x 200 mm'; W: 148 * PtPrmm; H: 200 * PtPrmm),
+ (Name: 'A6 Rotated 148 x 105 mm'; W: 148 * PtPrmm; H: 105 * PtPrmm),
+ (Name: 'Japanese Envelope Kaku #2 Rotated'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Kaku #3 Rotated'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Chou #3 Rotated'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Chou #4 Rotated'; W: 0; H: 0),
+ (Name: 'B6 (JIS) 128 x 182 mm'; W: 128 * PtPrmm; H: 182 * PtPrmm),
+ (Name: 'B6 (JIS) Rotated 182 x 128 mm'; W: 182 * PtPrmm; H: 128 * PtPrmm),
+ (Name: '12 x 11 in'; W: 12 * PtPrIn; H: 11 * PtPrIn),
+ (Name: 'Japanese Envelope You #4'; W: 0; H: 0),
+ (Name: 'Japanese Envelope You #4 Rotated'; W: 0; H: 0),
+ (Name: 'PRC 16K 146 x 215 mm'; W: 146 * PtPrmm; H: 215 * PtPrmm),
+ (Name: 'PRC 32K 97 x 151 mm'; W: 97 * PtPrmm; H: 151 * PtPrmm),
+ (Name: 'PRC 32K(Big) 97 x 151 mm'; W: 97 * PtPrmm; H: 151 * PtPrmm),
+ (Name: 'PRC Envelope #1 102 x 165 mm'; W: 102 * PtPrmm; H: 165 * PtPrmm),
+ (Name: 'PRC Envelope #2 102 x 176 mm'; W: 102 * PtPrmm; H: 176 * PtPrmm),
+ (Name: 'PRC Envelope #3 125 x 176 mm'; W: 125 * PtPrmm; H: 176 * PtPrmm),
+ (Name: 'PRC Envelope #4 110 x 208 mm'; W: 110 * PtPrmm; H: 208 * PtPrmm),
+ (Name: 'PRC Envelope #5 110 x 220 mm'; W: 110 * PtPrmm; H: 220 * PtPrmm),
+ (Name: 'PRC Envelope #6 120 x 230 mm'; W: 120 * PtPrmm; H: 230 * PtPrmm),
+ (Name: 'PRC Envelope #7 160 x 230 mm'; W: 160 * PtPrmm; H: 230 * PtPrmm),
+ (Name: 'PRC Envelope #8 120 x 309 mm'; W: 120 * PtPrmm; H: 309 * PtPrmm),
+ (Name: 'PRC Envelope #9 229 x 324 mm'; W: 229 * PtPrmm; H: 324 * PtPrmm),
+ (Name: 'PRC Envelope #10 324 x 458 mm'; W: 324 * PtPrmm; H: 458 * PtPrmm),
+ (Name: 'PRC 16K Rotated 215 x 146 mm'; W: 215 * PtPrmm; H: 146 * PtPrmm),
+ (Name: 'PRC 32K Rotated 151 x 97 mm'; W: 151 * PtPrmm; H: 97 * PtPrmm),
+ (Name: 'PRC 32K(Big) Rotated 151 x 97 mm'; W: 151 * PtPrmm; H: 97 * PtPrmm),
+ (Name: 'PRC Envelope #1 Rotated 165 x 102 mm'; W: 165 * PtPrmm; H: 102 * PtPrmm),
+ (Name: 'PRC Envelope #2 Rotated 176 x 102 mm'; W: 176 * PtPrmm; H: 102 * PtPrmm),
+ (Name: 'PRC Envelope #3 Rotated 176 x 125 mm'; W: 176 * PtPrmm; H: 125 * PtPrmm),
+ (Name: 'PRC Envelope #4 Rotated 208 x 110 mm'; W: 208 * PtPrmm; H: 110 * PtPrmm),
+ (Name: 'PRC Envelope #5 Rotated 220 x 110 mm'; W: 220 * PtPrmm; H: 110 * PtPrmm),
+ (Name: 'PRC Envelope #6 Rotated 230 x 120 mm'; W: 230 * PtPrmm; H: 120 * PtPrmm),
+ (Name: 'PRC Envelope #7 Rotated 230 x 160 mm'; W: 230 * PtPrmm; H: 160 * PtPrmm),
+ (Name: 'PRC Envelope #8 Rotated 309 x 120 mm'; W: 309 * PtPrmm; H: 120 * PtPrmm),
+ (Name: 'PRC Envelope #9 Rotated 324 x 229 mm'; W: 324 * PtPrmm; H: 229 * PtPrmm),
+ (Name: 'PRC Envelope #10 Rotated 458 x 324 mm'; W: 458 * PtPrmm; H: 324 * PtPrmm),
+ (Name: 'Custom size'; W: 0; H: 0));
+
+constructor TfrxPrinter.Create(const AName, APort: String);
+begin
+ inherited Create(AName, APort);
+end;
+
+destructor TfrxPrinter.Destroy;
+begin
+ inherited;
+end;
+
+procedure TfrxPrinter.Init;
+ function FindLinuxPaper(w, h: Integer): Integer;
+ var
+ I: Integer;
+ p: TPaperInfo;
+ lw,lh: Integer;
+ begin
+ Result := 0;
+ for I := 0 to Length(PaperInfo) - 1 do
+ begin
+ p := PaperInfo[I];
+ lw :=p.X;
+ lh :=p.Y;
+ if ((w >= lw - 6) and (w <= lw + 6)) and ((h >= lh - 6) and (h <= lh + 6)) then
+ begin
+ Result := I;
+ Break;
+ end;
+ end;
+ end;
+
+ procedure FillPapers;
+ var
+ i,k: Integer;
+ fw, fh: Integer;
+ begin
+ for I := 0 to PAPERCOUNT - 1 do
+ begin
+ fw := PaperInfo[I].X;
+ fh := PaperInfo[I].Y;
+ k := FindLinuxPaper(fw, fh);
+ if k > 0 then
+ FPapers.AddObject(LCLPaperInfo[i].Name, TObject(PaperInfo[k].Typ));
+ end;
+ end;
+
+ procedure AssignActivePrinter;
+ var
+ i: Integer;
+ begin
+ for i := 0 to FMX.Printer.Printer.Count - 1 do
+ if TPrinterLinux(FMX.Printer.Printer).Printers[i].Device = Name then
+ TPrinterLinux(FMX.Printer.Printer).ActivePrinter:=
+ TPrinterLinux(FMX.Printer.Printer).Printers[i];
+ end;
+
+begin
+ AssignActivePrinter;
+
+ if FInitialized then Exit;
+ UpdateDeviceCaps;
+ FDefOrientation := TPrinterLinux(FMX.Printer.Printer).Orientation;
+ FOrientation := FDefOrientation;
+
+ FDefPaper := 256;
+ FDefBin := 0;
+ FDefDuplex := 0;
+ FPaper := FDefPaper;
+ FDefPaperWidth := FPaperWidth;
+ FDefPaperHeight := FPaperHeight;
+ FOrientation := FDefOrientation;
+ FillPapers;
+ FBin := -1;
+ FDuplex := -1;
+
+ FInitialized := True;
+
+ FBin := -1;
+ FDuplex := -1;
+
+ FInitialized := True;
+end;
+
+procedure TfrxPrinter.Abort;
+begin
+ TPrinterLinux(FMX.Printer.Printer).Abort;
+end;
+
+procedure TfrxPrinter.BeginDoc;
+begin
+ FPrinting := True;
+ FCanvas := TPrinterLinux(FMX.Printer.Printer).Canvas;
+
+ FIsFirst := True;
+ if FTitle <> '' then
+ TPrinterLinux(FMX.Printer.Printer).Title := FTitle
+ else
+ TPrinterLinux(FMX.Printer.Printer).Title := 'Fast Report Document';
+
+ UpdateDeviceCaps;
+ TPrinterLinux(FMX.Printer.Printer).BeginDoc;
+ FCanvas := TPrinterLinux(FMX.Printer.Printer).Canvas;
+end;
+
+procedure TfrxPrinter.BeginPage;
+begin
+ inherited;
+
+ if not (FIsFirst) then
+ begin
+ TPrinterLinux(FMX.Printer.Printer).NewPage;
+ TPrinterLinux(FMX.Printer.Printer).Canvas.BeginScene;
+ end;
+ FIsFirst := False;
+end;
+
+procedure TfrxPrinter.EndDoc;
+var
+ LSettings: TFmuxPageSettings;
+begin
+
+ TPrinterLinux(FMX.Printer.Printer).EndDoc;
+ FmuxGetPageSettings(LSettings);
+ FPaperWidth := LSettings.Width * 25.4 / 96;
+ FPaperHeight := LSettings.Height * 25.4 / 96;
+
+{$IFDEF DELPHI25}
+ try
+ if TPrinterLinux(FMX.Printer.Printer).Canvas.BeginSceneCount > 0 then
+ TPrinterLinux(FMX.Printer.Printer).Canvas.EndScene;
+ except
+ end;
+{$ELSE}
+ TPrinterLinux(FMX.Printer.Printer).Canvas.EndScene;
+{$ENDIF}
+
+ FPrinting := False;
+ THackPrinter(FMX.Printer.Printer).FPrinting := False;
+ FBin := -1;
+ FDuplex := -1;
+
+end;
+
+procedure TfrxPrinter.EndPage;
+begin
+//todo
+end;
+
+procedure TfrxPrinter.BeginRAWDoc;
+begin
+//todo
+end;
+
+procedure TfrxPrinter.EndRAWDoc;
+begin
+//todo
+end;
+
+procedure TfrxPrinter.WriteRAWDoc(const buf: AnsiString);
+begin
+//todo
+end;
+
+procedure TfrxPrinter.SetViewParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation);
+begin
+ FPaper := APaperSize;
+ FOrientation := AOrientation;
+
+ if APaperSize <> 256 then
+ begin
+ FPaperHeight := LCLPaperInfo[FPaper].H;
+ FPaperWidth := LCLPaperInfo[FPaper].W;
+ if not UpdateDeviceCaps then Exit;
+ end
+ else
+ begin
+ // copy the margins from A4 paper
+ SetViewParams(DMPAPER_A4, 0, 0, AOrientation);
+ FPaperHeight := APaperHeight;
+ FPaperWidth := APaperWidth;
+ end;
+
+end;
+
+function TfrxPrinter.ShowPrintDialog: Boolean;
+begin
+ Result := False;
+end;
+
+procedure TfrxPrinter.SetPrintParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
+ ABin, ADuplex, ACopies: Integer);
+var
+ LPaperHeight, LPaperWidth: Double;
+begin
+
+ { later fix these values }
+ FPaper := APaperSize;
+
+ if TPrinterLinux(FMX.Printer.Printer).Orientation <> AOrientation then
+ begin
+ if FPrinting then
+ begin
+ EndDoc;
+ TPrinterLinux(FMX.Printer.Printer).Orientation := AOrientation;
+ BeginDoc;
+ end
+ else
+ TPrinterLinux(FMX.Printer.Printer).Orientation := AOrientation;
+ end;
+
+ LPaperHeight := FPaperHeight * FDPI.Y / 96;
+ LPaperWidth := FPaperWidth * FDPI.X / 96;
+{$IFDEF DELPHI18}
+ TPrinterLinux(FMX.Printer.Printer).Canvas.SetSize(Round(LPaperWidth), Round(LPaperHeight));
+{$ELSE}
+ TPrinterLinux(FMX.Printer.Printer).Canvas.ResizeBuffer(Round(LPaperWidth), Round(LPaperHeight);
+{$ENDIF}
+ FOrientation := AOrientation;
+ UpdateDeviceCaps;
+end;
+
+function TfrxPrinter.UpdateDeviceCaps: Boolean;
+var
+ Idx: Integer;
+ LSettings: TFmuxPageSettings;
+begin
+ FCanvas := TPrinterLinux(FMX.Printer.Printer).Canvas;
+ Idx := TPrinterLinux(FMX.Printer.Printer).ActivePrinter.ActiveDPIIndex;
+
+ if Idx <> -1 then
+ begin
+ FDPI.X := TPrinterLinux(FMX.Printer.Printer).ActivePrinter.DPI[Idx].X;
+ FDPI.y := TPrinterLinux(FMX.Printer.Printer).ActivePrinter.DPI[Idx].Y;
+ end
+ else if TPrinterLinux(FMX.Printer.Printer).ActivePrinter.DPICount > 0 then
+ begin
+ FDPI.X := TPrinterLinux(FMX.Printer.Printer).ActivePrinter.DPI[0].X;
+ FDPI.y := TPrinterLinux(FMX.Printer.Printer).ActivePrinter.DPI[0].Y;
+ end
+ else
+ begin
+ FDPI := System.Classes.Point(72, 72);
+ end;
+
+ FmuxGetPageSettings(LSettings);
+
+ FPaperWidth := LSettings.Width * 25.4 / 96; // DPI / DPI
+ FPaperHeight := LSettings.Height * 25.4 / 96; // DPI / DPI
+
+ FLeftMargin := LSettings.Margins.Left * 25.4 / 96; // mm per Inch / DPI = mm
+ FTopMargin := LSettings.Margins.Top * 25.4 / 96; // DPI
+ FRightMargin := LSettings.Margins.Right * 25.4 / 96; // DPI
+ FBottomMargin := LSettings.Margins.Bottom * 25.4 / 96; // DPI
+
+ Result := True;
+
+end;
+
+procedure TfrxPrinter.PropertiesDlg;
+begin
+end;
+
+{ TfrxPrinters }
+
+constructor TfrxPrinters.Create;
+begin
+ Inherited;
+end;
+
+destructor TfrxPrinters.Destroy;
+begin
+ inherited;
+end;
+
+function TfrxPrinters.GetDefaultPrinter: String;
+begin
+ Result := TPrinterLinux(FMX.Printer.Printer).ActivePrinter.Device;
+end;
+
+
+procedure TfrxPrinters.FillPrinters;
+var
+ i: Integer;
+
+ procedure AddPrinter(ADevice, APort: String);
+ begin
+ FPrinterList.Add(TfrxPrinter.Create(ADevice, APort));
+ FPrinters.Add(ADevice);
+ end;
+
+begin
+ Clear;
+ for i := 0 to TPrinterLinux(FMX.Printer.Printer).Count - 1 do
+ AddPrinter(FMX.Printer.Printer.Printers[i].Device, TPrinterLinux(FMX.Printer.Printer).Printers[i].Port);
+end;
+
+
+function ActualfrxPrinterClass : TfrxCustomPrintersClass;
+begin
+ Result := TfrxPrinters;
+end;
+
+initialization
+
+finalization
+
+end.
diff --git a/LibD28x64/FMX.Linux.frxPrinter.pas b/LibD28x64/FMX.Linux.frxPrinter.pas
new file mode 100644
index 0000000..caf0444
--- /dev/null
+++ b/LibD28x64/FMX.Linux.frxPrinter.pas
@@ -0,0 +1,1324 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Linux printer classes }
+{ }
+{ Copyright (c) 1998-2021 }
+{ by Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.Linux.frxPrinter;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.SysUtils, System.Types, System.UITypes,
+ System.Variants, FMX.Types, FMX.frxPrinter, FMX.Printer.Linux, FMX.Printer
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+type
+ TPGtkPrinter = Pointer;
+ TPGtkPrintBackend = Pointer;
+ TPGtkPrintJob = Pointer;
+ TPGtkPrintSettings = Pointer;
+ TPGtkPageSetup = Pointer;
+ TPGtkPaperSize = Pointer;
+ TPcairo_surface_t = Pointer;
+ TPcairo_t = Pointer;
+
+ TfrxDevUpdateType = (fdtMargins, fdtPageSize, fdtBin, fdtDuplex, fdtOrientation);
+ TfrxDevUpdateTypes = set of TfrxDevUpdateType;
+
+ TfrxPrinter = class(TfrxCustomPrinter)
+ private
+ FIsFirst: Boolean;
+ FPrinterContext: Pointer;
+ FPageSet: TPGtkPageSetup;
+ FCustomPaper: TPGtkPaperSize;
+ FSettings: TPGtkPrintSettings;
+ FJob: TPGtkPrintJob;
+ FSurf: TPcairo_surface_t;
+ FGTKPapers: TStrings;
+ FTerminated: Boolean;
+ protected
+ procedure ClearGTKPapers;
+ public
+ constructor Create(const AName: String; ADevice: NativeInt); reintroduce;
+ destructor Destroy; override;
+ procedure Init; override;
+ procedure Abort; override;
+ procedure BeginDoc; override;
+ procedure BeginPage; override;
+ procedure BeginRAWDoc; override;
+ procedure EndDoc; override;
+ procedure EndPage; override;
+ procedure EndRAWDoc; override;
+ procedure WriteRAWDoc(const buf: AnsiString); override;
+ procedure SetViewParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended;
+ AOrientation: TPrinterOrientation); override;
+ procedure SetPrintParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
+ ABin, ADuplex, ACopies: Integer); override;
+ procedure PropertiesDlg; override;
+ function ShowPrintDialog: Boolean; override;
+ function UpdateFromDeviceCaps: Boolean;
+ function UpdateToDeviceCaps(Params: TfrxDevUpdateTypes): Boolean;
+ procedure UpdatePageSettings;
+ end;
+
+ TfrxPrinters = class(TfrxCustomPrinters)
+ protected
+ function GetDefaultPrinter: String; override;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure FillPrinters; override;
+ end;
+
+function ActualfrxPrinterClass: TfrxCustomPrintersClass;
+
+implementation
+
+uses
+ FMX.frxUtils, FMX.frxRes, FMX.frxFMX, System.Math.Vectors, System.Math,
+ System.AnsiStrings, FMX.Canvas.Linux, FMX.frxCanvas.Linux, FMX.frxClass, FMX.Forms, System.Diagnostics;
+
+type
+ TPaperInfo = { packed } record
+ Typ: Integer;
+ Name: String;
+ X, Y: Integer;
+ end;
+
+ TGList = record
+ pData: Pointer;
+ pNext: ^TGList;
+ pPrev: ^TGList;
+ end;
+
+ TPGList = ^TGList;
+ TPGtkWidget = Pointer;
+ TPGtkPrintUnixDialog = Pointer;
+
+ TGConnectFlags = (G_CONNECT_AFTER, G_CONNECT_SWAPPED);
+ TGtkPageOrientation = (GTK_PAGE_ORIENTATION_PORTRAIT,
+ GTK_PAGE_ORIENTATION_LANDSCAPE, GTK_PAGE_ORIENTATION_REVERSE_PORTRAIT,
+ GTK_PAGE_ORIENTATION_REVERSE_LANDSCAPE);
+
+ TGtkPrintDuplex = (GTK_PRINT_DUPLEX_SIMPLEX, GTK_PRINT_DUPLEX_HORIZONTAL,
+ GTK_PRINT_DUPLEX_VERTICAL);
+
+ TGtkUnit = (GTK_UNIT_NONE, GTK_UNIT_POINTS, GTK_UNIT_INCH, GTK_UNIT_MM);
+
+ TCairo_surface_type = (
+
+ CAIRO_SURFACE_TYPE_IMAGE, CAIRO_SURFACE_TYPE_PDF, CAIRO_SURFACE_TYPE_PS,
+ CAIRO_SURFACE_TYPE_XLIB, CAIRO_SURFACE_TYPE_XCB, CAIRO_SURFACE_TYPE_GLITZ,
+ CAIRO_SURFACE_TYPE_QUARTZ, CAIRO_SURFACE_TYPE_WIN32,
+ CAIRO_SURFACE_TYPE_BEOS, CAIRO_SURFACE_TYPE_DIRECTFB,
+ CAIRO_SURFACE_TYPE_SVG, CAIRO_SURFACE_TYPE_OS2,
+ CAIRO_SURFACE_TYPE_WIN32_PRINTING, CAIRO_SURFACE_TYPE_QUARTZ_IMAGE,
+ CAIRO_SURFACE_TYPE_SCRIPT, CAIRO_SURFACE_TYPE_QT,
+ CAIRO_SURFACE_TYPE_RECORDING, CAIRO_SURFACE_TYPE_VG, CAIRO_SURFACE_TYPE_GL,
+ CAIRO_SURFACE_TYPE_DRM, CAIRO_SURFACE_TYPE_TEE, CAIRO_SURFACE_TYPE_XML,
+ CAIRO_SURFACE_TYPE_SKIA, CAIRO_SURFACE_TYPE_SUBSURFACE);
+
+ TPGtkPrintJobCompleteFunc = procedure(print_job: TPGtkPrintJob;
+ user_data: Pointer; error: Pointer); cdecl;
+ TPGDestroyNotify = procedure(pData: Pointer); cdecl;
+
+ TPGtkPrinterFunc = function(printer: TPGtkPrinter; pData: Pointer): LongBool; cdecl;
+ TPDetails_acquiredFunc = procedure(printer: TpGtkPrinter; success: LongBool; user_data: Pointer); cdecl;
+
+ Tfn_g_free = procedure(prt: Pointer); cdecl;
+ Tfn_g_list_free = procedure(prt: Pointer); cdecl;
+
+ Tfn_cairo_surface_finish = procedure(surface: TPcairo_surface_t); cdecl;
+
+ Tfn_cairo_create = function(target: TPcairo_surface_t): TPcairo_t; cdecl;
+ Tfn_cairo_destroy = procedure(cr: TPcairo_t); cdecl;
+ Tfn_cairo_show_page = procedure(cr: TPcairo_t); cdecl;
+
+ Tfn_cairo_surface_get_type = function(surface: TPcairo_surface_t): TCairo_surface_type; cdecl;
+ Tfn_cairo_ps_surface_set_size = procedure(surface: TPcairo_surface_t; width_in_points: double; height_in_points: double); cdecl;
+ Tfn_cairo_ps_surface_dsc_begin_setup = procedure(surface: TPcairo_surface_t); cdecl;
+ Tfn_cairo_ps_surface_dsc_begin_page_setup = procedure(surface: TPcairo_surface_t); cdecl;
+ Tfn_cairo_ps_surface_dsc_comment = procedure(surface: TPcairo_surface_t; const comment: PAnsiChar); cdecl;
+ Tfn_cairo_pdf_surface_set_size = procedure(surface: TPcairo_surface_t; width_in_points: double; height_in_points: double); cdecl;
+
+ Tfn_g_signal_connect_data = function(instance: Pointer; const detailed_signal: PAnsiChar; c_handler: Pointer; data: Pointer; destroy_data: Pointer; connect_flags: TGConnectFlags): UInt32; cdecl;
+ Tfn_g_object_unref = procedure(obj: Pointer); cdecl;
+ Tfn_g_object_ref = function(obj: Pointer): Pointer; cdecl;
+ Tfn_gtk_print_job_new = function(const title: PAnsiChar; Printer: TPGtkPrinter; settings: TPGtkPrintSettings; page_setup: TPGtkPageSetup): TPGtkPrintJob; cdecl;
+ Tfn_gtk_print_job_get_surface = function(job: TPGtkPrintJob; error: Pointer): TPcairo_surface_t; cdecl;
+ Tfn_gtk_print_job_send = procedure(job: TPGtkPrintJob; callback: TPGtkPrintJobCompleteFunc; user_data: Pointer; dnotify: TPGDestroyNotify); cdecl;
+ Tfn_gtk_printer_get_default_page_size = function(Printer: TPGtkPrinter): TPGtkPageSetup; cdecl;
+ Tfn_gtk_print_job_get_settings = function(job: TPGtkPrintJob): TPGtkPrintSettings; cdecl;
+ Tfn_gtk_enumerate_printers = procedure(GtkPrinterFunc: TPGtkPrinterFunc; data: Pointer; destroy: TPGDestroyNotify; wait: LongBool ); cdecl;
+ Tfn_gtk_printer_list_papers = function(printer: TPGtkPrinter): TPGList; cdecl;
+ Tfn_gtk_printer_has_details = function(printer: TPGtkPrinter): LongBool; cdecl;
+ Tfn_gtk_printer_request_details = procedure(printer: TPGtkPrinter); cdecl;
+ Tfn_gtk_printer_get_name = function(printer: TPGtkPrinter): PAnsiChar; cdecl;
+ Tfn_gtk_printer_is_default = function(printer: TPGtkPrinter): LongBool; cdecl;
+
+ // Tfn_gtk_print_context_get_page_setup = function(context: TPGtkPrintContext): TPGtkPageSetup;
+
+ Tfn_gtk_print_unix_dialog_new = function(const title: PAnsiChar; parent: TPGtkWidget): TPGtkPrintUnixDialog; cdecl;
+ Tfn_gtk_print_unix_dialog_set_page_setup = procedure(dialog: TPGtkPrintUnixDialog; page_setup: TPGtkPageSetup); cdecl;
+ Tfn_gtk_print_unix_dialog_get_page_setup = function(dialog: TPGtkPrintUnixDialog): TPGtkPageSetup; cdecl;
+ Tfn_gtk_print_unix_dialog_set_settings = procedure(dialog: TPGtkPrintUnixDialog; settings: TPGtkPrintSettings); cdecl;
+ Tfn_gtk_print_unix_dialog_get_settings = function(dialog: TPGtkPrintUnixDialog): TPGtkPrintSettings; cdecl;
+ Tfn_gtk_dialog_run = function(dialog: TPGtkPrintUnixDialog): Integer; cdecl;
+
+ { page_setup }
+ Tfn_gtk_page_setup_new = function: TPGtkPageSetup; cdecl;
+ Tfn_gtk_page_setup_copy = function(other: TPGtkPageSetup): TPGtkPageSetup; cdecl;
+
+ Tfn_gtk_page_setup_get_paper_size = function(setup: TPGtkPageSetup): TPGtkPaperSize; cdecl;
+ Tfn_gtk_page_setup_set_paper_size = procedure(setup: TPGtkPageSetup; size: TPGtkPaperSize); cdecl;
+ Tfn_gtk_page_setup_get_orientation = function(setup: TPGtkPageSetup): TGtkPageOrientation; cdecl;
+ Tfn_gtk_page_setup_set_orientation = procedure(setup: TPGtkPageSetup; orientation: TGtkPageOrientation); cdecl;
+ Tfn_gtk_page_setup_get_top_margin = function(setup: TPGtkPageSetup; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_page_setup_set_top_margin = procedure(setup: TPGtkPageSetup; margin: double; units: TGtkUnit); cdecl;
+ Tfn_gtk_page_setup_get_bottom_margin = function(setup: TPGtkPageSetup; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_page_setup_set_bottom_margin = procedure(setup: TPGtkPageSetup; margin: double; units: TGtkUnit); cdecl;
+ Tfn_gtk_page_setup_get_left_margin = function(setup: TPGtkPageSetup; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_page_setup_set_left_margin = procedure(setup: TPGtkPageSetup; margin: double; units: TGtkUnit); cdecl;
+ Tfn_gtk_page_setup_get_right_margin = function(setup: TPGtkPageSetup; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_page_setup_set_right_margin = procedure(setup: TPGtkPageSetup; margin: double; units: TGtkUnit); cdecl;
+ Tfn_gtk_page_setup_get_paper_width = function(setup: TPGtkPageSetup; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_page_setup_get_paper_height = function(setup: TPGtkPageSetup; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_page_setup_get_page_width = function(setup: TPGtkPageSetup; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_page_setup_get_page_height = function(setup: TPGtkPageSetup; units: TGtkUnit): double; cdecl;
+ { paper_size }
+ Tfn_gtk_paper_size_new = function(const Name: PAnsiChar): TPGtkPaperSize; cdecl;
+ Tfn_gtk_paper_size_new_from_ppd = function(const ppd_name: PAnsiChar; const ppd_display_name: PAnsiChar; width: double; height: double) : TPGtkPaperSize; cdecl;
+ Tfn_gtk_paper_size_new_from_ipp = function(const ipp_name: PAnsiChar; width: double; height: double): TPGtkPaperSize; cdecl;
+ Tfn_gtk_paper_size_new_custom = function(const Name: PAnsiChar; const display_name: PAnsiChar; width: double; height: double; units: TGtkUnit) : TPGtkPaperSize; cdecl;
+ Tfn_gtk_paper_size_copy = function(other: TPGtkPaperSize) : TPGtkPaperSize; cdecl;
+ Tfn_gtk_paper_size_free = procedure(size: TPGtkPaperSize); cdecl;
+ Tfn_gtk_paper_size_is_equal = function(size1: TPGtkPaperSize; size2: TPGtkPaperSize): LongBool; cdecl;
+ // GList *Tfn_gtk_paper_size_get_paper_sizes (gboolean include_custom);
+ Tfn_gtk_paper_size_get_name = function(size: TPGtkPaperSize): PAnsiChar; cdecl;
+ Tfn_gtk_paper_size_get_display_name = function(size: TPGtkPaperSize): PAnsiChar; cdecl;
+ Tfn_gtk_paper_size_get_ppd_name = function(size: TPGtkPaperSize): PAnsiChar; cdecl;
+ Tfn_gtk_paper_size_get_width = function(size: TPGtkPaperSize; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_paper_size_get_height = function(size: TPGtkPaperSize; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_paper_size_is_custom = function(size: TPGtkPaperSize): LongBool; cdecl;
+ Tfn_gtk_paper_size_is_ipp = function(size: TPGtkPaperSize): LongBool; cdecl;
+ Tfn_gtk_paper_size_set_size = procedure(size: TPGtkPaperSize; width: double; height: double; units: TGtkUnit); cdecl;
+ Tfn_gtk_paper_size_get_default_top_margin = function(size: TPGtkPaperSize; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_paper_size_get_default_bottom_margin = function(size: TPGtkPaperSize; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_paper_size_get_default_left_margin = function(size: TPGtkPaperSize; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_paper_size_get_default_right_margin = function(size: TPGtkPaperSize; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_paper_size_get_default = function: PAnsiChar; cdecl;
+ { print_settings }
+ Tfn_gtk_print_settings_new = function: TPGtkPrintSettings; cdecl;
+ Tfn_gtk_print_settings_get_printer = function(settings: TPGtkPrintSettings): PAnsiChar; cdecl;
+ Tfn_gtk_print_settings_set_printer = procedure(settings: TPGtkPrintSettings; const Printer: PAnsiChar); cdecl;
+ Tfn_gtk_print_settings_get_orientation = function(settings: TPGtkPrintSettings): TGtkPageOrientation; cdecl;
+ Tfn_gtk_print_settings_set_orientation = procedure(settings: TPGtkPrintSettings; orientation: TGtkPageOrientation); cdecl;
+ Tfn_gtk_print_settings_get_paper_size = function(settings: TPGtkPrintSettings): TPGtkPaperSize; cdecl;
+ Tfn_gtk_print_settings_set_paper_size = procedure(settings: TPGtkPrintSettings; paper_size: TPGtkPaperSize); cdecl;
+ Tfn_gtk_print_settings_get_paper_width = function(settings: TPGtkPrintSettings; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_print_settings_set_paper_width = procedure(settings: TPGtkPrintSettings; width: double; units: TGtkUnit); cdecl;
+ Tfn_gtk_print_settings_get_paper_height = function(settings: TPGtkPrintSettings; units: TGtkUnit): double; cdecl;
+ Tfn_gtk_print_settings_set_paper_height = procedure(settings: TPGtkPrintSettings; height: double; units: TGtkUnit); cdecl;
+ Tfn_gtk_print_settings_get_collate = function(settings: TPGtkPrintSettings): LongBool; cdecl;
+ Tfn_gtk_print_settings_set_collate = procedure(settings: TPGtkPrintSettings; collate: LongBool); cdecl;
+ Tfn_gtk_print_settings_get_duplex = function(settings: TPGtkPrintSettings): TGtkPrintDuplex; cdecl;
+ Tfn_gtk_print_settings_set_duplex = procedure(settings: TPGtkPrintSettings; duplex: TGtkPrintDuplex); cdecl;
+ Tfn_gtk_print_settings_get_n_copies = function(settings: TPGtkPrintSettings): Integer; cdecl;
+ Tfn_gtk_print_settings_set_n_copies = procedure(settings: TPGtkPrintSettings; num_copies: Integer); cdecl;
+ Tfn_gtk_print_settings_get_resolution_x = function(settings: TPGtkPrintSettings): Integer; cdecl;
+ Tfn_gtk_print_settings_get_resolution_y = function(settings: TPGtkPrintSettings): Integer; cdecl;
+ Tfn_gtk_print_settings_get_default_source = function(settings: TPGtkPrintSettings): PAnsiChar; cdecl;
+ Tfn_gtk_print_settings_set_default_source = procedure(settings: TPGtkPrintSettings; const default_source: PAnsiChar); cdecl;
+ Tfn_gtk_print_settings_get_media_type = function(settings: TPGtkPrintSettings): PAnsiChar; cdecl;
+ Tfn_gtk_print_settings_set_media_type = procedure(settings: TPGtkPrintSettings; const media_type: PAnsiChar); cdecl;
+ Tfn_gtk_print_settings_get_output_bin = function(settings: TPGtkPrintSettings): PAnsiChar; cdecl;
+ Tfn_gtk_print_settings_set_output_bin = procedure(settings: TPGtkPrintSettings; output_bin: PAnsiChar); cdecl;
+
+const
+ PAPERCOUNT = 66;
+ PaperInfo: array[0..PAPERCOUNT - 1] of TPaperInfo = (
+ (Typ:1; Name: ''; X:2159; Y:2794),
+ (Typ:2; Name: ''; X:2159; Y:2794),
+ (Typ:3; Name: ''; X:2794; Y:4318),
+ (Typ:4; Name: ''; X:4318; Y:2794),
+ (Typ:5; Name: ''; X:2159; Y:3556),
+ (Typ:6; Name: ''; X:1397; Y:2159),
+ (Typ:7; Name: ''; X:1842; Y:2667),
+ (Typ:8; Name: ''; X:2970; Y:4200),
+ (Typ:9; Name: ''; X:2100; Y:2970),
+ (Typ:10; Name: ''; X:2100; Y:2970),
+ (Typ:11; Name: ''; X:1480; Y:2100),
+ (Typ:12; Name: ''; X:2500; Y:3540),
+ (Typ:13; Name: ''; X:1820; Y:2570),
+ (Typ:14; Name: ''; X:2159; Y:3302),
+ (Typ:15; Name: ''; X:2150; Y:2750),
+ (Typ:16; Name: ''; X:2540; Y:3556),
+ (Typ:17; Name: ''; X:2794; Y:4318),
+ (Typ:18; Name: ''; X:2159; Y:2794),
+ (Typ:19; Name: ''; X:984; Y:2254),
+ (Typ:20; Name: ''; X:1048; Y:2413),
+ (Typ:21; Name: ''; X:1143; Y:2635),
+ (Typ:22; Name: ''; X:1207; Y:2794),
+ (Typ:23; Name: ''; X:1270; Y:2921),
+ (Typ:24; Name: ''; X:4318; Y:5588),
+ (Typ:25; Name: ''; X:5588; Y:8636),
+ (Typ:26; Name: ''; X:8636; Y:11176),
+ (Typ:27; Name: ''; X:1100; Y:2200),
+ (Typ:28; Name: ''; X:1620; Y:2290),
+ (Typ:29; Name: ''; X:3240; Y:4580),
+ (Typ:30; Name: ''; X:2290; Y:3240),
+ (Typ:31; Name: ''; X:1140; Y:1620),
+ (Typ:32; Name: ''; X:1140; Y:2290),
+ (Typ:33; Name: ''; X:2500; Y:3530),
+ (Typ:34; Name: ''; X:1760; Y:2500),
+ (Typ:35; Name: ''; X:1760; Y:1250),
+ (Typ:36; Name: ''; X:1100; Y:2300),
+ (Typ:37; Name: ''; X:984; Y:1905),
+ (Typ:38; Name: ''; X:920; Y:1651),
+ (Typ:39; Name: ''; X:3778; Y:2794),
+ (Typ:40; Name: ''; X:2159; Y:3048),
+ (Typ:41; Name: ''; X:2159; Y:3302),
+ (Typ:42; Name: ''; X:2500; Y:3530),
+ (Typ:43; Name: ''; X:1000; Y:1480),
+ (Typ:44; Name: ''; X:2286; Y:2794),
+ (Typ:45; Name: ''; X:2540; Y:2794),
+ (Typ:46; Name: ''; X:3810; Y:2794),
+ (Typ:47; Name: ''; X:2200; Y:2200),
+ (Typ:50; Name: ''; X:2355; Y:3048),
+ (Typ:51; Name: ''; X:2355; Y:3810),
+ (Typ:52; Name: ''; X:2969; Y:4572),
+ (Typ:53; Name: ''; X:2354; Y:3223),
+ (Typ:54; Name: ''; X:2101; Y:2794),
+ (Typ:55; Name: ''; X:2100; Y:2970),
+ (Typ:56; Name: ''; X:2355; Y:3048),
+ (Typ:57; Name: ''; X:2270; Y:3560),
+ (Typ:58; Name: ''; X:3050; Y:4870),
+ (Typ:59; Name: ''; X:2159; Y:3223),
+ (Typ:60; Name: ''; X:2100; Y:3300),
+ (Typ:61; Name: ''; X:1480; Y:2100),
+ (Typ:62; Name: ''; X:1820; Y:2570),
+ (Typ:63; Name: ''; X:3220; Y:4450),
+ (Typ:64; Name: ''; X:1740; Y:2350),
+ (Typ:65; Name: ''; X:2010; Y:2760),
+ (Typ:66; Name: ''; X:4200; Y:5940),
+ (Typ:67; Name: ''; X:2970; Y:4200),
+ (Typ:68; Name: ''; X:3220; Y:4450));
+
+type
+ TPaperInfoLCL = {packed} record
+ Name: String;
+ W, H: Extended;
+ end;
+
+ TfrxInfoLinkData = packed record
+ Num : Integer;
+ Name: AnsiString;
+ end;
+
+const
+ LCLPaperCount = 119;
+ CmPrIn = 2.54;
+ PtPrCm = frxDefPPIUnits/CmPrIn;
+ PtPrmm = PtPrCm/10;
+ LCLPaperInfo : array[0..LCLPAPERCOUNT-1] of TPaperInfoLCL =
+ ((Name: 'Letter 8 1/2 x 11 in'; W: 8.5 * frxDefPPIUnits; H: 11 * frxDefPPIUnits),
+ (Name: 'Letter Small 8 1/2 x 11 in'; W: 8.5 * frxDefPPIUnits; H: 11 * frxDefPPIUnits),
+ (Name: 'Tabloid 11 x 17 in'; W: 11 * frxDefPPIUnits; H: 17 * frxDefPPIUnits),
+ (Name: 'Ledger 17 x 11 in'; W: 17 * frxDefPPIUnits; H: 11 * frxDefPPIUnits),
+ (Name: 'Legal 8 1/2 x 14 in'; W: 8.5 * frxDefPPIUnits; H: 14 * frxDefPPIUnits),
+ (Name: 'Statement 5 1/2 x 8 1/2 in'; W: 5.5 * frxDefPPIUnits; H: 8.5 * frxDefPPIUnits),
+ (Name: 'Executive 7 1/4 x 10 1/2 in'; W: 7.25 * frxDefPPIUnits; H: 10.5 * frxDefPPIUnits),
+ (Name: 'A3 297 x 420 mm'; W: 297 * PtPrmm; H: 420 * PtPrmm),
+ (Name: 'A4 210 x 297 mm'; W: 210 * PtPrmm; H: 297 * PtPrmm),
+ (Name: 'A4 Small 210 x 297 mm'; W: 210 * PtPrmm; H: 297 * PtPrmm),
+ (Name: 'A5 148 x 210 mm'; W: 148 * PtPrmm; H: 210 * PtPrmm),
+ (Name: 'B4 (JIS) 250 x 354 mm'; W: 250 * PtPrmm; H: 354 * PtPrmm),
+ (Name: 'B5 (JIS) 182 x 257 mm'; W: 182 * PtPrmm; H: 257 * PtPrmm),
+ (Name: 'Folio 8 1/2 x 13 in'; W: 8.5 * frxDefPPIUnits; H: 13 * frxDefPPIUnits),
+ (Name: 'Quarto 215 x 275 mm'; W: 215 * PtPrmm; H: 275 * PtPrmm),
+ (Name: '10x14 in'; W: 10 * frxDefPPIUnits; H: 14 * frxDefPPIUnits),
+ (Name: '11x17 in'; W: 11 * frxDefPPIUnits; H: 17 * frxDefPPIUnits),
+ (Name: 'Note 8 1/2 x 11 in'; W: 8.5 * frxDefPPIUnits; H: 11 * frxDefPPIUnits),
+ (Name: 'Envelope #9 3 7/8 x 8 7/8'; W: 3 * 7 / 8 * frxDefPPIUnits; H: 8 * 7 / 8 * frxDefPPIUnits),
+ (Name: 'Envelope #10 4 1/8 x 9 1/2'; W: 3 * 1 / 8 * frxDefPPIUnits; H: 9.5 * frxDefPPIUnits),
+ (Name: 'Envelope #11 4 1/2 x 10 3/8'; W: 4.5 * frxDefPPIUnits; H: 10 * 3 / 8 * frxDefPPIUnits),
+ (Name: 'Envelope #12 4 3/4 x 11'; W: 4.75 * frxDefPPIUnits; H: 11 * frxDefPPIUnits),
+ (Name: 'Envelope #14 5 x 11 1/2'; W: 5 * frxDefPPIUnits; H: 11.5 * frxDefPPIUnits),
+ (Name: 'C size sheet 17 x 22 in'; W: 17 * frxDefPPIUnits; H: 22 * frxDefPPIUnits),
+ (Name: 'D size sheet 22 x 34 in'; W: 22 * frxDefPPIUnits; H: 34 * frxDefPPIUnits),
+ (Name: 'E size sheet 34 x 44 in'; W: 34 * frxDefPPIUnits; H: 44 * frxDefPPIUnits),
+ (Name: 'Envelope DL 110 x 220mm'; W: 110 * PtPrmm; H: 220 * PtPrmm),
+ (Name: 'Envelope C5 162 x 229 mm'; W: 162 * PtPrmm; H: 229 * PtPrmm),
+ (Name: 'Envelope C3 324 x 458 mm'; W: 324 * PtPrmm; H: 458 * PtPrmm),
+ (Name: 'Envelope C4 229 x 324 mm'; W: 229 * PtPrmm; H: 324 * PtPrmm),
+ (Name: 'Envelope C6 114 x 162 mm'; W: 114 * PtPrmm; H: 162 * PtPrmm),
+ (Name: 'Envelope C65 114 x 229 mm'; W: 114 * PtPrmm; H: 229 * PtPrmm),
+ (Name: 'Envelope B4 250 x 353 mm'; W: 250 * PtPrmm; H: 353 * PtPrmm),
+ (Name: 'Envelope B5 176 x 250 mm'; W: 176 * PtPrmm; H: 250 * PtPrmm),
+ (Name: 'Envelope B6 176 x 125 mm'; W: 176 * PtPrmm; H: 125 * PtPrmm),
+ (Name: 'Envelope 110 x 230 mm'; W: 110 * PtPrmm; H: 230 * PtPrmm),
+ (Name: 'Envelope Monarch 3 7/8 x 7 1/2 in'; W: 3 * 7 / 8 * frxDefPPIUnits; H: 7.5 * frxDefPPIUnits),
+ (Name: '6 34 Envelope 3 5/8 x 6 1/2 in'; W: 3 * 5 / 8 * frxDefPPIUnits; H: 6.5 * frxDefPPIUnits),
+ (Name: 'US Std Fanfold 14 7/8 x 11 in'; W: 14 * 7 / 8 * frxDefPPIUnits; H: 11 * frxDefPPIUnits),
+ (Name: 'German Std Fanfold 8 1/2 x 12 in'; W: 8.5 * frxDefPPIUnits; H: 12 * frxDefPPIUnits),
+ (Name: 'German Legal Fanfold 8 1/2 x 13 in'; W: 8.5 * frxDefPPIUnits; H: 13 * frxDefPPIUnits),
+ (Name: 'B4 (ISO) 250 x 353 mm'; W: 250 * PtPrmm; H: 353 * PtPrmm),
+ (Name: 'Japanese Postcard 100 x 148 mm'; W: 100 * PtPrmm; H: 148 * PtPrmm),
+ (Name: '9 x 11 in'; W: 9 * frxDefPPIUnits; H: 11 * frxDefPPIUnits),
+ (Name: '10 x 11 in'; W: 10 * frxDefPPIUnits; H: 11 * frxDefPPIUnits),
+ (Name: '15 x 11 in'; W: 15 * frxDefPPIUnits; H: 11 * frxDefPPIUnits),
+ (Name: 'Envelope Invite 220 x 220 mm'; W: 220 * PtPrmm; H: 220 * PtPrmm),
+ (Name: 'RESERVED--DO NOT USE'; W: 0; H: 0),
+ (Name: 'RESERVED--DO NOT USE'; W: 0; H: 0),
+ (Name: 'Letter Extra 9 \275 x 12 in'; W: 9.275 * frxDefPPIUnits; H: 12 * frxDefPPIUnits),
+ (Name: 'Legal Extra 9 \275 x 15 in'; W: 9.275 * frxDefPPIUnits; H: 15 * frxDefPPIUnits),
+ (Name: 'Tabloid Extra 11.69 x 18 in'; W: 11.69 * frxDefPPIUnits; H: 18 * frxDefPPIUnits),
+ (Name: 'A4 Extra 9.27 x 12.69 in'; W: 9.27 * frxDefPPIUnits; H: 12.69 * frxDefPPIUnits),
+ (Name: 'Letter Transverse 8 \275 x 11 in'; W: 8.275 * frxDefPPIUnits; H: 11 * frxDefPPIUnits),
+ (Name: 'A4 Transverse 210 x 297 mm'; W: 210 * PtPrmm; H: 297 * PtPrmm),
+ (Name: 'Letter Extra Transverse 9\275 x 12 in'; W: 9.275 * frxDefPPIUnits; H: 12 * frxDefPPIUnits),
+ (Name: 'SuperASuperAA4 227 x 356 mm'; W: 227 * PtPrmm; H: 356 * PtPrmm),
+ (Name: 'SuperBSuperBA3 305 x 487 mm'; W: 305 * PtPrmm; H: 487 * PtPrmm),
+ (Name: 'Letter Plus 8.5 x 12.69 in'; W: 8.5 * frxDefPPIUnits; H: 12.69 * frxDefPPIUnits),
+ (Name: 'A4 Plus 210 x 330 mm'; W: 210 * PtPrmm; H: 330 * PtPrmm),
+ (Name: 'A5 Transverse 148 x 210 mm'; W: 148 * PtPrmm; H: 210 * PtPrmm),
+ (Name: 'B5 (JIS) Transverse 182 x 257 mm'; W: 182 * PtPrmm; H: 257 * PtPrmm),
+ (Name: 'A3 Extra 322 x 445 mm'; W: 322 * PtPrmm; H: 445 * PtPrmm),
+ (Name: 'A5 Extra 174 x 235 mm'; W: 174 * PtPrmm; H: 235 * PtPrmm),
+ (Name: 'B5 (ISO) Extra 201 x 276 mm'; W: 201 * PtPrmm; H: 276 * PtPrmm),
+ (Name: 'A2 420 x 594 mm'; W: 420 * PtPrmm; H: 594 * PtPrmm),
+ (Name: 'A3 Transverse 297 x 420 mm'; W: 297 * PtPrmm; H: 420 * PtPrmm),
+ (Name: 'A3 Extra Transverse 322 x 445 mm'; W: 322 * PtPrmm; H: 445 * PtPrmm),
+ (Name: 'Japanese Double Postcard 200 x 148 mm'; W: 200 * PtPrmm; H: 148 * PtPrmm),
+ (Name: 'A6 105 x 148 mm'; W: 105 * PtPrmm; H: 148 * PtPrmm),
+ (Name: 'Japanese Envelope Kaku #2'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Kaku #3'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Chou #3'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Chou #4'; W: 0; H: 0),
+ (Name: 'Letter Rotated 11 x 8 1/2 11 in'; W: 11 * frxDefPPIUnits; H: 8.5 * frxDefPPIUnits),
+ (Name: 'A3 Rotated 420 x 297 mm'; W: 420 * PtPrmm; H: 297 * PtPrmm),
+ (Name: 'A4 Rotated 297 x 210 mm'; W: 297 * PtPrmm; H: 210 * PtPrmm),
+ (Name: 'A5 Rotated 210 x 148 mm'; W: 210 * PtPrmm; H: 148 * PtPrmm),
+ (Name: 'B4 (JIS) Rotated 364 x 257 mm'; W: 364 * PtPrmm; H: 257 * PtPrmm),
+ (Name: 'B5 (JIS) Rotated 257 x 182 mm'; W: 257 * PtPrmm; H: 182 * PtPrmm),
+ (Name: 'Japanese Postcard Rotated 148 x 100 mm'; W: 148 * PtPrmm; H: 100 * PtPrmm),
+ (Name: 'Double Japanese Postcard Rotated 148 x 200 mm'; W: 148 * PtPrmm; H: 200 * PtPrmm),
+ (Name: 'A6 Rotated 148 x 105 mm'; W: 148 * PtPrmm; H: 105 * PtPrmm),
+ (Name: 'Japanese Envelope Kaku #2 Rotated'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Kaku #3 Rotated'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Chou #3 Rotated'; W: 0; H: 0),
+ (Name: 'Japanese Envelope Chou #4 Rotated'; W: 0; H: 0),
+ (Name: 'B6 (JIS) 128 x 182 mm'; W: 128 * PtPrmm; H: 182 * PtPrmm),
+ (Name: 'B6 (JIS) Rotated 182 x 128 mm'; W: 182 * PtPrmm; H: 128 * PtPrmm),
+ (Name: '12 x 11 in'; W: 12 * frxDefPPIUnits; H: 11 * frxDefPPIUnits),
+ (Name: 'Japanese Envelope You #4'; W: 0; H: 0),
+ (Name: 'Japanese Envelope You #4 Rotated'; W: 0; H: 0),
+ (Name: 'PRC 16K 146 x 215 mm'; W: 146 * PtPrmm; H: 215 * PtPrmm),
+ (Name: 'PRC 32K 97 x 151 mm'; W: 97 * PtPrmm; H: 151 * PtPrmm),
+ (Name: 'PRC 32K(Big) 97 x 151 mm'; W: 97 * PtPrmm; H: 151 * PtPrmm),
+ (Name: 'PRC Envelope #1 102 x 165 mm'; W: 102 * PtPrmm; H: 165 * PtPrmm),
+ (Name: 'PRC Envelope #2 102 x 176 mm'; W: 102 * PtPrmm; H: 176 * PtPrmm),
+ (Name: 'PRC Envelope #3 125 x 176 mm'; W: 125 * PtPrmm; H: 176 * PtPrmm),
+ (Name: 'PRC Envelope #4 110 x 208 mm'; W: 110 * PtPrmm; H: 208 * PtPrmm),
+ (Name: 'PRC Envelope #5 110 x 220 mm'; W: 110 * PtPrmm; H: 220 * PtPrmm),
+ (Name: 'PRC Envelope #6 120 x 230 mm'; W: 120 * PtPrmm; H: 230 * PtPrmm),
+ (Name: 'PRC Envelope #7 160 x 230 mm'; W: 160 * PtPrmm; H: 230 * PtPrmm),
+ (Name: 'PRC Envelope #8 120 x 309 mm'; W: 120 * PtPrmm; H: 309 * PtPrmm),
+ (Name: 'PRC Envelope #9 229 x 324 mm'; W: 229 * PtPrmm; H: 324 * PtPrmm),
+ (Name: 'PRC Envelope #10 324 x 458 mm'; W: 324 * PtPrmm; H: 458 * PtPrmm),
+ (Name: 'PRC 16K Rotated 215 x 146 mm'; W: 215 * PtPrmm; H: 146 * PtPrmm),
+ (Name: 'PRC 32K Rotated 151 x 97 mm'; W: 151 * PtPrmm; H: 97 * PtPrmm),
+ (Name: 'PRC 32K(Big) Rotated 151 x 97 mm'; W: 151 * PtPrmm; H: 97 * PtPrmm),
+ (Name: 'PRC Envelope #1 Rotated 165 x 102 mm'; W: 165 * PtPrmm; H: 102 * PtPrmm),
+ (Name: 'PRC Envelope #2 Rotated 176 x 102 mm'; W: 176 * PtPrmm; H: 102 * PtPrmm),
+ (Name: 'PRC Envelope #3 Rotated 176 x 125 mm'; W: 176 * PtPrmm; H: 125 * PtPrmm),
+ (Name: 'PRC Envelope #4 Rotated 208 x 110 mm'; W: 208 * PtPrmm; H: 110 * PtPrmm),
+ (Name: 'PRC Envelope #5 Rotated 220 x 110 mm'; W: 220 * PtPrmm; H: 110 * PtPrmm),
+ (Name: 'PRC Envelope #6 Rotated 230 x 120 mm'; W: 230 * PtPrmm; H: 120 * PtPrmm),
+ (Name: 'PRC Envelope #7 Rotated 230 x 160 mm'; W: 230 * PtPrmm; H: 160 * PtPrmm),
+ (Name: 'PRC Envelope #8 Rotated 309 x 120 mm'; W: 309 * PtPrmm; H: 120 * PtPrmm),
+ (Name: 'PRC Envelope #9 Rotated 324 x 229 mm'; W: 324 * PtPrmm; H: 229 * PtPrmm),
+ (Name: 'PRC Envelope #10 Rotated 458 x 324 mm'; W: 458 * PtPrmm; H: 324 * PtPrmm),
+ (Name: 'Custom size'; W: 0; H: 0));
+
+ DefGtkPapersCount = 63;
+ GTKPapers: array[0 .. DefGtkPapersCount - 1] of TfrxInfoLinkData = (
+ (Num: DMPAPER_USER; Name: ''),
+ (Num: FRX_DMPAPER_LETTER_TRANSVERSE; Name: 'na_letter'),
+ (Num: FRX_DMPAPER_LETTER; Name: 'na_letter'),
+ (Num: FRX_DMPAPER_LETTERSMALL; Name: 'na_letter'),
+ (Num: FRX_DMPAPER_TABLOID; Name: 'na_ledger'),
+ (Num: FRX_DMPAPER_LEDGER; Name: 'na_ledger'),
+ (Num: FRX_DMPAPER_LEGAL; Name: 'na_legal'),
+ (Num: FRX_DMPAPER_STATEMENT; Name: 'na_invoice'),
+ (Num: FRX_DMPAPER_EXECUTIVE; Name: 'na_executive'),
+ (Num: FRX_DMPAPER_A3; Name: 'iso_a3'),
+ (Num: FRX_DMPAPER_A3_TRANSVERSE; Name: 'iso_a3'),
+ (Num: FRX_DMPAPER_A4; Name: 'iso_a4'),
+ (Num: FRX_DMPAPER_A4SMALL; Name: 'iso_a4'),
+ (Num: FRX_DMPAPER_A4_TRANSVERSE; Name: 'iso_a4'),
+ (Num: FRX_DMPAPER_A5; Name: 'iso_a5'),
+ (Num: FRX_DMPAPER_A5_TRANSVERSE; Name: 'iso_a5'),
+ (Num: FRX_DMPAPER_B4; Name: 'jis_b4'),
+ (Num: FRX_DMPAPER_B5; Name: 'jis_b5'),
+ (Num: FRX_DMPAPER_B5_TRANSVERSE; Name: 'jis_b5'),
+ (Num: FRX_DMPAPER_QUARTO; Name: 'na_quarto'),
+ (Num: FRX_DMPAPER_10X14; Name: 'na_10x14'),
+ (Num: FRX_DMPAPER_11X17; Name: 'na_ledger'),
+ (Num: FRX_DMPAPER_NOTE; Name: 'na_letter'),
+ (Num: FRX_DMPAPER_ENV_9; Name: 'na_number-9'),
+ (Num: FRX_DMPAPER_ENV_10; Name: 'na_number-10'),
+ (Num: FRX_DMPAPER_ENV_11; Name: 'na_number-11'),
+ (Num: FRX_DMPAPER_ENV_12; Name: 'na_number-12'),
+ (Num: FRX_DMPAPER_ENV_14; Name: 'na_number-14'),
+ (Num: FRX_DMPAPER_CSHEET; Name: 'na_c'),
+ (Num: FRX_DMPAPER_DSHEET; Name: 'na_d'),
+ (Num: FRX_DMPAPER_ESHEET; Name: 'na_e'),
+ (Num: FRX_DMPAPER_ENV_DL; Name: 'iso_dl'),
+ (Num: FRX_DMPAPER_ENV_C5; Name: 'iso_c5'),
+ (Num: FRX_DMPAPER_ENV_C3; Name: 'iso_c3'),
+ (Num: FRX_DMPAPER_ENV_C4; Name: 'iso_c4'),
+ (Num: FRX_DMPAPER_ENV_C6; Name: 'iso_c6'),
+ (Num: FRX_DMPAPER_ENV_C65; Name: 'iso_c6c5'),
+ (Num: FRX_DMPAPER_ENV_B4; Name: 'iso_b4'),
+ (Num: FRX_DMPAPER_ENV_B5; Name: 'iso_b5'),
+ (Num: FRX_DMPAPER_ENV_B6; Name: 'iso_b6'),
+ (Num: FRX_DMPAPER_ENV_ITALY; Name: 'om_italian'),
+ (Num: FRX_DMPAPER_ENV_MONARCH; Name: 'na_monarch'),
+ (Num: FRX_DMPAPER_ENV_PERSONAL; Name: 'na_personal'),
+ (Num: FRX_DMPAPER_FANFOLD_US; Name: 'na_fanfold-us'),
+ (Num: FRX_DMPAPER_FANFOLD_STD_GERMAN; Name: 'na_fanfold-eur'),
+ (Num: FRX_DMPAPER_FANFOLD_LGL_GERMAN; Name: 'na_foolscap'),
+ (Num: FRX_DMPAPER_ISO_B4; Name: 'iso_b4'),
+ (Num: FRX_DMPAPER_JAPANESE_POSTCARD; Name: 'jpn_hagaki'),
+ (Num: FRX_DMPAPER_9X11; Name: 'na_9x11'),
+ (Num: FRX_DMPAPER_10X11; Name: 'na_10x11'),
+ (Num: FRX_DMPAPER_ENV_INVITE; Name: 'om_invite'),
+ (Num: FRX_DMPAPER_LETTER_EXTRA; Name: 'na_letter-extra'),
+ (Num: FRX_DMPAPER_LETTER_EXTRA_TRANSVERSE; Name: 'na_letter-extra'),
+ (Num: FRX_DMPAPER_LEGAL_EXTRA; Name: 'na_legal-extra'),
+ (Num: FRX_DMPAPER_TABLOID_EXTRA; Name: 'na_arch'),
+ (Num: FRX_DMPAPER_A4_EXTRA; Name: 'iso_a4-extra'),
+ (Num: FRX_DMPAPER_B_PLUS; Name: 'na_b-plus'),
+ (Num: FRX_DMPAPER_LETTER_PLUS; Name: 'na_letter-plus'),
+ (Num: FRX_DMPAPER_A3_EXTRA; Name: 'iso_a3-extra'),
+ (Num: FRX_DMPAPER_A3_EXTRA_TRANSVERSE; Name: 'iso_a3-extra'),
+ (Num: FRX_DMPAPER_A5_EXTRA; Name: 'iso_a5-extra'),
+ (Num: FRX_DMPAPER_B5_EXTRA; Name: 'iso_b5-extra'),
+ (Num: FRX_DMPAPER_A2; Name: 'iso_a2'));
+
+ DefGtkBinsCount = 13;
+ GTKBins: array[0 .. DefGtkBinsCount - 1] of TfrxInfoLinkData = (
+ (Num: FRX_DMBIN_AUTO; Name: 'auto'),
+ (Num: FRX_DMBIN_CASSETTE; Name: 'cassette'),
+ (Num: FRX_DMBIN_ENVELOPE; Name: 'envelope'),
+ (Num: FRX_DMBIN_ENVMANUAL; Name: 'envelope-manual'),
+ (Num: FRX_DMBIN_LOWER; Name: 'lower'),
+ (Num: FRX_DMBIN_MANUAL; Name: 'manual'),
+ (Num: FRX_DMBIN_MIDDLE; Name: 'middle'),
+ (Num: FRX_DMBIN_ONLYONE; Name: 'only-one'),
+ (Num: FRX_DMBIN_FORMSOURCE; Name: 'form-source'),
+ (Num: FRX_DMBIN_LARGECAPACITY; Name: 'large-capacity'),
+ (Num: FRX_DMBIN_LARGEFMT; Name: 'large-format'),
+ (Num: FRX_DMBIN_TRACTOR; Name: 'tractor'),
+ (Num: FRX_DMBIN_SMALLFMT; Name: 'small-format'));
+
+var
+ cairo_surface_finish: Tfn_cairo_surface_finish;
+ cairo_create: Tfn_cairo_create;
+ cairo_destroy: Tfn_cairo_destroy;
+ cairo_show_page: Tfn_cairo_show_page;
+
+ cairo_surface_get_type: Tfn_cairo_surface_get_type;
+ cairo_ps_surface_set_size: Tfn_cairo_ps_surface_set_size;
+ cairo_ps_surface_dsc_begin_setup: Tfn_cairo_ps_surface_dsc_begin_setup;
+ cairo_ps_surface_dsc_begin_page_setup: Tfn_cairo_ps_surface_dsc_begin_page_setup;
+ cairo_ps_surface_dsc_comment: Tfn_cairo_ps_surface_dsc_comment;
+ cairo_pdf_surface_set_size: Tfn_cairo_pdf_surface_set_size;
+
+ g_free: Tfn_g_free;
+ g_list_free: Tfn_g_list_free;
+
+ g_signal_connect_data: Tfn_g_signal_connect_data;
+ g_object_unref: Tfn_g_object_unref;
+ g_object_ref: Tfn_g_object_ref;
+ gtk_print_job_new: Tfn_gtk_print_job_new;
+ gtk_print_job_get_surface: Tfn_gtk_print_job_get_surface;
+ gtk_print_job_send: Tfn_gtk_print_job_send;
+ gtk_printer_get_default_page_size: Tfn_gtk_printer_get_default_page_size;
+ gtk_print_job_get_settings: Tfn_gtk_print_job_get_settings;
+ gtk_enumerate_printers: Tfn_gtk_enumerate_printers;
+ gtk_printer_list_papers: Tfn_gtk_printer_list_papers;
+ gtk_printer_has_details: Tfn_gtk_printer_has_details;
+ gtk_printer_request_details: Tfn_gtk_printer_request_details;
+ gtk_printer_get_name: Tfn_gtk_printer_get_name;
+ gtk_printer_is_default: Tfn_gtk_printer_is_default;
+
+ gtk_print_unix_dialog_new: Tfn_gtk_print_unix_dialog_new;
+ gtk_print_unix_dialog_set_page_setup: Tfn_gtk_print_unix_dialog_set_page_setup;
+ gtk_print_unix_dialog_get_page_setup: Tfn_gtk_print_unix_dialog_get_page_setup;
+ gtk_print_unix_dialog_set_settings: Tfn_gtk_print_unix_dialog_set_settings;
+ gtk_print_unix_dialog_get_settings: Tfn_gtk_print_unix_dialog_get_settings;
+ gtk_dialog_run: Tfn_gtk_dialog_run;
+
+ { page_setup }
+ gtk_page_setup_new: Tfn_gtk_page_setup_new;
+ gtk_page_setup_copy: Tfn_gtk_page_setup_copy;
+ gtk_page_setup_get_paper_size: Tfn_gtk_page_setup_get_paper_size;
+ gtk_page_setup_set_paper_size: Tfn_gtk_page_setup_set_paper_size;
+ gtk_page_setup_get_orientation: Tfn_gtk_page_setup_get_orientation;
+ gtk_page_setup_set_orientation: Tfn_gtk_page_setup_set_orientation;
+ gtk_page_setup_get_top_margin: Tfn_gtk_page_setup_get_top_margin;
+ gtk_page_setup_set_top_margin: Tfn_gtk_page_setup_set_top_margin;
+ gtk_page_setup_get_bottom_margin: Tfn_gtk_page_setup_get_bottom_margin;
+ gtk_page_setup_set_bottom_margin: Tfn_gtk_page_setup_set_bottom_margin;
+ gtk_page_setup_get_left_margin: Tfn_gtk_page_setup_get_left_margin;
+ gtk_page_setup_set_left_margin: Tfn_gtk_page_setup_set_left_margin;
+ gtk_page_setup_get_right_margin: Tfn_gtk_page_setup_get_right_margin;
+ gtk_page_setup_set_right_margin: Tfn_gtk_page_setup_set_right_margin;
+ gtk_page_setup_get_paper_width: Tfn_gtk_page_setup_get_paper_width;
+ gtk_page_setup_get_paper_height: Tfn_gtk_page_setup_get_paper_height;
+ gtk_page_setup_get_page_width: Tfn_gtk_page_setup_get_page_width;
+ gtk_page_setup_get_page_height: Tfn_gtk_page_setup_get_page_height;
+ { paper_size }
+ gtk_paper_size_new: Tfn_gtk_paper_size_new;
+ gtk_paper_size_new_from_ppd: Tfn_gtk_paper_size_new_from_ppd;
+ gtk_paper_size_new_from_ipp: Tfn_gtk_paper_size_new_from_ipp;
+ gtk_paper_size_new_custom: Tfn_gtk_paper_size_new_custom;
+ gtk_paper_size_copy: Tfn_gtk_paper_size_copy;
+ gtk_paper_size_free: Tfn_gtk_paper_size_free;
+ gtk_paper_size_is_equal: Tfn_gtk_paper_size_is_equal;
+ //GList *Tfn_gtk_paper_size_get_paper_sizes (gboolean include_custom);
+ gtk_paper_size_get_name: Tfn_gtk_paper_size_get_name;
+ gtk_paper_size_get_display_name: Tfn_gtk_paper_size_get_display_name;
+ gtk_paper_size_get_ppd_name: Tfn_gtk_paper_size_get_ppd_name;
+ gtk_paper_size_get_width: Tfn_gtk_paper_size_get_width;
+ gtk_paper_size_get_height: Tfn_gtk_paper_size_get_height;
+ gtk_paper_size_is_custom: Tfn_gtk_paper_size_is_custom;
+ gtk_paper_size_is_ipp: Tfn_gtk_paper_size_is_ipp;
+ gtk_paper_size_set_size: Tfn_gtk_paper_size_set_size;
+ gtk_paper_size_get_default_top_margin: Tfn_gtk_paper_size_get_default_top_margin;
+ gtk_paper_size_get_default_bottom_margin: Tfn_gtk_paper_size_get_default_bottom_margin;
+ gtk_paper_size_get_default_left_margin: Tfn_gtk_paper_size_get_default_left_margin;
+ gtk_paper_size_get_default_right_margin: Tfn_gtk_paper_size_get_default_right_margin;
+ gtk_paper_size_get_default: Tfn_gtk_paper_size_get_default;
+ { print_settings }
+ gtk_print_settings_new: Tfn_gtk_print_settings_new;
+ gtk_print_settings_get_printer: Tfn_gtk_print_settings_get_printer;
+ gtk_print_settings_set_printer: Tfn_gtk_print_settings_set_printer;
+ gtk_print_settings_get_orientation: Tfn_gtk_print_settings_get_orientation;
+ gtk_print_settings_set_orientation: Tfn_gtk_print_settings_set_orientation;
+ gtk_print_settings_get_paper_size: Tfn_gtk_print_settings_get_paper_size;
+ gtk_print_settings_set_paper_size: Tfn_gtk_print_settings_set_paper_size;
+ gtk_print_settings_get_paper_width: Tfn_gtk_print_settings_get_paper_width;
+ gtk_print_settings_set_paper_width: Tfn_gtk_print_settings_set_paper_width;
+ gtk_print_settings_get_paper_height: Tfn_gtk_print_settings_get_paper_height;
+ gtk_print_settings_set_paper_height: Tfn_gtk_print_settings_set_paper_height;
+ gtk_print_settings_get_collate: Tfn_gtk_print_settings_get_collate;
+ gtk_print_settings_set_collate: Tfn_gtk_print_settings_set_collate;
+ gtk_print_settings_get_duplex: Tfn_gtk_print_settings_get_duplex;
+ gtk_print_settings_set_duplex: Tfn_gtk_print_settings_set_duplex;
+ gtk_print_settings_get_n_copies: Tfn_gtk_print_settings_get_n_copies;
+ gtk_print_settings_set_n_copies: Tfn_gtk_print_settings_set_n_copies;
+ gtk_print_settings_get_resolution_x: Tfn_gtk_print_settings_get_resolution_x;
+ gtk_print_settings_get_resolution_y: Tfn_gtk_print_settings_get_resolution_y;
+ gtk_print_settings_get_default_source: Tfn_gtk_print_settings_get_default_source;
+ gtk_print_settings_set_default_source: Tfn_gtk_print_settings_set_default_source;
+ gtk_print_settings_get_media_type: Tfn_gtk_print_settings_get_media_type;
+ gtk_print_settings_set_media_type: Tfn_gtk_print_settings_set_media_type;
+ gtk_print_settings_get_output_bin: Tfn_gtk_print_settings_get_output_bin;
+ gtk_print_settings_set_output_bin: Tfn_gtk_print_settings_set_output_bin;
+
+
+function frxGtkOrientationToFMX(Orientation: TGtkPageOrientation): TPrinterOrientation; inline;
+begin
+ Result := TPrinterOrientation(Byte(Orientation) div 2);
+end;
+
+function frxFMXOrientationToGtk(Orientation: TPrinterOrientation): TGtkPageOrientation;
+begin
+ Result := TGtkPageOrientation(Byte(Orientation));
+end;
+
+function GtkInfoNameFromConst(const InfoArr: array of TfrxInfoLinkData; const aConst: Integer): AnsiString;
+var
+ i: Integer;
+begin
+ Result := '';
+ for I := Low(InfoArr) to High(InfoArr) do
+ if InfoArr[i].Num = aConst then
+ begin
+ Result := InfoArr[i].Name;
+ break;
+ end;
+end;
+
+function InfoConstFromGtkName(const InfoArr: array of TfrxInfoLinkData; const Name: AnsiString): Integer;
+var
+ i: Integer;
+begin
+ Result := InfoArr[0].Num;
+ for I := Low(InfoArr) to High(InfoArr) do
+ if SameText(InfoArr[i].Name, Name) then
+ begin
+ Result := InfoArr[i].Num;
+ break;
+ end;
+end;
+
+function GtkPaperNameFromConst(PaperConst: Integer): AnsiString;
+begin
+ Result := GtkInfoNameFromConst(GTKPapers, PaperConst);
+end;
+
+function GtkBinNameFromConst(PaperConst: Integer): AnsiString;
+begin
+ Result := GtkInfoNameFromConst(GTKBins, PaperConst);
+end;
+
+function PaperConstFromGtkName(const PaperName: AnsiString): Integer;
+begin
+ Result := InfoConstFromGtkName(GTKPapers, PaperName);
+end;
+
+function BinConstFromGtkName(const PBinName: AnsiString): Integer;
+begin
+ Result := InfoConstFromGtkName(GTKBins, PBinName);
+end;
+
+destructor TfrxPrinter.Destroy;
+begin
+ inherited;
+ ClearGTKPapers;
+ FreeAndNil(FGTKPapers);
+ if Assigned(FPageSet) then
+ g_object_unref(FPageSet);
+ if Assigned(FSettings) then
+ g_object_unref(FSettings);
+ if Assigned(FCustomPaper) then
+ gtk_paper_size_free(FCustomPaper);
+end;
+
+procedure TfrxPrinter.Init;
+ procedure FillPapers;
+ var
+ pList, pOrgList: TPGList;
+ sName: AnsiString;
+ PSize: TPGtkPaperSize;
+ begin
+ pList := gtk_printer_list_papers(Pointer(Handle));
+ pOrgList := pList;
+ while pList <> nil do
+ begin
+ if pList.pData <> nil then
+ begin
+ PSize := gtk_page_setup_get_paper_size(pList.pData);
+ sName := AnsiString(gtk_paper_size_get_name(PSize));
+ FPapers.AddObject(String(gtk_paper_size_get_display_name(PSize)), TObject(PaperConstFromGtkName(sName)));
+ FGTKPapers.AddObject(String(sName), TObject(pList.pData))
+ end;
+ pList := TPGList(pList.pNext);
+ end;
+ g_list_free(pOrgList);
+ end;
+
+ procedure FillBins;
+ var
+ i: Integer;
+ begin
+ for i := Low(GTKBins) to High(GTKBins) do
+ FBins.AddObject(String(GTKBins[i].Name), Pointer(GTKBins[i].Num));
+ end;
+
+var
+ LPageSetup: TPGtkPageSetup;
+ LPaperSize: TPGtkPaperSize;
+ WaitTimer: TStopwatch;
+begin
+ if FInitialized then Exit;
+ FDPI := System.Classes.Point(300, 300);
+ gtk_printer_request_details(Pointer(Handle));
+ WaitTimer := TStopwatch.StartNew;
+ { wait for paper }
+ while not gtk_printer_has_details(Pointer(Handle)) and (WaitTimer.ElapsedMilliseconds < 30000) do Application.ProcessMessages;
+ WaitTimer.Stop;
+ FCanvas := TfrxLinuxCanvas.CreateFromFrxPrinter(Self);
+ FCanvas.Stroke.Kind := TBrushKind.Solid;
+ FCanvas.Stroke.Color := TAlphaColors.Black;
+ FCanvas.Fill.Kind := TBrushKind.Solid;
+ FCanvas.Fill.Color := TAlphaColors.Black;
+ FillPapers;
+ FillBins;
+ LPageSetup := gtk_printer_get_default_page_size(Pointer(FHandle));
+ if LPageSetup = nil then
+ LPageSetup := gtk_page_setup_new;
+ FPageSet := gtk_page_setup_copy(LPageSetup);
+ FSettings := gtk_print_settings_new;
+ FDefOrientation := frxGtkOrientationToFMX(gtk_page_setup_get_orientation(FPageSet));
+ LPaperSize := gtk_page_setup_get_paper_size(FPageSet);
+ FPaperHeight := gtk_page_setup_get_paper_height(FPageSet, GTK_UNIT_MM);
+ FPaperWidth := gtk_page_setup_get_paper_width(FPageSet, GTK_UNIT_MM);
+ FCustomPaper := gtk_paper_size_new_custom (PAnsiChar('frxPaper'), PAnsiChar('frxPaper'), FPaperWidth, FPaperHeight, GTK_UNIT_MM);
+ FOrientation := FDefOrientation;
+ FDefPaper := PaperConstFromGtkName(AnsiString(gtk_paper_size_get_name(LPaperSize)));
+ FDefBin := BinConstFromGtkName(AnsiString(gtk_print_settings_get_default_source(FSettings)));
+ FDefDuplex := Integer(gtk_print_settings_get_duplex(FSettings));
+ FPaper := FDefPaper;
+ FDefPaperWidth := FPaperWidth;
+ FDefPaperHeight := FPaperHeight;
+ FBin := -1;
+ FDuplex := -1;
+ FDPI.X := gtk_print_settings_get_resolution_x(FSettings);
+ FDPI.Y := gtk_print_settings_get_resolution_y(FSettings);
+ FCanvas.SetSize(Round(FPaperWidth * FDPI.X / frxDefDPIUnits * fr01cm), Round(FPaperHeight * FDPI.Y / frxDefDPIUnits * fr01cm));
+ FInitialized := True;
+ g_object_unref(LPageSetup);
+end;
+
+procedure TfrxPrinter.Abort;
+begin
+ FTerminated := True;
+end;
+
+procedure TfrxPrinter.BeginDoc;
+begin
+ if not FInitialized then Exit;
+ FTerminated := False;
+ FPrinting := True;
+ //UpdateFromDeviceCaps;
+ gtk_print_settings_set_n_copies(FSettings, 1);
+ FJob := gtk_print_job_new(PAnsiChar(AnsiString(FTitle)), Pointer(Handle), FSettings, FPageset);
+ FSurf := gtk_print_job_get_surface(FJob, nil);
+ FPrinterContext := Pointer(cairo_create(FSurf));
+ if Assigned(FPrinterContext) then
+ UpdateToDeviceCaps([fdtMargins, fdtPageSize, fdtBin, fdtDuplex, fdtOrientation])
+ else
+ raise Exception.Create('Can''t create canvas for Printer');
+
+ FIsFirst := True;
+end;
+
+procedure TfrxPrinter.BeginPage;
+begin
+ if FTerminated or not FInitialized then Exit;
+ FCanvas.BeginScene(nil, NativeInt(FPrinterContext));
+ inherited;
+ FIsFirst := False;
+end;
+
+procedure TfrxPrinter.EndDoc;
+begin
+ if not FInitialized then Exit;
+ cairo_surface_finish(FSurf);
+ FSurf := nil;
+ if not FTerminated then
+ gtk_print_job_send(FJob, nil, Pointer(Self), nil);
+ g_object_unref(FJob);
+ FJob := nil;
+ FPrinterContext := nil;
+ FPrinting := False;
+ FBin := -1;
+ FDuplex := -1;
+ FTerminated := False;
+end;
+
+procedure TfrxPrinter.EndPage;
+begin
+ if FTerminated or not FInitialized then Exit;
+ FCanvas.EndScene;
+ cairo_show_page(FPrinterContext);
+end;
+
+procedure TfrxPrinter.BeginRAWDoc;
+begin
+//todo
+end;
+
+procedure TfrxPrinter.ClearGTKPapers;
+var
+ i: Integer;
+begin
+ for i := 0 to FGTKPapers.Count - 1 do
+ g_object_unref(Pointer(FGTKPapers.Objects[i]));
+ FGTKPapers.Clear;
+end;
+
+constructor TfrxPrinter.Create(const AName: String; ADevice: NativeInt);
+begin
+ inherited Create(AName, '');
+ FHandle := ADevice;
+ FGTKPapers := TStringList.Create;
+end;
+
+procedure TfrxPrinter.EndRAWDoc;
+begin
+//todo
+end;
+
+procedure TfrxPrinter.WriteRAWDoc(const buf: AnsiString);
+begin
+//todo
+end;
+
+procedure TfrxPrinter.SetViewParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation);
+var
+ LPaperSize: TPGtkPaperSize;
+begin
+ FPaper := APaperSize;
+ FOrientation := AOrientation;
+ if not FInitialized then Exit;
+ if APaperSize = 256 then
+ begin
+ // copy the margins from A4 paper
+ SetViewParams(DMPAPER_A4, 0, 0, AOrientation);
+ FPaperHeight := APaperHeight;
+ FPaperWidth := APaperWidth;
+ end;
+ UpdateToDeviceCaps([fdtMargins, fdtPageSize, fdtOrientation]);
+ UpdateFromDeviceCaps;
+ FOrientation := AOrientation;
+ { Page setup doesnt change orientation until Job created }
+ { so we need to swap size manually. Used in page dialog }
+ LPaperSize := gtk_page_setup_get_paper_size(FPageSet);
+ if FOrientation = poPortrait then
+ begin
+ FPaperWidth := gtk_paper_size_get_width(LPaperSize, GTK_UNIT_MM);
+ FPaperHeight := gtk_paper_size_get_height(LPaperSize, GTK_UNIT_MM);
+ end
+ else
+ begin
+ FPaperHeight := gtk_paper_size_get_width(LPaperSize, GTK_UNIT_MM);
+ FPaperWidth := gtk_paper_size_get_height(LPaperSize, GTK_UNIT_MM);
+ end;
+end;
+
+function TfrxPrinter.ShowPrintDialog: Boolean;
+begin
+ Result := False;
+end;
+
+procedure TfrxPrinter.SetPrintParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
+ ABin, ADuplex, ACopies: Integer);
+var
+ ParamsToUpd: TfrxDevUpdateTypes;
+begin
+ if not FInitialized then Exit;
+ ParamsToUpd := [];
+ if FOrientation <> AOrientation then
+ Include(ParamsToUpd, fdtOrientation);
+ if (APaperSize <> FPaper) or (not SameValue(APaperWidth, FPaperWidth, 0.001) or not SameValue(APaperHeight, FPaperHeight, 0.001)) then
+ Include(ParamsToUpd, fdtPageSize);
+ if FDuplex <> ADuplex then
+ Include(ParamsToUpd, fdtDuplex);
+ if FBin <> ABin then
+ Include(ParamsToUpd, fdtBin);
+ FPaper := APaperSize;
+ FPaperHeight := APaperHeight;
+ FPaperWidth := APaperWidth;
+ FOrientation := AOrientation;
+ FBin := ABin;
+ FDuplex := ADuplex;
+ UpdateToDeviceCaps(ParamsToUpd);
+end;
+
+function TfrxPrinter.UpdateFromDeviceCaps: Boolean;
+var
+ LPSettings: TPGtkPrintSettings;
+ LPaperSize: TPGtkPaperSize;
+begin
+ Result := False;
+ if not FInitialized then Exit;
+ LPSettings := nil;
+ if Assigned(FJob) then
+ LPSettings := gtk_print_job_get_settings(FJob);
+
+ if LPSettings = nil then
+ LPSettings := FSettings;
+ FDPI.X := gtk_print_settings_get_resolution_x(FSettings);
+ FDPI.Y := gtk_print_settings_get_resolution_y(FSettings);
+ FLeftMargin := gtk_page_setup_get_left_margin(FPageSet, GTK_UNIT_MM);
+ FTopMargin := gtk_page_setup_get_top_margin(FPageSet, GTK_UNIT_MM);
+ FRightMargin := gtk_page_setup_get_right_margin(FPageSet, GTK_UNIT_MM);
+ FBottomMargin := gtk_page_setup_get_bottom_margin(FPageSet, GTK_UNIT_MM);
+
+ FOrientation := frxGtkOrientationToFMX(gtk_page_setup_get_orientation(FPageSet));
+ LPaperSize := gtk_page_setup_get_paper_size(FPageSet);
+
+ FPaperHeight := gtk_page_setup_get_paper_height(FPageSet, GTK_UNIT_MM);
+ FPaperWidth := gtk_page_setup_get_paper_width(FPageSet, GTK_UNIT_MM);
+ FPaper := PaperConstFromGtkName(gtk_paper_size_get_name(LPaperSize));
+ FBin := BinConstFromGtkName(gtk_print_settings_get_default_source(LPSettings));
+ FDuplex := Integer(gtk_print_settings_get_duplex(LPSettings));
+
+ Result := True;
+end;
+
+procedure TfrxPrinter.UpdatePageSettings;
+var
+ PaperSize: TPGtkPaperSize;
+ SurfType: TCairo_surface_type;
+ W, H: Double;
+
+ procedure SetPSSurfSize;
+ begin
+ cairo_ps_surface_set_size (FSurf, W, H);
+ cairo_ps_surface_dsc_begin_page_setup(FSurf);
+ case gtk_page_setup_get_orientation(FPageset) of
+ GTK_PAGE_ORIENTATION_PORTRAIT, GTK_PAGE_ORIENTATION_REVERSE_PORTRAIT:
+ cairo_ps_surface_dsc_comment(FSurf, '%%PageOrientation: Portrait');
+ GTK_PAGE_ORIENTATION_LANDSCAPE, GTK_PAGE_ORIENTATION_REVERSE_LANDSCAPE:
+ cairo_ps_surface_dsc_comment(FSurf, '%%PageOrientation: Landscape');
+ end;
+ end;
+begin
+ if FSurf = nil then Exit;
+
+ PaperSize := gtk_page_setup_get_paper_size(FPageset);
+ W := gtk_paper_size_get_width(PaperSize, GTK_UNIT_POINTS);
+ H := gtk_paper_size_get_height(PaperSize, GTK_UNIT_POINTS);
+ SurfType := cairo_surface_get_type(FSurf);
+
+ case SurfType of
+ CAIRO_SURFACE_TYPE_IMAGE: ;
+ CAIRO_SURFACE_TYPE_PDF: cairo_pdf_surface_set_size (FSurf, W, H);
+ CAIRO_SURFACE_TYPE_PS: SetPSSurfSize;
+ end;
+ FCanvas.SetSize(Round(FPaperWidth * FDPI.X / frxDefDPIUnits * fr01cm), Round(FPaperHeight * FDPI.Y / frxDefDPIUnits * fr01cm));
+end;
+
+function TfrxPrinter.UpdateToDeviceCaps(Params: TfrxDevUpdateTypes): Boolean;
+var
+ LPSettings: TPGtkPrintSettings;
+ LPaperSize: TPGtkPaperSize;
+ sName: AnsiString;
+ i: Integer;
+begin
+ Result := False;
+ if not FInitialized then Exit;
+ LPSettings := nil;
+ if Assigned(FJob) then
+ LPSettings := gtk_print_job_get_settings(FJob);
+
+ if LPSettings = nil then
+ LPSettings := FSettings;
+
+ if fdtOrientation in Params then
+ gtk_page_setup_set_orientation(FPageSet, frxFMXOrientationToGtk(FOrientation));
+
+ LPaperSize := gtk_page_setup_get_paper_size(FPageSet);
+
+ if fdtPageSize in Params then
+ begin
+ if FPaper <> 256 then
+ begin
+ sName := GtkPaperNameFromConst(FPaper);
+ i := FGTKPapers.IndexOf(String(sName));
+ if i <> -1 then
+ LPaperSize := gtk_page_setup_get_paper_size(FGTKPapers.Objects[i])
+ else
+ FPaper := 256;
+ end;
+ if FPaper = 256 then
+ begin
+ gtk_paper_size_set_size(FCustomPaper, FPaperWidth, FPaperHeight, GTK_UNIT_MM);
+ LPaperSize := FCustomPaper;
+ end;
+ gtk_page_setup_set_paper_size(FPageSet, LPaperSize);
+ end;
+ { TODO: Doesnt work. We should start new jobs for each new input slot }
+ if fdtBin in Params then
+ gtk_print_settings_set_default_source(LPSettings, PAnsiChar(AnsiString(GtkBinNameFromConst(FBin))));
+ if fdtDuplex in Params then
+ gtk_print_settings_set_duplex(LPSettings, TGtkPrintDuplex(FDuplex));
+
+ if fdtMargins in Params then
+ begin
+ gtk_page_setup_set_left_margin(FPageSet, FLeftMargin, GTK_UNIT_MM);
+ gtk_page_setup_set_top_margin(FPageSet, FTopMargin, GTK_UNIT_MM);
+ gtk_page_setup_set_right_margin(FPageSet, FRightMargin, GTK_UNIT_MM);
+ gtk_page_setup_set_bottom_margin(FPageSet, FBottomMargin, GTK_UNIT_MM);
+ end;
+ if fdtOrientation in Params then
+ gtk_page_setup_set_orientation(FPageSet, frxFMXOrientationToGtk(FOrientation));
+ if (fdtOrientation in Params) or (fdtPageSize in Params) then
+ UpdatePageSettings;
+ Result := True;
+end;
+
+procedure TfrxPrinter.PropertiesDlg;
+//var
+// Dlg: TPGtkPrintUnixDialog;
+begin
+// TODO need export more functions
+// Dlg := gtk_print_unix_dialog_new(PAnsiChar(AnsiString('Settings')), nil);
+// gtk_print_unix_dialog_set_page_setup(Dlg, FPageSet);
+// gtk_print_unix_dialog_set_settings(Dlg, FSettings);
+// gtk_dialog_run(Dlg);
+end;
+
+{ TfrxPrinters }
+
+constructor TfrxPrinters.Create;
+begin
+ Inherited;
+end;
+
+destructor TfrxPrinters.Destroy;
+begin
+ inherited;
+end;
+
+function TfrxPrinters.GetDefaultPrinter: String;
+var
+ i: Integer;
+begin
+ Result := '';
+ for I := 0 to FPrinterList.Count - 1 do
+ if gtk_printer_is_default(Pointer(TfrxPrinter(FPrinterList[i]).Handle)) then
+ begin
+ Result := TfrxPrinter(FPrinterList[i]).Name;
+ Break;
+ end;
+end;
+
+function PrintersEnum(printer: TPGtkPrinter; pData: Pointer): LongBool; cdecl;
+var
+ sName: String;
+ pStr: PAnsiChar;
+begin
+ Result := False;
+ if printer = nil then Exit;
+ g_object_ref(printer);
+ pStr := gtk_printer_get_name(printer);
+ gtk_printer_request_details(printer);
+ sName := String(AnsiString(pStr));
+ TfrxPrinters(pData).FPrinterList.Add(TfrxPrinter.Create(sName, NativeInt(Printer)));
+ TfrxPrinters(pData).FPrinters.Add(sName);
+end;
+
+procedure TfrxPrinters.FillPrinters;
+begin
+ Clear;
+ gtk_enumerate_printers(@PrintersEnum, Pointer(Self), nil, True);
+end;
+
+
+function ActualfrxPrinterClass : TfrxCustomPrintersClass;
+begin
+ Result := TfrxPrinters;
+end;
+
+const
+ cairoLib: String = 'libcairo.so.2';
+ ObjectsLib: String = 'libgobject-2.0.so.0';
+ GLIBLib: String = 'libglib-2.0.so.0';
+ cairoLoadError: String = 'Could not load libcairo library.';
+ GTKLib: String = 'libgtk-3.so.0';
+ GTKLoadError: String = 'Could not load GTK 3 library.';
+
+procedure InitGtkAPI;
+var
+ H: NativeInt;
+begin
+ H := LoadLibrary(PChar(cairoLib));
+ if H = 0 then raise Exception.Create(cairoLoadError);
+ cairo_surface_finish := GetProcAddress(H, 'cairo_surface_finish');
+ cairo_create := GetProcAddress(H, 'cairo_create');
+ cairo_destroy := GetProcAddress(H, 'cairo_destroy');
+ cairo_show_page := GetProcAddress(H, 'cairo_show_page');
+
+ cairo_surface_get_type := GetProcAddress(H, 'cairo_surface_get_type');
+ cairo_ps_surface_set_size := GetProcAddress(H, 'cairo_ps_surface_set_size');
+ cairo_ps_surface_dsc_begin_setup := GetProcAddress(H, 'cairo_ps_surface_dsc_begin_setup');
+ cairo_ps_surface_dsc_begin_page_setup := GetProcAddress(H, 'cairo_ps_surface_dsc_begin_page_setup');
+
+ cairo_ps_surface_dsc_comment := GetProcAddress(H, 'cairo_ps_surface_dsc_comment');
+ cairo_pdf_surface_set_size := GetProcAddress(H, 'cairo_pdf_surface_set_size');
+
+ if (@cairo_surface_finish = nil) or (@cairo_create = nil) or (@cairo_destroy = nil) or (@cairo_show_page = nil) or
+ (@cairo_surface_get_type = nil) or (@cairo_ps_surface_set_size = nil) or (@cairo_ps_surface_dsc_begin_setup = nil) or (@cairo_ps_surface_dsc_begin_page_setup = nil) or
+ (@cairo_ps_surface_dsc_comment = nil) or (@cairo_pdf_surface_set_size = nil) then
+ raise Exception.Create(cairoLoadError);
+
+ H := LoadLibrary(PChar(ObjectsLib));
+ if H = 0 then raise Exception.Create(GTKLoadError);
+ g_object_unref := GetProcAddress(H, 'g_object_unref');
+ g_object_ref := GetProcAddress(H, 'g_object_ref');
+ g_signal_connect_data := GetProcAddress(H, 'g_signal_connect_data');
+
+ H := LoadLibrary(PChar(GLIBLib));
+ if H = 0 then raise Exception.Create(GTKLoadError);
+ g_free := GetProcAddress(H, 'g_free');
+ g_list_free := GetProcAddress(H, 'g_list_free');
+
+ H := LoadLibrary(PChar(GTKLib));
+ if H = 0 then raise Exception.Create(GTKLoadError);
+
+ gtk_print_job_new := GetProcAddress(H, 'gtk_print_job_new');
+ gtk_print_job_get_surface := GetProcAddress(H, 'gtk_print_job_get_surface');
+ gtk_print_job_send := GetProcAddress(H, 'gtk_print_job_send');
+
+ gtk_printer_get_default_page_size := GetProcAddress(H, 'gtk_printer_get_default_page_size');
+ gtk_print_job_get_settings := GetProcAddress(H, 'gtk_print_job_get_settings');
+ gtk_enumerate_printers := GetProcAddress(H, 'gtk_enumerate_printers');
+ gtk_printer_list_papers := GetProcAddress(H, 'gtk_printer_list_papers');
+
+ gtk_printer_has_details := GetProcAddress(H, 'gtk_printer_has_details');
+ gtk_printer_request_details := GetProcAddress(H, 'gtk_printer_request_details');
+ gtk_printer_get_name := GetProcAddress(H, 'gtk_printer_get_name');
+ gtk_printer_is_default := GetProcAddress(H, 'gtk_printer_is_default');
+
+ if (@gtk_print_job_new = nil) or (@gtk_print_job_get_surface = nil) or (@gtk_print_job_send = nil) or
+ (@g_object_unref = nil) or (@gtk_printer_get_default_page_size = nil) or (@gtk_print_job_get_settings = nil) or
+ (@gtk_printer_has_details = nil) or (@g_free = nil) or (@gtk_printer_list_papers = nil) or
+ (@gtk_printer_request_details = nil) or (@g_free = nil) or (@gtk_printer_get_name = nil) or
+ (@g_object_ref = nil) or (@g_list_free = nil) or (@gtk_printer_is_default = nil) or
+ (@g_signal_connect_data = nil) then
+ raise Exception.Create(GTKLoadError);
+
+ gtk_print_unix_dialog_new := GetProcAddress(H, 'gtk_print_unix_dialog_new');
+ gtk_print_unix_dialog_set_page_setup := GetProcAddress(H, 'gtk_print_unix_dialog_set_page_setup');
+ gtk_print_unix_dialog_get_page_setup := GetProcAddress(H, 'gtk_print_unix_dialog_get_page_setup');
+ gtk_print_unix_dialog_set_settings := GetProcAddress(H, 'gtk_print_unix_dialog_set_settings');
+ gtk_print_unix_dialog_get_settings := GetProcAddress(H, 'gtk_print_unix_dialog_get_settings');
+ gtk_dialog_run := GetProcAddress(H, 'gtk_dialog_run');
+
+ if (@gtk_print_unix_dialog_new = nil) or (@gtk_print_unix_dialog_set_page_setup = nil) or (@gtk_print_unix_dialog_get_page_setup = nil) or
+ (@gtk_print_unix_dialog_set_settings = nil) or (@gtk_print_unix_dialog_get_settings = nil) or (@gtk_dialog_run = nil) then
+ raise Exception.Create(GTKLoadError);
+
+ gtk_page_setup_new := GetProcAddress(H, 'gtk_page_setup_new');
+ gtk_page_setup_copy := GetProcAddress(H, 'gtk_page_setup_copy');
+
+ gtk_page_setup_get_paper_size := GetProcAddress(H, 'gtk_page_setup_get_paper_size');
+ gtk_page_setup_set_paper_size := GetProcAddress(H, 'gtk_page_setup_set_paper_size');
+
+ gtk_page_setup_get_orientation := GetProcAddress(H, 'gtk_page_setup_get_orientation');
+ gtk_page_setup_set_orientation := GetProcAddress(H, 'gtk_page_setup_set_orientation');
+ gtk_page_setup_get_top_margin := GetProcAddress(H, 'gtk_page_setup_get_top_margin');
+
+ gtk_page_setup_set_top_margin := GetProcAddress(H, 'gtk_page_setup_set_top_margin');
+ gtk_page_setup_get_bottom_margin := GetProcAddress(H, 'gtk_page_setup_get_bottom_margin');
+ gtk_page_setup_set_bottom_margin := GetProcAddress(H, 'gtk_page_setup_set_bottom_margin');
+
+ gtk_page_setup_get_left_margin := GetProcAddress(H, 'gtk_page_setup_get_left_margin');
+ gtk_page_setup_set_left_margin := GetProcAddress(H, 'gtk_page_setup_set_left_margin');
+ gtk_page_setup_get_right_margin := GetProcAddress(H, 'gtk_page_setup_get_right_margin');
+
+ gtk_page_setup_set_right_margin := GetProcAddress(H, 'gtk_page_setup_set_right_margin');
+ gtk_page_setup_get_paper_width := GetProcAddress(H, 'gtk_page_setup_get_paper_width');
+ gtk_page_setup_get_paper_height := GetProcAddress(H, 'gtk_page_setup_get_paper_height');
+
+ gtk_page_setup_get_page_width := GetProcAddress(H, 'gtk_page_setup_get_page_width');
+ gtk_page_setup_get_page_height := GetProcAddress(H, 'gtk_page_setup_get_page_height');
+ if (@gtk_page_setup_new = nil) or (@gtk_page_setup_get_paper_size = nil) or (@gtk_page_setup_set_paper_size = nil) or
+ (@gtk_page_setup_get_orientation = nil) or (@gtk_page_setup_set_orientation = nil) or (@gtk_page_setup_get_top_margin = nil) or
+ (@gtk_page_setup_set_top_margin = nil) or (@gtk_page_setup_get_bottom_margin = nil) or (@gtk_page_setup_set_bottom_margin = nil) or
+ (@gtk_page_setup_get_left_margin = nil) or (@gtk_page_setup_set_left_margin = nil) or (@gtk_page_setup_get_right_margin = nil) or
+ (@gtk_page_setup_set_right_margin = nil) or (@gtk_page_setup_get_paper_width = nil) or (@gtk_page_setup_get_paper_height = nil) or
+ (@gtk_page_setup_get_page_width = nil) or (@gtk_page_setup_get_paper_size = nil) or (@gtk_page_setup_set_paper_size = nil) or
+ (@gtk_page_setup_new = nil) or (@gtk_page_setup_get_page_height = nil) or (@gtk_page_setup_copy = nil) then
+ raise Exception.Create(GTKLoadError);
+
+ gtk_paper_size_new := GetProcAddress(H, 'gtk_paper_size_new');
+ gtk_paper_size_new_from_ppd := GetProcAddress(H, 'gtk_paper_size_new_from_ppd');
+ gtk_paper_size_new_from_ipp := GetProcAddress(H, 'gtk_paper_size_new_from_ipp');
+
+ gtk_paper_size_new_custom := GetProcAddress(H, 'gtk_paper_size_new_custom');
+ gtk_paper_size_copy := GetProcAddress(H, 'gtk_paper_size_copy');
+ gtk_paper_size_free := GetProcAddress(H, 'gtk_paper_size_free');
+
+ gtk_paper_size_is_equal := GetProcAddress(H, 'gtk_paper_size_is_equal');
+ gtk_paper_size_get_name := GetProcAddress(H, 'gtk_paper_size_get_name');
+ gtk_paper_size_get_display_name := GetProcAddress(H, 'gtk_paper_size_get_display_name');
+
+ gtk_paper_size_get_ppd_name := GetProcAddress(H, 'gtk_paper_size_get_ppd_name');
+ gtk_paper_size_get_width := GetProcAddress(H, 'gtk_paper_size_get_width');
+ gtk_paper_size_get_height := GetProcAddress(H, 'gtk_paper_size_get_height');
+
+ gtk_paper_size_is_custom := GetProcAddress(H, 'gtk_paper_size_is_custom');
+ gtk_paper_size_is_ipp := GetProcAddress(H, 'gtk_paper_size_is_ipp');
+ gtk_paper_size_set_size := GetProcAddress(H, 'gtk_paper_size_set_size');
+
+ gtk_paper_size_get_default_top_margin := GetProcAddress(H, 'gtk_paper_size_get_default_top_margin');
+ gtk_paper_size_get_default_bottom_margin := GetProcAddress(H, 'gtk_paper_size_get_default_bottom_margin');
+ gtk_paper_size_get_default_left_margin := GetProcAddress(H, 'gtk_paper_size_get_default_left_margin');
+
+ gtk_paper_size_get_default_right_margin := GetProcAddress(H, 'gtk_paper_size_get_default_right_margin');
+ gtk_paper_size_get_default := GetProcAddress(H, 'gtk_paper_size_get_default');
+
+ if (@gtk_paper_size_new = nil) or (@gtk_paper_size_new_from_ppd = nil) or (@gtk_paper_size_new_from_ipp = nil) or
+ (@gtk_paper_size_new_custom = nil) or (@gtk_paper_size_copy = nil) or (@gtk_paper_size_free = nil) or
+ (@gtk_paper_size_is_equal = nil) or (@gtk_paper_size_get_name = nil) or (@gtk_paper_size_get_display_name = nil) or
+ (@gtk_paper_size_get_ppd_name = nil) or (@gtk_paper_size_get_width = nil) or (@gtk_paper_size_get_height = nil) or
+ (@gtk_paper_size_is_custom = nil) or (@gtk_paper_size_is_ipp = nil) or (@gtk_paper_size_set_size = nil) or
+ (@gtk_paper_size_get_default_top_margin = nil) or (@gtk_paper_size_get_default_bottom_margin = nil) or (@gtk_paper_size_get_default_left_margin = nil) or
+ (@gtk_paper_size_get_default_right_margin = nil) or (@gtk_paper_size_get_default = nil) then
+ raise Exception.Create(GTKLoadError);
+
+ gtk_print_settings_new := GetProcAddress(H, 'gtk_print_settings_new');
+ gtk_print_settings_get_printer := GetProcAddress(H, 'gtk_print_settings_get_printer');
+ gtk_print_settings_set_printer := GetProcAddress(H, 'gtk_print_settings_set_printer');
+
+ gtk_print_settings_get_orientation := GetProcAddress(H, 'gtk_print_settings_get_orientation');
+ gtk_print_settings_set_orientation := GetProcAddress(H, 'gtk_print_settings_set_orientation');
+ gtk_print_settings_get_paper_size := GetProcAddress(H, 'gtk_print_settings_get_paper_size');
+
+ gtk_print_settings_set_paper_size := GetProcAddress(H, 'gtk_print_settings_set_paper_size');
+ gtk_print_settings_get_paper_width := GetProcAddress(H, 'gtk_print_settings_get_paper_width');
+ gtk_print_settings_set_paper_width := GetProcAddress(H, 'gtk_print_settings_set_paper_width');
+
+ gtk_print_settings_get_paper_height := GetProcAddress(H, 'gtk_print_settings_get_paper_height');
+ gtk_print_settings_set_paper_height := GetProcAddress(H, 'gtk_print_settings_set_paper_height');
+ gtk_print_settings_get_collate := GetProcAddress(H, 'gtk_print_settings_get_collate');
+
+ gtk_print_settings_set_collate := GetProcAddress(H, 'gtk_print_settings_set_collate');
+ gtk_print_settings_get_duplex := GetProcAddress(H, 'gtk_print_settings_get_duplex');
+ gtk_print_settings_set_duplex := GetProcAddress(H, 'gtk_print_settings_set_duplex');
+
+ gtk_print_settings_get_n_copies := GetProcAddress(H, 'gtk_print_settings_get_n_copies');
+ gtk_print_settings_set_n_copies := GetProcAddress(H, 'gtk_print_settings_set_n_copies');
+ gtk_print_settings_get_resolution_x := GetProcAddress(H, 'gtk_print_settings_get_resolution_x');
+
+ gtk_print_settings_get_resolution_y := GetProcAddress(H, 'gtk_print_settings_get_resolution_y');
+ gtk_print_settings_get_default_source := GetProcAddress(H, 'gtk_print_settings_get_default_source');
+ gtk_print_settings_set_default_source := GetProcAddress(H, 'gtk_print_settings_set_default_source');
+
+ gtk_print_settings_get_media_type := GetProcAddress(H, 'gtk_print_settings_get_media_type');
+ gtk_print_settings_set_media_type := GetProcAddress(H, 'gtk_print_settings_set_media_type');
+ gtk_print_settings_get_output_bin := GetProcAddress(H, 'gtk_print_settings_get_output_bin');
+
+ gtk_print_settings_set_output_bin := GetProcAddress(H, 'gtk_print_settings_set_output_bin');
+
+ if (@gtk_print_settings_new = nil) or (@gtk_print_settings_get_printer = nil) or (@gtk_print_settings_set_printer = nil) or
+ (@gtk_print_settings_get_orientation = nil) or (@gtk_print_settings_set_orientation = nil) or (@gtk_print_settings_get_paper_size = nil) or
+ (@gtk_print_settings_set_paper_size = nil) or (@gtk_print_settings_get_paper_width = nil) or (@gtk_print_settings_set_paper_width = nil) or
+ (@gtk_print_settings_get_paper_height = nil) or (@gtk_print_settings_set_paper_height = nil) or (@gtk_print_settings_get_collate = nil) or
+ (@gtk_print_settings_set_collate = nil) or (@gtk_print_settings_get_duplex = nil) or (@gtk_print_settings_set_duplex = nil) or
+ (@gtk_print_settings_get_n_copies = nil) or (@gtk_print_settings_set_n_copies = nil) or (@gtk_print_settings_get_resolution_x = nil) or
+ (@gtk_print_settings_get_resolution_y = nil) or (@gtk_print_settings_get_default_source = nil) or (@gtk_print_settings_set_default_source = nil) or
+ (@gtk_print_settings_get_media_type = nil) or (@gtk_print_settings_set_media_type = nil) or (@gtk_print_settings_get_output_bin = nil) or
+ (@gtk_print_settings_set_output_bin = nil) then
+ raise Exception.Create(GTKLoadError);
+end;
+
+initialization
+ InitGtkAPI;
+
+finalization
+
+end.
diff --git a/LibD28x64/FMX.Mac.frxPrinter.pas b/LibD28x64/FMX.Mac.frxPrinter.pas
new file mode 100644
index 0000000..24aa39c
--- /dev/null
+++ b/LibD28x64/FMX.Mac.frxPrinter.pas
@@ -0,0 +1,529 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Printer }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.Mac.frxPrinter;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.SysUtils, System.Types, System.UITypes, System.Variants,
+ FMX.Types, FMX.frxPrinter, FMX.Printer.Mac, FMX.Printer
+{$IFDEF DELPHI27}
+ ,System.Rtti, FMX.frxCanvas.Mac
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+
+type
+ THackCanvas = class(TCanvas);
+ THackPrinter = class(TPrinter);
+
+
+ TfrxPrinter = class(TfrxCustomPrinter)
+ private
+ //FDriver: String;
+ //FPrintDLG: TPrintDialog;
+ //FOnChangedFont: TNotifyEvent;
+ FIsFirst: Boolean;
+ public
+ constructor Create(const AName, APort: String); override;
+ destructor Destroy; override;
+ procedure Init; override;
+ procedure Abort; override;
+ procedure BeginDoc; override;
+ procedure BeginPage; override;
+ procedure BeginRAWDoc; override;
+ procedure EndDoc; override;
+ procedure EndPage; override;
+ procedure EndRAWDoc; override;
+ procedure WriteRAWDoc(const buf: AnsiString); override;
+ procedure SetViewParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended;
+ AOrientation: TPrinterOrientation); override;
+ procedure SetPrintParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
+ ABin, ADuplex, ACopies: Integer); override;
+ procedure PropertiesDlg; override;
+ function ShowPrintDialog: Boolean; override;
+ function UpdateDeviceCaps: Boolean;
+ end;
+
+
+ TfrxPrinters = class(TfrxCustomPrinters)
+ protected
+ function GetDefaultPrinter: String; override;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure FillPrinters; override;
+ end;
+
+
+
+function frxGetPaperDimensions(PaperSize: Integer; var Width, Height: Extended): Boolean;
+function ActualfrxPrinterClass : TfrxCustomPrintersClass;
+
+
+implementation
+
+uses
+ FMX.frxUtils, FMX.frxRes, FMX.frxFMX, FMX.Forms, Macapi.CoreServices, Macapi.CoreFoundation, Macapi.Foundation,
+ Macapi.CocoaTypes, Macapi.AppKit;
+
+
+const
+{$IFDEF MACOS64}
+ libPrintCore = '/System/Library/Frameworks/ApplicationServices.framework/ApplicationServices';
+{$ELSE}
+ libPrintCore = '/System/Library/Frameworks/ApplicationServices.framework/Frameworks/PrintCore.framework/PrintCore';
+{$ENDIF}
+ kPMCancel = 128;
+{$IFDEF UNDERSCOREIMPORTNAME}
+ _PFX = '_';
+{$ELSE}
+ _PFX = '';
+{$ENDIF}
+{$EXTERNALSYM _PFX}
+
+function PMGetCopies(printSettings: PMPrintSettings; copies: PUInt32): OSStatus; cdecl; external libPrintCore name _PFX + 'PMGetCopies';
+function PMSetCopies(printSettings: PMPrintSettings; copies: UInt32; lock: Boolean): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSetCopies';
+function PMGetAdjustedPageRect(pageFormat: PMPageFormat; pageRect: PPMRect): OSStatus; cdecl; external libPrintCore name _PFX + 'PMGetAdjustedPageRect';
+function PMGetAdjustedPaperRect(pageFormat: PMPageFormat; paperRect: PPMRect): OSStatus; cdecl; external libPrintCore name _PFX + 'PMGetAdjustedPaperRect';
+function PMGetPageFormatPaper(format: PMPageFormat; paper: PPMPaper): OSStatus; cdecl; external libPrintCore name _PFX + 'PMGetPageFormatPaper';
+function PMPaperGetHeight(paper: PMPaper; paperHeight: PDouble): OSStatus; cdecl; external libPrintCore name _PFX + 'PMPaperGetHeight';
+function PMPaperGetWidth(paper: PMPaper; paperWidth: PDouble): OSStatus; cdecl; external libPrintCore name _PFX + 'PMPaperGetWidth';
+function PMPaperGetMargins(paper: PMPaper; paperMargins: PPMPaperMargins): OSStatus; cdecl; external libPrintCore name _PFX + 'PMPaperGetMargins';
+function PMPrinterGetDriverCreator(printer: PMPrinter; creator: POSType): OSStatus; cdecl; external libPrintCore name _PFX + 'PMPrinterGetDriverCreator';
+function PMPrinterGetDriverReleaseInfo(printer: PMPrinter; release: VersRecPtr): OSStatus; cdecl; external libPrintCore name _PFX + 'PMPrinterGetDriverReleaseInfo';
+function PMPrinterGetID(printer: PMPrinter): CFStringRef; cdecl; external libPrintCore name _PFX + 'PMPrinterGetID';
+function PMPrinterGetMakeAndModelName(printer: PMPrinter; makeAndModel: PCFStringRef): OSStatus; cdecl; external libPrintCore name _PFX + 'PMPrinterGetMakeAndModelName';
+function PMPrinterGetName(printer: PMPrinter): CFStringRef; cdecl; external libPrintCore name _PFX + 'PMPrinterGetName';
+function PMPrinterIsDefault(printer: PMPrinter): Boolean; cdecl; external libPrintCore name _PFX + 'PMPrinterIsDefault';
+function PMPrinterSetOutputResolution(printer: PMPrinter; printSettings: PMPrintSettings; resolutionP: PPMResolution): OSStatus; cdecl; external libPrintCore name _PFX + 'PMPrinterSetOutputResolution';
+function PMPrinterGetPrinterResolutionCount(printer: PMPrinter; countP: PUInt32): OSStatus; cdecl; external libPrintCore name _PFX + 'PMPrinterGetPrinterResolutionCount';
+function PMPrinterGetIndexedPrinterResolution(printer: PMPrinter; index: UInt32; resolutionP: PPMResolution): OSStatus; cdecl; external libPrintCore name _PFX + 'PMPrinterGetIndexedPrinterResolution';
+function PMPrinterGetOutputResolution(printer: PMPrinter; printSettings: PMPrintSettings; resolutionP: PPMResolution): OSStatus; cdecl; external libPrintCore name _PFX + 'PMPrinterGetOutputResolution';
+function PMServerCreatePrinterList(server: PMServer; printerList: PCFArrayRef): OSStatus; cdecl; external libPrintCore name _PFX + 'PMServerCreatePrinterList';
+function PMSessionBeginCGDocumentNoDialog(printSession: PMPrintSession; printSettings: PMPrintSettings; pageFormat: PMPageFormat): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSessionBeginCGDocumentNoDialog';
+function PMSessionBeginPageNoDialog(printSession: PMPrintSession; pageFormat: PMPageFormat; pageFrame: PPMRect): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSessionBeginPageNoDialog';
+function PMSessionDefaultPageFormat(printSession: PMPrintSession; pageFormat: PMPageFormat): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSessionDefaultPageFormat';
+function PMSessionDefaultPrintSettings(printSession: PMPrintSession; printSettings: PMPrintSettings): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSessionDefaultPrintSettings';
+function PMSessionEndDocumentNoDialog(printSession: PMPrintSession): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSessionEndDocumentNoDialog';
+function PMSessionEndPageNoDialog(printSession: PMPrintSession): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSessionEndPageNoDialog';
+function PMSessionSetCurrentPMPrinter(session: PMPrintSession; printer: PMPrinter): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSessionSetCurrentPMPrinter';
+function PMSessionSetError(printSession: PMPrintSession; printError: OSStatus): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSessionSetError';
+function PMSessionValidatePageFormat(printSession: PMPrintSession; pageFormat: PMPageFormat; result: PBoolean): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSessionValidatePageFormat';
+function PMSessionValidatePrintSettings(printSession: PMPrintSession; printSettings: PMPrintSettings; result: PBoolean): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSessionValidatePrintSettings';
+function PMSessionSetDestination(printSession: PMPrintSession; printSettings: PMPrintSettings; destType: PMDestinationType; destFormat: CFStringRef; destLocation: CFURLRef): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSessionSetDestination';
+function PMSetOrientation(pageFormat: PMPageFormat; orientation: PMOrientation; lock: Boolean): OSStatus; cdecl; external libPrintCore name _PFX + 'PMSetOrientation';
+
+type
+ TPaperInfo = {packed} record
+ Typ: Integer;
+ Name: String;
+ X, Y: Integer;
+ end;
+
+
+const
+ PAPERCOUNT = 66;
+ PaperInfo: array[0..PAPERCOUNT - 1] of TPaperInfo = (
+ (Typ:1; Name: ''; X:2159; Y:2794),
+ (Typ:2; Name: ''; X:2159; Y:2794),
+ (Typ:3; Name: ''; X:2794; Y:4318),
+ (Typ:4; Name: ''; X:4318; Y:2794),
+ (Typ:5; Name: ''; X:2159; Y:3556),
+ (Typ:6; Name: ''; X:1397; Y:2159),
+ (Typ:7; Name: ''; X:1842; Y:2667),
+ (Typ:8; Name: ''; X:2970; Y:4200),
+ (Typ:9; Name: ''; X:2100; Y:2970),
+ (Typ:10; Name: ''; X:2100; Y:2970),
+ (Typ:11; Name: ''; X:1480; Y:2100),
+ (Typ:12; Name: ''; X:2500; Y:3540),
+ (Typ:13; Name: ''; X:1820; Y:2570),
+ (Typ:14; Name: ''; X:2159; Y:3302),
+ (Typ:15; Name: ''; X:2150; Y:2750),
+ (Typ:16; Name: ''; X:2540; Y:3556),
+ (Typ:17; Name: ''; X:2794; Y:4318),
+ (Typ:18; Name: ''; X:2159; Y:2794),
+ (Typ:19; Name: ''; X:984; Y:2254),
+ (Typ:20; Name: ''; X:1048; Y:2413),
+ (Typ:21; Name: ''; X:1143; Y:2635),
+ (Typ:22; Name: ''; X:1207; Y:2794),
+ (Typ:23; Name: ''; X:1270; Y:2921),
+ (Typ:24; Name: ''; X:4318; Y:5588),
+ (Typ:25; Name: ''; X:5588; Y:8636),
+ (Typ:26; Name: ''; X:8636; Y:11176),
+ (Typ:27; Name: ''; X:1100; Y:2200),
+ (Typ:28; Name: ''; X:1620; Y:2290),
+ (Typ:29; Name: ''; X:3240; Y:4580),
+ (Typ:30; Name: ''; X:2290; Y:3240),
+ (Typ:31; Name: ''; X:1140; Y:1620),
+ (Typ:32; Name: ''; X:1140; Y:2290),
+ (Typ:33; Name: ''; X:2500; Y:3530),
+ (Typ:34; Name: ''; X:1760; Y:2500),
+ (Typ:35; Name: ''; X:1760; Y:1250),
+ (Typ:36; Name: ''; X:1100; Y:2300),
+ (Typ:37; Name: ''; X:984; Y:1905),
+ (Typ:38; Name: ''; X:920; Y:1651),
+ (Typ:39; Name: ''; X:3778; Y:2794),
+ (Typ:40; Name: ''; X:2159; Y:3048),
+ (Typ:41; Name: ''; X:2159; Y:3302),
+ (Typ:42; Name: ''; X:2500; Y:3530),
+ (Typ:43; Name: ''; X:1000; Y:1480),
+ (Typ:44; Name: ''; X:2286; Y:2794),
+ (Typ:45; Name: ''; X:2540; Y:2794),
+ (Typ:46; Name: ''; X:3810; Y:2794),
+ (Typ:47; Name: ''; X:2200; Y:2200),
+ (Typ:50; Name: ''; X:2355; Y:3048),
+ (Typ:51; Name: ''; X:2355; Y:3810),
+ (Typ:52; Name: ''; X:2969; Y:4572),
+ (Typ:53; Name: ''; X:2354; Y:3223),
+ (Typ:54; Name: ''; X:2101; Y:2794),
+ (Typ:55; Name: ''; X:2100; Y:2970),
+ (Typ:56; Name: ''; X:2355; Y:3048),
+ (Typ:57; Name: ''; X:2270; Y:3560),
+ (Typ:58; Name: ''; X:3050; Y:4870),
+ (Typ:59; Name: ''; X:2159; Y:3223),
+ (Typ:60; Name: ''; X:2100; Y:3300),
+ (Typ:61; Name: ''; X:1480; Y:2100),
+ (Typ:62; Name: ''; X:1820; Y:2570),
+ (Typ:63; Name: ''; X:3220; Y:4450),
+ (Typ:64; Name: ''; X:1740; Y:2350),
+ (Typ:65; Name: ''; X:2010; Y:2760),
+ (Typ:66; Name: ''; X:4200; Y:5940),
+ (Typ:67; Name: ''; X:2970; Y:4200),
+ (Typ:68; Name: ''; X:3220; Y:4450));
+
+
+function frxGetPaperDimensions(PaperSize: Integer; var Width, Height: Extended): Boolean;
+var
+ i: Integer;
+begin
+ Result := False;
+ for i := 0 to PAPERCOUNT - 1 do
+ if PaperInfo[i].Typ = PaperSize then
+ begin
+ Width := PaperInfo[i].X / 10;
+ Height := PaperInfo[i].Y / 10;
+ Result := True;
+ break;
+ end;
+end;
+
+destructor TfrxPrinter.Destroy;
+begin
+ inherited;
+ //FPrintDLG.Free;
+end;
+
+procedure TfrxPrinter.Init;
+begin
+ if FInitialized then Exit;
+ UpdateDeviceCaps;
+ FDefOrientation := TPrinterMac(FMX.Printer.Printer).Orientation;
+ FOrientation := FDefOrientation;
+ FPaperHeight := TPrinterMac(FMX.Printer.Printer).PrintInfo.paperSize.height;
+ FPaperWidth := TPrinterMac(FMX.Printer.Printer).PrintInfo.paperSize.width;
+
+ FDefPaper := 256;
+ FDefBin := 0;
+ FDefDuplex := 0;
+ FPaper := FDefPaper;
+ FDefPaperWidth := FPaperWidth;
+ FDefPaperHeight := FPaperHeight;
+ FOrientation := FDefOrientation;
+ FBin := -1;
+ FDuplex := -1;
+
+ FInitialized := True;
+
+ FBin := -1;
+ FDuplex := -1;
+
+ FInitialized := True;
+end;
+
+procedure TfrxPrinter.Abort;
+begin
+ FMX.Printer.Printer.EndDoc;
+end;
+
+procedure TfrxPrinter.BeginDoc;
+begin
+ FPrinting := True;
+ FCanvas := TPrinterMac(FMX.Printer.Printer).Canvas;
+ FIsFirst := True;
+ UpdateDeviceCaps;
+ FMX.Printer.Printer.BeginDoc;
+ FCanvas := TPrinterMac(FMX.Printer.Printer).Canvas;
+end;
+
+procedure TfrxPrinter.BeginPage;
+begin
+ inherited;
+
+ if not (FIsFirst) then
+ begin
+ with TPrinterMac(FMX.Printer.Printer).PrintInfo do
+ begin
+ PMSessionBeginPageNoDialog(PMPrintSession, PMPageFormat, nil);
+ end;
+ TPrinterMac(FMX.Printer.Printer).Canvas.BeginScene;
+ end;
+ FIsFirst := False;
+end;
+
+procedure TfrxPrinter.EndDoc;
+begin
+
+ FPaperHeight := FMX.Printer.Printer.PageHeight;
+ FPaperWidth := FMX.Printer.Printer.PageWidth;
+ //FMX.Printer.Printer.EndDoc;
+
+ PMSessionEndDocumentNoDialog(TPrinterMac(FMX.Printer.Printer).PrintInfo.PMPrintSession);
+{$IFDEF DELPHI25}
+ try
+ if TPrinterMac(FMX.Printer.Printer).Canvas.BeginSceneCount > 0 then
+ TPrinterMac(FMX.Printer.Printer).Canvas.EndScene;
+ except
+ end;
+{$ELSE}
+ TPrinterMac(FMX.Printer.Printer).Canvas.EndScene;
+{$ENDIF}
+ FPrinting := False;
+ THackPrinter(FMX.Printer.Printer).FPrinting := False;
+ FBin := -1;
+ FDuplex := -1;
+end;
+
+procedure TfrxPrinter.EndPage;
+begin
+ TPrinterMac(FMX.Printer.Printer).Canvas.EndScene;
+ with TPrinterMac(FMX.Printer.Printer).PrintInfo do
+ begin
+ PMSessionEndPageNoDialog(PMPrintSession);
+ end;
+end;
+
+procedure TfrxPrinter.BeginRAWDoc;
+begin
+//todo
+end;
+
+procedure TfrxPrinter.EndRAWDoc;
+begin
+//todo
+end;
+
+procedure TfrxPrinter.WriteRAWDoc(const buf: AnsiString);
+begin
+ //todo
+end;
+
+constructor TfrxPrinter.Create(const AName, APort: String);
+begin
+ inherited Create(AName, APort);
+ //FPrintDLG := TPrintDialog.Create(nil);
+end;
+
+procedure TfrxPrinter.SetViewParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation);
+begin
+ {if APaperSize <> 256 then
+ begin
+
+ if not UpdateDeviceCaps then Exit;
+ end
+ else
+ begin
+ // copy the margins from A4 paper
+ SetViewParams(DMPAPER_A4, 0, 0, AOrientation);
+ FPaperHeight := APaperHeight;
+ FPaperWidth := APaperWidth;
+ end; }
+
+ FPaper := APaperSize;
+ FOrientation := AOrientation;
+end;
+
+function TfrxPrinter.ShowPrintDialog: Boolean;
+begin
+// Result := FPrintDLG.Execute;
+ Result := False;
+end;
+
+procedure TfrxPrinter.SetPrintParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
+ ABin, ADuplex, ACopies: Integer);
+var
+ sSize: NSSize;
+ Changed: Boolean;
+ lOrientation: NSPrintingOrientation;
+begin
+
+ { later fix these values }
+ FPaper := APaperSize;
+ sSize.Height := APaperHeight * 2.835;
+ sSize.Width := APaperWidth * 2.835;
+
+ if AOrientation = TPrinterOrientation.poPortrait then
+ lOrientation := NSPortraitOrientation
+ else
+ lOrientation := NSLandscapeOrientation;
+
+ TPrinterMac(FMX.Printer.Printer).PrintInfo.setPaperSize(sSize);
+
+ with TPrinterMac(FMX.Printer.Printer) do
+ begin
+ //kPMPortrait = 1
+ //kPMLandscape = 2
+ //PMSetOrientation(PrintInfo.PMPageFormat, lOrientation + 1, false);
+ PMSessionValidatePageFormat(PrintInfo.PMPrintSession, PrintInfo.PMPageFormat, @Changed);
+ end;
+ TPrinterMac(FMX.Printer.Printer).PrintInfo.setOrientation(lOrientation);
+ TPrinterMac(FMX.Printer.Printer).PrintInfo.updateFromPMPageFormat;
+ FPaperHeight := TPrinterMac(FMX.Printer.Printer).PrintInfo.paperSize.height;
+ FPaperWidth := TPrinterMac(FMX.Printer.Printer).PrintInfo.paperSize.width;
+{$IFDEF DELPHI18}
+ TPrinterMac(FMX.Printer.Printer).Canvas.SetSize(Round(FPaperWidth), Round(FPaperHeight));
+{$ELSE}
+ TPrinterMac(FMX.Printer.Printer).Canvas.ResizeBuffer(Round(FPaperWidth), Round(FPaperHeight));
+{$ENDIF}
+ FOrientation := AOrientation;
+ UpdateDeviceCaps;
+end;
+
+function TfrxPrinter.UpdateDeviceCaps: Boolean;
+var
+ Idx: Integer;
+begin
+ FCanvas := TPrinterMac(FMX.Printer.Printer).Canvas;
+ FPaperHeight := TPrinterMac(FMX.Printer.Printer).PrintInfo.paperSize.height;
+ FPaperWidth := TPrinterMac(FMX.Printer.Printer).PrintInfo.paperSize.width;
+ Idx := FMX.Printer.Printer.ActivePrinter.ActiveDPIIndex;
+
+ if Idx <> -1 then
+ begin
+ FDPI.X := FMX.Printer.Printer.ActivePrinter.DPI[Idx].X;
+ FDPI.y := FMX.Printer.Printer.ActivePrinter.DPI[Idx].Y;
+ end
+ else if FMX.Printer.Printer.ActivePrinter.DPICount > 0 then
+ begin
+ FDPI.X := FMX.Printer.Printer.ActivePrinter.DPI[0].X;
+ FDPI.y := FMX.Printer.Printer.ActivePrinter.DPI[0].Y;
+ end
+ else
+ begin
+ FDPI := System.Classes.Point(72, 72);
+ end;
+
+ FLeftMargin := TPrinterMac(FMX.Printer.Printer).PrintInfo.imageablePageBounds.origin.x / 3;
+ FTopMargin := TPrinterMac(FMX.Printer.Printer).PrintInfo.imageablePageBounds.origin.y / 3;
+ FBottomMargin := FPaperHeight - TPrinterMac(FMX.Printer.Printer).PrintInfo.imageablePageBounds.size.height / 3 - FTopMargin;
+ FRightMargin := FPaperWidth - TPrinterMac(FMX.Printer.Printer).PrintInfo.imageablePageBounds.size.width / 3 - FLeftMargin;
+ Result := True;
+ { Result := True;
+ if FDC = 0 then GetDC;
+
+ FDPI := Point(GetDeviceCaps(FDC, LOGPIXELSX), GetDeviceCaps(FDC, LOGPIXELSY));
+ if (FDPI.X = 0) or (FDPI.Y = 0) then
+ begin
+ Result := False;
+ frxErrorMsg('Printer selected is not valid');
+ Exit;
+ end;
+ FPaperHeight := Round(GetDeviceCaps(FDC, PHYSICALHEIGHT) / FDPI.Y * 25.4);
+ FPaperWidth := Round(GetDeviceCaps(FDC, PHYSICALWIDTH) / FDPI.X * 25.4);
+ FLeftMargin := Round(GetDeviceCaps(FDC, PHYSICALOFFSETX) / FDPI.X * 25.4);
+ FTopMargin := Round(GetDeviceCaps(FDC, PHYSICALOFFSETY) / FDPI.Y * 25.4);
+ FRightMargin := FPaperWidth - Round(GetDeviceCaps(FDC, HORZRES) / FDPI.X * 25.4) - FLeftMargin;
+ FBottomMargin := FPaperHeight - Round(GetDeviceCaps(FDC, VERTRES) / FDPI.Y * 25.4) - FTopMargin;}
+end;
+
+procedure TfrxPrinter.PropertiesDlg;
+begin
+ //todo
+end;
+
+{ TfrxPrinters }
+
+constructor TfrxPrinters.Create;
+begin
+ Inherited;
+end;
+
+destructor TfrxPrinters.Destroy;
+begin
+ inherited;
+end;
+
+
+
+function TfrxPrinters.GetDefaultPrinter: String;
+begin
+ Result := FMX.Printer.Printer.ActivePrinter.Device;
+end;
+
+
+procedure TfrxPrinters.FillPrinters;
+var
+ i: Integer;
+ LPrinter: TPrinter;
+{$IFDEF DELPHI27}
+ RtCtx: TRttiContext;
+ RtFd: TRttiField;
+ Val: TValue;
+
{$ENDIF}
+
+ procedure AddPrinter(ADevice, APort: String);
+ begin
+ FPrinterList.Add(TfrxPrinter.Create(ADevice, APort));
+ FPrinters.Add(ADevice);
+ end;
+
+begin
+ Clear;
+ LPrinter := FMX.Printer.Printer;
+{$IFDEF DELPHI27}
+ RtCtx := TRttiContext.Create;
+ try
+ RtFd := RtCtx.GetType(TPrinterMac).GetField('FCanvas');
+ if Assigned(RtFd) then
+ begin
+ TValue.Make(TfrxCanvasQuartz.CreateFromPrinter(LPrinter), Val);
+ RtFd.SetValue(LPrinter, Val);
+ end;
+ finally
+ RtCtx.Free;
+ end;
+{$ENDIF}
+ for i := 0 to LPrinter.Count - 1 do
+ AddPrinter(LPrinter.Printers[i].Device, LPrinter.Printers[i].Port);
+end;
+
+function ActualfrxPrinterClass : TfrxCustomPrintersClass;
+begin
+ Result := TfrxPrinters;
+end;
+
+initialization
+
+finalization
+
+end.
+
diff --git a/LibD28x64/FMX.TTFHelpers.pas b/LibD28x64/FMX.TTFHelpers.pas
new file mode 100644
index 0000000..bdb06c3
--- /dev/null
+++ b/LibD28x64/FMX.TTFHelpers.pas
@@ -0,0 +1,68 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Font parser }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Aleksey Mandrykin, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.TTFHelpers;
+
+interface
+
+type
+
+TTF_Helpers = class abstract
+ // Methods
+ strict protected constructor Create;
+ public class function Increment(ptr: Pointer; cbSize: Integer): Pointer; static;
+ public class function SwapInt16(v: Smallint): Smallint; static;
+ public class function SwapInt32(v: Integer): Integer; static;
+ public class function SwapUInt16(v: Word): Word; static;
+ public class function SwapUInt32(v: Cardinal): Cardinal; static;
+ public class function SwapUInt64(v: UInt64): UInt64; static;
+
+end;
+
+implementation
+
+// Methods
+ constructor TTF_Helpers.Create;
+ begin
+ end;
+
+ class function TTF_Helpers.Increment(ptr: Pointer; cbSize: Integer): Pointer;
+ begin
+ Result := Pointer(NativeInt(ptr) + cbSize)
+ end;
+
+ class function TTF_Helpers.SwapInt16(v: Smallint): Smallint;
+ begin
+ Result := Smallint((((v and $ff) shl 8) or ((v shr 8) and $ff)))
+ end;
+
+ class function TTF_Helpers.SwapInt32(v: Integer): Integer;
+ begin
+ Result := ((TTF_Helpers.SwapInt16(Smallint(v)) and $ffff) shl $10) or (TTF_Helpers.SwapInt16(Smallint(v shr $10)) and $ffff)
+ end;
+
+ class function TTF_Helpers.SwapUInt16(v: Word): Word;
+ begin
+ Result := Word((((v and $ff) shl 8) or ((v shr 8) and $ff)))
+ end;
+
+ class function TTF_Helpers.SwapUInt32(v: Cardinal): Cardinal;
+ begin
+ Result := Cardinal((((TTF_Helpers.SwapUInt16(Word(v)) and $ffff) shl $10) or (TTF_Helpers.SwapUInt16(Word(v shr $10)) and $ffff)))
+ end;
+
+ class function TTF_Helpers.SwapUInt64(v: UInt64): UInt64;
+ begin
+ Result := (((TTF_Helpers.SwapUInt32(Cardinal(v)) and $ffffffff) shl $20) or (TTF_Helpers.SwapUInt32((Cardinal(v shr $20))) and $ffffffff))
+ end;
+
+ end.
+
diff --git a/LibD28x64/FMX.Win.frxPrinter.pas b/LibD28x64/FMX.Win.frxPrinter.pas
new file mode 100644
index 0000000..36c6a53
--- /dev/null
+++ b/LibD28x64/FMX.Win.frxPrinter.pas
@@ -0,0 +1,901 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Printer }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.Win.frxPrinter;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.SysUtils, Winapi.Windows, Winapi.WinSpool, System.Types, System.UITypes, System.Variants,
+ FMX.Types, FMX.frxPrinter, FMX.Printer.Win, FMX.Printer, FMX.Canvas.GDIP, FMX.frxClass
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+
+type
+ THackCanvas = class(TCanvas);
+// Fake printer used only for canvas creation
+ TFakePrinterWin = class(TPrinterWin)
+ protected
+ FPageHeight: Integer;
+ FPageWidth: Integer;
+ FCanvas: TCanvas;
+ procedure ActivePrinterChanged; override;
+ procedure DoAbortDoc; override;
+ procedure DoBeginDoc; override;
+ procedure DoEndDoc; override;
+ procedure DoNewPage; override;
+ function GetCanvas: TCanvas; override;
+ function GetNumCopies: Integer; override;
+ function GetOrientation: TPrinterOrientation; override;
+ function GetPageHeight: Integer; override;
+ function GetPageWidth: Integer; override;
+ function GetCapabilities: TPrinterCapabilities; override;
+ procedure RefreshFonts; override;
+ procedure RefreshPrinterDevices; override;
+ procedure SetOrientation(Value: TPrinterOrientation); override;
+ procedure SetNumCopies(Value: Integer); override;
+ procedure SetDefaultPrinter; override;
+ public
+ constructor Create; override;
+ destructor Destroy; override;
+ end;
+
+ TfrxPrinter = class(TfrxCustomPrinter)
+ private
+ FDeviceMode: THandle;
+ FDC: HDC;
+ FDriver: String;
+ FMode: PDeviceMode;
+ FWinPrinter: TFakePrinterWin;
+ FOldWinPrinter: TPrinterWin;
+ FOnChangedFont: TNotifyEvent;
+ procedure CreateDevMode;
+ procedure FreeDevMode;
+ procedure GetDC;
+ procedure FontChanged(Sender: TObject);
+ public
+ constructor Create(const AName, APort: String); override;
+ destructor Destroy; override;
+ procedure Init; override;
+ procedure RecreateDC;
+ procedure Abort; override;
+ procedure BeginDoc; override;
+ procedure BeginPage; override;
+ procedure BeginRAWDoc; override;
+ procedure EndDoc; override;
+ procedure EndPage; override;
+ procedure EndRAWDoc; override;
+ procedure WriteRAWDoc(const buf: AnsiString); override;
+ procedure SetViewParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended;
+ AOrientation: TPrinterOrientation); override;
+ procedure SetPrintParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
+ ABin, ADuplex, ACopies: Integer); override;
+ procedure PropertiesDlg; override;
+ function ShowPrintDialog: Boolean; override;
+ function UpdateDeviceCaps: Boolean;
+ property DeviceMode: PDeviceMode read FMode;
+ end;
+
+
+ TfrxPrinters = class(TfrxCustomPrinters)
+ protected
+ function GetDefaultPrinter: String; override;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure FillPrinters; override;
+ end;
+
+ TfrxPrinterCanvas = class(TCanvas)
+{$IFNDEF FMX}
+ private
+ FPrinter: TfrxCustomPrinter;
+ procedure UpdateFont;
+ public
+ procedure Changing; override;
+{$ENDIF}
+ end;
+
+
+
+function frxGetPaperDimensions(PaperSize: Integer; var Width, Height: Extended): Boolean;
+function ActualfrxPrinterClass : TfrxCustomPrintersClass;
+
+
+implementation
+
+uses
+ FMX.frxUtils, FMX.frxRes, FMX.frxFMX;
+
+
+type
+ TPaperInfo = {packed} record
+ Typ: Integer;
+ Name: String;
+ X, Y: Integer;
+ end;
+
+
+const
+ PAPERCOUNT = 66;
+ PaperInfo: array[0..PAPERCOUNT - 1] of TPaperInfo = (
+ (Typ:1; Name: ''; X:2159; Y:2794),
+ (Typ:2; Name: ''; X:2159; Y:2794),
+ (Typ:3; Name: ''; X:2794; Y:4318),
+ (Typ:4; Name: ''; X:4318; Y:2794),
+ (Typ:5; Name: ''; X:2159; Y:3556),
+ (Typ:6; Name: ''; X:1397; Y:2159),
+ (Typ:7; Name: ''; X:1842; Y:2667),
+ (Typ:8; Name: ''; X:2970; Y:4200),
+ (Typ:9; Name: ''; X:2100; Y:2970),
+ (Typ:10; Name: ''; X:2100; Y:2970),
+ (Typ:11; Name: ''; X:1480; Y:2100),
+ (Typ:12; Name: ''; X:2500; Y:3540),
+ (Typ:13; Name: ''; X:1820; Y:2570),
+ (Typ:14; Name: ''; X:2159; Y:3302),
+ (Typ:15; Name: ''; X:2150; Y:2750),
+ (Typ:16; Name: ''; X:2540; Y:3556),
+ (Typ:17; Name: ''; X:2794; Y:4318),
+ (Typ:18; Name: ''; X:2159; Y:2794),
+ (Typ:19; Name: ''; X:984; Y:2254),
+ (Typ:20; Name: ''; X:1048; Y:2413),
+ (Typ:21; Name: ''; X:1143; Y:2635),
+ (Typ:22; Name: ''; X:1207; Y:2794),
+ (Typ:23; Name: ''; X:1270; Y:2921),
+ (Typ:24; Name: ''; X:4318; Y:5588),
+ (Typ:25; Name: ''; X:5588; Y:8636),
+ (Typ:26; Name: ''; X:8636; Y:11176),
+ (Typ:27; Name: ''; X:1100; Y:2200),
+ (Typ:28; Name: ''; X:1620; Y:2290),
+ (Typ:29; Name: ''; X:3240; Y:4580),
+ (Typ:30; Name: ''; X:2290; Y:3240),
+ (Typ:31; Name: ''; X:1140; Y:1620),
+ (Typ:32; Name: ''; X:1140; Y:2290),
+ (Typ:33; Name: ''; X:2500; Y:3530),
+ (Typ:34; Name: ''; X:1760; Y:2500),
+ (Typ:35; Name: ''; X:1760; Y:1250),
+ (Typ:36; Name: ''; X:1100; Y:2300),
+ (Typ:37; Name: ''; X:984; Y:1905),
+ (Typ:38; Name: ''; X:920; Y:1651),
+ (Typ:39; Name: ''; X:3778; Y:2794),
+ (Typ:40; Name: ''; X:2159; Y:3048),
+ (Typ:41; Name: ''; X:2159; Y:3302),
+ (Typ:42; Name: ''; X:2500; Y:3530),
+ (Typ:43; Name: ''; X:1000; Y:1480),
+ (Typ:44; Name: ''; X:2286; Y:2794),
+ (Typ:45; Name: ''; X:2540; Y:2794),
+ (Typ:46; Name: ''; X:3810; Y:2794),
+ (Typ:47; Name: ''; X:2200; Y:2200),
+ (Typ:50; Name: ''; X:2355; Y:3048),
+ (Typ:51; Name: ''; X:2355; Y:3810),
+ (Typ:52; Name: ''; X:2969; Y:4572),
+ (Typ:53; Name: ''; X:2354; Y:3223),
+ (Typ:54; Name: ''; X:2101; Y:2794),
+ (Typ:55; Name: ''; X:2100; Y:2970),
+ (Typ:56; Name: ''; X:2355; Y:3048),
+ (Typ:57; Name: ''; X:2270; Y:3560),
+ (Typ:58; Name: ''; X:3050; Y:4870),
+ (Typ:59; Name: ''; X:2159; Y:3223),
+ (Typ:60; Name: ''; X:2100; Y:3300),
+ (Typ:61; Name: ''; X:1480; Y:2100),
+ (Typ:62; Name: ''; X:1820; Y:2570),
+ (Typ:63; Name: ''; X:3220; Y:4450),
+ (Typ:64; Name: ''; X:1740; Y:2350),
+ (Typ:65; Name: ''; X:2010; Y:2760),
+ (Typ:66; Name: ''; X:4200; Y:5940),
+ (Typ:67; Name: ''; X:2970; Y:4200),
+ (Typ:68; Name: ''; X:3220; Y:4450));
+
+
+
+
+
+function frxGetPaperDimensions(PaperSize: Integer; var Width, Height: Extended): Boolean;
+var
+ i: Integer;
+begin
+ Result := False;
+ for i := 0 to PAPERCOUNT - 1 do
+ if PaperInfo[i].Typ = PaperSize then
+ begin
+ Width := PaperInfo[i].X / 10;
+ Height := PaperInfo[i].Y / 10;
+ Result := True;
+ break;
+ end;
+end;
+
+
+{$IFNDEF FMX}
+{ TfrxPrinterCanvas }
+
+procedure TfrxPrinterCanvas.Changing;
+begin
+ inherited;
+ UpdateFont;
+end;
+
+procedure TfrxPrinterCanvas.UpdateFont;
+var
+ FontSize: Integer;
+begin
+ if FPrinter.DPI.Y <> Font.PixelsPerInch then
+ begin
+ FontSize := Font.Size;
+ Font.PixelsPerInch := FPrinter.DPI.Y;
+ Font.Size := FontSize;
+ end;
+end;
+{$ENDIF}
+
+
+
+destructor TfrxPrinter.Destroy;
+begin
+ if Assigned(FOldWinPrinter) then
+ SetPrinter(FOldWinPrinter);
+ FreeDevMode;
+ FWinPrinter.Free;
+ inherited;
+end;
+
+procedure TfrxPrinter.Init;
+
+ procedure FillPapers;
+ var
+ i, PaperSizesCount: Integer;
+ PaperSizes: array[0..255] of Word;
+ PaperNames: PChar;
+ begin
+ FillChar(PaperSizes, SizeOf(PaperSizes), 0);
+ PaperSizesCount := DeviceCapabilities(PChar(FName), PChar(FPort), DC_PAPERS, @PaperSizes, FMode);
+ GetMem(PaperNames, PaperSizesCount * 64 * sizeof(char));
+ DeviceCapabilities(PChar(FName), PChar(FPort), DC_PAPERNAMES, PaperNames, FMode);
+ for i := 0 to PaperSizesCount - 1 do
+ if PaperSizes[i] <> 256 then
+ FPapers.AddObject(StrPas(PWideChar(PaperNames + i * 64)), Pointer(PaperSizes[i]));
+
+ FreeMem(PaperNames, PaperSizesCount * 64 * sizeof(char));
+ end;
+
+ procedure FillBins;
+ var
+ i, BinsCount: Integer;
+ BinNumbers: array[0..255] of Word;
+ BinNames: PChar;
+ begin
+ FillChar(BinNumbers, SizeOf(BinNumbers), 0);
+ BinsCount := DeviceCapabilities(PChar(FName), PChar(FPort), DC_BINS, @BinNumbers[0], FMode);
+ GetMem(BinNames, BinsCount * 24 * sizeof(char));
+ try
+ DeviceCapabilities(PChar(FName), PChar(FPort), DC_BINNAMES, BinNames, FMode);
+ except
+ end;
+
+ for i := 0 to BinsCount - 1 do
+ if BinNumbers[i] <> DMBIN_AUTO then
+ FBins.AddObject(StrPas(PwideChar(BinNames + i * 24)), Pointer(BinNumbers[i]));
+
+ FreeMem(BinNames, BinsCount * 24 * sizeof(char));
+ end;
+
+begin
+ if FInitialized then Exit;
+ CreateDevMode;
+ if FDeviceMode = 0 then Exit;
+ RecreateDC;
+
+ if not UpdateDeviceCaps then
+ begin
+ FreeDevMode;
+ Exit;
+ end;
+
+ FDefPaper := FMode.dmPaperSize;
+ FDefBin := FMode.dmDefaultSource;
+ FDefDuplex := FMode.dmDuplex;
+ FPaper := FDefPaper;
+ FDefPaperWidth := FPaperWidth;
+ FDefPaperHeight := FPaperHeight;
+ if FMode.dmOrientation = DMORIENT_PORTRAIT then
+ FDefOrientation := poPortrait else
+ FDefOrientation := poLandscape;
+ FOrientation := FDefOrientation;
+ FillPapers;
+ FillBins;
+ FBin := -1;
+ FDuplex := -1;
+
+ FInitialized := True;
+ FOldWinPrinter := nil;
+end;
+
+procedure TfrxPrinter.Abort;
+begin
+ AbortDoc(FDC);
+ EndDoc;
+end;
+
+procedure TfrxPrinter.BeginDoc;
+var
+ DocInfo: TDocInfo;
+begin
+ FPrinting := True;
+ FillChar(DocInfo, SizeOf(DocInfo), 0);
+ DocInfo.cbSize := SizeOf(DocInfo);
+ if FTitle <> '' then
+ DocInfo.lpszDocName := PChar(FTitle)
+ else DocInfo.lpszDocName := PChar('Fast Report Document');
+
+ if FFileName <> '' then
+ DocInfo.lpszOutput := PChar(FFileName);
+
+ RecreateDC;
+ StartDoc(FDC, DocInfo);
+end;
+
+procedure TfrxPrinter.BeginPage;
+begin
+ StartPage(FDC);
+{$IFDEF DELPHI28}
+ Canvas.BeginScene;
+{$ENDIF}
+end;
+
+procedure TfrxPrinter.EndDoc;
+var
+ Saved8087CW: Word;
+begin
+ Saved8087CW := Default8087CW;
+ Set8087CW($133F);
+ try
+ Winapi.Windows.EndDoc(FDC);
+ except
+ end;
+ Set8087CW(Saved8087CW);
+
+ FPrinting := False;
+ RecreateDC;
+ FBin := -1;
+ FDuplex := -1;
+
+ FMode.dmFields := FMode.dmFields or DM_DEFAULTSOURCE or DM_DUPLEX;
+ FMode.dmDefaultSource := FDefBin;
+ FMode.dmDuplex := FDefDuplex;
+ if FCanvas <> nil then
+ FCanvas.Free;
+
+ FDC := ResetDC(FDC, FMode^);
+ TFakePrinterWin(FWinPrinter).FDC := FDC;
+{$IFNDEF Delphi17}
+ FCanvas := DefaultCanvasClass.CreateFromPrinter(FWinPrinter);
+{$ELSE}
+ FCanvas := TCanvasManager.CreateFromPrinter(FWinPrinter);
+{$ENDIF}
+ FOnChangedFont := THackCanvas(FCanvas).FFont.OnChanged;
+ THackCanvas(FCanvas).FFont.OnChanged := FontChanged;
+ SetPrinter(FOldWinPrinter);
+ FOldWinPrinter := nil;
+end;
+
+procedure TfrxPrinter.EndPage;
+begin
+ Winapi.Windows.EndPage(FDC);
+{$IFDEF Delphi28}
+ Canvas.EndScene;
+{$ENDIF}
+end;
+
+procedure TfrxPrinter.BeginRAWDoc;
+var
+ DocInfo1: TDocInfo1;
+begin
+ RecreateDC;
+ DocInfo1.pDocName := PChar(FTitle);
+ DocInfo1.pOutputFile := nil;
+ DocInfo1.pDataType := 'RAW';
+ StartDocPrinter(FHandle, 1, @DocInfo1);
+ StartPagePrinter(FHandle);
+end;
+
+procedure TfrxPrinter.EndRAWDoc;
+begin
+ EndPagePrinter(FHandle);
+ EndDocPrinter(FHandle);
+end;
+
+procedure TfrxPrinter.WriteRAWDoc(const buf: AnsiString);
+var
+ N: DWORD;
+begin
+ WritePrinter(FHandle, PAnsiChar(buf), Length(buf), N);
+end;
+
+constructor TfrxPrinter.Create(const AName, APort: String);
+begin
+ inherited Create(AName, APort);
+ FWinPrinter := TFakePrinterWin.Create;
+end;
+
+procedure TfrxPrinter.CreateDevMode;
+var
+ bufSize: Integer;
+begin
+ if OpenPrinter(PChar(FName), FHandle, nil) then
+ begin
+ bufSize := DocumentProperties(0, FHandle, PChar(FName), nil, nil, 0);
+ if bufSize > 0 then
+ begin
+ FDeviceMode := GlobalAlloc(GHND, bufSize);
+ if FDeviceMode <> 0 then
+ begin
+ FMode := GlobalLock(FDeviceMode);
+ if DocumentProperties(0, FHandle, PChar(FName), FMode^, FMode^,
+ DM_OUT_BUFFER) < 0 then
+ begin
+ GlobalUnlock(FDeviceMode);
+ GlobalFree(FDeviceMode);
+ FDeviceMode := 0;
+ FMode := nil;
+ end
+ end;
+ end;
+ end;
+end;
+
+procedure TfrxPrinter.FontChanged(Sender: TObject);
+begin
+ if Assigned(FOnChangedFont) then
+ FOnChangedFont(Sender);
+ //if FDPI.Y <> FCanvas.Font.PixelsPerInch then
+ begin
+ //FontSize := Round(FCanvas.Font.Size);
+ ///Font.PixelsPerInch := FPrinter.DPI.Y;
+ //FCanvas.Font.Size := MulDiv(FontSize, DPI.Y, 72)
+ end;
+end;
+
+procedure TfrxPrinter.FreeDevMode;
+begin
+ //FCanvas.Handle := 0;
+ if FDC <> 0 then
+ DeleteDC(FDC);
+ if FHandle <> 0 then
+ ClosePrinter(FHandle);
+ if FDeviceMode <> 0 then
+ begin
+ GlobalUnlock(FDeviceMode);
+ GlobalFree(FDeviceMode);
+ end;
+ FDeviceMode := 0;
+ FDC := 0;
+ FHandle := 0;
+ if FCanvas <> nil then
+ FCanvas.Free;
+end;
+
+procedure TfrxPrinter.RecreateDC;
+begin
+ if FDC <> 0 then
+ try
+ DeleteDC(FDC);
+ except
+ end;
+ FDC := 0;
+ GetDC;
+end;
+
+procedure TfrxPrinter.GetDC;
+begin
+ if FDC = 0 then
+ begin
+ if FPrinting then
+ FDC := CreateDC(PChar(FDriver), PChar(FName), nil, FMode) else
+ FDC := CreateIC(PChar(FDriver), PChar(FName), nil, FMode);
+
+ TFakePrinterWin(FWinPrinter).FDC := FDC;
+ //FWinPrinter.PageHeight
+ TFakePrinterWin(FWinPrinter).FState := TPrinterState.psHandleDC;
+{$IFNDEF Delphi17}
+ if FCanvas <> nil then
+ FCanvas.CreateFromPrinter(FWinPrinter)
+ else
+ FCanvas := DefaultCanvasClass.CreateFromPrinter(FWinPrinter);
+{$ELSE}
+ if FCanvas <> nil then
+ FreeAndNil(FCanvas);
+
+ FCanvas := TCanvasManager.CreateFromPrinter(FWinPrinter);
+{$ENDIF}
+ FOnChangedFont := THackCanvas(FCanvas).FFont.OnChanged;
+ THackCanvas(FCanvas).FFont.OnChanged := FontChanged;
+{$IFDEF Delphi28}
+ FCanvas.SetSize(Round(FPaperWidth * FDPI.X / 25.4), Round(FPaperHeight * FDPI.Y / 25.4));
+{$ENDIF}
+
+// FDC := THackPrinterWin(FWinPrinter).FDC;
+//
+// THackPrinterWin(FWinPrinter).SetState(TPrinterState.psNoHandle);
+// THackPrinterWin(FWinPrinter).SetState(TPrinterState.psHandleDC);
+// // on a second document printing process, the canvas must reconnect its
+// // underlying objects to the new DC
+// THackPrinterWin(FWinPrinter).Canvas.CreateFromPrinter(FWinPrinter);
+// THackPrinterWin(FWinPrinter).SetCanvasDefaultSettings;
+// FCanvas := THackPrinterWin(FWinPrinter).Canvas;
+// FDC := THackPrinterWin(FWinPrinter).FDC;
+// FHandle := THackPrinterWin(FWinPrinter).FPrinterHandle;
+// FMode := THackPrinterWin(FWinPrinter).FDevMode;
+// FDeviceMode := THackPrinterWin(FWinPrinter).FDeviceMode;
+
+ //FCanvas.Handle := FDC;
+ //FCanvas.Refresh;
+ //FCanvas.UpdateFont;
+ end;
+end;
+
+procedure TfrxPrinter.SetViewParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation);
+begin
+ if APaperSize <> 256 then
+ begin
+ FMode.dmFields := DM_PAPERSIZE or DM_ORIENTATION;
+ FMode.dmPaperSize := APaperSize;
+ if AOrientation = poPortrait then
+ FMode.dmOrientation := DMORIENT_PORTRAIT else
+ FMode.dmOrientation := DMORIENT_LANDSCAPE;
+ RecreateDC;
+ if not UpdateDeviceCaps then Exit;
+ end
+ else
+ begin
+ // copy the margins from A4 paper
+ SetViewParams(DMPAPER_A4, 0, 0, AOrientation);
+ FPaperHeight := APaperHeight;
+ FPaperWidth := APaperWidth;
+ end;
+
+ FPaper := APaperSize;
+ FOrientation := AOrientation;
+end;
+
+function TfrxPrinter.ShowPrintDialog: Boolean;
+begin
+ Result := False;
+end;
+
+procedure TfrxPrinter.SetPrintParams(APaperSize: Integer;
+ APaperWidth, APaperHeight: Extended; AOrientation: TPrinterOrientation;
+ ABin, ADuplex, ACopies: Integer);
+begin
+ FMode.dmFields := FMode.dmFields or DM_PAPERSIZE or DM_ORIENTATION or DM_COPIES
+ or DM_DEFAULTSOURCE;
+
+
+ if APaperSize = 256 then
+ begin
+ FMode.dmFields := FMode.dmFields or DM_PAPERLENGTH or DM_PAPERWIDTH;
+ if AOrientation = poLandscape then
+ begin
+ FMode.dmPaperLength := Round(APaperWidth * 10);
+ FMode.dmPaperWidth := Round(APaperHeight * 10);
+ end
+ else
+ begin
+ FMode.dmPaperLength := Round(APaperHeight * 10);
+ FMode.dmPaperWidth := Round(APaperWidth * 10);
+ end;
+ end
+ else
+ begin
+ FMode.dmPaperLength := 0;
+ FMode.dmPaperWidth := 0;
+ end;
+
+ FMode.dmPaperSize := APaperSize;
+ if AOrientation = poPortrait then
+ FMode.dmOrientation := DMORIENT_PORTRAIT else
+ FMode.dmOrientation := DMORIENT_LANDSCAPE;
+
+ FMode.dmCopies := ACopies;
+ if ABin = DMBIN_AUTO then
+ if FBin <> -1 then
+ ABin := FBin
+ else
+ ABin := DefBin;
+ FMode.dmDefaultSource := ABin;
+
+ if ADuplex = 0 then
+ ADuplex := FDefDuplex
+ else Inc(ADuplex);
+ if ADuplex = 4 then
+ ADuplex := DMDUP_SIMPLEX;
+ if FDuplex <> -1 then
+ ADuplex := FDuplex;
+ if ADuplex <> 1 then
+ FMode.dmFields := FMode.dmFields or DM_DUPLEX;
+ FMode.dmDuplex := ADuplex;
+
+
+ { strange behaviour with GDI+ canvas
+ need to release canvas and all gdi+ objects before call ResetDC
+ otherwise it return error }
+ if FCanvas <> nil then
+ FCanvas.Free;
+
+ FDC := ResetDC(FDC, FMode^);
+ FDC := ResetDC(FDC, FMode^); // needed for some printers
+ TFakePrinterWin(FWinPrinter).FDC := FDC;
+{$IFNDEF Delphi17}
+ FCanvas := DefaultCanvasClass.CreateFromPrinter(FWinPrinter);
+{$ELSE}
+ FCanvas := TCanvasManager.CreateFromPrinter(FWinPrinter);
+{$ENDIF}
+ FWinPrinter.FCanvas := FCanvas;
+ if {PrinterAssigned and} not Assigned(FOldWinPrinter) then
+ FOldWinPrinter := TPrinterWin(Printer);
+ SetPrinter(FWinPrinter);
+ FOnChangedFont := THackCanvas(FCanvas).FFont.OnChanged;
+ THackCanvas(FCanvas).FFont.OnChanged := FontChanged;
+
+
+ //FCanvas.Refresh;
+ if not UpdateDeviceCaps then Exit;
+ FPaper := APaperSize;
+ FOrientation := AOrientation;
+{$IFDEF Delphi28}
+ FCanvas.SetSize(Round(FPaperWidth * FDPI.X / 25.4), Round(FPaperHeight * FDPI.Y / 25.4));
+{$ENDIF}
+end;
+
+function TfrxPrinter.UpdateDeviceCaps: Boolean;
+begin
+ Result := True;
+ if FDC = 0 then GetDC;
+
+ FDPI := Point(GetDeviceCaps(FDC, LOGPIXELSX), GetDeviceCaps(FDC, LOGPIXELSY));
+ if (FDPI.X = 0) or (FDPI.Y = 0) then
+ begin
+ Result := False;
+ frxErrorMsg('Printer selected is not valid');
+ Exit;
+ end;
+ FPaperHeight := Round(GetDeviceCaps(FDC, PHYSICALHEIGHT) / FDPI.Y * 25.4);
+ FPaperWidth := Round(GetDeviceCaps(FDC, PHYSICALWIDTH) / FDPI.X * 25.4);
+ FLeftMargin := Round(GetDeviceCaps(FDC, PHYSICALOFFSETX) / FDPI.X * 25.4);
+ FTopMargin := Round(GetDeviceCaps(FDC, PHYSICALOFFSETY) / FDPI.Y * 25.4);
+ FRightMargin := FPaperWidth - Round(GetDeviceCaps(FDC, HORZRES) / FDPI.X * 25.4) - FLeftMargin;
+ FBottomMargin := FPaperHeight - Round(GetDeviceCaps(FDC, VERTRES) / FDPI.Y * 25.4) - FTopMargin;
+end;
+
+procedure TfrxPrinter.PropertiesDlg;
+var
+ h: THandle;
+ PrevDuplex: Integer;
+begin
+ PrevDuplex := FMode.dmDuplex;
+ //if Screen.ActiveForm <> nil then
+ // h := Screen.ActiveForm.Handle else
+ h := 0;
+ if DocumentProperties(h, FHandle, PChar(FName), FMode^,
+ FMode^, DM_IN_BUFFER or DM_OUT_BUFFER or DM_IN_PROMPT) > 0 then
+ begin
+ FBin := FMode.dmDefaultSource;
+ if PrevDuplex <> FMode.dmDuplex then
+ FDuplex := FMode.dmDuplex;
+ RecreateDC;
+ end;
+end;
+
+{ TfrxPrinters }
+
+constructor TfrxPrinters.Create;
+begin
+ Inherited;
+end;
+
+destructor TfrxPrinters.Destroy;
+begin
+ inherited;
+end;
+
+
+
+function TfrxPrinters.GetDefaultPrinter: String;
+var
+ prnName: array[0..255] of Char;
+begin
+ GetProfileString('windows', 'device', '', prnName, 255);
+ Result := Copy(prnName, 1, Pos(',', prnName) - 1);
+end;
+
+
+procedure TfrxPrinters.FillPrinters;
+var
+ i, j: Integer;
+ Buf, prnInfo: PByte;
+ Flags, bufSize, prnCount: DWORD;
+ Level: Byte;
+ sl: TStringList;
+
+ procedure AddPrinter(ADevice, APort: String);
+ begin
+ FPrinterList.Add(TfrxPrinter.Create(ADevice, APort));
+ FPrinters.Add(ADevice);
+ end;
+
+begin
+ Clear;
+ if Win32Platform = VER_PLATFORM_WIN32_NT then
+ begin
+ Flags := PRINTER_ENUM_CONNECTIONS or PRINTER_ENUM_LOCAL;
+ Level := 4;
+ end
+ else
+ begin
+ Flags := PRINTER_ENUM_LOCAL;
+ Level := 5;
+ end;
+
+ bufSize := 0;
+ EnumPrinters(Flags, nil, Level, nil, 0, bufSize, prnCount);
+ if bufSize = 0 then Exit;
+
+ GetMem(Buf, bufSize);
+ try
+
+ if not EnumPrinters(Flags, nil, Level, PByte(Buf), bufSize, bufSize, prnCount) then
+ Exit;
+ prnInfo := Buf;
+ for i := 0 to prnCount - 1 do
+ if Level = 4 then
+ with PPrinterInfo4(prnInfo)^ do
+ begin
+ AddPrinter(pPrinterName, '');
+ Inc(prnInfo, SizeOf(TPrinterInfo4));
+ end
+ else
+ with PPrinterInfo5(prnInfo)^ do
+ begin
+ sl := TStringList.Create;
+ frxSetCommaText(pPortName, sl, ',');
+
+ for j := 0 to sl.Count - 1 do
+ AddPrinter(pPrinterName, sl[j]);
+
+ sl.Free;
+ Inc(prnInfo, SizeOf(TPrinterInfo5));
+ end;
+
+ finally
+ FreeMem(Buf, bufSize);
+ end;
+end;
+
+
+
+
+{ THackPrinterWin }
+
+procedure TFakePrinterWin.ActivePrinterChanged;
+begin
+//do nothing
+end;
+
+constructor TFakePrinterWin.Create;
+begin
+ //inherited;
+inherited;
+end;
+
+destructor TFakePrinterWin.Destroy;
+begin
+ FCanvas := nil;
+inherited;
+ //inherited;
+end;
+
+procedure TFakePrinterWin.DoAbortDoc;
+begin
+ //do nothing
+end;
+
+procedure TFakePrinterWin.DoBeginDoc;
+begin
+ //do nothing
+end;
+
+procedure TFakePrinterWin.DoEndDoc;
+begin
+ //do nothing
+end;
+
+procedure TFakePrinterWin.DoNewPage;
+begin
+ //do nothing
+
+end;
+
+function TFakePrinterWin.GetCanvas: TCanvas;
+begin
+ Result := FCanvas;
+end;
+
+function TFakePrinterWin.GetCapabilities: TPrinterCapabilities;
+begin
+ Result := FCapabilities;
+end;
+
+function TFakePrinterWin.GetNumCopies: Integer;
+begin
+ Result := 0;
+ //do nothing
+end;
+
+function TFakePrinterWin.GetOrientation: TPrinterOrientation;
+begin
+ Result := TPrinterOrientation.poPortrait;
+ //do nothing
+end;
+
+function TFakePrinterWin.GetPageHeight: Integer;
+begin
+ Result := FPageHeight;
+end;
+
+function TFakePrinterWin.GetPageWidth: Integer;
+begin
+ Result := FPageWidth;
+end;
+
+procedure TFakePrinterWin.RefreshFonts;
+begin
+ //do nothing
+end;
+
+procedure TFakePrinterWin.RefreshPrinterDevices;
+begin
+ //do nothing
+end;
+
+procedure TFakePrinterWin.SetDefaultPrinter;
+begin
+ //do nothing
+end;
+
+procedure TFakePrinterWin.SetNumCopies(Value: Integer);
+begin
+ //do nothing
+end;
+
+procedure TFakePrinterWin.SetOrientation(Value: TPrinterOrientation);
+begin
+ //do nothing
+end;
+
+function ActualfrxPrinterClass : TfrxCustomPrintersClass;
+begin
+ Result := TfrxPrinters;
+end;
+
+initialization
+
+finalization
+
+end.
+
diff --git a/LibD28x64/FMX.frxADOComponents.pas b/LibD28x64/FMX.frxADOComponents.pas
new file mode 100644
index 0000000..6071857
--- /dev/null
+++ b/LibD28x64/FMX.frxADOComponents.pas
@@ -0,0 +1,1051 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ ADO enduser components }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxADOComponents;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.Classes, System.SysUtils, FMX.frxClass, FMX.frxCustomDB, Data.DB, Data.Win.ADODB, Winapi.ADOInt
+, System.Variants, FMX.Types
+{$IFDEF QBUILDER}
+, FMX.fqbClass
+{$ENDIF};
+
+type
+[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
+ TfrxADOComponents = class(TfrxDBComponents)
+ private
+ FDefaultDatabase: TADOConnection;
+ FOldComponents: TfrxADOComponents;
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetDefaultDatabase(Value: TADOConnection);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function GetDescription: String; override;
+ published
+ property DefaultDatabase: TADOConnection read FDefaultDatabase write SetDefaultDatabase;
+ end;
+
+ TfrxADODatabase = class(TfrxCustomDatabase)
+ private
+ FDatabase: TADOConnection;
+ protected
+ procedure SetConnected(Value: Boolean); override;
+ procedure SetDatabaseName(const Value: String); override;
+ procedure SetLoginPrompt(Value: Boolean); override;
+ function GetConnected: Boolean; override;
+ function GetDatabaseName: String; override;
+ function GetLoginPrompt: Boolean; override;
+ procedure ADOBeforeConnect(Sende: TObject);
+ procedure ADOAfterDisconnect(Sende: TObject);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ procedure SetLogin(const Login, Password: String); override;
+ function ToString: WideString; override;
+ procedure FromString(const Connection: WideString); override;
+ property Database: TADOConnection read FDatabase;
+ published
+ property DatabaseName;
+ property LoginPrompt;
+ property Connected;
+ end;
+
+
+ TfrxADOTable = class(TfrxCustomTable)
+ private
+ FDatabase: TfrxADODatabase;
+ FTable: TADOTable;
+ procedure SetDatabase(Value: TfrxADODatabase);
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetMaster(const Value: TDataSource); override;
+ procedure SetMasterFields(const Value: String); override;
+ procedure SetIndexFieldNames(const Value: String); override;
+ procedure SetIndexName(const Value: String); override;
+ procedure SetTableName(const Value: String); override;
+ function GetIndexFieldNames: String; override;
+ function GetIndexName: String; override;
+ function GetTableName: String; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor DesignCreate(AOwner: TComponent; Flags: Word); override;
+ class function GetDescription: String; override;
+ procedure BeforeStartReport; override;
+ property Table: TADOTable read FTable;
+ published
+ property Database: TfrxADODatabase read FDatabase write SetDatabase;
+ end;
+
+ TfrxADOQuery = class(TfrxCustomQuery)
+ private
+ FDatabase: TfrxADODatabase;
+ FQuery: TADOQuery;
+ FStrings: TStrings;
+ FLock: Boolean;
+ procedure SetDatabase(Value: TfrxADODatabase);
+ function GetCommandTimeout: Integer;
+ procedure SetCommandTimeout(const Value: Integer);
+ function GetLockType: TADOLockType;
+ procedure SetLockType(const Value: TADOLockType);
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure OnChangeSQL(Sender: TObject); override;
+ procedure SetMaster(const Value: TDataSource); override;
+ procedure SetSQL(Value: TStrings); override;
+ function GetSQL: TStrings; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor DesignCreate(AOwner: TComponent; Flags: Word); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ procedure BeforeStartReport; override;
+ procedure UpdateParams; override;
+{$IFDEF QBUILDER}
+ function QBEngine: TfqbEngine; override;
+{$ENDIF}
+ property Query: TADOQuery read FQuery;
+ published
+ property CommandTimeout: Integer read GetCommandTimeout write SetCommandTimeout;
+ property Database: TfrxADODatabase read FDatabase write SetDatabase;
+ property LockType: TADOLockType read GetLockType write SetLockType;
+ end;
+
+{$IFDEF QBUILDER}
+ TfrxEngineADO = class(TfqbEngine)
+ private
+ FQuery: TADOQuery;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure ReadTableList(ATableList: TStrings); override;
+ procedure ReadFieldList(const ATableName: string; var AFieldList: TfqbFieldList); override;
+ function ResultDataSet: TDataSet; override;
+ procedure SetSQL(const Value: string); override;
+ end;
+{$ENDIF}
+
+procedure frxParamsToTParameters(Query: TfrxCustomQuery; Params: TParameters);
+procedure frxADOGetTableNames(conADO: TADOConnection; List: TStrings; SystemTables: Boolean);
+
+var
+ ADOComponents: TfrxADOComponents;
+
+implementation
+
+uses
+ FMX.frxADORTTI,
+{$IFNDEF NO_EDITORS}
+ FMX.frxADOEditor,
+{$ENDIF}
+ FMX.frxDsgnIntf, FMX.frxRes;
+
+type
+ THackQuery = class(TADOQuery);
+
+
+{ frxParamsToTParameters }
+
+procedure frxParamsToTParameters(Query: TfrxCustomQuery; Params: TParameters);
+var
+ i: Integer;
+ Item: TfrxParamItem;
+begin
+ for i := 0 to Params.Count - 1 do
+ if Query.Params.IndexOf(Params[i].Name) <> -1 then
+ begin
+ Item := Query.Params[Query.Params.IndexOf(Params[i].Name)];
+ Params[i].DataType := Item.DataType;
+ Params[i].Attributes := [paNullable];
+ if Trim(Item.Expression) <> '' then
+ if not (Query.IsLoading or Query.IsDesigning) then
+ begin
+ Query.Report.CurObject := Query.Name;
+ Item.Value := Query.Report.Calc(Item.Expression);
+ end;
+ Params[i].Value := Item.Value;
+ end;
+end;
+
+procedure frxADOGetTableNames(conADO: TADOConnection; List: TStrings; SystemTables: Boolean);
+var
+ tbl: TADODataSet;
+ s: string;
+begin
+ tbl := TADODataSet.Create(nil);
+ List.Clear;
+ try
+ conADO.OpenSchema(siTables, EmptyParam, EmptyParam, tbl);
+ tbl.First;
+ while not tbl.Eof do
+ begin
+ s := Trim(tbl.FieldByName('TABLE_SCHEMA').AsString);
+ if s <> '' then
+ List.Add(s + '.' + tbl.FieldByName('TABLE_NAME').AsString)
+ else
+ List.Add(tbl.FieldByName('TABLE_NAME').AsString);
+ tbl.Next;
+ end;
+ finally
+ tbl.Free;
+ end;
+end;
+
+{ TfrxDBComponents }
+
+constructor TfrxADOComponents.Create(AOwner: TComponent);
+begin
+ inherited;
+ FOldComponents := ADOComponents;
+ FDefaultDatabase := nil;
+ ADOComponents := Self;
+end;
+
+destructor TfrxADOComponents.Destroy;
+begin
+ if ADOComponents = Self then
+ ADOComponents := FOldComponents;
+ inherited;
+end;
+
+function TfrxADOComponents.GetDescription: String;
+begin
+ Result := 'ADO';
+end;
+
+procedure TfrxADOComponents.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited;
+ if (AComponent = FDefaultDatabase) and (Operation = opRemove) then
+ FDefaultDatabase := nil;
+end;
+
+
+{ TfrxADODatabase }
+
+constructor TfrxADODatabase.Create(AOwner: TComponent);
+begin
+ inherited;
+ FDatabase := TADOConnection.Create(nil);
+ FDatabase.BeforeConnect := ADOBeforeConnect;
+ FDatabase.AfterDisconnect := ADOAfterDisconnect;
+ Component := FDatabase;
+end;
+
+class function TfrxADODatabase.GetDescription: String;
+begin
+ Result := frxResources.Get('obADODB');
+end;
+
+function TfrxADODatabase.GetConnected: Boolean;
+begin
+ Result := FDatabase.Connected;
+end;
+
+function TfrxADODatabase.GetDatabaseName: String;
+begin
+ Result := FDatabase.ConnectionString;
+end;
+
+function TfrxADODatabase.GetLoginPrompt: Boolean;
+begin
+ Result := FDatabase.LoginPrompt;
+end;
+
+procedure TfrxADODatabase.SetConnected(Value: Boolean);
+begin
+ BeforeConnect(Value);
+ FDatabase.Connected := Value;
+end;
+
+procedure TfrxADODatabase.SetDatabaseName(const Value: String);
+begin
+ FDatabase.ConnectionString := Value;
+end;
+
+procedure TfrxADODatabase.SetLoginPrompt(Value: Boolean);
+begin
+ FDatabase.LoginPrompt := Value;
+end;
+
+procedure TfrxADODatabase.SetLogin(const Login, Password: String);
+var
+ i, j: Integer;
+ s: String;
+begin
+ s := DatabaseName;
+ i := Pos('USER ID=', AnsiUppercase(s));
+ if i <> 0 then
+ begin
+ for j := i to Length(s) do
+ if s[j] = ';' then
+ break;
+ Delete(s, i, j - i);
+ Insert('User ID=' + Login, s, i);
+ end
+ else
+ s := s + ';User ID=' + Login;
+
+ i := Pos('PASSWORD=', AnsiUppercase(s));
+ if i <> 0 then
+ begin
+ for j := i to Length(s) do
+ if s[j] = ';' then
+ break;
+ Delete(s, i, j - i);
+ Insert('Password=' + Password, s, i);
+ end
+ else
+ s := s + ';Password=' + Password;
+
+ DatabaseName := s;
+end;
+{$IFDEF FR_COM}
+// helper function that supports IUnknown and IDispatchable interfaces
+function TfrxADODatabase.COM_Object: TfrxADODatabase;
+var
+ idsp: IInterfaceComponentReference;
+begin
+ if not Assigned( VCLComObject ) then Result := Self
+ else try
+ idsp := IVCLComObject(VCLComObject) as IInterfaceComponentReference;
+ Result := TfrxADODatabase( idsp.GetComponent );
+ except
+ Result := Self;
+ end;
+end;
+
+function TfrxADODatabase.Get_ConnectionString: WideString; safecall;
+begin
+ Result := PChar(COM_Object.DatabaseName);
+end;
+
+procedure TfrxADODatabase.Set_ConnectionString(const Value: WideString); safecall;
+begin
+ COM_Object.DatabaseName := Value;
+end;
+
+function TfrxADODatabase.Get_LoginPrompt: WordBool; safecall;
+begin
+ Result := COM_Object.LoginPrompt;
+end;
+
+procedure TfrxADODatabase.Set_LoginPrompt(Value: WordBool); safecall;
+begin
+ COM_Object.LoginPrompt := Value;
+end;
+
+function TfrxADODatabase.Get_Connected: WordBool; safecall;
+begin
+ Result := COM_Object.Connected;
+end;
+
+procedure TfrxADODatabase.Set_Connected(Value: WordBool); safecall;
+begin
+ COM_Object.Connected := Value;
+end;
+
+function TfrxADODatabase.Get_ConnectionTimeout: Integer; safecall;
+begin
+ Result := COM_Object.FDatabase.ConnectionTimeout;
+end;
+
+procedure TfrxADODatabase.Set_ConnectionTimeout(Value: Integer); safecall;
+begin
+ COM_Object.FDatabase.ConnectionTimeout := Value;
+end;
+
+function TfrxADODatabase.Get_CommandTimeout: Integer; safecall;
+begin
+ Result := COM_Object.FDatabase.CommandTimeout;
+end;
+
+procedure TfrxADODatabase.Set_CommandTimeout(Value: Integer); safecall;
+begin
+ COM_Object.FDatabase.CommandTimeout := Value;
+end;
+{$ENDIF}
+
+procedure TfrxADODatabase.FromString(const Connection: WideString);
+begin
+ FDatabase.ConnectionString := Connection;
+end;
+
+function TfrxADODatabase.ToString: WideString;
+begin
+ Result := FDatabase.ConnectionString;
+end;
+
+procedure TfrxADODatabase.ADOBeforeConnect(Sende: TObject);
+var
+ Param: Boolean;
+begin
+ Param := True;
+ BeforeConnect(Param);
+end;
+
+procedure TfrxADODatabase.ADOAfterDisconnect(Sende: TObject);
+begin
+ AfterDisconnect;
+end;
+
+procedure TfrxADOComponents.SetDefaultDatabase(Value: TADOConnection);
+begin
+ if (Value <> nil) then
+ Value.FreeNotification(Self);
+
+ if FDefaultDatabase <> nil then
+ FDefaultDatabase.RemoveFreeNotification(Self);
+
+ FDefaultDatabase := Value;
+end;
+
+{ TfrxADOTable }
+
+constructor TfrxADOTable.Create(AOwner: TComponent);
+begin
+ FTable := TADOTable.Create(nil);
+ DataSet := FTable;
+ SetDatabase(nil);
+ inherited;
+end;
+
+constructor TfrxADOTable.DesignCreate(AOwner: TComponent; Flags: Word);
+var
+ i: Integer;
+ l: TList;
+begin
+ inherited;
+ l := Report.AllObjects;
+ for i := 0 to l.Count - 1 do
+ if TObject(l[i]) is TfrxADODatabase then
+ begin
+ SetDatabase(TfrxADODatabase(l[i]));
+ break;
+ end;
+end;
+
+class function TfrxADOTable.GetDescription: String;
+begin
+ Result := frxResources.Get('obADOTb');
+end;
+
+procedure TfrxADOTable.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FDatabase) then
+ SetDatabase(nil);
+end;
+
+procedure TfrxADOTable.SetDatabase(Value: TfrxADODatabase);
+begin
+ FDatabase := Value;
+ if Value <> nil then
+ FTable.Connection := Value.Database
+ else if ADOComponents <> nil then
+ FTable.Connection := ADOComponents.DefaultDatabase
+ else
+ FTable.Connection := nil;
+ DBConnected := FTable.Connection <> nil;
+end;
+
+function TfrxADOTable.GetIndexFieldNames: String;
+begin
+ Result := FTable.IndexFieldNames;
+end;
+
+function TfrxADOTable.GetIndexName: String;
+begin
+ Result := FTable.IndexName;
+end;
+
+function TfrxADOTable.GetTableName: String;
+begin
+ Result := FTable.TableName;
+end;
+
+procedure TfrxADOTable.SetIndexFieldNames(const Value: String);
+begin
+ FTable.IndexFieldNames := Value;
+end;
+
+procedure TfrxADOTable.SetIndexName(const Value: String);
+begin
+ FTable.IndexName := Value;
+end;
+
+procedure TfrxADOTable.SetTableName(const Value: String);
+begin
+ FTable.TableName := Value;
+end;
+
+procedure TfrxADOTable.SetMaster(const Value: TDataSource);
+begin
+ FTable.MasterSource := Value;
+end;
+
+procedure TfrxADOTable.SetMasterFields(const Value: String);
+begin
+ FTable.MasterFields := Value;
+end;
+
+procedure TfrxADOTable.BeforeStartReport;
+begin
+ SetDatabase(FDatabase);
+end;
+
+{$IFDEF FR_COM}
+// helper function that supports IUnknown and IDispatchable interfaces
+function TfrxADOTable.COM_Object: TfrxADOTable;
+var
+ idsp: IInterfaceComponentReference;
+begin
+ if not Assigned( VCLComObject ) then Result := Self
+ else try
+ idsp := IVCLComObject(VCLComObject) as IInterfaceComponentReference;
+ Result := TfrxADOTable( idsp.GetComponent );
+ except
+ Result := Self;
+ end;
+end;
+
+function TfrxADOTable.Get_DataBase(out Value: IfrxADODatabase): HResult; stdcall;
+begin
+ Value := COM_Object.Database;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Set_DataBase(const Value: IfrxADODatabase): HResult; stdcall;
+var
+ idsp : IInterfaceComponentReference;
+ WorkingObject: TfrxADOTable;
+begin
+ WorkingObject := COM_Object;
+ if Value <> nil then
+ begin
+ Result := Value.QueryInterface( IInterfaceComponentReference, idsp);
+ if Result = S_OK then
+ WorkingObject.Database := TfrxADODatabase( idsp.GetComponent );
+ end
+ else
+ begin
+ WorkingObject.Database := nil;
+ Result := S_OK;
+ end;
+end;
+
+function TfrxADOTable.Get_IndexName(out Value: WideString): HResult; stdcall;
+begin
+ Value := COM_Object.FTable.IndexName;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Set_IndexName(const Value: WideString): HResult; stdcall;
+begin
+ COM_Object.FTable.IndexName := Value;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Get_TableName( out Value : WideString): HResult; stdcall;
+begin
+ Value := COM_Object.FTable.TableName;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Set_TableName(const Value: WideString): HResult; stdcall;
+begin
+ COM_Object.FTable.TableName := Value;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Get_Name(out Value: WideString): HResult; stdcall;
+begin
+ Value := COM_Object.Name;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Set_Name(const Value: WideString): HResult; stdcall;
+begin
+ COM_Object.Name := Value;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Set_Master(const Value: IfrxDataSet): HResult; stdcall;
+var
+ idsp : IInterfaceComponentReference;
+ WorkingObject: TfrxADOTable;
+begin
+ try
+ WorkingObject := COM_Object;
+ if Value <> nil then
+ begin
+ Result := Value.QueryInterface( IInterfaceComponentReference, idsp);
+ if Result = S_OK then
+ WorkingObject.Master := TfrxDBDataSet( idsp.GetComponent );
+ end
+ else
+ begin
+ WorkingObject.Master := nil;
+ Result := S_OK;
+ end;
+ except
+ Result := E_INVALIDARG;
+ end;
+end;
+
+function TfrxADOTable.Get_MasterFileds(out Value: WideString): HResult; stdcall;
+begin
+ Value := COM_Object.MasterFields;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Set_MasterFileds(const Value: WideString): HResult; stdcall;
+begin
+ COM_Object.MasterFields := Value;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Get_DataBaseEx(out Value: IfrxADODatabase): HResult; stdcall;
+begin
+ Value := COM_Object.Database;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Set_DataBaseEx(const Value: IfrxADODatabase): HResult; stdcall;
+begin
+ Result := Set_DataBase(value);
+end;
+
+function TfrxADOTable._Set_DataBaseEx(var Value: IfrxADODatabase): HResult; stdcall;
+begin
+ Result := Set_DataBase(value);
+end;
+
+function TfrxADOTable.Get_FieldsCount(out Value: Integer): HResult; stdcall;
+begin
+ Value := COM_Object.FTable.FieldDefs.Count;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.FieldName(Index: Integer; out Name: WideString): HResult; stdcall;
+begin
+ Result := E_FAIL;
+ if (Index < 0) or (Index > COM_Object.FTable.Fields.Count) then exit;
+ Name := COM_Object.FTable.Fields.Fields[Index].FieldName;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Get_Active(out Value: WordBool): HResult; stdcall;
+begin
+ Value := COM_Object.Active;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.Set_Active(Value: WordBool): HResult; stdcall;
+begin
+ COM_Object.Active := Value;
+ Result := S_OK;
+end;
+
+function TfrxADOTable.FieldType(Index: Integer; out Value: frxFieldType): HResult; stdcall;
+begin
+ Value := frxFieldType(COM_Object.FTable.Fields.Fields[Index].DataType);
+ Result := S_OK;
+end;
+
+function TfrxADOTable.DisplayWidth(Index: Integer; out Value: Integer): HResult; stdcall;
+begin
+ Value := COM_Object.FTable.Fields.Fields[Index].DisplayWidth;
+ Result := S_OK;
+end;
+{$ENDIF}
+
+{ TfrxADOQuery }
+
+constructor TfrxADOQuery.Create(AOwner: TComponent);
+begin
+ FStrings := TStringList.Create;
+ FQuery := TADOQuery.Create(nil);
+{$IFDEF Delphi7}
+ FQuery.LockType := ltReadOnly;
+{$ENDIF}
+ Dataset := FQuery;
+ SetDatabase(nil);
+ FLock := False;
+ inherited;
+end;
+
+constructor TfrxADOQuery.DesignCreate(AOwner: TComponent; Flags: Word);
+var
+ i: Integer;
+ l: TList;
+begin
+ inherited;
+ l := Report.AllObjects;
+ for i := 0 to l.Count - 1 do
+ if TObject(l[i]) is TfrxADODatabase then
+ begin
+ SetDatabase(TfrxADODatabase(l[i]));
+ break;
+ end;
+end;
+
+destructor TfrxADOQuery.Destroy;
+begin
+ FStrings.Free;
+ inherited;
+end;
+
+class function TfrxADOQuery.GetDescription: String;
+begin
+ Result := frxResources.Get('obADOQ');
+end;
+
+procedure TfrxADOQuery.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FDatabase) then
+ SetDatabase(nil);
+end;
+
+function TfrxADOQuery.GetSQL: TStrings;
+begin
+ FLock := True;
+ FStrings.Assign(FQuery.SQL);
+ FLock := False;
+ Result := FStrings;
+end;
+
+procedure TfrxADOQuery.SetSQL(Value: TStrings);
+begin
+ FQuery.SQL.Assign(Value);
+ FStrings.Assign(FQuery.SQL);
+end;
+
+procedure TfrxADOQuery.SetDatabase(Value: TfrxADODatabase);
+begin
+ FDatabase := Value;
+ if Value <> nil then
+ FQuery.Connection := Value.Database
+ else if ADOComponents <> nil then
+ FQuery.Connection := ADOComponents.DefaultDatabase
+ else
+ FQuery.Connection := nil;
+ DBConnected := FQuery.Connection <> nil;
+end;
+
+procedure TfrxADOQuery.SetMaster(const Value: TDataSource);
+begin
+ FQuery.DataSource := Value;
+end;
+
+function TfrxADOQuery.GetCommandTimeout: Integer;
+begin
+ Result := THackQuery(FQuery).CommandTimeout;
+end;
+
+procedure TfrxADOQuery.SetCommandTimeout(const Value: Integer);
+begin
+ THackQuery(FQuery).CommandTimeout := Value;
+end;
+
+procedure TfrxADOQuery.UpdateParams;
+begin
+ frxParamsToTParameters(Self, FQuery.Parameters);
+end;
+
+procedure TfrxADOQuery.OnChangeSQL(Sender: TObject);
+var
+ i, ind: Integer;
+ Param: TfrxParamItem;
+ QParam: TParameter;
+begin
+ if not FLock then
+ begin
+ { needed to update parameters }
+ FQuery.SQL.Text := '';
+ FQuery.SQL.Assign(FStrings);
+ inherited;
+
+ { fill datatype automatically, if possible }
+ for i := 0 to FQuery.Parameters.Count - 1 do
+ begin
+ QParam := FQuery.Parameters[i];
+ ind := Params.IndexOf(QParam.Name);
+ if ind <> -1 then
+ begin
+ Param := Params[ind];
+ if (Param.DataType = ftUnknown) and (QParam.DataType <> ftUnknown) then
+ Param.DataType := QParam.DataType;
+ end;
+ end;
+ end;
+end;
+
+procedure TfrxADOQuery.BeforeStartReport;
+begin
+ SetDatabase(FDatabase);
+ { needed to update parameters }
+ SQL.Text := SQL.Text;
+end;
+
+{$IFDEF QBUILDER}
+function TfrxADOQuery.QBEngine: TfqbEngine;
+begin
+ Result := TfrxEngineADO.Create(nil);
+ TfrxEngineADO(Result).FQuery.Connection := FQuery.Connection;
+end;
+{$ENDIF}
+
+{$IFDEF Delphi7}
+function TfrxADOQuery.GetLockType: TADOLockType;
+begin
+ Result := FQuery.LockType;
+end;
+
+procedure TfrxADOQuery.SetLockType(const Value: TADOLockType);
+begin
+ FQuery.LockType := Value;
+end;
+{$ENDIF}
+
+{$IFDEF FR_COM}
+// helper function that supports IUnknown and IDispatchable interfaces
+function TfrxADOQuery.COM_Object: TfrxADOQuery;
+var
+ idsp: IInterfaceComponentReference;
+begin
+ if not Assigned( VCLComObject ) then Result := Self
+ else try
+ idsp := IVCLComObject(VCLComObject) as IInterfaceComponentReference;
+ Result := TfrxADOQuery( idsp.GetComponent );
+ except
+ Result := Self;
+ end;
+end;
+
+function TfrxADOQuery.Get_Database: IfrxADODatabase; safecall;
+begin
+ Result := COM_Object.Database;
+end;
+
+procedure TfrxADOQuery.Set_Database(const Value: IfrxADODatabase); safecall;
+//var
+// idsp : IInterfaceComponentReference;
+begin
+// with COM_Object do
+// if Val <> nil then
+// begin
+// Result := Val.QueryInterface( IInterfaceComponentReference, idsp );
+// if Result = S_OK then Database := TfrxADODatabase( idsp.GetComponent );
+// end else begin
+// Database := nil;
+// end;
+ Database := TfrxADODatabase( value );
+end;
+
+function TfrxADOQuery.Get_Query: WideString; safecall;
+begin
+ Result := COM_Object.SQL.GetText;
+end;
+
+procedure TfrxADOQuery.Set_Query(const Value: WideString); safecall;
+begin
+ COM_Object.SQL.Text := Value;
+end;
+
+function TfrxADOQuery.Get_Name: WideString; safecall;
+begin
+ Result := COM_Object.Name;
+end;
+
+procedure TfrxADOQuery.Set_Name(const Value: WideString); safecall;
+begin
+ COM_Object.Name := Value;
+end;
+
+function TfrxADOQuery.Get_CommandTimeout: Integer; safecall;
+begin
+ Result := COM_Object.CommandTimeout;
+end;
+
+procedure TfrxADOQuery.Set_CommandTimeout(Value: Integer); safecall;
+begin
+ COM_Object.CommandTimeout := Value;
+end;
+
+function TfrxADOQuery.ParamByName(const Name: WideString): IfrxParamItem; safecall;
+var
+ par: TfrxParamItem;
+begin
+ par := inherited ParamByName(Name);
+ if par <> nil then Result := par;
+end;
+
+function TfrxADOQuery.AddParameter(const Name: WideString): IfrxParamItem; safecall;
+var
+ par: TfrxParamItem;
+begin
+ par := Params.Add;
+ par.Name := Name;
+ Result := par;
+end;
+
+function TfrxADOQuery.Get_Filter: WideString; safecall;
+begin
+ Result := COM_Object.Query.Filter;
+end;
+
+procedure TfrxADOQuery.Set_Filter(const Value: WideString); safecall;
+begin
+ if Value <> '' then
+ begin
+ COM_Object.Query.Filtered := False;
+ COM_Object.Query.Filter := Value;
+ COM_Object.Query.Filtered := True;
+ end
+ else
+ COM_Object.Query.Filtered := False;
+end;
+
+procedure TfrxADOQuery.Set_Master(const Param1: IfrxDataSet); safecall;
+var
+ idsp : IInterfaceComponentReference;
+ Res: HResult;
+begin
+ with COM_Object do
+ if Param1 <> nil then
+ begin
+ Res := Param1.QueryInterface( IInterfaceComponentReference, idsp);
+ if Res = S_OK then
+ Master := TfrxDBDataSet( idsp.GetComponent );
+ end
+ else
+ begin
+ Master := nil;
+ end;
+end;
+
+function TfrxADOQuery.Get_DataBaseEx: IfrxADODatabase; safecall;
+begin
+ Result := COM_Object.Database;
+end;
+
+procedure TfrxADOQuery.Set_DataBaseEx(const Value: IfrxADODatabase); safecall;
+begin
+ Set_DataBase(value);
+end;
+
+procedure TfrxADOQuery._Set_DataBaseEx(var Value: IfrxADODatabase); safecall;
+begin
+ Set_DataBase(value);
+end;
+
+function TfrxADOQuery.Get_FieldAliases: WideString; safecall;
+begin
+ Result := FieldAliases.GetText;
+end;
+
+procedure TfrxADOQuery.Set_FieldAliases(const Value: WideString); safecall;
+begin
+ FieldAliases.SetText( PChar(Value));
+end;
+{$ENDIF}
+
+{$IFDEF QBUILDER}
+constructor TfrxEngineADO.Create(AOwner: TComponent);
+begin
+ inherited;
+ FQuery := TADOQuery.Create(Self);
+end;
+
+destructor TfrxEngineADO.Destroy;
+begin
+ FQuery.Free;
+ inherited;
+end;
+
+procedure TfrxEngineADO.ReadFieldList(const ATableName: string;
+ var AFieldList: TfqbFieldList);
+var
+ TempTable: TADOTable;
+ Fields: TFieldDefs;
+ i: Integer;
+ tmpField: TfqbField;
+begin
+ AFieldList.Clear;
+ TempTable := TADOTable.Create(Self);
+ TempTable.Connection := FQuery.Connection;
+ TempTable.TableName := ATableName;
+ Fields := TempTable.FieldDefs;
+ try
+ try
+ TempTable.Active := True;
+ tmpField:= TfqbField(AFieldList.Add);
+ tmpField.FieldName := '*';
+ for i := 0 to Fields.Count - 1 do
+ begin
+ tmpField := TfqbField(AFieldList.Add);
+ tmpField.FieldName := Fields.Items[i].Name;
+ tmpField.FieldType := Ord(Fields.Items[i].DataType)
+ end;
+ except
+ end;
+ finally
+ TempTable.Free;
+ end;
+end;
+
+procedure TfrxEngineADO.ReadTableList(ATableList: TStrings);
+begin
+ ATableList.Clear;
+ frxADOGetTableNames(FQuery.Connection, ATableList, ShowSystemTables);
+// FQuery.Connection.GetTableNames(ATableList, ShowSystemTables);
+end;
+
+function TfrxEngineADO.ResultDataSet: TDataSet;
+begin
+ Result := FQuery;
+end;
+
+procedure TfrxEngineADO.SetSQL(const Value: string);
+begin
+ FQuery.SQL.Text := Value;
+end;
+{$ENDIF}
+
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxADODataBase, TFmxObject);
+ GroupDescendentsWith(TfrxADOTable, TFmxObject);
+ GroupDescendentsWith(TfrxADOQuery, TFmxObject);
+ frxObjects.RegisterObject1(TfrxADODataBase, nil, '', {$IFDEF DB_CAT}'DATABASES'{$ELSE}''{$ENDIF}, 0, 240);
+ frxObjects.RegisterObject1(TfrxADOTable, nil, '', {$IFDEF DB_CAT}'TABLES'{$ELSE}''{$ENDIF}, 0, 241);
+ frxObjects.RegisterObject1(TfrxADOQuery, nil, '', {$IFDEF DB_CAT}'QUERIES'{$ELSE}''{$ENDIF}, 0, 242);
+
+
+finalization
+ frxObjects.UnRegister(TfrxADODataBase);
+ frxObjects.UnRegister(TfrxADOTable);
+ frxObjects.UnRegister(TfrxADOQuery);
+
+end.
\ No newline at end of file
diff --git a/LibD28x64/FMX.frxADOEditor.pas b/LibD28x64/FMX.frxADOEditor.pas
new file mode 100644
index 0000000..7175808
--- /dev/null
+++ b/LibD28x64/FMX.frxADOEditor.pas
@@ -0,0 +1,157 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ ADO components design editors }
+{ }
+{ Copyright (c) 1998-2011 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxADOEditor;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ Winapi.Windows, System.Classes, System.SysUtils, FMX.Forms, FMX.frxADOComponents, FMX.frxCustomDB,
+ FMX.frxDsgnIntf, FMX.frxRes, Data.DB, Data.Win.ADODB, Winapi.ADOInt, System.Variants, FMX.Platform.Win;
+
+
+type
+ TfrxDatabaseNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+ TfrxDatabaseProperty = class(TfrxComponentProperty)
+ public
+ function GetValue: String; override;
+ end;
+
+ TfrxTableNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxIndexNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ end;
+
+
+{ TfrxDatabaseNameProperty }
+
+function TfrxDatabaseNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog];
+end;
+
+function TfrxDatabaseNameProperty.Edit: Boolean;
+var
+ SaveConnected: Boolean;
+ db: TADOConnection;
+ fName: String;
+begin
+ db := TfrxADODatabase(Component).Database;
+
+ SaveConnected := db.Connected;
+ db.Connected := False;
+ //FmxHandleToHWND(Application.MainForm.Handle)
+ fName := PromptDataSource(0, db.ConnectionString);
+ Result := fName <> '';
+ if Result then
+ db.ConnectionString := fName;
+ db.Connected := SaveConnected;
+end;
+
+
+{ TfrxDatabaseProperty }
+
+function TfrxDatabaseProperty.GetValue: String;
+var
+ db: TfrxADODatabase;
+begin
+ db := TfrxADODatabase(GetOrdValue);
+ if db = nil then
+ begin
+ if (ADOComponents <> nil) and (ADOComponents.DefaultDatabase <> nil) then
+ Result := ADOComponents.DefaultDatabase.Name
+ else
+ Result := frxResources.Get('prNotAssigned');
+ end
+ else
+ Result := inherited GetValue;
+end;
+
+
+{ TfrxTableNameProperty }
+
+function TfrxTableNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paSortList];
+end;
+
+procedure TfrxTableNameProperty.GetValues;
+begin
+ inherited;
+ with TfrxADOTable(Component).Table do
+ if Connection <> nil then
+ frxADOGetTableNames(Connection, Values, False);
+end;
+
+procedure TfrxTableNameProperty.SetValue(const Value: String);
+begin
+ inherited;
+ Designer.UpdateDataTree;
+end;
+
+
+{ TfrxIndexProperty }
+
+function TfrxIndexNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList];
+end;
+
+procedure TfrxIndexNameProperty.GetValues;
+var
+ i: Integer;
+begin
+ inherited;
+ try
+ with TfrxADOTable(Component).Table do
+ if (TableName <> '') and (IndexDefs <> nil) then
+ begin
+ IndexDefs.Update;
+ for i := 0 to IndexDefs.Count - 1 do
+ if IndexDefs[i].Name <> '' then
+ Values.Add(IndexDefs[i].Name);
+ end;
+ except
+ end;
+end;
+
+
+initialization
+ frxPropertyEditors.Register(TypeInfo(String), TfrxADODataBase, 'DatabaseName',
+ TfrxDataBaseNameProperty);
+ frxPropertyEditors.Register(TypeInfo(TfrxADODatabase), TfrxADOTable, 'Database',
+ TfrxDatabaseProperty);
+ frxPropertyEditors.Register(TypeInfo(TfrxADODatabase), TfrxADOQuery, 'Database',
+ TfrxDatabaseProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxADOTable, 'TableName',
+ TfrxTableNameProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxADOTable, 'IndexName',
+ TfrxIndexNameProperty);
+
+end.
diff --git a/LibD28x64/FMX.frxADORTTI.pas b/LibD28x64/FMX.frxADORTTI.pas
new file mode 100644
index 0000000..48b404b
--- /dev/null
+++ b/LibD28x64/FMX.frxADORTTI.pas
@@ -0,0 +1,102 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ ADO components RTTI }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxADORTTI;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, FMX.fs_iinterpreter, FMX.frxADOComponents, FMX.fs_iadortti
+, System.Variants;
+
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TADOLockType', 'ltUnspecified, ltReadOnly, ltPessimistic, ltOptimistic, ltBatchOptimistic');
+ with AddClass(TfrxADODatabase, 'TfrxCustomDatabase') do
+ AddProperty('Database', 'TADOConnection', GetProp, nil);
+ with AddClass(TfrxADOTable, 'TfrxCustomTable') do
+ AddProperty('Table', 'TADOTable', GetProp, nil);
+ with AddClass(TfrxADOQuery, 'TfrxCustomQuery') do
+ begin
+ AddMethod('procedure ExecSQL', CallMethod);
+ AddProperty('Query', 'TADOQuery', GetProp, nil);
+ end;
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TfrxADOQuery then
+ begin
+ if MethodName = 'EXECSQL' then
+ begin
+ TfrxADOQuery(Instance).UpdateParams;
+ TfrxADOQuery(Instance).Query.ExecSQL
+ end
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TfrxADODatabase then
+ begin
+ if PropName = 'DATABASE' then
+ Result := frxInteger(TfrxADODatabase(Instance).Database)
+ end
+ else if ClassType = TfrxADOTable then
+ begin
+ if PropName = 'TABLE' then
+ Result := frxInteger(TfrxADOTable(Instance).Table)
+ end
+ else if ClassType = TfrxADOQuery then
+ begin
+ if PropName = 'QUERY' then
+ Result := frxInteger(TfrxADOQuery(Instance).Query)
+ end
+end;
+
+
+initialization
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28x64/FMX.frxAbout.fmx b/LibD28x64/FMX.frxAbout.fmx
new file mode 100644
index 0000000..3e5829c
--- /dev/null
+++ b/LibD28x64/FMX.frxAbout.fmx
@@ -0,0 +1,274 @@
+object frxAboutForm: TfrxAboutForm
+ Left = 0
+ Top = 0
+ Caption = 'About FastReport'
+ BorderStyle = bsSingle
+ ClientHeight = 276
+ ClientWidth = 255
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object Label2: TLabel
+ Position.Point = '(136,44)'
+ Width = 102.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 0
+ Font.Style = [fsBold]
+ TextAlign = taTrailing
+ end
+ object Label3: TLabel
+ Position.Point = '(16,88)'
+ Width = 214.000000000000000000
+ Height = 29.000000000000000000
+ TabOrder = 1
+ end
+ object Label5: TLabel
+ Tag = 1
+ Cursor = crHandPoint
+ Position.Point = '(62,156)'
+ Width = 179.000000000000000000
+ Height = 13.000000000000000000
+ OnClick = LabelClick
+ TabOrder = 2
+ Font.Style = [fsUnderline]
+ TextAlign = taTrailing
+ Text = 'http://www.fast-report.com'
+ end
+ object Shape1: TLine
+ Position.Point = '(16,128)'
+ Width = 229.000000000000000000
+ Height = 1.000000000000000000
+ LineType = ltDiagonal
+ end
+ object Label1: TLabel
+ Position.Point = '(56,16)'
+ Width = 185.000000000000000000
+ Height = 29.000000000000000000
+ TabOrder = 4
+ Font.Size = 20.000000000000000000
+ Font.Style = [fsBold]
+ TextAlign = taTrailing
+ Text = 'FastReport FMX'
+ end
+ object Image1: TImage
+ Position.Point = '(16,16)'
+ Width = 62.000000000000000000
+ Height = 62.000000000000000000
+ Bitmap.PNG = {
+ 89504E470D0A1A0A0000000D4948445200000040000000400806000000AA6971
+ DE000000017352474200AECE1CE90000000467414D410000B18F0BFC61050000
+ 00097048597300000EC300000EC301C76FA864000012F749444154785EE55B77
+ 50D5D7BAA563C18620225550BAA0880222D2047B2F282A28B6A0B16137621705
+ 2987DE9B0236628DA6989B9B18A3D76472F332495E26C9242F93C9BB99BC9B49
+ 2699E4EFF5BEB50F0739823F0E897F385E67D650E49CB3D7DA7B7FDFB7BEBD7F
+ 66F20FFFE1D07F131313A33065CA940E4447477760F2E4C91D888A8AD263D224
+ 4C6A476464A4424444844278787807264E9CA83061C20485B0B03085F1E3C763
+ 7C68284205E3C68D53183B76AC42484888427070B0C2983163101414A4101818
+ A810101080007F7FF80BFCFCFC147C7D7DE1EBE3031FC1E8D1A315468D1A8551
+ DEDEF01678797929180960209F9595A570F0E041BCF4D24B0A070E1CC0FEFDFB
+ 15F6EDDB87BD7BF762CF9E3DD8BD7BB7C2AE5DBBB073E74E64666662C78E1DD8
+ BE7D3BB66DDB86AD5BB72A6CD9B2052FBEF822366FDE8C4D9B36212323032FBC
+ F002366EDC880DEBD763DDBA7558BB762DD2D3D3B166CD1AAC5EBD1A69696948
+ 4D4DC5AA55ABB072E54AAC4849C1F2E5CBB16CD93224272763E9D2A558B26409
+ 162F5A84850B1762C18205983F7F3EE6CD9B87B973E660F6ECD998356B1666CE
+ 9C8919336660FAB469484A4A42626222A64E9D8A912347C2D3D3D3580003F937
+ DE7843E1F5D75FC76BAFBD86DBB76FE3D6AD5B78E5955770F3E64DDCB87103D7
+ AE5DC3D5AB5771E5CA15BCFCF2CBB87CF9322E5DBA848B172FE2FCF9F3686D6D
+ 454B730BCE9D3B87B367CFA2B1B1110D0D0DA8ABAB436D6D2DAAABAB51555989
+ 8A8A0A949595A1B4B414C5C5C5D0E974282C2C447E7E3ECE9C3983DCDC5C9C3E
+ 7D1AD9D9D93879E2048E1F3F8EA3478FE2F0E1C338D43E519C204E8C9A94F6C9
+ E044701294F8143E6393127DC3860D48884F405C5C9CB1005CEE247FE7CE1D45
+ FE8F3FFEC0EFBFFF8EDF7EFB0DBFFEFA2B7EF9E517FCFCF3CFF8E9A79FF0EFFF
+ FB377EFCF147FCF0C30FF8D7FFFE0BDF7FFF3DBEFBEE3B7CFBEDB7F8E69B6FF0
+ F5D75FE3ABAFBEC2175F7C81CF3FFF1C9F7DF6193EF9E4137CFCF1C7F8E8A38F
+ F0E1871FE2830F3EC0C3870FF1E0FE7DDCBB770F77EFDEC5DB6FBF8DB7DE7A0B
+ 6FCA1828FEABAFBEAA84BFD92E38C56E13A10D22B7343777884B616B6A6A94A8
+ E5E5E54AD0A2A222BD9879797A214F9D52AB8D2B2D3636161E1E1EC60250CDE7
+ 99FCC9932771FCD871AC912DC615FF44019E67F2478E1C415A6A9AE2EBEEEE6E
+ 2C00031E07F03C933F74E8900AACD192C9DCDCDC1E09C034470118F49E67F207
+ 85E38A152B540AEF2200A3E96B3288E7993C5339D329EB165757D7AE027020CF
+ 33F9BD922A5947B0607375E92400AB3BFE01737E4FE4FF47C87FF5E5578AF0A7
+ 9F7E2A5FFFFBE9926F6BD3D714172EA87A82B5C4D322CFA26DA9145011E11170
+ 7171311680C50407D3D3CC7FF9C597B8FFDE03A42C5B83C898E9F00F8DC2E8E0
+ 49F00C0C87BBFF04B8F9FD35B80B1CDDFC30DC7514743332D02A05158BA8A741
+ 3E734726162F5EACCAF211234674124082C23E297159EDF5B4EC3FFAE77F6175
+ EA4678788E46DF7E0360656D030B0B4B98999B1BDEF0AF43DECBDADA169111D3
+ 70B3A60D4D8D4D42BEEA2F936775C8D2997EC448004645D6F85C8A3DEDF907FF
+ 7888C4190B3060903DCC2D2C8C07FE14616E6E0167471754EF3885B3F58DA878
+ 0AE4591A2F10CF4023E6ECEC6CF82CBD00ACA5AF5FBFDE63C0BBFFE01F884D9A
+ 837E76839EEEAC3F06AE2A57670F54651E47636D3DCA9E02F9CD62C66898E842
+ 9D877712806981CE8E81488B3CA3FD7BF71F202671B60830505EDCB300E6F237
+ 9616560A2465AE01FEBF95FC5D1FAB3EB01FE88084E81968A96C425D4DAD324B
+ 7F953C0DD11C718BB4DFC3870F378C512F005F4087A7459ED1FEDD7BEF2901FA
+ F6EF5900120A1C37057941B3D010B114F5E14BD03851109084A6C7D010300FF5
+ 829AC0B9280D4A4451F85CB49537A1B1A65E967F058AC42916B4BB443AC43F43
+ 7E83D86F5A65F61D9C9C9C0CE3345379913692D6568B3C53DDBDF7EE232A7E06
+ FAF4B33322DB15E6B0771C8153DBC5635CBE86D76FBF8ADB1264AF5FBBAE3E87
+ A9EEF13CDF505F8F7A01BF9EADAB47737915EAF374A8CC2B4465BE40578C525D
+ 11CEE4E4E28458E3DE9267DF61D6CC99AAE1D25580CC4C9583B5C833CF3F9018
+ 30313A11367DFA7522DB1516969618171A8D9B6D423EA71C67C366A0C63E1035
+ 83025033C00F35FD7DBB879DFCDF407F54DB07A1726800CA9D4251E91681A6F0
+ D9B8B6250B37B28B51969D8393478FF59A3C1B2E6C90B0D3346CD830C358F502
+ B0A3C3C686167916390FDF7F1F21E1B1B0B2B13522FC382CADAC10163A19AF5C
+ B986ABA999287708419199B360387426827FAB5E63E186625B2F54D807A3C62B
+ 0A0D49CB907FE8280E1FCCEA15F9B4D4544C9F3E5DB5D88C04600F8F5D14969F
+ 5AE459E13D7CF83E82C2A608411B23C28FC3D2CA1A1345801B975EC6D5E4AD28
+ B51BDD2DC9DE41C4B0744571FFD128779F8893878F60BF1470A692677B6D5A52
+ 92EA2F3A3A3A1AC6AA1780BDBC0B527E6A916779CB2D106892003698129188EB
+ 97AFE0564616AA1C43516AED81122150623E4266D645E0A55022DFF377EAF7E6
+ CEDD103746A1992B0A6C46A26EE404590507552B6CBB09E4535252545F704C50
+ 90B100ECDC523DD6DE5AE459DBDF932C1034A16701180382C784E3DAE597F156
+ 79332E4C4BC7F9C8C5B818958C4B9392D136652DAE4DDBA470755A06AECECAC0
+ 95C4743407C4A3D8DAB55BE29D4111747D47A1357D27B2F6ECC55613C82F1323
+ C4A6283BCB8E0E0E86B1EA056007B7A5A545933C8DCDDDBBEF9AB4059805860C
+ 76C4B1796BD1505285E6EA7A5C6A3D8FD696563435496E1773A36F8E5629540B
+ 6A04F51555381F3D1F3A2B8F6E897746A1A5072A474F46F69E03D8212B38A307
+ F2EC2427C4C7AB96BA436701680EB87CE8BCB4C8D3D5BDF3CE5D04C8DEE61E7F
+ 44B67B584AA96C2F2284844461DC8438048F8F4150E814048D9D02DF8070048E
+ 959F89713108967A2175661AAE979E459DA43B5D7F2F1498B9754BDC80428909
+ A5125CEBD6EFC24BDB77AA56BB16F9458B16A98E706040405701D8BB673ED622
+ AFB7B4EFC0776C942C712B23B24F8494CBFC5BC25CB685F20F2CA13B60A17E6F
+ 25E6C7D5DE1979D3D7A22A271FBA413E2240F7C43BA3C44E52E7F4141CDCBC0D
+ EB65F6B5C8D307B023CC031587A1430D633453EE8807172C46B4C9D3CFFF1D3E
+ 6327992E402FE0D07700B21356A2223B17BAC17E2609506CED89AAA038ECCED8
+ 8CB5E9E99AE4E7CD9D8B982953D449D2D0C705E0A90D7DB736F9B7F0E69B6FC2
+ 6F5C2F56402FE028029C966D5076E2340A07058A002EDD92EE8C622B57547847
+ 207363863A55D222CF3298DD2F1EA11909407BC8232B06264DF277EEA8C669E0
+ F8689362406F4101B2E39351722C1BBA815C013DA7C4624987D5C153B163C30B
+ 485DB54A933C8FCAD8FBF0F3F5C5507B7BC3E7EA0560FAE0B1951679B6B16EDD
+ BADD2E404F59400B0613A58F038C0B14D479B0034E27AC40D17111C08E31C0BD
+ 5BD28F204170803F1A67A7C90AD884952B566892E719218D9FAF8F2FEC3B0B40
+ 7FCC08CAB4A4459E3D3C768D4CCD0284B910B4934C603FDC0D0E82612E9E18E6
+ EA0D27B7517072F781B3872F5C3C7DE1EEE527FB73265A4E94A1486A7D5DBF91
+ 12E57BD802E6AE28730A46DD062984D6BFA03ABE5AE493A4088A94A28F27C75D
+ 04E0C1615555952679D5C0BC7953B280694190337BD26F366A44D8EA2A81E4F9
+ 4AB1B61565E5282B2D434971098A8B24E515E8509857009DA0F44C01AEA6EF83
+ CED60401C41FD48C89C7C10D9BB12E6D8D3A35D6229F9090A06A1E1E991B09C0
+ 060153084F6B35C9DFB881EBD76FC027C4340182C2E215F1BACA6ABC9E578B37
+ 72E56B6E15DED435E09DCA56BC5BD78677AA2FE26F65CDB853DC80574F96E2FC
+ B414F10D3E52128FE89E743B0A2DDD513C740CEAD377606BFA7A249B409E35C0
+ 4409F8A3478DC29021430CE3D40BB06EDD3AD574D422AF5AD757AF9AB60264E9
+ A727A68A0055685B99819AA078D449995B1F98803AFF78D47847A3CA2312D523
+ A350E313835ADF3854B9854B5EF741A1851679098C5623254D06A236613976AF
+ DD88352B5799449E87A28C77BC304101B83D65AC66AA43C20A8A7D374DF257AE
+ E0D2A5CBF05769503B06B0A9B96CEA4A55DE5E9CBF0E154E212896DABDC8D61B
+ 3A6B2FE82C3D8528E1F1E8AB39839E46E4973DCFF728759988F2B8A5D89EBE01
+ 2B96A7A88B12A6908F9E1CADB63B6F8A741180E7E62525259AE4DB2EB7A1F5FC
+ 050982513D0641EEFF1514A0BC12171667C86C47A06C901F4AC5CAD2DB1759B2
+ CCE54C93B001DD906E47B1B51BCA1C02512E7BBE62790676A56FC42A457EB1C9
+ E479A52754B87A7B3D26005B442C21D9787C3279FD71558B9819AE809E05B044
+ 4AFC0A549494A16DE75134C52E46E3849968189B28CB7F124A07F9CA2A70EF39
+ D009180F1A4746A369D5161C49CFC08BABD72275C54A2C594CF20B4C26CF0C40
+ AEBC23D45500A9A2D876D622CF1E5E73738B0830C9A41590103103BA421D2AF2
+ 75B878381797761FC3C5ED59685D9789DAB0E9289262878E4E59DB6E8877C0C2
+ 15AD93962067C3366C973D9F22E98E273CBC1BD41BF2E1E279428283E13572A4
+ 12C082BE8483658F8C6524DBCE5AE45BC42E9F3D7BCE3401240650007671734E
+ 9D862E370FA5B9F92839958BC2232790BFEF206A27CEC6D9C0441458F45CF014
+ F7198D86B8E5D826113F2579D99F223F410220BB41BC24D54500DECC2A282878
+ 32F9E6669C13B7585FDFD01E03B42B410A902C555DCEE91C75B1E9C8E123387C
+ E830B278B169FF01ECDFB31707F6EEC5BE3D7BD0E21FDBB3F19100582401B051
+ DE737DEA6A2C5AB0B0D7E479252F2830485D90EA2200AFA5F176D693C81B5AD7
+ D535B5081A3F59D9D7CE841F0705589D9886EC93D98F756FF7EA7B789999AA8D
+ B575CB5665C59B5CC36425F4B015D82EB3F1C2B998E558BE345909D01BF2E364
+ ABD30AF37E909100EC925280BCBC3C4DF2ECD9574A61133C211A36B67DBB90EE
+ 0CC6800571C9EA6A9B49AD6BA9449B5CA3553CD08A09AA1F2871A33572A18AFE
+ 1460AA89E4B9FFFDC509F27ED0E0C1838D05E0DD191E393D893C9D626D4D0D2A
+ 2BAAC4512562E0004651F506DD82A7422163A270F4C8D15EB5AED54A306319AC
+ 2D42A185339A82E3B078DE7C244D4D442CC98BD5D522CF66A8AF38415E8F3112
+ 8081813E3A2727E789E4D5F9BC54755592D70FAEDC82400F1F0CB01B0C6BDB7E
+ B0B4EE0373A90CCDA538D29FF359C1D6A61FB6FA24E058D6E15EF5ED398E3A87
+ 504D01083AC502A9088B3CC2B07CF65C24C6C52BABAB459EAD301FF101BC1E33
+ 68D02063017879E8D4A9534F26DF7E394119993C1D76CE4B4364781CFCC646C2
+ 3B281C1EFEFACB0DEA92837CEF1712859399593822D1BE37E40D7EBEC9799CCC
+ 32EB042D219C51D0D7030563A762E5ECF9888B895566E749E4FDFDFC31CA7B14
+ 5C46B860D0C0818F04609B981FCC03472DF23C9F67B1542CB9BDF04C3ECEE4F0
+ 3AAB2027575D673D76EC98FE1AAB04BD4359879075200B2FEDDBDF6BF2064B5B
+ EF10D97376908AB2C4792CF216A6636ED27465769E449ECB9F45D00867670C7C
+ 5C005E4466C0D222FFE87C5EC8F3889AF778794AFB270F2AB5C81BCADBFA2163
+ B445607AB40F44EE8C65989590A86AFD2791A70D660AE4D1F88001031E09C03E
+ 396F4F315FF74CFEAF9DCFF786BC21CF9F758D92AD30AC1BF2B205C423E4BB04
+ 634E62122264F96B91E795790FC9003C17B4EBDFFF5129CCDCC80F2789678DBC
+ CAF34949A8E34AE854271489652EECE38122B1D39CF908097C34755AE45902BB
+ 4900E4A950BF7EFD1E09C036313F9CF7859F39F252E430CFF348ABDA290C3A2B
+ 4F298BBD513AD41F2591F3303F71BA0463997913C87B7A784A001CA11AA27DFB
+ 76D43166AA4DCCDA9A249E35F2860A2F5622FC34F9B97AC23C94D13FCC4FC3AA
+ A459981C11A92CAE29E4590039CBFE1F2235409F3E7D8C05E0E5215E947A16C9
+ 1B2A3C82F97E4EE234CC4948424CD464211F6A32792E7F27D9FF4C81B6361D5E
+ C64CBD808F9AECDAB9F39925DF51E1C97267AA0B1B1F66F2B2379067FEE7FE67
+ 06B0E92C00DBC41C002F493CD3E4352A3C53C833FF73FFF7970C606DDD61E7CD
+ D48B38806D5BB73ED7E4873B392917C80C606DD5D1D4D50BC0CB43B4A5CF3379
+ E6FFC1E201FA4906B0EA2C00DBC41C040F489F67F2DCFF0C807DFB3C2E80BC98
+ C506493CCFE47922CC00C814686969F94800F6C97979884D091E903CCFE4EDEC
+ EC606B6B6B2C001D122B2D3E54A89EE05C2D44F8F4A6E1C94DB1CA8627370D4F
+ 6D92D4C2F62736E70AB139428C4F6B767E5253FF9EF1888B8DD51364C3423CFB
+ A4F6476C7933453D42DB4E928D191A3396E6AC4DD4E3AFB23DD523AF24294686
+ B53C1B1AF4F4ACEA78EB9BE686F97D98A3A3BAFA42B2F643EC55C1C33DCF65DF
+ 99BCAD4D3702B053CA99E015120E964F9271C086678579AC6C7836387CA23E17
+ 7386C2C47D199EFD353CF3DBF9595FC333BE6C4571D60CCFF432EEF080A28398
+ 8707DCBB236698C54EE498CAEC259A2B82023637686F49728090B4EB6FA7521D
+ A33D031EF73C977D67F2BCBFD42100C1411806A206D3AEB4416D35301717053E
+ 6CC0256618A461A086C11A066C1834EFE3A859E1C0054C450407AF66A89D8081
+ 04678A20890E2202D6EF0A4286843A480958D82858DBA81CAF20818EC18E50A4
+ 0D78449E6798CA11FD87C20CFF0F487B6657493B6B380000000049454E44AE42
+ 6082}
+ end
+ object Label4: TLabel
+ Position.Point = '(16,140)'
+ Width = 229.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 6
+ end
+ object Label6: TLabel
+ Position.Point = '(16,180)'
+ Width = 49.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 7
+ end
+ object Label7: TLabel
+ Tag = 2
+ Cursor = crHandPoint
+ Position.Point = '(116,180)'
+ Width = 125.000000000000000000
+ Height = 13.000000000000000000
+ OnClick = LabelClick
+ TabOrder = 8
+ Font.Style = [fsUnderline]
+ TextAlign = taTrailing
+ Text = 'sales@fast-report.com'
+ end
+ object Label8: TLabel
+ Position.Point = '(16,196)'
+ Width = 49.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 9
+ end
+ object Label9: TLabel
+ Tag = 2
+ Cursor = crHandPoint
+ Position.Point = '(100,196)'
+ Width = 141.000000000000000000
+ Height = 13.000000000000000000
+ OnClick = LabelClick
+ TabOrder = 10
+ Font.Style = [fsUnderline]
+ TextAlign = taTrailing
+ Text = 'support@fast-report.com'
+ end
+ object Label10: TLabel
+ Position.Point = '(240,14)'
+ Width = 3.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 11
+ end
+ object Button1: TButton
+ Position.Point = '(93,232)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 12
+ ModalResult = 1
+ Text = 'OK'
+ Default = True
+ end
+end
diff --git a/LibD28x64/FMX.frxAbout.pas b/LibD28x64/FMX.frxAbout.pas
new file mode 100644
index 0000000..6c9c681
--- /dev/null
+++ b/LibD28x64/FMX.frxAbout.pas
@@ -0,0 +1,98 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ About window }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxAbout;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, System.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.Objects, FMX.Types
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+type
+ TfrxAboutForm = class(TForm)
+ Button1: TButton;
+ Label2: TLabel;
+ Label3: TLabel;
+ Image1: TImage;
+ Label5: TLabel;
+ Shape1: TLine;
+ Label1: TLabel;
+ Label4: TLabel;
+ Label6: TLabel;
+ Label7: TLabel;
+ Label8: TLabel;
+ Label9: TLabel;
+ Label10: TLabel;
+ procedure FormCreate(Sender: TObject);
+ procedure LabelClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+
+implementation
+
+uses FMX.frxClass, FMX.frxUtils, FMX.frxRes
+{$IFDEF MSWINDOWS}
+ , Winapi.ShellAPI, Winapi.Windows
+ {$ENDIF}
+ {$IFDEF MACOS}
+ , Posix.Stdlib
+{$ENDIF};
+
+{$R *.FMX}
+
+procedure TfrxAboutForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(2600);
+ Label4.Text := frxGet(2601);
+ Label6.Text := frxGet(2602);
+ Label8.Text := frxGet(2603);
+ Label2.Text := 'Version ' + FR_VERSION;
+ Label10.Text := #174;
+ Label3.Text := '(c) 2011-' + FormatDateTime('YYYY', Now) + ' by Alexander Tzyganenko, Fast Reports Inc.';
+end;
+
+procedure TfrxAboutForm.LabelClick(Sender: TObject);
+var
+ sLink: String;
+begin
+ case TLabel(Sender).Tag of
+ 1: sLink := TLabel(Sender).Text;
+ 2: sLink := 'mailto:' + TLabel(Sender).Text;
+ end;
+
+{$IFDEF MSWINDOWS}
+ ShellExecute(0, 'open', PChar(sLink), '', '', SW_SHOWNORMAL);
+{$ENDIF}
+{$IFDEF MACOS}
+ _system(PAnsiChar('open ' + AnsiString(sLink)));
+{$ENDIF}
+end;
+
+procedure TfrxAboutForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKESCAPE then
+ ModalResult := mrCancel;
+end;
+
+end.
+
diff --git a/LibD28x64/FMX.frxAggregate.pas b/LibD28x64/FMX.frxAggregate.pas
new file mode 100644
index 0000000..4620941
--- /dev/null
+++ b/LibD28x64/FMX.frxAggregate.pas
@@ -0,0 +1,698 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Aggregate Functions }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxAggregate;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.frxClass, System.Variants;
+
+
+type
+ TfrxAggregateFunction = (agSum, agAvg, agMin, agMax, agCount);
+
+ TfrxAggregateItem = class(TObject)
+ private
+ FAggregateFunction: TfrxAggregateFunction;
+ FBand: TfrxDataBand;
+ FCountInvisibleBands: Boolean;
+ FDontReset: Boolean;
+ FExpression: String;
+ FIsPageFooter: Boolean;
+ FItemsArray: Variant; { used for vbands }
+ FItemsCount: Integer;
+ FItemsCountArray: Variant; { used for vbands }
+ FItemsValue: Variant;
+ FKeeping: Boolean;
+ FLastCount: Integer;
+ FLastValue: Variant;
+ FMemoName: String;
+ FOriginalName: String;
+ FParentBand: TfrxBand;
+ FReport: TfrxReport;
+ FTempItemsCount: Integer;
+ FTempItemsValue: Variant;
+ FVColumn: Integer; { used for vbands }
+ public
+ procedure Calc;
+ procedure DeleteValue;
+ procedure Reset;
+ procedure StartKeep;
+ procedure EndKeep;
+ function Value: Variant;
+ end;
+
+ TfrxAggregateList = class(TObject)
+ private
+ FList: TList;
+ FReport: TfrxReport;
+ function GetItem(Index: Integer): TfrxAggregateItem;
+ procedure FindAggregates(Memo: TfrxCustomMemoView; DataBand: TfrxDataBand);
+ procedure ParseName(const ComplexName: String; var Func: TfrxAggregateFunction;
+ var Expr: String; var Band: TfrxDataBand; var CountInvisible, DontReset: Boolean);
+ property Items[Index: Integer]: TfrxAggregateItem read GetItem; default;
+ public
+ constructor Create(AReport: TfrxReport);
+ destructor Destroy; override;
+ procedure Clear;
+ procedure ClearValues;
+
+ procedure AddItems(Page: TfrxReportPage);
+ procedure AddValue(Band: TfrxBand; VColumn: Integer = 0);
+ procedure DeleteValue(Band: TfrxBand);
+ procedure EndKeep;
+ procedure Reset(ParentBand: TfrxBand);
+ procedure StartKeep;
+ function GetValue(ParentBand: TfrxBand; const ComplexName: String;
+ VColumn: Integer = 0): Variant; overload;
+ function GetValue(ParentBand: TfrxBand; VColumn: Integer;
+ const Name, Expression: String; Band: TfrxBand; Flags: Integer): Variant; overload;
+ end;
+
+
+implementation
+
+uses
+ FMX.frxVariables, FMX.frxUtils, FMX.frxFMX;
+
+
+type
+ THackComponent = class(TfrxComponent);
+
+procedure Get3Params(const s: String; var i: Integer;
+ var s1, s2, s3: String);
+var
+ c, d, e, oi, ci: Integer;
+begin
+ s1 := ''; s2 := ''; s3 := '';
+ c := 1; d := 1; e := 1; oi := i + 1; ci := 1;
+ repeat
+ Inc(i);
+ if s[i] = '''' then
+ if (d = 1) and (e = 1) then Inc(d) else d := 1;
+ if (d = 1) and (s[i] = '"') then
+ if e = 1 then Inc(e) else e := 1;
+ if (d = 1) and (e = 1) then
+ begin
+ if s[i] = '(' then
+ Inc(c) else
+ if s[i] = ')' then Dec(c);
+ if (s[i] = ',') and (c = 1) then
+ begin
+ if ci = 1 then
+ s1 := Copy(s, oi, i - oi) else
+ s2 := Copy(s, oi, i - oi);
+ oi := i + 1; Inc(ci);
+ end;
+ end;
+ until (c = 0) or (i >= Length(s));
+ case ci of
+ 1: s1 := Copy(s, oi, i - oi);
+ 2: s2 := Copy(s, oi, i - oi);
+ 3: s3 := Copy(s, oi, i - oi);
+ end;
+ Inc(i);
+end;
+
+
+{ TfrxAggregateItem }
+
+procedure TfrxAggregateItem.Calc;
+var
+ Value: Variant;
+ i: Integer;
+begin
+ if not FBand.Visible and not FCountInvisibleBands then Exit;
+
+ FReport.CurObject := FMemoName;
+ if FAggregateFunction <> agCount then
+ Value := FReport.Calc(FExpression) else
+ Value := Null;
+
+ if VarType(Value) = varBoolean then
+ if Value = True then
+ Value := 1;
+
+ { process vbands }
+ if FVColumn > 0 then
+ begin
+ if VarIsNull(FItemsArray) then
+ begin
+ FItemsArray := VarArrayCreate([0, 1000], varVariant);
+ FItemsCountArray := VarArrayCreate([0, 1000], varVariant);
+ for i := 0 to 1000 do
+ begin
+ FItemsArray[i] := Null;
+ FItemsCountArray[i] := 0;
+ end;
+ end;
+
+ if (FAggregateFunction <> agAvg) or (Value <> Null) then
+ FItemsCountArray[FVColumn] := FItemsCountArray[FVColumn] + 1;
+ if FItemsArray[FVColumn] = Null then
+ FItemsArray[FVColumn] := Value
+ else if Value <> Null then
+ case FAggregateFunction of
+ agSum, agAvg:
+ FItemsArray[FVColumn] := FItemsArray[FVColumn] + Value;
+ agMin:
+ if Value < FItemsArray[FVColumn] then
+ FItemsArray[FVColumn] := Value;
+ agMax:
+ if Value > FItemsArray[FVColumn] then
+ FItemsArray[FVColumn] := Value;
+ end;
+ end
+ else if FKeeping then
+ begin
+ if (FAggregateFunction <> agAvg) or (Value <> Null) then
+ Inc(FTempItemsCount);
+ if FTempItemsValue = Null then
+ FTempItemsValue := Value
+ else if Value <> Null then
+ case FAggregateFunction of
+ agSum, agAvg:
+ FTempItemsValue := FTempItemsValue + Value;
+ agMin:
+ if Value < FTempItemsValue then
+ FTempItemsValue := Value;
+ agMax:
+ if Value > FTempItemsValue then
+ FTempItemsValue := Value;
+ end;
+ end
+ else
+ begin
+ FLastCount := FItemsCount;
+ FLastValue := FItemsValue;
+ if (FAggregateFunction <> agAvg) or (Value <> Null) then
+ Inc(FItemsCount);
+ if FItemsValue = Null then
+ FItemsValue := Value
+ else if Value <> Null then
+ case FAggregateFunction of
+ agSum, agAvg:
+ FItemsValue := FItemsValue + Value;
+ agMin:
+ if Value < FItemsValue then
+ FItemsValue := Value;
+ agMax:
+ if Value > FItemsValue then
+ FItemsValue := Value;
+ end;
+ end;
+end;
+
+procedure TfrxAggregateItem.DeleteValue;
+begin
+ FItemsCount := FLastCount;
+ FItemsValue := FLastValue;
+end;
+
+procedure TfrxAggregateItem.Reset;
+begin
+ if FDontReset and (FItemsCount <> 0) then Exit;
+
+ FItemsCount := 0;
+ FItemsValue := Null;
+ FItemsArray := Null;
+ FItemsCountArray := Null;
+end;
+
+procedure TfrxAggregateItem.StartKeep;
+begin
+ if not FIsPageFooter or FKeeping then Exit;
+ FKeeping := True;
+
+ FTempItemsCount := 0;
+ FTempItemsValue := Null;
+end;
+
+procedure TfrxAggregateItem.EndKeep;
+begin
+ if not FIsPageFooter or not FKeeping then Exit;
+ FKeeping := False;
+
+ FItemsCount := FItemsCount + FTempItemsCount;
+ if FItemsValue = Null then
+ FItemsValue := FTempItemsValue
+ else if FTempItemsValue <> Null then
+ case FAggregateFunction of
+ agMin:
+ if FTempItemsValue < FItemsValue then
+ FItemsValue := FTempItemsValue;
+ agMax:
+ if FTempItemsValue > FItemsValue then
+ FItemsValue := FTempItemsValue;
+ else
+ FItemsValue := FItemsValue + FTempItemsValue;
+ end;
+end;
+
+function TfrxAggregateItem.Value: Variant;
+begin
+ Result := Null;
+ if not VarIsNull(FItemsArray) then
+ begin
+ case FAggregateFunction of
+ agSum, agMin, agMax:
+ Result := FItemsArray[FVColumn];
+ agAvg:
+ Result := FItemsArray[FVColumn] / FItemsCountArray[FVColumn];
+ agCount:
+ Result := FItemsCountArray[FVColumn];
+ end
+ end
+ else
+ case FAggregateFunction of
+ agSum, agMin, agMax:
+ Result := FItemsValue;
+ agAvg:
+ Result := FItemsValue / FItemsCount;
+ agCount:
+ Result := FItemsCount;
+ end;
+
+ if VarIsNull(Result) then
+ Result := 0;
+end;
+
+
+{ TfrxAggregateList }
+
+constructor TfrxAggregateList.Create(AReport: TfrxReport);
+begin
+ FList := TList.Create;
+ FReport := AReport;
+end;
+
+destructor TfrxAggregateList.Destroy;
+begin
+ Clear;
+ FList.Free;
+ inherited;
+end;
+
+procedure TfrxAggregateList.Clear;
+begin
+ while FList.Count > 0 do
+ begin
+ TObject(FList[0]).Free;
+ FList.Delete(0);
+ end;
+end;
+
+function TfrxAggregateList.GetItem(Index: Integer): TfrxAggregateItem;
+begin
+ Result := FList[Index];
+end;
+
+procedure TfrxAggregateList.ParseName(const ComplexName: String;
+ var Func: TfrxAggregateFunction; var Expr: String; var Band: TfrxDataBand;
+ var CountInvisible, DontReset: Boolean);
+var
+ i: Integer;
+ Name, Param1, Param2, Param3: String;
+begin
+ i := Pos('(', ComplexName);
+ Name := UpperCase(Trim(Copy(ComplexName, 1, i - 1)));
+ Get3Params(ComplexName, i, Param1, Param2, Param3);
+ Param1 := Trim(Param1);
+ Param2 := Trim(Param2);
+ Param3 := Trim(Param3);
+
+ if Name = 'SUM' then
+ Func := agSum
+ else if Name = 'MIN' then
+ Func := agMin
+ else if Name = 'MAX' then
+ Func := agMax
+ else if Name = 'AVG' then
+ Func := agAvg
+ else //if Name = 'COUNT' then
+ Func := agCount;
+
+ if Name <> 'COUNT' then
+ begin
+ Expr := Param1;
+ if Param2 <> '' then
+ Band := TfrxDataBand(FReport.FindObject(Param2)) else
+ Band := nil;
+ if Param3 <> '' then
+ i := StrToInt(Param3) else
+ i := 0;
+ end
+ else
+ begin
+ Expr := '';
+ Band := TfrxDataBand(FReport.FindObject(Param1));
+ if Param2 <> '' then
+ i := StrToInt(Param2) else
+ i := 0;
+ end;
+
+ CountInvisible := (i and 1) <> 0;
+ DontReset := (i and 2) <> 0;
+end;
+
+procedure TfrxAggregateList.FindAggregates(Memo: TfrxCustomMemoView;
+ DataBand: TfrxDataBand);
+const
+ Spaces = [#1..#32, '!', '#', '$', '%', '^', '&', '|', '+', '-', '*', '/',
+ '=', '.', ',', '[', ']', '0'..'9'];
+ IdentSpaces = Spaces - ['0'..'9'] + ['('];
+var
+ i, j: Integer;
+ s, s1, dc1, dc2: String;
+ Report: TfrxReport;
+
+ procedure FindIn(const s: String); forward;
+
+ procedure SkipString(const s: String; var i: Integer);
+ var
+ ch: Char;
+ begin
+ ch := s[i];
+ Inc(i);
+ while (i <= Length(s)) and (s[i] <> ch) do
+ Inc(i);
+ Inc(i);
+ end;
+
+ function Check(s: String): Boolean;
+ var
+ i: Integer;
+ ds: TfrxDataSet;
+ s1: String;
+ VarVal: Variant;
+ begin
+ Result := False;
+ if s = '' then Exit;
+
+ { searching in the variables }
+ i := Report.Variables.IndexOf(s);
+ if i <> -1 then
+ begin
+ VarVal := Report.Variables.Items[i].Value;
+ if VarIsNull(VarVal) then
+ s := ''
+ else
+ s := VarVal;
+ FindIn(s);
+ Result := True;
+ Exit;
+ end;
+
+ { maybe it's a dataset/field? }
+ Report.GetDataSetAndField(s, ds, s1);
+ if (ds <> nil) and (s1 <> '') then
+ Result := True;
+ end;
+
+ procedure AddAggregate(const ComplexName: String);
+ var
+ Item: TfrxAggregateItem;
+ begin
+ Item := TfrxAggregateItem.Create;
+ FList.Add(Item);
+
+ ParseName(ComplexName, Item.FAggregateFunction, Item.FExpression,
+ Item.FBand, Item.FCountInvisibleBands, Item.FDontReset);
+ if Item.FBand = nil then
+ Item.FBand := DataBand;
+
+ Item.FReport := FReport;
+ Item.FParentBand := TfrxBand(Memo.Parent);
+ if Item.FParentBand.Vertical and (THackComponent(Memo).FOriginalBand <> nil) and
+ (TfrxBand(THackComponent(Memo).FOriginalBand).BandNumber in [1, 3, 5, 13]) then
+ Item.FParentBand := TfrxBand(THackComponent(Memo).FOriginalBand);
+ Item.FIsPageFooter := Item.FParentBand is TfrxPageFooter;
+ Item.FOriginalName := Trim(ComplexName);
+ Item.FMemoName := Memo.Name;
+ Item.Reset;
+ end;
+
+ procedure FindIn(const s: String);
+ var
+ i, j: Integer;
+ s1, s2, s3, s4: String;
+ begin
+ if Check(s) then
+ Exit;
+
+ { this is an expression }
+ i := 1;
+ while i <= Length(s) do
+ begin
+ { skip non-significant chars }
+ while (i <= Length(s)) and (CharInSet(s[i], Spaces)) do
+ Inc(i);
+
+ case s[i] of
+ '<':
+ begin
+ FindIn(frxGetBrackedVariableW(s, '<', '>', i, j));
+ i := j;
+ end;
+
+ '''', '"':
+ SkipString(s, i);
+
+ '(':
+ begin
+ FindIn(frxGetBrackedVariableW(s, '(', ')', i, j));
+ if i = j then
+ Inc(i) else
+ i := j;
+ end;
+ else
+ begin
+ j := i;
+ while (i <= Length(s)) and not (CharInSet(s[i], IdentSpaces)) do
+ Inc(i);
+ s1 := UpperCase(Copy(s, j, i - j));
+
+ if (s1 = 'SUM') or (s1 = 'MIN') or (s1 = 'MAX') or
+ (s1 = 'AVG') or (s1 = 'COUNT') then
+ begin
+ if (i < Length(s)) and (s[i] = '(') then
+ begin
+ Get3Params(s, i, s2, s3, s4);
+ AddAggregate(Copy(s, j, i - j));
+ end;
+ end
+ else
+ Check(s1);
+ end;
+ end;
+ end;
+ end;
+
+begin
+ Report := Memo.Report;
+ if Memo.AllowExpressions then
+ begin
+ s := Memo.Text;
+ i := 1;
+ dc1 := Memo.ExpressionDelimiters;
+ dc2 := Copy(dc1, Pos(',', dc1) + 1, 255);
+ dc1 := Copy(dc1, 1, Pos(',', dc1) - 1);
+
+ repeat
+ while (i < Length(s)) and (Copy(s, i, Length(dc1)) <> dc1) do Inc(i);
+ s1 := frxGetBrackedVariableW(s, dc1, dc2, i, j);
+ if i <> j then
+ begin
+ FindIn(s1);
+ i := j;
+ j := 0;
+ end;
+ until i = j;
+ end;
+end;
+
+procedure TfrxAggregateList.AddItems(Page: TfrxReportPage);
+
+ procedure EnumObjects(ParentBand: TfrxBand; DataBand: TfrxDataBand);
+ var
+ i: Integer;
+ c: TfrxComponent;
+ begin
+ if ParentBand = nil then Exit;
+
+ for i := 0 to ParentBand.Objects.Count - 1 do
+ begin
+ c := ParentBand.Objects[i];
+ if c is TfrxCustomMemoView then
+ FindAggregates(TfrxCustomMemoView(c), DataBand);
+ end;
+
+ if ParentBand.Child <> nil then
+ EnumObjects(ParentBand.Child, DataBand);
+ end;
+
+ procedure EnumGroups(GroupHeader: TfrxGroupHeader; DataBand: TfrxDataBand);
+ var
+ i: Integer;
+ g: TfrxGroupHeader;
+ begin
+ if GroupHeader = nil then Exit;
+
+ for i := 0 to GroupHeader.FSubBands.Count - 1 do
+ begin
+ g := GroupHeader.FSubBands[i];
+ EnumObjects(g.FFooter, DataBand);
+ end;
+ end;
+
+ procedure EnumDataBands(List: TList);
+ var
+ i: Integer;
+ d: TfrxDataBand;
+ begin
+ for i := 0 to List.Count - 1 do
+ begin
+ d := List[i];
+ EnumObjects(d.FFooter, d);
+ EnumGroups(TfrxGroupHeader(d.FGroup), d);
+ EnumDataBands(d.FSubBands);
+ if d.Vertical then
+ EnumObjects(d, d);
+ end;
+ end;
+
+begin
+ EnumDataBands(Page.FSubBands);
+ EnumDataBands(Page.FVSubBands);
+ if Page.FSubBands.Count > 0 then
+ begin
+ EnumObjects(Page.FindBand(TfrxPageFooter), Page.FSubBands[0]);
+ EnumObjects(Page.FindBand(TfrxColumnFooter), Page.FSubBands[0]);
+ EnumObjects(Page.FindBand(TfrxReportSummary), Page.FSubBands[0]);
+ end;
+end;
+
+procedure TfrxAggregateList.AddValue(Band: TfrxBand; VColumn: Integer = 0);
+var
+ i: Integer;
+begin
+ for i := 0 to FList.Count - 1 do
+ if Items[i].FBand = Band then
+ begin
+ Items[i].FVColumn := VColumn;
+ Items[i].Calc;
+ end;
+end;
+
+procedure TfrxAggregateList.DeleteValue(Band: TfrxBand);
+var
+ i: Integer;
+begin
+ for i := 0 to FList.Count - 1 do
+ if Items[i].FBand = Band then
+ Items[i].DeleteValue;
+end;
+
+function TfrxAggregateList.GetValue(ParentBand: TfrxBand;
+ const ComplexName: String; VColumn: Integer = 0): Variant;
+var
+ i: Integer;
+begin
+ Result := Null;
+
+ for i := 0 to FList.Count - 1 do
+ if (Items[i].FParentBand = ParentBand) and
+ (frxCompareText(Items[i].FOriginalName, Trim(ComplexName)) = 0) then
+ begin
+ Items[i].FVColumn := VColumn;
+ Result := Items[i].Value;
+ break;
+ end;
+end;
+
+function TfrxAggregateList.GetValue(ParentBand: TfrxBand; VColumn: Integer;
+ const Name, Expression: String; Band: TfrxBand; Flags: Integer): Variant;
+var
+ i: Integer;
+ fn: TfrxAggregateFunction;
+begin
+ Result := Null;
+ if Name = 'SUM' then
+ fn := agSum
+ else if Name = 'AVG' then
+ fn := agAvg
+ else if Name = 'MIN' then
+ fn := agMin
+ else if Name = 'MAX' then
+ fn := agMax
+ else
+ fn := agCount;
+
+ for i := 0 to FList.Count - 1 do
+ if (Items[i].FParentBand = ParentBand) and
+ (Items[i].FAggregateFunction = fn) and
+ (frxCompareText(Items[i].FExpression, Trim(Expression)) = 0) and
+ ((Band = nil) or (Items[i].FBand = Band)) and
+ (Items[i].FCountInvisibleBands = ((Flags and 1) <> 0)) and
+ (Items[i].FDontReset = ((Flags and 2) <> 0)) then
+ begin
+ Items[i].FVColumn := VColumn;
+ Result := Items[i].Value;
+ break;
+ end;
+end;
+
+procedure TfrxAggregateList.Reset(ParentBand: TfrxBand);
+var
+ i: Integer;
+begin
+ for i := 0 to FList.Count - 1 do
+ if Items[i].FParentBand = ParentBand then
+ Items[i].Reset;
+end;
+
+procedure TfrxAggregateList.StartKeep;
+var
+ i: Integer;
+begin
+ for i := 0 to FList.Count - 1 do
+ Items[i].StartKeep;
+end;
+
+procedure TfrxAggregateList.EndKeep;
+var
+ i: Integer;
+begin
+ for i := 0 to FList.Count - 1 do
+ Items[i].EndKeep;
+end;
+
+procedure TfrxAggregateList.ClearValues;
+var
+ i: Integer;
+ SaveReset: Boolean;
+begin
+ for i := 0 to FList.Count - 1 do
+ begin
+ SaveReset := Items[i].FDontReset;
+ Items[i].FDontReset := False;
+ Items[i].Reset;
+ Items[i].FDontReset := SaveReset;
+ end;
+end;
+
+end.
+
diff --git a/LibD28x64/FMX.frxBarcod.pas b/LibD28x64/FMX.frxBarcod.pas
new file mode 100644
index 0000000..f62b76f
--- /dev/null
+++ b/LibD28x64/FMX.frxBarcod.pas
@@ -0,0 +1,2044 @@
+unit FMX.frxBarcod;
+
+{
+Adopted for FMX framework by Fast Reports in 2013.
+
+Barcode Component
+Version 1.25 (15.05.2003)
+Copyright 1998-2003 Andreas Schmidt and friends
+Adapted to FR: Alexander Tzyganenko
+
+for use with Delphi 1 - 7
+Delphi 1 not tested; better use Delphi 2 (or higher)
+
+Freeware
+Feel free to distribute the component as
+long as all files are unmodified and kept together.
+
+I'am not responsible for wrong barcodes.
+
+bug-reports, enhancements:
+mailto:shmia@bizerba.de or a_j_schmidt@rocketmail.com
+
+please tell me wich version you are using, when mailing me.
+
+
+get latest version from
+http://members.tripod.de/AJSchmidt/index.html
+http://mitglied.lycos.de/AJSchmidt/fbarcode.zip
+
+
+many thanx and geetings to
+Nikolay Simeonov, Wolfgang Koranda, Norbert Waas,
+Richard Hugues, Olivier Guilbaud, Berend Tober, Jan Tungli,
+Mauro Lemes, Norbert Kostka, Frank De Prins, Shane O'Dea,
+Daniele Teti, Ignacio Trivino, Samuel J. Comstock, Roberto Parola,
+Stefano Torricella and Mariusz Mialkon.
+
+i use tabs: 1 tab = 3 spaces
+
+
+History:
+----------------------------------------------------------------------
+Version 1.0:
+- initial release
+Version 1.1:
+- more comments
+- changed function Code_93Extended (now correct ?)
+Version 1.2:
+- Bugs (found by Nikolay Simeonov) removed
+Version 1.3:
+- EAN8/EAN13 added by Wolfgang Koranda (wkoranda@csi.com)
+Version 1.4:
+- Bug (found by Norbert Waas) removed
+ Component must save the Canvas-properties Font,Pen and Brush
+Version 1.5:
+- Bug (found by Richard Hugues) removed
+ Last line of barcode was 1 Pixel too wide
+Version 1.6:
+- new read-only property 'Width'
+Version 1.7
+- check for numeric barcode types
+- compatible with Delphi 1 (i hope)
+Version 1.8
+- add Color and ColorBar properties
+Version 1.9
+- Code 128 C added by Jan Tungli
+Version 1.10
+- Bug in Code 39 Character I removed
+Version 1.11 (06.07.1999)
+- additional Code Types
+ CodeUPC_A,
+ CodeUPC_E0,
+ CodeUPC_E1,
+ CodeUPC_Supp2,
+ CodeUPC_Supp5
+ by Jan Tungli
+Version 1.12 (13.07.1999)
+- improved ShowText property by Mauro Lemes
+ you must change your applications due changed interface of TBarcode.
+Version 1.13 (23.07.1999)
+- additional Code Types
+ CodeEAN128A,
+ CodeEAN128B,
+ CodeEAN128C
+ (support by Norbert Kostka)
+- new property 'CheckSumMethod'
+Version 1.14 (29.07.1999)
+- checksum for EAN128 by Norbert Kostka
+- bug fix for EAN128C
+Version 1.15 (23.09.1999)
+- bug fix for Code 39 with checksum by Frank De Prins
+Version 1.16 (10.11.1999)
+- width property is now writable (suggestion by Shane O'Dea)
+Version 1.17 (27.06.2000)
+- new OnChange property
+- renamed TBarcode to TAsBarcode to avoid name conflicts
+Version 1.18 (25.08.2000)
+- some speed improvements (Code 93 and Code 128)
+Version 1.19 (27.09.2000)
+ (thanks to Samuel J. Comstock)
+- origin of the barcode (left upper edge) is moved so that
+ the barcode stays always on the canvas
+- new (read only) properties 'CanvasWidth' and 'CanvasHeight' gives you
+ the size of the resulting image.
+- a wrapper class for Quick Reports is now available.
+Version 1.20 (13.09.2000)
+- Assign procedure added
+- support for scaling barcode to Printer (see Demo)
+Version 1.21 (19.07.2001)
+ (thanks to Roberto Parola)
+- new properties ShowTextFont and ShowTextPosition
+Version 1.22 (26.10.2001)
+- Code 128 Symbol #12 (=comma) fixed (thanks to Stefano Torricella)
+Version 1.23 (13.11.2002)
+- UPC_E0 and UPC_E1 stopcodes fixed (thanks to Duo Dreamer)
+Version 1.24 (04.12.2002)
+- Bugfix for Code93 Extended
+Version 1.25 (15.05.2003)
+- fixed a bug in procedure Assign (thanks to Mariusz Mialkon)
+
+Todo (missing features)
+-----------------------
+
+- more CheckSum Methods
+- user defined barcodes
+- checksum event (fired when the checksum is calculated)
+- rename the unit name (from 'barcode' to 'fbarcode') to avoid name conflicts
+- I'am working on PDF417 barcode (has anybody some technical information about PDF417
+ or a PDF417 reader ?)
+
+
+
+Known Bugs
+---------
+- Top and Left properties must be set at runtime.
+- comments not compatible with Delphi 1
+}
+
+
+
+interface
+
+{$I frx.inc}
+
+uses
+
+ System.SysUtils, System.Classes, System.Types, System.UITypes, System.UIConsts,
+ FMX.Types, FMX.Objects, FMX.Controls, FMX.Forms, FMX.Dialogs, System.Math
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+ , FMX.frxFMX
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+ TfrxBarcodeType =
+ (
+ bcCode_2_5_interleaved,
+ bcCode_2_5_industrial,
+ bcCode_2_5_matrix,
+ bcCode39,
+ bcCode39Extended,
+ bcCode128A,
+ bcCode128B,
+ bcCode128C,
+ bcCode93,
+ bcCode93Extended,
+ bcCodeMSI,
+ bcCodePostNet,
+ bcCodeCodabar,
+ bcCodeEAN8,
+ bcCodeEAN13,
+ bcCodeUPC_A,
+ bcCodeUPC_E0,
+ bcCodeUPC_E1,
+ bcCodeUPC_Supp2, { UPC 2 digit supplemental }
+ bcCodeUPC_Supp5, { UPC 5 digit supplemental }
+ bcCodeEAN128A,
+ bcCodeEAN128B,
+ bcCodeEAN128C
+ );
+
+
+ TfrxBarLineType = (white, black, black_half); {for internal use only}
+ { black_half means a black line with 2/5 height (used for PostNet) }
+
+
+ TfrxCheckSumMethod =
+ (
+ csmNone,
+ csmModulo10
+ );
+
+
+ TfrxBarcode = class(TComponent)
+ private
+ FAngle: Double;
+ FColor: TAlphaColor;
+ FFontColor: TAlphaColor;
+ FColorBar: TAlphaColor;
+ FCheckSum: Boolean;
+ FCheckSumMethod: TfrxCheckSumMethod;
+ FHeight: Single;
+ FLeft: Single;
+ FModul: Integer;
+ FRatio: Double;
+ FText: AnsiString;
+ FTop: Single;
+ FTyp: TfrxBarcodeType;
+ FFont: TFont;
+ FDrawArea: TRectF;
+ modules: array[0..3] of ShortInt;
+
+ procedure DoLines(data: AnsiString; Canvas: TCanvas; Zoom: Single);
+ procedure OneBarProps(code: AnsiChar; var Width: Single; var lt: TfrxBarLineType);
+ function SetLen(pI: Byte): AnsiString;
+ function Code_2_5_interleaved: AnsiString;
+ function Code_2_5_industrial: AnsiString;
+ function Code_2_5_matrix: AnsiString;
+ function Code_39: AnsiString;
+ function Code_39Extended: AnsiString;
+ function Code_128: AnsiString;
+ function Code_93: AnsiString;
+ function Code_93Extended: AnsiString;
+ function Code_MSI: AnsiString;
+ function Code_PostNet: AnsiString;
+ function Code_Codabar: AnsiString;
+ function Code_EAN8: AnsiString;
+ function Code_EAN13: AnsiString;
+ function Code_UPC_A: AnsiString;
+ function Code_UPC_E0: AnsiString;
+ function Code_UPC_E1: AnsiString;
+ function Code_Supp5: AnsiString;
+ function Code_Supp2: AnsiString;
+
+ procedure MakeModules;
+ function GetWidth : Single;
+ function DoCheckSumming(const data : AnsiString):AnsiString;
+ function MakeData : AnsiString;
+ public
+ constructor Create(Owner:TComponent); override;
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent);override;
+
+ procedure DrawBarcode(Canvas: TCanvas; ARect: TRect; ShowText: Boolean; AZoom: Single; IsPrinting: Boolean = False);
+ published
+ property Text : AnsiString read FText write FText;
+ property Modul : integer read FModul write FModul;
+ property Ratio : Double read FRatio write FRatio;
+ property Typ : TfrxBarcodeType read FTyp write FTyp;
+ property Checksum:boolean read FCheckSum write FCheckSum;
+ property CheckSumMethod:TfrxCheckSumMethod read FCheckSumMethod write FCheckSumMethod;
+ property Angle :double read FAngle write FAngle;
+ property Width : Single read GetWidth;
+ property Height: Single read FHeight write FHeight;
+ property Color: TAlphaColor read FColor write FColor;
+ property ColorBar: TAlphaColor read FColorBar write FColorBar;
+ property FontColor: TAlphaColor read FFontColor write FFontColor default claBlack;
+ property Font: TFont read FFont write FFont;
+ end;
+
+
+ TBCdata = packed record
+ Name:AnsiString; { Name of Barcode }
+ num :Boolean; { numeric data only }
+ end;
+
+const BCdata:array[bcCode_2_5_interleaved..bcCodeEAN128C] of TBCdata =
+ (
+ (Name:'2_5_interleaved'; num:True),
+ (Name:'2_5_industrial'; num:True),
+ (Name:'2_5_matrix'; num:True),
+ (Name:'Code39'; num:False),
+ (Name:'Code39 Extended'; num:False),
+ (Name:'Code128A'; num:False),
+ (Name:'Code128B'; num:False),
+ (Name:'Code128C'; num:False),
+ (Name:'Code93'; num:False),
+ (Name:'Code93 Extended'; num:False),
+ (Name:'MSI'; num:True),
+ (Name:'PostNet'; num:True),
+ (Name:'Codebar'; num:False),
+ (Name:'EAN8'; num:True),
+ (Name:'EAN13'; num:True),
+ (Name:'UPC_A'; num:True),
+ (Name:'UPC_E0'; num:True),
+ (Name:'UPC_E1'; num:True),
+ (Name:'UPC Supp2'; num:True),
+ (Name:'UPC Supp5'; num:True),
+ (Name:'EAN128A'; num:False),
+ (Name:'EAN128B'; num:False),
+ (Name:'EAN128C'; num:True)
+ );
+
+
+implementation
+
+function CheckSumModulo10(const data:AnsiString):AnsiString;
+ var i,fak,sum : Integer;
+begin
+ sum := 0;
+ fak := Length(data);
+ for i:=1 to Length(data) do
+ begin
+ if (fak mod 2) = 0 then
+ sum := sum + (StrToInt(String(data[i]))*1)
+ else
+ sum := sum + (StrToInt(String(data[i]))*3);
+ dec(fak);
+ end;
+ if (sum mod 10) = 0 then
+ result := data+'0'
+ else
+ result := data + AnsiString(IntToStr(10-(sum mod 10)));
+end;
+
+procedure Assert(Cond: Boolean; Text: String);
+begin
+ if not Cond then
+ raise Exception.Create(Text);
+end;
+
+{
+ converts a string from '321' to the internal representation '715'
+ i need this function because some pattern tables have a different
+ format :
+
+ '00111'
+ converts to '05161'
+}
+function Convert(const s:AnsiString):AnsiString;
+var
+ i, v : integer;
+begin
+ Result := s; { same Length as Input - string }
+ for i:=1 to Length(s) do
+ begin
+ v := ord(s[i]) - 1;
+
+ if odd(i) then
+ Inc(v, 5);
+ Result[i] := AnsiChar(Chr(v));
+ end;
+end;
+
+(*
+ * Berechne die Quersumme aus einer Zahl x
+ * z.B.: Quersumme von 1234 ist 10
+ *)
+function quersumme(x:integer):integer;
+var
+ sum:integer;
+begin
+ sum := 0;
+
+ while x > 0 do
+ begin
+ sum := sum + (x mod 10);
+ x := x div 10;
+ end;
+ result := sum;
+end;
+
+
+{
+ Rotate a Point by Angle 'alpha'
+}
+function Rotate2D(p:TPointF; alpha:double): TPointF;
+var
+ sinus, cosinus : Extended;
+begin
+ sinus := sin(alpha);
+ cosinus := cos(alpha);
+ result.x := Round(p.x*cosinus + p.y*sinus);
+ result.y := Round(-p.x*sinus + p.y*cosinus);
+end;
+
+{
+ Move Point "a" by Vector "b"
+}
+function Translate2D(a, b:TPointF): TPointF;
+begin
+ result.x := a.x + b.x;
+ result.y := a.y + b.y;
+end;
+
+
+{
+ Move the orgin so that when point is rotated by alpha, the rect
+ between point and orgin stays in the visible quadrant.
+}
+function TranslateQuad2D(const alpha :double; const orgin, point :TPointF): TPointF;
+var
+ alphacos: Extended;
+ alphasin: Extended;
+ moveby: TPointF;
+begin
+ alphasin := sin(alpha);
+ alphacos := cos(alpha);
+
+ if alphasin >= 0 then
+ begin
+ if alphacos >= 0 then
+ begin
+ // 1. Quadrant
+ moveby.x := 0;
+ moveby.y := Round(alphasin*point.x);
+ end
+ else
+ begin
+ // 2. Quadrant
+ moveby.x := -Round(alphacos*point.x);
+ moveby.y := Round(alphasin*point.x - alphacos*point.y);
+ end;
+ end
+ else
+ begin
+ if alphacos >= 0 then
+ begin
+ // 4. quadrant
+ moveby.x := -Round(alphasin*point.y);
+ moveby.y := 0;
+ end
+ else
+ begin
+ // 3. quadrant
+ moveby.x := -Round(alphacos*point.x) - Round(alphasin*point.y);
+ moveby.y := -Round(alphacos*point.y);
+ end;
+ end;
+ Result := Translate2D(orgin, moveby);
+end;
+
+
+constructor TfrxBarcode.Create(Owner:TComponent);
+begin
+ inherited Create(owner);
+ FAngle := 0.0;
+ FRatio := 2.0;
+ FModul := 1;
+ FTyp := bcCodeEAN13;
+ FCheckSum := FALSE;
+ FCheckSumMethod := csmModulo10;
+ FColor := claNull;
+ FColorBar := claBlack;
+ FFont := TFont.Create;
+ FFont.Family := 'Arial';
+ FFont.Size := 9;
+ FontColor := claBlack;
+end;
+
+
+procedure TfrxBarcode.Assign(Source: TPersistent);
+var
+ BSource : TfrxBarcode;
+begin
+ if Source is TfrxBarcode then
+ begin
+ BSource := TfrxBarcode(Source);
+ FHeight := BSource.FHeight;
+ FText := BSource.FText;
+ FTop := BSource.FTop;
+ FLeft := BSource.FLeft;
+ FModul := BSource.FModul;
+ FRatio := BSource.FRatio;
+ FTyp := BSource.FTyp;
+ FCheckSum := BSource.FCheckSum;
+ FAngle := BSource.FAngle;
+ FColor := BSource.FColor;
+ FColorBar := BSource.FColorBar;
+ FCheckSumMethod := BSource.FCheckSumMethod;
+ end;
+end;
+
+
+
+
+{
+calculate the width and the linetype of a sigle bar
+
+
+ Code Line-Color Width Height
+------------------------------------------------------------------
+ '0' white 100% full
+ '1' white 100%*Ratio full
+ '2' white 150%*Ratio full
+ '3' white 200%*Ratio full
+ '5' black 100% full
+ '6' black 100%*Ratio full
+ '7' black 150%*Ratio full
+ '8' black 200%*Ratio full
+ 'A' black 100% 2/5 (used for PostNet)
+ 'B' black 100%*Ratio 2/5 (used for PostNet)
+ 'C' black 150%*Ratio 2/5 (used for PostNet)
+ 'D' black 200%*Ratio 2/5 (used for PostNet)
+}
+procedure TfrxBarcode.OneBarProps(code:AnsiChar; var Width:Single; var lt:TfrxBarLineType);
+begin
+ case code of
+ '0': begin width := modules[0]; lt := white; end;
+ '1': begin width := modules[1]; lt := white; end;
+ '2': begin width := modules[2]; lt := white; end;
+ '3': begin width := modules[3]; lt := white; end;
+
+
+ '5': begin width := modules[0]; lt := black; end;
+ '6': begin width := modules[1]; lt := black; end;
+ '7': begin width := modules[2]; lt := black; end;
+ '8': begin width := modules[3]; lt := black; end;
+
+ 'A': begin width := modules[0]; lt := black_half; end;
+ 'B': begin width := modules[1]; lt := black_half; end;
+ 'C': begin width := modules[2]; lt := black_half; end;
+ 'D': begin width := modules[3]; lt := black_half; end;
+ else
+ begin
+ {something went wrong :-( }
+ {mistyped pattern table}
+ raise Exception.CreateFmt('%s: internal Error', [self.ClassName]);
+ end;
+ end;
+end;
+
+
+function TfrxBarcode.MakeData : AnsiString;
+var
+ i : integer;
+ S: AnsiString;
+begin
+ {calculate the with of the different lines (modules)}
+ MakeModules;
+
+
+ {numeric barcode type ?}
+ if BCdata[Typ].num then
+ begin
+ FText := AnsiString(Trim(String(FText))); {remove blanks}
+ S := FTEXT;
+ if Typ in [bcCodeEAN128A, bcCodeEAN128B, bcCodeEAN128C] then
+ repeat
+ i := Pos(AnsiString('&FNC1;'), S);
+ Delete(S, i, 6);
+ until (i = 0);
+ for i := 1 to Length(S) do
+ if (S[i] > '9') or (S[i] < '0') then
+ raise Exception.Create('Barcode must be numeric');
+ end;
+
+
+ {get the pattern of the barcode}
+ case Typ of
+ bcCode_2_5_interleaved: Result := Code_2_5_interleaved;
+ bcCode_2_5_industrial: Result := Code_2_5_industrial;
+ bcCode_2_5_matrix: Result := Code_2_5_matrix;
+ bcCode39: Result := Code_39;
+ bcCode39Extended: Result := Code_39Extended;
+ bcCode128A,
+ bcCode128B,
+ bcCode128C,
+ bcCodeEAN128A,
+ bcCodeEAN128B,
+ bcCodeEAN128C: Result := Code_128;
+ bcCode93: Result := Code_93;
+ bcCode93Extended: Result := Code_93Extended;
+ bcCodeMSI: Result := Code_MSI;
+ bcCodePostNet: Result := Code_PostNet;
+ bcCodeCodabar: Result := Code_Codabar;
+ bcCodeEAN8: Result := Code_EAN8;
+ bcCodeEAN13: Result := Code_EAN13;
+ bcCodeUPC_A: Result := Code_UPC_A;
+ bcCodeUPC_E0: Result := Code_UPC_E0;
+ bcCodeUPC_E1: Result := Code_UPC_E1;
+ bcCodeUPC_Supp2: Result := Code_Supp2;
+ bcCodeUPC_Supp5: Result := Code_Supp5;
+ else
+ raise Exception.CreateFmt('%s: wrong BarcodeType', [self.ClassName]);
+ end;
+
+{
+Showmessage(Format('Data <%s>', [Result]));
+}
+end;
+
+
+
+function TfrxBarcode.GetWidth: Single;
+var
+ data : AnsiString;
+ i : integer;
+ w : Single;
+ lt : TfrxBarLineType;
+begin
+ Result := 0;
+
+ {get barcode pattern}
+ data := MakeData;
+
+ for i:=1 to Length(data) do {examine the pattern string}
+ begin
+ OneBarProps(data[i], w, lt);
+ Result := Result + w;
+// Inc(Result, w);
+ end;
+end;
+
+function TfrxBarcode.DoCheckSumming(const data : AnsiString):AnsiString;
+begin
+ case FCheckSumMethod of
+
+ csmNone:
+ Result := data;
+ csmModulo10:
+ Result := CheckSumModulo10(data);
+
+ end;
+end;
+
+
+
+
+{
+////////////////////////////// EAN /////////////////////////////////////////
+}
+
+
+{
+////////////////////////////// EAN8 /////////////////////////////////////////
+}
+
+{Pattern for Barcode EAN Charset A}
+ {L1 S1 L2 S2}
+const tabelle_EAN_A:array['0'..'9'] of AnsiString =
+ (
+ ('2605'), { 0 }
+ ('1615'), { 1 }
+ ('1516'), { 2 }
+ ('0805'), { 3 }
+ ('0526'), { 4 }
+ ('0625'), { 5 }
+ ('0508'), { 6 }
+ ('0706'), { 7 }
+ ('0607'), { 8 }
+ ('2506') { 9 }
+ );
+
+{Pattern for Barcode EAN Charset C}
+ {S1 L1 S2 L2}
+const tabelle_EAN_C:array['0'..'9'] of AnsiString =
+ (
+ ('7150' ), { 0 }
+ ('6160' ), { 1 }
+ ('6061' ), { 2 }
+ ('5350' ), { 3 }
+ ('5071' ), { 4 }
+ ('5170' ), { 5 }
+ ('5053' ), { 6 }
+ ('5251' ), { 7 }
+ ('5152' ), { 8 }
+ ('7051' ) { 9 }
+ );
+
+
+function TfrxBarcode.Code_EAN8:AnsiString;
+var
+ i : integer;
+ tmp : AnsiString;
+begin
+ if FCheckSum then
+ begin
+ tmp := SetLen(7);
+ tmp := DoCheckSumming(copy(tmp,length(tmp)-6,7));
+ end
+ else
+ tmp := SetLen(8);
+
+ Assert(Length(tmp)=8, 'Invalid Text len (EAN8)');
+ result := '505'; {Startcode}
+
+ for i:=1 to 4 do
+ result := result + tabelle_EAN_A[tmp[i]] ;
+
+ result := result + '05050'; {Center Guard Pattern}
+
+ for i:=5 to 8 do
+ result := result + tabelle_EAN_C[tmp[i]] ;
+
+ result := result + '505'; {Stopcode}
+end;
+
+{////////////////////////////// EAN13 ///////////////////////////////////////}
+
+{Pattern for Barcode EAN Zeichensatz B}
+ {L1 S1 L2 S2}
+const tabelle_EAN_B:array['0'..'9'] of AnsiString =
+ (
+ ('0517'), { 0 }
+ ('0616'), { 1 }
+ ('1606'), { 2 }
+ ('0535'), { 3 }
+ ('1705'), { 4 }
+ ('0715'), { 5 }
+ ('3505'), { 6 }
+ ('1525'), { 7 }
+ ('2515'), { 8 }
+ ('1507') { 9 }
+ );
+
+{Zuordung der Paraitaetsfolgen fr EAN13}
+const tabelle_ParityEAN13:array[0..9, 1..6] of AnsiChar =
+ (
+ ('A', 'A', 'A', 'A', 'A', 'A'), { 0 }
+ ('A', 'A', 'B', 'A', 'B', 'B'), { 1 }
+ ('A', 'A', 'B', 'B', 'A', 'B'), { 2 }
+ ('A', 'A', 'B', 'B', 'B', 'A'), { 3 }
+ ('A', 'B', 'A', 'A', 'B', 'B'), { 4 }
+ ('A', 'B', 'B', 'A', 'A', 'B'), { 5 }
+ ('A', 'B', 'B', 'B', 'A', 'A'), { 6 }
+ ('A', 'B', 'A', 'B', 'A', 'B'), { 7 }
+ ('A', 'B', 'A', 'B', 'B', 'A'), { 8 }
+ ('A', 'B', 'B', 'A', 'B', 'A') { 9 }
+ );
+
+function TfrxBarcode.Code_EAN13:AnsiString;
+var
+ i, LK: integer;
+ tmp : AnsiString;
+begin
+ if Length(FText) <> 13 then
+ begin
+ FText := SetLen(13);
+ if FCheckSum then
+ tmp := DoCheckSumming(copy(FText,2,12));
+ if FCheckSum then
+ FText := tmp
+ else
+ tmp := FText;
+ end
+ else
+ tmp := FText;
+
+ Assert(Length(tmp) = 13, 'Invalid Text len (EAN13)');
+
+ LK := StrToInt(String(tmp[1]));
+ tmp := copy(tmp,2,12);
+
+ result := '505'; {Startcode}
+
+ for i:=1 to 6 do
+ begin
+ case tabelle_ParityEAN13[LK,i] of
+ 'A' : result := result + tabelle_EAN_A[tmp[i]];
+ 'B' : result := result + tabelle_EAN_B[tmp[i]] ;
+ 'C' : result := result + tabelle_EAN_C[tmp[i]] ;
+ end;
+ end;
+
+ result := result + '05050'; {Center Guard Pattern}
+
+ for i:=7 to 12 do
+ result := result + tabelle_EAN_C[tmp[i]] ;
+
+ result := result + '505'; {Stopcode}
+end;
+
+{Pattern for Barcode 2 of 5}
+const tabelle_2_5:array['0'..'9', 1..5] of AnsiChar =
+ (
+ ('0', '0', '1', '1', '0'), {'0'}
+ ('1', '0', '0', '0', '1'), {'1'}
+ ('0', '1', '0', '0', '1'), {'2'}
+ ('1', '1', '0', '0', '0'), {'3'}
+ ('0', '0', '1', '0', '1'), {'4'}
+ ('1', '0', '1', '0', '0'), {'5'}
+ ('0', '1', '1', '0', '0'), {'6'}
+ ('0', '0', '0', '1', '1'), {'7'}
+ ('1', '0', '0', '1', '0'), {'8'}
+ ('0', '1', '0', '1', '0') {'9'}
+ );
+
+function TfrxBarcode.Code_2_5_interleaved:AnsiString;
+var
+ i, j : integer;
+ c : AnsiChar;
+begin
+ result := '5050'; {Startcode}
+ if FCheckSum and (Length(FText) mod 2 <> 0) then
+ FText := DoCheckSumming(FText);
+
+ for i:=1 to Length(FText) div 2 do
+ begin
+ for j:= 1 to 5 do
+ begin
+ if tabelle_2_5[FText[i*2-1], j] = '1' then
+ c := '6'
+ else
+ c := '5';
+ result := result + c;
+ if tabelle_2_5[FText[i*2], j] = '1' then
+ c := '1'
+ else
+ c := '0';
+ result := result + c;
+ end;
+ end;
+
+ result := result + '605'; {Stopcode}
+end;
+
+
+function TfrxBarcode.Code_2_5_industrial:AnsiString;
+var
+ i, j: integer;
+begin
+// result := '606050'; {Startcode}
+ result := '55055050'; {Startcode}
+
+ for i:=1 to Length(FText) do
+ begin
+ for j:= 1 to 5 do
+ begin
+ if tabelle_2_5[FText[i], j] = '1' then
+ result := result + '60'
+ else
+ result := result + '50';
+ end;
+ end;
+
+// result := result + '605060'; {Stopcode}
+ result := result + '55050550'; {Stopcode}
+end;
+
+function TfrxBarcode.Code_2_5_matrix:AnsiString;
+var
+ i, j: integer;
+ c :AnsiChar;
+begin
+ result := '705050'; {Startcode}
+
+ for i:=1 to Length(FText) do
+ begin
+ for j:= 1 to 5 do
+ begin
+ if tabelle_2_5[FText[i], j] = '1' then
+ c := '1'
+ else
+ c := '0';
+
+ {Falls i ungerade ist dann mache Lcke zu Strich}
+ if odd(j) then
+ c := AnsiChar(chr(ord(c)+5));
+ result := result + c;
+ end;
+ result := result + '0'; {Lcke zwischen den Zeichen}
+ end;
+
+ result := result + '70505'; {Stopcode}
+end;
+
+
+function TfrxBarcode.Code_39:AnsiString;
+
+type TCode39 =
+ record
+ c : AnsiChar;
+ data : array[0..9] of AnsiChar;
+ chk: shortint;
+ end;
+
+const tabelle_39: array[0..43] of TCode39 = (
+ ( c:'0'; data:'505160605'; chk:0 ),
+ ( c:'1'; data:'605150506'; chk:1 ),
+ ( c:'2'; data:'506150506'; chk:2 ),
+ ( c:'3'; data:'606150505'; chk:3 ),
+ ( c:'4'; data:'505160506'; chk:4 ),
+ ( c:'5'; data:'605160505'; chk:5 ),
+ ( c:'6'; data:'506160505'; chk:6 ),
+ ( c:'7'; data:'505150606'; chk:7 ),
+ ( c:'8'; data:'605150605'; chk:8 ),
+ ( c:'9'; data:'506150605'; chk:9 ),
+ ( c:'A'; data:'605051506'; chk:10),
+ ( c:'B'; data:'506051506'; chk:11),
+ ( c:'C'; data:'606051505'; chk:12),
+ ( c:'D'; data:'505061506'; chk:13),
+ ( c:'E'; data:'605061505'; chk:14),
+ ( c:'F'; data:'506061505'; chk:15),
+ ( c:'G'; data:'505051606'; chk:16),
+ ( c:'H'; data:'605051605'; chk:17),
+ ( c:'I'; data:'506051605'; chk:18),
+ ( c:'J'; data:'505061605'; chk:19),
+ ( c:'K'; data:'605050516'; chk:20),
+ ( c:'L'; data:'506050516'; chk:21),
+ ( c:'M'; data:'606050515'; chk:22),
+ ( c:'N'; data:'505060516'; chk:23),
+ ( c:'O'; data:'605060515'; chk:24),
+ ( c:'P'; data:'506060515'; chk:25),
+ ( c:'Q'; data:'505050616'; chk:26),
+ ( c:'R'; data:'605050615'; chk:27),
+ ( c:'S'; data:'506050615'; chk:28),
+ ( c:'T'; data:'505060615'; chk:29),
+ ( c:'U'; data:'615050506'; chk:30),
+ ( c:'V'; data:'516050506'; chk:31),
+ ( c:'W'; data:'616050505'; chk:32),
+ ( c:'X'; data:'515060506'; chk:33),
+ ( c:'Y'; data:'615060505'; chk:34),
+ ( c:'Z'; data:'516060505'; chk:35),
+ ( c:'-'; data:'515050606'; chk:36),
+ ( c:'.'; data:'615050605'; chk:37),
+ ( c:' '; data:'516050605'; chk:38),
+ ( c:'*'; data:'515060605'; chk:0 ),
+ ( c:'$'; data:'515151505'; chk:39),
+ ( c:'/'; data:'515150515'; chk:40),
+ ( c:'+'; data:'515051515'; chk:41),
+ ( c:'%'; data:'505151515'; chk:42)
+ );
+
+
+function FindIdx(z: AnsiChar):integer;
+var
+ i:integer;
+begin
+ for i:=0 to High(tabelle_39) do
+ begin
+ if z = tabelle_39[i].c then
+ begin
+ result := i;
+ exit;
+ end;
+ end;
+ result := -1;
+end;
+
+var
+ i, idx : integer;
+ checksum:integer;
+
+begin
+ checksum := 0;
+ {Startcode}
+ result := tabelle_39[FindIdx('*')].data + '0';
+
+ for i:=1 to Length(FText) do
+ begin
+ idx := FindIdx(AnsiChar(FText[i]));
+ if idx < 0 then
+ continue;
+ result := result + tabelle_39[idx].data + '0';
+ Inc(checksum, tabelle_39[idx].chk);
+ end;
+
+ {Calculate Checksum Data}
+ if FCheckSum then
+ begin
+ checksum := checksum mod 43;
+ for i:=0 to High(tabelle_39) do
+ if checksum = tabelle_39[i].chk then
+ begin
+ result := result + tabelle_39[i].data + '0';
+ break;
+ end;
+ end;
+
+ {Stopcode}
+ result := result + tabelle_39[FindIdx('*')].data;
+end;
+
+function TfrxBarcode.Code_39Extended:AnsiString;
+
+const code39x : array[0..127] of AnsiString =
+ (
+ ('%U'), ('$A'), ('$B'), ('$C'), ('$D'), ('$E'), ('$F'), ('$G'),
+ ('$H'), ('$I'), ('$J'), ('$K'), ('$L'), ('$M'), ('$N'), ('$O'),
+ ('$P'), ('$Q'), ('$R'), ('$S'), ('$T'), ('$U'), ('$V'), ('$W'),
+ ('$X'), ('$Y'), ('$Z'), ('%A'), ('%B'), ('%C'), ('%D'), ('%E'),
+ (' '), ('/A'), ('/B'), ('/C'), ('/D'), ('/E'), ('/F'), ('/G'),
+ ('/H'), ('/I'), ('/J'), ('/K'), ('/L'), ('/M'), ('/N'), ('/O'),
+ ( '0'), ('1'), ('2'), ('3'), ('4'), ('5'), ('6'), ('7'),
+ ('8'), ('9'), ('/Z'), ('%F'), ('%G'), ('%H'), ('%I'), ('%J'),
+ ('%V'), ('A'), ('B'), ('C'), ('D'), ('E'), ('F'), ('G'),
+ ('H'), ('I'), ('J'), ('K'), ('L'), ('M'), ('N'), ('O'),
+ ('P'), ('Q'), ('R'), ('S'), ('T'), ('U'), ('V'), ('W'),
+ ('X'), ('Y'), ('Z'), ('%K'), ('%L'), ('%M'), ('%N'), ('%O'),
+ ('%W'), ('+A'), ('+B'), ('+C'), ('+D'), ('+E'), ('+F'), ('+G'),
+ ('+H'), ('+I'), ('+J'), ('+K'), ('+L'), ('+M'), ('+N'), ('+O'),
+ ('+P'), ('+Q'), ('+R'), ('+S'), ('+T'), ('+U'), ('+V'), ('+W'),
+ ('+X'), ('+Y'), ('+Z'), ('%P'), ('%Q'), ('%R'), ('%S'), ('%T')
+ );
+
+
+var
+ save:AnsiString;
+ i : integer;
+begin
+ save := FText;
+ FText := '';
+
+ for i:=1 to Length(save) do
+ begin
+ if ord(save[i]) <= 127 then
+ FText := FText + code39x[ord(save[i])];
+ end;
+ result := Code_39;
+ FText := save;
+end;
+
+
+
+{
+Code 128
+}
+function TfrxBarcode.Code_128:AnsiString;
+type TCode128 =
+ record
+ a, b : AnsiChar;
+ c : AnsiString;
+ data : AnsiString;
+ end;
+
+const tabelle_128: array[0..102] of TCode128 = (
+ ( a:' '; b:' '; c:'00'; data:'212222' ),
+ ( a:'!'; b:'!'; c:'01'; data:'222122' ),
+ ( a:'"'; b:'"'; c:'02'; data:'222221' ),
+ ( a:'#'; b:'#'; c:'03'; data:'121223' ),
+ ( a:'$'; b:'$'; c:'04'; data:'121322' ),
+ ( a:'%'; b:'%'; c:'05'; data:'131222' ),
+ ( a:'&'; b:'&'; c:'06'; data:'122213' ),
+ ( a:''''; b:''''; c:'07'; data:'122312' ),
+ ( a:'('; b:'('; c:'08'; data:'132212' ),
+ ( a:')'; b:')'; c:'09'; data:'221213' ),
+ ( a:'*'; b:'*'; c:'10'; data:'221312' ),
+ ( a:'+'; b:'+'; c:'11'; data:'231212' ),
+ ( a:','; b:','; c:'12'; data:'112232' ), {23.10.2001 Stefano Torricella}
+ ( a:'-'; b:'-'; c:'13'; data:'122132' ),
+ ( a:'.'; b:'.'; c:'14'; data:'122231' ),
+ ( a:'/'; b:'/'; c:'15'; data:'113222' ),
+ ( a:'0'; b:'0'; c:'16'; data:'123122' ),
+ ( a:'1'; b:'1'; c:'17'; data:'123221' ),
+ ( a:'2'; b:'2'; c:'18'; data:'223211' ),
+ ( a:'3'; b:'3'; c:'19'; data:'221132' ),
+ ( a:'4'; b:'4'; c:'20'; data:'221231' ),
+ ( a:'5'; b:'5'; c:'21'; data:'213212' ),
+ ( a:'6'; b:'6'; c:'22'; data:'223112' ),
+ ( a:'7'; b:'7'; c:'23'; data:'312131' ),
+ ( a:'8'; b:'8'; c:'24'; data:'311222' ),
+ ( a:'9'; b:'9'; c:'25'; data:'321122' ),
+ ( a:':'; b:':'; c:'26'; data:'321221' ),
+ ( a:';'; b:';'; c:'27'; data:'312212' ),
+ ( a:'<'; b:'<'; c:'28'; data:'322112' ),
+ ( a:'='; b:'='; c:'29'; data:'322211' ),
+ ( a:'>'; b:'>'; c:'30'; data:'212123' ),
+ ( a:'?'; b:'?'; c:'31'; data:'212321' ),
+ ( a:'@'; b:'@'; c:'32'; data:'232121' ),
+ ( a:'A'; b:'A'; c:'33'; data:'111323' ),
+ ( a:'B'; b:'B'; c:'34'; data:'131123' ),
+ ( a:'C'; b:'C'; c:'35'; data:'131321' ),
+ ( a:'D'; b:'D'; c:'36'; data:'112313' ),
+ ( a:'E'; b:'E'; c:'37'; data:'132113' ),
+ ( a:'F'; b:'F'; c:'38'; data:'132311' ),
+ ( a:'G'; b:'G'; c:'39'; data:'211313' ),
+ ( a:'H'; b:'H'; c:'40'; data:'231113' ),
+ ( a:'I'; b:'I'; c:'41'; data:'231311' ),
+ ( a:'J'; b:'J'; c:'42'; data:'112133' ),
+ ( a:'K'; b:'K'; c:'43'; data:'112331' ),
+ ( a:'L'; b:'L'; c:'44'; data:'132131' ),
+ ( a:'M'; b:'M'; c:'45'; data:'113123' ),
+ ( a:'N'; b:'N'; c:'46'; data:'113321' ),
+ ( a:'O'; b:'O'; c:'47'; data:'133121' ),
+ ( a:'P'; b:'P'; c:'48'; data:'313121' ),
+ ( a:'Q'; b:'Q'; c:'49'; data:'211331' ),
+ ( a:'R'; b:'R'; c:'50'; data:'231131' ),
+ ( a:'S'; b:'S'; c:'51'; data:'213113' ),
+ ( a:'T'; b:'T'; c:'52'; data:'213311' ),
+ ( a:'U'; b:'U'; c:'53'; data:'213131' ),
+ ( a:'V'; b:'V'; c:'54'; data:'311123' ),
+ ( a:'W'; b:'W'; c:'55'; data:'311321' ),
+ ( a:'X'; b:'X'; c:'56'; data:'331121' ),
+ ( a:'Y'; b:'Y'; c:'57'; data:'312113' ),
+ ( a:'Z'; b:'Z'; c:'58'; data:'312311' ),
+ ( a:'['; b:'['; c:'59'; data:'332111' ),
+ ( a:'\'; b:'\'; c:'60'; data:'314111' ),
+ ( a:']'; b:']'; c:'61'; data:'221411' ),
+ ( a:'^'; b:'^'; c:'62'; data:'431111' ),
+ ( a:'_'; b:'_'; c:'63'; data:'111224' ),
+ ( a:' '; b:'`'; c:'64'; data:'111422' ),
+ ( a:' '; b:'a'; c:'65'; data:'121124' ),
+ ( a:' '; b:'b'; c:'66'; data:'121421' ),
+ ( a:' '; b:'c'; c:'67'; data:'141122' ),
+ ( a:' '; b:'d'; c:'68'; data:'141221' ),
+ ( a:' '; b:'e'; c:'69'; data:'112214' ),
+ ( a:' '; b:'f'; c:'70'; data:'112412' ),
+ ( a:' '; b:'g'; c:'71'; data:'122114' ),
+ ( a:' '; b:'h'; c:'72'; data:'122411' ),
+ ( a:' '; b:'i'; c:'73'; data:'142112' ),
+ ( a:' '; b:'j'; c:'74'; data:'142211' ),
+ ( a:' '; b:'k'; c:'75'; data:'241211' ),
+ ( a:' '; b:'l'; c:'76'; data:'221114' ),
+ ( a:' '; b:'m'; c:'77'; data:'413111' ),
+ ( a:' '; b:'n'; c:'78'; data:'241112' ),
+ ( a:' '; b:'o'; c:'79'; data:'134111' ),
+ ( a:' '; b:'p'; c:'80'; data:'111242' ),
+ ( a:' '; b:'q'; c:'81'; data:'121142' ),
+ ( a:' '; b:'r'; c:'82'; data:'121241' ),
+ ( a:' '; b:'s'; c:'83'; data:'114212' ),
+ ( a:' '; b:'t'; c:'84'; data:'124112' ),
+ ( a:' '; b:'u'; c:'85'; data:'124211' ),
+ ( a:' '; b:'v'; c:'86'; data:'411212' ),
+ ( a:' '; b:'w'; c:'87'; data:'421112' ),
+ ( a:' '; b:'x'; c:'88'; data:'421211' ),
+ ( a:' '; b:'y'; c:'89'; data:'212141' ),
+ ( a:' '; b:'z'; c:'90'; data:'214121' ),
+ ( a:' '; b:'{'; c:'91'; data:'412121' ),
+ ( a:' '; b:'|'; c:'92'; data:'111143' ),
+ ( a:' '; b:'}'; c:'93'; data:'111341' ),
+ ( a:' '; b:'~'; c:'94'; data:'131141' ),
+ ( a:' '; b:' '; c:'95'; data:'114113' ),
+ ( a:' '; b:' '; c:'96'; data:'114311' ),
+ ( a:' '; b:' '; c:'97'; data:'411113' ),
+ ( a:' '; b:' '; c:'98'; data:'411311' ),
+ ( a:' '; b:' '; c:'99'; data:'113141' ),
+ ( a:' '; b:' '; c:' '; data:'114131' ),
+ ( a:' '; b:' '; c:' '; data:'311141' ),
+ ( a:' '; b:' '; c:' '; data:'411131' ) { FNC1 }
+ );
+
+StartA = '211412';
+StartB = '211214';
+StartC = '211232';
+Stop = '2331112';
+
+
+
+
+{find Code 128 Codeset A or B}
+function Find_Code128AB(c: AnsiChar):integer;
+var
+ i:integer;
+ v: AnsiChar;
+begin
+ for i:=0 to High(tabelle_128) do
+ begin
+ if FTyp = bcCode128A then
+ v := tabelle_128[i].a
+ else
+ v := tabelle_128[i].b;
+
+ if c = v then
+ begin
+ result := i;
+ exit;
+ end;
+ end;
+ result := -1;
+end;
+
+{ find Code 128 Codeset C }
+function Find_Code128C(c:AnsiString):integer;
+ var i:integer;
+ begin
+ for i:=0 to High(tabelle_128) do begin
+ if tabelle_128[i].c = c then begin
+ result := i;
+ exit;
+ end;
+ end;
+ result := -1;
+ end;
+
+
+
+var i, idx: integer;
+ startcode:AnsiString;
+ CheckSumCode: AnsiString;
+ checksum : integer;
+ codeword_pos : integer;
+
+begin
+ case FTyp of
+ bcCode128A, bcCodeEAN128A:
+ begin checksum := 103; startcode:= StartA; end;
+ bcCode128B, bcCodeEAN128B:
+ begin checksum := 104; startcode:= StartB; end;
+ bcCode128C, bcCodeEAN128C:
+ begin checksum := 105; startcode:= StartC; end;
+ else
+ raise Exception.CreateFmt('%s: wrong BarcodeType in Code_128', [self.ClassName]);
+ end;
+
+ result := startcode; {Startcode}
+ codeword_pos := 1;
+
+ case FTyp of
+ bcCodeEAN128A,
+ bcCodeEAN128B,
+ bcCodeEAN128C:
+ begin
+ {
+ special identifier
+ FNC1 = function code 1
+ for EAN 128 barcodes
+ }
+ result := result + tabelle_128[102].data;
+ Inc(checksum, 102*codeword_pos);
+ Inc(codeword_pos);
+ {
+ if there is no checksum at the end of the string
+ the EAN128 needs one (modulo 10)
+ }
+
+ if FCheckSum then
+ begin
+ CheckSumCode := FTEXT;
+ repeat
+ i := Pos(AnsiString('&FNC1;'), CheckSumCode);
+ Delete(CheckSumCode, i, 6);
+ until (i = 0);
+ CheckSumCode := DoCheckSumming(CheckSumCode);
+ FTEXT := FTEXT + CheckSumCode[Length(CheckSumCode)];
+ end;
+ end;
+ end;
+ i := 1;
+ if (FTyp = bcCode128C) or (FTyp = bccodeEAN128C) then
+ begin
+ if (Length(FText) mod 2<>0) then FText:='0'+FText;
+ while i <= Length(FText) do
+ if (FText[i] = '&') and (Copy(FText, i, 6) = '&FNC1;') then
+ begin
+ Inc(i, 6);
+ result := result + tabelle_128[102].data;
+ Inc(checksum, 102 *codeword_pos);
+ Inc(codeword_pos);
+ end
+ else
+ begin
+ idx:=Find_Code128C(copy(Ftext,i,2));
+ if idx < 0 then idx := Find_Code128C('00');
+ result := result + tabelle_128[idx].data;
+ Inc(checksum, idx*codeword_pos);
+ Inc(codeword_pos);
+ Inc(i,2);
+ end;
+ end
+ else
+ while i <= Length(FText) do
+ begin
+ if (FText[i] = '&') and (Copy(FText, i, 6) = '&FNC1;') then
+ begin
+ Inc(i, 6);
+ result := result + tabelle_128[102].data;
+ Inc(checksum, 102 *codeword_pos);
+ Inc(codeword_pos);
+ end
+ else
+ begin
+ idx := Find_Code128AB(AnsiChar(FText[i]));
+ if idx < 0 then
+ idx := Find_Code128AB(' ');
+ result := result + tabelle_128[idx].data;
+ Inc(checksum, idx*codeword_pos);
+ Inc(codeword_pos);
+ Inc(i)
+ end;
+ end;
+
+ checksum := checksum mod 103;
+ result := result + tabelle_128[checksum].data;
+
+ result := result + Stop; {Stopcode}
+ Result := Convert(Result);
+end;
+
+
+
+
+
+function TfrxBarcode.Code_93:AnsiString;
+type TCode93 =
+ record
+ c : AnsiChar;
+ data : array[0..5] of AnsiChar;
+ end;
+
+const tabelle_93: array[0..46] of TCode93 = (
+ ( c:'0'; data:'131112' ),
+ ( c:'1'; data:'111213' ),
+ ( c:'2'; data:'111312' ),
+ ( c:'3'; data:'111411' ),
+ ( c:'4'; data:'121113' ),
+ ( c:'5'; data:'121212' ),
+ ( c:'6'; data:'121311' ),
+ ( c:'7'; data:'111114' ),
+ ( c:'8'; data:'131211' ),
+ ( c:'9'; data:'141111' ),
+ ( c:'A'; data:'211113' ),
+ ( c:'B'; data:'211212' ),
+ ( c:'C'; data:'211311' ),
+ ( c:'D'; data:'221112' ),
+ ( c:'E'; data:'221211' ),
+ ( c:'F'; data:'231111' ),
+ ( c:'G'; data:'112113' ),
+ ( c:'H'; data:'112212' ),
+ ( c:'I'; data:'112311' ),
+ ( c:'J'; data:'122112' ),
+ ( c:'K'; data:'132111' ),
+ ( c:'L'; data:'111123' ),
+ ( c:'M'; data:'111222' ),
+ ( c:'N'; data:'111321' ),
+ ( c:'O'; data:'121122' ),
+ ( c:'P'; data:'131121' ),
+ ( c:'Q'; data:'212112' ),
+ ( c:'R'; data:'212211' ),
+ ( c:'S'; data:'211122' ),
+ ( c:'T'; data:'211221' ),
+ ( c:'U'; data:'221121' ),
+ ( c:'V'; data:'222111' ),
+ ( c:'W'; data:'112122' ),
+ ( c:'X'; data:'112221' ),
+ ( c:'Y'; data:'122121' ),
+ ( c:'Z'; data:'123111' ),
+ ( c:'-'; data:'121131' ),
+ ( c:'.'; data:'311112' ),
+ ( c:' '; data:'311211' ),
+ ( c:'$'; data:'321111' ),
+ ( c:'/'; data:'112131' ),
+ ( c:'+'; data:'113121' ),
+ ( c:'%'; data:'211131' ),
+ ( c:'['; data:'121221' ), {only used for Extended Code 93}
+ ( c:']'; data:'312111' ), {only used for Extended Code 93}
+ ( c:'{'; data:'311121' ), {only used for Extended Code 93}
+ ( c:'}'; data:'122211' ) {only used for Extended Code 93}
+ );
+
+
+{find Code 93}
+function Find_Code93(c: AnsiChar):integer;
+var
+ i:integer;
+begin
+ for i:=0 to High(tabelle_93) do
+ begin
+ if c = tabelle_93[i].c then
+ begin
+ result := i;
+ exit;
+ end;
+ end;
+ result := -1;
+end;
+
+
+
+
+var
+ i, idx : integer;
+ checkC, checkK, {Checksums}
+ weightC, weightK : integer;
+begin
+
+ result := '111141'; {Startcode}
+
+ for i:=1 to Length(FText) do
+ begin
+ idx := Find_Code93(AnsiChar(FText[i]));
+ if idx < 0 then
+ raise Exception.CreateFmt('%s:Code93 bad Data <%s>', [self.ClassName,FText]);
+ result := result + tabelle_93[idx].data;
+ end;
+
+ checkC := 0;
+ checkK := 0;
+
+ weightC := 1;
+ weightK := 2;
+
+ for i:=Length(FText) downto 1 do
+ begin
+ idx := Find_Code93(AnsiChar(FText[i]));
+
+ Inc(checkC, idx*weightC);
+ Inc(checkK, idx*weightK);
+
+ Inc(weightC);
+ if weightC > 20 then weightC := 1;
+ Inc(weightK);
+ if weightK > 15 then weightK := 1;
+ end;
+
+ Inc(checkK, checkC);
+
+ checkC := checkC mod 47;
+ checkK := checkK mod 47;
+
+ result := result + tabelle_93[checkC].data +
+ tabelle_93[checkK].data;
+
+ result := result + '1111411'; {Stopcode}
+ Result := Convert(Result);
+end;
+
+
+
+
+
+function TfrxBarcode.Code_93Extended:AnsiString;
+const code93x : array[0..127] of AnsiString =
+ (
+ (']U'), ('[A'), ('[B'), ('[C'), ('[D'), ('[E'), ('[F'), ('[G'),
+ ('[H'), ('[I'), ('[J'), ('[K'), ('[L'), ('[M'), ('[N'), ('[O'),
+ ('[P'), ('[Q'), ('[R'), ('[S'), ('[T'), ('[U'), ('[V'), ('[W'),
+ ('[X'), ('[Y'), ('[Z'), (']A'), (']B'), (']C'), (']D'), (']E'),
+ (' '), ('{A'), ('{B'), ('{C'), ('{D'), ('{E'), ('{F'), ('{G'),
+ ('{H'), ('{I'), ('{J'), ('{K'), ('{L'), ('{M'), ('{N'), ('{O'),
+ ( '0'), ('1'), ('2'), ('3'), ('4'), ('5'), ('6'), ('7'),
+ ('8'), ('9'), ('{Z'), (']F'), (']G'), (']H'), (']I'), (']J'),
+ (']V'), ('A'), ('B'), ('C'), ('D'), ('E'), ('F'), ('G'),
+ ('H'), ('I'), ('J'), ('K'), ('L'), ('M'), ('N'), ('O'),
+ ('P'), ('Q'), ('R'), ('S'), ('T'), ('U'), ('V'), ('W'),
+ ('X'), ('Y'), ('Z'), (']K'), (']L'), (']M'), (']N'), (']O'),
+ (']W'), ('}A'), ('}B'), ('}C'), ('}D'), ('}E'), ('}F'), ('}G'),
+ ('}H'), ('}I'), ('}J'), ('}K'), ('}L'), ('}M'), ('}N'), ('}O'),
+ ('}P'), ('}Q'), ('}R'), ('}S'), ('}T'), ('}U'), ('}V'), ('}W'),
+ ('}X'), ('}Y'), ('}Z'), (']P'), (']Q'), (']R'), (']S'), (']T')
+ );
+
+var
+ save : AnsiString;
+ i : integer;
+begin
+ {CharToOem(PChar(FText), save);}
+
+ save := FText;
+ FText := '';
+
+
+ for i:=1 to Length(save) do
+ begin
+ if ord(save[i]) <= 127 then
+ FText := FText + code93x[ord(save[i])];
+ end;
+
+ {Showmessage(Format('Text: <%s>', [FText]));}
+
+ result := Code_93;
+ FText := save;
+end;
+
+
+
+function TfrxBarcode.Code_MSI:AnsiString;
+const tabelle_MSI:array['0'..'9'] of AnsiString =
+ (
+ ( '51515151' ), {'0'}
+ ( '51515160' ), {'1'}
+ ( '51516051' ), {'2'}
+ ( '51516060' ), {'3'}
+ ( '51605151' ), {'4'}
+ ( '51605160' ), {'5'}
+ ( '51606051' ), {'6'}
+ ( '51606060' ), {'7'}
+ ( '60515151' ), {'8'}
+ ( '60515160' ) {'9'}
+ );
+
+var
+ i:integer;
+ check_even, check_odd, checksum:integer;
+begin
+ result := '60'; {Startcode}
+ check_even := 0;
+ check_odd := 0;
+
+ for i:=1 to Length(FText) do
+ begin
+ if odd(i-1) then
+ check_odd := check_odd*10+ord(FText[i])
+ else
+ check_even := check_even+ord(FText[i]);
+
+ result := result + tabelle_MSI[FText[i]];
+ end;
+
+ checksum := quersumme(check_odd*2) + check_even;
+
+ checksum := checksum mod 10;
+ if checksum > 0 then
+ checksum := 10-checksum;
+
+ result := result + tabelle_MSI[chr(ord('0')+checksum)];
+
+ result := result + '515'; {Stopcode}
+end;
+
+
+
+function TfrxBarcode.Code_PostNet:AnsiString;
+const tabelle_PostNet:array['0'..'9'] of AnsiString =
+ (
+ ( '5151A1A1A1' ), {'0'}
+ ( 'A1A1A15151' ), {'1'}
+ ( 'A1A151A151' ), {'2'}
+ ( 'A1A15151A1' ), {'3'}
+ ( 'A151A1A151' ), {'4'}
+ ( 'A151A151A1' ), {'5'}
+ ( 'A15151A1A1' ), {'6'}
+ ( '51A1A1A151' ), {'7'}
+ ( '51A1A151A1' ), {'8'}
+ ( '51A151A1A1' ) {'9'}
+ );
+var
+ i:integer;
+begin
+ result := '51';
+
+ for i:=1 to Length(FText) do
+ begin
+ result := result + tabelle_PostNet[FText[i]];
+ end;
+ result := result + '5';
+end;
+
+
+function TfrxBarcode.Code_Codabar:AnsiString;
+type TCodabar =
+ record
+ c : AnsiChar;
+ data : array[0..6] of AnsiChar;
+ end;
+
+const tabelle_cb: array[0..19] of TCodabar = (
+ ( c:'1'; data:'5050615' ),
+ ( c:'2'; data:'5051506' ),
+ ( c:'3'; data:'6150505' ),
+ ( c:'4'; data:'5060515' ),
+ ( c:'5'; data:'6050515' ),
+ ( c:'6'; data:'5150506' ),
+ ( c:'7'; data:'5150605' ),
+ ( c:'8'; data:'5160505' ),
+ ( c:'9'; data:'6051505' ),
+ ( c:'0'; data:'5050516' ),
+ ( c:'-'; data:'5051605' ),
+ ( c:'$'; data:'5061505' ),
+ ( c:':'; data:'6050606' ),
+ ( c:'/'; data:'6060506' ),
+ ( c:'.'; data:'6060605' ),
+ ( c:'+'; data:'5060606' ),
+ ( c:'A'; data:'5061515' ),
+ ( c:'B'; data:'5151506' ),
+ ( c:'C'; data:'5051516' ),
+ ( c:'D'; data:'5051615' )
+ );
+
+
+
+{find Codabar}
+function Find_Codabar(c: AnsiChar):integer;
+var
+ i:integer;
+begin
+ for i:=0 to High(tabelle_cb) do
+ begin
+ if c = tabelle_cb[i].c then
+ begin
+ result := i;
+ exit;
+ end;
+ end;
+ result := -1;
+end;
+
+var
+ i, idx : integer;
+begin
+ result := tabelle_cb[Find_Codabar('A')].data + '0';
+ for i:=1 to Length(FText) do
+ begin
+ idx := Find_Codabar(AnsiChar(FText[i]));
+ result := result + tabelle_cb[idx].data + '0';
+ end;
+ result := result + tabelle_cb[Find_Codabar('B')].data;
+end;
+
+
+
+{---------------}
+
+{Assist function}
+function TfrxBarcode.SetLen(pI:byte):AnsiString;
+begin
+ Result := StringOfChar(AnsiChar('0'), pI - Length(FText)) + FText;
+end;
+
+
+
+function TfrxBarcode.Code_UPC_A:AnsiString;
+var
+ i : integer;
+ tmp : AnsiString;
+begin
+ FText := SetLen(12);
+ if FCheckSum then tmp:=DoCheckSumming(copy(FText,1,11));
+ if FCheckSum then FText:=tmp else tmp:=FText;
+ result := '505'; {Startcode}
+ for i:=1 to 6 do
+ result := result + tabelle_EAN_A[tmp[i]];
+ result := result + '05050'; {Trennzeichen}
+ for i:=7 to 12 do
+ result := result + tabelle_EAN_C[tmp[i]];
+ result := result + '505'; {Stopcode}
+end;
+
+
+{UPC E Parity Pattern Table , Number System 0}
+const tabelle_UPC_E0:array['0'..'9', 1..6] of AnsiChar =
+ (
+ ('E', 'E', 'E', 'o', 'o', 'o' ), { 0 }
+ ('E', 'E', 'o', 'E', 'o', 'o' ), { 1 }
+ ('E', 'E', 'o', 'o', 'E', 'o' ), { 2 }
+ ('E', 'E', 'o', 'o', 'o', 'E' ), { 3 }
+ ('E', 'o', 'E', 'E', 'o', 'o' ), { 4 }
+ ('E', 'o', 'o', 'E', 'E', 'o' ), { 5 }
+ ('E', 'o', 'o', 'o', 'E', 'E' ), { 6 }
+ ('E', 'o', 'E', 'o', 'E', 'o' ), { 7 }
+ ('E', 'o', 'E', 'o', 'o', 'E' ), { 8 }
+ ('E', 'o', 'o', 'E', 'o', 'E' ) { 9 }
+ );
+
+function TfrxBarcode.Code_UPC_E0:AnsiString;
+var i,j : integer;
+ tmp : AnsiString;
+ c : AnsiChar;
+begin
+ FText := SetLen(7);
+ tmp:=DoCheckSumming(copy(FText,1,6));
+ c:=tmp[7];
+ if FCheckSum then FText:=tmp else tmp := FText;
+ result := '505'; {Startcode}
+ for i:=1 to 6 do
+ begin
+ if tabelle_UPC_E0[c,i]='E' then
+ begin
+ for j:= 1 to 4 do result := result + tabelle_EAN_C[tmp[i],5-j];
+ end
+ else
+ begin
+ result := result + tabelle_EAN_A[tmp[i]];
+ end;
+ end;
+ result := result + '050505'; {Stopcode}
+end;
+
+function TfrxBarcode.Code_UPC_E1:AnsiString;
+var i,j : integer;
+ tmp : AnsiString;
+ c : AnsiChar;
+begin
+ FText := SetLen(7);
+ tmp:=DoCheckSumming(copy(FText,1,6));
+ c:=tmp[7];
+ if FCheckSum then FText:=tmp else tmp := FText;
+ result := '505'; {Startcode}
+ for i:=1 to 6 do
+ begin
+ if tabelle_UPC_E0[c,i]='E' then
+ begin
+ result := result + tabelle_EAN_A[tmp[i]];
+ end
+ else
+ begin
+ for j:= 1 to 4 do result := result + tabelle_EAN_C[tmp[i],5-j];
+ end;
+ end;
+ result := result + '050505'; {Stopcode}
+end;
+
+{assist function}
+function getSupp(Nr : AnsiString) : AnsiString;
+var i,fak,sum : Integer;
+ tmp : AnsiString;
+begin
+ sum := 0;
+ tmp := copy(nr,1,Length(Nr)-1);
+ fak := Length(tmp);
+ for i:=1 to length(tmp) do
+ begin
+ if (fak mod 2) = 0 then
+ sum := sum + (StrToInt(String(tmp[i]))*9)
+ else
+ sum := sum + (StrToInt(String(tmp[i]))*3);
+ dec(fak);
+ end;
+ sum:=((sum mod 10) mod 10) mod 10;
+ result := tmp + AnsiString(IntToStr(sum));
+end;
+
+function TfrxBarcode.Code_Supp5:AnsiString;
+var i,j : integer;
+ tmp : AnsiString;
+ c : AnsiChar;
+begin
+ FText := SetLen(5);
+ tmp:=getSupp(copy(FText,1,5)+'0');
+ c:=tmp[6];
+ if FCheckSum then FText:=tmp else tmp := FText;
+ result := '506'; {Startcode}
+ for i:=1 to 5 do
+ begin
+ if tabelle_UPC_E0[c,(6-5)+i]='E' then
+ begin
+ for j:= 1 to 4 do result := result + tabelle_EAN_C[tmp[i],5-j];
+ end
+ else
+ begin
+ result := result + tabelle_EAN_A[tmp[i]];
+ end;
+ if i<5 then result:=result+'05'; { character delineator }
+ end;
+end;
+
+function TfrxBarcode.Code_Supp2:AnsiString;
+var i,j : integer;
+ tmp,mS : AnsiString;
+begin
+ FText := SetLen(2);
+ i := StrToInt(String(Ftext));
+ case i mod 4 of
+ 3: mS:='EE';
+ 2: mS:='Eo';
+ 1: mS:='oE';
+ 0: mS:='oo';
+ end;
+ tmp:=getSupp(copy(FText,1,5)+'0');
+
+ if FCheckSum then FText:=tmp else tmp := FText;
+ result := '506'; {Startcode}
+ for i:=1 to 2 do
+ begin
+ if mS[i]='E' then
+ begin
+ for j:= 1 to 4 do result := result + tabelle_EAN_C[tmp[i],5-j];
+ end
+ else
+ begin
+ result := result + tabelle_EAN_A[tmp[i]];
+ end;
+ if i<2 then result:=result+'05'; { character delineator }
+ end;
+end;
+
+{---------------}
+
+
+
+
+procedure TfrxBarcode.MakeModules;
+begin
+ case Typ of
+ bcCode_2_5_interleaved,
+ bcCode_2_5_industrial,
+ bcCode39,
+ bcCodeEAN8,
+ bcCodeEAN13,
+ bcCode39Extended,
+ bcCodeCodabar,
+ bcCodeUPC_A,
+ bcCodeUPC_E0,
+ bcCodeUPC_E1,
+ bcCodeUPC_Supp2,
+ bcCodeUPC_Supp5:
+
+ begin
+ if Ratio < 2.0 then Ratio := 2.0;
+ if Ratio > 3.0 then Ratio := 3.0;
+ end;
+
+ bcCode_2_5_matrix:
+ begin
+ if Ratio < 2.25 then Ratio := 2.25;
+ if Ratio > 3.0 then Ratio := 3.0;
+ end;
+ bcCode128A,
+ bcCode128B,
+ bcCode128C,
+ bcCode93,
+ bcCode93Extended,
+ bcCodeMSI,
+ bcCodePostNet: ;
+ end;
+
+
+ modules[0] := FModul;
+ modules[1] := Round(FModul*FRatio);
+ modules[2] := modules[1] * 3 div 2;
+ modules[3] := modules[1] * 2;
+end;
+
+
+{
+Draw the Barcode
+
+Parameter :
+'data' holds the pattern for a Barcode.
+A barcode begins always with a black line and
+ends with a black line.
+
+The white Lines builds the space between the black Lines.
+
+A black line must always followed by a white Line and vica versa.
+
+Examples:
+ '50505' // 3 thin black Lines with 2 thin white Lines
+ '606' // 2 fat black Lines with 1 thin white Line
+
+ '5605015' // Error
+
+
+data[] : see procedure OneBarProps
+
+}
+procedure TfrxBarcode.DoLines(data:AnsiString; Canvas:TCanvas; Zoom: Single);
+
+var i:integer;
+ lt : TfrxBarLineType;
+ xadd:Single;
+ awidth, aheight: Single;
+begin
+ xadd := 0;
+ with Canvas do begin
+
+
+ for i:=1 to Length(data) do {examine the pattern string}
+ begin
+
+ {
+ input: pattern code
+ output: Width and Linetype
+ }
+ OneBarProps(data[i], awidth, lt);
+
+ if (lt = black) or (lt = black_half) then
+ begin
+ Stroke.Color := FColorBar;
+ end
+ else
+ begin
+ Stroke.Color := FColor;
+ end;
+ Fill.Color := FColor;
+
+ if lt = black_half then
+ aheight := FHeight * 2 / 5
+ else
+ aheight := FHeight;
+
+ aheight := aheight * zoom - 2 * Zoom;
+ awidth := awidth * zoom;
+{$IFDEF Delphi25}
+ Stroke.Thickness := awidth;
+{$ELSE}
+ StrokeThickness := awidth;
+{$ENDIF}
+
+ if lt = black_half then
+ DrawLine(PointF(FDrawArea.Left + xadd + awidth / 2, FDrawArea.Bottom), PointF(FDrawArea.Left + xadd + awidth / 2, FDrawArea.Bottom - aheight), 1)
+ else if lt <> white then
+ DrawLine(PointF(FDrawArea.Left + xadd + awidth / 2, FDrawArea.Top + awidth / 2), PointF(FDrawArea.Left + xadd + awidth / 2, FDrawArea.Top + aheight - awidth / 2), 1);
+ xadd := xadd + awidth;
+ end;
+ end;
+end;
+
+procedure TfrxBarcode.DrawBarcode(Canvas: TCanvas; ARect: TRect; ShowText: Boolean; AZoom: Single; IsPrinting: Boolean = False);
+var
+ data : AnsiString;
+ BarWidth, e, TxtHeight: single;
+ i: Integer;
+ Zoom: Extended;
+ DrawText: AnsiString;
+ state: TCanvasSaveState;
+ m, OldM: TMatrix;
+
+ procedure TextOutR(x, y, w: Single; s: AnsiString);
+ var
+ aRight: Single;
+ sRect: TRectF;
+ begin
+ with Canvas do
+ begin
+
+ Fill.Color := FColor;
+
+ aRight := FDrawArea.Right;
+ if w > 0 then
+ aRight := FDrawArea.Left + w * AZoom + x * AZoom;
+
+ sRect := RectF(FDrawArea.Left + x * AZoom , FDrawArea.Bottom - TxtHeight * AZoom + y * AZoom , aRight, FDrawArea.Bottom);
+
+ FillRect(sRect, 0, 0, allCorners, 1);
+ Fill.Color := FontColor;
+ Stroke.Color := FontColor;
+
+ FillText(sRect, String(s), False, 1, [], TTextAlign.taCenter, TTextAlign.taLeading);
+ end;
+ end;
+
+ procedure OutText;
+// var
+// TxtWidth: Single;
+ begin
+ with Canvas do
+ begin
+ Canvas.Font.Assign(FFont);
+ if not IsPrinting then
+ if Zoom - AZoom > 0.1 then
+ Canvas.Font.Size := (FFont.Size * (Zoom - AZoom))
+ else
+ Canvas.Font.Size := (FFont.Size * AZoom);
+
+
+ case FTyp of
+ bcCodeEAN8: // 8 digits, 4+4
+ begin
+ TextOutR(3,0, 30, Copy(FText, 1, 4));
+ TextOutR(37, 0, 27, Copy(FText, 5, 4));
+ end;
+ bcCodeEAN13: // 13 digits, 1+6+6 or 12 digits, 6+6
+ begin
+ //if FText[1] <> '0' then
+ TextOutR(-6, 0, 4, Copy(FText, 1, 1));
+ TextOutR(3, 0, 44, Copy(FText, 2, 6));
+ TextOutR(51, 0, 41, Copy(FText, 8, 6));
+ end;
+ bcCodeUPC_A: // 12 digits, 1+5+5+1
+ begin
+ TextOutR(-6, 0, 4, Copy(FText, 1, 1));
+ TextOutR(11, 0, 34, Copy(FText, 2, 5));
+ TextOutR(50, 0, 34, Copy(FText, 7, 5));
+ TextOutR(BarWidth + 2, 0, 4, Copy(FText, 12, 1));
+ end;
+ bcCodeUPC_E0,
+ bcCodeUPC_E1: // 7 digits, 6+1
+ begin
+ TextOutR(3, 0, 44, Copy(FText, 1, 6));
+ TextOutR(BarWidth + 2, 0, 4, Copy(FText, 7, 1));
+ end;
+ bcCodeEAN128A,
+ bcCodeEAN128B,
+ bcCodeEAN128C,
+ bcCode128A,
+ bcCode128B,
+ bcCode128C:
+ begin
+ DrawText := FTEXT;
+ repeat
+ i := Pos(AnsiString('&FNC1;'), DrawText);
+ Delete(DrawText, i, 6);
+ until (i = 0);
+ //TxtWidth := TextWidth(String(DrawText));
+ TextOutR(0, 0, 0, DrawText);
+ end
+ else
+ begin
+ //TxtWidth := TextWidth(String(FText));
+ TextOutR(0, 0, 0, FText);
+ end;
+ end;
+
+ end;
+ end;
+
+begin
+ data := MakeData;
+ BarWidth := Width;
+ FLeft := 0;
+ FTop := 0;
+ TxtHeight := (Round(Font.Size * 96 / 72) + 4) ;
+
+ OldM := Canvas.Matrix;
+ State := Canvas.SaveState;
+
+ FDrawArea.Top := ARect.Top;
+ FDrawArea.Left := ARect.Left;
+ FDrawArea.Bottom := ARect.Bottom;
+ FDrawArea.Right := ARect.Right;
+
+ if (FAngle = 0) then
+ begin
+ Zoom := (ARect.Right - ARect.Left) / BarWidth ;
+ FHeight := (ARect.Bottom - ARect.Top)/ Zoom;
+ end
+ else
+ begin
+ m := CreateRotationMatrix(-DegToRad(FAngle));
+ m.m31 := OldM.m31 + ARect.Left + ARect.Width / 2;
+ m.m32 := OldM.m32 + ARect.Top + ARect.Height / 2;
+ Canvas.SetMatrix(m);
+
+ e := ARect.Width;
+ FDrawArea.Left := -ARect.Width / 2;
+ FDrawArea.Right := FDrawArea.Left + e;
+ e := ARect.Height;
+ FDrawArea.Top := -ARect.Height / 2;
+ FDrawArea.Bottom := FDrawArea.Top + e;
+
+ if ((FAngle >= 90) and (FAngle < 180)) or ((FAngle >= 270) and (FAngle < 360)) then
+ FDrawArea := RectF(FDrawArea.Top, FDrawArea.Left, FDrawArea.Bottom, FDrawArea.Right);
+
+ Zoom := (Arect.Bottom - Arect.Top) / BarWidth;
+ FHeight := Arect.Width / Zoom;
+
+ if(FAngle = 180) then
+ begin
+ Zoom := (ARect.Right - ARect.Left) / BarWidth ;
+ FHeight := (ARect.Bottom - ARect.Top)/ Zoom;
+ end;
+
+ end;
+
+ try
+ {$IFDEF DELPHI25}
+ Canvas.Stroke.Dash := TStrokeDash.sdSolid;
+ {$ELSE}
+ Canvas.StrokeDash := TStrokeDash.sdSolid;
+ {$ENDIF}
+ DoLines(data, Canvas, Zoom);
+ if ShowText then
+ OutText;
+ finally
+ Canvas.RestoreState(state);
+ Canvas.SetMatrix(OldM);
+ end;
+end;
+
+
+destructor TfrxBarcode.Destroy;
+begin
+ FFont.Free;
+ inherited;
+end;
+
+end.
diff --git a/LibD28x64/FMX.frxBarcode.pas b/LibD28x64/FMX.frxBarcode.pas
new file mode 100644
index 0000000..81dbd06
--- /dev/null
+++ b/LibD28x64/FMX.frxBarcode.pas
@@ -0,0 +1,302 @@
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ Barcode Add-in object }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxBarcode;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.Types, System.UIConsts, FMX.Types,
+ FMX.Objects, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Menus, FMX.frxBarcod,
+ FMX.frxClass, System.Variants
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxBarCodeObject = class(TComponent); // fake component
+
+
+ TfrxBarCodeView = class(TfrxView)
+ private
+ FBarCode: TfrxBarCode;
+ FBarType: TfrxBarcodeType;
+ FCalcCheckSum: Boolean;
+ FExpression: String;
+ FHAlign: TfrxHAlign;
+ FRotation: Integer;
+ FShowText: Boolean;
+ FText: String;
+ FWideBarRatio: Double;
+ FZoom: Double;
+ procedure BcFontChanged(Sender: TObject);
+ procedure SetRotation(const Value: Integer);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ procedure GetData; override;
+ class function GetDescription: String; override;
+ function GetRealBounds: TfrxRect; override;
+ property BarCode: TfrxBarCode read FBarCode;
+ published
+ property BarType: TfrxBarcodeType read FBarType write FBarType;
+ property BrushStyle;
+ property CalcCheckSum: Boolean read FCalcCheckSum write FCalcCheckSum default False;
+ property Color;
+ property Cursor;
+ property DataField;
+ property DataSet;
+ property DataSetName;
+ property Expression: String read FExpression write FExpression;
+ property Frame;
+ property HAlign: TfrxHAlign read FHAlign write FHAlign default haLeft;
+ property Rotation: Integer read FRotation write SetRotation;
+ property ShowText: Boolean read FShowText write FShowText default True;
+ property TagStr;
+ property Text: String read FText write FText;
+ property URL;
+ property WideBarRatio: Double read FWideBarRatio write FWideBarRatio;
+ property Zoom: Double read FZoom write FZoom;
+ property Font;
+ end;
+
+
+implementation
+
+uses
+{$IFNDEF NO_EDITORS}
+ FMX.frxBarcodeEditor,
+{$ENDIF}
+ FMX.frxBarcodeRTTI, FMX.frxDsgnIntf, FMX.frxRes, FMX.frxUtils, FMX.frxPrinter;
+
+const
+ cbDefaultText = '12345678';
+
+
+{ TfrxBarCodeView }
+
+constructor TfrxBarCodeView.Create(AOwner: TComponent);
+begin
+ inherited;
+ FBarCode := TfrxBarCode.Create(nil);
+ FBarType := bcCode39;
+ FShowText := True;
+ FZoom := 1;
+ FText := cbDefaultText;
+ FWideBarRatio := 2;
+ Font.Name := 'Arial';
+ Font.Size := 9;
+ Font.OnChange := BcFontChanged;
+end;
+
+destructor TfrxBarCodeView.Destroy;
+begin
+ FBarCode.Free;
+ inherited Destroy;
+end;
+
+class function TfrxBarCodeView.GetDescription: String;
+begin
+ Result := frxResources.Get('obBarC');
+end;
+
+procedure TfrxBarCodeView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+var
+ SaveWidth: Extended;
+ ErrorText: String;
+ DrawRectA: TRectF;
+ CorrL, CorrR: Integer;
+ OutRect: TRect;
+begin
+ FBarCode.Angle := FRotation;
+ Font.AssignToFont(FBarCode.Font);
+ FBarCode.Font.Size := FBarCode.Font.Size * FZoom;
+ FBarCode.FontColor := Font.Color;
+ FBarCode.Checksum := FCalcCheckSum;
+ FBarCode.Typ := FBarType;
+ FBarCode.Ratio := FWideBarRatio;
+ if Color = claNull then
+ FBarCode.Color := claWhite else
+ FBarCode.Color := Color;
+
+ SaveWidth := Width;
+
+ FBarCode.Text := AnsiString(FText);
+ ErrorText := '';
+ if FZoom < 0.0001 then
+ FZoom := 1;
+
+ { frame correction for some bacrode types }
+ if FBarCode.Typ in [bcCodeUPC_E0, bcCodeUPC_E1, bcCodeUPC_A] then
+ CorrR := 9
+ else
+ CorrR := 0;
+ if FBarCode.Typ in [bcCodeEAN13, bcCodeUPC_A] then
+ CorrL := 8
+ else
+ CorrL := 0;
+
+ try
+ if (FRotation = 0) or (FRotation = 180) then
+ Width := (FBarCode.Width + CorrL + CorrR) * FZoom
+ else
+ Height := (FBarCode.Width + CorrL + CorrR) * FZoom;
+ except
+ on e: Exception do
+ begin
+ FBarCode.Text := '12345678';
+ ErrorText := e.Message;
+ end;
+ end;
+
+ if FHAlign = haRight then
+ Left := Left + SaveWidth - Width
+ else if FHAlign = haCenter then
+ Left := Left + (SaveWidth - Width) / 2;
+
+ BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+
+ DrawBackground;
+ if (FRotation = 0) or (FRotation = 180) then
+ OutRect := Rect(FX + Round(CorrL * ScaleX) , FY, FX1 - Round(CorrR * ScaleX), FY1)
+ else
+ OutRect := Rect(FX, FY + Round(CorrL * ScaleX) , FX1, FY1 - Round(CorrR * ScaleX));
+ if ErrorText = '' then
+ FBarCode.DrawBarcode(Canvas, OutRect, FShowText, ScaleY, {$IFDEF DELPHI25}{$IFDEF MSWINDOWS}False{$ELSE}IsPrinting{$ENDIF}{$ELSE}IsPrinting{$ENDIF})
+ else
+ with Canvas do
+ begin
+ Font.Family := 'Arial';
+ Font.Size := Round(8 * ScaleY);
+ Fill.Color := claRed;
+ DrawRectA := RectF(FX + 2, FY + 2, FX1, FY1);
+ FillText(DrawRectA, ErrorText, True, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ end;
+ DrawFrame;
+end;
+
+procedure TfrxBarCodeView.GetData;
+begin
+ inherited;
+ if IsDataField then
+ FText := VarToStr(DataSet.Value[DataField])
+ else if FExpression <> '' then
+ FText := VarToStr(Report.Calc(FExpression));
+end;
+
+function TfrxBarCodeView.GetRealBounds: TfrxRect;
+var
+ extra1, extra2, txtWidth: Single;
+ bmp: TBitmap;
+begin
+ bmp := TBitmap.Create(1,1);
+ bmp.Canvas.BeginScene;
+ try
+ Draw(bmp.Canvas, 1, 1, 0, 0);
+
+ Result := inherited GetRealBounds;
+ extra1 := 0;
+ extra2 := 0;
+
+ if (FRotation = 0) or (FRotation = 180) then
+ begin
+ Font.AssignToCanvas(bmp.Canvas);
+ with bmp.Canvas do
+ begin
+ {Font.Name := 'Arial';
+ Font.Size := 9;
+ Font.Style := []; }
+ //Font.Assign(Self.Font);
+ txtWidth := TextWidth(String(FBarcode.Text));
+ if Width < txtWidth then
+ begin
+ extra1 := Round((txtWidth - Width) / 2) + 2;
+ extra2 := extra1;
+ end;
+ end;
+ end;
+ finally
+ bmp.Canvas.EndScene;
+ end;
+
+ if FBarType in [bcCodeEAN13, bcCodeUPC_A] then
+ extra1 := 8;
+ if FBarType in [bcCodeUPC_A, bcCodeUPC_E0, bcCodeUPC_E1] then
+ extra2 := 8;
+ case FRotation of
+ 0:
+ begin
+ Result.Left := Result.Left - extra1;
+ Result.Right := Result.Right + extra2;
+ end;
+ 90:
+ begin
+ Result.Bottom := Result.Bottom + extra1;
+ Result.Top := Result.Top - extra2;
+ end;
+ 180:
+ begin
+ Result.Left := Result.Left - extra2;
+ Result.Right := Result.Right + extra1;
+ end;
+ 270:
+ begin
+ Result.Bottom := Result.Bottom + extra2;
+ Result.Top := Result.Top - extra1;
+ end;
+ end;
+
+ bmp.Free;
+end;
+
+procedure TfrxBarCodeView.SetRotation(const Value: Integer);
+begin
+ case Round(Value) of
+ 0 .. 44: FRotation := 0;
+ 45 .. 135: FRotation := 90;
+ 136 .. 224: FRotation := 180;
+ 225 .. 315: FRotation := 270;
+ else
+ FRotation := 0;
+ end;
+end;
+
+procedure TfrxBarCodeView.BcFontChanged(Sender: TObject);
+begin
+ if Font.Size > 9 then Font.Size := 9;
+end;
+
+initialization
+ StartClassGroup(TfmxObject);
+ ActivateClassGroup(TfmxObject);
+ //GroupDescendentsWith(TfrxBarCodeView, TfmxObject);
+ GroupDescendentsWith(TfrxBarCodeObject, TfmxObject);
+ RegisterFmxClasses([TfrxBarCodeObject]);
+ frxObjects.RegisterObject1(TfrxBarCodeView, nil, '', '', 0, 123);
+
+finalization
+ frxObjects.UnRegister(TfrxBarCodeView);
+
+end.
diff --git a/LibD28x64/FMX.frxBarcode2DBase.pas b/LibD28x64/FMX.frxBarcode2DBase.pas
new file mode 100644
index 0000000..3916857
--- /dev/null
+++ b/LibD28x64/FMX.frxBarcode2DBase.pas
@@ -0,0 +1,468 @@
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ 2D Barcode Add-in object }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxBarcode2DBase;
+{$I frx.inc}
+
+interface
+
+uses
+ System.Classes,
+ System.SysUtils,
+ System.Types,
+ System.UITypes,
+ System.UIConsts,
+ System.Math,
+ FMX.Types,
+ FMX.Objects,
+ FMX.frxPrinter
+{$IFDEF DELPHI19}
+ , FMX.Graphics, FMX.frxFMX
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+
+ TfrxBarcode2DBase = class(TComponent)
+ protected
+ FImage: TBytes;
+ FHeight: Integer;
+ FWidth: Integer;
+ FPixelWidth: Integer;
+ FPixelHeight: Integer;
+ FShowText: boolean;
+ FRotation: Integer;
+ FText: String;
+ FZoom: Double;
+ FFontScaled: boolean;
+ FFont: TFont;
+ FColor: TAlphaColor;
+ FColorBar: TAlphaColor;
+ FFontColor: TAlphaColor;
+ FErrorText: String;
+ FQuiteZone: Integer;
+
+ procedure SetShowText(Value: boolean); virtual;
+ procedure SetRotation(Value: Integer); virtual;
+ procedure SetText(Value: String); virtual;
+ procedure SetZoom(Value: Double); virtual;
+ procedure SetFontScaled(Value: boolean); virtual;
+ procedure SetFont(Value: TFont); virtual;
+ procedure SetColor(Value: TAlphaColor); virtual;
+ procedure SetColorBar(Value: TAlphaColor); virtual;
+ procedure SetErrorText(Value: String); virtual;
+ function GetWidth: Integer; virtual;
+ function GetHeight: Integer; virtual;
+ public
+ constructor Create; reintroduce; virtual;
+ destructor Destroy; override;
+ procedure Assign(Source: TfrxBarcode2DBase); reintroduce; virtual;
+ function GetFooterHeight: Integer; virtual;
+ procedure Draw2DBarcode(var Canvas: TCanvas; scalex, scaley: extended;
+ x, y: Integer; IsPrinting: boolean = False); virtual;
+
+ property ShowText: boolean read FShowText write SetShowText;
+ property Rotation: Integer read FRotation write SetRotation;
+ property Text: String read FText write SetText;
+ property Zoom: Double read FZoom write SetZoom;
+ property FontScaled: boolean read FFontScaled write SetFontScaled;
+ property Font: TFont read FFont write SetFont;
+ property Color: TAlphaColor read FColor write SetColor;
+ property FontColor: TAlphaColor read FFontColor write FFontColor;
+ property ColorBar: TAlphaColor read FColorBar write SetColorBar;
+ property ErrorText: String read FErrorText write SetErrorText;
+ property Width: Integer read GetWidth;
+ property Height: Integer read GetHeight;
+ property PixelWidth: Integer read FPixelWidth write FPixelWidth;
+ property PixelHeight: Integer read FPixelHeight write FPixelHeight;
+ property QuiteZone: Integer read FQuiteZone write FQuiteZone;
+ end;
+
+const
+ cbDefaultText = '12345678';
+
+implementation
+
+constructor TfrxBarcode2DBase.Create;
+begin
+ FWidth := 0;
+ FHeight := 0;
+ FImage := nil;
+ FPixelWidth := 2;
+ FPixelHeight := 2;
+ FShowText := true;
+ FRotation := 0;
+ FText := cbDefaultText;
+ FZoom := 1;
+ FFontScaled := true;
+ FColor := claWhite;
+ FColorBar := claBlack;
+ FFontColor := claBlack;
+ FFont := TFont.Create;
+ FFont.Family := 'Arial';
+ FFont.Size := 9;
+ FQuiteZone := 3;
+end;
+
+procedure TfrxBarcode2DBase.Assign(Source: TfrxBarcode2DBase);
+begin
+ FShowText := Source.FShowText;
+ FRotation := Source.FRotation;
+ FText := Source.FText;
+ FZoom := Source.FZoom;
+ FPixelWidth := Source.FPixelWidth;
+ FPixelHeight := Source.FPixelHeight;
+ FFontScaled := Source.FFontScaled;
+ FFont.Assign(Source.FFont);
+ FColor := Source.FColor;
+ FColorBar := Source.FColorBar;
+ FErrorText := Source.FErrorText;
+ FQuiteZone := Source.FQuiteZone;
+end;
+
+procedure TfrxBarcode2DBase.SetShowText(Value: boolean);
+begin
+ FShowText := Value;
+end;
+
+procedure TfrxBarcode2DBase.SetRotation(Value: Integer);
+begin
+ FRotation := Value;
+end;
+
+procedure TfrxBarcode2DBase.SetText(Value: String);
+begin
+ if (FText <> Value) then
+ FText := Value;
+end;
+
+procedure TfrxBarcode2DBase.SetZoom(Value: Double);
+begin
+ FZoom := Value;
+end;
+
+procedure TfrxBarcode2DBase.SetFontScaled(Value: boolean);
+begin
+ FFontScaled := Value;
+end;
+
+procedure TfrxBarcode2DBase.SetFont(Value: TFont);
+begin
+ FFont.Assign(Value);
+end;
+
+procedure TfrxBarcode2DBase.SetColor(Value: TAlphaColor);
+begin
+ FColor := Value;
+end;
+
+procedure TfrxBarcode2DBase.SetColorBar(Value: TAlphaColor);
+begin
+ FColorBar := Value;
+end;
+
+procedure TfrxBarcode2DBase.SetErrorText(Value: String);
+begin
+ FErrorText := Value;
+end;
+
+function TfrxBarcode2DBase.GetFooterHeight: Integer;
+begin
+ result := Round(Font.Size * 96 / 72) * 2 div 4;
+end;
+
+function TfrxBarcode2DBase.GetWidth: Integer;
+begin
+ result := Round(FWidth * FPixelWidth + FQuiteZone * 2);
+end;
+
+function TfrxBarcode2DBase.GetHeight: Integer;
+begin
+ if FShowText then
+ result := Round(FHeight * FPixelHeight + Round(Font.Size * 96 / 72 * 2) / 4
+ + FQuiteZone * 2)
+ else
+ result := Round(FHeight * FPixelHeight + FQuiteZone * 2);
+end;
+
+destructor TfrxBarcode2DBase.Destroy;
+begin
+ FreeAndNil(FFont);
+ SetLength(FImage, 0);
+ inherited;
+end;
+
+procedure TfrxBarcode2DBase.Draw2DBarcode(var Canvas: TCanvas;
+ scalex, scaley: extended; x, y: Integer; IsPrinting: boolean = False);
+var
+ stride, p, k, j, b: Integer;
+ dx, dy, textLeftOffset, textSemiLength, footerHeight, saveFooter, paddingX,
+ paddingY, x1, y1, x2, y2, txtX, txtY, e: Single;
+ kx, ky, saveKX, saveKY: extended;
+// flag: boolean;
+ bmp: TBitmap;
+ r, TextRect: TRectF;
+ state: TCanvasSaveState;
+ m, OldM: TMatrix;
+
+begin
+ kx := scalex * Zoom;
+ ky := scaley * Zoom;
+ x1 := 0;
+ x2 := 0;
+ y1 := 0;
+ y2 := 0;
+ footerHeight := 0;
+ dy := Round(FHeight * PixelHeight * ky);
+ dx := Round(FWidth * PixelWidth * kx);
+ paddingX := Round(FQuiteZone * kx);
+ paddingY := Round(FQuiteZone * ky);
+
+ if ShowText then
+ begin
+ Canvas.Font.Assign(FFont);
+
+
+ // Canvas.Font.Size := Canvas.Font.Size * ScaleY;
+
+ textSemiLength := Canvas.TextWidth(Text) / 2;
+ footerHeight := (Round(Font.Size * 96 / 72) + 4) * Zoom * scaley;
+ // + Round(Font.Size * 96 / 72);
+ if not IsPrinting then
+ Canvas.Font.Size := (FFont.Size * Zoom * scaley);
+
+ case Round(Rotation) of
+ 0:
+ begin
+ x1 := x;
+ y1 := y + dy;
+ x2 := x + dx;
+ y2 := y + dy + footerHeight;
+ textLeftOffset := dx / 2 - textSemiLength;
+ if textLeftOffset < 0 then
+ textLeftOffset := 0;
+ txtX := x + textLeftOffset;
+ txtY := y + dy
+ end;
+ 90:
+ begin
+ x1 := x + dy;
+ x2 := x + dy + footerHeight;
+ y1 := y;
+ y2 := y + dx;
+ textLeftOffset := dx / 2 - textSemiLength;
+ if textLeftOffset < 0 then
+ textLeftOffset := 0;
+ txtX := x1;
+ txtY := y2 - textLeftOffset;
+ end;
+ 180:
+ begin
+ x1 := x;
+ x2 := x + dx;
+ y1 := y;
+ y2 := y + footerHeight;
+ textLeftOffset := dx / 2 - textSemiLength;
+ if textLeftOffset < 0 then
+ textLeftOffset := 0;
+ txtX := x + dx - textLeftOffset;
+ txtY := y + footerHeight;
+ end;
+ 270:
+ begin
+ x1 := x;
+ x2 := x + footerHeight;
+ y1 := y;
+ y2 := y + dx;
+ textLeftOffset := dx / 2 - textSemiLength;
+ if textLeftOffset < 0 then
+ textLeftOffset := 0;
+ txtX := x1 + footerHeight;
+ txtY := y1 + textLeftOffset;
+ end;
+
+ end;
+
+ OldM := Canvas.Matrix;
+ state := Canvas.SaveState;
+ try
+ TextRect := RectF(x1 + paddingX, y1 + paddingY, x2 + paddingX,
+ y2 + paddingY);
+ if FRotation > 0 then
+ begin
+ m := CreateRotationMatrix(-DegToRad(FRotation));
+ m.m31 := OldM.m31 + TextRect.Left + TextRect.Width / 2;
+ m.m32 := OldM.m32 + TextRect.Top + TextRect.Height / 2;
+ Canvas.SetMatrix(m);
+
+ e := TextRect.Width;
+ TextRect.Left := -TextRect.Width / 2;
+ TextRect.Right := TextRect.Left + e;
+ e := TextRect.Height;
+ TextRect.Top := -TextRect.Height / 2;
+ TextRect.Bottom := TextRect.Top + e;
+
+ if ((FRotation >= 90) and (FRotation < 180)) or
+ ((FRotation >= 270) and (FRotation < 360)) then
+ TextRect := RectF(TextRect.Top, TextRect.Left, TextRect.Bottom,
+ TextRect.Right);
+ end;
+ Canvas.Fill.Color := FFontColor;
+ Canvas.FillText(TextRect, Text, False, 1, [], TTextAlign.taCenter,
+ TTextAlign.taLeading);
+
+ finally
+ Canvas.RestoreState(state);
+ Canvas.SetMatrix(OldM);
+ end;
+
+ end;
+
+ stride := (FWidth + 7) div 8;
+
+ saveKX := 0;
+ bmp := nil;
+ if (kx < 1) or (ky < 1) then
+ begin
+ saveKX := kx;
+ saveKY := ky;
+ saveFooter := footerHeight;
+ kx := 1;
+ ky := 1;
+ footerHeight := 0;
+ bmp := TBitmap.Create(FWidth * PixelWidth, FHeight * PixelHeight);
+ if (Rotation = 90) or (Rotation = 270) then
+ begin
+ bmp.Height := FWidth * PixelWidth;
+ bmp.Width := FHeight * PixelHeight;
+ end;
+ dy := Round(FHeight * PixelHeight);
+ dx := Round(FWidth * PixelWidth);
+ bmp.Canvas.BeginScene();
+ end;
+ try
+
+ for k := 0 to FHeight - 1 do
+ begin
+ p := k * stride;
+ for j := 0 to FWidth - 1 do
+ begin
+ b := FImage[p + (j div 8)] and $FF;
+ b := b shl (j mod 8);
+
+ if (b and $80) = 0 then
+ begin
+ if (saveKX <> 0) then
+ bmp.Canvas.Fill.Color := claWhite
+ else
+ Canvas.Fill.Color := claWhite;
+ end
+ else
+ begin
+ if (saveKX <> 0) then
+ bmp.Canvas.Fill.Color := claBlack
+ else
+ Canvas.Fill.Color := claBlack;
+ end;
+
+ case Round(Rotation) of
+ 0:
+ begin
+ x1 := Round(x + j * PixelWidth * kx);
+ y1 := Round(y + k * PixelHeight * ky);
+ x2 := Round(x + j * PixelWidth * kx + PixelWidth * kx);
+ y2 := Round(y + k * PixelHeight * ky + PixelHeight * ky);
+ end;
+ 90:
+ begin
+ x1 := Round(x + k * PixelHeight * kx);
+ x2 := Round(x + k * PixelHeight * kx + PixelHeight * kx);
+ y1 := Round(y + dx - j * PixelWidth * ky);
+ y2 := Round(y + dx - j * PixelWidth * ky - PixelWidth * ky);
+ end;
+ 180:
+ begin
+ x1 := Round(x + dx - j * PixelWidth * kx);
+ x2 := Round(x + dx - j * PixelWidth * kx - PixelWidth * kx);
+ y1 := Round(y + footerHeight + dy - k * PixelHeight * ky);
+ y2 := Round(y + footerHeight + dy - k * PixelHeight * ky -
+ PixelHeight * ky);
+ end;
+ 270:
+ begin
+ x1 := Round(x + footerHeight + dy - k * PixelHeight * kx);
+ x2 := Round(x + footerHeight + dy - k * PixelHeight * kx -
+ PixelHeight * kx);
+ y1 := Round(y + j * PixelWidth * ky);
+ y2 := Round(y + j * PixelWidth * ky + PixelWidth * ky);
+ end;
+
+ end;
+
+ if (saveKX = 0) then
+ Canvas.FillRect(RectF(x1 + paddingX, y1 + paddingY, x2 + paddingX,
+ y2 + paddingY), 0, 0, allCorners, 1)
+ else
+ bmp.Canvas.FillRect(RectF(x1 - x + paddingX, y1 - y + paddingY,
+ x2 - x + paddingX, y2 - y + paddingY), 0, 0, allCorners, 1);
+
+ end
+ end;
+
+ if (saveKX <> 0) then
+ begin
+ bmp.Canvas.EndScene;
+ case Round(Rotation) of
+ 0:
+ begin
+ x1 := 0;
+ y1 := 0;
+ x2 := Round(FWidth * PixelWidth * saveKX);
+ y2 := Round(FHeight * PixelHeight * saveKY);
+ end;
+ 90:
+ begin
+ x1 := 0;
+ y1 := 0;
+ x2 := Round(FHeight * PixelHeight * saveKY);
+ y2 := Round(FWidth * PixelWidth * saveKX);
+ end;
+ 180:
+ begin
+ x1 := 0;
+ y1 := saveFooter;
+ x2 := Round(FWidth * PixelWidth * saveKX);
+ y2 := Round(FHeight * PixelHeight * saveKY);
+ end;
+ 270:
+ begin
+ x1 := saveFooter;
+ y1 := 0;
+ x2 := Round(FHeight * PixelHeight * saveKY);
+ y2 := Round(FWidth * PixelWidth * saveKX);
+ end;
+ end;
+ r := RectF(x, y, x + x1 + x2 + paddingX, y + y1 + y2 + paddingY);
+ Canvas.DrawBitmap(bmp, RectF(0, 0, bmp.Width, bmp.Height), r, 1, False);
+ end;
+ finally
+ if Assigned(bmp) then
+ FreeAndNil(bmp);
+ end;
+
+end;
+
+end.
diff --git a/LibD28x64/FMX.frxBarcode2DRTTI.pas b/LibD28x64/FMX.frxBarcode2DRTTI.pas
new file mode 100644
index 0000000..7ce3ff2
--- /dev/null
+++ b/LibD28x64/FMX.frxBarcode2DRTTI.pas
@@ -0,0 +1,68 @@
+{ ****************************************** }
+{ }
+{ FastReport v5.0 }
+{ Barcode RTTI }
+{ }
+{ Copyright (c) 1998-2014 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{ ****************************************** }
+
+unit FMX.frxBarcode2DRTTI;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, System.Types, System.SysUtils, FMX.Types, FMX.fs_iinterpreter, FMX.frxBarcodePDF417,
+ FMX.frxBarcodeDataMatrix, FMX.frxBarcodeQR, FMX.frxClassRTTI, FMX.frxBarcode2DView,
+ FMX.frxBarcodeProperties, System.Variants;
+
+type
+ TFunctions = class(TfsRTTIModule)
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+ { TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TfrxBarcode2DType', 'bcCodePDF417, bcCodeDataMatrix, bcCodeQR');
+ AddEnum('TQRCodeEncoding', 'qrAuto, qrNumeric, qrAlphanumeric, qrISO88591, qrUTF8NoBOM, qrUTF8BOM, qrShift_JIS');
+ AddEnum('TQRErrorLevels', 'ecL, ecM, ecQ, ecH');
+
+ AddEnum('DatamatrixEncoding', 'Auto, Ascii, C40, Txt, Base256, X12, Edifact');
+ AddEnum('DatamatrixSymbolSize', 'AutoSize, Size10x10, Size12x12, Size8x18, Size14x14, Size8x32, Size16x16, Size12x26,'
+ + ' Size18x18, Size20x20, Size12x36, Size22x22, Size16x36, Size24x24, Size26x26, Size16x48, Size32x32, Size36x36, Size40x40,'
+ + 'Size44x44, Size48x48, Size52x52, Size64x64, Size72x72, Size80x80, Size88x88, Size96x96, Size104x104, Size120x120, Size132x132, Size144x144');
+
+ AddEnum('PDF417ErrorCorrection', ' AutoCorr, Level0, Level1, Level2, Level3, Level4, Level5, Level6, Level7, Level8');
+ AddEnum('PDF417CompactionMode', 'AutoCompaction, TextComp, Numeric, Binary');
+
+ AddClass(TUniqueProp, 'TPersistent');
+ AddClass(TPDF417UniqueProperties, 'TUniqueProp');
+ AddClass(TDataMatrixUniqueProperties, 'TUniqueProp');
+ AddClass(TfrxQRProperties, 'TUniqueProp');
+
+ AddClass(TfrxBarcode2DView, 'TfrxView');
+ end;
+end;
+
+initialization
+
+fsRTTIModules.Add(TFunctions);
+
+finalization
+
+if fsRTTIModules <> nil then
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28x64/FMX.frxBarcode2DView.pas b/LibD28x64/FMX.frxBarcode2DView.pas
new file mode 100644
index 0000000..56d0823
--- /dev/null
+++ b/LibD28x64/FMX.frxBarcode2DView.pas
@@ -0,0 +1,360 @@
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ 2D Barcode Add-in object }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+
+unit FMX.frxBarcode2DView;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, System.UIConsts,
+ System.Types, FMX.Controls, FMX.Types, FMX.Objects, FMX.Forms, FMX.Dialogs,
+ FMX.Menus, FMX.frxClass, FMX.frxdesgn, FMX.frxBarcodePDF417, FMX.frxBarcodeQR,
+ FMX.frxBarcodeDataMatrix, FMX.frxBarcode2DBase, FMX.frxBarcodeProperties,
+ System.Variants
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+type
+
+ TfrxBarcodeType =
+ (
+ bc_datamatrix,
+ bc_PDF417,
+ bcCodeQR
+ );
+
+{$I frxFMX_PlatformsAttribute.inc}
+ Tfrx2DBarCodeObject = class(TComponent); // fake component
+
+ TfrxBarcode2DView = class(TfrxView)
+ private
+ FBarCode: TfrxBarcode2DBase;
+ FBarType: TfrxBarcodeType;
+ FHAlign: TfrxHAlign;
+ FProp : TUniqueProp;
+ FExpression: String;
+ procedure SetZoom(z: Double);
+ function GetZoom : Double;
+ procedure SetRotation(Value : Integer);
+ function GetRotation: Integer;
+ procedure SetShowText(Value: Boolean);
+ function GetShowText: Boolean;
+ procedure SetText(Value: String);
+ function GetText: String;
+ procedure SetFontScaled(Value: Boolean);
+ function GetFontScaled: Boolean;
+ procedure SetErrorText(Value: String);
+ function GetErrorText: String;
+ procedure SetQuiteZone(Value: Integer);
+ function GetQuiteZone: Integer;
+ procedure SetProp (Value: TUniqueProp);
+ procedure SetBarType(Value: TfrxBarcodeType);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY : Extended); override;
+ class function GetDescription: String; override;
+ procedure GetData; override;
+ property BarCode: TfrxBarcode2DBase read FBarCode write FBarcode;
+ published
+ property Expression: String read FExpression write FExpression;
+ property BarType: TfrxBarcodeType read FBarType write SetBarType;
+ property BarProperties : TUniqueProp read FProp write SetProp;
+ property BrushStyle;
+ property Color;
+ property Cursor;
+ property DataField;
+ property DataSet;
+ property DataSetName;
+ property Frame;
+ property HAlign: TfrxHAlign read FHAlign write FHAlign default haLeft;
+ property Rotation: Integer read GetRotation write SetRotation;
+ property ShowText: Boolean read GetShowText write SetShowText;
+ property TagStr;
+ property Text: String read GetText write SetText;
+ property URL;
+ property Zoom: Double read GetZoom write SetZoom;
+ property Font;
+ property FontScaled: Boolean read GetFontScaled write SetFontScaled;
+ property ErrorText: String read GetErrorText write SetErrorText;
+ property QuiteZone: Integer read GetQuiteZone write SetQuiteZone;
+ end;
+
+implementation
+
+uses
+{$IFNDEF NO_EDITORS}
+// frxBarcodeEditor,
+{$ENDIF}
+ FMX.frxBarcode2DRTTI, FMX.frxDsgnIntf, FMX.frxRes, FMX.frxUtils;
+
+{ TfrxBarcode2DView }
+
+constructor TfrxBarcode2DView.Create(AOwner: TComponent);
+begin
+ inherited;
+ FBarCode := TfrxBarcodePDF417.Create;
+ FBarType := bc_PDF417;
+ Font.AssignToFont(FBarCode.Font);
+ Width := 0;
+ Height := 0;
+ FProp := TPDF417UniqueProperties.Create;
+ FProp.SetWhose(FBarcode);
+end;
+
+destructor TfrxBarcode2DView.Destroy;
+begin
+ FBarCode.Free;
+ FProp.free;
+ inherited Destroy;
+end;
+
+procedure TfrxBarcode2DView.SetProp (Value: TUniqueProp);
+begin
+ FProp.Assign(Value);
+end;
+
+procedure TfrxBarcode2DView.SetBarType(Value: TfrxBarcodeType);
+var
+ tmp: TfrxBarcode2DBase;
+ aReport: TfrxReport;
+begin
+ if FBarType = Value then exit;
+ tmp := TfrxBarcode2DBase.Create;
+ tmp.Assign(FBarcode);
+ try
+ if Value = bc_PDF417 then
+ begin
+ FBarType := Value;
+ FBarCode.Free;
+ FBarCode := TfrxBarcodePDF417.Create;
+ FBarcode.Assign(tmp);
+ FBarcode.PixelWidth := FBarcode.PixelHeight div 4;
+ if FBarcode.PixelWidth < 1 then FBarcode.PixelWidth := 1;
+ FProp.Free;
+ FProp := TPDF417UniqueProperties.create;
+ FProp.SetWhose(FBarCode);
+ end
+ else if Value = bc_datamatrix then
+ begin
+ FBarType := Value;
+ FBarCode.Free;
+ FBarCode := TfrxBarcodeDataMatrix.Create;
+ FBarCode.Assign(tmp);
+ FBarCode.PixelWidth := FBarCode.PixelHeight;
+ FProp.Free;
+ FProp := TDataMatrixUniqueProperties.Create;
+ FProp.SetWhose(FBarCode);
+ end
+ else if Value = bcCodeQR then
+ begin
+ FBarType := Value;
+ FBarCode.Free;
+ FBarCode := TfrxBarcodeQR.Create;
+ FProp.Free;
+ FProp := TfrxQRProperties.Create;
+ FProp.SetWhose(FBarCode);
+ end;
+ aReport := Self.Report;
+ if (aReport <> nil) and (aReport.Designer <> nil) then
+ aReport.Designer.UpdateInspector;
+ finally
+ tmp.Free;
+ end;
+end;
+
+procedure TfrxBarcode2DView.SetZoom(z: Double);
+begin
+ FBarcode.Zoom := z;
+end;
+
+function TfrxBarcode2DView.GetZoom: Double;
+begin
+ Result := FBarcode.Zoom;
+end;
+
+procedure TfrxBarcode2DView.SetRotation(Value: Integer);
+begin
+ FBarcode.Rotation := Value;
+end;
+
+function TfrxBarcode2DView.GetRotation: Integer;
+begin
+ Result := FBarcode.Rotation;
+end;
+
+procedure TfrxBarcode2DView.SetShowText(Value : Boolean);
+begin
+ FBarcode.ShowText := Value;
+end;
+
+function TfrxBarcode2DView.GetShowText : Boolean;
+begin
+ Result := FBarcode.ShowText;
+end;
+
+procedure TfrxBarcode2DView.SetText(Value: String);
+begin
+ FBarcode.Text := Value;
+end;
+
+function TfrxBarcode2DView.GetText: String;
+begin
+ Result := FBarcode.Text;
+end;
+
+procedure TfrxBarcode2DView.SetFontScaled(Value: Boolean);
+begin
+ FBarcode.FontScaled := Value;
+end;
+
+function TfrxBarcode2DView.GetFontScaled: Boolean;
+begin
+ Result := FBarcode.FontScaled;
+end;
+
+procedure TfrxBarcode2DView.SetErrorText(Value: String);
+begin
+ FBarcode.ErrorText := Value;
+end;
+
+function TfrxBarcode2DView.GetErrorText: String;
+begin
+ Result := FBarcode.ErrorText;
+end;
+
+procedure TfrxBarcode2DView.SetQuiteZone(Value : Integer);
+begin
+ FBarcode.QuiteZone := Value;
+end;
+
+function TfrxBarcode2DView.GetQuiteZone: Integer;
+begin
+ Result := FBarcode.QuiteZone;
+end;
+
+procedure TfrxBarcode2DView.GetData;
+begin
+ inherited;
+ if IsDataField then
+ FBarcode.Text := VarToStr(DataSet.Value[DataField])
+ else if FExpression <> '' then
+ FBarcode.Text := VarToStr(Report.Calc(FExpression));
+end;
+
+class function TfrxBarcode2DView.GetDescription: String;
+begin
+ Result := frxResources.Get('2D Barcode');
+end;
+
+procedure TfrxBarcode2DView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
+var
+ w, h, tmp: Extended;
+ scaledFontCorrX, scaledFontCorrY: Integer;
+ DrawRectA: TRectF;
+begin
+ case Round(Rotation) of
+ 0 .. 44: Rotation := 0;
+ 45 .. 135: Rotation := 90;
+ 136 .. 224: Rotation := 180;
+ 225 .. 315: Rotation := 270;
+ else
+ Rotation := 0;
+ end;
+
+ Font.AssignToFont(FBarCode.Font);
+ FBarCode.FontColor := Font.Color;
+
+ if Color = claNull then
+ FBarCode.Color := claWhite
+ else
+ FBarCode.Color := Color;
+
+ w := FBarCode.Width;
+ h := FBarCode.Height;
+
+
+
+ if FontScaled or (not ShowText) then
+ begin
+ scaledFontCorrX := 0;
+ scaledFontCorrY := 0;
+ end
+ else
+ begin
+ scaledFontCorrY := FBarCode.GetFooterHeight;
+ scaledFontCorrX := 0;
+ if (Rotation = 90) or (Rotation = 270) then
+ begin
+ scaledFontCorrX := FBarCode.GetFooterHeight;
+ scaledFontCorrY := 0;
+ end;
+ end;
+
+ if (Rotation = 90) or (Rotation = 270) then
+ begin
+ tmp := w;
+ w := h;
+ h := tmp;
+ end;
+
+ Height := (h - scaledFontCorrY) * Zoom + scaledFontCorrY;
+ Width := (w - scaledFontCorrX) * Zoom + scaledFontCorrX;
+ if Frame.DropShadow then
+ begin
+ Height := Height + round(Frame.ShadowWidth);
+ Width := Width + round(Frame.ShadowWidth);
+ end;
+
+ BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+
+ if FBarcode.ErrorText <> '' then
+ begin
+ with Canvas do
+ begin
+ Font.Family := 'Arial';
+ Font.Size := Round(8 * ScaleY);
+ Fill.Color := claRed;
+ Stroke.Color := claBlack;
+ DrawRectA := RectF(FX + 2, FY + 2, FX1, FY1);
+ FillText(DrawRectA, ErrorText, True, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ Exit;
+ end;
+ end;
+
+ DrawBackground;
+ FBarCode.Draw2DBarcode(Canvas, FScaleX, FScaleY, FX, FY, IsPrinting);
+ DrawFrame;
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxBarcode2DView, TFmxObject);
+ GroupDescendentsWith(Tfrx2DBarCodeObject, TFmxObject);
+ frxObjects.RegisterObject1(TfrxBarcode2DView, nil, '', '', 0, 123);
+
+finalization
+ frxObjects.Unregister(TfrxBarcode2DView);
+
+
+end.
diff --git a/LibD28x64/FMX.frxBarcodeDataMatrix.pas b/LibD28x64/FMX.frxBarcodeDataMatrix.pas
new file mode 100644
index 0000000..5fa176b
--- /dev/null
+++ b/LibD28x64/FMX.frxBarcodeDataMatrix.pas
@@ -0,0 +1,1308 @@
+//
+//
+//
+// Copyright 2007 by Paulo Soares.
+//
+// The contents of this file are subject to the Mozilla Public License Version 1.1
+// (the "License"); you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at http://www.mozilla.org/MPL/
+//
+// Software distributed under the License is distributed on an "AS IS" basis,
+// WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
+// for the specific language governing rights and limitations under the License.
+//
+// The Original Code is 'iText, a free JAVA-PDF library'.
+//
+// The Initial Developer of the Original Code is Bruno Lowagie. Portions created by
+// the Initial Developer are Copyright (C) 1999, 2000, 2001, 2002 by Bruno Lowagie.
+// All Rights Reserved.
+// Co-Developer of the code is Paulo Soares. Portions created by the Co-Developer
+// are Copyright (C) 2000, 2001, 2002 by Paulo Soares. All Rights Reserved.
+// Modifications: Alexander Tzyganenko
+//
+//
+//
+//
+//
+// TODO:
+// -
+// - frxBarcodeBase, ????????
+//
+//
+
+
+unit FMX.frxBarcodeDataMatrix;
+
+
+interface
+
+{$I frx.inc}
+
+uses System.SysUtils, System.Types, System.UITypes, System.StrUtils,
+ System.Classes, FMX.Objects, FMX.Types, FMX.Controls, FMX.Forms,
+ FMX.Dialogs, FMX.frxBarcode2DBase
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+type
+
+
+// Specifies the Datamatrix encoding. ///////////////////////////////////////////////////////////////////////
+
+DatamatrixEncoding =
+(
+ Auto,
+ Ascii,
+ C40,
+ Txt,
+ Base256,
+ X12,
+ Edifact
+);
+
+// Specifies the Datamatrix symbol size. /////////////////////////////////////////////////////////////////////
+
+DatamatrixSymbolSize =
+(
+ AutoSize,
+ Size10x10,
+ Size12x12,
+ Size8x18,
+ Size14x14,
+ Size8x32,
+ Size16x16,
+ Size12x26,
+ Size18x18,
+ Size20x20,
+ Size12x36,
+ Size22x22,
+ Size16x36,
+ Size24x24,
+ Size26x26,
+ Size16x48,
+ Size32x32,
+ Size36x36,
+ Size40x40,
+ Size44x44,
+ Size48x48,
+ Size52x52,
+ Size64x64,
+ Size72x72,
+ Size80x80,
+ Size88x88,
+ Size96x96,
+ Size104x104,
+ Size120x120,
+ Size132x132,
+ Size144x144
+);
+
+// ////////////////////////////////////////////////////////////////////////////////////////////////////
+//
+//
+// ////////////////////////////////////////////////////////////////////////////////////////////////////
+
+DmParams = record
+
+ height,
+ width,
+ heightSection,
+ widthSection,
+ dataSize,
+ dataBlock,
+ errorBlock : integer;
+
+end;
+
+const
+
+ dmSizes : array[Size10x10..Size144x144] of DmParams =
+ (
+ ( height: 10; width: 10; heightSection: 10; widthSection: 10; dataSize: 3; dataBlock: 3; errorBlock: 5 ),
+ ( height: 12; width: 12; heightSection: 12; widthSection: 12; dataSize: 5; dataBlock: 5; errorBlock: 7 ),
+ ( height: 8; width: 18; heightSection: 8; widthSection: 18; dataSize: 5; dataBlock: 5; errorBlock: 7 ),
+ ( height: 14; width: 14; heightSection: 14; widthSection: 14; dataSize: 8; dataBlock: 8; errorBlock:10 ),
+ ( height: 8; width: 32; heightSection: 8; widthSection: 16; dataSize:10; dataBlock:10; errorBlock:11 ),
+ ( height: 16; width: 16; heightSection: 16; widthSection: 16; dataSize:12; dataBlock:12; errorBlock:12 ),
+ ( height: 12; width: 26; heightSection: 12; widthSection: 26; dataSize:16; dataBlock:16; errorBlock:14 ),
+ ( height: 18; width: 18; heightSection: 18; widthSection: 18; dataSize:18; dataBlock:18; errorBlock:14 ),
+ ( height: 20; width: 20; heightSection: 20; widthSection: 20; dataSize:22; dataBlock:22; errorBlock:18 ),
+ ( height: 12; width: 36; heightSection: 12; widthSection: 18; dataSize:22; dataBlock:22; errorBlock:18 ),
+ ( height: 22; width: 22; heightSection: 22; widthSection: 22; dataSize:30; dataBlock:30; errorBlock:20 ),
+ ( height: 16; width: 36; heightSection: 16; widthSection: 18; dataSize:32; dataBlock:32; errorBlock:24 ),
+ ( height: 24; width: 24; heightSection: 24; widthSection: 24; dataSize:36; dataBlock:36; errorBlock:24 ),
+ ( height: 26; width: 26; heightSection: 26; widthSection: 26; dataSize:44; dataBlock:44; errorBlock:28 ),
+ ( height: 16; width: 48; heightSection: 16; widthSection: 24; dataSize:49; dataBlock:49; errorBlock:28 ),
+ ( height: 32; width: 32; heightSection: 16; widthSection: 16; dataSize:62; dataBlock:62; errorBlock:36 ),
+ ( height: 36; width: 36; heightSection: 18; widthSection: 18; dataSize:86; dataBlock:86; errorBlock:42 ),
+ ( height: 40; width: 40; heightSection: 20; widthSection: 20; dataSize:114; dataBlock:114; errorBlock: 48 ),
+ ( height: 44; width: 44; heightSection: 22; widthSection: 22; dataSize:144; dataBlock:144; errorBlock: 56 ),
+ ( height: 48; width: 48; heightSection: 24; widthSection: 24; dataSize:174; dataBlock:174; errorBlock: 68 ),
+ ( height: 52; width: 52; heightSection: 26; widthSection: 26; dataSize:204; dataBlock:102; errorBlock: 42 ),
+ ( height: 64; width: 64; heightSection: 16; widthSection: 16; dataSize:280; dataBlock:140; errorBlock: 56 ),
+ ( height: 72; width: 72; heightSection: 18; widthSection: 18; dataSize:368; dataBlock:92; errorBlock: 36 ),
+ ( height: 80; width: 80; heightSection: 20; widthSection: 20; dataSize:456; dataBlock:114; errorBlock: 48 ),
+ ( height: 88; width: 88; heightSection: 22; widthSection: 22; dataSize:576; dataBlock:144; errorBlock: 56 ),
+ ( height: 96; width: 96; heightSection: 24; widthSection: 24; dataSize:696; dataBlock:174; errorBlock: 68 ),
+ ( height:104; width:104; heightSection: 26; widthSection: 26; dataSize:816; dataBlock:136; errorBlock: 56 ),
+ ( height:120; width:120; heightSection: 20; widthSection: 20; dataSize:1050; dataBlock:175; errorBlock: 68 ),
+ ( height:132; width:132; heightSection: 22; widthSection: 22; dataSize:1304; dataBlock:163; errorBlock: 62 ),
+ ( height:144; width:144; heightSection: 24; widthSection: 24; dataSize:1558; dataBlock:156; errorBlock: 62 )
+);
+
+ log : array[0..255] of integer =
+ ( 0, 255, 1, 240, 2, 225, 241, 53, 3, 38, 226, 133, 242, 43, 54, 210,
+ 4, 195, 39, 114, 227, 106, 134, 28, 243, 140, 44, 23, 55, 118, 211, 234,
+ 5, 219, 196, 96, 40, 222, 115, 103, 228, 78, 107, 125, 135, 8, 29, 162,
+ 244, 186, 141, 180, 45, 99, 24, 49, 56, 13, 119, 153, 212, 199, 235, 91,
+ 6, 76, 220, 217, 197, 11, 97, 184, 41, 36, 223, 253, 116, 138, 104, 193,
+ 229, 86, 79, 171, 108, 165, 126, 145, 136, 34, 9, 74, 30, 32, 163, 84,
+ 245, 173, 187, 204, 142, 81, 181, 190, 46, 88, 100, 159, 25, 231, 50, 207,
+ 57, 147, 14, 67, 120, 128, 154, 248, 213, 167, 200, 63, 236, 110, 92, 176,
+ 7, 161, 77, 124, 221, 102, 218, 95, 198, 90, 12, 152, 98, 48, 185, 179,
+ 42, 209, 37, 132, 224, 52, 254, 239, 117, 233, 139, 22, 105, 27, 194, 113,
+ 230, 206, 87, 158, 80, 189, 172, 203, 109, 175, 166, 62, 127, 247, 146, 66,
+ 137, 192, 35, 252, 10, 183, 75, 216, 31, 83, 33, 73, 164, 144, 85, 170,
+ 246, 65, 174, 61, 188, 202, 205, 157, 143, 169, 82, 72, 182, 215, 191, 251,
+ 47, 178, 89, 151, 101, 94, 160, 123, 26, 112, 232, 21, 51, 238, 208, 131,
+ 58, 69, 148, 18, 15, 16, 68, 17, 121, 149, 129, 19, 155, 59, 249, 70,
+ 214, 250, 168, 71, 201, 156, 64, 60, 237, 130, 111, 20, 93, 122, 177, 150 );
+
+ alog : array[0..255] of integer =
+ ( 1, 2, 4, 8, 16, 32, 64, 128, 45, 90, 180, 69, 138, 57, 114, 228,
+ 229, 231, 227, 235, 251, 219, 155, 27, 54, 108, 216, 157, 23, 46, 92, 184,
+ 93, 186, 89, 178, 73, 146, 9, 18, 36, 72, 144, 13, 26, 52, 104, 208,
+ 141, 55, 110, 220, 149, 7, 14, 28, 56, 112, 224, 237, 247, 195, 171, 123,
+ 246, 193, 175, 115, 230, 225, 239, 243, 203, 187, 91, 182, 65, 130, 41, 82,
+ 164, 101, 202, 185, 95, 190, 81, 162, 105, 210, 137, 63, 126, 252, 213, 135,
+ 35, 70, 140, 53, 106, 212, 133, 39, 78, 156, 21, 42, 84, 168, 125, 250,
+ 217, 159, 19, 38, 76, 152, 29, 58, 116, 232, 253, 215, 131, 43, 86, 172,
+ 117, 234, 249, 223, 147, 11, 22, 44, 88, 176, 77, 154, 25, 50, 100, 200,
+ 189, 87, 174, 113, 226, 233, 255, 211, 139, 59, 118, 236, 245, 199, 163, 107,
+ 214, 129, 47, 94, 188, 85, 170, 121, 242, 201, 191, 83, 166, 97, 194, 169,
+ 127, 254, 209, 143, 51, 102, 204, 181, 71, 142, 49, 98, 196, 165, 103, 206,
+ 177, 79, 158, 17, 34, 68, 136, 61, 122, 244, 197, 167, 99, 198, 161, 111,
+ 222, 145, 15, 30, 60, 120, 240, 205, 183, 67, 134, 33, 66, 132, 37, 74,
+ 148, 5, 10, 20, 40, 80, 160, 109, 218, 153, 31, 62, 124, 248, 221, 151,
+ 3, 6, 12, 24, 48, 96, 192, 173, 119, 238, 241, 207, 179, 75, 150, 1 );
+ poly5 : array[0..4] of integer = ( 228, 48, 15, 111, 62 );
+ poly7 : array[0..6] of integer = ( 23, 68, 144, 134, 240, 92, 254 );
+ poly10 : array[0..9] of integer = ( 28, 24, 185, 166, 223, 248, 116, 255, 110, 61 );
+ poly11 : array[0..10] of integer = ( 175, 138, 205, 12, 194, 168, 39, 245, 60, 97, 120 );
+ poly12 : array[0..11] of integer = ( 41, 153, 158, 91, 61, 42, 142, 213, 97, 178, 100, 242 );
+ poly14 : array[0..13] of integer = ( 156, 97, 192, 252, 95, 9, 157, 119, 138, 45, 18, 186, 83, 185 );
+ poly18 : array[0..17] of integer = ( 83, 195, 100, 39, 188, 75, 66, 61, 241, 213, 109, 129, 94, 254, 225, 48, 90, 188 );
+ poly20 : array[0..19] of integer = ( 15, 195, 244, 9, 233, 71, 168, 2, 188, 160, 153, 145, 253, 79,
+ 108, 82, 27, 174, 186, 172 );
+ poly24 : array[0..23] of integer = ( 52, 190, 88, 205, 109, 39, 176, 21, 155, 197, 251, 223, 155, 21, 5, 172,
+ 254, 124, 12, 181, 184, 96, 50, 193 );
+ poly28 : array[0..27] of integer = ( 211, 231, 43, 97, 71, 96, 103, 174, 37, 151, 170, 53, 75, 34, 249, 121,
+ 17, 138, 110, 213, 141, 136, 120, 151, 233, 168, 93, 255 );
+ poly36 : array[0..35] of integer = ( 245, 127, 242, 218, 130, 250, 162, 181, 102, 120, 84, 179, 220, 251, 80, 182,
+ 229, 18, 2, 4, 68, 33, 101, 137, 95, 119, 115, 44, 175, 184, 59, 25,
+ 225, 98, 81, 112 );
+ poly42 : array[0..41] of integer = ( 77, 193, 137, 31, 19, 38, 22, 153, 247, 105, 122, 2, 245, 133, 242, 8,
+ 175, 95, 100, 9, 167, 105, 214, 111, 57, 121, 21, 1, 253, 57, 54, 101,
+ 248, 202, 69, 50, 150, 177, 226, 5, 9, 5 );
+ poly48 : array[0..47] of integer = ( 245, 132, 172, 223, 96, 32, 117, 22, 238, 133, 238, 231, 205, 188, 237, 87,
+ 191, 106, 16, 147, 118, 23, 37, 90, 170, 205, 131, 88, 120, 100, 66, 138,
+ 186, 240, 82, 44, 176, 87, 187, 147, 160, 175, 69, 213, 92, 253, 225, 19 );
+ poly56 : array[0..55] of integer = ( 175, 9, 223, 238, 12, 17, 220, 208, 100, 29, 175, 170, 230, 192, 215, 235,
+ 150, 159, 36, 223, 38, 200, 132, 54, 228, 146, 218, 234, 117, 203, 29, 232,
+ 144, 238, 22, 150, 201, 117, 62, 207, 164, 13, 137, 245, 127, 67, 247, 28,
+ 155, 43, 203, 107, 233, 53, 143, 46 );
+ poly62 : array[0..61] of integer = ( 242, 93, 169, 50, 144, 210, 39, 118, 202, 188, 201, 189, 143, 108, 196, 37,
+ 185, 112, 134, 230, 245, 63, 197, 190, 250, 106, 185, 221, 175, 64, 114, 71,
+ 161, 44, 147, 6, 27, 218, 51, 63, 87, 10, 40, 130, 188, 17, 163, 31,
+ 176, 170, 4, 107, 232, 7, 94, 166, 224, 124, 86, 47, 11, 204 );
+ poly68 : array[0..67] of integer = ( 220, 228, 173, 89, 251, 149, 159, 56, 89, 33, 147, 244, 154, 36, 73, 127,
+ 213, 136, 248, 180, 234, 197, 158, 177, 68, 122, 93, 213, 15, 160, 227, 236,
+ 66, 139, 153, 185, 202, 167, 179, 25, 220, 232, 96, 210, 231, 136, 223, 239,
+ 181, 241, 59, 52, 172, 25, 49, 232, 211, 189, 64, 54, 108, 153, 132, 63,
+ 96, 103, 82, 186 );
+
+ _x12 = #13 + '*> 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
+ cbDefaultText = '12345678';
+
+type
+
+ SizeF = record
+ height : Double;
+ width : Double;
+ end;
+
+ TInts = array of integer;
+
+// /////////////////////////////////////////////////////////////////////////
+// Generates the 2D Data Matrix barcode. /////////////////////////////////////////////////////////////////////////
+// /////////////////////////////////////////////////////////////////////////
+
+{$M+}
+TfrxBarcodeDataMatrix = class( TfrxBarcode2DBase )
+
+ private
+
+ FPlace : TInts;
+ FSymbolSize : DatamatrixSymbolSize;
+ FEncoding : DatamatrixEncoding;
+ FCodePage : integer;
+
+ procedure SetBit(x, y, xByte : integer);
+ procedure Generate(var text : string); overload;
+ procedure Generate( var text :TBytes; textOffset, textSize : integer); overload;
+ function GetEncodation(var Text : tbytes; textOffset, textSize : integer; var data : Tbytes;
+ dataOffset, dataSize : integer; firstMatch : boolean) : integer;
+
+ procedure Draw(var data : TBytes; dataSize : integer; const dm: DmParams);
+ procedure SetCodePage( cp : integer );
+ procedure SetEncoding( v : DatamatrixEncoding);
+ procedure Ecc200;
+ procedure SetSymbolSize( s : DatamatrixSymbolSize);
+ function GetPixelSize : integer;
+ procedure SetPixelSize(v : integer);
+ protected
+ procedure SetText(v : string); override;
+
+public
+
+ constructor Create; override;
+ destructor Destroy; override;
+ procedure Assign(src: TfrxBarcode2DBase);override;
+// procedure Draw2DBarcode(var g : TCanvas; scalex, scaley : extended; x, y : integer ); override;
+
+published
+
+
+ property SymbolSize : DatamatrixSymbolSize read FSymbolSize write SetSymbolSize;
+ property Encoding : DatamatrixEncoding read FEncoding write SetEncoding;
+ property CodePage : integer read FCodePage write SetCodePage;
+ property PixelSize : integer read GetPixelSize write SetPixelSize;
+
+end;
+
+
+procedure GenerateECC(var wd : TBytes; nd, datablock, nc : integer );
+
+
+implementation
+
+var
+ nrow, ncol : integer;
+
+
+constructor TfrxBarcodeDataMatrix.Create;
+
+begin
+
+ inherited;
+ FSymbolSize := AutoSize;
+ FEncoding := Auto;
+ FCodePage := 1251;
+ FPixelWidth := 3;
+ FWidth := 0;
+ FPixelHeight := 3;
+ FHeight := 0;
+
+ Generate(FText);
+
+end;
+
+destructor TfrxBarcodeDataMatrix.Destroy;
+begin
+ inherited;
+end;
+
+
+//
+
+procedure TfrxBarcodeDataMatrix.SetCodepage(cp : integer);
+begin
+
+ FCodepage := cp;
+ Generate(FText);
+
+end;
+
+
+procedure TfrxBarcodeDataMatrix.SetEncoding( v : DatamatrixEncoding);
+begin
+
+ FEncoding := v;
+ Generate(FText);
+
+end;
+
+procedure TfrxBarcodeDataMatrix.SetSymbolSize( s : DatamatrixSymbolSize );
+begin
+ FSymbolSize := s;
+ Generate(FText);
+
+end;
+
+function TfrxBarcodeDataMatrix.GetPixelSize : integer; begin result := FPixelWidth; end;
+procedure TfrxBarcodeDataMatrix.SetPixelSize(v : integer); begin FPixelWidth := v; FPixelHeight := v; end;
+
+
+
+
+procedure TfrxBarcodeDataMatrix.Assign(src: TfrxBarcode2DBase);
+var
+ BSource : TfrxBarcodeDataMatrix;
+begin
+ inherited;
+ if src is TfrxBarcodeDataMatrix then
+ begin
+ BSource := TfrxBarcodeDataMatrix( src );
+ FHeight := BSource.FHeight;
+ FSymbolSize := BSource.SymbolSize;
+ FEncoding := BSource.Encoding;
+ FCodePage := BSource.CodePage;
+ end;
+end;
+
+procedure TfrxBarcodeDataMatrix.SetText( v : string);
+begin
+ if( FText <> v) then
+ begin
+ FText := v;
+ Generate( FText );
+ end;
+end;
+
+procedure TfrxBarcodeDataMatrix.SetBit( x, y, xByte : integer);
+begin
+ FImage[y * xByte + x div 8] := FImage[y * xByte + x div 8] or ( 128 shr (x and 7) );
+end;
+
+
+procedure TfrxBarcodeDataMatrix.Draw(var data : tbytes; dataSize : integer; const dm: DmParams);
+var
+ k,i, j, p, x, y, xs, ys, z, xByte : integer;
+begin
+
+ xByte := (dm.width + 7) div 8;
+
+ for k:=0 to Length(FImage)-1 do
+ FImage[k] := 0;
+
+ //alignment patterns
+ //dotted horizontal line
+ i := 0;
+ while i < dm.height do
+ begin
+ j := 0;
+ while j < dm.width do
+ begin
+ SetBit(j, i, xByte);
+ inc(j,2);
+ end;
+ inc(i, dm.heightSection);
+ end;
+
+ //solid horizontal line
+ i := dm.heightSection - 1;
+ while i < dm.height do
+ begin
+ for j := 0 to dm.width-1 do
+ SetBit(j, i, xByte);
+
+ inc(i,dm.heightSection);
+ end;
+
+ //solid vertical line
+ i := 0;
+ while i < dm.width do
+ begin
+ for j:=0 to dm.height-1 do
+ SetBit(i, j, xByte);
+ inc(i, dm.widthSection);
+ end;
+
+ //dotted vertical line
+ i := dm.widthSection - 1;
+ while i < dm.width do
+ begin
+ j := 1;
+ while j < dm.height do
+ begin
+ SetBit(i, j, xByte);
+ inc(j,2);
+ end;
+ inc(i, dm.widthSection);
+ end;
+
+ p := 0;
+ ys := 0;
+ while ys < dm.height do
+ begin
+ for y := 1 to dm.heightSection - 2 do
+ begin
+ xs := 0;
+ while xs < dm.width do
+ begin
+ for x:=1 to dm.widthSection - 2 do
+ begin
+ z := FPlace[p];
+ inc(p);
+ if ( (z = 1) or ( (z > 1) and (( data[(z div 8) - 1] and $ff ) and (128 shr (z mod 8)) <> 0) ) ) then
+ SetBit(x + xs, y + ys, xByte);
+ end;
+ inc(xs, dm.widthSection);
+ end;
+ end;
+ inc(ys, dm.heightSection);
+ end;
+
+end;
+
+
+
+
+procedure MakePadding(var data : tbytes; position, count : integer);
+var
+ t : integer;
+begin
+ //already in ascii mode
+ if count > 0 then
+ begin
+ data[position] := 129;
+ inc(position);
+ dec(count);
+ while count > 0 do
+ begin
+ t := 129 + (((position + 1) * 149) mod 253) + 1;
+ if t > 254 then dec(t,254);
+ data[position] := byte(t);
+ inc(position);
+ dec(count);
+ end
+ end
+end;
+
+function IsDigit( c : integer ) : boolean;
+begin
+ result := false;
+ if ansichar(c) in ['0'..'9'] then result := true;
+end;
+
+
+function AsciiEncodation( var text : tbytes; textOffset, textLength : integer; var data : tbytes; dataOffset, dataLength : integer ) : integer;
+var
+ ptrIn, ptrOut,c : integer;
+
+begin
+
+ ptrIn := textOffset;
+ ptrOut := dataOffset;
+ inc(textLength, textOffset);
+ inc(dataLength, dataOffset);
+
+ while (ptrIn < textLength) do
+ begin
+ if (ptrOut >= dataLength) then
+ begin
+ result := -1;
+ exit;
+ end;
+
+ c := text[ptrIn] and $ff;
+ inc(ptrIn);
+
+ if IsDigit(c) and (ptrIn < textLength) and IsDigit( text[ptrIn] and $ff ) then
+ begin
+ data[ptrOut] := byte( (( c - integer('0')) * 10 + ( text[ptrIn] and $ff ) - integer('0') + 130));
+ inc(ptrIn);
+ inc(ptrOut);
+ end
+ else
+ if c > 127 then
+ begin
+ if ( ptrOut + 1 ) >= dataLength then
+ begin
+ result := -1;
+ exit;
+ end;
+ data[ptrOut] := byte(235);
+ inc(ptrOut);
+ data[ptrOut] := byte(c - 128 + 1);
+ inc(ptrOut);
+ end
+ else
+ begin
+ data[ptrOut] := byte(c + 1);
+ inc(ptrOut);
+ end
+ end;
+
+ result := ptrOut - dataOffset;
+end;
+
+function B256Encodation(var text : tbytes; textOffset, textLength : integer; var data : tbytes; dataOffset, dataLength : integer ) : integer;
+var
+ k, j, prn, tv, c : integer;
+
+begin
+
+ if textLength = 0 then begin result := 0; exit; end;
+ if (textLength < 250) and (textLength + 2 > dataLength) then begin result := -1; exit; end;
+ if (textLength >= 250) and (textLength + 3 > dataLength) then begin result := -1; exit; end;
+
+ data[dataOffset] := byte(231);
+ if textLength < 250 then
+ begin
+ data[dataOffset + 1] := byte(textLength);
+ k := 2;
+ end
+ else
+ begin
+ data[dataOffset + 1] := byte((textLength div 250) + 249);
+ data[dataOffset + 2] := byte( textLength mod 250 );
+ k := 3;
+ end;
+
+ for j := 0 to textLength-1 do
+ data[k + dataOffset + j] := byte(text[textOffset + j]);
+
+ inc(k, textLength + dataOffset);
+
+ for j := dataOffset + 1 to k-1 do
+ begin
+ c := data[j] and $ff;
+ prn := ((149 * (j + 1)) mod 255) + 1;
+ tv := c + prn;
+ if (tv > 255) then dec(tv, 256);
+ data[j] := byte(tv);
+ end;
+ result := k - dataOffset;
+end;
+
+
+
+function X12Encodation(var text: tbytes; textOffset, textLength : integer; var data : tbytes; dataOffset, dataLength : integer ) : integer;
+var
+ ptrIn, ptrOut, count, k, n, ci, i : integer;
+ c : byte;
+ x : array of byte;
+begin
+
+ if (textLength = 0) then begin result := 0; exit; end;
+ ptrOut := 0;
+ SetLength( x, textLength);
+
+ count := 0;
+ for ptrIn := 0 to textLength - 1 do
+ begin
+ i := Pos( char(text[ptrIn + textOffset]), _x12) - 1;
+ if (i >= 0) then
+ begin
+ x[ptrIn] := byte(i);
+ inc(count);
+ end
+ else
+ begin
+ x[ptrIn] := byte(100);
+ if (count >= 6) then
+ dec(count, (count div 3) * 3 );
+ for k := 0 to count-1 do
+ x[ptrIn - k - 1] := byte(100);
+ count := 0;
+ end
+ end;
+
+ ptrIn := textLength - 1;
+
+ if (count >= 6) then dec(count, (count div 3) * 3);
+ for k := 0 to count-1 do
+ x[ptrIn - k - 1] := byte(100);
+
+ ptrIn := 0;
+ while ptrIn < textLength do
+ begin
+ c := x[ptrIn];
+ if (ptrOut >= dataLength) then break;
+ if (c < 40) then
+ begin
+ if (ptrIn = 0) or ( (ptrIn > 0 ) and ( x[ptrIn - 1] > 40 ) ) then
+ begin
+ data[dataOffset + ptrOut] := byte(238);
+ inc(ptrOut);
+ end;
+
+ if (ptrOut + 2 > dataLength) then
+ break;
+ n := 1600 * x[ptrIn] + 40 * x[ptrIn + 1] + x[ptrIn + 2] + 1;
+ data[dataOffset + ptrOut] := byte(n div 256);
+ inc(ptrOut);
+ data[dataOffset + ptrOut] := byte(n);
+ inc(ptrOut);
+ inc(ptrIn, 2);
+ end
+ else
+ begin
+ if (ptrIn > 0) and (x[ptrIn - 1] < 40) then
+ begin
+ data[dataOffset + ptrOut] := byte(254);
+ inc(ptrOut);
+ end;
+ ci := text[ptrIn + textOffset] and $ff;
+ if (ci > 127) then
+ begin
+ data[dataOffset + ptrOut] := byte(235);
+ inc(ptrOut);
+ dec(ci, 128);
+ end;
+ if (ptrOut >= dataLength) then
+ break;
+ data[dataOffset + ptrOut] := byte(ci + 1);
+ inc(ptrOut);
+ end;
+ inc(ptrIn);
+ end;
+ c := 100;
+ if (textLength > 0) then
+ c := x[textLength - 1];
+ if (ptrIn <> textLength) or ( (c < 40 ) and (ptrOut >= dataLength)) then
+ begin
+ result := -1;
+ exit;
+ end;
+ if (c < 40) then
+ begin
+ data[dataOffset + ptrOut] := byte(254);
+ inc(ptrOut);
+ end;
+
+ result := ptrOut;
+
+end;
+
+
+function EdifactEncodation(var text: tbytes; textOffset, textLength: integer; var data: tbytes; dataOffset, dataLength: integer): integer;
+var
+ ptrIn, ptrOut, edi, pedi, c : integer;
+ Ascii : boolean;
+begin
+
+ if (textLength = 0) then begin result := 0; exit; end;
+ ptrOut := 0;
+ edi := 0;
+ pedi := 18;
+ Ascii := true;
+
+ for ptrIn := 0 to textLength-1 do
+ begin
+ c := text[ptrIn + textOffset] and $ff;
+ if ( ( (c and $e0) = $40 ) or ( (c and $e0) = $20) )
+ and
+ (char(c) <> '_' ) then
+ begin
+ if (Ascii) then
+ begin
+ if (ptrOut + 1 > dataLength) then break;
+ data[dataOffset + ptrOut] := byte(240);
+ inc(ptrOut);
+ Ascii := false;
+ end;
+ c := c and $3f;
+ edi := edi or (c shl pedi);
+ if (pedi = 0) then
+ begin
+ if (ptrOut + 3 > dataLength) then break;
+ data[dataOffset + ptrOut] := byte(edi shr 16); inc(ptrOut);
+ data[dataOffset + ptrOut] := byte(edi shr 8); inc(ptrOut);
+ data[dataOffset + ptrOut] := byte(edi); inc(ptrOut);
+ edi := 0;
+ pedi := 18;
+ end
+ else
+ dec(pedi,6);
+ end
+ else
+ begin
+ if (not Ascii) then
+ begin
+ edi := edi or ( (integer('_') and $3f) shl pedi);
+ if (ptrOut + (3 - ( pedi div 8 )) > dataLength) then break;
+ data[dataOffset + ptrOut] := byte(edi shr 16); inc(ptrOut);
+ if (pedi <= 12) then
+ begin
+ data[dataOffset + ptrOut] := byte(edi shr 8); inc(ptrOut);
+ end;
+ if (pedi <= 6) then
+ begin
+ data[dataOffset + ptrOut] := byte(edi); inc(ptrOut);
+ end;
+ Ascii := true;
+ pedi := 18;
+ edi := 0;
+ end;
+ if (c > 127) then
+ begin
+ if (ptrOut >= dataLength) then break;
+ data[dataOffset + ptrOut] := byte(235);
+ inc(ptrOut);
+ dec(c, 128);
+ end;
+ if (ptrOut >= dataLength) then break;
+ data[dataOffset + ptrOut] := byte(c + 1);
+ inc(ptrOut);
+ end;
+
+ end; // for
+
+ if ( ptrIn <> textLength) then begin result := -1; exit; end;
+ if (not Ascii) then
+ begin
+ edi := edi or ( (integer('_') and $3f) shl pedi );
+ if (ptrOut + (3 - (pedi div 8)) > dataLength) then begin result:= - 1; exit; end;
+ data[dataOffset + ptrOut] := byte(edi shr 16);
+ inc(ptrOut);
+ if ( pedi <= 12) then
+ begin
+ data[dataOffset + ptrOut] := byte(edi shr 8);
+ inc(ptrOut);
+ end;
+ if ( pedi <= 6 ) then
+ begin
+ data[dataOffset + ptrOut] := byte(edi);
+ inc(ptrOut);
+ end;
+ end;
+
+ result := ptrOut;
+
+end;
+
+function C40OrTextEncodation(var Text : tbytes; textOffset, textLength : integer; var data : tbytes; dataOffset, dataLength : integer;
+ C40 : boolean ) : integer;
+var
+
+ ptrIn, ptrOut, encPtr, last0, last1, i, a, c, idx : integer;
+ basic, shift2, shift3 : string;
+ enc : array of integer;
+
+begin
+
+ if (textLength = 0) then begin result := 0; exit; end;
+ ptrIn := 0;
+ ptrOut := 0;
+ if (C40) then
+ begin
+ data[dataOffset + ptrOut] := byte(230);
+ inc(ptrOut);
+ end
+ else
+ begin
+ data[dataOffset + ptrOut] := byte(239);
+ inc(ptrOut);
+ end;
+
+ shift2 := '!\"#$%&'+#39+'()*+,-./:;<=>?@[\\]^_';
+ if (C40) then
+ begin
+ basic := ' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
+ shift3 := '`abcdefghijklmnopqrstuvwxyz{|}~' + #127;
+ end
+ else
+ begin
+ basic := ' 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
+ shift3 := '`abcdefghijklmnopqrstuvwxyz{|}~' + #127;
+ end;
+
+ SetLength( enc, textLength * 4 + 10);
+ encPtr := 0;
+ last0 := 0;
+ last1 := 0;
+
+ while (ptrIn < textLength) do
+ begin
+ if ((encPtr mod 3) = 0) then
+ begin
+ last0 := ptrIn;
+ last1 := encPtr;
+ end;
+ c := text[textOffset + ptrIn] and $ff;
+ inc(ptrIn);
+ if (c > 127) then
+ begin
+ dec(c, 128);
+ enc[encPtr] := 1; inc(encPtr);
+ enc[encPtr] := 30; inc(encPtr);
+ end;
+
+ idx := Pos( char(c), basic) - 1;
+ if (idx >= 0) then
+ begin
+ enc[encPtr] := idx + 3;
+ inc(encPtr);
+ end
+ else
+ if (c < 32) then
+ begin
+ enc[encPtr] := 0; inc(encPtr);
+ enc[encPtr] := c; inc(encPtr);
+ end
+ else
+ begin
+ idx := Pos( char(c), shift2) - 1;
+ if ( idx >= 0 ) then
+ begin
+ enc[encPtr] := 1; inc(encPtr);
+ enc[encPtr] := idx; inc(encPtr);
+ end
+ else
+ begin
+ idx := Pos( char(c), shift3) - 1;
+ if ( idx >= 0) then
+ begin
+ enc[encPtr] := 2; inc(encPtr);
+ enc[encPtr] := idx; inc(encPtr);
+ end
+ end;
+ end;
+ end;
+
+ if ((encPtr mod 3) <> 0) then
+ begin
+ ptrIn := last0;
+ encPtr := last1;
+ end;
+
+ if ( (encPtr div 3) * 2 > dataLength - 2) then
+ begin
+ result := - 1;
+ exit;
+ end;
+
+ i := 0;
+ while i < encPtr do
+ begin
+ a := 1600 * enc[i] + 40 * enc[i + 1] + enc[i + 2] + 1;
+ data[dataOffset + ptrOut] := byte(a div 256); inc(ptrOut);
+ data[dataOffset + ptrOut] := byte(a); inc(ptrOut);
+ inc(i, 3);
+ end;
+
+ data[ptrOut] := byte(254);
+ inc(ptrOut);
+ i := AsciiEncodation(Text, ptrIn, textLength - ptrIn, data, ptrOut, dataLength - ptrOut);
+ if (i < 0) then
+ result := i
+ else
+ result := ptrOut + i;
+end;
+
+function TfrxBarcodeDataMatrix.GetEncodation(var Text : tbytes; textOffset, textSize : integer; var data : tbytes;
+ dataOffset, dataSize : integer; firstMatch : boolean) : integer;
+var
+ e, j, k : integer;
+ e1 : array[0..5] of integer;
+
+begin
+
+ if (dataSize < 0) then
+ begin
+ result := -1;
+ exit;
+ end;
+
+ if ( FEncoding = Auto) then
+ begin
+ e1[0] := AsciiEncodation(text, textOffset, textSize, data, dataOffset, dataSize);
+ if firstMatch and ( e1[0] >= 0 ) then begin result := e1[0]; exit; end;
+ e1[1] := C40OrTextEncodation(text, textOffset, textSize, data, dataOffset, dataSize, false);
+ if firstMatch and ( e1[1] >= 0 ) then begin result := e1[1]; exit; end;
+ e1[2] := C40OrTextEncodation(text, textOffset, textSize, data, dataOffset, dataSize, true);
+ if firstMatch and ( e1[2] >= 0 ) then begin result := e1[2]; exit; end;
+ e1[3] := B256Encodation(text, textOffset, textSize, data, dataOffset, dataSize);
+ if firstMatch and ( e1[3] >= 0 ) then begin result := e1[3]; exit; end;
+ e1[4] := X12Encodation(text, textOffset, textSize, data, dataOffset, dataSize);
+ if firstMatch and ( e1[4] >= 0 ) then begin result := e1[4]; exit; end;
+ e1[5] := EdifactEncodation(text, textOffset, textSize, data, dataOffset, dataSize);
+ if firstMatch and ( e1[5] >= 0 ) then begin result := e1[5]; exit; end;
+ if (e1[0] < 0) and (e1[1] < 0) and (e1[2] < 0) and (e1[3] < 0) and (e1[4] < 0) and (e1[5] < 0) then
+ begin
+ result := -1;
+ exit;
+ end;
+
+ j := 0;
+ e := 99999;
+ for k := 0 to 5 do
+ if (e1[k] >= 0 ) and (e1[k] < e) then
+ begin
+ e := e1[k];
+ j := k;
+ end;
+
+ if (j = 0) then
+ e := AsciiEncodation(text, textOffset, textSize, data, dataOffset, dataSize)
+ else
+ if (j = 1) then
+ e := C40OrTextEncodation(text, textOffset, textSize, data, dataOffset, dataSize, false)
+ else
+ if (j = 2) then
+ e := C40OrTextEncodation(text, textOffset, textSize, data, dataOffset, dataSize, true)
+ else
+ if (j = 3) then
+ e := B256Encodation(text, textOffset, textSize, data, dataOffset, dataSize)
+ else
+ if (j = 4) then
+ e := X12Encodation(text, textOffset, textSize, data, dataOffset, dataSize);
+ result := e;
+ exit;
+ end;
+
+ case (FEncoding) of
+
+ Ascii: begin result := AsciiEncodation(text, textOffset, textSize, data, dataOffset, dataSize); exit; end;
+ C40: begin result := C40OrTextEncodation(text, textOffset, textSize, data, dataOffset, dataSize, true); exit; end;
+ Txt: begin result := C40OrTextEncodation(text, textOffset, textSize, data, dataOffset, dataSize, false); exit; end;
+ Base256: begin result := B256Encodation(text, textOffset, textSize, data, dataOffset, dataSize); exit; end;
+ X12: begin result := X12Encodation(text, textOffset, textSize, data, dataOffset, dataSize); exit; end;
+ Edifact: begin result := EdifactEncodation(text, textOffset, textSize, data, dataOffset, dataSize); exit; end;
+
+ end;
+ result := -1;
+
+end;
+
+function ReplaceControlCodes(var text: string) : string;
+begin
+ if Pos('&1;', text) = 1 then
+ begin
+ Delete(text,1,3);
+ text := #232 + text;
+ end;
+ result := ReplaceStr(text, '&1;', string(#29));
+end;
+
+procedure TfrxBarcodeDataMatrix.Generate(var text : string);
+var
+ t :TBytes;
+ e : TEncoding;
+begin
+
+ text := ReplaceControlCodes(text);
+ e := TEncoding.GetEncoding(CodePage);
+ try
+ t := e.GetBytes(text);
+ finally
+ e.Free;
+ end;
+ Generate(t, 0, Length(t));
+
+end;
+
+ procedure TfrxBarcodeDataMatrix.Generate(var text: TBytes; textOffset, textSize : integer);
+
+var
+ e, full, extCount : integer;
+ dm, last : DmParams;
+ data : TBytes;
+ k : DatamatrixSymbolSize;
+
+begin
+
+ ErrorText := '';
+ extCount := 0;
+ SetLength(data, 2500);
+ if ( Length(text) > 0) and ( text[0] = byte(232)) then
+ begin
+ data[0] := byte(232);
+ inc(textOffset);
+ dec(textSize);
+ extCount := 1;
+ end;
+
+ // ,
+ last := dmSizes[ High(dmSizes) ];
+ e := GetEncodation(text, textOffset, textSize, data, extCount, last.dataSize, false); // Auto,
+ // -1,
+
+try
+
+ if (e < 0) then
+ begin
+ raise Exception.Create('The text is too big.');
+ end;
+
+ inc(e, extCount); //
+
+ // ,
+ // E,
+
+ if FSymbolSize = AutoSize then
+ begin
+
+ for k := Size10x10 to High(dmSizes) do
+ if dmSizes[k].datasize >= e then
+ break;
+
+ dm := dmSizes[k];
+ FHeight := dm.height;
+ FWidth := dm.width;
+
+ end
+ else
+ begin
+
+ dm := dmSizes[FSymbolSize];
+ e := GetEncodation(text, textOffset, textSize, data, extCount, dm.dataSize, false);
+
+ if (e < 0) then
+ begin
+ raise Exception.Create(' The text is too big.');
+ end;
+
+ FHeight := dm.height;
+ FWidth := dm.width;
+ inc(e, extCount);
+
+ end;
+
+ SetLength(FImage, ((dm.width + 7) div 8) * dm.height );
+ MakePadding(data, e, dm.dataSize - e);
+ nrow := dm.height - ( (dm.height div dm.heightSection) * 2);
+ ncol := dm.width - ( ( dm.width div dm.widthSection ) * 2);
+ SetLength(FPlace, nrow * ncol);
+ Ecc200;
+
+ full := dm.dataSize + ((dm.dataSize + 2) div dm.dataBlock) * dm.errorBlock;
+ GenerateECC(data, dm.dataSize, dm.dataBlock, dm.errorBlock);
+ Draw(data, full, dm);
+
+ except
+ on e: Exception do
+ begin
+// FText := cbDefaultText;
+ ErrorText := e.Message;
+ end;
+ end;
+
+end;
+
+
+
+//* "ECC200" fills an nrow x ncol array with appropriate values for ECC200 */
+procedure TfrxBarcodeDataMatrix.Ecc200;
+
+//* "module" places "chr+bit" with appropriate wrapping within array[] */
+procedure Module( row, col, chr, bit : integer);
+begin
+ if (row < 0) then begin row := row + nrow; col := col + 4 - ((nrow + 4) mod 8); end;
+ if (col < 0) then begin col := col + ncol; row := row + 4 - ((ncol + 4) mod 8); end;
+ FPlace[row * ncol + col] := integer(8 * chr + bit);
+end;
+
+//* "utah" places the 8 bits of a utah-shaped symbol character in ECC200 */
+
+procedure Utah( row, col, chr : integer);
+begin
+ Module(row - 2, col - 2, chr, 0);
+ Module(row - 2, col - 1, chr, 1);
+ Module(row - 1, col - 2, chr, 2);
+ Module(row - 1, col - 1, chr, 3);
+ Module(row - 1, col, chr, 4);
+ Module(row, col - 2, chr, 5);
+ Module(row, col - 1, chr, 6);
+ Module(row, col, chr, 7);
+end;
+
+//* "cornerN" places 8 bits of the four special corner cases in ECC200 */
+procedure Corner1( chr : integer);
+begin
+ Module(nrow - 1, 0, chr, 0);
+ Module(nrow - 1, 1, chr, 1);
+ Module(nrow - 1, 2, chr, 2);
+ Module(0, ncol - 2, chr, 3);
+ Module(0, ncol - 1, chr, 4);
+ Module(1, ncol - 1, chr, 5);
+ Module(2, ncol - 1, chr, 6);
+ Module(3, ncol - 1, chr, 7);
+end;
+
+procedure Corner2( chr : integer);
+begin
+ Module(nrow - 3, 0, chr, 0);
+ Module(nrow - 2, 0, chr, 1);
+ Module(nrow - 1, 0, chr, 2);
+ Module(0, ncol - 4, chr, 3);
+ Module(0, ncol - 3, chr, 4);
+ Module(0, ncol - 2, chr, 5);
+ Module(0, ncol - 1, chr, 6);
+ Module(1, ncol - 1, chr, 7);
+end;
+
+procedure Corner3( chr : integer);
+begin
+ Module(nrow - 3, 0, chr, 0);
+ Module(nrow - 2, 0, chr, 1);
+ Module(nrow - 1, 0, chr, 2);
+ Module(0, ncol - 2, chr, 3);
+ Module(0, ncol - 1, chr, 4);
+ Module(1, ncol - 1, chr, 5);
+ Module(2, ncol - 1, chr, 6);
+ Module(3, ncol - 1, chr, 7);
+end;
+
+procedure Corner4( chr : integer);
+begin
+ Module(nrow - 1, 0, chr, 0);
+ Module(nrow - 1, ncol - 1, chr, 1);
+ Module(0, ncol - 3, chr, 2);
+ Module(0, ncol - 2, chr, 3);
+ Module(0, ncol - 1, chr, 4);
+ Module(1, ncol - 3, chr, 5);
+ Module(1, ncol - 2, chr, 6);
+ Module(1, ncol - 1, chr, 7);
+end;
+
+
+
+var
+
+ row, col, chr, k : integer;
+
+label l1,l2,l3;
+
+begin
+
+ //* First, fill the array[] with invalid entries */
+ for k := 0 to Length(FPlace) - 1 do
+ FPlace[k] := 0;
+ //* Starting in the correct location for character #1, bit 8,... */
+ chr := 1; row := 4; col := 0;
+l1://repeat
+ //* repeatedly first check for one of the special corner cases, then... */
+ if ((row = nrow) and (col = 0)) then begin Corner1(chr); inc(chr); end;
+ if ((row = nrow - 2) and (col = 0) and ( (ncol mod 4 ) <> 0)) then
+ begin Corner2(chr); inc(chr); end;
+ if ((row = nrow - 2) and (col = 0) and ( ( ncol mod 8 ) = 4)) then
+ begin Corner3(chr); inc(chr); end;
+ if ((row = nrow + 4) and (col = 2) and ( ( ncol mod 8 ) = 0)) then
+ begin Corner4(chr); inc(chr); end;
+ //* sweep upward diagonally, inserting successive characters,... */
+l2: //repeat
+
+ if ((row < nrow) and (col >= 0) and ( FPlace[row * ncol + col] = 0)) then
+
+ begin
+ Utah(row, col, chr);
+ inc(chr);
+ end;
+ dec(row, 2); inc(col, 2);
+ //until not((row >= 0) and (col < ncol));
+ if ((row >= 0) and (col < ncol)) then goto l2;
+ inc(row);
+ inc(col, 3);
+ //* & then sweep downward diagonally, inserting successive characters,... */
+l3: //repeat
+ if ((row >= 0) and (col < ncol) and (FPlace[row * ncol + col] = 0)) then
+ begin
+ Utah(row, col, chr);
+ inc(chr);
+ end;
+ inc(row,2);
+ dec(col, 2);
+ //until not ((row < nrow) and (col >= 0));
+ if((row < nrow) and (col >= 0)) then goto l3;
+ inc(row, 3);
+ inc( col, 1);
+ //* ... until the entire array is scanned */
+//until not ((row < nrow) or (col < ncol));
+ if(((row < nrow) or (col < ncol))) then goto l1;
+ //* Lastly, if the lower righthand corner is untouched, fill in fixed pattern */
+ if (FPlace[nrow * ncol - 1] = 0) then
+ begin
+ FPlace[nrow * ncol - 1] := 1;
+ FPlace[nrow * ncol - ncol - 2] := 1;
+ end
+end;
+
+procedure ReedSolomonBlock(var wd : TBytes; nd : integer; var ncout : TBytes; nc: integer; var c : TInts );
+var
+
+ i,j,k : integer;
+
+begin
+
+ for i := 0 to nc do
+ ncout[i] := 0;
+ for i := 0 to nd-1 do
+ begin
+ k := ( ncout[0] xor wd[i] ) and $ff;
+ for j := 0 to nc-1 do
+ begin
+ if( k = 0 ) then
+ ncout[j] := byte( ncout[j + 1] xor byte(0) )
+ else
+ ncout[j] := byte( ncout[j + 1]
+ xor (byte( alog[ (log[k] + log[ c[nc - j - 1] ] ) mod 255 ] )) );
+ end
+ end
+end;
+
+procedure GenerateECC(var wd : TBytes; nd, datablock, nc : integer );
+var
+
+ blocks, b, n, p : integer;
+ buf, ecc : TBytes;
+ c : Pointer;
+
+begin
+
+ blocks := (nd + 2) div datablock;
+ SetLength(buf, 256);
+ SetLength(ecc, 256);
+ c := nil;
+ case nc of
+ 5: c := @poly5;
+ 7: c := @poly7;
+ 10:c := @poly10;
+ 11:c := @poly11;
+ 12:c := @poly12;
+ 14:c := @poly14;
+ 18:c := @poly18;
+ 20:c := @poly20;
+ 24:c := @poly24;
+ 28:c := @poly28;
+ 36:c := @poly36;
+ 42:c := @poly42;
+ 48:c := @poly48;
+ 56:c := @poly56;
+ 62:c := @poly62;
+ 68:c := @poly68;
+ end;
+ for b := 0 to blocks-1 do
+ begin
+ p := 0;
+ n := b;
+ while n < nd do
+ begin
+ buf[p] := wd[n];
+ inc(p);
+ inc(n, blocks);
+ end;
+ ReedSolomonBlock(buf, p, ecc, nc, TInts(c));
+ p := 0;
+ n := b;
+ while n < nc * blocks do
+ begin
+ wd[nd + n] := ecc[p];
+ inc(p);
+ inc(n, blocks);
+ end;
+ end;
+end;
+
+
+initialization
+
+
+
+finalization
+
+
+end.
diff --git a/LibD28x64/FMX.frxBarcodeEditor.fmx b/LibD28x64/FMX.frxBarcodeEditor.fmx
new file mode 100644
index 0000000..6d5e01c
--- /dev/null
+++ b/LibD28x64/FMX.frxBarcodeEditor.fmx
@@ -0,0 +1,151 @@
+object frxBarcodeEditorForm: TfrxBarcodeEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Barcode editor'
+ ClientHeight = 255
+ ClientWidth = 539
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object CodeLbl: TLabel
+ Position.Point = '(8,8)'
+ Width = 185.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object TypeLbl: TLabel
+ Position.Point = '(8,52)'
+ Width = 201.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object ExamplePB: TPaintBox
+ Position.Point = '(276,12)'
+ Width = 253.000000000000000000
+ Height = 233.000000000000000000
+ OnPaint = ExamplePB2Paint
+ end
+ object CancelB: TButton
+ Position.Point = '(184,225)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 50
+ TabOrder = 3
+ ModalResult = 2
+ Cancel = True
+ end
+ object OkB: TButton
+ Position.Point = '(104,225)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 40
+ TabOrder = 4
+ ModalResult = 1
+ Default = True
+ end
+ object CodeE: TComboEdit
+ Cursor = crIBeam
+ Position.Point = '(8,24)'
+ Width = 253.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 260
+ TabOrder = 5
+ KeyboardType = vktDefault
+ OnChange = Rotation0RBClick
+ ItemHeight = 13.000000000000000000
+ ItemIndex = -1
+ ListBoxResource = 'combolistboxstyle'
+ Text = '0'
+ end
+ object TypeCB: TComboBox
+ Position.Point = '(8,68)'
+ Width = 253.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 261
+ TabOrder = 6
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ ListBoxResource = 'transparentlistboxstyle'
+ OnChange = Rotation0RBClick
+ end
+ object OptionsLbl: TGroupBox
+ Position.Point = '(8,100)'
+ Width = 253.000000000000000000
+ Height = 65.000000000000000000
+ TabOrder = 7
+ object ZoomLbl: TLabel
+ Position.Point = '(155,22)'
+ Width = 38.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object CalcCheckSumCB: TCheckBox
+ Position.Point = '(8,20)'
+ Width = 133.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 262
+ TabOrder = 1
+ OnChange = Rotation0RBClick
+ end
+ object ViewTextCB: TCheckBox
+ Position.Point = '(8,40)'
+ Width = 133.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 263
+ TabOrder = 2
+ OnChange = Rotation0RBClick
+ end
+ object ZoomE: TEdit
+ Position.Point = '(196,18)'
+ Width = 33.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 149
+ TabOrder = 3
+ KeyboardType = vktDefault
+ OnChange = Rotation0RBClick
+ Password = False
+ Text = '1'
+ end
+ end
+ object RotationLbl: TGroupBox
+ Position.Point = '(8,172)'
+ Width = 253.000000000000000000
+ Height = 45.000000000000000000
+ TabOrder = 8
+ object Rotation0RB: TRadioButton
+ Position.Point = '(8,20)'
+ Width = 37.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = Rotation0RBClick
+ HelpContext = 264
+ TabOrder = 0
+ end
+ object Rotation90RB: TRadioButton
+ Position.Point = '(72,20)'
+ Width = 37.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = Rotation0RBClick
+ HelpContext = 264
+ TabOrder = 1
+ end
+ object Rotation180RB: TRadioButton
+ Position.Point = '(136,20)'
+ Width = 45.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = Rotation0RBClick
+ HelpContext = 264
+ TabOrder = 2
+ end
+ object Rotation270RB: TRadioButton
+ Position.Point = '(200,20)'
+ Width = 45.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = Rotation0RBClick
+ HelpContext = 264
+ TabOrder = 3
+ end
+ end
+end
diff --git a/LibD28x64/FMX.frxBarcodeEditor.pas b/LibD28x64/FMX.frxBarcodeEditor.pas
new file mode 100644
index 0000000..9f875d6
--- /dev/null
+++ b/LibD28x64/FMX.frxBarcodeEditor.pas
@@ -0,0 +1,307 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ Barcode design editor }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxBarcodeEditor;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.Menus, FMX.frxClass, FMX.frxBarcode, FMX.frxCustomEditors, System.Types,
+ FMX.frxBarcod, FMX.frxCtrls, FMX.Edit, FMX.ListBox, FMX.Objects, FMX.Types
+, System.Variants, System.UITypes, System.UIConsts, FMX.frxBaseModalForm
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI21}
+ , FMX.ComboEdit
+{$ENDIF};
+
+
+type
+ TfrxBarcodeEditor = class(TfrxViewEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxBarcodeEditorForm = class(TfrxForm)
+ CancelB: TButton;
+ OkB: TButton;
+ CodeE: TComboEdit;
+ CodeLbl: TLabel;
+ TypeCB: TComboBox;
+ TypeLbl: TLabel;
+ ExamplePB: TPaintBox;
+ OptionsLbl: TGroupBox;
+ ZoomLbl: TLabel;
+ CalcCheckSumCB: TCheckBox;
+ ViewTextCB: TCheckBox;
+ ZoomE: TEdit;
+ RotationLbl: TGroupBox;
+ Rotation0RB: TRadioButton;
+ Rotation90RB: TRadioButton;
+ Rotation180RB: TRadioButton;
+ Rotation270RB: TRadioButton;
+ procedure ExprBtnClick(Sender: TObject);
+ procedure UpBClick(Sender: TObject);
+ procedure DownBClick(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure FormHide(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure ExamplePB2Paint(Sender: TObject; Canvas: TCanvas);
+ procedure Rotation0RBClick(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ { Private declarations }
+ FBarcode: TfrxBarcodeView;
+ public
+ { Public declarations }
+ property Barcode: TfrxBarcodeView read FBarcode write FBarcode;
+ end;
+
+
+implementation
+
+uses FMX.frxDsgnIntf, FMX.frxRes, FMX.frxUtils;
+
+
+{$R *.FMX}
+
+const
+ cbDefaultText = '12345678';
+
+
+{ TfrxBarcodeEditor }
+
+function TfrxBarcodeEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+function TfrxBarcodeEditor.Edit: Boolean;
+begin
+ with TfrxBarcodeEditorForm.Create(Designer) do
+ begin
+ Barcode := TfrxBarcodeView(Component);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ Self.Designer.PeekLastModalResult;
+ Free;
+ end;
+end;
+
+function TfrxBarcodeEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ i: Integer;
+ c: TfrxComponent;
+ v: TfrxBarcodeView;
+begin
+ Result := inherited Execute(Tag, Checked);
+ for i := 0 to Designer.SelectedObjects.Count - 1 do
+ begin
+ c := Designer.SelectedObjects[i];
+ if (c is TfrxBarcodeView) and not (rfDontModify in c.Restrictions) then
+ begin
+ v := TfrxBarcodeView(c);
+ if Tag = 1 then
+ v.CalcCheckSum := Checked
+ else if Tag = 2 then
+ v.ShowText := Checked;
+ Result := True;
+ end;
+ end;
+end;
+
+procedure TfrxBarcodeEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ v: TfrxBarcodeView;
+begin
+ v := TfrxBarcodeView(Component);
+ AddItem(frxResources.Get('bcCalcChecksum'), 1, v.CalcCheckSum);
+ AddItem(frxResources.Get('bcShowText'), 2, v.ShowText);
+ inherited;
+end;
+
+
+{ TfrxBarcodeEditorForm }
+
+procedure TfrxBarcodeEditorForm.FormShow(Sender: TObject);
+var
+ i: TfrxBarcodeType;
+begin
+{$IFDEF DELPHI23}
+ TypeCB.Clear;
+{$ELSE}
+ TypeCB.Items.Clear;
+{$ENDIF}
+ for i := bcCode_2_5_interleaved to bcCodeEAN128C do
+ TypeCB.Items.Add(frxResources.Get(String(bcData[i].Name)));
+
+ CodeE.Text := FBarcode.Expression;
+ TypeCB.ItemIndex := Integer(FBarcode.BarType);
+ CalcCheckSumCB.IsChecked := FBarcode.CalcCheckSum;
+ ViewTextCB.IsChecked := FBarcode.ShowText;
+ ZoomE.Text := FloatToStr(FBarcode.Zoom);
+
+ case FBarcode.Rotation of
+ 90: Rotation90RB.IsChecked := True;
+ 180: Rotation180RB.IsChecked := True;
+ 270: Rotation270RB.IsChecked := True;
+ else Rotation0RB.IsChecked := True;
+ end;
+
+ ExamplePB.Repaint;
+end;
+
+procedure TfrxBarcodeEditorForm.Rotation0RBClick(Sender: TObject);
+begin
+ ExamplePB.Repaint;
+end;
+
+procedure TfrxBarcodeEditorForm.FormHide(Sender: TObject);
+begin
+ if ModalResult = mrOk then
+ begin
+ FBarcode.Expression := CodeE.Text;
+ FBarcode.BarType := TfrxBarcodeType(TypeCB.ItemIndex);
+ FBarcode.CalcCheckSum := CalcCheckSumCB.IsChecked;
+ FBarcode.ShowText := ViewTextCB.IsChecked;
+ FBarcode.Zoom := frxStrToFloat(ZoomE.Text);
+
+ if Rotation90RB.IsChecked then
+ FBarcode.Rotation := 90
+ else if Rotation180RB.IsChecked then
+ FBarcode.Rotation := 180
+ else if Rotation270RB.IsChecked then
+ FBarcode.Rotation := 270
+ else
+ FBarcode.Rotation := 0;
+ end;
+end;
+
+procedure TfrxBarcodeEditorForm.ExprBtnClick(Sender: TObject);
+var
+ s: String;
+begin
+ s := TfrxCustomDesigner(Owner).InsertExpression(CodeE.Text);
+ if s <> '' then
+ CodeE.Text := s;
+end;
+
+procedure TfrxBarcodeEditorForm.UpBClick(Sender: TObject);
+var
+ i: Double;
+begin
+ i := frxStrToFloat(ZoomE.Text);
+ i := i + 0.1;
+ ZoomE.Text := FloatToStr(i);
+end;
+
+procedure TfrxBarcodeEditorForm.DownBClick(Sender: TObject);
+var
+ i: Double;
+begin
+ i := frxStrToFloat(ZoomE.Text);
+ i := i - 0.1;
+ if i <= 0 then i := 1;
+ ZoomE.Text := FloatToStr(i);
+end;
+
+procedure TfrxBarcodeEditorForm.ExamplePB2Paint(Sender: TObject;
+ Canvas: TCanvas);
+var
+ Barcode: TfrxBarcode;
+ dRect: TRect;
+begin
+ Barcode := TfrxBarcode.Create(Self);
+ Barcode.Typ := TfrxBarcodeType(TypeCB.ItemIndex);
+ Barcode.Text := '12345678';
+ Barcode.Ratio := 1;
+ if Rotation0RB.IsChecked then
+ Barcode.Angle := 0
+ else if Rotation90RB.IsChecked then
+ Barcode.Angle := 90
+ else if Rotation180RB.IsChecked then
+ Barcode.Angle := 180
+ else
+ Barcode.Angle := 270;
+ Barcode.CheckSum := CalcCheckSumCB.IsChecked;
+
+ with ExamplePB.Canvas do
+ begin
+ Fill.Color := claWhite;
+
+ if (Barcode.Angle = 0) or (Barcode.Angle = 180) then
+ dRect := Rect(40, 20, 40 + Round(Barcode.Width * 1.5), 200)
+ else
+ dRect := Rect(20, 40, 200, 40 + Round(Barcode.Width * 1.5));
+
+ Barcode.Color := claWhite;
+ Canvas.FillRect(RectF(0, 0, ExamplePB.Width, ExamplePB.Height), 0, 0, allCorners, 1);
+ Barcode.DrawBarcode(Canvas, dRect ,
+ ViewTextCB.IsChecked, 1.5);
+ end;
+
+ Barcode.Free;
+
+
+
+end;
+
+procedure TfrxBarcodeEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ FormHide(Self);
+end;
+
+procedure TfrxBarcodeEditorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(3500);
+ CodeLbl.Text := frxGet(3501);
+ TypeLbl.Text := frxGet(3502);
+ ZoomLbl.Text := frxGet(3503);
+ OptionsLbl.Text := frxGet(3504);
+ RotationLbl.Text := frxGet(3505);
+ CancelB.Text := frxGet(2);
+ OkB.Text := frxGet(1);
+ CalcCheckSumCB.Text := frxGet(3506);
+ ViewTextCB.Text := frxGet(3507);
+ Rotation0RB.Text := frxGet(3508);
+ Rotation90RB.Text := frxGet(3509);
+ Rotation180RB.Text := frxGet(3510);
+ Rotation270RB.Text := frxGet(3511);
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+end;
+
+
+procedure TfrxBarcodeEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = vkF1 then
+ frxResources.Help(Self);
+end;
+
+initialization
+ frxComponentEditors.Register(TfrxBarcodeView, TfrxBarcodeEditor);
+
+
+end.
diff --git a/LibD28x64/FMX.frxBarcodePDF417.pas b/LibD28x64/FMX.frxBarcodePDF417.pas
new file mode 100644
index 0000000..8eff92a
--- /dev/null
+++ b/LibD28x64/FMX.frxBarcodePDF417.pas
@@ -0,0 +1,1745 @@
+// Generates the 2D barcode PDF417. Supports dimensioning auto-sizing, fixed
+// and variable sizes, automatic and manual error levels, raw codeword input,
+// codeword size optimization and bitmap inversion.
+// Author: Paulo Soares (psoares@consiste.pt)
+// Modifications by Alexander Tzyganenko
+//
+
+
+
+
+unit FMX.frxBarcodePDF417;
+
+
+interface
+
+uses System.SysUtils, System.Types, System.UITypes, System.StrUtils, System.Classes,
+ FMX.Types, FMX.Objects, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ System.Generics.Collections, FMX.frxBarcode2DBase, FMX.frxPrinter
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+type
+
+ TInt = array of integer;
+ PInt = ^TInt;
+
+const
+
+ START_PATTERN = $1fea8;
+ STOP_PATTERN = $3fa29;
+ START_CODE_SIZE = 17;
+ STOP_SIZE = 18;
+ _MOD = 929;
+ ALPHA = $10000;
+ LOWER = $20000;
+ MIXED = $40000;
+ PUNCTUATION = $80000;
+ ISBYTE = $100000;
+ BYTESHIFT = 913;
+ PL = 25;
+ LL = 27;
+ _AS = 27;
+ ML = 28;
+ AL = 28;
+ PS = 29;
+ PAL = 29;
+ SPACE = 26;
+ TEXT_MODE = 900;
+ BYTE_MODE_6 = 924;
+ BYTE_MODE = 901;
+ NUMERIC_MODE = 902;
+ ABSOLUTE_MAX_TEXT_SIZE = 5420;
+ MAX_DATA_CODEWORDS = 926;
+ MACRO_SEGMENT_ID = 928;
+ MACRO_LAST_SEGMENT = 922;
+
+ MIXED_SET = '0123456789&'#13#9',:#-.$/+%*=^';
+ PUNCTUATION_SET = ';<>@[\]_`~!'#13#9',:'#10'-.$/"|*()?{}''';
+
+ CLUSTERS : array[0..2,0..928] of integer =
+ (
+ (
+ $1d5c0, $1eaf0, $1f57c, $1d4e0, $1ea78, $1f53e, $1a8c0, $1d470,
+ $1a860, $15040, $1a830, $15020, $1adc0, $1d6f0, $1eb7c, $1ace0,
+ $1d678, $1eb3e, $158c0, $1ac70, $15860, $15dc0, $1aef0, $1d77c,
+ $15ce0, $1ae78, $1d73e, $15c70, $1ae3c, $15ef0, $1af7c, $15e78,
+ $1af3e, $15f7c, $1f5fa, $1d2e0, $1e978, $1f4be, $1a4c0, $1d270,
+ $1e93c, $1a460, $1d238, $14840, $1a430, $1d21c, $14820, $1a418,
+ $14810, $1a6e0, $1d378, $1e9be, $14cc0, $1a670, $1d33c, $14c60,
+ $1a638, $1d31e, $14c30, $1a61c, $14ee0, $1a778, $1d3be, $14e70,
+ $1a73c, $14e38, $1a71e, $14f78, $1a7be, $14f3c, $14f1e, $1a2c0,
+ $1d170, $1e8bc, $1a260, $1d138, $1e89e, $14440, $1a230, $1d11c,
+ $14420, $1a218, $14410, $14408, $146c0, $1a370, $1d1bc, $14660,
+ $1a338, $1d19e, $14630, $1a31c, $14618, $1460c, $14770, $1a3bc,
+ $14738, $1a39e, $1471c, $147bc, $1a160, $1d0b8, $1e85e, $14240,
+ $1a130, $1d09c, $14220, $1a118, $1d08e, $14210, $1a10c, $14208,
+ $1a106, $14360, $1a1b8, $1d0de, $14330, $1a19c, $14318, $1a18e,
+ $1430c, $14306, $1a1de, $1438e, $14140, $1a0b0, $1d05c, $14120,
+ $1a098, $1d04e, $14110, $1a08c, $14108, $1a086, $14104, $141b0,
+ $14198, $1418c, $140a0, $1d02e, $1a04c, $1a046, $14082, $1cae0,
+ $1e578, $1f2be, $194c0, $1ca70, $1e53c, $19460, $1ca38, $1e51e,
+ $12840, $19430, $12820, $196e0, $1cb78, $1e5be, $12cc0, $19670,
+ $1cb3c, $12c60, $19638, $12c30, $12c18, $12ee0, $19778, $1cbbe,
+ $12e70, $1973c, $12e38, $12e1c, $12f78, $197be, $12f3c, $12fbe,
+ $1dac0, $1ed70, $1f6bc, $1da60, $1ed38, $1f69e, $1b440, $1da30,
+ $1ed1c, $1b420, $1da18, $1ed0e, $1b410, $1da0c, $192c0, $1c970,
+ $1e4bc, $1b6c0, $19260, $1c938, $1e49e, $1b660, $1db38, $1ed9e,
+ $16c40, $12420, $19218, $1c90e, $16c20, $1b618, $16c10, $126c0,
+ $19370, $1c9bc, $16ec0, $12660, $19338, $1c99e, $16e60, $1b738,
+ $1db9e, $16e30, $12618, $16e18, $12770, $193bc, $16f70, $12738,
+ $1939e, $16f38, $1b79e, $16f1c, $127bc, $16fbc, $1279e, $16f9e,
+ $1d960, $1ecb8, $1f65e, $1b240, $1d930, $1ec9c, $1b220, $1d918,
+ $1ec8e, $1b210, $1d90c, $1b208, $1b204, $19160, $1c8b8, $1e45e,
+ $1b360, $19130, $1c89c, $16640, $12220, $1d99c, $1c88e, $16620,
+ $12210, $1910c, $16610, $1b30c, $19106, $12204, $12360, $191b8,
+ $1c8de, $16760, $12330, $1919c, $16730, $1b39c, $1918e, $16718,
+ $1230c, $12306, $123b8, $191de, $167b8, $1239c, $1679c, $1238e,
+ $1678e, $167de, $1b140, $1d8b0, $1ec5c, $1b120, $1d898, $1ec4e,
+ $1b110, $1d88c, $1b108, $1d886, $1b104, $1b102, $12140, $190b0,
+ $1c85c, $16340, $12120, $19098, $1c84e, $16320, $1b198, $1d8ce,
+ $16310, $12108, $19086, $16308, $1b186, $16304, $121b0, $190dc,
+ $163b0, $12198, $190ce, $16398, $1b1ce, $1638c, $12186, $16386,
+ $163dc, $163ce, $1b0a0, $1d858, $1ec2e, $1b090, $1d84c, $1b088,
+ $1d846, $1b084, $1b082, $120a0, $19058, $1c82e, $161a0, $12090,
+ $1904c, $16190, $1b0cc, $19046, $16188, $12084, $16184, $12082,
+ $120d8, $161d8, $161cc, $161c6, $1d82c, $1d826, $1b042, $1902c,
+ $12048, $160c8, $160c4, $160c2, $18ac0, $1c570, $1e2bc, $18a60,
+ $1c538, $11440, $18a30, $1c51c, $11420, $18a18, $11410, $11408,
+ $116c0, $18b70, $1c5bc, $11660, $18b38, $1c59e, $11630, $18b1c,
+ $11618, $1160c, $11770, $18bbc, $11738, $18b9e, $1171c, $117bc,
+ $1179e, $1cd60, $1e6b8, $1f35e, $19a40, $1cd30, $1e69c, $19a20,
+ $1cd18, $1e68e, $19a10, $1cd0c, $19a08, $1cd06, $18960, $1c4b8,
+ $1e25e, $19b60, $18930, $1c49c, $13640, $11220, $1cd9c, $1c48e,
+ $13620, $19b18, $1890c, $13610, $11208, $13608, $11360, $189b8,
+ $1c4de, $13760, $11330, $1cdde, $13730, $19b9c, $1898e, $13718,
+ $1130c, $1370c, $113b8, $189de, $137b8, $1139c, $1379c, $1138e,
+ $113de, $137de, $1dd40, $1eeb0, $1f75c, $1dd20, $1ee98, $1f74e,
+ $1dd10, $1ee8c, $1dd08, $1ee86, $1dd04, $19940, $1ccb0, $1e65c,
+ $1bb40, $19920, $1eedc, $1e64e, $1bb20, $1dd98, $1eece, $1bb10,
+ $19908, $1cc86, $1bb08, $1dd86, $19902, $11140, $188b0, $1c45c,
+ $13340, $11120, $18898, $1c44e, $17740, $13320, $19998, $1ccce,
+ $17720, $1bb98, $1ddce, $18886, $17710, $13308, $19986, $17708,
+ $11102, $111b0, $188dc, $133b0, $11198, $188ce, $177b0, $13398,
+ $199ce, $17798, $1bbce, $11186, $13386, $111dc, $133dc, $111ce,
+ $177dc, $133ce, $1dca0, $1ee58, $1f72e, $1dc90, $1ee4c, $1dc88,
+ $1ee46, $1dc84, $1dc82, $198a0, $1cc58, $1e62e, $1b9a0, $19890,
+ $1ee6e, $1b990, $1dccc, $1cc46, $1b988, $19884, $1b984, $19882,
+ $1b982, $110a0, $18858, $1c42e, $131a0, $11090, $1884c, $173a0,
+ $13190, $198cc, $18846, $17390, $1b9cc, $11084, $17388, $13184,
+ $11082, $13182, $110d8, $1886e, $131d8, $110cc, $173d8, $131cc,
+ $110c6, $173cc, $131c6, $110ee, $173ee, $1dc50, $1ee2c, $1dc48,
+ $1ee26, $1dc44, $1dc42, $19850, $1cc2c, $1b8d0, $19848, $1cc26,
+ $1b8c8, $1dc66, $1b8c4, $19842, $1b8c2, $11050, $1882c, $130d0,
+ $11048, $18826, $171d0, $130c8, $19866, $171c8, $1b8e6, $11042,
+ $171c4, $130c2, $171c2, $130ec, $171ec, $171e6, $1ee16, $1dc22,
+ $1cc16, $19824, $19822, $11028, $13068, $170e8, $11022, $13062,
+ $18560, $10a40, $18530, $10a20, $18518, $1c28e, $10a10, $1850c,
+ $10a08, $18506, $10b60, $185b8, $1c2de, $10b30, $1859c, $10b18,
+ $1858e, $10b0c, $10b06, $10bb8, $185de, $10b9c, $10b8e, $10bde,
+ $18d40, $1c6b0, $1e35c, $18d20, $1c698, $18d10, $1c68c, $18d08,
+ $1c686, $18d04, $10940, $184b0, $1c25c, $11b40, $10920, $1c6dc,
+ $1c24e, $11b20, $18d98, $1c6ce, $11b10, $10908, $18486, $11b08,
+ $18d86, $10902, $109b0, $184dc, $11bb0, $10998, $184ce, $11b98,
+ $18dce, $11b8c, $10986, $109dc, $11bdc, $109ce, $11bce, $1cea0,
+ $1e758, $1f3ae, $1ce90, $1e74c, $1ce88, $1e746, $1ce84, $1ce82,
+ $18ca0, $1c658, $19da0, $18c90, $1c64c, $19d90, $1cecc, $1c646,
+ $19d88, $18c84, $19d84, $18c82, $19d82, $108a0, $18458, $119a0,
+ $10890, $1c66e, $13ba0, $11990, $18ccc, $18446, $13b90, $19dcc,
+ $10884, $13b88, $11984, $10882, $11982, $108d8, $1846e, $119d8,
+ $108cc, $13bd8, $119cc, $108c6, $13bcc, $119c6, $108ee, $119ee,
+ $13bee, $1ef50, $1f7ac, $1ef48, $1f7a6, $1ef44, $1ef42, $1ce50,
+ $1e72c, $1ded0, $1ef6c, $1e726, $1dec8, $1ef66, $1dec4, $1ce42,
+ $1dec2, $18c50, $1c62c, $19cd0, $18c48, $1c626, $1bdd0, $19cc8,
+ $1ce66, $1bdc8, $1dee6, $18c42, $1bdc4, $19cc2, $1bdc2, $10850,
+ $1842c, $118d0, $10848, $18426, $139d0, $118c8, $18c66, $17bd0,
+ $139c8, $19ce6, $10842, $17bc8, $1bde6, $118c2, $17bc4, $1086c,
+ $118ec, $10866, $139ec, $118e6, $17bec, $139e6, $17be6, $1ef28,
+ $1f796, $1ef24, $1ef22, $1ce28, $1e716, $1de68, $1ef36, $1de64,
+ $1ce22, $1de62, $18c28, $1c616, $19c68, $18c24, $1bce8, $19c64,
+ $18c22, $1bce4, $19c62, $1bce2, $10828, $18416, $11868, $18c36,
+ $138e8, $11864, $10822, $179e8, $138e4, $11862, $179e4, $138e2,
+ $179e2, $11876, $179f6, $1ef12, $1de34, $1de32, $19c34, $1bc74,
+ $1bc72, $11834, $13874, $178f4, $178f2, $10540, $10520, $18298,
+ $10510, $10508, $10504, $105b0, $10598, $1058c, $10586, $105dc,
+ $105ce, $186a0, $18690, $1c34c, $18688, $1c346, $18684, $18682,
+ $104a0, $18258, $10da0, $186d8, $1824c, $10d90, $186cc, $10d88,
+ $186c6, $10d84, $10482, $10d82, $104d8, $1826e, $10dd8, $186ee,
+ $10dcc, $104c6, $10dc6, $104ee, $10dee, $1c750, $1c748, $1c744,
+ $1c742, $18650, $18ed0, $1c76c, $1c326, $18ec8, $1c766, $18ec4,
+ $18642, $18ec2, $10450, $10cd0, $10448, $18226, $11dd0, $10cc8,
+ $10444, $11dc8, $10cc4, $10442, $11dc4, $10cc2, $1046c, $10cec,
+ $10466, $11dec, $10ce6, $11de6, $1e7a8, $1e7a4, $1e7a2, $1c728,
+ $1cf68, $1e7b6, $1cf64, $1c722, $1cf62, $18628, $1c316, $18e68,
+ $1c736, $19ee8, $18e64, $18622, $19ee4, $18e62, $19ee2, $10428,
+ $18216, $10c68, $18636, $11ce8, $10c64, $10422, $13de8, $11ce4,
+ $10c62, $13de4, $11ce2, $10436, $10c76, $11cf6, $13df6, $1f7d4,
+ $1f7d2, $1e794, $1efb4, $1e792, $1efb2, $1c714, $1cf34, $1c712,
+ $1df74, $1cf32, $1df72, $18614, $18e34, $18612, $19e74, $18e32,
+ $1bef4
+ ),
+ (
+ $1f560, $1fab8, $1ea40, $1f530, $1fa9c, $1ea20, $1f518, $1fa8e,
+ $1ea10, $1f50c, $1ea08, $1f506, $1ea04, $1eb60, $1f5b8, $1fade,
+ $1d640, $1eb30, $1f59c, $1d620, $1eb18, $1f58e, $1d610, $1eb0c,
+ $1d608, $1eb06, $1d604, $1d760, $1ebb8, $1f5de, $1ae40, $1d730,
+ $1eb9c, $1ae20, $1d718, $1eb8e, $1ae10, $1d70c, $1ae08, $1d706,
+ $1ae04, $1af60, $1d7b8, $1ebde, $15e40, $1af30, $1d79c, $15e20,
+ $1af18, $1d78e, $15e10, $1af0c, $15e08, $1af06, $15f60, $1afb8,
+ $1d7de, $15f30, $1af9c, $15f18, $1af8e, $15f0c, $15fb8, $1afde,
+ $15f9c, $15f8e, $1e940, $1f4b0, $1fa5c, $1e920, $1f498, $1fa4e,
+ $1e910, $1f48c, $1e908, $1f486, $1e904, $1e902, $1d340, $1e9b0,
+ $1f4dc, $1d320, $1e998, $1f4ce, $1d310, $1e98c, $1d308, $1e986,
+ $1d304, $1d302, $1a740, $1d3b0, $1e9dc, $1a720, $1d398, $1e9ce,
+ $1a710, $1d38c, $1a708, $1d386, $1a704, $1a702, $14f40, $1a7b0,
+ $1d3dc, $14f20, $1a798, $1d3ce, $14f10, $1a78c, $14f08, $1a786,
+ $14f04, $14fb0, $1a7dc, $14f98, $1a7ce, $14f8c, $14f86, $14fdc,
+ $14fce, $1e8a0, $1f458, $1fa2e, $1e890, $1f44c, $1e888, $1f446,
+ $1e884, $1e882, $1d1a0, $1e8d8, $1f46e, $1d190, $1e8cc, $1d188,
+ $1e8c6, $1d184, $1d182, $1a3a0, $1d1d8, $1e8ee, $1a390, $1d1cc,
+ $1a388, $1d1c6, $1a384, $1a382, $147a0, $1a3d8, $1d1ee, $14790,
+ $1a3cc, $14788, $1a3c6, $14784, $14782, $147d8, $1a3ee, $147cc,
+ $147c6, $147ee, $1e850, $1f42c, $1e848, $1f426, $1e844, $1e842,
+ $1d0d0, $1e86c, $1d0c8, $1e866, $1d0c4, $1d0c2, $1a1d0, $1d0ec,
+ $1a1c8, $1d0e6, $1a1c4, $1a1c2, $143d0, $1a1ec, $143c8, $1a1e6,
+ $143c4, $143c2, $143ec, $143e6, $1e828, $1f416, $1e824, $1e822,
+ $1d068, $1e836, $1d064, $1d062, $1a0e8, $1d076, $1a0e4, $1a0e2,
+ $141e8, $1a0f6, $141e4, $141e2, $1e814, $1e812, $1d034, $1d032,
+ $1a074, $1a072, $1e540, $1f2b0, $1f95c, $1e520, $1f298, $1f94e,
+ $1e510, $1f28c, $1e508, $1f286, $1e504, $1e502, $1cb40, $1e5b0,
+ $1f2dc, $1cb20, $1e598, $1f2ce, $1cb10, $1e58c, $1cb08, $1e586,
+ $1cb04, $1cb02, $19740, $1cbb0, $1e5dc, $19720, $1cb98, $1e5ce,
+ $19710, $1cb8c, $19708, $1cb86, $19704, $19702, $12f40, $197b0,
+ $1cbdc, $12f20, $19798, $1cbce, $12f10, $1978c, $12f08, $19786,
+ $12f04, $12fb0, $197dc, $12f98, $197ce, $12f8c, $12f86, $12fdc,
+ $12fce, $1f6a0, $1fb58, $16bf0, $1f690, $1fb4c, $169f8, $1f688,
+ $1fb46, $168fc, $1f684, $1f682, $1e4a0, $1f258, $1f92e, $1eda0,
+ $1e490, $1fb6e, $1ed90, $1f6cc, $1f246, $1ed88, $1e484, $1ed84,
+ $1e482, $1ed82, $1c9a0, $1e4d8, $1f26e, $1dba0, $1c990, $1e4cc,
+ $1db90, $1edcc, $1e4c6, $1db88, $1c984, $1db84, $1c982, $1db82,
+ $193a0, $1c9d8, $1e4ee, $1b7a0, $19390, $1c9cc, $1b790, $1dbcc,
+ $1c9c6, $1b788, $19384, $1b784, $19382, $1b782, $127a0, $193d8,
+ $1c9ee, $16fa0, $12790, $193cc, $16f90, $1b7cc, $193c6, $16f88,
+ $12784, $16f84, $12782, $127d8, $193ee, $16fd8, $127cc, $16fcc,
+ $127c6, $16fc6, $127ee, $1f650, $1fb2c, $165f8, $1f648, $1fb26,
+ $164fc, $1f644, $1647e, $1f642, $1e450, $1f22c, $1ecd0, $1e448,
+ $1f226, $1ecc8, $1f666, $1ecc4, $1e442, $1ecc2, $1c8d0, $1e46c,
+ $1d9d0, $1c8c8, $1e466, $1d9c8, $1ece6, $1d9c4, $1c8c2, $1d9c2,
+ $191d0, $1c8ec, $1b3d0, $191c8, $1c8e6, $1b3c8, $1d9e6, $1b3c4,
+ $191c2, $1b3c2, $123d0, $191ec, $167d0, $123c8, $191e6, $167c8,
+ $1b3e6, $167c4, $123c2, $167c2, $123ec, $167ec, $123e6, $167e6,
+ $1f628, $1fb16, $162fc, $1f624, $1627e, $1f622, $1e428, $1f216,
+ $1ec68, $1f636, $1ec64, $1e422, $1ec62, $1c868, $1e436, $1d8e8,
+ $1c864, $1d8e4, $1c862, $1d8e2, $190e8, $1c876, $1b1e8, $1d8f6,
+ $1b1e4, $190e2, $1b1e2, $121e8, $190f6, $163e8, $121e4, $163e4,
+ $121e2, $163e2, $121f6, $163f6, $1f614, $1617e, $1f612, $1e414,
+ $1ec34, $1e412, $1ec32, $1c834, $1d874, $1c832, $1d872, $19074,
+ $1b0f4, $19072, $1b0f2, $120f4, $161f4, $120f2, $161f2, $1f60a,
+ $1e40a, $1ec1a, $1c81a, $1d83a, $1903a, $1b07a, $1e2a0, $1f158,
+ $1f8ae, $1e290, $1f14c, $1e288, $1f146, $1e284, $1e282, $1c5a0,
+ $1e2d8, $1f16e, $1c590, $1e2cc, $1c588, $1e2c6, $1c584, $1c582,
+ $18ba0, $1c5d8, $1e2ee, $18b90, $1c5cc, $18b88, $1c5c6, $18b84,
+ $18b82, $117a0, $18bd8, $1c5ee, $11790, $18bcc, $11788, $18bc6,
+ $11784, $11782, $117d8, $18bee, $117cc, $117c6, $117ee, $1f350,
+ $1f9ac, $135f8, $1f348, $1f9a6, $134fc, $1f344, $1347e, $1f342,
+ $1e250, $1f12c, $1e6d0, $1e248, $1f126, $1e6c8, $1f366, $1e6c4,
+ $1e242, $1e6c2, $1c4d0, $1e26c, $1cdd0, $1c4c8, $1e266, $1cdc8,
+ $1e6e6, $1cdc4, $1c4c2, $1cdc2, $189d0, $1c4ec, $19bd0, $189c8,
+ $1c4e6, $19bc8, $1cde6, $19bc4, $189c2, $19bc2, $113d0, $189ec,
+ $137d0, $113c8, $189e6, $137c8, $19be6, $137c4, $113c2, $137c2,
+ $113ec, $137ec, $113e6, $137e6, $1fba8, $175f0, $1bafc, $1fba4,
+ $174f8, $1ba7e, $1fba2, $1747c, $1743e, $1f328, $1f996, $132fc,
+ $1f768, $1fbb6, $176fc, $1327e, $1f764, $1f322, $1767e, $1f762,
+ $1e228, $1f116, $1e668, $1e224, $1eee8, $1f776, $1e222, $1eee4,
+ $1e662, $1eee2, $1c468, $1e236, $1cce8, $1c464, $1dde8, $1cce4,
+ $1c462, $1dde4, $1cce2, $1dde2, $188e8, $1c476, $199e8, $188e4,
+ $1bbe8, $199e4, $188e2, $1bbe4, $199e2, $1bbe2, $111e8, $188f6,
+ $133e8, $111e4, $177e8, $133e4, $111e2, $177e4, $133e2, $177e2,
+ $111f6, $133f6, $1fb94, $172f8, $1b97e, $1fb92, $1727c, $1723e,
+ $1f314, $1317e, $1f734, $1f312, $1737e, $1f732, $1e214, $1e634,
+ $1e212, $1ee74, $1e632, $1ee72, $1c434, $1cc74, $1c432, $1dcf4,
+ $1cc72, $1dcf2, $18874, $198f4, $18872, $1b9f4, $198f2, $1b9f2,
+ $110f4, $131f4, $110f2, $173f4, $131f2, $173f2, $1fb8a, $1717c,
+ $1713e, $1f30a, $1f71a, $1e20a, $1e61a, $1ee3a, $1c41a, $1cc3a,
+ $1dc7a, $1883a, $1987a, $1b8fa, $1107a, $130fa, $171fa, $170be,
+ $1e150, $1f0ac, $1e148, $1f0a6, $1e144, $1e142, $1c2d0, $1e16c,
+ $1c2c8, $1e166, $1c2c4, $1c2c2, $185d0, $1c2ec, $185c8, $1c2e6,
+ $185c4, $185c2, $10bd0, $185ec, $10bc8, $185e6, $10bc4, $10bc2,
+ $10bec, $10be6, $1f1a8, $1f8d6, $11afc, $1f1a4, $11a7e, $1f1a2,
+ $1e128, $1f096, $1e368, $1e124, $1e364, $1e122, $1e362, $1c268,
+ $1e136, $1c6e8, $1c264, $1c6e4, $1c262, $1c6e2, $184e8, $1c276,
+ $18de8, $184e4, $18de4, $184e2, $18de2, $109e8, $184f6, $11be8,
+ $109e4, $11be4, $109e2, $11be2, $109f6, $11bf6, $1f9d4, $13af8,
+ $19d7e, $1f9d2, $13a7c, $13a3e, $1f194, $1197e, $1f3b4, $1f192,
+ $13b7e, $1f3b2, $1e114, $1e334, $1e112, $1e774, $1e332, $1e772,
+ $1c234, $1c674, $1c232, $1cef4, $1c672, $1cef2, $18474, $18cf4,
+ $18472, $19df4, $18cf2, $19df2, $108f4, $119f4, $108f2, $13bf4,
+ $119f2, $13bf2, $17af0, $1bd7c, $17a78, $1bd3e, $17a3c, $17a1e,
+ $1f9ca, $1397c, $1fbda, $17b7c, $1393e, $17b3e, $1f18a, $1f39a,
+ $1f7ba, $1e10a, $1e31a, $1e73a, $1ef7a, $1c21a, $1c63a, $1ce7a,
+ $1defa, $1843a, $18c7a, $19cfa, $1bdfa, $1087a, $118fa, $139fa,
+ $17978, $1bcbe, $1793c, $1791e, $138be, $179be, $178bc, $1789e,
+ $1785e, $1e0a8, $1e0a4, $1e0a2, $1c168, $1e0b6, $1c164, $1c162,
+ $182e8, $1c176, $182e4, $182e2, $105e8, $182f6, $105e4, $105e2,
+ $105f6, $1f0d4, $10d7e, $1f0d2, $1e094, $1e1b4, $1e092, $1e1b2,
+ $1c134, $1c374, $1c132, $1c372, $18274, $186f4, $18272, $186f2,
+ $104f4, $10df4, $104f2, $10df2, $1f8ea, $11d7c, $11d3e, $1f0ca,
+ $1f1da, $1e08a, $1e19a, $1e3ba, $1c11a, $1c33a, $1c77a, $1823a,
+ $1867a, $18efa, $1047a, $10cfa, $11dfa, $13d78, $19ebe, $13d3c,
+ $13d1e, $11cbe, $13dbe, $17d70, $1bebc, $17d38, $1be9e, $17d1c,
+ $17d0e, $13cbc, $17dbc, $13c9e, $17d9e, $17cb8, $1be5e, $17c9c,
+ $17c8e, $13c5e, $17cde, $17c5c, $17c4e, $17c2e, $1c0b4, $1c0b2,
+ $18174, $18172, $102f4, $102f2, $1e0da, $1c09a, $1c1ba, $1813a,
+ $1837a, $1027a, $106fa, $10ebe, $11ebc, $11e9e, $13eb8, $19f5e,
+ $13e9c, $13e8e, $11e5e, $13ede, $17eb0, $1bf5c, $17e98, $1bf4e,
+ $17e8c, $17e86, $13e5c, $17edc, $13e4e, $17ece, $17e58, $1bf2e,
+ $17e4c, $17e46, $13e2e, $17e6e, $17e2c, $17e26, $10f5e, $11f5c,
+ $11f4e, $13f58, $19fae, $13f4c, $13f46, $11f2e, $13f6e, $13f2c,
+ $13f26
+ ),
+ (
+ $1abe0, $1d5f8, $153c0, $1a9f0, $1d4fc, $151e0, $1a8f8, $1d47e,
+ $150f0, $1a87c, $15078, $1fad0, $15be0, $1adf8, $1fac8, $159f0,
+ $1acfc, $1fac4, $158f8, $1ac7e, $1fac2, $1587c, $1f5d0, $1faec,
+ $15df8, $1f5c8, $1fae6, $15cfc, $1f5c4, $15c7e, $1f5c2, $1ebd0,
+ $1f5ec, $1ebc8, $1f5e6, $1ebc4, $1ebc2, $1d7d0, $1ebec, $1d7c8,
+ $1ebe6, $1d7c4, $1d7c2, $1afd0, $1d7ec, $1afc8, $1d7e6, $1afc4,
+ $14bc0, $1a5f0, $1d2fc, $149e0, $1a4f8, $1d27e, $148f0, $1a47c,
+ $14878, $1a43e, $1483c, $1fa68, $14df0, $1a6fc, $1fa64, $14cf8,
+ $1a67e, $1fa62, $14c7c, $14c3e, $1f4e8, $1fa76, $14efc, $1f4e4,
+ $14e7e, $1f4e2, $1e9e8, $1f4f6, $1e9e4, $1e9e2, $1d3e8, $1e9f6,
+ $1d3e4, $1d3e2, $1a7e8, $1d3f6, $1a7e4, $1a7e2, $145e0, $1a2f8,
+ $1d17e, $144f0, $1a27c, $14478, $1a23e, $1443c, $1441e, $1fa34,
+ $146f8, $1a37e, $1fa32, $1467c, $1463e, $1f474, $1477e, $1f472,
+ $1e8f4, $1e8f2, $1d1f4, $1d1f2, $1a3f4, $1a3f2, $142f0, $1a17c,
+ $14278, $1a13e, $1423c, $1421e, $1fa1a, $1437c, $1433e, $1f43a,
+ $1e87a, $1d0fa, $14178, $1a0be, $1413c, $1411e, $141be, $140bc,
+ $1409e, $12bc0, $195f0, $1cafc, $129e0, $194f8, $1ca7e, $128f0,
+ $1947c, $12878, $1943e, $1283c, $1f968, $12df0, $196fc, $1f964,
+ $12cf8, $1967e, $1f962, $12c7c, $12c3e, $1f2e8, $1f976, $12efc,
+ $1f2e4, $12e7e, $1f2e2, $1e5e8, $1f2f6, $1e5e4, $1e5e2, $1cbe8,
+ $1e5f6, $1cbe4, $1cbe2, $197e8, $1cbf6, $197e4, $197e2, $1b5e0,
+ $1daf8, $1ed7e, $169c0, $1b4f0, $1da7c, $168e0, $1b478, $1da3e,
+ $16870, $1b43c, $16838, $1b41e, $1681c, $125e0, $192f8, $1c97e,
+ $16de0, $124f0, $1927c, $16cf0, $1b67c, $1923e, $16c78, $1243c,
+ $16c3c, $1241e, $16c1e, $1f934, $126f8, $1937e, $1fb74, $1f932,
+ $16ef8, $1267c, $1fb72, $16e7c, $1263e, $16e3e, $1f274, $1277e,
+ $1f6f4, $1f272, $16f7e, $1f6f2, $1e4f4, $1edf4, $1e4f2, $1edf2,
+ $1c9f4, $1dbf4, $1c9f2, $1dbf2, $193f4, $193f2, $165c0, $1b2f0,
+ $1d97c, $164e0, $1b278, $1d93e, $16470, $1b23c, $16438, $1b21e,
+ $1641c, $1640e, $122f0, $1917c, $166f0, $12278, $1913e, $16678,
+ $1b33e, $1663c, $1221e, $1661e, $1f91a, $1237c, $1fb3a, $1677c,
+ $1233e, $1673e, $1f23a, $1f67a, $1e47a, $1ecfa, $1c8fa, $1d9fa,
+ $191fa, $162e0, $1b178, $1d8be, $16270, $1b13c, $16238, $1b11e,
+ $1621c, $1620e, $12178, $190be, $16378, $1213c, $1633c, $1211e,
+ $1631e, $121be, $163be, $16170, $1b0bc, $16138, $1b09e, $1611c,
+ $1610e, $120bc, $161bc, $1209e, $1619e, $160b8, $1b05e, $1609c,
+ $1608e, $1205e, $160de, $1605c, $1604e, $115e0, $18af8, $1c57e,
+ $114f0, $18a7c, $11478, $18a3e, $1143c, $1141e, $1f8b4, $116f8,
+ $18b7e, $1f8b2, $1167c, $1163e, $1f174, $1177e, $1f172, $1e2f4,
+ $1e2f2, $1c5f4, $1c5f2, $18bf4, $18bf2, $135c0, $19af0, $1cd7c,
+ $134e0, $19a78, $1cd3e, $13470, $19a3c, $13438, $19a1e, $1341c,
+ $1340e, $112f0, $1897c, $136f0, $11278, $1893e, $13678, $19b3e,
+ $1363c, $1121e, $1361e, $1f89a, $1137c, $1f9ba, $1377c, $1133e,
+ $1373e, $1f13a, $1f37a, $1e27a, $1e6fa, $1c4fa, $1cdfa, $189fa,
+ $1bae0, $1dd78, $1eebe, $174c0, $1ba70, $1dd3c, $17460, $1ba38,
+ $1dd1e, $17430, $1ba1c, $17418, $1ba0e, $1740c, $132e0, $19978,
+ $1ccbe, $176e0, $13270, $1993c, $17670, $1bb3c, $1991e, $17638,
+ $1321c, $1761c, $1320e, $1760e, $11178, $188be, $13378, $1113c,
+ $17778, $1333c, $1111e, $1773c, $1331e, $1771e, $111be, $133be,
+ $177be, $172c0, $1b970, $1dcbc, $17260, $1b938, $1dc9e, $17230,
+ $1b91c, $17218, $1b90e, $1720c, $17206, $13170, $198bc, $17370,
+ $13138, $1989e, $17338, $1b99e, $1731c, $1310e, $1730e, $110bc,
+ $131bc, $1109e, $173bc, $1319e, $1739e, $17160, $1b8b8, $1dc5e,
+ $17130, $1b89c, $17118, $1b88e, $1710c, $17106, $130b8, $1985e,
+ $171b8, $1309c, $1719c, $1308e, $1718e, $1105e, $130de, $171de,
+ $170b0, $1b85c, $17098, $1b84e, $1708c, $17086, $1305c, $170dc,
+ $1304e, $170ce, $17058, $1b82e, $1704c, $17046, $1302e, $1706e,
+ $1702c, $17026, $10af0, $1857c, $10a78, $1853e, $10a3c, $10a1e,
+ $10b7c, $10b3e, $1f0ba, $1e17a, $1c2fa, $185fa, $11ae0, $18d78,
+ $1c6be, $11a70, $18d3c, $11a38, $18d1e, $11a1c, $11a0e, $10978,
+ $184be, $11b78, $1093c, $11b3c, $1091e, $11b1e, $109be, $11bbe,
+ $13ac0, $19d70, $1cebc, $13a60, $19d38, $1ce9e, $13a30, $19d1c,
+ $13a18, $19d0e, $13a0c, $13a06, $11970, $18cbc, $13b70, $11938,
+ $18c9e, $13b38, $1191c, $13b1c, $1190e, $13b0e, $108bc, $119bc,
+ $1089e, $13bbc, $1199e, $13b9e, $1bd60, $1deb8, $1ef5e, $17a40,
+ $1bd30, $1de9c, $17a20, $1bd18, $1de8e, $17a10, $1bd0c, $17a08,
+ $1bd06, $17a04, $13960, $19cb8, $1ce5e, $17b60, $13930, $19c9c,
+ $17b30, $1bd9c, $19c8e, $17b18, $1390c, $17b0c, $13906, $17b06,
+ $118b8, $18c5e, $139b8, $1189c, $17bb8, $1399c, $1188e, $17b9c,
+ $1398e, $17b8e, $1085e, $118de, $139de, $17bde, $17940, $1bcb0,
+ $1de5c, $17920, $1bc98, $1de4e, $17910, $1bc8c, $17908, $1bc86,
+ $17904, $17902, $138b0, $19c5c, $179b0, $13898, $19c4e, $17998,
+ $1bcce, $1798c, $13886, $17986, $1185c, $138dc, $1184e, $179dc,
+ $138ce, $179ce, $178a0, $1bc58, $1de2e, $17890, $1bc4c, $17888,
+ $1bc46, $17884, $17882, $13858, $19c2e, $178d8, $1384c, $178cc,
+ $13846, $178c6, $1182e, $1386e, $178ee, $17850, $1bc2c, $17848,
+ $1bc26, $17844, $17842, $1382c, $1786c, $13826, $17866, $17828,
+ $1bc16, $17824, $17822, $13816, $17836, $10578, $182be, $1053c,
+ $1051e, $105be, $10d70, $186bc, $10d38, $1869e, $10d1c, $10d0e,
+ $104bc, $10dbc, $1049e, $10d9e, $11d60, $18eb8, $1c75e, $11d30,
+ $18e9c, $11d18, $18e8e, $11d0c, $11d06, $10cb8, $1865e, $11db8,
+ $10c9c, $11d9c, $10c8e, $11d8e, $1045e, $10cde, $11dde, $13d40,
+ $19eb0, $1cf5c, $13d20, $19e98, $1cf4e, $13d10, $19e8c, $13d08,
+ $19e86, $13d04, $13d02, $11cb0, $18e5c, $13db0, $11c98, $18e4e,
+ $13d98, $19ece, $13d8c, $11c86, $13d86, $10c5c, $11cdc, $10c4e,
+ $13ddc, $11cce, $13dce, $1bea0, $1df58, $1efae, $1be90, $1df4c,
+ $1be88, $1df46, $1be84, $1be82, $13ca0, $19e58, $1cf2e, $17da0,
+ $13c90, $19e4c, $17d90, $1becc, $19e46, $17d88, $13c84, $17d84,
+ $13c82, $17d82, $11c58, $18e2e, $13cd8, $11c4c, $17dd8, $13ccc,
+ $11c46, $17dcc, $13cc6, $17dc6, $10c2e, $11c6e, $13cee, $17dee,
+ $1be50, $1df2c, $1be48, $1df26, $1be44, $1be42, $13c50, $19e2c,
+ $17cd0, $13c48, $19e26, $17cc8, $1be66, $17cc4, $13c42, $17cc2,
+ $11c2c, $13c6c, $11c26, $17cec, $13c66, $17ce6, $1be28, $1df16,
+ $1be24, $1be22, $13c28, $19e16, $17c68, $13c24, $17c64, $13c22,
+ $17c62, $11c16, $13c36, $17c76, $1be14, $1be12, $13c14, $17c34,
+ $13c12, $17c32, $102bc, $1029e, $106b8, $1835e, $1069c, $1068e,
+ $1025e, $106de, $10eb0, $1875c, $10e98, $1874e, $10e8c, $10e86,
+ $1065c, $10edc, $1064e, $10ece, $11ea0, $18f58, $1c7ae, $11e90,
+ $18f4c, $11e88, $18f46, $11e84, $11e82, $10e58, $1872e, $11ed8,
+ $18f6e, $11ecc, $10e46, $11ec6, $1062e, $10e6e, $11eee, $19f50,
+ $1cfac, $19f48, $1cfa6, $19f44, $19f42, $11e50, $18f2c, $13ed0,
+ $19f6c, $18f26, $13ec8, $11e44, $13ec4, $11e42, $13ec2, $10e2c,
+ $11e6c, $10e26, $13eec, $11e66, $13ee6, $1dfa8, $1efd6, $1dfa4,
+ $1dfa2, $19f28, $1cf96, $1bf68, $19f24, $1bf64, $19f22, $1bf62,
+ $11e28, $18f16, $13e68, $11e24, $17ee8, $13e64, $11e22, $17ee4,
+ $13e62, $17ee2, $10e16, $11e36, $13e76, $17ef6, $1df94, $1df92,
+ $19f14, $1bf34, $19f12, $1bf32, $11e14, $13e34, $11e12, $17e74,
+ $13e32, $17e72, $1df8a, $19f0a, $1bf1a, $11e0a, $13e1a, $17e3a,
+ $1035c, $1034e, $10758, $183ae, $1074c, $10746, $1032e, $1076e,
+ $10f50, $187ac, $10f48, $187a6, $10f44, $10f42, $1072c, $10f6c,
+ $10726, $10f66, $18fa8, $1c7d6, $18fa4, $18fa2, $10f28, $18796,
+ $11f68, $18fb6, $11f64, $10f22, $11f62, $10716, $10f36, $11f76,
+ $1cfd4, $1cfd2, $18f94, $19fb4, $18f92, $19fb2, $10f14, $11f34,
+ $10f12, $13f74, $11f32, $13f72, $1cfca, $18f8a, $19f9a, $10f0a,
+ $11f1a, $13f3a, $103ac, $103a6, $107a8, $183d6, $107a4, $107a2,
+ $10396, $107b6, $187d4, $187d2, $10794, $10fb4, $10792, $10fb2,
+ $1c7ea
+ ));
+
+ ERRLVL0 : array[0..1] of integer = ( 27, 917 );
+ ERRLVL1 : array[0..3] of integer = ( 522, 568, 723, 809 );
+ ERRLVL2 : array[0..7] of integer = ( 237, 308, 436, 284, 646, 653, 428, 379 );
+ ERRLVL3: array[0..15] of integer = ( 274, 562, 232, 755, 599, 524, 801, 132, 295, 116, 442, 428, 295, 42, 176, 65 );
+ ERRLVL4 : array[0..31] of integer = ( 361, 575, 922, 525, 176, 586, 640, 321, 536, 742, 677, 742, 687, 284, 193, 517,
+ 273, 494, 263, 147, 593, 800, 571, 320, 803, 133, 231, 390, 685, 330, 63, 410 );
+ ERRLVL5 : array[0..63] of integer = (
+ 539, 422, 6, 93, 862, 771, 453, 106, 610, 287, 107, 505, 733, 877, 381, 612,
+ 723, 476, 462, 172, 430, 609, 858, 822, 543, 376, 511, 400, 672, 762, 283, 184,
+ 440, 35, 519, 31, 460, 594, 225, 535, 517, 352, 605, 158, 651, 201, 488, 502,
+ 648, 733, 717, 83, 404, 97, 280, 771, 840, 629, 4, 381, 843, 623, 264, 543 );
+ ERRLVL6 : array[0..127] of integer = (
+ 521, 310, 864, 547, 858, 580, 296, 379, 53, 779, 897, 444, 400, 925, 749, 415,
+ 822, 93, 217, 208, 928, 244, 583, 620, 246, 148, 447, 631, 292, 908, 490, 704,
+ 516, 258, 457, 907, 594, 723, 674, 292, 272, 96, 684, 432, 686, 606, 860, 569,
+ 193, 219, 129, 186, 236, 287, 192, 775, 278, 173, 40, 379, 712, 463, 646, 776,
+ 171, 491, 297, 763, 156, 732, 95, 270, 447, 90, 507, 48, 228, 821, 808, 898,
+ 784, 663, 627, 378, 382, 262, 380, 602, 754, 336, 89, 614, 87, 432, 670, 616,
+ 157, 374, 242, 726, 600, 269, 375, 898, 845, 454, 354, 130, 814, 587, 804, 34,
+ 211, 330, 539, 297, 827, 865, 37, 517, 834, 315, 550, 86, 801, 4, 108, 539 );
+ ERRLVL7 : array[0..255] of integer = (
+ 524, 894, 75, 766, 882, 857, 74, 204, 82, 586, 708, 250, 905, 786, 138, 720,
+ 858, 194, 311, 913, 275, 190, 375, 850, 438, 733, 194, 280, 201, 280, 828, 757,
+ 710, 814, 919, 89, 68, 569, 11, 204, 796, 605, 540, 913, 801, 700, 799, 137,
+ 439, 418, 592, 668, 353, 859, 370, 694, 325, 240, 216, 257, 284, 549, 209, 884,
+ 315, 70, 329, 793, 490, 274, 877, 162, 749, 812, 684, 461, 334, 376, 849, 521,
+ 307, 291, 803, 712, 19, 358, 399, 908, 103, 511, 51, 8, 517, 225, 289, 470,
+ 637, 731, 66, 255, 917, 269, 463, 830, 730, 433, 848, 585, 136, 538, 906, 90,
+ 2, 290, 743, 199, 655, 903, 329, 49, 802, 580, 355, 588, 188, 462, 10, 134,
+ 628, 320, 479, 130, 739, 71, 263, 318, 374, 601, 192, 605, 142, 673, 687, 234,
+ 722, 384, 177, 752, 607, 640, 455, 193, 689, 707, 805, 641, 48, 60, 732, 621,
+ 895, 544, 261, 852, 655, 309, 697, 755, 756, 60, 231, 773, 434, 421, 726, 528,
+ 503, 118, 49, 795, 32, 144, 500, 238, 836, 394, 280, 566, 319, 9, 647, 550,
+ 73, 914, 342, 126, 32, 681, 331, 792, 620, 60, 609, 441, 180, 791, 893, 754,
+ 605, 383, 228, 749, 760, 213, 54, 297, 134, 54, 834, 299, 922, 191, 910, 532,
+ 609, 829, 189, 20, 167, 29, 872, 449, 83, 402, 41, 656, 505, 579, 481, 173,
+ 404, 251, 688, 95, 497, 555, 642, 543, 307, 159, 924, 558, 648, 55, 497, 10 );
+ ERRLVL8 : array[0..511] of integer = (
+ 352, 77, 373, 504, 35, 599, 428, 207, 409, 574, 118, 498, 285, 380, 350, 492,
+ 197, 265, 920, 155, 914, 299, 229, 643, 294, 871, 306, 88, 87, 193, 352, 781,
+ 846, 75, 327, 520, 435, 543, 203, 666, 249, 346, 781, 621, 640, 268, 794, 534,
+ 539, 781, 408, 390, 644, 102, 476, 499, 290, 632, 545, 37, 858, 916, 552, 41,
+ 542, 289, 122, 272, 383, 800, 485, 98, 752, 472, 761, 107, 784, 860, 658, 741,
+ 290, 204, 681, 407, 855, 85, 99, 62, 482, 180, 20, 297, 451, 593, 913, 142,
+ 808, 684, 287, 536, 561, 76, 653, 899, 729, 567, 744, 390, 513, 192, 516, 258,
+ 240, 518, 794, 395, 768, 848, 51, 610, 384, 168, 190, 826, 328, 596, 786, 303,
+ 570, 381, 415, 641, 156, 237, 151, 429, 531, 207, 676, 710, 89, 168, 304, 402,
+ 40, 708, 575, 162, 864, 229, 65, 861, 841, 512, 164, 477, 221, 92, 358, 785,
+ 288, 357, 850, 836, 827, 736, 707, 94, 8, 494, 114, 521, 2, 499, 851, 543,
+ 152, 729, 771, 95, 248, 361, 578, 323, 856, 797, 289, 51, 684, 466, 533, 820,
+ 669, 45, 902, 452, 167, 342, 244, 173, 35, 463, 651, 51, 699, 591, 452, 578,
+ 37, 124, 298, 332, 552, 43, 427, 119, 662, 777, 475, 850, 764, 364, 578, 911,
+ 283, 711, 472, 420, 245, 288, 594, 394, 511, 327, 589, 777, 699, 688, 43, 408,
+ 842, 383, 721, 521, 560, 644, 714, 559, 62, 145, 873, 663, 713, 159, 672, 729,
+ 624, 59, 193, 417, 158, 209, 563, 564, 343, 693, 109, 608, 563, 365, 181, 772,
+ 677, 310, 248, 353, 708, 410, 579, 870, 617, 841, 632, 860, 289, 536, 35, 777,
+ 618, 586, 424, 833, 77, 597, 346, 269, 757, 632, 695, 751, 331, 247, 184, 45,
+ 787, 680, 18, 66, 407, 369, 54, 492, 228, 613, 830, 922, 437, 519, 644, 905,
+ 789, 420, 305, 441, 207, 300, 892, 827, 141, 537, 381, 662, 513, 56, 252, 341,
+ 242, 797, 838, 837, 720, 224, 307, 631, 61, 87, 560, 310, 756, 665, 397, 808,
+ 851, 309, 473, 795, 378, 31, 647, 915, 459, 806, 590, 731, 425, 216, 548, 249,
+ 321, 881, 699, 535, 673, 782, 210, 815, 905, 303, 843, 922, 281, 73, 469, 791,
+ 660, 162, 498, 308, 155, 422, 907, 817, 187, 62, 16, 425, 535, 336, 286, 437,
+ 375, 273, 610, 296, 183, 923, 116, 667, 751, 353, 62, 366, 691, 379, 687, 842,
+ 37, 357, 720, 742, 330, 5, 39, 923, 311, 424, 242, 749, 321, 54, 669, 316,
+ 342, 299, 534, 105, 667, 488, 640, 672, 576, 540, 316, 486, 721, 610, 46, 656,
+ 447, 171, 616, 464, 190, 531, 297, 321, 762, 752, 533, 175, 134, 14, 381, 433,
+ 717, 45, 111, 20, 596, 284, 736, 138, 646, 411, 877, 669, 141, 919, 45, 780,
+ 407, 164, 332, 899, 165, 726, 600, 325, 498, 655, 357, 752, 768, 223, 849, 647,
+ 63, 310, 863, 251, 366, 304, 282, 738, 675, 410, 389, 244, 31, 121, 303, 263 );
+
+
+
+ ERROR_LEVEL : array[0..8] of PInt = ( @ERRLVL0, @ERRLVL1, @ERRLVL2, @ERRLVL3, @ERRLVL4, @ERRLVL5, @ERRLVL6, @ERRLVL7, @ERRLVL8 );
+
+
+type
+
+ /// Specifies the error correction level used for PDF417 barcode.
+ PDF417ErrorCorrection =
+ (
+ AutoCorr,
+ Level0,
+ Level1,
+ Level2,
+ Level3,
+ Level4,
+ Level5,
+ Level6,
+ Level7,
+ Level8
+ );
+
+ /// Specifies the compaction mode used for PDF417 barcode.
+ PDF417CompactionMode =
+ (
+ AutoCompaction,
+ TextComp,
+ Numeric,
+ Binary
+ );
+
+ Segment = class
+
+ public
+
+ _type : char;
+ _start,
+ _end : integer;
+
+ constructor Create( _t : char; _s, _e : integer);
+
+ end;
+
+
+ TSegmentList = class
+
+ public
+
+ list : TList;
+
+ constructor Create;
+ destructor Destroy; override;
+ procedure Add(_type: char; _start,_end : integer);
+ function Get(idx : integer) : Segment;
+ procedure Remove( idx : integer);
+ function Size : integer;
+
+ end;
+
+
+
+
+ ///
+ /// Generates the 2D PDF417 barcode.
+ ///
+ /// This example shows how to configure the BarcodeObject to display PDF417 barcode.
+ ///
+ /// BarcodeObject barcode;
+ /// ...
+ /// barcode.Barcode = new BarcodePDF417();
+ /// (barcode.Barcode as BarcodePDF417).CompactionMode = PDF417CompactionMode.Text;
+ ///
+ ///
+ TfrxBarcodePDF417 = class(TfrxBarcode2DBase)
+
+ private
+
+ codeColumns,
+ FRows,
+ FColumns : integer;
+ codewords : array[0 .. MAX_DATA_CODEWORDS + 1] of integer;
+ lenCodewords,
+ errorLevel : integer;
+ FErrorCorrection : PDF417ErrorCorrection;
+ FCompactionMode : PDF417CompactionMode;
+ bytes : TBytes;
+ FAspectRatio : Double;
+ FCodePage,
+ bitPtr,
+ cwPtr : integer;
+ segmentList : TSegmentList;
+
+ function CheckSegmentType( var segm : Segment; typ : char) : boolean;
+ function GetSegmentLength( var segm : Segment ) : integer;
+ procedure OutCodeword17( codeword : integer);
+ procedure OutCodeword18( codeword : integer);
+ procedure OutCodeword( codeword : integer );
+ procedure OutStopPattern;
+ procedure OutStartPattern;
+ procedure OutPaintCode;
+ procedure CalculateErrorCorrection(dest : integer);
+ function GetTextTypeAndValue( var input : TBytes; maxLength, idx : integer ) : integer; overload;
+ function GetTextTypeAndValue(maxLength, idx : integer) : integer; overload;
+ procedure TextCompaction(var input : TBytes; start, length : integer); overload;
+ procedure TextCompaction( start, length : integer); overload;
+ procedure BasicNumberCompaction(var input : TBytes; start, length : integer); overload;
+ procedure NumberCompaction(var input : TBytes; start,length : integer); overload;
+ procedure NumberCompaction( start, length : integer); overload;
+ procedure ByteCompaction6( start : integer );
+ procedure ByteCompaction( start, length : integer);
+ procedure BreakString;
+ procedure Assemble;
+ function MaxPossibleErrorLevel( remain: integer) : integer;
+ function GetMaxSquare : integer;
+ procedure PaintCode;
+ procedure Initialize;
+
+ procedure SetAspectRatio(v : Double);
+ procedure SetColumns(v : integer);
+ procedure SetRows(v : integer);
+ procedure SetErrorCorrection(v : PDF417ErrorCorrection);
+ procedure SetCodePage(v : integer);
+ procedure SetCompactionMode(v : PDF417CompactionMode);
+ protected
+ procedure SetText(v : string); override;
+ function CalcBounds : TSize;
+ public
+ procedure Assign( source : TfrxBarcode2DBase ); override;
+// procedure Draw2DBarcode(var g : TCanvas; scalex, scaley : extended; x, y : integer ); override;
+ constructor Create; override;
+ destructor Destroy; override;
+
+ published
+
+ /// Gets or sets the barcode aspect ratio.
+ /// A ratio or 0.5 will make the barcode width twice as large as the height.
+ property AspectRatio : Double read FAspectRatio write SetAspectRatio;
+ /// Gets or sets the number of barcode data columns.
+ /// To calculate the necessary number of columns and rows, set the
+ /// and properties to 0. In this case, the property
+ /// should be set to desired aspect ratio.
+ property Columns : integer read FColumns write SetColumns;
+ /// Gets or sets the number of barcode data rows.
+ /// To calculate the necessary number of columns and rows, set the
+ /// and properties to 0. In this case, the property
+ /// should be set to desired aspect ratio.
+ property Rows : integer read FRows write SetRows;
+ /// Gets or sets the error level correction used for the barcode.
+ // [DefaultValue(PDF417ErrorCorrection.Auto)]
+ property ErrorCorrection : PDF417ErrorCorrection read FErrorCorrection write SetErrorCorrection;
+ /// Gets or sets the code page used for text conversion.
+ /// Use this property to encode non-ASCII characters. For example, set this
+ /// property to 1251 to use Window CP1251.
+ /// [DefaultValue(437)]
+ property CodePage : integer read FCodePage write SetCodePage;
+ /// Gets or sets the compaction mode.
+ /// [DefaultValue(PDF417CompactionMode.Auto)]
+ property CompactionMode : PDF417CompactionMode read FCompactionMode write SetCompactionMode;
+ /// Gets or sets the size of the pixel.
+
+end;
+
+implementation
+
+
+procedure TfrxBarcodePDF417.SetText(v : string);
+begin
+ if( FText <> v) then
+ begin
+ FText := v;
+ Initialize;
+ end;
+end;
+procedure TfrxBarcodePDF417.SetAspectRatio(v : Double);
+begin
+ if v <> FAspectRatio then
+ begin
+ FAspectRatio := v;
+ Initialize;
+ end;
+end;
+procedure TfrxBarcodePDF417.SetColumns(v : integer);
+begin
+ if v <> FColumns then
+ begin
+ FColumns := v;
+ Initialize;
+ end;
+end;
+procedure TfrxBarcodePDF417.SetRows(v : integer);
+begin
+ if v <> FRows then
+ begin
+ FRows := v;
+ Initialize;
+ end;
+end;
+procedure TfrxBarcodePDF417.SetErrorCorrection(v : PDF417ErrorCorrection);
+begin
+ if v <> FErrorCorrection then
+ begin
+ FErrorCorrection := v;
+ Initialize;
+ end;
+end;
+
+procedure TfrxBarcodePDF417.SetCodePage(v : integer);
+begin
+ if v <> FCodePage then
+ begin
+ FCodePage := v;
+ Initialize;
+ end;
+end;
+procedure TfrxBarcodePDF417.SetCompactionMode(v : PDF417CompactionMode);
+begin
+ if v <> FCompactionMode then
+ begin
+ FCompactionMode := v;
+ Initialize;
+ end;
+end;
+
+procedure TfrxBarcodePDF417.Initialize;
+var
+ e: TEncoding;
+begin
+ if (text = '') then
+ SetLength(bytes, 0)
+ else
+ begin
+ e := TEncoding.GetEncoding(FCodePage);
+ try
+ bytes := e.GetBytes(text);
+ finally
+ e.Free;
+ end;
+ end;
+
+ codeColumns := FColumns;
+ FHeight := FRows;
+ fillChar(codewords[0], (MAX_DATA_CODEWORDS + 1) * sizeof(integer), 0);
+ PaintCode();
+end;
+
+/// Initializes a new instance of the class with default settings.
+constructor TfrxBarcodePDF417.Create;
+begin
+ inherited;
+ FImage := nil;
+ SetLength( bytes, 0);
+ setlength(FImage, 0);
+
+ FPixelwidth := 2;
+ FPixelHeight := 8;
+ FAspectRatio := 0.5;
+ FCodePage := 437;
+ Columns := 0;
+ Rows := 0;
+ FCompactionMode := AutoCompaction;
+ Initialize;
+ end;
+
+destructor TfrxBarcodePDF417.Destroy;
+begin
+ SetLength(bytes, 0);
+ inherited;
+end;
+
+
+function TfrxBarcodePDF417.CalcBounds : TSize;
+var
+ textAdd : integer;
+begin
+ if ( ShowText ) then textAdd := 18 else textAdd := 0;
+ result.width := FWidth * PixelWidth;
+ result.height := FHeight * PixelHeight + textAdd;
+end;
+
+procedure TfrxBarcodePDF417.Assign( source : TfrxBarcode2DBase );
+var
+ src : TfrxBarcodePDF417;
+begin
+ inherited;
+ if source is TfrxBarcodePDF417 then
+ begin
+ src := source as TfrxBarcodePDF417;
+
+ AspectRatio := src.AspectRatio;
+ Columns := src.Columns;
+ Rows := src.Rows;
+ CodePage := src.CodePage;
+ CompactionMode := src.CompactionMode;
+ ErrorCorrection := src.ErrorCorrection;
+ end;
+end;
+
+//** Paints the barcode. If no exception was thrown a valid barcode is available. */
+procedure TfrxBarcodePDF417.PaintCode;
+var
+ maxErr, lenErr, tot, pad : integer;
+ fixedColumn, skipRowColAdjust : boolean;
+ c, b, yHeight : extended;
+begin
+ if (bytes = nil) then
+ raise Exception.Create('Text cannot be null.');
+ if (Length(bytes) > ABSOLUTE_MAX_TEXT_SIZE) then
+ raise Exception.Create('The text is too big.');
+ segmentList := TSegmentList.Create;
+ BreakString;
+ Assemble;
+ FreeAndNil(segmentList);
+ codewords[0] := cwPtr;
+ lenCodewords := cwPtr;
+
+ // error correction level
+ maxErr := MaxPossibleErrorLevel(MAX_DATA_CODEWORDS + 2 - lenCodewords);
+ if (ErrorCorrection = AutoCorr ) then
+ begin
+ if (lenCodewords < 41) then
+ errorLevel := 2
+ else
+ if (lenCodewords < 161) then
+ errorLevel := 3
+ else
+ if (lenCodewords < 321) then
+ errorLevel := 4
+ else
+ errorLevel := 5;
+ end
+ else
+ errorLevel := integer(ord(ErrorCorrection) - 1);
+ if (errorLevel < 0) then
+ errorLevel := 0
+ else
+ if (errorLevel > maxErr) then
+ errorLevel := maxErr;
+
+ if (codeColumns < 1) then
+ codeColumns := 1
+ else
+ if (codeColumns > 30) then
+ codeColumns := 30;
+ if (FHeight < 3) then
+ FHeight := 3
+ else
+ if (FHeight > 90) then
+ FHeight := 90;
+ lenErr := 2 shl errorLevel;
+ fixedColumn := FRows = 0;
+ skipRowColAdjust := false;
+ tot := lenCodewords + lenErr;
+ if (FColumns <> 0) and (FRows <> 0) then
+ begin
+ tot := codeColumns * FHeight;
+ if (tot > MAX_DATA_CODEWORDS + 2) then
+ tot := GetMaxSquare;
+ if (tot < lenCodewords + lenErr) then
+ tot := lenCodewords + lenErr
+ else
+ skipRowColAdjust := true;
+ end
+ else
+ begin
+ fixedColumn := true;
+ if (FAspectRatio < 0.001) then
+ FAspectRatio := 0.001
+ else
+ if (FAspectRatio > 1000) then
+ FAspectRatio := 1000;
+ if PixelWidth = 0 then
+ yHeight := 3
+ else
+ yHeight := extended( PixelHeight / PixelWidth );
+ b := 73 * FAspectRatio - 4;
+ c := (-b + Sqrt(b * b + 4 * 17 * FAspectRatio * (lenCodewords + lenErr) * yHeight)) / (2 * 17 * FAspectRatio);
+ codeColumns := trunc(c + 0.5);
+ if (codeColumns < 1) then
+ codeColumns := 1
+ else
+ if (codeColumns > 30) then
+ codeColumns := 30;
+ end;
+
+ if not skipRowColAdjust then
+ begin
+ if (fixedColumn) then
+ begin
+ FHeight := (tot - 1) div codeColumns + 1;
+ if (FHeight < 3) then
+ FHeight := 3
+ else
+ if (FHeight > 90) then
+ begin
+ FHeight := 90;
+ codeColumns := (tot - 1) div 90 + 1;
+ end;
+ end
+
+ else
+ begin
+ codeColumns := (tot - 1) div FHeight + 1;
+ if (codeColumns > 30) then
+ begin
+ codeColumns := 30;
+ FHeight := (tot - 1) div 30 + 1;
+ end;
+ end;
+ tot := FHeight * codeColumns;
+ end;
+
+ if (tot > MAX_DATA_CODEWORDS + 2) then
+ tot := GetMaxSquare;
+ errorLevel := MaxPossibleErrorLevel(tot - lenCodewords);
+ lenErr := 2 shl errorLevel;
+ pad := tot - lenErr - lenCodewords;
+
+ cwPtr := lenCodewords;
+ while (pad <> 0) do
+ begin
+ dec(pad);
+ codewords[cwPtr] := TEXT_MODE;
+ inc(cwPtr);
+ end;
+
+ codewords[0] := cwPtr;
+ lenCodewords := cwPtr;
+ CalculateErrorCorrection(lenCodewords);
+ lenCodewords := tot;
+ OutPaintCode;
+end;
+
+
+function TfrxBarcodePDF417.GetMaxSquare : integer;
+begin
+ if (codeColumns > 21) then
+ begin
+ codeColumns := 29;
+ FHeight := 32;
+ end
+ else
+ begin
+ codeColumns := 16;
+ FHeight := 58;
+ end;
+ result := MAX_DATA_CODEWORDS + 2;
+end;
+
+function TfrxBarcodePDF417.MaxPossibleErrorLevel( remain: integer) : integer;
+var
+ level, size : integer;
+begin
+ level := 8;
+ size := 512;
+ while (level > 0) do
+ begin
+ if (remain >= size) then
+ begin
+ result := level;
+ exit;
+ end;
+ dec(level);
+ size := size shr 1;
+ end;
+ result := 0;
+end;
+
+procedure TfrxBarcodePDF417.Assemble;
+var
+
+ k : integer;
+ v : Segment;
+begin
+
+ if segmentList.Size = 0 then
+ exit;
+ cwPtr := 1;
+ for k := 0 to segmentList.Size-1 do
+ begin
+ v := segmentList.Get(k);
+ case v._type of
+
+ 'T': begin
+ if (k <> 0) then
+ begin
+ codewords[cwPtr] := TEXT_MODE; inc(cwPtr);
+ end;
+ TextCompaction(v._start, GetSegmentLength(v));
+ end;
+ 'N': begin
+ codewords[cwPtr] := NUMERIC_MODE; inc(cwPtr);
+ NumberCompaction(v._start, GetSegmentLength(v));
+ end;
+ 'B': begin
+ if (GetSegmentLength(v) mod 6) <> 0 then
+ begin
+ codewords[cwPtr] := BYTE_MODE;
+ inc(cwPtr);
+ end
+ else
+ begin
+ codewords[cwPtr] := BYTE_MODE_6;
+ inc(cwPtr);
+ end;
+ ByteCompaction(v._start, GetSegmentLength(v));
+ end;
+ end;
+ end;
+end;
+
+
+procedure TfrxBarcodePDF417.BreakString;
+var
+ textLength, lastP, startN, nd, k, j : integer;
+ c : char;
+ lastTxt, txt, redo : boolean;
+ v, vp, vn : Segment;
+begin
+
+ textLength := Length(bytes);
+ lastP := 0;
+ startN := 0;
+ nd := 0;
+
+ case CompactionMode of
+
+ TextComp: begin
+ segmentList.Add('T', 0, textLength);
+ exit;
+ end;
+
+ Numeric:
+ begin
+ segmentList.Add('N', 0, textLength);
+ exit;
+ end;
+
+ Binary:
+ begin
+ segmentList.Add('B', 0, textLength);
+ exit;
+ end;
+ end;
+
+ for k := 0 to textLength-1 do
+ begin
+ c := char((bytes[k] and $ff));
+ if (c >= '0') and (c <= '9') then
+ begin
+ if (nd = 0) then
+ startN := k;
+ inc(nd);
+ continue;
+ end;
+ if (nd >= 13) then
+ begin
+ if (lastP <> startN) then
+ begin
+ c := char((bytes[lastP] and $ff));
+ lastTxt := ((c >= ' ') and (c < #127)) or ( c = #13 ) or ( c = #10 ) or ( c = #9 );
+ for j := lastP to startN - 1 do
+ begin
+ c := char((bytes[j] and $ff));
+ txt := ((c >= ' ') and (c < #127)) or ( c = #13 ) or ( c = #10 ) or ( c = #9 );
+ if (txt <> lastTxt) then
+ begin
+ if lastTxt then
+ segmentList.Add('T', lastP, j)
+ else
+ segmentList.Add('B', lastP, j);
+ lastP := j;
+ lastTxt := txt;
+ end;
+ end;
+ if lastTxt then
+ segmentList.Add('T', lastP, startN)
+ else
+ segmentList.Add('B', lastP, startN);
+ end;
+ segmentList.Add('N', startN, k);
+ lastP := k;
+ end;
+ nd := 0;
+ end;
+ if (nd < 13) then
+ startN := textLength;
+ if (lastP <> startN) then
+ begin
+ c := char((bytes[lastP] and $ff));
+ lastTxt := ((c >= ' ') and (c < #127)) or (c = #10) or ( c = #13) or ( c = #9 );
+ for j := lastP to startN-1 do
+ begin
+ c := char((bytes[j] and $ff));
+ txt := ((c >= ' ') and (c < #127)) or ( c = #10 ) or ( c = #13 ) or ( c = #9 );
+ if (txt <> lastTxt) then
+ begin
+ if lastTxt then
+ segmentList.Add('T', lastP, j)
+ else
+ segmentList.Add('B', lastP, j);
+ lastP := j;
+ lastTxt := txt;
+ end;
+ end;
+ if lastTxt then
+ segmentList.Add('T', lastP, startN)
+ else
+ segmentList.Add('B', lastP, startN);
+ end;
+ if (nd >= 13) then
+ segmentList.Add('N', startN, textLength);
+ //optimize
+ //merge short binary
+ k := 0;
+ while k < segmentList.Size do
+ begin
+ v := segmentList.Get(k);
+ vp := segmentList.Get(k - 1);
+ vn := segmentList.Get(k + 1);
+ if ( CheckSegmentType(v, 'B') and ( GetSegmentLength(v) = 1) ) then
+ begin
+ if CheckSegmentType(vp, 'T') and CheckSegmentType(vn, 'T')
+ and (GetSegmentLength(vp) + GetSegmentLength(vn) >= 3) then
+ begin
+ vp._end := vn._end;
+ segmentList.Remove(k);
+ segmentList.Remove(k);
+ k := -1;
+ inc(k);
+ continue;
+ end;
+ end;
+ inc(k);
+ end;
+ //merge text sections
+ k := 0;
+ while k < segmentList.Size do
+ begin
+ v := segmentList.Get(k);
+ vp := segmentList.Get(k - 1);
+ vn := segmentList.Get(k + 1);
+ if CheckSegmentType(v, 'T') and (GetSegmentLength(v) >= 5) then
+ begin
+ redo := false;
+ if ( CheckSegmentType(vp, 'B') and (GetSegmentLength(vp) = 1)) or CheckSegmentType(vp, 'T') then
+ begin
+ redo := true;
+ v._start := vp._start;
+ segmentList.Remove(k - 1);
+ dec(k);
+ end;
+ if ( CheckSegmentType(vn, 'B') and (GetSegmentLength(vn) = 1)) or CheckSegmentType(vn, 'T') then
+ begin
+ redo := true;
+ v._end := vn._end;
+ segmentList.Remove(k + 1);
+ end;
+ if (redo) then
+ begin
+ k := -1;
+ inc(k);
+ continue;
+ end;
+ end;
+ inc(k);
+ end;
+ //merge binary sections
+ k := 0;
+ while k < segmentList.Size do
+ begin
+ v := segmentList.Get(k);
+ vp := segmentList.Get(k - 1);
+ vn := segmentList.Get(k + 1);
+ if CheckSegmentType(v, 'B') then
+ begin
+ redo := false;
+ if (CheckSegmentType(vp, 'T') and ( GetSegmentLength(vp) < 5 ) ) or CheckSegmentType(vp, 'B') then
+ begin
+ redo := true;
+ v._start := vp._start;
+ segmentList.Remove(k - 1);
+ dec(k);
+ end;
+ if ( CheckSegmentType(vn, 'T') and (GetSegmentLength(vn) < 5)) or CheckSegmentType(vn, 'B') then
+ begin
+ redo := true;
+ v._end := vn._end;
+ segmentList.Remove(k + 1);
+ end;
+ if (redo) then
+ begin
+ k := -1;
+ inc(k);
+ continue;
+ end;
+ end;
+ inc(k);
+ end;
+ // check if all numbers
+ v := segmentList.Get(0);
+ if (segmentList.Size = 1) and (v._type = 'T') and ( GetSegmentLength(v) >= 8 ) then
+ begin
+ for k := v._start to v._end-1 do
+ begin
+ c := char((bytes[k] and $ff));
+ if (c < '0') or ( c > '9') then
+ break;
+ end;
+ if (k = v._end) then
+ v._type := 'N';
+ end;
+end;
+
+procedure TfrxBarcodePDF417.ByteCompaction( start, length : integer);
+var
+ k,j, size : integer;
+begin
+ size := (length div 6) * 5 + (length mod 6);
+ if (size + cwPtr ) > MAX_DATA_CODEWORDS then
+ raise Exception.Create('The text is too big.');
+
+ inc(length,start);
+
+ k := start;
+ while k < length do
+ begin
+ size := length - k;
+ if size>=44 then size:=6;
+ if (size < 6) then
+ begin
+ for j := 0 to size-1 do
+ begin
+ codewords[cwPtr] := integer(bytes[k + j]) and $ff;
+ inc(cwPtr);
+ end;
+ end
+ else
+ begin
+ ByteCompaction6(k);
+ end;
+ inc(k, 6);
+ end;
+end;
+
+
+procedure TfrxBarcodePDF417.ByteCompaction6( start : integer );
+var
+ length, ret, retLast, ni, k : integer;
+begin
+ length := 6;
+ ret := cwPtr;
+ retLast := 4;
+ inc(cwPtr, retLast + 1);
+ for k := 0 to retLast do
+ codewords[ret + k] := 0;
+ inc( length, start );
+ for ni := start to length-1 do
+ begin
+ // multiply by 256
+ for k := retLast downto 0 do
+ codewords[ret + k] := codewords[ret + k] * 256;
+ // add the digit
+ inc(codewords[ret + retLast], integer(bytes[ni]) and $ff);
+ // propagate carry
+ for k := retLast downto 1 do
+ begin
+ inc(codewords[ret + k - 1], codewords[ret + k] div 900);
+ codewords[ret + k] := codewords[ret + k] mod 900;
+ end;
+ end;
+end;
+
+
+procedure TfrxBarcodePDF417.NumberCompaction( start, length : integer);
+begin
+ NumberCompaction(bytes, start, length);
+end;
+
+
+procedure TfrxBarcodePDF417.NumberCompaction(var input : TBytes; start,length : integer);
+var
+ full, size, k : integer;
+begin
+ full := (length div 44) * 15;
+ size := length mod 44;
+ if (size = 0) then
+ size := full
+ else
+ size := full + size div 3 + 1;
+ if (size + cwPtr > MAX_DATA_CODEWORDS) then
+ raise Exception.Create('The text is too big.');
+
+ inc(length, start);
+ k := start;
+ while( k < length ) do
+ begin
+ size := length - k;
+ if size > 44 then size := 44;
+ BasicNumberCompaction(input, k, size);
+ inc(k ,44);
+ end;
+end;
+
+procedure TfrxBarcodePDF417.BasicNumberCompaction(var input : TBytes; start, length : integer);
+var
+ ret, retLast, ni, k : integer;
+begin
+ ret := cwPtr;
+ retLast := length div 3;
+ inc(cwPtr, retLast + 1);
+ for k := 0 to retLast do
+ codewords[ret + k] := 0;
+
+ codewords[ret + retLast] := 1;
+ inc(length, start);
+ for ni := start to length-1 do
+ begin
+ // multiply by 10
+ for k := retLast downto 0 do
+ codewords[ret + k] := codewords[ret + k] * 10;
+ // add the digit
+ inc(codewords[ret + retLast], input[ni] - ord('0'));
+ // propagate carry
+ for k := retLast downto 1 do
+ begin
+ inc(codewords[ret + k - 1], codewords[ret + k] div 900);
+ codewords[ret + k] := codewords[ret + k] mod 900;
+ end;
+ end;
+end;
+
+procedure TfrxBarcodePDF417.TextCompaction( start, length : integer);
+begin
+ TextCompaction(bytes, start, length);
+end;
+
+procedure TfrxBarcodePDF417.TextCompaction(var input : TBytes; start, length : integer);
+var
+ dest : TInt;
+ mode, ptr, fullBytes, v, k, size
+ : integer;
+begin
+ SetLength( dest, ABSOLUTE_MAX_TEXT_SIZE * 2 );
+
+ FillChar(dest[0], sizeof(dest), 0);
+ mode := ALPHA;
+ ptr := 0; fullBytes := 0;
+ inc(length, start);
+ k := start;
+ while ( k < length) do
+ begin
+ v := GetTextTypeAndValue(input, length, k);
+ if ((v and mode) <> 0) then
+ begin
+ dest[ptr] := v and $ff;
+ inc(ptr);
+ inc(k);
+ continue;
+ end;
+ if ((v and ISBYTE) <> 0) then
+ begin
+ if ((ptr and 1) <> 0) then
+ begin
+ //add a padding word
+// dest[ptr] := PAL;
+ if mode and PUNCTUATION <> 0 then
+ dest[ptr] := PAL
+ else
+ dest[ptr] := PS;
+ inc(ptr);
+ if (mode and PUNCTUATION) <> 0 then mode := ALPHA;
+ end;
+ dest[ptr] := BYTESHIFT; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ inc(fullBytes, 2);
+ inc(k);
+ continue;
+ end;
+ case (mode) of
+ ALPHA: if ((v and LOWER) <> 0) then
+ begin
+ dest[ptr] := LL; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ mode := LOWER;
+ end
+ else
+ if ((v and MIXED) <> 0) then
+ begin
+ dest[ptr] := ML; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ mode := MIXED;
+ end
+ else
+ if ((GetTextTypeAndValue(input, length, k + 1)
+ and GetTextTypeAndValue(input, length, k + 2)
+ and PUNCTUATION) <> 0) then
+ begin
+ dest[ptr] := ML; inc(ptr);
+ dest[ptr] := PL; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ mode := PUNCTUATION;
+ end
+ else
+ begin
+ dest[ptr] := PS; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ end;
+ LOWER: if ((v and ALPHA) <> 0) then
+ begin
+ if ((GetTextTypeAndValue(length, k + 1)
+ and GetTextTypeAndValue(length, k + 2)
+ and ALPHA) <> 0) then
+ begin
+ dest[ptr] := ML; inc(ptr);
+ dest[ptr] := AL; inc(ptr);
+ mode := ALPHA;
+ end
+ else
+ begin
+ dest[ptr] := _AS; inc(ptr);
+ end;
+ dest[ptr] := v and $ff; inc(ptr);
+ end
+ else
+ if ((v and MIXED) <> 0) then
+ begin
+ dest[ptr] := ML; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ mode := MIXED;
+ end
+ else
+ if ((GetTextTypeAndValue(input, length, k + 1)
+ and GetTextTypeAndValue(input, length, k + 2)
+ and PUNCTUATION) <> 0) then
+ begin
+ dest[ptr] := ML; inc(ptr);
+ dest[ptr] := PL; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ mode := PUNCTUATION;
+ end
+ else
+ begin
+ dest[ptr] := PS; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ end;
+ MIXED: if ((v and LOWER) <> 0) then
+ begin
+ dest[ptr] := LL; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ mode := LOWER;
+ end
+ else
+ if ((v and ALPHA) <> 0) then
+ begin
+ dest[ptr] := AL; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ mode := ALPHA;
+ end
+ else
+ if ((GetTextTypeAndValue(input, length, k + 1)
+ and GetTextTypeAndValue(input, length, k + 2)
+ and PUNCTUATION) <> 0) then
+ begin
+ dest[ptr] := PL; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ mode := PUNCTUATION;
+ end
+ else
+ begin
+ dest[ptr] := PS; inc(ptr);
+ dest[ptr] := v and $ff; inc(ptr);
+ end;
+ PUNCTUATION: begin
+ dest[ptr] := PAL; inc(ptr);
+ mode := ALPHA;
+ dec(k);
+ end;
+ end; // case
+ inc(k);
+ end; // for
+ if ((ptr and 1) <> 0) then
+ begin
+ dest[ptr] := PS; inc(ptr);
+ end;
+ size := (ptr + fullBytes) div 2;
+ if (size + cwPtr > MAX_DATA_CODEWORDS) then
+ raise Exception.Create('The text is too big.');
+ length := ptr;
+ ptr := 0;
+ while (ptr < length) do
+ begin
+ v := dest[ptr]; inc(ptr);
+ if (v >= 30) then
+ begin
+ codewords[cwPtr] := v; inc(cwPtr);
+ codewords[cwPtr] := dest[ptr]; inc(cwPtr);
+ inc(ptr);
+ end
+ else
+ begin
+ codewords[cwPtr] := v * 30 + dest[ptr];
+ inc(cwPtr);
+ inc(ptr);
+ end;
+ end;
+end;
+
+function TfrxBarcodePDF417.GetTextTypeAndValue(maxLength, idx : integer) : integer;
+begin
+ result := GetTextTypeAndValue(bytes, maxLength, idx);
+end;
+
+
+function TfrxBarcodePDF417.GetTextTypeAndValue( var input : TBytes; maxLength, idx : integer ) : integer;
+var
+ c : char;
+ ms,ps : integer;
+begin
+
+ if (idx >= maxLength) then begin
+ result := 0;
+ exit;
+ end;
+ c := char(input[idx] and $ff);
+
+ if (c >= 'A') and (c <= 'Z') then begin
+ result := (ALPHA + ord(c) - ord('A'));
+ exit;
+ end;
+ if (c >= 'a') and (c <= 'z') then begin
+ result := (LOWER + ord(c) - ord('a'));
+ exit;
+ end;
+ if (c = ' ') then begin
+ result := (ALPHA + LOWER + MIXED + SPACE);
+ exit;
+ end;
+
+ ms := Pos(c,MIXED_SET) - 1;
+ ps := Pos(c,PUNCTUATION_SET) - 1;
+ if (ms < 0) and (ps < 0) then begin
+ result := (ISBYTE + (ord(c) and $ff));
+ exit;
+ end;
+ if (ms = ps) then begin
+ result := (MIXED + PUNCTUATION + ms);
+ exit;
+ end;
+ if (ms >= 0) then begin
+ result := (MIXED + ms);
+ exit;
+ end;
+ result := (PUNCTUATION + ps);
+
+end;
+
+procedure TfrxBarcodePDF417.CalculateErrorCorrection( dest : integer);
+var
+ A : TInt;
+ ALength,e,k,t1,t2,t3, LastE: integer;
+begin
+ if (errorLevel < 0) or ( errorLevel > 8) then
+ errorLevel := 0;
+
+ Alength := 2 shl errorLevel;
+ SetLength(A,Alength);
+ for k := 0 to Alength-1 do
+ A[k] := TInt(ERROR_LEVEL[errorLevel])[k];
+
+ for k := 0 to Alength-1 do
+ codewords[dest + k] := 0;
+ lastE := Alength - 1;
+ for k := 0 to lenCodewords-1 do
+ begin
+ t1 := codewords[k] + codewords[dest];
+ for e := 0 to lastE do
+ begin
+ t2 := (t1 * A[lastE - e]) mod _MOD;
+ t3 := _MOD - t2;
+ if e = LastE then
+ codewords[dest + e] := t3 mod _MOD
+ else
+ codewords[dest + e] := ((codewords[dest + e + 1]) + t3) mod _MOD;
+ end;
+ end;
+ for k := 0 to Alength- 1 do
+ codewords[dest + k] := (_MOD - codewords[dest + k]) mod _MOD;
+
+end;
+
+procedure TfrxBarcodePDF417.OutPaintCode;
+var
+ codePtr, lenBits, rowMod, edge, column, row : integer;
+ cluster : ^integer;
+
+begin
+ codePtr := 0;
+ FWidth := START_CODE_SIZE * (codeColumns + 3) + STOP_SIZE;
+ lenBits := ((FWidth - 1) div 8 + 1) * FHeight;
+ SetLength(FImage, lenBits);
+ FillChar(FImage[0],length(FImage),0);
+ for row := 0 to FHeight-1 do
+ begin
+ bitPtr := ((FWidth - 1) div 8 + 1) * 8 * row;
+ rowMod := row mod 3;
+ cluster := @CLUSTERS[rowMod];
+ OutStartPattern;
+ case (rowMod) of
+ 0: edge := 30 * (row div 3) + ((FHeight - 1) div 3);
+ 1: edge := 30 * (row div 3) + errorLevel * 3 + ((FHeight - 1) mod 3);
+ else
+ edge := 30 * (row div 3) + codeColumns - 1;
+ end;
+
+ OutCodeword(TInt(cluster)[edge]);
+
+ for column := 0 to codeColumns-1 do
+ begin
+ OutCodeword(TInt(cluster)[codewords[codePtr]]);
+ inc(codePtr);
+ end;
+
+ case rowMod of
+ 0: edge := 30 * (row div 3) + codeColumns - 1;
+ 1: edge := 30 * (row div 3) + ((FHeight - 1) div 3);
+ else
+ edge := 30 * (row div 3) + errorLevel * 3 + ((FHeight - 1) mod 3);
+ end;
+
+ OutCodeword(TInt(cluster)[edge]);
+ OutStopPattern;
+ end;
+
+end;
+
+
+procedure TfrxBarcodePDF417.OutStartPattern;
+begin
+ OutCodeword17(START_PATTERN);
+end;
+
+procedure TfrxBarcodePDF417.OutStopPattern;
+begin
+ OutCodeword18(STOP_PATTERN);
+end;
+
+procedure TfrxBarcodePDF417.OutCodeword( codeword : integer );
+begin
+ OutCodeword17(codeword);
+end;
+
+procedure TfrxBarcodePDF417.OutCodeword18( codeword : integer);
+var
+ bytePtr, bit : integer;
+begin
+ bytePtr := bitPtr div 8;
+ bit := bitPtr - bytePtr * 8;
+ FImage[bytePtr] := FImage[bytePtr] or (byte((codeword shr (10 + bit))));
+ inc(bytePtr);
+ FImage[bytePtr] := FImage[bytePtr] or (byte(codeword shr (2 + bit)));
+ inc(bytePtr);
+ codeword := codeword shl 8;
+ FImage[bytePtr] := FImage[bytePtr] or (byte((codeword shr (2 + bit))));
+ if (bit = 7) then
+ begin
+ inc(bytePtr);
+ FImage[bytePtr] := FImage[bytePtr] or $80;
+ end;
+ inc(bitPtr, 18);
+end;
+
+procedure TfrxBarcodePDF417.OutCodeword17( codeword : integer);
+var
+ bytePtr, bit : integer;
+
+begin
+ bytePtr := bitPtr div 8;
+ bit := bitPtr - bytePtr * 8;
+ FImage[bytePtr] := FImage[bytePtr] or ( byte((codeword shr (9 + bit))));
+ inc(bytePtr);
+ FImage[bytePtr] := FImage[bytePtr] or ( byte((codeword shr (1 + bit))));
+ inc(bytePtr);
+ codeword := codeword shl 8;
+ FImage[bytePtr] := FImage[bytePtr] or ( byte((codeword shr (1 + bit))));
+ inc(bitPtr, 17);
+end;
+
+function TfrxBarcodePDF417.GetSegmentLength(var segm : Segment ) : integer;
+begin
+ if (segm = nil) then
+ result := 0
+ else
+ result := segm._end - segm._start;
+end;
+
+function TfrxBarcodePDF417.CheckSegmentType(var segm : Segment; typ : char) : boolean;
+begin
+ if (segm = nil) then
+ result := false
+ else
+ result := segm._type = typ;
+end;
+
+
+
+constructor Segment.Create( _t : char; _s, _e : integer);
+begin
+ _type := _t;
+ _start := _s;
+ _end := _e;
+end;
+
+constructor TSegmentList.Create;
+begin
+ list := TList.Create;
+end;
+
+destructor TSegmentList.Destroy;
+var
+ i: Integer;
+begin
+ for i := 0 to list.Count - 1 do
+ Segment(List[i]).Free;
+ List.Free;
+end;
+
+procedure TSegmentList.Add(_type: char; _start,_end : integer);
+begin
+ list.Add(Segment.Create(_type, _start, _end));
+end;
+
+function TSegmentList.Get(idx : integer) : Segment;
+begin
+ if (idx < 0) or (idx >= list.Count) then
+ result := nil
+ else
+ result := list[idx];
+end;
+procedure TSegmentList.Remove( idx : integer);
+begin
+ if (idx < 0) or (idx >= list.Count) then
+ exit;
+ list.Delete(idx);
+end;
+
+function TSegmentList.Size : integer;
+begin
+ result := list.count;
+end;
+
+end.
+
+
+//16bfbc33f73bd4cb8424198d249c56b6
\ No newline at end of file
diff --git a/LibD28x64/FMX.frxBarcodeProperties.pas b/LibD28x64/FMX.frxBarcodeProperties.pas
new file mode 100644
index 0000000..ab38599
--- /dev/null
+++ b/LibD28x64/FMX.frxBarcodeProperties.pas
@@ -0,0 +1,325 @@
+unit FMX.frxBarcodeProperties;
+
+interface
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Types, FMX.Objects,
+ System.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Menus,
+ FMX.frxClass, FMX.frxdesgn, FMX.frxBarcodePDF417, FMX.frxBarcodeDataMatrix,
+ FMX.frxBarcode2DBase, FMX.DelphiZXingQRCode, FMX.frxBarcodeQR;
+
+type
+
+{$M+}
+ TUniqueProp = class (TPersistent)
+
+ private
+
+ FOnChange: TNotifyEvent;
+
+ public
+ FWhose : TObject;
+ procedure Changed;
+ procedure Assign(Source: TPersistent); override; abstract;
+ procedure SetWhose( w : TObject);
+
+ end;
+
+
+ TPDF417UniqueProperties = class( TUniqueProp )
+
+ private
+
+
+ function GetAspectRatio : Double;
+ function GetColumns : integer;
+ function GetRows : integer;
+ function GetErrorCorrection : PDF417ErrorCorrection;
+ function GetCodePage : integer;
+ function GetCompactionMode : PDF417CompactionMode;
+ function GetPixelWidth : integer;
+ function GetPixelHeight : integer;
+
+ procedure SetAspectRatio(v : Double);
+ procedure SetColumns(v : integer);
+ procedure SetRows(v : integer);
+ procedure SetErrorCorrection(v : PDF417ErrorCorrection);
+ procedure SetCodePage(v : integer);
+ procedure SetCompactionMode(v : PDF417CompactionMode);
+ procedure SetPixelWidth(v : integer);
+ procedure SetPixelHeight(v : integer);
+
+
+ public
+
+ procedure Assign(Source: TPersistent); override;
+
+ published
+
+ property AspectRatio : Double read GetAspectRatio write SetAspectRatio;
+ property Columns : integer read GetColumns write SetColumns;
+ property Rows : integer read GetRows write SetRows;
+ property ErrorCorrection : PDF417ErrorCorrection read GetErrorCorrection write SetErrorCorrection;
+ property CodePage : integer read GetCodePage write SetCodePage;
+ property CompactionMode : PDF417CompactionMode read GetCompactionMode write SetCompactionMode;
+ property PixelWidth : integer read GetPixelWidth write SetPixelWidth;
+ property PixelHeight : integer read GetPixelHeight write SetPixelHeight;
+
+ end;
+
+ TDataMatrixUniqueProperties = class( TUniqueProp )
+
+ private
+
+
+ function GetCodePage : integer;
+ function GetPixelSize : integer;
+ function GetSymbolSize : DatamatrixSymbolSize;
+ function GetEncoding : DatamatrixEncoding;
+
+ procedure SetCodePage(v : integer);
+ procedure SetPixelSize(v : integer);
+ procedure SetSymbolSize(v : DatamatrixSymbolSize);
+ procedure SetEncoding(v : DatamatrixEncoding);
+
+
+ public
+
+ procedure Assign(Source: TPersistent); override;
+
+ published
+
+ property CodePage : integer read GetCodePage write SetCodePage;
+ property PixelSize : integer read GetPixelSize write SetPixelSize;
+ property SymbolSize : DatamatrixSymbolSize read GetSymbolSize write SetSymbolSize;
+ property Encoding : DatamatrixEncoding read GetEncoding write SetEncoding;
+
+ end;
+
+ TfrxQRProperties = class( TUniqueProp )
+ private
+ function GetEncoding: TQRCodeEncoding;
+ function GetQuietZone: Integer;
+ function GetPixelSize : integer;
+ procedure SetPixelSize(v : integer);
+ procedure SetEncoding(const Value: TQRCodeEncoding);
+ procedure SetQuietZone(const Value: Integer);
+ function GetErrorLevels: TQRErrorLevels;
+ procedure SetErrorLevels(const Value: TQRErrorLevels);
+ function GetCodePage: Longint;
+ procedure SetCodePage(const Value: Longint);
+
+ public
+
+ procedure Assign(Source: TPersistent); override;
+
+ published
+
+ property Encoding: TQRCodeEncoding read GetEncoding write SetEncoding;
+ property QuietZone: Integer read GetQuietZone write SetQuietZone;
+ property ErrorLevels: TQRErrorLevels read GetErrorLevels write SetErrorLevels;
+ property PixelSize : integer read GetPixelSize write SetPixelSize;
+ property CodePage : Longint read GetCodePage write SetCodePage;
+
+ end;
+
+implementation
+
+procedure TUniqueProp.SetWhose( w : TObject);
+begin
+ FWhose := w;
+end;
+
+procedure TUniqueProp.Changed;
+begin
+ if @FOnChange <> nil then FOnChange(Self);
+end;
+
+procedure TPDF417UniqueProperties.Assign(Source: TPersistent);
+var
+ src : TPDF417UniqueProperties;
+begin
+ if Source is TPDF417UniqueProperties then
+ begin
+ src := TPDF417UniqueProperties(Source);
+ SetAspectRatio(src.AspectRatio);
+ SetColumns(src.Columns);
+ SetRows(src.Rows);
+ SetErrorCorrection(src.ErrorCorrection);
+ SetCodePage(src.Codepage);
+ SetCompactionMode(src.CompactionMode);
+ SetPixelWidth(src.PixelWidth);
+ SetPixelHeight(src.PixelHeight);
+ SetWhose(src.FWhose);
+ end
+ else
+ inherited;
+end;
+
+function TPDF417UniqueProperties.GetAspectRatio : Double;
+begin
+ result := TfrxBarcodePDF417(FWhose).AspectRatio;
+end;
+function TPDF417UniqueProperties.GetColumns : integer;
+begin
+ result := TfrxBarcodePDF417(FWhose).Columns;
+end;
+function TPDF417UniqueProperties.GetRows : integer;
+begin
+ result := TfrxBarcodePDF417(FWhose).Rows;
+end;
+function TPDF417UniqueProperties.GetErrorCorrection : PDF417ErrorCorrection;
+begin
+ result := TfrxBarcodePDF417(FWhose).ErrorCorrection;
+end;
+function TPDF417UniqueProperties.GetCodePage : integer;
+begin
+ result := TfrxBarcodePDF417(FWhose).CodePage;
+end;
+function TPDF417UniqueProperties.GetCompactionMode : PDF417CompactionMode;
+begin
+ result := TfrxBarcodePDF417(FWhose).CompactionMode;
+end;
+function TPDF417UniqueProperties.GetPixelHeight : integer;
+begin
+ result := TfrxBarcodePDF417(FWhose).PixelHeight;
+end;
+function TPDF417UniqueProperties.GetPixelWidth : integer;
+begin
+ result := TfrxBarcodePDF417(FWhose).PixelWidth;
+end;
+procedure TPDF417UniqueProperties.SetAspectRatio(v : Double);
+begin
+ TfrxBarcodePDF417(FWhose).AspectRatio := v;
+end;
+procedure TPDF417UniqueProperties.SetColumns(v : integer);
+begin
+ TfrxBarcodePDF417(FWhose).Columns := v;
+end;
+procedure TPDF417UniqueProperties.SetRows(v : integer);
+begin
+ TfrxBarcodePDF417(FWhose).Rows := v;
+end;
+procedure TPDF417UniqueProperties.SetErrorCorrection(v : PDF417ErrorCorrection);
+begin
+ TfrxBarcodePDF417(FWhose).ErrorCorrection := v;
+end;
+procedure TPDF417UniqueProperties.SetCodePage(v : integer);
+begin
+ TfrxBarcodePDF417(FWhose).CodePage := v;
+end;
+procedure TPDF417UniqueProperties.SetCompactionMode(v : PDF417CompactionMode);
+begin
+ TfrxBarcodePDF417(FWhose).CompactionMode := v;
+end;
+procedure TPDF417UniqueProperties.SetPixelWidth(v : integer);
+begin
+ TfrxBarcodePDF417(FWhose).PixelWidth := v;
+end;
+procedure TPDF417UniqueProperties.SetPixelHeight(v : integer);
+begin
+ TfrxBarcodePDF417(FWhose).PixelHeight := v;
+end;
+
+////////////////////////////////////////////////////////////////////////////////////////
+
+function TDataMatrixUniqueProperties.GetCodePage : integer;begin result := TfrxBarcodeDataMatrix(FWhose).CodePage; end;
+function TDataMatrixUniqueProperties.GetPixelSize : integer;begin result := TfrxBarcodeDataMatrix(FWhose).PixelSize; end;
+function TDataMatrixUniqueProperties.GetSymbolSize : DatamatrixSymbolSize;begin result := TfrxBarcodeDataMatrix(FWhose).SymbolSize; end;
+function TDataMatrixUniqueProperties.GetEncoding : DatamatrixEncoding;begin result := TfrxBarcodeDataMatrix(FWhose).Encoding; end;
+
+procedure TDataMatrixUniqueProperties.SetCodePage(v : integer);begin TfrxBarcodeDataMatrix(FWhose).CodePage := v;end;
+procedure TDataMatrixUniqueProperties.SetPixelSize(v : integer);
+begin
+ if v < 2 then v := 2; TfrxBarcodeDataMatrix(FWhose).PixelSize := v;end;
+procedure TDataMatrixUniqueProperties.SetSymbolSize(v : DatamatrixSymbolSize);begin TfrxBarcodeDataMatrix(FWhose).SymbolSize := v;end;
+procedure TDataMatrixUniqueProperties.SetEncoding(v : DatamatrixEncoding);begin TfrxBarcodeDataMatrix(FWhose).Encoding := v;end;
+
+procedure TDataMatrixUniqueProperties.Assign(Source: TPersistent);
+var
+ src : TDataMatrixUniqueProperties;
+begin
+ if Source is TDataMatrixUniqueProperties then
+ begin
+ src := TDataMatrixUniqueProperties(Source);
+ SetCodePage(src.CodePage);
+ SetPixelSize(src.PixelSize);
+ SetSymbolSize(src.SymbolSize);
+ SetEncoding(src.Encoding);
+ end
+ else
+ inherited;
+end;
+
+
+
+{ TfrxQRProperties }
+
+procedure TfrxQRProperties.Assign(Source: TPersistent);
+var
+ src : TfrxQRProperties;
+begin
+ if Source is TfrxQRProperties then
+ begin
+ src := TfrxQRProperties(Source);
+ SetEncoding(src.Encoding);
+ SetQuietZone(src.QuietZone);
+ SetErrorLevels(src.ErrorLevels);
+ SetCodePage(src.CodePage);
+ end
+ else
+ inherited;
+end;
+
+function TfrxQRProperties.GetCodePage: Longint;
+begin
+ Result := TfrxBarcodeQR(FWhose).Codepage;
+end;
+
+function TfrxQRProperties.GetEncoding: TQRCodeEncoding;
+begin
+ Result := TfrxBarcodeQR(FWhose).Encoding;
+end;
+
+function TfrxQRProperties.GetErrorLevels: TQRErrorLevels;
+begin
+ Result := TfrxBarcodeQR(FWhose).ErrorLevels;
+end;
+
+function TfrxQRProperties.GetQuietZone: Integer;
+begin
+ Result := TfrxBarcodeQR(FWhose).QuietZone;
+end;
+
+procedure TfrxQRProperties.SetCodePage(const Value: Longint);
+begin
+ TfrxBarcodeQR(FWhose).Codepage := Value;
+end;
+
+procedure TfrxQRProperties.SetEncoding(const Value: TQRCodeEncoding);
+begin
+ TfrxBarcodeQR(FWhose).Encoding := Value;
+end;
+
+procedure TfrxQRProperties.SetErrorLevels(const Value: TQRErrorLevels);
+begin
+ TfrxBarcodeQR(FWhose).ErrorLevels := Value;
+end;
+
+procedure TfrxQRProperties.SetQuietZone(const Value: Integer);
+begin
+ TfrxBarcodeQR(FWhose).QuietZone := Value;
+end;
+
+function TfrxQRProperties.GetPixelSize: integer;
+begin
+ result := TfrxBarcodeQR(FWhose).PixelSize;
+end;
+
+procedure TfrxQRProperties.SetPixelSize(v : integer);
+begin
+ if v < 2 then v := 2;
+ TfrxBarcodeQR(FWhose).PixelSize := v;
+end;
+
+end.
diff --git a/LibD28x64/FMX.frxBarcodeQR.pas b/LibD28x64/FMX.frxBarcodeQR.pas
new file mode 100644
index 0000000..b0ab659
--- /dev/null
+++ b/LibD28x64/FMX.frxBarcodeQR.pas
@@ -0,0 +1,171 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ QR code }
+{ }
+{ Copyright (c) 1998-2014 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxBarcodeQR;
+
+
+interface
+
+{$I frx.inc}
+
+uses System.SysUtils, System.Types, System.StrUtils, System.Classes, FMX.Types,
+ System.UITypes, FMX.Objects, FMX.frxBarcode2DBase, FMX.DelphiZXingQRCode;
+
+type
+ TfrxBarcodeQR = class( TfrxBarcode2DBase )
+ private
+ FDelphiZXingQRCode: TDelphiZXingQRCode;
+ procedure Generate();
+ function GetEncoding: TQRCodeEncoding;
+ function GetQuietZone: Integer;
+ procedure SetEncoding(const Value: TQRCodeEncoding);
+ procedure SetQuietZone(const Value: Integer);
+ function GetErrorLevels: TQRErrorLevels;
+ procedure SetErrorLevels(const Value: TQRErrorLevels);
+ function GetPixelSize : integer;
+ procedure SetPixelSize(v : integer);
+ function GetCodepage: Longint;
+ procedure SetCodepage(const Value: Longint);
+ protected
+ procedure SetText( v : string ); override;
+ public
+ constructor Create; override;
+ destructor Destroy; override;
+ procedure Assign(src: TfrxBarcode2DBase);override;
+ published
+ property Encoding: TQRCodeEncoding read GetEncoding write SetEncoding;
+ property QuietZone: Integer read GetQuietZone write SetQuietZone;
+ property ErrorLevels: TQRErrorLevels read GetErrorLevels write SetErrorLevels;
+ property PixelSize : integer read GetPixelSize write SetPixelSize;
+ property Codepage : Longint read GetCodepage write SetCodepage;
+ end;
+
+
+implementation
+
+
+{ TfrxBarcodeQR }
+
+procedure TfrxBarcodeQR.Assign(src: TfrxBarcode2DBase);
+var
+ BSource : TfrxBarcodeQR;
+begin
+ inherited;
+ if src is TfrxBarcodeQR then
+ begin
+ BSource := TfrxBarcodeQR( src );
+ FHeight := BSource.FHeight;
+ Encoding := BSource.Encoding;
+ QuietZone := BSource.QuietZone;
+ ErrorLevels := BSource.ErrorLevels;
+ end;
+end;
+
+constructor TfrxBarcodeQR.Create;
+begin
+ inherited;
+ FDelphiZXingQRCode := TDelphiZXingQRCode.Create;
+ FDelphiZXingQRCode.Data := FText;
+ PixelWidth := 4;
+ PixelHeight := 4;
+ QuietZone := 0;
+ Generate;
+end;
+
+destructor TfrxBarcodeQR.Destroy;
+begin
+ FDelphiZXingQRCode.Free;
+ inherited;
+end;
+
+procedure TfrxBarcodeQR.Generate;
+var
+ stride, x, y, lenBits: Integer;
+begin
+ FHeight := FDelphiZXingQRCode.Rows;
+ FWidth := FDelphiZXingQRCode.Columns;
+ lenBits := ((FWidth - 1) div 8 + 1) * FHeight;
+ SetLength(FImage, lenBits);
+ FillChar(FImage[0],length(FImage),0);
+ stride := (FWidth + 7) div 8;
+
+ for x := 0 to FHeight-1 do
+ begin
+ for y := 0 to FWidth-1 do
+ if FDelphiZXingQRCode.IsBlack[y, x] then
+ FImage[y * stride + x div 8] := FImage[y * stride + x div 8] or ( 128 shr (x and 7) );
+ end;
+end;
+
+function TfrxBarcodeQR.GetCodepage: Longint;
+begin
+ Result := FDelphiZXingQRCode.CodePage;
+end;
+
+function TfrxBarcodeQR.GetEncoding: TQRCodeEncoding;
+begin
+ Result := FDelphiZXingQRCode.Encoding;
+end;
+
+function TfrxBarcodeQR.GetErrorLevels: TQRErrorLevels;
+begin
+ Result := FDelphiZXingQRCode.ErrorLevels;
+end;
+
+function TfrxBarcodeQR.GetQuietZone: Integer;
+begin
+ Result := FDelphiZXingQRCode.QuietZone;
+end;
+
+procedure TfrxBarcodeQR.SetCodepage(const Value: Longint);
+begin
+ FDelphiZXingQRCode.CodePage := Value;
+end;
+
+procedure TfrxBarcodeQR.SetEncoding(const Value: TQRCodeEncoding);
+begin
+ FDelphiZXingQRCode.Encoding := Value;
+ Generate;
+end;
+
+procedure TfrxBarcodeQR.SetErrorLevels(const Value: TQRErrorLevels);
+begin
+ FDelphiZXingQRCode.ErrorLevels := Value;
+ Generate;
+end;
+
+procedure TfrxBarcodeQR.SetQuietZone(const Value: Integer);
+begin
+ FDelphiZXingQRCode.QuietZone := Value;
+ Generate;
+end;
+
+procedure TfrxBarcodeQR.SetText(v: string);
+begin
+ inherited;
+ FDelphiZXingQRCode.Data := v;
+ Generate;
+end;
+
+function TfrxBarcodeQR.GetPixelSize: integer;
+begin
+ result := FPixelWidth;
+end;
+
+procedure TfrxBarcodeQR.SetPixelSize(v : integer);
+begin
+ FPixelWidth := v;
+ FPixelHeight := v;
+end;
+
+
+end.
diff --git a/LibD28x64/FMX.frxBarcodeRTTI.pas b/LibD28x64/FMX.frxBarcodeRTTI.pas
new file mode 100644
index 0000000..246119a
--- /dev/null
+++ b/LibD28x64/FMX.frxBarcodeRTTI.pas
@@ -0,0 +1,57 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Barcode RTTI }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxBarcodeRTTI;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, System.SysUtils, FMX.Forms, FMX.fs_iinterpreter, FMX.frxBarcode,
+ FMX.frxClassRTTI, System.Variants, System.Types;
+
+type
+ TFunctions = class(TfsRTTIModule)
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TfrxBarcodeType', 'bcCode_2_5_interleaved, bcCode_2_5_industrial,' +
+ 'bcCode_2_5_matrix, bcCode39, bcCode39Extended, bcCode128A, bcCode128B,' +
+ 'bcCode128C, bcCode93, bcCode93Extended, bcCodeMSI, bcCodePostNet,' +
+ 'bcCodeCodabar, bcCodeEAN8, bcCodeEAN13, bcCodeUPC_A, bcCodeUPC_E0,' +
+ 'bcCodeUPC_E1, bcCodeUPC_Supp2, bcCodeUPC_Supp5, bcCodeEAN128A,' +
+ 'bcCodeEAN128B, bcCodeEAN128C');
+ AddClass(TfrxBarcodeView, 'TfrxView');
+ end;
+end;
+
+
+initialization
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
+
diff --git a/LibD28x64/FMX.frxBaseModalForm.pas b/LibD28x64/FMX.frxBaseModalForm.pas
new file mode 100644
index 0000000..558b6a9
--- /dev/null
+++ b/LibD28x64/FMX.frxBaseModalForm.pas
@@ -0,0 +1,219 @@
+unit FMX.frxBaseModalForm;
+
+interface
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
+ FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs
+{$IFDEF LINUX}
+ ,FMUX.Api
+{$ENDIF}
+{$IFDEF DELPHI18}
+{$IFDEF MACoS}
+ , Macapi.Foundation, FMX.Platform.Mac, Macapi.AppKit, Macapi.CocoaTypes
+{$ENDIF}
+{$ENDIF};
+{$IFDEF LINUX}
+ const RedHatScaleWidth: Double = 1.17;
+ const RedHatScaleHeight: Double = 1.22;
+
+ function ScaleWidthOrHeightForm(ALength: Integer; Scale : Double): Integer;
+ procedure BorderStyleSizeable(AForm: TForm);
+ function GnomeAndRedHat(): Boolean;
+ function InfoLinux() : TStringList;
+{$ENDIF}
+type
+ TfrxForm = class(TForm)
+ private
+ FSession: Pointer;
+ FFormClosed: Boolean;
+{$IFNDEF DELPHI26}
+{$IFDEF DELPHI18}
+{$IFDEF MACoS}
+ FNSWin: NSWindow;
+ FNSApp: NSApplication;
+{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+ protected
+ procedure DestroyHandle; override;
+{$IFNDEF DELPHI26}
+{$IFDEF DELPHI18}
+ procedure DoClose(var CloseAction: TCloseAction); override;
+{$ENDIF}
+{$ENDIF}
+ public
+ function CloseQuery: Boolean; override;
+ function ShowModal: TModalResult; overload;
+ procedure PeekLastModalResult;
+ procedure BeginSesssion;
+ procedure EndSession;
+ end;
+
+implementation
+
+{$IFDEF LINUX}
+function InfoLinux() : TStringList;
+var
+ FileInfoOSRelese : TFileStream;
+ Bytes : TBytes;
+begin
+ Result := TStringList.Create;
+ FileInfoOSRelese := TFileStream.Create('/usr/lib/os-release', fmOpenRead, fmShareDenyNone);
+ try
+ FileInfoOSRelese.Seek(Int64(0), soFromBeginning);
+ SetLength(Bytes, FileInfoOSRelese.Size);
+ FileInfoOSRelese.Read(Bytes[0], FileInfoOSRelese.Size);
+ Result.CommaText := TEncoding.ASCII.GetString(Bytes);
+ finally
+ FileInfoOSRelese.Free;
+ end;
+end;
+
+function ScaleWidthOrHeightForm(ALength: Integer; Scale : Double): Integer;
+begin
+ Result := Round(ALength * Scale)
+end;
+
+function GnomeAndRedHat: Boolean;
+var InfoLinuxList : TStringList;
+begin
+ InfoLinuxList := InfoLinux;
+ try
+ Result := (SameText(GetEnvironmentVariable('XDG_SESSION_DESKTOP'), 'gnome'))
+ and ((InfoLinuxList.Values['REDHAT_SUPPORT_PRODUCT'] <> '')
+ or (SameText(InfoLinuxList.Values['ID'],'debian')));
+ finally
+ InfoLinuxList.Free;
+ end;
+end;
+
+procedure BorderStyleSizeable(AForm: TForm);
+begin
+ if GnomeAndRedHat then
+ AForm.BorderStyle := TFmxFormBorderStyle.Sizeable;
+end;
+{$ENDIF}
+
+{ TfrxForm }
+
+procedure TfrxForm.BeginSesssion;
+// BUG with modal forms was fixed in 10.3.2 so holding of modal session is not needed
+{$IFNDEF DELPHI26}
+{$IFDEF DELPHI18}
+{$IFDEF MACoS}
+var
+ AutoReleasePool: NSAutoreleasePool;
+{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+begin
+{$IFNDEF DELPHI26}
+{$IFDEF DELPHI18}
+{$IFDEF MACoS}
+{$IFDEF DELPHI19}
+ HandleNeed;
+{$ENDIF}
+ AutoReleasePool := TNSAutoreleasePool.Alloc;
+ try
+ AutoReleasePool.init;
+ FNSApp := TNSApplication.Wrap(TNSApplication.OCClass.sharedApplication);
+ FNSWin := WindowHandleToPlatform(Self.Handle).Wnd;
+ if FNSWin <> nil then
+ begin
+ FNSWin.retain;
+ FSession := FNSApp.beginModalSessionForWindow(FNSWin);
+ end;
+ finally
+ AutoReleasePool.release;
+ end;
+{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+end;
+
+function TfrxForm.CloseQuery: Boolean;
+begin
+{$IFNDEF DELPHI26}
+{$IFDEF DELPHI18}
+{$IFDEF MACoS}
+ Result := True;
+ if FFormClosed then Exit;
+{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+ Result := inherited;
+end;
+
+procedure TfrxForm.DestroyHandle;
+begin
+ inherited;
+ EndSession;
+end;
+
+procedure TfrxForm.EndSession;
+begin
+{$IFNDEF DELPHI26}
+{$IFDEF DELPHI18}
+{$IFDEF MACoS}
+ if (FSession <> nil) and (FNSApp <> nil) then
+ begin
+ FNSApp.runModalSession(FSession);
+ FNSApp.endModalSession(FSession);
+ FNSWin.release;
+ FNSApp := nil;
+ end;
+{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+ FSession := nil;
+end;
+
+{$IFNDEF DELPHI26}
+{$IFDEF DELPHI18}
+procedure TfrxForm.DoClose(var CloseAction: TCloseAction);
+begin
+{$IFDEF MACoS}
+ if FFormClosed then Exit; // skip restart modal session from TPlatformCocoa.ShowWindowModal
+{$ENDIF}
+ inherited;
+{$IFDEF MACoS}
+ if ModalResult <> mrNone then
+ FFormClosed := True;
+ EndSession;
+ Application.HandleMessage;
+{$ENDIF}
+end;
+{$ENDIF}
+{$ENDIF}
+
+procedure TfrxForm.PeekLastModalResult;
+begin
+{$IFNDEF DELPHI26}
+{$IFDEF DELPHI18}
+{$IFDEF MACoS}
+ if (FSession <> nil) and (FNSApp <> nil) then
+ FNSApp.runModalSession(FSession);
+{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+end;
+
+function TfrxForm.ShowModal: TModalResult;
+
+begin
+ BeginSesssion;
+{$IFDEF LINUX}
+ if (BorderStyle = TFmxFormBorderStyle.Single) and GnomeAndRedHat then
+ begin
+ Width := ScaleWidthOrHeightForm(ClientWidth, RedHatScaleWidth);
+ Height := ScaleWidthOrHeightForm(ClientHeight, RedHatScaleHeight);
+ end;
+{$ENDIF}
+ FFormClosed := False;
+ Result := inherited;
+end;
+
+end.
diff --git a/LibD28x64/FMX.frxCanvas.Linux.pas b/LibD28x64/FMX.frxCanvas.Linux.pas
new file mode 100644
index 0000000..8c48d52
--- /dev/null
+++ b/LibD28x64/FMX.frxCanvas.Linux.pas
@@ -0,0 +1,76 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Linux canvas stub classes }
+{ }
+{ Copyright (c) 1998-2021 }
+{ by Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCanvas.Linux;
+
+interface
+{$I fmx.inc}
+{$I frx.inc}
+{$SCOPEDENUMS ON}
+
+uses
+ System.SysUtils, System.Classes, System.Types, System.Math.Vectors, System.UITypes, System.UIConsts, FMX.Types,
+ FMX.Graphics, FMX.TextLayout, FMX.Canvas.Linux;
+
+type
+ TfrxLinuxCanvas = class(TLinuxCanvas)
+ private
+ FPrinter: TObject;
+ protected
+ procedure DoSetMatrix(const M: TMatrix); override;
+ public
+ constructor CreateFromFrxPrinter(const APrinter: TObject);
+ end;
+
+implementation
+
+uses System.Math, FMX.Consts, FMX.frxFMX, FMX.frxPrinter, FMX.frxClass;
+
+
+{ TfrxLinuxCanvas }
+
+constructor TfrxLinuxCanvas.CreateFromFrxPrinter(const APrinter: TObject);
+begin
+ if APrinter is TfrxCustomPrinter then
+ FPrinter := APrinter;
+ inherited CreateFromPrinter(nil);
+end;
+
+procedure TfrxLinuxCanvas.DoSetMatrix(const M: TMatrix);
+var
+ LMatrix: TMatrix;
+ frxPrinter: TfrxCustomPrinter;
+begin
+
+ if FPrinter <> nil then
+ begin
+ { marging converts from MM by using DPI }
+ { scale converts based on PPI = 72 }
+ frxPrinter := TfrxCustomPrinter(FPrinter);
+ if frxPrinter.Orientation = TPrinterOrientation.poLandscape then
+ LMatrix := M * TMatrix.CreateRotation(DegToRad(90)) *
+ TMatrix.CreateTranslation(Height, 0) * TMatrix.CreateTranslation
+ (frxPrinter.LeftMargin * frxPrinter.DPI.X / frxDefDPIUnits,
+ frxPrinter.TopMargin * frxPrinter.DPI.Y / frxDefDPIUnits) * TMatrix.CreateScaling
+ (1 / (frxPrinter.DPI.X / frxDefPPIUnits), 1 / (frxPrinter.DPI.Y / frxDefPPIUnits))
+ else
+ LMatrix := M * TMatrix.CreateTranslation(frxPrinter.LeftMargin * fr01cm *
+ frxPrinter.DPI.X / frxDefDPIUnits, frxPrinter.TopMargin * fr01cm * frxPrinter.DPI.Y
+ / frxDefDPIUnits) * TMatrix.CreateScaling(1 / (frxPrinter.DPI.X / frxDefPPIUnits),
+ 1 / (frxPrinter.DPI.Y / frxDefPPIUnits));
+ end;
+ inherited DoSetMatrix(LMatrix);
+end;
+
+initialization
+ TTextLayoutManager.RegisterTextLayout(TLinuxTextLayout, TfrxLinuxCanvas);
+
+
+end.
diff --git a/LibD28x64/FMX.frxCanvas.Mac.pas b/LibD28x64/FMX.frxCanvas.Mac.pas
new file mode 100644
index 0000000..6843e1d
--- /dev/null
+++ b/LibD28x64/FMX.frxCanvas.Mac.pas
@@ -0,0 +1,166 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.8 }
+{ Canvas for printing bitmap }
+{ when using MetalAPI }
+{ }
+{ Copyright (c) 2021 }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCanvas.Mac;
+
+{$H+}
+
+interface
+
+uses
+ System.Types, System.Math.Vectors, System.UIConsts, System.Classes, System.SysUtils, System.Math, System.UITypes,
+ System.Character, System.Generics.Collections, Macapi.CocoaTypes, Macapi.CoreGraphics, Macapi.CoreFoundation,
+ Macapi.ImageIO, Macapi.CoreText, Macapi.Helpers, FMX.Types, FMX.Platform, FMX.Printer, FMX.Printer.Mac, FMX.Consts,
+ FMX.Forms, FMX.TextLayout, FMX.Surfaces, FMX.Graphics, FMX.Canvas.Mac;
+
+type
+
+ TfrxCanvasQuartz = class(TCanvasQuartz)
+ protected
+ procedure DoDrawBitmap(const ABitmap: TBitmap; const SrcRect, DstRect: TRectF;
+ const AOpacity: Single; const HighSpeed: Boolean = False); override;
+ public
+ constructor CreateFromPrinter(const APrinter: TAbstractPrinter); override;
+ end;
+
+implementation
+
+uses
+ Macapi.PrintCore;
+ var
+ GlobalColorSpace: CGColorSpaceRef;
+
+function ColorSpace: CGColorSpaceRef;
+begin
+ if GlobalColorSpace = nil then
+ GlobalColorSpace := CGColorSpaceCreateDeviceRGB;
+ Result := GlobalColorSpace;
+end;
+
+constructor TfrxCanvasQuartz.CreateFromPrinter(
+ const APrinter: TAbstractPrinter);
+begin
+ inherited;
+end;
+
+{ TfrxCanvasQuartz }
+
+procedure TfrxCanvasQuartz.DoDrawBitmap(const ABitmap: TBitmap;
+ const SrcRect, DstRect: TRectF; const AOpacity: Single;
+ const HighSpeed: Boolean);
+var
+ B: TObject;
+ pData, LContext: Pointer;
+ NewDestRect, SubRect: CGRect;
+ ImageRef, SubImageRef: CGImageRef;
+ Surf: TBitmapSurface;
+begin
+ if (Context = nil) or (ABitmap = nil) then Exit;
+ if ABitmap.HandleAllocated then
+ begin
+ B := TObject(ABitmap.Handle);
+ if (B is TQuartzBitmap) then
+ inherited DoDrawBitmap(ABitmap, SrcRect, DstRect, AOpacity, HighSpeed)
+ else
+ begin
+ Surf := TBitmapSurface.Create;
+ try
+ Surf.Assign(ABitmap);
+
+ if Surf.PixelFormat = TPixelFormat.RGBA then
+ LContext := CGBitmapContextCreate(Surf.Bits, Surf.Width, Surf.Height,
+ 8, Surf.Pitch, ColorSpace, kCGImageAlphaPremultipliedLast)
+ else
+ begin
+ LContext := CGBitmapContextCreate(nil, Surf.Width, Surf.Height, 8,
+ Surf.Pitch, ColorSpace, kCGImageAlphaPremultipliedLast);
+ pData := CGBitmapContextGetData(LContext);
+ ChangePixelFormat(Surf.Bits, pData, Surf.Width * Surf.Height,
+ Surf.PixelFormat, TPixelFormat.RGBA);
+ end;
+
+ if LContext <> nil then
+ begin
+ ImageRef := CGBitmapContextCreateImage(LContext);
+ if ImageRef <> nil then
+ try
+
+ NewDestRect := CGRectFromRect(DstRect);
+
+ if (SrcRect.Left = 0) and (SrcRect.Top = 0) and
+ (SrcRect.Right = ABitmap.Width) and
+ (SrcRect.Bottom = ABitmap.Height) then
+ begin
+ CGContextSaveGState(Context);
+ CGContextSetAlpha(Context, AOpacity);
+
+ if HighSpeed then
+ CGContextSetInterpolationQuality(Context,
+ kCGInterpolationNone)
+ else
+ CGContextSetInterpolationQuality(Context,
+ kCGInterpolationDefault);
+
+ NewDestRect.origin.y := -DstRect.Bottom;
+ CGContextScaleCTM(Context, 1, -1);
+
+ CGContextSetAllowsAntialiasing(Context, False);
+ CGContextDrawImage(Context, NewDestRect, ImageRef);
+ CGContextSetAllowsAntialiasing(Context, True);
+
+ CGContextRestoreGState(Context);
+ end
+ else
+ begin
+ SubRect := CGRectFromRect(SrcRect);
+
+ SubImageRef := CGImageCreateWithImageInRect(ImageRef, SubRect);
+ if SubImageRef <> nil then
+ begin
+ CGContextSaveGState(Context);
+ CGContextSetAlpha(Context, AOpacity);
+
+ if HighSpeed then
+ CGContextSetInterpolationQuality(Context,
+ kCGInterpolationNone)
+ else
+ CGContextSetInterpolationQuality(Context,
+ kCGInterpolationDefault);
+
+ NewDestRect.origin.y := -DstRect.Bottom;
+ CGContextScaleCTM(Context, 1, -1);
+
+ CGContextDrawImage(Context, NewDestRect, SubImageRef);
+ CGImageRelease(SubImageRef);
+
+ CGContextRestoreGState(Context);
+ end;
+ end;
+
+ finally
+ if ImageRef <> nil then
+ CGImageRelease(ImageRef);
+ if LContext <> nil then
+ CGContextRelease(LContext);
+ end;
+ end;
+ finally
+ Surf.Free;
+ end;
+ end;
+ end;
+end;
+
+initialization
+ TTextLayoutManager.RegisterTextLayout(TTextLayoutCT, TfrxCanvasQuartz);
+finalization
+
+end.
diff --git a/LibD28x64/FMX.frxChBox.pas b/LibD28x64/FMX.frxChBox.pas
new file mode 100644
index 0000000..12c8dec
--- /dev/null
+++ b/LibD28x64/FMX.frxChBox.pas
@@ -0,0 +1,249 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Checkbox Add-In Object }
+{ }
+{ Copyright (c) 1998-2014 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxChBox;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.Types, System.SysUtils, System.Classes, FMX.Objects, FMX.Controls, FMX.frxClass,
+ FMX.Types, FMX.TabControl, System.UIConsts, System.UITypes, System.Variants
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+ TfrxCheckStyle = (csCross, csCheck, csLineCross, csPlus);
+ TfrxUncheckStyle = (usEmpty, usCross, usLineCross, usMinus);
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxCheckBoxObject = class(TComponent) // fake component
+ end;
+
+ TfrxCheckBoxView = class(TfrxView)
+ private
+ FCheckColor: TAlphaColor;
+ FChecked: Boolean;
+ FCheckStyle: TfrxCheckStyle;
+ FUncheckStyle: TfrxUncheckStyle;
+ FExpression: String;
+ procedure DrawCheck(ARect: TRectF);
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ procedure GetData; override;
+ class function GetDescription: String; override;
+ published
+ property BrushStyle;
+ property CheckColor: TAlphaColor read FCheckColor write FCheckColor default claBlack;
+ property Checked: Boolean read FChecked write FChecked default True;
+ property CheckStyle: TfrxCheckStyle read FCheckStyle write FCheckStyle;
+ property Color;
+ property Cursor;
+ property DataField;
+ property DataSet;
+ property DataSetName;
+ property Expression: String read FExpression write FExpression;
+ property Frame;
+ property TagStr;
+ property UncheckStyle: TfrxUncheckStyle read FUncheckStyle write FUncheckStyle default usEmpty;
+ property URL;
+ end;
+
+implementation
+
+uses FMX.frxChBoxRTTI, FMX.frxDsgnIntf, FMX.frxRes;
+
+
+constructor TfrxCheckBoxView.Create(AOwner: TComponent);
+begin
+ inherited;
+ FChecked := True;
+ Height := fr01cm * 5;
+ Width := fr01cm * 5;
+ FCheckColor := claBlack;
+end;
+
+class function TfrxCheckBoxView.GetDescription: String;
+begin
+ Result := frxResources.Get('obChBox');
+end;
+
+procedure TfrxCheckBoxView.DrawCheck(ARect: TRectF);
+var
+ minVal, dx, dy: Double;
+begin
+ with FCanvas, ARect do
+ if FChecked then
+ begin
+ if FCheckStyle = csCheck then
+ begin
+ FCanvas.Stroke.Kind := TBrushKind.bkSolid;
+{$IFDEF Delphi25}
+ FCanvas.Stroke.Cap := TStrokeCap.scRound;
+{$ELSE}
+ FCanvas.StrokeCap := TStrokeCap.scRound;
+{$ENDIF}
+ FCanvas.Stroke.Color := FCheckColor;
+ minVal := (Bottom - Top);
+ if (minVal > (Right - Left)) then
+ minVal := (Right - Left);
+{$IFDEF Delphi25}
+ FCanvas.Stroke.Thickness := minVal/ 6;
+{$ELSE}
+ FCanvas.StrokeThickness := minVal/ 6;
+{$ENDIF}
+ dx := (Right - Left) / 2;
+ dy := (Bottom - Top) / 2;
+ DrawLine( PointF(Left + (dx - minVal / 4 + minVal / 20), Top + (dy + minVal / 6)), PointF(Right - (dx ), Bottom - minVal / 6 ), 1);
+ DrawLine( PointF(Left + dx, Bottom - minVal / 6), PointF(Right - (dx - minVal / 3), Top + (dy - minVal / 5)), 1);
+ end
+ else if FCheckStyle = csCross then
+ begin
+ FCanvas.Stroke.Kind := TBrushKind.bkSolid;
+{$IFDEF Delphi25}
+ FCanvas.Stroke.Cap := TStrokeCap.scRound;
+{$ELSE}
+ FCanvas.StrokeCap := TStrokeCap.scRound;
+{$ENDIF}
+ FCanvas.Stroke.Color := FCheckColor;
+ minVal := (Bottom - Top);
+ if (minVal > (Right - Left)) then
+ minVal := (Right - Left);
+{$IFDEF Delphi25}
+ FCanvas.Stroke.Thickness := minVal/ 6;
+{$ELSE}
+ FCanvas.StrokeThickness := minVal/ 6;
+{$ENDIF}
+ dx := (Right - Left) / 2;
+ dy := (Bottom - Top) / 2;
+ DrawLine( PointF(Left + (dx - minVal / 4 + minVal / 20), Top + (dy - minVal / 4)), PointF(Right - (dx - minVal / 4), Bottom - (dy - minVal / 4 )), 1);
+ DrawLine( PointF(Left + (dx - minVal / 4 + minVal / 16), Bottom - (dy - minVal / 4)), PointF(Right - (dx - minVal / 4), Top + (dy - minVal / 4)), 1);
+ end
+ else if FCheckStyle = csLineCross then
+ begin
+ FCanvas.Stroke.Kind := TBrushKind.bkSolid;
+ FCanvas.Stroke.Color := FCheckColor;
+{$IFDEF Delphi25}
+ FCanvas.Stroke.Thickness := FFrameWidth;
+{$ELSE}
+ FCanvas.StrokeThickness := FFrameWidth;
+{$ENDIF}
+
+ DrawLine( PointF(Left, Top), PointF(Right, Bottom), 1);
+ DrawLine( PointF(Left, Bottom), PointF(Right, Top), 1);
+ end
+ else if FCheckStyle = csPlus then
+ begin
+ FCanvas.Stroke.Kind := TBrushKind.bkSolid;
+ FCanvas.Stroke.Color := FCheckColor;
+{$IFDEF Delphi25}
+ FCanvas.Stroke.Thickness := FFrameWidth;
+{$ELSE}
+ FCanvas.StrokeThickness := FFrameWidth;
+{$ENDIF}
+ DrawLine( PointF(Left + 3, Top + (Bottom - Top) / 2), PointF(Right - 2, Top + (Bottom - Top) / 2), 1);
+ DrawLine( PointF(Left + (Right - Left) / 2, Top + 3), PointF(Left + (Right - Left) / 2, Bottom - 2), 1);
+ end
+ end
+ else
+ begin
+ if FUncheckStyle = usCross then
+ begin
+ FCanvas.Stroke.Kind := TBrushKind.bkSolid;
+{$IFDEF Delphi25}
+ FCanvas.Stroke.Cap := TStrokeCap.scRound;
+{$ELSE}
+ FCanvas.StrokeCap := TStrokeCap.scRound;
+{$ENDIF}
+ FCanvas.Stroke.Color := FCheckColor;
+ minVal := (Bottom - Top);
+ if (minVal > (Right - Left)) then
+ minVal := (Right - Left);
+{$IFDEF Delphi25}
+ FCanvas.Stroke.Thickness := minVal/ 6;
+{$ELSE}
+ FCanvas.StrokeThickness := minVal/ 6;
+{$ENDIF}
+ dx := (Right - Left) / 2;
+ dy := (Bottom - Top) / 2;
+ DrawLine( PointF(Left + (dx - minVal / 4 + minVal / 20), Top + (dy - minVal / 4)), PointF(Right - (dx - minVal / 4), Bottom - (dy - minVal / 4 )), 1);
+ DrawLine( PointF(Left + (dx - minVal / 4 + minVal / 16), Bottom - (dy - minVal / 4)), PointF(Right - (dx - minVal / 4), Top + (dy - minVal / 4)), 1);
+ end
+ else if FUncheckStyle = usLineCross then
+ begin
+ FCanvas.Stroke.Kind := TBrushKind.bkSolid;
+ FCanvas.Stroke.Color := FCheckColor;
+{$IFDEF Delphi25}
+ FCanvas.Stroke.Thickness := FFrameWidth;
+{$ELSE}
+ FCanvas.StrokeThickness := FFrameWidth;
+{$ENDIF}
+
+ DrawLine( PointF(Left, Top), PointF(Right, Bottom), 1);
+ DrawLine( PointF(Left, Bottom), PointF(Right, Top), 1);
+
+ end
+ else if FUncheckStyle = usMinus then
+ begin
+ FCanvas.Stroke.Kind := TBrushKind.bkSolid;
+ FCanvas.Stroke.Color := FCheckColor;
+ DrawLine(PointF(Left + 3, Top + (Bottom - Top) / 2), PointF(Right - 2, Top + (Bottom - Top) / 2), 1);
+ end
+ end;
+end;
+
+procedure TfrxCheckBoxView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+begin
+ BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+
+ DrawBackground;
+ DrawCheck(RectF(FX, FY, FX1, FY1));
+ DrawFrame;
+end;
+
+procedure TfrxCheckBoxView.GetData;
+var
+ v: Variant;
+begin
+ inherited;
+ if IsDataField then
+ begin
+ v := DataSet.Value[DataField];
+ if v = Null then
+ v := False;
+ FChecked := v;
+ end
+ else if FExpression <> '' then
+ FChecked := Report.Calc(FExpression);
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxCheckBoxObject, TFmxObject);
+ frxObjects.RegisterObject1(TfrxCheckBoxView, nil, '', '', 0, 116);
+
+finalization
+ frxObjects.UnRegister(TfrxCheckBoxView);
+
+
+end.
diff --git a/LibD28x64/FMX.frxChBoxRTTI.pas b/LibD28x64/FMX.frxChBoxRTTI.pas
new file mode 100644
index 0000000..90a656c
--- /dev/null
+++ b/LibD28x64/FMX.frxChBoxRTTI.pas
@@ -0,0 +1,53 @@
+
+{******************************************}
+{ }
+{ FastReport v2.0 }
+{ CheckBox RTTI }
+{ }
+{ Copyright (c) 1998-2014 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxChBoxRTTI;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, System.Types, System.SysUtils, FMX.Forms, FMX.fs_iinterpreter, FMX.frxChBox, FMX.frxClassRTTI, System.Variants;
+
+
+type
+ TFunctions = class(TfsRTTIModule)
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TfrxCheckStyle', 'csCross, csCheck, csLineCross, csPlus');
+ AddEnum('TfrxUncheckStyle', 'usEmpty, usCross, usLineCross, usMinus');
+ AddClass(TfrxCheckBoxView, 'TfrxView');
+ end;
+end;
+
+
+initialization
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
+
diff --git a/LibD28x64/FMX.frxChart.pas b/LibD28x64/FMX.frxChart.pas
new file mode 100644
index 0000000..59afbf3
--- /dev/null
+++ b/LibD28x64/FMX.frxChart.pas
@@ -0,0 +1,786 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ TeeChart Add-In Object }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxChart;
+
+interface
+
+{$I frx.inc}
+{$I tee.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.Types, FMX.Types, FMX.Menus, FMX.Controls,
+ FMX.frxClass, System.UIConsts,
+ FMXTee.Procs, FMXTee.Engine, FMXTee.Chart, FMXTee.Series, FMXTee.Canvas
+, System.Variants
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+ , FMX.frxFMX
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF};
+
+
+type
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxChartObject = class(TComponent); // fake component
+ TChartClass = class of TCustomChart;
+
+ TfrxSeriesDataType = (dtDBData, dtBandData, dtFixedData);
+ TfrxSeriesSortOrder = (soNone, soAscending, soDescending);
+ TfrxSeriesXType = (xtText, xtNumber, xtDate);
+ TSeriesClass = class of TChartSeries;
+ TfrxChartSeries = (csLine, csArea, csPoint, csBar, csHorizBar,
+ csPie, csGantt, csFastLine, csArrow, csBubble, csChartShape, csHorizArea,
+ csHorizLine, csPolar, csRadar, csPolarBar, csGauge, csSmith, csPyramid,
+ csDonut, csBezier, csCandle, csVolume, csPointFigure, csHistogram,
+ csHorizHistogram, csErrorBar, csError, csHighLow, csFunnel, csBox,
+ csHorizBox, csSurface, csContour, csWaterFall, csColorGrid, csVector3D,
+ csTower, csTriSurface, csPoint3D, csBubble3D, csMyPoint, csBarJoin, csBar3D);
+
+
+
+ TfrxSeriesItem = class(TCollectionItem)
+ private
+ FDataBand: TfrxDataBand;
+ FDataSet: TfrxDataSet;
+ FDataSetName: String;
+ FDataType: TfrxSeriesDataType;
+ FSortOrder: TfrxSeriesSortOrder;
+ FTopN: Integer;
+ FTopNCaption: String;
+ FSource1: String;
+ FSource2: String;
+ FSource3: String;
+ FSource4: String;
+ FSource5: String;
+ FSource6: String;
+ FXType: TfrxSeriesXType;
+ FValues1: String;
+ FValues2: String;
+ FValues3: String;
+ FValues4: String;
+ FValues5: String;
+ FValues6: String;
+ FIsDataChanged: Boolean;
+ procedure FillSeries(Series: TChartSeries);
+ procedure SetDataSet(const Value: TfrxDataSet);
+ procedure SetDataSetName(const Value: String);
+ function GetDataSetName: String;
+ procedure SetValues1(const Value: String);
+ procedure SetValues2(const Value: String);
+ procedure SetValues3(const Value: String);
+ procedure SetValues4(const Value: String);
+ procedure SetValues5(const Value: String);
+ procedure SetValues6(const Value: String);
+ published
+ property DataType: TfrxSeriesDataType read FDataType write FDataType;
+ property DataBand: TfrxDataBand read FDataBand write FDataBand;
+ property DataSet: TfrxDataSet read FDataSet write SetDataSet;
+ property DataSetName: String read GetDataSetName write SetDataSetName;
+ property SortOrder: TfrxSeriesSortOrder read FSortOrder write FSortOrder;
+ property TopN: Integer read FTopN write FTopN;
+ property TopNCaption: String read FTopNCaption write FTopNCaption;
+ property XType: TfrxSeriesXType read FXType write FXType;
+
+ { source expressions }
+ property Source1: String read FSource1 write FSource1;
+ property Source2: String read FSource2 write FSource2;
+ property Source3: String read FSource3 write FSource3;
+ property Source4: String read FSource4 write FSource4;
+ property Source5: String read FSource5 write FSource5;
+ property Source6: String read FSource6 write FSource6;
+
+ { ready values. For internal use only. }
+ property Values1: String read FValues1 write SetValues1;
+ property Values2: String read FValues2 write SetValues2;
+ property Values3: String read FValues3 write SetValues3;
+ property Values4: String read FValues4 write SetValues4;
+ property Values5: String read FValues5 write SetValues5;
+ property Values6: String read FValues6 write SetValues6;
+
+ { backward compatibility }
+ property XSource: String read FSource1 write FSource1;
+ property YSource: String read FSource2 write FSource2;
+ property XValues: String read FValues1 write SetValues1;
+ property YValues: String read FValues2 write SetValues2;
+ end;
+
+ TfrxSeriesData = class(TCollection)
+ private
+ FReport: TfrxReport;
+ function GetSeries(Index: Integer): TfrxSeriesItem;
+ public
+ constructor Create(Report: TfrxReport);
+ function Add: TfrxSeriesItem;
+ property Items[Index: Integer]: TfrxSeriesItem read GetSeries; default;
+ end;
+
+ TfrxChartView = class(TfrxView)
+ private
+ FChart: TCustomChart;
+ FSeriesData: TfrxSeriesData;
+ FIgnoreNulls: Boolean;
+ FNormalSize: TBitmap;
+ FBigSize: TBitmap;
+ procedure FillChart;
+ procedure ReadData(Stream: TStream);
+ procedure ReadData1(Reader: TReader);
+ procedure ReadData2(Reader: TReader);
+ procedure WriteData(Stream: TStream);
+ procedure WriteData1(Writer: TWriter);
+ procedure WriteData2(Writer: TWriter);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure CreateChart; virtual;
+ class function GetChartClass: TChartClass; virtual;
+ procedure SetWidth(Value: Double); override;
+ procedure SetHeight(Value: Double); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ procedure AfterPrint; override;
+ procedure GetData; override;
+ procedure BeforeStartReport; override;
+ procedure OnNotify(Sender: TObject); override;
+ procedure ClearSeries;
+ procedure AddSeries(Series: TfrxChartSeries);
+
+ property Chart: TCustomChart read FChart;
+ property SeriesData: TfrxSeriesData read FSeriesData;
+ published
+ property IgnoreNulls: Boolean read FIgnoreNulls write FIgnoreNulls default False;
+// property BrushStyle;
+ property Color;
+ property Cursor;
+ property Frame;
+ property TagStr;
+ property URL;
+ end;
+
+
+implementation
+
+uses
+ FMX.frxChartHelpers, FMX.frxChartRTTI,
+{$IFNDEF NO_EDITORS}
+ FMX.frxChartEditor,
+{$ENDIF}
+ FMX.frxDsgnIntf, FMX.frxUtils, FMX.frxRes, System.Math;
+
+
+{ TfrxSeriesItem }
+
+procedure TfrxSeriesItem.SetDataSet(const Value: TfrxDataSet);
+begin
+ FDataSet := Value;
+ if FDataSet = nil then
+ FDataSetName := '' else
+ FDataSetName := FDataSet.UserName;
+end;
+
+procedure TfrxSeriesItem.SetDataSetName(const Value: String);
+begin
+ FDataSetName := Value;
+ if FDataSetName = '' then
+ FDataSet := nil
+ else if TfrxSeriesData(Collection).FReport <> nil then
+ FDataSet := TfrxSeriesData(Collection).FReport.FindDataSet(FDataSet, FDataSetName);
+end;
+
+procedure TfrxSeriesItem.SetValues1(const Value: String);
+begin
+ FValues1 := Value;
+ FIsDataChanged := True;
+end;
+
+procedure TfrxSeriesItem.SetValues2(const Value: String);
+begin
+ FValues2 := Value;
+ FIsDataChanged := True;
+end;
+
+procedure TfrxSeriesItem.SetValues3(const Value: String);
+begin
+ FValues3 := Value;
+ FIsDataChanged := True;
+end;
+
+procedure TfrxSeriesItem.SetValues4(const Value: String);
+begin
+ FValues4 := Value;
+ FIsDataChanged := True;
+end;
+
+procedure TfrxSeriesItem.SetValues5(const Value: String);
+begin
+ FValues5 := Value;
+ FIsDataChanged := True;
+end;
+
+procedure TfrxSeriesItem.SetValues6(const Value: String);
+begin
+ FValues6 := Value;
+ FIsDataChanged := True;
+end;
+
+function TfrxSeriesItem.GetDataSetName: String;
+begin
+ if FDataSet = nil then
+ Result := FDataSetName else
+ Result := FDataSet.UserName;
+end;
+
+procedure TfrxSeriesItem.FillSeries(Series: TChartSeries);
+var
+ i: Integer;
+ sl1, sl2, sl3, sl4, sl5, sl6: TStringList;
+ v1, v2, v3, v4, v5, v6: String;
+ Helper: TfrxSeriesHelper;
+
+ procedure Sort;
+ var
+ i, idx, iStart, SortOrd: Integer;
+ d, mMax: Double;
+ s: String;
+ begin
+ if sl1.Count <> sl2.Count then exit;
+
+ {bug fix, stringList sort all negative values as string }
+ if FSortOrder = soAscending then SortOrd := 1
+ else SortOrd := -1;
+ iStart := 0;
+
+ while sl2.Count > iStart do
+ begin
+ idx := 0;
+ mMax := MaxDouble * SortOrd;
+ for i := iStart to sl2.Count - 1 do
+ begin
+ s := sl2[i];
+ if not frxIsValidFloat(s) then d := 0
+ else d := frxStrToFloat(s);
+ if d * SortOrd < mMax * SortOrd then
+ begin
+ mMax := d;
+ idx := i;
+ end;
+ end;
+ sl1.Move(idx,iStart);
+ sl2.Move(idx,iStart);
+ if idx < sl3.Count then sl3.Move(idx, iStart);
+ if idx < sl4.Count then sl4.Move(idx, iStart);
+ if idx < sl5.Count then sl5.Move(idx, iStart);
+ if idx < sl6.Count then sl6.Move(idx, iStart);
+ inc(iStart);
+ end;
+ end;
+
+ procedure MakeTopN;
+ var
+ i: Integer;
+ d: Double;
+ begin
+ if sl1.Count <> sl2.Count then exit;
+ { for future using
+ if FSortOrder <> soNone then Sort;}
+
+ FSortOrder := soDescending;
+ Sort;
+ d := 0;
+ for i := sl2.Count - 1 downto FTopN - 1 do
+ begin
+ d := d + frxStrToFloat(sl2[i]);
+ sl1.Delete(i);
+ sl2.Delete(i);
+ if i < sl3.Count then sl3.Delete(i);
+ if i < sl4.Count then sl4.Delete(i);
+ if i < sl5.Count then sl5.Delete(i);
+ if i < sl6.Count then sl6.Delete(i);
+ end;
+
+ sl1.Add(FTopNCaption);
+ sl2.Add(FloatToStr(d));
+ end;
+
+begin
+ sl1 := TStringList.Create;
+ sl2 := TStringList.Create;
+ sl3 := TStringList.Create;
+ sl4 := TStringList.Create;
+ sl5 := TStringList.Create;
+ sl6 := TStringList.Create;
+ Series.Clear;
+
+ v1 := FValues1;
+ if (v1 <> '') and (v1[1] = ';') then
+ Delete(v1, 1, 1);
+ v2 := FValues2;
+ if (v2 <> '') and (v2[1] = ';') then
+ Delete(v2, 1, 1);
+ v3 := FValues3;
+ if (v3 <> '') and (v3[1] = ';') then
+ Delete(v3, 1, 1);
+ v4 := FValues4;
+ if (v4 <> '') and (v4[1] = ';') then
+ Delete(v4, 1, 1);
+ v5 := FValues5;
+ if (v5 <> '') and (v5[1] = ';') then
+ Delete(v5, 1, 1);
+ v6 := FValues6;
+ if (v6 <> '') and (v6[1] = ';') then
+ Delete(v6, 1, 1);
+
+ frxSetCommaText(v1, sl1);
+ frxSetCommaText(v2, sl2);
+ frxSetCommaText(v3, sl3);
+ frxSetCommaText(v4, sl4);
+ frxSetCommaText(v5, sl5);
+ frxSetCommaText(v6, sl6);
+
+ Helper := frxFindSeriesHelper(Series);
+
+ try
+ if sl2.Count > 0 then
+ begin
+ if (FTopN > 0) and (FTopN < sl2.Count) then
+ MakeTopN
+ else if FSortOrder <> soNone then
+ Sort;
+
+ for i := 0 to sl2.Count - 1 do
+ begin
+ if i < sl1.Count then v1 := sl1[i] else v1 := '';
+ if i < sl2.Count then v2 := sl2[i] else v2 := '';
+ if i < sl3.Count then v3 := sl3[i] else v3 := '';
+ if i < sl4.Count then v4 := sl4[i] else v4 := '';
+ if i < sl5.Count then v5 := sl5[i] else v5 := '';
+ if i < sl6.Count then v6 := sl6[i] else v6 := '';
+ Helper.AddValues(Series, v1, v2, v3, v4, v5, v6, FXType);
+ end;
+ end;
+
+ finally
+ Helper.Free;
+ sl1.Free;
+ sl2.Free;
+ sl3.Free;
+ sl4.Free;
+ sl5.Free;
+ sl6.Free;
+ end;
+end;
+
+
+{ TfrxSeriesData }
+
+constructor TfrxSeriesData.Create(Report: TfrxReport);
+begin
+ inherited Create(TfrxSeriesItem);
+ FReport := Report;
+end;
+
+function TfrxSeriesData.Add: TfrxSeriesItem;
+begin
+ Result := TfrxSeriesItem(inherited Add);
+end;
+
+function TfrxSeriesData.GetSeries(Index: Integer): TfrxSeriesItem;
+begin
+ Result := TfrxSeriesItem(inherited Items[Index]);
+end;
+
+
+{ TfrxChartView }
+
+constructor TfrxChartView.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ CreateChart;
+ FNormalSize := TBitmap.Create(0, 0);
+ FBigSize := TBitmap.Create(0, 0);
+ FSeriesData := TfrxSeriesData.Create(Report);
+end;
+
+destructor TfrxChartView.Destroy;
+begin
+ FChart.Free;
+ FNormalSize.Free;
+ FBigSize.Free;
+ inherited Destroy;
+ FSeriesData.Free;
+end;
+
+class function TfrxChartView.GetDescription: String;
+begin
+ Result := frxResources.Get('obChart');
+end;
+
+procedure TfrxChartView.Notification(AComponent: TComponent; Operation: TOperation);
+var
+ i: Integer;
+begin
+ inherited;
+ if Operation = opRemove then
+ begin
+ for i := 0 to FSeriesData.Count - 1 do
+ if AComponent is TfrxDataSet then
+ begin
+ if FSeriesData[i].DataSet = AComponent then
+ FSeriesData[i].DataSet := nil;
+ end
+ else if AComponent is TfrxBand then
+ begin
+ if FSeriesData[i].DataBand = AComponent then
+ FSeriesData[i].DataBand := nil;
+ end;
+ end;
+end;
+
+class function TfrxChartView.GetChartClass: TChartClass;
+begin
+ Result := TChart;
+end;
+
+procedure TfrxChartView.CreateChart;
+begin
+ FChart := GetChartClass.Create(Self);
+ with FChart do
+ begin
+ Color := claWhite;
+ BevelInner := bvNone;
+ BevelOuter := bvNone;
+ Name := 'Chart';
+ Frame.Visible := False;
+ View3DOptions.Rotation := 0;
+ Title.Text.Text := '';
+ end;
+end;
+
+procedure TfrxChartView.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ Filer.DefineBinaryProperty('Chart', ReadData, WriteData, True);
+ Filer.DefineProperty('ChartElevation', ReadData1, WriteData1, True);
+ Filer.DefineProperty('SeriesData', ReadData2, WriteData2, True);
+end;
+
+procedure TfrxChartView.ReadData(Stream: TStream);
+begin
+ FChart.Free;
+ CreateChart;
+ Stream.ReadComponent(FChart);
+end;
+
+procedure TfrxChartView.WriteData(Stream: TStream);
+begin
+ Stream.WriteComponent(FChart);
+end;
+
+procedure TfrxChartView.ReadData1(Reader: TReader);
+begin
+ FChart.View3DOptions.Elevation := Reader.ReadInteger;
+end;
+
+procedure TfrxChartView.WriteData1(Writer: TWriter);
+begin
+ Writer.WriteInteger(FChart.View3DOptions.Elevation);
+end;
+
+procedure TfrxChartView.ReadData2(Reader: TReader);
+begin
+ frxReadCollection(FSeriesData, Reader, Self);
+end;
+
+procedure TfrxChartView.SetHeight(Value: Double);
+begin
+ inherited;
+ if FSeriesData.Count > 0 then
+ FSeriesData[0].FIsDataChanged := True;
+end;
+
+procedure TfrxChartView.SetWidth(Value: Double);
+begin
+ inherited;
+ if FSeriesData.Count > 0 then
+ FSeriesData[0].FIsDataChanged := True;
+end;
+
+procedure TfrxChartView.WriteData2(Writer: TWriter);
+begin
+ frxWriteCollection(FSeriesData, Writer, Self);
+end;
+
+procedure TfrxChartView.FillChart;
+var
+ i: Integer;
+begin
+ for i := 0 to FSeriesData.Count - 1 do
+ FSeriesData[i].FillSeries(FChart.Series[i]);
+end;
+
+procedure TfrxChartView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+var
+{$IFNDEF MSWINDOWS}
+ i: Integer;
+ IsDataChanged: Boolean;
+{$ELSE}
+ OffsetM, ScaleM: TMatrix;
+ state: TCanvasSaveState;
+ OldM: TMatrix;
+ MetaF: TBitmap;
+{$ENDIF}
+begin
+ BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+ DrawBackground;
+{$IFNDEF MSWINDOWS}
+ IsDataChanged := False;
+ for i := 0 to FSeriesData.Count - 1 do
+ begin
+ IsDataChanged := FSeriesData[i].FIsDataChanged;
+ FSeriesData[i].FIsDataChanged := False;
+ end;
+
+ if IsDataChanged then
+ begin
+ FillChart;
+ if Color = claNull then
+ FChart.Color := claWhite else
+ FChart.Color := Color;
+ FChart.BufferedDisplay := True;
+ FNormalSize := FChart.TeeCreateBitmap(claNull,RectF(0, 0, Width, Height), 0);
+ end;
+ Canvas.DrawBitmap(FNormalSize, RectF(0, 0, Width, Height), RectF(FX, FY, FX1, FY1), 1, True);
+{$ELSE}
+ FillChart;
+ if Color = claNull then
+ FChart.Color := claWhite else
+ FChart.Color := Color;
+ FChart.BufferedDisplay := True;
+{$IFDEF DELPHI17}
+ if IsPrinting then
+ begin
+ // todo printing in low res
+ // with actual DPI TeeChart doesnt fit labels and text correct
+ // should be :
+ //MetaF := FChart.TeeCreateBitmap(claNull, RectF(0, 0, Width * ScaleX, Height * ScaleY ), 96);
+ MetaF := FChart.TeeCreateBitmap(claNull, RectF(0, 0, Width, Height ), 96);
+ try
+ Canvas.BeginScene();
+ // should be :
+ //Canvas.DrawBitmap(MetaF, RectF(0, 0, Width * ScaleX, Height * ScaleY), RectF(FX, FY, FX1, FY1), 1, True);
+ Canvas.DrawBitmap(MetaF, RectF(0, 0, Width , Height), RectF(FX, FY, FX1, FY1), 1, True);
+ if Canvas.BeginSceneCount > 0 then
+ Canvas.EndScene;
+ finally
+ MetaF.Free;
+ end;
+ end
+ else begin
+ OldM := Canvas.Matrix;
+ State := Canvas.SaveState;
+ try
+ ScaleM := CreateScaleMatrix(ScaleX, ScaleY);
+ OffsetM := CreateTranslateMatrix(FX, FY);
+ OffsetM := MatrixMultiply(OldM, OffsetM);
+ OffsetM := MatrixMultiply(ScaleM, OffsetM);
+ Canvas.SetMatrix(OffsetM);
+ FChart.Draw (Canvas, RectF(0, 0, Width , Height));
+ finally
+ Canvas.RestoreState(state);
+ Canvas.SetMatrix(OldM);
+ end;
+ end;
+{$ELSE}
+ OldM := Canvas.Matrix;
+ State := Canvas.SaveState;
+ try
+ ScaleM := CreateScaleMatrix(ScaleX, ScaleY);
+ OffsetM := CreateTranslateMatrix(FX, FY);
+ OffsetM := MatrixMultiply(OldM, OffsetM);
+ OffsetM := MatrixMultiply(ScaleM, OffsetM);
+ Canvas.SetMatrix(OffsetM);
+ FChart.Draw (Canvas, RectF(0, 0, Width , Height));
+ finally
+ Canvas.RestoreState(state);
+ Canvas.SetMatrix(OldM);
+ end;
+{$ENDIF}
+{$ENDIF}
+ DrawFrame;
+end;
+
+procedure TfrxChartView.AfterPrint;
+var
+ i: Integer;
+begin
+ for i := 0 to FSeriesData.Count - 1 do
+ with FSeriesData[i] do
+ begin
+ Values1 := '';
+ Values2 := '';
+ Values3 := '';
+ Values4 := '';
+ Values5 := '';
+ Values6 := '';
+ end;
+end;
+
+procedure TfrxChartView.GetData;
+var
+ i: Integer;
+ function ConvertVarToStr(Val: Variant): String;
+ begin
+ if not FIgnoreNulls and VarIsNull(Val) then
+ Result := '0'
+ else
+ Result := VarToStr(Val)
+ end;
+begin
+ inherited;
+ for i := 0 to FSeriesData.Count - 1 do
+ with FSeriesData[i] do
+ if (DataType = dtDBData) and (DataSet <> nil) then
+ begin
+ Values1 := '';
+ Values2 := '';
+ Values3 := '';
+ Values4 := '';
+ Values5 := '';
+ Values6 := '';
+
+ DataSet.First;
+ while not DataSet.Eof do
+ begin
+ if Source1 <> '' then
+ Values1 := Values1 + ';' + VarToStr(Report.Calc(Source1));
+ if Source2 <> '' then
+ Values2 := Values2 + ';' + ConvertVarToStr(Report.Calc(Source2));
+ if Source3 <> '' then
+ Values3 := Values3 + ';' + ConvertVarToStr(Report.Calc(Source3));
+ if Source4 <> '' then
+ Values4 := Values4 + ';' + ConvertVarToStr(Report.Calc(Source4));
+ if Source5 <> '' then
+ Values5 := Values5 + ';' + ConvertVarToStr(Report.Calc(Source5));
+ if Source6 <> '' then
+ Values6 := Values6 + ';' + ConvertVarToStr(Report.Calc(Source6));
+ DataSet.Next;
+ end;
+ end
+ else if DataType = dtFixedData then
+ begin
+ Values1 := Source1;
+ Values2 := Source2;
+ Values3 := Source3;
+ Values4 := Source4;
+ Values5 := Source5;
+ Values6 := Source6;
+ end
+end;
+
+procedure TfrxChartView.BeforeStartReport;
+var
+ i: Integer;
+begin
+ for i := 0 to FSeriesData.Count - 1 do
+ with FSeriesData[i] do
+ begin
+ Values1 := '';
+ Values2 := '';
+ Values3 := '';
+ Values4 := '';
+ Values5 := '';
+ Values6 := '';
+ end;
+ Report.Engine.NotifyList.Add(Self);
+end;
+
+procedure TfrxChartView.OnNotify(Sender: TObject);
+var
+ i: Integer;
+ function ConvertVarToStr(Val: Variant): String;
+ begin
+ if FIgnoreNulls and VarIsNull(Val) then
+ Result := '0'
+ else
+ Result := VarToStr(Val)
+ end;
+begin
+ inherited;
+ for i := 0 to FSeriesData.Count - 1 do
+ with FSeriesData[i] do
+ if (DataType = dtBandData) and (DataBand = Sender) then
+ begin
+ Report.CurObject := Self.Name;
+ if Source1 <> '' then
+ Values1 := Values1 + ';' + VarToStr(Report.Calc(Source1));
+ if Source2 <> '' then
+ Values2 := Values2 + ';' + ConvertVarToStr(Report.Calc(Source2));
+ if Source3 <> '' then
+ Values3 := Values3 + ';' + ConvertVarToStr(Report.Calc(Source3));
+ if Source4 <> '' then
+ Values4 := Values4 + ';' + ConvertVarToStr(Report.Calc(Source4));
+ if Source5 <> '' then
+ Values5 := Values5 + ';' + ConvertVarToStr(Report.Calc(Source5));
+ if Source6 <> '' then
+ Values6 := Values6 + ';' + ConvertVarToStr(Report.Calc(Source6));
+ end;
+end;
+
+procedure TfrxChartView.AddSeries(Series: TfrxChartSeries);
+var
+ sc: TSeriesClass;
+ s: TChartSeries;
+ b: Boolean;
+begin
+ sc := frxChartSeries[NativeInt(Series)];
+ s := TChartSeries(sc.NewInstance);
+ s.Create(Chart);
+ Chart.AddSeries(s);
+ SeriesData.Add;
+
+ with Chart do
+ begin
+ b := not (s is TPieSeries);
+ View3DOptions.Orthogonal := b;
+ AxisVisible := b;
+ View3DWalls := b;
+ end;
+end;
+
+procedure TfrxChartView.ClearSeries;
+begin
+ FChart.Free;
+ CreateChart;
+ SeriesData.Clear;
+end;
+
+
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxChartObject, TFmxObject);
+ RegisterTeeStandardSeries;
+ frxObjects.RegisterObject1(TfrxChartView, nil, '', '', 0, 125);
+
+finalization
+ frxObjects.UnRegister(TfrxChartView);
+
+end.
diff --git a/LibD28x64/FMX.frxChartEditor.fmx b/LibD28x64/FMX.frxChartEditor.fmx
new file mode 100644
index 0000000..b6274c1
--- /dev/null
+++ b/LibD28x64/FMX.frxChartEditor.fmx
@@ -0,0 +1,365 @@
+object frxChartEditorForm: TfrxChartEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Chart Editor'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 444
+ ClientWidth = 527
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object HintL: TLabel
+ Position.Point = '(276,172)'
+ Width = 198.000000000000000000
+ Height = 61.000000000000000000
+ TabOrder = 0
+ end
+ object OkB: TButton
+ Position.Point = '(367,415)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = OkBClick
+ HelpContext = 40
+ TabOrder = 1
+ ModalResult = 1
+ end
+ object Panel1: TPanel
+ Position.Point = '(2,2)'
+ Width = 217.000000000000000000
+ Height = 439.000000000000000000
+ TabOrder = 2
+ object Panel2: TPanel
+ Align = alTop
+ Position.Point = '(0,127)'
+ Width = 217.000000000000000000
+ Height = 8.000000000000000000
+ TabOrder = 0
+ end
+ object InspSite: TPanel
+ Align = alClient
+ Position.Point = '(0,135)'
+ Width = 217.000000000000000000
+ Height = 304.000000000000000000
+ TabOrder = 1
+ end
+ object Panel3: TPanel
+ Align = alTop
+ Width = 217.000000000000000000
+ Height = 127.000000000000000000
+ TabOrder = 2
+ object TreePanel: TPanel
+ Align = alRight
+ Position.Point = '(187,0)'
+ Width = 30.000000000000000000
+ Height = 127.000000000000000000
+ TabOrder = 0
+ object AddB: TSpeedButton
+ Position.Point = '(4,4)'
+ Width = 23.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = AddBClick
+ Font.Size = 16.000000000000000000
+ Font.Style = [fsBold]
+ Text = '+'
+ end
+ object DeleteB: TSpeedButton
+ Position.Point = '(4,28)'
+ Width = 23.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = DeleteBClick
+ Font.Size = 16.000000000000000000
+ Font.Style = [fsBold]
+ Text = '-'
+ end
+ object EditB: TSpeedButton
+ Position.Point = '(4,100)'
+ Width = 23.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ OnClick = EditBClick
+ end
+ object UPB: TSpeedButton
+ Position.Point = '(4,52)'
+ Width = 23.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = UPBClick
+ end
+ object DownB: TSpeedButton
+ Position.Point = '(4,76)'
+ Width = 23.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = DownBClick
+ end
+ end
+ object ChartTree: TfrxTreeView
+ Align = alClient
+ Width = 187.000000000000000000
+ Height = 127.000000000000000000
+ OnClick = ChartTreeClick
+ TabOrder = 1
+ Editable = False
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 0
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 1
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 2
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 3
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+ end
+ end
+ object CancelB: TButton
+ Position.Point = '(447,415)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 3
+ ModalResult = 2
+ Cancel = True
+ end
+ object SourcePanel: TPanel
+ Position.Point = '(224,0)'
+ Width = 305.000000000000000000
+ Height = 407.000000000000000000
+ TabOrder = 4
+ object DataSourceGB: TGroupBox
+ Position.Point = '(8,0)'
+ Width = 293.000000000000000000
+ Height = 99.000000000000000000
+ TabOrder = 0
+ object DBSourceRB: TRadioButton
+ Position.Point = '(8,20)'
+ Width = 109.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = DBSourceRBClick
+ TabOrder = 0
+ end
+ object BandSourceRB: TRadioButton
+ Position.Point = '(8,44)'
+ Width = 109.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = DBSourceRBClick
+ TabOrder = 1
+ end
+ object FixedDataRB: TRadioButton
+ Position.Point = '(8,68)'
+ Width = 153.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = DBSourceRBClick
+ TabOrder = 2
+ end
+ object DatasetsCB: TComboBox
+ Tag = 2
+ Position.Point = '(120,21)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ OnClick = DatasetsCBClick
+ TabOrder = 3
+ ItemIndex = -1
+ OnChange = DatasetsCBClick
+ end
+ object DatabandsCB: TComboBox
+ Tag = 6
+ Position.Point = '(120,45)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ OnClick = DatabandsCBClick
+ TabOrder = 4
+ ItemIndex = -1
+ OnChange = DatabandsCBClick
+ end
+ end
+ object ValuesGB: TGroupBox
+ Position.Point = '(8,104)'
+ Width = 293.000000000000000000
+ Height = 171.000000000000000000
+ TabOrder = 1
+ object Values1L: TLabel
+ Position.Point = '(12,20)'
+ Width = 101.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object Values2L: TLabel
+ Position.Point = '(12,44)'
+ Width = 101.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object Values3L: TLabel
+ Position.Point = '(12,68)'
+ Width = 101.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 2
+ end
+ object Values4L: TLabel
+ Position.Point = '(12,92)'
+ Width = 101.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 3
+ end
+ object Values5L: TLabel
+ Position.Point = '(12,116)'
+ Width = 101.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 4
+ end
+ object Values6L: TLabel
+ Position.Point = '(12,140)'
+ Width = 101.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 5
+ end
+ object Values1CB: TComboEdit
+ Tag = 3
+ Position.Point = '(120,16)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 6
+ ItemIndex = -1
+ OnChange = DoClick
+ end
+ object Values2CB: TComboEdit
+ Tag = 3
+ Position.Point = '(120,40)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 7
+ ItemIndex = -1
+ OnChange = DoClick
+ end
+ object Values3CB: TComboEdit
+ Tag = 3
+ Position.Point = '(120,64)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 8
+ ItemIndex = -1
+ OnChange = DoClick
+ end
+ object Values4CB: TComboEdit
+ Tag = 3
+ Position.Point = '(120,88)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 9
+ ItemIndex = -1
+ OnChange = DoClick
+ end
+ object Values5CB: TComboEdit
+ Tag = 3
+ Position.Point = '(120,112)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 10
+ ItemIndex = -1
+ OnChange = DoClick
+ end
+ object Values6CB: TComboEdit
+ Tag = 3
+ Position.Point = '(120,136)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 11
+ ItemIndex = -1
+ OnChange = DoClick
+ end
+ end
+ object OptionsGB: TGroupBox
+ Position.Point = '(8,280)'
+ Width = 293.000000000000000000
+ Height = 123.000000000000000000
+ TabOrder = 2
+ object ShowTopLbl: TLabel
+ Position.Point = '(12,44)'
+ Width = 109.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object CaptionLbl: TLabel
+ Position.Point = '(12,68)'
+ Width = 93.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object SortLbl: TLabel
+ Position.Point = '(12,20)'
+ Width = 101.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 2
+ end
+ object XLbl: TLabel
+ Position.Point = '(12,92)'
+ Width = 101.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 3
+ end
+ object TopNE: TEdit
+ Tag = 12
+ Position.Point = '(235,43)'
+ Width = 33.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 4
+ KeyboardType = vktDefault
+ OnChange = DoClick
+ Password = False
+ Text = '0'
+ end
+ object TopNCaptionE: TEdit
+ Tag = 13
+ Position.Point = '(120,65)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 5
+ KeyboardType = vktDefault
+ OnChange = DoClick
+ Password = False
+ end
+ object SortCB: TComboBox
+ Tag = 14
+ Position.Point = '(120,16)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ OnClick = DoClick
+ TabOrder = 6
+ ItemIndex = -1
+ end
+ object XTypeCB: TComboBox
+ Tag = 15
+ Position.Point = '(120,90)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 7
+ ItemIndex = -1
+ OnChange = DoClick
+ end
+ end
+ end
+end
diff --git a/LibD28x64/FMX.frxChartEditor.pas b/LibD28x64/FMX.frxChartEditor.pas
new file mode 100644
index 0000000..b47b901
--- /dev/null
+++ b/LibD28x64/FMX.frxChartEditor.pas
@@ -0,0 +1,828 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Chart design editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxChartEditor;
+
+interface
+{$I frx.inc}
+{$I tee.inc}
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.Menus, FMX.ExtCtrls, FMX.frxClass, FMX.frxChart, FMX.frxCustomEditors,
+ FMX.frxCtrls, FMX.frxInsp, FMX.Edit, FMX.ListBox, FMX.Layouts, FMX.TreeView,
+ FMX.Types, FMXTee.Procs, FMXTee.Engine, FMXTee.Chart, FMXTee.Series, {$IFDEF TeeChartPro}FMXTee.Commander, FMXTee.Editor.EditorPanel,{$ENDIF}
+ System.Variants, FMX.frxFMX, FMXTee.Chart.GalleryPanel, FMX.frxBaseModalForm
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI21}
+ , FMX.ComboEdit, FMX.Controls.Presentation
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+ TfrxChartEditor = class(TfrxViewEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+{$IFDEF LINUX}
+ TfrxChartEditorForm = class(TfrxForm)
+{$ELSE}
+ TfrxChartEditorForm = class(TForm)
+{$ENDIF}
+ OkB: TButton;
+ Panel1: TPanel;
+ Panel2: TPanel;
+ CancelB: TButton;
+ SourcePanel: TPanel;
+ DataSourceGB: TGroupBox;
+ DBSourceRB: TRadioButton;
+ BandSourceRB: TRadioButton;
+ FixedDataRB: TRadioButton;
+ DatasetsCB: TComboBox;
+ DatabandsCB: TComboBox;
+ ValuesGB: TGroupBox;
+ Values1CB: TComboEdit;
+ Values1L: TLabel;
+ Values2L: TLabel;
+ Values2CB: TComboEdit;
+ Values3L: TLabel;
+ Values3CB: TComboEdit;
+ Values4L: TLabel;
+ Values4CB: TComboEdit;
+ OptionsGB: TGroupBox;
+ ShowTopLbl: TLabel;
+ CaptionLbl: TLabel;
+ SortLbl: TLabel;
+ XLbl: TLabel;
+ TopNE: TEdit;
+ TopNCaptionE: TEdit;
+ SortCB: TComboBox;
+ XTypeCB: TComboBox;
+ InspSite: TPanel;
+ Values5L: TLabel;
+ Values5CB: TComboEdit;
+ HintL: TLabel;
+ Values6L: TLabel;
+ Values6CB: TComboEdit;
+ Panel3: TPanel;
+ TreePanel: TPanel;
+ AddB: TSpeedButton;
+ DeleteB: TSpeedButton;
+ EditB: TSpeedButton;
+ UPB: TSpeedButton;
+ DownB: TSpeedButton;
+ ChartTree: TfrxTreeView;
+ procedure FormShow(Sender: TObject);
+ procedure ChartTreeClick(Sender: TObject);
+ procedure AddBClick(Sender: TObject);
+ procedure DeleteBClick(Sender: TObject);
+ procedure DoClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure UpDown1Click(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure DatasetsCBClick(Sender: TObject);
+ procedure DatabandsCBClick(Sender: TObject);
+ procedure DBSourceRBClick(Sender: TObject);
+ procedure OkBClick(Sender: TObject);
+ procedure EditBClick(Sender: TObject);
+ procedure ChartTreeEdited(Sender: TObject; Node: TfrxTreeViewItem;
+ var S: String);
+ procedure ChartTreeEditing(Sender: TObject; OldNode: TfrxTreeViewItem; NewNode: TfrxTreeViewItem);
+ procedure UPBClick(Sender: TObject);
+ procedure DownBClick(Sender: TObject);
+ private
+ { Private declarations }
+ FChart: TfrxChartView;
+ FCurSeries: TfrxSeriesItem;
+ FInspector: TfrxObjectInspector;
+ FModified: Boolean;
+ FReport: TfrxReport;
+ FUpdating: Boolean;
+ FValuesGBHeight: Single;
+ procedure FillDropDownLists(ds: TfrxDataset);
+ procedure SetCurSeries(const Value: TfrxSeriesItem);
+ procedure SetModified(const Value: Boolean);
+ procedure ShowSeriesData;
+ procedure UpdateSeriesData;
+ property Modified: Boolean read FModified write SetModified;
+ property CurSeries: TfrxSeriesItem read FCurSeries write SetCurSeries;
+ public
+ { Public declarations }
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ property Chart: TfrxChartView read FChart write FChart;
+ end;
+
+
+implementation
+
+uses FMX.frxDsgnIntf, FMX.frxUtils, FMX.frxRes, FMX.frxChartHelpers, FMX.frxChartGallery;
+//{$IFDEF DELPHI16}
+//{$IFDEF TeeChartPro}, VCLTee.TeeEdit{$IFNDEF TeeChart4}, VCLTee.TeeEditCha{$ENDIF} {$ENDIF};
+//{$ELSE}
+//{$IFDEF TeeChartPro}, TeeEdit{$IFNDEF TeeChart4}, TeeEditCha{$ENDIF} {$ENDIF};
+//{$ENDIF}
+
+{$R *.FMX}
+
+type
+ THackControl = class(TControl);
+
+
+{ TfrxChartEditor }
+
+function TfrxChartEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+function TfrxChartEditor.Edit: Boolean;
+begin
+ with TfrxChartEditorForm.Create(Designer) do
+ begin
+ Chart.Assign(TfrxChartView(Component));
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ Self.Designer.PeekLastModalResult;
+ if Result then
+ TfrxChartView(Component).Assign(Chart);
+ Free;
+ end;
+end;
+
+function TfrxChartEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ i: Integer;
+ c: TfrxComponent;
+ v: TfrxChartView;
+begin
+ Result := inherited Execute(Tag, Checked);
+ for i := 0 to Designer.SelectedObjects.Count - 1 do
+ begin
+ c := Designer.SelectedObjects[i];
+ if (c is TfrxChartView) and not (rfDontModify in c.Restrictions) then
+ begin
+ v := TfrxChartView(c);
+ if Tag = 1 then
+ v.Chart.View3D := Checked
+ else if Tag = 2 then
+ v.Chart.AxisVisible := Checked;
+ Result := True;
+ end;
+ end;
+end;
+
+procedure TfrxChartEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ v: TfrxChartView;
+begin
+ v := TfrxChartView(Component);
+ AddItem(frxResources.Get('ch3D'), 1, v.Chart.View3D);
+ AddItem(frxResources.Get('chAxis'), 2, v.Chart.AxisVisible);
+ inherited;
+end;
+
+
+{ TfrxChartEditorForm }
+
+constructor TfrxChartEditorForm.Create(AOwner: TComponent);
+var
+ bmp: TBitmap;
+begin
+ inherited;
+ FReport := TfrxCustomDesigner(AOwner).Report;
+ FChart := TfrxChartView.Create(FReport);
+ FInspector := TfrxObjectInspector.Create(Owner);
+ with FInspector do
+ begin
+ SplitterPos := InspSite.Width / 2;
+ Box.Parent := InspSite;
+ Box.Align := alClient;
+ end;
+
+ { add chart image }
+ bmp := TBitmap.Create(24, 24);
+ //frxResources.LoadImageFromResouce(
+ //ObjectImages.Draw(bmp.Canvas, 0, 0, 25);
+ //frxAssignImages(bmp, 24, 24, ChartImages);
+ bmp.Free;
+ FValuesGBHeight := ValuesGB.Height;
+{$IFDEF TeeChartPro}
+ EditB.Visible := True;
+{$ENDIF}
+end;
+
+destructor TfrxChartEditorForm.Destroy;
+begin
+ FChart.Free;
+ inherited;
+end;
+
+procedure TfrxChartEditorForm.FormShow(Sender: TObject);
+
+ procedure FillChartTree;
+ var
+ i: Integer;
+ n: TfrxTreeViewItem;
+ begin
+ for i := 0 to FChart.Chart.SeriesCount - 1 do
+ begin
+
+ n := ChartTree.AddItem(ChartTree.Items[0], GetGallerySeriesName(FChart.Chart.Series[i]) + ' - ' + FChart.Chart.Series[i].Name);
+
+ n.OpenImageIndex := 0;
+ n.CloseImageIndex := 0;
+ end;
+
+ ChartTree.ExpandAll;
+ ChartTree.Selected := ChartTree.Items[0];
+ end;
+
+ procedure FillBandsList;
+ var
+ i: Integer;
+ c: TfrxComponent;
+ begin
+ for i := 0 to FReport.Designer.Objects.Count - 1 do
+ begin
+ c := FReport.Designer.Objects[i];
+ if c is TfrxDataBand then
+ DatabandsCB.Items.Add(c.Name);
+ end;
+ end;
+
+begin
+ ChartTree.AddItem(ChartTree, 'Root');
+ FReport.GetDatasetList(DatasetsCB.Items);
+ FillBandsList;
+ FillChartTree;
+ CurSeries := nil;
+ //Constraints.MinWidth := Width;
+ //Constraints.MinHeight := Height;
+ //Constraints.MaxHeight := Height;
+end;
+
+procedure TfrxChartEditorForm.ShowSeriesData;
+var
+ Helper: TfrxSeriesHelper;
+ sl: TStrings;
+ NewHeight: Single;
+begin
+ FUpdating := True;
+
+ if FCurSeries <> nil then
+ with FCurSeries do
+ begin
+ if DataType = dtDBData then
+ DBSourceRB.IsChecked := True
+ else if DataType = dtBandData then
+ BandSourceRB.IsChecked := True
+ else if DataType = dtFixedData then
+ FixedDataRB.IsChecked := True;
+ if Values1CB.Count > 0 then
+ Values1CB.ItemIndex := Values1CB.Items.IndexOf(FCurSeries.Source1)
+ else
+ Values1CB.Text := FCurSeries.Source1;
+
+ if Values2CB.Count > 0 then
+ Values2CB.ItemIndex := Values2CB.Items.IndexOf(FCurSeries.Source2)
+ else
+ Values2CB.Text := FCurSeries.Source2;
+ if Values3CB.Count > 0 then
+ Values3CB.ItemIndex := Values3CB.Items.IndexOf(FCurSeries.Source3)
+ else
+ Values3CB.Text := FCurSeries.Source3;
+ if Values4CB.Count > 0 then
+ Values4CB.ItemIndex := Values4CB.Items.IndexOf(FCurSeries.Source4)
+ else
+ Values4CB.Text := FCurSeries.Source4;
+ if Values5CB.Count > 0 then
+ Values5CB.ItemIndex := Values5CB.Items.IndexOf(FCurSeries.Source5)
+ else
+ Values5CB.Text := FCurSeries.Source5;
+ if Values6CB.Count > 0 then
+ Values6CB.ItemIndex := Values6CB.Items.IndexOf(FCurSeries.Source6)
+ else
+ Values6CB.Text := FCurSeries.Source6;
+ Helper := frxFindSeriesHelper(FChart.Chart.Series[FCurSeries.Index]);
+ sl := TStringList.Create;
+ frxSetCommaText(Helper.GetParamNames, sl);
+
+ NewHeight := FValuesGBHeight;
+ Values2CB.Visible := sl.Count >= 2;
+ Values2L.Visible := sl.Count >= 2;
+ if not Values2CB.Visible then
+ NewHeight := NewHeight - (Values2CB.Height + 4);
+ Values3CB.Visible := sl.Count >= 3;
+ Values3L.Visible := sl.Count >= 3;
+ if not Values3CB.Visible then
+ NewHeight := NewHeight - (Values3CB.Height + 4);
+ Values4CB.Visible := sl.Count >= 4;
+ Values4L.Visible := sl.Count >= 4;
+ if not Values4CB.Visible then
+ NewHeight := NewHeight - (Values4CB.Height + 4);
+ Values5CB.Visible := sl.Count >= 5;
+ Values5L.Visible := sl.Count >= 5;
+ if not Values5CB.Visible then
+ NewHeight := NewHeight - (Values5CB.Height + 4);
+ Values6CB.Visible := sl.Count >= 6;
+ Values6L.Visible := sl.Count >= 6;
+ if not Values6CB.Visible then
+ NewHeight := NewHeight - (Values6CB.Height + 4);
+
+ ValuesGB.Height := NewHeight;
+ OptionsGB.Position.Y := ValuesGB.Position.Y + ValuesGB.Height + 8;
+
+ if sl.Count > 0 then
+ Values1L.Text := sl[0];
+ if sl.Count > 1 then
+ Values2L.Text := sl[1];
+ if sl.Count > 2 then
+ Values3L.Text := sl[2];
+ if sl.Count > 3 then
+ Values4L.Text := sl[3];
+ if sl.Count > 4 then
+ Values5L.Text := sl[4];
+ if sl.Count > 5 then
+ Values6L.Text := sl[5];
+
+ sl.Free;
+ Helper.Free;
+
+
+ if DataSet = nil then
+ DatasetsCB.ItemIndex := -1
+ else
+ begin
+ DatasetsCB.ItemIndex := DatasetsCB.Items.IndexOf(FReport.GetAlias(DataSet));
+ DatasetsCBClick(nil);
+ end;
+
+ if DataBand = nil then
+ DatabandsCB.ItemIndex := -1
+ else
+ begin
+ DatabandsCB.ItemIndex := DatabandsCB.Items.IndexOf(DataBand.Name);
+ DatabandsCBClick(nil);
+ end;
+
+ TopNE.Text := IntToStr(TopN);
+ TopNCaptionE.Text := TopNCaption;
+ SortCB.ItemIndex := Integer(SortOrder);
+ XTypeCB.ItemIndex := Integer(XType);
+ end;
+
+ FUpdating := False;
+end;
+
+procedure TfrxChartEditorForm.UpdateSeriesData;
+begin
+ if FCurSeries <> nil then
+ with FCurSeries do
+ begin
+ if DBSourceRB.IsChecked then
+ DataType := dtDBData
+ else if BandSourceRB.IsChecked then
+ DataType := dtBandData
+ else if FixedDataRB.IsChecked then
+ DataType := dtFixedData;
+
+ if DatabandsCB.ItemIndex <> -1 then
+ DataBand := TfrxDataBand(FReport.FindObject(DatabandsCB.Items[DatabandsCB.ItemIndex]))
+ else
+ DataBand := nil;
+ if DatasetsCB.ItemIndex <> -1 then
+ DataSet := FReport.GetDataSet(DatasetsCB.Items[DatasetsCB.ItemIndex])
+ else
+ DataSet := nil;
+
+// if Values1CB.Selected <> nil then
+// Source1 := Values1CB.Selected.Text;
+// if Values2CB.Selected <> nil then
+// Source2 := Values2CB.Selected.Text;
+// if Values3CB.Selected <> nil then
+// Source3 := Values3CB.Selected.Text;
+// if Values4CB.Selected <> nil then
+// Source4 := Values4CB.Selected.Text;
+// if Values5CB.Selected <> nil then
+// Source5 := Values5CB.Selected.Text;
+// if Values6CB.Selected <> nil then
+// Source6 := Values6CB.Selected.Text;
+
+
+ Source1 := Values1CB.Text;
+ Source2 := Values2CB.Text;
+ Source3 := Values3CB.Text;
+ Source4 := Values4CB.Text;
+ Source5 := Values5CB.Text;
+ Source6 := Values6CB.Text;
+
+ SortOrder := TfrxSeriesSortOrder(SortCB.ItemIndex);
+ TopN := StrToInt(TopNE.Text);
+ TopNCaption := TopNCaptionE.Text;
+ XType := TfrxSeriesXType(XTypeCB.ItemIndex);
+ end;
+
+ Modified := False;
+end;
+
+procedure TfrxChartEditorForm.SetCurSeries(const Value: TfrxSeriesItem);
+var
+ InspectObj: TPersistent;
+begin
+ if Modified then
+ UpdateSeriesData;
+ FCurSeries := Value;
+
+ if FCurSeries = nil then
+ InspectObj := FChart.Chart
+ else
+ begin
+ InspectObj := FChart.Chart.Series[FCurSeries.Index];
+ UPB.Enabled := FCurSeries.Index > 0;
+ DownB.Enabled := (FCurSeries.Index < FChart.Chart.SeriesCount) and (FChart.Chart.SeriesCount <> FCurSeries.Index + 1);
+ end;
+ FInspector.Inspect([InspectObj]);
+ SourcePanel.Visible := FCurSeries <> nil;
+ HintL.Visible := not SourcePanel.Visible;
+ DeleteB.Visible := FCurSeries <> nil;
+ UPB.Visible := (FCurSeries <> nil);
+ DownB.Visible := (FCurSeries <> nil);
+ ShowSeriesData;
+end;
+
+procedure TfrxChartEditorForm.SetModified(const Value: Boolean);
+begin
+ if not FUpdating then
+ FModified := Value;
+end;
+
+procedure TfrxChartEditorForm.FillDropDownLists(ds: TfrxDataset);
+var
+ l: TStringList;
+ i: Integer;
+begin
+ if ds = nil then
+ begin
+{$IFDEF DELPHI23}
+ Values1CB.Clear;
+ Values2CB.Clear;
+ Values3CB.Clear;
+ Values4CB.Clear;
+ Values5CB.Clear;
+ Values6CB.Clear;
+{$ELSE}
+ Values1CB.Items.Clear;
+ Values2CB.Items.Clear;
+ Values3CB.Items.Clear;
+ Values4CB.Items.Clear;
+ Values5CB.Items.Clear;
+ Values6CB.Items.Clear;
+{$ENDIF}
+ end
+ else
+ begin
+ l := TStringList.Create;
+ try
+ ds.GetFieldList(l);
+ for i := 0 to l.Count - 1 do
+ l[i] := FReport.GetAlias(ds) + '."' + l[i] + '"';
+
+ Values1CB.Items := l;
+ Values2CB.Items := l;
+ Values3CB.Items := l;
+ Values4CB.Items := l;
+ Values5CB.Items := l;
+ Values6CB.Items := l;
+ finally
+ l.Free;
+ end;
+ end;
+end;
+
+procedure TfrxChartEditorForm.ChartTreeClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ i := ChartTree.Selected.GlobalIndex - 1;
+ if i >= 0 then
+ CurSeries := FChart.SeriesData[i] else
+ CurSeries := nil;
+end;
+
+{$HINTS OFF}
+procedure TfrxChartEditorForm.AddBClick(Sender: TObject);
+var
+ s: TChartSeries;
+ n: TfrxTreeViewItem;
+ b: Boolean;
+ ind, i: Integer;
+ TeeGalleryForm: TfrxChartGalleryForm;
+//{$IFDEF Delphi11}
+// TeeGalleryForm: TTeeGalleryForm;
+ ChartSeriesClass : TChartSeriesClass;
+ TeeFunctionClass : TTeeFunctionClass;
+//{$ENDIF}
+begin
+ ind := 0;
+{$IFDEF TeeChartStd7}
+ s := CreateNewSeriesGallery(nil, nil, FChart.Chart, False, False, ind);
+{$ELSE}
+
+//{$IFDEF Delphi11}
+ s := nil;
+ TeeGalleryForm := TfrxChartGalleryForm.Create(nil);
+{$IFDEF LINUX}
+ // TeeGalleryForm.Width := ScaleWidthOrHeightForm(TeeGalleryForm.ClientWidth, True);
+ // TeeGalleryForm.Height := ScaleWidthOrHeightForm(TeeGalleryForm.ClientHeight, False);
+{$ENDIF}
+// TeeGalleryForm := TTeeGalleryForm.Create(nil);
+ TeeGalleryForm.Position := TFormPosition.poScreenCenter;
+ if TeeGalleryForm.ShowModal = mrOk then
+ begin
+ ChartSeriesClass := nil;
+ TeeFunctionClass := nil;
+ TeeGalleryForm.GetGallery.GetSeriesClass(ChartSeriesClass, TeeFunctionClass, ind);
+ s := CreateNewSeries(nil, FChart.Chart, ChartSeriesClass, TeeFunctionClass);
+ end;
+//{$ELSE}
+// s := CreateNewSeriesGallery(nil, nil, FChart.Chart, False, False{$IFNDEF TeeChart4}{$IFDEF TeeChartPro}, ind{$ENDIF}{$ENDIF});
+//{$ENDIF}
+
+{$ENDIF}
+ if s = nil then
+ Exit;
+ FChart.SeriesData.Add;
+
+ with FChart.Chart do
+ begin
+ b := not (s is TPieSeries);
+ View3DOptions.Orthogonal := b;
+ AxisVisible := b;
+ View3DWalls := b;
+ end;
+
+ n := ChartTree.AddItem(ChartTree.ItemByGlobalIndex(0), GetGallerySeriesName(s) + ' - ' + s.Name);
+
+ n.OpenImageIndex := 0;
+ n.CloseImageIndex := 0;
+
+ ChartTree.Selected := n;
+
+ TeeGalleryForm.Free;
+
+ ChartTreeClick(nil);
+end;
+{$HINTS ON}
+
+procedure TfrxChartEditorForm.DeleteBClick(Sender: TObject);
+var
+ s: TChartSeries;
+begin
+ s := FChart.Chart.Series[FCurSeries.Index];
+ s.Free;
+ FCurSeries.Free;
+ ChartTree.Selected.Free;
+
+ ChartTree.SetFocus;
+ ChartTree.Selected := ChartTree.Items[0];
+ ChartTreeClick(nil);
+end;
+
+procedure TfrxChartEditorForm.EditBClick(Sender: TObject);
+begin
+{$IFDEF TeeChartPro}
+ with TChartEditor.Create(nil) do
+ begin
+ //TChartEditor.Create(nil).Chart;
+ Chart := FChart.Chart;
+ //F//mxTee.Editor.EditorPanel.
+ if FCurSeries <> nil then
+ Series := FChart.Chart.Series[FCurSeries.Index];
+
+ // HideTabs := [cetGeneral, cetTitles, cetPaging, cetSeriesData, cetMain,
+ // cetExport, {$IFDEF TeeChart7}cetExportNative,{$ENDIF} cetPrintPreview];
+ // Tab := DefaultTab - [ceDataSource, ceHelp, ceClone, ceTitle, ceAdd];
+
+ Execute;
+ Free;
+ end;
+{$ENDIF}
+end;
+
+procedure TfrxChartEditorForm.DoClick(Sender: TObject);
+begin
+ if not FUpdating then
+ Modified := True;
+end;
+
+procedure TfrxChartEditorForm.UpDown1Click(Sender: TObject);
+begin
+ DoClick(Sender);
+end;
+
+procedure TfrxChartEditorForm.DatasetsCBClick(Sender: TObject);
+var
+ ds: TfrxDataSet;
+begin
+ if DatasetsCB.ItemIndex = -1 then Exit;
+
+ ds := FReport.GetDataSet(DatasetsCB.Items[DatasetsCB.ItemIndex]);
+ FillDropDownLists(ds);
+ DoClick(nil);
+end;
+
+procedure TfrxChartEditorForm.DatabandsCBClick(Sender: TObject);
+var
+ db: TfrxDataBand;
+ ds: TfrxDataSet;
+begin
+ if DatabandsCB.ItemIndex = -1 then Exit;
+ db := TfrxDataBand(FReport.FindObject(DatabandsCB.Items[DatabandsCB.ItemIndex]));
+ if db <> nil then
+ ds := db.DataSet
+ else
+ ds := nil;
+ FillDropDownLists(ds);
+ DoClick(nil);
+end;
+
+procedure TfrxChartEditorForm.DBSourceRBClick(Sender: TObject);
+begin
+ DatasetsCB.ItemIndex := -1;
+ DatabandsCB.ItemIndex := -1;
+ FillDropDownLists(nil);
+ DoClick(nil);
+end;
+
+procedure TfrxChartEditorForm.OkBClick(Sender: TObject);
+begin
+ FInspector.FormDeactivate(nil);
+ CurSeries := nil;
+end;
+
+procedure TfrxChartEditorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(4100);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ //AddB.Hint := frxGet(4101);
+ //DeleteB.Hint := frxGet(4102);
+ //EditB.Hint := frxGet(4103);
+ {$IFDEF LINUX}
+ AddB.StyledSettings:= AddB.StyledSettings - [TStyledSetting.FontColor];
+ AddB.FontColor := TAlphaColorrec.Black;
+ DeleteB.StyledSettings:= AddB.StyledSettings - [TStyledSetting.FontColor];
+ DeleteB.FontColor := TAlphaColorrec.Black;
+ UPB.StyledSettings:= AddB.StyledSettings - [TStyledSetting.FontColor];
+ UPB.FontColor := TAlphaColorrec.Black;
+ DownB.StyledSettings:= AddB.StyledSettings - [TStyledSetting.FontColor];
+ DownB.FontColor := TAlphaColorrec.Black;
+ {$ENDIF}
+ DatasourceGB.Text := frxGet(4107);
+ DBSourceRB.Text := frxGet(4106);
+ BandSourceRB.Text := frxGet(4104);
+ FixedDataRB.Text := frxGet(4105);
+
+ ValuesGB.Text := frxGet(4108);
+ HintL.Text := frxGet(4109);
+
+ OptionsGB.Text := frxGet(4114);
+ ShowTopLbl.Text := frxGet(4115);
+ CaptionLbl.Text := frxGet(4116);
+ SortLbl.Text := frxGet(4117);
+ XLbl.Text := frxGet(4126);
+{$IFDEF DELPHI23}
+ XTypeCB.Clear;
+{$ELSE}
+ XTypeCB.Items.Clear;
+{$ENDIF}
+ XTypeCB.Items.Add(frxResources.Get('chxtText'));
+ XTypeCB.Items.Add(frxResources.Get('chxtNumber'));
+ XTypeCB.Items.Add(frxResources.Get('chxtDate'));
+{$IFDEF DELPHI23}
+ SortCB.Clear;
+{$ELSE}
+ SortCB.Items.Clear;
+{$ENDIF}
+ SortCB.Items.Add(frxResources.Get('chsoNone'));
+ SortCB.Items.Add(frxResources.Get('chsoAscending'));
+ SortCB.Items.Add(frxResources.Get('chsoDescending'));
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxChartEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+procedure TfrxChartEditorForm.ChartTreeEdited(Sender: TObject; Node: TfrxTreeViewItem;
+ var S: String);
+var
+ Ser: TChartSeries;
+begin
+ if FCurSeries <> nil then
+ begin
+ Ser := FChart.Chart.Series[FCurSeries.Index];
+ Ser.Name := S;
+ S := GetGallerySeriesName(Ser) + ' - ' + Ser.Name;
+ end;
+end;
+
+procedure TfrxChartEditorForm.ChartTreeEditing(Sender: TObject; OldNode: TfrxTreeViewItem; NewNode: TfrxTreeViewItem);
+//var
+// FEditHandle: HWND;
+begin
+// if Node.Parent = nil then
+// begin
+// AllowEdit := False;
+// exit;
+// end;
+// FEditHandle := HWND( SendMessage(ChartTree.Handle, $110F, 0, 0) );
+// if (FCurSeries <> nil) and (FEditHandle <> 0) then
+// Windows.SetWindowText(FEditHandle, PChar(FChart.Chart.Series[FCurSeries.Index].Name));
+end;
+
+procedure TfrxChartEditorForm.UPBClick(Sender: TObject);
+//var
+// tNode: TTreeNode;
+// idx: Integer;
+begin
+// idx := FCurSeries.Index;
+// FChart.Chart.SeriesUp(FChart.Chart.Series[idx]);
+// FChart.SeriesData.Items[idx].Index := idx - 1;
+//
+// with ChartTree.Items.GetFirstNode do
+// begin
+// tNode := Item[idx - 1];
+// Item[idx].MoveTo(tNode, naInsert);
+// ChartTree.Selected := Item[idx - 1];
+// end;
+//
+// ChartTree.SetFocus;
+// ChartTreeClick(nil);
+end;
+
+procedure TfrxChartEditorForm.DownBClick(Sender: TObject);
+//var
+// tNode: TTreeNode;
+// idx: Integer;
+begin
+// idx := FCurSeries.Index;
+// FChart.Chart.SeriesDown(FChart.Chart.Series[idx]);
+// FChart.SeriesData.Items[idx].Index := idx + 1;
+//
+// with ChartTree.Items.GetFirstNode do
+// begin
+// if idx + 2 = Count then
+// Item[idx].MoveTo(ChartTree.Items.GetFirstNode, naAddChild)
+// else
+// begin
+// tNode := Item[idx + 2];
+// Item[idx].MoveTo(tNode, naInsert);
+// end;
+// ChartTree.Selected := Item[idx + 1];
+// end;
+//
+// ChartTree.SetFocus;
+// ChartTreeClick(nil);
+end;
+
+initialization
+ frxComponentEditors.Register(TfrxChartView, TfrxChartEditor);
+ frxHideProperties(TChart, 'Align;AllowPanning;AllowZoom;Anchors;AnimatedZoom;' +
+ 'AnimatedZoomSteps;AutoSize;BackImage;BackImageInside;BackImageMode;' +
+ 'BevelInner;BevelOuter;BevelWidth;BorderStyle;BorderWidth;ClipPoints;Color;' +
+ 'Constraints;Cursor;DragCursor;DragKind;DragMode;DockSite;Enabled;Foot;Frame;Height;' +
+ 'HelpContext;HelpType;HelpKeyword;Hint;Left;Locked;MarginBottom;MarginLeft;MarginRight;MarginTop;' +
+ 'MaxPointsPerPage;Name;Page;ParentColor;ParentShowHint;PopupMenu;PrintProportional;' +
+ 'ScaleLastPage;ScrollMouseButton;SeriesList;ShowHint;TabOrder;TabStop;Tag;Top;UseDockManager;' +
+ 'Visible;Width');
+ frxHideProperties(TChartSeries, 'ColorSource;Cursor;DataSource;Name;' +
+ 'ParentChart;Tag;XLabelsSource');
+ frxHideProperties(TfrxChartView, 'SeriesData;BrushStyle');
+
+
+end.
diff --git a/LibD28x64/FMX.frxChartGallery.fmx b/LibD28x64/FMX.frxChartGallery.fmx
new file mode 100644
index 0000000..4d95c9c
--- /dev/null
+++ b/LibD28x64/FMX.frxChartGallery.fmx
@@ -0,0 +1,35 @@
+object frxChartGalleryForm: TfrxChartGalleryForm
+ Left = 0
+ Top = 0
+ Caption = 'frxChartGalleryForm'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 400
+ ClientWidth = 600
+ Visible = False
+ OnCreate = FormCreate
+ StyleLookup = 'backgroundstyle'
+ object ToolBar1: TToolBar
+ Align = alBottom
+ Position.Point = '(0,352)'
+ Width = 600.000000000000000000
+ Height = 48.000000000000000000
+ TabOrder = 0
+ object Button1: TButton
+ Position.Point = '(400,16)'
+ Width = 80.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 0
+ ModalResult = 1
+ Text = 'Ok'
+ end
+ object Button2: TButton
+ Position.Point = '(496,16)'
+ Width = 80.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Text = 'Cancel'
+ end
+ end
+end
diff --git a/LibD28x64/FMX.frxChartGallery.pas b/LibD28x64/FMX.frxChartGallery.pas
new file mode 100644
index 0000000..dd3dab3
--- /dev/null
+++ b/LibD28x64/FMX.frxChartGallery.pas
@@ -0,0 +1,85 @@
+unit FMX.frxChartGallery;
+{$I frx.inc}
+{$I tee.inc}
+interface
+
+uses
+ System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
+ FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs, FMXTee.Procs, FMXTee.Engine, FMXTee.Chart, FMXTee.Series,
+ FMX.frxFMX, FMXTee.Chart.GalleryPanel, FMXTee.Constants, FMX.TabControl
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+{$IFDEF LINUX}
+ TfrxChartGalleryForm = class(TfrxForm)
+{$ELSE}
+ TfrxChartGalleryForm = class(TForm)
+{$ENDIF}
+ ToolBar1: TToolBar;
+ Button1: TButton;
+ Button2: TButton;
+ procedure FormCreate(Sender: TObject);
+ private
+ FTeePanel: TChartGalleryPanel;
+ FTabs: TTabControl;
+ { Private declarations }
+ public
+ function GetGallery: TChartGalleryPanel;
+ { Public declarations }
+ end;
+
+
+implementation
+
+{$R *.fmx}
+procedure TfrxChartGalleryForm.FormCreate(Sender: TObject);
+var
+ tItem: TTabItem;
+ I: Integer;
+ SCGallary: array[0 .. 6] of String;
+begin
+ SCGallary[0] := TeeMsg_GalleryStandard;
+ SCGallary[1] := TeeMsg_GalleryExtended;
+ SCGallary[2] := '3D';
+ SCGallary[3] := 'Stats';
+ SCGallary[4] := 'Financial';
+ SCGallary[5] := 'Gauges';
+ SCGallary[6] := 'Other';
+ FTabs := TTabControl.Create(self);
+ FTabs.Parent := Self;
+ FTabs.Visible := True;
+ FTabs.Align := TAlignLayout.alClient;
+ FTabs.TabHeight := 20;
+
+ for I := 0 to High(SCGallary) do
+ begin
+ tItem := TTabItem.Create(FTabs);
+ tItem.Parent := FTabs;
+ tItem.Text := SCGallary[i];
+ FTabs.AddObject(tItem);
+ tItem.Align := TAlignLayout.alClient;
+
+ FTeePanel := TChartGalleryPanel.Create(tItem);
+ FTeePanel.Parent := tItem;
+ FTeePanel.Visible := True;
+ FTeePanel.Align := TAlignLayout.alClient;
+ FTeePanel.CreateGalleryPage(SCGallary[i]);
+ tItem.Tag := NativeInt(FTeePanel);
+ end;
+ FTabs.TabIndex := 0;
+end;
+
+function TfrxChartGalleryForm.GetGallery: TChartGalleryPanel;
+begin
+ Result := TChartGalleryPanel(FTabs.ActiveTab.Tag);
+end;
+
+end.
diff --git a/LibD28x64/FMX.frxChartHelpers.pas b/LibD28x64/FMX.frxChartHelpers.pas
new file mode 100644
index 0000000..10f5ac3
--- /dev/null
+++ b/LibD28x64/FMX.frxChartHelpers.pas
@@ -0,0 +1,573 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ TeeChart series helpers }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxChartHelpers;
+
+interface
+
+{$I frx.inc}
+{$I tee.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UIConsts, FMX.Types, FMX.Menus, FMX.Controls, FMX.frxChart,
+ FMXTee.Procs, FMXTee.Engine, FMXTee.Chart, FMXTee.Series, FMXTee.Canvas
+{$IFDEF TeeChartPro}
+, FMXTee.Series.Polar,
+{$IFNDEF TeeChart4}
+ FMXTee.Series.Smith, FMXTee.Series.Pyramid, FMXTee.Series.Donut, FMXTee.Series.Funnel, FMXTee.Series.BoxPlot, FMXTee.Series.TriSurface,{$ENDIF}
+ FMXTee.Series.Bezier, FMXTee.Series.OHLC, FMXTee.Series.Candle, FMXTee.Series.Error, FMXTee.Functions.Stats,
+ FMXTee.Series.Surface, FMXTee.Series.Point3D, FMXTee.Series.Bar3D
+{$IFDEF TeeChart7}
+, FMXTee.TeeGauges, FMXTee.TeePointFigure
+{$ENDIF}
+{$ENDIF}
+
+, System.Variants
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+
+type
+ TfrxSeriesHelper = class(TObject)
+ public
+ function GetParamNames: String; virtual; abstract;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); virtual; abstract;
+ end;
+
+ TfrxStdSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+ TfrxPieSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+{$IFDEF TeeChartPro}
+ TfrxPolarSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+ TfrxGaugeSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+ TfrxSmithSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+ TfrxCandleSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+ TfrxErrorSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+ TfrxHiLoSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+ TfrxFunnelSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+ TfrxSurfaceSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+ TfrxVector3DSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+ TfrxBubble3DSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+
+ TfrxBar3DSeriesHelper = class(TfrxSeriesHelper)
+ public
+ function GetParamNames: String; override;
+ procedure AddValues(Series: TChartSeries; const v1, v2, v3, v4, v5, v6: String;
+ XType: TfrxSeriesXType); override;
+ end;
+{$ENDIF}
+
+ TfrxSeriesHelperClass = class of TfrxSeriesHelper;
+
+
+const
+{$IFDEF TeeChartPro}
+ frxNumSeries = 38;
+{$ELSE}
+ frxNumSeries = 7;
+{$ENDIF}
+ frxChartSeries: array[0..frxNumSeries - 1] of TSeriesClass =
+ (TLineSeries, TAreaSeries, TPointSeries,
+ TBarSeries, THorizBarSeries, TPieSeries,
+ TFastLineSeries
+{$IFDEF TeeChartPro}
+ , {$IFDEF TeeChart7}THorizAreaSeries{$ELSE}nil{$ENDIF}, {$IFNDEF TeeChart4}THorizLineSeries{$ELSE}nil{$ENDIF}, TPolarSeries,
+ TRadarSeries, {$IFDEF TeeChart7}TPolarBarSeries{$ELSE}nil{$ENDIF}, {$IFDEF TeeChart7}TGaugeSeries{$ELSE}nil{$ENDIF},
+ {$IFNDEF TeeChart4}TSmithSeries, TPyramidSeries, TDonutSeries{$ELSE}nil, nil, nil{$ENDIF},
+ TBezierSeries, TCandleSeries, TVolumeSeries,
+ {$IFDEF TeeChart7}TPointFigureSeries{$ELSE}nil{$ENDIF}, {$IFNDEF TeeChart4}THistogramSeries{$ELSE}nil{$ENDIF}, {$IFDEF TeeChart7}THorizHistogramSeries{$ELSE}nil{$ENDIF},
+ TErrorBarSeries, TErrorSeries, {$IFNDEF TeeChart4}THighLowSeries{$ELSE}nil{$ENDIF},
+ {$IFNDEF TeeChart4}TFunnelSeries, TBoxSeries, THorizBoxSeries{$ELSE}nil, nil, nil{$ENDIF},
+ TSurfaceSeries, TContourSeries, {$IFNDEF TeeChart4}TWaterFallSeries,
+ TColorGridSeries{$ELSE}nil, nil{$ENDIF}, {$IFDEF TeeChart7}TVector3DSeries{$ELSE}nil{$ENDIF}, {$IFDEF TeeChart7}TTowerSeries{$ELSE}nil{$ENDIF},
+ {$IFNDEF TeeChart4}TTriSurfaceSeries{$ELSE}nil{$ENDIF}, TPoint3DSeries, {$IFDEF TeeChart7}TBubble3DSeries{$ELSE}nil{$ENDIF},
+ TBar3DSeries
+{$ENDIF}
+ );
+ frxSeriesHelpers: array[0..frxNumSeries - 1] of TfrxSeriesHelperClass =
+ (TfrxStdSeriesHelper, TfrxStdSeriesHelper, TfrxStdSeriesHelper,
+ TfrxStdSeriesHelper, TfrxStdSeriesHelper, TfrxPieSeriesHelper,
+ TfrxStdSeriesHelper
+{$IFDEF TeeChartPro}
+ , TfrxStdSeriesHelper, TfrxStdSeriesHelper, TfrxPolarSeriesHelper,
+ TfrxPolarSeriesHelper, TfrxPolarSeriesHelper, TfrxGaugeSeriesHelper,
+ TfrxSmithSeriesHelper, TfrxStdSeriesHelper, TfrxPieSeriesHelper,
+ TfrxStdSeriesHelper, TfrxCandleSeriesHelper, TfrxStdSeriesHelper,
+ TfrxCandleSeriesHelper, TfrxStdSeriesHelper, TfrxStdSeriesHelper,
+ TfrxErrorSeriesHelper, TfrxErrorSeriesHelper, TfrxHiLoSeriesHelper,
+ TfrxFunnelSeriesHelper, TfrxStdSeriesHelper, TfrxStdSeriesHelper,
+ TfrxSurfaceSeriesHelper, TfrxSurfaceSeriesHelper, TfrxSurfaceSeriesHelper,
+ TfrxSurfaceSeriesHelper, TfrxVector3DSeriesHelper, TfrxSurfaceSeriesHelper,
+ TfrxSurfaceSeriesHelper, TfrxSurfaceSeriesHelper, TfrxBubble3DSeriesHelper,
+ TfrxBar3DSeriesHelper
+{$ENDIF}
+ );
+
+
+function frxFindSeriesHelper(Series: TChartSeries): TfrxSeriesHelper;
+
+
+implementation
+
+uses FMX.frxDsgnIntf, FMX.frxUtils, FMX.frxRes;
+
+
+function CheckNulls(Value: String): Boolean;
+begin
+ Result := (UpperCase(Value) = 'NULL') or (Value = '');
+end;
+
+function frxFindSeriesHelper(Series: TChartSeries): TfrxSeriesHelper;
+var
+ i: Integer;
+begin
+ Result := nil;
+ for i := 0 to frxNumSeries - 1 do
+ if Series.ClassType = frxChartSeries[i] then
+ begin
+ Result := TfrxSeriesHelper(frxSeriesHelpers[i].NewInstance);
+ Result.Create;
+ break;
+ end;
+
+ if Result = nil then
+ Result := TfrxStdSeriesHelper.Create;
+end;
+
+{ TfrxStdSeriesHelper }
+
+procedure TfrxStdSeriesHelper.AddValues(Series: TChartSeries; const v1, v2,
+ v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+var
+ d: Double;
+ Color: TColor;
+ s: String;
+begin
+ d := 0;
+ Color := clTeeColor;
+ if v4 <> '' then
+ try
+ Color := StringToColor(v4);
+ except
+ end;
+ if CheckNulls(v2) then
+ begin
+ Series.AddNull(v1);
+ Exit;
+ end;
+ if Series.YValues.DateTime then
+ d := StrToDateTime(v2)
+ else if frxIsValidFloat(v2) then
+ d := frxStrToFloat(v2);
+ if v3 <> '' then
+ s := v3
+ else
+ s := v1;
+ case XType of
+ xtText:
+ Series.Add(d, v1, Color);
+ xtNumber:
+ Series.AddXY(frxStrToFloat(s), d, v1, Color);
+ xtDate:
+ Series.AddXY(StrToDateTime(s), d, v1, Color);
+ end;
+end;
+
+function TfrxStdSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Label;Y;X (optional);Color (optional)';
+end;
+
+
+{ TfrxPieSeriesHelper }
+
+procedure TfrxPieSeriesHelper.AddValues(Series: TChartSeries; const v1, v2,
+ v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+var
+ d: Double;
+ c: TColor;
+begin
+ if CheckNulls(v2) then
+ begin
+ Series.AddNull(v1);
+ Exit;
+ end;
+
+ if Series.YValues.DateTime then
+ d := StrToDateTime(v2)
+ else
+ d := frxStrToFloat(v2);
+
+ c := clTeeColor;
+ if v3 <> '' then
+ try
+ c := StringToColor(v3);
+ except
+ end;
+
+ Series.Add(d, v1, c);
+end;
+
+function TfrxPieSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Label;Pie;Color (optional)';
+end;
+
+
+{$IFDEF TeeChartPro}
+{ TfrxPolarSeriesHelper }
+
+procedure TfrxPolarSeriesHelper.AddValues(Series: TChartSeries; const v1,
+ v2, v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+var
+ Color: TColor;
+begin
+ if CheckNulls(v2) or CheckNulls(v3) then
+ begin
+ Series.AddNull(v1);
+ Exit;
+ end;
+ Color := clTeeColor;
+ if v4 <> '' then
+ try
+ Color := StringToColor(v4);
+ except
+ end;
+ Series.AddXY(frxStrToFloat(v2), frxStrToFloat(v3), v1, Color);
+end;
+
+function TfrxPolarSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Label;Angle;Value;Color (optional)';
+end;
+
+{ TfrxGaugeSeriesHelper }
+
+procedure TfrxGaugeSeriesHelper.AddValues(Series: TChartSeries; const v1,
+ v2, v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+var
+ Color: TColor;
+begin
+ if CheckNulls(v2) then
+ begin
+ Series.AddNull(v1);
+ Exit;
+ end;
+ Color := clTeeColor;
+ if v3 <> '' then
+ try
+ Color := StringToColor(v3);
+ except
+ end;
+ Series.Clear;
+ Series.Add(frxStrToFloat(v2), v1, Color);
+end;
+
+function TfrxGaugeSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Label (optional);Value;Color (optional)';
+end;
+
+
+{ TfrxSmithSeriesHelper }
+
+procedure TfrxSmithSeriesHelper.AddValues(Series: TChartSeries; const v1,
+ v2, v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+begin
+{$IFNDEF TeeChart4}
+ if CheckNulls(v2) or CheckNulls(v3) then
+ begin
+ Series.AddNull(v1);
+ Exit;
+ end;
+ TSmithSeries(Series).AddPoint(frxStrToFloat(v2), frxStrToFloat(v3), v1);
+{$ENDIF}
+end;
+
+function TfrxSmithSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Label;Resistance;Reactance';
+end;
+
+
+{ TfrxCandleSeriesHelper }
+
+procedure TfrxCandleSeriesHelper.AddValues(Series: TChartSeries; const v1,
+ v2, v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+begin
+ TOHLCSeries(Series).AddOHLC(StrToDateTime(v1),
+ frxStrToFloat(v2), frxStrToFloat(v3), frxStrToFloat(v4), frxStrToFloat(v5));
+end;
+
+function TfrxCandleSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Date;Open;High;Low;Close';
+end;
+
+
+{ TfrxErrorSeriesHelper }
+
+procedure TfrxErrorSeriesHelper.AddValues(Series: TChartSeries; const v1,
+ v2, v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+begin
+ if CheckNulls(v2) or CheckNulls(v3) or CheckNulls(v4) then
+ begin
+ Series.AddNull(v1);
+ Exit;
+ end;
+ TCustomErrorSeries(Series).AddErrorBar(frxStrToFloat(v2), frxStrToFloat(v3),
+ frxStrToFloat(v4), v1);
+end;
+
+function TfrxErrorSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Label;X;Y;Error';
+end;
+
+
+{ TfrxHiLoSeriesHelper }
+
+procedure TfrxHiLoSeriesHelper.AddValues(Series: TChartSeries; const v1,
+ v2, v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+begin
+{$IFNDEF TeeChart4}
+ if CheckNulls(v2) or CheckNulls(v3) or CheckNulls(v4) then
+ begin
+ Series.AddNull(v1);
+ Exit;
+ end;
+ THighLowSeries(Series).AddHighLow(frxStrToFloat(v2), frxStrToFloat(v3),
+ frxStrToFloat(v4), v1);
+{$ENDIF}
+end;
+
+function TfrxHiLoSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Label;X;High;Low';
+end;
+
+
+{ TfrxFunnelSeriesHelper }
+
+procedure TfrxFunnelSeriesHelper.AddValues(Series: TChartSeries; const v1,
+ v2, v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+{$IFNDEF TeeChart4}
+var
+ Color: TColor;
+{$ENDIF}
+begin
+{$IFNDEF TeeChart4}
+ if CheckNulls(v2) or CheckNulls(v3) then
+ begin
+ Series.AddNull(v1);
+ Exit;
+ end;
+ Color := clTeeColor;
+ if v4 <> '' then
+ try
+ Color := StringToColor(v4);
+ except
+ end;
+ TFunnelSeries(Series).AddSegment(frxStrToFloat(v2), frxStrToFloat(v3), v1, Color);
+{$ENDIF}
+end;
+
+function TfrxFunnelSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Label;Quote;Opportunity;Color (optional)';
+end;
+
+
+{ TfrxSurfaceSeriesHelper }
+
+procedure TfrxSurfaceSeriesHelper.AddValues(Series: TChartSeries; const v1,
+ v2, v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+var
+ Color: TColor;
+begin
+ if CheckNulls(v2) or CheckNulls(v3) or CheckNulls(v4) then
+ begin
+ Series.AddNull(v1);
+ Exit;
+ end;
+ Color := clTeeColor;
+ if v5 <> '' then
+ try
+ Color := StringToColor(v5);
+ except
+ end;
+{$IFDEF TeeChart4}
+ TCustom3DSeries(Series).AddXYZ(Round(frxStrToFloat(v2)), frxStrToFloat(v3),
+ Round(frxStrToFloat(v4)), v1, Color);
+{$ELSE}
+ TCustom3DSeries(Series).AddXYZ(frxStrToFloat(v2), frxStrToFloat(v3),
+ frxStrToFloat(v4), v1, Color);
+{$ENDIF}
+end;
+
+function TfrxSurfaceSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Label;X;Y;Z;Color (optional)';
+end;
+
+
+{ TfrxVector3DSeriesHelper }
+
+procedure TfrxVector3DSeriesHelper.AddValues(Series: TChartSeries;
+ const v1, v2, v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+begin
+{$IFDEF TeeChart7}
+ TVector3DSeries(Series).AddVector(frxStrToFloat(v1), frxStrToFloat(v2),
+ frxStrToFloat(v3), frxStrToFloat(v4), frxStrToFloat(v5), frxStrToFloat(v6));
+{$ENDIF}
+end;
+
+function TfrxVector3DSeriesHelper.GetParamNames: String;
+begin
+ Result := 'X1;Y1;Z1;X2;Y2;Z2';
+end;
+
+
+{ TfrxBubble3DSeriesHelper }
+
+procedure TfrxBubble3DSeriesHelper.AddValues(Series: TChartSeries;
+ const v1, v2, v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+{$IFDEF TeeChart7}
+var
+ Color: TColor;
+{$ENDIF}
+begin
+{$IFDEF TeeChart7}
+ if CheckNulls(v2) or CheckNulls(v3) or
+ CheckNulls(v4) or CheckNulls(v5) then
+ begin
+ Series.AddNull(v1);
+ Exit;
+ end;
+ Color := clTeeColor;
+ if v6 <> '' then
+ try
+ Color := StringToColor(v6);
+ except
+ end;
+ TBubble3DSeries(Series).AddBubble(frxStrToFloat(v2), frxStrToFloat(v3),
+ frxStrToFloat(v4), frxStrToFloat(v5), v1, Color);
+{$ENDIF}
+end;
+
+function TfrxBubble3DSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Label;X;Y;Z;Radius;Color (optional)';
+end;
+
+
+{ TfrxBar3DSeriesHelper }
+
+procedure TfrxBar3DSeriesHelper.AddValues(Series: TChartSeries; const v1,
+ v2, v3, v4, v5, v6: String; XType: TfrxSeriesXType);
+var
+ Color: TColor;
+begin
+ if CheckNulls(v2) or CheckNulls(v3) or CheckNulls(v4) then
+ begin
+ Series.AddNull(v1);
+ Exit;
+ end;
+ Color := clTeeColor;
+ if v5 <> '' then
+ try
+ Color := StringToColor(v5);
+ except
+ end;
+ TBar3DSeries(Series).AddBar(frxStrToFloat(v2), frxStrToFloat(v3),
+ frxStrToFloat(v4), v1, Color);
+end;
+
+function TfrxBar3DSeriesHelper.GetParamNames: String;
+begin
+ Result := 'Label;X;Y;Offset;Color (optional)';
+end;
+{$ENDIF}
+
+end.
diff --git a/LibD28x64/FMX.frxChartRTTI.pas b/LibD28x64/FMX.frxChartRTTI.pas
new file mode 100644
index 0000000..35602c1
--- /dev/null
+++ b/LibD28x64/FMX.frxChartRTTI.pas
@@ -0,0 +1,116 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Chart RTTI }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxChartRTTI;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, System.SysUtils, FMX.Forms, FMX.fs_iinterpreter, FMX.frxChart, FMX.fs_ichartrtti
+, System.Variants, System.Types, FMXTee.Engine;
+
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TfrxSeriesDataType', 'dtDBData, dtBandData, dtFixedData');
+ AddEnum('TfrxChartSeries', 'csLine, csArea, csPoint, csBar, csHorizBar, '+
+ 'csPie, csGantt, csFastLine, csArrow, csBubble, csChartShape, csHorizArea, '+
+ 'csHorizLine, csPolar, csRadar, csPolarBar, csGauge, csSmith, csPyramid, '+
+ 'csDonut, csBezier, csCandle, csVolume, csPointFigure, csHistogram, '+
+ 'csHorizHistogram, csErrorBar, csError, csHighLow, csFunnel, csBox, '+
+ 'csHorizBox, csSurface, csContour, csWaterFall, csColorGrid, csVector3D, '+
+ 'csTower, csTriSurface, csPoint3D, csBubble3D, csMyPoint, csBarJoin, csBar3D');
+ AddClass(TfrxSeriesItem, 'TPersistent');
+ with AddClass(TfrxSeriesData, 'TPersistent') do
+ begin
+ AddMethod('function Add: TfrxSeriesItem', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TfrxSeriesItem', CallMethod, True);
+ end;
+ with AddClass(TfrxChartView, 'TfrxView') do
+ begin
+ AddProperty('Chart', 'TChart', GetProp, nil);
+ AddIndexProperty('Series', 'Integer', 'TChartSeries', CallMethod, True);
+ AddProperty('SeriesData', 'TfrxSeriesData', GetProp, nil);
+ AddProperty('SeriesCount', 'Integer', GetProp, nil);
+ AddMethod('procedure AddSeries(ASeries:TfrxChartSeries)', CallMethod);
+ end;
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TfrxSeriesData then
+ begin
+ if MethodName = 'ADD' then
+ Result := frxInteger(TfrxSeriesData(Instance).Add)
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TfrxSeriesData(Instance).Items[Caller.Params[0]])
+ end
+ else if ClassType = TfrxChartView then
+ begin
+ if MethodName = 'SERIES.GET' then
+ Result := frxInteger(TfrxChartView(Instance).Chart.Series[Caller.Params[0]])
+ else
+ if MethodName = 'ADDSERIES' then
+ TfrxChartView(Instance).AddSeries(TfrxChartSeries(Caller.Params[0]));
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TfrxChartView then
+ begin
+ if PropName = 'CHART' then
+ Result := frxInteger(TfrxChartView(Instance).Chart)
+ else if PropName = 'SERIESCOUNT' then
+ Result:=TfrxChartView(Instance).Chart.SeriesCount
+ else if PropName = 'SERIESDATA' then
+ Result := frxInteger(TfrxChartView(Instance).SeriesData)
+ end
+end;
+
+
+initialization
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ if fsRTTIModules <> nil then
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28x64/FMX.frxClass.pas b/LibD28x64/FMX.frxClass.pas
new file mode 100644
index 0000000..a355bfc
--- /dev/null
+++ b/LibD28x64/FMX.frxClass.pas
@@ -0,0 +1,10116 @@
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ Report classes }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxClass;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, System.WideStrings,
+ System.Types, System.SyncObjs, System.IniFiles, System.Variants, FMX.Platform,
+ FMX.Types, FMX.Printer, FMX.Forms, System.StrUtils, System.UIConsts,
+ FMX.frxVariables, FMX.frxXML, FMX.frxProgress,
+ FMX.fs_iinterpreter, FMX.frxUnicodeUtils, FMX.frxFMX, FMX.frxBaseModalForm
+{$IFDEF LINUX}
+ ,FMUX.Api
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.Controls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI22}
+ , FMX.ActnList
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+const
+ fr01cm: Double = 3.77953;
+ fr1cm: Double = 37.7953;
+ fr01in: Double = 9.6;
+ fr1in: Integer = 96;
+ fr1CharX: Double = 9.6;
+ fr1CharY: Integer = 17;
+ frxDefPPI: Integer = 96;
+
+type
+ TfrxReport = class;
+ TfrxPage = class;
+ TfrxReportPage = class;
+ TfrxDialogPage = class;
+ TfrxCustomEngine = class;
+ TfrxCustomDesigner = class;
+ TfrxCustomPreview = class;
+ TfrxCustomPreviewPages = class;
+ TfrxComponent = class;
+ TfrxReportComponent = class;
+ TfrxView = class;
+ TfrxStyleItem = class;
+ TfrxCustomExportFilter = class;
+ TfrxCustomCompressor = class;
+ TfrxCustomDatabase = class;
+ TfrxFrame = class;
+ TfrxDataSet = class;
+
+ TfrxNotifyEvent = type String;
+ TfrxCloseQueryEvent = type String;
+ TfrxKeyEvent = type String;
+ TfrxKeyPressEvent = type String;
+ TfrxMouseEvent = type String;
+ TfrxMouseMoveEvent = type String;
+ TfrxPreviewClickEvent = type String;
+ TfrxRunDialogsEvent = type String;
+
+ EDuplicateName = class(Exception);
+ EExportTerminated = class(TObject);
+
+ SYSINT = Integer;
+
+ TfrxComponentStyle = set of (csContainer, csPreviewVisible, csDefaultDiff);
+ TfrxStretchMode = (smDontStretch, smActualHeight, smMaxHeight);
+ TfrxShiftMode = (smDontShift, smAlways, smWhenOverlapped);
+ TfrxDuplexMode = (dmNone, dmVertical, dmHorizontal, dmSimplex);
+
+ TfrxAlign = (baNone, baLeft, baRight, baCenter, baWidth, baBottom, baClient);
+
+ TfrxFrameStyle = (fsSolid, fsDash, fsDot, fsDashDot, fsDashDotDot, fsDouble, fsAltDot, fsSquare);
+
+ TfrxFrameType = (ftLeft, ftRight, ftTop, ftBottom);
+ TfrxFrameTypes = set of TfrxFrameType;
+
+ TfrxFormatKind = (fkText, fkNumeric, fkDateTime, fkBoolean);
+
+ TfrxHAlign = (haLeft, haRight, haCenter, haBlock);
+ TfrxVAlign = (vaTop, vaBottom, vaCenter);
+
+ TfrxSilentMode = (simMessageBoxes, simSilent, simReThrow);
+ TfrxRestriction = (rfDontModify, rfDontSize, rfDontMove, rfDontDelete, rfDontEdit);
+ TfrxRestrictions = set of TfrxRestriction;
+
+ TfrxShapeKind = (skRectangle, skRoundRectangle, skEllipse, skTriangle,
+ skDiamond, skDiagonal1, skDiagonal2);
+
+ TfrxPreviewButton = (pbPrint, pbLoad, pbSave, pbExport, pbZoom, pbFullScreen,
+ pbOutline, pbThumbnails, pbPageSetup, pbEdit, pbNavigator, pbClose);
+ TfrxPreviewButtons = set of TfrxPreviewButton;
+ TfrxZoomMode = (zmDefault, zmWholePage, zmPageWidth, zmManyPages);
+ TfrxPrintPages = (ppAll, ppOdd, ppEven);
+ TfrxAddPageAction = (apWriteOver, apAdd);
+ TfrxRangeBegin = (rbFirst, rbCurrent);
+ TfrxRangeEnd = (reLast, reCurrent, reCount);
+ TfrxFieldType = (fftNumeric, fftString, fftBoolean);
+ TfrxProgressType = (ptRunning, ptExporting, ptPrinting);
+ TfrxPrintMode = (pmDefault, pmSplit, pmJoin, pmScale);
+ TfrxInheriteMode = (imDefault, imDelete, imRename);
+
+ frxInteger = NativeInt;
+
+ TfrxRect = packed record
+ Left, Top, Right, Bottom: Double;
+ end;
+
+ TfrxPoint = packed record
+ X, Y: Double;
+ end;
+
+ TfrxProgressEvent = procedure(Sender: TfrxReport;
+ ProgressType: TfrxProgressType; Progress: Integer) of object;
+ TfrxBeforePrintEvent = procedure(Sender: TfrxReportComponent) of object;
+ TfrxGetValueEvent = procedure(const VarName: String; var Value: Variant) of object;
+ TfrxNewGetValueEvent = procedure(Sender: TObject; const VarName: String; var Value: Variant) of object;
+ TfrxUserFunctionEvent = function(const MethodName: String;
+ var Params: Variant): Variant of object;
+ TfrxManualBuildEvent = procedure(Page: TfrxPage) of object;
+ TfrxClickObjectEvent = procedure(Sender: TfrxView;
+ Button: TMouseButton; Shift: TShiftState; var Modified: Boolean) of object;
+ TfrxMouseOverObjectEvent = procedure(Sender: TfrxView) of object;
+ TfrxCheckEOFEvent = procedure(Sender: TObject; var Eof: Boolean) of object;
+ TfrxRunDialogEvent = procedure(Page: TfrxDialogPage) of object;
+ TfrxEditConnectionEvent = function(const ConnString: String): String of object;
+ TfrxSetConnectionEvent = procedure(const ConnString: String) of object;
+ TfrxBeforeConnectEvent = procedure(Sender: TfrxCustomDatabase; var Connected: Boolean) of object;
+ TfrxAfterDisconnectEvent = procedure(Sender: TfrxCustomDatabase) of object;
+ TfrxPrintPageEvent = procedure(Page: TfrxReportPage; CopyNo: Integer) of object;
+ TfrxLoadTemplateEvent = procedure(Report: TfrxReport; const TemplateName: String) of object;
+
+{ Root classes }
+
+ TfrxComponent = class(TComponent)
+ private
+ FFont: TfrxFont;
+ FObjects: TList;
+ FAllObjects: TList;
+ FParent: TfrxComponent;
+ FLeft: Double;
+ FTop: Double;
+ FWidth: Double;
+ FHeight: Double;
+ FParentFont: Boolean;
+ FGroupIndex: Integer;
+ FIsDesigning: Boolean;
+ FIsLoading: Boolean;
+ FIsPrinting: Boolean;
+ FIsWriting: Boolean;
+ FRestrictions: TfrxRestrictions;
+ FVisible: Boolean;
+ FDescription: String;
+ FAncestor: Boolean;
+ FComponentStyle: TfrxComponentStyle;
+ function GetAbsTop: Double;
+ function GetPage: TfrxPage;
+ function GetReport: TfrxReport;
+ function IsFontStored: Boolean;
+ function GetAllObjects: TList;
+ function GetAbsLeft: Double;
+ function GetIsLoading: Boolean;
+ function GetIsAncestor: Boolean;
+ protected
+ FAliasName: String;
+ FBaseName: String;
+ FOriginalComponent: TfrxComponent;
+ FOriginalRect: TfrxRect;
+ FOriginalBand: TfrxComponent;
+ procedure SetParent(AParent: TfrxComponent); virtual;
+ procedure SetLeft(Value: Double); virtual;
+ procedure SetTop(Value: Double); virtual;
+ procedure SetWidth(Value: Double); virtual;
+ procedure SetHeight(Value: Double); virtual;
+ procedure SetName(const AName: TComponentName); override;
+ procedure SetFont(Value: TfrxFont); virtual;
+ procedure SetParentFont(const Value: Boolean); virtual;
+ procedure SetVisible(Value: Boolean); virtual;
+ procedure FontChanged(Sender: TObject); virtual;
+ function DiffFont(f1, f2: TfrxFont; const Add: String): String;
+ function InternalDiff(AComponent: TfrxComponent): String;
+ function GetContainerObjects: TList; virtual;
+
+ procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
+ function GetChildOwner: TComponent; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor DesignCreate(AOwner: TComponent; Flags: Word); virtual;
+ destructor Destroy; override;
+ class function GetDescription: String; virtual;
+ procedure AlignChildren; virtual;
+ procedure Assign(Source: TPersistent); override;
+ procedure AssignAll(Source: TfrxComponent; Streaming: Boolean = False);
+ procedure AddSourceObjects; virtual;
+ procedure BeforeStartReport; virtual;
+ procedure Clear; virtual;
+ procedure CreateUniqueName;
+ procedure LoadFromStream(Stream: TStream); virtual;
+ procedure SaveToStream(Stream: TStream; SaveChildren: Boolean = True;
+ SaveDefaultValues: Boolean = False; Streaming: Boolean = False); virtual;
+ procedure SetBounds(ALeft, ATop, AWidth, AHeight: Double);
+ procedure OnNotify(Sender: TObject); virtual;
+ procedure OnPaste; virtual;
+ function AllDiff(AComponent: TfrxComponent): String;
+ function Diff(AComponent: TfrxComponent): String; virtual;
+ function FindObject(const AName: String): TfrxComponent;
+ function ContainerAdd(Obj: TfrxComponent): Boolean; virtual;
+ function ContainerMouseDown(Sender: TObject; X, Y: Integer): Boolean; virtual;
+ procedure ContainerMouseMove(Sender: TObject; X, Y: Integer); virtual;
+ procedure ContainerMouseUp(Sender: TObject; X, Y: Integer); virtual;
+ function FindDataSet(DataSet: TfrxDataSet; const DSName: String): TfrxDataSet;
+
+ property Objects: TList read FObjects;
+ property AllObjects: TList read GetAllObjects;
+ property ContainerObjects: TList read GetContainerObjects;
+ property Parent: TfrxComponent read FParent write SetParent;
+ property Page: TfrxPage read GetPage;
+ property Report: TfrxReport read GetReport;
+ property IsAncestor: Boolean read GetIsAncestor;
+ property IsDesigning: Boolean read FIsDesigning write FIsDesigning;
+ property IsLoading: Boolean read GetIsLoading write FIsLoading;
+ property IsPrinting: Boolean read FIsPrinting write FIsPrinting;
+ property IsWriting: Boolean read FIsWriting write FIsWriting;
+ property BaseName: String read FBaseName;
+ property GroupIndex: Integer read FGroupIndex write FGroupIndex default 0;
+ property frComponentStyle: TfrxComponentStyle read FComponentStyle write FComponentStyle;
+
+ property Left: Double read FLeft write SetLeft;
+ property Top: Double read FTop write SetTop;
+ property Width: Double read FWidth write SetWidth;
+ property Height: Double read FHeight write SetHeight;
+ property AbsLeft: Double read GetAbsLeft;
+ property AbsTop: Double read GetAbsTop;
+
+ property Description: String read FDescription write FDescription;
+ property ParentFont: Boolean read FParentFont write SetParentFont default True;
+ property Restrictions: TfrxRestrictions read FRestrictions write FRestrictions default [];
+ property Visible: Boolean read FVisible write SetVisible default True;
+ property Font: TfrxFont read FFont write SetFont stored IsFontStored;
+ end;
+
+ TfrxReportComponent = class(TfrxComponent)
+ private
+ FOnAfterData: TfrxNotifyEvent;
+ FOnAfterPrint: TfrxNotifyEvent;
+ FOnBeforePrint: TfrxNotifyEvent;
+ FOnPreviewClick: TfrxPreviewClickEvent;
+ FOnPreviewDblClick: TfrxPreviewClickEvent;
+ public
+ FShiftAmount: Double;
+ FShiftChildren: TList;
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
+ virtual; abstract;
+ procedure BeforePrint; virtual;
+ procedure GetData; virtual;
+ procedure AfterPrint; virtual;
+ function GetComponentText: String; virtual;
+ function GetRealBounds: TfrxRect; virtual;
+ property OnAfterData: TfrxNotifyEvent read FOnAfterData write FOnAfterData;
+ property OnAfterPrint: TfrxNotifyEvent read FOnAfterPrint write FOnAfterPrint;
+ property OnBeforePrint: TfrxNotifyEvent read FOnBeforePrint write FOnBeforePrint;
+ property OnPreviewClick: TfrxPreviewClickEvent read FOnPreviewClick write FOnPreviewClick;
+ property OnPreviewDblClick: TfrxPreviewClickEvent read FOnPreviewDblClick write FOnPreviewDblClick;
+ published
+ property Description;
+ end;
+
+ TfrxDialogComponent = class(TfrxReportComponent)
+ private
+ FComponent: TComponent;
+ FImage : TBitmap;
+ FImageIsLoaded: Boolean;
+ procedure ReadLeft(Reader: TReader);
+ procedure ReadTop(Reader: TReader);
+ procedure WriteLeft(Writer: TWriter);
+ procedure WriteTop(Writer: TWriter);
+ protected
+ FImageIndex: Integer;
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ property Component: TComponent read FComponent write FComponent;
+ end;
+
+ TfrxDialogControl = class(TfrxReportComponent)
+ private
+ FControl: TControl;
+ FOnClick: TfrxNotifyEvent;
+ FOnDblClick: TfrxNotifyEvent;
+ FOnEnter: TfrxNotifyEvent;
+ FOnExit: TfrxNotifyEvent;
+ FOnKeyDown: TfrxKeyEvent;
+ FOnKeyPress: TfrxKeyPressEvent;
+ FOnKeyUp: TfrxKeyEvent;
+ FOnMouseDown: TfrxMouseEvent;
+ FOnMouseMove: TfrxMouseMoveEvent;
+ FOnMouseUp: TfrxMouseEvent;
+ FOnActivate: TNotifyEvent;
+ function GetEnabled: Boolean;
+ procedure DoOnClick(Sender: TObject);
+ procedure DoOnDblClick(Sender: TObject);
+ procedure DoOnEnter(Sender: TObject);
+ procedure DoOnExit(Sender: TObject);
+ procedure DoOnKeyDown(Sender: TObject; var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState);
+ procedure DoOnKeyUp(Sender: TObject; var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState);
+ procedure DoOnMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+ procedure DoOnMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
+ procedure DoOnMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+ procedure SetEnabled(const Value: Boolean);
+ function GetCaption: String;
+ procedure SetCaption(const Value: String);
+ function GetHint: String;
+ procedure SetHint(const Value: String);
+ function GetShowHint: Boolean;
+ procedure SetShowHint(const Value: Boolean);
+ function GetTabStop: Boolean;
+ procedure SetTabStop(const Value: Boolean);
+ protected
+ procedure SetLeft(Value: Double); override;
+ procedure SetTop(Value: Double); override;
+ procedure SetWidth(Value: Double); override;
+ procedure SetHeight(Value: Double); override;
+ procedure SetParentFont(const Value: Boolean); override;
+ procedure SetVisible(Value: Boolean); override;
+ procedure SetParent(AParent: TfrxComponent); override;
+ procedure FontChanged(Sender: TObject); override;
+ procedure InitControl(AControl: TControl);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+
+ property Caption: String read GetCaption write SetCaption;
+ property Control: TControl read FControl write FControl;
+ property TabStop: Boolean read GetTabStop write SetTabStop default True;
+ property OnClick: TfrxNotifyEvent read FOnClick write FOnClick;
+ property OnDblClick: TfrxNotifyEvent read FOnDblClick write FOnDblClick;
+ property OnEnter: TfrxNotifyEvent read FOnEnter write FOnEnter;
+ property OnExit: TfrxNotifyEvent read FOnExit write FOnExit;
+ property OnKeyDown: TfrxKeyEvent read FOnKeyDown write FOnKeyDown;
+ property OnKeyPress: TfrxKeyPressEvent read FOnKeyPress write FOnKeyPress;
+ property OnKeyUp: TfrxKeyEvent read FOnKeyUp write FOnKeyUp;
+ property OnMouseDown: TfrxMouseEvent read FOnMouseDown write FOnMouseDown;
+ property OnMouseMove: TfrxMouseMoveEvent read FOnMouseMove write FOnMouseMove;
+ property OnMouseUp: TfrxMouseEvent read FOnMouseUp write FOnMouseUp;
+ property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
+ published
+ property Left;
+ property Top;
+ property Width;
+ property Height;
+ property Font;
+ property GroupIndex;
+ property ParentFont;
+ property Enabled: Boolean read GetEnabled write SetEnabled default True;
+ property Hint: String read GetHint write SetHint;
+ property ShowHint: Boolean read GetShowHint write SetShowHint;
+ property Visible;
+ end;
+
+ TfrxDataSet = class(TfrxDialogComponent)
+ private
+ FCloseDataSource: Boolean;
+ FEnabled: Boolean;
+ FEof: Boolean;
+ FOpenDataSource: Boolean;
+ FRangeBegin: TfrxRangeBegin;
+ FRangeEnd: TfrxRangeEnd;
+ FRangeEndCount: Integer;
+ FReportRef: TfrxReport;
+ FUserName: String;
+ FOnCheckEOF: TfrxCheckEOFEvent;
+ FOnFirst: TNotifyEvent;
+ FOnNext: TNotifyEvent;
+ FOnPrior: TNotifyEvent;
+ FOnOpen: TNotifyEvent;
+ FOnClose: TNotifyEvent;
+ protected
+ FInitialized: Boolean;
+ FRecNo: Integer;
+ function GetDisplayText(Index: String): WideString; virtual;
+ function GetDisplayWidth(Index: String): Integer; virtual;
+ function GetFieldType(Index: String): TfrxFieldType; virtual;
+ function GetValue(Index: String): Variant; virtual;
+ procedure SetName(const NewName: TComponentName); override;
+ procedure SetUserName(const Value: String); virtual;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+
+ { Navigation methods }
+ procedure Initialize; virtual;
+ procedure Finalize; virtual;
+ procedure Open; virtual;
+ procedure Close; virtual;
+ procedure First; virtual;
+ procedure Next; virtual;
+ procedure Prior; virtual;
+ function Eof: Boolean; virtual;
+
+ { Data access }
+ function FieldsCount: Integer; virtual;
+ function HasField(const fName: String): Boolean;
+ function IsBlobField(const fName: String): Boolean; virtual;
+ function RecordCount: Integer; virtual;
+ procedure AssignBlobTo(const fName: String; Obj: TObject); virtual;
+ procedure GetFieldList(List: TStrings); virtual;
+ property DisplayText[Index: String]: WideString read GetDisplayText;
+ property DisplayWidth[Index: String]: Integer read GetDisplayWidth;
+ property FieldType[Index: String]: TfrxFieldType read GetFieldType;
+ property Value[Index: String]: Variant read GetValue;
+
+ property CloseDataSource: Boolean read FCloseDataSource write FCloseDataSource;
+ { OpenDataSource is kept for backward compatibility only }
+ property OpenDataSource: Boolean read FOpenDataSource write FOpenDataSource default True;
+ property RecNo: Integer read FRecNo;
+ property ReportRef: TfrxReport read FReportRef write FReportRef;
+ property OnClose: TNotifyEvent read FOnClose write FOnClose;
+ property OnOpen: TNotifyEvent read FOnOpen write FOnOpen;
+ published
+ property Enabled: Boolean read FEnabled write FEnabled default True;
+ property RangeBegin: TfrxRangeBegin read FRangeBegin write FRangeBegin default rbFirst;
+ property RangeEnd: TfrxRangeEnd read FRangeEnd write FRangeEnd default reLast;
+ property RangeEndCount: Integer read FRangeEndCount write FRangeEndCount default 0;
+ property UserName: String read FUserName write SetUserName;
+ property OnCheckEOF: TfrxCheckEOFEvent read FOnCheckEOF write FOnCheckEOF;
+ property OnFirst: TNotifyEvent read FOnFirst write FOnFirst;
+ property OnNext: TNotifyEvent read FOnNext write FOnNext;
+ property OnPrior: TNotifyEvent read FOnPrior write FOnPrior;
+ end;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxUserDataSet = class(TfrxDataset)
+ private
+ FFields: TStrings;
+ FOnGetValue: TfrxGetValueEvent;
+ FOnNewGetValue: TfrxNewGetValueEvent;
+ procedure SetFields(const Value: TStrings);
+ protected
+ function GetDisplayText(Index: String): WideString; override;
+ function GetValue(Index: String): Variant; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function FieldsCount: Integer; override;
+ procedure GetFieldList(List: TStrings); override;
+ published
+ property Fields: TStrings read FFields write SetFields;
+ property OnGetValue: TfrxGetValueEvent read FOnGetValue write FOnGetValue;
+ property OnNewGetValue: TfrxNewGetValueEvent read FOnNewGetValue write FOnNewGetValue;
+ end;
+
+ TfrxCustomDBDataSet = class(TfrxDataSet)
+ private
+ FAliases: TStrings;
+ FFields: TStringList;
+ procedure SetFieldAliases(const Value: TStrings);
+ protected
+ property Fields: TStringList read FFields;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function ConvertAlias(const fName: String): String;
+ function GetAlias(const fName: String): String;
+ function FieldsCount: Integer; override;
+ published
+ property CloseDataSource;
+ property FieldAliases: TStrings read FAliases write SetFieldAliases;
+ property OpenDataSource;
+ property OnClose;
+ property OnOpen;
+ end;
+
+ TfrxDBComponents = class(TComponent)
+ public
+ function GetDescription: String; virtual;
+ end;
+
+ TfrxCustomDatabase = class(TfrxDialogComponent)
+ protected
+ procedure BeforeConnect(var Value: Boolean);
+ procedure AfterDisconnect;
+ procedure SetConnected(Value: Boolean); virtual;
+ procedure SetDatabaseName(const Value: String); virtual;
+ procedure SetLoginPrompt(Value: Boolean); virtual;
+ procedure SetParams(Value: TStrings); virtual;
+ function GetConnected: Boolean; virtual;
+ function GetDatabaseName: String; virtual;
+ function GetLoginPrompt: Boolean; virtual;
+ function GetParams: TStrings; virtual;
+ public
+ function ToString: WideString; reintroduce; virtual;
+ procedure FromString(const Connection: WideString); virtual;
+ procedure SetLogin(const Login, Password: String); virtual;
+ property Connected: Boolean read GetConnected write SetConnected default False;
+ property DatabaseName: String read GetDatabaseName write SetDatabaseName;
+ property LoginPrompt: Boolean read GetLoginPrompt write SetLoginPrompt default True;
+ property Params: TStrings read GetParams write SetParams;
+ end;
+
+
+ TfrxComponentClass = class of TfrxComponent;
+
+{ Report Objects }
+
+ TfrxFrameLine = class(TPersistent)
+ private
+ FFrame: TfrxFrame;
+ FColor: TAlphaColor;
+ FStyle: TfrxFrameStyle;
+ FWidth: Double;
+ function IsColorStored: Boolean;
+ function IsStyleStored: Boolean;
+ function IsWidthStored: Boolean;
+ public
+ constructor Create(AFrame: TfrxFrame);
+ procedure Assign(Source: TPersistent); override;
+ function Diff(ALine: TfrxFrameLine; const LineName: String;
+ ColorChanged, StyleChanged, WidthChanged: Boolean): String;
+ published
+ property Color: TAlphaColor read FColor write FColor stored IsColorStored;
+ property Style: TfrxFrameStyle read FStyle write FStyle stored IsStyleStored;
+ property Width: Double read FWidth write FWidth stored IsWidthStored;
+ end;
+
+ TfrxFrame = class(TPersistent)
+ private
+ FLeftLine: TfrxFrameLine;
+ FTopLine: TfrxFrameLine;
+ FRightLine: TfrxFrameLine;
+ FBottomLine: TfrxFrameLine;
+ FColor: TAlphaColor;
+ FDropShadow: Boolean;
+ FShadowWidth: Double;
+ FShadowColor: TAlphaColor;
+ FStyle: TfrxFrameStyle;
+ FTyp: TfrxFrameTypes;
+ FWidth: Double;
+ function IsShadowWidthStored: Boolean;
+ function IsTypStored: Boolean;
+ function IsWidthStored: Boolean;
+ procedure SetBottomLine(const Value: TfrxFrameLine);
+ procedure SetLeftLine(const Value: TfrxFrameLine);
+ procedure SetRightLine(const Value: TfrxFrameLine);
+ procedure SetTopLine(const Value: TfrxFrameLine);
+ procedure SetColor(const Value: TAlphaColor);
+ procedure SetStyle(const Value: TfrxFrameStyle);
+ procedure SetWidth(const Value: Double);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ function Diff(AFrame: TfrxFrame): String;
+ published
+ property Color: TAlphaColor read FColor write SetColor default claBlack;
+ property DropShadow: Boolean read FDropShadow write FDropShadow default False;
+ property ShadowColor: TAlphaColor read FShadowColor write FShadowColor default claBlack;
+ property ShadowWidth: Double read FShadowWidth write FShadowWidth stored IsShadowWidthStored;
+ property Style: TfrxFrameStyle read FStyle write SetStyle default fsSolid;
+ property Typ: TfrxFrameTypes read FTyp write FTyp stored IsTypStored;
+ property Width: Double read FWidth write SetWidth stored IsWidthStored;
+ property LeftLine: TfrxFrameLine read FLeftLine write SetLeftLine;
+ property TopLine: TfrxFrameLine read FTopLine write SetTopLine;
+ property RightLine: TfrxFrameLine read FRightLine write SetRightLine;
+ property BottomLine: TfrxFrameLine read FBottomLine write SetBottomLine;
+ end;
+
+ TfrxView = class(TfrxReportComponent)
+ private
+ FAlign: TfrxAlign;
+ FColor: TAlphaColor;
+ FCursor: TCursor;
+ FDataField: String;
+ FDataSet: TfrxDataSet;
+ FDataSetName: String;
+ FFrame: TfrxFrame;
+ FPrintable: Boolean;
+ FShiftMode: TfrxShiftMode;
+ FTagStr: String;
+ FTempTag: String;
+ FTempURL: String;
+ FHint: String;
+ FHintIsActive: Boolean;
+ FShowHint: Boolean;
+ FURL: String;
+ FPlainText: Boolean;
+ FBrushStyle: TBrushKind;
+ procedure SetFrame(const Value: TfrxFrame);
+ procedure SetDataSet(const Value: TfrxDataSet);
+ procedure SetDataSetName(const Value: String);
+ function GetDataSetName: String;
+ protected
+ FX: Integer;
+ FY: Integer;
+ FX1: Integer;
+ FY1: Integer;
+ FDX: Integer;
+ FDY: Integer;
+ FFrameWidth: Double;
+ FScaleX: Double;
+ FScaleY: Double;
+ FOffsetX: Double;
+ FOffsetY: Double;
+ FCanvas: TCanvas;
+ FFastCanvas: TCanvas;
+ procedure BeginDraw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); virtual;
+ procedure DrawBackground; virtual;
+ procedure DrawFrame; virtual;
+ procedure ExpandVariables(var Expr: String);
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function Diff(AComponent: TfrxComponent): String; override;
+ function IsDataField: Boolean;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ procedure BeforePrint; override;
+ procedure GetData; override;
+ procedure AfterPrint; override;
+ procedure SetFastCanvas(aCanvas: TCanvas);
+ procedure GetVisibleRect(var aRect: TRectF); virtual;
+ property Color: TAlphaColor read FColor write FColor default claNull;
+ property DataField: String read FDataField write FDataField;
+ property DataSet: TfrxDataSet read FDataSet write SetDataSet;
+ property DataSetName: String read GetDataSetName write SetDataSetName;
+ property Frame: TfrxFrame read FFrame write SetFrame;
+ property PlainText: Boolean read FPlainText write FPlainText;
+ property Cursor: TCursor read FCursor write FCursor default crDefault;
+ property TagStr: String read FTagStr write FTagStr;
+ property URL: String read FURL write FURL;
+ property HintIsActive: Boolean read FHintIsActive write FHintIsActive;
+ property BrushStyle: TBrushKind read FBrushStyle write FBrushStyle;
+ published
+ property Align: TfrxAlign read FAlign write FAlign default baNone;
+ property Printable: Boolean read FPrintable write FPrintable default True;
+ property ShiftMode: TfrxShiftMode read FShiftMode write FShiftMode default smAlways;
+ property Left;
+ property Top;
+ property Width;
+ property Height;
+ property GroupIndex;
+ property Restrictions;
+ property Visible;
+ property OnAfterData;
+ property OnAfterPrint;
+ property OnBeforePrint;
+ property OnPreviewClick;
+ property OnPreviewDblClick;
+ property Hint: String read FHint write FHint;
+ property ShowHint: Boolean read FShowHint write FShowHint;
+ end;
+
+ TfrxStretcheable = class(TfrxView)
+ private
+ FStretchMode: TfrxStretchMode;
+ public
+ FSaveHeight: Double;
+ FSavedTop: Double;
+ constructor Create(AOwner: TComponent); override;
+ function CalcHeight: Double; virtual;
+ function DrawPart: Double; virtual;
+ procedure InitPart; virtual;
+ function HasNextDataPart: Boolean; virtual;
+ published
+ property StretchMode: TfrxStretchMode read FStretchMode write FStretchMode
+ default smDontStretch;
+ end;
+
+ TfrxHighlight = class(TPersistent)
+ private
+ FActive: Boolean;
+ FColor: TAlphaColor;
+ FCondition: String;
+ FFont: TfrxFont;
+ procedure SetFont(const Value: TfrxFont);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ published
+ property Active: Boolean read FActive write FActive default False;
+ property Font: TfrxFont read FFont write SetFont;
+ property Color: TAlphaColor read FColor write FColor default claNull;
+ property Condition: String read FCondition write FCondition;
+ end;
+
+ TfrxFormat = class(TPersistent)
+ private
+ FDecimalSeparator: String;
+ FThousandSeparator: String;
+ FFormatStr: String;
+ FKind: TfrxFormatKind;
+ public
+ procedure Assign(Source: TPersistent); override;
+ published
+ property DecimalSeparator: String read FDecimalSeparator write FDecimalSeparator;
+ property ThousandSeparator: String read FThousandSeparator write FThousandSeparator;
+ property FormatStr: String read FFormatStr write FFormatStr;
+ property Kind: TfrxFormatKind read FKind write FKind default fkText;
+ end;
+
+ TfrxCustomMemoView = class(TfrxStretcheable)
+ private
+ FAllowExpressions: Boolean;
+ FAllowHTMLTags: Boolean;
+ FAutoWidth: Boolean;
+ FCharSpacing: Double;
+ FClipped: Boolean;
+ FDisplayFormat: TfrxFormat;
+ FExpressionDelimiters: String;
+ FFlowTo: TfrxCustomMemoView;
+ FFirstParaBreak: Boolean;
+ FGapX: Double;
+ FGapY: Double;
+ FHAlign: TfrxHAlign;
+ FHideZeros: Boolean;
+ FHighlight: TfrxHighlight;
+ FLastParaBreak: Boolean;
+ FLineSpacing: Double;
+ FMemo: TWideStrings;
+ FParagraphGap: Double;
+ FPartMemo: WideString;
+ FRotation: Integer;
+ FRTLReading: Boolean;
+ FStyle: String;
+ FSuppressRepeated: Boolean;
+ FTempMemo: WideString;
+ FUnderlines: Boolean;
+ FVAlign: TfrxVAlign;
+ FValue: Variant;
+ FWordBreak: Boolean;
+ FWordWrap: Boolean;
+ FWysiwyg: Boolean;
+ FTextRenderer: TObject;
+ procedure SetMemo(const Value: TWideStrings);
+ procedure SetRotation(Value: Integer);
+ procedure SetText(const Value: WideString);
+ function AdjustCalcHeight: Double;
+ function AdjustCalcWidth: Double;
+ function GetText: WideString;
+ function IsExprDelimitersStored: Boolean;
+ function IsLineSpacingStored: Boolean;
+ function IsGapXStored: Boolean;
+ function IsGapYStored: Boolean;
+ function IsHighlightStored: Boolean;
+ function IsParagraphGapStored: Boolean;
+ procedure SetHighlight(const Value: TfrxHighlight);
+ procedure SetDisplayFormat(const Value: TfrxFormat);
+ procedure SetStyle(const Value: String);
+ function IsCharSpacingStored: Boolean;
+ procedure SetAllowHTMLTags(const Value: Boolean);
+ protected
+ FLastValue: Variant;
+ FTotalPages: Integer;
+ FCopyNo: Integer;
+ FTextRect: TRectF;
+ FPrintScale: Double;
+ function CalcAndFormat(const Expr: WideString): WideString;
+ procedure BeginDraw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ function IsAdvancedRendererNeeded: Boolean;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ function Diff(AComponent: TfrxComponent): String; override;
+ function CalcHeight: Double; override;
+ function CalcWidth: Double; virtual;
+ function DrawPart: Double; override;
+ function GetComponentText: String; override;
+ function FormatData(const Value: Variant; AFormat: TfrxFormat = nil): WideString;
+ procedure WrapText(WrapWords: Boolean; var aLineHeight: Single; WrapLines: TWideStrings; aBitmap: TBitmap = nil);
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ procedure BeforePrint; override;
+ procedure GetData; override;
+ procedure AfterPrint; override;
+ procedure InitPart; override;
+ procedure ApplyStyle(Style: TfrxStyleItem);
+ procedure ExtractMacros;
+ procedure ResetSuppress;
+ property Text: WideString read GetText write SetText;
+ property Value: Variant read FValue write FValue;
+ // analogue of Memo property
+ property Lines: TWideStrings read FMemo write SetMemo;
+
+ property AllowExpressions: Boolean read FAllowExpressions write FAllowExpressions default True;
+ property AllowHTMLTags: Boolean read FAllowHTMLTags write SetAllowHTMLTags default False;
+ property AutoWidth: Boolean read FAutoWidth write FAutoWidth default False;
+ property CharSpacing: Double read FCharSpacing write FCharSpacing stored IsCharSpacingStored;
+ property Clipped: Boolean read FClipped write FClipped default True;
+ property DisplayFormat: TfrxFormat read FDisplayFormat write SetDisplayFormat;
+ property ExpressionDelimiters: String read FExpressionDelimiters
+ write FExpressionDelimiters stored IsExprDelimitersStored;
+ property FlowTo: TfrxCustomMemoView read FFlowTo write FFlowTo;
+ property GapX: Double read FGapX write FGapX stored IsGapXStored;
+ property GapY: Double read FGapY write FGapY stored IsGapYStored;
+ property HAlign: TfrxHAlign read FHAlign write FHAlign default haLeft;
+ property HideZeros: Boolean read FHideZeros write FHideZeros default False;
+ property Highlight: TfrxHighlight read FHighlight write SetHighlight
+ stored IsHighlightStored;
+ property LineSpacing: Double read FLineSpacing write FLineSpacing stored IsLineSpacingStored;
+ property Memo: TWideStrings read FMemo write SetMemo;
+ property ParagraphGap: Double read FParagraphGap write FParagraphGap stored IsParagraphGapStored;
+ property Rotation: Integer read FRotation write SetRotation default 0;
+ property RTLReading: Boolean read FRTLReading write FRTLReading default False;
+ property Style: String read FStyle write SetStyle;
+ property SuppressRepeated: Boolean read FSuppressRepeated write FSuppressRepeated default False;
+ property Underlines: Boolean read FUnderlines write FUnderlines default False;
+ property WordBreak: Boolean read FWordBreak write FWordBreak default False;
+ property WordWrap: Boolean read FWordWrap write FWordWrap default True;
+ property Wysiwyg: Boolean read FWysiwyg write FWysiwyg default True;
+ property VAlign: TfrxVAlign read FVAlign write FVAlign default vaTop;
+ published
+ property FirstParaBreak: Boolean read FFirstParaBreak write FFirstParaBreak default False;
+ property LastParaBreak: Boolean read FLastParaBreak write FLastParaBreak default False;
+ property Cursor;
+ property TagStr;
+ property URL;
+ end;
+
+ TfrxMemoView = class(TfrxCustomMemoView)
+ published
+ property AutoWidth;
+ property AllowExpressions;
+ property AllowHTMLTags;
+ property CharSpacing;
+ property Clipped;
+ property Color;
+ property DataField;
+ property DataSet;
+ property DataSetName;
+ property DisplayFormat;
+ property ExpressionDelimiters;
+ property FlowTo;
+ property Font;
+ property Frame;
+ property GapX;
+ property GapY;
+ property HAlign;
+ property HideZeros;
+ property Highlight;
+ property LineSpacing;
+ property Memo;
+ property ParagraphGap;
+ property ParentFont;
+ property Rotation;
+ property RTLReading;
+ property Style;
+ property SuppressRepeated;
+ property Underlines;
+ property WordBreak;
+ property WordWrap;
+ property Wysiwyg;
+ property VAlign;
+ end;
+
+ TfrxSysMemoView = class(TfrxCustomMemoView)
+ public
+ class function GetDescription: String; override;
+ published
+ property AutoWidth;
+ property CharSpacing;
+ property Color;
+ property DisplayFormat;
+ property Font;
+ property Frame;
+ property GapX;
+ property GapY;
+ property HAlign;
+ property HideZeros;
+ property Highlight;
+ property Memo;
+ property ParentFont;
+ property Rotation;
+ property RTLReading;
+ property Style;
+ property SuppressRepeated;
+ property VAlign;
+ property WordWrap;
+ end;
+
+ TfrxCustomLineView = class(TfrxStretcheable)
+ private
+ FDiagonal: Boolean;
+ FArrowEnd: Boolean;
+ FArrowLength: Integer;
+ FArrowSolid: Boolean;
+ FArrowStart: Boolean;
+ FArrowWidth: Integer;
+ procedure DrawArrow(x1, y1, x2, y2: Extended);
+ procedure DrawDiagonalLine;
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor DesignCreate(AOwner: TComponent; Flags: Word); override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ procedure GetVisibleRect(var aRect: TRectF); override;
+ property ArrowEnd: Boolean read FArrowEnd write FArrowEnd default False;
+ property ArrowLength: Integer read FArrowLength write FArrowLength default 20;
+ property ArrowSolid: Boolean read FArrowSolid write FArrowSolid default False;
+ property ArrowStart: Boolean read FArrowStart write FArrowStart default False;
+ property ArrowWidth: Integer read FArrowWidth write FArrowWidth default 5;
+ property Diagonal: Boolean read FDiagonal write FDiagonal default False;
+ published
+ property TagStr;
+ end;
+
+ TfrxLineView = class(TfrxCustomLineView)
+ public
+ class function GetDescription: String; override;
+ published
+ property ArrowEnd;
+ property ArrowLength;
+ property ArrowSolid;
+ property ArrowStart;
+ property ArrowWidth;
+ property Frame;
+ property Diagonal;
+ end;
+
+ TfrxPictureView = class(TfrxView)
+ protected
+ procedure ReadVCLPicture(Stream: TStream);
+ private
+ FAutoSize: Boolean;
+ FCenter: Boolean;
+ FFileLink: String;
+ FImageIndex: Integer;
+ FIsImageIndexStored: Boolean;
+ FIsPictureStored: Boolean;
+ FKeepAspectRatio: Boolean;
+ FPicture: TBitmap;
+ FPictureChanged: Boolean;
+ FStretched: Boolean;
+ FHightQuality: Boolean;
+ FTransparent: Boolean;
+ FTransparentColor: TAlphaColor;
+ procedure SetPicture(const Value: TBitmap);
+ procedure PictureChanged(Sender: TObject);
+ procedure SetAutoSize(const Value: Boolean);
+ procedure SetTransparent(const Value: Boolean);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ function Diff(AComponent: TfrxComponent):String; override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ procedure GetData; override;
+ property IsImageIndexStored: Boolean read FIsImageIndexStored write FIsImageIndexStored;
+ property IsPictureStored: Boolean read FIsPictureStored write FIsPictureStored;
+ published
+ property Cursor;
+ property AutoSize: Boolean read FAutoSize write SetAutoSize default False;
+ property Center: Boolean read FCenter write FCenter default False;
+ property DataField;
+ property DataSet;
+ property DataSetName;
+ property Frame;
+ property FileLink: String read FFileLink write FFileLink;
+ property ImageIndex: Integer read FImageIndex write FImageIndex stored FIsImageIndexStored;
+ property KeepAspectRatio: Boolean read FKeepAspectRatio write FKeepAspectRatio default True;
+ property Picture: TBitmap read FPicture write SetPicture stored FIsPictureStored;
+ property Stretched: Boolean read FStretched write FStretched default True;
+ property TagStr;
+ property URL;
+ property HightQuality: Boolean read FHightQuality write FHightQuality;
+ property Transparent: Boolean read FTransparent write SetTransparent;
+ property TransparentColor: TAlphaColor read FTransparentColor write FTransparentColor;
+ end;
+
+ TfrxShapeView = class(TfrxView)
+ private
+ FCurve: Integer;
+ FShape: TfrxShapeKind;
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor DesignCreate(AOwner: TComponent; Flags: Word); override;
+ function Diff(AComponent: TfrxComponent): String; override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ class function GetDescription: String; override;
+ procedure GetVisibleRect(var aRect: TRectF); override;
+ published
+ property Color;
+ property Cursor;
+ property Curve: Integer read FCurve write FCurve default 0;
+ property Frame;
+ property Shape: TfrxShapeKind read FShape write FShape default skRectangle;
+ property TagStr;
+ property URL;
+ end;
+
+ TfrxSubreport = class(TfrxView)
+ private
+ FPage: TfrxReportPage;
+ FPrintOnParent: Boolean;
+ procedure SetPage(const Value: TfrxReportPage);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ class function GetDescription: String; override;
+ published
+ property Page: TfrxReportPage read FPage write SetPage;
+ property PrintOnParent: Boolean read FPrintOnParent write FPrintOnParent
+ default False;
+ end;
+
+
+{ Bands }
+ TfrxChild = class;
+
+ TfrxBand = class(TfrxReportComponent)
+ private
+ FAllowSplit: Boolean;
+ FChild: TfrxChild;
+ FKeepChild: Boolean;
+ FOnAfterCalcHeight: TfrxNotifyEvent;
+ FOutlineText: String;
+ FOverflow: Boolean;
+ FStartNewPage: Boolean;
+ FStretched: Boolean;
+ FPrintChildIfInvisible: Boolean;
+ FVertical: Boolean;
+ function GetBandName: String;
+ procedure SetChild(Value: TfrxChild);
+ procedure SetVertical(const Value: Boolean);
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetLeft(Value: Double); override;
+ procedure SetTop(Value: Double); override;
+ procedure SetHeight(Value: Double); override;
+ public
+ FSubBands: TList; { list of subbands }
+ FHeader, FFooter, FGroup: TfrxBand; { h./f./g. bands }
+ FLineN: Integer; { used for Line# }
+ FLineThrough: Integer; { used for LineThrough# }
+ FOriginalObjectsCount: Integer; { used for TfrxSubReport.PrintOnParent }
+ FHasVBands: Boolean; { whether the band should show vbands }
+ FStretchedHeight: Double;
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function BandNumber: Integer;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ class function GetDescription: String; override;
+ property AllowSplit: Boolean read FAllowSplit write FAllowSplit default False;
+ property BandName: String read GetBandName;
+ property Child: TfrxChild read FChild write SetChild;
+ property KeepChild: Boolean read FKeepChild write FKeepChild default False;
+ property OutlineText: String read FOutlineText write FOutlineText;
+ property Overflow: Boolean read FOverflow write FOverflow;
+ property PrintChildIfInvisible: Boolean read FPrintChildIfInvisible
+ write FPrintChildIfInvisible default False;
+ property StartNewPage: Boolean read FStartNewPage write FStartNewPage default False;
+ property Stretched: Boolean read FStretched write FStretched default False;
+ published
+ property Font;
+ property Height;
+ property Left;
+ property ParentFont;
+ property Restrictions;
+ property Top;
+ property Vertical: Boolean read FVertical write SetVertical default False;
+ property Visible;
+ property Width;
+ property OnAfterCalcHeight: TfrxNotifyEvent read FOnAfterCalcHeight
+ write FOnAfterCalcHeight;
+ property OnAfterPrint;
+ property OnBeforePrint;
+ end;
+
+ TfrxBandClass = class of TfrxBand;
+
+ TfrxDataBand = class(TfrxBand)
+ private
+ FColumnGap: Double;
+ FColumnWidth: Double;
+ FColumns: Integer;
+ FCurColumn: Integer;
+ FDataSet: TfrxDataSet;
+ FDataSetName: String;
+ FFooterAfterEach: Boolean;
+ FKeepFooter: Boolean;
+ FKeepHeader: Boolean;
+ FKeepTogether: Boolean;
+ FPrintIfDetailEmpty: Boolean;
+ FRowCount: Integer;
+ FOnMasterDetail: TfrxNotifyEvent;
+ FVirtualDataSet: TfrxUserDataSet;
+ procedure SetCurColumn(Value: Integer);
+ procedure SetRowCount(const Value: Integer);
+ procedure SetDataSet(const Value: TfrxDataSet);
+ procedure SetDataSetName(const Value: String);
+ function GetDataSetName: String;
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ public
+ FMaxY: Double; { used for columns }
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ property CurColumn: Integer read FCurColumn write SetCurColumn;
+ property VirtualDataSet: TfrxUserDataSet read FVirtualDataSet;
+ published
+ property AllowSplit;
+ property Child;
+ property Columns: Integer read FColumns write FColumns default 0;
+ property ColumnWidth: Double read FColumnWidth write FColumnWidth;
+ property ColumnGap: Double read FColumnGap write FColumnGap;
+ property DataSet: TfrxDataSet read FDataSet write SetDataSet;
+ property DataSetName: String read GetDataSetName write SetDataSetName;
+ property FooterAfterEach: Boolean read FFooterAfterEach write FFooterAfterEach default False;
+ property KeepChild;
+ property KeepFooter: Boolean read FKeepFooter write FKeepFooter default False;
+ property KeepHeader: Boolean read FKeepHeader write FKeepHeader default False;
+ property KeepTogether: Boolean read FKeepTogether write FKeepTogether default False;
+ property OutlineText;
+ property PrintChildIfInvisible;
+ property PrintIfDetailEmpty: Boolean read FPrintIfDetailEmpty
+ write FPrintIfDetailEmpty default False;
+ property RowCount: Integer read FRowCount write SetRowCount;
+ property StartNewPage;
+ property Stretched;
+ property OnMasterDetail: TfrxNotifyEvent read FOnMasterDetail write FOnMasterDetail;
+ end;
+
+ TfrxHeader = class(TfrxBand)
+ private
+ FReprintOnNewPage: Boolean;
+ published
+ property AllowSplit;
+ property Child;
+ property KeepChild;
+ property PrintChildIfInvisible;
+ property ReprintOnNewPage: Boolean read FReprintOnNewPage write FReprintOnNewPage default False;
+ property StartNewPage;
+ property Stretched;
+ end;
+
+ TfrxFooter = class(TfrxBand)
+ private
+ public
+ published
+ property AllowSplit;
+ property Child;
+ property KeepChild;
+ property PrintChildIfInvisible;
+ property Stretched;
+ end;
+
+ TfrxMasterData = class(TfrxDataBand)
+ private
+ public
+ published
+ end;
+
+ TfrxDetailData = class(TfrxDataBand)
+ private
+ public
+ published
+ end;
+
+ TfrxSubdetailData = class(TfrxDataBand)
+ private
+ public
+ published
+ end;
+
+ TfrxDataBand4 = class(TfrxDataBand)
+ private
+ public
+ published
+ end;
+
+ TfrxDataBand5 = class(TfrxDataBand)
+ private
+ public
+ published
+ end;
+
+ TfrxDataBand6 = class(TfrxDataBand)
+ private
+ public
+ published
+ end;
+
+ TfrxPageHeader = class(TfrxBand)
+ private
+ FPrintOnFirstPage: Boolean;
+ public
+ constructor Create(AOwner: TComponent); override;
+ published
+ property Child;
+ property PrintChildIfInvisible;
+ property PrintOnFirstPage: Boolean read FPrintOnFirstPage write FPrintOnFirstPage default True;
+ property Stretched;
+ end;
+
+ TfrxPageFooter = class(TfrxBand)
+ private
+ FPrintOnFirstPage: Boolean;
+ FPrintOnLastPage: Boolean;
+ public
+ constructor Create(AOwner: TComponent); override;
+ published
+ property PrintOnFirstPage: Boolean read FPrintOnFirstPage write FPrintOnFirstPage default True;
+ property PrintOnLastPage: Boolean read FPrintOnLastPage write FPrintOnLastPage default True;
+ end;
+
+ TfrxColumnHeader = class(TfrxBand)
+ private
+ public
+ published
+ property Child;
+ property Stretched;
+ end;
+
+ TfrxColumnFooter = class(TfrxBand)
+ private
+ public
+ published
+ end;
+
+ TfrxGroupHeader = class(TfrxBand)
+ private
+ FCondition: String;
+ FDrillName: String; { used instead Tag property in drill down }
+ FDrillDown: Boolean;
+ FExpandDrillDown: Boolean;
+ FShowFooterIfDrillDown: Boolean;
+ FShowChildIfDrillDown: Boolean;
+ FKeepTogether: Boolean;
+ FReprintOnNewPage: Boolean;
+ FResetPageNumbers: Boolean;
+ public
+ FLastValue: Variant;
+ function Diff(AComponent: TfrxComponent): String; override;
+ published
+ property AllowSplit;
+ property Child;
+ property Condition: String read FCondition write FCondition;
+ property DrillDown: Boolean read FDrillDown write FDrillDown default False;
+ property ExpandDrillDown: Boolean read FExpandDrillDown write FExpandDrillDown default False;
+ property KeepChild;
+ property KeepTogether: Boolean read FKeepTogether write FKeepTogether default False;
+ property ReprintOnNewPage: Boolean read FReprintOnNewPage write FReprintOnNewPage default False;
+ property OutlineText;
+ property PrintChildIfInvisible;
+ property ResetPageNumbers: Boolean read FResetPageNumbers write FResetPageNumbers default False;
+ property ShowFooterIfDrillDown: Boolean read FShowFooterIfDrillDown
+ write FShowFooterIfDrillDown default False;
+ property ShowChildIfDrillDown: Boolean read FShowChildIfDrillDown
+ write FShowChildIfDrillDown default False;
+ property StartNewPage;
+ property Stretched;
+ property DrillName: String read FDrillName write FDrillName;
+ end;
+
+ TfrxGroupFooter = class(TfrxBand)
+ private
+ FHideIfSingleDataRecord: Boolean;
+ public
+ published
+ property AllowSplit;
+ property Child;
+ property HideIfSingleDataRecord: Boolean read FHideIfSingleDataRecord
+ write FHideIfSingleDataRecord default False;
+ property KeepChild;
+ property PrintChildIfInvisible;
+ property Stretched;
+ end;
+
+ TfrxReportTitle = class(TfrxBand)
+ private
+ public
+ published
+ property AllowSplit;
+ property Child;
+ property KeepChild;
+ property PrintChildIfInvisible;
+ property StartNewPage;
+ property Stretched;
+ end;
+
+ TfrxReportSummary = class(TfrxBand)
+ private
+ public
+ published
+ property AllowSplit;
+ property Child;
+ property KeepChild;
+ property PrintChildIfInvisible;
+ property StartNewPage;
+ property Stretched;
+ end;
+
+ TfrxChild = class(TfrxBand)
+ private
+ public
+ published
+ property AllowSplit;
+ property Child;
+ property KeepChild;
+ property PrintChildIfInvisible;
+ property StartNewPage;
+ property Stretched;
+ end;
+
+ TfrxOverlay = class(TfrxBand)
+ private
+ FPrintOnTop: Boolean;
+ public
+ published
+ property PrintOnTop: Boolean read FPrintOnTop write FPrintOnTop default False;
+ end;
+
+ TfrxNullBand = class(TfrxBand);
+
+
+{ Pages }
+
+ TfrxPage = class(TfrxComponent)
+ private
+ protected
+ public
+ published
+ property Font;
+ property Visible;
+ end;
+
+ TfrxReportPage = class(TfrxPage)
+ private
+ FBackPicture: TfrxPictureView;
+ FBin: Integer;
+ FBinOtherPages: Integer;
+ FBottomMargin: Double;
+ FColumns: Integer;
+ FColumnWidth: Double;
+ FColumnPositions: TStrings;
+ FDataSet: TfrxDataSet;
+ FDuplex: TfrxDuplexMode;
+ FEndlessHeight: Boolean;
+ FEndlessWidth: Boolean;
+ FHGuides: TStrings;
+ FLargeDesignHeight: Boolean;
+ FLeftMargin: Double;
+ FMirrorMargins: Boolean;
+ FOrientation: TPrinterOrientation;
+ FOutlineText: String;
+ FPrintIfEmpty: Boolean;
+ FPrintOnPreviousPage: Boolean;
+ FResetPageNumbers: Boolean;
+ FRightMargin: Double;
+ FSubReport: TfrxSubreport;
+ FTitleBeforeHeader: Boolean;
+ FTopMargin: Double;
+ FVGuides: TStrings;
+ FOnAfterPrint: TfrxNotifyEvent;
+ FOnBeforePrint: TfrxNotifyEvent;
+ FOnManualBuild: TfrxNotifyEvent;
+ FDataSetName: String;
+ FBackPictureVisible: Boolean;
+ FBackPicturePrintable: Boolean;
+ FPageCount: Integer;
+ procedure SetPageCount(const Value: Integer);
+ procedure SetColumns(const Value: Integer);
+ procedure SetOrientation(Value: TPrinterOrientation);
+ procedure SetHGuides(const Value: TStrings);
+ procedure SetVGuides(const Value: TStrings);
+ procedure SetColumnPositions(const Value: TStrings);
+ procedure SetFrame(const Value: TfrxFrame);
+ function GetFrame: TfrxFrame;
+ function GetColor: TAlphaColor;
+ procedure SetColor(const Value: TAlphaColor);
+ function GetBackPicture: TBitmap;
+ procedure SetBackPicture(const Value: TBitmap);
+ procedure SetDataSet(const Value: TfrxDataSet);
+ procedure SetDataSetName(const Value: String);
+ function GetDataSetName: String;
+ protected
+ FPaperHeight: Double;
+ FPaperSize: Integer;
+ FPaperWidth: Double;
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetPaperHeight(const Value: Double); virtual;
+ procedure SetPaperWidth(const Value: Double); virtual;
+ procedure SetPaperSize(const Value: Integer); virtual;
+ procedure UpdateDimensions;
+ public
+ FSubBands: TList; { list of master bands }
+ FVSubBands: TList; { list of vertical master bands }
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ function FindBand(Band: TfrxBandClass): TfrxBand;
+ function IsSubReport: Boolean;
+ procedure AlignChildren; override;
+ procedure ClearGuides;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
+ procedure SetDefaults; virtual;
+ procedure SetSizeAndDimensions(ASize: Integer; AWidth, AHeight: Double);
+ property SubReport: TfrxSubreport read FSubReport;
+ published
+ { paper }
+ property Orientation: TPrinterOrientation read FOrientation
+ write SetOrientation default poPortrait;
+ property PaperWidth: Double read FPaperWidth write SetPaperWidth;
+ property PaperHeight: Double read FPaperHeight write SetPaperHeight;
+ property PaperSize: Integer read FPaperSize write SetPaperSize;
+ { margins }
+ property LeftMargin: Double read FLeftMargin write FLeftMargin;
+ property RightMargin: Double read FRightMargin write FRightMargin;
+ property TopMargin: Double read FTopMargin write FTopMargin;
+ property BottomMargin: Double read FBottomMargin write FBottomMargin;
+ property MirrorMargins: Boolean read FMirrorMargins write FMirrorMargins
+ default False;
+ { columns }
+ property Columns: Integer read FColumns write SetColumns default 0;
+ property ColumnWidth: Double read FColumnWidth write FColumnWidth;
+ property ColumnPositions: TStrings read FColumnPositions write SetColumnPositions;
+ { bins }
+ property Bin: Integer read FBin write FBin default DMBIN_AUTO;
+ property BinOtherPages: Integer read FBinOtherPages write FBinOtherPages
+ default DMBIN_AUTO;
+ { other }
+ property BackPicture: TBitmap read GetBackPicture write SetBackPicture;
+ property BackPictureVisible: Boolean read FBackPictureVisible write FBackPictureVisible default True;
+ property BackPicturePrintable: Boolean read FBackPicturePrintable write FBackPicturePrintable default True;
+ property PageCount: Integer read FPageCount write SetPageCount default 1;
+ property Color: TAlphaColor read GetColor write SetColor default claNull;
+ property DataSet: TfrxDataSet read FDataSet write SetDataSet;
+ property DataSetName: String read GetDataSetName write SetDataSetName;
+ property Duplex: TfrxDuplexMode read FDuplex write FDuplex default dmNone;
+ property Frame: TfrxFrame read GetFrame write SetFrame;
+ property EndlessHeight: Boolean read FEndlessHeight write FEndlessHeight default False;
+ property EndlessWidth: Boolean read FEndlessWidth write FEndlessWidth default False;
+ property LargeDesignHeight: Boolean read FLargeDesignHeight
+ write FLargeDesignHeight default False;
+ property OutlineText: String read FOutlineText write FOutlineText;
+ property PrintIfEmpty: Boolean read FPrintIfEmpty write FPrintIfEmpty default True;
+ property PrintOnPreviousPage: Boolean read FPrintOnPreviousPage
+ write FPrintOnPreviousPage default False;
+ property ResetPageNumbers: Boolean read FResetPageNumbers
+ write FResetPageNumbers default False;
+ property TitleBeforeHeader: Boolean read FTitleBeforeHeader
+ write FTitleBeforeHeader default True;
+ property HGuides: TStrings read FHGuides write SetHGuides;
+ property VGuides: TStrings read FVGuides write SetVGuides;
+ property OnAfterPrint: TfrxNotifyEvent read FOnAfterPrint write FOnAfterPrint;
+ property OnBeforePrint: TfrxNotifyEvent read FOnBeforePrint write FOnBeforePrint;
+ property OnManualBuild: TfrxNotifyEvent read FOnManualBuild write FOnManualBuild;
+ end;
+
+ TfrxDialogPage = class(TfrxPage)
+ private
+ FBorderStyle: TfmxFormBorderStyle;
+ FCaption: String;
+ FColor: TAlphaColor;
+{$IFDEF LINUX}
+ FForm: TfrxForm;
+{$ELSE}
+ FForm: TForm;
+{$ENDIF}
+ FOnActivate: TfrxNotifyEvent;
+ FOnClick: TfrxNotifyEvent;
+ FOnDeactivate: TfrxNotifyEvent;
+ FOnHide: TfrxNotifyEvent;
+ FOnKeyDown: TfrxKeyEvent;
+ FOnKeyPress: TfrxKeyPressEvent;
+ FOnKeyUp: TfrxKeyEvent;
+ FOnResize: TfrxNotifyEvent;
+ FOnShow: TfrxNotifyEvent;
+ FOnCloseQuery: TfrxCloseQueryEvent;
+ FPosition: TFormPosition;
+ FWindowState: TWindowState;
+ FClientWidth: Double;
+ FClientHeight: Double;
+ procedure DoInitialize;
+ procedure DoOnActivate(Sender: TObject);
+ procedure DoOnCloseQuery(Sender: TObject; var CanClose: Boolean);
+ procedure DoOnDeactivate(Sender: TObject);
+ procedure DoOnResize(Sender: TObject);
+{$IFDEF DELPHI18}
+ procedure DoOnShow(Sender: TObject);
+{$ENDIF}
+ procedure DoModify(Sender: TObject);
+ procedure SetBorderStyle(const Value: TfmxFormBorderStyle);
+ procedure SetCaption(const Value: String);
+ procedure SetColor(const Value: TAlphaColor);
+ function GetModalResult: TModalResult;
+ procedure SetModalResult(const Value: TModalResult);
+ procedure SetPosition(const Value: TFormPosition);
+ protected
+ procedure SetLeft(Value: Double); override;
+ procedure SetTop(Value: Double); override;
+ procedure SetWidth(Value: Double); override;
+ procedure SetHeight(Value: Double); override;
+ procedure SetClientWidth(Value: Double);
+ procedure SetClientHeight(Value: Double);
+ function GetClientWidth: Double;
+ function GetClientHeight: Double;
+ procedure FontChanged(Sender: TObject); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ procedure Initialize;
+ procedure UpdateClientRect;
+ function ShowModal: TModalResult;
+{$IFDEF LINUX}
+ property DialogForm: TfrxForm read FForm;
+{$ELSE}
+ property DialogForm: TForm read FForm;
+{$ENDIF}
+ property ModalResult: TModalResult read GetModalResult write SetModalResult;
+ published
+ property BorderStyle: TfmxFormBorderStyle read FBorderStyle write SetBorderStyle default TfmxFormBorderStyle.bsSizeable;
+ property Caption: String read FCaption write SetCaption;
+ property Color: TAlphaColor read FColor write SetColor default claWhiteSmoke;
+ property Height;
+ property ClientHeight: Double read GetClientHeight write SetClientHeight;
+ property Left;
+ property Position: TFormPosition read FPosition write SetPosition default TFormPosition.poScreenCenter;
+ property Top;
+ property Width;
+ property ClientWidth: Double read GetClientWidth write SetClientWidth;
+ property WindowState: TWindowState read FWindowState write FWindowState default TWindowState.wsNormal;
+ property OnActivate: TfrxNotifyEvent read FOnActivate write FOnActivate;
+ property OnClick: TfrxNotifyEvent read FOnClick write FOnClick;
+ property OnCloseQuery: TfrxCloseQueryEvent read FOnCloseQuery write FOnCloseQuery;
+ property OnDeactivate: TfrxNotifyEvent read FOnDeactivate write FOnDeactivate;
+ property OnHide: TfrxNotifyEvent read FOnHide write FOnHide;
+ property OnKeyDown: TfrxKeyEvent read FOnKeyDown write FOnKeyDown;
+ property OnKeyPress: TfrxKeyPressEvent read FOnKeyPress write FOnKeyPress;
+ property OnKeyUp: TfrxKeyEvent read FOnKeyUp write FOnKeyUp;
+ property OnShow: TfrxNotifyEvent read FOnShow write FOnShow;
+ property OnResize: TfrxNotifyEvent read FOnResize write FOnResize;
+ end;
+
+ TfrxDataPage = class(TfrxPage)
+ private
+ protected
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ published
+ property Height;
+ property Left;
+ property Top;
+ property Width;
+ end;
+
+
+{ Report }
+
+ TfrxEngineOptions = class(TPersistent)
+ private
+ FConvertNulls: Boolean;
+ FDestroyForms: Boolean;
+ FDoublePass: Boolean;
+ FMaxMemSize: Integer;
+ FPrintIfEmpty: Boolean;
+ FReportThread: TThread;
+ FEnableThreadSafe: Boolean;
+ FSilentMode: TfrxSilentMode;
+ FTempDir: String;
+ FUseFileCache: Boolean;
+ FUseGlobalDataSetList: Boolean;
+ FIgnoreDevByZero: Boolean;
+
+ procedure SetSilentMode(Mode: Boolean);
+ function GetSilentMode: Boolean;
+ public
+ constructor Create;
+ procedure Assign(Source: TPersistent); override;
+ procedure Clear;
+ property ReportThread: TThread read FReportThread write FReportThread;
+ property DestroyForms: Boolean read FDestroyForms write FDestroyForms;
+ property EnableThreadSafe: Boolean read FEnableThreadSafe write FEnableThreadSafe;
+ property UseGlobalDataSetList: Boolean read FUseGlobalDataSetList write FUseGlobalDataSetList;
+ published
+ property ConvertNulls: Boolean read FConvertNulls write FConvertNulls default True;
+ property DoublePass: Boolean read FDoublePass write FDoublePass default False;
+ property MaxMemSize: Integer read FMaxMemSize write FMaxMemSize default 10;
+ property PrintIfEmpty: Boolean read FPrintIfEmpty write FPrintIfEmpty default True;
+ property SilentMode: Boolean read GetSilentMode write SetSilentMode default False;
+ property NewSilentMode: TfrxSilentMode read FSilentMode write FSilentMode default simMessageBoxes;
+ property TempDir: String read FTempDir write FTempDir;
+ property UseFileCache: Boolean read FUseFileCache write FUseFileCache default False;
+ property IgnoreDevByZero: Boolean read FIgnoreDevByZero write FIgnoreDevByZero default False;
+ end;
+
+ TfrxPrintOptions = class(TPersistent)
+ private
+ FCopies: Integer;
+ FCollate: Boolean;
+ FPageNumbers: String;
+ FPagesOnSheet: Integer;
+ FPrinter: String;
+ FPrintMode: TfrxPrintMode;
+ FPrintOnSheet: Integer;
+ FPrintPages: TfrxPrintPages;
+ FReverse: Boolean;
+ FShowDialog: Boolean;
+ FSwapPageSize: Boolean;
+ FPrnOutFileName: String;
+ FDuplex: TfrxDuplexMode;
+ FSplicingLine: Integer;
+ public
+ constructor Create;
+ procedure Assign(Source: TPersistent); override;
+ procedure Clear;
+ property PrnOutFileName: String read FPrnOutFileName write FPrnOutFileName;
+ property Duplex: TfrxDuplexMode read FDuplex write FDuplex;// set only after prepare report, need to store global duplex
+ property SplicingLine: Integer read FSplicingLine write FSplicingLine default 3;
+ published
+ property Copies: Integer read FCopies write FCopies default 1;
+ property Collate: Boolean read FCollate write FCollate default True;
+ property PageNumbers: String read FPageNumbers write FPageNumbers;
+ property Printer: String read FPrinter write FPrinter;
+ property PrintMode: TfrxPrintMode read FPrintMode write FPrintMode default pmDefault;
+ property PrintOnSheet: Integer read FPrintOnSheet write FPrintOnSheet;
+ property PrintPages: TfrxPrintPages read FPrintPages write FPrintPages default ppAll;
+ property Reverse: Boolean read FReverse write FReverse default False;
+ property ShowDialog: Boolean read FShowDialog write FShowDialog default True;
+ property SwapPageSize: Boolean read FSwapPageSize write FSwapPageSize stored False;// remove it
+ end;
+
+ TfrxPreviewOptions = class(TPersistent)
+ private
+ FAllowEdit: Boolean;
+ FButtons: TfrxPreviewButtons;
+ FDoubleBuffered: Boolean;
+ FMaximized: Boolean;
+ FMDIChild: Boolean;
+ FModal: Boolean;
+ FOutlineExpand: Boolean;
+ FOutlineVisible: Boolean;
+ FOutlineWidth: Integer;
+ FPagesInCache: Integer;
+ FShowCaptions: Boolean;
+ FThumbnailVisible: Boolean;
+ FZoom: Double;
+ FZoomMode: TfrxZoomMode;
+ FPictureCacheInFile: Boolean;
+ FRTLPreview: Boolean;
+ FPagesInPictureCache: Boolean;
+ FMaxPagePictureWidth: Integer;
+ FMaxPagePictureHeight: Integer;
+ public
+ constructor Create;
+ procedure Assign(Source: TPersistent); override;
+ procedure Clear;
+ property RTLPreview: Boolean read FRTLPreview write FRTLPreview;
+ property PagesInPictureCache: Boolean read FPagesInPictureCache write FPagesInPictureCache default False;
+ property MaxPagePictureWidth: Integer read FMaxPagePictureWidth write FMaxPagePictureWidth default 1600;
+ property MaxPagePictureHeight: Integer read FMaxPagePictureHeight write FMaxPagePictureHeight default 1200;
+ published
+ property AllowEdit: Boolean read FAllowEdit write FAllowEdit default True;
+ property Buttons: TfrxPreviewButtons read FButtons write FButtons;
+ property DoubleBuffered: Boolean read FDoubleBuffered write FDoubleBuffered default True;
+ property Maximized: Boolean read FMaximized write FMaximized default True;
+ property MDIChild: Boolean read FMDIChild write FMDIChild default False;
+ property Modal: Boolean read FModal write FModal default True;
+ property OutlineExpand: Boolean read FOutlineExpand write FOutlineExpand default True;
+ property OutlineVisible: Boolean read FOutlineVisible write FOutlineVisible default False;
+ property OutlineWidth: Integer read FOutlineWidth write FOutlineWidth default 120;
+ property PagesInCache: Integer read FPagesInCache write FPagesInCache default 50;
+ property ThumbnailVisible: Boolean read FThumbnailVisible write FThumbnailVisible default False;
+ property ShowCaptions: Boolean read FShowCaptions write FShowCaptions default False;
+ property Zoom: Double read FZoom write FZoom;
+ property ZoomMode: TfrxZoomMode read FZoomMode write FZoomMode default zmDefault;
+ property PictureCacheInFile: Boolean read FPictureCacheInFile write FPictureCacheInFile default False;
+ end;
+
+ TfrxReportOptions = class(TPersistent)
+ private
+ FAuthor: String;
+ FCompressed: Boolean;
+ FConnectionName: String;
+ FCreateDate: TDateTime;
+ FDescription: TStrings;
+ FInitString: String;
+ FName: String;
+ FLastChange: TDateTime;
+ FPassword: String;
+ FPicture: TBitmap;
+ FReport: TfrxReport;
+ FVersionBuild: String;
+ FVersionMajor: String;
+ FVersionMinor: String;
+ FVersionRelease: String;
+ FPrevPassword: String;
+ FHiddenPassword: String;
+ FInfo: Boolean;
+ FIsFMXReport: Boolean;
+ procedure SetDescription(const Value: TStrings);
+ procedure SetPicture(const Value: TBitmap);
+ public
+ constructor Create(AOwner: TComponent);
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ procedure Clear;
+ function CheckPassword: Boolean;
+ property PrevPassword: String write FPrevPassword;
+ property Info: Boolean read FInfo write FInfo;
+ property HiddenPassword: String read FHiddenPassword write FHiddenPassword;
+ published
+ property Author: String read FAuthor write FAuthor;
+ property Compressed: Boolean read FCompressed write FCompressed default False;
+ property CreateDate: TDateTime read FCreateDate write FCreateDate;
+ property Description: TStrings read FDescription write SetDescription;
+ property InitString: String read FInitString write FInitString;
+ property Name: String read FName write FName;
+ property LastChange: TDateTime read FLastChange write FLastChange;
+ property Password: String read FPassword write FPassword;
+ property Picture: TBitmap read FPicture write SetPicture;
+ property VersionBuild: String read FVersionBuild write FVersionBuild;
+ property VersionMajor: String read FVersionMajor write FVersionMajor;
+ property VersionMinor: String read FVersionMinor write FVersionMinor;
+ property VersionRelease: String read FVersionRelease write FVersionRelease;
+ property IsFMXReport: Boolean read FIsFMXReport write FIsFMXReport;
+ end;
+
+
+ TfrxExpressionCache = class(TObject)
+ private
+ FExpressions: TStringList;
+ FMainScript: TfsScript;
+ FScript: TfsScript;
+ FScriptLanguage: String;
+ procedure SetCaseSensitive(const Value: Boolean);
+ function GetCaseSensitive: Boolean;
+ public
+ constructor Create(AScript: TfsScript);
+ destructor Destroy; override;
+ procedure Clear;
+ function Calc(const Expression: String; var ErrorMsg: String;
+ AScript: TfsScript): Variant;
+ property CaseSensitive: Boolean read GetCaseSensitive write SetCaseSensitive;
+ end;
+
+ TfrxDataSetItem = class(TCollectionItem)
+ private
+ FDataSet: TfrxDataSet;
+ FDataSetName: String;
+ procedure SetDataSet(const Value: TfrxDataSet);
+ procedure SetDataSetName(const Value: String);
+ function GetDataSetName: String;
+ published
+ property DataSet: TfrxDataSet read FDataSet write SetDataSet;
+ property DataSetName: String read GetDataSetName write SetDataSetName;
+ end;
+
+ TfrxReportDataSets = class(TCollection)
+ private
+ FReport: TfrxReport;
+ function GetItem(Index: Integer): TfrxDataSetItem;
+ public
+ constructor Create(AReport: TfrxReport);
+ procedure Initialize;
+ procedure Finalize;
+ procedure Add(ds: TfrxDataSet);
+ function Find(ds: TfrxDataSet): TfrxDataSetItem; overload;
+ function Find(const Name: String): TfrxDataSetItem; overload;
+ procedure Delete(const Name: String); overload;
+ property Items[Index: Integer]: TfrxDataSetItem read GetItem; default;
+ end;
+
+ TfrxStyleItem = class(TCollectionItem)
+ private
+ FName: String;
+ FColor: TAlphaColor;
+ FFont: TfrxFont;
+ FFrame: TfrxFrame;
+ procedure SetFont(const Value: TfrxFont);
+ procedure SetFrame(const Value: TfrxFrame);
+ procedure SetName(const Value: String);
+ public
+ constructor Create(Collection: TCollection); override;
+ destructor Destroy; override;
+ procedure Assign(Source: TPersistent); override;
+ procedure CreateUniqueName;
+ published
+ property Name: String read FName write SetName;
+ property Color: TAlphaColor read FColor write FColor;
+ property Font: TfrxFont read FFont write SetFont;
+ property Frame: TfrxFrame read FFrame write SetFrame;
+ end;
+
+ TfrxStyles = class(TCollection)
+ private
+ FName: String;
+ FReport: TfrxReport;
+ function GetItem(Index: Integer): TfrxStyleItem;
+ public
+ constructor Create(AReport: TfrxReport);
+ function Add: TfrxStyleItem;
+ function Find(const Name: String): TfrxStyleItem;
+ procedure Apply;
+ procedure GetList(List: TStrings);
+ procedure LoadFromFile(const FileName: String);
+ procedure LoadFromStream(Stream: TStream);
+ procedure LoadFromXMLItem(Item: TfrxXMLItem; OldXMLFormat: Boolean = True);
+ procedure SaveToFile(const FileName: String);
+ procedure SaveToStream(Stream: TStream);
+ procedure SaveToXMLItem(Item: TfrxXMLItem);
+ property Items[Index: Integer]: TfrxStyleItem read GetItem; default;
+ property Name: String read FName write FName;
+ end;
+
+ TfrxStyleSheet = class(TObject)
+ private
+ FItems: TList;
+ function GetItems(Index: Integer): TfrxStyles;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Clear;
+ procedure Delete(Index: Integer);
+ procedure GetList(List: TStrings);
+ procedure LoadFromFile(const FileName: String);
+ procedure LoadFromStream(Stream: TStream);
+ procedure SaveToFile(const FileName: String);
+ procedure SaveToStream(Stream: TStream);
+ function Add: TfrxStyles;
+ function Count: Integer;
+ function Find(const Name: String): TfrxStyles;
+ function IndexOf(const Name: String): Integer;
+ property Items[Index: Integer]: TfrxStyles read GetItems; default;
+ end;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxReport = class(TfrxComponent)
+ private
+{$IFNDEF MSWINDOWS}
+{$IFDEF DELPHI17}
+ FRAppService: IFMXApplicationService;
+{$ENDIF}
+{$ENDIF}
+ FCurObject: String;
+ FDataSet: TfrxDataSet;
+ FDataSetName: String;
+ FDataSets: TfrxReportDatasets;
+ FDesigner: TfrxCustomDesigner;
+ FDotMatrixReport: Boolean;
+ FDrawText: Pointer;
+ FDrillState: TStrings;
+ FEnabledDataSets: TfrxReportDataSets;
+ FEngine: TfrxCustomEngine;
+ FEngineOptions: TfrxEngineOptions;
+ FErrors: TStrings;
+ FExpressionCache: TfrxExpressionCache;
+ FFileName: String;
+ FIniFile: String;
+ FLoadStream: TStream;
+ FLocalValue: TfsCustomVariable;
+ FSelfValue: TfsCustomVariable;
+ FModified: Boolean;
+ FOldStyleProgress: Boolean;
+ FParentForm: TForm;
+ FParentReport: String;
+ FParentReportObject: TfrxReport;
+ FPreviewPages: TfrxCustomPreviewPages;
+ FPreview: TfrxCustomPreview;
+ FPreviewForm: TForm;
+ FPreviewOptions: TfrxPreviewOptions;
+ FPrintOptions: TfrxPrintOptions;
+ FProgress: TfrxProgress;
+ FReloading: Boolean;
+ FReportOptions: TfrxReportOptions;
+ FScript: TfsScript;
+ FScriptLanguage: String;
+ FScriptText: TStrings;
+ FFakeScriptText: TStrings; {fake object}
+ FShowProgress: Boolean;
+ FStoreInDFM: Boolean;
+ FStyles: TfrxStyles;
+ FSysVariables: TStrings;
+ FTerminated: Boolean;
+ FTimer: TTimer;
+ FVariables: TfrxVariables;
+ FVersion: String;
+ FXMLSerializer: TObject;
+ FStreamLoaded: Boolean;
+ FDrawBitmap: TBitmap;
+
+ FOnAfterPrint: TfrxBeforePrintEvent;
+ FOnAfterPrintReport: TNotifyEvent;
+ FOnBeforeConnect: TfrxBeforeConnectEvent;
+ FOnAfterDisconnect: TfrxAfterDisconnectEvent;
+ FOnBeforePrint: TfrxBeforePrintEvent;
+ FOnBeginDoc: TNotifyEvent;
+ FOnClickObject: TfrxClickObjectEvent;
+ FOnDblClickObject: TfrxClickObjectEvent;
+ FOnEditConnection: TfrxEditConnectionEvent;
+ FOnEndDoc: TNotifyEvent;
+ FOnGetValue: TfrxGetValueEvent;
+ FOnNewGetValue: TfrxNewGetValueEvent;
+ FOnLoadTemplate: TfrxLoadTemplateEvent;
+ FOnManualBuild: TfrxManualBuildEvent;
+ FOnMouseOverObject: TfrxMouseOverObjectEvent;
+ FOnPreview: TNotifyEvent;
+ FOnPrintPage: TfrxPrintPageEvent;
+ FOnPrintReport: TNotifyEvent;
+ FOnProgressStart: TfrxProgressEvent;
+ FOnProgress: TfrxProgressEvent;
+ FOnProgressStop: TfrxProgressEvent;
+ FOnRunDialogs: TfrxRunDialogsEvent;
+ FOnSetConnection: TfrxSetConnectionEvent;
+ FOnStartReport: TfrxNotifyEvent;
+ FOnStopReport: TfrxNotifyEvent;
+ FOnUserFunction: TfrxUserFunctionEvent;
+ FOnClosePreview: TNotifyEvent;
+ FOnReportPrint: TfrxNotifyEvent;
+ FOnAfterScriptCompile: TNotifyEvent;
+
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; var Params: Variant): Variant;
+ function DoGetValue(const Expr: String; var Value: Variant): Boolean;
+ function GetScriptValue(Instance: TObject; ClassType: TClass;
+ const MethodName: String; var Params: Variant): Variant;
+ function SetScriptValue(Instance: TObject; ClassType: TClass;
+ const MethodName: String; var Params: Variant): Variant;
+ function DoUserFunction(Instance: TObject; ClassType: TClass;
+ const MethodName: String; var Params: Variant): Variant;
+ function GetDataSetName: String;
+ function GetLocalValue: Variant;
+ function GetSelfValue: TfrxView;
+ function GetPages(Index: Integer): TfrxPage;
+ function GetPagesCount: Integer;
+ function GetCaseSensitive: Boolean;
+ function GetScriptText: TStrings;
+ procedure AncestorNotFound(Reader: TReader; const ComponentName: string;
+ ComponentClass: TPersistentClass; var Component: TComponent);
+ procedure DoClear;
+ procedure DoGetAncestor(const Name: String; var Ancestor: TPersistent);
+ procedure DoLoadFromStream;
+ procedure OnTimer(Sender: TObject);
+ procedure ReadDatasets(Reader: TReader);
+ procedure ReadStyle(Reader: TReader);
+ procedure ReadVariables(Reader: TReader);
+ procedure SetDataSet(const Value: TfrxDataSet);
+ procedure SetDataSetName(const Value: String);
+ procedure SetEngineOptions(const Value: TfrxEngineOptions);
+ procedure SetSelfValue(const Value: TfrxView);
+ procedure SetLocalValue(const Value: Variant);
+ procedure SetParentReport(const Value: String);
+ procedure SetPreviewOptions(const Value: TfrxPreviewOptions);
+ procedure SetPrintOptions(const Value: TfrxPrintOptions);
+ procedure SetReportOptions(const Value: TfrxReportOptions);
+ procedure SetScriptText(const Value: TStrings);
+ procedure SetStyles(const Value: TfrxStyles);
+ procedure SetTerminated(const Value: Boolean);
+ procedure SetCaseSensitive(const Value: Boolean);
+ procedure WriteDatasets(Writer: TWriter);
+ procedure WriteStyle(Writer: TWriter);
+ procedure WriteVariables(Writer: TWriter);
+ procedure SetPreview(const Value: TfrxCustomPreview);
+ procedure SetVersion(const Value: String);
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure DefineProperties(Filer: TFiler); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Clear; override;
+ class function GetDescription: String; override;
+ function GetDrawBitmap: TBitmap;
+
+ { internal methods }
+ function Calc(const Expr: String; AScript: TfsScript = nil): Variant;
+ function DesignPreviewPage: Boolean;
+ function GetAlias(DataSet: TfrxDataSet): String;
+ function GetDataset(const Alias: String): TfrxDataset;
+ function GetIniFile: TCustomIniFile;
+ function GetApplicationFolder: String;
+ function PrepareScript: Boolean;
+ function InheritFromTemplate(const templName: String; InheriteMode: TfrxInheriteMode = imDefault): Boolean;
+ procedure DesignReport(IDesigner: IUnknown; Editor: TObject); overload;
+ procedure DoNotifyEvent(Obj: TObject; const EventName: String;
+ RunAlways: Boolean = False);
+ procedure DoParamEvent(const EventName: String; var Params: Variant;
+ RunAlways: Boolean = False);
+ procedure DoAfterPrint(c: TfrxReportComponent);
+ procedure DoBeforePrint(c: TfrxReportComponent);
+ procedure DoPreviewClick(v: TfrxView; Button: TMouseButton;
+ Shift: TShiftState; var Modified: Boolean; DblClick: Boolean = False);
+ procedure GetDatasetAndField(const ComplexName: String;
+ var Dataset: TfrxDataset; var Field: String);
+ procedure GetDataSetList(List: TStrings; OnlyDB: Boolean = False);
+ procedure GetActiveDataSetList(List: TStrings);
+ procedure InternalOnProgressStart(ProgressType: TfrxProgressType); virtual;
+ procedure InternalOnProgress(ProgressType: TfrxProgressType; Progress: Integer); virtual;
+ procedure InternalOnProgressStop(ProgressType: TfrxProgressType); virtual;
+ procedure SelectPrinter;
+ procedure SetProgressMessage(const Value: String; Ishint: Boolean = False);
+ procedure CheckDataPage;
+ procedure AppHandleMessage;
+
+ { public methods }
+ function LoadFromFile(const FileName: String;
+ ExceptionIfNotFound: Boolean = False): Boolean;
+ procedure LoadFromStream(Stream: TStream); override;
+ procedure SaveToFile(const FileName: String);
+ procedure SaveToStream(Stream: TStream; SaveChildren: Boolean = True;
+ SaveDefaultValues: Boolean = False; UseGetAncestor: Boolean = False); override;
+ procedure DesignReport(Modal: Boolean = True; MDIChild: Boolean = False); overload; stdcall;
+ function PrepareReport(ClearLastReport: Boolean = True): Boolean;
+ procedure ShowPreparedReport; stdcall;
+ procedure ShowReport(ClearLastReport: Boolean = True); stdcall;
+ procedure AddFunction(const FuncName: String; const Category: String = '';
+ const Description: String = '');
+ function Print: Boolean; stdcall;
+ function Export(Filter: TfrxCustomExportFilter): Boolean;
+
+ { internals }
+ property CurObject: String read FCurObject write FCurObject;
+ property DrillState: TStrings read FDrillState;
+ property LocalValue: Variant read GetLocalValue write SetLocalValue;
+ property SelfValue: TfrxView read GetSelfValue write SetSelfValue;
+ property PreviewForm: TForm read FPreviewForm;
+ property XMLSerializer: TObject read FXMLSerializer;
+ property Reloading: Boolean read FReloading write FReloading;
+
+ { public }
+ property DataSets: TfrxReportDataSets read FDataSets;
+ property Designer: TfrxCustomDesigner read FDesigner write FDesigner;
+ property EnabledDataSets: TfrxReportDataSets read FEnabledDataSets;
+ property Engine: TfrxCustomEngine read FEngine;
+ property Errors: TStrings read FErrors;
+ property FileName: String read FFileName write FFileName;
+ property Modified: Boolean read FModified write FModified;
+ property PreviewPages: TfrxCustomPreviewPages read FPreviewPages;
+ property Pages[Index: Integer]: TfrxPage read GetPages;
+ property PagesCount: Integer read GetPagesCount;
+ property Script: TfsScript read FScript;
+ property Styles: TfrxStyles read FStyles write SetStyles;
+ property Terminated: Boolean read FTerminated write SetTerminated;
+ property Variables: TfrxVariables read FVariables;
+ property CaseSensitiveExpressions: Boolean read GetCaseSensitive write SetCaseSensitive;
+
+ property OnEditConnection: TfrxEditConnectionEvent read FOnEditConnection write FOnEditConnection;
+ property OnSetConnection: TfrxSetConnectionEvent read FOnSetConnection write FOnSetConnection;
+ published
+ property Version: String read FVersion write SetVersion;
+ property ParentReport: String read FParentReport write SetParentReport;
+ property DataSet: TfrxDataSet read FDataSet write SetDataSet;
+ property DataSetName: String read GetDataSetName write SetDataSetName;
+ property DotMatrixReport: Boolean read FDotMatrixReport write FDotMatrixReport;
+ property EngineOptions: TfrxEngineOptions read FEngineOptions write SetEngineOptions;
+ property IniFile: String read FIniFile write FIniFile;
+ property OldStyleProgress: Boolean read FOldStyleProgress write FOldStyleProgress default True;
+ property Preview: TfrxCustomPreview read FPreview write SetPreview;
+ property PreviewOptions: TfrxPreviewOptions read FPreviewOptions write SetPreviewOptions;
+ property PrintOptions: TfrxPrintOptions read FPrintOptions write SetPrintOptions;
+ property ReportOptions: TfrxReportOptions read FReportOptions write SetReportOptions;
+ property ScriptLanguage: String read FScriptLanguage write FScriptLanguage;
+ property ScriptText: TStrings read GetScriptText write SetScriptText;
+ property ShowProgress: Boolean read FShowProgress write FShowProgress default True;
+ property StoreInDFM: Boolean read FStoreInDFM write FStoreInDFM default True;
+
+ property OnAfterPrint: TfrxBeforePrintEvent read FOnAfterPrint write FOnAfterPrint;
+ property OnBeforeConnect: TfrxBeforeConnectEvent read FOnBeforeConnect write FOnBeforeConnect;
+ property OnAfterDisconnect: TfrxAfterDisconnectEvent read FOnAfterDisconnect write FOnAfterDisconnect;
+ property OnBeforePrint: TfrxBeforePrintEvent read FOnBeforePrint write FOnBeforePrint;
+ property OnBeginDoc: TNotifyEvent read FOnBeginDoc write FOnBeginDoc;
+ property OnClickObject: TfrxClickObjectEvent read FOnClickObject write FOnClickObject;
+ property OnDblClickObject: TfrxClickObjectEvent read FOnDblClickObject write FOnDblClickObject;
+ property OnEndDoc: TNotifyEvent read FOnEndDoc write FOnEndDoc;
+ property OnGetValue: TfrxGetValueEvent read FOnGetValue write FOnGetValue;
+ property OnNewGetValue: TfrxNewGetValueEvent read FOnNewGetValue write FOnNewGetValue;
+ property OnManualBuild: TfrxManualBuildEvent read FOnManualBuild write FOnManualBuild;
+ property OnMouseOverObject: TfrxMouseOverObjectEvent read FOnMouseOverObject
+ write FOnMouseOverObject;
+ property OnPreview: TNotifyEvent read FOnPreview write FOnPreview;
+ property OnPrintPage: TfrxPrintPageEvent read FOnPrintPage write FOnPrintPage;
+ property OnPrintReport: TNotifyEvent read FOnPrintReport write FOnPrintReport;
+ property OnAfterPrintReport: TNotifyEvent read FOnAfterPrintReport write FOnAfterPrintReport;
+ property OnProgressStart: TfrxProgressEvent read FOnProgressStart write FOnProgressStart;
+ property OnProgress: TfrxProgressEvent read FOnProgress write FOnProgress;
+ property OnProgressStop: TfrxProgressEvent read FOnProgressStop write FOnProgressStop;
+ property OnRunDialogs: TfrxRunDialogsEvent read FOnRunDialogs write FOnRunDialogs;
+ property OnStartReport: TfrxNotifyEvent read FOnStartReport write FOnStartReport;
+ property OnStopReport: TfrxNotifyEvent read FOnStopReport write FOnStopReport;
+ property OnUserFunction: TfrxUserFunctionEvent read FOnUserFunction write FOnUserFunction;
+ property OnLoadTemplate: TfrxLoadTemplateEvent read FOnLoadTemplate write FOnLoadTemplate;
+ property OnClosePreview: TNotifyEvent read FOnClosePreview write FOnClosePreview;
+ property OnReportPrint: TfrxNotifyEvent read FOnReportPrint write FOnReportPrint;
+ property OnAfterScriptCompile: TNotifyEvent read FOnAfterScriptCompile write FOnAfterScriptCompile;
+ end;
+
+ TfrxCustomDesigner = class(TfrxForm)
+ private
+ FReport: TfrxReport;
+ FIsPreviewDesigner: Boolean;
+ FMemoFontName: String;
+ FMemoFontSize: Integer;
+ FUseObjectFont: Boolean;
+ FParentForm: TForm;
+ protected
+ FModified: Boolean;
+ FObjects: TList;
+ FPage: TfrxPage;
+ FSelectedObjects: TList;
+ procedure SetModified(const Value: Boolean); virtual;
+ procedure SetPage(const Value: TfrxPage); virtual;
+ function GetCode: TStrings; virtual; abstract;
+ public
+ constructor CreateDesigner(AOwner: TComponent; AReport: TfrxReport;
+ APreviewDesigner: Boolean = False);
+ destructor Destroy; override;
+ procedure FormShow(Sender: TObject); virtual; abstract;
+ function InsertExpression(const Expr: String): String; virtual; abstract;
+ procedure Lock; virtual; abstract;
+ procedure ReloadPages(Index: Integer); virtual; abstract;
+ procedure ReloadReport; virtual; abstract;
+ procedure UpdateDataTree; virtual; abstract;
+ procedure UpdatePage; virtual; abstract;
+ procedure UpdateInspector; virtual; abstract;
+ procedure Done; virtual; abstract;
+ procedure Init; virtual; abstract;
+ property IsPreviewDesigner: Boolean read FIsPreviewDesigner;
+ property Modified: Boolean read FModified write SetModified;
+ property Objects: TList read FObjects;
+ property Report: TfrxReport read FReport;
+ property SelectedObjects: TList read FSelectedObjects;
+ property Page: TfrxPage read FPage write SetPage;
+ property Code: TStrings read GetCode;
+ property UseObjectFont: Boolean read FUseObjectFont write FUseObjectFont;
+ property MemoFontName: String read FMemoFontName write FMemoFontName;
+ property MemoFontSize: Integer read FMemoFontSize write FMemoFontSize;
+ property ParentForm: TForm read FParentForm write FParentForm;
+ end;
+
+ TfrxDesignerClass = class of TfrxCustomDesigner;
+
+ TfrxCustomExportFilter = class(TComponent)
+ private
+ FCurPage: Boolean;
+ FExportNotPrintable: Boolean;
+ FName: String;
+ FNoRegister: Boolean;
+ FPageNumbers: String;
+ FReport: TfrxReport;
+ FShowDialog: Boolean;
+ FStream: TStream;
+ FUseFileCache: Boolean;
+ FDefaultPath: String;
+ FSlaveExport: Boolean;
+ FShowProgress: Boolean;
+ FDefaultExt: String;
+ FFilterDesc: String;
+ FSuppressPageHeadersFooters: Boolean;
+ FTitle: String;
+ FOverwritePrompt: Boolean;
+ FFIles: TStrings;
+ FOnBeginExport: TNotifyEvent;
+ FCreationTime: TDateTime;
+ FDataOnly: Boolean;
+ protected
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor CreateNoRegister;
+ destructor Destroy; override;
+ class function GetDescription: String; virtual;
+ function ShowModal: TModalResult; virtual;
+ function Start: Boolean; virtual;
+ procedure ExportObject(Obj: TfrxComponent); virtual; abstract;
+ procedure Finish; virtual;
+ procedure FinishPage(Page: TfrxReportPage; Index: Integer); virtual;
+ procedure StartPage(Page: TfrxReportPage; Index: Integer); virtual;
+
+ property CurPage: Boolean read FCurPage write FCurPage;
+ property PageNumbers: String read FPageNumbers write FPageNumbers;
+ property Report: TfrxReport read FReport write FReport;
+ property Stream: TStream read FStream write FStream;
+ property SlaveExport: Boolean read FSlaveExport write FSlaveExport;
+ property DefaultExt: String read FDefaultExt write FDefaultExt;
+ property FilterDesc: String read FFilterDesc write FFilterDesc;
+ property SuppressPageHeadersFooters: Boolean read FSuppressPageHeadersFooters
+ write FSuppressPageHeadersFooters;
+ property ExportTitle: String read FTitle write FTitle;
+ property Files: TStrings read FFiles write FFiles;
+ published
+ property ShowDialog: Boolean read FShowDialog write FShowDialog default True;
+ property FileName: String read FName write FName;
+ property ExportNotPrintable: Boolean read FExportNotPrintable write FExportNotPrintable default False;
+ property UseFileCache: Boolean read FUseFileCache write FUseFileCache;
+ property DefaultPath: String read FDefaultPath write FDefaultPath;
+ property ShowProgress: Boolean read FShowProgress write FShowProgress;
+ property OverwritePrompt: Boolean read FOverwritePrompt write FOverwritePrompt;
+ property CreationTime: TDateTime read FCreationTime write FCreationTime;
+ property DataOnly: Boolean read FDataOnly write FDataOnly;
+
+ property OnBeginExport: TNotifyEvent read FOnBeginExport write FOnBeginExport;
+ end;
+
+ TfrxCustomWizard = class(TComponent)
+ private
+ FDesigner: TfrxCustomDesigner;
+ FReport: TfrxReport;
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; virtual;
+ function Execute: Boolean; virtual; abstract;
+ property Designer: TfrxCustomDesigner read FDesigner;
+ property Report: TfrxReport read FReport;
+ end;
+
+ TfrxWizardClass = class of TfrxCustomWizard;
+
+ TfrxCustomEngine = class(TPersistent)
+ private
+ FCurColumn: Integer;
+ FCurVColumn: Integer;
+ FCurLine: Integer;
+ FCurLineThrough: Integer;
+ FCurX: Double;
+ FCurY: Double;
+ FFinalPass: Boolean;
+ FNotifyList: TList;
+ FPageHeight: Double;
+ FPageWidth: Double;
+ FPreviewPages: TfrxCustomPreviewPages;
+ FReport: TfrxReport;
+ FRunning: Boolean;
+ FStartDate: TDateTime;
+ FStartTime: TDateTime;
+ FTotalPages: Integer;
+ FOnRunDialog: TfrxRunDialogEvent;
+ FSecondScriptCall: Boolean;
+ function GetDoublePass: Boolean;
+ protected
+ function GetPageHeight: Double; virtual;
+ public
+ constructor Create(AReport: TfrxReport); virtual;
+ destructor Destroy; override;
+ procedure EndPage; virtual; abstract;
+ procedure BreakAllKeep; virtual;
+ procedure NewColumn; virtual; abstract;
+ procedure NewPage; virtual; abstract;
+ procedure ShowBand(Band: TfrxBand); overload; virtual; abstract;
+ procedure ShowBand(Band: TfrxBandClass); overload; virtual; abstract;
+ procedure ShowBandByName(const BandName: String);
+ procedure StopReport;
+ function HeaderHeight: Double; virtual; abstract;
+ function FooterHeight: Double; virtual; abstract;
+ function FreeSpace: Double; virtual; abstract;
+ function GetAggregateValue(const Name, Expression: String;
+ Band: TfrxBand; Flags: Integer): Variant; virtual; abstract;
+ function Run: Boolean; virtual; abstract;
+
+ property CurLine: Integer read FCurLine write FCurLine;
+ property CurLineThrough: Integer read FCurLineThrough write FCurLineThrough;
+ property NotifyList: TList read FNotifyList;
+ property PreviewPages: TfrxCustomPreviewPages read FPreviewPages;
+ property Report: TfrxReport read FReport;
+ property Running: Boolean read FRunning write FRunning;
+ property OnRunDialog: TfrxRunDialogEvent read FOnRunDialog write FOnRunDialog;
+ published
+ property CurColumn: Integer read FCurColumn write FCurColumn;
+ property CurVColumn: Integer read FCurVColumn write FCurVColumn;
+ property CurX: Double read FCurX write FCurX;
+ property CurY: Double read FCurY write FCurY;
+ property DoublePass: Boolean read GetDoublePass;
+ property FinalPass: Boolean read FFinalPass write FFinalPass;
+ property PageHeight: Double read GetPageHeight write FPageHeight;
+ property PageWidth: Double read FPageWidth write FPageWidth;
+ property StartDate: TDateTime read FStartDate write FStartDate;
+ property StartTime: TDateTime read FStartTime write FStartTime;
+ property TotalPages: Integer read FTotalPages write FTotalPages;
+ property SecondScriptCall: Boolean read FSecondScriptCall write FSecondScriptCall;
+ end;
+
+ TfrxCustomOutline = class(TPersistent)
+ private
+ FCurItem: TfrxXMLItem;
+ FPreviewPages: TfrxCustomPreviewPages;
+ protected
+ function GetCount: Integer; virtual; abstract;
+ public
+ constructor Create(APreviewPages: TfrxCustomPreviewPages); virtual;
+ procedure AddItem(const Text: String; Top: Integer); virtual; abstract;
+ procedure LevelDown(Index: Integer); virtual; abstract;
+ procedure LevelRoot; virtual; abstract;
+ procedure LevelUp; virtual; abstract;
+ procedure GetItem(Index: Integer; var Text: String;
+ var Page, Top: Integer); virtual; abstract;
+ procedure ShiftItems(From: TfrxXMLItem; NewTop: Integer); virtual; abstract;
+ function Engine: TfrxCustomEngine;
+ function GetCurPosition: TfrxXMLItem; virtual; abstract;
+ property Count: Integer read GetCount;
+ property CurItem: TfrxXMLItem read FCurItem write FCurItem;
+ property PreviewPages: TfrxCustomPreviewPages read FPreviewPages;
+ end;
+
+ TfrxCustomPreviewPages = class(TObject)
+ private
+ FAddPageAction: TfrxAddPageAction; { used in the cross-tab renderer }
+ FCurPage: Integer;
+ FCurPreviewPage: Integer;
+ FEngine: TfrxCustomEngine;
+ FFirstPage: Integer; { used in the composite reports }
+ FOutline: TfrxCustomOutline;
+ FReport: TfrxReport;
+ protected
+ function GetCount: Integer; virtual; abstract;
+ function GetPage(Index: Integer): TfrxReportPage; virtual; abstract;
+ function GetPageSize(Index: Integer): TPoint; virtual; abstract;
+ public
+ constructor Create(AReport: TfrxReport); virtual;
+ destructor Destroy; override;
+ procedure Clear; virtual; abstract;
+ procedure Initialize; virtual; abstract;
+
+ procedure AddObject(Obj: TfrxComponent); virtual; abstract;
+ procedure AddPage(Page: TfrxReportPage); virtual; abstract;
+ procedure AddSourcePage(Page: TfrxReportPage); virtual; abstract;
+ procedure AddToSourcePage(Obj: TfrxComponent); virtual; abstract;
+ procedure BeginPass; virtual; abstract;
+ procedure ClearFirstPassPages; virtual; abstract;
+ procedure CutObjects(APosition: Integer); virtual; abstract;
+ procedure Finish; virtual; abstract;
+ procedure IncLogicalPageNumber; virtual; abstract;
+ procedure ResetLogicalPageNumber; virtual; abstract;
+ procedure PasteObjects(X, Y: Extended); virtual; abstract;
+ procedure ShiftAnchors(From, NewTop: Integer); virtual; abstract;
+ procedure AddPicture(Picture: TfrxPictureView); virtual; abstract;
+ function BandExists(Band: TfrxBand): Boolean; virtual; abstract;
+ function GetCurPosition: Integer; virtual; abstract;
+ function GetAnchorCurPosition: Integer; virtual; abstract;
+ function GetLastY(ColumnPosition: Extended = 0): Extended; virtual; abstract;
+ function GetLogicalPageNo: Integer; virtual; abstract;
+ function GetLogicalTotalPages: Integer; virtual; abstract;
+
+ procedure AddEmptyPage(Index: Integer); virtual; abstract;
+ procedure DeletePage(Index: Integer); virtual; abstract;
+ procedure ModifyPage(Index: Integer; Page: TfrxReportPage); virtual; abstract;
+ procedure DrawPage(Index: Integer; Canvas: TCanvas; ScaleX, ScaleY,
+ OffsetX, OffsetY: Extended; WorkArea: TRectF); virtual; abstract;
+ procedure ObjectOver(Index: Integer; X, Y: Integer; Button: TMouseButton;
+ Shift: TShiftState; Scale, OffsetX, OffsetY: Extended;
+ Click: Boolean; var Cursor: TCursor; DBClick: Boolean = False); virtual; abstract;
+ procedure AddFrom(Report: TfrxReport); virtual; abstract;
+
+ procedure LoadFromStream(Stream: TStream;
+ AllowPartialLoading: Boolean = False); virtual; abstract;
+ procedure SaveToStream(Stream: TStream); virtual; abstract;
+ function LoadFromFile(const FileName: String;
+ ExceptionIfNotFound: Boolean = False): Boolean; virtual; abstract;
+ procedure SaveToFile(const FileName: String); virtual; abstract;
+ function Print: Boolean; virtual; abstract;
+ function Export(Filter: TfrxCustomExportFilter): Boolean; virtual; abstract;
+
+ property AddPageAction: TfrxAddPageAction read FAddPageAction write FAddPageAction;
+ property Count: Integer read GetCount;
+ property CurPage: Integer read FCurPage write FCurPage;
+ property CurPreviewPage: Integer read FCurPreviewPage write FCurPreviewPage;
+ property Engine: TfrxCustomEngine read FEngine;
+ property FirstPage: Integer read FFirstPage write FFirstPage;
+ property Outline: TfrxCustomOutline read FOutline;
+ property Page[Index: Integer]: TfrxReportPage read GetPage;
+ property PageSize[Index: Integer]: TPoint read GetPageSize;
+ property Report: TfrxReport read FReport;
+ end;
+
+ TfrxCustomPreview = class(TControl)
+ private
+ FPreviewPages: TfrxCustomPreviewPages;
+ FReport: TfrxReport;
+ FUseReportHints: Boolean;
+ public
+ function GetCanvas: TCanvas; virtual; abstract;
+ procedure Init; virtual; abstract;
+ procedure ShowHint(aRect: TRectF; Text: String); virtual; abstract;
+ procedure HideHint; virtual; abstract;
+ procedure ClearBackBuffer; virtual; abstract;
+ procedure Lock; virtual; abstract;
+ procedure Unlock; virtual; abstract;
+ procedure RefreshReport; virtual; abstract;
+ procedure InternalOnProgressStart(Sender: TfrxReport;
+ ProgressType: TfrxProgressType; Progress: Integer); virtual; abstract;
+ procedure InternalOnProgress(Sender: TfrxReport;
+ ProgressType: TfrxProgressType; Progress: Integer); virtual; abstract;
+ procedure InternalOnProgressStop(Sender: TfrxReport;
+ ProgressType: TfrxProgressType; Progress: Integer); virtual; abstract;
+
+ property PreviewPages: TfrxCustomPreviewPages read FPreviewPages write FPreviewPages;
+ property Report: TfrxReport read FReport write FReport;
+ property UseReportHints: Boolean read FUseReportHints write FUseReportHints;
+ end;
+
+ TfrxCompressorClass = class of TfrxCustomCompressor;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxCustomCompressor = class(TComponent)
+ private
+ FIsFR3File: Boolean;
+ FOldCompressor: TfrxCompressorClass;
+ FReport: TfrxReport;
+ FStream: TStream;
+ FTempFile: String;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function Decompress(Source: TStream): Boolean; virtual; abstract;
+ procedure Compress(Dest: TStream); virtual; abstract;
+ procedure CreateStream;
+ property IsFR3File: Boolean read FIsFR3File write FIsFR3File;
+ property Report: TfrxReport read FReport write FReport;
+ property Stream: TStream read FStream write FStream;
+ end;
+
+ TfrxCrypterClass = class of TfrxCustomCrypter;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxCustomCrypter = class(TComponent)
+ private
+ FStream: TStream;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function Decrypt(Source: TStream; const Key: AnsiString): Boolean; virtual; abstract;
+ procedure Crypt(Dest: TStream; const Key: AnsiString); virtual; abstract;
+ procedure CreateStream;
+ property Stream: TStream read FStream write FStream;
+ end;
+
+ TfrxLoadEvent = function(Sender: TfrxReport; Stream: TStream): Boolean of object;
+ TfrxAfterLoadEvent = procedure(Sender: TfrxReport) of object;
+ TfrxGetScriptValueEvent = function(var Params: Variant): Variant of object;
+
+ TfrxConverterEvents = class(TObject)
+ private
+ FOnGetValue: TfrxGetValueEvent;
+ FOnPrepareScript: TNotifyEvent;
+ FOnLoad: TfrxLoadEvent;
+ FOnAfterLoad: TfrxAfterLoadEvent;
+ FOnGetScriptValue: TfrxGetScriptValueEvent;
+ FFilter: String;
+ public
+ property OnGetValue: TfrxGetValueEvent read FOnGetValue write FOnGetValue;
+ property OnPrepareScript: TNotifyEvent read FOnPrepareScript write FOnPrepareScript;
+ property OnLoad: TfrxLoadEvent read FOnLoad write FOnLoad;
+ property OnAfterLoad: TfrxAfterLoadEvent read FOnAfterLoad write FOnAfterLoad;
+ property OnGetScriptValue: TfrxGetScriptValueEvent read FOnGetScriptValue write FOnGetScriptValue;
+ property Filter: String read FFilter write FFilter;
+ end;
+
+ TfrxGlobalDataSetList = class(TList)
+{$IFNDEF NO_CRITICAL_SECTION}
+ FCriticalSection: TCriticalSection;
+{$ENDIF}
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Lock;
+ procedure Unlock;
+ end;
+
+ TfrxCanvasClass = Class of TfrxFastCanvasLayer;
+
+function frxFindDataSet(DataSet: TfrxDataSet; const Name: String;
+ Owner: TComponent): TfrxDataSet;
+procedure frxGetDataSetList(List: TStrings);
+function frxCanvasClass(): TfrxCanvasClass;
+
+var
+ frxDesignerClass: TfrxDesignerClass;
+ frxDotMatrixExport: TfrxCustomExportFilter;
+ frxCompressorClass: TfrxCompressorClass;
+ frxCrypterClass: TfrxCrypterClass;
+ frxConverter: TfrxConverterEvents;
+{$IFNDEF NO_CRITICAL_SECTION}
+ frxCS: TCriticalSection;
+{$ENDIF}
+ frxGlobalVariables: TfrxVariables;
+const
+ FR_VERSION = {$I frxVersion.inc};
+ BND_COUNT = 18;
+ frxBands: array[0..BND_COUNT - 1] of TfrxComponentClass =
+ (TfrxReportTitle, TfrxReportSummary, TfrxPageHeader, TfrxPageFooter,
+ TfrxHeader, TfrxFooter, TfrxMasterData, TfrxDetailData, TfrxSubdetailData,
+ TfrxDataBand4, TfrxDataBand5, TfrxDataBand6, TfrxGroupHeader, TfrxGroupFooter,
+ TfrxChild, TfrxColumnHeader, TfrxColumnFooter, TfrxOverlay);
+
+implementation
+
+//{$R *.RES}
+
+uses
+ System.TypInfo, System.SysConst, System.Math,
+ FMX.frxEngine, FMX.frxPreviewPages, FMX.frxPreview, FMX.frxPrinter,
+ FMX.frxUtils, FMX.frxPassw, FMX.frxDialogForm,
+ FMX.frxXMLSerializer, FMX.frxAggregate, FMX.frxGraphicUtils, FMX.frxRes, FMX.frxDsgnIntf,
+ FMX.frxrcClass, FMX.frxClassRTTI, FMX.frxInheritError,
+ FMX.fs_ipascal, FMX.fs_icpp, FMX.fs_ibasic, FMX.fs_ijs, FMX.fs_iclassesrtti,
+ FMX.fs_igraphicsrtti, FMX.fs_iformsrtti, FMX.fs_idialogsrtti, FMX.fs_iinirtti,
+ FMX.frxDMPClass
+{$IFDEF DELPHI17}
+{$IFDEF MACOS}
+ , Macapi.Foundation, Macapi.AppKit
+{$ENDIF}
+{$ENDIF}
+{$IFDEF POSIX}
+ , Posix.Unistd
+{$ENDIF}
+;
+
+
+var
+ DatasetList: TfrxGlobalDataSetList;
+
+type
+ TByteSet = set of 0..7;
+ PByteSet = ^TByteSet;
+
+ THackControl = class(TControl);
+ THackPersistent = class(TPersistent);
+ THackThread = class(TThread);
+ TParentForm = class(TForm);
+
+function Round8(e: Extended): Extended;
+begin
+ Result := Round(e * 100000000) / 100000000;
+end;
+
+function frxFindDataSet(DataSet: TfrxDataSet; const Name: String;
+ Owner: TComponent): TfrxDataSet;
+var
+ i: Integer;
+ ds: TfrxDataSet;
+begin
+ Result := DataSet;
+ if Name = '' then
+ begin
+ Result := nil;
+ Exit;
+ end;
+ if Owner = nil then Exit;
+ DatasetList.Lock;
+ for i := 0 to DatasetList.Count - 1 do
+ begin
+ ds := DatasetList[i];
+ if frxCompareText(ds.UserName, Name) = 0 then
+ if not ((Owner is TfrxReport) and (ds.Owner is TfrxReport) and
+ (ds.Owner <> Owner)) then
+ begin
+ Result := DatasetList[i];
+ break;
+ end;
+ end;
+ DatasetList.Unlock;
+end;
+
+function frxCanvasClass(): TfrxCanvasClass;
+begin
+{$IFDEF DELPHI19}
+ {$IFDEF LINUX}
+ Result := nil;
+ {$ELSE}
+ {$IFDEF DELPHI27}
+ if GlobalUseMetal then
+ Result := nil
+ else
+ Result := TfrxFastCanvas;
+ {$ELSE}
+ Result := TfrxFastCanvas;
+ {$ENDIF}
+ {$ENDIF}
+{$ELSE}
+ Result := nil;
+{$ENDIF}
+end;
+
+procedure frxGetDataSetList(List: TStrings);
+var
+ i: Integer;
+ ds: TfrxDataSet;
+begin
+ DatasetList.Lock;
+ List.Clear;
+ for i := 0 to DatasetList.Count - 1 do
+ begin
+ ds := DatasetList[i];
+ if (ds <> nil) and (ds.UserName <> '') and ds.Enabled then
+ List.AddObject(ds.UserName, ds);
+ end;
+ DatasetList.Unlock;
+end;
+
+function FloatDiff(const Val1, Val2: Double): Boolean;
+begin
+ Result := Abs(Val1 - Val2) > 1e-4;
+end;
+
+function ShiftToByte(Value: TShiftState): Byte;
+begin
+ Result := Byte(PByteSet(@Value)^);
+end;
+
+
+{ TfrxDataset }
+
+constructor TfrxDataSet.Create(AOwner: TComponent);
+begin
+ inherited;
+ FEnabled := True;
+ FOpenDataSource := True;
+ FRangeBegin := rbFirst;
+ FRangeEnd := reLast;
+ DatasetList.Lock;
+ DatasetList.Add(Self);
+ DatasetList.Unlock;
+end;
+
+destructor TfrxDataSet.Destroy;
+begin
+ DatasetList.Lock;
+ DatasetList.Remove(Self);
+ inherited;
+ DatasetList.Unlock;
+end;
+
+procedure TfrxDataSet.SetName(const NewName: TComponentName);
+begin
+ inherited;
+ if NewName <> '' then
+ if (FUserName = '') or (FUserName = Name) then
+ UserName := NewName
+end;
+
+procedure TfrxDataSet.SetUserName(const Value: String);
+begin
+ if Trim(Value) = '' then
+ raise Exception.Create(frxResources.Get('prInvProp'));
+ FUserName := Value;
+end;
+
+procedure TfrxDataSet.Initialize;
+begin
+end;
+
+procedure TfrxDataSet.Finalize;
+begin
+end;
+
+procedure TfrxDataSet.Close;
+begin
+ if Assigned(FOnClose) then FOnClose(Self);
+end;
+
+procedure TfrxDataSet.Open;
+begin
+ if Assigned(FOnOpen) then FOnOpen(Self);
+end;
+
+procedure TfrxDataSet.First;
+begin
+ FRecNo := 0;
+ FEof := False;
+ if Assigned(FOnFirst) then
+ FOnFirst(Self);
+end;
+
+procedure TfrxDataSet.Next;
+begin
+ FEof := False;
+ Inc(FRecNo);
+ if not ((FRangeEnd = reCount) and (FRecNo >= FRangeEndCount)) then
+ begin
+ if Assigned(FOnNext) then
+ FOnNext(Self);
+ end
+ else
+ begin
+ FRecNo := FRangeEndCount - 1;
+ FEof := True;
+ end;
+end;
+
+procedure TfrxDataSet.Prior;
+begin
+ Dec(FRecNo);
+ if Assigned(FOnPrior) then
+ FOnPrior(Self);
+end;
+
+function TfrxDataSet.Eof: Boolean;
+begin
+ Result := False;
+ if FRangeEnd = reCount then
+ if (FRecNo >= FRangeEndCount) or FEof then
+ Result := True;
+ if Assigned(FOnCheckEOF) then
+ FOnCheckEOF(Self, Result);
+end;
+
+function TfrxDataSet.GetDisplayText(Index: String): WideString;
+begin
+ Result := '';
+end;
+
+function TfrxDataSet.GetDisplayWidth(Index: String): Integer;
+begin
+ Result := 10;
+end;
+
+procedure TfrxDataSet.GetFieldList(List: TStrings);
+begin
+ List.Clear;
+end;
+
+function TfrxDataSet.GetValue(Index: String): Variant;
+begin
+ Result := Null;
+end;
+
+function TfrxDataSet.HasField(const fName: String): Boolean;
+var
+ sl: TStringList;
+begin
+ sl := TStringList.Create;
+ GetFieldList(sl);
+ Result := sl.IndexOf(fName) <> -1;
+ sl.Free;
+end;
+
+procedure TfrxDataSet.AssignBlobTo(const fName: String; Obj: TObject);
+begin
+// empty method
+end;
+
+function TfrxDataSet.IsBlobField(const fName: String): Boolean;
+begin
+ Result := False;
+end;
+
+function TfrxDataSet.FieldsCount: Integer;
+begin
+ Result := 0;
+end;
+
+function TfrxDataSet.GetFieldType(Index: String): TfrxFieldType;
+begin
+ Result := fftNumeric;
+end;
+
+function TfrxDataSet.RecordCount: Integer;
+begin
+ if (RangeBegin = rbFirst) and (RangeEnd = reCount) then
+ Result := RangeEndCount
+ else
+ Result := 0;
+end;
+
+
+{ TfrxUserDataSet }
+
+constructor TfrxUserDataSet.Create(AOwner: TComponent);
+begin
+ inherited;
+ FFields := TStringList.Create;
+end;
+
+destructor TfrxUserDataSet.Destroy;
+begin
+ FFields.Free;
+ inherited;
+end;
+
+procedure TfrxUserDataSet.SetFields(const Value: TStrings);
+begin
+ FFields.Assign(Value);
+end;
+
+procedure TfrxUserDataSet.GetFieldList(List: TStrings);
+begin
+ List.Assign(FFields);
+end;
+
+function TfrxUserDataSet.FieldsCount: Integer;
+begin
+ Result := FFields.Count;
+end;
+
+function TfrxUserDataSet.GetDisplayText(Index: String): WideString;
+var
+ v: Variant;
+begin
+ Result := '';
+ if Assigned(FOnGetValue) then
+ begin
+ v := Null;
+ FOnGetValue(Index, v);
+ Result := VarToWideStr(v);
+ end;
+
+ if Assigned(FOnNewGetValue) then
+ begin
+ v := Null;
+ FOnNewGetValue(Self, Index, v);
+ Result := VarToWideStr(v);
+ end;
+end;
+
+function TfrxUserDataSet.GetValue(Index: String): Variant;
+begin
+ Result := Null;
+ if Assigned(FOnGetValue) then
+ FOnGetValue(Index, Result);
+ if Assigned(FOnNewGetValue) then
+ FOnNewGetValue(Self, Index, Result);
+end;
+
+
+{ TfrxCustomDBDataSet }
+
+constructor TfrxCustomDBDataset.Create(AOwner: TComponent);
+begin
+ FFields := TStringList.Create;
+ FFields.Sorted := True;
+ FFields.Duplicates := dupIgnore;
+ FAliases := TStringList.Create;
+ inherited;
+end;
+
+destructor TfrxCustomDBDataset.Destroy;
+begin
+ FFields.Free;
+ FAliases.Free;
+ inherited;
+end;
+
+procedure TfrxCustomDBDataset.SetFieldAliases(const Value: TStrings);
+begin
+ FAliases.Assign(Value);
+end;
+
+function TfrxCustomDBDataset.ConvertAlias(const fName: String): String;
+var
+ i: Integer;
+ s: String;
+begin
+ Result := fName;
+ for i := 0 to FAliases.Count - 1 do
+ begin
+ s := FAliases[i];
+ if frxCompareText(Copy(s, Pos('=', s) + 1, MaxInt), fName) = 0 then
+ begin
+ Result := FAliases.Names[i];
+ break;
+ end;
+ end;
+end;
+
+function TfrxCustomDBDataset.GetAlias(const fName: String): String;
+var
+ i: Integer;
+begin
+ Result := fName;
+ for i := 0 to FAliases.Count - 1 do
+ if frxCompareText(FAliases.Names[i], fName) = 0 then
+ begin
+ Result := FAliases[i];
+ Result := Copy(Result, Pos('=', Result) + 1, MaxInt);
+ break;
+ end;
+end;
+
+function TfrxCustomDBDataset.FieldsCount: Integer;
+var
+ sl: TStrings;
+begin
+ sl := TStringList.Create;
+ try
+ GetFieldList(sl);
+ finally
+ Result := sl.Count;
+ sl.Free;
+ end;
+end;
+
+{ TfrxDBComponents }
+
+function TfrxDBComponents.GetDescription: String;
+begin
+ Result := '';
+end;
+
+{ TfrxCustomDatabase }
+
+procedure TfrxCustomDatabase.BeforeConnect(var Value: Boolean);
+begin
+ if (Report <> nil) and Assigned(Report.OnBeforeConnect) then
+ Report.OnBeforeConnect(Self, Value);
+end;
+
+procedure TfrxCustomDatabase.AfterDisconnect;
+begin
+ if (Report <> nil) and Assigned(Report.OnAfterDisconnect) then
+ Report.OnAfterDisconnect(Self);
+end;
+
+function TfrxCustomDatabase.GetConnected: Boolean;
+begin
+ Result := False;
+end;
+
+function TfrxCustomDatabase.GetDatabaseName: String;
+begin
+ Result := '';
+end;
+
+function TfrxCustomDatabase.GetLoginPrompt: Boolean;
+begin
+ Result := False;
+end;
+
+function TfrxCustomDatabase.GetParams: TStrings;
+begin
+ Result := nil;
+end;
+
+procedure TfrxCustomDatabase.SetConnected(Value: Boolean);
+begin
+// empty
+end;
+
+procedure TfrxCustomDatabase.SetDatabaseName(const Value: String);
+begin
+// empty
+end;
+
+procedure TfrxCustomDatabase.FromString(const Connection: WideString);
+begin
+// empty
+end;
+
+function TfrxCustomDatabase.ToString: WideString;
+begin
+// empty
+ Result := '';
+end;
+
+
+procedure TfrxCustomDatabase.SetLogin(const Login, Password: String);
+begin
+// empty
+end;
+
+procedure TfrxCustomDatabase.SetLoginPrompt(Value: Boolean);
+begin
+// empty
+end;
+
+procedure TfrxCustomDatabase.SetParams(Value: TStrings);
+begin
+// empty
+end;
+
+
+{ TfrxComponent }
+
+constructor TfrxComponent.Create(AOwner: TComponent);
+begin
+ if AOwner is TfrxComponent then
+ inherited Create(TfrxComponent(AOwner).Report)
+ else
+ inherited Create(AOwner);
+
+ FComponentStyle := [csPreviewVisible];
+ FBaseName := ClassName;
+ Delete(FBaseName, Pos('Tfrx', FBaseName), 4);
+ Delete(FBaseName, Pos('View', FBaseName), 4);
+ FObjects := TList.Create;
+ FAllObjects := TList.Create;
+
+ FFont := TfrxFont.Create;
+ with FFont do
+ begin
+ Name := DefFontName;
+ Size := DefFontSize;
+ Color := claBlack;
+ OnChange := FontChanged;
+ end;
+
+ FVisible := True;
+ ParentFont := True;
+ if AOwner is TfrxComponent then
+ SetParent(TfrxComponent(AOwner));
+end;
+
+constructor TfrxComponent.DesignCreate(AOwner: TComponent; Flags: Word);
+begin
+ FIsDesigning := True;
+ Create(AOwner);
+end;
+
+destructor TfrxComponent.Destroy;
+begin
+ SetParent(nil);
+ Clear;
+ FFont.Free;
+ FObjects.Free;
+ FAllObjects.Free;
+ inherited;
+end;
+
+procedure TfrxComponent.Assign(Source: TPersistent);
+var
+ s: TMemoryStream;
+begin
+ if Source is TfrxComponent then
+ begin
+ s := TMemoryStream.Create;
+ try
+ TfrxComponent(Source).SaveToStream(s, False, True);
+ s.Position := 0;
+ LoadFromStream(s);
+ finally
+ s.Free;
+ end;
+ end;
+end;
+
+procedure TfrxComponent.AssignAll(Source: TfrxComponent; Streaming: Boolean = False);
+var
+ s: TMemoryStream;
+begin
+ s := TMemoryStream.Create;
+ try
+ Source.SaveToStream(s, True, True, Streaming);
+ s.Position := 0;
+ LoadFromStream(s);
+ finally
+ s.Free;
+ end;
+end;
+
+procedure TfrxComponent.LoadFromStream(Stream: TStream);
+var
+ Reader: TfrxXMLSerializer;
+begin
+ Clear;
+ Reader := TfrxXMLSerializer.Create(Stream);
+ if Report <> nil then
+ Report.FXMLSerializer := Reader;
+
+ try
+ Reader.Owner := Report;
+ if (Report <> nil) and Report.EngineOptions.EnableThreadSafe then
+ begin
+{$IFNDEF NO_CRITICAL_SECTION}
+ frxCS.Enter;
+{$ENDIF}
+ try
+ Reader.ReadRootComponent(Self, nil);
+ finally
+{$IFNDEF NO_CRITICAL_SECTION}
+ frxCS.Leave;
+{$ENDIF}
+ end;
+ end
+ else
+ Reader.ReadRootComponent(Self, nil);
+
+ if Report <> nil then
+ Report.Errors.AddStrings(Reader.Errors);
+
+ finally
+ Reader.Free;
+ if Report <> nil then
+ Report.FXMLSerializer := nil;
+ end;
+end;
+
+procedure TfrxComponent.SaveToStream(Stream: TStream; SaveChildren: Boolean = True;
+ SaveDefaultValues: Boolean = False; Streaming: Boolean = False);
+var
+ Writer: TfrxXMLSerializer;
+begin
+ Writer := TfrxXMLSerializer.Create(Stream);
+
+ try
+ Writer.Owner := Report;
+ Writer.SerializeDefaultValues := SaveDefaultValues;
+ if Self is TfrxReport then
+ Writer.OnGetAncestor := Report.DoGetAncestor;
+ Writer.WriteRootComponent(Self, SaveChildren, nil, Streaming);
+ finally
+ Writer.Free;
+ end;
+end;
+
+procedure TfrxComponent.Clear;
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ i := 0;
+ while i < FObjects.Count do
+ begin
+ c := FObjects[i];
+ if (csAncestor in c.ComponentState) then
+ begin
+ c.Clear;
+ Inc(i);
+ end
+ else
+ c.Free;
+ end;
+end;
+
+procedure TfrxComponent.SetParent(AParent: TfrxComponent);
+begin
+ if FParent <> AParent then
+ begin
+ if FParent <> nil then
+ FParent.FObjects.Remove(Self);
+ if AParent <> nil then
+ AParent.FObjects.Add(Self);
+ end;
+
+ FParent := AParent;
+ if FParent <> nil then
+ SetParentFont(FParentFont);
+end;
+
+procedure TfrxComponent.SetBounds(ALeft, ATop, AWidth, AHeight: Double);
+begin
+ Left := ALeft;
+ Top := ATop;
+ Width := AWidth;
+ Height := AHeight;
+end;
+
+function TfrxComponent.GetPage: TfrxPage;
+var
+ p: TfrxComponent;
+begin
+ if Self is TfrxPage then
+ begin
+ Result := TfrxPage(Self);
+ Exit;
+ end;
+
+ Result := nil;
+ p := Parent;
+ while p <> nil do
+ begin
+ if p is TfrxPage then
+ begin
+ Result := TfrxPage(p);
+ Exit;
+ end;
+ p := p.Parent;
+ end;
+end;
+
+function TfrxComponent.GetReport: TfrxReport;
+var
+ p: TfrxComponent;
+begin
+ if Self is TfrxReport then
+ begin
+ Result := TfrxReport(Self);
+ Exit;
+ end;
+
+ Result := nil;
+ p := Parent;
+ while p <> nil do
+ begin
+ if p is TfrxReport then
+ begin
+ Result := TfrxReport(p);
+ Exit;
+ end;
+ p := p.Parent;
+ end;
+end;
+
+function TfrxComponent.GetIsLoading: Boolean;
+begin
+ Result := FIsLoading or (csLoading in ComponentState);
+end;
+
+function TfrxComponent.GetAbsTop: Double;
+begin
+ if (Parent <> nil) and not (Parent is TfrxDialogPage) then
+ Result := Parent.AbsTop + Top else
+ Result := Top;
+end;
+
+function TfrxComponent.GetAbsLeft: Double;
+begin
+ if (Parent <> nil) and not (Parent is TfrxDialogPage) then
+ Result := Parent.AbsLeft + Left else
+ Result := Left;
+end;
+
+procedure TfrxComponent.SetLeft(Value: Double);
+begin
+ if not IsDesigning or not (rfDontMove in FRestrictions) then
+ FLeft := Value;
+end;
+
+procedure TfrxComponent.SetTop(Value: Double);
+begin
+ if not IsDesigning or not (rfDontMove in FRestrictions) then
+ FTop := Value;
+end;
+
+procedure TfrxComponent.SetWidth(Value: Double);
+begin
+ if not IsDesigning or not (rfDontSize in FRestrictions) then
+ FWidth := Value;
+end;
+
+procedure TfrxComponent.SetHeight(Value: Double);
+begin
+ if not IsDesigning or not (rfDontSize in FRestrictions) then
+ FHeight := Value;
+end;
+
+function TfrxComponent.IsFontStored: Boolean;
+begin
+ Result := not FParentFont;
+end;
+
+procedure TfrxComponent.SetFont(Value: TfrxFont);
+begin
+ FFont.Assign(Value);
+ FParentFont := False;
+end;
+
+procedure TfrxComponent.SetParentFont(const Value: Boolean);
+begin
+ if Value then
+ if Parent <> nil then
+ Font := Parent.Font;
+ FParentFont := Value;
+end;
+
+procedure TfrxComponent.SetVisible(Value: Boolean);
+begin
+ FVisible := Value;
+end;
+
+procedure TfrxComponent.FontChanged(Sender: TObject);
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ FParentFont := False;
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if c.ParentFont then
+ c.ParentFont := True;
+ end;
+end;
+
+function TfrxComponent.GetAllObjects: TList;
+
+ procedure EnumObjects(c: TfrxComponent);
+ var
+ i: Integer;
+ begin
+ if c <> Self then
+ FAllObjects.Add(c);
+ for i := 0 to c.FObjects.Count - 1 do
+ EnumObjects(c.FObjects[i]);
+ end;
+
+begin
+ FAllObjects.Clear;
+ EnumObjects(Self);
+ Result := FAllObjects;
+end;
+
+procedure TfrxComponent.SetName(const AName: TComponentName);
+var
+ c: TfrxComponent;
+begin
+ if CompareText(AName, Name) = 0 then Exit;
+
+ if (AName <> '') and (Report <> nil) then
+ begin
+ c := Report.FindObject(AName);
+ if (c <> nil) and (c <> Self) then
+ raise EDuplicateName.Create(frxResources.Get('prDupl'));
+ if IsAncestor and not((Self is TfrxReport) and (Name = '')) and not(csLoading in ComponentState) then
+ raise Exception.CreateFmt(frxResources.Get('clCantRen'), [Name]);
+ end;
+ inherited;
+end;
+
+procedure TfrxComponent.CreateUniqueName;
+var
+ i: Integer;
+ l: TList;
+ sl: TStringList;
+begin
+ sl := TfrxStringList.Create;
+ sl.Sorted := True;
+ sl.Duplicates := dupIgnore;
+
+ if Report <> nil then
+ l := Report.AllObjects else
+ l := Parent.AllObjects;
+ for i := 0 to l.Count - 1 do
+ sl.Add(TfrxComponent(l[i]).Name);
+
+ i := 1;
+ while sl.IndexOf(FBaseName + IntToStr(i)) <> -1 do
+ Inc(i);
+
+ Name := String(FBaseName) + IntToStr(i);
+ sl.Free;
+end;
+
+function TfrxComponent.Diff(AComponent: TfrxComponent): String;
+begin
+ Result := InternalDiff(AComponent);
+end;
+
+function TfrxComponent.DiffFont(f1, f2: TfrxFont; const Add: String): String;
+var
+ fs: Integer;
+begin
+ Result := '';
+
+ if f1.Name <> f2.Name then
+ Result := Result + Add + 'Font.Name="' + frxStrToXML(f1.Name) + '"';
+ if f1.Size <> f2.Size then
+ Result := Result + Add + 'Font.Size="' + FloatToStr(f1.Size) + '"';
+ if f1.Color <> f2.Color then
+ Result := Result + Add + 'Font.Color="' + IntToStr(Integer(f1.Color)) + '"';
+ if f1.Style <> f2.Style then
+ begin
+ fs := 0;
+ if fsBold in f1.Style then fs := 1;
+ if fsItalic in f1.Style then fs := fs or 2;
+ if fsUnderline in f1.Style then fs := fs or 4;
+ if fsStrikeout in f1.Style then fs := fs or 8;
+ Result := Result + Add + 'Font.Style="' + IntToStr(fs) + '"';
+ end;
+end;
+
+function TfrxComponent.InternalDiff(AComponent: TfrxComponent): String;
+begin
+ Result := '';
+
+ if FloatDiff(FLeft, AComponent.FLeft) then
+ Result := Result + ' l="' + FloatToStr(FLeft) + '"';
+ if (Self is TfrxBand) or FloatDiff(FTop, AComponent.FTop) then
+ Result := Result + ' t="' + FloatToStr(FTop) + '"';
+ if not ((Self is TfrxCustomMemoView) and TfrxCustomMemoView(Self).FAutoWidth) then
+ if FloatDiff(FWidth, AComponent.FWidth) then
+ Result := Result + ' w="' + FloatToStr(FWidth) + '"';
+ if FloatDiff(FHeight, AComponent.FHeight) then
+ Result := Result + ' h="' + FloatToStr(FHeight) + '"';
+ if FVisible <> AComponent.FVisible then
+ Result := Result + ' Visible="' + frxValueToXML(FVisible) + '"';
+ if not FParentFont then
+ Result := Result + DiffFont(FFont, AComponent.FFont, ' ');
+ if FParentFont <> AComponent.FParentFont then
+ Result := Result + ' ParentFont="' + frxValueToXML(FParentFont) + '"';
+ if Tag <> AComponent.Tag then
+ Result := Result + ' Tag="' + IntToStr(Tag) + '"';
+end;
+
+function TfrxComponent.AllDiff(AComponent: TfrxComponent): String;
+var
+ s: TStringStream;
+ Writer: TfrxXMLSerializer;
+ i: Integer;
+begin
+ s := TStringStream.Create('', TEncoding.UTF8);
+ Writer := TfrxXMLSerializer.Create(s);
+ Writer.Owner := Report;
+ Writer.WriteComponent(Self);
+ Writer.Free;
+
+ Result := s.DataString;
+ i := Pos(' ', Result);
+ if i <> 0 then
+ begin
+ Delete(Result, 1, i);
+ Delete(Result, Length(Result) - 1, 2);
+ end
+ else
+ Result := '';
+ if AComponent <> nil then
+ Result := Result + ' ' + InternalDiff(AComponent);
+ { cross bands and Keep mechanism fix }
+ if (Self is TfrxNullBand) then
+ begin
+ Result := Result + ' l="' + FloatToStr(FLeft) + '"';
+ Result := Result + ' t="' + FloatToStr(FTop) + '"';
+ end;
+
+ s.Free;
+end;
+
+procedure TfrxComponent.AddSourceObjects;
+begin
+// do nothing
+end;
+procedure TfrxComponent.AlignChildren;
+var
+ i: Integer;
+ c: TfrxComponent;
+ sl: TStringList;
+
+ procedure DoAlign(v: TfrxView; n, dir: Integer);
+ var
+ i: Integer;
+ c, c0: TfrxComponent;
+ begin
+ c0 := nil;
+ i := n;
+ while (i >= 0) and (i < sl.Count) do
+ begin
+ c := TfrxComponent(sl.Objects[i]);
+ if c <> v then
+ if (c.AbsTop < v.AbsTop + v.Height - 1e-4) and
+ (v.AbsTop < c.AbsTop + c.Height - 1e-4) then
+ begin
+ { special case for baWidth }
+ if (v.Align = baWidth) and
+ (((dir = 1) and (c.Left > v.Left)) or
+ ((dir = -1) and (c.Left + c.Width < v.Left + v.Width))) then
+ begin
+ Dec(i, dir);
+ continue;
+ end;
+ c0 := c;
+ break;
+ end;
+ Dec(i, dir);
+ end;
+
+ if (dir = 1) and (v.Align in [baLeft, baWidth]) then
+ if c0 = nil then
+ v.Left := 0 else
+ v.Left := c0.Left + c0.Width;
+
+ if v.Align = baRight then
+ if c0 = nil then
+ v.Left := Width - v.Width else
+ v.Left := c0.Left - v.Width;
+
+ if (dir = -1) and (v.Align = baWidth) then
+ if c0 = nil then
+ v.Width := Width - v.Left else
+ v.Width := c0.Left - v.Left;
+ end;
+
+begin
+ sl := TfrxStringList.Create;
+ sl.Sorted := True;
+ sl.Duplicates := dupAccept;
+
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if c is TfrxView then
+ if c.Left >= 0 then
+ sl.AddObject('1' + Format('%9.2f', [c.Left]), c)
+ else
+ sl.AddObject('0' + Format('%9.2f', [-c.Left]), c);
+ end;
+
+ { process baLeft }
+
+ for i := 0 to sl.Count - 1 do
+ begin
+ c := TfrxComponent(sl.Objects[i]);
+ if c is TfrxView then
+ if TfrxView(c).Align in [baLeft, baWidth] then
+ DoAlign(TfrxView(c), i, 1);
+ end;
+
+ { process baRight }
+
+ for i := sl.Count - 1 downto 0 do
+ begin
+ c := TfrxComponent(sl.Objects[i]);
+ if c is TfrxView then
+ if TfrxView(c).Align in [baRight, baWidth] then
+ DoAlign(TfrxView(c), i, -1);
+ end;
+
+ { process others }
+
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if c is TfrxView then
+ case TfrxView(c).Align of
+ baCenter:
+ c.Left := (Width - c.Width) / 2;
+
+ baBottom:
+ c.Top := Height - c.Height;
+
+ baClient:
+ begin
+ c.Left := 0;
+ c.Top := 0;
+ c.Width := Width;
+ c.Height := Height;
+ end;
+ end;
+ end;
+
+ sl.Free;
+end;
+
+function TfrxComponent.FindObject(const AName: String): TfrxComponent;
+var
+ i: Integer;
+ l: TList;
+begin
+ Result := nil;
+ l := AllObjects;
+ for i := 0 to l.Count - 1 do
+ if CompareText(AName, TfrxComponent(l[i]).Name) = 0 then
+ begin
+ Result := l[i];
+ break;
+ end;
+end;
+
+class function TfrxComponent.GetDescription: String;
+begin
+ Result := ClassName;
+end;
+
+function TfrxComponent.GetChildOwner: TComponent;
+begin
+ Result := Self;
+end;
+
+procedure TfrxComponent.GetChildren(Proc: TGetChildProc; Root: TComponent);
+var
+ i: Integer;
+begin
+ if (Self is TfrxReport) and not TfrxReport(Self).StoreInDFM then
+ Exit;
+ for i := 0 to FObjects.Count - 1 do
+ Proc(FObjects[i]);
+end;
+
+procedure TfrxComponent.BeforeStartReport;
+begin
+// do nothing
+end;
+
+procedure TfrxComponent.OnNotify(Sender: TObject);
+begin
+// do nothing
+end;
+
+procedure TfrxComponent.OnPaste;
+begin
+//
+end;
+
+function TfrxComponent.GetIsAncestor: Boolean;
+begin
+ Result := (csAncestor in ComponentState) or FAncestor;
+end;
+
+function TfrxComponent.FindDataSet(DataSet: TfrxDataSet; const DSName: String): TfrxDataSet;
+var
+ DSItem:TfrxDataSetItem;
+ AReport: TfrxReport;
+begin
+ Result := nil;
+ if Self is TfrxReport then
+ AReport := TfrxReport(Self)
+ else AReport := Report;
+ if (AReport <> nil) and not AReport.EngineOptions.UseGlobalDataSetList then
+ begin
+ DSItem := AReport.EnabledDataSets.Find(DSName);
+ if DSItem <> nil then Result := DSItem.FDataSet;
+ end
+ else
+ Result := frxFindDataSet(DataSet, DSName, AReport);
+end;
+
+function TfrxComponent.GetContainerObjects: TList;
+begin
+ Result := FObjects;
+end;
+
+function TfrxComponent.ContainerAdd(Obj: TfrxComponent): Boolean;
+begin
+ Result := False;
+end;
+
+function TfrxComponent.ContainerMouseDown(Sender: TObject; X, Y: Integer): Boolean;
+begin
+ Result := False;
+end;
+
+procedure TfrxComponent.ContainerMouseMove(Sender: TObject; X, Y: Integer);
+begin
+end;
+
+procedure TfrxComponent.ContainerMouseUp(Sender: TObject; X, Y: Integer);
+begin
+end;
+
+
+{ TfrxReportComponent }
+
+constructor TfrxReportComponent.Create(AOwner: TComponent);
+begin
+ inherited;
+ FShiftChildren := TList.Create;
+end;
+
+destructor TfrxReportComponent.Destroy;
+begin
+ FShiftChildren.Free;
+ inherited;
+end;
+
+procedure TfrxReportComponent.GetData;
+begin
+// do nothing
+end;
+
+procedure TfrxReportComponent.BeforePrint;
+begin
+ FOriginalRect := frxRect(Left, Top, Width, Height);
+end;
+
+procedure TfrxReportComponent.AfterPrint;
+begin
+ with FOriginalRect do
+ SetBounds(Left, Top, Right, Bottom);
+end;
+
+function TfrxReportComponent.GetComponentText: String;
+begin
+ Result := '';
+end;
+
+function TfrxReportComponent.GetRealBounds: TfrxRect;
+begin
+ Result := frxRect(AbsLeft, AbsTop, AbsLeft + Width, AbsTop + Height);
+end;
+
+
+{ TfrxDialogComponent }
+
+constructor TfrxDialogComponent.Create(AOwner: TComponent);
+begin
+ inherited;
+ frComponentStyle := frComponentStyle - [csPreviewVisible];
+ Width := 28;
+ Height := 28;
+ FImageIsLoaded := False;
+ FImage := TBitmap.Create(28, 28);
+end;
+
+destructor TfrxDialogComponent.Destroy;
+begin
+ if FComponent <> nil then
+ FComponent.Free;
+ FComponent := nil;
+ FImage.Free;
+ inherited;
+end;
+
+procedure TfrxDialogComponent.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ Filer.DefineProperty('pLeft', ReadLeft, WriteLeft, Report <> nil);
+ Filer.DefineProperty('pTop', ReadTop, WriteTop, Report <> nil);
+end;
+
+procedure TfrxDialogComponent.ReadLeft(Reader: TReader);
+begin
+ Left := Reader.ReadInteger;
+end;
+
+procedure TfrxDialogComponent.ReadTop(Reader: TReader);
+begin
+ Top := Reader.ReadInteger;
+end;
+
+procedure TfrxDialogComponent.WriteLeft(Writer: TWriter);
+begin
+ Writer.WriteInteger(Round(Left));
+end;
+
+procedure TfrxDialogComponent.WriteTop(Writer: TWriter);
+begin
+ Writer.WriteInteger(Round(Top));
+end;
+
+procedure TfrxDialogComponent.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+var
+ r: TRectF;
+ i: Integer;
+ w: Single;
+ Item: TfrxObjectItem;
+begin
+ Width := 28;
+ Height := 28;
+
+ r := RectF(Round(Left), Round(Top), Round(Left + 28), Round(Top + 28));
+ Canvas.Fill.Color := claWhitesmoke;
+ Canvas.FillRect(r, 0, 0, allCorners, 1);
+{$IFDEF DELPHI25}
+ Canvas.Stroke.Thickness := 1;
+{$ELSE}
+ Canvas.StrokeThickness := 1;
+{$ENDIF}
+ Canvas.Stroke.Color := claBlack;
+ Canvas.DrawRect(r, 0, 0, allCorners, 1);
+{$IFDEF DELPHI25}
+ Canvas.Stroke.Thickness := 1;
+{$ELSE}
+ Canvas.StrokeThickness := 1;
+{$ENDIF}
+ Canvas.Stroke.Color := claSilver;
+ Canvas.DrawRect(RectF(Round(Left + 1), Round(Top + 1), Round(Left + 27), Round(Top + 27)), 0, 0, allCorners, 1);
+
+ if not FImageIsLoaded then
+ for i := 0 to frxObjects.Count - 1 do
+ begin
+ Item := frxObjects[i];
+ if Item.ClassRef = ClassType then
+ begin
+ frxResources.LoadImageFromResouce(FImage, Item.ButtonImageIndex);
+ FImageIsLoaded := True;
+ break;
+ end;
+ end;
+
+ Canvas.DrawBitmap(FImage, RectF(0, 0, FImage.Width, FImage.Height), RectF(Round(Left + 4), Round(Top + 4), Round(Left + 25), Round(Top + 25)), 1, false);
+
+{$IFDEF LINUX}
+ Canvas.Font.Family := 'Liberation Mono';
+{$ELSE}
+ Canvas.Font.Family := 'Tahoma';
+{$ENDIF}
+ Canvas.Font.Size := 10;
+ Canvas.Fill.Color := claBlack;
+ Canvas.Font.Style := [];
+ w := Canvas.TextWidth(Name);
+// Canvas.Brush.Color := clWindow;
+ Canvas.FillText(RectF(r.Left - (w - 28) / 2, r.Bottom + 4, r.Left - (w - 28) / 2 + w, r.Bottom + 20), Name, false, 1, [], TTextAlign.taCenter, TTextAlign.taLeading);
+end;
+
+
+{ TfrxDialogControl }
+
+constructor TfrxDialogControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FBaseName := ClassName;
+ Delete(FBaseName, Pos('Tfrx', FBaseName), 4);
+ Delete(FBaseName, Pos('Control', FBaseName), 7);
+end;
+
+destructor TfrxDialogControl.Destroy;
+begin
+ inherited;
+ if FControl <> nil then
+ FControl.Free;
+ FControl := nil;
+end;
+
+procedure TfrxDialogControl.InitControl(AControl: TControl);
+begin
+ FControl := AControl;
+ with FControl do
+ begin
+ OnClick := DoOnClick;
+ OnDblClick := DoOnDblClick;
+ OnMouseDown := DoOnMouseDown;
+ OnMouseMove := DoOnMouseMove;
+ OnMouseUp := DoOnMouseUp;
+ OnEnter := DoOnEnter;
+ OnExit := DoOnExit;
+ OnKeyDown := DoOnKeyDown;
+ OnKeyUp := DoOnKeyUp;
+ end;
+ SetParent(Parent);
+end;
+
+procedure TfrxDialogControl.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+var
+ Sstate: TCanvasSaveState;
+ oldM: TMatrix;
+begin
+ Sstate := Canvas.SaveState;
+ oldM := Canvas.Matrix;
+ try
+{$IFDEF DELPHI22}
+ FControl.PrepareForPaint;
+{$ENDIF}
+ FControl.PaintTo(Canvas, RectF(oldM.m31 + AbsLeft, oldM.m32 + AbsTop, oldM.m31 + AbsLeft + Width, oldM.m32 + AbsTop + Height), nil);
+ finally
+ Canvas.SetMatrix(oldM);
+ Canvas.RestoreState(Sstate);
+ end;
+end;
+
+function TfrxDialogControl.GetCaption: String;
+{$IFDEF DELPHI22}
+var
+ aICaption: ICaption;
+{$ENDIF}
+begin
+{$IFDEF DELPHI22}
+ aICaption := FControl as ICaption;
+ if aICaption <> nil then
+ Result := aICaption.Text;
+{$ELSE}
+ if FControl is TTextControl then
+ Result := TTextControl(FControl).Text
+ else
+ Result := '';
+{$ENDIF}
+end;
+
+function TfrxDialogControl.GetEnabled: Boolean;
+begin
+ Result := FControl.Enabled;
+end;
+
+procedure TfrxDialogControl.SetLeft(Value: Double);
+begin
+ inherited;
+ FControl.Position.X := Round(Left);
+end;
+
+procedure TfrxDialogControl.SetTop(Value: Double);
+begin
+ inherited;
+ FControl.Position.Y := Round(Top);
+end;
+
+procedure TfrxDialogControl.SetWidth(Value: Double);
+begin
+ inherited;
+ FControl.Width := Round(Width);
+end;
+
+procedure TfrxDialogControl.SetHeight(Value: Double);
+begin
+ inherited;
+ FControl.Height := Round(Height);
+end;
+
+procedure TfrxDialogControl.SetVisible(Value: Boolean);
+begin
+ inherited;
+ FControl.Visible := Visible;
+end;
+
+procedure TfrxDialogControl.SetCaption(const Value: String);
+{$IFDEF DELPHI22}
+var
+ aICaption: ICaption;
+{$ENDIF}
+begin
+{$IFDEF DELPHI22}
+ aICaption := FControl as ICaption;
+ if aICaption <> nil then
+ aICaption.Text := Value;
+{$ELSE}
+ if FControl is TTextControl then
+ TTextControl(FControl).Text := Value;
+{$ENDIF}
+end;
+
+procedure TfrxDialogControl.SetEnabled(const Value: Boolean);
+begin
+ FControl.Enabled := Value;
+end;
+
+function TfrxDialogControl.GetHint: String;
+begin
+// todo
+ Result := '';//FControl.Hint;
+end;
+
+procedure TfrxDialogControl.SetHint(const Value: String);
+begin
+// FControl.Hint := Value;
+end;
+
+function TfrxDialogControl.GetShowHint: Boolean;
+begin
+ Result := False;//FControl.ShowHint;
+end;
+
+procedure TfrxDialogControl.SetShowHint(const Value: Boolean);
+begin
+// FControl.ShowHint := Value;
+end;
+
+function TfrxDialogControl.GetTabStop: Boolean;
+begin
+ Result := FControl.CanFocus;
+end;
+
+procedure TfrxDialogControl.SetTabStop(const Value: Boolean);
+begin
+ FControl.CanFocus := Value;
+end;
+
+procedure TfrxDialogControl.FontChanged(Sender: TObject);
+begin
+ inherited;
+ if FControl is TTextControl then
+ Font.AssignToFont(TTextControl(FControl).Font);
+end;
+
+procedure TfrxDialogControl.SetParentFont(const Value: Boolean);
+begin
+ inherited;
+// todo
+// if FControl <> nil then
+// THackControl(FControl).ParentFont := Value;
+end;
+
+procedure TfrxDialogControl.SetParent(AParent: TfrxComponent);
+begin
+ inherited;
+ if FControl <> nil then
+ if AParent is TfrxDialogControl then
+ FControl.Parent := TfrxDialogControl(AParent).Control
+ else if AParent is TfrxDialogPage then
+ FControl.Parent := TfrxDialogPage(AParent).DialogForm
+end;
+
+procedure TfrxDialogControl.DoOnClick(Sender: TObject);
+begin
+ if Report <> nil then
+ Report.DoNotifyEvent(Self, FOnClick, True);
+end;
+
+procedure TfrxDialogControl.DoOnDblClick(Sender: TObject);
+begin
+ if Report <> nil then
+ Report.DoNotifyEvent(Self, FOnDblClick, True);
+end;
+
+procedure TfrxDialogControl.DoOnEnter(Sender: TObject);
+begin
+ if Report <> nil then
+ Report.DoNotifyEvent(Self, FOnEnter, True);
+end;
+
+procedure TfrxDialogControl.DoOnExit(Sender: TObject);
+begin
+ if Report <> nil then
+ Report.DoNotifyEvent(Self, FOnExit, True);
+end;
+
+procedure TfrxDialogControl.DoOnKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: System.WideChar; Shift: TShiftState);
+var
+ v: Variant;
+begin
+ v := VarArrayOf([frxInteger(Self), Key, ShiftToByte(Shift)]);
+ if (Report <> nil) and (FOnKeyDown <> '') then
+ begin
+ Report.DoParamEvent(FOnKeyDown, v, True);
+ Key := v[1];
+ end;
+end;
+
+procedure TfrxDialogControl.DoOnKeyUp(Sender: TObject; var Key: Word;
+ var KeyChar: System.WideChar; Shift: TShiftState);
+var
+ v: Variant;
+begin
+ v := VarArrayOf([frxInteger(Self), Key, ShiftToByte(Shift)]);
+ if (Report <> nil) and (FOnKeyUp <> '') then
+ begin
+ Report.DoParamEvent(FOnKeyUp, v, True);
+ Key := v[1];
+ end;
+end;
+
+procedure TfrxDialogControl.DoOnMouseDown(Sender: TObject;
+ Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+var
+ v: Variant;
+begin
+ v := VarArrayOf([frxInteger(Self), Button, ShiftToByte(Shift), X, Y]);
+ if Report <> nil then
+ Report.DoParamEvent(FOnMouseDown, v, True);
+end;
+
+procedure TfrxDialogControl.DoOnMouseMove(Sender: TObject;
+ Shift: TShiftState; X, Y: Single);
+var
+ v: Variant;
+begin
+ if (Report <> nil) and (Hint <> '') and ShowHint then
+ begin
+ Report.SetProgressMessage(GetLongHint(Self.Hint), True);
+ end;
+ v := VarArrayOf([frxInteger(Self), ShiftToByte(Shift), X, Y]);
+ if Report <> nil then
+ Report.DoParamEvent(FOnMouseMove, v, True);
+end;
+
+procedure TfrxDialogControl.DoOnMouseUp(Sender: TObject;
+ Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+var
+ v: Variant;
+begin
+ v := VarArrayOf([frxInteger(Self), Button, ShiftToByte(Shift), X, Y]);
+ if Report <> nil then
+ Report.DoParamEvent(FOnMouseUp, v, True);
+end;
+
+
+{ TfrxFrameLine }
+
+constructor TfrxFrameLine.Create(AFrame: TfrxFrame);
+begin
+ FColor := claBlack;
+ FStyle := fsSolid;
+ FWidth := 1;
+ FFrame := AFrame;
+end;
+
+procedure TfrxFrameLine.Assign(Source: TPersistent);
+begin
+ if Source is TfrxFrameLine then
+ begin
+ FColor := TfrxFrameLine(Source).Color;
+ FStyle := TfrxFrameLine(Source).Style;
+ FWidth := TfrxFrameLine(Source).Width;
+ end;
+end;
+
+function TfrxFrameLine.IsColorStored: Boolean;
+begin
+ Result := FColor <> FFrame.Color;
+end;
+
+function TfrxFrameLine.IsStyleStored: Boolean;
+begin
+ Result := FStyle <> FFrame.Style;
+end;
+
+function TfrxFrameLine.IsWidthStored: Boolean;
+begin
+ Result := FWidth <> FFrame.Width;
+end;
+
+function TfrxFrameLine.Diff(ALine: TfrxFrameLine; const LineName: String;
+ ColorChanged, StyleChanged, WidthChanged: Boolean): String;
+begin
+ Result := '';
+
+ if (ColorChanged and IsColorStored) or (not ColorChanged and (FColor <> ALine.Color)) then
+ Result := Result + ' ' + LineName + '.Color="' + IntToStr(Integer(FColor)) + '"';
+ if (StyleChanged and IsStyleStored) or (not StyleChanged and (FStyle <> ALine.Style)) then
+ Result := Result + ' ' + LineName + '.Style="' + frxValueToXML(FStyle) + '"';
+ if (WidthChanged and IsWidthStored) or (not WidthChanged and FloatDiff(FWidth, ALine.Width)) then
+ Result := Result + ' ' + LineName + '.Width="' + FloatToStr(FWidth) + '"';
+end;
+
+
+{ TfrxFrame }
+
+constructor TfrxFrame.Create;
+begin
+ FColor := claBlack;
+ FShadowColor := claBlack;
+ FShadowWidth := 4;
+ FStyle := fsSolid;
+ FTyp := [];
+ FWidth := 1;
+
+ FLeftLine := TfrxFrameLine.Create(Self);
+ FTopLine := TfrxFrameLine.Create(Self);
+ FRightLine := TfrxFrameLine.Create(Self);
+ FBottomLine := TfrxFrameLine.Create(Self);
+end;
+
+destructor TfrxFrame.Destroy;
+begin
+ FLeftLine.Free;
+ FTopLine.Free;
+ FRightLine.Free;
+ FBottomLine.Free;
+ inherited;
+end;
+
+procedure TfrxFrame.Assign(Source: TPersistent);
+begin
+ if Source is TfrxFrame then
+ begin
+ FColor := TfrxFrame(Source).Color;
+ FDropShadow := TfrxFrame(Source).DropShadow;
+ FShadowColor := TfrxFrame(Source).ShadowColor;
+ FShadowWidth := TfrxFrame(Source).ShadowWidth;
+ FStyle := TfrxFrame(Source).Style;
+ FTyp := TfrxFrame(Source).Typ;
+ FWidth := TfrxFrame(Source).Width;
+
+ FLeftLine.Assign(TfrxFrame(Source).LeftLine);
+ FTopLine.Assign(TfrxFrame(Source).TopLine);
+ FRightLine.Assign(TfrxFrame(Source).RightLine);
+ FBottomLine.Assign(TfrxFrame(Source).BottomLine);
+ end;
+end;
+
+function TfrxFrame.IsShadowWidthStored: Boolean;
+begin
+ Result := FShadowWidth <> 4;
+end;
+
+function TfrxFrame.IsTypStored: Boolean;
+begin
+ Result := FTyp <> [];
+end;
+
+function TfrxFrame.IsWidthStored: Boolean;
+begin
+ Result := FWidth <> 1;
+end;
+
+procedure TfrxFrame.SetBottomLine(const Value: TfrxFrameLine);
+begin
+ FBottomLine.Assign(Value);
+end;
+
+procedure TfrxFrame.SetLeftLine(const Value: TfrxFrameLine);
+begin
+ FLeftLine.Assign(Value);
+end;
+
+procedure TfrxFrame.SetRightLine(const Value: TfrxFrameLine);
+begin
+ FRightLine.Assign(Value);
+end;
+
+procedure TfrxFrame.SetTopLine(const Value: TfrxFrameLine);
+begin
+ FTopLine.Assign(Value);
+end;
+
+procedure TfrxFrame.SetColor(const Value: TAlphaColor);
+begin
+ FColor := Value;
+ FLeftLine.Color := Value;
+ FTopLine.Color := Value;
+ FRightLine.Color := Value;
+ FBottomLine.Color := Value;
+end;
+
+procedure TfrxFrame.SetStyle(const Value: TfrxFrameStyle);
+begin
+ FStyle := Value;
+ FLeftLine.Style := Value;
+ FTopLine.Style := Value;
+ FRightLine.Style := Value;
+ FBottomLine.Style := Value;
+end;
+
+procedure TfrxFrame.SetWidth(const Value: Double);
+begin
+ FWidth := Value;
+ FLeftLine.Width := Value;
+ FTopLine.Width := Value;
+ FRightLine.Width := Value;
+ FBottomLine.Width := Value;
+end;
+
+function TfrxFrame.Diff(AFrame: TfrxFrame): String;
+var
+ i: Integer;
+ ColorChanged, StyleChanged, WidthChanged: Boolean;
+begin
+ Result := '';
+
+ ColorChanged := FColor <> AFrame.Color;
+ if ColorChanged then
+ Result := Result + ' Frame.Color="' + IntToStr(Integer(FColor)) + '"';
+ if FDropShadow <> AFrame.DropShadow then
+ Result := Result + ' Frame.DropShadow="' + frxValueToXML(FDropShadow) + '"';
+ if FShadowColor <> AFrame.ShadowColor then
+ Result := Result + ' Frame.ShadowColor="' + IntToStr(Integer(FShadowColor)) + '"';
+ if FloatDiff(FShadowWidth, AFrame.ShadowWidth) then
+ Result := Result + ' Frame.ShadowWidth="' + FloatToStr(FShadowWidth) + '"';
+ StyleChanged := FStyle <> AFrame.Style;
+ if StyleChanged then
+ Result := Result + ' Frame.Style="' + frxValueToXML(FStyle) + '"';
+ if FTyp <> AFrame.Typ then
+ begin
+ i := 0;
+ if ftLeft in FTyp then i := i or 1;
+ if ftRight in FTyp then i := i or 2;
+ if ftTop in FTyp then i := i or 4;
+ if ftBottom in FTyp then i := i or 8;
+ Result := Result + ' Frame.Typ="' + IntToStr(i) + '"';
+ end;
+ WidthChanged := FloatDiff(FWidth, AFrame.Width);
+ if WidthChanged then
+ Result := Result + ' Frame.Width="' + FloatToStr(FWidth) + '"';
+
+ Result := Result + FLeftLine.Diff(AFrame.LeftLine, 'Frame.LeftLine',
+ ColorChanged, StyleChanged, WidthChanged);
+ Result := Result + FTopLine.Diff(AFrame.TopLine, 'Frame.TopLine',
+ ColorChanged, StyleChanged, WidthChanged);
+ Result := Result + FRightLine.Diff(AFrame.RightLine, 'Frame.RightLine',
+ ColorChanged, StyleChanged, WidthChanged);
+ Result := Result + FBottomLine.Diff(AFrame.BottomLine, 'Frame.BottomLine',
+ ColorChanged, StyleChanged, WidthChanged);
+end;
+
+
+{ TfrxView }
+
+constructor TfrxView.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ frComponentStyle := frComponentStyle + [csDefaultDiff];
+ FAlign := baNone;
+ FColor := claNull;
+ FFrame := TfrxFrame.Create;
+ FShiftMode := smAlways;
+ FPrintable := True;
+ FPlainText := False;
+ FFastCanvas := nil;
+end;
+
+destructor TfrxView.Destroy;
+begin
+ FFrame.Free;
+ inherited;
+end;
+
+procedure TfrxView.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FDataSet) then
+ FDataSet := nil;
+end;
+
+procedure TfrxView.SetDataSet(const Value: TfrxDataSet);
+begin
+ FDataSet := Value;
+ if FDataSet = nil then
+ FDataSetName := '' else
+ FDataSetName := FDataSet.UserName;
+end;
+
+procedure TfrxView.SetDataSetName(const Value: String);
+begin
+ FDataSetName := Value;
+ FDataSet := FindDataSet(FDataSet, FDataSetName);
+end;
+
+function TfrxView.GetDataSetName: String;
+begin
+ if FDataSet = nil then
+ Result := FDataSetName else
+ Result := FDataSet.UserName;
+end;
+
+procedure TfrxView.GetVisibleRect(var aRect: TRectF);
+begin
+ aRect := RectF(0, 0, 0, 0);
+ if ftLeft in FFrame.Typ then
+ aRect.Left := FFrame.LeftLine.Width;
+ aRect.Left := AbsLeft - aRect.Left;
+ if ftTop in FFrame.Typ then
+ aRect.Top := FFrame.TopLine.Width;
+ aRect.Top := AbsTop - aRect.Top;
+ if ftRight in FFrame.Typ then
+ aRect.Right := FFrame.RightLine.Width;
+ aRect.Right := AbsLeft + Width + aRect.Right;
+ if ftBottom in FFrame.Typ then
+ aRect.Bottom := FFrame.BottomLine.Width;
+ aRect.Bottom := AbsTop + Height + aRect.Bottom;
+end;
+
+procedure TfrxView.SetFastCanvas(aCanvas: TCanvas);
+begin
+ FFastCanvas := aCanvas;
+end;
+
+procedure TfrxView.SetFrame(const Value: TfrxFrame);
+begin
+ FFrame.Assign(Value);
+end;
+
+procedure TfrxView.BeginDraw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
+begin
+ FCanvas := Canvas;
+ FScaleX := ScaleX;
+ FScaleY := ScaleY;
+ FOffsetX := OffsetX;
+ FOffsetY := OffsetY;
+ FX := Round(AbsLeft * ScaleX + OffsetX);
+ FY := Round(AbsTop * ScaleY + OffsetY);
+ FX1 := Round((AbsLeft + Width) * ScaleX + OffsetX);
+ FY1 := Round((AbsTop + Height) * ScaleY + OffsetY);
+
+ if Frame.DropShadow then
+ begin
+ FX1 := FX1 - Round(Frame.ShadowWidth * ScaleX);
+ FY1 := FY1 - Round(Frame.ShadowWidth * ScaleY);
+ end;
+
+ FDX := FX1 - FX;
+ FDY := FY1 - FY;
+ FFrameWidth := Frame.Width * ScaleX;
+end;
+
+procedure TfrxView.DrawBackground;
+begin
+ with FCanvas do
+ begin
+ if FColor <> claNull then
+ begin
+ Fill.Color := FColor;
+ Fill.Kind := TBrushKind.bkSolid;
+ FillRect(RectF(FX, FY, FX1, FY1), 0, 0, allCorners, 1);
+ end;
+ end;
+end;
+
+procedure TfrxView.DrawFrame;
+var
+ d: Integer;
+ add, add1: Extended;
+
+ procedure Line(x, y, x1, y1: Extended; Line: TfrxFrameLine; Typ: TfrxFrameType; gap1, gap2: Boolean);
+ var
+ g1, g2, g3, g4, fw: Integer;
+
+ procedure Line1(x, y, x1, y1: Extended);
+ begin
+ FCanvas.DrawLine(PointF(x, y), PointF(x1, y1), 1);
+ end;
+
+ begin
+ if Frame.Style <> fsDouble then
+ Line1(x, y, x1, y1)
+ else //if Frame.Style = fsDouble then
+ begin
+ fw := Round(Line.Width * FScaleX);
+ if gap1 then g1 := 0 else g1 := 1;
+ if gap2 then g2 := 0 else g2 := 1;
+
+ if Typ in [ftTop, ftBottom] then
+ begin
+ x := x + (fw * g1 div 2);
+ x1 := x1 - (fw * g2 div 2);
+ end
+ else
+ begin
+ y := y + (fw * g1 div 2);
+ y1 := y1 - (fw * g2 div 2);
+ end;
+
+ if gap1 then
+ g1 := fw else
+ g1 := 0;
+ if gap2 then
+ g2 := fw else
+ g2 := 0;
+ g3 := -g1;
+ g4 := -g2;
+
+ if Typ in [ftLeft, ftTop] then
+ begin
+ g1 := -g1;
+ g2 := -g2;
+ g3 := -g3;
+ g4 := -g4;
+ end;
+
+ if x = x1 then
+ Line1(x - fw, y + g1, x1 - fw, y1 - g2) else
+ Line1(x + g1, y - fw, x1 - g2, y1 - fw);
+ if Color <> claNull then
+ begin
+ FCanvas.Stroke.Color := Color;
+ Line1(x, y, x1, y1);
+ end;
+ FCanvas.Stroke.Color := Line.Color;
+ if x = x1 then
+ Line1(x + fw, y + g3, x1 + fw, y1 - g4) else
+ Line1(x + g3, y + fw, x1 - g4, y1 + fw);
+ end
+ end;
+
+ procedure SetPen(Line: TfrxFrameLine);
+ begin
+ with FCanvas do
+ begin
+ Stroke.Color := Line.Color;
+ if Line.Style in [fsSolid, fsDouble] then
+{$IFDEF DELPHI25}
+ begin
+ Stroke.Thickness := Round(Line.Width * FScaleX);
+ Stroke.Dash := TStrokeDash.sdSolid
+ end
+ else
+ begin
+ Stroke.Thickness := 1;
+ Stroke.Dash := TStrokeDash(Frame.Style);
+ end;
+{$ELSE}
+ begin
+ StrokeThickness := Round(Line.Width * FScaleX);
+ StrokeDash := TStrokeDash.sdSolid
+ end
+ else
+ begin
+ StrokeThickness := 1;
+ StrokeDash := TStrokeDash(Frame.Style);
+ end;
+{$ENDIF}
+ end;
+ end;
+
+begin
+ with FCanvas do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+
+ if Frame.DropShadow then
+ begin
+ Stroke.Color := Frame.ShadowColor;
+ d := Round(Frame.ShadowWidth * FScaleX);
+{$IFDEF DELPHI25}
+ Stroke.Dash := TStrokeDash.sdSolid;
+ Stroke.Thickness := d;
+{$ELSE}
+ StrokeDash := TStrokeDash.sdSolid;
+ StrokeThickness := d;
+{$ENDIF}
+ DrawLine(PointF(FX1 + d div 2, FY + d), PointF(FX1 + d div 2, FY1), 1);
+ d := Round(Frame.ShadowWidth * FScaleY);
+{$IFDEF DELPHI25}
+ Stroke.Thickness := d;
+{$ELSE}
+ StrokeThickness := d;
+{$ENDIF}
+ DrawLine(PointF(FX + d, FY1 + d div 2), PointF(FX1 + d, FY1 + d div 2), 1);
+ end;
+
+ if (Frame.Typ <> []) and (Frame.Color <> claNull) and (Frame.Width <> 0) then
+ begin
+ if ftLeft in Frame.Typ then
+ begin
+ SetPen(FFrame.LeftLine);
+{$IFNDEF DELPHI21}
+ add := StrokeThickness / 2;
+{$ELSE}
+{$IFDEF MACOS}
+{$IFDEF DELPHI25}
+ add := Stroke.Thickness / 2;
+{$ELSE}
+ add := StrokeThickness / 2;
+{$ENDIF}
+{$ELSE}
+ add := 0;
+{$ENDIF}
+{$ENDIF}
+ add1 := 0;
+{$IFDEF DELPHI25}
+ if (Trunc(Stroke.Thickness) mod 2) = 1 then
+{$ELSE}
+
+ if (Trunc(StrokeThickness) mod 2) = 1 then
+{$ENDIF}
+ add1 := 0.5;
+ Line(FX + add1, FY + add1 - add, FX + add1, FY1 + add1 + add, FFrame.LeftLine, ftLeft, ftTop in Frame.Typ, ftBottom in Frame.Typ);
+ end;
+ if ftRight in Frame.Typ then
+ begin
+ SetPen(FFrame.RightLine);
+{$IFNDEF DELPHI21}
+ add := StrokeThickness / 2;
+{$ELSE}
+{$IFDEF MACOS}
+{$IFDEF DELPHI25}
+ add := Stroke.Thickness / 2;
+{$ELSE}
+ add := StrokeThickness / 2;
+{$ENDIF}
+{$ELSE}
+ add := 0;
+{$ENDIF}
+{$ENDIF}
+ add1 := 0;
+{$IFDEF DELPHI25}
+ if (Trunc(Stroke.Thickness) mod 2) = 1 then
+{$ELSE}
+ if (Trunc(StrokeThickness) mod 2) = 1 then
+{$ENDIF}
+ add1 := 0.5;
+ Line(FX1 + add1, FY + add1 - add, FX1 + add1, FY1 + add1 + add, FFrame.RightLine, ftRight, ftTop in Frame.Typ, ftBottom in Frame.Typ);
+ end;
+ if ftTop in Frame.Typ then
+ begin
+ SetPen(FFrame.TopLine);
+ add1 := 0;
+{$IFDEF DELPHI25}
+ add := Stroke.Thickness / 2;
+ if (Trunc(Stroke.Thickness) mod 2) = 1 then
+{$ELSE}
+ add := StrokeThickness / 2;
+ if (Trunc(StrokeThickness) mod 2) = 1 then
+{$ENDIF}
+ add1 := 0.5;
+ Line(FX + add1 + add, FY + add1, FX1 + add1 - add, FY + add1, FFrame.TopLine, ftTop, ftLeft in Frame.Typ, ftRight in Frame.Typ);
+ end;
+ if ftBottom in Frame.Typ then
+ begin
+ SetPen(FFrame.BottomLine);
+ add1 := 0;
+{$IFDEF DELPHI25}
+ add := Stroke.Thickness / 2;
+ if (Trunc(Stroke.Thickness) mod 2) = 1 then
+{$ELSE}
+ add := StrokeThickness / 2;
+ if (Trunc(StrokeThickness) mod 2) = 1 then
+{$ENDIF}
+ add1 := 0.5;
+ Line(FX + add1 + add, FY1 + add1 , FX1 + add1 - add, FY1 + add1, FFrame.BottomLine, ftBottom, ftLeft in Frame.Typ, ftRight in Frame.Typ);
+ end;
+ end;
+ end;
+end;
+
+procedure TfrxView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
+begin
+ BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+ DrawBackground;
+ DrawFrame;
+end;
+
+function TfrxView.Diff(AComponent: TfrxComponent): String;
+var
+ v: TfrxView;
+begin
+ Result := inherited Diff(AComponent);
+ v := TfrxView(AComponent);
+
+ if FAlign <> v.FAlign then
+ Result := Result + ' Align="' + frxValueToXML(FAlign) + '"';
+ if FColor <> v.FColor then
+ Result := Result + ' Color="' + IntToStr(Integer(FColor)) + '"';
+ Result := Result + FFrame.Diff(v.FFrame);
+ if Cursor <> v.Cursor then
+ Result := Result + ' Cursor="' + frxValueToXML(Cursor) + '"';
+ if FPrintable <> v.FPrintable then
+ Result := Result + ' Printable="' + frxValueToXML(FPrintable) + '"';
+ if TagStr <> v.TagStr then
+ Result := Result + ' TagStr="' + frxStrToXML(TagStr) + '"';
+ if URL <> v.URL then
+ Result := Result + ' URL="' + frxStrToXML(URL) + '"';
+ if FHint <> v.Hint then
+ Result := Result + ' Hint="' + frxStrToXML(FHint) + '"';
+end;
+
+function TfrxView.IsDataField: Boolean;
+begin
+ Result := (DataSet <> nil) and (Length(DataField) <> 0);
+end;
+
+procedure TfrxView.BeforePrint;
+begin
+ inherited;
+ FTempTag := FTagStr;
+ FTempURL := FURL;
+ if Report <> nil then
+ begin
+ Report.SelfValue := Self;
+ end;
+end;
+
+procedure TfrxView.ExpandVariables(var Expr: String);
+var
+ i, j: Integer;
+ s: String;
+begin
+ i := 1;
+ repeat
+ while i < Length(Expr) do
+{ if isDBCSLeadByte(Byte(Expr[i])) then // if DBCS then skip 2 bytes
+ Inc(i, 2)
+ else }
+ if (Expr[i] <> '[') then
+ Inc(i)
+ else
+ break;
+ s := frxGetBrackedVariableW(Expr, '[', ']', i, j);
+ if i <> j then
+ begin
+ Delete(Expr, i, j - i + 1);
+ s := VarToStr(Report.Calc(s));
+ Insert(s, Expr, i);
+ Inc(i, Length(s));
+ j := 0;
+ end;
+ until i = j;
+end;
+
+procedure TfrxView.GetData;
+begin
+ if (FTagStr <> '') and (Pos('[', FTagStr) <> 0) then
+ ExpandVariables(FTagStr);
+ if (FURL <> '') and (Pos('[', FURL) <> 0) then
+ ExpandVariables(FURL);
+end;
+
+procedure TfrxView.AfterPrint;
+begin
+ inherited;
+ FTagStr := FTempTag;
+ FURL := FTempURL;
+end;
+
+
+{ TfrxShapeView }
+
+constructor TfrxShapeView.Create(AOwner: TComponent);
+begin
+ inherited;
+ frComponentStyle := frComponentStyle - [csDefaultDiff];
+end;
+
+constructor TfrxShapeView.DesignCreate(AOwner: TComponent; Flags: Word);
+begin
+ inherited;
+ FShape := TfrxShapeKind(Flags);
+end;
+
+procedure TfrxShapeView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+var
+ min: Integer;
+ poly: TPolygon;
+begin
+ BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+
+ with Canvas do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := Frame.Color;
+{$IFDEF DELPHI25}
+ Stroke.Thickness := FFrameWidth;
+ Stroke.Dash := TStrokeDash(Frame.Style);
+{$ELSE}
+ StrokeThickness := FFrameWidth;
+ StrokeDash := TStrokeDash(Frame.Style);
+{$ENDIF}
+
+ Fill.Kind := TBrushKind.bkSolid;
+ Fill.Color := FColor;
+
+ case FShape of
+ skRectangle:
+ begin
+ FillRect(RectF(FX, FY, FX1 + 1, FY1 + 1), 0, 0, allCorners, 1);
+ DrawRect(RectF(FX, FY, FX1 + 1, FY1 + 1), 0, 0, allCorners, 1);
+ end;
+
+ skRoundRectangle:
+ begin
+ if FDY < FDX then
+ min := FDY else
+ min := FDX;
+ if FCurve = 0 then
+ min := min div 4
+ else
+ min := Round(FCurve * FScaleX * 10);
+ FillRect(RectF(FX, FY, FX1 + 1, FY1 + 1), min, min, allCorners, 1);
+ DrawRect(RectF(FX, FY, FX1 + 1, FY1 + 1), min, min, allCorners, 1);
+ end;
+
+ skEllipse:
+ begin
+ FillEllipse(RectF(FX, FY, FX1 + 1, FY1 + 1), 1);
+ DrawEllipse(RectF(FX, FY, FX1 + 1, FY1 + 1), 1);
+ end;
+
+ skTriangle:
+ begin
+ SetLength(poly, 4);
+ poly[0] := PointF(FX1, FY1);
+ poly[1] := PointF(FX, FY1);
+ poly[2] := PointF(FX + FDX div 2, FY);
+ poly[3] := PointF(FX1, FY1);
+ FillPolygon(poly, 1);
+ DrawPolygon(poly, 1);
+ end;
+
+ skDiamond:
+ begin
+ SetLength(poly, 4);
+ poly[0] := PointF(FX + FDX div 2, FY);
+ poly[1] := PointF(FX1, FY + FDY div 2);
+ poly[2] := PointF(FX + FDX div 2, FY1);
+ poly[3] := PointF(FX, FY + FDY div 2);
+ FillPolygon(poly, 1);
+ DrawPolygon(poly, 1);
+ end;
+
+ skDiagonal1:
+ DrawLine(PointF(FX, FY1), PointF(FX1, FY), 1);
+
+ skDiagonal2:
+ DrawLine(PointF(FX, FY), PointF(FX1, FY1), 1);
+ end;
+ end;
+end;
+
+function TfrxShapeView.Diff(AComponent: TfrxComponent): String;
+begin
+ Result := inherited Diff(AComponent);
+
+ if FShape <> TfrxShapeView(AComponent).FShape then
+ Result := Result + ' Shape="' + frxValueToXML(FShape) + '"';
+end;
+
+class function TfrxShapeView.GetDescription: String;
+begin
+ Result := frxResources.Get('obShape');
+end;
+
+
+procedure TfrxShapeView.GetVisibleRect(var aRect: TRectF);
+begin
+ aRect := RectF(0, 0, 0, 0);
+ aRect.Left := AbsLeft - (Frame.Width + 1);
+ aRect.Top := AbsTop - (Frame.Width + 1);
+ aRect.Right := AbsLeft + Width + (Frame.Width + 1);
+ aRect.Bottom := AbsTop + Height + (Frame.Width + 1);
+end;
+{ TfrxHighlight }
+
+constructor TfrxHighlight.Create;
+begin
+ FColor := claNull;
+ FFont := TfrxFont.Create;
+ with FFont do
+ begin
+ Name := DefFontName;
+ Size := DefFontSize;
+ Color := claRed;
+ end;
+end;
+
+destructor TfrxHighlight.Destroy;
+begin
+ FFont.Free;
+ inherited;
+end;
+
+procedure TfrxHighlight.Assign(Source: TPersistent);
+begin
+ if Source is TfrxHighlight then
+ begin
+ FFont.Assign(TfrxHighlight(Source).Font);
+ FColor := TfrxHighlight(Source).Color;
+ FCondition := TfrxHighlight(Source).Condition;
+ end;
+end;
+
+procedure TfrxHighlight.SetFont(const Value: TfrxFont);
+begin
+ FFont.Assign(Value);
+end;
+
+
+{ TfrxFormat }
+
+procedure TfrxFormat.Assign(Source: TPersistent);
+begin
+ if Source is TfrxFormat then
+ begin
+ FDecimalSeparator := TfrxFormat(Source).DecimalSeparator;
+ FThousandSeparator := TfrxFormat(Source).ThousandSeparator;
+ FFormatStr := TfrxFormat(Source).FormatStr;
+ FKind := TfrxFormat(Source).Kind;
+ end;
+end;
+
+
+{ TfrxStretcheable }
+
+constructor TfrxStretcheable.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FStretchMode := smDontStretch;
+end;
+
+function TfrxStretcheable.CalcHeight: Double;
+begin
+ Result := Height;
+end;
+
+function TfrxStretcheable.DrawPart: Double;
+begin
+ Result := 0;
+end;
+
+procedure TfrxStretcheable.InitPart;
+begin
+//
+end;
+
+function TfrxStretcheable.HasNextDataPart: Boolean;
+begin
+ Result := False;
+end;
+
+
+{ TfrxCustomMemoView }
+
+constructor TfrxCustomMemoView.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ frComponentStyle := frComponentStyle - [csDefaultDiff];
+ FHighlight := TfrxHighlight.Create;
+ FDisplayFormat := TfrxFormat.Create;
+ FMemo := TfrxWideStrings.Create;
+ FAllowExpressions := True;
+ FClipped := True;
+ FExpressionDelimiters := '[,]';
+ FGapX := 2;
+ FGapY := 1;
+ FHAlign := haLeft;
+ FVAlign := vaTop;
+ FLineSpacing := 2;
+ ParentFont := True;
+ FWordWrap := True;
+ FWysiwyg := True;
+ FLastValue := Null;
+ FTextRenderer := nil;
+end;
+
+destructor TfrxCustomMemoView.Destroy;
+begin
+ FHighlight.Free;
+ FDisplayFormat.Free;
+ FMemo.Free;
+ inherited;
+end;
+
+class function TfrxCustomMemoView.GetDescription: String;
+begin
+ Result := frxResources.Get('obText');
+end;
+
+procedure TfrxCustomMemoView.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FFlowTo) then
+ FFlowTo := nil;
+end;
+
+function TfrxCustomMemoView.IsExprDelimitersStored: Boolean;
+begin
+ Result := FExpressionDelimiters <> '[,]';
+end;
+
+function TfrxCustomMemoView.IsLineSpacingStored: Boolean;
+begin
+ Result := FLineSpacing <> 2;
+end;
+
+function TfrxCustomMemoView.IsGapXStored: Boolean;
+begin
+ Result := FGapX <> 2;
+end;
+
+function TfrxCustomMemoView.IsGapYStored: Boolean;
+begin
+ Result := FGapY <> 1;
+end;
+
+function TfrxCustomMemoView.IsParagraphGapStored: Boolean;
+begin
+ Result := FParagraphGap <> 0;
+end;
+
+function TfrxCustomMemoView.IsAdvancedRendererNeeded: Boolean;
+begin
+ Result := (FHAlign = haBlock) or FAllowHTMLTags or (FLineSpacing <> 2);// or FWysiwyg;
+end;
+
+function TfrxCustomMemoView.IsCharSpacingStored: Boolean;
+begin
+ Result := FCharSpacing <> 0;
+end;
+
+function TfrxCustomMemoView.IsHighlightStored: Boolean;
+begin
+ Result := Trim(FHighlight.Condition) <> '';
+end;
+
+procedure TfrxCustomMemoView.SetRotation(Value: Integer);
+begin
+ FRotation := Value mod 360;
+end;
+
+procedure TfrxCustomMemoView.SetText(const Value: WideString);
+begin
+ FMemo.Text := Value;
+end;
+
+function TfrxCustomMemoView.GetText: WideString;
+begin
+ Result := FMemo.Text;
+end;
+
+procedure TfrxCustomMemoView.SetMemo(const Value: TWideStrings);
+begin
+ FMemo.Assign(Value);
+end;
+
+procedure TfrxCustomMemoView.SetHighlight(const Value: TfrxHighlight);
+begin
+ FHighlight.Assign(Value);
+end;
+
+procedure TfrxCustomMemoView.SetAllowHTMLTags(const Value: Boolean);
+begin
+ FAllowHTMLTags := Value;
+end;
+
+procedure TfrxCustomMemoView.SetDisplayFormat(const Value: TfrxFormat);
+begin
+ FDisplayFormat.Assign(Value);
+end;
+
+procedure TfrxCustomMemoView.SetStyle(const Value: String);
+begin
+ FStyle := Value;
+ if Report <> nil then
+ ApplyStyle(Report.Styles.Find(FStyle));
+end;
+
+function TfrxCustomMemoView.AdjustCalcHeight: Double;
+begin
+ Result := GapY * 2;
+ if ftTop in Frame.Typ then
+ Result := Result + (Frame.Width - 1) / 2;
+ if ftBottom in Frame.Typ then
+ Result := Result + Frame.Width / 2;
+ if Frame.DropShadow then
+ Result := Result + Frame.ShadowWidth;
+end;
+
+function TfrxCustomMemoView.AdjustCalcWidth: Double;
+begin
+ Result := GapX * 2 + 1;
+ if ftLeft in Frame.Typ then
+ Result := Result + Frame.Width / 2;
+ if ftRight in Frame.Typ then
+ Result := Result + Frame.Width / 2;
+ if Frame.DropShadow then
+ Result := Result + Frame.ShadowWidth;
+end;
+
+procedure TfrxCustomMemoView.BeginDraw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
+var
+ bx, by, bx1, by1, wx1, wx2, wy1, wy2, gx1, gy1: Single;
+begin
+ inherited BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+
+ wx1 := (Frame.Width * ScaleX - 1) / 2;
+ wx2 := Frame.Width * ScaleX / 2;
+ wy1 := (Frame.Width * ScaleY - 1) / 2;
+ wy2 := Frame.Width * ScaleY / 2;
+
+ bx := FX;
+ by := FY;
+ bx1 := FX1;
+ by1 := FY1;
+ if ftLeft in Frame.Typ then
+ bx := bx + wx1;
+ if ftRight in Frame.Typ then
+ bx1 := bx1 + wx2;
+ if ftTop in Frame.Typ then
+ by := by + wy1;
+ if ftBottom in Frame.Typ then
+ by1 := by1 + wy2;
+ gx1 := GapX * ScaleX;
+ gy1 := GapY * ScaleY;
+
+ FTextRect := RectF(bx + gx1, by + gy1, bx1 - gx1 - 1, by1 - gy1 - 1);
+end;
+
+function NormalizeText(const aText: String; bDeleteLineBreak: Boolean = true): String;
+begin
+ Result := ReplaceStr(aText, #13#10, System.sLineBreak);
+ if bDeleteLineBreak and EndsText(sLineBreak, aText) then
+ Delete(Result, Length(Result) - Length(sLineBreak) + 1, Length(sLineBreak));
+end;
+
+procedure TfrxCustomMemoView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+var
+ TextRenderer: TAdvancedTextRenderer;
+ SaveColor: TAlphaColor;
+ aFont: TfrxFont;
+ aText: String;
+{$IFNDEF DELPHI24}
+{$IFDEF DELPHI17}
+{$IFDEF MSWINDOWS}
+ oldh: Single;
+{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+ h, Sh, ALineHeight: Single;
+ state: TCanvasSaveState;
+ m, OldM: TMatrix;
+ e: Single;
+ TextCanvas: TCanvas;
+
+ procedure DrawUnderlines;
+ var
+ dy: Extended;
+ begin
+ with Canvas do
+ begin
+ Stroke.Color := Frame.Color;
+ Stroke.Kind := TBrushKind.bkSolid;
+ end;
+
+ //h := TextRenderer.LineHeight;
+ dy := FY + ALineHeight + (GapY - LineSpacing + 1) * ScaleY;
+ while dy < FY1 do
+ begin
+ Canvas.DrawLine(PointF(FX, Round(dy)), PointF(FX1, Round(dy)), 1);
+ dy := dy + ALineHeight;
+ end;
+ end;
+
+begin
+ SaveColor := FColor;
+ if Assigned(FFastCanvas) then
+ begin
+ TfrxFastCanvasLayer(FFastCanvas).Canvas := Canvas;
+ TextCanvas := FFastCanvas;
+ end
+ else
+ TextCanvas := Canvas;
+ ALineHeight := 0;
+ if FHighlight.Active then
+ begin
+ aFont := FHighlight.Font;
+ FColor := FHighlight.Color;
+ end
+ else
+ begin
+ aFont := FFont;
+ end;
+
+ inherited Draw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+ if not IsDesigning then
+ ExtractMacros
+ else if IsDataField then
+ FMemo.Text := '[' + DataSet.UserName + '."' + DataField + '"]';
+{$IFNDEF MSWINDOWS}
+ //if IsPrinting then
+ // FFont.PixelsPerInch := 96 * 1.5;
+{$ENDIF}
+
+{$IFDEF MSWINDOWS}
+ // aboid bug with right align draw of last line
+ // appears in D2D only
+ aText := NormalizeText(FMemo.Text, GlobalUseDirect2D);
+{$ELSE}
+ aText := NormalizeText(FMemo.Text);
+{$ENDIF}
+ sh := aFont.Height;
+ h := aFont.Height * FScaleY;
+{$IFNDEF DELPHI24}
+{$IFDEF DELPHI17}
+{$IFDEF MSWINDOWS}
+ oldh := aFont.Height;
+{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+{$IFNDEF DELPHI17}
+{$IFDEF MSWINDOWS}
+ if not IsPrinting then
+{$ENDIF}
+{$ENDIF}
+{$IFDEF DELPHI24}
+{$IFNDEF MSWINDOWS}
+ if not IsPrinting then
+{$ENDIF}
+{$ENDIF}
+{$IFNDEF DELPHI24}
+{$IFDEF DELPHI19}
+//{$IFNDEF MSWINDOWS}
+ if not IsPrinting then
+//{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+ aFont.Height := h;
+ ALineHeight := -h + FLineSpacing * FScaleY;
+ if IsAdvancedRendererNeeded then
+ begin
+ TextRenderer := TAdvancedTextRenderer.Create(TextCanvas, aText, aFont, FTextRect, FHAlign, FVAlign, ALineHeight, FRotation, FWordWrap, false, FAllowHTMLTags, false, ScaleX);
+ try
+ if FUnderlines and (FRotation = 0) then
+ DrawUnderlines;
+{$IFNDEF DELPHI24}
+{$IFDEF DELPHI17}
+{$IFDEF MSWINDOWS}
+ if IsPrinting then
+ aFont.Height := oldh;
+{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+ TextRenderer.Draw();
+ finally
+ TextRenderer.Free;
+ end;
+ end
+ else
+ begin
+ OldM := Canvas.Matrix;
+ State := Canvas.SaveState;
+
+ try
+ if FUnderlines and (FRotation = 0) then
+ DrawUnderlines;
+ Canvas.IntersectClipRect(FTextRect);
+
+ if FRotation <> 0 then
+ begin
+ m := CreateRotationMatrix(-DegToRad(FRotation));
+ m.m31 := OldM.m31 + FTextRect.Left + FTextRect.Width / 2;
+ m.m32 := OldM.m32 + FTextRect.Top + FTextRect.Height / 2;
+ Canvas.SetMatrix(m);
+
+ e := FTextRect.Width;
+ FTextRect.Left := -FTextRect.Width / 2;
+ FTextRect.Right := FTextRect.Left + e;
+ e := FTextRect.Height;
+ FTextRect.Top := -FTextRect.Height / 2;
+ FTextRect.Bottom := FTextRect.Top + e;
+
+ // rotate rect if angle is 90 or 270
+ if ((FRotation >= 90) and (FRotation < 180)) or ((FRotation >= 270) and (FRotation < 360)) then
+ FTextRect := RectF(FTextRect.Top, FTextRect.Left, FTextRect.Bottom, FTextRect.Right);
+ end;
+{$IFNDEF DELPHI24}
+{$IFDEF DELPHI17}
+{$IFDEF MSWINDOWS}
+ if IsPrinting then
+ aFont.Height := oldh;
+{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+ aFont.AssignToCanvas(Canvas);
+ TextCanvas.FillText(FTextRect, aText, FWordWrap, 1, [], frxHAlignToTextAlign(FHAlign), frxVAlignToTextAlign(FVAlign));
+
+ finally
+ Canvas.RestoreState(state);
+ Canvas.SetMatrix(OldM);
+ end;
+ end;
+{$IFNDEF MSWINDOWS}
+ if IsPrinting then
+ aFont.PixelsPerInch := 96;
+{$ENDIF}
+ aFont.Height := sh;
+ FColor := SaveColor;
+end;
+
+function TfrxCustomMemoView.CalcHeight: Double;
+var
+ TextRenderer: TAdvancedTextRenderer;
+ r: TRectF;
+ aText: String;
+ aFont: TfrxFont;
+ ALineHeight: Single;
+ TextCanvas: TCanvas;
+ FBmpCanvas: TBitmap;
+ bNeedFree: Boolean;
+begin
+ Result := 0;
+ aText := NormalizeText(FMemo.Text);
+ if aText = '' then
+ Exit;
+
+ if FHighlight.Active then
+ aFont := FHighlight.Font
+ else
+ aFont := FFont;
+ FBmpCanvas := nil;
+ bNeedFree := True;
+ if Report <> nil then
+ FBmpCanvas := Report.GetDrawBitmap;
+
+ if Assigned(FBmpCanvas) then
+ bNeedFree := False
+ else
+ FBmpCanvas := TBitmap.Create(1,1);
+
+ if Assigned(FFastCanvas) then
+ begin
+ TfrxFastCanvasLayer(FFastCanvas).Canvas := FBmpCanvas.Canvas;
+ TextCanvas := FFastCanvas;
+ end
+ else
+ TextCanvas := FBmpCanvas.Canvas;
+
+ TextCanvas.BeginScene();
+ try
+ BeginDraw(FBmpCanvas.Canvas, 1, 1, 0, 0);
+ r := RectF(0, 0, FTextRect.Width, 10000);
+ if IsAdvancedRendererNeeded then
+ begin
+ ALineHeight := -aFont.Height + FLineSpacing;
+ TextRenderer := TAdvancedTextRenderer.Create(TextCanvas, aText, aFont, r,
+ FHAlign, FVAlign, ALineHeight, FRotation, FWordWrap, False,
+ FAllowHTMLTags, False, 1);
+ try
+ Result := TextRenderer.CalcHeight() + 4 + AdjustCalcHeight;
+ finally
+ TextRenderer.Free;
+ end;
+ end
+ else
+ begin
+ aFont.AssignToCanvas(FBmpCanvas.Canvas);
+ TextCanvas.MeasureText(r, aText, FWordWrap, [],
+ frxHAlignToTextAlign(FHAlign), frxVAlignToTextAlign(FVAlign));
+ Result := r.Height + 4 + AdjustCalcHeight;
+ end;
+ finally
+ TextCanvas.EndScene;
+ if bNeedFree then
+ FBmpCanvas.Free;
+ end;
+end;
+
+function TfrxCustomMemoView.CalcWidth: Double;
+var
+ TextRenderer: TAdvancedTextRenderer;
+ r: TRectF;
+ aFont: TfrxFont;
+ aText: String;
+ TextCanvas: TCanvas;
+ addW: Single;
+ FBmpCanvas: TBitmap;
+ bNeedFree: Boolean;
+begin
+ Result := 0;
+ addW := 2;
+ aText := NormalizeText(FMemo.Text);
+ if aText = '' then
+ Exit;
+
+ if FHighlight.Active then
+ aFont := FHighlight.Font
+ else
+ aFont := FFont;
+ FBmpCanvas := nil;
+ bNeedFree := True;
+ if Report <> nil then
+ FBmpCanvas := Report.GetDrawBitmap;
+
+ if Assigned(FBmpCanvas) then
+ bNeedFree := False
+ else
+ FBmpCanvas := TBitmap.Create(1,1);
+ if Assigned(FFastCanvas) then
+ begin
+ TfrxFastCanvasLayer(FFastCanvas).Canvas := FBmpCanvas.Canvas;
+ TextCanvas := FFastCanvas;
+ end
+ else
+ TextCanvas := FBmpCanvas.Canvas;
+ if CompareText(FBmpCanvas.Canvas.ClassName, 'TCanvasD2D') = 0 then
+ addW := 4;
+ TextCanvas.BeginScene();
+ try
+ BeginDraw(FBmpCanvas.Canvas, 1, 1, 0, 0);
+ r := RectF(0, 0, 10000, 10000);
+ if IsAdvancedRendererNeeded then
+ begin
+ TextRenderer := TAdvancedTextRenderer.Create(TextCanvas, aText, aFont, r,
+ FHAlign, FVAlign, 0, FRotation, FWordWrap, False,
+ FAllowHTMLTags, False, 1);
+ try
+ Result := TextRenderer.CalcWidth() + TextRenderer.SpaceWidth + AdjustCalcWidth + addW;
+ finally
+ TextRenderer.Free;
+ end;
+ end
+ else
+ begin
+ aFont.AssignToCanvas(FBmpCanvas.Canvas);
+ TextCanvas.MeasureText(r, aText + ' ', FWordWrap, [],
+ TTextAlign.taLeading, TTextAlign.taLeading);
+ Result := r.Width + AdjustCalcWidth + addW;
+ end;
+ finally
+ TextCanvas.EndScene;
+ if bNeedFree then
+ FBmpCanvas.Free;
+ end;
+end;
+
+procedure TfrxCustomMemoView.InitPart;
+begin
+ FPartMemo := FMemo.Text;
+ FFirstParaBreak := False;
+ FLastParaBreak := False;
+end;
+
+function TfrxCustomMemoView.DrawPart: Double;
+var
+ TextRenderer: TAdvancedTextRenderer;
+ charsFit, nIndex, LWordIndex: Integer;
+ s2: String;
+ style: TStyleDescriptor;
+ aFont: TfrxFont;
+ TextCanvas: TCanvas;
+ r: TRectF;
+ PrevH: Double;
+ FBmpCanvas: TBitmap;
+ bNeedFree: Boolean;
+begin
+ if FHighlight.Active then
+ aFont := FHighlight.Font
+ else
+ aFont := FFont;
+
+ FBmpCanvas := nil;
+ bNeedFree := True;
+ if Report <> nil then
+ FBmpCanvas := Report.GetDrawBitmap;
+
+ if Assigned(FBmpCanvas) then
+ bNeedFree := False
+ else
+ FBmpCanvas := TBitmap.Create(1,1);
+ if Assigned(FFastCanvas) then
+ begin
+ TfrxFastCanvasLayer(FFastCanvas).Canvas := FBmpCanvas.Canvas;
+ TextCanvas := FFastCanvas;
+ end
+ else
+ TextCanvas := FBmpCanvas.Canvas;
+ TextCanvas.BeginScene;
+ BeginDraw(FBmpCanvas.Canvas, 1, 1, 0, 0);
+ try
+ if IsAdvancedRendererNeeded then
+ begin
+ TextRenderer := TAdvancedTextRenderer.Create(TextCanvas, FPartMemo, aFont,
+ FTextRect, FHAlign, FVAlign, -aFont.Height + FLineSpacing, FRotation,
+ FWordWrap, False, FAllowHTMLTags, False, 1);
+ try
+ Result := TextRenderer.CalcHeight(charsFit, Style);
+ if charsFit > 0 then
+ if (FPartMemo[charsFit]) <> #$0A then
+ charsFit := charsFit - 1;
+ FMemo.Text := Copy(FPartMemo, 1, charsFit);
+ Delete(FPartMemo, 1, charsFit);
+ if (FPartMemo = '') and (charsFit > 0) then
+ Result := 0
+ else if Result <> 0 then
+ Result := Height - Result;
+ finally
+ TextRenderer.Free;
+ end;
+ end
+ else
+ { text split for simple text output }
+ { we need that because we use simple height calculation }
+ { and for different fonts we can get different line spacing from advanced text render }
+ begin
+ s2 := '';
+ Result := 0;
+ Font.AssignToCanvas(FBmpCanvas.Canvas);
+ PrevH := 0;
+ LWordIndex := 1;
+ for nIndex := 1 to Length(FPartMemo) do
+ begin
+ r := RectF(0, 0, FTextRect.Width, 10000);
+ if (FPartMemo[nIndex] = #9) or (FPartMemo[nIndex] = ' ') or
+ (FPartMemo[nIndex] = #13) or (FPartMemo[nIndex] = #10) or
+ (nIndex = Length(FPartMemo)) then
+ begin
+ s2 := s2 + Copy(FPartMemo, LWordIndex, nIndex - LWordIndex);
+ //if s2 = '' then continue;
+
+ if (nIndex = Length(FPartMemo)) then
+ s2 := s2 + FPartMemo[nIndex];
+ TextCanvas.MeasureText(r, s2, FWordWrap, [],
+ frxHAlignToTextAlign(FHAlign), frxVAlignToTextAlign(FVAlign));
+
+ if (r.Height > Height) or (nIndex = Length(FPartMemo)) then
+ begin
+ { delete part only if text doesnt fit }
+ if (r.Height > Height) then
+ Delete(s2, Length(s2) - (nIndex - LWordIndex - 1), (nIndex - LWordIndex))
+ else
+ PrevH := r.Height;
+ { copy part that fit into bounds }
+ FMemo.Text := Copy(FPartMemo, 1, Length(s2));
+
+ { check if we have wrap at spec symbol and correct outbound text }
+ if (s2 <> '') and (Length(FPartMemo) > 1) then
+ begin
+ if (LWordIndex <= Length(FPartMemo)) and (FPartMemo[LWordIndex] = #13) then
+ Delete(FPartMemo, LWordIndex, Length(sLineBreak));
+ if (LWordIndex <= Length(FPartMemo)) and (FPartMemo[LWordIndex] = #10) then
+ Delete(FPartMemo, LWordIndex, 1);
+ if (LWordIndex <= Length(FPartMemo)) and (FPartMemo[LWordIndex] = ' ') then
+ Delete(FPartMemo, LWordIndex, 1);
+ end;
+ { correct outbound text }
+
+ Delete(FPartMemo, 1, Length(s2));
+ { return unused height }
+ if s2 = '' then
+ Result := Height
+ else if FPartMemo = '' then
+ Result := 0
+ else
+ Result := Height - PrevH;
+ break;
+ end;
+ { save current height we dont want to calculate it twice }
+ PrevH := r.Height;
+ LWordIndex := nIndex;
+ end;
+ end;
+ end;
+ finally
+ TextCanvas.EndScene;
+ if bNeedFree then
+ FBmpCanvas.Free;
+ end;
+end;
+
+function TfrxCustomMemoView.Diff(AComponent: TfrxComponent): String;
+var
+ m: TfrxCustomMemoView;
+ s: WideString;
+ c: Integer;
+begin
+ Result := inherited Diff(AComponent);
+ m := TfrxCustomMemoView(AComponent);
+
+ if FAutoWidth <> m.FAutoWidth then
+ Result := Result + ' AutoWidth="' + frxValueToXML(FAutoWidth) + '"';
+ if FloatDiff(FCharSpacing, m.FCharSpacing) then
+ Result := Result + ' CharSpacing="' + FloatToStr(FCharSpacing) + '"';
+ if FloatDiff(FGapX, m.FGapX) then
+ Result := Result + ' GapX="' + FloatToStr(FGapX) + '"';
+ if FloatDiff(FGapY, m.FGapY) then
+ Result := Result + ' GapY="' + FloatToStr(FGapY) + '"';
+ if FHAlign <> m.FHAlign then
+ Result := Result + ' HAlign="' + frxValueToXML(FHAlign) + '"';
+ if FHighlight.Active <> m.FHighlight.Active then
+ Result := Result + ' Highlight.Active="' + frxValueToXML(FHighlight.Active) + '"';
+ if FloatDiff(FLineSpacing, m.FLineSpacing) then
+ Result := Result + ' LineSpacing="' + FloatToStr(FLineSpacing) + '"';
+
+ c := FMemo.Count;
+ if c = 0 then
+ Result := Result + ' u=""'
+ else
+ begin
+ if c = 1 then
+ Result := Result + ' u="' + frxStrToXML(FMemo[0]) + '"'
+ else
+ begin
+ s := Text;
+ SetLength(s, Length(s) - 2);
+ Result := Result + ' u="' + frxStrToXML(s) + '"';
+ end;
+ end;
+
+ if FloatDiff(FParagraphGap, m.FParagraphGap) then
+ Result := Result + ' ParagraphGap="' + FloatToStr(FParagraphGap) + '"';
+ if FRotation <> m.FRotation then
+ Result := Result + ' Rotation="' + IntToStr(FRotation) + '"';
+ if FRTLReading <> m.FRTLReading then
+ Result := Result + ' RTLReading="' + frxValueToXML(FRTLReading) + '"';
+ if FUnderlines <> m.FUnderlines then
+ Result := Result + ' Underlines="' + frxValueToXML(FUnderlines) + '"';
+ if FVAlign <> m.FVAlign then
+ Result := Result + ' VAlign="' + frxValueToXML(FVAlign) + '"';
+ if FWordWrap <> m.FWordWrap then
+ Result := Result + ' WordWrap="' + frxValueToXML(FWordWrap) + '"';
+
+ { formatting }
+ if FDisplayFormat.FKind <> m.FDisplayFormat.FKind then
+ Result := Result + ' DisplayFormat.Kind="' + frxValueToXML(FDisplayFormat.FKind) + '"';
+ if FDisplayFormat.FDecimalSeparator <> m.FDisplayFormat.FDecimalSeparator then
+ Result := Result + ' DisplayFormat.DecimalSeparator="' + frxStrToXML(FDisplayFormat.FDecimalSeparator) + '"';
+ if FDisplayFormat.FThousandSeparator <> m.FDisplayFormat.FThousandSeparator then
+ Result := Result + ' DisplayFormat.ThousandSeparator="' + frxStrToXML(FDisplayFormat.FThousandSeparator) + '"';
+ if FDisplayFormat.FFormatStr <> m.FDisplayFormat.FFormatStr then
+ Result := Result + ' DisplayFormat.FormatStr="' + frxStrToXML(FDisplayFormat.FFormatStr) + '"';
+
+ if FFirstParaBreak then
+ Result := Result + ' FirstParaBreak="1"';
+ if FLastParaBreak then
+ Result := Result + ' LastParaBreak="1"';
+
+ FFirstParaBreak := FLastParaBreak;
+ FLastParaBreak := False;
+end;
+
+procedure TfrxCustomMemoView.BeforePrint;
+begin
+ inherited;
+ if not IsDataField then
+ FTempMemo := FMemo.Text;
+end;
+
+procedure TfrxCustomMemoView.AfterPrint;
+begin
+ if not IsDataField then
+ FMemo.Text := FTempMemo;
+ inherited;
+end;
+
+procedure TfrxCustomMemoView.GetData;
+var
+ i, j: Integer;
+ s, s1, s2, dc1, dc2: WideString;
+begin
+ inherited;
+ if IsDataField then
+ begin
+ if DataSet.IsBlobField(DataField) then
+ begin
+ DataSet.AssignBlobTo(DataField, FMemo);
+ end
+ else
+ begin
+ FValue := DataSet.Value[DataField];
+ if FDisplayFormat.Kind = fkText then
+ FMemo.Text := DataSet.DisplayText[DataField]
+ else
+ FMemo.Text := FormatData(FValue);
+ if FHideZeros and (TVarData(FValue).VType <> varString) and
+ (TVarData(FValue).VType <> varUString) and
+ (TVarData(FValue).VType <> varOleStr) and (FValue = 0) then
+ FMemo.Text := '';
+ end;
+ end
+ else if AllowExpressions then
+ begin
+ s := FMemo.Text;
+ i := 1;
+ dc1 := FExpressionDelimiters;
+ dc2 := Copy(dc1, Pos(',', dc1) + 1, 255);
+ dc1 := Copy(dc1, 1, Pos(',', dc1) - 1);
+
+ if Pos(dc1, s) <> 0 then
+ begin
+ repeat
+ while (i < Length(s)) and (Copy(s, i, Length(dc1)) <> dc1) do Inc(i);
+
+ s1 := frxGetBrackedVariableW(s, dc1, dc2, i, j);
+ if i <> j then
+ begin
+ Delete(s, i, j - i + 1);
+ s2 := CalcAndFormat(s1);
+ Insert(s2, s, i);
+ Inc(i, Length(s2));
+ j := 0;
+ end;
+ until i = j;
+
+ FMemo.Text := s;
+ end;
+ end;
+
+ Report.LocalValue := FValue;
+ FHighlight.Active := False;
+ if FHighlight.Condition <> '' then
+ FHighlight.Active := Report.Calc(FHighlight.Condition);
+
+ if FSuppressRepeated then
+ begin
+ if FLastValue = FMemo.Text then
+ FMemo.Text := '' else
+ FLastValue := FMemo.Text;
+ end;
+
+ if FFlowTo <> nil then
+ begin
+ InitPart;
+ DrawPart;
+ FFlowTo.Text := FPartMemo;
+ FFlowTo.AllowExpressions := False;
+ end;
+end;
+
+procedure TfrxCustomMemoView.ResetSuppress;
+begin
+ FLastValue := '';
+end;
+
+function TfrxCustomMemoView.CalcAndFormat(const Expr: WideString): WideString;
+var
+ i: Integer;
+ ExprStr, FormatStr: WideString;
+ Format: TfrxFormat;
+begin
+ Result := '';
+ Format := nil;
+ i := Pos(WideString(' #'), Expr);
+ if i <> 0 then
+ begin
+ ExprStr := Copy(Expr, 1, i - 1);
+ FormatStr := Copy(Expr, i + 2, Length(Expr) - i - 1);
+ if Pos(')', FormatStr) = 0 then
+ begin
+ Format := TfrxFormat.Create;
+
+ if CharInSet(FormatStr[1], [WideChar('N'), WideChar('n')]) then
+ begin
+ Format.Kind := fkNumeric;
+ for i := 1 to Length(FormatStr) do
+ if CharInSet(FormatStr[i], [WideChar(','), WideChar('.'), WideChar('-')]) then
+ begin
+ Format.DecimalSeparator := FormatStr[i];
+ FormatStr[i] := '.';
+ end;
+ end
+ else if CharInSet(FormatStr[1], [WideChar('D'), WideChar('T'), WideChar('d'), WideChar('t')]) then
+ Format.Kind := fkDateTime
+ else if CharInSet(FormatStr[1], [WideChar('B'), WideChar('b')]) then
+ Format.Kind := fkBoolean;
+
+ Format.FormatStr := Copy(FormatStr, 2, 255);
+ end
+ else
+ ExprStr := Expr;
+ end
+ else
+ ExprStr := Expr;
+
+ try
+ if CompareText(ExprStr, 'TOTALPAGES#') = 0 then
+ FValue := '[TotalPages#]'
+ else if CompareText(ExprStr, 'COPYNAME#') = 0 then
+ FValue := '[CopyName#]'
+ else
+ FValue := Report.Calc(ExprStr);
+ if FHideZeros and (TVarData(FValue).VType <> varString) and
+ (TVarData(FValue).VType <> varOleStr) and
+ (TVarData(FValue).VType <> varUString) and
+ (FValue = 0) then
+ Result := ''
+ else
+ Result := FormatData(FValue, Format);
+ finally
+ if Format <> nil then
+ Format.Free;
+ end;
+end;
+
+function TfrxCustomMemoView.FormatData(const Value: Variant;
+ AFormat: TfrxFormat = nil): WideString;
+var
+ i, DecSepPos: Integer;
+begin
+ DecSepPos := 0;
+ if AFormat = nil then
+ AFormat := FDisplayFormat;
+ if VarIsNull(Value) then
+ Result := ''
+ else if AFormat.Kind = fkText then
+ Result := VarToWideStr(Value)
+ else
+ try
+ case AFormat.Kind of
+ fkNumeric:
+ begin
+ if (Pos('#', AFormat.FormatStr) <> 0) or (Pos('0', AFormat.FormatStr) = 1) then
+ Result := FormatFloat(AFormat.FormatStr, Extended(Value))
+ else if (Pos('d', AFormat.FormatStr) <> 0) or (Pos('u', AFormat.FormatStr) <> 0) then
+ Result := Format(AFormat.FormatStr, [Integer(Value)])
+ else
+ Result := Format(AFormat.FormatStr, [Extended(Value)]);
+ if (Length(AFormat.DecimalSeparator) = 1) and
+ (FormatSettings.DecimalSeparator <> AFormat.DecimalSeparator[1]) then
+ for i := Length(Result) downto 1 do
+ if Result[i] = WideChar(FormatSettings.DecimalSeparator) then
+ begin
+ DecSepPos := i; // save dec seporator pos
+ break;
+ end;
+
+ if (Length(AFormat.ThousandSeparator) = 1) and
+ (FormatSettings.ThousandSeparator <> AFormat.ThousandSeparator[1]) then
+ for i := 1 to Length(Result) do
+ if Result[i] = WideChar(FormatSettings.ThousandSeparator) then
+ Result[i] := WideChar(AFormat.ThousandSeparator[1]);
+
+ if DecSepPos > 0 then // replace dec seporator
+ Result[DecSepPos] := WideChar(AFormat.DecimalSeparator[1]);
+ end;
+
+ fkDateTime:
+ Result := FormatDateTime(AFormat.FormatStr, Value);
+
+ fkBoolean:
+ if Value = True then
+ Result := Copy(AFormat.FormatStr, Pos(',', AFormat.FormatStr) + 1, 255) else
+ Result := Copy(AFormat.FormatStr, 1, Pos(',', AFormat.FormatStr) - 1);
+ else
+ Result := VarToWideStr(Value)
+ end;
+ except
+ Result := VarToWideStr(Value)
+ end;
+end;
+
+function TfrxCustomMemoView.GetComponentText: String;
+var
+ i: Integer;
+begin
+ Result := FMemo.Text;
+ if FAllowExpressions then { extract TOTALPAGES macro if any }
+ begin
+ i := Pos('[TOTALPAGES]', UpperCase(Result));
+ if i <> 0 then
+ begin
+ Delete(Result, i, 12);
+ Insert(IntToStr(FTotalPages), Result, i);
+ end;
+ end;
+end;
+
+procedure TfrxCustomMemoView.ApplyStyle(Style: TfrxStyleItem);
+begin
+ if Style <> nil then
+ begin
+ Color := Style.Color;
+ Font := Style.Font;
+ Frame := Style.Frame;
+ end;
+end;
+
+procedure TfrxCustomMemoView.WrapText(WrapWords: Boolean; var aLineHeight: Single; WrapLines: TWideStrings; aBitmap: TBitmap);
+
+const
+{$IFDEF MACOS}
+ AddTextWidth = 0.0;
+{$ELSE}
+ AddTextWidth = -2.0;
+{$ENDIF}
+{$IFDEF MACOS}
+ AddHeight = 1;
+{$ELSE}
+ AddHeight = 1.5;
+{$ENDIF}
+
+var
+ TextRenderer: TAdvancedTextRenderer;
+ paragraph: TParagraph;
+ s1, s2, s3: String;
+ nIndex, idx, idy, LWordIndex: Integer;
+ TextCanvas: TCanvas;
+ FBmpCanvas: TBitmap;
+ HasWords: Boolean;
+ aText: String;
+ aSpaceWidth: Single;
+
+ function SplitString(const sText: String): String;
+ var
+ Len, RemaingLen: Integer;
+ CurWidth: Integer;
+ begin
+ Result := sText;
+ Len := (length(Result) + 1) div 2;
+ RemaingLen := length(Result);
+ CurWidth := Round(TextCanvas.TextWidth(sText));
+ while (true) do
+ begin
+
+ if (CurWidth = Trunc(FTextRect.Width - AddTextWidth)) then
+ break
+ else if (Len = 0) then
+ begin
+ if TextCanvas.TextWidth(Copy(sText, 1, RemaingLen + 1)) + aSpaceWidth < Trunc(FTextRect.Width - AddTextWidth) then
+ Inc(Len)
+ else
+ break;
+ end;
+ if (CurWidth + aSpaceWidth> Trunc(FTextRect.Width - AddTextWidth)) then
+ begin
+ RemaingLen := RemaingLen - Len;
+ Result := Copy(Result, 1, RemaingLen);
+ end
+ else if (CurWidth + aSpaceWidth < Trunc(FTextRect.Width - AddTextWidth)) then
+ begin
+ RemaingLen := RemaingLen + Len;
+ Result := Copy(sText, 1, RemaingLen);
+
+ end;
+ Len := Len div 2;
+
+ CurWidth := Round(TextCanvas.TextWidth(Result));
+ end;
+ end;
+
+begin
+ if not Assigned(WrapLines) then Exit;
+ aText := NormalizeText(FMemo.Text);
+ if Assigned(aBitmap) then
+ FBmpCanvas := aBitmap
+ else
+ FBmpCanvas := TBitmap.Create(1,1);
+
+ if Assigned(FFastCanvas) then
+ begin
+ TfrxFastCanvasLayer(FFastCanvas).Canvas := FBmpCanvas.Canvas;
+ TextCanvas := FFastCanvas;
+ end
+ else
+ TextCanvas := FBmpCanvas.Canvas;
+ TextCanvas.BeginScene();
+ BeginDraw(FBmpCanvas.Canvas, 1, 1, 0, 0);
+ try
+ if IsAdvancedRendererNeeded then
+ begin
+ TextRenderer := TAdvancedTextRenderer.Create(TextCanvas, aText,
+ FFont, FTextRect, FHAlign, FVAlign, -Font.Height + FLineSpacing * 1, FRotation, FWordWrap, False,
+ FAllowHTMLTags, False, 1);
+ try
+ for idx := 0 to TextRenderer.Paragraphs.Count - 1 do
+ begin
+ paragraph := TextRenderer.Paragraphs[idx];
+ for idy := 0 to paragraph.Lines.Count - 1 do
+ WrapLines.Add(paragraph.Lines[idy].Text);
+ if paragraph.Lines.Count > 0 then
+ begin
+ { 1 - means paragraph start}
+ WrapLines.Objects[WrapLines.Count - paragraph.Lines.Count] := TObject(1);
+ { 2 - means paragraph end }
+ { 3 - both }
+ WrapLines.Objects[WrapLines.Count - 1] := TObject(Integer(WrapLines.Objects[WrapLines.Count - 1]) + 2);
+ end;
+ end;
+ finally
+ aLineHeight := TextRenderer.LineHeight;
+ TextRenderer.Free;
+ end;
+ end
+ else
+ begin
+ Font.AssignToCanvas(FBmpCanvas.Canvas);
+ aSpaceWidth := 0;
+
+ for idx := 0 to Memo.Count - 1 do
+ begin
+ s1 := Memo[idx];
+ if (s1 = '') or (s1 = ' ') or (s1 = #9) then
+ begin
+ WrapLines.Add('');
+ Continue;
+ end;
+ nIndex := 1;
+ s2 := '';
+ LWordIndex := 1;
+ HasWords := False;
+ while nIndex <= Length(s1) do
+ begin
+ if (s1[nIndex] = #9) or (s1[nIndex] = ' ') or (nIndex = Length(s1)) then
+ begin
+ s2 := s2 + Copy(s1, LWordIndex, nIndex - LWordIndex);
+ if (nIndex = Length(s1)) then
+ s2 := s2 + s1[nIndex];
+ if (TextCanvas.TextWidth(s2) {+ aSpaceWidth} > Trunc(FTextRect.Width - AddTextWidth)) then
+ begin
+ if not HasWords then
+ begin
+ s3 := SplitString(s2);
+ if (s3 = '') and (nIndex = Length(s1)) then
+ begin
+ s2 := '';
+ break;
+ end;
+ WrapLines.Add(s3);
+ nIndex := LWordIndex + Length(s3);
+ LWordIndex := LWordIndex + Length(s3);
+ end
+ else
+ begin
+ WrapLines.Add(Copy(s2, 1, Length(s2) - (nIndex - LWordIndex)));
+ Inc(LWordIndex);
+ nIndex := LWordIndex;
+ end;
+ HasWords := False;
+ s2 := '';
+ end
+ else
+ LWordIndex := nIndex;
+ if (s1[nIndex] = #9) or (s1[nIndex] = ' ') then
+ HasWords := True;
+ end;
+ Inc(nIndex);
+ end;
+ if s2 <> '' then
+ WrapLines.Add(s2);
+ end;
+ aLineHeight := Font.GetHeight(FBmpCanvas.Canvas) + AddHeight;
+ end;
+ finally
+ TextCanvas.EndScene;
+ if not Assigned(aBitmap) then
+ FBmpCanvas.Free;
+ end
+end;
+
+procedure TfrxCustomMemoView.ExtractMacros;
+var
+ s, s1: WideString;
+ i, j: Integer;
+begin
+ if FAllowExpressions then
+ begin
+ s := FMemo.Text;
+ i := Pos('[TOTALPAGES#]', UpperCase(s));
+ if i <> 0 then
+ begin
+ Delete(s, i, 13);
+ Insert(IntToStr(FTotalPages), s, i);
+ FMemo.Text := s;
+ end;
+ i := Pos('[COPYNAME#]', UpperCase(s));
+ if i <> 0 then
+ begin
+ j := frxGlobalVariables.IndexOf('CopyName' + IntToStr(FCopyNo));
+ if j <> -1 then
+ s1 := VarToStr(frxGlobalVariables.Items[j].Value)
+ else
+ s1 := '';
+ Delete(s, i, 11);
+ Insert(s1, s, i);
+ FMemo.Text := s;
+ end;
+ end;
+end;
+
+
+{ TfrxSysMemoView }
+
+class function TfrxSysMemoView.GetDescription: String;
+begin
+ Result := frxResources.Get('obSysText');
+end;
+
+
+{ TfrxCustomLineView }
+
+constructor TfrxCustomLineView.Create(AOwner: TComponent);
+begin
+ inherited;
+ frComponentStyle := frComponentStyle - [csDefaultDiff];
+ FArrowWidth := 5;
+ FArrowLength := 20;
+end;
+
+constructor TfrxCustomLineView.DesignCreate(AOwner: TComponent; Flags: Word);
+begin
+ inherited;
+ FDiagonal := Flags <> 0;
+ FArrowEnd := Flags in [2, 4];
+ FArrowStart := Flags in [3, 4];
+end;
+
+procedure TfrxCustomLineView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+begin
+ if not FDiagonal then
+ begin
+ if Width > Height then
+ begin
+ Height := 0;
+ Frame.Typ := [ftTop];
+ end
+ else
+ begin
+ Width := 0;
+ Frame.Typ := [ftLeft];
+ end;
+ end;
+
+ BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+ if not FDiagonal then
+ begin
+ DrawFrame;
+ if FArrowStart then
+ DrawArrow(FX1, FY1, FX, FY);
+ if FArrowEnd then
+ DrawArrow(FX, FY, FX1, FY1);
+ end
+ else
+ DrawDiagonalLine;
+end;
+
+procedure TfrxCustomLineView.DrawArrow(x1, y1, x2, y2: Extended);
+var
+ k1, a, b, c, D: Double;
+ xp, yp, x3, y3, x4, y4, wd, ld: Extended;
+ poly: TPolygon;
+begin
+ wd := FArrowWidth * FScaleX;
+ ld := FArrowLength * FScaleX;
+ if abs(x2 - x1) > 8 then
+ begin
+ k1 := (y2 - y1) / (x2 - x1);
+ a := Sqr(k1) + 1;
+ b := 2 * (k1 * ((x2 * y1 - x1 * y2) / (x2 - x1) - y2) - x2);
+ c := Sqr(x2) + Sqr(y2) - Sqr(ld) + Sqr((x2 * y1 - x1 * y2) / (x2 - x1)) -
+ 2 * y2 * (x2 * y1 - x1 * y2) / (x2 - x1);
+ D := Sqr(b) - 4 * a * c;
+ xp := (-b + Sqrt(D)) / (2 * a);
+ if (xp > x1) and (xp > x2) or (xp < x1) and (xp < x2) then
+ xp := (-b - Sqrt(D)) / (2 * a);
+ yp := xp * k1 + (x2 * y1 - x1 * y2) / (x2 - x1);
+ if y2 <> y1 then
+ begin
+ x3 := xp + wd * sin(ArcTan(k1));
+ y3 := yp - wd * cos(ArcTan(k1));
+ x4 := xp - wd * sin(ArcTan(k1));
+ y4 := yp + wd * cos(ArcTan(k1));
+ end
+ else
+ begin
+ x3 := xp;
+ y3 := yp - wd;
+ x4 := xp;
+ y4 := yp + wd;
+ end;
+ end
+ else
+ begin
+ xp := x2;
+ yp := y2 - ld;
+ if (yp > y1) and (yp > y2) or (yp < y1) and (yp < y2) then
+ yp := y2 + ld;
+ x3 := xp - wd;
+ y3 := yp;
+ x4 := xp + wd;
+ y4 := yp;
+ end;
+
+ SetLength(poly, 4);
+ poly[0] := PointF(Round(x2), Round(y2));
+ poly[1] := PointF(Round(x3), Round(y3));
+ poly[2] := PointF(Round(x4), Round(y4));
+ poly[3] := PointF(Round(x2), Round(y2));
+
+ if FArrowSolid then
+ begin
+ FCanvas.Fill.Kind := TBrushKind.bkSolid;
+ FCanvas.Fill.Color := Frame.Color;
+ FCanvas.FillPolygon(poly, 1);
+ end
+ else
+ begin
+ FCanvas.DrawPolygon(poly, 1);
+ end;
+end;
+
+procedure TfrxCustomLineView.DrawDiagonalLine;
+begin
+ if (Frame.Color = claNull) or (Frame.Width = 0) then exit;
+
+ with FCanvas do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := Frame.Color;
+{$IFDEF DELPHI25}
+ Stroke.Thickness := Round(FFrame.Width * FScaleX);
+ if Frame.Style <> fsDouble then
+ Stroke.Dash := TStrokeDash(Frame.Style) else
+ Stroke.Dash := TStrokeDash.sdSolid;
+{$ELSE}
+ StrokeThickness := Round(FFrame.Width * FScaleX);
+ if Frame.Style <> fsDouble then
+ StrokeDash := TStrokeDash(Frame.Style) else
+ StrokeDash := TStrokeDash.sdSolid;
+{$ENDIF}
+
+ DrawLine(PointF(FX, FY), PointF(FX1, FY1), 1);
+
+ if FArrowStart then
+ DrawArrow(FX1, FY1, FX, FY);
+ if FArrowEnd then
+ DrawArrow(FX, FY, FX1, FY1);
+ end;
+end;
+
+
+procedure TfrxCustomLineView.GetVisibleRect(var aRect: TRectF);
+var
+ xTemp, AddFrame: Single;
+begin
+ AddFrame := 1;
+ if FArrowStart or FArrowEnd then
+ AddFrame := AddFrame + FArrowWidth / 2;
+ aRect := RectF(AbsLeft, AbsTop, AbsLeft + Width, AbsTop + Height);
+ if aRect.Bottom < aRect.Top then
+ begin
+ xTemp := aRect.Bottom;
+ aRect.Bottom := aRect.Top;
+ aRect.Top := xTemp;
+ end;
+ if aRect.Right < aRect.Left then
+ begin
+ xTemp := aRect.Right;
+ aRect.Right := aRect.Left;
+ aRect.Left := xTemp;
+ end;
+
+ aRect.Left := aRect.Left - (Frame.Width + AddFrame);
+ aRect.Top := aRect.Top - (Frame.Width + AddFrame);
+ aRect.Right := aRect.Right + (Frame.Width + AddFrame);
+ aRect.Bottom := aRect.Bottom + (Frame.Width + AddFrame);
+end;
+
+{ TfrxLineView }
+
+class function TfrxLineView.GetDescription: String;
+begin
+ Result := frxResources.Get('obLine');
+end;
+
+
+{ TfrxPictureView }
+
+constructor TfrxPictureView.Create(AOwner: TComponent);
+begin
+ inherited;
+ frComponentStyle := frComponentStyle - [csDefaultDiff];
+ FPicture := TBitmap.Create(0, 0);
+ FPicture.OnChange := PictureChanged;
+ FKeepAspectRatio := True;
+ FStretched := True;
+ FColor := claWhite;
+ FTransparentColor := claWhite;
+ FIsPictureStored := True;
+end;
+
+procedure TfrxPictureView.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ Filer.DefineBinaryProperty('Data', ReadVCLPicture, nil, false);
+end;
+
+destructor TfrxPictureView.Destroy;
+begin
+ FPicture.Free;
+ inherited;
+end;
+
+class function TfrxPictureView.GetDescription: String;
+begin
+ Result := frxResources.Get('obPicture');
+end;
+
+procedure TfrxPictureView.SetPicture(const Value: TBitmap);
+begin
+ FPicture.Assign(Value);
+end;
+
+procedure TfrxPictureView.SetTransparent(const Value: Boolean);
+begin
+ FTransparent := Value;
+ if FTransparent then
+ FColor := claNull
+ else FColor := claWhite;
+end;
+
+procedure TfrxPictureView.SetAutoSize(const Value: Boolean);
+begin
+ FAutoSize := Value;
+ if FAutoSize and not (FPicture = nil) then
+ begin
+ FWidth := FPicture.Width;
+ FHeight := FPicture.Height;
+ end;
+end;
+
+procedure TfrxPictureView.PictureChanged(Sender: TObject);
+begin
+ AutoSize := FAutoSize;
+ FPictureChanged := True;
+end;
+
+procedure TfrxPictureView.ReadVCLPicture(Stream: TStream);
+var
+ LenName: Byte;
+begin
+ { skip VCL Image format }
+ Stream.Read(LenName, 1);
+ Stream.Position := 5 + LenName;
+ FPicture.LoadFromStream(Stream);
+end;
+
+procedure TfrxPictureView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
+var
+ r: TRectF;
+ kx, ky: Extended;
+ state: TCanvasSaveState;
+ OldM: TMatrix;
+{ rgn: HRGN;
+
+ procedure PrintGraphic(Canvas: TCanvas; DestRect: TRect; aGraph: TGraphic);
+ begin
+ frxDrawGraphic(Canvas, DestRect, aGraph, IsPrinting, HightQuality, FTransparent, FTransparentColor);
+ end;
+}
+begin
+ BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
+
+ with Canvas do
+ begin
+
+ DrawBackground;
+
+ r := RectF(FX, FY, FX1, FY1);
+
+ if FPicture.IsEmpty then
+ begin
+{ if IsDesigning then
+ frxResources.ObjectImages.Draw(Canvas, FX + 1, FY + 2, 3);}
+ end
+ else
+ begin
+ if FStretched then
+ begin
+ if FKeepAspectRatio then
+ begin
+ kx := FDX / FPicture.Width;
+ ky := FDY / FPicture.Height;
+ if kx < ky then
+ r.Bottom := r.Top + Round(FPicture.Height * kx) else
+ r.Right := r.Left + Round(FPicture.Width * ky);
+
+ if FCenter then
+ OffsetRect(r, (FDX - (r.Right - r.Left)) / 2,
+ (FDY - (r.Bottom - r.Top)) / 2);
+ end;
+
+ Canvas.DrawBitmap(FPicture, RectF(0, 0, FPicture.Width, FPicture.Height), r, 1, not FHightQuality);
+
+ end
+ else
+ begin
+ if FCenter then
+ OffsetRect(r, (FDX - Round(ScaleX * FPicture.Width)) div 2,
+ (FDY - Round(ScaleY * FPicture.Height)) div 2);
+ r.Right := r.Left + Round(FPicture.Width * ScaleX);
+ r.Bottom := r.Top + Round(FPicture.Height * ScaleY);
+ OldM := Canvas.Matrix;
+ State := Canvas.SaveState;
+ try
+ Canvas.IntersectClipRect(REctF(FX, FY, FX1, FY1));
+ Canvas.DrawBitmap(FPicture, RectF(0, 0, FPicture.Width, FPicture.Height), r, 1, not FHightQuality);
+ finally
+ Canvas.RestoreState(state);
+ Canvas.SetMatrix(OldM);
+ end;
+ end;
+ end;
+ DrawFrame;
+ end;
+end;
+
+function TfrxPictureView.Diff(AComponent: TfrxComponent): String;
+begin
+ if FPictureChanged then
+ begin
+ Report.PreviewPages.AddPicture(Self);
+ FPictureChanged := False;
+ end;
+
+ Result := ' ' + inherited Diff(AComponent) + ' ImageIndex="' +
+ IntToStr(FImageIndex) + '"';
+ if Transparent then
+ Result := Result + ' Transparent="' + frxValueToXML(FTransparent) + '"';
+ if TransparentColor <> claWhite then
+ Result := Result + ' TransparentColor="' + intToStr(Integer(FTransparentColor)) + '"';
+end;
+
+ type
+ TGraphicHeader = record
+ Count: Word;
+ HType: Word;
+ Size: Int32;
+ end;
+procedure TfrxPictureView.GetData;
+var
+ m: TMemoryStream;
+ s: String;
+ ipos: Integer;
+ Header: TGraphicHeader;
+begin
+ inherited;
+ if FFileLink <> '' then
+ begin
+ s := FFileLink;
+ if Pos('[', s) <> 0 then
+ ExpandVariables(s);
+ if FileExists(s) then
+ FPicture.LoadFromFile(s)
+ else
+ FPicture.SetSize(0,0);
+ end
+ else if IsDataField and DataSet.IsBlobField(DataField) then
+ begin
+ m := TMemoryStream.Create;
+ try
+ DataSet.AssignBlobTo(DataField, m);
+ if m.Size >= SizeOf(TGraphicHeader) then
+ begin
+ ipos := m.Position;
+ m.Read(Header, SizeOf(Header));
+ if (Header.Count <> 1) or (Header.HType <> $0100) or
+ (Header.Size <> m.Size - SizeOf(Header)) then
+ m.Position := ipos;
+ end;
+ FPicture.LoadFromStream(m);
+ finally
+ m.Free;
+ end;
+ end;
+end;
+
+
+{ TfrxBand }
+
+constructor TfrxBand.Create(AOwner: TComponent);
+begin
+ inherited;
+ FSubBands := TList.Create;
+ FOriginalObjectsCount := -1;
+end;
+
+destructor TfrxBand.Destroy;
+begin
+ FSubBands.Free;
+ inherited;
+end;
+
+procedure TfrxBand.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FChild) then
+ FChild := nil;
+end;
+
+procedure TfrxBand.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
+begin
+end;
+
+function TfrxBand.GetBandName: String;
+begin
+ Result := ClassName;
+ Delete(Result, Pos('Tfrx', Result), 4);
+ Delete(Result, Pos('Band', Result), 4);
+end;
+
+function TfrxBand.BandNumber: Integer;
+var
+ i: Integer;
+begin
+ Result := 0;
+ for i := 0 to BND_COUNT - 1 do
+ if Self is frxBands[i] then
+ Result := i;
+end;
+
+class function TfrxBand.GetDescription: String;
+begin
+ Result := frxResources.Get('obBand');
+end;
+
+procedure TfrxBand.SetLeft(Value: Double);
+begin
+ if Parent is TfrxDMPPage then
+ Value := Round(Value / fr1CharX) * fr1CharX;
+ inherited;
+end;
+
+procedure TfrxBand.SetTop(Value: Double);
+begin
+ if Parent is TfrxDMPPage then
+ Value := Round(Value / fr1CharY) * fr1CharY;
+ inherited;
+end;
+
+procedure TfrxBand.SetVertical(const Value: Boolean);
+begin
+{$IFDEF RAD_ED}
+ FVertical := False;
+{$ELSE}
+ FVertical := Value;
+{$ENDIF}
+end;
+
+procedure TfrxBand.SetHeight(Value: Double);
+begin
+ if Parent is TfrxDMPPage then
+ Value := Round(Value / fr1CharY) * fr1CharY;
+ inherited;
+end;
+
+procedure TfrxBand.SetChild(Value: TfrxChild);
+var
+ b: TfrxBand;
+begin
+ b := Value;
+ while b <> nil do
+ begin
+ b := b.Child;
+ if b = Self then
+ raise Exception.Create(frxResources.Get('clCirRefNotAllow'));
+ end;
+ FChild := Value;
+end;
+
+
+{ TfrxDataBand }
+
+constructor TfrxDataBand.Create(AOwner: TComponent);
+begin
+ inherited;
+ FVirtualDataSet := TfrxUserDataSet.Create(nil);
+ FVirtualDataSet.RangeEnd := reCount;
+end;
+
+destructor TfrxDataBand.Destroy;
+begin
+ FVirtualDataSet.Free;
+ inherited;
+end;
+
+class function TfrxDataBand.GetDescription: String;
+begin
+ Result := frxResources.Get('obDataBand');
+end;
+
+procedure TfrxDataBand.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FDataSet) then
+ FDataSet := nil;
+end;
+
+procedure TfrxDataBand.SetCurColumn(Value: Integer);
+begin
+ if Value > FColumns then
+ Value := 1;
+ FCurColumn := Value;
+ if FCurColumn = 1 then
+ FMaxY := 0;
+ FLeft := (FCurColumn - 1) * (FColumnWidth + FColumnGap);
+end;
+
+procedure TfrxDataBand.SetDataSet(const Value: TfrxDataSet);
+begin
+ FDataSet := Value;
+ if FDataSet = nil then
+ FDataSetName := '' else
+ FDataSetName := FDataSet.UserName;
+end;
+
+procedure TfrxDataBand.SetDataSetName(const Value: String);
+begin
+ FDataSetName := Value;
+ FDataSet := FindDataSet(FDataSet, FDataSetName);
+end;
+
+function TfrxDataBand.GetDataSetName: String;
+begin
+ if FDataSet = nil then
+ Result := FDataSetName else
+ Result := FDataSet.UserName;
+end;
+
+procedure TfrxDataBand.SetRowCount(const Value: Integer);
+begin
+ FRowCount := Value;
+ FVirtualDataSet.RangeEndCount := Value;
+end;
+
+
+{ TfrxPageHeader }
+
+constructor TfrxPageHeader.Create(AOwner: TComponent);
+begin
+ inherited;
+ FPrintOnFirstPage := True;
+end;
+
+
+{ TfrxPageFooter }
+
+constructor TfrxPageFooter.Create(AOwner: TComponent);
+begin
+ inherited;
+ FPrintOnFirstPage := True;
+ FPrintOnLastPage := True;
+end;
+
+
+{ TfrxGroupHeader }
+
+function TfrxGroupHeader.Diff(AComponent: TfrxComponent): String;
+begin
+ Result := inherited Diff(AComponent);
+ if FDrillDown then
+ Result := Result + ' DrillName="' + FDrillName + '"';
+end;
+
+
+{ TfrxSubreport }
+
+constructor TfrxSubreport.Create(AOwner: TComponent);
+begin
+ inherited;
+ frComponentStyle := frComponentStyle - [csPreviewVisible];
+ FFrame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
+ FFont.Name := 'Tahoma';
+ FFont.Size := 8;
+ FColor := claSilver;
+end;
+
+destructor TfrxSubreport.Destroy;
+begin
+ if FPage <> nil then
+ FPage.FSubReport := nil;
+ inherited;
+end;
+
+procedure TfrxSubreport.SetPage(const Value: TfrxReportPage);
+begin
+ FPage := Value;
+ if FPage <> nil then
+ FPage.FSubReport := Self;
+end;
+
+procedure TfrxSubreport.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+begin
+ inherited;
+
+{ with Canvas do
+ begin
+ Font.Assign(FFont);
+ FillText(FX + 2, FY + 2, Name);
+ end;}
+end;
+
+class function TfrxSubreport.GetDescription: String;
+begin
+ Result := frxResources.Get('obSubRep');
+end;
+
+
+{ TfrxDialogPage }
+
+constructor TfrxDialogPage.Create(AOwner: TComponent);
+var
+ FSaveTag: Integer;
+begin
+ inherited;
+ FSaveTag := Tag;
+ if (Report <> nil) and Report.EngineOptions.EnableThreadSafe then
+ Tag := 318
+ else
+ Tag := 0;
+ FForm := TfrxDialogForm.Create(Self);
+ Tag := FSaveTag;
+{$IFDEF LINUX}
+ Font.Name := 'Liberation Mono';
+{$ELSE}
+ Font.Name := 'Tahoma';
+{$ENDIF}
+ Font.Size := 8;
+ BorderStyle := TfmxFormBorderStyle.bsSizeable;
+ Position := TFormPosition.poScreenCenter;
+ WindowState := TWindowState.wsNormal;
+ Color := claWhiteSmoke;
+ FClientWidth := 0;
+ FClientHeight := 0;
+end;
+
+destructor TfrxDialogPage.Destroy;
+begin
+{$IFNDEF NO_CRITICAL_SECTION}
+ frxCS.Enter;
+{$ENDIF}
+ try
+ inherited;
+ FForm.Free;
+ finally
+{$IFNDEF NO_CRITICAL_SECTION}
+ frxCS.Leave;
+{$ENDIF}
+ end;
+end;
+
+class function TfrxDialogPage.GetDescription: String;
+begin
+ Result := frxResources.Get('obDlgPage');
+end;
+
+procedure TfrxDialogPage.SetLeft(Value: Double);
+begin
+ inherited;
+ FForm.Left := Round(Value);
+end;
+
+procedure TfrxDialogPage.SetTop(Value: Double);
+begin
+ inherited;
+ FForm.Top := Round(Value);
+end;
+
+procedure TfrxDialogPage.SetWidth(Value: Double);
+begin
+ inherited;
+ if IsLoading and (FClientWidth <> 0) then Exit;
+ FForm.Width := Round(Value);
+ FClientWidth := FForm.ClientWidth;
+end;
+
+procedure TfrxDialogPage.SetHeight(Value: Double);
+begin
+ inherited;
+ if IsLoading and (FClientHeight <> 0) then Exit;
+ FForm.Height := Round(Value);
+ FClientHeight := FForm.ClientHeight;
+end;
+
+procedure TfrxDialogPage.SetClientWidth(Value: Double);
+begin
+ if IsLoading and (Value > Width) then Exit;
+ FForm.ClientWidth := Round(Value);
+ FClientWidth := Value;
+ inherited SetWidth(FForm.Width);
+end;
+
+procedure TfrxDialogPage.SetClientHeight(Value: Double);
+begin
+ if IsLoading and (Value > Height) then Exit;
+ FForm.ClientHeight := Round(Value);
+ FClientHeight := Value;
+ inherited SetHeight(FForm.Height);
+end;
+
+function TfrxDialogPage.GetClientWidth: Double;
+begin
+ Result := FForm.ClientWidth;
+end;
+
+function TfrxDialogPage.GetClientHeight: Double;
+begin
+ Result := FForm.ClientHeight;
+end;
+
+procedure TfrxDialogPage.SetBorderStyle(const Value: TfmxFormBorderStyle);
+begin
+ FBorderStyle := Value;
+end;
+
+procedure TfrxDialogPage.SetCaption(const Value: String);
+begin
+ FCaption := Value;
+ FForm.Caption := Value;
+end;
+
+procedure TfrxDialogPage.SetColor(const Value: TAlphaColor);
+begin
+ FColor := Value;
+ FForm.Fill.Color := Value;
+end;
+
+function TfrxDialogPage.GetModalResult: TModalResult;
+begin
+ Result := FForm.ModalResult;
+end;
+
+procedure TfrxDialogPage.SetModalResult(const Value: TModalResult);
+begin
+ FForm.ModalResult := Value;
+end;
+
+procedure TfrxDialogPage.SetPosition(const Value: TFormPosition);
+begin
+ FPosition := Value;
+ FForm.Position := FPosition;
+end;
+
+procedure TfrxDialogPage.FontChanged(Sender: TObject);
+begin
+ inherited;
+ //FForm.Font := Font;
+end;
+
+procedure TfrxDialogPage.DoInitialize;
+begin
+ // we need it to reset FBoundChanges
+ FForm.AfterConstruction;
+ if FForm.Visible then
+ FForm.Hide;
+ FForm.Position := FPosition;
+ FForm.WindowState := FWindowState;
+ FForm.OnActivate := DoOnActivate;
+ FForm.OnCloseQuery := DoOnCloseQuery;
+ FForm.OnDeactivate := DoOnDeactivate;
+ FForm.OnResize := DoOnResize;
+{$IFDEF DELPHI18}
+ FForm.OnShow := DoOnShow;
+{$ENDIF}
+end;
+
+procedure TfrxDialogPage.Initialize;
+begin
+ DoInitialize;
+end;
+
+function TfrxDialogPage.ShowModal: TModalResult;
+begin
+ Initialize;
+ FForm.BorderStyle := FBorderStyle;
+{$IFNDEF DELPHI19}
+ FForm.TopMost := False;
+ {$ENDIF}
+ try
+ TfrxDialogForm(FForm).OnModify := DoModify;
+{$IFDEF LINUX}
+ Result := TfrxDialogForm(FForm).ShowModal;
+{$ELSE}
+ Result := FForm.ShowModal;
+{$ENDIF}
+
+ finally
+{$IFNDEF DELPHI19}
+ FForm.TopMost := True;
+{$ENDIF}
+ end;
+end;
+
+type
+ THackCommonCustomForm = class(TCommonCustomForm);
+procedure TfrxDialogPage.UpdateClientRect;
+var
+ lForm: TfrxDialogForm;
+begin
+ lForm := TfrxDialogForm.Create(nil);
+ try
+ lForm.Top := 0;
+ lForm.Left := 0;
+ lForm.Width := FForm.Width;
+ lForm.Height := FForm.Height;
+ lForm.Show;
+ FClientHeight := lForm.ClientHeight;
+ FClientWidth := lForm.ClientWidth;
+ FForm.ClientHeight := Round(FClientHeight);
+ FForm.ClientWidth := Round(FClientWidth);
+ FForm.Hide;
+ finally
+ lForm.Close;
+ lForm.Free;
+ end;
+end;
+
+procedure TfrxDialogPage.DoModify(Sender: TObject);
+begin
+ FLeft := FForm.Left;
+ FTop := FForm.Top;
+ FWidth := FForm.Width;
+ FHeight := FForm.Height;
+end;
+
+procedure TfrxDialogPage.DoOnActivate(Sender: TObject);
+var
+ i: Integer;
+begin
+ DoModify(nil);
+ if Report <> nil then
+ Report.DoNotifyEvent(Sender, FOnActivate, True);
+ for i := 0 to AllObjects.Count - 1 do
+ begin
+ if (TObject(AllObjects[i]) is TfrxDialogControl) and
+ Assigned(TfrxDialogControl(AllObjects[i]).OnActivate) then
+ TfrxDialogControl(AllObjects[i]).OnActivate(Self);
+ end;
+end;
+
+procedure TfrxDialogPage.DoOnCloseQuery(Sender: TObject; var CanClose: Boolean);
+var
+ v: Variant;
+begin
+ v := VarArrayOf([frxInteger(Sender), CanClose]);
+ Report.DoParamEvent(FOnCloseQuery, v, True);
+ CanClose := v[1];
+end;
+
+procedure TfrxDialogPage.DoOnDeactivate(Sender: TObject);
+begin
+ Report.DoNotifyEvent(Sender, FOnDeactivate, True);
+end;
+
+procedure TfrxDialogPage.DoOnResize(Sender: TObject);
+begin
+ Report.DoNotifyEvent(Sender, FOnResize, True);
+end;
+
+{$IFDEF DELPHI18}
+procedure TfrxDialogPage.DoOnShow(Sender: TObject);
+begin
+ Report.DoNotifyEvent(Sender, FOnShow, True);
+end;
+{$ENDIF}
+
+{ TfrxReportPage }
+
+constructor TfrxReportPage.Create(AOwner: TComponent);
+begin
+ inherited;
+ FBackPicture := TfrxPictureView.Create(nil);
+ FBackPicture.Color := claNull;
+ FBackPicture.KeepAspectRatio := False;
+ FColumnPositions := TStringList.Create;
+ FOrientation := poPortrait;
+ PaperSize := DMPAPER_A4;
+ FBin := DMBIN_AUTO;
+ FBinOtherPages := DMBIN_AUTO;
+ FBaseName := 'Page';
+ FSubBands := TList.Create;
+ FVSubBands := TList.Create;
+ FHGuides := TStringList.Create;
+ FVGuides := TStringList.Create;
+ FPrintIfEmpty := True;
+ FTitleBeforeHeader := True;
+ FBackPictureVisible := True;
+ FBackPicturePrintable := True;
+ FPageCount := 1;
+end;
+
+destructor TfrxReportPage.Destroy;
+begin
+ FColumnPositions.Free;
+ FBackPicture.Free;
+ FSubBands.Free;
+ FVSubBands.Free;
+ FHGuides.Free;
+ FVGuides.Free;
+ if FSubReport <> nil then
+ FSubReport.FPage := nil;
+ inherited;
+end;
+
+class function TfrxReportPage.GetDescription: String;
+begin
+ Result := frxResources.Get('obRepPage');
+end;
+
+procedure TfrxReportPage.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FDataSet) then
+ FDataSet := nil;
+end;
+
+procedure TfrxReportPage.SetDataSet(const Value: TfrxDataSet);
+begin
+ FDataSet := Value;
+ if FDataSet = nil then
+ FDataSetName := '' else
+ FDataSetName := FDataSet.UserName;
+end;
+
+procedure TfrxReportPage.SetDataSetName(const Value: String);
+begin
+ FDataSetName := Value;
+ FDataSet := FindDataSet(FDataSet, FDataSetName);
+end;
+
+function TfrxReportPage.GetDataSetName: String;
+begin
+ if FDataSet = nil then
+ Result := FDataSetName else
+ Result := FDataSet.UserName;
+end;
+
+procedure TfrxReportPage.SetPaperHeight(const Value: Double);
+begin
+ FPaperHeight := Round8(Value);
+ FPaperSize := 256;
+ UpdateDimensions;
+end;
+
+procedure TfrxReportPage.SetPaperWidth(const Value: Double);
+begin
+ FPaperWidth := Round8(Value);
+ FPaperSize := 256;
+ UpdateDimensions;
+end;
+
+procedure TfrxReportPage.SetPaperSize(const Value: Integer);
+var
+ e: Extended;
+begin
+ FPaperSize := Value;
+ if FPaperSize < DMPAPER_USER then
+ begin
+ if frxGetPaperDimensions(FPaperSize, FPaperWidth, FPaperHeight) then
+ if FOrientation = poLandscape then
+ begin
+ e := FPaperWidth;
+ FPaperWidth := FPaperHeight;
+ FPaperHeight := e;
+ end;
+ UpdateDimensions;
+ end;
+end;
+
+procedure TfrxReportPage.SetSizeAndDimensions(ASize: Integer; AWidth,
+ AHeight: Double);
+begin
+ FPaperSize := ASize;
+ FPaperWidth := Round8(AWidth);
+ FPaperHeight := Round8(AHeight);
+ UpdateDimensions;
+end;
+
+procedure TfrxReportPage.SetColumns(const Value: Integer);
+begin
+ FColumns := Value;
+ FColumnPositions.Clear;
+ if FColumns <= 0 then exit;
+
+ FColumnWidth := (FPaperWidth - FLeftMargin - FRightMargin) / FColumns;
+ while FColumnPositions.Count < FColumns do
+ FColumnPositions.Add(FloatToStr(FColumnPositions.Count * FColumnWidth));
+end;
+
+procedure TfrxReportPage.SetPageCount(const Value: Integer);
+begin
+ if Value > 0 then
+ FPageCount := Value;
+end;
+
+procedure TfrxReportPage.SetOrientation(Value: TPrinterOrientation);
+var
+ e, m1, m2, m3, m4: Extended;
+begin
+ if FOrientation <> Value then
+ begin
+ e := FPaperWidth;
+ FPaperWidth := FPaperHeight;
+ FPaperHeight := e;
+
+ m1 := FLeftMargin;
+ m2 := FRightMargin;
+ m3 := FTopMargin;
+ m4 := FBottomMargin;
+
+ if Value = poLandscape then
+ begin
+ FLeftMargin := m3;
+ FRightMargin := m4;
+ FTopMargin := m2;
+ FBottomMargin := m1;
+ end
+ else
+ begin
+ FLeftMargin := m4;
+ FRightMargin := m3;
+ FTopMargin := m1;
+ FBottomMargin := m2;
+ end;
+ UpdateDimensions;
+ end;
+
+ FOrientation := Value;
+end;
+
+procedure TfrxReportPage.UpdateDimensions;
+begin
+ Width := Round(FPaperWidth * fr01cm);
+ Height := Round(FPaperHeight * fr01cm);
+end;
+
+procedure TfrxReportPage.ClearGuides;
+begin
+ FHGuides.Clear;
+ FVGuides.Clear;
+end;
+
+procedure TfrxReportPage.SetHGuides(const Value: TStrings);
+begin
+ FHGuides.Assign(Value);
+end;
+
+procedure TfrxReportPage.SetVGuides(const Value: TStrings);
+begin
+ FVGuides.Assign(Value);
+end;
+
+function TfrxReportPage.FindBand(Band: TfrxBandClass): TfrxBand;
+var
+ i: Integer;
+begin
+ Result := nil;
+ for i := 0 to FObjects.Count - 1 do
+ if TObject(FObjects[i]) is Band then
+ begin
+ Result := FObjects[i];
+ break;
+ end;
+end;
+
+function TfrxReportPage.IsSubReport: Boolean;
+begin
+ Result := SubReport <> nil;
+end;
+
+procedure TfrxReportPage.SetColumnPositions(const Value: TStrings);
+begin
+ FColumnPositions.Assign(Value);
+end;
+
+function TfrxReportPage.GetFrame: TfrxFrame;
+begin
+ Result := FBackPicture.Frame;
+end;
+
+procedure TfrxReportPage.SetFrame(const Value: TfrxFrame);
+begin
+ FBackPicture.Frame := Value;
+end;
+
+function TfrxReportPage.GetColor: TAlphaColor;
+begin
+ Result := FBackPicture.Color;
+end;
+
+procedure TfrxReportPage.SetColor(const Value: TAlphaColor);
+begin
+ FBackPicture.Color := Value;
+end;
+
+function TfrxReportPage.GetBackPicture: TBitmap;
+begin
+ Result := FBackPicture.Picture;
+end;
+
+procedure TfrxReportPage.SetBackPicture(const Value: TBitmap);
+begin
+ FBackPicture.Picture := Value;
+end;
+
+procedure TfrxReportPage.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+begin
+ FBackPicture.Width := (FPaperWidth - FLeftMargin - FRightMargin) * fr01cm;
+ FBackPicture.Height := (FPaperHeight - FTopMargin - FBottomMargin) * fr01cm;
+ if FBackPictureVisible and (not IsPrinting or FBackPicturePrintable) then
+ FBackPicture.Draw(Canvas, ScaleX, ScaleY,
+ OffsetX + FLeftMargin * fr01cm * ScaleX,
+ OffsetY + FTopMargin * fr01cm * ScaleY);
+end;
+
+procedure TfrxReportPage.SetDefaults;
+begin
+ FLeftMargin := 10;
+ FRightMargin := 10;
+ FTopMargin := 10;
+ FBottomMargin := 10;
+ FPaperSize := frxPrinters.Printer.DefPaper;
+ FPaperWidth := frxPrinters.Printer.DefPaperWidth;
+ FPaperHeight := frxPrinters.Printer.DefPaperHeight;
+ FOrientation := frxPrinters.Printer.DefOrientation;
+
+ UpdateDimensions;
+end;
+
+procedure TfrxReportPage.AlignChildren;
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ Width := (FPaperWidth - FLeftMargin - FRightMargin) * fr01cm;
+ Height := (FPaperHeight - FTopMargin - FBottomMargin) * fr01cm;
+ inherited;
+ for i := 0 to Objects.Count - 1 do
+ begin
+ c := Objects[i];
+ if c is TfrxBand then
+ begin
+ if TfrxBand(c).Vertical then
+ c.Height := (FPaperHeight - FTopMargin - FBottomMargin) * fr01cm - c.Top
+ else
+ if (Columns > 1) and not((c is TfrxNullBand) or (c is TfrxReportSummary) or
+ (c is TfrxPageHeader) or (c is TfrxPageFooter) or
+ (c is TfrxReportTitle) or (c is TfrxOverlay)) then
+ c.Width := ColumnWidth * fr01cm
+ else
+ c.Width := Width - c.Left;
+ c.AlignChildren;
+ end;
+ end;
+ UpdateDimensions;
+end;
+
+
+{ TfrxDataPage }
+
+constructor TfrxDataPage.Create(AOwner: TComponent);
+begin
+ inherited;
+ Width := 1000;
+ Height := 1000;
+end;
+
+class function TfrxDataPage.GetDescription: String;
+begin
+ Result := frxResources.Get('obDataPage');
+end;
+
+
+{ TfrxEngineOptions }
+
+constructor TfrxEngineOptions.Create;
+begin
+ Clear;
+ FMaxMemSize := 10;
+ FPrintIfEmpty := True;
+ FSilentMode := simMessageBoxes;
+ FEnableThreadSafe := False;
+ FTempDir := '';
+ FUseGlobalDataSetList := True;
+ FUseFileCache := False;
+ FDestroyForms := True;
+end;
+
+procedure TfrxEngineOptions.Assign(Source: TPersistent);
+begin
+ if Source is TfrxEngineOptions then
+ begin
+ FConvertNulls := TfrxEngineOptions(Source).ConvertNulls;
+ FDoublePass := TfrxEngineOptions(Source).DoublePass;
+ FMaxMemSize := TfrxEngineOptions(Source).MaxMemSize;
+ FPrintIfEmpty := TfrxEngineOptions(Source).PrintIfEmpty;
+ NewSilentMode := TfrxEngineOptions(Source).NewSilentMode;
+ FTempDir := TfrxEngineOptions(Source).TempDir;
+ FUseFileCache := TfrxEngineOptions(Source).UseFileCache;
+ FIgnoreDevByZero := TfrxEngineOptions(Source).IgnoreDevByZero;
+ end;
+end;
+
+procedure TfrxEngineOptions.Clear;
+begin
+ FConvertNulls := True;
+ FIgnoreDevByZero := False;
+ FDoublePass := False;
+end;
+
+procedure TfrxEngineOptions.SetSilentMode(Mode: Boolean);
+begin
+ if Mode = True then
+ FSilentMode := simSilent
+ else
+ FSilentMode := simMessageBoxes;
+end;
+
+function TfrxEngineOptions.GetSilentMode: Boolean;
+begin
+ if FSilentMode = simSilent then
+ Result := True
+ else
+ Result := False;
+end;
+
+
+{ TfrxPreviewOptions }
+
+constructor TfrxPreviewOptions.Create;
+begin
+ Clear;
+ FAllowEdit := True;
+ FButtons := [pbPrint, pbLoad, pbSave, pbExport, pbZoom, pbFullScreen,
+ pbOutline, pbThumbnails, pbPageSetup, pbEdit, pbNavigator, pbClose];
+ FDoubleBuffered := True;
+ FMaximized := True;
+ FMDIChild := False;
+ FModal := True;
+ FPagesInCache := 50;
+ FShowCaptions := False;
+ FZoom := 1;
+ FZoomMode := zmDefault;
+ FPictureCacheInFile := False;
+ FMaxPagePictureWidth := 1600;
+ FMaxPagePictureHeight := 1200;
+{$IFDEF DELPHI19}
+ FPagesInPictureCache := False;
+{$ELSE}
+ FPagesInPictureCache := True;
+{$ENDIF}
+end;
+
+procedure TfrxPreviewOptions.Assign(Source: TPersistent);
+begin
+ if Source is TfrxPreviewOptions then
+ begin
+ FAllowEdit := TfrxPreviewOptions(Source).AllowEdit;
+ FButtons := TfrxPreviewOptions(Source).Buttons;
+ FDoubleBuffered := TfrxPreviewOptions(Source).DoubleBuffered;
+ FMaximized := TfrxPreviewOptions(Source).Maximized;
+ FMDIChild := TfrxPreviewOptions(Source).MDIChild;
+ FModal := TfrxPreviewOptions(Source).Modal;
+ FOutlineExpand := TfrxPreviewOptions(Source).OutlineExpand;
+ FOutlineVisible := TfrxPreviewOptions(Source).OutlineVisible;
+ FOutlineWidth := TfrxPreviewOptions(Source).OutlineWidth;
+ FPagesInCache := TfrxPreviewOptions(Source).PagesInCache;
+ FShowCaptions := TfrxPreviewOptions(Source).ShowCaptions;
+ FThumbnailVisible := TfrxPreviewOptions(Source).ThumbnailVisible;
+ FZoom := TfrxPreviewOptions(Source).Zoom;
+ FZoomMode := TfrxPreviewOptions(Source).ZoomMode;
+ FPictureCacheInFile := TfrxPreviewOptions(Source).PictureCacheInFile;
+ FRTLPreview := TfrxPreviewOptions(Source).RTLPreview;
+ end;
+end;
+
+procedure TfrxPreviewOptions.Clear;
+begin
+ FOutlineExpand := True;
+ FOutlineVisible := False;
+ FOutlineWidth := 120;
+ FPagesInCache := 50;
+ FThumbnailVisible := False;
+end;
+
+
+{ TfrxPrintOptions }
+
+constructor TfrxPrintOptions.Create;
+begin
+ Clear;
+end;
+
+procedure TfrxPrintOptions.Assign(Source: TPersistent);
+begin
+ if Source is TfrxPrintOptions then
+ begin
+ FCopies := TfrxPrintOptions(Source).Copies;
+ FCollate := TfrxPrintOptions(Source).Collate;
+ FPageNumbers := TfrxPrintOptions(Source).PageNumbers;
+ FPrinter := TfrxPrintOptions(Source).Printer;
+ FPrintMode := TfrxPrintOptions(Source).PrintMode;
+ FPrintOnSheet := TfrxPrintOptions(Source).PrintOnSheet;
+ FPrintPages := TfrxPrintOptions(Source).PrintPages;
+ FReverse := TfrxPrintOptions(Source).Reverse;
+ FShowDialog := TfrxPrintOptions(Source).ShowDialog;
+ FSplicingLine := TfrxPrintOptions(Source).SplicingLine;
+ end;
+end;
+
+procedure TfrxPrintOptions.Clear;
+begin
+ FCopies := 1;
+ FCollate := True;
+ FPageNumbers := '';
+ FPagesOnSheet := 0;
+ FPrinter := frxResources.Get('prDefault');
+ FPrintMode := pmDefault;
+ FPrintOnSheet := 0;
+ FPrintPages := ppAll;
+ FReverse := False;
+ FShowDialog := True;
+ FSplicingLine := 3;
+ FDuplex := dmNone;
+end;
+
+
+{ TfrxReportOptions }
+
+constructor TfrxReportOptions.Create;
+begin
+ FDescription := TStringList.Create;
+ FPicture := TBitmap.Create(0, 0);
+ FCreateDate := Now;
+ FLastChange := Now;
+ FPrevPassword := '';
+ FInfo := False;
+ FIsFMXReport := True;
+end;
+
+destructor TfrxReportOptions.Destroy;
+begin
+ FDescription.Free;
+ FPicture.Free;
+ inherited;
+end;
+
+procedure TfrxReportOptions.Assign(Source: TPersistent);
+begin
+ if Source is TfrxReportOptions then
+ begin
+ FAuthor := TfrxReportOptions(Source).Author;
+ FCompressed := TfrxReportOptions(Source).Compressed;
+ FCreateDate := TfrxReportOptions(Source).CreateDate;
+ Description := TfrxReportOptions(Source).Description;
+ FInitString := TfrxReportOptions(Source).InitString;
+ FLastChange := TfrxReportOptions(Source).LastChange;
+ FName := TfrxReportOptions(Source).Name;
+ FPassword := TfrxReportOptions(Source).Password;
+ Picture := TfrxReportOptions(Source).Picture;
+ FVersionBuild := TfrxReportOptions(Source).VersionBuild;
+ FVersionMajor := TfrxReportOptions(Source).VersionMajor;
+ FVersionMinor := TfrxReportOptions(Source).VersionMinor;
+ FVersionRelease := TfrxReportOptions(Source).VersionRelease;
+ end;
+end;
+
+procedure TfrxReportOptions.Clear;
+begin
+ if not FInfo then
+ begin
+ FPicture.Free;
+ FAuthor := '';
+ FCompressed := False;
+ FCreateDate := Now;
+ FDescription.Clear;
+ FLastChange := Now;
+ FPicture := TBitmap.Create(0, 0);
+ FVersionBuild := '';
+ FVersionMajor := '';
+ FVersionMinor := '';
+ FVersionRelease := '';
+ end;
+ FConnectionName := '';
+ FInitString := '';
+ FName := '';
+ FPassword := '';
+ FPrevPassword := '';
+end;
+
+procedure TfrxReportOptions.SetDescription(const Value: TStrings);
+begin
+ FDescription.Assign(Value);
+end;
+
+procedure TfrxReportOptions.SetPicture(const Value: TBitmap);
+begin
+ FPicture.Assign(Value);
+end;
+
+function TfrxReportOptions.CheckPassword: Boolean;
+begin
+ Result := True;
+ if (FPassword <> '') and (FPassword <> FPrevPassword) and (FPassword <> HiddenPassword) then
+ with TfrxPasswordForm.Create(Application) do
+ begin
+ if (ShowModal <> mrOk) or (FPassword <> PasswordE.Text) then
+ begin
+ Result := False;
+ FReport.Errors.Add(frxResources.Get('Invalid password'));
+ frxCommonErrorHandler(FReport, frxResources.Get('clErrors') + #13#10 + FReport.Errors.Text);
+ end
+ else
+ FPrevPassword := FPassword;
+ Free;
+ end;
+end;
+
+
+{ TfrxDataSetItem }
+
+procedure TfrxDataSetItem.SetDataSet(const Value: TfrxDataSet);
+begin
+ FDataSet := Value;
+ if FDataSet = nil then
+ FDataSetName := '' else
+ FDataSetName := FDataSet.UserName;
+end;
+
+procedure TfrxDataSetItem.SetDataSetName(const Value: String);
+begin
+ FDataSetName := Value;
+ if FDataSetName = '' then
+ FDataSet := nil
+ else if TfrxReportDataSets(Collection).FReport <> nil then
+ FDataSet := TfrxReportDataSets(Collection).FReport.FindDataSet(FDataSet, FDataSetName);
+end;
+
+function TfrxDataSetItem.GetDataSetName: String;
+begin
+ if FDataSet = nil then
+ Result := FDataSetName else
+ Result := FDataSet.UserName;
+end;
+
+
+{ TfrxReportDatasets }
+
+constructor TfrxReportDatasets.Create(AReport: TfrxReport);
+begin
+ inherited Create(TfrxDatasetItem);
+ FReport := AReport;
+end;
+
+procedure TfrxReportDataSets.Initialize;
+var
+ i: Integer;
+begin
+ for i := 0 to Count - 1 do
+ if Items[i].DataSet <> nil then
+ begin
+ Items[i].DataSet.ReportRef := FReport;
+ Items[i].DataSet.Initialize;
+ end;
+end;
+
+procedure TfrxReportDataSets.Finalize;
+var
+ i: Integer;
+begin
+ for i := 0 to Count - 1 do
+ if Items[i].DataSet <> nil then
+ Items[i].DataSet.Finalize;
+end;
+
+procedure TfrxReportDatasets.Add(ds: TfrxDataSet);
+begin
+ TfrxDatasetItem(inherited Add).DataSet := ds;
+end;
+
+function TfrxReportDatasets.GetItem(Index: Integer): TfrxDatasetItem;
+begin
+ Result := TfrxDatasetItem(inherited Items[Index]);
+end;
+
+function TfrxReportDatasets.Find(ds: TfrxDataSet): TfrxDatasetItem;
+var
+ i: Integer;
+begin
+ Result := nil;
+ for i := 0 to Count - 1 do
+ if Items[i].DataSet = ds then
+ begin
+ Result := Items[i];
+ Exit;
+ end;
+end;
+
+function TfrxReportDatasets.Find(const Name: String): TfrxDatasetItem;
+var
+ i: Integer;
+begin
+ Result := nil;
+ for i := 0 to Count - 1 do
+ if Items[i].DataSet <> nil then
+ if CompareText(Items[i].DataSet.UserName, Name) = 0 then
+ begin
+ Result := Items[i];
+ Exit;
+ end;
+end;
+
+procedure TfrxReportDatasets.Delete(const Name: String);
+var
+ i: Integer;
+begin
+ for i := 0 to Count - 1 do
+ if Items[i].DataSet <> nil then
+ if CompareText(Items[i].DataSet.UserName, Name) = 0 then
+ begin
+ Items[i].Free;
+ Exit;
+ end;
+end;
+
+{ TfrxStyleItem }
+
+constructor TfrxStyleItem.Create(Collection: TCollection);
+begin
+ inherited;
+ FColor := claNull;
+ FFont := TfrxFont.Create;
+ with FFont do
+ begin
+ Name := DefFontName;
+ Size := DefFontSize;
+ end;
+ FFrame := TfrxFrame.Create;
+end;
+
+destructor TfrxStyleItem.Destroy;
+begin
+ FFont.Free;
+ FFrame.Free;
+ inherited;
+end;
+
+procedure TfrxStyleItem.Assign(Source: TPersistent);
+begin
+ if Source is TfrxStyleItem then
+ begin
+ FName := TfrxStyleItem(Source).Name;
+ FColor := TfrxStyleItem(Source).Color;
+ FFont.Assign(TfrxStyleItem(Source).Font);
+ FFrame.Assign(TfrxStyleItem(Source).Frame);
+ end;
+end;
+
+procedure TfrxStyleItem.SetFont(const Value: TfrxFont);
+begin
+ FFont.Assign(Value);
+end;
+
+procedure TfrxStyleItem.SetFrame(const Value: TfrxFrame);
+begin
+ FFrame.Assign(Value);
+end;
+
+procedure TfrxStyleItem.SetName(const Value: String);
+var
+ Item: TfrxStyleItem;
+begin
+ Item := TfrxStyles(Collection).Find(Value);
+ if (Item = nil) or (Item = Self) then
+ FName := Value else
+ raise Exception.Create(frxResources.Get('clDupName'));
+end;
+
+procedure TfrxStyleItem.CreateUniqueName;
+var
+ i: Integer;
+begin
+ i := 1;
+ while TfrxStyles(Collection).Find('Style' + IntToStr(i)) <> nil do
+ Inc(i);
+ Name := 'Style' + IntToStr(i);
+end;
+
+
+{ TfrxStyles }
+
+constructor TfrxStyles.Create(AReport: TfrxReport);
+begin
+ inherited Create(TfrxStyleItem);
+ FReport := AReport;
+end;
+
+function TfrxStyles.Add: TfrxStyleItem;
+begin
+ Result := TfrxStyleItem(inherited Add);
+end;
+
+function TfrxStyles.Find(const Name: String): TfrxStyleItem;
+var
+ i: Integer;
+begin
+ Result := nil;
+ for i := 0 to Count - 1 do
+ if frxCompareText(Items[i].Name, Name) = 0 then
+ begin
+ Result := Items[i];
+ break;
+ end;
+end;
+
+function TfrxStyles.GetItem(Index: Integer): TfrxStyleItem;
+begin
+ Result := TfrxStyleItem(inherited Items[Index]);
+end;
+
+procedure TfrxStyles.GetList(List: TStrings);
+var
+ i: Integer;
+begin
+ List.Clear;
+ for i := 0 to Count - 1 do
+ List.Add(Items[i].Name);
+end;
+
+procedure TfrxStyles.LoadFromXMLItem(Item: TfrxXMLItem; OldXMLFormat: Boolean);
+var
+ xs: TfrxXMLSerializer;
+ i: Integer;
+begin
+ Clear;
+ xs := TfrxXMLSerializer.Create(nil);
+ try
+ xs.OldFormat := OldXMLFormat;
+ Name := Item.Prop['Name'];
+ for i := 0 to Item.Count - 1 do
+ if CompareText(Item[i].Name, 'item') = 0 then
+ xs.XMLToObj(Item[i].Text, Add);
+ finally
+ xs.Free;
+ end;
+
+ Apply;
+end;
+
+procedure TfrxStyles.SaveToXMLItem(Item: TfrxXMLItem);
+var
+ xi: TfrxXMLItem;
+ xs: TfrxXMLSerializer;
+ i: Integer;
+begin
+ xs := TfrxXMLSerializer.Create(nil);
+ try
+ Item.Name := 'style';
+ Item.Prop['Name'] := Name;
+ for i := 0 to Count - 1 do
+ begin
+ xi := Item.Add;
+ xi.Name := 'item';
+ xi.Text := xs.ObjToXML(Items[i]);
+ end;
+ finally
+ xs.Free;
+ end;
+end;
+
+procedure TfrxStyles.LoadFromFile(const FileName: String);
+var
+ f: TFileStream;
+begin
+ f := TFileStream.Create(FileName, fmOpenRead);
+ try
+ LoadFromStream(f);
+ finally
+ f.Free;
+ end;
+end;
+
+procedure TfrxStyles.LoadFromStream(Stream: TStream);
+var
+ x: TfrxXMLDocument;
+begin
+ Clear;
+ x := TfrxXMLDocument.Create;
+ try
+ x.LoadFromStream(Stream);
+ if CompareText(x.Root.Name, 'style') = 0 then
+ LoadFromXMLItem(x.Root, x.OldVersion);
+ finally
+ x.Free;
+ end;
+end;
+
+procedure TfrxStyles.SaveToFile(const FileName: String);
+var
+ f: TFileStream;
+begin
+ f := TFileStream.Create(FileName, fmCreate);
+ try
+ SaveToStream(f);
+ finally
+ f.Free;
+ end;
+end;
+
+procedure TfrxStyles.SaveToStream(Stream: TStream);
+var
+ x: TfrxXMLDocument;
+begin
+ x := TfrxXMLDocument.Create;
+ x.AutoIndent := True;
+ try
+ x.Root.Name := 'style';
+ SaveToXMLItem(x.Root);
+ x.SaveToStream(Stream);
+ finally
+ x.Free;
+ end;
+end;
+
+procedure TfrxStyles.Apply;
+var
+ i: Integer;
+ l: TList;
+begin
+ if FReport <> nil then
+ begin
+ l := FReport.AllObjects;
+ for i := 0 to l.Count - 1 do
+ if TObject(l[i]) is TfrxCustomMemoView then
+ if Find(TfrxCustomMemoView(l[i]).Style) = nil then
+ TfrxCustomMemoView(l[i]).Style := ''
+ else
+ TfrxCustomMemoView(l[i]).Style := TfrxCustomMemoView(l[i]).Style;
+ end;
+end;
+
+
+{ TfrxStyleSheet }
+
+constructor TfrxStyleSheet.Create;
+begin
+ FItems := TList.Create;
+end;
+
+destructor TfrxStyleSheet.Destroy;
+begin
+ Clear;
+ FItems.Free;
+ inherited;
+end;
+
+procedure TfrxStyleSheet.Clear;
+begin
+ while Count > 0 do
+ Delete(0);
+end;
+
+procedure TfrxStyleSheet.Delete(Index: Integer);
+begin
+ Items[Index].Free;
+ FItems.Delete(Index);
+end;
+
+function TfrxStyleSheet.Add: TfrxStyles;
+begin
+ Result := TfrxStyles.Create(nil);
+ FItems.Add(Result);
+end;
+
+function TfrxStyleSheet.Count: Integer;
+begin
+ Result := FItems.Count;
+end;
+
+function TfrxStyleSheet.GetItems(Index: Integer): TfrxStyles;
+begin
+ Result := FItems[Index];
+end;
+
+function TfrxStyleSheet.Find(const Name: String): TfrxStyles;
+var
+ i: Integer;
+begin
+ Result := nil;
+ for i := 0 to Count - 1 do
+ if frxCompareText(Items[i].Name, Name) = 0 then
+ begin
+ Result := Items[i];
+ break;
+ end;
+end;
+
+function TfrxStyleSheet.IndexOf(const Name: String): Integer;
+var
+ i: Integer;
+begin
+ Result := -1;
+ for i := 0 to Count - 1 do
+ if frxCompareText(Items[i].Name, Name) = 0 then
+ begin
+ Result := i;
+ break;
+ end;
+end;
+
+procedure TfrxStyleSheet.GetList(List: TStrings);
+var
+ i: Integer;
+begin
+ List.Clear;
+ for i := 0 to Count - 1 do
+ List.Add(Items[i].Name);
+end;
+
+procedure TfrxStyleSheet.LoadFromFile(const FileName: String);
+var
+ f: TFileStream;
+begin
+ f := TFileStream.Create(FileName, fmOpenRead);
+ try
+ LoadFromStream(f);
+ finally
+ f.Free;
+ end;
+end;
+
+procedure TfrxStyleSheet.LoadFromStream(Stream: TStream);
+var
+ x: TfrxXMLDocument;
+ i: Integer;
+begin
+ Clear;
+ x := TfrxXMLDocument.Create;
+ try
+ x.LoadFromStream(Stream);
+ if CompareText(x.Root.Name, 'stylesheet') = 0 then
+ for i := 0 to x.Root.Count - 1 do
+ if CompareText(x.Root[i].Name, 'style') = 0 then
+ Add.LoadFromXMLItem(x.Root[i], x.OldVersion);
+ finally
+ x.Free;
+ end;
+end;
+
+procedure TfrxStyleSheet.SaveToFile(const FileName: String);
+var
+ f: TFileStream;
+begin
+ f := TFileStream.Create(FileName, fmCreate);
+ try
+ SaveToStream(f);
+ finally
+ f.Free;
+ end;
+end;
+
+procedure TfrxStyleSheet.SaveToStream(Stream: TStream);
+var
+ x: TfrxXMLDocument;
+ i: Integer;
+begin
+ x := TfrxXMLDocument.Create;
+ x.AutoIndent := True;
+ try
+ x.Root.Name := 'stylesheet';
+ for i := 0 to Count - 1 do
+ Items[i].SaveToXMLItem(x.Root.Add);
+
+ x.SaveToStream(Stream);
+ finally
+ x.Free;
+ end;
+end;
+
+
+{ TfrxReport }
+
+constructor TfrxReport.Create(AOwner: TComponent);
+begin
+ inherited;
+{$IFNDEF MSWINDOWS}
+{$IFDEF DELPHI17}
+ FRAppService := nil;
+{$ENDIF}
+{$ENDIF}
+ FVersion := FR_VERSION;
+ FDatasets := TfrxReportDatasets.Create(Self);
+ FVariables := TfrxVariables.Create;
+ FScript := TfsScript.Create(nil);
+ FScript.ExtendedCharset := True;
+ FScript.AddRTTI;
+
+ FTimer := TTimer.Create(nil);
+ FTimer.Interval := 50;
+ FTimer.Enabled := False;
+ FTimer.OnTimer := OnTimer;
+
+ FEngineOptions := TfrxEngineOptions.Create;
+ FPreviewOptions := TfrxPreviewOptions.Create;
+ FPrintOptions := TfrxPrintOptions.Create;
+ FReportOptions := TfrxReportOptions.Create(Self);
+ FReportOptions.FReport := Self;
+
+ FIniFile := '';
+ FScriptText := TStringList.Create;
+ FFakeScriptText := TStringList.Create;
+ FExpressionCache := TfrxExpressionCache.Create(FScript);
+ FErrors := TStringList.Create;
+ TStringList(FErrors).Sorted := True;
+ TStringList(FErrors).Duplicates := dupIgnore;
+ FStyles := TfrxStyles.Create(Self);
+ FSysVariables := TStringList.Create;
+ FEnabledDataSets := TfrxReportDataSets.Create(Self);
+ FShowProgress := True;
+ FStoreInDFM := True;
+ FOldStyleProgress := True;
+
+ FEngine := TfrxEngine.Create(Self);
+ FPreviewPages := TfrxPreviewPages.Create(Self);
+ FEngine.FPreviewPages := FPreviewPages;
+ FPreviewPages.FEngine := FEngine;
+ FDrillState := TStringList.Create;
+ FDrawBitmap := TBitmap.Create(1, 1);
+ Clear;
+end;
+
+destructor TfrxReport.Destroy;
+begin
+ inherited;
+ if FPreviewForm <> nil then
+ FPreviewForm.Close;
+ Preview := nil;
+ if FParentReportObject <> nil then
+ FParentReportObject.Free;
+ FDatasets.Free;
+ FEngineOptions.Free;
+ FPreviewOptions.Free;
+ FPrintOptions.Free;
+ FReportOptions.Free;
+ FExpressionCache.Free;
+ FScript.Free;
+ FScriptText.Free;
+ FFakeScriptText.Free;
+ FVariables.Free;
+ FEngine.Free;
+ FPreviewPages.Free;
+ FErrors.Free;
+ FStyles.Free;
+ FSysVariables.Free;
+ FEnabledDataSets.Free;
+ FTimer.Free;
+ TObject(FDrawText).Free;
+ FDrillState.Free;
+ FreeAndNil(FDrawBitmap);
+ if FParentForm <> nil then
+ FParentForm.Free;
+end;
+
+class function TfrxReport.GetDescription: String;
+begin
+ Result := frxResources.Get('obReport');
+end;
+
+function TfrxReport.GetDrawBitmap: TBitmap;
+begin
+ Result := FDrawBitmap;
+end;
+
+procedure TfrxReport.DoClear;
+begin
+ inherited Clear;
+ FDataSets.Clear;
+ FVariables.Clear;
+ FEngineOptions.Clear;
+ FPreviewOptions.Clear;
+ FPrintOptions.Clear;
+ FReportOptions.Clear;
+ FStyles.Clear;
+ FDataSet := nil;
+ FDataSetName := '';
+ FDotMatrixReport := False;
+ ParentReport := '';
+
+ FScriptLanguage := 'PascalScript';
+ with FScriptText do
+ begin
+ Clear;
+ Add('begin');
+ Add('');
+ Add('end.');
+ end;
+
+ with FSysVariables do
+ begin
+ Clear;
+ Add('Date');
+ Add('Time');
+ Add('Page');
+ Add('Page#');
+ Add('TotalPages');
+ Add('TotalPages#');
+ Add('Line');
+ Add('Line#');
+ Add('CopyName#');
+ end;
+
+ FOnRunDialogs := '';
+ FOnStartReport := '';
+ FOnStopReport := '';
+end;
+
+procedure TfrxReport.Clear;
+begin
+ DoClear;
+end;
+
+procedure TfrxReport.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if Operation = opRemove then
+ if AComponent is TfrxDataSet then
+ begin
+ if FDataSets.Find(TfrxDataSet(AComponent)) <> nil then
+ FDataSets.Find(TfrxDataSet(AComponent)).Free;
+ if FDataset = AComponent then
+ FDataset := nil;
+ if Designer <> nil then
+ Designer.UpdateDataTree;
+ end
+ else if AComponent is TfrxCustomPreview then
+ if FPreview = AComponent then
+ FPreview := nil;
+end;
+
+procedure TfrxReport.AncestorNotFound(Reader: TReader; const ComponentName: string;
+ ComponentClass: TPersistentClass; var Component: TComponent);
+begin
+ Component := FindObject(ComponentName);
+end;
+
+procedure TfrxReport.AppHandleMessage;
+{$IFDEF DELPHI17}
+{$IFNDEF MSWINDOWS}
+{$IFDEF MACOS}
+var
+ AutoReleasePool: NSAutoreleasePool;
+ NSApp: NSApplication;
+ TimeoutDate: NSDate;
+ LEvent: NSEvent;
+{$ENDIF}
+{$ENDIF}
+{$ENDIF}
+begin
+ if not EngineOptions.EnableThreadSafe then
+ begin
+{$IFDEF DELPHI17}
+{$IFDEF MSWINDOWS}
+ Application.ProcessMessages;
+{$ELSE}
+{$IFDEF MACOS}
+
+{$IFDEF DELPHI27}
+ if GlobalUseMetal then Exit; // TODO: not implemented
+{$ENDIF}
+ // starts from XE5 ProcessMessages under mac has interval delay with 0.1 seconds
+ // and ProcessMessages cycle can't be used for synchronization anymore - cause very long delays
+ // reported to Embarcadero, but bug still present
+ AutoReleasePool := TNSAutoreleasePool.Alloc;
+ try
+ AutoReleasePool.init;
+ NSApp := TNSApplication.Wrap(TNSApplication.OCClass.sharedApplication);
+ TimeoutDate := TNSDate.Wrap(TNSDate.OCClass.dateWithTimeIntervalSinceNow(0));
+ LEvent := NSApp.nextEventMatchingMask(NSAnyEventMask, TimeoutDate, NSDefaultRunLoopMode, True);
+ if LEvent <> nil then
+ NSApp.sendEvent(LEvent);
+ finally
+ AutoReleasePool.release;
+ end;
+{$ENDIF}
+{$ENDIF}
+{$ELSE}
+ Application.ProcessMessages;
+{$ENDIF}
+ end;
+end;
+
+procedure TfrxReport.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ if (csWriting in ComponentState) and not FStoreInDFM then Exit;
+
+ Filer.DefineProperty('Datasets', ReadDatasets, WriteDatasets, True);
+ Filer.DefineProperty('Variables', ReadVariables, WriteVariables, True);
+ Filer.DefineProperty('Style', ReadStyle, WriteStyle, True);
+ if Filer is TReader then
+ TReader(Filer).OnAncestorNotFound := AncestorNotFound;
+end;
+
+procedure TfrxReport.ReadDatasets(Reader: TReader);
+begin
+ frxReadCollection(FDatasets, Reader, Self);
+end;
+
+procedure TfrxReport.ReadStyle(Reader: TReader);
+begin
+ frxReadCollection(FStyles, Reader, Self);
+end;
+
+procedure TfrxReport.ReadVariables(Reader: TReader);
+begin
+ frxReadCollection(FVariables, Reader, Self);
+end;
+
+procedure TfrxReport.WriteDatasets(Writer: TWriter);
+begin
+ frxWriteCollection(FDatasets, Writer, Self);
+end;
+
+procedure TfrxReport.WriteStyle(Writer: TWriter);
+begin
+ frxWriteCollection(FStyles, Writer, Self);
+end;
+
+procedure TfrxReport.WriteVariables(Writer: TWriter);
+begin
+ frxWriteCollection(FVariables, Writer, Self);
+end;
+
+function TfrxReport.GetPages(Index: Integer): TfrxPage;
+begin
+ Result := TfrxPage(Objects[Index]);
+end;
+
+function TfrxReport.GetPagesCount: Integer;
+begin
+ Result := Objects.Count;
+end;
+
+procedure TfrxReport.SetScriptText(const Value: TStrings);
+begin
+ FScriptText.Assign(Value);
+end;
+
+procedure TfrxReport.SetEngineOptions(const Value: TfrxEngineOptions);
+begin
+ FEngineOptions.Assign(Value);
+end;
+
+procedure TfrxReport.SetParentReport(const Value: String);
+var
+ i: Integer;
+ list: TList;
+ c: TfrxComponent;
+ fName, SaveFileName: String;
+ SaveXMLSerializer: TObject;
+begin
+ FParentReport := Value;
+ if FParentReportObject <> nil then
+ begin
+ FParentReportObject.Free;
+ FParentReportObject := nil;
+ end;
+ if Value = '' then
+ begin
+ list := AllObjects;
+ for i := 0 to list.Count - 1 do
+ begin
+ c := list[i];
+ c.FAncestor := False;
+ end;
+
+ FAncestor := False;
+ Exit;
+ end;
+
+ SaveFileName := FFileName;
+ SaveXMLSerializer := FXMLSerializer;
+ if Assigned(FOnLoadTemplate) then
+ FOnLoadTemplate(Self, Value)
+ else
+ begin
+ fName := Value;
+ { check relative path, exclude network path }
+ if (Length(fName) > 1) and (fName[2] <> ':')
+ and not ((fName[1] = '\') and (fName[2] = '\')) then
+ begin
+ fName := ExtractFilePath(SaveFileName) + Value;
+ if not FileExists(fName) then
+ fName := GetApplicationFolder + Value;
+ end;
+ LoadFromFile(fName);
+ end;
+
+ if FParentReportObject <> nil then
+ FParentReportObject.Free;
+ FParentReportObject := TfrxReport.Create(nil);
+ FParentReportObject.FileName := FFileName;
+ FParentReportObject.AssignAll(Self);
+ FFileName := SaveFileName;
+
+ for i := 0 to FParentReportObject.Objects.Count - 1 do
+ if TObject(FParentReportObject.Objects[i]) is TfrxReportPage then
+ TfrxReportPage(FParentReportObject.Objects[i]).PaperSize := 256;
+
+ { set ancestor flag for parent objects }
+ list := AllObjects;
+ for i := 0 to list.Count - 1 do
+ begin
+ c := list[i];
+ c.FAncestor := True;
+ end;
+
+ FAncestor := True;
+ FParentReport := Value;
+ FXMLSerializer := SaveXMLSerializer;
+end;
+
+function TfrxReport.InheritFromTemplate(const templName: String; InheriteMode: TfrxInheriteMode = imDefault): Boolean;
+var
+ tempReport: TfrxReport;
+ Ref: TObject;
+ i: Integer;
+ DS: TfrxDataSet;
+ lItem: TfrxFixupItem;
+ l, FixupList: TList;
+ c: TfrxComponent;
+ found, DeleteDuplicates: Boolean;
+ saveScript, OpenQuote, CloseQuote: String;
+ fn1, fn2: String;
+
+ procedure FixNames(OldName, NewName: String);
+ var
+ i: Integer;
+ begin
+ for i := 0 to FixupList.Count - 1 do
+ with TfrxFixupItem(FixupList[i]) do
+ begin
+ if Value = OldName then Value := NewName;
+ end;
+ end;
+
+ procedure EnumObjects(ToParent, FromParent: TfrxComponent);
+ var
+ xs: TfrxXMLSerializer;
+ s, OldName: String;
+ i: Integer;
+ cFrom, cTo, tObj: TfrxComponent;
+ cFromSubPage, cToSubPage: TfrxReportPage;
+ begin
+ xs := TfrxXMLSerializer.Create(nil);
+ { don't serialize ParentReport property! }
+ xs.SerializeDefaultValues := not (ToParent is TfrxReport);
+ if FromParent.Owner is TfrxComponent then
+ xs.Owner := TfrxComponent(FromParent.Owner);
+ s := xs.ObjToXML(FromParent);
+ if ToParent.Owner is TfrxComponent then
+ xs.Owner := TfrxComponent(ToParent.Owner);
+ xs.XMLToObj(s, ToParent);
+ xs.CopyFixupList(FixupList);
+ xs.Free;
+ i := 0;
+ while (i < FromParent.Objects.Count) do
+ begin
+ cFrom := FromParent.Objects[i];
+ cTo := Self.FindObject(cFrom.Name);
+ inc(i);
+
+ if (cTo <> nil) and not (cTo is TfrxPage) then
+ begin
+ { skip duplicate object }
+ if DeleteDuplicates then continue;
+ { set empty name for duplicate object, rename later }
+ OldName := cFrom.Name;
+ cFrom.Name := '';
+ cTo := nil;
+ end;
+
+ if cTo = nil then
+ begin
+ cTo := TfrxComponent(cFrom.NewInstance);
+ cTo.Create(ToParent);
+ if cFrom.Name = '' then
+ begin
+ cTo.CreateUniqueName;
+ tObj := tempReport.FindObject(cTo.Name);
+ if tObj <> nil then
+ begin
+ tObj.Name := '';
+ cFrom.Name := cTo.Name;
+ tObj.CreateUniqueName;
+ end
+ else cFrom.Name := cTo.Name;
+ FixNames(OldName, cTo.Name);
+ if cFrom is TfrxDataSet then
+ begin
+ TfrxDataSet(cFrom).UserName := cFrom.Name;
+ Self.DataSets.Add(TfrxDataSet(cTo));
+ end;
+ end
+ else
+ cTo.Name := cFrom.Name;
+
+ if cFrom is TfrxSubreport then
+ begin
+ cFromSubPage := TfrxSubreport(cFrom).Page;
+ TfrxSubreport(cTo).Page := TfrxReportPage.Create(Self);
+ cToSubPage := TfrxSubreport(cTo).Page;
+ cToSubPage.Assign(cFromSubPage);
+ cToSubPage.CreateUniqueName;
+ EnumObjects(cToSubPage, cFromSubPage);
+ tempReport.Objects.Remove(cFromSubPage);
+ end
+ end;
+ EnumObjects(cTo, cFrom);
+ end;
+ end;
+
+begin
+ Result := True;
+
+ if (Length(FileName) > 1) and ((FileName[1] = '.') or (FileName[1] = '\')) then
+ fn1 := ExpandFileName(FileName)
+ else
+ fn1 := FileName;
+
+ if (Length(templName) > 1) and ((templName[1] = '.') or (templName[1] = '\')) then
+ fn2 := ExpandFileName(templName)
+ else
+ fn2 := templName;
+
+ if fn1 = fn2 then
+ begin
+ Result := False;
+ Exit;
+ end;
+
+ tempReport := TfrxReport.Create(nil);
+ FixupList := TList.Create;
+ tempReport.AssignAll(Self);
+ { load the template }
+ ParentReport := ExtractRelativePath(ExtractFilePath(FileName), templName);
+ { find duplicate objects }
+ found := False;
+ l := tempReport.AllObjects;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if not (c is TfrxPage) and (FindObject(c.Name) <> nil) then
+ begin
+ found := True;
+ break;
+ end;
+ end;
+
+ deleteDuplicates := False;
+ if (found) and (InheriteMode = imDefault) then
+ begin
+ with TfrxInheritErrorForm.Create(nil) do
+ begin
+ Result := ShowModal = mrOk;
+ if Result then
+ deleteDuplicates := DeleteRB.IsChecked;
+ Free;
+ end;
+ end
+ else
+ deleteDuplicates := (InheriteMode = imDelete);
+
+ if Result then
+ begin
+ saveScript := ScriptText.Text;
+ EnumObjects(Self, tempReport);
+
+ if (Script.SyntaxType = 'C++Script') or (Script.SyntaxType = 'JScript') then
+ begin
+ OpenQuote := '/*';
+ CloseQuote := '*/';
+ end
+ else if (Script.SyntaxType = 'BasicScript') then
+ begin
+ OpenQuote := '/\';
+ CloseQuote := '/\';
+ end
+ else if (Script.SyntaxType = 'PascalScript') then
+ begin
+ OpenQuote := '{';
+ CloseQuote := '}';
+ end;
+
+ ScriptText.Add(OpenQuote);
+ ScriptText.Add('**********Script from parent report**********');
+ ScriptText.Text := ScriptText.Text + saveScript;
+ ScriptText.Add(CloseQuote);
+
+ { fixup datasets }
+ for i := 0 to Self.DataSets.Count - 1 do
+ begin
+ DS := Self.FindDataSet(nil, DataSets[i].DataSetName);
+ DataSets[i].DataSet := DS;
+ end;
+
+ { fixup properties}
+ while FixupList.Count > 0 do
+ begin
+ lItem := TfrxFixupItem(FixupList[0]);
+ Ref := Self.FindObject(lItem.Value);
+ if Ref = nil then
+ Ref := frxFindComponent(Self, lItem.Value);
+ if Ref <> nil then
+ SetOrdProp(lItem.Obj, lItem.PropInfo, frxInteger(Ref));
+ lItem.Free;
+ FixupList.Delete(0);
+ end;
+ end
+ else
+ AssignAll(tempReport);
+
+ FixupList.Free;
+ tempReport.Free;
+end;
+
+procedure TfrxReport.SetPreviewOptions(const Value: TfrxPreviewOptions);
+begin
+ FPreviewOptions.Assign(Value);
+end;
+
+procedure TfrxReport.SetPrintOptions(const Value: TfrxPrintOptions);
+begin
+ FPrintOptions.Assign(Value);
+end;
+
+procedure TfrxReport.SetReportOptions(const Value: TfrxReportOptions);
+begin
+ FReportOptions.Assign(Value);
+end;
+
+procedure TfrxReport.SetStyles(const Value: TfrxStyles);
+begin
+ if Value <> nil then
+ begin
+ FStyles.Assign(Value);
+ FStyles.Apply;
+ end
+ else
+ FStyles.Clear;
+end;
+
+procedure TfrxReport.SetDataSet(const Value: TfrxDataSet);
+begin
+ FDataSet := Value;
+ if FDataSet = nil then
+ FDataSetName := '' else
+ FDataSetName := FDataSet.UserName;
+end;
+
+procedure TfrxReport.SetDataSetName(const Value: String);
+begin
+ FDataSetName := Value;
+ FDataSet := FindDataSet(FDataSet, FDataSetName);
+end;
+
+function TfrxReport.GetDataSetName: String;
+begin
+ if FDataSet = nil then
+ Result := FDataSetName else
+ Result := FDataSet.UserName;
+end;
+
+function TfrxReport.Calc(const Expr: String; AScript: TfsScript = nil): Variant;
+var
+ ErrorMsg: String;
+ CalledFromScript: Boolean;
+begin
+ CalledFromScript := False;
+ if frxInteger(AScript) = 1 then
+ begin
+ AScript := FScript;
+ CalledFromScript := True;
+ end;
+ if AScript = nil then
+ AScript := FScript;
+ if not DoGetValue(Expr, Result) then
+ begin
+ Result := FExpressionCache.Calc(Expr, ErrorMsg, AScript);
+ if (ErrorMsg <> '') and
+ not ((ErrorMsg = SZeroDivide) and FEngineOptions.IgnoreDevByZero) then
+ begin
+ if not CalledFromScript then
+ begin
+ if FCurObject <> '' then
+ ErrorMsg := FCurObject + ': ' + ErrorMsg;
+ FErrors.Add(ErrorMsg);
+ end
+ else ErrorMsg := frxResources.Get('clErrorInExp') + ErrorMsg;
+ raise Exception.Create(ErrorMsg);
+ end;
+ end;
+end;
+
+function TfrxReport.GetAlias(DataSet: TfrxDataSet): String;
+var
+ ds: TfrxDataSetItem;
+begin
+ if DataSet = nil then
+ begin
+ Result := '';
+ Exit;
+ end;
+
+ ds := DataSets.Find(DataSet);
+ if ds <> nil then
+ Result := ds.DataSet.UserName else
+ Result := frxResources.Get('clDSNotIncl');
+end;
+
+function TfrxReport.GetDataset(const Alias: String): TfrxDataset;
+var
+ ds: TfrxDataSetItem;
+begin
+ ds := DataSets.Find(Alias);
+ if ds <> nil then
+ Result := ds.DataSet else
+ Result := nil;
+end;
+
+procedure TfrxReport.GetDatasetAndField(const ComplexName: String;
+ var DataSet: TfrxDataSet; var Field: String);
+var
+ i: Integer;
+ s: String;
+begin
+ DataSet := nil;
+ Field := '';
+
+ { ComplexName has format: dataset name."field name"
+ Spaces are allowed in both parts of the complex name }
+ i := Pos('."', ComplexName);
+ if i <> 0 then
+ begin
+ s := Copy(ComplexName, 1, i - 1); { dataset name }
+ DataSet := GetDataSet(s);
+ Field := Copy(ComplexName, i + 2, Length(ComplexName) - i - 2);
+ end;
+end;
+
+procedure TfrxReport.GetDataSetList(List: TStrings; OnlyDB: Boolean = False);
+var
+ i: Integer;
+begin
+ List.Clear;
+ for i := 0 to DataSets.Count - 1 do
+ if Datasets[i].DataSet <> nil then
+ if not OnlyDB or not (DataSets[i].DataSet is TfrxUserDataSet) then
+ List.AddObject(DataSets[i].DataSet.UserName, DataSets[i].DataSet);
+end;
+
+procedure TfrxReport.GetActiveDataSetList(List: TStrings);
+var
+ i: Integer;
+ ds: TfrxDataSet;
+begin
+ if EngineOptions.FUseGlobalDataSetList then
+ frxGetDataSetList(List)
+ else
+ begin
+ List.Clear;
+ for i := 0 to EnabledDataSets.Count - 1 do
+ begin
+ ds := EnabledDataSets[i].DataSet;
+ if ds <> nil then
+ List.AddObject(ds.UserName, ds);
+ end;
+ end;
+end;
+
+procedure TfrxReport.DoLoadFromStream;
+var
+ SaveLeftTop: Longint;
+ Loaded: Boolean;
+begin
+ SaveLeftTop := DesignInfo;
+ Loaded := False;
+ if Assigned(frxConverter.OnLoad) then
+ Loaded := frxConverter.OnLoad(Self, FLoadStream);
+ if not Loaded then
+ inherited LoadFromStream(FLoadStream);
+ if Assigned(frxConverter.OnAfterLoad) then
+ frxConverter.OnAfterLoad(Self);
+ DesignInfo := SaveLeftTop;
+end;
+
+procedure TfrxReport.CheckDataPage;
+var
+ i, x: Integer;
+ l: TList;
+ hasDataPage, hasDataObjects: Boolean;
+ p: TfrxDataPage;
+ c: TfrxComponent;
+begin
+ { check if report has datapage and datacomponents }
+ hasDataPage := False;
+ hasDataObjects := False;
+ l := AllObjects;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if c is TfrxDataPage then
+ hasDataPage := True;
+ if c is TfrxDialogComponent then
+ hasDataObjects := True;
+ end;
+
+ if not hasDataPage then
+ begin
+ { create the datapage }
+ p := TfrxDataPage.Create(Self);
+ if FindObject('Data') = nil then
+ p.Name := 'Data'
+ else
+ p.CreateUniqueName;
+
+ { make it the first page }
+ Objects.Delete(Objects.Count - 1);
+ Objects.Insert(0, p);
+
+ { move existing datacomponents to this page }
+ if hasDataObjects then
+ begin
+ x := 60;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if c is TfrxDialogComponent then
+ begin
+ c.Parent := p;
+ c.Left := x;
+ c.Top := 20;
+ Inc(x, 64);
+ end;
+ end;
+ end;
+ end;
+end;
+
+procedure TfrxReport.LoadFromStream(Stream: TStream);
+var
+ Compressor: TfrxCustomCompressor;
+ Crypter: TfrxCustomCrypter;
+ SaveEngineOptions: TfrxEngineOptions;
+ SavePreviewOptions: TfrxPreviewOptions;
+ SaveConvertNulls: Boolean;
+ SaveIgnoreDevByZero: Boolean;
+ SaveDoublePass: Boolean;
+ SaveOutlineVisible, SaveOutlineExpand: Boolean;
+ SaveOutlineWidth, SavePagesInCache: Integer;
+ SaveIni: String;
+ SavePreview: TfrxCustomPreview;
+ SaveOldStyleProgress, SaveShowProgress, SaveStoreInDFM: Boolean;
+ Crypted, SaveThumbnailVisible: Boolean;
+
+ function DecodePwd(const s: String): String;
+ var
+ i: Integer;
+ begin
+ Result := '';
+ for i := 1 to Length(s) do
+ Result := Result + Chr(Ord(s[i]) + 10);
+ end;
+
+begin
+ FErrors.Clear;
+
+ Compressor := nil;
+ if frxCompressorClass <> nil then
+ begin
+ Compressor := TfrxCustomCompressor(frxCompressorClass.NewInstance);
+ Compressor.Create(nil);
+ Compressor.Report := Self;
+ Compressor.IsFR3File := True;
+ try
+ Compressor.CreateStream;
+ if Compressor.Decompress(Stream) then
+ Stream := Compressor.Stream;
+ except
+ Compressor.Free;
+ FErrors.Add(frxResources.Get('clDecompressError'));
+ frxCommonErrorHandler(Self, frxResources.Get('clErrors') + #13#10 + FErrors.Text);
+ Exit;
+ end;
+ end;
+
+ ReportOptions.Password := ReportOptions.HiddenPassword;
+ Crypter := nil;
+ Crypted := False;
+ if frxCrypterClass <> nil then
+ begin
+ Crypter := TfrxCustomCrypter(frxCrypterClass.NewInstance);
+ Crypter.Create(nil);
+ try
+ Crypter.CreateStream;
+ Crypted := Crypter.Decrypt(Stream, AnsiString(ReportOptions.Password));
+ if Crypted then
+ Stream := Crypter.Stream;
+ except
+ Crypter.Free;
+ FErrors.Add(frxResources.Get('clDecryptError'));
+ frxCommonErrorHandler(Self, frxResources.Get('clErrors') + #13#10 + FErrors.Text);
+ Exit;
+ end;
+ end;
+
+ SaveEngineOptions := TfrxEngineOptions.Create;
+ SaveEngineOptions.Assign(FEngineOptions);
+ SavePreviewOptions := TfrxPreviewOptions.Create;
+ SavePreviewOptions.Assign(FPreviewOptions);
+ SaveIni := FIniFile;
+ SavePreview := FPreview;
+ SaveOldStyleProgress := FOldStyleProgress;
+ SaveShowProgress := FShowProgress;
+ SaveStoreInDFM := FStoreInDFM;
+ FStreamLoaded := True;
+ try
+ FLoadStream := Stream;
+ try
+ DoLoadFromStream;
+ except
+ on E: Exception do
+ begin
+ FStreamLoaded := False;
+ if (E is TfrxInvalidXMLException) and Crypted then
+ FErrors.Add('Invalid password')
+ else
+ FErrors.Add(E.Message)
+ end;
+ end;
+ finally
+ if Compressor <> nil then
+ Compressor.Free;
+ if Crypter <> nil then
+ Crypter.Free;
+
+ CheckDataPage;
+
+ SaveConvertNulls := FEngineOptions.ConvertNulls;
+ SaveIgnoreDevByZero := FEngineOptions.IgnoreDevByZero;
+ SaveDoublePass := FEngineOptions.DoublePass;
+ FEngineOptions.Assign(SaveEngineOptions);
+ FEngineOptions.ConvertNulls := SaveConvertNulls;
+ FEngineOptions.IgnoreDevByZero := SaveIgnoreDevByZero;
+ FEngineOptions.DoublePass := SaveDoublePass;
+ SaveEngineOptions.Free;
+
+ SaveOutlineVisible := FPreviewOptions.OutlineVisible;
+ SaveOutlineWidth := FPreviewOptions.OutlineWidth;
+ SaveOutlineExpand := FPreviewOptions.OutlineExpand;
+ SavePagesInCache := FPreviewOptions.PagesInCache;
+ SaveThumbnailVisible := FPreviewOptions.ThumbnailVisible;
+ FPreviewOptions.Assign(SavePreviewOptions);
+ FPreviewOptions.OutlineVisible := SaveOutlineVisible;
+ FPreviewOptions.OutlineWidth := SaveOutlineWidth;
+ FPreviewOptions.OutlineExpand := SaveOutlineExpand;
+ FPreviewOptions.PagesInCache := SavePagesInCache;
+ FPreviewOptions.ThumbnailVisible := SaveThumbnailVisible;
+ SavePreviewOptions.Free;
+ FIniFile := SaveIni;
+ FPreview := SavePreview;
+ FOldStyleProgress := SaveOldStyleProgress;
+ FShowProgress := SaveShowProgress;
+ FStoreInDFM := SaveStoreInDFM;
+ if not Crypted then
+ ReportOptions.Password := DecodePwd(ReportOptions.Password);
+
+ if ReportOptions.Info or ((not FReloading) and
+ (not FEngineOptions.EnableThreadSafe) and
+ (not Crypted and not FReportOptions.CheckPassword)) then
+
+ Clear
+ else if (FErrors.Count > 0) then
+ frxCommonErrorHandler(Self, frxResources.Get('clErrors') + #13#10 + FErrors.Text);
+ end;
+end;
+
+procedure TfrxReport.SaveToStream(Stream: TStream; SaveChildren: Boolean = True;
+ SaveDefaultValues: Boolean = False; UseGetAncestor: Boolean = False);
+var
+ Compressor: TfrxCustomCompressor;
+ Crypter: TfrxCustomCrypter;
+ StreamTo: TStream;
+ SavePwd: String;
+ SavePreview: TfrxCustomPreview;
+
+ function EncodePwd(const s: String): String;
+ var
+ i: Integer;
+ begin
+ Result := '';
+ for i := 1 to Length(s) do
+ Result := Result + Chr(Ord(s[i]) - 10);
+ end;
+
+begin
+ StreamTo := Stream;
+
+ Compressor := nil;
+ if FReportOptions.Compressed and (frxCompressorClass <> nil) then
+ begin
+ Compressor := TfrxCustomCompressor(frxCompressorClass.NewInstance);
+ Compressor.Create(nil);
+ Compressor.Report := Self;
+ Compressor.IsFR3File := True;
+ Compressor.CreateStream;
+ StreamTo := Compressor.Stream;
+ end;
+
+ Crypter := nil;
+ if (FReportOptions.Password <> '') and (frxCrypterClass <> nil) then
+ begin
+ Crypter := TfrxCustomCrypter(frxCrypterClass.NewInstance);
+ Crypter.Create(nil);
+ Crypter.CreateStream;
+ StreamTo := Crypter.Stream;
+ end;
+
+ SavePwd := ReportOptions.Password;
+ ReportOptions.PrevPassword := SavePwd;
+ if Crypter = nil then
+ ReportOptions.Password := EncodePwd(SavePwd);
+ SavePreview := FPreview;
+ FPreview := nil;
+
+ try
+ inherited SaveToStream(StreamTo, SaveChildren, SaveDefaultValues);
+ finally
+ FPreview := SavePreview;
+ ReportOptions.Password := SavePwd;
+ { crypt }
+ if Crypter <> nil then
+ begin
+ try
+ if Compressor <> nil then
+ Crypter.Crypt(Compressor.Stream, UTF8Encode(ReportOptions.Password))
+ else
+ Crypter.Crypt(Stream, UTF8Encode(ReportOptions.Password));
+ finally
+ Crypter.Free;
+ end;
+ end;
+ { compress }
+ if Compressor <> nil then
+ begin
+ try
+ Compressor.Compress(Stream);
+ finally
+ Compressor.Free;
+ end;
+ end;
+ end;
+end;
+
+function TfrxReport.LoadFromFile(const FileName: String;
+ ExceptionIfNotFound: Boolean = False): Boolean;
+var
+ f: TFileStream;
+begin
+ Clear;
+ FFileName := '';
+ Result := FileExists(FileName);
+ if Result or ExceptionIfNotFound then
+ begin
+ f := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ try
+ FFileName := FileName;
+ LoadFromStream(f);
+
+ finally
+ f.Free;
+ end;
+ end;
+end;
+
+procedure TfrxReport.SaveToFile(const FileName: String);
+var
+ f: TFileStream;
+begin
+ //fix up ParentReport property
+ if (Length(FParentReport) > 1) and (FParentReport[2] = ':') then
+ FParentReport := ExtractRelativePath(ExtractFilePath(FileName), FParentReport);
+ f := TFileStream.Create(FileName, fmCreate);
+ try
+ SaveToStream(f);
+ finally
+ f.Free;
+ end;
+end;
+
+function TfrxReport.GetIniFile: TCustomIniFile;
+var
+ fileName: String;
+begin
+ fileName := FIniFile;
+ if fileName = '' then
+ fileName := GetHomePath + PathDelim + 'FastReportFMX.config';
+ Result := TIniFile.Create(fileName);
+end;
+
+function TfrxReport.GetApplicationFolder: String;
+begin
+ if csDesigning in ComponentState then
+ Result := GetCurrentDir + '\'
+ else
+ Result := GetAppPath;
+end;
+
+procedure TfrxReport.SelectPrinter;
+begin
+ if frxPrinters.IndexOf(FPrintOptions.Printer) <> -1 then
+ frxPrinters.PrinterIndex := frxPrinters.IndexOf(FPrintOptions.Printer);
+end;
+
+procedure TfrxReport.DoNotifyEvent(Obj: TObject; const EventName: String;
+ RunAlways: Boolean = False);
+begin
+{$IFNDEF FR_VER_BASIC}
+ if FEngine.Running or RunAlways then
+ if EventName <> '' then
+ begin
+ FScript.CallFunction(EventName, VarArrayOf([frxInteger(Obj)]));
+ end;
+{$ENDIF}
+end;
+
+procedure TfrxReport.DoParamEvent(const EventName: String; var Params: Variant;
+ RunAlways: Boolean = False);
+begin
+{$IFNDEF FR_VER_BASIC}
+ if FEngine.Running or RunAlways then
+ if EventName <> '' then
+ FScript.CallFunction1(EventName, Params);
+{$ENDIF}
+end;
+
+procedure TfrxReport.DoBeforePrint(c: TfrxReportComponent);
+begin
+ if Assigned(FOnBeforePrint) then
+ FOnBeforePrint(c);
+ DoNotifyEvent(c, c.OnBeforePrint);
+end;
+
+procedure TfrxReport.DoAfterPrint(c: TfrxReportComponent);
+begin
+ if Assigned(FOnAfterPrint) then
+ FOnAfterPrint(c);
+ DoNotifyEvent(c, c.OnAfterPrint);
+end;
+
+procedure TfrxReport.DoPreviewClick(v: TfrxView; Button: TMouseButton;
+ Shift: TShiftState; var Modified: Boolean; DblClick: Boolean);
+var
+ arr: Variant;
+begin
+ arr := VarArrayOf([frxInteger(v), Button, ShiftToByte(Shift), Modified]);
+ if DblClick then
+ DoParamEvent(v.OnPreviewDblClick, arr, True)
+ else
+ DoParamEvent(v.OnPreviewClick, arr, True);
+ Modified := arr[3];
+ if DblClick then
+ begin
+ if Assigned(FOnDblClickObject) then
+ FOnDblClickObject(v, Button, Shift, Modified)
+ end
+ else
+ if Assigned(FOnClickObject) then
+ FOnClickObject(v, Button, Shift, Modified);
+end;
+
+procedure TfrxReport.DoGetAncestor(const Name: String; var Ancestor: TPersistent);
+begin
+ if FParentReportObject <> nil then
+ begin
+ if Name = Self.Name then
+ Ancestor := FParentReportObject
+ else
+ Ancestor := FParentReportObject.FindObject(Name);
+ end;
+end;
+
+function TfrxReport.DoGetValue(const Expr: String; var Value: Variant): Boolean;
+var
+ i: Integer;
+ ds: TfrxDataSet;
+ fld: String;
+ val: Variant;
+ v: TfsCustomVariable;
+begin
+ Result := False;
+ Value := Null;
+
+ { maybe it's a dataset/field? }
+ GetDataSetAndField(Expr, ds, fld);
+ if (ds <> nil) and (fld <> '') then
+ begin
+ Value := ds.Value[fld];
+ if FEngineOptions.ConvertNulls and (Value = Null) then
+ case ds.FieldType[fld] of
+ fftNumeric:
+ Value := 0;
+ fftString:
+ Value := '';
+ fftBoolean:
+ Value := False;
+ end;
+ Result := True;
+ Exit;
+ end;
+
+ { searching in the sys variables }
+ i := FSysVariables.IndexOf(Expr);
+ if i <> -1 then
+ begin
+ case i of
+ 0: Value := FEngine.StartDate; { Date }
+ 1: Value := FEngine.StartTime; { Time }
+ 2: Value := FPreviewPages.GetLogicalPageNo; { Page }
+ 3: Value := FPreviewPages.CurPage + 1; { Page# }
+ 4: Value := FPreviewPages.GetLogicalTotalPages; { TotalPages }
+ 5: Value := FEngine.TotalPages; { TotalPages# }
+ 6: Value := FEngine.CurLine; { Line }
+ 7: Value := FEngine.CurLineThrough; { Line# }
+ 8: Value := frxGlobalVariables['CopyName0'];
+ end;
+ Result := True;
+ Exit;
+ end;
+
+ { value supplied by OnGetValue event }
+ TVarData(val).VType := varEmpty;
+ if Assigned(FOnGetValue) then
+ FOnGetValue(Expr, val);
+ if Assigned(FOnNewGetValue) then
+ FOnNewGetValue(Self, Expr, val);
+ if TVarData(val).VType <> varEmpty then
+ begin
+ Value := val;
+ Result := True;
+ Exit;
+ end;
+
+ { searching in the variables }
+ i := FVariables.IndexOf(Expr);
+ if i <> -1 then
+ begin
+ val := FVariables.Items[i].Value;
+ if (TVarData(val).VType = varString) or (TVarData(val).VType = varOleStr) or (TVarData(val).VType = varUString) then
+ begin
+ if (Pos(#13#10, VarToStr(val)) <> 0) or (Pos(System.sLineBreak, VarToStr(val)) <> 0) or
+ (Pos(#13, VarToStr(val)) <> 0) or (Pos(#10, VarToStr(val)) <> 0) then
+ Value := val
+ else
+ Value := Calc(val);
+ end
+ else
+ Value := val;
+ Result := True;
+ Exit;
+ end;
+
+ { searching in the global variables }
+ i := frxGlobalVariables.IndexOf(Expr);
+ if i <> -1 then
+ begin
+ Value := frxGlobalVariables.Items[i].Value;
+ Result := True;
+ Exit;
+ end;
+
+ { searching in the script }
+ v := FScript.FindLocal(Expr);
+ if (v <> nil) and
+ not ((v is TfsProcVariable) or (v is TfsMethodHelper)) then
+ begin
+ Value := v.Value;
+ Result := True;
+ Exit;
+ end;
+end;
+
+function TfrxReport.GetScriptValue(Instance: TObject; ClassType: TClass;
+ const MethodName: String; var Params: Variant): Variant;
+var
+ i: Integer;
+ s: String;
+begin
+ if not DoGetValue(Params[0], Result) then
+ begin
+ { checking aggregate functions }
+ s := VarToStr(Params[0]);
+ i := Pos('(', s);
+ if i <> 0 then
+ begin
+ s := UpperCase(Trim(Copy(s, 1, i - 1)));
+ if (s = 'SUM') or (s = 'MIN') or (s = 'MAX') or
+ (s = 'AVG') or (s = 'COUNT') then
+ begin
+ Result := Calc(Params[0]);
+ Exit;
+ end;
+ end;
+
+ FErrors.Add(frxResources.Get('clUnknownVar') + ' ' + VarToStr(Params[0]));
+ end;
+end;
+
+function TfrxReport.SetScriptValue(Instance: TObject; ClassType: TClass;
+ const MethodName: String; var Params: Variant): Variant;
+begin
+ FVariables[Params[0]] := Params[1];
+end;
+
+function TfrxReport.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; var Params: Variant): Variant;
+var
+ p1, p2, p3: Variant;
+begin
+ if MethodName = 'IIF' then
+ begin
+ p1 := Params[0];
+ p2 := Params[1];
+ p3 := Params[2];
+ try
+ if Calc(p1, FScript.ProgRunning) = True then
+ Result := Calc(p2, FScript.ProgRunning) else
+ Result := Calc(p3, FScript.ProgRunning);
+ except
+ end;
+ end
+ else if (MethodName = 'SUM') or (MethodName = 'AVG') or
+ (MethodName = 'MIN') or (MethodName = 'MAX') then
+ begin
+ p2 := Params[1];
+ if Trim(VarToStr(p2)) = '' then
+ p2 := 0
+ else
+ p2 := Calc(p2, FScript.ProgRunning);
+ p3 := Params[2];
+ if Trim(VarToStr(p3)) = '' then
+ p3 := 0
+ else
+ p3 := Calc(p3, FScript.ProgRunning);
+ Result := FEngine.GetAggregateValue(MethodName, Params[0],
+ TfrxBand(frxInteger(p2)), p3);
+ end
+ else if MethodName = 'COUNT' then
+ begin
+ p1 := Params[0];
+ if Trim(VarToStr(p1)) = '' then
+ p1 := 0
+ else
+ p1 := Calc(p1, FScript.ProgRunning);
+ p2 := Params[1];
+ if Trim(VarToStr(p2)) = '' then
+ p2 := 0
+ else
+ p2 := Calc(p2, FScript.ProgRunning);
+ Result := FEngine.GetAggregateValue(MethodName, '',
+ TfrxBand(frxInteger(p1)), p2);
+ end
+end;
+
+function TfrxReport.DoUserFunction(Instance: TObject; ClassType: TClass;
+ const MethodName: String; var Params: Variant): Variant;
+begin
+ if Assigned(FOnUserFunction) then
+ Result := FOnUserFunction(MethodName, Params);
+end;
+
+function TfrxReport.PrepareScript: Boolean;
+var
+ i: Integer;
+ l: TList;
+ c: TfrxComponent;
+begin
+ FExpressionCache.Clear;
+ FExpressionCache.FScriptLanguage := FScriptLanguage;
+ FEngine.NotifyList.Clear;
+
+ FScript.ClearItems(Self);
+ FScript.AddedBy := Self;
+ FScript.MainProg := True;
+ try
+ l := AllObjects;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ c.IsDesigning := False;
+ c.BeforeStartReport;
+ if c is TfrxPictureView then
+ TfrxPictureView(c).FPictureChanged := True;
+ FScript.AddObject(c.Name, c);
+ end;
+
+ FScript.AddObject('Report', Self);
+ FScript.AddObject('Engine', FEngine);
+ FScript.AddObject('Outline', FPreviewPages.Outline);
+ FScript.AddVariable('Value', 'Variant', Null);
+ FScript.AddVariable('Self', 'TfrxView', Null);
+ FScript.AddMethod('function Get(Name: String): Variant', GetScriptValue);
+ FScript.AddMethod('procedure Set(Name: String; Value: Variant)', SetScriptValue);
+ FScript.AddMethod('macrofunction IIF(Expr: Boolean; TrueValue, FalseValue: Variant): Variant',
+ CallMethod);
+ FScript.AddMethod('macrofunction SUM(Expr: Variant; Band: Variant = 0; Flags: Integer = 0): Variant',
+ CallMethod);
+ FScript.AddMethod('macrofunction AVG(Expr: Variant; Band: Variant = 0; Flags: Integer = 0): Variant',
+ CallMethod);
+ FScript.AddMethod('macrofunction MIN(Expr: Variant; Band: Variant = 0; Flags: Integer = 0): Variant',
+ CallMethod);
+ FScript.AddMethod('macrofunction MAX(Expr: Variant; Band: Variant = 0; Flags: Integer = 0): Variant',
+ CallMethod);
+ FScript.AddMethod('macrofunction COUNT(Band: Variant = 0; Flags: Integer = 0): Variant',
+ CallMethod);
+
+ FLocalValue := FScript.Find('Value');
+ FSelfValue := FScript.Find('Self');
+ FScript.Lines := FScriptText;
+ FScript.SyntaxType := FScriptLanguage;
+ {$IFNDEF FR_VER_BASIC}
+ Result := FScript.Compile;
+ if not Result then
+ FErrors.Add(Format(frxResources.Get('clScrError'),
+ [FScript.ErrorPos, FScript.ErrorMsg]));
+ {$ELSE}
+ Result := True;
+ {$ENDIF}
+ finally
+ FScript.AddedBy := nil;
+ end;
+end;
+
+function TfrxReport.PrepareReport(ClearLastReport: Boolean = True): Boolean;
+var
+ TempStream: TStream;
+ ErrorsText: String;
+ ErrorMessage: String;
+ SavePwd: String;
+ SaveSplisLine: Integer;
+ TmpFile: String;
+ EngineRun: Boolean;
+
+ function CheckDatasets: Boolean;
+ var
+ i: Integer;
+ begin
+ for i := 0 to FDataSets.Count - 1 do
+ if FDatasets[i].DataSet = nil then
+ FErrors.Add(Format(frxResources.Get('clDSNotExist'), [FDatasets[i].DataSetName]));
+ Result := FErrors.Count = 0;
+ end;
+
+begin
+ if ClearLastReport then
+ PreviewPages.Clear;
+ SaveSplisLine := 0;
+ FErrors.Clear;
+ FTerminated := False;
+ Result := False;
+ EngineRun := False;
+
+ if CheckDatasets then
+ begin
+ TempStream := nil;
+ SavePwd := ReportOptions.Password;
+
+ { save the report state }
+ if FEngineOptions.DestroyForms then
+ begin
+ if EngineOptions.UseFileCache then
+ begin
+ TmpFile := frxCreateTempFile(EngineOptions.TempDir);
+ TempStream := TFileStream.Create(TmpFile, fmCreate);
+ end
+ else TempStream := TMemoryStream.Create;
+
+ ReportOptions.Password := '';
+ SaveSplisLine := PrintOptions.SplicingLine;
+ SaveToStream(TempStream);
+ end;
+
+ try
+ if Assigned(FOnBeginDoc) then
+ FOnBeginDoc(Self);
+ if PrepareScript then
+ begin
+{$IFNDEF FR_VER_BASIC}
+ if Assigned(FOnAfterScriptCompile) then FOnAfterScriptCompile(Self);
+ if FScript.Statement.Count > 0 then
+ FScript.Execute;
+{$ENDIF}
+ if not Terminated then
+ EngineRun := FEngine.Run;
+ if EngineRun then
+ begin
+ if Assigned(FOnEndDoc) then
+ FOnEndDoc(Self);
+ Result := True
+ end
+ else if FPreviewForm <> nil then
+ FPreviewForm.Close;
+ end;
+ except
+ on e: Exception do
+ FErrors.Add(e.Message);
+ end;
+
+ if FEngineOptions.DestroyForms then
+ begin
+ ErrorsText := FErrors.Text;
+ TempStream.Position := 0;
+ FReloading := True;
+ try
+// if FEngineOptions.ReportThread = nil then
+ LoadFromStream(TempStream);
+ finally
+ FReloading := False;
+ ReportOptions.Password := SavePwd;
+ PrintOptions.SplicingLine := SaveSplisLine;
+ end;
+ TempStream.Free;
+ if EngineOptions.UseFileCache then
+ DeleteFile(TmpFile);
+ FErrors.Text := ErrorsText;
+ end;
+ end;
+
+ if FErrors.Text <> '' then
+ begin
+ Result := False;
+ ErrorMessage := frxResources.Get('clErrors') + #13#10 + FErrors.Text;
+ frxCommonErrorHandler(Self, ErrorMessage);
+ end;
+end;
+
+procedure TfrxReport.ShowPreparedReport;
+begin
+ FPreviewForm := nil;
+ if FPreview <> nil then
+ begin
+ FPreview.FReport := Self;
+ FPreview.FPreviewPages := FPreviewPages;
+ FPreview.Init;
+ end
+ else
+ begin
+ FPreviewForm := TfrxPreviewForm.Create(Application);
+ with TfrxPreviewForm(FPreviewForm) do
+ begin
+ Preview.FReport := Self;
+ Preview.FPreviewPages := FPreviewPages;
+ FPreview := Preview;
+ Preview.Workspace.DoubleBuffered := PreviewOptions.DoubleBuffered
+{$IFDEF DELPHI27}
+ and not GlobalUseMetal;
+{$ENDIF};
+ Init;
+ if Assigned(FOnPreview) then
+ FOnPreview(Self);
+ if PreviewOptions.Maximized then
+ Position := TFormPosition.poDesigned;
+ if FPreviewOptions.Modal then
+ begin
+ ShowModal;
+ Free;
+ FPreviewForm := nil;
+ end
+ else
+ begin
+ FreeOnClose := True;
+ Show;
+ end;
+ end;
+ end;
+end;
+
+procedure TfrxReport.ShowReport(ClearLastReport: Boolean = True);
+begin
+ if ClearLastReport then
+ PreviewPages.Clear;
+
+ if FOldStyleProgress then
+ begin
+ if PrepareReport(False) then
+ ShowPreparedReport;
+ end
+ else
+ begin
+ FTimer.Enabled := True;
+ ShowPreparedReport;
+ end;
+end;
+
+procedure TfrxReport.OnTimer(Sender: TObject);
+begin
+ FTimer.Enabled := False;
+ PrepareReport(False);
+end;
+
+{$HINTS OFF}
+
+{$UNDEF FR_RUN_DESIGNER}
+
+{$IFDEF FR_LITE}
+ {$DEFINE FR_RUN_DESIGNER}
+{$ENDIF}
+
+{$IFNDEF FR_VER_BASIC}
+ {$DEFINE FR_RUN_DESIGNER}
+{$ENDIF}
+
+procedure TfrxReport.DesignReport(Modal: Boolean = True; MDIChild: Boolean = False);
+var
+ l: TList;
+ i: Integer;
+ c: TfrxComponent;
+begin
+{$IFDEF FR_RUN_DESIGNER}
+ if FDesigner <> nil then Exit;
+ if frxDesignerClass <> nil then
+ begin
+ FScript.ClearItems(Self);
+ l := AllObjects;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if c is TfrxCustomDBDataset then
+ c.BeforeStartReport;
+ end;
+
+ FModified := False;
+ FDesigner := TfrxCustomDesigner(frxDesignerClass.NewInstance);
+ FDesigner.CreateDesigner(nil, Self);
+ FDesigner.FormShow(FDesigner);
+ if Modal then
+ begin
+ FDesigner.ShowModal;
+ FDesigner.Free;
+ AppHandleMessage;
+ FDesigner := nil;
+ end
+ else
+ begin
+ FDesigner.Show;
+ end;
+ end;
+{$ENDIF}
+end;
+{$HINTS ON}
+
+procedure TfrxReport.DesignReport(IDesigner: IUnknown; Editor: TObject);
+var
+ l: TList;
+ i: Integer;
+ c: TfrxComponent;
+begin
+ if FDesigner <> nil then
+ begin
+ FDesigner.Activate;
+ Exit;
+ end;
+ if (IDesigner = nil) or (Editor.ClassName <> 'TfrxReportEditor') then Exit;
+
+ l := AllObjects;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if c is TfrxCustomDBDataset then
+ c.BeforeStartReport;
+ end;
+
+ FDesigner := TfrxCustomDesigner(frxDesignerClass.NewInstance);
+ FDesigner.CreateDesigner(nil, Self);
+ FDesigner.FormShow(FDesigner);
+ FDesigner.ShowModal;
+ FreeAndNil(FDesigner);
+end;
+
+{$HINTS OFF}
+function TfrxReport.DesignPreviewPage: Boolean;
+begin
+ Result := False;
+{$IFNDEF FR_VER_BASIC}
+ if FDesigner <> nil then
+ begin
+ FDesigner.Activate;
+ Exit;
+ end;
+ if frxDesignerClass <> nil then
+ begin
+ FDesigner := TfrxCustomDesigner(frxDesignerClass.NewInstance);
+ FDesigner.CreateDesigner(nil, Self, True);
+ FDesigner.FormShow(FDesigner);
+ FDesigner.ShowModal;
+ Result := FModified;
+ FreeAndNil(FDesigner);
+ end;
+{$ENDIF}
+end;
+{$HINTS ON}
+
+function TfrxReport.Export(Filter: TfrxCustomExportFilter): Boolean;
+begin
+ Result := FPreviewPages.Export(Filter);
+end;
+
+function TfrxReport.Print: Boolean;
+begin
+ Result := FPreviewPages.Print;
+end;
+
+procedure TfrxReport.AddFunction(const FuncName: String;
+ const Category: String = ''; const Description: String = '');
+begin
+ FScript.AddedBy := nil;
+ FScript.AddMethod(FuncName, DoUserFunction, Category, Description);
+end;
+
+function TfrxReport.GetLocalValue: Variant;
+begin
+ Result := FLocalValue.Value;
+end;
+
+function TfrxReport.GetSelfValue: TfrxView;
+begin
+ Result := TfrxView(frxInteger(FSelfValue.Value));
+end;
+
+procedure TfrxReport.SetLocalValue(const Value: Variant);
+begin
+ FLocalValue.Value := Value;
+end;
+
+procedure TfrxReport.SetSelfValue(const Value: TfrxView);
+begin
+ FSelfValue.Value := frxInteger(Value);
+end;
+
+procedure TfrxReport.SetTerminated(const Value: Boolean);
+begin
+ FTerminated := Value;
+ if Value then
+ FScript.Terminate;
+end;
+
+procedure TfrxReport.SetPreview(const Value: TfrxCustomPreview);
+begin
+ if (FPreview <> nil) and (Value = nil) then
+ begin
+ FPreview.FReport := nil;
+ FPreview.FPreviewPages := nil;
+ FPreviewForm := nil;
+ end;
+
+ FPreview := Value;
+
+ if FPreview <> nil then
+ begin
+ FPreview.FReport := Self;
+ FPreview.FPreviewPages := FPreviewPages;
+ if not (csDesigning in FPreview.ComponentState) then
+ FPreview.Init;
+ end;
+end;
+
+function TfrxReport.GetCaseSensitive: Boolean;
+begin
+ Result := FExpressionCache.CaseSensitive;
+end;
+
+function TfrxReport.GetScriptText: TStrings;
+begin
+ if (csWriting in ComponentState) and not FStoreInDFM then
+ Result := FFakeScriptText
+ else Result := FScriptText;
+end;
+
+procedure TfrxReport.SetCaseSensitive(const Value: Boolean);
+begin
+ FExpressionCache.CaseSensitive := Value;
+end;
+
+procedure TfrxReport.InternalOnProgressStart(ProgressType: TfrxProgressType);
+begin
+ if (FEngineOptions.EnableThreadSafe) then Exit; //(FEngineOptions.ReportThread <> nil) or
+
+ if Assigned(FOnProgressStart) then
+ FOnProgressStart(Self, ProgressType, 0);
+
+ if OldStyleProgress or (ProgressType <> ptRunning) then
+ begin
+ if FShowProgress then
+ begin
+ if FProgress <> nil then
+ FProgress.Free;
+ FProgress := TfrxProgress.Create(nil);
+ FProgress.Execute(0, '', True, False);
+{$IFDEF LINUX}
+ if GnomeAndRedHat then
+ FProgress.Visible := False;
+{$ENDIF}
+
+ end;
+ end;
+
+ if (FPreview <> nil) and (ProgressType = ptRunning) then
+ FPreview.InternalOnProgressStart(Self, ProgressType, 0);
+ AppHandleMessage;
+end;
+
+procedure TfrxReport.InternalOnProgress(ProgressType: TfrxProgressType;
+ Progress: Integer);
+begin
+ if FEngineOptions.EnableThreadSafe then Exit;
+
+ if Assigned(FOnProgress) then
+ FOnProgress(Self, ProgressType, Progress);
+
+ if OldStyleProgress or (ProgressType <> ptRunning) then
+ begin
+ if FShowProgress then
+ begin
+ case ProgressType of
+ ptRunning:
+ if not Engine.FinalPass then
+ FProgress.Message := Format(frxResources.Get('prRunningFirst'), [Progress])
+ else
+ FProgress.Message := Format(frxResources.Get('prRunning'), [Progress]);
+ ptPrinting:
+ FProgress.Message := Format(frxResources.Get('prPrinting'), [Progress]);
+ ptExporting:
+ FProgress.Message := Format(frxResources.Get('prExporting'), [Progress]);
+ end;
+ if FProgress.Terminated then
+ Terminated := True;
+ end;
+ end;
+
+ if (FPreview <> nil) and (ProgressType = ptRunning) then
+ FPreview.InternalOnProgress(Self, ProgressType, Progress - 1);
+ AppHandleMessage;
+end;
+
+procedure TfrxReport.InternalOnProgressStop(ProgressType: TfrxProgressType);
+begin
+ if FEngineOptions.EnableThreadSafe then Exit;
+
+ if Assigned(FOnProgressStop) then
+ FOnProgressStop(Self, ProgressType, 0);
+
+ if OldStyleProgress or (ProgressType <> ptRunning) then
+ begin
+ if FShowProgress then
+ begin
+ FProgress.Free;
+ FProgress := nil;
+ end;
+ end;
+
+ if (FPreview <> nil) and (ProgressType = ptRunning) then
+ FPreview.InternalOnProgressStop(Self, ProgressType, 0);
+ AppHandleMessage;
+end;
+
+procedure TfrxReport.SetProgressMessage(const Value: String; IsHint: Boolean);
+begin
+ if FEngineOptions.EnableThreadSafe then Exit;
+
+ if OldStyleProgress and Engine.Running then
+ begin
+ if FShowProgress then
+ FProgress.Message := Value
+ end;
+
+ if FPreviewForm <> nil then
+ TfrxPreviewForm(FPreviewForm).SetMessageText(Value, IsHint);
+ AppHandleMessage;
+end;
+
+procedure TfrxReport.SetVersion(const Value: String);
+begin
+ FVersion := FR_VERSION;
+end;
+
+
+{ TfrxCustomDesigner }
+
+constructor TfrxCustomDesigner.CreateDesigner(AOwner: TComponent;
+ AReport: TfrxReport; APreviewDesigner: Boolean);
+begin
+ inherited Create(AOwner);
+ FReport := AReport;
+ FIsPreviewDesigner := APreviewDesigner;
+ FObjects := TList.Create;
+ FSelectedObjects := TList.Create;
+end;
+
+destructor TfrxCustomDesigner.Destroy;
+begin
+ FObjects.Free;
+ FSelectedObjects.Free;
+ inherited;
+end;
+
+procedure TfrxCustomDesigner.SetModified(const Value: Boolean);
+begin
+ FModified := Value;
+ if Value then
+ FReport.Modified := True;
+end;
+
+procedure TfrxCustomDesigner.SetPage(const Value: TfrxPage);
+begin
+ FPage := Value;
+end;
+
+
+{ TfrxCustomEngine }
+
+procedure TfrxCustomEngine.BreakAllKeep;
+begin
+// do nothing
+end;
+
+constructor TfrxCustomEngine.Create(AReport: TfrxReport);
+begin
+ FReport := AReport;
+ FNotifyList := TList.Create;
+end;
+
+destructor TfrxCustomEngine.Destroy;
+begin
+ FNotifyList.Free;
+ inherited;
+end;
+
+function TfrxCustomEngine.GetDoublePass: Boolean;
+begin
+ Result := FReport.EngineOptions.DoublePass;
+end;
+
+procedure TfrxCustomEngine.ShowBandByName(const BandName: String);
+begin
+ ShowBand(TfrxBand(Report.FindObject(BandName)));
+end;
+
+procedure TfrxCustomEngine.StopReport;
+begin
+ Report.Terminated := True;
+end;
+
+function TfrxCustomEngine.GetPageHeight: Double;
+begin
+ Result := FPageHeight;
+end;
+
+
+{ TfrxCustomOutline }
+
+constructor TfrxCustomOutline.Create(APreviewPages: TfrxCustomPreviewPages);
+begin
+ FPreviewPages := APreviewPages;
+end;
+
+function TfrxCustomOutline.Engine: TfrxCustomEngine;
+begin
+ Result := FPreviewPages.Engine;
+end;
+
+{ TfrxCustomPreviewPages }
+
+constructor TfrxCustomPreviewPages.Create(AReport: TfrxReport);
+begin
+ FReport := AReport;
+ FOutline := TfrxOutline.Create(Self);
+end;
+
+destructor TfrxCustomPreviewPages.Destroy;
+begin
+ FOutline.Free;
+ inherited;
+end;
+
+
+{ TfrxExpressionCache }
+
+constructor TfrxExpressionCache.Create(AScript: TfsScript);
+begin
+ FExpressions := TStringList.Create;
+ FExpressions.Sorted := True;
+ FScript := TfsScript.Create(nil);
+ FScript.ExtendedCharset := True;
+ FMainScript := AScript;
+end;
+
+destructor TfrxExpressionCache.Destroy;
+begin
+ FExpressions.Free;
+ FScript.Free;
+ inherited;
+end;
+
+procedure TfrxExpressionCache.Clear;
+begin
+ FExpressions.Clear;
+ FScript.Clear;
+end;
+
+function TfrxExpressionCache.Calc(const Expression: String;
+ var ErrorMsg: String; AScript: TfsScript): Variant;
+var
+ i: Integer;
+ v: TfsProcVariable;
+ Compiled: Boolean;
+begin
+ ErrorMsg := '';
+ FScript.Parent := AScript;
+ i := FExpressions.IndexOf(Expression);
+ if i = -1 then
+ begin
+ i := FExpressions.Count;
+ FScript.SyntaxType := FScriptLanguage;
+ if CompareText(FScriptLanguage, 'PascalScript') = 0 then
+ FScript.Lines.Text := 'function fr3f' + IntToStr(i) + ': Variant; begin ' +
+ 'Result := ' + Expression + ' end; begin end.'
+ else if CompareText(FScriptLanguage, 'C++Script') = 0 then
+ FScript.Lines.Text := 'Variant fr3f' + IntToStr(i) + '() { ' +
+ 'return ' + Expression + '; } {}'
+ else if CompareText(FScriptLanguage, 'BasicScript') = 0 then
+ FScript.Lines.Text := 'function fr3f' + IntToStr(i) + #13#10 +
+ 'return ' + Expression + #13#10 + 'end function'
+ else if CompareText(FScriptLanguage, 'JScript') = 0 then
+ FScript.Lines.Text := 'function fr3f' + IntToStr(i) + '() { ' +
+ 'return ' + Expression + '; }';
+
+ Compiled := FScript.Compile;
+ v := TfsProcVariable(FScript.Find('fr3f' + IntToStr(i)));
+
+ if not Compiled then
+ begin
+ if v <> nil then
+ begin
+ v.Free;
+ FScript.Remove(v);
+ end;
+ ErrorMsg := frxResources.Get('clExprError') + ' ''' + Expression + ''': ' +
+ FScript.ErrorMsg;
+ Result := Null;
+ Exit;
+ end;
+
+ FExpressions.AddObject(Expression, v);
+ end
+ else
+ v := TfsProcVariable(FExpressions.Objects[i]);
+ FMainScript.MainProg := False;
+ try
+ try
+ Result := v.Value;
+ except
+ on e: Exception do
+ ErrorMsg := e.Message;
+ end;
+ finally
+ FMainScript.MainProg := True;
+ end;
+end;
+
+function TfrxExpressionCache.GetCaseSensitive: Boolean;
+begin
+ Result := FExpressions.CaseSensitive;
+end;
+
+procedure TfrxExpressionCache.SetCaseSensitive(const Value: Boolean);
+begin
+ FExpressions.CaseSensitive := Value;
+end;
+
+
+{ TfrxCustomExportFilter }
+
+constructor TfrxCustomExportFilter.Create(AOwner: TComponent);
+begin
+ inherited;
+ if not FNoRegister then
+ frxExportFilters.Register(Self);
+ FShowDialog := True;
+ FUseFileCache := True;
+ FDefaultPath := '';
+ FShowProgress := True;
+ FSlaveExport := False;
+ FOverwritePrompt := False;
+ FFiles := nil;
+end;
+
+constructor TfrxCustomExportFilter.CreateNoRegister;
+begin
+ FNoRegister := True;
+ Create(nil);
+end;
+
+destructor TfrxCustomExportFilter.Destroy;
+begin
+ if not FNoRegister then
+ frxExportFilters.Unregister(Self);
+ if FFiles <> nil then
+ FFiles.Free;
+ inherited;
+end;
+
+class function TfrxCustomExportFilter.GetDescription: String;
+begin
+ Result := '';
+end;
+
+procedure TfrxCustomExportFilter.Finish;
+begin
+//
+end;
+
+procedure TfrxCustomExportFilter.FinishPage(Page: TfrxReportPage;
+ Index: Integer);
+begin
+//
+end;
+
+function TfrxCustomExportFilter.ShowModal: TModalResult;
+begin
+ Result := mrOk;
+end;
+
+function TfrxCustomExportFilter.Start: Boolean;
+begin
+ Result := True;
+end;
+
+procedure TfrxCustomExportFilter.StartPage(Page: TfrxReportPage;
+ Index: Integer);
+begin
+//
+end;
+
+
+{ TfrxCustomWizard }
+
+constructor TfrxCustomWizard.Create(AOwner: TComponent);
+begin
+ inherited;
+ FDesigner := TfrxCustomDesigner(AOwner);
+ FReport := FDesigner.Report;
+end;
+
+class function TfrxCustomWizard.GetDescription: String;
+begin
+ Result := '';
+end;
+
+
+{ TfrxCustomCompressor }
+
+constructor TfrxCustomCompressor.Create(AOwner: TComponent);
+begin
+ inherited;
+ FOldCompressor := frxCompressorClass;
+ frxCompressorClass := TfrxCompressorClass(ClassType);
+end;
+
+destructor TfrxCustomCompressor.Destroy;
+begin
+ frxCompressorClass := FOldCompressor;
+ if FStream <> nil then
+ FStream.Free;
+ if FTempFile <> '' then
+ DeleteFile(FTempFile);
+ inherited;
+end;
+
+procedure TfrxCustomCompressor.CreateStream;
+begin
+ if FIsFR3File or not FReport.EngineOptions.UseFileCache then
+ FStream := TMemoryStream.Create
+ else
+ begin
+ FTempFile := frxCreateTempFile(FReport.EngineOptions.TempDir);
+ FStream := TFileStream.Create(FTempFile, fmCreate);
+ end;
+end;
+
+
+{ TfrxCustomCrypter }
+
+constructor TfrxCustomCrypter.Create(AOwner: TComponent);
+begin
+ inherited;
+ frxCrypterClass := TfrxCrypterClass(ClassType);
+end;
+
+destructor TfrxCustomCrypter.Destroy;
+begin
+ if FStream <> nil then
+ FStream.Free;
+ inherited;
+end;
+
+procedure TfrxCustomCrypter.CreateStream;
+begin
+ FStream := TMemoryStream.Create;
+end;
+
+
+{ TfrxGlobalDataSetList }
+
+constructor TfrxGlobalDataSetList.Create;
+begin
+{$IFNDEF NO_CRITICAL_SECTION}
+ FCriticalSection := TCriticalSection.Create;
+{$ENDIF}
+ inherited;
+end;
+
+destructor TfrxGlobalDataSetList.Destroy;
+begin
+{$IFNDEF NO_CRITICAL_SECTION}
+ FCriticalSection.Free;
+ FCriticalSection := nil;
+{$ENDIF}
+ inherited;
+end;
+
+procedure TfrxGlobalDataSetList.Lock;
+begin
+{$IFNDEF NO_CRITICAL_SECTION}
+ if FCriticalSection <> nil then
+ FCriticalSection.Enter;
+{$ENDIF}
+end;
+
+procedure TfrxGlobalDataSetList.Unlock;
+begin
+{$IFNDEF NO_CRITICAL_SECTION}
+ if FCriticalSection <> nil then
+ FCriticalSection.Leave;
+{$ENDIF}
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxComponent, TFmxObject);
+ GroupDescendentsWith(TfrxDBComponents, TFmxObject);
+ GroupDescendentsWith(TfrxCustomCrypter, TFmxObject);
+ GroupDescendentsWith(TfrxCustomCompressor, TFmxObject);
+ GroupDescendentsWith(TfrxCustomExportFilter, TFmxObject);
+ GroupDescendentsWith(TfrxCustomWizard, TFmxObject);
+ GroupDescendentsWith(TfrxFrame, TFmxObject);
+ GroupDescendentsWith(TfrxHighlight, TFmxObject);
+ GroupDescendentsWith(TfrxStyleItem, TFmxObject);
+{$IFNDEF DELPHI19}
+ GlobalUseDirect2D := False;
+{$ENDIF}
+{$IFNDEF NO_CRITICAL_SECTION}
+ frxCS := TCriticalSection.Create;
+{$ENDIF}
+ frxConverter := TfrxConverterEvents.Create;
+ DatasetList := TfrxGlobalDataSetList.Create;
+ frxGlobalVariables := TfrxVariables.Create;
+
+ RegisterFmxClasses([
+ TfrxChild, TfrxColumnFooter, TfrxColumnHeader, TfrxCustomMemoView, TfrxMasterData,
+ TfrxDetailData, TfrxSubDetailData, TfrxDataBand4, TfrxDataBand5, TfrxDataBand6,
+ TfrxDialogPage, TfrxFooter, TfrxFrame, TfrxGroupFooter, TfrxGroupHeader,
+ TfrxHeader, TfrxHighlight, TfrxLineView, TfrxMemoView, TfrxOverlay, TfrxPageFooter,
+ TfrxPageHeader, TfrxPictureView, TfrxReport, TfrxReportPage, TfrxReportSummary,
+ TfrxReportTitle, TfrxShapeView, TfrxSubreport, TfrxSysMemoView, TfrxStyleItem,
+ TfrxNullBand, TfrxCustomLineView, TfrxDataPage]);
+
+
+ frxResources.UpdateFSResources;
+
+
+finalization
+{$IFNDEF NO_CRITICAL_SECTION}
+ frxCS.Free;
+{$ENDIF}
+ frxGlobalVariables.Free;
+ DatasetList.Free;
+ frxConverter.Free;
+end.
diff --git a/LibD28x64/FMX.frxClass.res b/LibD28x64/FMX.frxClass.res
new file mode 100644
index 0000000..d097bbf
Binary files /dev/null and b/LibD28x64/FMX.frxClass.res differ
diff --git a/LibD28x64/FMX.frxClassRTTI.pas b/LibD28x64/FMX.frxClassRTTI.pas
new file mode 100644
index 0000000..a117078
--- /dev/null
+++ b/LibD28x64/FMX.frxClassRTTI.pas
@@ -0,0 +1,611 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Publish all classes defined in }
+{ frxClass }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxClassRTTI;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+implementation
+
+uses
+ System.SysUtils, System.Classes, System.Variants, System.WideStrings,
+ FMX.Types, System.UIConsts, System.Types,
+ FMX.fs_iinterpreter, FMX.frxClass, FMX.frxCtrls,
+ FMX.frxPreviewPages, FMX.frxEngine, FMX.frxDMPClass, FMX.frxVariables, FMX.fs_iformsrtti,
+ FMX.frxUnicodeUtils, FMX.frxFMX
+{$IFDEF DELPHI18}
+ ,FMX.Controls
+{$ENDIF};
+
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddConst('fr01cm', 'Extended', fr01cm);
+ AddConst('fr1cm', 'Extended', fr1cm);
+ AddConst('fr01in', 'Extended', fr01in);
+ AddConst('fr1in', 'Extended', fr1in);
+ AddConst('fr1CharX', 'Extended', fr1CharX);
+ AddConst('fr1CharY', 'Extended', fr1CharY);
+ AddConst('clTransparent', 'Integer', claNull);
+ AddEnum('TfrxStretchMode', 'smDontStretch, smActualHeight, smMaxHeight');
+ AddEnum('TfrxShiftMode', 'smDontShift, smAlways, smWhenOverlapped');
+ AddEnum('TfrxDuplexMode', 'dmNone, dmVertical, dmHorizontal, dmSimplex');
+ AddEnum('TfrxAlign', 'baNone, baLeft, baRight, baCenter, baWidth, baBottom');
+ AddEnum('TfrxFrameStyle', 'fsSolid, fsDash, fsDot, fsDashDot, fsDashDotDot, fsDouble');
+ AddEnumSet('TfrxFrameTypes', 'ftLeft, ftRight, ftTop, ftBottom');
+ AddEnum('TfrxHAlign', 'haLeft, haRight, haCenter, haBlock');
+ AddEnum('TfrxVAlign', 'vaTop, vaBottom, vaCenter');
+ AddEnumSet('TfrxRestrictions', 'rfDontModify, rfDontSize, rfDontMove, rfDontDelete');
+ AddEnum('TfrxShapeKind', 'skRectangle, skRoundRectangle, skEllipse, skTriangle, skDiamond, skDiagonal1, skDiagonal2');
+ AddEnumSet('TfrxPreviewButtons', 'pbPrint, pbLoad, pbSave, pbExport, ' +
+ 'pbZoom, pbFind, pbTree, pbPageSetup, pbRefresh, pbTools, pbEdit, pbNavigator, pbExportQuick');
+ AddEnum('TfrxZoomMode', 'zmDefault, zmWholePage, zmPageWidth, zmManyPages');
+ AddEnum('TfrxPrintPages', 'ppAll, ppOdd, ppEven');
+ AddEnumSet('TfrxDMPFontStyles', 'fsxBold, fsxItalic, fsxUnderline, fsxSuperScript, ' +
+ 'fsxSubScript, fsxCondensed, fsxWide, fsx12cpi, fsx15cpi');
+ AddEnum('TfrxRangeBegin', 'rbFirst, rbCurrent');
+ AddEnum('TfrxRangeEnd', 'reLast, reCurrent, reCount');
+ AddEnum('TfrxFieldType', 'fftNumeric, fftString, fftBoolean');
+ AddEnum('TfrxFormatKind', 'fkText, fkNumeric, fkDateTime, fkBoolean');
+
+ if FindClass('TPersistent') <> nil then
+ with AddClass(TWideStrings, 'TPersistent') do
+ begin
+ AddConstructor('constructor Create', CallMethod);
+ AddMethod('function Add(const S: string): Integer', CallMethod);
+ AddMethod('function AddObject(const S: string; AObject: TObject): Integer', CallMethod);
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('procedure Delete(Index: Integer)', CallMethod);
+ AddMethod('function IndexOf(const S: string): Integer', CallMethod);
+ AddMethod('procedure Insert(Index: Integer; const S: string)', CallMethod);
+ AddMethod('procedure LoadFromFile(const FileName: string)', CallMethod);
+ AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure SaveToFile(const FileName: string)', CallMethod);
+ AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
+
+ AddProperty('Count', 'Integer', GetProp, nil);
+ AddIndexProperty('Objects', 'Integer', 'TObject', CallMethod);
+ AddDefaultProperty('Strings', 'Integer', 'string', CallMethod);
+ AddProperty('Text', 'string', GetProp, SetProp);
+ end;
+
+ with AddClass(TfrxDataSet, 'TComponent') do
+ begin
+ AddMethod('procedure Open', CallMethod);
+ AddMethod('procedure Close', CallMethod);
+ AddMethod('procedure First', CallMethod);
+ AddMethod('procedure Next', CallMethod);
+ AddMethod('procedure Prior', CallMethod);
+ AddMethod('function Eof: Boolean', CallMethod);
+ AddMethod('function FieldsCount: Integer', CallMethod);
+ AddMethod('function HasField(const fName: String): Boolean', CallMethod);
+ AddMethod('function IsBlobField(const fName: String): Boolean', CallMethod);
+ AddMethod('function RecordCount: Integer', CallMethod);
+ AddMethod('procedure GetFieldList(List: TStrings)', CallMethod);
+ AddProperty('RecNo', 'Integer', GetProp, nil);
+ AddIndexProperty('DisplayText', 'String', 'String', CallMethod, True);
+ AddIndexProperty('DisplayWidth', 'String', 'Integer', CallMethod, True);
+ AddIndexProperty('FieldType', 'String', 'TfrxFieldType', CallMethod, True);
+ AddIndexProperty('Value', 'String', 'Variant', CallMethod, True);
+ end;
+ AddClass(TfrxUserDataSet, 'TfrxDataSet');
+ AddClass(TfrxCustomDBDataSet, 'TfrxDataSet');
+ AddClass(TfrxFont, 'TPersistent');
+
+ with AddClass(TfrxComponent, 'TComponent') do
+ begin
+ AddMethod('procedure Clear', CallMethod);
+ AddMethod('function FindObject(s: String): TfrxComponent', CallMethod);
+ AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure SaveToStream(Stream: TStream; SaveChildren: Boolean = True)', CallMethod);
+ AddMethod('procedure SetBounds(ALeft, ATop, AWidth, AHeight: Double)', CallMethod);
+ AddProperty('Objects', 'TList', GetProp, nil);
+ AddProperty('AllObjects', 'TList', GetProp, nil);
+ AddProperty('Parent', 'TfrxComponent', GetProp, SetProp);
+ AddProperty('Page', 'TfrxPage', GetProp, nil);
+ AddProperty('AbsLeft', 'Double', GetProp, nil);
+ AddProperty('AbsTop', 'Double', GetProp, nil);
+ end;
+ AddClass(TfrxReportComponent, 'TfrxComponent');
+ AddClass(TfrxDialogComponent, 'TfrxReportComponent');
+ with AddClass(TfrxDialogControl, 'TfrxReportComponent') do
+ AddMethod('procedure SetFocus', CallMethod);
+ AddClass(TfrxFrameLine, 'TPersistent');
+ AddClass(TfrxFrame, 'TPersistent');
+ with AddClass(TfrxView, 'TfrxReportComponent') do
+ AddProperty('TagStr', 'String', GetProp, SetProp);
+ AddClass(TfrxShapeView, 'TfrxView');
+ with AddClass(TfrxStretcheable, 'TfrxView') do
+ AddMethod('function CalcHeight: Double', CallMethod);
+ AddClass(TfrxHighlight, 'TPersistent');
+ AddClass(TfrxFormat, 'TPersistent');
+ with AddClass(TfrxCustomMemoView, 'TfrxStretcheable') do
+ begin
+ AddMethod('function CalcWidth: Double', CallMethod);
+ AddProperty('Text', 'String', GetProp, SetProp);
+ AddProperty('Lines', 'TWideStrings', GetProp, SetProp);
+ AddProperty('Value', 'Variant', GetProp, nil);
+ end;
+ AddClass(TfrxMemoView, 'TfrxCustomMemoView');
+ AddClass(TfrxSysMemoView, 'TfrxCustomMemoView');
+ AddClass(TfrxDMPMemoView, 'TfrxCustomMemoView');
+ AddClass(TfrxCustomLineView, 'TfrxStretcheable');
+ AddClass(TfrxLineView, 'TfrxCustomLineView');
+ AddClass(TfrxDMPLineView, 'TfrxCustomLineView');
+ AddClass(TfrxDMPCommand, 'TfrxView');
+ with AddClass(TfrxPictureView, 'TfrxView') do
+ AddMethod('procedure LoadFromFile(filename: String)', CallMethod);
+ AddClass(TfrxSubreport, 'TfrxView');
+ with AddClass(TfrxBand, 'TfrxReportComponent') do
+ AddProperty('Overflow', 'Boolean', GetProp, nil);
+ AddClass(TfrxDataBand, 'TfrxBand');
+ AddClass(TfrxHeader, 'TfrxBand');
+ AddClass(TfrxFooter, 'TfrxBand');
+ AddClass(TfrxMasterData, 'TfrxDataBand');
+ AddClass(TfrxDetailData, 'TfrxDataBand');
+ AddClass(TfrxSubDetailData, 'TfrxDataBand');
+ AddClass(TfrxDataBand4, 'TfrxDataBand');
+ AddClass(TfrxDataBand5, 'TfrxDataBand');
+ AddClass(TfrxDataBand6, 'TfrxDataBand');
+ AddClass(TfrxPageHeader, 'TfrxBand');
+ AddClass(TfrxPageFooter, 'TfrxBand');
+ AddClass(TfrxColumnHeader, 'TfrxBand');
+ AddClass(TfrxColumnFooter, 'TfrxBand');
+ AddClass(TfrxGroupHeader, 'TfrxBand');
+ AddClass(TfrxGroupFooter, 'TfrxBand');
+ AddClass(TfrxReportTitle, 'TfrxBand');
+ AddClass(TfrxReportSummary, 'TfrxBand');
+ AddClass(TfrxChild, 'TfrxBand');
+ AddClass(TfrxOverlay, 'TfrxBand');
+ AddClass(TfrxPage, 'TfrxComponent');
+ AddClass(TfrxReportPage, 'TfrxPage');
+ with AddClass(TfrxDialogPage, 'TfrxPage') do
+ begin
+ AddMethod('function ShowModal: Integer', CallMethod);
+ AddProperty('ModalResult', 'Integer', GetProp, SetProp);
+ end;
+ AddClass(TfrxDMPPage, 'TfrxReportPage');
+ AddClass(TfrxDataPage, 'TfrxPage');
+ with AddClass(TfrxEngineOptions, 'TPersistent') do
+ begin
+ AddProperty('DestroyForms', 'Boolean', GetProp, SetProp);
+ end;
+ AddClass(TfrxPrintOptions, 'TPersistent');
+ AddClass(TfrxPreviewOptions, 'TPersistent');
+ AddClass(TfrxReportOptions, 'TPersistent');
+ AddClass(TfrxVariable, 'TCollectionItem');
+ with AddClass(TfrxVariables, 'TCollection') do
+ begin
+ AddConstructor('constructor Create', CallMethod);
+ AddDefaultProperty('Variables', 'String', 'Variant', CallMethod);
+ end;
+ AddClass(TfrxStyleItem,'TCollectionItem');
+ with AddClass(TfrxStyles, 'TCollection') do
+ begin
+ AddConstructor('constructor Create(AReport: TfrxReport)', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TfrxStyleItem', CallMethod);
+ AddMethod('function Add: TfrxStyleItem', CallMethod);
+ AddMethod('function Find(const Name: String): TfrxStyleItem', CallMethod);
+ AddMethod('procedure Apply', CallMethod);
+ AddMethod('procedure GetList(List: TStrings)', CallMethod);
+ AddMethod('procedure LoadFromFile(const FileName: String)', CallMethod);
+ AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
+ AddMethod('procedure SaveToFile(const FileName: String)', CallMethod);
+ AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
+ end;
+ with AddClass(TfrxArray, 'TCollection') do
+ begin
+ AddConstructor('constructor Create', CallMethod);
+ AddDefaultProperty('Variables', 'Variant', 'Variant', CallMethod);
+ end;
+ AddObject('frxGlobalVariables', frxGlobalVariables);
+ with AddClass(TfrxReport, 'TfrxComponent') do
+ begin
+ AddMethod('function Calc(const Expr: String): Variant', CallMethod);
+ AddMethod('function GetDataset(const Alias: String): TfrxDataset', CallMethod);
+ AddMethod('function LoadFromFile(const FileName: String): Boolean', CallMethod);
+ AddMethod('procedure SaveToFile(const FileName: String)', CallMethod);
+ AddMethod('procedure ShowReport', CallMethod);
+ AddProperty('Terminated', 'Boolean', GetProp, SetProp);
+ AddProperty('Variables', 'TfrxVariables', GetProp, nil);
+ AddProperty('Styles', 'TfrxStyles', GetProp, nil);
+ end;
+ with AddClass(TfrxCustomEngine, 'TPersistent') do
+ begin
+ AddMethod('procedure AddAnchor(const Text: String)', CallMethod);
+ AddMethod('procedure NewPage', CallMethod);
+ AddMethod('procedure NewColumn', CallMethod);
+ AddMethod('procedure ShowBand(Band: TfrxBand)', CallMethod);
+ AddMethod('procedure StopReport', CallMethod);
+ AddMethod('function FreeSpace: Double', CallMethod);
+ AddMethod('function GetAnchorPage(const Text: String): Integer', CallMethod);
+ end;
+ AddClass(TfrxEngine, 'TfrxCustomEngine');
+ with AddClass(TfrxCustomOutline, 'TPersistent') do
+ begin
+ AddMethod('procedure AddItem(const Text: String)', CallMethod);
+ AddMethod('procedure LevelRoot', CallMethod);
+ AddMethod('procedure LevelUp', CallMethod);
+ end;
+ AddClass(TfrxOutline, 'TfrxCustomOutline');
+
+ AddMethod('function DayOf(Date: TDateTime): Integer', CallMethod, 'ctDate');
+ AddMethod('function MonthOf(Date: TDateTime): Integer', CallMethod, 'ctDate');
+ AddMethod('function YearOf(Date: TDateTime): Integer', CallMethod, 'ctDate');
+
+ { note: these functions don't have implementation here. They are implemented
+ in the frxClass.pas unit }
+ AddMethod('function IIF(Expr: Boolean; TrueValue, FalseValue: Variant): Variant',
+ CallMethod, 'ctOther');
+ AddMethod('function SUM(Expr: Variant; Band: Variant = 0; Flags: Integer = 0): Variant',
+ CallMethod, 'ctAggregate');
+ AddMethod('function AVG(Expr: Variant; Band: Variant = 0; Flags: Integer = 0): Variant',
+ CallMethod, 'ctAggregate');
+ AddMethod('function MIN(Expr: Variant; Band: Variant = 0; Flags: Integer = 0): Variant',
+ CallMethod, 'ctAggregate');
+ AddMethod('function MAX(Expr: Variant; Band: Variant = 0; Flags: Integer = 0): Variant',
+ CallMethod, 'ctAggregate');
+ AddMethod('function COUNT(Band: Variant = 0; Flags: Integer = 0): Variant',
+ CallMethod, 'ctAggregate');
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ _TfrxDataSet: TfrxDataSet;
+ _TStrings: TWideStrings;
+begin
+ Result := 0;
+ if ClassType = TWideStrings then
+ begin
+ _TStrings := TWideStrings(Instance);
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TWideStringList.Create)
+ else if MethodName = 'ADD' then
+ Result := _TStrings.Add(Caller.Params[0])
+ else if MethodName = 'ADDOBJECT' then
+ Result := _TStrings.AddObject(Caller.Params[0], TObject(frxInteger(Caller.Params[1])))
+ else if MethodName = 'CLEAR' then
+ _TStrings.Clear
+ else if MethodName = 'DELETE' then
+ _TStrings.Delete(Caller.Params[0])
+ else if MethodName = 'INDEXOF' then
+ Result := _TStrings.IndexOf(Caller.Params[0])
+ else if MethodName = 'INSERT' then
+ _TStrings.Insert(Caller.Params[0], Caller.Params[1])
+ else if MethodName = 'LOADFROMFILE' then
+ _TStrings.LoadFromFile(Caller.Params[0], TEncoding.Unicode)
+ else if MethodName = 'LOADFROMSTREAM' then
+ _TStrings.LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVETOFILE' then
+ _TStrings.SaveToFile(Caller.Params[0])
+ else if MethodName = 'SAVETOSTREAM' then
+ _TStrings.SaveToStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'OBJECTS.GET' then
+ Result := frxInteger(_TStrings.Objects[Caller.Params[0]])
+ else if MethodName = 'OBJECTS.SET' then
+ _TStrings.Objects[Caller.Params[0]] := TObject(frxInteger(Caller.Params[1]))
+ else if MethodName = 'STRINGS.GET' then
+ Result := _TStrings.Strings[Caller.Params[0]]
+ else if MethodName = 'STRINGS.SET' then
+ _TStrings.Strings[Caller.Params[0]] := Caller.Params[1]
+ end
+ else if ClassType = TfrxDataSet then
+ begin
+ _TfrxDataSet := TfrxDataSet(Instance);
+ if MethodName = 'OPEN' then
+ _TfrxDataSet.Open
+ else if MethodName = 'CLOSE' then
+ _TfrxDataSet.Close
+ else if MethodName = 'FIRST' then
+ _TfrxDataSet.First
+ else if MethodName = 'NEXT' then
+ _TfrxDataSet.Next
+ else if MethodName = 'PRIOR' then
+ _TfrxDataSet.Prior
+ else if MethodName = 'EOF' then
+ Result := _TfrxDataSet.Eof
+ else if MethodName = 'FIELDSCOUNT' then
+ Result := _TfrxDataSet.FieldsCount
+ else if MethodName = 'RECORDCOUNT' then
+ Result := _TfrxDataSet.RecordCount
+ else if MethodName = 'HASFIELD' then
+ Result := _TfrxDataSet.HasField(Caller.Params[0])
+ else if MethodName = 'ISBLOBFIELD' then
+ Result := _TfrxDataSet.IsBlobField(Caller.Params[0])
+ else if MethodName = 'GETFIELDLIST' then
+ _TfrxDataSet.GetFieldList(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'DISPLAYTEXT.GET' then
+ Result := _TfrxDataSet.DisplayText[Caller.Params[0]]
+ else if MethodName = 'DISPLAYWIDTH.GET' then
+ Result := _TfrxDataSet.DisplayWidth[Caller.Params[0]]
+ else if MethodName = 'FIELDTYPE.GET' then
+ Result := _TfrxDataSet.FieldType[Caller.Params[0]]
+ else if MethodName = 'VALUE.GET' then
+ Result := _TfrxDataSet.Value[Caller.Params[0]]
+ end
+ else if ClassType = TfrxComponent then
+ begin
+ if MethodName = 'CLEAR' then
+ TfrxComponent(Instance).Clear
+ else if MethodName = 'FINDOBJECT' then
+ Result := frxInteger(TfrxComponent(Instance).FindObject(Caller.Params[0]))
+ else if MethodName = 'LOADFROMSTREAM' then
+ TfrxComponent(Instance).LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVETOSTREAM' then
+ TfrxComponent(Instance).SaveToStream(TStream(frxInteger(Caller.Params[0])), Caller.Params[1])
+ else if MethodName = 'SETBOUNDS' then
+ TfrxComponent(Instance).SetBounds(Caller.Params[0], Caller.Params[1], Caller.Params[2], Caller.Params[3])
+ end
+ else if ClassType = TfrxDialogControl then
+ begin
+ if MethodName = 'SETFOCUS' then
+ if TfrxDialogControl(Instance).Control is TControl then
+ TControl(TfrxDialogControl(Instance).Control).SetFocus;
+ end
+ else if ClassType = TfrxStretcheable then
+ begin
+ if MethodName = 'CALCHEIGHT' then
+ Result := TfrxStretcheable(Instance).CalcHeight
+ end
+ else if ClassType = TfrxCustomMemoView then
+ begin
+ if MethodName = 'CALCWIDTH' then
+ Result := TfrxCustomMemoView(Instance).CalcWidth
+ end
+ else if ClassType = TfrxPictureView then
+ begin
+ if MethodName = 'LOADFROMFILE' then
+ TfrxPictureView(Instance).Picture.LoadFromFile(Caller.Params[0])
+ end
+ else if ClassType = TfrxDialogPage then
+ begin
+ if MethodName = 'SHOWMODAL' then
+ Result := TfrxDialogPage(Instance).ShowModal
+ end
+ else if ClassType = TfrxVariables then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TfrxVariables(Instance).Create)
+ else if MethodName = 'VARIABLES.GET' then
+ Result := TfrxVariables(Instance).Variables[Caller.Params[0]]
+ else if MethodName = 'VARIABLES.SET' then
+ TfrxVariables(Instance).Variables[Caller.Params[0]] := Caller.Params[1]
+ end
+ else if ClassType = TfrxArray then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TfrxArray(Instance).Create)
+ else if MethodName = 'VARIABLES.GET' then
+ Result := TfrxArray(Instance).Variables[Caller.Params[0]]
+ else if MethodName = 'VARIABLES.SET' then
+ TfrxArray(Instance).Variables[Caller.Params[0]] := Caller.Params[1]
+ end
+ else if ClassType = TfrxReport then
+ begin
+ if MethodName = 'CALC' then
+ Result := TfrxReport(Instance).Calc(Caller.Params[0], TfsScript(1))
+ else if MethodName = 'GETDATASET' then
+ Result := frxInteger(TfrxReport(Instance).GetDataset(Caller.Params[0]))
+ else if MethodName = 'LOADFROMFILE' then
+ Result := TfrxReport(Instance).LoadFromFile(Caller.Params[0])
+ else if MethodName = 'SAVETOFILE' then
+ TfrxReport(Instance).SaveToFile(Caller.Params[0])
+ else if MethodName = 'SHOWREPORT' then
+ TfrxReport(Instance).ShowReport
+ end
+ else if ClassType = TfrxCustomEngine then
+ begin
+ if MethodName = 'ADDANCHOR' then
+ TfrxPreviewPages(TfrxCustomEngine(Instance).PreviewPages).AddAnchor(Caller.Params[0])
+ else if MethodName = 'GETANCHORPAGE' then
+ Result := TfrxPreviewPages(TfrxCustomEngine(Instance).PreviewPages).GetAnchorPage(Caller.Params[0])
+ else if MethodName = 'NEWPAGE' then
+ TfrxCustomEngine(Instance).NewPage
+ else if MethodName = 'NEWCOLUMN' then
+ TfrxCustomEngine(Instance).NewColumn
+ else if MethodName = 'FREESPACE' then
+ Result := TfrxCustomEngine(Instance).FreeSpace
+ else if MethodName = 'SHOWBAND' then
+ TfrxCustomEngine(Instance).ShowBand(TfrxBand(frxInteger(Caller.Params[0])))
+ else if MethodName = 'STOPREPORT' then
+ TfrxCustomEngine(Instance).StopReport
+ end
+ else if ClassType = TfrxCustomOutline then
+ begin
+ if MethodName = 'ADDITEM' then
+ TfrxCustomOutline(Instance).AddItem(Caller.Params[0],
+ Round(TfrxCustomOutline(Instance).Engine.CurY))
+ else if MethodName = 'LEVELROOT' then
+ TfrxCustomOutline(Instance).LevelRoot
+ else if MethodName = 'LEVELUP' then
+ TfrxCustomOutline(Instance).LevelUp
+ end
+ else if ClassType = TfrxStyles then
+ begin
+ if MethodName = 'CREATE' then
+ Result := frxInteger(TfrxStyles(Instance).Create(TfrxReport(frxInteger(Caller.Params[0]))))
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TfrxStyles(Instance).Items[Caller.Params[0]])
+ else if MethodName = 'ADD' then
+ Result := frxInteger(TfrxStyles(Instance).Add)
+ else if MethodName = 'FIND' then
+ Result := frxInteger(TfrxStyles(Instance).Find(Caller.Params[0]))
+ else if MethodName = 'APPLY' then
+ TfrxStyles(Instance).Apply
+ else if MethodName = 'GETLIST' then
+ TfrxStyles(Instance).GetList(TStrings(frxInteger(Caller.Params[0])))
+ else if MethodName = 'LOADFROMFILE' then
+ TfrxStyles(Instance).LoadFromFile(Caller.Params[0])
+ else if MethodName = 'LOADFROMSTREAM' then
+ TfrxStyles(Instance).LoadFromStream(TStream(frxInteger(Caller.Params[0])))
+ else if MethodName = 'SAVETOFILE' then
+ TfrxStyles(Instance).SaveToFile(Caller.Params[0])
+ else if MethodName = 'SAVETOSTREAM' then
+ TfrxStyles(Instance).SaveToStream(TStream(frxInteger(Caller.Params[0])))
+ end
+ else if MethodName = 'DAYOF' then
+ Result := StrToInt(FormatDateTime('d', Caller.Params[0]))
+ else if MethodName = 'MONTHOF' then
+ Result := StrToInt(FormatDateTime('m', Caller.Params[0]))
+ else if MethodName = 'YEAROF' then
+ Result := StrToInt(FormatDateTime('yyyy', Caller.Params[0]))
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TWideStrings then
+ begin
+ if PropName = 'COUNT' then
+ Result := TWideStrings(Instance).Count
+ else if PropName = 'TEXT' then
+ Result := TWideStrings(Instance).Text
+ end
+ else if ClassType = TfrxDataSet then
+ begin
+ if PropName = 'RECNO' then
+ Result := TfrxDataSet(Instance).RecNo
+ end
+ else if ClassType = TfrxComponent then
+ begin
+ if PropName = 'OBJECTS' then
+ Result := frxInteger(TfrxComponent(Instance).Objects)
+ else if PropName = 'ALLOBJECTS' then
+ Result := frxInteger(TfrxComponent(Instance).AllObjects)
+ else if PropName = 'PARENT' then
+ Result := frxInteger(TfrxComponent(Instance).Parent)
+ else if PropName = 'PAGE' then
+ Result := frxInteger(TfrxComponent(Instance).Page)
+ else if PropName = 'ABSLEFT' then
+ Result := TfrxComponent(Instance).AbsLeft
+ else if PropName = 'ABSTOP' then
+ Result := TfrxComponent(Instance).AbsTop
+ end
+ else if ClassType = TfrxView then
+ begin
+ if PropName = 'TAGSTR' then
+ Result := TfrxView(Instance).TagStr
+ end
+ else if ClassType = TfrxCustomMemoView then
+ begin
+ if PropName = 'TEXT' then
+ Result := TfrxMemoView(Instance).Text
+ else if PropName = 'LINES' then
+ Result := frxInteger(TfrxMemoView(Instance).Memo)
+ else if PropName = 'VALUE' then
+ Result := TfrxMemoView(Instance).Value
+ end
+ else if ClassType = TfrxBand then
+ begin
+ if PropName = 'OVERFLOW' then
+ Result := TfrxBand(Instance).Overflow
+ end
+ else if ClassType = TfrxDialogPage then
+ begin
+ if PropName = 'MODALRESULT' then
+ Result := TfrxDialogPage(Instance).ModalResult
+ end
+ else if ClassType = TfrxReport then
+ begin
+ if PropName = 'TERMINATED' then
+ Result := TfrxReport(Instance).Terminated
+ else if PropName = 'VARIABLES' then
+ Result := frxInteger(TfrxReport(Instance).Variables)
+ else if PropName = 'STYLES' then
+ Result := frxInteger(TfrxReport(Instance).Styles)
+ end
+ else if ClassType = TfrxEngineOptions then
+ begin
+ if PropName = 'DESTROYFORMS' then
+ Result := TfrxEngineOptions(Instance).DestroyForms
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TWideStrings then
+ begin
+ if PropName = 'TEXT' then
+ TWideStrings(Instance).Text := Value
+ end
+ else if ClassType = TfrxComponent then
+ begin
+ if PropName = 'PARENT' then
+ TfrxComponent(Instance).Parent := TfrxComponent(frxInteger(Value))
+ end
+ else if ClassType = TfrxView then
+ begin
+ if PropName = 'TAGSTR' then
+ TfrxView(Instance).TagStr := Value
+ end
+ else if ClassType = TfrxCustomMemoView then
+ begin
+ if PropName = 'TEXT' then
+ TfrxMemoView(Instance).Text := Value
+ else if PropName = 'LINES' then
+ TfrxMemoView(Instance).Memo.Assign(TStrings(frxInteger(Value)));
+ end
+ else if ClassType = TfrxDialogPage then
+ begin
+ if PropName = 'MODALRESULT' then
+ TfrxDialogPage(Instance).ModalResult := Value
+ end
+ else if ClassType = TfrxReport then
+ begin
+ if PropName = 'TERMINATED' then
+ TfrxReport(Instance).Terminated := Value
+ end
+ else if ClassType = TfrxEngineOptions then
+ begin
+ if PropName = 'DESTROYFORMS' then
+ TfrxEngineOptions(Instance).DestroyForms := Value
+ end
+end;
+
+
+initialization
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ if fsRTTIModules <> nil then
+ fsRTTIModules.Remove(TFunctions);
+
+end.
+
diff --git a/LibD28x64/FMX.frxCmapTableClass.pas b/LibD28x64/FMX.frxCmapTableClass.pas
new file mode 100644
index 0000000..76f9b92
--- /dev/null
+++ b/LibD28x64/FMX.frxCmapTableClass.pas
@@ -0,0 +1,275 @@
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Font parser }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Aleksey Mandrykin, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCmapTableClass;
+interface
+
+uses System.SysUtils, FMX.TTFHelpers, FMX.frxTrueTypeTable;
+
+
+ type // Nested Types
+ EncodingFormats = (ByteEncoding=0, HighByteMapping=2, SegmentMapping=4, TrimmedTable=6);
+ TSmallintArray = array of Smallint;
+ TWordArray = array of Word;
+
+ TSegmentMapping = packed record
+ public segCountX2: Word;
+ public searchRange: Word;
+ public entrySelector: Word;
+ public rangeShift: Word;
+ end;
+
+ Table_CMAP = packed record
+ public TableVersion: Word;
+ public NumSubTables: Word;
+ end;
+
+ Table_Encode = packed record
+ public
+ Format: Word;
+ Length: Word;
+ Version: Word;
+ end;
+
+ Table_ByteEncodingSubTable = packed record
+ public
+ Format: Word;
+ Length: Word;
+ language: Word;
+ GlyphIndexArray: Array[0 .. 255] of Byte;
+ end;
+
+ Table_SUBMAP = packed record
+ public Platform: Word;
+ public EncodingID: Word;
+ public TableOffset: Cardinal;
+ end;
+
+
+ TCmapSubTableTable = class(TObject);
+ TCmapByteEncodingSubTable = class(TCmapSubTableTable)
+ private
+ FGlyphIndexArray: Array[0 .. 255] of Byte;
+ public
+ function GetGlyphIndex(ch: Byte): Word;
+ end;
+
+ TMappingTable = packed record
+ public
+ EndCount: TWordArray;
+ GlyphIndexArray: TWordArray;
+ idDelta: TSmallintArray;
+ idRangeOffset: TWordArray;
+ StartCount: TWordArray;
+ segment_count: Integer;
+ end;
+
+ CmapTableClass = class(TrueTypeTable)
+ // Fields
+ private
+ FByteEncodingSubTable: TCmapByteEncodingSubTable;
+ FWinCmap: TMappingTable;
+ FMacCmap: TMappingTable;
+ // Methods
+ function InternalGlyphIndex(CMapTable:TMappingTable; ch: Word): Word;
+ public
+ constructor Create(src: TrueTypeTable);
+ destructor Destroy; override;
+ public function GetGlyphIndex(ch: Word): Word;
+ private function LoadCmapSegment(segment_ptr: Pointer; segment_count: Integer): TWordArray;
+ public procedure LoadCmapTable(font: Pointer);
+ strict private function LoadSignedCmapSegment(segment_ptr: Pointer; segment_count: Integer): TSmallintArray;
+end;
+
+implementation
+
+// Methods
+constructor CmapTableClass.Create(src: TrueTypeTable);
+begin
+ inherited Create(src);
+ FWinCmap.segment_count := 0;
+ FMacCmap.segment_count := 0;
+ FWinCmap.StartCount := nil;
+ FMacCmap.StartCount := nil;
+ FWinCmap.EndCount := nil;
+ FMacCmap.EndCount := nil;
+end;
+
+destructor CmapTableClass.Destroy;
+begin
+ FreeAndNil(FByteEncodingSubTable);
+ inherited;
+end;
+
+function CmapTableClass.GetGlyphIndex(ch: Word): Word;
+begin
+{$IFDEF MACOS}
+ Result := InternalGlyphIndex(FMacCmap, ch);
+ if Result = 0 then
+ Result := InternalGlyphIndex(FWinCmap, ch);
+{$ELSE}
+ Result := InternalGlyphIndex(FWinCmap, ch);
+ if Result = 0 then
+ Result := InternalGlyphIndex(FMacCmap, ch);
+{$ENDIF}
+ if Assigned(FByteEncodingSubTable) and (Result = 0) then
+ Result := FByteEncodingSubTable.GetGlyphIndex(Byte(ch));
+end;
+
+function CmapTableClass.InternalGlyphIndex(CMapTable: TMappingTable;
+ ch: Word): Word;
+var
+ i,j: Integer;
+begin
+ Result := 0;
+ i := 0;
+ while ((i < CMapTable.segment_count)) do
+ begin
+ if (CMapTable.EndCount[i] >= ch) then
+ begin
+ if (CMapTable.StartCount[i] > ch) then
+ exit;
+ if (CMapTable.idRangeOffset[i] = 0) then
+ begin
+ Result := Word((ch + CMapTable.idDelta[i]) mod $10000);
+ exit
+ end;
+ j := Word(((CMapTable.idRangeOffset[i] div 2) +
+ (ch - CMapTable.StartCount[i])) - (CMapTable.segment_count - i));
+ Result := CMapTable.GlyphIndexArray[j];
+ exit;
+ end;
+ inc(i)
+ end;
+end;
+
+function CmapTableClass.LoadCmapSegment(segment_ptr: Pointer; segment_count: Integer): TWordArray;
+ var
+ i: Integer;
+ ptr: ^Word;
+ begin
+ ptr := segment_ptr;
+ SetLength(Result, segment_count);
+ i := 0;
+ while ((i < segment_count)) do
+ begin
+ Result[i] := TTF_Helpers.SwapUInt16(ptr^);
+ Inc(i);
+ Inc(ptr);
+ end;
+ end;
+
+ procedure CmapTableClass.LoadCmapTable(font: Pointer);
+ var
+ encode_ptr: ^Table_Encode;
+ encode: Table_Encode;
+ cmap: ^Table_CMAP;
+ j, i, subtables_count: Integer;
+ submap: Table_SUBMAP;
+ submap_ptr: ^Table_SUBMAP;
+ ByteEncodingSubTable: ^Table_ByteEncodingSubTable;
+ segment: TSegmentMapping;
+ segment_ptr: ^TSegmentMapping;
+ index_array_size: Cardinal;
+ CurCmap: ^TMappingTable;
+ begin
+ cmap := TTF_Helpers.Increment( font, self.entry.offset );
+ subtables_count := TTF_Helpers.SwapUInt16(cmap.NumSubTables);
+ submap_ptr := TTF_Helpers.Increment(cmap, SizeOf(Table_CMAP));
+ j := 0;
+ while ((j < subtables_count)) do
+ begin
+// submap := submap_ptr;
+ submap.Platform := TTF_Helpers.SwapUInt16(submap_ptr.Platform);
+ submap.EncodingID := TTF_Helpers.SwapUInt16(submap_ptr.EncodingID);
+ submap.TableOffset := TTF_Helpers.SwapUInt32(submap_ptr.TableOffset);
+ submap_ptr := TTF_Helpers.Increment(submap_ptr, SizeOf(Table_SUBMAP));
+ if ((submap.Platform in [1, 3]) and (submap.EncodingID in [0, 1])) then
+ begin
+ case submap.Platform of
+ 1: CurCmap := @FMacCmap;
+ else
+ CurCmap := @FWinCmap;
+ end;
+ encode_ptr := TTF_Helpers.Increment(cmap, submap.TableOffset);
+// encode := encode_ptr;
+ encode.Format := TTF_Helpers.SwapUInt16(encode_ptr.Format);
+ encode.Length := TTF_Helpers.SwapUInt16(encode_ptr.Length);
+ encode.Version := TTF_Helpers.SwapUInt16(encode_ptr.Version);
+ case encode.Format of
+ 0:
+ begin
+ if FByteEncodingSubTable = nil then
+ FByteEncodingSubTable := TCmapByteEncodingSubTable.Create;
+ ByteEncodingSubTable := (Pointer(encode_ptr));
+ for i := 0 to 255 do
+ FByteEncodingSubTable.FGlyphIndexArray[i] := ByteEncodingSubTable.GlyphIndexArray[i];
+ end;
+ 4:
+ begin
+ segment_ptr := TTF_Helpers.Increment(encode_ptr, SizeOf(Table_Encode));
+// segment := encode_ptr;
+ segment.segCountX2 := TTF_Helpers.SwapUInt16(segment_ptr.segCountX2);
+ segment.searchRange := TTF_Helpers.SwapUInt16(segment_ptr.searchRange);
+ segment.entrySelector := TTF_Helpers.SwapUInt16(segment_ptr.entrySelector);
+ segment.rangeShift := TTF_Helpers.SwapUInt16(segment_ptr.rangeShift);
+ CurCmap^.segment_count := (segment.segCountX2 div 2);
+
+ encode_ptr := TTF_Helpers.Increment(segment_ptr, SizeOf(TSegmentMapping));
+ CurCmap^.endCount := self.LoadCmapSegment(encode_ptr, CurCmap^.segment_count);
+ encode_ptr := TTF_Helpers.Increment(encode_ptr, (segment.segCountX2 + 2));
+ CurCmap^.startCount := self.LoadCmapSegment(encode_ptr, CurCmap^.segment_count);
+ encode_ptr := TTF_Helpers.Increment(encode_ptr, segment.segCountX2);
+ CurCmap^.idDelta := self.LoadSignedCmapSegment(encode_ptr, CurCmap^.segment_count);
+ encode_ptr := TTF_Helpers.Increment(encode_ptr, segment.segCountX2);
+ CurCmap^.idRangeOffset := self.LoadCmapSegment(encode_ptr, CurCmap^.segment_count);
+
+ index_array_size := Cardinal((8 + (4 * CurCmap^.segment_count)) * 2);
+ index_array_size := ((inherited length - index_array_size) div 2);
+ encode_ptr := TTF_Helpers.Increment(encode_ptr, segment.segCountX2);
+
+ CurCmap^.GlyphIndexArray := self.LoadCmapSegment(encode_ptr, index_array_size);
+ end;
+ end
+ end;
+ inc(j);
+ continue;
+ ;
+
+ end
+ end;
+
+ function CmapTableClass.LoadSignedCmapSegment(segment_ptr: Pointer; segment_count: Integer ): TSmallintArray;
+ var
+ i: Integer;
+ p : PWord;
+ begin
+ SetLength(Result, segment_count);
+ p := segment_ptr;
+ i := 0;
+ while ((i < segment_count)) do
+ begin
+ {$R-}
+ Result[i] := TTF_Helpers.SwapInt16(p^);
+ {$R+}
+ inc(i);
+ inc(p);
+ end;
+ end;
+
+{ TCmapByteEncodingSubTable }
+
+function TCmapByteEncodingSubTable.GetGlyphIndex(ch: Byte): Word;
+begin
+ Result := FGlyphIndexArray[ch];
+end;
+
+end.
diff --git a/LibD28x64/FMX.frxCodeUtils.pas b/LibD28x64/FMX.frxCodeUtils.pas
new file mode 100644
index 0000000..835e0b4
--- /dev/null
+++ b/LibD28x64/FMX.frxCodeUtils.pas
@@ -0,0 +1,271 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Code window utils }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCodeUtils;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.Classes, System.SysUtils, System.TypInfo, System.Variants;
+
+
+procedure frxGetEventHandlersList(Code: TStrings; const Language: String;
+ EventType: PTypeInfo; List: TStrings);
+function frxLocateEventHandler(Code: TStrings; const Language,
+ EventName: String): Integer;
+function frxLocateMainProc(Code: TStrings; const Language: String): Integer;
+function frxAddEvent(Code: TStrings; const Language: String;
+ EventType: PTypeInfo; const EventName: String): Integer;
+procedure frxEmptyCode(Code: TStrings; const Language: String);
+procedure frxAddCodeRes;
+
+implementation
+
+uses FMX.frxRes;
+
+procedure frxAddCodeRes;
+begin
+ with frxResources do
+ begin
+ Add('PascalScript',
+ 'proc="procedure" begin="begin" end="end;" lastend="end."'
+ + ' openquote="{" closequote="}"');
+ Add('C++Script',
+ 'proc="void" begin="{" end="}" lastend="}"'
+ + ' openquote="/*" closequote="*/"');
+ Add('BasicScript',
+ 'proc="sub" begin="" end="end sub" lastend=""'
+ + ' openquote="/\" closequote="/\"');
+ Add('JScript',
+ 'proc="function" begin="{" end="}" lastend=""'
+ + ' openquote="/*" closequote="*/"');
+
+ Add('TfrxNotifyEvent',
+ 'PascalScript=(Sender: TfrxComponent);' + #13#10 +
+ 'C++Script=(TfrxComponent Sender)' + #13#10 +
+ 'BasicScript=(Sender)' + #13#10 +
+ 'JScript=(Sender)');
+ Add('TfrxCloseQueryEvent',
+ 'PascalScript=(Sender: TfrxComponent; var CanClose: Boolean);' + #13#10 +
+ 'C++Script=(TfrxComponent Sender, bool &CanClose)' + #13#10 +
+ 'BasicScript=(Sender, byref CanClose)' + #13#10 +
+ 'JScript=(Sender, &CanClose)');
+ Add('TfrxKeyEvent',
+ 'PascalScript=(Sender: TfrxComponent; var Key: Word; Shift: Integer);' + #13#10 +
+ 'C++Script=(TfrxComponent Sender, word &Key, int Shift)' + #13#10 +
+ 'BasicScript=(Sender, byref Key, Shift)' + #13#10 +
+ 'JScript=(Sender, &Key, Shift)');
+ Add('TfrxKeyPressEvent',
+ 'PascalScript=(Sender: TfrxComponent; var Key: Char);' + #13#10 +
+ 'C++Script=(TfrxComponent Sender, char &Key)' + #13#10 +
+ 'BasicScript=(Sender, byref Key)' + #13#10 +
+ 'JScript=(Sender, &Key)');
+ Add('TfrxMouseEvent',
+ 'PascalScript=(Sender: TfrxComponent; Button: TMouseButton; Shift: Integer; X, Y: Integer);' + #13#10 +
+ 'C++Script=(TfrxComponent Sender, TMouseButton Button, int Shift, int X, int Y)' + #13#10 +
+ 'BasicScript=(Sender, Button, Shift, X, Y)' + #13#10 +
+ 'JScript=(Sender, Button, Shift, X, Y)');
+ Add('TfrxMouseMoveEvent',
+ 'PascalScript=(Sender: TfrxComponent; Shift: Integer; X, Y: Integer);' + #13#10 +
+ 'C++Script=(TfrxComponent Sender, int Shift, int X, int Y)' + #13#10 +
+ 'BasicScript=(Sender, Shift, X, Y)' + #13#10 +
+ 'JScript=(Sender, Shift, X, Y)');
+ Add('TfrxPreviewClickEvent',
+ 'PascalScript=(Sender: TfrxView; Button: TMouseButton; Shift: Integer; var Modified: Boolean);' + #13#10 +
+ 'C++Script=(TfrxView Sender, TMouseButton Button, int Shift, bool &Modified)' + #13#10 +
+ 'BasicScript=(Sender, Button, Shift, byref Modified)' + #13#10 +
+ 'JScript=(Sender, Button, Shift, &Modified)');
+ Add('TfrxRunDialogsEvent',
+ 'PascalScript=(var Result: Boolean);' + #13#10 +
+ 'C++Script=(bool &Result)' + #13#10 +
+ 'BasicScript=(byref Result)' + #13#10 +
+ 'JScript=(&Result)');
+ end;
+end;
+
+function GetLangParam(const Language, Param: String): String;
+var
+ s: String;
+ i: Integer;
+begin
+ Result := '';
+ s := frxResources.Get(Language);
+ if s = Language then Exit;
+
+ i := Pos(AnsiUppercase(Param) + '="', AnsiUppercase(s));
+ if (i <> 0) and ((i = 1) or (s[i - 1] = ' ')) then
+ begin
+ Result := Copy(s, i + Length(Param + '="'), MaxInt);
+ Result := Copy(Result, 1, Pos('"', Result) - 1);
+ end;
+end;
+
+function GetEventParams(EventType: PTypeInfo; const Language: String): String;
+var
+ s: String;
+ sl: TStringList;
+begin
+ Result := '';
+ s := frxResources.Get(String(EventType.Name));
+ if s = String(EventType.Name) then Exit;
+
+ sl := TStringList.Create;
+ sl.Text := s;
+ Result := sl.Values[Language];
+ sl.Free;
+end;
+
+procedure frxGetEventHandlersList(Code: TStrings; const Language: String;
+ EventType: PTypeInfo; List: TStrings);
+var
+ i, InComment: Integer;
+ s, EventName, EventWord, EventParams, OpenQuote, CloseQuote: String;
+begin
+ List.Clear;
+ EventParams := GetEventParams(EventType, Language);
+ EventWord := AnsiUppercase(GetLangParam(Language, 'proc'));
+ OpenQuote := GetLangParam(Language, 'openquote');
+ CloseQuote := GetLangParam(Language, 'closequote');
+ InComment := 0;
+
+ for i := 0 to Code.Count - 1 do
+ begin
+ s := Code[i];
+ if Pos(CloseQuote, Code[i]) <> 0 then
+ Dec(InComment);
+ if Pos(OpenQuote, Code[i]) <> 0 then
+ Inc(InComment);
+ if (Pos(EventWord, AnsiUppercase(s)) = 1) and (InComment = 0) then
+ begin
+ { delete the "procedure" word }
+ Delete(s, 1, Length(EventWord));
+ { extract the event name and params }
+ EventName := Trim(Copy(s, 1, Pos('(', s) - 1));
+ s := Trim(Copy(s, Pos('(', s), 255));
+ { compare the params }
+ if AnsiCompareText(s, EventParams) = 0 then
+ List.Add(EventName);
+ end;
+ end;
+end;
+
+function frxLocateEventHandler(Code: TStrings; const Language,
+ EventName: String): Integer;
+var
+ i, InComment: Integer;
+ s, OpenQuote, CloseQuote: String;
+begin
+ Result := -1;
+ OpenQuote := GetLangParam(Language, 'openquote');
+ CloseQuote := GetLangParam(Language, 'closequote');
+ InComment := 0;
+ s := UpperCase(GetLangParam(Language, 'proc') + ' ' + EventName + '(');
+
+ for i := 0 to Code.Count - 1 do
+ begin
+ if Pos(CloseQuote, Code[i]) <> 0 then
+ Dec(InComment);
+ if Pos(OpenQuote, Code[i]) <> 0 then
+ Inc(InComment);
+ if (Pos(s, UpperCase(Code[i])) = 1) and (InComment = 0) then
+ begin
+ Result := i;
+ break;
+ end;
+ end;
+end;
+
+function frxLocateMainProc(Code: TStrings; const Language: String): Integer;
+var
+ i, endCount, InComment: Integer;
+ s, BeginStr, EndStr: String;
+ OpenQuote, CloseQuote: String;
+begin
+ Result := -1;
+
+ BeginStr := GetLangParam(Language, 'begin');
+ EndStr := GetLangParam(Language, 'lastend');
+ OpenQuote := GetLangParam(Language, 'openquote');
+ CloseQuote := GetLangParam(Language, 'closequote');
+
+ if EndStr = '' then
+ begin
+ Result := Code.Count - 1;
+ Exit;
+ end;
+
+ i := Code.Count - 1;
+ InComment := 0;
+ while i >= 0 do
+ begin
+ s := AnsiUpperCase(Code[i]);
+ Dec(i);
+ if Pos(CloseQuote, s) <> 0 then
+ Inc(InComment);
+ if Pos(OpenQuote, s) <> 0 then
+ Dec(InComment);
+
+ if (Pos(AnsiUpperCase(EndStr), s) <> 0) and (InComment = 0) then
+ break;
+ end;
+
+ if i < 0 then Exit;
+
+ EndStr := GetLangParam(Language, 'end');
+ endCount := 1;
+ while (i >= 0) and (endCount <> 0) do
+ begin
+ s := AnsiUpperCase(Code[i]);
+ if Pos(AnsiUpperCase(EndStr), s) <> 0 then
+ Inc(endCount);
+ if Pos(AnsiUpperCase(BeginStr), s) <> 0 then
+ Dec(endCount);
+ Dec(i);
+ end;
+
+ Result := i + 1;
+end;
+
+function frxAddEvent(Code: TStrings; const Language: String;
+ EventType: PTypeInfo; const EventName: String): Integer;
+var
+ MainProcIndex: Integer;
+begin
+ Result := -1;
+ MainProcIndex := frxLocateMainProc(Code, Language);
+ if MainProcIndex = -1 then Exit;
+
+ Code.Insert(MainProcIndex, GetLangParam(Language, 'proc') + ' ' + EventName +
+ GetEventParams(EventType, Language));
+ Code.Insert(MainProcIndex + 1, GetLangParam(Language, 'begin'));
+ Code.Insert(MainProcIndex + 2, '');
+ Code.Insert(MainProcIndex + 3, GetLangParam(Language, 'end'));
+ Code.Insert(MainProcIndex + 4, '');
+ Result := MainProcIndex + 3;
+end;
+
+procedure frxEmptyCode(Code: TStrings; const Language: String);
+begin
+ Code.Clear;
+ if GetLangParam(Language, 'lastend') <> '' then
+ begin
+ Code.Add(GetLangParam(Language, 'begin'));
+ Code.Add('');
+ Code.Add(GetLangParam(Language, 'lastend'));
+ end;
+end;
+
+
+
+end.
diff --git a/LibD28x64/FMX.frxConnWizard.fmx b/LibD28x64/FMX.frxConnWizard.fmx
new file mode 100644
index 0000000..b80197b
--- /dev/null
+++ b/LibD28x64/FMX.frxConnWizard.fmx
@@ -0,0 +1,249 @@
+object frxConnectionWizardForm: TfrxConnectionWizardForm
+ Left = 0
+ Top = 0
+ BorderIcons = [biSystemMenu]
+ BorderStyle = bsSingle
+ Caption = 'Connection Wizard'
+ ClientHeight = 307
+ ClientWidth = 300
+ Position = poScreenCenter
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ OnClose = FormClose
+ object OKB: TButton
+ Default = True
+ DisableFocusEffect = False
+ Height = 25.000000000000000000
+ ModalResult = 1
+ Position.X = 140.000000000000000000
+ Position.Y = 276.000000000000000000
+ Width = 75.000000000000000000
+ OnClick = OKBClick
+ end
+ object CancelB: TButton
+ DisableFocusEffect = False
+ Height = 25.000000000000000000
+ ModalResult = 2
+ Position.X = 220.000000000000000000
+ Position.Y = 276.000000000000000000
+ Width = 75.000000000000000000
+ end
+ object PageControl1: TTabControl
+ Height = 265.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 4.000000000000000000
+ TabIndex = 0
+ Width = 293.000000000000000000
+ object ConnTS: TTabItem
+ WordWrap = False
+ Height = 24.000000000000000000
+ Position.X = 1.000000000000000000
+ Text = 'ConnTS'
+ Width = 57.000000000000000000
+ object ConnL1: TLabel
+ Height = 13.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 4.000000000000000000
+ Width = 205.000000000000000000
+ end
+ object DBL: TLabel
+ Height = 13.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 60.000000000000000000
+ Width = 269.000000000000000000
+ end
+ object LoginL: TLabel
+ Height = 13.000000000000000000
+ Position.X = 20.000000000000000000
+ Position.Y = 164.000000000000000000
+ Width = 93.000000000000000000
+ end
+ object PasswordL: TLabel
+ Height = 13.000000000000000000
+ Position.X = 20.000000000000000000
+ Position.Y = 188.000000000000000000
+ Width = 93.000000000000000000
+ end
+ object ChooseB: TSpeedButton
+ Height = 22.000000000000000000
+ Position.X = 256.000000000000000000
+ Position.Y = 80.000000000000000000
+ Text = '...'
+ Width = 23.000000000000000000
+ OnClick = ChooseBClick
+ end
+ object ConnCB: TComboBox
+ DisableFocusEffect = False
+ Height = 21.000000000000000000
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ ListBoxResource = 'transparentlistboxstyle'
+ Position.X = 16.000000000000000000
+ Position.Y = 24.000000000000000000
+ TabOrder = 0
+ Width = 157.000000000000000000
+ OnClick = ConnCBClick
+ end
+ object DatabaseE: TEdit
+ TabOrder = 1
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ Password = False
+ Position.X = 16.000000000000000000
+ Position.Y = 80.000000000000000000
+ Width = 237.000000000000000000
+ Height = 21.000000000000000000
+ end
+ object LoginE: TEdit
+ TabOrder = 2
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ Password = False
+ Position.X = 116.000000000000000000
+ Position.Y = 160.000000000000000000
+ Width = 121.000000000000000000
+ Height = 21.000000000000000000
+ end
+ object PasswordE: TEdit
+ TabOrder = 3
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ Password = False
+ Position.X = 116.000000000000000000
+ Position.Y = 184.000000000000000000
+ Width = 121.000000000000000000
+ Height = 21.000000000000000000
+ end
+ object PromptRB: TRadioButton
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ IsChecked = True
+ Position.X = 4.000000000000000000
+ Position.Y = 116.000000000000000000
+ TabOrder = 4
+ Width = 245.000000000000000000
+ end
+ object LoginRB: TRadioButton
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 136.000000000000000000
+ TabOrder = 5
+ Width = 245.000000000000000000
+ end
+ end
+ object TableTS: TTabItem
+ WordWrap = False
+ Height = 24.000000000000000000
+ Text = 'TableTS'
+ Width = 58.000000000000000000
+ object ConnL2: TLabel
+ Height = 13.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 4.000000000000000000
+ Width = 205.000000000000000000
+ end
+ object TableL: TLabel
+ Height = 13.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 60.000000000000000000
+ Width = 189.000000000000000000
+ end
+ object ConnCB1: TComboBox
+ DisableFocusEffect = False
+ Height = 21.000000000000000000
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ ListBoxResource = 'transparentlistboxstyle'
+ Position.X = 16.000000000000000000
+ Position.Y = 24.000000000000000000
+ TabOrder = 0
+ Width = 157.000000000000000000
+ OnClick = ConnCB1Click
+ end
+ object TableCB: TComboBox
+ DisableFocusEffect = False
+ Height = 21.000000000000000000
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ ListBoxResource = 'transparentlistboxstyle'
+ Position.X = 16.000000000000000000
+ Position.Y = 80.000000000000000000
+ TabOrder = 1
+ Width = 157.000000000000000000
+ end
+ object FilterCB: TCheckBox
+ DisableFocusEffect = False
+ Height = 17.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 116.000000000000000000
+ TabOrder = 2
+ Width = 225.000000000000000000
+ end
+ object FilterE: TEdit
+ TabOrder = 3
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ Password = False
+ Position.X = 16.000000000000000000
+ Position.Y = 140.000000000000000000
+ Width = 157.000000000000000000
+ Height = 21.000000000000000000
+ end
+ end
+ object QueryTS: TTabItem
+ WordWrap = False
+ Height = 24.000000000000000000
+ Text = 'QueryTS'
+ Width = 61.000000000000000000
+ object ConnL3: TLabel
+ Height = 13.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 4.000000000000000000
+ Width = 173.000000000000000000
+ end
+ object QueryL: TLabel
+ Height = 13.000000000000000000
+ Position.X = 4.000000000000000000
+ Position.Y = 60.000000000000000000
+ Width = 75.000000000000000000
+ end
+ object ConnCB2: TComboBox
+ DisableFocusEffect = False
+ Height = 21.000000000000000000
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ ListBoxResource = 'transparentlistboxstyle'
+ Position.X = 16.000000000000000000
+ Position.Y = 24.000000000000000000
+ TabOrder = 0
+ Width = 157.000000000000000000
+ OnClick = ConnCB2Click
+ end
+ object ToolBar1: TToolBar
+ Align = alNone
+ Height = 29.000000000000000000
+ Position.X = 232.000000000000000000
+ Position.Y = 48.000000000000000000
+ TabOrder = 1
+ Width = 53.000000000000000000
+ object BuildSQLB: TfrxToolButton
+ Height = 24.000000000000000000
+ Position.X = 3.000000000000000000
+ Position.Y = 4.000000000000000000
+ Text = 'BuildSQLB'
+ Width = 24.000000000000000000
+ Hint = ''
+ end
+ object ParamsB: TfrxToolButton
+ Height = 24.000000000000000000
+ Position.X = 27.000000000000000000
+ Position.Y = 4.000000000000000000
+ Text = 'ParamsB'
+ Width = 24.000000000000000000
+ Hint = ''
+ end
+ end
+ end
+ end
+end
diff --git a/LibD28x64/FMX.frxConnWizard.pas b/LibD28x64/FMX.frxConnWizard.pas
new file mode 100644
index 0000000..9b4a4b9
--- /dev/null
+++ b/LibD28x64/FMX.frxConnWizard.pas
@@ -0,0 +1,551 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ DB Connection wizard }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxConnWizard;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Controls, FMX.Forms,
+ FMX.Dialogs, FMX.frxFMX, System.UITypes, System.UIConsts,
+ FMX.frxClass, FMX.fs_SynMemo, FMX.frxCustomDB, FMX.Types,
+ System.Variants, FMX.TabControl, FMX.Edit, FMX.ListBox
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF QBUILDER}
+, FMX.fqbClass
+{$ENDIF};
+
+type
+ TfrxDBConnWizard = class(TfrxCustomWizard)
+ private
+ FDatabase: TfrxCustomDatabase;
+ public
+ class function GetDescription: String; override;
+ function Execute: Boolean; override;
+ property Database: TfrxCustomDatabase read FDatabase write FDatabase;
+ end;
+
+ TfrxDBTableWizard = class(TfrxCustomWizard)
+ public
+ class function GetDescription: String; override;
+ function Execute: Boolean; override;
+ end;
+
+ TfrxDBQueryWizard = class(TfrxCustomWizard)
+ public
+ class function GetDescription: String; override;
+ function Execute: Boolean; override;
+ end;
+
+ TfrxConnectionWizardForm = class(TForm)
+ OKB: TButton;
+ CancelB: TButton;
+ PageControl1: TTabControl;
+ ConnTS: TTabItem;
+ TableTS: TTabItem;
+ ConnL1: TLabel;
+ DBL: TLabel;
+ LoginL: TLabel;
+ PasswordL: TLabel;
+ ChooseB: TSpeedButton;
+ ConnCB: TComboBox;
+ DatabaseE: TEdit;
+ LoginE: TEdit;
+ PasswordE: TEdit;
+ PromptRB: TRadioButton;
+ LoginRB: TRadioButton;
+ ConnL2: TLabel;
+ ConnCB1: TComboBox;
+ TableL: TLabel;
+ TableCB: TComboBox;
+ FilterCB: TCheckBox;
+ FilterE: TEdit;
+ QueryTS: TTabItem;
+ ConnL3: TLabel;
+ ConnCB2: TComboBox;
+ QueryL: TLabel;
+ ToolBar1: TToolBar;
+ BuildSQLB: TfrxToolButton;
+ ParamsB: TfrxToolButton;
+ procedure FormCreate(Sender: TObject);
+ procedure ChooseBClick(Sender: TObject);
+ procedure ConnCBClick(Sender: TObject);
+ procedure FormHide(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure ConnCB1Click(Sender: TObject);
+ procedure ConnCB2Click(Sender: TObject);
+ procedure BuildSQLBClick(Sender: TObject);
+ procedure ParamsBClick(Sender: TObject);
+ procedure OKBClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ FComponent: TfrxComponent;
+ FDatabase: TfrxCustomDatabase;
+ FDesigner: TfrxCustomDesigner;
+ FItem: Integer;
+ FItemIndex: Integer;
+ FMemo: TfsSyntaxMemo;
+ FOldItem: Integer;
+ FPage: TfrxPage;
+ FQuery: TfrxCustomQuery;
+ FReport: TfrxReport;
+ FTable: TfrxCustomTable;
+ public
+ { Public declarations }
+ end;
+
+
+implementation
+
+
+{$R *.FMX}
+{$R *.res}
+
+uses FMX.frxUtils, FMX.frxDsgnIntf, FMX.frxRes, FMX.frxEditQueryParams, FMX.frxBaseModalForm;
+
+const
+ dbiConnection = 0;
+ dbiTable = 1;
+ dbiQuery = 2;
+
+
+{ TfrxDBConnWizard }
+
+class function TfrxDBConnWizard.GetDescription: String;
+begin
+ Result := frxResources.Get('wzDBConn');
+end;
+
+function TfrxDBConnWizard.Execute: Boolean;
+begin
+ with TfrxConnectionWizardForm.Create(Owner) do
+ begin
+ FDesigner := Self.Designer;
+ FReport := Report;
+ FItem := dbiConnection;
+ FDatabase := Self.FDatabase;
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ FDesigner.PeekLastModalResult;
+ Free;
+ end;
+end;
+
+
+{ TfrxDBTableWizard }
+
+class function TfrxDBTableWizard.GetDescription: String;
+begin
+ Result := frxResources.Get('wzDBTable');
+end;
+
+function TfrxDBTableWizard.Execute: Boolean;
+begin
+ with TfrxConnectionWizardForm.Create(Owner) do
+ begin
+ FDesigner := Self.Designer;
+ FReport := Report;
+ FItem := dbiTable;
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ FDesigner.PeekLastModalResult;
+ Free;
+ end;
+end;
+
+
+{ TfrxDBQueryWizard }
+
+class function TfrxDBQueryWizard.GetDescription: String;
+begin
+ Result := frxResources.Get('wzDBQuery');
+end;
+
+function TfrxDBQueryWizard.Execute: Boolean;
+begin
+ with TfrxConnectionWizardForm.Create(Owner) do
+ begin
+ FDesigner := Self.Designer;
+ FReport := Report;
+ FItem := dbiQuery;
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ FDesigner.PeekLastModalResult;
+ Free;
+ end;
+end;
+
+
+{ TfrxConnectionWizardForm }
+
+procedure TfrxConnectionWizardForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ FormHide(Self);
+end;
+
+procedure TfrxConnectionWizardForm.FormCreate(Sender: TObject);
+var
+ i: Integer;
+begin
+ Caption := frxGet(5700);
+ OKB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ ConnTS.Text := frxGet(5701);
+ ConnL1.Text := frxGet(5702);
+ ConnL2.Text := ConnL1.Text;
+ ConnL3.Text := ConnL1.Text;
+ DBL.Text := frxGet(5703);
+ LoginL.Text := frxGet(5704);
+ PasswordL.Text := frxGet(5705);
+ PromptRB.Text := frxGet(5706);
+ LoginRB.Text := frxGet(5707);
+ TableTS.Text := frxGet(5708);
+ TableL.Text := frxGet(5709);
+ FilterCB.Text := frxGet(5710);
+ QueryTS.Text := frxGet(5711);
+ QueryL.Text := frxGet(5712);
+ BuildSQLB.Hint := frxGet(5713);
+ ParamsB.Hint := frxGet(5714);
+
+ //Toolbar1.Images := frxResources.MainButtonImages;
+
+ frxResources.LoadImageFromResouce(BuildSQLB.Bitmap, 5, 8);
+ frxResources.LoadImageFromResouce(ParamsB.Bitmap, 5, 6);
+
+ FOldItem := dbiConnection;
+ FMemo := TfsSyntaxMemo.Create(Self);
+ with FMemo do
+ begin
+ Parent := QueryTS;
+ SetBounds(16, 80, 265, 153);
+ SyntaxType := stSQL;
+ ShowGutter := False;
+ Fill.Color := claWhite;
+
+{$I frxEditSQL.inc}
+ end;
+
+{$IFNDEF QBUILDER}
+ BuildSQLB.Visible := False;
+{$ENDIF}
+
+ ConnCB1.Items.Add(frxResources.Get('prNotAssigned'));
+ ConnCB2.Items.Add(frxResources.Get('prNotAssigned'));
+ for i := 0 to frxObjects.Count - 1 do
+ if frxObjects[i].ClassRef <> nil then
+ if frxObjects[i].ClassRef.InheritsFrom(TfrxCustomDatabase) then
+ ConnCB.Items.AddObject(frxObjects[i].ClassRef.GetDescription, Pointer(i))
+ else if frxObjects[i].ClassRef.InheritsFrom(TfrxCustomTable) then
+ ConnCB1.Items.AddObject(frxObjects[i].ClassRef.GetDescription, Pointer(i))
+ else if frxObjects[i].ClassRef.InheritsFrom(TfrxCustomQuery) then
+ ConnCB2.Items.AddObject(frxObjects[i].ClassRef.GetDescription, Pointer(i));
+
+// if UseRightToLeftAlignment then
+// FlipChildren(True);
+end;
+
+procedure TfrxConnectionWizardForm.FormShow(Sender: TObject);
+var
+ i: Integer;
+begin
+ FPage := FReport.Pages[0];
+
+ if FItem = dbiConnection then
+ begin
+ PageControl1.ActiveTab := ConnTS;
+ ConnTS.Visible := True;
+ TableTS.Visible := False;
+ QueryTS.Visible := False;
+ if FDatabase <> nil then
+ begin
+ for i := 0 to ConnCB.Items.Count - 1 do
+ if frxObjects[frxInteger(ConnCB.Items.Objects[i])].ClassRef = FDatabase.ClassType then
+ begin
+ ConnCB.ItemIndex := i;
+ break;
+ end;
+ ConnCB.Enabled := False;
+ DatabaseE.Text := FDatabase.DatabaseName;
+ end
+ else
+ begin
+ if (FItem <> dbiConnection) and (ConnCB.Items.Count > 1) then
+ ConnCB.ItemIndex := 1
+ else
+ ConnCB.ItemIndex := 0;
+ ConnCBClick(nil);
+ end;
+ end
+ else if FItem = dbiTable then
+ begin
+ PageControl1.ActiveTab := TableTS;
+ ConnTS.Visible := False;
+ TableTS.Visible := True;
+ QueryTS.Visible := False;
+ if FItemIndex <> 0 then
+ ConnCB1.ItemIndex := FItemIndex
+ else if ConnCB1.Items.Count > 1 then
+ ConnCB1.ItemIndex := 1
+ else
+ ConnCB1.ItemIndex := 0;
+ ConnCB1Click(nil);
+ end
+ else if FItem = dbiQuery then
+ begin
+ PageControl1.ActiveTab := QueryTS;
+ ConnTS.Visible := False;
+ TableTS.Visible := False;
+ QueryTS.Visible := True;
+ if FItemIndex <> 0 then
+ ConnCB2.ItemIndex := FItemIndex
+ else if ConnCB2.Items.Count > 1 then
+ ConnCB2.ItemIndex := 1
+ else
+ ConnCB2.ItemIndex := 0;
+ ConnCB2Click(nil);
+ end;
+end;
+
+procedure TfrxConnectionWizardForm.FormHide(Sender: TObject);
+begin
+ if FItem = dbiConnection then
+ begin
+ FComponent := FDatabase;
+ if ConnCB.Enabled = False then
+ FComponent := nil;
+ end
+ else if FItem = dbiTable then
+ FComponent := FTable
+ else if FItem = dbiQuery then
+ FComponent := FQuery;
+
+ if FComponent <> nil then
+ if ModalResult = mrCancel then
+ FComponent.Free
+ else
+ begin
+ FComponent.CreateUniqueName;
+ FDesigner.ReloadReport;
+ end;
+end;
+
+procedure TfrxConnectionWizardForm.OKBClick(Sender: TObject);
+begin
+ if FItem = dbiConnection then
+ begin
+ if FDatabase = nil then Exit;
+ FDatabase.DatabaseName := DatabaseE.Text;
+ if PromptRB.IsChecked then
+ FDatabase.LoginPrompt := True
+ else
+ begin
+ FDatabase.LoginPrompt := False;
+ FDatabase.SetLogin(LoginE.Text, PasswordE.Text);
+ end;
+ FComponent := FDatabase;
+ if ConnCB.Items.Count > ConnCB.ItemIndex + 1 then
+ FItemIndex := ConnCB.ItemIndex + 1;
+ end
+ else if FItem = dbiTable then
+ begin
+ if FTable = nil then Exit;
+ if TableCB.Selected <> nil then
+ FTable.TableName := TableCB.Selected.Text;
+ FTable.Filter := FilterE.Text;
+ FTable.Filtered := FilterCB.IsChecked;
+ FComponent := FTable;
+ end
+ else if FItem = dbiQuery then
+ begin
+ if FQuery = nil then Exit;
+ FQuery.SQL.Assign(FMemo.Lines);
+ FComponent := FQuery;
+ end;
+
+ if FOldItem <> dbiConnection then
+ begin
+ FComponent.CreateUniqueName;
+ FItem := FOldItem;
+ FOldItem := dbiConnection;
+ ModalResult := mrNone;
+ FormShow(nil);
+ end;
+end;
+
+procedure TfrxConnectionWizardForm.ConnCBClick(Sender: TObject);
+var
+ ClassRef: TClass;
+begin
+ if FDatabase <> nil then
+ begin
+ FDatabase.Free;
+ FDatabase := nil;
+ end;
+ ClassRef := frxObjects[frxInteger(ConnCB.Items.Objects[ConnCB.ItemIndex])].ClassRef;
+ FDatabase := TfrxCustomDatabase(ClassRef.NewInstance);
+ FDatabase.Create(FPage);
+ FDatabase.SetBounds((FPage.Objects.Count - 1) * 100 + 30, 20, 32, 32);
+end;
+
+procedure TfrxConnectionWizardForm.ConnCB1Click(Sender: TObject);
+var
+ i: Integer;
+ ClassRef: TClass;
+ propList: TfrxPropertyList;
+begin
+ if FTable <> nil then
+ begin
+ FTable.Free;
+ FTable := nil;
+ end;
+ if ConnCB1.ItemIndex = 0 then Exit;
+
+ ClassRef := frxObjects[frxInteger(ConnCB1.Items.Objects[ConnCB1.ItemIndex])].ClassRef;
+ FTable := TfrxCustomTable(ClassRef.NewInstance);
+ FTable.DesignCreate(FPage, 0);
+ FTable.SetBounds((FPage.Objects.Count - 1) * 100 + 30, 20, 32, 32);
+
+ propList := TfrxPropertyList.Create(nil);
+ propList.Component := FTable;
+ for i := 0 to propList.Count - 1 do
+ if propList[i].Editor.GetName = 'TableName' then
+ begin
+ propList[i].Editor.GetValues;
+ TableCB.Items := propList[i].Editor.Values;
+ end;
+ propList.Free;
+
+ if not FTable.DBConnected then
+ begin
+ FTable.Free;
+ FTable := nil;
+ FOldItem := FItem;
+ FItem := dbiConnection;
+ FItemIndex := ConnCB1.ItemIndex;
+ FormShow(nil);
+ end;
+end;
+
+procedure TfrxConnectionWizardForm.ConnCB2Click(Sender: TObject);
+var
+ ClassRef: TClass;
+begin
+ if FQuery <> nil then
+ begin
+ FQuery.Free;
+ FQuery := nil;
+ end;
+ if ConnCB2.ItemIndex = 0 then Exit;
+
+ ClassRef := frxObjects[frxInteger(ConnCB2.Items.Objects[ConnCB2.ItemIndex])].ClassRef;
+ FQuery := TfrxCustomQuery(ClassRef.NewInstance);
+ FQuery.DesignCreate(FPage, 0);
+ FQuery.SetBounds((FPage.Objects.Count - 1) * 100 + 30, 20, 32, 32);
+
+ if not FQuery.DBConnected then
+ begin
+ FQuery.Free;
+ FQuery := nil;
+ FOldItem := FItem;
+ FItem := dbiConnection;
+ FItemIndex := ConnCB2.ItemIndex;
+ FormShow(nil);
+ end;
+end;
+
+procedure TfrxConnectionWizardForm.ChooseBClick(Sender: TObject);
+var
+ i: Integer;
+ propList: TfrxPropertyList;
+begin
+ propList := TfrxPropertyList.Create(nil);
+ propList.Component := FDatabase;
+ for i := 0 to propList.Count - 1 do
+ if (CompareText(propList[i].Editor.GetName, 'DatabaseName') = 0) or
+ (CompareText(propList[i].Editor.GetName, 'ConnectionName') = 0) then
+ begin
+ propList[i].Editor.Edit;
+ DatabaseE.Text := FDatabase.DatabaseName;
+ break;
+ end;
+ propList.Free;
+
+ DatabaseE.SetFocus;
+end;
+
+procedure TfrxConnectionWizardForm.BuildSQLBClick(Sender: TObject);
+{$IFDEF QBUILDER}
+var
+ fqbDialog: TfqbDialog;
+{$ENDIF}
+begin
+{$IFDEF QBUILDER}
+ if FQuery = nil then Exit;
+ fqbDialog := TfqbDialog.Create(nil);
+ try
+ fqbDialog.Engine := FQuery.QBEngine;
+ fqbDialog.SchemaInsideSQL := False;
+ fqbDialog.SQL := FMemo.Lines.Text;
+ fqbDialog.SQLSchema := FQuery.SQLSchema;
+
+ if fqbDialog.Execute then
+ begin
+ FMemo.Lines.Text := fqbDialog.SQL;
+ FQuery.SQLSchema := fqbDialog.SQLSchema;
+ end;
+ finally
+ fqbDialog.Free;
+ end;
+{$ENDIF}
+end;
+
+procedure TfrxConnectionWizardForm.ParamsBClick(Sender: TObject);
+begin
+ if FQuery <> nil then
+ begin
+ FQuery.SQL.Assign(FMemo.Lines);
+ if FQuery.Params.Count <> 0 then
+ with TfrxParamsEditorForm.Create(FDesigner) do
+ begin
+ Params := FQuery.Params;
+ FormShow(Self);
+ if ShowModal = mrOk then
+ FQuery.UpdateParams;
+ Free;
+ end;
+ end;
+end;
+
+procedure TfrxConnectionWizardForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VK_F1 then
+ frxResources.Help(Self);
+end;
+
+
+initialization
+ frxWizards.Register1(TfrxDBConnWizard, 2);
+ frxWizards.Register1(TfrxDBTableWizard, 3);
+ frxWizards.Register1(TfrxDBQueryWizard, 4);
+
+finalization
+ frxWizards.Unregister(TfrxDBConnWizard);
+ frxWizards.Unregister(TfrxDBTableWizard);
+ frxWizards.Unregister(TfrxDBQueryWizard);
+
+end.
diff --git a/LibD28x64/FMX.frxConnWizard.res b/LibD28x64/FMX.frxConnWizard.res
new file mode 100644
index 0000000..bc19066
Binary files /dev/null and b/LibD28x64/FMX.frxConnWizard.res differ
diff --git a/LibD28x64/FMX.frxCross.pas b/LibD28x64/FMX.frxCross.pas
new file mode 100644
index 0000000..cc9f8ca
--- /dev/null
+++ b/LibD28x64/FMX.frxCross.pas
@@ -0,0 +1,4377 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Cross object }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCross;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Controls, System.UITypes, System.UIConsts, System.Types, FMX.Types, FMX.Forms,
+ FMX.frxClass, System.Variants
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxCrossObject = class(TComponent); // fake component
+
+ TfrxPrintCellEvent = type String;
+ TfrxPrintHeaderEvent = type String;
+ TfrxCalcWidthEvent = type String;
+ TfrxCalcHeightEvent = type String;
+ TfrxOnPrintCellEvent = procedure (Memo: TfrxCustomMemoView;
+ RowIndex, ColumnIndex, CellIndex: Integer;
+ const RowValues, ColumnValues, Value: Variant) of object;
+ TfrxOnPrintHeaderEvent = procedure (Memo: TfrxCustomMemoView;
+ const HeaderIndexes, HeaderValues, Value: Variant) of object;
+ TfrxOnCalcWidthEvent = procedure (ColumnIndex: Integer;
+ const ColumnValues: Variant; var Width: Extended) of object;
+ TfrxOnCalcHeightEvent = procedure (RowIndex: Integer;
+ const RowValues: Variant; var Height: Extended) of object;
+
+ { the record represents one cell of cross matrix }
+ PfrCrossCell = ^TfrxCrossCell;
+ TfrxCrossCell = packed record
+ Value: Variant;
+ Count: Integer;
+ Next: PfrCrossCell; { pointer to the next value in the same cell }
+ end;
+
+ TfrxCrossSortOrder = (soAscending, soDescending, soNone, soGrouping);
+ TfrxCrossFunction = (cfNone, cfSum, cfMin, cfMax, cfAvg, cfCount);
+ TfrxVariantArray = array of Variant;
+ TfrxSortArray = array [0..31] of TfrxCrossSortOrder;
+
+ { the base class for column/row item. Contains Indexes array that
+ identifies a column/row }
+ TfrxIndexItem = class(TCollectionItem)
+ private
+ FIndexes: TfrxVariantArray;
+ public
+ destructor Destroy; override;
+ property Indexes: TfrxVariantArray read FIndexes write FIndexes;
+ end;
+
+ { the base collection for column/row items. Contains methods for working
+ with Indexes and sorting them }
+ TfrxIndexCollection = class(TCollection)
+ private
+ FIndexesCount: Integer;
+ FSortOrder: TfrxSortArray;
+ function GetItems(Index: Integer): TfrxIndexItem;
+ public
+ function Find(const Indexes: array of Variant; var Index: Integer): Boolean;
+ function InsertItem(Index: Integer; const Indexes: array of Variant): TfrxIndexItem; virtual;
+ property Items[Index: Integer]: TfrxIndexItem read GetItems; default;
+ end;
+
+ { the class representing a single row item }
+ TfrxCrossRow = class(TfrxIndexItem)
+ private
+ FCellLevels: Integer;
+ FCells: TList;
+ procedure CreateCell(Index: Integer);
+ public
+ constructor Create(Collection: TCollection); override;
+ destructor Destroy; override;
+ function GetCell(Index: Integer): PfrCrossCell;
+ function GetCellValue(Index1, Index2: Integer): Variant;
+ procedure SetCellValue(Index1, Index2: Integer; const Value: Variant);
+ end;
+
+ { the class representing row items }
+ TfrxCrossRows = class(TfrxIndexCollection)
+ private
+ FCellLevels: Integer;
+ function GetItems(Index: Integer): TfrxCrossRow;
+ public
+ constructor Create;
+ function InsertItem(Index: Integer; const Indexes: array of Variant): TfrxIndexItem; override;
+ function Row(const Indexes: array of Variant): TfrxCrossRow;
+ property Items[Index: Integer]: TfrxCrossRow read GetItems; default;
+ end;
+
+ { the class representing a single column item }
+ TfrxCrossColumn = class(TfrxIndexItem)
+ private
+ FCellIndex: Integer;
+ public
+ property CellIndex: Integer read FCellIndex write FCellIndex;
+ end;
+
+ { the class representing column items }
+ TfrxCrossColumns = class(TfrxIndexCollection)
+ private
+ function GetItems(Index: Integer): TfrxCrossColumn;
+ public
+ constructor Create;
+ function Column(const Indexes: array of Variant): TfrxCrossColumn;
+ function InsertItem(Index: Integer; const Indexes: array of Variant): TfrxIndexItem; override;
+ property Items[Index: Integer]: TfrxCrossColumn read GetItems; default;
+ end;
+
+ { TfrxCrossHeader represents one cell of a cross header. The cell has a value,
+ position, size and list of subcells }
+ TfrxCrossHeader = class(TObject)
+ private
+ FBounds: TfrxRect; { bounds of the cell }
+ FMemos: TList;
+ FTotalMemos: TList;
+ FCounts: TfrxVariantArray;
+ FCellIndex: Integer; { help to determine cell index for cell header }
+ FCellLevels: Integer;
+ FFuncValues: TfrxVariantArray;
+ FHasCellHeaders: Boolean; { top level item only }
+ FIndex: Integer; { index of the item }
+ FIsCellHeader: Boolean;
+ FIsIndex: Boolean; { used in IndexItems to determine if item is index }
+ FIsTotal: Boolean; { is this cell a total cell }
+ FItems: TList; { subcells }
+ FLevelsCount: Integer; { number of header levels }
+ FMemo: TfrxCustomMemoView; { memo for this cell }
+ FNoLevels: Boolean; { true if no items in row/column header }
+ FParent: TfrxCrossHeader; { parent of the cell }
+ FSize: TfrxPoint;
+ FTotalIndex: Integer; { will help to choose which header memo to use }
+ FValue: Variant; { value (text) of the cell }
+ FVisible: Boolean; { visibility of the cell }
+
+ function AddCellHeader(Memos: TList; Index, CellIndex: Integer): TfrxCrossHeader;
+ function AddChild(Memo: TfrxCustomMemoView): TfrxCrossHeader;
+ procedure AddFuncValues(const Values, Counts: array of Variant;
+ const CellFunctions: array of TfrxCrossFunction);
+ procedure AddValues(const Values: array of Variant; Unsorted: Boolean);
+ procedure Reset(const CellFunctions: array of TfrxCrossFunction);
+
+ function GetCount: Integer;
+ function GetItems(Index: Integer): TfrxCrossHeader;
+ function GetLevel: Integer;
+ function GetHeight: Double;
+ function GetWidth: Double;
+ public
+ constructor Create(CellLevels: Integer);
+ destructor Destroy; override;
+ procedure CalcBounds; virtual; abstract;
+ procedure CalcSizes(MaxWidth, MinWidth: Integer; AutoSize: Boolean); virtual; abstract;
+
+ function AllItems: TList;
+ function Find(Value: Variant): Integer;
+ function GetIndexes: Variant;
+ function GetValues: Variant;
+ function TerminalItems: TList;
+ function IndexItems: TList;
+
+ property Bounds: TfrxRect read FBounds write FBounds;
+ property Count: Integer read GetCount;
+ property HasCellHeaders: Boolean read FHasCellHeaders write FHasCellHeaders;
+ property Height: Double read GetHeight;
+ property IsTotal: Boolean read FIsTotal;
+ property Items[Index: Integer]: TfrxCrossHeader read GetItems; default;
+ property Level: Integer read GetLevel;
+ property Memo: TfrxCustomMemoView read FMemo;
+ property Parent: TfrxCrossHeader read FParent;
+ property Value: Variant read FValue write FValue;
+ property Visible: Boolean read FVisible write FVisible;
+ property Width: Double read GetWidth;
+ end;
+
+ { the cross columns }
+ TfrxCrossColumnHeader = class(TfrxCrossHeader)
+ private
+ FCorner: TfrxCrossHeader;
+ public
+ procedure CalcBounds; override;
+ procedure CalcSizes(MaxWidth, MinWidth: Integer; AutoSize: Boolean); override;
+ end;
+
+ { the cross rows }
+ TfrxCrossRowHeader = class(TfrxCrossHeader)
+ private
+ FCorner: TfrxCrossHeader;
+ public
+ procedure CalcBounds; override;
+ procedure CalcSizes(MaxWidth, MinWidth: Integer; AutoSize: Boolean); override;
+ end;
+
+ { the cross corner }
+ TfrxCrossCorner = class(TfrxCrossColumnHeader)
+ end;
+
+
+ { cutted bands }
+ TfrxCutBandItem = class(TCollectionItem)
+ public
+ Band: TfrxBand;
+ FromIndex: Integer;
+ ToIndex: Integer;
+ destructor Destroy; override;
+ end;
+
+ TfrxCutBands = class(TCollection)
+ private
+ function GetItems(Index: Integer): TfrxCutBandItem;
+ public
+ constructor Create;
+ procedure Add(ABand: TfrxBand; AFromIndex, AToIndex: Integer);
+ property Items[Index: Integer]: TfrxCutBandItem read GetItems; default;
+ end;
+
+ { design-time grid resize support }
+ TfrxGridLineItem = class(TCollectionItem)
+ public
+ Coord: Double;
+ Objects: TList;
+ constructor Create(Collection: TCollection); override;
+ destructor Destroy; override;
+ end;
+
+ TfrxGridLines = class(TCollection)
+ private
+ function GetItems(Index: Integer): TfrxGridLineItem;
+ public
+ constructor Create;
+ procedure Add(AObj: TObject; ACoord: Double);
+ property Items[Index: Integer]: TfrxGridLineItem read GetItems; default;
+ end;
+
+
+ { custom cross object }
+ TfrxCustomCrossView = class(TfrxView)
+ private
+ FAddHeight: Double;
+ FAddWidth: Double;
+ FAllowDuplicates: Boolean;
+ FAutoSize: Boolean;
+ FBorder: Boolean;
+ FCellFields: TStrings;
+ FCellFunctions: array[0..31] of TfrxCrossFunction;
+ FCellLevels: Integer;
+ FClearBeforePrint: Boolean;
+ FColumnBands: TfrxCutBands;
+ FColumnFields: TStrings;
+ FColumnHeader: TfrxCrossColumnHeader;
+ FColumnLevels: Integer;
+ FColumns: TfrxCrossColumns;
+ FColumnSort: TfrxSortArray;
+ FCorner: TfrxCrossCorner;
+ FDefHeight: Integer;
+ FDotMatrix: Boolean;
+ FDownThenAcross: Boolean;
+ FFirstMousePos: TPoint;
+ FGapX: Integer;
+ FGapY: Integer;
+ FGridUsed: TfrxGridLines;
+ FGridX: TfrxGridLines;
+ FGridY: TfrxGridLines;
+ FJoinEqualCells: Boolean;
+ FKeepTogether: Boolean;
+ FLastMousePos: TPoint;
+ FMaxWidth: Integer;
+ FMinWidth: Integer;
+ FMouseDown: Boolean;
+ FMovingObjects: Integer;
+ FNextCross: TfrxCustomCrossView;
+ FNextCrossGap: Double;
+ FNoColumns: Boolean;
+ FNoRows: Boolean;
+ FPlainCells: Boolean;
+ FRepeatHeaders: Boolean;
+ FRowBands: TfrxCutBands;
+ FRowFields: TStrings;
+ FRowHeader: TfrxCrossRowHeader;
+ FRowLevels: Integer;
+ FRows: TfrxCrossRows;
+ FRowSort: TfrxSortArray;
+ FShowColumnHeader: Boolean;
+ FShowColumnTotal: Boolean;
+ FShowCorner: Boolean;
+ FShowRowHeader: Boolean;
+ FShowRowTotal: Boolean;
+ FShowTitle: Boolean;
+ FSuppressNullRecords: Boolean;
+ FKeepRowsTogether: Boolean;
+
+ FOnCalcHeight: TfrxCalcHeightEvent; { script event }
+ FOnCalcWidth: TfrxCalcWidthEvent; { script event }
+ FOnPrintCell: TfrxPrintCellEvent; { script event }
+ FOnPrintColumnHeader: TfrxPrintHeaderEvent; { script event }
+ FOnPrintRowHeader: TfrxPrintHeaderEvent; { script event }
+ FOnBeforeCalcHeight: TfrxOnCalcHeightEvent; { Delphi event }
+ FOnBeforeCalcWidth: TfrxOnCalcWidthEvent; { Delphi event }
+ FOnBeforePrintCell: TfrxOnPrintCellEvent; { Delphi event }
+ FOnBeforePrintColumnHeader: TfrxOnPrintHeaderEvent; { Delphi event }
+ FOnBeforePrintRowHeader: TfrxOnPrintHeaderEvent; { Delphi event }
+
+ procedure CalcBounds(addWidth, addHeight: Extended);
+ procedure CalcTotal(Header: TfrxCrossHeader; Source: TfrxIndexCollection);
+ procedure CalcTotals;
+ procedure CreateHeader(Header: TfrxCrossHeader; Source: TfrxIndexCollection;
+ Totals: TList; TotalVisible: Boolean);
+ procedure CreateHeaders;
+ procedure BuildColumnBands;
+ procedure BuildRowBands;
+ procedure ClearMatrix;
+ procedure ClearMemos;
+ procedure CreateCellHeaderMemos(NewCount: Integer);
+ procedure CreateCellMemos(NewCount: Integer);
+ procedure CreateColumnMemos(NewCount: Integer);
+ procedure CreateCornerMemos(NewCount: Integer);
+ procedure CreateRowMemos(NewCount: Integer);
+ procedure CorrectDMPBounds(Memo: TfrxCustomMemoView);
+ procedure DoCalcHeight(Row: Integer; var Height: Extended);
+ procedure DoCalcWidth(Column: Integer; var Width: Extended);
+ procedure DoOnCell(Memo: TfrxCustomMemoView; Row, Column, Cell: Integer;
+ const Value: Variant);
+ procedure DoOnColumnHeader(Memo: TfrxCustomMemoView; Header: TfrxCrossHeader);
+ procedure DoOnRowHeader(Memo: TfrxCustomMemoView; Header: TfrxCrossHeader);
+ procedure InitMatrix;
+ procedure InitMemos(AddToScript: Boolean);
+ procedure ReadMemos(Stream: TStream);
+ procedure RenderMatrix;
+ procedure SetCellFields(const Value: TStrings);
+ procedure SetCellFunctions(Index: Integer; const Value: TfrxCrossFunction);
+ procedure SetColumnFields(const Value: TStrings);
+ procedure SetColumnSort(Index: Integer; Value: TfrxCrossSortOrder);
+ procedure SetDotMatrix(const Value: Boolean);
+ procedure SetRowFields(const Value: TStrings);
+ procedure SetRowSort(Index: Integer; Value: TfrxCrossSortOrder);
+ procedure SetupOriginalComponent(Obj1, Obj2: TfrxComponent);
+ procedure UpdateVisibility;
+ procedure WriteMemos(Stream: TStream);
+ function CreateMemo(Parent: TfrxComponent): TfrxCustomMemoView;
+ function GetCellFunctions(Index: Integer): TfrxCrossFunction;
+ function GetCellHeaderMemos(Index: Integer): TfrxCustomMemoView;
+ function GetCellMemos(Index: Integer): TfrxCustomMemoView;
+ function GetColumnMemos(Index: Integer): TfrxCustomMemoView;
+ function GetColumnSort(Index: Integer): TfrxCrossSortOrder;
+ function GetColumnTotalMemos(Index: Integer): TfrxCustomMemoView;
+ function GetCornerMemos(Index: Integer): TfrxCustomMemoView;
+ function GetRowMemos(Index: Integer): TfrxCustomMemoView;
+ function GetRowSort(Index: Integer): TfrxCrossSortOrder;
+ function GetRowTotalMemos(Index: Integer): TfrxCustomMemoView;
+ protected
+ FAllMemos: TList;
+ FCellMemos: TList;
+ FCellHeaderMemos: TList;
+ FColumnMemos: TList;
+ FColumnTotalMemos: TList;
+ FCornerMemos: TList;
+ FRowMemos: TList;
+ FRowTotalMemos: TList;
+ procedure DefineProperties(Filer: TFiler); override;
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetCellLevels(const Value: Integer); virtual;
+ procedure SetColumnLevels(const Value: Integer); virtual;
+ procedure SetRowLevels(const Value: Integer); virtual;
+ function GetContainerObjects: TList; override;
+ function GetNestedObjects: TList;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ procedure BeforePrint; override;
+ procedure BeforeStartReport; override;
+ procedure GetData; override;
+ procedure AddSourceObjects; override;
+ function ContainerAdd(Obj: TfrxComponent): Boolean; override;
+ function ContainerMouseDown(Sender: TObject; X, Y: Integer): Boolean; override;
+ procedure ContainerMouseMove(Sender: TObject; X, Y: Integer); override;
+ procedure ContainerMouseUp(Sender: TObject; X, Y: Integer); override;
+
+ procedure AddValue(const Rows, Columns, Cells: array of Variant);
+ procedure ApplyStyle(Style: TfrxStyles);
+ procedure BeginMatrix;
+ procedure EndMatrix;
+ procedure FillMatrix; virtual;
+ procedure GetStyle(Style: TfrxStyles);
+
+ function ColCount: Integer;
+ function DrawCross(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended): TfrxPoint;
+ function GetColumnIndexes(AColumn: Integer): Variant;
+ function GetRowIndexes(ARow: Integer): Variant;
+ function GetValue(ARow, AColumn, ACell: Integer): Variant;
+ function IsCrossValid: Boolean; virtual;
+ function IsGrandTotalColumn(Index: Integer): Boolean;
+ function IsGrandTotalRow(Index: Integer): Boolean;
+ function IsTotalColumn(Index: Integer): Boolean;
+ function IsTotalRow(Index: Integer): Boolean;
+ function RowCount: Integer;
+ function RowHeaderWidth: Double;
+ function ColumnHeaderHeight: Double;
+
+ property ColumnHeader: TfrxCrossColumnHeader read FColumnHeader;
+ property RowHeader: TfrxCrossRowHeader read FRowHeader;
+ property Corner: TfrxCrossCorner read FCorner;
+ property NoColumns: Boolean read FNoColumns;
+ property NoRows: Boolean read FNoRows;
+
+ property CellFields: TStrings read FCellFields write SetCellFields;
+ property CellFunctions[Index: Integer]: TfrxCrossFunction read GetCellFunctions
+ write SetCellFunctions;
+ property CellMemos[Index: Integer]: TfrxCustomMemoView read GetCellMemos;
+ property CellHeaderMemos[Index: Integer]: TfrxCustomMemoView read GetCellHeaderMemos;
+ property ClearBeforePrint: Boolean read FClearBeforePrint write FClearBeforePrint;
+ property ColumnFields: TStrings read FColumnFields write SetColumnFields;
+ property ColumnMemos[Index: Integer]: TfrxCustomMemoView read GetColumnMemos;
+ property ColumnSort[Index: Integer]: TfrxCrossSortOrder read GetColumnSort
+ write SetColumnSort;
+ property ColumnTotalMemos[Index: Integer]: TfrxCustomMemoView read GetColumnTotalMemos;
+ property CornerMemos[Index: Integer]: TfrxCustomMemoView read GetCornerMemos;
+ property DotMatrix: Boolean read FDotMatrix;
+ property RowFields: TStrings read FRowFields write SetRowFields;
+ property RowMemos[Index: Integer]: TfrxCustomMemoView read GetRowMemos;
+ property RowSort[Index: Integer]: TfrxCrossSortOrder read GetRowSort
+ write SetRowSort;
+ property RowTotalMemos[Index: Integer]: TfrxCustomMemoView read GetRowTotalMemos;
+ property OnBeforeCalcHeight: TfrxOnCalcHeightEvent
+ read FOnBeforeCalcHeight write FOnBeforeCalcHeight;
+ property OnBeforeCalcWidth: TfrxOnCalcWidthEvent
+ read FOnBeforeCalcWidth write FOnBeforeCalcWidth;
+ property OnBeforePrintCell: TfrxOnPrintCellEvent
+ read FOnBeforePrintCell write FOnBeforePrintCell;
+ property OnBeforePrintColumnHeader: TfrxOnPrintHeaderEvent
+ read FOnBeforePrintColumnHeader write FOnBeforePrintColumnHeader;
+ property OnBeforePrintRowHeader: TfrxOnPrintHeaderEvent
+ read FOnBeforePrintRowHeader write FOnBeforePrintRowHeader;
+ published
+ property AddHeight: Double read FAddHeight write FAddHeight;
+ property AddWidth: Double read FAddWidth write FAddWidth;
+ property AllowDuplicates: Boolean read FAllowDuplicates write FAllowDuplicates default True;
+ property AutoSize: Boolean read FAutoSize write FAutoSize default True;
+ property Border: Boolean read FBorder write FBorder default True;
+ property CellLevels: Integer read FCellLevels write SetCellLevels default 1;
+ property ColumnLevels: Integer read FColumnLevels write SetColumnLevels default 1;
+ property DefHeight: Integer read FDefHeight write FDefHeight default 0;
+ property DownThenAcross: Boolean read FDownThenAcross write FDownThenAcross;
+ property GapX: Integer read FGapX write FGapX default 3;
+ property GapY: Integer read FGapY write FGapY default 3;
+ property JoinEqualCells: Boolean read FJoinEqualCells write FJoinEqualCells default False;
+ property KeepTogether: Boolean read FKeepTogether write FKeepTogether default False;
+ property KeepRowsTogether: Boolean read FKeepRowsTogether write FKeepRowsTogether default False;
+ property MaxWidth: Integer read FMaxWidth write FMaxWidth default 200;
+ property MinWidth: Integer read FMinWidth write FMinWidth default 0;
+ property NextCross: TfrxCustomCrossView read FNextCross write FNextCross;
+ property NextCrossGap: Double read FNextCrossGap write FNextCrossGap;
+ property PlainCells: Boolean read FPlainCells write FPlainCells default False;
+ property RepeatHeaders: Boolean read FRepeatHeaders write FRepeatHeaders default True;
+ property RowLevels: Integer read FRowLevels write SetRowLevels default 1;
+ property ShowColumnHeader: Boolean read FShowColumnHeader write FShowColumnHeader default True;
+ property ShowColumnTotal: Boolean read FShowColumnTotal write FShowColumnTotal default True;
+ property ShowCorner: Boolean read FShowCorner write FShowCorner default True;
+ property ShowRowHeader: Boolean read FShowRowHeader write FShowRowHeader default True;
+ property ShowRowTotal: Boolean read FShowRowTotal write FShowRowTotal default True;
+ property ShowTitle: Boolean read FShowTitle write FShowTitle default True;
+ property SuppressNullRecords: Boolean read FSuppressNullRecords write FSuppressNullRecords default True;
+ property OnCalcHeight: TfrxCalcHeightEvent read FOnCalcHeight write FOnCalcHeight;
+ property OnCalcWidth: TfrxCalcWidthEvent read FOnCalcWidth write FOnCalcWidth;
+ property OnPrintCell: TfrxPrintCellEvent read FOnPrintCell write FOnPrintCell;
+ property OnPrintColumnHeader: TfrxPrintHeaderEvent
+ read FOnPrintColumnHeader write FOnPrintColumnHeader;
+ property OnPrintRowHeader: TfrxPrintHeaderEvent
+ read FOnPrintRowHeader write FOnPrintRowHeader;
+ end;
+
+ TfrxCrossView = class(TfrxCustomCrossView)
+ protected
+ procedure SetCellLevels(const Value: Integer); override;
+ procedure SetColumnLevels(const Value: Integer); override;
+ procedure SetRowLevels(const Value: Integer); override;
+ public
+ class function GetDescription: String; override;
+ function IsCrossValid: Boolean; override;
+ published
+ end;
+
+ TfrxDBCrossView = class(TfrxCustomCrossView)
+ private
+ public
+ class function GetDescription: String; override;
+ function IsCrossValid: Boolean; override;
+ procedure FillMatrix; override;
+ published
+ property CellFields;
+ property ColumnFields;
+ property DataSet;
+ property DataSetName;
+ property RowFields;
+ end;
+
+
+implementation
+
+uses
+{$IFNDEF NO_EDITORS}
+ FMX.frxCrossEditor,
+{$ENDIF}
+ FMX.frxCrossRTTI, FMX.frxDsgnIntf, FMX.frxXML, FMX.frxUtils, FMX.frxXMLSerializer, FMX.frxRes,
+ FMX.frxDMPClass, FMX.frxVariables, FMX.frxUnicodeUtils;
+
+type
+ THackComponent = class(TfrxComponent);
+ THackMemoView = class(TfrxCustomMemoView);
+
+
+function CalcSize(m: TfrxCustomMemoView): TfrxPoint;
+var
+ e, SaveHeight: Extended;
+begin
+ SaveHeight := m.Height;
+ m.Height := 10000;
+
+ Result.X := m.CalcWidth;
+ Result.Y := m.CalcHeight;
+
+ if m is TfrxDMPMemoView then
+ begin
+ Result.X := Result.X + fr1CharX;
+ Result.Y := Result.Y + fr1CharY;
+ end;
+
+ if (m.Rotation = 90) or (m.Rotation = 270) then
+ begin
+ e := Result.X;
+ Result.X := Result.Y;
+ Result.Y := e;
+ end;
+
+ m.Height := SaveHeight;
+end;
+
+
+{ TfrxIndexItem }
+
+destructor TfrxIndexItem.Destroy;
+begin
+ FIndexes := nil;
+ inherited;
+end;
+
+
+{ TfrxIndexCollection }
+
+function TfrxIndexCollection.GetItems(Index: Integer): TfrxIndexItem;
+begin
+ Result := TfrxIndexItem(inherited Items[Index]);
+end;
+
+function TfrxIndexCollection.Find(const Indexes: array of Variant;
+ var Index: Integer): Boolean;
+var
+ i, i0, i1, c: Integer;
+ Item: TfrxIndexItem;
+
+{compare function returns > 2 to keep equal columns/rows together without sorting}
+ function Compare: Integer;
+ var
+ i: Integer;
+ begin
+ Result := 1;
+ for i := 0 to FIndexesCount - 1 do
+ if Item.Indexes[i] = Indexes[i] then
+ begin
+ if (VarType(Indexes[i]) = varString) or (VarType(Indexes[i]) = varOleStr)
+ or (VarType(Indexes[i]) = varUString) then
+ if VarToWideStr(Item.Indexes[i]) = VarToWideStr(Indexes[i]) then
+ Result := 0
+ else
+ begin
+ Result := -1;
+ break;
+ end
+ else
+ Result := 0;
+ end
+ else if (Result = 0) and (FSortOrder[0] = {soNone} soGrouping) then
+ begin
+ Result := i + 2;
+ break;
+ end
+ else if VarIsNull(Indexes[i]) then
+ begin
+ if FSortOrder[i] = soAscending then
+ Result := 1 else
+ Result := -1;
+ break;
+ end
+ else if VarIsNull(Item.Indexes[i]) then
+ begin
+ if FSortOrder[i] = soAscending then
+ Result := -1 else
+ Result := 1;
+ break;
+ end
+ else if Item.Indexes[i] > Indexes[i] then
+ begin
+ if FSortOrder[i] = soAscending then
+ Result := 1 else
+ Result := -1;
+ break;
+ end
+ else if Item.Indexes[i] < Indexes[i] then
+ begin
+ if FSortOrder[i] = soAscending then
+ Result := -1 else
+ Result := 1;
+ break;
+ end;
+ end;
+
+begin
+ Result := False;
+ if FSortOrder[0] in [soNone, soGrouping] then
+ begin
+ i0 := 0;
+ Index := Count;
+ for i := 0 to Count - 1 do
+ begin
+ Item := TfrxIndexItem(Items[i]);
+ c := Compare;
+ if c = 0 then
+ begin
+ Result := True;
+ Index := i;
+ Exit;
+ end else if (c > 2) and (i0 <= c) then {place same colums together}
+ begin
+ Index := i + 1;
+ i0 := c;
+ end;
+ end;
+ Exit;
+ end;
+
+ { quick find }
+ i0 := 0;
+ i1 := Count - 1;
+
+ while i0 <= i1 do
+ begin
+ i := (i0 + i1) div 2;
+ Item := TfrxIndexItem(Items[i]);
+ c := Compare;
+
+ if c < 0 then
+ i0 := i + 1
+ else
+ begin
+ i1 := i - 1;
+ if c = 0 then
+ begin
+ Result := True;
+ i0 := i;
+ end;
+ end;
+ end;
+
+ Index := i0;
+end;
+
+function TfrxIndexCollection.InsertItem(Index: Integer;
+ const Indexes: array of Variant): TfrxIndexItem;
+var
+ i: Integer;
+begin
+ if Index < Count then
+ Result := TfrxIndexItem(Insert(Index)) else
+ Result := TfrxIndexItem(Add);
+ SetLength(Result.FIndexes, FIndexesCount);
+ for i := 0 to FIndexesCount - 1 do
+ Result.FIndexes[i] := Indexes[i];
+end;
+
+
+{ TfrxCrossRow }
+
+constructor TfrxCrossRow.Create;
+begin
+ inherited;
+ FCells := TList.Create;
+end;
+
+destructor TfrxCrossRow.Destroy;
+var
+ i: Integer;
+ c, c1: PfrCrossCell;
+begin
+ for i := 0 to FCells.Count - 1 do
+ begin
+ c := FCells[i];
+ while c <> nil do
+ begin
+ c1 := c;
+ c := c.Next;
+ VarClear(c1.Value);
+ Dispose(c1);
+ end;
+ end;
+
+ FCells.Free;
+ inherited;
+end;
+
+procedure TfrxCrossRow.CreateCell(Index: Integer);
+var
+ i: Integer;
+ c, c1: PfrCrossCell;
+begin
+ while Index >= FCells.Count do
+ begin
+ c1 := nil;
+ for i := 0 to FCellLevels - 1 do
+ begin
+ New(c);
+ c.Value := Null;
+ c.Count := 1;
+ c.Next := nil;
+ if c1 <> nil then
+ c1.Next := c else
+ FCells.Add(c);
+ c1 := c;
+ end;
+ end;
+end;
+
+function TfrxCrossRow.GetCellValue(Index1, Index2: Integer): Variant;
+var
+ c: PfrCrossCell;
+begin
+ Result := Null;
+ if (Index1 < 0) or (Index1 >= FCells.Count) then Exit;
+
+ c := FCells[Index1];
+ while (c <> nil) and (Index2 > 0) do
+ begin
+ c := c.Next;
+ Dec(Index2);
+ end;
+
+ if c <> nil then
+ Result := c.Value;
+end;
+
+procedure TfrxCrossRow.SetCellValue(Index1, Index2: Integer; const Value: Variant);
+var
+ c: PfrCrossCell;
+begin
+ if Index1 < 0 then Exit;
+ if Index1 >= FCells.Count then
+ CreateCell(Index1);
+
+ c := FCells[Index1];
+ while (c <> nil) and (Index2 > 0) do
+ begin
+ c := c.Next;
+ Dec(Index2);
+ end;
+ if c <> nil then
+ if c.Value = Null then
+ c.Value := Value else
+ c.Value := c.Value + Value;
+end;
+
+function TfrxCrossRow.GetCell(Index: Integer): PfrCrossCell;
+begin
+ Result := nil;
+ if Index < 0 then Exit;
+
+ if Index >= FCells.Count then
+ CreateCell(Index);
+
+ Result := FCells[Index];
+end;
+
+
+{ TfrxCrossRows }
+
+constructor TfrxCrossRows.Create;
+begin
+ inherited Create(TfrxCrossRow);
+end;
+
+function TfrxCrossRows.GetItems(Index: Integer): TfrxCrossRow;
+begin
+ Result := TfrxCrossRow(inherited Items[Index]);
+end;
+
+function TfrxCrossRows.InsertItem(Index: Integer;
+ const Indexes: array of Variant): TfrxIndexItem;
+begin
+ Result := inherited InsertItem(Index, Indexes);
+ TfrxCrossRow(Result).FCellLevels := FCellLevels;
+end;
+
+function TfrxCrossRows.Row(const Indexes: array of Variant): TfrxCrossRow;
+var
+ i: Integer;
+begin
+ if Find(Indexes, i) then
+ Result := Items[i] else
+ Result := TfrxCrossRow(InsertItem(i, Indexes));
+end;
+
+
+{ TfrxCrossColumns }
+
+constructor TfrxCrossColumns.Create;
+begin
+ inherited Create(TfrxCrossColumn);
+end;
+
+function TfrxCrossColumns.GetItems(Index: Integer): TfrxCrossColumn;
+begin
+ Result := TfrxCrossColumn(inherited Items[Index]);
+end;
+
+function TfrxCrossColumns.Column(const Indexes: array of Variant): TfrxCrossColumn;
+var
+ i: Integer;
+begin
+ if Find(Indexes, i) then
+ Result := Items[i] else
+ Result := TfrxCrossColumn(InsertItem(i, Indexes));
+end;
+
+function TfrxCrossColumns.InsertItem(Index: Integer;
+ const Indexes: array of Variant): TfrxIndexItem;
+begin
+ Result := inherited InsertItem(Index, Indexes);
+ TfrxCrossColumn(Result).FCellIndex := Count - 1;
+end;
+
+
+{ TfrxCrossHeader }
+
+constructor TfrxCrossHeader.Create(CellLevels: Integer);
+begin
+ FItems := TList.Create;
+ FCellLevels := CellLevels;
+ FValue := Null;
+ FVisible := True;
+
+ SetLength(FFuncValues, FCellLevels);
+ SetLength(FCounts, FCellLevels);
+end;
+
+destructor TfrxCrossHeader.Destroy;
+begin
+ FFuncValues := nil;
+ FCounts := nil;
+
+ while FItems.Count > 0 do
+ begin
+ TfrxCrossHeader(FItems[0]).Free;
+ FItems.Delete(0);
+ end;
+
+ FItems.Free;
+ inherited;
+end;
+
+function TfrxCrossHeader.GetItems(Index: Integer): TfrxCrossHeader;
+begin
+ Result := TfrxCrossHeader(FItems[Index]);
+end;
+
+function TfrxCrossHeader.GetCount: Integer;
+begin
+ Result := FItems.Count;
+end;
+
+function TfrxCrossHeader.GetLevel: Integer;
+var
+ h: TfrxCrossHeader;
+begin
+ Result := -2;
+ h := Self;
+
+ while h <> nil do
+ begin
+ h := h.Parent;
+ Inc(Result);
+ end;
+end;
+
+function TfrxCrossHeader.Find(Value: Variant): Integer;
+var
+ i: Integer;
+begin
+ { find the cell containing the given value }
+ Result := -1;
+ for i := 0 to Count - 1 do
+ if VarToWideStr(Items[i].Value) = VarToWideStr(Value) then
+ begin
+ Result := i;
+ Exit;
+ end;
+end;
+
+function TfrxCrossHeader.AddChild(Memo: TfrxCustomMemoView): TfrxCrossHeader;
+begin
+ Result := TfrxCrossHeader(NewInstance);
+ Result.Create(FCellLevels);
+ { link it to the parent }
+ FItems.Add(Result);
+ Result.FParent := Self;
+
+ Result.FLevelsCount := FLevelsCount;
+ Result.FMemo := Memo;
+ Result.FValue := Memo.Text;
+end;
+
+function TfrxCrossHeader.AddCellHeader(Memos: TList; Index, CellIndex: Integer): TfrxCrossHeader;
+begin
+ Result := TfrxCrossHeader(NewInstance);
+ Result.Create(FCellLevels);
+ { link it to the parent }
+ FItems.Add(Result);
+ Result.FParent := Self;
+
+ Result.FIndex := Index;
+ Result.FCellIndex := CellIndex;
+ Result.FLevelsCount := FLevelsCount;
+ Result.FIsTotal := FIsTotal;
+ Result.FTotalIndex := FTotalIndex;
+ Result.FMemo := Memos[FTotalIndex * FCellLevels + CellIndex];
+ Result.FValue := Result.FMemo.Text;
+ Result.FIsCellHeader := True;
+end;
+
+procedure TfrxCrossHeader.AddValues(const Values: array of Variant; Unsorted: Boolean);
+var
+ i, j: Integer;
+ Header, Header1: TfrxCrossHeader;
+ v: Variant;
+ s: String;
+begin
+ { create the header tree. For example, subsequent calls
+ AddValues([1998,1]);
+ AddValues([1998,2]);
+ AddValues([1999,1]);
+ will create the header
+ 1998 | 1999
+ --+--+-----
+ 1 |2 | 1 }
+
+
+ Header := Self;
+
+ for i := Low(Values) to High(Values) do
+ begin
+ {unsorted mode join same cells only for consecutive values}
+ if Unsorted then
+ begin
+ j := Header.Count;
+ if (j > 0) and
+ (VarToWideStr(Header.Items[Header.Count - 1].Value) = VarToWideStr(Values[i])) then
+ dec(j)
+ else j := -1;
+ end
+ else j := Header.Find(Values[i]);
+ if j <> -1 then
+ Header := Header.Items[j] { find existing item... }
+ else
+ begin
+ { ...or create new one }
+ Header1 := TfrxCrossHeader(NewInstance);
+ Header1.Create(FCellLevels);
+ Header1.FLevelsCount := FLevelsCount;
+ { link it to the parent }
+ Header.FItems.Add(Header1);
+ Header1.FParent := Header;
+
+ v := Values[i];
+ s := VarToStr(v);
+ { this is subtotal item }
+ if Pos('@@@', s) = 1 then
+ begin
+ { remove @@@ }
+ s := Copy(s, 4, Length(s) - 5);
+ v := s;
+ Header1.FIsTotal := True;
+ Header1.FMemo := FTotalMemos[i];
+ Header1.FTotalIndex := FLevelsCount - i;
+ end
+ else
+ Header1.FMemo := FMemos[i];
+
+ Header1.FValue := v;
+ Header := Header1;
+
+ if Header.FIsTotal then break;
+ end;
+ end;
+end;
+
+procedure TfrxCrossHeader.Reset(const CellFunctions: array of TfrxCrossFunction);
+var
+ i: Integer;
+ h: TfrxCrossHeader;
+begin
+ { reset aggregate values for this cell and all its parent cells }
+ h := Self;
+
+ while h <> nil do
+ begin
+ for i := 0 to FCellLevels - 1 do
+ begin
+ case CellFunctions[i] of
+ cfNone, cfMin, cfMax:
+ h.FFuncValues[i] := Null;
+
+ cfSum, cfAvg, cfCount:
+ h.FFuncValues[i] := 0;
+ end;
+
+ h.FCounts[i] := 0;
+ end;
+
+ h := h.Parent;
+ end;
+end;
+
+procedure TfrxCrossHeader.AddFuncValues(const Values, Counts: array of Variant;
+ const CellFunctions: array of TfrxCrossFunction);
+var
+ i: Integer;
+ h: TfrxCrossHeader;
+begin
+ { add aggregate values for this cell and all its parent cells }
+ h := Self;
+
+ while h <> nil do
+ begin
+ for i := 0 to FCellLevels - 1 do
+ if Values[i] <> Null then
+ case CellFunctions[i] of
+ cfNone:;
+
+ cfSum:
+ h.FFuncValues[i] := h.FFuncValues[i] + Values[i];
+
+ cfMin:
+ if (h.FFuncValues[i] = Null) or (Values[i] < h.FFuncValues[i]) then
+ h.FFuncValues[i] := Values[i];
+
+ cfMax:
+ if (h.FFuncValues[i] = Null) or (Values[i] > h.FFuncValues[i]) then
+ h.FFuncValues[i] := Values[i];
+
+ cfAvg:
+ begin
+ h.FFuncValues[i] := h.FFuncValues[i] + Values[i];
+ h.FCounts[i] := h.FCounts[i] + Counts[i];
+ end;
+
+ cfCount:
+ h.FFuncValues[i] := h.FFuncValues[i] + Values[i];// + Counts[i];
+ end;
+
+ h := h.Parent;
+ end;
+end;
+
+function TfrxCrossHeader.AllItems: TList;
+
+ procedure EnumItems(Item: TfrxCrossHeader);
+ var
+ i: Integer;
+ begin
+ if Item.Memo <> nil then
+ Result.Add(Item);
+ for i := 0 to Item.Count - 1 do
+ EnumItems(Item[i]);
+ end;
+
+begin
+ { list all items in the header }
+ Result := TList.Create;
+ EnumItems(Self);
+end;
+
+function TfrxCrossHeader.TerminalItems: TList;
+var
+ i: Integer;
+ Item: TfrxCrossHeader;
+begin
+ { list all terminal items in the header }
+ Result := AllItems;
+ i := 0;
+ while i < Result.Count do
+ begin
+ Item := Result[i];
+ if Item.Count = 0 then
+ Inc(i)
+ else
+ Result.Delete(i);
+ end;
+end;
+
+function TfrxCrossHeader.IndexItems: TList;
+var
+ i: Integer;
+ Item: TfrxCrossHeader;
+begin
+ { list all terminal items in the header }
+ Result := AllItems;
+ i := 0;
+ while i < Result.Count do
+ begin
+ Item := Result[i];
+ if Item.FIsIndex then
+ Inc(i)
+ else
+ Result.Delete(i);
+ end;
+end;
+
+function TfrxCrossHeader.GetIndexes: Variant;
+var
+ ar: array of Variant;
+ i, n: Integer;
+ h, h1: TfrxCrossHeader;
+begin
+ SetLength(ar, FLevelsCount + 1);
+ n := 0;
+ h := Parent;
+ h1 := Self;
+ while h <> nil do
+ begin
+ ar[n] := h.FItems.IndexOf(h1);
+ Inc(n);
+ h1 := h;
+ h := h.Parent;
+ end;
+
+ Result := VarArrayCreate([0, FLevelsCount - 1], varVariant);
+ for i := 0 to FLevelsCount - 1 do
+ if i < n then
+ Result[i] := ar[n - i - 1] else
+ Result[i] := Null;
+ ar := nil;
+end;
+
+function TfrxCrossHeader.GetValues: Variant;
+var
+ ar: array of Variant;
+ i, n: Integer;
+ h: TfrxCrossHeader;
+begin
+ SetLength(ar, FLevelsCount + 1);
+ n := 0;
+ h := Self;
+ while h.Parent <> nil do
+ begin
+ ar[n] := h.Value;
+ Inc(n);
+ h := h.Parent;
+ end;
+
+ Result := VarArrayCreate([0, FLevelsCount - 1], varVariant);
+ for i := 0 to FLevelsCount - 1 do
+ if i < n then
+ Result[i] := ar[n - i - 1] else
+ Result[i] := Null;
+ ar := nil;
+end;
+
+function TfrxCrossHeader.GetHeight: Double;
+var
+ Items: TList;
+begin
+ Items := TerminalItems;
+
+ if (Items.Count > 0) and FVisible then
+ Result := TfrxCrossHeader(Items[Items.Count - 1]).Bounds.Top +
+ TfrxCrossHeader(Items[Items.Count - 1]).Bounds.Bottom
+ else
+ Result := 0;
+
+ Items.Free;
+end;
+
+function TfrxCrossHeader.GetWidth: Double;
+var
+ Items: TList;
+begin
+ Items := TerminalItems;
+
+ if (Items.Count > 0) and FVisible then
+ Result := TfrxCrossHeader(Items[Items.Count - 1]).Bounds.Left +
+ TfrxCrossHeader(Items[Items.Count - 1]).Bounds.Right
+ else
+ Result := 0;
+
+ Items.Free;
+end;
+
+
+{ TfrxCrossColumnHeader }
+
+procedure TfrxCrossColumnHeader.CalcBounds;
+var
+ i, j, l: Integer;
+ h, hAvg: Extended;
+ Items: TList;
+ Item: TfrxCrossHeader;
+ LevelHeights: array of Extended;
+
+ function DoAdjust(Item: TfrxCrossHeader): Extended;
+ var
+ i: Integer;
+ Width: Extended;
+ begin
+ if Item.Count = 0 then
+ begin
+ Result := Item.FSize.X;
+ Exit;
+ end;
+
+ Width := 0;
+ for i := 0 to Item.Count - 1 do
+ Width := Width + DoAdjust(Item[i]);
+
+ if Item.FSize.X < Width then
+ Item.FSize.X := Width
+ else
+ begin
+ Item[Item.Count - 1].FSize.X := Item[Item.Count - 1].FSize.X + Item.FSize.X - Width;
+ DoAdjust(Item[Item.Count - 1]);
+ end;
+
+ Result := Item.FSize.X;
+ end;
+
+ procedure FillBounds(Item: TfrxCrossHeader; Offset: TfrxPoint);
+ var
+ i, j, l: Integer;
+ h: Extended;
+ begin
+ l := Item.Level;
+ if l <> -1 then
+ h := LevelHeights[l] else
+ h := Item.FSize.Y;
+
+ if Item.FIsCellHeader then
+ h := LevelHeights[FLevelsCount]
+ else if Item.IsTotal then
+ for j := l + 1 to FLevelsCount - 1 do
+ h := h + LevelHeights[j];
+
+ Item.FBounds := frxRect(Offset.X, Offset.Y, Item.FSize.X, h);
+ Offset.Y := Offset.Y + h;
+
+ for i := 0 to Item.Count - 1 do
+ begin
+ FillBounds(Item[i], Offset);
+ Offset.X := Offset.X + Item[i].FSize.X;
+ end;
+ end;
+
+begin
+ DoAdjust(Self);
+
+ SetLength(LevelHeights, FLevelsCount + 1);
+
+ Items := AllItems;
+
+// calculate height of each row
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ l := Item.Level;
+
+ // cell headers always adjust the last level height
+ if Item.FIsCellHeader then
+ l := FLevelsCount
+ // don't count total elemens unless they are on last level.
+ // such elements will be adjusted later
+ else if Item.IsTotal then
+ if l <> FLevelsCount - 1 then continue;
+
+ if l >= 0 then
+ if Item.FSize.Y > LevelHeights[l] then
+ LevelHeights[l] := Item.FSize.Y;
+ end;
+
+ if FNoLevels then
+ LevelHeights[0] := 0;
+
+// adjust level height - count totals that not on the last level
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ l := Item.Level;
+
+ if Item.IsTotal and (l < FLevelsCount - 1) then
+ begin
+ h := 0;
+ for j := l to FLevelsCount - 1 do
+ h := h + LevelHeights[j];
+
+ if Item.FSize.Y > h then
+ LevelHeights[FLevelsCount - 1] := LevelHeights[FLevelsCount - 1] + Item.FSize.Y - h;
+ end;
+ end;
+
+ { syncronize height of CornerMemos[0] and [1] }
+ if FCorner <> nil then
+ begin
+ if not FMemo.Visible then
+ FSize.Y := 0;
+ if not FCorner.FMemo.Visible then
+ FCorner.FSize.Y := 0;
+ h := FSize.Y;
+ if FCorner.FSize.Y > h then
+ h := FCorner.FSize.Y;
+ FSize.Y := h;
+ if not FNoLevels then
+ FCorner.FSize.Y := h;
+ end;
+
+// FillBounds(Self, frxPoint(0, 0));
+
+ { update height of CornerMemos[2..n] }
+ if FCorner <> nil then
+ begin
+ h := 0;
+ l := FLevelsCount - 1;
+ if HasCellHeaders then
+ Inc(l);
+ for i := 0 to l do
+ h := h + LevelHeights[i];
+ if FNoLevels then
+ h := h + FSize.Y;
+
+ for i := 0 to FCorner.Count - 1 do
+ if FCorner[i].FSize.Y > h then
+ begin
+ if l = 0 then
+ TfrxCrossHeader(Items[0]).FSize.Y := FCorner[i].FSize.Y
+ else
+ begin
+ hAvg := (FCorner[i].FSize.Y - h) / (l + 1);
+ for j := 0 to l do
+ LevelHeights[j] := LevelHeights[j] + hAvg; {normalize columns height}
+ end;
+ end
+ else FCorner[i].FSize.Y := h;
+ end;
+
+ FillBounds(Self, frxPoint(0, 0));
+ Items.Free;
+ LevelHeights := nil;
+
+end;
+
+procedure TfrxCrossColumnHeader.CalcSizes(MaxWidth, MinWidth: Integer; AutoSize: Boolean);
+var
+ i: Integer;
+ Items: TList;
+ Item: TfrxCrossHeader;
+ s: WideString;
+ m: TfrxCustomMemoView;
+begin
+ Items := AllItems;
+
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ m := Item.FMemo;
+ if m <> nil then
+ begin
+ if AutoSize or (((m.Width = 0) or (m.Height = 0)) and m.Visible) then
+ begin
+ m.Width := MaxWidth;
+ s := m.Text;
+ m.Text := m.FormatData(Item.Value);
+ if m.Lines.Count = 0 then
+ m.Text := ' ';
+ Item.FSize := CalcSize(m);
+ m.Text := s;
+ end
+ else
+ begin
+ if (Item.Count = 0) or (Item.Count = 1) then
+ Item.FSize.X := m.Width;
+ if not Item.IsTotal then
+ Item.FSize.Y := m.Height;
+ end;
+
+ if Item.FSize.X < MinWidth then
+ Item.FSize.X := MinWidth;
+ if Item.FSize.X > MaxWidth then
+ Item.FSize.X := MaxWidth;
+ end;
+ end;
+
+ Items.Free;
+end;
+
+
+{ TfrxCrossRowHeader }
+
+procedure TfrxCrossRowHeader.CalcBounds;
+var
+ i, j, l: Integer;
+ w: Extended;
+ Items: TList;
+ Item: TfrxCrossHeader;
+ LevelWidths: array of Extended;
+
+ function DoAdjust(Item: TfrxCrossHeader): Extended;
+ var
+ i: Integer;
+ Height: Extended;
+ begin
+ if Item.Count = 0 then
+ begin
+ Result := Item.FSize.Y;
+ Exit;
+ end;
+
+ Height := 0;
+ for i := 0 to Item.Count - 1 do
+ Height := Height + DoAdjust(Item[i]);
+
+ if Item.FSize.Y < Height then
+ Item.FSize.Y := Height
+ else
+ begin
+ Item[Item.Count - 1].FSize.Y := Item[Item.Count - 1].FSize.Y + Item.FSize.Y - Height;
+ DoAdjust(Item[Item.Count - 1]);
+ end;
+
+ Result := Item.FSize.Y;
+ end;
+
+ procedure FillBounds(Item: TfrxCrossHeader; Offset: TfrxPoint);
+ var
+ i, j, l: Integer;
+ w: Extended;
+ begin
+ l := Item.Level;
+ if l <> -1 then
+ w := LevelWidths[l] else
+ w := Item.FSize.X;
+
+ if Item.FIsCellHeader then
+ w := LevelWidths[FLevelsCount]
+ else if Item.IsTotal then
+ for j := l + 1 to FLevelsCount - 1 do
+ w := w + LevelWidths[j];
+
+ Item.FBounds := frxRect(Offset.X, Offset.Y, w, Item.FSize.Y);
+ Offset.X := Offset.X + w;
+
+ for i := 0 to Item.Count - 1 do
+ begin
+ FillBounds(Item[i], Offset);
+ Offset.Y := Offset.Y + Item[i].FSize.Y;
+ end;
+ end;
+
+begin
+ DoAdjust(Self);
+
+ SetLength(LevelWidths, FLevelsCount + 1);
+
+ Items := AllItems;
+
+// calculate maxwidth of each row
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ l := Item.Level;
+
+ // cell headers always adjust the last level width
+ if Item.FIsCellHeader then
+ l := FLevelsCount
+ // don't count total elemens unless they are on last level.
+ // such elements will be adjusted later
+ else if Item.IsTotal then
+ if l <> FLevelsCount - 1 then continue;
+
+ if l >= 0 then
+ if Item.FSize.X > LevelWidths[l] then
+ LevelWidths[l] := Item.FSize.X;
+ end;
+
+// adjust totals
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ l := Item.Level;
+
+ if Item.IsTotal and (l < FLevelsCount - 1) then
+ begin
+ w := 0;
+ for j := l to FLevelsCount - 1 do
+ w := w + LevelWidths[j];
+
+ if Item.FSize.X > w then
+ LevelWidths[FLevelsCount - 1] := LevelWidths[FLevelsCount - 1] + Item.FSize.X - w;
+ end;
+ end;
+
+// adjust corner
+ for i := 0 to FCorner.Count - 1 do
+ if FCorner[i].FSize.X > LevelWidths[i] then
+ LevelWidths[i] := FCorner[i].FSize.X
+ else
+ FCorner[i].FSize.X := LevelWidths[i];
+
+ FillBounds(Self, frxPoint(0, 0));
+
+ Items.Free;
+ LevelWidths := nil;
+end;
+
+procedure TfrxCrossRowHeader.CalcSizes(MaxWidth, MinWidth: Integer; AutoSize: Boolean);
+var
+ i: Integer;
+ Items: TList;
+ Item: TfrxCrossHeader;
+ s: WideString;
+ m: TfrxCustomMemoView;
+begin
+ Items := AllItems;
+
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ m := Item.FMemo;
+ if m <> nil then
+ begin
+ if AutoSize or (((m.Width = 0) or (m.Height = 0)) and m.Visible) then
+ begin
+ m.Width := MaxWidth;
+ s := m.Text;
+ m.Text := m.FormatData(Item.Value);
+ if m.Lines.Count = 0 then
+ m.Text := ' ';
+ Item.FSize := CalcSize(m);
+ m.Text := s;
+ end
+ else
+ begin
+ if Item.Count = 0 then
+ Item.FSize.Y := m.Height;
+ if not Item.IsTotal then
+ Item.FSize.X := m.Width;
+ end;
+
+ if Item.FSize.X < MinWidth then
+ Item.FSize.X := MinWidth;
+ if Item.FSize.X > MaxWidth then
+ Item.FSize.X := MaxWidth;
+ end;
+ end;
+
+ Items.Free;
+end;
+
+
+{ TfrxCutBandItem }
+
+destructor TfrxCutBandItem.Destroy;
+begin
+ Band.Free;
+ inherited;
+end;
+
+
+{ TfrxCutBands }
+
+constructor TfrxCutBands.Create;
+begin
+ inherited Create(TfrxCutBandItem);
+end;
+
+procedure TfrxCutBands.Add(ABand: TfrxBand; AFromIndex, AToIndex: Integer);
+begin
+ with TfrxCutBandItem(inherited Add) do
+ begin
+ Band := ABand;
+ FromIndex := AFromIndex;
+ ToIndex := AToIndex;
+ end;
+end;
+
+function TfrxCutBands.GetItems(Index: Integer): TfrxCutBandItem;
+begin
+ Result := TfrxCutBandItem(inherited Items[Index]);
+end;
+
+
+{ TfrxGridLineItem }
+
+constructor TfrxGridLineItem.Create(Collection: TCollection);
+begin
+ inherited;
+ Objects := TList.Create;
+end;
+
+destructor TfrxGridLineItem.Destroy;
+begin
+ Objects.Free;
+ inherited;
+end;
+
+
+{ TfrxGridLines }
+
+constructor TfrxGridLines.Create;
+begin
+ inherited Create(TfrxGridLineItem);
+end;
+
+procedure TfrxGridLines.Add(AObj: TObject; ACoord: Double);
+var
+ i: Integer;
+ Item: TfrxGridLineItem;
+begin
+ Item := nil;
+ for i := 0 to Count - 1 do
+ if Abs(Items[i].Coord - ACoord) < 1 then
+ begin
+ Item := Items[i];
+ break;
+ end;
+
+ if Item = nil then
+ Item := TfrxGridLineItem(inherited Add);
+
+ Item.Coord := ACoord;
+ Item.Objects.Add(AObj);
+end;
+
+function TfrxGridLines.GetItems(Index: Integer): TfrxGridLineItem;
+begin
+ Result := TfrxGridLineItem(inherited Items[Index]);
+end;
+
+
+{ TfrxCustomCrossView }
+
+constructor TfrxCustomCrossView.Create(AOwner: TComponent);
+var
+ i: Integer;
+begin
+ inherited;
+ Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
+ Color := claWhite;
+ frComponentStyle := frComponentStyle - [csPreviewVisible] + [csContainer];
+
+ FAllMemos := TList.Create;
+ FCellMemos := TList.Create;
+ FCellHeaderMemos := TList.Create;
+ FColumnMemos := TList.Create;
+ FColumnTotalMemos := TList.Create;
+ FCornerMemos := TList.Create;
+ FRowMemos := TList.Create;
+ FRowTotalMemos := TList.Create;
+
+ FCellFields := TStringList.Create;
+ FColumnFields := TStringList.Create;
+ FRowFields := TStringList.Create;
+ FColumnBands := TfrxCutBands.Create;
+ FRowBands := TfrxCutBands.Create;
+
+ FGridX := TfrxGridLines.Create;
+ FGridY := TfrxGridLines.Create;
+
+ FAutoSize := True;
+ FBorder := True;
+ FGapX := 3;
+ FGapY := 3;
+ FMaxWidth := 200;
+ FRepeatHeaders := True;
+ FShowColumnHeader := True;
+ FShowColumnTotal := True;
+ FShowRowHeader := True;
+ FShowRowTotal := True;
+ FShowCorner := True;
+ FShowTitle := True;
+ FAllowDuplicates := True;
+ FClearBeforePrint := True;
+ FSuppressNullRecords := True;
+
+ SetDotMatrix(Page is TfrxDMPPage);
+ CreateCornerMemos(3);
+ CellLevels := 1;
+ ColumnLevels := 1;
+ RowLevels := 1;
+
+ for i := 0 to 31 do
+ begin
+ FCellFunctions[i] := cfSum;
+ FColumnSort[i] := soAscending;
+ FRowSort[i] := soAscending;
+ end;
+end;
+
+destructor TfrxCustomCrossView.Destroy;
+begin
+ ClearMemos;
+ FAllMemos.Free;
+ FCellMemos.Free;
+ FCellHeaderMemos.Free;
+ FColumnMemos.Free;
+ FColumnTotalMemos.Free;
+ FCornerMemos.Free;
+ FRowMemos.Free;
+ FRowTotalMemos.Free;
+
+ FCellFields.Free;
+ FColumnFields.Free;
+ FRowFields.Free;
+
+ FColumnBands.Free;
+ FRowBands.Free;
+ FGridX.Free;
+ FGridY.Free;
+
+ ClearMatrix;
+ inherited;
+end;
+
+function TfrxCustomCrossView.GetCellFunctions(Index: Integer): TfrxCrossFunction;
+begin
+ Result := FCellFunctions[Index];
+end;
+
+function TfrxCustomCrossView.GetCellMemos(Index: Integer): TfrxCustomMemoView;
+begin
+ Result := FCellMemos[Index];
+end;
+
+function TfrxCustomCrossView.GetCellHeaderMemos(Index: Integer): TfrxCustomMemoView;
+begin
+ Result := FCellHeaderMemos[Index];
+end;
+
+function TfrxCustomCrossView.GetColumnMemos(Index: Integer): TfrxCustomMemoView;
+begin
+ Result := FColumnMemos[Index];
+end;
+
+function TfrxCustomCrossView.GetColumnTotalMemos(Index: Integer): TfrxCustomMemoView;
+begin
+ Result := FColumnTotalMemos[Index];
+end;
+
+function TfrxCustomCrossView.GetCornerMemos(Index: Integer): TfrxCustomMemoView;
+begin
+ Result := FCornerMemos[Index];
+end;
+
+function TfrxCustomCrossView.GetRowMemos(Index: Integer): TfrxCustomMemoView;
+begin
+ Result := FRowMemos[Index];
+end;
+
+function TfrxCustomCrossView.GetRowTotalMemos(Index: Integer): TfrxCustomMemoView;
+begin
+ Result := FRowTotalMemos[Index];
+end;
+
+function TfrxCustomCrossView.GetColumnSort(Index: Integer): TfrxCrossSortOrder;
+begin
+ Result := FColumnSort[Index];
+end;
+
+function TfrxCustomCrossView.GetRowSort(Index: Integer): TfrxCrossSortOrder;
+begin
+ Result := FRowSort[Index];
+end;
+
+procedure TfrxCustomCrossView.SetCellFunctions(Index: Integer;
+ const Value: TfrxCrossFunction);
+begin
+ FCellFunctions[Index] := Value;
+end;
+
+procedure TfrxCustomCrossView.SetColumnSort(Index: Integer; Value: TfrxCrossSortOrder);
+begin
+ FColumnSort[Index] := Value;
+end;
+
+procedure TfrxCustomCrossView.SetRowSort(Index: Integer; Value: TfrxCrossSortOrder);
+begin
+ FRowSort[Index] := Value;
+end;
+
+function TfrxCustomCrossView.ColCount: Integer;
+begin
+ Result := FColumns.Count;
+end;
+
+function TfrxCustomCrossView.RowCount: Integer;
+begin
+ Result := FRows.Count;
+end;
+
+function TfrxCustomCrossView.IsGrandTotalColumn(Index: Integer): Boolean;
+begin
+ Result := Index = FColumns.Count - 1;
+end;
+
+function TfrxCustomCrossView.IsGrandTotalRow(Index: Integer): Boolean;
+begin
+ Result := Index = FRows.Count - 1;
+end;
+
+function TfrxCustomCrossView.IsTotalColumn(Index: Integer): Boolean;
+var
+ i: Integer;
+begin
+ Result := False;
+
+ for i := 0 to FColumns.FIndexesCount - 1 do
+ if VarToStr(FColumns[Index].Indexes[i]) = '@@@' then
+ Result := True;
+end;
+
+function TfrxCustomCrossView.IsTotalRow(Index: Integer): Boolean;
+var
+ i: Integer;
+begin
+ Result := False;
+
+ for i := 0 to FRows.FIndexesCount - 1 do
+ if VarToStr(FRows[Index].Indexes[i]) = '@@@' then
+ Result := True;
+end;
+
+function TfrxCustomCrossView.GetColumnIndexes(AColumn: Integer): Variant;
+begin
+ Result := FColumns[AColumn].Indexes;
+end;
+
+function TfrxCustomCrossView.GetRowIndexes(ARow: Integer): Variant;
+begin
+ Result := FRows[ARow].Indexes;
+end;
+
+procedure TfrxCustomCrossView.SetCellFields(const Value: TStrings);
+begin
+ FCellFields.Assign(Value);
+end;
+
+procedure TfrxCustomCrossView.SetColumnFields(const Value: TStrings);
+begin
+ FColumnFields.Assign(Value);
+end;
+
+procedure TfrxCustomCrossView.SetRowFields(const Value: TStrings);
+begin
+ FRowFields.Assign(Value);
+end;
+
+procedure TfrxCustomCrossView.SetCellLevels(const Value: Integer);
+var
+ max: Integer;
+begin
+ FCellLevels := Value;
+ CreateCellMemos(FCellLevels * (FRowLevels + 1) * (FColumnLevels + 1));
+ max := FRowLevels;
+ if FColumnLevels > max then
+ max := FColumnLevels;
+ CreateCellHeaderMemos(FCellLevels * (max + 1));
+end;
+
+procedure TfrxCustomCrossView.SetColumnLevels(const Value: Integer);
+var
+ max, lvl: Integer;
+begin
+ FColumnLevels := Value;
+ lvl := FColumnLevels;
+ if lvl = 0 then
+ lvl := 1;
+ CreateColumnMemos(lvl);
+ CreateCellMemos(FCellLevels * (FRowLevels + 1) * (FColumnLevels + 1));
+ max := FRowLevels;
+ if FColumnLevels > max then
+ max := FColumnLevels;
+ CreateCellHeaderMemos(FCellLevels * (max + 1));
+end;
+
+procedure TfrxCustomCrossView.SetRowLevels(const Value: Integer);
+var
+ max, lvl: Integer;
+begin
+ FRowLevels := Value;
+ lvl := FRowLevels;
+ if lvl = 0 then
+ lvl := 1;
+ CreateRowMemos(lvl);
+ CreateCornerMemos(FRowLevels + 3);
+ CreateCellMemos(FCellLevels * (FRowLevels + 1) * (FColumnLevels + 1));
+ max := FRowLevels;
+ if FColumnLevels > max then
+ max := FColumnLevels;
+ CreateCellHeaderMemos(FCellLevels * (max + 1));
+end;
+
+procedure TfrxCustomCrossView.SetDotMatrix(const Value: Boolean);
+begin
+ FDotMatrix := Value;
+ if FDotMatrix then
+ begin
+ FGapX := 0;
+ FGapY := 0;
+ end;
+end;
+
+function TfrxCustomCrossView.IsCrossValid: Boolean;
+begin
+ Result := True;
+end;
+
+function TfrxCustomCrossView.ColumnHeaderHeight: Double;
+begin
+ Result := ColumnHeader.Height;
+end;
+
+function TfrxCustomCrossView.RowHeaderWidth: Double;
+begin
+ Result := RowHeader.Width;
+ if FNoRows then
+ Result := 0;
+end;
+
+procedure TfrxCustomCrossView.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FNextCross) then
+ FNextCross := nil;
+end;
+
+procedure TfrxCustomCrossView.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ Filer.DefineBinaryProperty('Memos', ReadMemos, WriteMemos, True);
+end;
+
+procedure TfrxCustomCrossView.ReadMemos(Stream: TStream);
+var
+ x: TfrxXMLDocument;
+ i: Integer;
+
+ procedure GetItem(m: TfrxCustomMemoView; const Name: String; Index: Integer);
+ var
+ xs: TfrxXMLSerializer;
+ Item: TfrxXMLItem;
+ begin
+ Item := x.Root.FindItem(Name);
+ if Index >= Item.Count then Exit;
+ Item := Item[Index];
+
+ xs := TfrxXMLSerializer.Create(nil);
+ xs.OldFormat := x.OldVersion;
+ m.Color := claNull;
+ m.Frame.Color := claBlack;
+ m.Frame.Width := 1;
+ m.Frame.Typ := [];
+ m.Font.Style := [];
+ m.HAlign := haLeft;
+ m.VAlign := vaTop;
+ xs.ReadRootComponent(m, Item);
+ xs.Free;
+ end;
+
+ function GetItem1(const Name: String; Index: Integer): TfrxCrossFunction;
+ var
+ Item: TfrxXMLItem;
+ begin
+ Result := cfNone;
+ Item := x.Root.FindItem(Name);
+ if Index >= Item.Count then Exit;
+ Item := Item[Index];
+ Result := TfrxCrossFunction(StrToInt(Item.Text));
+ end;
+
+ function GetItem2(const Name: String; Index: Integer): TfrxCrossSortOrder;
+ var
+ Item: TfrxXMLItem;
+ begin
+ Result := soAscending;
+ Item := x.Root.FindItem(Name);
+ if Index >= Item.Count then Exit;
+ Item := Item[Index];
+ Result := TfrxCrossSortOrder(StrToInt(Item.Text));
+ end;
+
+begin
+ x := TfrxXMLDocument.Create;
+
+ try
+ x.LoadFromStream(Stream);
+
+ for i := 0 to FCellLevels - 1 do
+ CellFunctions[i] := GetItem1('cellfunctions', i);
+
+ for i := 0 to FCellHeaderMemos.Count - 1 do
+ GetItem(CellHeaderMemos[i], 'cellheadermemos', i);
+
+ for i := 0 to FCellMemos.Count - 1 do
+ GetItem(CellMemos[i], 'cellmemos', i);
+
+ for i := 0 to FColumnMemos.Count - 1 do
+ begin
+ GetItem(ColumnMemos[i], 'columnmemos', i);
+ GetItem(ColumnTotalMemos[i], 'columntotalmemos', i);
+ ColumnSort[i] := GetItem2('columnsort', i);
+ end;
+
+ for i := 0 to FRowMemos.Count - 1 do
+ begin
+ GetItem(RowMemos[i], 'rowmemos', i);
+ GetItem(RowTotalMemos[i], 'rowtotalmemos', i);
+ RowSort[i] := GetItem2('rowsort', i);
+ end;
+
+ for i := 0 to FCornerMemos.Count - 1 do
+ GetItem(CornerMemos[i], 'cornermemos', i);
+
+ finally
+ x.Free;
+ end;
+end;
+
+procedure TfrxCustomCrossView.WriteMemos(Stream: TStream);
+var
+ x: TfrxXMLDocument;
+ i: Integer;
+
+ procedure AddItem(m: TfrxCustomMemoView; const Name: String);
+ var
+ xs: TfrxXMLSerializer;
+ begin
+ xs := TfrxXMLSerializer.Create(nil);
+ xs.WriteRootComponent(m, True, x.Root.FindItem(Name).Add);
+ xs.Free;
+ end;
+
+ procedure AddItem1(f: TfrxCrossFunction; const Name: String);
+ var
+ Item: TfrxXMLItem;
+ begin
+ Item := x.Root.FindItem(Name);
+ Item := Item.Add;
+ Item.Name := 'item';
+ Item.Text := IntToStr(Integer(f));
+ end;
+
+ procedure AddItem2(f: TfrxCrossSortOrder; const Name: String);
+ var
+ Item: TfrxXMLItem;
+ begin
+ Item := x.Root.FindItem(Name);
+ Item := Item.Add;
+ Item.Name := 'item';
+ Item.Text := IntToStr(Integer(f));
+ end;
+
+begin
+ x := TfrxXMLDocument.Create;
+ x.Root.Name := 'cross';
+
+ try
+ x.Root.Add.Name := 'cellmemos';
+ x.Root.Add.Name := 'cellheadermemos';
+ x.Root.Add.Name := 'columnmemos';
+ x.Root.Add.Name := 'columntotalmemos';
+ x.Root.Add.Name := 'cornermemos';
+ x.Root.Add.Name := 'rowmemos';
+ x.Root.Add.Name := 'rowtotalmemos';
+ x.Root.Add.Name := 'cellfunctions';
+ x.Root.Add.Name := 'columnsort';
+ x.Root.Add.Name := 'rowsort';
+
+ for i := 0 to FCellLevels - 1 do
+ AddItem1(CellFunctions[i], 'cellfunctions');
+
+ for i := 0 to FCellHeaderMemos.Count - 1 do
+ AddItem(CellHeaderMemos[i], 'cellheadermemos');
+
+ for i := 0 to FCellMemos.Count - 1 do
+ AddItem(CellMemos[i], 'cellmemos');
+
+ for i := 0 to FColumnMemos.Count - 1 {FColumnLevels - 1} do
+ begin
+ AddItem(ColumnMemos[i], 'columnmemos');
+ AddItem(ColumnTotalMemos[i], 'columntotalmemos');
+ AddItem2(ColumnSort[i], 'columnsort');
+ end;
+
+ for i := 0 to FRowMemos.Count - 1 {FRowLevels - 1} do
+ begin
+ AddItem(RowMemos[i], 'rowmemos');
+ AddItem(RowTotalMemos[i], 'rowtotalmemos');
+ AddItem2(RowSort[i], 'rowsort');
+ end;
+
+ for i := 0 to FCornerMemos.Count - 1 do
+ AddItem(CornerMemos[i], 'cornermemos');
+
+ x.SaveToStream(Stream);
+ finally
+ x.Free;
+ end;
+end;
+
+procedure TfrxCustomCrossView.CreateCellHeaderMemos(NewCount: Integer);
+var
+ i: Integer;
+ m: TfrxCustomMemoView;
+begin
+ for i := FCellHeaderMemos.Count to NewCount - 1 do
+ begin
+ m := CreateMemo(nil);
+ FCellHeaderMemos.Add(m);
+ m.Restrictions := [rfDontDelete];
+ m.VAlign := vaCenter;
+ m.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
+ m.AllowExpressions := False;
+ end;
+end;
+
+procedure TfrxCustomCrossView.CreateCellMemos(NewCount: Integer);
+var
+ i: Integer;
+ m: TfrxCustomMemoView;
+begin
+ for i := FCellMemos.Count to NewCount - 1 do
+ begin
+ m := CreateMemo(nil);
+ FCellMemos.Add(m);
+ m.Restrictions := [rfDontDelete];
+ m.HAlign := haRight;
+ m.VAlign := vaCenter;
+ m.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
+ m.AllowExpressions := False;
+ end;
+end;
+
+procedure TfrxCustomCrossView.CreateColumnMemos(NewCount: Integer);
+var
+ i: Integer;
+ m: TfrxCustomMemoView;
+begin
+ for i := FColumnMemos.Count to NewCount - 1 do
+ begin
+ m := CreateMemo(nil);
+ FColumnMemos.Add(m);
+ m.Restrictions := [rfDontDelete, rfDontEdit];
+ m.HAlign := haCenter;
+ m.VAlign := vaCenter;
+ m.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
+ m.AllowExpressions := False;
+
+ m := CreateMemo(nil);
+ FColumnTotalMemos.Add(m);
+ m.Restrictions := [rfDontDelete];
+ if i = 0 then
+ m.Text := 'Grand Total'
+ else
+ m.Text := 'Total';
+ m.Font.Style := [TFontStyle.fsBold];
+ m.HAlign := haCenter;
+ m.VAlign := vaCenter;
+ m.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
+ end;
+end;
+
+procedure TfrxCustomCrossView.CreateRowMemos(NewCount: Integer);
+var
+ i: Integer;
+ m: TfrxCustomMemoView;
+begin
+ for i := FRowMemos.Count to NewCount - 1 do
+ begin
+ m := CreateMemo(nil);
+ FRowMemos.Add(m);
+ m.Restrictions := [rfDontDelete, rfDontEdit];
+ m.HAlign := haCenter;
+ m.VAlign := vaCenter;
+ m.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
+ m.AllowExpressions := False;
+
+ m := CreateMemo(nil);
+ FRowTotalMemos.Add(m);
+ m.Restrictions := [rfDontDelete];
+ if i = 0 then
+ m.Text := 'Grand Total'
+ else
+ m.Text := 'Total';
+ m.Font.Style := [TFontStyle.fsBold];
+ m.HAlign := haCenter;
+ m.VAlign := vaCenter;
+ m.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
+ end;
+end;
+
+procedure TfrxCustomCrossView.CreateCornerMemos(NewCount: Integer);
+var
+ i: Integer;
+ m: TfrxCustomMemoView;
+begin
+ for i := FCornerMemos.Count to NewCount - 1 do
+ begin
+ m := CreateMemo(nil);
+ FCornerMemos.Add(m);
+ m.Restrictions := [rfDontDelete];
+ m.HAlign := haCenter;
+ m.VAlign := vaCenter;
+ m.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
+ m.AllowExpressions := False;
+ end;
+end;
+
+procedure TfrxCustomCrossView.ClearMemos;
+begin
+ while FCellHeaderMemos.Count > 0 do
+ begin
+ CellHeaderMemos[0].Free;
+ FCellHeaderMemos.Delete(0);
+ end;
+ while FCellMemos.Count > 0 do
+ begin
+ CellMemos[0].Free;
+ FCellMemos.Delete(0);
+ end;
+ while FColumnMemos.Count > 0 do
+ begin
+ ColumnMemos[0].Free;
+ FColumnMemos.Delete(0);
+ ColumnTotalMemos[0].Free;
+ FColumnTotalMemos.Delete(0);
+ end;
+ while FRowMemos.Count > 0 do
+ begin
+ RowMemos[0].Free;
+ FRowMemos.Delete(0);
+ RowTotalMemos[0].Free;
+ FRowTotalMemos.Delete(0);
+ end;
+ while FCornerMemos.Count > 0 do
+ begin
+ CornerMemos[0].Free;
+ FCornerMemos.Delete(0);
+ end;
+end;
+
+procedure TfrxCustomCrossView.InitMatrix;
+var
+ ColL, RowL: Integer;
+begin
+ ClearMatrix;
+
+ RowL := FRowLevels;
+ FNoRows := FRowLevels = 0;
+ if FNoRows then
+ RowL := 1;
+ ColL := FColumnLevels;
+ FNoColumns := FColumnLevels = 0;
+ if FNoColumns then
+ ColL := 1;
+
+ FRows := TfrxCrossRows.Create;
+ FRows.FIndexesCount := RowL;
+ FRows.FSortOrder := FRowSort;
+ FRows.FCellLevels := FCellLevels;
+
+ FColumns := TfrxCrossColumns.Create;
+ FColumns.FIndexesCount := ColL;
+ FColumns.FSortOrder := FColumnSort;
+
+ FCorner := TfrxCrossCorner.Create(1);
+ FCorner.FMemo := CornerMemos[0];
+ FCorner.Value := CornerMemos[0].Text;
+ FCorner.FLevelsCount := 1;
+
+ FRowHeader := TfrxCrossRowHeader.Create(FCellLevels);
+ FRowHeader.FMemos := FRowMemos;
+ FRowHeader.FTotalMemos := FRowTotalMemos;
+ FRowHeader.FLevelsCount := RowL;
+ FRowHeader.HasCellHeaders := (FCellLevels > 1) and not FPlainCells;
+ FRowHeader.FCorner := FCorner;
+ FRowHeader.FNoLevels := FNoRows;
+
+ FColumnHeader := TfrxCrossColumnHeader.Create(FCellLevels);
+ FColumnHeader.FMemos := FColumnMemos;
+ FColumnHeader.FTotalMemos := FColumnTotalMemos;
+ FColumnHeader.FMemo := CornerMemos[1];
+ FColumnHeader.Value := CornerMemos[1].Text;
+ FColumnHeader.FLevelsCount := ColL;
+ FColumnHeader.HasCellHeaders := (FCellLevels > 1) and FPlainCells;
+ FColumnHeader.FCorner := FCorner;
+ FColumnHeader.FNoLevels := FNoColumns;
+end;
+
+function TfrxCustomCrossView.GetNestedObjects: TList;
+var
+ i: Integer;
+ NestedObjects: TList;
+
+ procedure DoNested(Memo: TfrxCustomMemoView);
+ var
+ i: Integer;
+ c: TfrxComponent;
+ begin
+ for i := 0 to Memo.Objects.Count - 1 do
+ begin
+ c := Memo.Objects[i];
+ NestedObjects.Add(c);
+ end;
+ end;
+
+begin
+ NestedObjects := TList.Create;
+
+ for i := 0 to FCellHeaderMemos.Count - 1 do
+ DoNested(CellHeaderMemos[i]);
+
+ for i := 0 to FCellMemos.Count - 1 do
+ DoNested(CellMemos[i]);
+
+ for i := 0 to FColumnMemos.Count - 1 do
+ begin
+ DoNested(ColumnMemos[i]);
+ DoNested(ColumnTotalMemos[i]);
+ end;
+
+ for i := 0 to FRowMemos.Count - 1 do
+ begin
+ DoNested(RowMemos[i]);
+ DoNested(RowTotalMemos[i]);
+ end;
+
+ for i := 0 to FCornerMemos.Count - 1 do
+ DoNested(CornerMemos[i]);
+
+ Result := NestedObjects;
+end;
+
+procedure TfrxCustomCrossView.InitMemos(AddToScript: Boolean);
+var
+ i: Integer;
+ m: TfrxCustomMemoView;
+ NestedObjects: TList;
+begin
+ for i := 0 to FCellHeaderMemos.Count - 1 do
+ begin
+ m := CellHeaderMemos[i];
+ m.GapX := FGapX;
+ m.GapY := FGapY;
+ m.Visible := True;
+ m.Name := Name + 'CellHeader' + IntToStr(i);
+ if AddToScript then
+ Report.Script.AddObject(m.Name, m);
+ end;
+
+ for i := 0 to FCellMemos.Count - 1 do
+ begin
+ m := CellMemos[i];
+ m.GapX := FGapX;
+ m.GapY := FGapY;
+ m.Name := Name + 'Cell' + IntToStr(i);
+ if AddToScript then
+ Report.Script.AddObject(m.Name, m);
+ end;
+
+ for i := 0 to FColumnMemos.Count - 1 do
+ begin
+ m := ColumnMemos[i];
+ m.GapX := FGapX;
+ m.GapY := FGapY;
+ m.Visible := True;
+ m.Name := Name + 'Column' + IntToStr(i);
+ if AddToScript then
+ Report.Script.AddObject(m.Name, m);
+
+ m := ColumnTotalMemos[i];
+ m.GapX := FGapX;
+ m.GapY := FGapY;
+ m.AllowExpressions := False;
+ m.Name := Name + 'ColumnTotal' + IntToStr(i);
+ if AddToScript then
+ Report.Script.AddObject(m.Name, m);
+ end;
+
+ for i := 0 to FRowMemos.Count - 1 do
+ begin
+ m := RowMemos[i];
+ m.GapX := FGapX;
+ m.GapY := FGapY;
+ m.Visible := true;
+ m.Name := Name + 'Row' + IntToStr(i);
+ if AddToScript then
+ Report.Script.AddObject(m.Name, m);
+
+ m := RowTotalMemos[i];
+ m.GapX := FGapX;
+ m.GapY := FGapY;
+ m.AllowExpressions := False;
+ m.Name := Name + 'RowTotal' + IntToStr(i);
+ if AddToScript then
+ Report.Script.AddObject(m.Name, m);
+ end;
+
+ for i := 0 to FCornerMemos.Count - 1 do
+ begin
+ m := CornerMemos[i];
+ m.GapX := FGapX;
+ m.GapY := FGapY;
+ if i > 2 then
+ m.Visible := True;
+ m.Name := Name + 'Corner' + IntToStr(i);
+ if AddToScript then
+ Report.Script.AddObject(m.Name, m);
+ end;
+
+ NestedObjects := GetNestedObjects;
+
+ for i := 0 to NestedObjects.Count - 1 do
+ begin
+ m := NestedObjects[i];
+ m.Name := Name + 'Object' + IntToStr(m.Tag);
+ if AddToScript then
+ Report.Script.AddObject(m.Name, m);
+ end;
+
+ NestedObjects.Free;
+end;
+
+procedure TfrxCustomCrossView.ClearMatrix;
+begin
+ FRows.Free;
+ FRows := nil;
+ FColumns.Free;
+ FColumns := nil;
+ FCorner.Free;
+ FCorner := nil;
+ FRowHeader.Free;
+ FRowHeader := nil;
+ FColumnHeader.Free;
+ FColumnHeader := nil;
+end;
+
+procedure TfrxCustomCrossView.AddValue(const Rows, Columns, Cells: array of Variant);
+var
+ i: Integer;
+ Row: TfrxCrossRow;
+ Column: TfrxCrossColumn;
+ Cell: PfrCrossCell;
+ Value, v: Variant;
+ isNull: Boolean;
+begin
+ if not IsCrossValid then
+ raise Exception.Create('Cross-tab is not valid');
+ if FRows = nil then Exit;
+
+ { check for all nulls }
+ isNull := True;
+ for i := Low(Rows) to High(Rows) do
+ if not VarIsNull(Rows[i]) then
+ isNull := False;
+ if isNull then
+ begin
+ for i := Low(Columns) to High(Columns) do
+ if not VarIsNull(Columns[i]) then
+ isNull := False;
+ if isNull then
+ begin
+ for i := Low(Cells) to High(Cells) do
+ if not VarIsNull(Cells[i]) then
+ isNull := False;
+ end;
+ end;
+
+ if isNull and FSuppressNullRecords then Exit;
+
+ if FNoColumns then
+ Column := FColumns.Column([Null]) else
+ Column := FColumns.Column(Columns);
+ if FNoRows then
+ Row := FRows.Row([Null]) else
+ Row := FRows.Row(Rows);
+
+ Cell := Row.GetCell(Column.CellIndex);
+
+ for i := 0 to FCellLevels - 1 do
+ begin
+ Value := Cell.Value;
+ v := Cells[i];
+
+ if FCellFunctions[i] = cfCount then
+ begin
+ if v = Null then
+ v := 0
+ else
+ v := 1;
+ end;
+
+ if Value = Null then
+ Cell.Value := v
+ else if (TVarData(Value).VType = varString) or (TVarData(Value).VType = varOleStr) or (TVarData(Value).VType = varUString) then
+ begin
+ if FAllowDuplicates or
+ (Pos(#13#10 + v + #13#10, #13#10 + Cell.Value + #13#10) = 0) then
+ Cell.Value := Value + #13#10 + v
+ end
+ else
+ Cell.Value := Value + v;
+
+ Cell := Cell.Next;
+ end;
+end;
+
+function TfrxCustomCrossView.GetValue(ARow, AColumn, ACell: Integer): Variant;
+var
+ Row: TfrxCrossRow;
+ Column: TfrxCrossColumn;
+ Cell: PfrCrossCell;
+begin
+ Result := Null;
+ Column := FColumns[AColumn];
+ Row := FRows[ARow];
+ Cell := Row.GetCell(Column.CellIndex);
+
+ while (Cell <> nil) and (ACell > 0) do
+ begin
+ Cell := Cell.Next;
+ Dec(ACell);
+ end;
+
+ if Cell <> nil then
+ Result := Cell.Value;
+end;
+
+procedure TfrxCustomCrossView.CreateHeader(Header: TfrxCrossHeader;
+ Source: TfrxIndexCollection; Totals: TList; TotalVisible: Boolean);
+var
+ i, j, IndexesCount: Integer;
+ LastValues, CurValues: TfrxVariantArray;
+ Unsorted: Boolean;
+
+ function ExpandVariable(s: String; const Value: Variant): String;
+ var
+ i: Integer;
+ begin
+ { expand the [Value] macro if any (eg. if total memo contains
+ the text: 'Total of [Value]' }
+ i := Pos('[VALUE]', AnsiUppercase(s));
+ if i <> 0 then
+ begin
+ Delete(s, i, 7);
+ Insert(VarToStr(Value), s, i);
+ end;
+ Result := s;
+ end;
+
+ procedure AddTotals;
+ var
+ j, k: Integer;
+ begin
+ for j := 0 to IndexesCount - 1 do
+ { if value changed... }
+ if LastValues[j] <> CurValues[j] then
+ begin
+ { ...create subtotals for all down-level values }
+ for k := IndexesCount - 1 downto j + 1 do
+ if TfrxCustomMemoView(Totals[k]).Visible then
+ begin
+ { '@@@' means that this is subtotal cell }
+ LastValues[k] := '@@@' +
+ ExpandVariable(TfrxCustomMemoView(Totals[k]).Text, LastValues[k - 1]);
+ { create header cells... }
+ Header.AddValues(LastValues, Unsorted);
+ LastValues[k] := '@@@';
+ { ...and row/column item }
+ Source.InsertItem(i, LastValues);
+ Inc(i);
+ end;
+ break;
+ end;
+ end;
+
+begin
+ if Source.Count = 0 then Exit;
+ Unsorted := (Source.FSortOrder[0] = soNone);
+ IndexesCount := Source.FIndexesCount;
+ { copy first indexes to lastvalues }
+ LastValues := Copy(Source.Items[0].Indexes, 0, IndexesCount);
+ i := 0;
+
+ while i < Source.Count do
+ begin
+ { copy current indexes to curvalues }
+ CurValues := Copy(Source.Items[i].Indexes, 0, IndexesCount);
+ { if lastvalues <> curvalues, make a subtotal item }
+ AddTotals;
+ { add header cells }
+ Header.AddValues(CurValues, Unsorted);
+
+ LastValues := CurValues;
+ Inc(i);
+ end;
+
+ { create last subtotal item }
+ CurValues := Copy(Source.Items[0].Indexes, 0, IndexesCount);
+ for j := 0 to IndexesCount - 1 do
+ CurValues[j] := Null;
+ AddTotals;
+
+ { create grand total }
+ if TotalVisible and TfrxCustomMemoView(Totals[0]).Visible then
+ begin
+ LastValues[0] := '@@@' + TfrxCustomMemoView(Totals[0]).Text;
+ Header.AddValues(LastValues, Unsorted);
+ LastValues[0] := '@@@';
+ Source.InsertItem(i, LastValues);
+ end;
+end;
+
+procedure TfrxCustomCrossView.CreateHeaders;
+var
+ i: Integer;
+begin
+ CreateHeader(FColumnHeader, FColumns, FColumnTotalMemos, not FNoColumns);
+ CreateHeader(FRowHeader, FRows, FRowTotalMemos, not FNoRows);
+
+ { add corner elements }
+ for i := 0 to FRowLevels - 1 do
+ FCorner.AddChild(FCornerMemos[3 + i]);
+ if FRowHeader.HasCellHeaders then
+ FCorner.AddChild(FCornerMemos[2]);
+end;
+
+procedure TfrxCustomCrossView.CalcTotal(Header: TfrxCrossHeader;
+ Source: TfrxIndexCollection);
+var
+ i, j: Integer;
+ Items: TList;
+ Values, Counts: TfrxVariantArray;
+ Item: TfrxCrossHeader;
+ p: PfrCrossCell;
+ FinalPass: Boolean;
+
+ procedure CellToArrays(p: PfrCrossCell);
+ var
+ i: Integer;
+ begin
+ for i := 0 to FCellLevels - 1 do
+ begin
+ Values[i] := p.Value;
+ Counts[i] := p.Count;
+
+ if (FCellFunctions[i] = cfAvg) and FinalPass and (p.Count <> 0) then
+ p.Value := p.Value / p.Count;
+
+ p := p.Next;
+ end;
+ end;
+
+ procedure ArraysToCell(p: PfrCrossCell);
+ var
+ i: Integer;
+ begin
+ for i := 0 to FCellLevels - 1 do
+ begin
+ p.Value := Item.FFuncValues[i];
+ p.Count := Item.FCounts[i];
+
+ if (FCellFunctions[i] = cfAvg) and FinalPass then
+ if p.Count <> 0 then
+ p.Value := p.Value / p.Count else
+ p.Value := 0;
+
+ if (FCellFunctions[i] = cfCount) and not FinalPass then
+ p.Count := p.Value;
+
+ p := p.Next;
+ end;
+ end;
+
+begin
+ Items := Header.TerminalItems;
+ SetLength(Values, FCellLevels);
+ SetLength(Counts, FCellLevels);
+ FinalPass := Source = FColumns;
+
+ { scan the matrix }
+ for i := 0 to Source.Count - 1 do
+ begin
+ for j := 0 to Items.Count - 1 do
+ TfrxCrossHeader(Items[j]).Reset(FCellFunctions);
+
+ for j := 0 to Items.Count - 1 do
+ begin
+ Item := Items[j];
+ if Source = FRows then
+ p := FRows[i].GetCell(FColumns[j].CellIndex) else
+ p := FRows[j].GetCell(FColumns[i].CellIndex);
+
+ if not Item.IsTotal then
+ begin
+ { convert cell values to Values and Counts arrays }
+ CellToArrays(p);
+ { accumulate values in the header items }
+ Item.AddFuncValues(Values, Counts, FCellFunctions);
+ end
+ else
+ begin
+ { get the accumulated values from the item's parent }
+ Item := Item.Parent;
+ { and convert it to the cell }
+ ArraysToCell(p);
+ end;
+ end;
+ end;
+
+ Items.Free;
+ Values := nil;
+ Counts := nil;
+end;
+
+procedure TfrxCustomCrossView.CalcTotals;
+begin
+ { scan the matrix from left to right, then from top to bottom }
+ CalcTotal(FColumnHeader, FRows);
+ { final pass, scan the matrix from top to bottom, then from left to right }
+ CalcTotal(FRowHeader, FColumns);
+end;
+
+procedure TfrxCustomCrossView.CalcBounds;
+var
+ i, j, k: Integer;
+ ColumnItems, RowItems: TList;
+ ColumnItem, RowItem: TfrxCrossHeader;
+ Cell: PfrCrossCell;
+ m: TfrxCustomMemoView;
+ NewHeight: Extended;
+ Size: TfrxPoint;
+
+ procedure DoCalc(const Value: Variant);
+ var
+ i, r: Integer;
+ s: WideString;
+ Width, NewWidth: Extended;
+ WidthChanged: Boolean;
+ begin
+ s := m.Text;
+ m.Text := m.FormatData(Value, CellMemos[k].DisplayFormat);
+ r := m.Rotation;
+ m.Rotation := 0;
+
+ Width := FMaxWidth;
+ NewWidth := Width;
+ DoCalcWidth(j, NewWidth);
+ m.Width := NewWidth;
+ WidthChanged := NewWidth <> Width;
+
+ Size := CalcSize(m);
+ Size.X := Size.X + FAddWidth;
+ Size.Y := Size.Y + FAddHeight;
+ if Size.X > FMaxWidth then
+ Size.X := FMaxWidth;
+ if Size.X < FMinWidth then
+ Size.X := FMinWidth;
+ if WidthChanged then
+ begin
+ Size.X := NewWidth;
+ ColumnItem.FSize.X := Size.X;
+ for i := 0 to ColumnItem.Count - 1 do
+ ColumnItem[i].FSize.X := NewWidth;
+ end;
+ if FDefHeight <> 0 then
+ Size.Y := FDefHeight;
+ if NewWidth = 0 then
+ Size.Y := 0;
+
+ m.Rotation := r;
+ m.Text := s;
+ end;
+
+begin
+ ColumnItems := FColumnHeader.TerminalItems;
+ RowItems := FRowHeader.TerminalItems;
+
+ { create cell headers }
+ if FCellLevels > 1 then
+ if FPlainCells then
+ begin
+ for i := 0 to ColumnItems.Count - 1 do
+ begin
+ ColumnItem := ColumnItems[i];
+ for j := 0 to FCellLevels - 1 do
+ ColumnItem.AddCellHeader(FCellHeaderMemos, i, j);
+ end;
+ end
+ else
+ begin
+ for i := 0 to RowItems.Count - 1 do
+ begin
+ RowItem := RowItems[i];
+ for j := 0 to FCellLevels - 1 do
+ RowItem.AddCellHeader(FCellHeaderMemos, i, j);
+ end;
+ end;
+
+ { calculate the widths of columns and the heights of rows }
+ FColumnHeader.CalcSizes(FMaxWidth, FMinWidth, FAutoSize);
+ FRowHeader.CalcSizes(FMaxWidth, FMinWidth, FAutoSize);
+ FCorner.CalcSizes(FMaxWidth, FMinWidth, FAutoSize);
+
+ { scanning the matrix cells and update calculated widths and heights }
+ for i := 0 to RowItems.Count - 1 do
+ begin
+ RowItem := RowItems[i];
+ RowItem.FIsIndex := True;
+ RowItem.FIndex := i;
+
+ for j := 0 to ColumnItems.Count - 1 do
+ begin
+ ColumnItem := ColumnItems[j];
+ ColumnItem.FIsIndex := True;
+ ColumnItem.FIndex := j;
+ if not FAutoSize then continue;
+
+ Cell := FRows[i].GetCell(FColumns[j].CellIndex);
+
+ for k := 0 to FCellLevels - 1 do
+ begin
+ m := CellMemos[ColumnItem.FTotalIndex * ((FRowLevels + 1) * FCellLevels) +
+ RowItem.FTotalIndex * FCellLevels + k];
+
+ DoCalc(Cell.Value);
+
+ if FCellLevels > 1 then
+ if FPlainCells then
+ begin
+ if ColumnItem[k].FSize.X < Size.X then
+ ColumnItem[k].FSize.X := Size.X;
+ if RowItem.FSize.Y < Size.Y then
+ RowItem.FSize.Y := Size.Y;
+ end
+ else
+ begin
+ if RowItem[k].FSize.Y < Size.Y then
+ RowItem[k].FSize.Y := Size.Y;
+ if ColumnItem.FSize.X < Size.X then
+ ColumnItem.FSize.X := Size.X;
+ end
+ else
+ begin
+ if RowItem.FSize.Y < Size.Y then
+ RowItem.FSize.Y := Size.Y;
+ if ColumnItem.FSize.X < Size.X then
+ ColumnItem.FSize.X := Size.X;
+ end;
+
+ Cell := Cell.Next;
+ end;
+ end;
+
+ NewHeight := RowItem.FSize.Y;
+ DoCalcHeight(i, NewHeight);
+ RowItem.FSize.Y := NewHeight;
+ end;
+
+ { calculate the positions and sizes of the header cells }
+ FCorner.CalcBounds;
+ FColumnHeader.CalcBounds;
+ FRowHeader.CalcBounds;
+ { recalc corner again - it may be adjusted in rowheader }
+ FCorner.CalcBounds;
+
+ ColumnItems.Free;
+ RowItems.Free;
+end;
+
+function TfrxCustomCrossView.CreateMemo(Parent: TfrxComponent): TfrxCustomMemoView;
+begin
+ if FDotMatrix then
+ Result := TfrxDMPMemoView.Create(Parent)
+ else
+ Result := TfrxMemoView.Create(Parent);
+end;
+
+procedure TfrxCustomCrossView.CorrectDMPBounds(Memo: TfrxCustomMemoView);
+begin
+ if Memo is TfrxDMPMemoView then
+ begin
+ Memo.Left := Memo.Left + fr1CharX;
+ Memo.Top := Memo.Top + fr1CharY;
+ Memo.Width := Memo.Width - fr1CharX;
+ Memo.Height := Memo.Height - fr1CharY;
+ end;
+end;
+
+function TfrxCustomCrossView.GetContainerObjects: TList;
+begin
+ Result := FAllMemos;
+end;
+
+function TfrxCustomCrossView.ContainerAdd(Obj: TfrxComponent): Boolean;
+var
+ i, j, n: Integer;
+ c: TfrxComponent;
+ Offset: TfrxPoint;
+ NestedObjects: TList;
+ Found: Boolean;
+begin
+ Result := False;
+ if (Obj is TfrxCustomCrossView) or (Obj is TfrxSubreport) then Exit;
+
+ Offset := frxPoint(20, 20);
+ if FDotMatrix then
+ Offset := frxPoint(fr1CharX * 2, fr1CharY);
+ { call DrawCross to calc visible memos and their bounds }
+ DrawCross(nil, FScaleX, FScaleY, AbsLeft + Offset.X, AbsTop + Offset.Y);
+
+ { find parent memo for added object }
+ for i := 0 to FAllMemos.Count - 1 do
+ begin
+ c := FAllMemos[i];
+ if (Obj.Left >= c.Left) and (Obj.Top >= c.Top) and
+ (Obj.Left <= c.Left + c.Width) and
+ (Obj.Top <= c.Top + c.Height) then
+ begin
+ Obj.Left := Obj.Left - c.Left;
+ Obj.Top := Obj.Top - c.Top;
+ Obj.Owner.RemoveComponent(Obj);
+ Obj.Parent := c;
+
+ { create unique tag for it - it will be used for name creation }
+ NestedObjects := GetNestedObjects;
+ n := 0;
+ while True do
+ begin
+ Inc(n);
+ Found := False;
+ for j := 0 to NestedObjects.Count - 1 do
+ if TfrxComponent(NestedObjects[j]).Tag = n then
+ begin
+ Found := True;
+ break;
+ end;
+ if not Found then
+ begin
+ Obj.Tag := n;
+ Obj.Name := Name + 'Object' + IntToStr(n);
+ break;
+ end;
+ end;
+
+ NestedObjects.Free;
+ Result := True;
+ break;
+ end;
+ end;
+end;
+
+function TfrxCustomCrossView.ContainerMouseDown(Sender: TObject; X, Y: Integer): Boolean;
+var
+ i, j: Integer;
+ c: TfrxComponent;
+ Offset: TfrxPoint;
+begin
+ Offset := frxPoint(20, 20);
+ if FDotMatrix then
+ Offset := frxPoint(fr1CharX * 2, fr1CharY);
+ DrawCross(nil, FScaleX, FScaleY, AbsLeft + Offset.X, AbsTop + Offset.Y);
+ FGridUsed := nil;
+ FFirstMousePos := Point(X, Y);
+ FLastMousePos := Point(X, Y);
+ Result := False;
+
+ for i := 0 to FGridX.Count - 1 do
+ for j := 0 to FGridX[i].Objects.Count - 1 do
+ begin
+ c := FGridX[i].Objects[j];
+ if (Abs(c.AbsLeft + c.Width - X / FScaleX) < 2) and
+ (Y / FScaleY >= c.AbsTop) and (Y / FScaleY <= c.AbsTop + c.Height) then
+ begin
+ FGridUsed := FGridX;
+ FMovingObjects := i;
+ Result := True;
+ break;
+ end;
+ end;
+
+ for i := 0 to FGridY.Count - 1 do
+ for j := 0 to FGridY[i].Objects.Count - 1 do
+ begin
+ c := FGridY[i].Objects[j];
+ if (Abs(c.AbsTop + c.Height - Y / FScaleY) < 2) and
+ (X / FScaleX >= c.AbsLeft) and (X / FScaleX <= c.AbsLeft + c.Width) then
+ begin
+ FGridUsed := FGridY;
+ FMovingObjects := i;
+ Result := True;
+ break;
+ end;
+ end;
+
+ FMouseDown := Result;
+end;
+
+procedure TfrxCustomCrossView.ContainerMouseMove(Sender: TObject; X, Y: Integer);
+var
+ i, j: Integer;
+ c: TfrxComponent;
+ Offset: TfrxPoint;
+begin
+//todo designer
+ if (FScaleX = 0) or (FScaleY = 0) then Exit;
+
+ if not FMouseDown then
+ begin
+ Offset := frxPoint(20, 20);
+ if FDotMatrix then
+ Offset := frxPoint(fr1CharX * 2, fr1CharY);
+ DrawCross(nil, FScaleX, FScaleY, AbsLeft + Offset.X, AbsTop + Offset.Y);
+
+ for i := 0 to FGridX.Count - 1 do
+ for j := 0 to FGridX[i].Objects.Count - 1 do
+ begin
+ c := FGridX[i].Objects[j];
+ if (Abs(c.AbsLeft + c.Width - X / FScaleX) < 2) and
+ (Y / FScaleY >= c.AbsTop) and (Y / FScaleY <= c.AbsTop + c.Height) then
+ begin
+ TControl(Sender).Cursor := crHSplit;
+ break;
+ end;
+ end;
+
+ for i := 0 to FGridY.Count - 1 do
+ for j := 0 to FGridY[i].Objects.Count - 1 do
+ begin
+ c := FGridY[i].Objects[j];
+ if (Abs(c.AbsTop + c.Height - Y / FScaleY) < 2) and
+ (X / FScaleX >= c.AbsLeft) and (X / FScaleX <= c.AbsLeft + c.Width) then
+ begin
+ TControl(Sender).Cursor := crVSplit;
+ break;
+ end;
+ end;
+ end
+ else
+ begin
+ if FGridUsed = FGridX then
+ begin
+ for i := 0 to FGridX[FMovingObjects].Objects.Count - 1 do
+ begin
+ c := FGridX[FMovingObjects].Objects[i];
+ c.Width := c.Width + (X - FLastMousePos.X);
+ end;
+ end
+ else if FGridUsed = FGridY then
+ begin
+ for i := 0 to FGridY[FMovingObjects].Objects.Count - 1 do
+ begin
+ c := FGridY[FMovingObjects].Objects[i];
+ c.Height := c.Height + (Y - FLastMousePos.Y);
+ end;
+ end;
+ FLastMousePos := Point(X, Y);
+ end;
+end;
+
+procedure TfrxCustomCrossView.ContainerMouseUp(Sender: TObject; X, Y: Integer);
+begin
+ FMouseDown := False;
+ if FAutoSize and ((Abs(X - FFirstMousePos.X) > 5) or (Abs(Y - FFirstMousePos.Y) > 5)) then
+ frxInfoMsg(frxResources.Get('crResize'));
+end;
+
+function TfrxCustomCrossView.DrawCross(Canvas: TCanvas; ScaleX, ScaleY,
+ OffsetX, OffsetY: Extended): TfrxPoint;
+
+ procedure FillMatrix;
+ var
+ i: Integer;
+ RowValues, ColumnValues, CellValues: array of Variant;
+ begin
+ BeginMatrix;
+ InitMemos(False);
+ SetLength(RowValues, RowLevels);
+ SetLength(ColumnValues, ColumnLevels);
+ SetLength(CellValues, CellLevels);
+
+ for i := 0 to RowLevels - 1 do
+ RowValues[i] := '[' + RowFields[i] + ']';
+ for i := 0 to ColumnLevels - 1 do
+ ColumnValues[i] := '[' + ColumnFields[i] + ']';
+ for i := 0 to CellLevels - 1 do
+ CellValues[i] := 0;
+ AddValue(RowValues, ColumnValues, CellValues);
+
+ RowValues := nil;
+ ColumnValues := nil;
+ CellValues := nil;
+ EndMatrix;
+ end;
+
+ procedure DrawLine2(x, y, dx, dy: Extended);
+ begin
+ Canvas.DrawLine(PointF(Round(x * ScaleX), Round(y * ScaleY)), PointF(Round((x + dx) * ScaleX), Round((y + dy) * ScaleY)), 1);
+ end;
+
+ procedure DrawScriptSign(c: TfrxReportComponent);
+ begin
+ if (Canvas <> nil) and (c.OnBeforePrint <> '') then
+ with c, Canvas do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := claRed;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+
+ DrawLine2(AbsLeft + 2, AbsTop + 1, 0, 7);
+ DrawLine2(AbsLeft + 3, AbsTop + 2, 0, 5);
+ DrawLine2(AbsLeft + 4, AbsTop + 3, 0, 3);
+ DrawLine2(AbsLeft + 5, AbsTop + 4, 0, 1);
+ end;
+ end;
+
+ procedure DrawObj(Obj: TfrxReportComponent; Child: Boolean = False);
+ var
+ i: Integer;
+ begin
+ { don't let a child move outside parent }
+ if Child then
+ begin
+ if Obj.Left < 0 then
+ Obj.Left := 0;
+ if Obj.Left + Obj.Width > Obj.Parent.Width then
+ Obj.Left := Obj.Parent.Width - Obj.Width;
+ if Obj.Top < 0 then
+ Obj.Top := 0;
+ if Obj.Top + Obj.Height > Obj.Parent.Height then
+ Obj.Top := Obj.Parent.Height - Obj.Height;
+ end;
+
+ if Canvas <> nil then
+ Obj.Draw(Canvas, ScaleX, ScaleY, 0, 0);
+ DrawScriptSign(Obj);
+ if not Child then
+ begin
+ FGridX.Add(Obj, Obj.AbsLeft + Obj.Width);
+ FGridY.Add(Obj, Obj.AbsTop + Obj.Height);
+ end;
+ FAllMemos.Add(Obj);
+ for i := 0 to Obj.Objects.Count - 1 do
+ DrawObj(Obj.Objects[i], True);
+ end;
+
+ procedure DrawHeader(Header: TfrxCrossHeader; p: TfrxPoint);
+ var
+ i: Integer;
+ Items: TList;
+ Item: TfrxCrossHeader;
+ r: TfrxRect;
+ m: TfrxCustomMemoView;
+ SaveWidth, SaveHeight: Extended; // for dot-matrix
+ s: WideString;
+ begin
+ Items := Header.AllItems;
+
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ m := Item.Memo;
+ r := Item.Bounds;
+
+ s := m.Text;
+ m.Text := VarToWideStr(Item.Value);
+ m.SetBounds(r.Left + p.X, r.Top + p.Y, r.Right, r.Bottom);
+ SaveWidth := m.Width;
+ SaveHeight := m.Height;
+ CorrectDMPBounds(m);
+ if m.Left + m.Width > Result.X then
+ Result.X := m.Left + m.Width;
+ if m.Top + m.Height > Result.Y then
+ Result.Y := m.Top + m.Height;
+
+ if m.Visible then
+ DrawObj(m);
+
+ m.Text := s;
+ if m is TfrxDMPMemoView then
+ TfrxDMPMemoView(m).SetBoundsDirect(m.Left - fr1CharX / 2,
+ m.Top - fr1CharY / 2, SaveWidth, SaveHeight);
+ end;
+
+ Items.Free;
+ end;
+
+ procedure DrawCell(p: TfrxPoint);
+ var
+ i, j, CellIndex: Integer;
+ Cell: Variant;
+ ColumnItems, RowItems: TList;
+ ColumnItem, RowItem: TfrxCrossHeader;
+ m: TfrxCustomMemoView;
+ SaveWidth, SaveHeight: Extended; // for dot-matrix
+ begin
+ ColumnItems := ColumnHeader.TerminalItems;
+ RowItems := RowHeader.TerminalItems;
+
+ for i := 0 to RowItems.Count - 1 do
+ begin
+ RowItem := RowItems[i];
+ for j := 0 to ColumnItems.Count - 1 do
+ begin
+ ColumnItem := ColumnItems[j];
+
+ if FCellLevels > 1 then
+ if FPlainCells then
+ begin
+ CellIndex := ColumnItem.FCellIndex;
+ Cell := GetValue(i, ColumnItem.FIndex, CellIndex);
+ end
+ else
+ begin
+ CellIndex := RowItem.FCellIndex;
+ Cell := GetValue(RowItem.FIndex, j, CellIndex);
+ end
+ else
+ begin
+ CellIndex := 0;
+ Cell := GetValue(i, j, 0);
+ end;
+
+ m := CellMemos[ColumnItem.FTotalIndex * ((FRowLevels + 1) * FCellLevels) +
+ RowItem.FTotalIndex * FCellLevels + CellIndex];
+ m.Visible := True;
+ m.Restrictions := [rfDontDelete, rfDontEdit];
+ m.Text := m.FormatData(Cell, CellMemos[CellIndex].DisplayFormat);
+ m.SetBounds(ColumnItem.Bounds.Left, RowItem.Bounds.Top,
+ ColumnItem.Bounds.Right, RowItem.Bounds.Bottom);
+ m.Left := m.Left + p.X;
+ m.Top := m.Top + p.Y;
+ SaveWidth := m.Width;
+ SaveHeight := m.Height;
+ CorrectDMPBounds(m);
+ if m.Left + m.Width > Result.X then
+ Result.X := m.Left + m.Width;
+ if m.Top + m.Height > Result.Y then
+ Result.Y := m.Top + m.Height;
+
+ DrawObj(m);
+ if m is TfrxDMPMemoView then
+ TfrxDMPMemoView(m).SetBoundsDirect(m.Left - fr1CharX / 2,
+ m.Top - fr1CharY / 2, SaveWidth, SaveHeight);
+ end;
+ end;
+
+ ColumnItems.Free;
+ RowItems.Free;
+ end;
+
+begin
+ Result := frxPoint(0, 0);
+ FGridX.Clear;
+ FGridY.Clear;
+ FAllMemos.Clear;
+
+ if IsCrossValid then
+ begin
+ FillMatrix;
+ if Corner.Visible then
+ DrawHeader(Corner, frxPoint(OffsetX, OffsetY));
+ if ColumnHeader.Visible then
+ DrawHeader(ColumnHeader, frxPoint(OffsetX + RowHeaderWidth, OffsetY));
+ if RowHeader.Visible then
+ DrawHeader(RowHeader, frxPoint(OffsetX, OffsetY + ColumnHeaderHeight));
+ DrawCell(frxPoint(OffsetX + RowHeaderWidth, OffsetY + ColumnHeaderHeight));
+ end;
+
+ Result.X := Result.X - OffsetX;
+ Result.Y := Result.Y - OffsetY;
+end;
+
+procedure TfrxCustomCrossView.Draw(Canvas: TCanvas; ScaleX, ScaleY,
+ OffsetX, OffsetY: Extended);
+var
+ size, Offset: TfrxPoint;
+begin
+ size := DrawCross(nil, ScaleX, ScaleY, AbsLeft, AbsTop);
+ if (size.X > 0) and (size.Y > 0) then
+ begin
+ Width := size.X + 40;
+ Height := size.Y + 40;
+ end;
+
+ Color := claWhite;
+ Frame.Style := fsDot;
+ inherited;
+
+ Offset := frxPoint(20, 20);
+ if FDotMatrix then
+ Offset := frxPoint(fr1CharX * 2, fr1CharY);
+ DrawCross(Canvas, ScaleX, ScaleY, AbsLeft + Offset.X, AbsTop + Offset.Y);
+{ if Self is TfrxDBCrossView then
+ img := 49
+ else
+ img := 42;
+ frxResources.ObjectImages.Draw(Canvas, FX + 2, FY + 2, img);}
+end;
+
+procedure TfrxCustomCrossView.ApplyStyle(Style: TfrxStyles);
+var
+ i: Integer;
+ s: String;
+begin
+ for i := 0 to FCellHeaderMemos.Count - 1 do
+ CellHeaderMemos[i].ApplyStyle(Style.Find('cellheader'));
+
+ for i := 0 to FCellMemos.Count - 1 do
+ CellMemos[i].ApplyStyle(Style.Find('cell'));
+
+ for i := 0 to FColumnMemos.Count - 1 do
+ begin
+ ColumnMemos[i].ApplyStyle(Style.Find('column'));
+ if i = 0 then
+ s := 'colgrand'
+ else
+ s := 'coltotal';
+ ColumnTotalMemos[i].ApplyStyle(Style.Find(s));
+ end;
+
+ for i := 0 to FRowMemos.Count - 1 do
+ begin
+ RowMemos[i].ApplyStyle(Style.Find('row'));
+ if i = 0 then
+ s := 'rowgrand'
+ else
+ s := 'rowtotal';
+ RowTotalMemos[i].ApplyStyle(Style.Find(s));
+ end;
+
+ for i := 0 to FCornerMemos.Count - 1 do
+ CornerMemos[i].ApplyStyle(Style.Find('corner'));
+end;
+
+procedure TfrxCustomCrossView.GetStyle(Style: TfrxStyles);
+
+ procedure DoStyle(m: TfrxCustomMemoView; const s: String);
+ var
+ stItem: TfrxStyleItem;
+ begin
+ stItem := Style.Find(s);
+ if stItem = nil then
+ stItem := Style.Add;
+ stItem.Name := s;
+ stItem.Color := m.Color;
+ stItem.Font := m.Font;
+ stItem.Frame := m.Frame;
+ end;
+
+begin
+ if FCellHeaderMemos.Count > 0 then
+ DoStyle(CellHeaderMemos[0], 'cellheader');
+
+ if FCellMemos.Count > 0 then
+ DoStyle(CellMemos[0], 'cell');
+
+ if FColumnMemos.Count > 0 then
+ begin
+ DoStyle(ColumnMemos[0], 'column');
+ DoStyle(ColumnTotalMemos[0], 'colgrand');
+ if FColumnTotalMemos.Count > 1 then
+ DoStyle(ColumnTotalMemos[1], 'coltotal');
+ end;
+
+ if FRowMemos.Count > 0 then
+ begin
+ DoStyle(RowMemos[0], 'row');
+ DoStyle(RowTotalMemos[0], 'rowgrand');
+ if FRowTotalMemos.Count > 1 then
+ DoStyle(RowTotalMemos[1], 'rowtotal');
+ end;
+
+ if FCornerMemos.Count > 0 then
+ DoStyle(CornerMemos[0], 'corner');
+end;
+
+procedure TfrxCustomCrossView.UpdateVisibility;
+begin
+ Corner.Visible := FShowCorner and not FNoRows
+ and FShowColumnHeader and FShowRowHeader;
+ CornerMemos[0].Visible := Corner.Visible and not FNoColumns and FShowTitle;
+ CornerMemos[2].Visible := Corner.Visible and (FCellLevels > 1) and not FPlainCells;
+
+ ColumnHeader.Visible := FShowColumnHeader;
+ if FColumnTotalMemos.Count > 0 then
+ ColumnTotalMemos[0].Visible := FShowColumnTotal and not FNoColumns;
+ CornerMemos[1].Visible := FShowTitle and ColumnHeader.Visible;
+ ColumnMemos[0].Visible := ColumnHeader.Visible and not FNoColumns;
+
+ RowHeader.Visible := not FNoRows and FShowRowHeader;
+ if FRowTotalMemos.Count > 0 then
+ RowTotalMemos[0].Visible := FShowRowTotal and not FNoRows;
+end;
+
+procedure TfrxCustomCrossView.BeginMatrix;
+begin
+ InitMatrix;
+ UpdateVisibility;
+end;
+
+procedure TfrxCustomCrossView.EndMatrix;
+begin
+ CreateHeaders;
+ CalcTotals;
+ CalcBounds(FAddWidth, FAddHeight);
+end;
+
+procedure TfrxCustomCrossView.FillMatrix;
+begin
+end;
+
+procedure TfrxCustomCrossView.DoCalcHeight(Row: Integer; var Height: Extended);
+var
+ v: Variant;
+begin
+ if FOnCalcHeight <> '' then
+ begin
+ v := VarArrayOf([Row, GetRowIndexes(Row), Height]);
+ if Report <> nil then
+ Report.DoParamEvent(FOnCalcHeight, v);
+ Height := v[2];
+ end;
+ if Assigned(FOnBeforeCalcHeight) then
+ FOnBeforeCalcHeight(Row, GetRowIndexes(Row), Height);
+end;
+
+procedure TfrxCustomCrossView.DoCalcWidth(Column: Integer; var Width: Extended);
+var
+ v: Variant;
+begin
+ if FOnCalcWidth <> '' then
+ begin
+ v := VarArrayOf([Column, GetColumnIndexes(Column), Width]);
+ if Report <> nil then
+ Report.DoParamEvent(FOnCalcWidth, v);
+ Width := v[2];
+ end;
+ if Assigned(FOnBeforeCalcWidth) then
+ FOnBeforeCalcWidth(Column, GetColumnIndexes(Column), Width);
+end;
+
+procedure TfrxCustomCrossView.DoOnCell(Memo: TfrxCustomMemoView;
+ Row, Column, Cell: Integer; const Value: Variant);
+var
+ v: Variant;
+begin
+ if FOnPrintCell <> '' then
+ begin
+ v := VarArrayOf([frxInteger(Memo), Row, Column, Cell, GetRowIndexes(Row),
+ GetColumnIndexes(Column), Value]);
+ if Report <> nil then
+ Report.DoParamEvent(FOnPrintCell, v);
+ end;
+ if Assigned(FOnBeforePrintCell) then
+ FOnBeforePrintCell(Memo, Row, Column, Cell, GetRowIndexes(Row),
+ GetColumnIndexes(Column), Value);
+end;
+
+procedure TfrxCustomCrossView.DoOnColumnHeader(Memo: TfrxCustomMemoView;
+ Header: TfrxCrossHeader);
+var
+ v: Variant;
+begin
+ if FOnPrintColumnHeader <> '' then
+ begin
+ v := VarArrayOf([frxInteger(Memo), Header.GetIndexes, Header.GetValues, Header.Value]);
+ if Report <> nil then
+ Report.DoParamEvent(FOnPrintColumnHeader, v);
+ end;
+ if Assigned(FOnBeforePrintColumnHeader) then
+ FOnBeforePrintColumnHeader(Memo, Header.GetIndexes, Header.GetValues, Header.Value);
+end;
+
+procedure TfrxCustomCrossView.DoOnRowHeader(Memo: TfrxCustomMemoView;
+ Header: TfrxCrossHeader);
+var
+ v: Variant;
+begin
+ if FOnPrintRowHeader <> '' then
+ begin
+ v := VarArrayOf([frxInteger(Memo), Header.GetIndexes, Header.GetValues, Header.Value]);
+ if Report <> nil then
+ Report.DoParamEvent(FOnPrintRowHeader, v);
+ end;
+ if Assigned(FOnBeforePrintRowHeader) then
+ FOnBeforePrintRowHeader(Memo, Header.GetIndexes, Header.GetValues, Header.Value);
+end;
+
+procedure TfrxCustomCrossView.BeforeStartReport;
+begin
+ inherited;
+ InitMemos(True);
+end;
+
+procedure TfrxCustomCrossView.BeforePrint;
+begin
+ inherited;
+ if FClearBeforePrint then
+ BeginMatrix;
+end;
+
+procedure TfrxCustomCrossView.GetData;
+begin
+ inherited;
+ Report.SetProgressMessage(frxResources.Get('crFillMx'));
+ if IsCrossValid then
+ FillMatrix;
+ Report.SetProgressMessage(frxResources.Get('crBuildMx'));
+ EndMatrix;
+ RenderMatrix;
+end;
+
+procedure TfrxCustomCrossView.RenderMatrix;
+var
+ i, j, Page, SavePage: Integer;
+ CurY, FirstCurY, SaveCurY, AddWidth, MaxX: Extended;
+ Band: TfrxBand;
+ ColumnItems: TList;
+ RowItems: TList;
+ VarRowIndex, VarColumnIndex: TfrxVariable;
+
+ function GetCellBand(RowIndex, ColumnIndex: Integer): TfrxBand;
+ var
+ i, iFrom, iTo, j: Integer;
+ Cell: Variant;
+ CellIndex: Integer;
+ ColumnItem, RowItem: TfrxCrossHeader;
+ m, Memo: TfrxCustomMemoView;
+ LeftMargin, TopMargin: Extended;
+ SameMemos: array[0..31] of TfrxCustomMemoView;
+ c, c1: TfrxReportComponent;
+ begin
+ RowItem := RowItems[RowIndex];
+
+ Result := TfrxNullBand.Create(Report);
+ Result.Height := RowItem.Bounds.Bottom;
+
+ iFrom := FColumnBands[ColumnIndex].FromIndex;
+ iTo := FColumnBands[ColumnIndex].ToIndex;
+ LeftMargin := TfrxCrossHeader(ColumnItems[iFrom]).Bounds.Left;
+ TopMargin := RowItem.Bounds.Top;
+
+ for i := 0 to CellLevels - 1 do
+ SameMemos[i] := nil;
+
+ for i := iFrom to iTo do
+ begin
+ ColumnItem := ColumnItems[i];
+
+ if FCellLevels > 1 then
+ if FPlainCells then
+ begin
+ CellIndex := ColumnItem.FCellIndex;
+ Cell := GetValue(RowIndex, ColumnItem.FIndex, CellIndex);
+ end
+ else
+ begin
+ CellIndex := RowItem.FCellIndex;
+ Cell := GetValue(RowItem.FIndex, i, CellIndex);
+ end
+ else
+ begin
+ CellIndex := 0;
+ Cell := GetValue(RowIndex, i, 0);
+ end;
+
+ m := CellMemos[ColumnItem.FTotalIndex * ((FRowLevels + 1) * FCellLevels) +
+ RowItem.FTotalIndex * FCellLevels + CellIndex];
+ Memo := CreateMemo(Result);
+ Memo.Assign(m);
+ SetupOriginalComponent(Memo, m);
+ if Cell <> Null then
+ THackMemoView(Memo).Value := Cell
+ else
+ THackMemoView(Memo).Value := 0;
+
+ if THackMemoView(Memo).HideZeros and (TVarData(THackMemoView(Memo).Value).VType <> varString)
+ and (TVarData(THackMemoView(Memo).Value).VType <> varUString) and
+ (TVarData(THackMemoView(Memo).Value).VType <> varOleStr) and (THackMemoView(Memo).Value = 0) then
+ Memo.Text := ''
+ else
+ Memo.Text := Memo.FormatData(Cell, CellMemos[CellIndex].DisplayFormat);
+
+ Memo.Rotation := 0;
+ Memo.SetBounds(ColumnItem.Bounds.Left - LeftMargin + AddWidth,
+ RowItem.Bounds.Top - TopMargin,
+ ColumnItem.Bounds.Right,
+ RowItem.Bounds.Bottom);
+ CorrectDMPBounds(Memo);
+ if Memo.AbsLeft + Memo.Width > MaxX then
+ MaxX := Memo.AbsLeft + Memo.Width;
+ Memo.Visible := (Memo.Width <> 0) and (Memo.Height <> 0);
+ DoOnCell(Memo, RowItem.FIndex, ColumnItem.FIndex, CellIndex, Cell);
+
+ if FBorder then
+ begin
+ if FPlainCells then
+ begin
+ if RowIndex = 0 then
+ Memo.Frame.Typ := Memo.Frame.Typ + [ftTop];
+ if (i = 0) and (CellIndex = 0) then
+ Memo.Frame.Typ := Memo.Frame.Typ + [ftLeft];
+ if (i = ColumnItems.Count - 1) and (CellIndex = CellLevels - 1) then
+ Memo.Frame.Typ := Memo.Frame.Typ + [ftRight];
+ if RowIndex = RowItems.Count - 1 then
+ Memo.Frame.Typ := Memo.Frame.Typ + [ftBottom];
+ end
+ else
+ begin
+ if (RowIndex = 0) and (CellIndex = 0) then
+ Memo.Frame.Typ := Memo.Frame.Typ + [ftTop];
+ if i = 0 then
+ Memo.Frame.Typ := Memo.Frame.Typ + [ftLeft];
+ if i = ColumnItems.Count - 1 then
+ Memo.Frame.Typ := Memo.Frame.Typ + [ftRight];
+ if (RowIndex = RowItems.Count - 1) and (CellIndex = CellLevels - 1) then
+ Memo.Frame.Typ := Memo.Frame.Typ + [ftBottom];
+ end;
+ end;
+
+ { check if previous memo has the same value and JoinEqualCells is True }
+ if JoinEqualCells then
+ if RowItem.IsTotal or ColumnItem.IsTotal then
+ SameMemos[CellIndex] := nil
+ else if (SameMemos[CellIndex] = nil) or RowItem.IsTotal or ColumnItem.IsTotal or
+ (THackMemoView(SameMemos[CellIndex]).Value <> THackMemoView(Memo).Value) then
+ SameMemos[CellIndex] := Memo
+ else
+ begin
+ SameMemos[CellIndex].Width := SameMemos[CellIndex].Width + Memo.Width;
+ SameMemos[CellIndex].HAlign := haCenter;
+ Memo.Free;
+ Memo := SameMemos[CellIndex];
+ end;
+
+ VarRowIndex.Value := RowIndex;
+ VarColumnIndex.Value := i;
+ Report.LocalValue := THackMemoView(Memo).Value;
+ Report.CurObject := Memo.Name;
+ Report.DoBeforePrint(Memo);
+
+ { process memo children if any }
+ for j := 0 to m.Objects.Count - 1 do
+ begin
+ c := m.Objects[j];
+ c1 := TfrxReportComponent(c.NewInstance);
+ c1.Create(Result);
+ c1.Assign(c);
+ c1.Left := c1.Left + Memo.Left;
+ c1.Top := c1.Top + Memo.Top;
+ Report.CurObject := c.Name;
+ Report.DoBeforePrint(c1);
+ end;
+ end;
+ end;
+
+ procedure DrawCorner(Offset: TfrxPoint);
+ var
+ i: Integer;
+ Items: TList;
+ Item: TfrxCrossHeader;
+ r: TfrxRect;
+ m: TfrxCustomMemoView;
+ begin
+ if not FShowRowHeader or not FShowColumnHeader or FNoRows or not FShowCorner then Exit;
+
+ Items := Corner.AllItems;
+
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ m := Item.Memo;
+ r := Item.Bounds;
+ m.BeforePrint;
+ m.Text := VarToWideStr(Item.Value);
+ m.SetBounds(r.Left + Offset.X, r.Top + Offset.Y, r.Right, r.Bottom);
+ CorrectDMPBounds(m);
+ Report.PreviewPages.AddObject(m);
+ m.AfterPrint;
+ end;
+
+ Items.Free;
+ end;
+
+ procedure DoPagination(i, j: Integer);
+ var
+ k, kFrom, kTo: Integer;
+ begin
+ if ShowColumnHeader and (FRepeatHeaders or (i = 0)) then
+ begin
+ Band := FColumnBands[j].Band;
+ Band.Top := CurY;
+ Report.Engine.ShowBand(Band);
+ end;
+
+ if ShowRowHeader and (FRepeatHeaders or (j = 0)) and not FNoRows then
+ begin
+ Band := FRowBands[i].Band;
+ if j = 0 then
+ Band.Left := Left
+ else
+ Band.Left := 0;
+ Band.Top := Band.Top + CurY;
+ Report.Engine.ShowBand(Band);
+ Band.Top := Band.Top - CurY;
+
+ if ShowColumnHeader and (FRepeatHeaders or (i = 0)) then
+ DrawCorner(frxPoint(Band.Left, Band.Top + CurY - ColumnHeaderHeight));
+ end;
+
+ if FRepeatHeaders or (i = 0) then
+ Report.Engine.CurY := CurY + ColumnHeaderHeight else
+ Report.Engine.CurY := CurY;
+ if FRepeatHeaders or (j = 0) then
+ begin
+ AddWidth := RowHeaderWidth;
+ if j = 0 then
+ AddWidth := AddWidth + Left;
+ end
+ else
+ AddWidth := 0;
+
+ kFrom := FRowBands[i].FromIndex;
+ kTo := FRowBands[i].ToIndex;
+
+ for k := kFrom to kTo do
+ begin
+ Band := GetCellBand(k, j);
+ Band.Top := Report.Engine.CurY;
+ Report.Engine.ShowBand(Band);
+ Band.Free;
+ end;
+ end;
+
+begin
+ { chek if cross header doesn't fit on the free space}
+ if ColumnHeaderHeight >= Report.Engine.FreeSpace then
+ Report.Engine.NewPage;
+ BuildColumnBands;
+ BuildRowBands;
+
+ ColumnItems := ColumnHeader.TerminalItems;
+ RowItems := RowHeader.TerminalItems;
+ SavePage := Report.PreviewPages.CurPage;
+ Page := SavePage;
+ SaveCurY := Report.Engine.CurY;
+ CurY := SaveCurY;
+ MaxX := 0;
+
+ frxGlobalVariables['RowIndex'] := 0;
+ frxGlobalVariables['ColumnIndex'] := 0;
+ VarRowIndex := frxGlobalVariables.Items[frxGlobalVariables.IndexOf('RowIndex')];
+ VarColumnIndex := frxGlobalVariables.Items[frxGlobalVariables.IndexOf('ColumnIndex')];
+
+ if FDownThenAcross then
+ begin
+ FirstCurY := Report.Engine.CurY;
+ for i := 0 to FColumnBands.Count - 1 do
+ begin
+ for j := 0 to FRowBands.Count - 1 do
+ begin
+ Report.PreviewPages.CurPage := Page + j;
+ DoPagination(j, i);
+ if j <> FRowBands.Count - 1 then
+ begin
+ Report.Engine.BreakAllKeep;
+ Report.Engine.NewPage;
+ CurY := Report.Engine.CurY;
+ end;
+ end;
+
+ if i <> FColumnBands.Count - 1 then
+ Report.Engine.NewPage;
+ CurY := FirstCurY;
+ Inc(Page, FRowBands.Count);
+
+ Report.AppHandleMessage;
+ if Report.Terminated then break;
+ end
+ end
+ else
+ for i := 0 to FRowBands.Count - 1 do
+ begin
+ for j := 0 to FColumnBands.Count - 1 do
+ begin
+ Report.PreviewPages.CurPage := Page + j;
+ MaxX := 0;
+ DoPagination(i, j);
+ if j <> FColumnBands.Count - 1 then
+ begin
+ Report.PreviewPages.AddPageAction := apWriteOver;
+ Report.Engine.NewPage;
+ end
+ else if NextCross <> nil then
+ NextCross.Left := MaxX + NextCrossGap;
+ end;
+
+ if i <> FRowBands.Count - 1 then
+ begin
+ Report.PreviewPages.AddPageAction := apAdd;
+ Report.Engine.BreakAllKeep;
+ Report.Engine.NewPage;
+ Page := Report.PreviewPages.CurPage;
+ end
+ else
+ Inc(Page, FColumnBands.Count);
+ CurY := Report.Engine.CurY;
+
+ Report.AppHandleMessage;
+ if Report.Terminated then break;
+ end;
+
+ if Parent is TfrxBand then
+ CurY := CurY - Height;
+ { print last page footers }
+ if FColumnBands.Count > 1 then
+ Report.Engine.EndPage;
+
+ if NextCross <> nil then
+ begin
+ { position to last column, first row page }
+ Report.PreviewPages.CurPage := SavePage + FColumnBands.Count - 1;
+ Report.PreviewPages.AddPageAction := apAdd;
+ Report.Engine.CurY := SaveCurY;
+ end
+ else
+ begin
+ { position to last row, first column page }
+ Report.PreviewPages.CurPage := Page - FColumnBands.Count;
+ Report.PreviewPages.AddPageAction := apAdd;
+ Report.Engine.CurY := CurY;
+ end;
+
+ ColumnItems.Free;
+ RowItems.Free;
+ FColumnBands.Clear;
+ FRowBands.Clear;
+end;
+
+procedure TfrxCustomCrossView.AddSourceObjects;
+var
+ i: Integer;
+begin
+ for i := 0 to FCellHeaderMemos.Count - 1 do
+ Report.PreviewPages.AddToSourcePage(CellHeaderMemos[i]);
+ for i := 0 to FCellMemos.Count - 1 do
+ Report.PreviewPages.AddToSourcePage(CellMemos[i]);
+ for i := 0 to FColumnMemos.Count - 1 do
+ begin
+ Report.PreviewPages.AddToSourcePage(ColumnMemos[i]);
+ Report.PreviewPages.AddToSourcePage(ColumnTotalMemos[i]);
+ end;
+ for i := 0 to FCornerMemos.Count - 1 do
+ Report.PreviewPages.AddToSourcePage(CornerMemos[i]);
+ for i := 0 to FRowMemos.Count - 1 do
+ begin
+ Report.PreviewPages.AddToSourcePage(RowMemos[i]);
+ Report.PreviewPages.AddToSourcePage(RowTotalMemos[i]);
+ end;
+end;
+
+procedure TfrxCustomCrossView.SetupOriginalComponent(Obj1, Obj2: TfrxComponent);
+begin
+ THackComponent(Obj1).FOriginalComponent := THackComponent(Obj2).FOriginalComponent;
+ THackComponent(Obj1).FAliasName := THackComponent(Obj2).FAliasName;
+end;
+
+procedure TfrxCustomCrossView.BuildColumnBands;
+var
+ i, j, LeftIndex, RightIndex: Integer;
+ Items: TList;
+ Item: TfrxCrossHeader;
+ Memo: TfrxCustomMemoView;
+ LargeBand: TfrxNullBand;
+ CurWidth, AddWidth, LeftMargin, RightMargin: Extended;
+ c: TfrxReportComponent;
+
+ procedure CreateBand;
+ var
+ i: Integer;
+ Band: TfrxNullBand;
+ Memo, CutMemo: TfrxCustomMemoView;
+ CutSize: Extended;
+ begin
+ Band := TfrxNullBand.Create(Report);
+ Band.Left := AddWidth;
+
+ { move in-bounds memos to the new band }
+ i := 0;
+ while i < LargeBand.Objects.Count do
+ begin
+ Memo := LargeBand.Objects[i];
+ if Memo.Left < RightMargin then
+ begin
+ if Memo.Left + Memo.Width <= RightMargin + 5 then
+ begin
+ Memo.Parent := Band;
+ Memo.Visible := Memo.Width > 0;
+ Dec(i);
+ end
+ else { cut off the memo }
+ begin
+ CutSize := RightMargin - Memo.Left;
+ CutMemo := CreateMemo(Band);
+ CutMemo.AssignAll(Memo);
+ CutMemo.Width := CutSize;
+ //if CutMemo.CalcWidth > CutSize then
+ //CutMemo.Text := '';
+
+ SetupOriginalComponent(CutMemo, Memo);
+ Memo.Width := Memo.Width - CutSize;
+ Memo.Left := Memo.Left + CutSize;
+ if Memo is TfrxDMPMemoView then
+ begin
+ Memo.Left := Memo.Left + fr1CharX;
+ Memo.Width := Memo.Width - fr1CharX;
+ end;
+ CutMemo.Frame.Typ := CutMemo.Frame.Typ - [ftRight];
+ Memo.Frame.Typ := Memo.Frame.Typ - [ftLeft];
+
+ //if Memo.CalcWidth > Memo.Width then
+ //Memo.Text := '';
+ Memo := CutMemo;
+ end;
+
+ Memo.Left := Memo.Left - LeftMargin;
+ end;
+ Inc(i);
+ end;
+
+ FColumnBands.Add(Band, LeftIndex, RightIndex);
+ end;
+
+begin
+ FColumnBands.Clear;
+ { create one large band }
+ LargeBand := TfrxNullBand.Create(nil);
+ Items := ColumnHeader.AllItems;
+
+ { add memos to band }
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ if (i = 0) and not FShowTitle then continue;
+ Memo := CreateMemo(LargeBand);
+ Memo.AssignAll(Item.Memo);
+ SetupOriginalComponent(Memo, Item.Memo);
+ Memo.Text := Memo.FormatData(Item.Value);
+ Memo.Highlight.Condition := '';
+ with Item.Bounds do
+ Memo.SetBounds(Left, Top, Right, Bottom);
+ CorrectDMPBounds(Memo);
+ Memo.Visible := (Memo.Width <> 0) and (Memo.Height <> 0);
+ DoOnColumnHeader(Memo, Item);
+
+ Report.LocalValue := Item.Value;
+ Report.CurObject := Memo.Name;
+ Report.DoBeforePrint(Memo);
+
+ { process memo children if any }
+ for j := 0 to Memo.Objects.Count - 1 do
+ begin
+ c := Memo.Objects[j];
+ Report.CurObject := c.Name;
+ Report.DoBeforePrint(c);
+ end;
+ end;
+
+ Items.Free;
+
+ { cut it to small bands for each page }
+ Items := ColumnHeader.TerminalItems;
+ AddWidth := RowHeaderWidth;
+ CurWidth := Report.Engine.PageWidth - AddWidth;
+ LeftMargin := -Left;
+ RightMargin := LeftMargin + CurWidth;
+ LeftIndex := 0;
+ RightIndex := Items.Count - 1;
+
+ if not TfrxReportPage(Page).EndlessWidth then
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ { find right terminal item }
+ if Item.Bounds.Left + Item.Bounds.Right - LeftMargin > CurWidth then
+ begin
+ RightMargin := Item.Bounds.Left;
+ RightIndex := i - 1;
+ CreateBand;
+ LeftMargin := RightMargin;
+ if FRepeatHeaders then
+ AddWidth := RowHeaderWidth else
+ AddWidth := 0;
+ CurWidth := Report.Engine.PageWidth - AddWidth;
+ RightMargin := LeftMargin + CurWidth;
+ LeftIndex := RightIndex + 1;
+ RightIndex := Items.Count - 1;
+ end;
+ end;
+
+ if TfrxReportPage(Page).EndlessWidth then
+ begin
+ Item := Items[Items.Count - 1];
+ CurWidth := Item.Bounds.Left + Item.Bounds.Right - LeftMargin + AddWidth;
+ if Report.Engine.PageWidth < CurWidth then
+ Report.Engine.PageWidth := CurWidth;
+ RightMargin := 1e+6;
+ end;
+
+ { add last band }
+ CreateBand;
+
+ LargeBand.Free;
+ Items.Free;
+end;
+
+procedure TfrxCustomCrossView.BuildRowBands;
+var
+ i, j, TopIndex, BottomIndex: Integer;
+ Items: TList;
+ Item, HParent: TfrxCrossHeader;
+ Memo: TfrxCustomMemoView;
+ LargeBand: TfrxNullBand;
+ MaxHeight, CurHeight, AddHeight, TopMargin, BottomMargin: Extended;
+ c: TfrxReportComponent;
+
+ procedure CreateBand;
+ var
+ i: Integer;
+ Band: TfrxNullBand;
+ Memo, CutMemo: TfrxCustomMemoView;
+ CutSize: Extended;
+ begin
+ Band := TfrxNullBand.Create(Report);
+ Band.Top := AddHeight;
+
+ { move in-bounds memos to the new band }
+ i := 0;
+ while i < LargeBand.Objects.Count do
+ begin
+ Memo := LargeBand.Objects[i];
+ if Memo.Top < BottomMargin then
+ begin
+ if Memo.Top + Memo.Height <= BottomMargin + 5 then
+ begin
+ Memo.Parent := Band;
+ Dec(i);
+ end
+ else { cut off the memo }
+ begin
+ CutSize := BottomMargin - Memo.Top;
+ CutMemo := CreateMemo(Band);
+ CutMemo.AssignAll(Memo);
+ CutMemo.Height := CutSize;
+ SetupOriginalComponent(CutMemo, Memo);
+ Memo.Height := Memo.Height - CutSize;
+ Memo.Top := Memo.Top + CutSize;
+ if Memo is TfrxDMPMemoView then
+ begin
+ Memo.Top := Memo.Top + fr1CharY;
+ Memo.Height := Memo.Height - fr1CharY;
+ end;
+ CutMemo.Frame.Typ := CutMemo.Frame.Typ - [ftBottom];
+ Memo.Frame.Typ := Memo.Frame.Typ - [ftTop];
+ Memo := CutMemo;
+ end;
+
+ Memo.Top := Memo.Top - TopMargin;
+ end;
+ Inc(i);
+ end;
+
+ FRowBands.Add(Band, TopIndex, BottomIndex);
+ end;
+
+begin
+ FRowBands.Clear;
+ LargeBand := TfrxNullBand.Create(nil);
+ Items := RowHeader.AllItems;
+ MaxHeight := 0;
+ HParent := nil;
+
+ { create one large band }
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ Memo := CreateMemo(LargeBand);
+ Memo.AssignAll(Item.Memo);
+ SetupOriginalComponent(Memo, Item.Memo);
+ Memo.Text := Memo.FormatData(Item.Value);
+ Memo.Highlight.Condition := '';
+ with Item.Bounds do
+ Memo.SetBounds(Left, Top, Right, Bottom);
+ CorrectDMPBounds(Memo);
+ Memo.Visible := (Memo.Width <> 0) and (Memo.Height <> 0);
+ DoOnRowHeader(Memo, Item);
+ if Item.Bounds.Top + Item.Bounds.Bottom > MaxHeight then
+ MaxHeight := Item.Bounds.Top + Item.Bounds.Bottom;
+
+ Report.LocalValue := Item.Value;
+ Report.CurObject := Memo.Name;
+ Report.DoBeforePrint(Memo);
+
+ { process memo children if any }
+ for j := 0 to Memo.Objects.Count - 1 do
+ begin
+ c := Memo.Objects[j];
+ Report.CurObject := c.Name;
+ Report.DoBeforePrint(c);
+ end;
+ end;
+
+ Items.Free;
+
+ { cut it to small bands for each page }
+ Items := RowHeader.TerminalItems;
+ AddHeight := ColumnHeaderHeight;
+ CurHeight := Report.Engine.FreeSpace - AddHeight;
+ if (MaxHeight > CurHeight) and KeepTogether then
+ begin
+ Report.Engine.NewPage;
+ AddHeight := ColumnHeaderHeight;
+ CurHeight := Report.Engine.FreeSpace - AddHeight;
+ end;
+
+ TopMargin := 0;
+ BottomMargin := TopMargin + CurHeight;
+ TopIndex := 0;
+ BottomIndex := Items.Count - 1;
+
+ for i := 0 to Items.Count - 1 do
+ begin
+ Item := Items[i];
+ { find right terminal item }
+
+ { keep rows by top parent }
+ if FKeepRowsTogether then
+ begin
+ HParent := Item.Parent;
+ while (HParent.Parent <> nil) do
+ begin
+ if (HParent.Parent.Parent = nil) then
+ Break;
+ HParent := HParent.Parent;
+ end;
+ end;
+
+ if ((HParent <> nil) and (CurHeight > HParent.Bounds.Bottom)
+ and (CurHeight - (HParent.Bounds.Top - TopMargin) < HParent.Bounds.Bottom))
+ or (Item.Bounds.Top + Item.Bounds.Bottom - TopMargin > CurHeight) then
+ begin
+ BottomMargin := Item.Bounds.Top;
+ BottomIndex := i - 1;
+ CreateBand;
+ TopMargin := BottomMargin;
+ if FRepeatHeaders then
+ AddHeight := ColumnHeaderHeight else
+ AddHeight := 0;
+ if (Parent is TfrxDataBand) and (TfrxDataBand(Parent).FHeader is TfrxHeader)
+ and TfrxHeader(TfrxDataBand(Parent).FHeader).ReprintOnNewPage then
+ CurHeight := Report.Engine.PageHeight - Report.Engine.CurY -
+ Report.Engine.FooterHeight - AddHeight
+ else
+ CurHeight := Report.Engine.PageHeight - Report.Engine.HeaderHeight -
+ Report.Engine.FooterHeight - AddHeight;
+ BottomMargin := TopMargin + CurHeight;
+ TopIndex := BottomIndex + 1;
+ BottomIndex := Items.Count - 1;
+ end;
+ end;
+
+ CreateBand;
+
+ LargeBand.Free;
+ Items.Free;
+end;
+
+
+{ TfrxCrossView }
+
+class function TfrxCrossView.GetDescription: String;
+begin
+ Result := frxResources.Get('obCross');
+end;
+
+function TfrxCrossView.IsCrossValid: Boolean;
+begin
+ Result := (FCellLevels > 0) and (FRowLevels >= 0) and (FColumnLevels >= 0);
+end;
+
+procedure TfrxCrossView.SetCellLevels(const Value: Integer);
+var
+ i: Integer;
+begin
+ inherited;
+ FCellFields.Clear;
+ if Value = 1 then
+ FCellFields.Add('Cell')
+ else
+ for i := 0 to Value - 1 do
+ FCellFields.Add('Cell' + IntToStr(i + 1));
+end;
+
+procedure TfrxCrossView.SetColumnLevels(const Value: Integer);
+var
+ i: Integer;
+begin
+ inherited;
+ FColumnFields.Clear;
+ if Value = 1 then
+ FColumnFields.Add('Column')
+ else
+ for i := 0 to Value - 1 do
+ FColumnFields.Add('Column' + IntToStr(i + 1));
+end;
+
+procedure TfrxCrossView.SetRowLevels(const Value: Integer);
+var
+ i: Integer;
+begin
+ inherited;
+ FRowFields.Clear;
+ if Value = 1 then
+ FRowFields.Add('Row')
+ else
+ for i := 0 to Value - 1 do
+ FRowFields.Add('Row' + IntToStr(i + 1));
+end;
+
+
+{ TfrxDBCrossView }
+
+class function TfrxDBCrossView.GetDescription: String;
+begin
+ Result := frxResources.Get('obDBCross');
+end;
+
+function TfrxDBCrossView.IsCrossValid: Boolean;
+begin
+ Result := (DataSet <> nil) and (FCellLevels > 0) and
+ (FRowFields.Count = FRowLevels) and (FColumnFields.Count = FColumnLevels) and
+ (FCellFields.Count = FCellLevels);
+end;
+
+procedure TfrxDBCrossView.FillMatrix;
+var
+ i: Integer;
+ RowValues, ColumnValues, CellValues: array of Variant;
+ sl: TStringList;
+begin
+ SetLength(RowValues, FRowLevels);
+ SetLength(ColumnValues, FColumnLevels);
+ SetLength(CellValues, FCellLevels);
+
+ sl := TStringList.Create;
+ try
+ DataSet.Open;
+ DataSet.GetFieldList(sl);
+ sl.Sorted := True;
+
+ DataSet.First;
+ while not DataSet.Eof do
+ begin
+ if Report.Terminated then Exit;
+ for i := 0 to FRowLevels - 1 do
+ begin
+ if sl.IndexOf(FRowFields[i]) <> -1 then
+ RowValues[i] := DataSet.Value[FRowFields[i]]
+ else
+ RowValues[i] := Report.Calc(FRowFields[i])
+ end;
+ for i := 0 to FColumnLevels - 1 do
+ begin
+ if sl.IndexOf(FColumnFields[i]) <> -1 then
+ ColumnValues[i] := DataSet.Value[FColumnFields[i]]
+ else
+ ColumnValues[i] := Report.Calc(FColumnFields[i])
+ end;
+ for i := 0 to FCellLevels - 1 do
+ begin
+ if sl.IndexOf(FCellFields[i]) <> -1 then
+ CellValues[i] := DataSet.Value[FCellFields[i]]
+ else
+ CellValues[i] := Report.Calc(FCellFields[i])
+ end;
+ AddValue(RowValues, ColumnValues, CellValues);
+ DataSet.Next;
+ end;
+ finally
+ sl.Free;
+ end;
+
+ RowValues := nil;
+ ColumnValues := nil;
+ CellValues := nil;
+end;
+
+{$IFNDEF RAD_ED}
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxCrossObject, TFmxObject);
+ frxObjects.RegisterObject1(TfrxCrossView, nil, '', '', 0, 142, [ctReport, ctDMP]);
+ frxObjects.RegisterObject1(TfrxDBCrossView, nil, '', '', 0, 149, [ctReport, ctDMP]);
+ frxResources.Add('TfrxPrintCellEvent',
+ 'PascalScript=(Memo: TfrxMemoView; RowIndex, ColumnIndex, CellIndex: Integer; RowValues, ColumnValues, Value: Variant);' + #13#10 +
+ 'C++Script=(TfrxMemoView Memo, int RowIndex, int ColumnIndex, int CellIndex, variant RowValues, variant ColumnValues, variant Value)' + #13#10 +
+ 'BasicScript=(Memo, RowIndex, ColumnIndex, CellIndex, RowValues, ColumnValues, Value)' + #13#10 +
+ 'JScript=(Memo, RowIndex, ColumnIndex, CellIndex, RowValues, ColumnValues, Value)');
+ frxResources.Add('TfrxPrintHeaderEvent',
+ 'PascalScript=(Memo: TfrxMemoView; HeaderIndexes, HeaderValues, Value: Variant);' + #13#10 +
+ 'C++Script=(TfrxMemoView Memo, variant HeaderIndexes, variant HeaderValues, variant Value)' + #13#10 +
+ 'BasicScript=(Memo, HeaderIndexes, HeaderValues, Value)' + #13#10 +
+ 'JScript=(Memo, HeaderIndexes, HeaderValues, Value)');
+ frxResources.Add('TfrxCalcWidthEvent',
+ 'PascalScript=(ColumnIndex: Integer; ColumnValues: Variant; var Width: Extended);' + #13#10 +
+ 'C++Script=(int ColumnIndex, variant ColumnValues, float &Width)' + #13#10 +
+ 'BasicScript=(ColumnIndex, ColumnValues, byref Width)' + #13#10 +
+ 'JScript=(ColumnIndex, ColumnValues, &Width)');
+ frxResources.Add('TfrxCalcHeightEvent',
+ 'PascalScript=(RowIndex: Integer; RowValues: Variant; var Height: Extended);' + #13#10 +
+ 'C++Script=(int RowIndex, variant RowValues, float &Height)' + #13#10 +
+ 'BasicScript=(RowIndex, RowValues, byref Height)' + #13#10 +
+ 'JScript=(RowIndex, RowValues, &Height)');
+
+finalization
+ frxObjects.UnRegister(TfrxCrossView);
+ frxObjects.UnRegister(TfrxDBCrossView);
+{$ENDIF}
+
+
+end.
diff --git a/LibD28x64/FMX.frxCrossEditor.fmx b/LibD28x64/FMX.frxCrossEditor.fmx
new file mode 100644
index 0000000..2fb03e9
--- /dev/null
+++ b/LibD28x64/FMX.frxCrossEditor.fmx
@@ -0,0 +1,342 @@
+object frxCrossEditorForm: TfrxCrossEditorForm
+ Left = 0
+ Top = 0
+ BorderIcons = [biSystemMenu, biMinimize]
+ BorderStyle = bsSingle
+ Caption = 'Cross-tab Editor'
+ ClientHeight = 535
+ ClientWidth = 703
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ ActiveControl = OkB
+ StyleLookup = 'backgroundstyle'
+ object DatasetL: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 165.000000000000000000
+ Height = 205.000000000000000000
+ Visible = False
+ TabOrder = 0
+ object DatasetCB: TComboBox
+ Position.Point = '(12,20)'
+ Width = 141.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 0
+ ItemIndex = -1
+ ItemHeight = 16.000000000000000000
+ OnChange = DatasetCBClick
+ end
+ object FieldsLB: TfrxListBox
+ DragMode = dmAutomatic
+ Position.Point = '(12,48)'
+ Width = 141.000000000000000000
+ Height = 145.000000000000000000
+ OnDragOver = LBDragOver
+ OnDragDrop = LBDragDrop
+ OnClick = LBClick
+ TabOrder = 1
+ AutoHide = False
+ DisableMouseWheel = True
+ AllowDrag = True
+ ItemHeight = 16.000000000000000000
+ end
+ end
+ object DimensionsL: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 165.000000000000000000
+ Height = 205.000000000000000000
+ Visible = False
+ TabOrder = 1
+ object RowsL: TLabel
+ Position.Point = '(12,20)'
+ Width = 66.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object ColumnsL: TLabel
+ Position.Point = '(12,48)'
+ Width = 66.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object CellsL: TLabel
+ Position.Point = '(12,76)'
+ Width = 66.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 2
+ end
+ object RowsE: TEdit
+ Position.Point = '(100,16)'
+ Width = 33.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 3
+ KeyboardType = vktDefault
+ OnChange = DimensionsChange
+ Password = False
+ Text = '0'
+ end
+ object ColumnsE: TEdit
+ Tag = 1
+ Position.Point = '(100,44)'
+ Width = 33.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 4
+ KeyboardType = vktDefault
+ OnChange = DimensionsChange
+ Password = False
+ Text = '0'
+ end
+ object CellsE: TEdit
+ Tag = 2
+ Position.Point = '(100,72)'
+ Width = 33.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 5
+ KeyboardType = vktDefault
+ OnChange = DimensionsChange
+ Password = False
+ Text = '1'
+ end
+ end
+ object StructureL: TGroupBox
+ Position.Point = '(176,4)'
+ Width = 521.000000000000000000
+ Height = 205.000000000000000000
+ TabOrder = 2
+ object Shape1: TLine
+ Position.Point = '(12,104)'
+ Width = 497.000000000000000000
+ Height = 1.000000000000000000
+ end
+ object Shape2: TLine
+ Position.Point = '(260,16)'
+ Width = 1.000000000000000000
+ Height = 177.000000000000000000
+ end
+ object SwapB: TSpeedButton
+ Position.Point = '(226,70)'
+ Width = 27.000000000000000000
+ Height = 26.000000000000000000
+ OnClick = SwapBClick
+ Text = '<->'
+ end
+ object ColumnsLB: TfrxListBox
+ DragMode = dmAutomatic
+ Position.Point = '(268,16)'
+ Width = 241.000000000000000000
+ Height = 81.000000000000000000
+ OnDragEnter = RowsLBDragEnter
+ OnDragLeave = RowsLBDragLeave
+ OnDragOver = LBDragOver
+ OnDragDrop = LBDragDrop
+ OnClick = LBClick
+ OnDblClick = LBDblClick
+ OnMouseDown = LBMouseDown
+ TabOrder = 4
+ AutoHide = False
+ MouseTracking = True
+ AllowDrag = True
+ ItemHeight = 16.000000000000000000
+ ShowButtons = False
+ end
+ object CellsLB: TfrxListBox
+ DragMode = dmAutomatic
+ Position.Point = '(268,112)'
+ Width = 241.000000000000000000
+ Height = 81.000000000000000000
+ OnDragEnter = RowsLBDragEnter
+ OnDragLeave = RowsLBDragLeave
+ OnDragOver = LBDragOver
+ OnDragDrop = LBDragDrop
+ OnClick = LBClick
+ OnDblClick = LBDblClick
+ TabOrder = 5
+ AutoHide = False
+ MouseTracking = True
+ AllowDrag = True
+ ItemHeight = 16.000000000000000000
+ ShowButtons = False
+ end
+ object RowsLB: TfrxListBox
+ DragMode = dmAutomatic
+ Position.Point = '(12,112)'
+ Width = 241.000000000000000000
+ Height = 81.000000000000000000
+ OnDragEnter = RowsLBDragEnter
+ OnDragLeave = RowsLBDragLeave
+ OnDragOver = LBDragOver
+ OnDragDrop = LBDragDrop
+ OnClick = LBClick
+ OnDblClick = LBDblClick
+ OnMouseDown = LBMouseDown
+ TabOrder = 3
+ AutoHide = False
+ MouseTracking = True
+ AllowDrag = True
+ ItemHeight = 16.000000000000000000
+ ShowButtons = False
+ end
+ end
+ object OptionsL: TGroupBox
+ Position.Point = '(4,216)'
+ Width = 693.000000000000000000
+ Height = 281.000000000000000000
+ TabOrder = 3
+ object RowHeaderCB: TCheckBox
+ Position.Point = '(440,76)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 0
+ OnChange = CBClick
+ end
+ object ColumnHeaderCB: TCheckBox
+ Position.Point = '(440,56)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 1
+ OnChange = CBClick
+ end
+ object RowTotalCB: TCheckBox
+ Position.Point = '(440,116)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 2
+ OnChange = CBClick
+ end
+ object ColumnTotalCB: TCheckBox
+ Position.Point = '(440,96)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 3
+ OnChange = CBClick
+ end
+ object TitleCB: TCheckBox
+ Position.Point = '(440,16)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 4
+ OnChange = CBClick
+ end
+ object CornerCB: TCheckBox
+ Position.Point = '(440,36)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 5
+ OnChange = CBClick
+ end
+ object AutoSizeCB: TCheckBox
+ Position.Point = '(440,152)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 6
+ OnChange = CBClick
+ end
+ object BorderCB: TCheckBox
+ Position.Point = '(440,172)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 7
+ OnChange = CBClick
+ end
+ object DownAcrossCB: TCheckBox
+ Position.Point = '(440,192)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 8
+ OnChange = CBClick
+ end
+ object PlainCB: TCheckBox
+ Position.Point = '(440,232)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 9
+ OnChange = CBClick
+ end
+ object JoinCB: TCheckBox
+ Position.Point = '(440,252)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 10
+ OnChange = CBClick
+ end
+ object Box: TScrollBox
+ Position.Point = '(12,16)'
+ Width = 413.000000000000000000
+ Height = 253.000000000000000000
+ TabOrder = 11
+ object PaintBox: TPaintBox
+ Position.Point = '(16,24)'
+ Width = 393.000000000000000000
+ Height = 225.000000000000000000
+ OnPaint = PaintBoxPaint
+ end
+ object ToolBar: TToolBar
+ Width = 413.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 1
+ object StyleB: TfrxToolButton
+ Position.Point = '(16,0)'
+ Width = 89.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 0
+ end
+ end
+ end
+ object RepeatCB: TCheckBox
+ Position.Point = '(440,212)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+
+ TabOrder = 12
+ OnChange = CBClick
+ end
+ end
+ object OkB: TButton
+ Position.Point = '(540,504)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 4
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(620,504)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 5
+ ModalResult = 2
+ Cancel = True
+ end
+ object FuncPopup: TPopupMenu
+ end
+ object SortPopup: TPopupMenu
+ end
+ object StylePopup: TPopupMenu
+ object Sep1: TMenuItem
+ Width = 50.000000000000000000
+ Height = 50.000000000000000000
+ TabOrder = 0
+ ShortCut = 0
+ end
+ object SaveStyleMI: TMenuItem
+ Width = 50.000000000000000000
+ Height = 50.000000000000000000
+ OnClick = SaveStyleMIClick
+ TabOrder = 1
+ ShortCut = 0
+ end
+ end
+end
diff --git a/LibD28x64/FMX.frxCrossEditor.pas b/LibD28x64/FMX.frxCrossEditor.pas
new file mode 100644
index 0000000..66d56ec
--- /dev/null
+++ b/LibD28x64/FMX.frxCrossEditor.pas
@@ -0,0 +1,1029 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Cross editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCrossEditor;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, System.UIConsts, System.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.Types, FMX.Objects, FMX.Edit, FMX.ListBox, FMX.Layouts, FMX.Menus, FMX.ExtCtrls,
+ FMX.frxCross, FMX.frxClass, FMX.frxCtrls, FMX.frxCustomEditors, System.Variants,
+ FMX.frxFMX
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+ TfrxCrossEditor = class(TfrxViewEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ end;
+
+{$IFDEF LINUX}
+ TfrxCrossEditorForm = class(TfrxForm)
+{$ELSE}
+ TfrxCrossEditorForm = class(TForm)
+{$ENDIF}
+ FuncPopup: TPopupMenu;
+ SortPopup: TPopupMenu;
+ DatasetL: TGroupBox;
+ DatasetCB: TComboBox;
+ FieldsLB: TfrxListBox;
+ DimensionsL: TGroupBox;
+ RowsL: TLabel;
+ RowsE: TEdit;
+ ColumnsL: TLabel;
+ ColumnsE: TEdit;
+ CellsL: TLabel;
+ CellsE: TEdit;
+ StructureL: TGroupBox;
+ Shape1: TLine;
+ Shape2: TLine;
+ SwapB: TSpeedButton;
+ RowsLB: TfrxListBox;
+ ColumnsLB: TfrxListBox;
+ CellsLB: TfrxListBox;
+ OptionsL: TGroupBox;
+ RowHeaderCB: TCheckBox;
+ ColumnHeaderCB: TCheckBox;
+ RowTotalCB: TCheckBox;
+ ColumnTotalCB: TCheckBox;
+ TitleCB: TCheckBox;
+ CornerCB: TCheckBox;
+ AutoSizeCB: TCheckBox;
+ BorderCB: TCheckBox;
+ DownAcrossCB: TCheckBox;
+ PlainCB: TCheckBox;
+ JoinCB: TCheckBox;
+ Box: TScrollBox;
+ PaintBox: TPaintBox;
+ OkB: TButton;
+ CancelB: TButton;
+ RepeatCB: TCheckBox;
+ StylePopup: TPopupMenu;
+ Sep1: TMenuItem;
+ SaveStyleMI: TMenuItem;
+ ToolBar: TToolBar;
+ StyleB: TfrxToolButton;
+ procedure FormCreate(Sender: TObject);
+ procedure CancelBClick(Sender: TObject);
+ procedure OkBClick(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure DatasetCBClick(Sender: TObject);
+// procedure DatasetCBDrawItem(Control: TWinControl; Index: Integer;
+// ARect: TRect; State: TOwnerDrawState);
+// procedure FieldsLBDrawItem(Control: TWinControl; Index: Integer;
+// ARect: TRect; State: TOwnerDrawState);
+// procedure LBDrawItem(Control: TWinControl; Index: Integer;
+// ARect: TRect; State: TOwnerDrawState);
+// procedure CellsLBDrawItem(Control: TWinControl; Index: Integer;
+// ARect: TRect; State: TOwnerDrawState);
+ procedure LBDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+ procedure LBDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+ procedure LBMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+ procedure LBClick(Sender: TObject);
+ procedure CBClick(Sender: TObject);
+ procedure FuncMIClick(Sender: TObject);
+ procedure SortMIClick(Sender: TObject);
+ procedure SwapBClick(Sender: TObject);
+ procedure DimensionsChange(Sender: TObject);
+ procedure LBDblClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure PaintBoxPaint(Sender: TObject; Canvas: TCanvas);
+ procedure SaveStyleMIClick(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure RowsLBDragEnter(Sender: TObject; const Data: TDragObject;
+ const Point: TPointF);
+ procedure RowsLBDragLeave(Sender: TObject);
+ procedure StyleBClick(Sender: TObject);
+ private
+ FCross: TfrxCustomCrossView;
+ FCurList: TfrxListBox;
+ FSortMenuList: TList;
+ FFuncMenuList: TList;
+ FFuncNames: array[TfrxCrossFunction] of String;
+ FImages: TfrxImageList;
+ FSortNames: array[TfrxCrossSortOrder] of String;
+ FStyleSheet: TfrxStyleSheet;
+ FTempCross: TfrxDBCrossView;
+ FUpdating: Boolean;
+ FItemAdded: Boolean;
+ procedure ReflectChanges(ChangesFrom: TObject; UpdateText: Boolean = True);
+ procedure CreateStyleMenu;
+ procedure StyleClick(Sender: TObject);
+ procedure UpdateCheckBoxes(aListBox: TfrxListBox);
+ procedure LBButtonClick(Sender: TObject; aButton: TObject; aItem: TfrxListBoxItem);
+ procedure LBCheckChange(Sender: TObject);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ property Cross: TfrxCustomCrossView read FCross write FCross;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses
+ FMX.frxDsgnIntf, FMX.frxEditFormat, FMX.frxEditHighlight, FMX.frxEditMemo,
+ FMX.frxEditFrame, FMX.frxDesgnCtrls, FMX.frxRes, FMX.frxUtils, FMX.frxXML;
+
+const
+ CrossStyles =
+'' +
+'' +
+ '' +
+ '' +
+ '' +
+ '' +
+ '' +
+ '' +
+ '' +
+ '' +
+ '' +
+ '' +
+'';
+
+type
+ THackControl = class(TControl);
+ THackListBoxItem = class(TfrxListBoxItem);
+
+
+{ TfrxCrossEditor }
+
+function TfrxCrossEditor.Edit: Boolean;
+begin
+ with TfrxCrossEditorForm.Create(Designer) do
+ begin
+ Cross := TfrxCustomCrossView(Component);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ Free;
+ end;
+end;
+
+function TfrxCrossEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+
+{ TfrxCrossEditorForm }
+
+
+constructor TfrxCrossEditorForm.Create(AOwner: TComponent);
+var
+ TempStream: TStringStream;
+begin
+ inherited;
+ FSortMenuList := TList.Create;
+ FFuncMenuList := TList.Create;
+ FStyleSheet := TfrxStyleSheet.Create;
+ if FileExists(ExtractFilePath(ParamStr(0)) + 'crossstyles.xml') then
+ FStyleSheet.LoadFromFile(ExtractFilePath(ParamStr(0)) + 'crossstyles.xml')
+ else
+ begin
+ TempStream := TStringStream.Create(CrossStyles, TEncoding.UTF8);
+ FStyleSheet.LoadFromStream(TempStream);
+ TempStream.Free;
+ end;
+
+ FImages := TfrxImageList.Create(nil);
+ FTempCross := TfrxDBCrossView.Create(nil);
+ FFuncNames[cfNone] := frxResources.Get('crNone');
+ FFuncNames[cfSum] := frxResources.Get('crSum');
+ FFuncNames[cfMin] := frxResources.Get('crMin');
+ FFuncNames[cfMax] := frxResources.Get('crMax');
+ FFuncNames[cfAvg] := frxResources.Get('crAvg');
+ FFuncNames[cfCount] := frxResources.Get('crCount');
+ FSortNames[soAscending] := frxResources.Get('crAsc');
+ FSortNames[soDescending] := frxResources.Get('crDesc');
+ FSortNames[soNone] := frxResources.Get('crNone');
+ FSortNames[soGrouping] := frxResources.Get('crGroup');
+end;
+
+destructor TfrxCrossEditorForm.Destroy;
+begin
+ FImages.Free;
+ FStyleSheet.Free;
+ FTempCross.Free;
+ FSortMenuList.Free;
+ FFuncMenuList.Free;
+ inherited;
+end;
+
+procedure TfrxCrossEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ if ModalResult = mrCancel then
+ FCross.Assign(FTempCross);
+end;
+
+procedure TfrxCrossEditorForm.FormCreate(Sender: TObject);
+var
+ i: Integer;
+ m: TMenuItem;
+begin
+ CellsLB.ShowCheckboxes := False;
+ CellsLB.ShowButtons := True;
+ RowsLB.ShowCheckboxes := True;
+ RowsLB.ShowButtons := True;
+ ColumnsLB.ShowCheckboxes := True;
+ ColumnsLB.ShowButtons := True;
+
+{$IFDEF DELPHI18}
+ ColumnsLB.DragMode := TDragMode.dmManual;
+ RowsLB.DragMode := TDragMode.dmManual;
+ CellsLB.DragMode := TDragMode.dmManual;
+ FieldsLB.DragMode := TDragMode.dmManual;
+
+ CellsLB.ManualDragAndDrop := True;
+ RowsLB.ManualDragAndDrop := True;
+ ColumnsLB.ManualDragAndDrop := True;
+ FieldsLB.ManualDragAndDrop := True;
+{$ENDIF}
+ // compatibility XE2- XE6
+ for i := 0 to 3 do
+ begin
+ m := TMenuItem.Create(SortPopup);
+ case i of
+ 0: m.Text := frxGet(4328);
+ 1: m.Text := frxGet(4329);
+ 2: m.Text := frxGet(4330);
+ 3: m.Text := frxGet(4331);
+ end;
+ m.OnClick := SortMIClick;
+ m.Tag := i;
+ SortPopup.AddObject(m);
+ FSortMenuList.Add(Pointer(m));
+ end;
+
+ for i := 0 to 5 do
+ begin
+ m := TMenuItem.Create(FuncPopup);
+ case i of
+ 0: m.Text := frxGet(4322);
+ 1: m.Text := frxGet(4323);
+ 2: m.Text := frxGet(4324);
+ 3: m.Text := frxGet(4325);
+ 4: m.Text := frxGet(4326);
+ 5: m.Text := frxGet(4327);
+ end;
+ m.OnClick := FuncMIClick;
+ m.Tag := i;
+ FuncPopup.AddObject(m);
+ FFuncMenuList.Add(Pointer(m));
+ end;
+
+ Caption := frxGet(4300);
+ DatasetL.Text := frxGet(4301);
+ DimensionsL.Text := frxGet(4302);
+ RowsL.Text := frxGet(4303);
+ ColumnsL.Text := frxGet(4304);
+ CellsL.Text := frxGet(4305);
+ StructureL.Text := frxGet(4306);
+ RowHeaderCB.Text := frxGet(4307);
+ ColumnHeaderCB.Text := frxGet(4308);
+ RowTotalCB.Text := frxGet(4309);
+ ColumnTotalCB.Text := frxGet(4310);
+ //SwapB.Hint := frxGet(4311);
+
+
+ TitleCB.Text := frxGet(4314);
+ CornerCB.Text := frxGet(4315);
+ AutoSizeCB.Text := frxGet(4317);
+ BorderCB.Text := frxGet(4318);
+ DownAcrossCB.Text := frxGet(4319);
+ RepeatCB.Text := frxGet(4316);
+ PlainCB.Text := frxGet(4320);
+ JoinCB.Text := frxGet(4321);
+ StyleB.Text := frxGet(4312);
+ StyleB.OnClick := StyleBClick;
+ SaveStyleMI.Text := frxGet(4313);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ FItemAdded := False;
+ CreateStyleMenu;
+
+ CellsLB.CheckBoxText := frxResources.Get('crSubtotal');
+ RowsLB.CheckBoxText := frxResources.Get('crSubtotal');
+ ColumnsLB.CheckBoxText := frxResources.Get('crSubtotal');
+
+ CellsLB.ButtonText := 'Func';
+ CellsLB.OnButtonClick := LBButtonClick;
+ RowsLB.ButtonText := 'A-Z';
+ RowsLB.OnButtonClick := LBButtonClick;
+ RowsLB.OnChangeCheck := LBCheckChange;
+ ColumnsLB.ButtonText := 'A-Z';
+ ColumnsLB.OnButtonClick := LBButtonClick;
+ ColumnsLB.OnChangeCheck := LBCheckChange;
+
+end;
+
+procedure TfrxCrossEditorForm.FormShow(Sender: TObject);
+
+ procedure SelectDataset;
+ begin
+ DatasetCB.ItemIndex := DatasetCB.Items.IndexOfObject(FCross.DataSet);
+ if DatasetCB.ItemIndex = -1 then
+ DatasetCB.ItemIndex := 0;
+ DatasetCBClick(nil);
+ end;
+
+ procedure SelectFields;
+ var
+ i: Integer;
+ Item: TfrxListBoxItem;
+ begin
+ for i := 0 to FCross.RowFields.Count - 1 do
+ begin
+ Item := RowsLB.ListItems[RowsLB.Count - 1] as TfrxListBoxItem;
+ if Item <> nil then
+ begin
+ Item.CheckVisible := True;
+ Item.IsChecked := FCross.RowTotalMemos[THackListBoxItem(Item).Index + 1].Visible;
+ end;
+ RowsLB.Items.Add(FCross.RowFields[i]);
+ end;
+
+ for i := 0 to FCross.ColumnFields.Count - 1 do
+ begin
+ Item := ColumnsLB.ListItems[ColumnsLB.Count - 1] as TfrxListBoxItem;
+ if Item <> nil then
+ begin
+ Item.CheckVisible := True;
+ Item.IsChecked := FCross.ColumnTotalMemos[THackListBoxItem(Item).Index + 1].Visible;
+ end;
+ ColumnsLB.Items.Add(FCross.ColumnFields[i]);
+ end;
+
+ CellsLB.Items := FCross.CellFields;
+ end;
+
+begin
+ FUpdating := True;
+ FTempCross.Assign(FCross);
+ FCross.Report.GetDataSetList(DatasetCB.Items);
+ SelectDataset;
+ SelectFields;
+
+
+
+ if FCross is TfrxCrossView then
+ begin
+
+ SwapB.Visible := False;
+ DimensionsL.Visible := True;
+ RowsE.Text := IntToStr(FCross.RowLevels);
+ ColumnsE.Text := IntToStr(FCross.ColumnLevels);
+ CellsE.Text := IntToStr(FCross.CellLevels);
+ end
+ else
+ DatasetL.Visible := True;
+
+ TitleCB.IsChecked := FCross.ShowTitle;
+ CornerCB.IsChecked := FCross.ShowCorner;
+ ColumnHeaderCB.IsChecked := FCross.ShowColumnHeader;
+ RowHeaderCB.IsChecked := FCross.ShowRowHeader;
+ ColumnTotalCB.IsChecked := FCross.ShowColumnTotal;
+ RowTotalCB.IsChecked := FCross.ShowRowTotal;
+
+ AutoSizeCB.IsChecked := FCross.AutoSize;
+ BorderCB.IsChecked := FCross.Border;
+ DownAcrossCB.IsChecked := FCross.DownThenAcross;
+ RepeatCB.IsChecked := FCross.RepeatHeaders;
+ PlainCB.IsChecked := FCross.PlainCells;
+ JoinCB.IsChecked := FCross.JoinEqualCells;
+
+ StyleB.Visible := not FCross.DotMatrix;
+
+ FUpdating := False;
+end;
+
+
+procedure TfrxCrossEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+procedure TfrxCrossEditorForm.CreateStyleMenu;
+var
+ i: Integer;
+ sl: TStringList;
+ m: TMenuItem;
+ b: TBitmap;
+ Style: TfrxStyles;
+begin
+ sl := TStringList.Create;
+ FStyleSheet.GetList(sl);
+
+ FImages.Clear;
+ b := TBitmap.Create(16, 16);
+
+ //frxResources.MainButtonImages.Draw(b.Canvas, 0, 0, 2);
+ //FImages.Add(b, nil);
+
+ { create thumbnail images for each style }
+ for i := 0 to sl.Count - 1 do
+ begin
+ Style := FStyleSheet[i];
+ with b.Canvas do
+ begin
+ Fill.Color := Style.Find('column').Color;
+ if Fill.Color = claNull then
+ Fill.Color := claWhite;
+ FillRect(RectF(0, 0, 16, 8), 1, 1, AllCorners, 1, TCornerType.ctBevel);
+ Fill.Color := Style.Find('cell').Color;
+ if Fill.Color = claNull then
+ Fill.Color := claWhite;
+ FillRect(RectF(0, 8, 16, 16), 1, 1, AllCorners, 1, TCornerType.ctBevel);
+ Stroke.Color := claSilver;
+ Fill.Kind := TBrushKind.bkNone;
+ DrawRect(RectF(0, 0, 16, 16), 1, 1, AllCorners, 1, TCornerType.ctBevel);
+ end;
+ //FImages.Add(b, nil);
+ end;
+
+ //while StylePopup.Items[0] <> Sep1 do
+ // StylePopup.Items[0].Free;
+
+ for i := sl.Count - 1 downto 0 do
+ begin
+ m := TMenuItem.Create(StylePopup);
+ m.Text := sl[i];
+ //m.ImageIndex := i + 1;
+ m.OnClick := StyleClick;
+ StylePopup.AddObject(m);
+ //StylePopup.Items.Insert(0, m);
+ end;
+
+ b.Free;
+ sl.Free;
+end;
+
+procedure TfrxCrossEditorForm.ReflectChanges(ChangesFrom: TObject; UpdateText: Boolean);
+var
+ i, j: Integer;
+ s: String;
+begin
+ if (DatasetCB.ItemIndex = -1) or (DatasetCB.Items.Count = 0) then
+ FCross.DataSet := nil else
+ FCross.DataSet := TfrxCustomDBDataSet(DatasetCB.Items.Objects[DatasetCB.ItemIndex]);
+ if FCross is TfrxDBCrossView then
+ begin
+ FCross.RowFields := RowsLB.Items;
+ FCross.ColumnFields := ColumnsLB.Items;
+ FCross.CellFields := CellsLB.Items;
+ end;
+ FCross.RowLevels := FCross.RowFields.Count;
+ FCross.ColumnLevels := FCross.ColumnFields.Count;
+ FCross.CellLevels := FCross.CellFields.Count;
+
+ if ChangesFrom = nil then // change all
+ begin
+ if FCross.CellLevels = 1 then
+ if UpdateText then
+ FCross.CornerMemos[0].Text := FCross.CellFields[0]
+ else
+ begin
+ FCross.CornerMemos[0].Text := '';
+ FCross.CornerMemos[2].Text := 'Data';
+ end;
+
+ if UpdateText then
+ for i := 0 to FCross.RowLevels do
+ for j := 0 to FCross.CellLevels - 1 do
+ FCross.CellHeaderMemos[i * FCross.CellLevels + j].Text := FCross.CellFields[j];
+
+ s := '';
+ for i := 0 to FCross.ColumnLevels - 1 do
+ s := s + FCross.ColumnFields[i] + ', ';
+ if s <> '' then
+ SetLength(s, Length(s) - 2);
+ if UpdateText then
+ FCross.CornerMemos[1].Text := s;
+
+ if UpdateText then
+ for i := 0 to FCross.RowLevels - 1 do
+ FCross.CornerMemos[i + 3].Text := FCross.RowFields[i];
+ end
+ else if (ChangesFrom = RowsLB) or (ChangesFrom = RowsE) then
+ begin
+ if UpdateText then
+ for i := 0 to FCross.RowLevels do
+ for j := 0 to FCross.CellLevels - 1 do
+ FCross.CellHeaderMemos[i * FCross.CellLevels + j].Text := FCross.CellFields[j];
+
+ if UpdateText then
+ for i := 0 to FCross.RowLevels - 1 do
+ FCross.CornerMemos[i + 3].Text := FCross.RowFields[i];
+ end
+ else if (ChangesFrom = ColumnsLB) or (ChangesFrom = ColumnsE) then
+ begin
+ s := '';
+ for i := 0 to FCross.ColumnLevels - 1 do
+ s := s + FCross.ColumnFields[i] + ', ';
+ if s <> '' then
+ SetLength(s, Length(s) - 2);
+ if UpdateText then
+ FCross.CornerMemos[1].Text := s;
+ end
+ else if (ChangesFrom = CellsLB) or (ChangesFrom = CellsE) then
+ begin
+ if FCross.CellLevels = 1 then
+ if UpdateText then
+ FCross.CornerMemos[0].Text := FCross.CellFields[0]
+ else
+ begin
+ FCross.CornerMemos[0].Text := '';
+ FCross.CornerMemos[2].Text := 'Data';
+ end;
+
+ if UpdateText then
+ for i := 0 to FCross.RowLevels do
+ for j := 0 to FCross.CellLevels - 1 do
+ FCross.CellHeaderMemos[i * FCross.CellLevels + j].Text := FCross.CellFields[j];
+ end;
+ PaintBox.InvalidateRect(PaintBox.BoundsRect);
+// PaintBoxPaint(nil, PaintBox.Canvas);
+end;
+
+procedure TfrxCrossEditorForm.RowsLBDragEnter(Sender: TObject;
+ const Data: TDragObject; const Point: TPointF);
+begin
+ if (Data.Source is TfrxListBox) and (TfrxListBox(Sender).Count = 0) then
+ begin
+ FItemAdded := True;
+ TfrxListBox(Sender).Items.Add('');// add fake item
+ end;
+ TfrxListBox(Sender).ItemIndex := 0;
+end;
+
+procedure TfrxCrossEditorForm.RowsLBDragLeave(Sender: TObject);
+begin
+ if FItemAdded then
+ begin
+ TfrxListBox(Sender).Items.Delete(0);
+ FItemAdded := False;
+ end;
+end;
+
+procedure TfrxCrossEditorForm.DatasetCBClick(Sender: TObject);
+var
+ ds: TfrxCustomDBDataSet;
+begin
+ if (DatasetCB.ItemIndex = -1) or (DatasetCB.Items.Count = 0) then Exit;
+ ds := TfrxCustomDBDataSet(DatasetCB.Items.Objects[DatasetCB.ItemIndex]);
+ ds.GetFieldList(FieldsLB.Items);
+ RowsLB.Clear;
+ ColumnsLB.Clear;
+ CellsLB.Clear;
+ if (Sender <> nil) and not FUpdating then
+ ReflectChanges(nil);
+end;
+
+procedure TfrxCrossEditorForm.LBDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+{$IFDEF DELPHI20}
+var
+ Accept: Boolean;
+{$ENDIF}
+begin
+ Accept := (Data.Source is TfrxListBox) and (TfrxListBox(Data.Source).Items.Count > 0);
+ if not Accept then
+ Accept := (Data.Source is TListBoxItem);
+{$IFDEF DELPHI20}
+ if Accept then
+ Operation := TDragOperation.Copy;
+{$ENDIF}
+end;
+
+procedure TfrxCrossEditorForm.UpdateCheckBoxes(aListBox: TfrxListBox);
+var
+ i: Integer;
+ item2: TfrxListBoxItem;
+begin
+ FUpdating := True;
+ if aListBox.ShowCheckboxes then
+ for i := 0 to aListBox.Items.Count - 1 do
+ begin
+ item2 := aListBox.ListItems[i] as TfrxListBoxItem;
+ if item2 <> nil then
+ begin
+ item2.CheckVisible := (aListBox.Items.Count - 1 <> i);
+ if item2.CheckVisible then
+ if aListBox = ColumnsLB then
+ item2.IsChecked := FCross.ColumnTotalMemos[i].Visible
+ else if aListBox = RowsLB then
+ item2.IsChecked := FCross.RowTotalMemos[i].Visible;
+ end;
+ end;
+ FUpdating := False;
+end;
+
+procedure TfrxCrossEditorForm.LBDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+var
+ s: String;
+ i: Integer;
+ item: TListBoxItem;
+ SourceLB, SenderLB: TfrxListBox;
+begin
+ SourceLB := nil;
+//there are two ways to drag an item select and drag list box or drag item
+ if Data.Source is TfrxListBoxItem then
+ SourceLB := TfrxListBox(THackListBoxItem(Data.Source).ListBox)
+ else if Data.Source is TfrxListBox then
+ SourceLB := TfrxListBox(Data.Source);
+ if SourceLB = nil then Exit;
+ SenderLB := TfrxListBox(Sender);
+ if FItemAdded then
+ begin
+ TfrxListBox(Sender).Items.Delete(0);
+ FItemAdded := False;
+ end;
+ if (SourceLB.ItemIndex = -1) or (SourceLB.Count = 0) then Exit;
+ if (Data.Source = Sender) and (Data.Source <> FieldsLB) then
+ begin
+ item := SourceLB.ItemByPoint(Point.X, Point.Y);
+ i := -1;
+ if item <> nil then i := item.Index;
+
+ if i = -1 then
+ i := SourceLB.Items.Count - 1;
+ SourceLB.Items.Exchange(SourceLB.ItemIndex, i);
+ end
+ else if SourceLB <> Sender then
+ begin
+ s := SourceLB.Items[SourceLB.ItemIndex];
+ if SourceLB <> FieldsLB then
+ SourceLB.Items.Delete(SourceLB.Items.IndexOf(s));
+ if Sender <> FieldsLB then
+ SenderLB.Items.Add(s);
+ end;
+
+
+ UpdateCheckBoxes(SourceLB);
+ UpdateCheckBoxes(SenderLB);
+ ReflectChanges(Data.Source);
+ ReflectChanges(Sender);
+end;
+
+procedure TfrxCrossEditorForm.LBButtonClick(Sender, aButton: TObject;
+ aItem: TfrxListBoxItem);
+var
+ sort: TfrxCrossSortOrder;
+ f: TfrxCrossFunction;
+ i: Integer;
+ pt: TPointF;
+ m : TMenuItem;
+ //Button: TButton;
+begin
+ FCurList := TfrxListBox(Sender);
+ //Button := aButton as TButton;
+ if (Sender = RowsLB) or (Sender = ColumnsLB) then
+ begin
+ if Sender = RowsLB then
+ sort := FCross.RowSort[THackListBoxItem(aItem).Index] else
+ sort := FCross.ColumnSort[THackListBoxItem(aItem).Index];
+
+ for i := 0 to FSortMenuList.Count - 1 do
+ begin
+ m := TMenuItem(FSortMenuList[i]);
+ if m.Tag = Integer(sort) then
+ m.IsChecked := True
+ else
+ m.IsChecked := False;
+ end;
+ pt := aItem.LocalToAbsolute(PointF(aItem.Position.X + aItem.Width, 0));
+ pt := Self.ClientToScreen(pt);
+ SortPopup.Popup(pt.X, pt.Y);
+ end
+ else if (Sender = CellsLB) then
+ begin
+ if CellsLB.ItemIndex = -1 then Exit;
+ f := FCross.CellFunctions[CellsLB.ItemIndex];
+ for i := 0 to FFuncMenuList.Count - 1 do
+ begin
+ m := TMenuItem(FFuncMenuList[i]);
+ if m.Tag = Integer(f) then
+ m.IsChecked := True
+ else
+ m.IsChecked := False;
+ end;
+ pt := aItem.LocalToAbsolute(PointF(aItem.Position.X + aItem.Width, 0));
+ pt := Self.ClientToScreen(pt);
+ FuncPopup.Popup(pt.X, pt.Y);
+ end;
+end;
+
+procedure TfrxCrossEditorForm.LBCheckChange(Sender: TObject);
+var
+ FCurItem: TfrxListBoxItem;
+ Memo: TfrxCustomMemoView;
+begin
+
+ FCurItem := Sender as TfrxListBoxItem;
+ if (FCurItem = nil) or FUpdating then Exit;
+ FCurList := TfrxListBox(THackListBoxItem(FCurItem).ListBox);
+ if THackListBoxItem(FCurItem).ListBox = RowsLB then
+ Memo := FCross.RowTotalMemos[THackListBoxItem(FCurItem).Index + 1] else
+ Memo := FCross.ColumnTotalMemos[THackListBoxItem(FCurItem).Index + 1];
+ Memo.Visible := FCurItem.IsChecked;
+ PaintBox.InvalidateRect(PaintBox.BoundsRect);
+end;
+
+procedure TfrxCrossEditorForm.LBClick(Sender: TObject);
+begin
+ if Sender <> FieldsLB then
+ FieldsLB.ItemIndex := -1;
+ if Sender <> RowsLB then
+ RowsLB.ItemIndex := -1;
+ if Sender <> ColumnsLB then
+ ColumnsLB.ItemIndex := -1;
+ if Sender <> CellsLB then
+ CellsLB.ItemIndex := -1;
+end;
+
+procedure TfrxCrossEditorForm.LBDblClick(Sender: TObject);
+var
+ lb: TfrxListBox;
+ s: String;
+begin
+ lb := TfrxListBox(Sender);
+ if lb.ItemIndex = -1 then
+ exit;
+ s := Cross.Report.Designer.InsertExpression(lb.Items[lb.ItemIndex]);
+ if s <> '' then
+ begin
+ lb.Items[lb.ItemIndex] := s;
+ ReflectChanges(Sender);
+ end;
+end;
+
+procedure TfrxCrossEditorForm.CancelBClick(Sender: TObject);
+begin
+ ModalResult := mrCancel;
+end;
+
+procedure TfrxCrossEditorForm.OkBClick(Sender: TObject);
+begin
+ ModalResult := mrOk;
+end;
+
+procedure TfrxCrossEditorForm.LBMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+begin
+ FCurList := TfrxListBox(Sender);
+ FCurList.Repaint;
+ ReflectChanges(Sender, False);
+end;
+
+procedure TfrxCrossEditorForm.CBClick(Sender: TObject);
+begin
+ if FUpdating then Exit;
+
+ FCross.ShowTitle := TitleCB.IsChecked;
+ FCross.ShowCorner := CornerCB.IsChecked;
+ FCross.ShowColumnHeader := ColumnHeaderCB.IsChecked;
+ FCross.ShowRowHeader := RowHeaderCB.IsChecked;
+ FCross.ShowColumnTotal := ColumnTotalCB.IsChecked;
+ FCross.ShowRowTotal := RowTotalCB.IsChecked;
+
+ FCross.AutoSize := AutoSizeCB.IsChecked;
+ FCross.Border := BorderCB.IsChecked;
+ FCross.DownThenAcross := DownAcrossCB.IsChecked;
+ FCross.RepeatHeaders := RepeatCB.IsChecked;
+ FCross.PlainCells := PlainCB.IsChecked;
+ FCross.JoinEqualCells := JoinCB.IsChecked;
+ ReflectChanges(Sender, False);
+end;
+
+procedure TfrxCrossEditorForm.DimensionsChange(Sender: TObject);
+begin
+ if FUpdating then Exit;
+
+ case TControl(Sender).Tag of
+ 0: FCross.RowLevels := StrToInt(RowsE.Text);
+ 1: FCross.ColumnLevels := StrToInt(ColumnsE.Text);
+ 2: FCross.CellLevels := StrToInt(CellsE.Text);
+ end;
+
+ RowsLB.Items := FCross.RowFields;
+ ColumnsLB.Items := FCross.ColumnFields;
+ CellsLB.Items := FCross.CellFields;
+
+ ReflectChanges(Sender);
+end;
+
+procedure TfrxCrossEditorForm.FuncMIClick(Sender: TObject);
+begin
+ if CellsLB.ItemIndex = -1 then Exit;
+ FCross.CellFunctions[CellsLB.ItemIndex] := TfrxCrossFunction(TControl(Sender).Tag);
+ CellsLB.Repaint;
+ THackControl(CellsLB).DragEnd;
+end;
+
+
+procedure TfrxCrossEditorForm.SortMIClick(Sender: TObject);
+begin
+ if FCurList.ItemIndex = -1 then Exit;
+ if FCurList = ColumnsLB then
+ FCross.ColumnSort[FCurList.ItemIndex] := TfrxCrossSortOrder(TControl(Sender).Tag) else
+ FCross.RowSort[FCurList.ItemIndex] := TfrxCrossSortOrder(TControl(Sender).Tag);
+ FCurList.Repaint;
+ THackControl(FCurList).DragEnd;
+end;
+
+procedure TfrxCrossEditorForm.SwapBClick(Sender: TObject);
+var
+ sl: TStrings;
+begin
+ sl := TStringList.Create;
+ sl.Assign(RowsLB.Items);
+ FUpdating := True;
+ RowsLB.Items := ColumnsLB.Items;
+ ColumnsLB.Items := sl;
+ sl.Free;
+ FUpdating := False;
+ UpdateCheckBoxes(RowsLB);
+ UpdateCheckBoxes(ColumnsLB);
+ ReflectChanges(nil);
+ RowsLB.Repaint;
+ ColumnsLB.Repaint;
+end;
+
+procedure TfrxCrossEditorForm.StyleBClick(Sender: TObject);
+var
+ pt: TPointF;
+begin
+ pt := PaintBox.LocalToAbsolute(PointF(StyleB.Position.X, StyleB.Position.Y + ToolBar.Height));
+ StylePopup.Popup(Self.Left + pt.X, Self.Top + pt.Y );
+end;
+
+procedure TfrxCrossEditorForm.StyleClick(Sender: TObject);
+var
+ Style: TfrxStyles;
+begin
+ Style := FStyleSheet.Find(TMenuItem(Sender).Text);
+ if Style <> nil then
+ FCross.ApplyStyle(Style);
+ PaintBox.InvalidateRect(PaintBox.BoundsRect);
+end;
+
+procedure TfrxCrossEditorForm.SaveStyleMIClick(Sender: TObject);
+var
+ s: String;
+ Style: TfrxStyles;
+begin
+ s := '';
+ s := InputBox(frxGet(4313), frxResources.Get('crStName'), s);
+ if s <> '' then
+ begin
+ Style := FStyleSheet.Find(s);
+ if Style = nil then
+ Style := FStyleSheet.Add;
+ Style.Name := s;
+ FCross.GetStyle(Style);
+ FStyleSheet.SaveToFile(ExtractFilePath(ParamStr(0)) + 'crossstyles.xml');
+ CreateStyleMenu;
+ end;
+end;
+
+procedure TfrxCrossEditorForm.PaintBoxPaint(Sender: TObject; Canvas: TCanvas);
+begin
+ with Canvas do
+ begin
+ Fill.Color := claWhite;
+ FillRect(RectF(0, 0, PaintBox.Width, PaintBox.Height), 1, 1, AllCorners, 1, TCornerType.ctBevel);
+ end;
+ FCross.DrawCross(PaintBox.Canvas, 1, 1, 0, 0);
+end;
+
+
+initialization
+ frxComponentEditors.Register(TfrxCrossView, TfrxCrossEditor);
+ frxComponentEditors.Register(TfrxDBCrossView, TfrxCrossEditor);
+
+end.
diff --git a/LibD28x64/FMX.frxCrossRTTI.pas b/LibD28x64/FMX.frxCrossRTTI.pas
new file mode 100644
index 0000000..eab9fde
--- /dev/null
+++ b/LibD28x64/FMX.frxCrossRTTI.pas
@@ -0,0 +1,140 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Cross-tab RTTI }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCrossRTTI;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, System.SysUtils, FMX.Forms, FMX.fs_iinterpreter, FMX.frxCross, FMX.frxClassRTTI,
+ System.Variants, System.Types;
+
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddEnum('TfrxCrossFunction', 'cfNone, cfSum, cfMin, cfMax, cfAvg, cfCount');
+ with AddClass(TfrxCustomCrossView, 'TfrxView') do
+ begin
+ AddMethod('procedure AddValue(Rows, Columns, Cells: array)', CallMethod);
+ AddMethod('procedure BeginMatrix', CallMethod);
+ AddMethod('function ColCount: Integer', CallMethod);
+ AddMethod('function RowCount: Integer', CallMethod);
+ AddMethod('function IsGrandTotalColumn(Index: Integer): Boolean', CallMethod);
+ AddMethod('function IsGrandTotalRow(Index: Integer): Boolean', CallMethod);
+ AddMethod('function IsTotalColumn(Index: Integer): Boolean', CallMethod);
+ AddMethod('function IsTotalRow(Index: Integer): Boolean', CallMethod);
+ AddProperty('ClearBeforePrint', 'Boolean', GetProp, SetProp);
+ AddIndexProperty('CellFunctions', 'Integer', 'TfrxCrossFunction', CallMethod);
+ end;
+
+ AddClass(TfrxCrossView, 'TfrxCustomCrossView');
+ AddClass(TfrxDBCrossView, 'TfrxCustomCrossView');
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+var
+ ar: array[0..2] of array of Variant;
+ _TfrxCustomCrossView: TfrxCustomCrossView;
+
+ procedure ConvertVariantToArray(v: Variant; Index: Integer);
+ var
+ i: Integer;
+ begin
+ SetLength(ar[Index], VarArrayHighBound(v, 1) + 1);
+ for i := 0 to VarArrayHighBound(v, 1) do
+ ar[Index][i] := v[i];
+ end;
+
+begin
+ Result := 0;
+ _TfrxCustomCrossView := TfrxCustomCrossView(Instance);
+
+ if MethodName = 'ADDVALUE' then
+ begin
+ ConvertVariantToArray(Caller.Params[0], 0);
+ ConvertVariantToArray(Caller.Params[1], 1);
+ ConvertVariantToArray(Caller.Params[2], 2);
+ _TfrxCustomCrossView.AddValue(ar[0], ar[1], ar[2]);
+ ar[0] := nil;
+ ar[1] := nil;
+ ar[2] := nil;
+ end
+ else if MethodName = 'BEGINMATRIX' then
+ _TfrxCustomCrossView.BeginMatrix
+ else if MethodName = 'COLCOUNT' then
+ Result := _TfrxCustomCrossView.ColCount
+ else if MethodName = 'ROWCOUNT' then
+ Result := _TfrxCustomCrossView.RowCount
+ else if MethodName = 'ISGRANDTOTALCOLUMN' then
+ Result := _TfrxCustomCrossView.IsGrandTotalColumn(Caller.Params[0])
+ else if MethodName = 'ISGRANDTOTALROW' then
+ Result := _TfrxCustomCrossView.IsGrandTotalRow(Caller.Params[0])
+ else if MethodName = 'ISTOTALCOLUMN' then
+ Result := _TfrxCustomCrossView.IsTotalColumn(Caller.Params[0])
+ else if MethodName = 'ISTOTALROW' then
+ Result := _TfrxCustomCrossView.IsTotalRow(Caller.Params[0])
+ else if MethodName = 'CELLFUNCTIONS.GET' then
+ Result := _TfrxCustomCrossView.CellFunctions[Caller.Params[0]]
+ else if MethodName = 'CELLFUNCTIONS.SET' then
+ _TfrxCustomCrossView.CellFunctions[Caller.Params[0]] := TfrxCrossFunction(Caller.Params[1])
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if PropName = 'CLEARBEFOREPRINT' then
+ Result := TfrxCustomCrossView(Instance).ClearBeforePrint
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if PropName = 'CLEARBEFOREPRINT' then
+ TfrxCustomCrossView(Instance).ClearBeforePrint := Value;
+end;
+
+
+initialization
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ if fsRTTIModules <> nil then
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28x64/FMX.frxCrypto.pas b/LibD28x64/FMX.frxCrypto.pas
new file mode 100644
index 0000000..86be489
--- /dev/null
+++ b/LibD28x64/FMX.frxCrypto.pas
@@ -0,0 +1,1456 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v2.0 }
+{ Cryptography }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Anton Khayrudinov }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCrypto;
+
+{ Disable overflow checking.
+ Cryptography operates in finite fields
+ and integer oveflow is meaningless for it. }
+
+{$Q-}
+
+interface
+
+uses
+ System.SysUtils,
+ System.Classes;
+
+type
+
+ { RC4 cipher }
+
+ TCryptoRC4 = class
+ private
+ FS: array[0..255] of Byte;
+ FI, FJ: Byte;
+ public
+
+ { Initializes the RC4 cipher with a specified key }
+
+ procedure Init(const Key; Len: LongInt);
+
+ { Encrypts a data block "in place".
+ The RC4 cipher generates a crypto stream (based on the password),
+ that is combined with the original data with XOR operation.
+ If Data is nil, the crypto stream is generated but is written
+ nowhere. }
+
+ procedure Encrypt(Data: Pointer; Size: LongInt);
+ end;
+
+ { AES cipher. FIPS 197. }
+
+ TCryptoAESMatrix = array[0..15] of Byte; // matrix 4x4
+ TCryptoAESSBox = array[0..255] of Byte;
+ TCryptoAESDiffuseRow = array[0..3] of Byte;
+
+ TCryptoAES = class
+ private
+ FNr: Integer;
+ FW: array of TCryptoAESMatrix;
+
+ class procedure InitSBox;
+ class function Mul8(a, b: Integer): Integer;
+ protected
+ class procedure MatrixToData(out Data; const a: TCryptoAESMatrix);
+ class procedure DataToMatrix(out a: TCryptoAESMatrix; const Data);
+
+ procedure Sum(var a: TCryptoAESMatrix; const b, c: TCryptoAESMatrix);
+ procedure Mov(var a: TCryptoAESMatrix; const b: TCryptoAESMatrix);
+ procedure Zero(var a: TCryptoAESMatrix);
+
+ procedure Apply(var a: TCryptoAESMatrix; const Box: TCryptoAESSBox);
+ procedure Rotate(var a: TCryptoAESMatrix; Dir: Integer);
+ procedure Diffuse(var a: TCryptoAESMatrix; const DiffuseRow: TCryptoAESDiffuseRow);
+ procedure ExpandKey(const Key: array of Byte);
+
+ procedure Encrypt(var a: TCryptoAESMatrix); overload; virtual;
+ procedure Decrypt(var a: TCryptoAESMatrix); overload; virtual;
+ public
+
+ { Key length can be 16, 24 or 32 bytes }
+
+ constructor Create(const Key: array of Byte);
+
+ { Encrypts/decrypts a 16-byte block }
+
+ procedure Encrypt(var Output; const Input); overload; virtual;
+ procedure Decrypt(var Output; const Input); overload; virtual;
+ end;
+
+ ECryptoAESException = class(Exception);
+ ECryptoAESInvalidKeyLength = class(ECryptoAESException);
+ ECryptoAESInvalidBlockSize = class(ECryptoAESException);
+
+ { AES CBC mode }
+
+ TCryptoAES_CBC = class(TCryptoAES)
+ private
+ FC: TCryptoAESMatrix;
+ protected
+ procedure Encrypt(var a: TCryptoAESMatrix); override;
+ procedure Decrypt(var a: TCryptoAESMatrix); override;
+ public
+
+ { IV has 16 bytes }
+
+ constructor Create(const Key: array of Byte; const IV);
+ end;
+
+ { lag-r CMWC random number generator with base 2**32 }
+
+ TCryptoCMWC = class
+ private
+ FMultiplier: LongWord;
+ FSeed: array of LongWord;
+ FCarry: LongWord;
+ FNext: LongInt;
+ public
+ constructor Create(a: Cardinal = 3636507990; r: Cardinal = 1359);
+ function Next: LongWord;
+ end;
+
+ { Hash-function interface.
+ Typical use of a hash function is following:
+
+ h := TCryptoHash.Create('SHA1');
+ h.Push(@Message, Length(Message));
+ h.GetDigest(@Digest);
+ h.Free;
+
+ If several digests are computed with one TCryptoHash
+ instance (in order to save resources), then the following
+ way can be used:
+
+ h := TCryptoHash.Create('SHA1');
+
+ h.Reset; // optional
+ h.Push(@Message1, Length(Message1));
+ h.GetDigest(@Digest1);
+
+ h.Reset; // mandatory
+ h.Push(@Message2, Length(Message2));
+ h.GetDigest(@Digest2);
+
+ h.Reset; // mandatory
+ h.Push(@Message2, Length(Message2));
+ h.GetDigest(@Digest2);
+
+ h.Free;
+
+ Message can be sent by parts:
+
+ h := TCryptoHash.Create('SHA1');
+ h.Push(@MessagePart1, Length(MessagePart1));
+ h.Push(@MessagePart2, Length(MessagePart2));
+ h.Push(@MessagePart3, Length(MessagePart3));
+ h.GetDigest(@Digest);
+ h.Free; }
+
+ TCryptoHash = class
+ private
+ FChunk: array of Byte;
+ FLength: Integer;
+ protected
+ constructor Create(ChunkSize: Integer); overload;
+
+ procedure Process(const Chunk: array of Byte); virtual; abstract;
+ procedure Finish(LengthSize: Integer; Straight: Boolean); virtual;
+ public
+
+ { Creates an instance of a hash function.
+ Acceptable names are:
+
+ MD5
+ SHA1
+ Whirlpool
+ Jenkins
+
+ If the name is not recognised, nil is returned. }
+
+ class function Create(const Name: string): TCryptoHash; overload;
+
+ { Calculates a hash of a text. Note that different hash functions
+ produce digests of different lengths. }
+
+ class procedure Hash(const Name: string; var Digest; DigestSize: Integer;
+ const Data; Size: Integer); overload;
+ class procedure Hash(const Name: string; var Digest; DigestSize: Integer;
+ const s: AnsiString); overload;
+
+ { Resets the state of the hash function.
+ This method must be called if more than one digest
+ is computed with one TCryptoHash instance. }
+
+ procedure Reset; virtual;
+
+ { Sends a piece of message to the hash function }
+
+ procedure Push(b: Byte); overload;
+ procedure Push(const Data; Size: Integer); overload;
+ procedure Push(Stream: TStream); overload;
+
+ { Returns message digest. This function should not be called several times in a row. }
+
+ procedure GetDigest(out Digest; Size: Integer); virtual; abstract;
+
+ { Returns size of the digest in bytes }
+
+ function DigestSize: Integer; virtual; abstract;
+
+ { Block hashes compute read a message by chunks of fixed size.
+ It's most efficient to send a message to a hash function by chunks
+ of this size. }
+
+ function ChunkSize: Integer;
+ end;
+
+ ECryptoHash = class(Exception);
+
+ ECryptoHashUnknown = class(ECryptoHash)
+ public
+ constructor Create(Name: string);
+ end;
+
+ { MD5 hash. RFC 1321. Digest length: 16 bytes. }
+
+ TCryptoMD5 = class(TCryptoHash)
+ private
+ FState: array[0..3] of Integer;
+
+ class procedure InitSinTable;
+ procedure InitState;
+ protected
+ procedure Process(const Chunk: array of Byte); override;
+ public
+ constructor Create;
+
+ procedure GetDigest(out Digest; Size: Integer); override;
+ procedure Reset; override;
+ function DigestSize: Integer; override;
+ end;
+
+ { SHA1 hash. RFC 3174. Digest length: 20 bytes. }
+
+ TCryptoSHA1 = class(TCryptoHash)
+ private
+ FState: array[0..4] of Integer;
+
+ procedure InitState;
+ protected
+ procedure Process(const Chunk: array of Byte); override;
+ public
+ constructor Create;
+
+ procedure GetDigest(out Digest; Size: Integer); override;
+ procedure Reset; override;
+ function DigestSize: Integer; override;
+ end;
+
+ { Whirlpool hash. ISO/IEC 10118-3. Digest length: 64 bytes. }
+
+ TCryptoWhirlpoolMatrix = array[0..7, 0..7] of Byte;
+
+ TCryptoWhirlpool = class(TCryptoHash)
+ private
+ FState: TCryptoWhirlpoolMatrix;
+
+ procedure ApplySBox(var a: TCryptoWhirlpoolMatrix);
+ procedure Rotate(var a: TCryptoWhirlpoolMatrix);
+ procedure Diffuse(var a: TCryptoWhirlpoolMatrix);
+ procedure Transform(var a: TCryptoWhirlpoolMatrix; const b: TCryptoWhirlpoolMatrix);
+
+ procedure InitState;
+
+ procedure Sum(var a: TCryptoWhirlpoolMatrix; const b, c: TCryptoWhirlpoolMatrix);
+ procedure Encrypt(var w: TCryptoWhirlpoolMatrix; const a, b: TCryptoWhirlpoolMatrix);
+ protected
+ procedure Process(const Chunk: array of Byte); override;
+ private
+ class procedure InitSBox;
+ class procedure InitMul8;
+
+ class function Mul4(a, b: Integer): Integer;
+ class function Mul8(a, b: Integer): Integer;
+ class function Mul8NoCache(a, b: Integer): Integer;
+ public
+ constructor Create;
+
+ procedure GetDigest(out Digest; Size: Integer); override;
+ procedure Reset; override;
+ function DigestSize: Integer; override;
+ end;
+
+ { This is a modification of the Jenkins hash.
+ It's noncryptographic, but fast. }
+
+ TCryptoJenkins = class(TCryptoHash)
+ private
+ FState: Cardinal;
+ protected
+ procedure Finish(LengthSize: Integer; Straight: Boolean); override;
+ procedure Process(const Chunk: array of Byte); override;
+ public
+ constructor Create;
+
+ procedure GetDigest(out Digest; Size: Integer); override;
+ procedure Reset; override;
+ function DigestSize: Integer; override;
+ end;
+
+implementation
+
+uses
+ System.Math;
+
+{ Delphi4 doesn't allow to put these variables as
+ static class fields of corresponding classes. }
+
+var
+ AESSBox, AESIBox: TCryptoAESSBox;
+ MD5SinTable: array[1..64] of Integer;
+ WhirlpoolSBox: array[0..255] of Byte;
+ WhirlpoolMul8: array[1..9, 0..255] of Byte;
+
+{ Returns N bytes from Base + Offset }
+
+function GetNBytesAt(const Base; Offset, N: Integer): Integer;
+begin
+ Assert(SizeOf(Result) >= N);
+ Result := 0;
+ Move(Pointer(NativeInt(@Base) + Offset)^, Result, N);
+end;
+
+procedure SetNBytesAt(var Base; Offset, N, Value: Integer);
+begin
+ Assert(SizeOf(Value) >= N);
+ Move(Value, Pointer(NativeInt(@Base) + Offset)^, N);
+end;
+
+function Min(a, b: Integer): Integer;
+begin
+ if a < b then
+ Result := a
+ else
+ Result := b
+end;
+
+{ Rotates a 32-bit integer by n bits left }
+
+function RotLeft(a, n: Integer): Integer;
+var
+ p, q: Integer;
+begin
+ p := Integer(Cardinal(a) shr (32 - n));
+ q := a and ((Cardinal(1) shl (32 - n)) - 1);
+
+ Result := (q shl n) xor p;
+end;
+
+{ Swap bytes of a 32-bit integer }
+
+function ByteSwap(x: Integer): Integer;
+var
+ b: array[0..3] of Byte;
+ i: Integer;
+begin
+ for i := 0 to 3 do
+ begin
+ b[i] := x and $ff;
+ x := x shr 8;
+ end;
+
+ Result := 0;
+
+ for i := 0 to 3 do
+ Result := (Result shl 8) xor b[i];
+end;
+
+{ TCryptoCMWC }
+
+constructor TCryptoCMWC.Create(a, r: Cardinal);
+var
+ t: Extended;
+ i: LongInt;
+ h: array[0..15] of Byte;
+begin
+ FMultiplier := a;
+ SetLength(FSeed, r);
+
+ { Initialise the first r seed values with some data }
+
+ t := Time;
+ TCryptoHash.Hash('MD5', h, Length(h), t, SizeOf(t));
+
+ for i := 0 to Length(FSeed) - 1 do
+ begin
+ FSeed[i] := 0;
+ Move(h[(i mod 4)*4], FSeed[i], 4);
+ end;
+end;
+
+function TCryptoCMWC.Next: LongWord;
+const
+ Mask: Cardinal = $ffffffff;
+var
+ q: UInt64;
+begin
+ q := UInt64(FMultiplier)*FSeed[FNext] + FCarry;
+
+ FSeed[FNext] := q and Mask;
+ FCarry := (q shr 32) and Mask;
+ Result := FSeed[FNext];
+
+ Inc(FNext);
+
+ if FNext = Length(FSeed) then
+ FNext := 0;
+end;
+
+{ TCryptoRC4 }
+
+procedure TCryptoRC4.Init(const Key; Len: LongInt);
+var
+ i, j, k: Byte;
+ b: Byte;
+begin
+ for i := 0 to 255 do
+ FS[i] := i;
+
+ j := 0;
+ k := 0;
+
+ for i := 0 to 255 do
+ begin
+ j := (Integer(j) + GetNBytesAt(Key, k, 1) + FS[i]) and $ff;
+ k := k + 1;
+
+ if k = len then
+ k := 0;
+
+ b := FS[i];
+ FS[i] := FS[j];
+ FS[j] := b;
+ end;
+
+ FI := 0;
+ FJ := 0;
+end;
+
+procedure TCryptoRC4.Encrypt(Data: Pointer; Size: LongInt);
+var
+ i: Integer;
+ s, h: Byte;
+begin
+ for i := 0 to Size - 1 do
+ begin
+ Inc(FI);
+ Inc(FJ, FS[FI]);
+
+ s := FS[FJ];
+ FS[FJ] := FS[FI];
+ FS[FI] := s;
+
+ if Data <> nil then
+ begin
+ h := FS[(FS[FI] + FS[FJ]) and $ff];
+ SetNBytesAt(Data^, i, 1, GetNBytesAt(Data^, i, 1) xor h);
+ end;
+ end;
+end;
+
+{ TCryptoHash }
+
+function TCryptoHash.ChunkSize: Integer;
+begin
+ Result := Length(FChunk);
+end;
+
+class function TCryptoHash.Create(const Name: string): TCryptoHash;
+begin
+ if Name = 'MD5' then
+ Result := TCryptoMD5.Create
+
+ else if Name = 'SHA1' then
+ Result := TCryptoSHA1.Create
+
+ else if Name = 'Whirlpool' then
+ Result := TCryptoWhirlpool.Create
+
+ else if Name = 'Jenkins' then
+ Result := TCryptoJenkins.Create
+
+ else
+ Result := nil
+end;
+
+class procedure TCryptoHash.Hash(const Name: string; var Digest; DigestSize: Integer;
+ const Data; Size: Integer);
+var
+ h: TCryptoHash;
+begin
+ h := Create(Name);
+
+ if h = nil then
+ raise ECryptoHashUnknown.Create(Name);
+
+ try
+ h.Push(Data, Size);
+ h.GetDigest(Digest, DigestSize);
+ finally
+ h.Free;
+ end;
+end;
+
+constructor TCryptoHash.Create(ChunkSize: Integer);
+begin
+ SetLength(FChunk, ChunkSize);
+end;
+
+class procedure TCryptoHash.Hash(const Name: string; var Digest; DigestSize: Integer;
+ const s: AnsiString);
+begin
+ if s = '' then
+ Hash(Name, Digest, DigestSize, nil^, 0)
+ else
+ Hash(Name, Digest, DigestSize, s[1], Length(s))
+end;
+
+procedure TCryptoHash.Push(b: Byte);
+begin
+ FChunk[FLength mod Length(FChunk)] := b;
+ Inc(FLength);
+
+ if FLength mod Length(FChunk) = 0 then
+ Process(FChunk);
+end;
+
+procedure TCryptoHash.Push(const Data; Size: Integer);
+var
+ Used, n: Integer;
+ Offset: Integer;
+begin
+ { The following code is equal to:
+
+ for n := 0 to Size - 1 do
+ Push(PByte(Integer(Data) + n)^) }
+
+ Used := FLength mod ChunkSize;
+ Inc(FLength, Size);
+ Offset := 0;
+
+ while Size > 0 do
+ begin
+ n := Min(Size, ChunkSize - Used);
+ Move(Pointer(NativeInt(@Data) + Offset)^, FChunk[Used], n);
+
+ Inc(Offset, n);
+ Inc(Used, n);
+ Dec(Size, n);
+
+ if Used = ChunkSize then
+ begin
+ Process(FChunk);
+ Used := 0;
+ end;
+ end;
+end;
+
+procedure TCryptoHash.Reset;
+begin
+ FLength := 0;
+end;
+
+procedure TCryptoHash.Finish(LengthSize: Integer; Straight: Boolean);
+var
+ i, n, cn: Integer;
+begin
+ cn := Length(FChunk);
+ n := FLength*8;
+ Push($80);
+
+ while FLength mod cn <> cn - LengthSize do
+ Push(0);
+
+ if Straight then
+ for i := cn - LengthSize to cn - 1 do
+ begin
+ FChunk[i] := n and $ff;
+ n := n shr 8;
+ end
+ else
+ for i := cn - 1 downto cn - LengthSize do
+ begin
+ FChunk[i] := n and $ff;
+ n := n shr 8;
+ end;
+
+ Process(FChunk);
+end;
+
+procedure TCryptoHash.Push(Stream: TStream);
+var
+ Buffer: array of Byte;
+ n: Integer;
+begin
+ Stream.Position := 0;
+ SetLength(Buffer, ChunkSize);
+
+ n := Stream.Read(Buffer[0], Length(Buffer));
+
+ while n > 0 do
+ begin
+ Push(Buffer[0], n);
+ n := Stream.Read(Buffer[0], Length(Buffer));
+ end;
+end;
+
+{ TCryptoMD5 }
+
+constructor TCryptoMD5.Create;
+begin
+ inherited Create(64);
+ InitState;
+end;
+
+procedure TCryptoMD5.InitState;
+begin
+ FState[0] := ByteSwap(Integer($01234567));
+ FState[1] := ByteSwap(Integer($89abcdef));
+ FState[2] := ByteSwap(Integer($fedcba98));
+ FState[3] := ByteSwap(Integer($76543210));
+end;
+
+class procedure TCryptoMD5.InitSinTable;
+
+ function AbsSin(x: Extended): Extended;
+ begin
+ Result := Sin(x);
+
+ if Result < 0 then
+ Result := -Result;
+ end;
+
+var
+ i: Integer;
+begin
+ for i := 1 to 64 do
+ MD5SinTable[i] := Floor($100000000*AbsSin(i))
+end;
+
+procedure TCryptoMD5.Process(const Chunk: array of Byte);
+
+ function X(i: Integer): Integer;
+ begin
+ Result := GetNBytesAt(Chunk[4*i], 0, 4)
+ end;
+
+ function F(i, x, y, z: Integer): Integer;
+ begin
+ case i of
+ 00..15: Result := x and y or not x and z;
+ 16..31: Result := x and z or y and not z;
+ 32..47: Result := x xor y xor z;
+ 48..63: Result := y xor (x or not z);
+
+ else Result := 0;
+ end;
+ end;
+
+const
+ G: array[0..63, 0..1] of Integer =
+ (
+ { Round 1 }
+
+ ( 0, 7),
+ ( 1, 12),
+ ( 2, 17),
+ ( 3, 22),
+ ( 4, 7),
+ ( 5, 12),
+ ( 6, 17),
+ ( 7, 22),
+ ( 8, 7),
+ ( 9, 12),
+ (10, 17),
+ (11, 22),
+ (12, 7),
+ (13, 12),
+ (14, 17),
+ (15, 22),
+
+ { Round 2 }
+
+
+ ( 1, 5),
+ ( 6, 9),
+ (11, 14),
+ ( 0, 20),
+ ( 5, 5),
+ (10, 9),
+ (15, 14),
+ ( 4, 20),
+ ( 9, 5),
+ (14, 9),
+ ( 3, 14),
+ ( 8, 20),
+ (13, 5),
+ ( 2, 9),
+ ( 7, 14),
+ (12, 20),
+
+ { Round 3 }
+
+ ( 5, 4),
+ ( 8, 11),
+ (11, 16),
+ (14, 23),
+ ( 1, 4),
+ ( 4, 11),
+ ( 7, 16),
+ (10, 23),
+ (13, 4),
+ ( 0, 11),
+ ( 3, 16),
+ ( 6, 23),
+ ( 9, 4),
+ (12, 11),
+ (15, 16),
+ ( 2, 23),
+
+ { Round 4 }
+
+ ( 0, 6),
+ ( 7, 10),
+ (14, 15),
+ ( 5, 21),
+ (12, 6),
+ ( 3, 10),
+ (10, 15),
+ ( 1, 21),
+ ( 8, 6),
+ (15, 10),
+ ( 6, 15),
+ (13, 21),
+ ( 4, 6),
+ (11, 10),
+ ( 2, 15),
+ ( 9, 21)
+ );
+var
+ i, j, k: Integer;
+ W, R: array[0..3] of Integer;
+begin
+ for j := 0 to 3 do
+ W[j] := FState[j];
+
+ for i := 0 to 63 do
+ begin
+ for j := 0 to 3 do
+ R[j] := W[(j - i mod 16) and 3];
+
+ k := R[0] + X(G[i, 0]) + MD5SinTable[i + 1] + F(i, R[1], R[2], R[3]);
+ W[(0 - i mod 16) and 3] := R[1] + RotLeft(k, G[i, 1]);
+ end;
+
+ for j := 0 to 3 do
+ Inc(FState[j], W[j]);
+end;
+
+procedure TCryptoMD5.Reset;
+begin
+ inherited;
+ InitState;
+end;
+
+function TCryptoMD5.DigestSize: Integer;
+begin
+ Result := 16;
+end;
+
+procedure TCryptoMD5.GetDigest(out Digest; Size: Integer);
+begin
+ Assert(Size = DigestSize);
+ Finish(8, True);
+ Move(FState, Digest, Size);
+end;
+
+{ TCryptoSHA1 }
+
+constructor TCryptoSHA1.Create;
+begin
+ inherited Create(64);
+ InitState;
+end;
+
+function TCryptoSHA1.DigestSize: Integer;
+begin
+ Result := 20;
+end;
+
+procedure TCryptoSHA1.GetDigest(out Digest; Size: Integer);
+var
+ i: Integer;
+begin
+ Assert(Size = DigestSize);
+ Finish(8, False);
+
+ for i := 0 to 4 do
+ SetNBytesAt(Digest, i*4, 4, ByteSwap(FState[i]));
+end;
+
+procedure TCryptoSHA1.InitState;
+begin
+ FState[0] := ByteSwap(Integer($01234567));
+ FState[1] := ByteSwap(Integer($89abcdef));
+ FState[2] := ByteSwap(Integer($fedcba98));
+ FState[3] := ByteSwap(Integer($76543210));
+ FState[4] := ByteSwap(Integer($f0e1d2c3));
+end;
+
+procedure TCryptoSHA1.Process(const Chunk: array of Byte);
+
+ function K(i: Integer): Integer;
+ begin
+ case i of
+ 00..19: Result := Integer($5a827999);
+ 20..39: Result := Integer($6ed9eba1);
+ 40..59: Result := Integer($8f1bbcdc);
+ 60..79: Result := Integer($ca62c1d6);
+
+ else Result := 0
+ end
+ end;
+
+ function F(t, b, c, d: Integer): Integer;
+ begin
+ case t of
+ 00..19: Result := b and c or not b and d;
+ 20..39: Result := b xor c xor d;
+ 40..59: Result := b and c or b and d or c and d;
+ 60..79: Result := b xor c xor d;
+
+ else Result := 0
+ end
+ end;
+
+var
+ H: array[0..4] of Integer;
+
+ procedure Shuffle(t: Integer);
+ begin
+ H[4] := H[3];
+ H[3] := H[2];
+ H[2] := H[1];
+ H[1] := H[0];
+ H[0] := t;
+
+ H[2] := RotLeft(H[2], 30);
+ end;
+
+var
+ i, j: Integer;
+ W: array[0..79] of Integer;
+begin
+ for i := 0 to 15 do
+ W[i] := ByteSwap(GetNBytesAt(Chunk[i*4], 0, 4));
+
+ for i := 16 to 79 do
+ W[i] := RotLeft(W[i - 3] xor W[i - 8] xor W[i - 14] xor W[i - 16], 1);
+
+ for j := 0 to 4 do
+ H[j] := FState[j];
+
+ for i := 0 to 79 do
+ Shuffle(RotLeft(H[0], 5) + F(i, H[1], H[2], H[3]) + H[4] + W[i] + K(i));
+
+ for j := 0 to 4 do
+ Inc(FState[j], H[j]);
+end;
+
+procedure TCryptoSHA1.Reset;
+begin
+ inherited;
+ InitState;
+end;
+
+{ TCryptoWhirlpool }
+
+class procedure TCryptoWhirlpool.InitSBox;
+const
+ R: array[0..15] of Byte = (7, 12, 11, 13, 14, 4, 9, 15, 6, 3, 8, 10, 2, 5, 1, 0);
+var
+ s, u, v, a: Integer;
+ E, I: array[0..15] of Byte;
+begin
+ E[0] := 1;
+ E[15] := 0;
+
+ for s := 1 to 14 do
+ E[s] := Mul4($b, E[s - 1]);
+
+ for s := 0 to 15 do
+ I[E[s]] := s;
+
+ for s := 0 to 255 do
+ begin
+ u := s shr 4;
+ v := s and $f;
+
+ a := R[E[u] xor I[v]];
+ u := E[E[u] xor a];
+ v := I[I[v] xor a];
+
+ WhirlpoolSBox[s] := (u shl 4) xor v;
+ end;
+end;
+
+class function TCryptoWhirlpool.Mul4(a, b: Integer): Integer;
+begin
+ Result := 0;
+
+ while b <> 0 do
+ begin
+ if b and 1 = 1 then
+ Result := Result xor a;
+
+ b := b shr 1;
+ a := a shl 1;
+
+ if a and $10 <> 0 then
+ a := a xor $13;
+ end;
+end;
+
+class function TCryptoWhirlpool.Mul8(a, b: Integer): Integer;
+begin
+ { If an exception happens here, then Whirlpool is incorrectly initialised.
+ Before using Whirlpool, its Mul8 cache must be filled in for all values
+ in the diffuse row. }
+
+ Result := WhirlpoolMul8[a, b]
+end;
+
+class procedure TCryptoWhirlpool.InitMul8;
+var
+ a, b: Integer;
+begin
+ for a := 1 to 9 do
+ for b := 0 to 255 do
+ WhirlpoolMul8[a, b] := Mul8NoCache(a, b);
+end;
+
+class function TCryptoWhirlpool.Mul8NoCache(a, b: Integer): Integer;
+begin
+ Result := 0;
+
+ while b <> 0 do
+ begin
+ if b and 1 = 1 then
+ Result := Result xor a;
+
+ b := b shr 1;
+ a := a shl 1;
+
+ if a and $100 <> 0 then
+ a := a xor $11d;
+ end;
+end;
+
+procedure TCryptoWhirlpool.ApplySBox(var a: TCryptoWhirlpoolMatrix);
+var
+ i, j: Integer;
+begin
+ for i := 0 to 7 do
+ for j := 0 to 7 do
+ a[i, j] := WhirlpoolSBox[a[i, j]]
+end;
+
+procedure TCryptoWhirlpool.Rotate(var a: TCryptoWhirlpoolMatrix);
+var
+ i, j: Integer;
+ Col: array[0..7] of Byte;
+begin
+ for j := 0 to 7 do
+ begin
+ for i := 0 to 7 do
+ Col[i] := a[(i - j) and 7, j];
+
+ for i := 0 to 7 do
+ a[i, j] := Col[i];
+ end;
+end;
+
+procedure TCryptoWhirlpool.Sum(var a: TCryptoWhirlpoolMatrix; const b, c: TCryptoWhirlpoolMatrix);
+var
+ i, j: Integer;
+begin
+ for i := 0 to 7 do
+ for j := 0 to 7 do
+ a[i, j] := b[i, j] xor c[i, j];
+end;
+
+procedure TCryptoWhirlpool.Diffuse(var a: TCryptoWhirlpoolMatrix);
+const
+ DiffuseRow: array[0..7] of Byte = (1, 1, 4, 1, 8, 5, 2, 9);
+var
+ i, j, k: Integer;
+ Row: array[0..7] of Byte;
+begin
+ for i := 0 to 7 do
+ begin
+ for j := 0 to 7 do
+ Row[j] := 0;
+
+ for j := 0 to 7 do
+ for k := 0 to 7 do
+ Row[j] := Row[j] xor Mul8(DiffuseRow[(j - k) and 7], a[i, k]);
+
+ for j := 0 to 7 do
+ a[i, j] := Row[j];
+ end;
+end;
+
+function TCryptoWhirlpool.DigestSize: Integer;
+begin
+ Result := 64;
+end;
+
+procedure TCryptoWhirlpool.Encrypt(var w: TCryptoWhirlpoolMatrix; const a, b: TCryptoWhirlpoolMatrix);
+var
+ c, k: TCryptoWhirlpoolMatrix;
+ i, r: Integer;
+begin
+ Sum(w, a, b);
+ Sum(c, c, c);
+ Sum(k, a, c);
+
+ for r := 1 to 10 do
+ begin
+ for i := 0 to 7 do
+ c[0, i] := WhirlpoolSBox[8*(r - 1) + i];
+
+ Transform(k, c);
+ Transform(w, k);
+ end;
+end;
+
+procedure TCryptoWhirlpool.Transform(var a: TCryptoWhirlpoolMatrix; const b: TCryptoWhirlpoolMatrix);
+begin
+ ApplySBox(a);
+ Rotate(a);
+ Diffuse(a);
+ Sum(a, a, b);
+end;
+
+procedure TCryptoWhirlpool.InitState;
+begin
+ Sum(FState, FState, FState);
+end;
+
+procedure TCryptoWhirlpool.GetDigest(out Digest; Size: Integer);
+var
+ i: Integer;
+begin
+ Assert(Size = DigestSize);
+ Finish(32, False);
+
+ for i := 0 to 7 do
+ Move(FState[i, 0], Pointer(NativeInt(@Digest) + i*8)^, 8);
+end;
+
+procedure TCryptoWhirlpool.Reset;
+begin
+ inherited;
+ InitState;
+end;
+
+procedure TCryptoWhirlpool.Process(const Chunk: array of Byte);
+var
+ i, j: Integer;
+ b, w: TCryptoWhirlpoolMatrix;
+begin
+ for i := 0 to 7 do
+ for j := 0 to 7 do
+ b[i, j] := Chunk[i*8 + j];
+
+ Encrypt(w, FState, b);
+
+ Sum(FState, FState, w);
+ Sum(FState, FState, b);
+end;
+
+constructor TCryptoWhirlpool.Create;
+begin
+ inherited Create(64);
+ InitState;
+end;
+
+{ TCryptoAES }
+
+class procedure TCryptoAES.InitSBox;
+
+ function XorBits(b: Byte): Byte;
+ var
+ i: Integer;
+ begin
+ Result := 0;
+
+ for i := 0 to 7 do
+ Result := Result xor ((b shr i) and 1);
+ end;
+
+var
+ i, b: Integer;
+ m, r, q: Byte;
+begin
+ for b := 0 to 255 do
+ begin
+ m := $f8;
+ r := 0;
+
+ { Find qb = 1 }
+
+ if b = 0 then
+ q := 0
+ else
+ for q := 1 to 255 do
+ if Mul8(b, q) = 1 then
+ Break;
+
+ for i := 0 to 7 do
+ begin
+ r := (r shl 1) xor XorBits(q and m);
+ m := (m shr 1) xor Byte(m shl 7);
+ end;
+
+ AESSBox[b] := r xor $63;
+ AESIBox[AESSBox[b]] := b;
+ end;
+end;
+
+class function TCryptoAES.Mul8(a, b: Integer): Integer;
+begin
+ Result := 0;
+
+ while b <> 0 do
+ begin
+ if b and 1 <> 0 then
+ Result := Result xor a;
+
+ b := b shr 1;
+ a := a shl 1;
+
+ if a and $100 <> 0 then
+ a := a xor $11b;
+ end;
+end;
+
+procedure TCryptoAES.Apply(var a: TCryptoAESMatrix; const Box: TCryptoAESSBox);
+var
+ i: Integer;
+begin
+ for i := 0 to 15 do
+ a[i] := Box[a[i]]
+end;
+
+procedure TCryptoAES.Diffuse(var a: TCryptoAESMatrix; const DiffuseRow: TCryptoAESDiffuseRow);
+var
+ i, j, k: Integer;
+ Col: array[0..3] of Byte;
+begin
+ for j := 0 to 3 do
+ begin
+ for i := 0 to 3 do
+ Col[i] := 0;
+
+ for i := 0 to 3 do
+ for k := 0 to 3 do
+ Col[i] := Col[i] xor Mul8(DiffuseRow[(k - i) and 3], a[k*4 + j]);
+
+ for i := 0 to 3 do
+ a[i*4 + j] := Col[i];
+ end;
+end;
+
+procedure TCryptoAES.ExpandKey(const Key: array of Byte);
+var
+ i, j, Nk: Integer;
+ c: Byte; // 2^(i/Nk - 1) in GF(2^8)
+ a: array of array[0..3] of Byte;
+ t: array[0..3] of Byte;
+begin
+ Nk := Length(Key) div 4;
+ SetLength(a, 4*(FNr + 1));
+
+ for i := 0 to Nk - 1 do
+ for j := 0 to 3 do
+ a[i][j] := Key[i*4 + j];
+
+ c := 1;
+
+ for i := Nk to 4*(FNr + 1) - 1 do
+ begin
+ for j := 0 to 3 do
+ t[j] := a[i - 1][j];
+
+ if i mod Nk = 0 then
+ begin
+ for j := 0 to 3 do
+ t[j] := AESSBox[a[i - 1][(j + 1) and 3]];
+
+ t[0] := t[0] xor c;
+ c := Mul8(c, 2);
+ end;
+
+ if (i mod Nk = 4) and (Nk > 6) then
+ for j := 0 to 3 do
+ t[j] := AESSBox[a[i - 1][j]];
+
+ for j := 0 to 3 do
+ a[i][j] := t[j] xor a[i - Nk][j];
+ end;
+
+ SetLength(FW, FNr + 1);
+
+ for i := 0 to 4*(FNr + 1) - 1 do
+ for j := 0 to 3 do
+ FW[i div 4][j*4 + i mod 4] := a[i][j]
+end;
+
+procedure TCryptoAES.Rotate(var a: TCryptoAESMatrix; Dir: Integer);
+var
+ i, j: Integer;
+ r: array[0..3] of Byte;
+begin
+ for i := 0 to 3 do
+ begin
+ for j := 0 to 3 do
+ r[j] := a[i*4 + (j - Dir*i) mod 4];
+
+ for j := 0 to 3 do
+ a[i*4 + j] := r[j];
+ end;
+end;
+
+procedure TCryptoAES.Sum(var a: TCryptoAESMatrix; const b, c: TCryptoAESMatrix);
+var
+ i: Integer;
+begin
+ for i := 0 to 15 do
+ a[i] := b[i] xor c[i]
+end;
+
+procedure TCryptoAES.Mov(var a: TCryptoAESMatrix; const b: TCryptoAESMatrix);
+var
+ i: Integer;
+begin
+ for i := 0 to 15 do
+ a[i] := b[i]
+end;
+
+procedure TCryptoAES.Zero(var a: TCryptoAESMatrix);
+var
+ i: Integer;
+begin
+ for i := 0 to 15 do
+ a[i] := 0
+end;
+
+procedure TCryptoAES.Encrypt(var a: TCryptoAESMatrix);
+const
+ R: TCryptoAESDiffuseRow = (2, 3, 1, 1);
+var
+ i: Integer;
+begin
+ Sum(a, a, FW[0]);
+
+ for i := 1 to FNr - 1 do
+ begin
+ Apply(a, AESSBox);
+ Rotate(a, -1);
+ Diffuse(a, R);
+ Sum(a, a, FW[i]);
+ end;
+
+ Apply(a, AESSBox);
+ Rotate(a, -1);
+ Sum(a, a, FW[FNr]);
+end;
+
+procedure TCryptoAES.Decrypt(var a: TCryptoAESMatrix);
+const
+ R: TCryptoAESDiffuseRow = ($e, $b, $d, 9);
+var
+ i: Integer;
+begin
+ Sum(a, a, FW[FNr]);
+
+ for i := FNr - 1 downto 1 do
+ begin
+ Rotate(a, +1);
+ Apply(a, AESIBox);
+ Sum(a, a, FW[i]);
+ Diffuse(a, R);
+ end;
+
+ Rotate(a, +1);
+ Apply(a, AESIBox);
+ Sum(a, a, FW[0]);
+end;
+
+class procedure TCryptoAES.MatrixToData(out Data; const a: TCryptoAESMatrix);
+var
+ i, j: Integer;
+begin
+ for i := 0 to 3 do
+ for j := 0 to 3 do
+ SetNBytesAt(Data, j*4 + i, 1, a[i*4 + j])
+end;
+
+class procedure TCryptoAES.DataToMatrix(out a: TCryptoAESMatrix; const Data);
+var
+ i, j: Integer;
+begin
+ for i := 0 to 3 do
+ for j := 0 to 3 do
+ a[i*4 + j] := GetNBytesAt(Data, j*4 + i, 1)
+end;
+
+procedure TCryptoAES.Decrypt(var Output; const Input);
+var
+ a: TCryptoAESMatrix;
+begin
+ DataToMatrix(a, Input);
+ Decrypt(a);
+ MatrixToData(Output, a);
+end;
+
+procedure TCryptoAES.Encrypt(var Output; const Input);
+var
+ a: TCryptoAESMatrix;
+begin
+ DataToMatrix(a, Input);
+ Encrypt(a);
+ MatrixToData(Output, a);
+end;
+
+constructor TCryptoAES.Create(const Key: array of Byte);
+begin
+ case Length(Key) of
+ 4*4: FNr := 10;
+ 4*6: FNr := 12;
+ 4*8: FNr := 14;
+ else raise ECryptoAESInvalidKeyLength.CreateFmt('AES-%d is undefined',
+ [Length(Key)*8]);
+ end;
+
+ ExpandKey(Key);
+end;
+
+{ TCryptoAES_CBC }
+
+constructor TCryptoAES_CBC.Create(const Key: array of Byte; const IV);
+begin
+ inherited Create(Key);
+ DataToMatrix(FC, IV);
+end;
+
+procedure TCryptoAES_CBC.Encrypt(var a: TCryptoAESMatrix);
+begin
+ Sum(a, a, FC);
+ inherited Encrypt(a);
+ Mov(FC, a);
+end;
+
+procedure TCryptoAES_CBC.Decrypt(var a: TCryptoAESMatrix);
+var
+ s: TCryptoAESMatrix;
+begin
+ Mov(s, FC);
+ Mov(FC, a);
+ inherited Decrypt(a);
+ Sum(a, a, s);
+end;
+
+{ ECryptoHashUnknown }
+
+constructor ECryptoHashUnknown.Create(Name: string);
+begin
+ CreateFmt('Hash function %s is unknown', [Name]);
+end;
+
+{ TCryptoJenkins }
+
+constructor TCryptoJenkins.Create;
+begin
+ inherited Create(64)
+end;
+
+function TCryptoJenkins.DigestSize: Integer;
+begin
+ Result := 4
+end;
+
+procedure TCryptoJenkins.Finish(LengthSize: Integer; Straight: Boolean);
+var
+ h: Cardinal;
+begin
+ inherited;
+
+ h := FState;
+
+ h := h + (h shl 3);
+ h := h xor (h shr 11);
+ h := h + (h shl 15);
+
+ FState := h;
+end;
+
+procedure TCryptoJenkins.GetDigest(out Digest; Size: Integer);
+begin
+ Assert(Size = DigestSize);
+ Finish(ChunkSize div 2, True);
+ Move(FState, Digest, Size);
+end;
+
+procedure TCryptoJenkins.Process(const Chunk: array of Byte);
+var
+ h: Cardinal;
+ i: Integer;
+begin
+ h := FState;
+
+ for i := 0 to ChunkSize - 1 do
+ begin
+ h := h + Chunk[i];
+ h := h + (h shl 10);
+ h := h xor (h shr 6);
+ end;
+
+ FState := h;
+end;
+
+procedure TCryptoJenkins.Reset;
+begin
+ inherited;
+ FState := 0;
+end;
+
+initialization
+
+TCryptoMD5.InitSinTable;
+TCryptoWhirlpool.InitSBox;
+TCryptoWhirlpool.InitMul8;
+TCryptoAES.InitSBox;
+
+end.
diff --git a/LibD28x64/FMX.frxCtrls.pas b/LibD28x64/FMX.frxCtrls.pas
new file mode 100644
index 0000000..55296ad
--- /dev/null
+++ b/LibD28x64/FMX.frxCtrls.pas
@@ -0,0 +1,435 @@
+{***************************************************}
+{ }
+{ FastReport v4.0 }
+{ Tool controls }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{***************************************************}
+
+unit FMX.frxCtrls;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.Types, System.UITypes, FMX.Types, FMX.Controls, FMX.ListBox,
+ FMX.Forms, FMX.Edit, System.UIConsts, FMX.Objects, FMX.Layouts
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI21}
+ , FMX.Controls.Presentation
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+ TfrxScrollWin = class(TStyledControl)
+ private
+ FHScrollBar: TScrollBar;
+ FVScrollBar: TScrollBar;
+ FContent: TContent;
+ procedure SetHorzRange(Value: Single);
+ procedure SetHorzPosition(Value: Single);
+ procedure SetVertRange(Value: Single);
+ procedure SetVertPosition(Value: Single);
+ procedure CheckScrollBars;
+ procedure UpdateScrollBars;
+ function HScrollBar: TScrollBar;
+ function VScrollBar: TScrollBar;
+ function GetHorzPosition: Single;
+ function GetVertPosition: Single;
+ function GetHorzRange: Single;
+ function GetVertRange: Single;
+ protected
+ procedure ApplyStyle; override;
+ procedure FreeStyle; override;
+ procedure KeyDown(var Key: Word; var KeyChar: System.WideChar; Shift: TShiftState); override;
+ procedure MouseWheel(Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean); override;
+ procedure OnHScrollChange(Sender: TObject); virtual;
+ procedure OnVScrollChange(Sender: TObject); virtual;
+ procedure DoContentPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF); virtual;
+ function GetContentCanvas: TCanvas;
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure Resize; override;
+ function GetClientRect: TRectF;
+ property HorzRange: Single read GetHorzRange write SetHorzRange;
+ property HorzPosition: Single read GetHorzPosition write SetHorzPosition;
+ property VertRange: Single read GetVertRange write SetVertRange;
+ property VertPosition: Single read GetVertPosition write SetVertPosition;
+ end;
+
+
+ TfrxSplitter = class(TSplitter)
+ private
+ FOnMove: TNotifyEvent;
+ public
+ procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
+ property OnMove: TNotifyEvent read FOnMove write FOnMove;
+ end;
+
+ TfrxEditWithButton = class(TEdit)
+ private
+{$IFDEF DELPHI21}
+ FButton: TEditButton;
+{$ELSE}
+ FButton: TSpeedButton;
+{$ENDIF}
+ FOnButtonClick: TNotifyEvent;
+ procedure DoButtonClick(Sender: TObject);
+ protected
+{$IFDEF DELPHI21}
+ function DefinePresentationName: string; override;
+{$ENDIF}
+ procedure ApplyStyle; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ published
+ property OnButtonClick: TNotifyEvent read FOnButtonClick write FOnButtonClick;
+ end;
+
+ TfrxEditButton = class(TSpeedButton)
+ private
+ procedure DoContentPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
+ protected
+ procedure ApplyStyle; override;
+ end;
+
+
+implementation
+
+function Min(A, B: Single): Single;
+begin
+ if A < B then Result := A
+ else Result := B;
+end;
+
+constructor TfrxScrollWin.Create(AOwner: TComponent);
+begin
+ inherited;
+ CanFocus := True;
+{$IFDEF Delphi18}
+ StyleLookup := 'scrollboxstyle';
+{$ELSE}
+ FStyleLookup := 'scrollboxstyle';
+{$ENDIF}
+ ClipChildren := True;
+{$IFNDEF Delphi17}
+ CanClip := True;
+{$ENDIF}
+ ClipParent := True;
+end;
+
+procedure TfrxScrollWin.ApplyStyle;
+var
+ B: TFmxObject;
+begin
+ inherited;
+ if (FVScrollBar = nil) or (FHScrollBar = nil) then
+ begin
+ B := FindStyleResource('vscrollbar');
+ if (B <> nil) and (B is TScrollBar) then
+ begin
+ FVScrollBar := TScrollBar(B);
+ FVScrollBar.OnChange := OnVScrollChange;
+ end;
+ B := FindStyleResource('hscrollbar');
+ if (B <> nil) and (B is TScrollBar) then
+ begin
+ FHScrollBar := TScrollBar(B);
+ FHScrollBar.OnChange := OnHScrollChange;
+ end;
+ B := FindStyleResource('sizegrip');
+ if (B <> nil) and (B is TControl) then
+ (B as TControl).Visible := False;
+ end;
+ B := FindStyleResource('content');
+ if (B <> nil) and (B is TControl) then
+ begin
+ FContent := TContent(B);
+ FContent.OnPaint := DoContentPaint;
+ FContent.BringToFront;
+ FContent.ClipChildren := True;
+ FContent.ClipParent := True;
+{$IFNDEF Delphi17}
+ FContent.CanClip := True;
+{$ENDIF}
+ end;
+end;
+
+procedure TfrxScrollWin.CheckScrollBars;
+begin
+ if (FHScrollBar = nil) or (FVScrollBar = nil) then
+ ApplyStyleLookup;
+end;
+
+function TfrxScrollWin.GetClientRect: TRectF;
+begin
+ if FContent <> nil then
+ Result := FContent.ClipRect
+ else
+ Result := RectF(0, 0, 0, 0);
+end;
+
+function TfrxScrollWin.GetContentCanvas: TCanvas;
+begin
+ Result := nil;
+ if (FContent <> nil) and (FContent.Canvas <> nil) then
+ Result := FContent.Canvas;
+end;
+
+function TfrxScrollWin.GetHorzPosition: Single;
+begin
+ Result := HScrollBar.Value;
+end;
+
+function TfrxScrollWin.GetHorzRange: Single;
+begin
+ Result := HScrollBar.Max;
+end;
+
+function TfrxScrollWin.GetVertPosition: Single;
+begin
+ Result := VScrollBar.Value;
+end;
+
+function TfrxScrollWin.GetVertRange: Single;
+begin
+ Result := VScrollBar.Max;
+end;
+
+function TfrxScrollWin.HScrollBar: TScrollBar;
+begin
+ CheckScrollBars;
+ Result := FHScrollBar;
+end;
+
+function TfrxScrollWin.VScrollBar: TScrollBar;
+begin
+ CheckScrollBars;
+ Result := FVScrollBar;
+end;
+
+procedure TfrxScrollWin.SetHorzPosition(Value: Single);
+begin
+ HScrollBar.Value := Value;
+end;
+
+procedure TfrxScrollWin.SetHorzRange(Value: Single);
+begin
+ HScrollBar.Max := Value;
+ UpdateScrollBars;
+end;
+
+procedure TfrxScrollWin.SetVertPosition(Value: Single);
+begin
+ VScrollBar.Value := Value;
+end;
+
+procedure TfrxScrollWin.SetVertRange(Value: Single);
+begin
+ VScrollBar.Max := Value;
+ UpdateScrollBars;
+end;
+
+procedure TfrxScrollWin.UpdateScrollbars;
+begin
+ if HorzRange > BoundsRect.Width then
+ begin
+ HScrollBar.Visible := True;
+ HScrollBar.SmallChange := BoundsRect.Width / 5;
+ HorzPosition := HorzPosition;
+ HScrollBar.ViewportSize := BoundsRect.Width;
+ end
+ else
+ begin
+ HScrollBar.Visible := False;
+ end;
+
+ if VertRange > BoundsRect.Height then
+ begin
+ VScrollBar.Visible := True;
+ VScrollBar.SmallChange := BoundsRect.Height / 5;
+ VertPosition := VertPosition;
+ VScrollBar.ViewportSize := BoundsRect.Height;
+ end
+ else
+ begin
+ VScrollBar.Visible := False;
+ end;
+
+ if HScrollBar.Visible and VScrollBar.Visible then
+ HScrollBar.Padding.Right := VScrollBar.Width
+ else
+ HScrollBar.Padding.Right := 0;
+end;
+
+procedure TfrxScrollWin.Resize;
+begin
+ if FContent <> nil then
+ begin
+ //FContent.SetBounds(Left, Top, Width, Height);
+{$IFNDEF Delphi17}
+ FContent.Realign;
+{$ENDIF}
+ end;
+// XE3 bug?
+// UpdateScrollBars;
+ inherited;
+end;
+
+procedure TfrxScrollWin.MouseWheel(Shift: TShiftState; WheelDelta: Integer;
+ var Handled: Boolean);
+begin
+ inherited;
+ VertPosition := VertPosition - WheelDelta;
+ Handled := True;
+end;
+
+procedure TfrxScrollWin.KeyDown(var Key: Word; var KeyChar: System.WideChar;
+ Shift: TShiftState);
+begin
+ inherited;
+ case Key of
+ vkHome:
+ VertPosition := 0;
+ vkEnd:
+ VertPosition := VertRange;
+ vkUp:
+ VertPosition := VertPosition - VScrollBar.SmallChange;
+ vkDown:
+ VertPosition := VertPosition + VScrollBar.SmallChange;
+ vkLeft:
+ HorzPosition := HorzPosition - HScrollBar.SmallChange;
+ vkRight:
+ HorzPosition := HorzPosition + HScrollBar.SmallChange;
+ vkPrior:
+ VertPosition := VertPosition - VScrollBar.ViewportSize;
+ vkNext:
+ VertPosition := VertPosition + VScrollBar.ViewportSize;
+ end;
+end;
+
+procedure TfrxScrollWin.DoContentPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
+begin
+end;
+
+procedure TfrxScrollWin.FreeStyle;
+begin
+ inherited;
+ { Need to clear style objects }
+ FVScrollBar := nil;
+ FHScrollBar := nil;
+end;
+
+procedure TfrxScrollWin.OnHScrollChange(Sender: TObject);
+begin
+end;
+
+procedure TfrxScrollWin.OnVScrollChange(Sender: TObject);
+begin
+end;
+
+{ TfrxSplitter }
+
+procedure TfrxSplitter.MouseMove(Shift: TShiftState; X, Y: Single);
+begin
+ inherited;
+{$IFDEF DELPHI21}
+ if Pressed and Assigned(FOnMove) then
+{$ELSE}
+ if FPressed and Assigned(FOnMove) then
+{$ENDIF}
+ FOnMove(Self);
+end;
+
+
+{ TfrxEditWithButton }
+
+procedure TfrxEditButton.ApplyStyle;
+var
+ C: TFmxObject;
+begin
+ inherited;
+ C := FindStyleResource('text');
+ if Assigned(C) and (C is TText) then
+ begin
+ TText(C).OnPaint := DoContentPaint;
+ end;
+end;
+
+procedure TfrxEditButton.DoContentPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
+var
+ i, dx, dy: Integer;
+begin
+ Canvas.Fill.Kind := TBrushKind.bkSolid;
+ Canvas.Fill.Color := claGray;
+ dx := Round(ARect.Width / 2) - 6;
+ dy := Round(ARect.Height / 2) - 1;
+ for i := 0 to 2 do
+ Canvas.FillRect(RectF(ARect.Left + dx + i * 5, ARect.Top + dy, ARect.Left + 2 + dx + i * 5, ARect.Top + 2 + dy), 0, 0, allCorners, 1);
+end;
+
+constructor TfrxEditWithButton.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+{$IFDEF DELPHI21}
+ FButton := TEditButton.Create(Self);
+ FButton.Text := '..';
+ ButtonsContent.AddObject(FButton);
+{$ELSE}
+ FButton := TfrxEditButton.Create(Self);
+ FButton.Parent := Self;
+{$ENDIF}
+ FButton.Width := 22;
+ FButton.Height := 22;
+ FButton.Align := TAlignLayout.alFitRight;
+ FButton.OnClick := DoButtonClick;
+end;
+
+procedure TfrxEditWithButton.ApplyStyle;
+var
+ C: TFmxObject;
+begin
+ inherited;
+ C := FindStyleResource('content');
+ if Assigned(C) and (C is TLayout) then
+ begin
+ TLayout(C).Padding.Right := FButton.Width + 2;
+ end;
+end;
+
+procedure TfrxEditWithButton.DoButtonClick(Sender: TObject);
+begin
+ if Assigned(FOnButtonClick) then
+ FOnButtonClick(Self);
+end;
+
+{$IFDEF DELPHI21}
+function TfrxEditWithButton.DefinePresentationName: String;
+begin
+ Result := TEDIT.ClassName;
+ if (Length(Result) > 1) and (Result[1] = 'T') then
+ Delete(Result, 1, 1);
+ Result := Result + '-' + GetPresentationSuffix;
+end;
+{$ENDIF}
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxSplitter, TFmxObject);
+ GroupDescendentsWith(TfrxEditWithButton, TFmxObject);
+ RegisterFmxClasses([TfrxSplitter, TfrxEditWithButton]);
+
+end.
diff --git a/LibD28x64/FMX.frxCustomDB.pas b/LibD28x64/FMX.frxCustomDB.pas
new file mode 100644
index 0000000..3788db6
--- /dev/null
+++ b/LibD28x64/FMX.frxCustomDB.pas
@@ -0,0 +1,833 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ Custom TDataSet-based classes }
+{ for enduser DB components }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCustomDB;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.Classes, System.SysUtils, Data.DB, FMX.frxClass, FMX.frxDBSet,
+ FMX.ListBox, System.Variants, System.Types, FMX.Types
+{$IFDEF QBUILDER}
+, FMX.fqbClass
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+
+type
+ TfrxCustomDataset = class(TfrxDBDataSet)
+ private
+ FDBConnected: Boolean;
+ FDataSource: TDataSource;
+ FMaster: TfrxDBDataSet;
+ FMasterFields: String;
+ procedure SetActive(Value: Boolean);
+ procedure SetFilter(const Value: String);
+ procedure SetFiltered(Value: Boolean);
+ function GetActive: Boolean;
+ function GetFields: TFields;
+ function GetFilter: String;
+ function GetFiltered: Boolean;
+ procedure InternalSetMaster(const Value: TfrxDBDataSet);
+ procedure InternalSetMasterFields(const Value: String);
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetParent(AParent: TfrxComponent); override;
+ procedure SetUserName(const Value: String); override;
+ procedure SetMaster(const Value: TDataSource); virtual;
+ procedure SetMasterFields(const Value: String); virtual;
+ property DataSet;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure OnPaste; override;
+ property DBConnected: Boolean read FDBConnected write FDBConnected;
+ property Fields: TFields read GetFields;
+ property MasterFields: String read FMasterFields write InternalSetMasterFields;
+ property Active: Boolean read GetActive write SetActive default False;
+ published
+ property Filter: String read GetFilter write SetFilter;
+ property Filtered: Boolean read GetFiltered write SetFiltered default False;
+ property Master: TfrxDBDataset read FMaster write InternalSetMaster;
+ end;
+
+ TfrxCustomTable = class(TfrxCustomDataset)
+ protected
+ function GetIndexFieldNames: String; virtual;
+ function GetIndexName: String; virtual;
+ function GetTableName: String; virtual;
+ procedure SetIndexFieldNames(const Value: String); virtual;
+ procedure SetIndexName(const Value: String); virtual;
+ procedure SetTableName(const Value: String); virtual;
+ property DataSet;
+ published
+ property MasterFields;
+ property TableName: String read GetTableName write SetTableName;
+ property IndexName: String read GetIndexName write SetIndexName;
+ property IndexFieldNames: String read GetIndexFieldNames write SetIndexFieldNames;
+ end;
+
+ TfrxParamItem = class(TCollectionItem)
+ private
+ FDataType: TFieldType;
+ FExpression: String;
+ FName: String;
+ FValue: Variant;
+ public
+ procedure Assign(Source: TPersistent); override;
+ property Value: Variant read FValue write FValue;
+ published
+ property Name: String read FName write FName;
+ property DataType: TFieldType read FDataType write FDataType;
+ property Expression: String read FExpression write FExpression;
+ end;
+
+ TfrxParams = class(TCollection)
+ private
+ FIgnoreDuplicates: Boolean;
+ function GetParam(Index: Integer): TfrxParamItem;
+ public
+ constructor Create;
+ function Add: TfrxParamItem;
+ function Find(const Name: String): TfrxParamItem;
+ function IndexOf(const Name: String): Integer;
+ procedure UpdateParams(const SQL: String);
+ property Items[Index: Integer]: TfrxParamItem read GetParam; default;
+ property IgnoreDuplicates: Boolean read FIgnoreDuplicates write FIgnoreDuplicates;
+ end;
+
+
+ TfrxCustomQuery = class(TfrxCustomDataset)
+ private
+ FParams: TfrxParams;
+ FSaveOnBeforeOpen: TDataSetNotifyEvent;
+ FSaveOnChange: TNotifyEvent;
+ FSQLSchema: String;
+ procedure ReadData(Reader: TReader);
+ procedure SetParams(Value: TfrxParams);
+ procedure WriteData(Writer: TWriter);
+ function GetIgnoreDupParams: Boolean;
+ procedure SetIgnoreDupParams(const Value: Boolean);
+ protected
+ procedure DefineProperties(Filer: TFiler); override;
+ procedure OnBeforeOpen(DataSet: TDataSet); virtual;
+ procedure OnChangeSQL(Sender: TObject); virtual;
+ procedure SetSQL(Value: TStrings); virtual;
+ function GetSQL: TStrings; virtual;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure UpdateParams; virtual;
+ function ParamByName(const Value: String): TfrxParamItem;
+{$IFDEF QBUILDER}
+ function QBEngine: TfqbEngine; virtual;
+{$ENDIF}
+ published
+ property IgnoreDupParams: Boolean read GetIgnoreDupParams write SetIgnoreDupParams;
+ property Params: TfrxParams read FParams write SetParams;
+ property SQL: TStrings read GetSQL write SetSQL;
+ property SQLSchema: String read FSQLSchema write FSQLSchema;
+ end;
+
+ { emulates work of DBLookupComboBox in VCL, for back compatibility only }
+ TfrxDBLookupComboBox = class(TfrxDialogControl)
+ private
+ FDataSet: TfrxDBDataSet;
+ FDataSetName: String;
+ FComboBox: TComboBox;
+ FAutoOpenDataSet: Boolean;
+ FIsFilled: Boolean;
+ FListField: String;
+ FKeyField: String;
+ FValue: Variant;
+ function GetDataSetName: String;
+ function GetKeyField: String;
+ function GetKeyValue: Variant;
+ function GetListField: String;
+ function GetText: String;
+ procedure SetDataSet(const Value: TfrxDBDataSet);
+ procedure SetDataSetName(const Value: String);
+ procedure SetKeyField(Value: String);
+ procedure SetKeyValue(const Value: Variant);
+ procedure SetListField(Value: String);
+ procedure UpdateDataSet;
+ procedure OnOpenDS(Sender: TObject);
+ function GetDropDownWidth: Integer;
+ procedure SetDropDownWidth(const Value: Integer);
+ function GetDropDownRows: Integer;
+ procedure SetDropDownRows(const Value: Integer);
+ procedure DoOnChange(Sender: TObject);
+ procedure FillWithData;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ procedure BeforeStartReport; override;
+ property ComboBox: TComboBox read FComboBox;
+ property KeyValue: Variant read GetKeyValue write FValue;
+ property Text: String read GetText;
+ procedure PaintControl(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
+ published
+ property AutoOpenDataSet: Boolean read FAutoOpenDataSet write FAutoOpenDataSet default False;
+ property DataSet: TfrxDBDataset read FDataSet write SetDataSet;
+ property DataSetName: String read GetDataSetName write SetDataSetName;
+ property ListField: String read GetListField write SetListField;
+ property KeyField: String read GetKeyField write SetKeyField;
+ property DropDownWidth: Integer read GetDropDownWidth write SetDropDownWidth;
+ property DropDownRows: Integer read GetDropDownRows write SetDropDownRows;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+
+procedure frxParamsToTParams(Query: TfrxCustomQuery; Params: TParams);
+
+
+implementation
+
+uses
+{$IFNDEF NO_EDITORS}
+ FMX.frxCustomDBEditor,
+{$ENDIF}
+ FMX.frxCustomDBRTTI, FMX.frxDsgnIntf, FMX.frxUtils, FMX.frxRes;
+
+
+{ TfrxParamItem }
+
+procedure TfrxParamItem.Assign(Source: TPersistent);
+begin
+ if Source is TfrxParamItem then
+ begin
+ FName := TfrxParamItem(Source).Name;
+ FDataType := TfrxParamItem(Source).DataType;
+ FExpression := TfrxParamItem(Source).Expression;
+ FValue := TfrxParamItem(Source).Value;
+ end;
+end;
+
+{ TfrxParams }
+
+constructor TfrxParams.Create;
+begin
+ inherited Create(TfrxParamItem);
+ FIgnoreDuplicates := False;
+end;
+
+function TfrxParams.Add: TfrxParamItem;
+begin
+ Result := TfrxParamItem(inherited Add);
+end;
+
+function TfrxParams.GetParam(Index: Integer): TfrxParamItem;
+begin
+ Result := TfrxParamItem(inherited Items[Index]);
+end;
+
+function TfrxParams.Find(const Name: String): TfrxParamItem;
+var
+ i: Integer;
+begin
+ i := IndexOf(Name);
+ if i <> -1 then
+ Result := Items[i] else
+ Result := nil;
+end;
+
+function TfrxParams.IndexOf(const Name: String): Integer;
+var
+ i: Integer;
+begin
+ Result := -1;
+ for i := 0 to Count - 1 do
+ if CompareText(Items[i].Name, Name) = 0 then
+ begin
+ Result := i;
+ break;
+ end;
+end;
+
+procedure TfrxParams.UpdateParams(const SQL: String);
+var
+ i, j: Integer;
+ QParams: TParams;
+ NewParams: TfrxParams;
+begin
+ { parse query params }
+ QParams := TParams.Create;
+ QParams.ParseSQL(SQL, True);
+
+ { create new TfrxParams object and copy all params to it }
+ NewParams := TfrxParams.Create;
+ for i := 0 to QParams.Count - 1 do
+ if not ((NewParams.IndexOf(QParams[i].Name) <> -1) and FIgnoreDuplicates) then
+ with NewParams.Add do
+ begin
+ Name := QParams[i].Name;
+ j := IndexOf(Name);
+ if j <> -1 then
+ begin
+ DataType := Items[j].DataType;
+ Value := Items[j].Value;
+ Expression := Items[j].Expression;
+ end;
+ end;
+ Assign(NewParams);
+ QParams.Free;
+ NewParams.Free;
+end;
+
+{ TfrxCustomDataset }
+
+constructor TfrxCustomDataset.Create(AOwner: TComponent);
+begin
+ Component := Dataset;
+ inherited;
+ CloseDataSource := True;
+ FDataSource := TDataSource.Create(nil);
+ SetMaster(FDataSource);
+end;
+
+destructor TfrxCustomDataset.Destroy;
+begin
+ FDataSource.Free;
+ inherited;
+end;
+
+procedure TfrxCustomDataset.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited;
+ if Operation = opRemove then
+ if AComponent = FMaster then
+ Master := nil
+end;
+
+procedure TfrxCustomDataset.SetParent(AParent: TfrxComponent);
+begin
+ inherited;
+ if (AParent <> nil) and (Report <> nil) then
+ begin
+ if IsDesigning and (Report.DataSets.Find(Self) = nil) then
+ begin
+ Report.DataSets.Add(Self);
+ if Report.Designer <> nil then
+ Report.Designer.UpdateDataTree;
+ end;
+ end;
+end;
+
+procedure TfrxCustomDataset.SetUserName(const Value: String);
+begin
+ inherited;
+ if (Report <> nil) and (Report.Designer <> nil) then
+ Report.Designer.UpdateDataTree;
+end;
+
+procedure TfrxCustomDataset.OnPaste;
+var
+ i: Integer;
+ sl: TStringList;
+begin
+ if Report = nil then Exit;
+
+ if Report.DataSets.Find(Self) = nil then
+ Report.DataSets.Add(Self);
+
+ sl := TStringList.Create;
+
+ Report.GetDatasetList(sl);
+ for i := 0 to sl.Count - 1 do
+ if (sl.Objects[i] <> Self) and (CompareText(sl[i], UserName) = 0) then
+ begin
+ if Name <> '' then
+ UserName := Name;
+ break;
+ end;
+ sl.Free;
+
+ Report.Designer.UpdateDataTree;
+end;
+
+procedure TfrxCustomDataset.SetActive(Value: Boolean);
+begin
+ Dataset.Active := Value;
+end;
+
+procedure TfrxCustomDataset.SetFilter(const Value: String);
+begin
+ Dataset.Filter := Value;
+end;
+
+function TfrxCustomDataset.GetActive: Boolean;
+begin
+ Result := Dataset.Active;
+end;
+
+function TfrxCustomDataset.GetFields: TFields;
+begin
+ Result := Dataset.Fields;
+end;
+
+function TfrxCustomDataset.GetFilter: String;
+begin
+ Result := Dataset.Filter;
+end;
+
+function TfrxCustomDataset.GetFiltered: Boolean;
+begin
+ Result := Dataset.Filtered;
+end;
+
+procedure TfrxCustomDataset.SetFiltered(Value: Boolean);
+begin
+ Dataset.Filtered := Value;
+end;
+
+procedure TfrxCustomDataset.InternalSetMaster(const Value: TfrxDBDataSet);
+begin
+ FMaster := Value;
+ if FMaster <> nil then
+ FDataSource.DataSet := FMaster.GetDataSet
+ else
+ FDataSource.DataSet := nil;
+end;
+
+procedure TfrxCustomDataset.InternalSetMasterFields(const Value: String);
+var
+ sl: TStringList;
+ s: String;
+ i: Integer;
+
+ function ConvertAlias(const s: String): String;
+ begin
+ if FMaster <> nil then
+ Result := FMaster.ConvertAlias(s)
+ else
+ Result := s;
+ end;
+
+begin
+ FMasterFields := Value;
+
+ sl := TStringList.Create;
+ frxSetCommaText(Value, sl);
+ s := '';
+ for i := 0 to sl.Count - 1 do
+ s := s + ConvertAlias(sl.Values[sl.Names[i]]) + ';';
+ s := Copy(s, 1, Length(s) - 1);
+
+ SetMasterFields(s);
+
+ s := '';
+ for i := 0 to sl.Count - 1 do
+ s := s + ConvertAlias(sl.Names[i]) + ';';
+ s := Copy(s, 1, Length(s) - 1);
+
+ if Self is TfrxCustomTable then
+ TfrxCustomTable(Self).SetIndexFieldNames(s);
+
+ sl.Free;
+end;
+
+procedure TfrxCustomDataset.SetMaster(const Value: TDataSource);
+begin
+// do nothing
+end;
+
+procedure TfrxCustomDataset.SetMasterFields(const Value: String);
+begin
+// do nothing
+end;
+
+
+{ TfrxCustomTable }
+
+function TfrxCustomTable.GetIndexFieldNames: String;
+begin
+ Result := '';
+end;
+
+function TfrxCustomTable.GetIndexName: String;
+begin
+ Result := '';
+end;
+
+function TfrxCustomTable.GetTableName: String;
+begin
+ Result := '';
+end;
+
+procedure TfrxCustomTable.SetIndexFieldNames(const Value: String);
+begin
+// do nothing
+end;
+
+procedure TfrxCustomTable.SetIndexName(const Value: String);
+begin
+// do nothing
+end;
+
+procedure TfrxCustomTable.SetTableName(const Value: String);
+begin
+// do nothing
+end;
+
+
+{ TfrxCustomQuery }
+
+constructor TfrxCustomQuery.Create(AOwner: TComponent);
+begin
+ inherited;
+ FParams := TfrxParams.Create;
+ FSaveOnBeforeOpen := DataSet.BeforeOpen;
+ DataSet.BeforeOpen := OnBeforeOpen;
+ FSaveOnChange := TStringList(SQL).OnChange;
+ TStringList(SQL).OnChange := OnChangeSQL;
+end;
+
+destructor TfrxCustomQuery.Destroy;
+begin
+ FParams.Free;
+ inherited;
+end;
+
+procedure TfrxCustomQuery.DefineProperties(Filer: TFiler);
+begin
+ inherited;
+ Filer.DefineProperty('Parameters', ReadData, WriteData, True);
+end;
+
+procedure TfrxCustomQuery.ReadData(Reader: TReader);
+begin
+ frxReadCollection(FParams, Reader, Self);
+ UpdateParams;
+end;
+
+procedure TfrxCustomQuery.WriteData(Writer: TWriter);
+begin
+ frxWriteCollection(FParams, Writer, Self);
+end;
+
+procedure TfrxCustomQuery.OnBeforeOpen(DataSet: TDataSet);
+begin
+ UpdateParams;
+ if Assigned(FSaveOnBeforeOpen) then
+ FSaveOnBeforeOpen(DataSet);
+end;
+
+procedure TfrxCustomQuery.OnChangeSQL(Sender: TObject);
+begin
+ if Assigned(FSaveOnChange) then
+ FSaveOnChange(Sender);
+ FParams.UpdateParams(SQL.Text);
+end;
+
+procedure TfrxCustomQuery.SetParams(Value: TfrxParams);
+begin
+ FParams.Assign(Value);
+end;
+
+function TfrxCustomQuery.ParamByName(const Value: String): TfrxParamItem;
+begin
+ Result := FParams.Find(Value);
+ if Result = nil then
+ raise Exception.Create('Parameter "' + Value + '" not found');
+end;
+
+procedure TfrxCustomQuery.SetSQL(Value: TStrings);
+begin
+//
+end;
+
+function TfrxCustomQuery.GetSQL: TStrings;
+begin
+ Result := nil;
+end;
+
+procedure TfrxCustomQuery.UpdateParams;
+begin
+//
+end;
+
+{$IFDEF QBUILDER}
+function TfrxCustomQuery.QBEngine: TfqbEngine;
+begin
+ Result := nil;
+end;
+{$ENDIF}
+
+
+{ frxParamsToTParams }
+
+procedure frxParamsToTParams(Query: TfrxCustomQuery; Params: TParams);
+var
+ i: Integer;
+ Item: TfrxParamItem;
+begin
+ for i := 0 to Params.Count - 1 do
+ if Query.Params.IndexOf(Params[i].Name) <> -1 then
+ begin
+ Item := Query.Params[Query.Params.IndexOf(Params[i].Name)];
+ Params[i].Clear;
+ Params[i].DataType := Item.DataType;
+ { Bound should be True in design mode }
+ if not (Query.IsLoading or Query.IsDesigning) then
+ Params[i].Bound := False
+ else
+ begin
+ if Item.Expression <> '' then
+ Params[i].Value := 0;
+ Params[i].Bound := True;
+ end;
+
+ if Trim(Item.Expression) <> '' then
+ if not (Query.IsLoading or Query.IsDesigning) then
+ if Query.Report <> nil then
+ begin
+ Query.Report.CurObject := Query.Name;
+ Item.Value := Query.Report.Calc(Item.Expression);
+ end;
+ if not VarIsEmpty(Item.Value) then
+ begin
+ Params[i].Bound := True;
+ if Params[i].DataType in [ftDate, ftTime, ftDateTime] then
+ Params[i].Value := Item.Value
+ else
+ Params[i].Text := VarToStr(Item.Value);
+ end;
+
+ end;
+end;
+
+function TfrxCustomQuery.GetIgnoreDupParams: Boolean;
+begin
+ Result := FParams.FIgnoreDuplicates;
+end;
+
+procedure TfrxCustomQuery.SetIgnoreDupParams(const Value: Boolean);
+begin
+ FParams.FIgnoreDuplicates := Value;
+ FParams.UpdateParams(SQL.Text);
+end;
+
+{ TfrxDBLookupComboBox }
+
+constructor TfrxDBLookupComboBox.Create(AOwner: TComponent);
+begin
+ inherited;
+ FComboBox := TComboBox.Create(nil);
+ InitControl(FComboBox);
+ Width := 145;
+ Height := 21;
+ FComboBox.OnPainting := PaintControl;
+ FIsFilled := False;
+ FComboBox.OnChange := DoOnChange;
+// FDBLookupComboBox.ListSource := FDataSource;
+end;
+
+destructor TfrxDBLookupComboBox.Destroy;
+begin
+ inherited;
+end;
+
+procedure TfrxDBLookupComboBox.DoOnChange(Sender: TObject);
+begin
+ if (FDataSet <> nil) and FDataSet.HasField(FListField) and (FComboBox.Selected <> nil) then
+ begin
+ FDataSet.DataSet.Locate(FDataSet.ConvertAlias(FListField), FComboBox.Selected.Text, []);
+ if(FDataSet.HasField(FKeyField)) then
+ begin
+ FValue := FDataSet.Value[FKeyField];
+ end;
+ end;
+
+end;
+
+procedure TfrxDBLookupComboBox.FillWithData;
+begin
+ if not FIsFilled then
+ begin
+ if FDataSet = nil then Exit;
+ if not FDataSet.HasField(FListField) then Exit;
+ FDataSet.First;
+{$IFDEF DELPHI23}
+ FComboBox.Clear;
+{$ELSE}
+ FComboBox.Items.Clear;
+{$ENDIF}
+ FComboBox.BeginUpdate;
+ try
+ while not FDataSet.Eof do
+ begin
+ FComboBox.Items.Add(FDataSet.Value[FListField]);
+ FDataSet.Next;
+ end;
+ finally
+ FComboBox.EndUpdate;
+ end;
+ if FComboBox.Items.Count > 0 then
+ FComboBox.ListItems[0].IsSelected := True;
+ FIsFilled := True;
+ end;
+end;
+
+class function TfrxDBLookupComboBox.GetDescription: String;
+begin
+ Result := frxResources.Get('obDBLookup');
+end;
+
+function TfrxDBLookupComboBox.GetDataSetName: String;
+begin
+ if FDataSet = nil then
+ Result := FDataSetName else
+ Result := FDataSet.UserName;
+end;
+
+function TfrxDBLookupComboBox.GetKeyField: String;
+begin
+ Result := FKeyField;
+end;
+
+function TfrxDBLookupComboBox.GetKeyValue: Variant;
+begin
+ Result := FValue;
+end;
+
+function TfrxDBLookupComboBox.GetListField: String;
+begin
+ Result := FListField;
+ FDataSet := TfrxDBDataSet(Report.GetDataset(FDataSetName));
+end;
+
+function TfrxDBLookupComboBox.GetText: String;
+begin
+ if FComboBox.Selected <> nil then
+ Result := FComboBox.Selected.Text;
+end;
+
+procedure TfrxDBLookupComboBox.SetDataSet(const Value: TfrxDBDataSet);
+begin
+ FDataSet := Value;
+ if FDataSet = nil then
+ FDataSetName := '' else
+ FDataSetName := FDataSet.UserName;
+ UpdateDataSet;
+end;
+
+procedure TfrxDBLookupComboBox.SetDataSetName(const Value: String);
+begin
+ FDataSetName := Value;
+ FDataSet := TfrxDBDataSet(FindDataSet(FDataSet, FDataSetName));
+ UpdateDataSet;
+end;
+
+procedure TfrxDBLookupComboBox.SetKeyField(Value: String);
+begin
+ FKeyField := Value;
+ if FListField = '' then
+ FListField := FKeyField;
+end;
+
+procedure TfrxDBLookupComboBox.SetKeyValue(const Value: Variant);
+var
+ i: Integer;
+begin
+ if (FDataSet <> nil) and FDataSet.HasField(FKeyField) and FDataSet.HasField(FListField) then
+ begin
+ FillWithData;
+ FDataSet.DataSet.Locate(FDataSet.ConvertAlias(FKeyField), Value, []);
+ i := FComboBox.Items.IndexOf(FDataSet.Value[FListField]);
+ if i > 0 then
+ begin
+ FValue := Value;
+ FComboBox.ListItems[i].IsSelected := True;
+ FComboBox.ItemIndex := i;
+ end;
+ end;
+end;
+
+procedure TfrxDBLookupComboBox.SetListField(Value: String);
+begin
+ FListField := Value;
+ FIsFilled := False;
+end;
+
+procedure TfrxDBLookupComboBox.UpdateDataSet;
+begin
+ FIsFilled := False;
+end;
+
+procedure TfrxDBLookupComboBox.BeforeStartReport;
+begin
+ SetListField(FListField);
+ SetKeyField(FKeyField);
+ Self.OnActivate := OnOpenDS;
+end;
+
+
+procedure TfrxDBLookupComboBox.OnOpenDS(Sender: TObject);
+begin
+ UpdateDataSet;
+ if (FDataSet <> nil) and (FAutoOpenDataSet) then
+ FDataSet.Open;
+ FIsFilled := False;
+ FillWithData;
+ SetKeyValue(FValue);
+end;
+
+procedure TfrxDBLookupComboBox.PaintControl(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF);
+begin
+ FillWithData;
+end;
+
+function TfrxDBLookupComboBox.GetDropDownWidth: Integer;
+begin
+ Result := 0;
+end;
+
+procedure TfrxDBLookupComboBox.SetDropDownWidth(const Value: Integer);
+begin
+ //FDBLookupComboBox.DropDownWidth := Value;
+end;
+
+function TfrxDBLookupComboBox.GetDropDownRows: Integer;
+begin
+ Result := FComboBox.DropDownCount;
+end;
+
+procedure TfrxDBLookupComboBox.SetDropDownRows(const Value: Integer);
+begin
+ FComboBox.DropDownCount := Value;;
+end;
+
+initialization
+ frxObjects.RegisterObject1(TfrxDBLookupComboBox, nil, '', '', 0, 119);
+
+finalization
+ frxObjects.UnRegister(TfrxDBLookupComboBox);
+
+
+end.
diff --git a/LibD28x64/FMX.frxCustomDBEditor.pas b/LibD28x64/FMX.frxCustomDBEditor.pas
new file mode 100644
index 0000000..b7bc14b
--- /dev/null
+++ b/LibD28x64/FMX.frxCustomDBEditor.pas
@@ -0,0 +1,355 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ Enduser DB components design editors }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCustomDBEditor;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, System.SysUtils, System.UITypes, FMX.Forms, FMX.Controls, FMX.frxClass, FMX.frxCustomDB,
+ FMX.frxDsgnIntf, FMX.frxEditMD, FMX.frxEditAliases, FMX.frxEditQueryParams, FMX.frxEditSQL,
+ FMX.frxDBSet, FMX.frxRes, FMX.frxConnWizard, System.Variants
+{$IFDEF QBUILDER}
+, FMX.fqbClass
+{$ENDIF};
+
+type
+ TfrxCustomDatabaseEditor = class(TfrxComponentEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ end;
+
+ TfrxCustomDataSetEditor = class(TfrxComponentEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ end;
+
+ TfrxCustomQueryEditor = class(TfrxComponentEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ end;
+
+ TfrxFieldAliasesProperty = class(TfrxClassProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+ TfrxDataSetProperty = class(TfrxComponentProperty)
+ public
+ function GetValue: String; override;
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ procedure SetValue(const AValue: String); override;
+ end;
+
+ TfrxDataFieldProperty = class(TfrxPropertyEditor)
+ public
+ function GetValue: String; override;
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ procedure SetValue(const AValue: String); override;
+ end;
+
+ TfrxMasterFieldsProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+ TfrxSQLProperty = class(TfrxClassProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+ TfrxParamsProperty = class(TfrxClassProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+
+{ TfrxCustomDatabaseEditor }
+
+function TfrxCustomDatabaseEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+function TfrxCustomDatabaseEditor.Edit: Boolean;
+var
+ i: Integer;
+ wiz: TfrxCustomWizard;
+begin
+ Result := False;
+ for i := 0 to frxWizards.Count - 1 do
+ if frxWizards[i].ClassRef = TfrxDBConnWizard then
+ begin
+ wiz := TfrxCustomWizard(frxWizards[i].ClassRef.NewInstance);
+ wiz.Create(Designer);
+ try
+ TfrxDBConnWizard(wiz).Database := TfrxCustomDatabase(Component);
+ Result := wiz.Execute;
+ finally
+ wiz.Free;
+ end;
+ break;
+ end;
+end;
+
+
+{ TfrxCustomDataSetEditor }
+
+function TfrxCustomDataSetEditor.Edit: Boolean;
+begin
+ with TfrxAliasesEditorForm.Create(Application) do
+ begin
+ DataSet := TfrxCustomDataSet(Component);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ Self.Designer.UpdateDataTree;
+ Free;
+ end;
+end;
+
+function TfrxCustomDataSetEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+
+{ TfrxCustomQueryEditor }
+
+function TfrxCustomQueryEditor.Edit: Boolean;
+begin
+ with TfrxSQLEditorForm.Create(Designer) do
+ begin
+ Query := TfrxCustomQuery(Component);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ Self.Designer.UpdateDataTree;
+ Free;
+ end;
+end;
+
+function TfrxCustomQueryEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+
+{ TfrxFieldAliasesProperty }
+
+function TfrxFieldAliasesProperty.Edit: Boolean;
+begin
+ with TfrxAliasesEditorForm.Create(Application) do
+ begin
+ DataSet := TfrxCustomDataSet(Component);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ Self.Designer.UpdateDataTree;
+ Free;
+ end;
+end;
+
+function TfrxFieldAliasesProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog, paReadOnly];
+end;
+
+
+{ TfrxDataSetProperty }
+
+function TfrxDataSetProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList];
+end;
+
+function TfrxDataSetProperty.GetValue: String;
+var
+ ds: TfrxDataSet;
+begin
+ ds := TfrxDataSet(GetOrdValue);
+ if ds <> nil then
+ Result := frComponent.Report.GetAlias(ds) else
+ Result := frxResources.Get('prNotAssigned');
+end;
+
+procedure TfrxDataSetProperty.GetValues;
+var
+ i: Integer;
+begin
+ frComponent.Report.GetDataSetList(Values, True);
+ if Component is TfrxDataSet then
+ begin
+ i := Values.IndexOf(TfrxDataSet(Component).UserName);
+ if i <> -1 then
+ Values.Delete(i);
+ end;
+end;
+
+procedure TfrxDataSetProperty.SetValue(const AValue: String);
+var
+ ds: TfrxDataSet;
+begin
+ if AValue = '' then
+ SetOrdValue(0)
+ else
+ begin
+ ds := frComponent.Report.GetDataSet(AValue);
+ if ds <> nil then
+ SetOrdValue(frxInteger(ds)) else
+ raise Exception.Create(frxResources.Get('prInvProp'));
+ end;
+end;
+
+
+{ TfrxDataFieldProperty }
+
+function TfrxDataFieldProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList];
+end;
+
+function TfrxDataFieldProperty.GetValue: String;
+begin
+ Result := GetStrValue;
+end;
+
+procedure TfrxDataFieldProperty.SetValue(const AValue: String);
+begin
+ SetStrValue(AValue);
+end;
+
+procedure TfrxDataFieldProperty.GetValues;
+var
+ ds: TfrxDataSet;
+begin
+ inherited;
+ ds := TfrxDBLookupComboBox(Component).DataSet;
+ if ds <> nil then
+ ds.GetFieldList(Values);
+end;
+
+
+{ TfrxMasterFieldsProperty }
+
+function TfrxMasterFieldsProperty.Edit: Boolean;
+var
+ ds: TfrxCustomDataSet;
+begin
+ Result := False;
+ ds := TfrxCustomDataSet(Component);
+ if ds.Master <> nil then
+ with TfrxMDEditorForm.Create(Application) do
+ begin
+ DataSet := ds;
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ Free;
+ end;
+end;
+
+function TfrxMasterFieldsProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog, paReadOnly];
+end;
+
+
+{ TfrxSQLProperty }
+
+function TfrxSQLProperty.Edit: Boolean;
+begin
+ with TfrxSQLEditorForm.Create(Designer) do
+ begin
+ Query := TfrxCustomQuery(Component);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ Self.Designer.UpdateDataTree;
+ Free;
+ end;
+end;
+
+function TfrxSQLProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog, paReadOnly];
+end;
+
+
+{ TfrxParamsProperty }
+
+function TfrxParamsProperty.Edit: Boolean;
+var
+ q: TfrxCustomQuery;
+begin
+ Result := False;
+ q := TfrxCustomQuery(Component);
+ if q.Params.Count <> 0 then
+ with TfrxParamsEditorForm.Create(Designer) do
+ begin
+ Params := q.Params;
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ begin
+ q.UpdateParams;
+ Self.Designer.UpdateDataTree;
+ end;
+ Free;
+ end;
+end;
+
+function TfrxParamsProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog, paReadOnly];
+end;
+
+
+initialization
+ frxComponentEditors.Register(TfrxCustomDatabase, TfrxCustomDatabaseEditor);
+ frxComponentEditors.Register(TfrxCustomDataSet, TfrxCustomDataSetEditor);
+ frxComponentEditors.Register(TfrxCustomQuery, TfrxCustomQueryEditor);
+ frxPropertyEditors.Register(TypeInfo(TStrings), TfrxCustomDataSet, 'FieldAliases',
+ TfrxFieldAliasesProperty);
+ frxPropertyEditors.Register(TypeInfo(TfrxCustomDBDataSet), TfrxCustomDataSet,
+ 'Master', TfrxDataSetProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxCustomDataSet, 'MasterFields',
+ TfrxMasterFieldsProperty);
+ frxPropertyEditors.Register(TypeInfo(TStrings), TfrxCustomQuery, 'SQL',
+ TfrxSQLProperty);
+ frxPropertyEditors.Register(TypeInfo(TfrxParams), TfrxCustomQuery, 'Params',
+ TfrxParamsProperty);
+
+ frxPropertyEditors.Register(TypeInfo(TfrxDBDataSet), TfrxDBLookupComboBox,
+ 'DataSet', TfrxDataSetProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxDBLookupComboBox,
+ 'KeyField', TfrxDataFieldProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxDBLookupComboBox,
+ 'ListField', TfrxDataFieldProperty);
+
+ frxHideProperties(TfrxCustomDataset, 'DataSet;DataSource;Enabled;OpenDataSource;Tag');
+ frxHideProperties(TfrxCustomQuery, 'SQLSchema');
+ frxHideProperties(TfrxDBLookupComboBox, 'DataSetName');
+
+end.
diff --git a/LibD28x64/FMX.frxCustomDBRTTI.pas b/LibD28x64/FMX.frxCustomDBRTTI.pas
new file mode 100644
index 0000000..23f2891
--- /dev/null
+++ b/LibD28x64/FMX.frxCustomDBRTTI.pas
@@ -0,0 +1,182 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ DB components RTTI }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCustomDBRTTI;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, System.SysUtils, System.Types, FMX.Forms, Data.DB, FMX.fs_iinterpreter, FMX.frxClass, FMX.frxCustomDB,
+ FMX.frxDBSet, FMX.fs_idbrtti
+, System.Variants;
+
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ with AddClass(TfrxDBDataset, 'TfrxCustomDBDataSet') do
+ begin
+ AddMethod('function Locate(const KeyFields: string; const KeyValues: Variant;' +
+ 'Options: TLocateOptions): Boolean', CallMethod);
+ AddMethod('function IsEmpty: Boolean', CallMethod);
+ AddMethod('function RecordCount: Integer', CallMethod);
+ end;
+ AddClass(TfrxCustomDatabase, 'TfrxComponent');
+ with AddClass(TfrxCustomDataset, 'TfrxDBDataSet') do
+ begin
+ AddMethod('procedure Last', CallMethod);
+ AddMethod('function FieldByName(Name: String): TField', CallMethod);
+ AddProperty('DataSet', 'TDataSet', GetProp, nil);
+ AddProperty('Active', 'Boolean', GetProp, SetProp);
+ AddProperty('Fields', 'TFields', GetProp, nil);
+ end;
+ AddClass(TfrxCustomTable, 'TfrxCustomDataset');
+ with AddClass(TfrxParamItem, 'TCollectionItem') do
+ AddProperty('Value', 'Variant', GetProp, SetProp);
+ with AddClass(TfrxParams, 'TCollection') do
+ begin
+ AddMethod('function IndexOf(Name: String): Integer', CallMethod);
+ AddDefaultProperty('Items', 'Integer', 'TfrxParamItem', CallMethod, True);
+ end;
+ with AddClass(TfrxCustomQuery, 'TfrxCustomDataset') do
+ AddMethod('function ParamByName(Name: string): TfrxParamItem', CallMethod);
+ with AddClass(TfrxDBLookupComboBox, 'TfrxDialogControl') do
+ begin
+ AddProperty('KeyValue', 'Variant', GetProp, SetProp);
+ AddProperty('Text', 'String', GetProp, nil);
+ end;
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+
+ function IntToLocateOptions(i: Integer): TLocateOptions;
+ begin
+ Result := [];
+ if (i and 1) <> 0 then
+ Result := Result + [loCaseInsensitive];
+ if (i and 2) <> 0 then
+ Result := Result + [loPartialKey];
+ end;
+
+begin
+ Result := 0;
+
+ if ClassType = TfrxParams then
+ begin
+ if MethodName = 'INDEXOF' then
+ Result := TfrxParams(Instance).IndexOf(Caller.Params[0])
+ else if MethodName = 'ITEMS.GET' then
+ Result := frxInteger(TfrxParams(Instance).Items[Caller.Params[0]])
+ end
+ else if ClassType = TfrxDBDataset then
+ begin
+ if MethodName = 'LOCATE' then
+ Result := TfrxDBDataSet(Instance).GetDataSet.Locate(Caller.Params[0], Caller.Params[1], IntToLocateOptions(Caller.Params[2]))
+ else if MethodName = 'ISEMPTY' then
+ Result := TfrxDBDataSet(Instance).GetDataSet.IsEmpty
+ else if MethodName = 'RECORDCOUNT' then
+ Result := TfrxDBDataSet(Instance).GetDataSet.RecordCount
+ end
+ else if ClassType = TfrxCustomDataSet then
+ begin
+ if MethodName = 'LAST' then
+ TfrxCustomDataSet(Instance).GetDataSet.Last
+ else if MethodName = 'FIELDBYNAME' then
+ Result := frxInteger(TfrxCustomDataset(Instance).GetDataSet.FieldByName(Caller.Params[0]))
+ end
+ else if ClassType = TfrxCustomQuery then
+ begin
+ if MethodName = 'PARAMBYNAME' then
+ Result := frxInteger(TfrxCustomQuery(Instance).ParamByName(Caller.Params[0]))
+ end
+end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TfrxCustomDataset then
+ begin
+ if PropName = 'DATASET' then
+ Result := frxInteger(TfrxCustomDataset(Instance).DataSet)
+ else if PropName = 'ACTIVE' then
+ Result := TfrxCustomDataset(Instance).Active
+ else if PropName = 'FIELDS' then
+ Result := frxInteger(TfrxCustomDataset(Instance).Fields)
+ end
+ else if ClassType = TfrxParamItem then
+ begin
+ if PropName = 'VALUE' then
+ Result := TfrxParamItem(Instance).Value
+ end
+ else if ClassType = TfrxDBLookupComboBox then
+ begin
+ if PropName = 'KEYVALUE' then
+ Result := TfrxDBLookupComboBox(Instance).KeyValue
+ else if PropName = 'TEXT' then
+ Result := TfrxDBLookupComboBox(Instance).Text
+ end
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TfrxCustomDataset then
+ begin
+ if PropName = 'ACTIVE' then
+ TfrxCustomDataset(Instance).Active := Value;
+ end
+ else if ClassType = TfrxParamItem then
+ begin
+ if PropName = 'VALUE' then
+ TfrxParamItem(Instance).Value := Value
+ end
+ else if ClassType = TfrxDBLookupComboBox then
+ begin
+ if PropName = 'KEYVALUE' then
+ TfrxDBLookupComboBox(Instance).KeyValue := Value
+ end
+end;
+
+
+initialization
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28x64/FMX.frxCustomEditors.pas b/LibD28x64/FMX.frxCustomEditors.pas
new file mode 100644
index 0000000..db73432
--- /dev/null
+++ b/LibD28x64/FMX.frxCustomEditors.pas
@@ -0,0 +1,174 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Property editors for Designer }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxCustomEditors;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.Classes, System.SysUtils, System.UITypes, System.Types, FMX.Types, FMX.Controls, FMX.Forms, FMX.Menus,
+ FMX.Dialogs, FMX.frxClass, FMX.frxDMPClass, FMX.frxDsgnIntf
+, System.Variants;
+
+
+type
+ TfrxViewEditor = class(TfrxComponentEditor)
+ public
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxCustomMemoEditor = class(TfrxViewEditor)
+ public
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+
+implementation
+
+uses FMX.frxEditMemo, FMX.frxEditFormat, FMX.frxRes;
+
+
+{ TfrxViewEditor }
+
+function TfrxViewEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ i: Integer;
+ c: TfrxComponent;
+ v: TfrxView;
+begin
+ Result := False;
+ for i := 0 to Designer.SelectedObjects.Count - 1 do
+ begin
+ c := Designer.SelectedObjects[i];
+ if (c is TfrxView) and not (rfDontModify in c.Restrictions) and (Tag in [50..53]) then
+ begin
+ v := TfrxView(c);
+ case Tag of
+ 50: if Checked then
+ v.ShiftMode := smAlways else
+ v.ShiftMode := smDontShift;
+ 51: if Checked then
+ v.ShiftMode := smWhenOverlapped else
+ v.ShiftMode := smDontShift;
+ 52: v.Visible := Checked;
+ 53: v.Printable := Checked;
+ end;
+
+ Result := True;
+ end;
+ end;
+end;
+
+procedure TfrxViewEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ v: TfrxView;
+begin
+ inherited;
+ v := TfrxView(Component);
+
+ AddItem(frxResources.Get('mvShift'), 50, v.ShiftMode = smAlways);
+ AddItem(frxResources.Get('mvShiftOver'), 51, v.ShiftMode = smWhenOverlapped);
+ AddItem(frxResources.Get('mvVisible'), 52, v.Visible);
+ AddItem(frxResources.Get('mvPrintable'), 53, v.Printable);
+end;
+
+
+{ TfrxCustomMemoEditor }
+
+function TfrxCustomMemoEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ i: Integer;
+ c: TfrxComponent;
+ m: TfrxCustomMemoView;
+ DisplayFormat: TfrxFormat;
+
+ function EditFormat: Boolean;
+ begin
+ with TfrxFormatEditorForm.Create(Designer) do
+ begin
+ Format.Assign(TfrxCustomMemoView(Component).DisplayFormat);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ DisplayFormat.Assign(Format);
+ Free;
+ end;
+ end;
+
+begin
+ Result := inherited Execute(Tag, Checked);
+
+ DisplayFormat := TfrxFormat.Create;
+ try
+ if Tag = 1 then
+ if not EditFormat then Exit;
+
+ for i := 0 to Designer.SelectedObjects.Count - 1 do
+ begin
+ c := Designer.SelectedObjects[i];
+ if (c is TfrxCustomMemoView) and not (rfDontModify in c.Restrictions) then
+ begin
+ m := TfrxCustomMemoView(c);
+ case Tag of
+ 1: m.DisplayFormat := DisplayFormat;
+ 2: m.Memo.Clear;
+ 3: m.AutoWidth := Checked;
+ 4: m.WordWrap := Checked;
+ 5: m.SuppressRepeated := Checked;
+ 6: m.HideZeros := Checked;
+ 7: m.AllowExpressions := Checked;
+ 8: m.AllowHTMLTags := Checked;
+ 40: if Checked then
+ m.StretchMode := smActualHeight else
+ m.StretchMode := smDontStretch;
+ 41: if Checked then
+ m.StretchMode := smMaxHeight else
+ m.StretchMode := smDontStretch;
+ end;
+
+ Result := True;
+ end;
+ end;
+ finally
+ DisplayFormat.Free;
+ end;
+end;
+
+procedure TfrxCustomMemoEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ m: TfrxCustomMemoView;
+begin
+ inherited;
+ m := TfrxCustomMemoView(Component);
+
+ AddItem(frxResources.Get('mvFormat'), 1);
+ AddItem(frxResources.Get('mvClear'), 2);
+ AddItem('-', -1);
+ AddItem(frxResources.Get('mvAutoWidth'), 3, m.AutoWidth);
+ AddItem(frxResources.Get('mvWWrap'), 4, m.WordWrap);
+ AddItem(frxResources.Get('mvSuppress'), 5, m.SuppressRepeated);
+ AddItem(frxResources.Get('mvHideZ'), 6, m.HideZeros);
+ AddItem(frxResources.Get('mvExpr'), 7, m.AllowExpressions);
+ if not (m is TfrxDMPMemoView) then
+ AddItem(frxResources.Get('mvHTML'), 8, m.AllowHTMLTags);
+ AddItem('-', -1);
+ AddItem(frxResources.Get('mvStretch'), 40, m.StretchMode = smActualHeight);
+ AddItem(frxResources.Get('mvStretchToMax'), 41, m.StretchMode = smMaxHeight);
+
+end;
+
+
+end.
diff --git a/LibD28x64/FMX.frxDBSet.pas b/LibD28x64/FMX.frxDBSet.pas
new file mode 100644
index 0000000..5037ab1
--- /dev/null
+++ b/LibD28x64/FMX.frxDBSet.pas
@@ -0,0 +1,473 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ DB dataset }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDBSet;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.frxClass, Data.DB, System.Variants, System.WideStrings;
+
+
+type
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxDBDataset = class(TfrxCustomDBDataset)
+ private
+ FBookmark: TBookmark;
+ FDataSet: TDataSet;
+ FDataSource: TDataSource;
+ FDS: TDataSet;
+ FEof: Boolean;
+ FBCDToCurrency: Boolean;
+ FSaveOpenEvent: TDatasetNotifyEvent;
+ FSaveCloseEvent: TDatasetNotifyEvent;
+ procedure BeforeClose(Sender: TDataSet);
+ procedure AfterOpen(Sender: TDataset);
+ procedure SetDataSet(Value: TDataSet);
+ procedure SetDataSource(Value: TDataSource);
+ function DataSetActive: Boolean;
+ function IsDataSetStored: Boolean;
+ protected
+ function GetDisplayText(Index: String): WideString; override;
+ function GetDisplayWidth(Index: String): Integer; override;
+ function GetFieldType(Index: String): TfrxFieldType; override;
+ function GetValue(Index: String): Variant; override;
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ public
+ procedure Initialize; override;
+ procedure Finalize; override;
+ procedure First; override;
+ procedure Next; override;
+ procedure Prior; override;
+ procedure Open; override;
+ procedure Close; override;
+ function Eof: Boolean; override;
+
+ function GetDataSet: TDataSet;
+ function IsBlobField(const fName: String): Boolean; override;
+ function RecordCount: Integer; override;
+ procedure AssignBlobTo(const fName: String; Obj: TObject); override;
+ procedure GetFieldList(List: TStrings); override;
+ published
+ property DataSet: TDataSet read FDataSet write SetDataSet stored IsDataSetStored;
+ property DataSource: TDataSource read FDataSource write SetDataSource stored IsDataSetStored;
+ property BCDToCurrency: Boolean read FBCDToCurrency write FBCDToCurrency;
+ end;
+
+
+implementation
+
+uses FMX.frxUtils, FMX.frxRes, FMX.frxUnicodeUtils;
+
+type
+ EDSError = class(Exception);
+
+
+{ TfrxDBDataset }
+
+procedure TfrxDBDataset.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if Operation = opRemove then
+ if AComponent = FDataSource then
+ DataSource := nil
+ else if AComponent = FDataSet then
+ DataSet := nil
+end;
+
+procedure TfrxDBDataset.SetDataSet(Value: TDataSet);
+begin
+ FDataSet := Value;
+ if Value <> nil then
+ FDataSource := nil;
+ FDS := GetDataSet;
+end;
+
+procedure TfrxDBDataset.SetDataSource(Value: TDataSource);
+begin
+ FDataSource := Value;
+ if Value <> nil then
+ FDataSet := nil;
+ FDS := GetDataSet;
+end;
+
+function TfrxDBDataset.DataSetActive: Boolean;
+begin
+ Result := (FDS <> nil) and FDS.Active;
+end;
+
+function TfrxDBDataset.GetDataset: TDataSet;
+begin
+ if FDataSet <> nil then
+ Result := FDataSet
+ else if (FDataSource <> nil) and (FDataSource.DataSet <> nil) then
+ Result := FDataSource.DataSet
+ else
+ Result := nil;
+end;
+
+function TfrxDBDataset.IsDataSetStored: Boolean;
+begin
+ Result := Report = nil;
+end;
+
+procedure TfrxDBDataset.Initialize;
+begin
+ FDS := GetDataSet;
+ if FDS = nil then
+ raise Exception.Create(Format(frxResources.Get('dbNotConn'), [Name]));
+
+ FSaveOpenEvent := FDS.AfterOpen;
+ FDS.AfterOpen := AfterOpen;
+ FSaveCloseEvent := FDS.BeforeClose;
+ FDS.BeforeClose := BeforeClose;
+ FEof := False;
+ FInitialized := False;
+end;
+
+procedure TfrxDBDataset.Finalize;
+begin
+ if FDS = nil then Exit;
+ if FBookMark <> nil then
+ begin
+ FDS.GotoBookmark(FBookmark);
+ FDS.FreeBookmark(FBookmark);
+ end;
+ FBookMark := nil;
+
+ if CloseDataSource then
+ Close;
+ FDS.AfterOpen := FSaveOpenEvent;
+ FDS.BeforeClose := FSaveCloseEvent;
+ FSaveOpenEvent := nil;
+ FSaveCloseEvent := nil;
+ FInitialized := False;
+end;
+
+procedure TfrxDBDataSet.Open;
+begin
+ if FInitialized then
+ Exit;
+
+ FInitialized := True;
+ FDS.Open;
+ AfterOpen(nil);
+ if (RangeBegin = rbCurrent) or (RangeEnd = reCurrent) then
+ FBookmark := FDS.GetBookmark else
+ FBookmark := nil;
+
+ inherited;
+end;
+
+procedure TfrxDBDataSet.Close;
+begin
+ inherited;
+ BeforeClose(nil);
+ FDS.Close;
+end;
+
+procedure TfrxDBDataset.AfterOpen(Sender: TDataset);
+var
+ i: Integer;
+begin
+ GetFieldList(Fields);
+ for i := 0 to Fields.Count - 1 do
+ Fields.Objects[i] := FDS.FindField(ConvertAlias(Fields[i]));
+
+ if Assigned(FSaveOpenEvent) and (Sender <> nil) then
+ FSaveOpenEvent(Sender);
+end;
+
+procedure TfrxDBDataset.BeforeClose(Sender: TDataSet);
+begin
+ if Assigned(FSaveCloseEvent) and (Sender <> nil) then
+ FSaveCloseEvent(Sender);
+
+ if FBookMark <> nil then
+ FDS.FreeBookmark(FBookmark);
+ FBookMark := nil;
+
+ FInitialized := False;
+end;
+
+procedure TfrxDBDataSet.First;
+begin
+ if not FInitialized then
+ Open;
+ if RangeBegin = rbFirst then
+ FDS.First else
+ FDS.GotoBookmark(FBookmark);
+ FEof := False;
+ inherited First;
+end;
+
+procedure TfrxDBDataSet.Next;
+var
+ b: TBookmark;
+begin
+ if not FInitialized then
+ Open;
+ FEof := False;
+ if RangeEnd = reCurrent then
+ begin
+ b := FDS.GetBookmark;
+ if FDS.CompareBookmarks(b, FBookmark) = 0 then
+ FEof := True;
+ FDS.FreeBookmark(b);
+ if FEof then
+ Exit;
+ end;
+ FDS.Next;
+ inherited Next;
+end;
+
+procedure TfrxDBDataSet.Prior;
+begin
+ if not FInitialized then
+ Open;
+ FDS.Prior;
+ inherited Prior;
+end;
+
+function TfrxDBDataSet.Eof: Boolean;
+begin
+ if not FInitialized then
+ Open;
+ Result := inherited Eof or FDS.Eof or FEof;
+end;
+
+function TfrxDBDataset.GetDisplayText(Index: String): WideString;
+var
+ i: Integer;
+ s: WideString;
+begin
+ s := '';
+ if not FInitialized then
+ Open;
+ if DataSetActive then
+ if Fields.Count = 0 then
+ s := FDS.FieldByName(Index).DisplayText
+ else
+ begin
+ i := Fields.IndexOf(Index);
+ if i <> -1 then
+ begin
+ if TField(Fields.Objects[i]) is TWideStringField then
+ s := VarToWideStr(TField(Fields.Objects[i]).Value)
+ else
+ s := TField(Fields.Objects[i]).DisplayText;
+ end
+ else
+ begin
+ s := frxResources.Get('dbFldNotFound') + ' ' + UserName + '."' +
+ Index + '"';
+ ReportRef.Errors.Add(ReportRef.CurObject + ': ' + s);
+ end;
+ end
+ else
+ s := UserName + '."' + Index + '"';
+ Result := s;
+end;
+
+function TfrxDBDataset.GetValue(Index: String): Variant;
+var
+ i: Integer;
+ v: Variant;
+begin
+ if not FInitialized then
+ Open;
+ i := Fields.IndexOf(Index);
+ if i <> -1 then
+ begin
+ if TField(Fields.Objects[i]) is TFMTBCDField then
+ begin
+ if TField(Fields.Objects[i]).IsNull then
+ v := Null
+ else if BCDToCurrency then
+ v := TField(Fields.Objects[i]).AsCurrency
+ else
+ v := TField(Fields.Objects[i]).AsFloat
+ end
+ else
+ if TField(Fields.Objects[i]) is TLargeIntField then
+ begin
+ { TLargeIntField.AsVariant converts value to vt_decimal variant type
+ which is not supported by Delphi }
+ if TField(Fields.Objects[i]).IsNull then
+ v := Null
+ else
+ v := TLargeIntField(Fields.Objects[i]).AsLargeInt
+ end
+ else if TField(Fields.Objects[i]) is TSQLTimeStampField then
+ begin
+ if TField(Fields.Objects[i]).IsNull then
+ v := Null
+ else
+ v := TSQLTimeStampField(Fields.Objects[i]).AsDateTime;
+ end
+ else
+ if Fields.Objects[i] is TBlobField then
+ begin
+ if (TBlobField(Fields.Objects[i]).BlobType
+ in [ftWideString, ftWideMemo, ftFixedWideChar]) then
+ v := TField(Fields.Objects[i]).AsWideString
+ else v := TField(Fields.Objects[i]).AsString
+ end
+ else
+ v := TField(Fields.Objects[i]).Value
+ end
+ else
+ begin
+ v := Null;
+ ReportRef.Errors.Add(ReportRef.CurObject + ': ' +
+ frxResources.Get('dbFldNotFound') + ' ' + UserName + '."' + Index + '"');
+ end;
+ Result := v;
+end;
+
+function TfrxDBDataset.GetDisplayWidth(Index: String): Integer;
+var
+ f: TField;
+ fDef: TFieldDef;
+begin
+ Result := 10;
+ Index := ConvertAlias(Index);
+ f := FDS.FindField(Index);
+ if f <> nil then
+ Result := f.DisplayWidth
+ else
+ begin
+ try
+ if not FDS.FieldDefs.Updated then
+ FDS.FieldDefs.Update;
+ except
+ end;
+ fDef := FDS.FieldDefs.Find(Index);
+ if fDef <> nil then
+ case fDef.DataType of
+ ftString, ftWideString: Result := fDef.Size;
+ ftLargeInt: Result := 15;
+ ftDateTime: Result := 20;
+ end;
+ end;
+end;
+
+function TfrxDBDataset.GetFieldType(Index: String): TfrxFieldType;
+var
+ f: TField;
+begin
+ Result := fftNumeric;
+ f := FDS.FindField(ConvertAlias(Index));
+ if f <> nil then
+ case f.DataType of
+ ftString, ftWideString, ftMemo:
+ Result := fftString;
+ ftBoolean:
+ Result := fftBoolean;
+ end;
+end;
+
+procedure TfrxDBDataset.AssignBlobTo(const fName: String; Obj: TObject);
+var
+ Field: TField;
+ BlobStream: TStream;
+ sl: TStringList;
+begin
+ if not FInitialized then
+ Open;
+ Field := TField(Fields.Objects[Fields.IndexOf(fName)]);
+ if (Field <> nil) and Field.IsBlob then
+// if Field is TBlobField then
+ begin
+ if Obj is TfrxWideStrings then
+ begin
+ BlobStream := TMemoryStream.Create;
+ sl := TStringList.Create;
+ try
+ TBlobField(Field).SaveToStream(BlobStream);
+ BlobStream.Position := 0;
+ if Field is TWideMemoField then
+ TfrxWideStrings(Obj).LoadFromWStream(BlobStream)
+ else if Field is TMemoField then
+ TfrxWideStrings(Obj).Text := Field.AsWideString;
+ finally
+ BlobStream.Free;
+ sl.Free;
+ end;
+ end
+ else if Obj is TStream then
+ begin
+ if (Field is TWideMemoField) and (Obj is TStringStream) then
+ TStringStream(Obj).WriteString(TWideMemoField(Field).AsWideString)
+ else
+ TBlobField(Field).SaveToStream(TStream(Obj));
+ TStream(Obj).Position := 0;
+ end;
+ end;
+end;
+
+procedure TfrxDBDataset.GetFieldList(List: TStrings);
+var
+ i: Integer;
+begin
+ List.Clear;
+ if FieldAliases.Count = 0 then
+ begin
+ try
+ if FDS <> nil then
+ begin
+ FDS.GetFieldNames(List);
+ List.BeginUpdate;
+ for i := 0 to FDS.AggFields.Count - 1 do
+ List.Add(FDS.AggFields[i].FieldName);
+ List.EndUpdate;
+ end;
+ except
+ end;
+ end
+ else
+ begin
+ for i := 0 to FieldAliases.Count - 1 do
+ if Pos('-', FieldAliases.Names[i]) <> 1 then
+ List.Add(FieldAliases.Values[FieldAliases.Names[i]]);
+ end;
+end;
+
+function TfrxDBDataset.IsBlobField(const fName: String): Boolean;
+var
+ Field: TField;
+ i: Integer;
+begin
+ if not FInitialized then
+ Open;
+ Result := False;
+ i := Fields.IndexOf(fName);
+ if i <> -1 then
+ begin
+ Field := TField(Fields.Objects[i]);
+ Result := (Field <> nil) and Field.IsBlob;
+ end;
+end;
+
+function TfrxDBDataset.RecordCount: Integer;
+begin
+ if not FInitialized then
+ Open;
+ Result := FDS.RecordCount;
+end;
+
+end.
+
diff --git a/LibD28x64/FMX.frxDBXComponents.pas b/LibD28x64/FMX.frxDBXComponents.pas
new file mode 100644
index 0000000..32a8c13
--- /dev/null
+++ b/LibD28x64/FMX.frxDBXComponents.pas
@@ -0,0 +1,654 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ DBX enduser components }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDBXComponents;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.Classes, FMX.frxClass, FMX.frxCustomDB, Data.DB, Data.DBCommonTypes,
+ Data.SqlExpr, Datasnap.Provider, Datasnap.DBClient, System.Variants, FMX.Types
+{$IFDEF QBUILDER}
+, FMX.fqbClass
+{$ENDIF};
+
+
+type
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxDBXDataset = class(TCustomClientDataset)
+ private
+ FDataSet: TDataSet;
+ FProvider: TDataSetProvider;
+ procedure SetDataset(const Value: TDataset);
+ protected
+ procedure OpenCursor(InfoQuery: Boolean); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ property Dataset: TDataset read FDataset write SetDataset;
+ end;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxDBXComponents = class(TfrxDBComponents)
+ private
+ FDefaultDatabase: TSQLConnection;
+ FOldComponents: TfrxDBXComponents;
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetDefaultDatabase(Value: TSQLConnection);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function GetDescription: String; override;
+ published
+ property DefaultDatabase: TSQLConnection read FDefaultDatabase write SetDefaultDatabase;
+ end;
+
+ TfrxDBXDatabase = class(TfrxCustomDatabase)
+ private
+ FDatabase: TSQLConnection;
+ FStrings: TStrings;
+ FLock: Boolean;
+ function GetDriverName: String;
+ function GetGetDriverFunc: String;
+ function GetLibraryName: String;
+ function GetVendorLib: String;
+ procedure SetDriverName(const Value: String);
+ procedure SetGetDriverFunc(const Value: String);
+ procedure SetLibraryName(const Value: String);
+ procedure SetVendorLib(const Value: String);
+ procedure OnChange(Sender: TObject);
+ protected
+ procedure SetConnected(Value: Boolean); override;
+ procedure SetDatabaseName(const Value: String); override;
+ procedure SetLoginPrompt(Value: Boolean); override;
+ procedure SetParams(Value: TStrings); override;
+ function GetConnected: Boolean; override;
+ function GetDatabaseName: String; override;
+ function GetLoginPrompt: Boolean; override;
+ function GetParams: TStrings; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ property Database: TSQLConnection read FDatabase;
+ published
+ property ConnectionName: String read GetDatabaseName write SetDatabaseName;
+ property DriverName: String read GetDriverName write SetDriverName;
+ property GetDriverFunc: String read GetGetDriverFunc write SetGetDriverFunc;
+ property LibraryName: String read GetLibraryName write SetLibraryName;
+ property LoginPrompt;
+ property Params;
+ property VendorLib: String read GetVendorLib write SetVendorLib;
+ property Connected;
+ end;
+
+ TfrxDBXTable = class(TfrxCustomTable)
+ private
+ FDatabase: TfrxDBXDatabase;
+ FTable: TSQLTable;
+ procedure SetDatabase(const Value: TfrxDBXDatabase);
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetMaster(const Value: TDataSource); override;
+ procedure SetMasterFields(const Value: String); override;
+ procedure SetIndexName(const Value: String); override;
+ procedure SetIndexFieldNames(const Value: String); override;
+ procedure SetTableName(const Value: String); override;
+ function GetIndexName: String; override;
+ function GetIndexFieldNames: String; override;
+ function GetTableName: String; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor DesignCreate(AOwner: TComponent; Flags: Word); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ procedure BeforeStartReport; override;
+ property Table: TSQLTable read FTable;
+ published
+ property Database: TfrxDBXDatabase read FDatabase write SetDatabase;
+ end;
+
+ TfrxDBXQuery = class(TfrxCustomQuery)
+ private
+ FDatabase: TfrxDBXDatabase;
+ FQuery: TSQLQuery;
+ FStrings: TStrings;
+ FLock: Boolean;
+ procedure SetDatabase(const Value: TfrxDBXDatabase);
+ protected
+ procedure Notification(AComponent: TComponent; Operation: TOperation); override;
+ procedure SetMaster(const Value: TDataSource); override;
+ procedure SetSQL(Value: TStrings); override;
+ function GetSQL: TStrings; override;
+ procedure OnChangeSQL(Sender: TObject); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ constructor DesignCreate(AOwner: TComponent; Flags: Word); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ procedure BeforeStartReport; override;
+ procedure UpdateParams; override;
+{$IFDEF QBUILDER}
+ function QBEngine: TfqbEngine; override;
+{$ENDIF}
+ property Query: TSQLQuery read FQuery;
+ published
+ property Database: TfrxDBXDatabase read FDatabase write SetDatabase;
+ end;
+
+{$IFDEF QBUILDER}
+ TfrxEngineDBX = class(TfqbEngine)
+ private
+ FQuery: TSQLQuery;
+ FDBXDataset: TfrxDBXDataset;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure ReadTableList(ATableList: TStrings); override;
+ procedure ReadFieldList(const ATableName: string; var AFieldList: TfqbFieldList); override;
+ function ResultDataSet: TDataSet; override;
+ procedure SetSQL(const Value: string); override;
+ end;
+{$ENDIF}
+
+var
+ DBXComponents: TfrxDBXComponents;
+
+
+implementation
+
+uses
+ FMX.frxDBXRTTI,
+{$IFNDEF NO_EDITORS}
+ FMX.frxDBXEditor,
+{$ENDIF}
+ FMX.frxDsgnIntf, FMX.frxRes;
+
+type
+ THackSQLConnection = class(TSQLConnection);
+
+
+{ TfrxDBXDataset }
+
+constructor TfrxDBXDataset.Create(AOwner: TComponent);
+begin
+ inherited;
+ FProvider := TDatasetProvider.Create(nil);
+end;
+
+destructor TfrxDBXDataset.Destroy;
+begin
+ FProvider.Free;
+ inherited;
+end;
+
+procedure TfrxDBXDataset.OpenCursor(InfoQuery: Boolean);
+begin
+ SetProvider(FProvider);
+ inherited;
+end;
+
+procedure TfrxDBXDataset.SetDataset(const Value: TDataset);
+begin
+ FDataset := Value;
+ FProvider.Dataset := FDataset;
+end;
+
+
+{ TfrxDBXComponents }
+
+constructor TfrxDBXComponents.Create(AOwner: TComponent);
+begin
+ inherited;
+ FOldComponents := DBXComponents;
+ DBXComponents := Self;
+end;
+
+destructor TfrxDBXComponents.Destroy;
+begin
+ if DBXComponents = Self then
+ DBXComponents := FOldComponents;
+ inherited;
+end;
+
+function TfrxDBXComponents.GetDescription: String;
+begin
+ Result := 'DBX';
+end;
+
+procedure TfrxDBXComponents.Notification(AComponent: TComponent;
+ Operation: TOperation);
+begin
+ inherited;
+ if (AComponent = FDefaultDatabase) and (Operation = opRemove) then
+ FDefaultDatabase := nil;
+end;
+
+procedure TfrxDBXComponents.SetDefaultDatabase(Value: TSQLConnection);
+begin
+ if (Value <> nil) then
+ Value.FreeNotification(Self);
+
+ if FDefaultDatabase <> nil then
+ FDefaultDatabase.RemoveFreeNotification(Self);
+
+ FDefaultDatabase := Value;
+end;
+
+
+{ TfrxDBXDatabase }
+
+constructor TfrxDBXDatabase.Create(AOwner: TComponent);
+begin
+ inherited;
+ FStrings := TStringList.Create;
+ TStringList(FStrings).OnChange := OnChange;
+ FDatabase := TSQLConnection.Create(nil);
+// set ComponentState := csDesigning to obtain Params automatically
+ THackSQLConnection(FDataBase).SetDesigning(True, False);
+ Component := FDatabase;
+end;
+
+destructor TfrxDBXDatabase.Destroy;
+begin
+ FStrings.Free;
+ inherited;
+end;
+
+class function TfrxDBXDatabase.GetDescription: String;
+begin
+ Result := frxResources.Get('obDBXDB');
+end;
+
+function TfrxDBXDatabase.GetConnected: Boolean;
+begin
+ Result := FDatabase.Connected;
+end;
+
+function TfrxDBXDatabase.GetDatabaseName: String;
+begin
+ Result := FDatabase.ConnectionName;
+end;
+
+function TfrxDBXDatabase.GetDriverName: String;
+begin
+ Result := FDatabase.DriverName;
+end;
+
+function TfrxDBXDatabase.GetGetDriverFunc: String;
+begin
+ Result := FDatabase.GetDriverFunc;
+end;
+
+function TfrxDBXDatabase.GetLibraryName: String;
+begin
+ Result := FDatabase.LibraryName;
+end;
+
+function TfrxDBXDatabase.GetLoginPrompt: Boolean;
+begin
+ Result := FDatabase.LoginPrompt;
+end;
+
+function TfrxDBXDatabase.GetParams: TStrings;
+begin
+ FLock := True;
+ FStrings.Assign(FDatabase.Params);
+ FLock := False;
+ Result := FStrings;
+end;
+
+function TfrxDBXDatabase.GetVendorLib: String;
+begin
+ Result := FDatabase.VendorLib;
+end;
+
+procedure TfrxDBXDatabase.SetConnected(Value: Boolean);
+begin
+ BeforeConnect(Value);
+ FDatabase.Connected := Value;
+end;
+
+procedure TfrxDBXDatabase.SetDatabaseName(const Value: String);
+begin
+ FDatabase.ConnectionName := Value;
+end;
+
+procedure TfrxDBXDatabase.SetDriverName(const Value: String);
+begin
+ FDatabase.DriverName := Value;
+end;
+
+procedure TfrxDBXDatabase.SetGetDriverFunc(const Value: String);
+begin
+ FDatabase.GetDriverFunc := Value;
+end;
+
+procedure TfrxDBXDatabase.SetLibraryName(const Value: String);
+begin
+ FDatabase.LibraryName := Value;
+end;
+
+procedure TfrxDBXDatabase.SetLoginPrompt(Value: Boolean);
+begin
+ FDatabase.LoginPrompt := Value;
+end;
+
+procedure TfrxDBXDatabase.SetParams(Value: TStrings);
+begin
+ FStrings.Assign(Value);
+end;
+
+procedure TfrxDBXDatabase.SetVendorLib(const Value: String);
+begin
+ FDatabase.VendorLib := Value;
+end;
+
+procedure TfrxDBXDatabase.OnChange(Sender: TObject);
+begin
+ if not FLock then
+ FDatabase.Params.Assign(FStrings);
+end;
+
+
+{ TfrxDBXTable }
+
+constructor TfrxDBXTable.Create(AOwner: TComponent);
+begin
+ FTable := TSQLTable.Create(nil);
+ DataSet := FTable;
+ SetDatabase(nil);
+ inherited;
+end;
+
+destructor TfrxDBXTable.Destroy;
+begin
+ inherited;
+end;
+
+constructor TfrxDBXTable.DesignCreate(AOwner: TComponent; Flags: Word);
+var
+ i: Integer;
+ l: TList;
+begin
+ inherited;
+ l := Report.AllObjects;
+ for i := 0 to l.Count - 1 do
+ if TObject(l[i]) is TfrxDBXDatabase then
+ begin
+ SetDatabase(TfrxDBXDatabase(l[i]));
+ break;
+ end;
+end;
+
+class function TfrxDBXTable.GetDescription: String;
+begin
+ Result := frxResources.Get('obDBXTb');
+end;
+
+procedure TfrxDBXTable.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FDatabase) then
+ SetDatabase(nil);
+end;
+
+procedure TfrxDBXTable.SetDatabase(const Value: TfrxDBXDatabase);
+begin
+ FDatabase := Value;
+ if Value <> nil then
+ FTable.SQLConnection := Value.Database
+ else if DBXComponents <> nil then
+ FTable.SQLConnection := DBXComponents.DefaultDatabase
+ else
+ FTable.SQLConnection := nil;
+ DBConnected := FTable.SQLConnection <> nil;
+end;
+
+function TfrxDBXTable.GetIndexName: String;
+begin
+ Result := FTable.IndexName;
+end;
+
+function TfrxDBXTable.GetIndexFieldNames: String;
+begin
+ Result := FTable.IndexFieldNames;
+end;
+
+function TfrxDBXTable.GetTableName: String;
+begin
+ Result := FTable.TableName;
+end;
+
+procedure TfrxDBXTable.SetIndexName(const Value: String);
+begin
+ FTable.IndexName := Value;
+end;
+
+procedure TfrxDBXTable.SetIndexFieldNames(const Value: String);
+begin
+ FTable.IndexFieldNames := Value;
+end;
+
+procedure TfrxDBXTable.SetTableName(const Value: String);
+begin
+ FTable.TableName := Value;
+end;
+
+procedure TfrxDBXTable.SetMaster(const Value: TDataSource);
+begin
+ FTable.MasterSource := Value;
+end;
+
+procedure TfrxDBXTable.SetMasterFields(const Value: String);
+begin
+ FTable.MasterFields := Value;
+end;
+
+procedure TfrxDBXTable.BeforeStartReport;
+begin
+ SetDatabase(FDatabase);
+end;
+
+
+{ TfrxDBXQuery }
+
+constructor TfrxDBXQuery.Create(AOwner: TComponent);
+begin
+ FStrings := TStringList.Create;
+ FQuery := TSQLQuery.Create(nil);
+ DataSet := FQuery;
+ SetDatabase(nil);
+ inherited;
+end;
+
+destructor TfrxDBXQuery.Destroy;
+begin
+ FStrings.Free;
+ inherited;
+end;
+
+constructor TfrxDBXQuery.DesignCreate(AOwner: TComponent; Flags: Word);
+var
+ i: Integer;
+ l: TList;
+begin
+ inherited;
+ l := Report.AllObjects;
+ for i := 0 to l.Count - 1 do
+ if TObject(l[i]) is TfrxDBXDatabase then
+ begin
+ SetDatabase(TfrxDBXDatabase(l[i]));
+ break;
+ end;
+end;
+
+class function TfrxDBXQuery.GetDescription: String;
+begin
+ Result := frxResources.Get('obDBXQ');
+end;
+
+procedure TfrxDBXQuery.Notification(AComponent: TComponent; Operation: TOperation);
+begin
+ inherited;
+ if (Operation = opRemove) and (AComponent = FDatabase) then
+ SetDatabase(nil);
+end;
+
+procedure TfrxDBXQuery.SetDatabase(const Value: TfrxDBXDatabase);
+begin
+ FDatabase := Value;
+ if Value <> nil then
+ FQuery.SQLConnection := Value.Database
+ else if DBXComponents <> nil then
+ FQuery.SQLConnection := DBXComponents.DefaultDatabase
+ else
+ FQuery.SQLConnection := nil;
+ DBConnected := FQuery.SQLConnection <> nil;
+end;
+
+function TfrxDBXQuery.GetSQL: TStrings;
+begin
+ FLock := True;
+ FStrings.Assign(FQuery.SQL);
+ FLock := False;
+ Result := FStrings;
+end;
+
+procedure TfrxDBXQuery.SetSQL(Value: TStrings);
+begin
+ FQuery.SQL.Assign(Value);
+ FStrings.Assign(Value);
+end;
+
+procedure TfrxDBXQuery.SetMaster(const Value: TDataSource);
+begin
+ FQuery.DataSource := Value;
+end;
+
+procedure TfrxDBXQuery.UpdateParams;
+begin
+ FQuery.SQL.Assign(FStrings);
+ frxParamsToTParams(Self, FQuery.Params);
+end;
+
+procedure TfrxDBXQuery.BeforeStartReport;
+begin
+ SetDatabase(FDatabase);
+end;
+
+procedure TfrxDBXQuery.OnChangeSQL(Sender: TObject);
+begin
+ if not FLock then
+ begin
+ FQuery.SQL.Assign(FStrings);
+ inherited;
+ end;
+end;
+
+{$IFDEF QBUILDER}
+function TfrxDBXQuery.QBEngine: TfqbEngine;
+begin
+ Result := TfrxEngineDBX.Create(nil);
+ TfrxEngineDBX(Result).FQuery.SQLConnection := FQuery.SQLConnection;
+end;
+{$ENDIF}
+
+
+{$IFDEF QBUILDER}
+constructor TfrxEngineDBX.Create(AOwner: TComponent);
+begin
+ inherited;
+ FQuery := TSQLQuery.Create(nil);
+ FDBXDataset := TfrxDBXDataset.Create(nil);
+ FDBXDataset.Dataset := FQuery;
+end;
+
+destructor TfrxEngineDBX.Destroy;
+begin
+ FQuery.Free;
+ FDBXDataset.Free;
+ inherited;
+end;
+
+procedure TfrxEngineDBX.ReadFieldList(const ATableName: string;
+ var AFieldList: TfqbFieldList);
+var
+ TempTable: TSQLTable;
+ Fields: TFieldDefs;
+ i: Integer;
+ tmpField: TfqbField;
+begin
+ AFieldList.Clear;
+ TempTable := TSQLTable.Create(Self);
+ TempTable.SQLConnection := FQuery.SQLConnection;
+ TempTable.TableName := ATableName;
+ Fields := TempTable.FieldDefs;
+ try
+ try
+ TempTable.Active := True;
+ tmpField:= TfqbField(AFieldList.Add);
+ tmpField.FieldName := '*';
+ for i := 0 to Fields.Count - 1 do
+ begin
+ tmpField := TfqbField(AFieldList.Add);
+ tmpField.FieldName := Fields.Items[i].Name;
+ tmpField.FieldType := Ord(Fields.Items[i].DataType)
+ end;
+ except
+ end;
+ finally
+ TempTable.Free;
+ end;
+end;
+
+procedure TfrxEngineDBX.ReadTableList(ATableList: TStrings);
+begin
+ ATableList.Clear;
+ FQuery.SQLConnection.GetTableNames(ATableList, ShowSystemTables);
+end;
+
+function TfrxEngineDBX.ResultDataSet: TDataSet;
+begin
+ Result := FDBXDataset;
+end;
+
+procedure TfrxEngineDBX.SetSQL(const Value: string);
+begin
+ FQuery.SQL.Text := Value;
+end;
+{$ENDIF}
+
+
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxDBXDataBase, TFmxObject);
+ GroupDescendentsWith(TfrxDBXTable, TFmxObject);
+ GroupDescendentsWith(TfrxDBXQuery, TFmxObject);
+ frxObjects.RegisterObject1(TfrxDBXDataBase, nil, '', {$IFDEF DB_CAT}'DATABASES'{$ELSE}''{$ENDIF}, 0, 246);
+ frxObjects.RegisterObject1(TfrxDBXTable, nil, '', {$IFDEF DB_CAT}'TABLES'{$ELSE}''{$ENDIF}, 0, 247);
+ frxObjects.RegisterObject1(TfrxDBXQuery, nil, '', {$IFDEF DB_CAT}'QUERIES'{$ELSE}''{$ENDIF}, 0, 248);
+
+finalization
+ frxObjects.UnRegister(TfrxDBXDataBase);
+ frxObjects.UnRegister(TfrxDBXTable);
+ frxObjects.UnRegister(TfrxDBXQuery);
+
+
+end.
\ No newline at end of file
diff --git a/LibD28x64/FMX.frxDBXEditor.pas b/LibD28x64/FMX.frxDBXEditor.pas
new file mode 100644
index 0000000..cb7640d
--- /dev/null
+++ b/LibD28x64/FMX.frxDBXEditor.pas
@@ -0,0 +1,167 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ DBX components design editors }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDBXEditor;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, System.SysUtils, FMX.Forms, FMX.Dialogs, FMX.frxDBXComponents, FMX.frxCustomDB,
+ FMX.frxDsgnIntf, FMX.frxRes, Data.DBCommonTypes, Data.SqlExpr, System.Variants;
+
+
+type
+ TfrxConnectionNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ end;
+
+ TfrxDriverNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ end;
+
+ TfrxDatabaseProperty = class(TfrxComponentProperty)
+ public
+ function GetValue: String; override;
+ end;
+
+ TfrxTableNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxIndexNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ end;
+
+
+{ TfrxConnectionNameProperty }
+
+function TfrxConnectionNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList];
+end;
+
+procedure TfrxConnectionNameProperty.GetValues;
+begin
+ inherited;
+ GetConnectionNames(Values);
+end;
+
+
+{ TfrxDriverNameProperty }
+
+function TfrxDriverNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList];
+end;
+
+procedure TfrxDriverNameProperty.GetValues;
+begin
+ inherited;
+ GetDriverNames(Values);
+end;
+
+
+{ TfrxDatabaseProperty }
+
+function TfrxDatabaseProperty.GetValue: String;
+var
+ db: TfrxDBXDatabase;
+begin
+ db := TfrxDBXDatabase(GetOrdValue);
+ if db = nil then
+ begin
+ if (DBXComponents <> nil) and (DBXComponents.DefaultDatabase <> nil) then
+ Result := DBXComponents.DefaultDatabase.Name
+ else
+ Result := frxResources.Get('prNotAssigned');
+ end
+ else
+ Result := inherited GetValue;
+end;
+
+
+{ TfrxTableNameProperty }
+
+function TfrxTableNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paSortList];
+end;
+
+procedure TfrxTableNameProperty.GetValues;
+begin
+ inherited;
+ with TfrxDBXTable(Component).Table do
+ if SQLConnection <> nil then
+ SQLConnection.GetTableNames(Values, False);
+end;
+
+procedure TfrxTableNameProperty.SetValue(const Value: String);
+begin
+ inherited;
+ Designer.UpdateDataTree;
+end;
+
+
+{ TfrxIndexProperty }
+
+function TfrxIndexNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList];
+end;
+
+procedure TfrxIndexNameProperty.GetValues;
+var
+ i: Integer;
+begin
+ inherited;
+ try
+ with TfrxDBXTable(Component).Table do
+ if (TableName <> '') and (IndexDefs <> nil) then
+ begin
+ IndexDefs.Update;
+ for i := 0 to IndexDefs.Count - 1 do
+ if IndexDefs[i].Name <> '' then
+ Values.Add(IndexDefs[i].Name);
+ end;
+ except
+ end;
+end;
+
+
+initialization
+ frxPropertyEditors.Register(TypeInfo(String), TfrxDBXDataBase, 'ConnectionName',
+ TfrxConnectionNameProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxDBXDataBase, 'DriverName',
+ TfrxDriverNameProperty);
+ frxPropertyEditors.Register(TypeInfo(TfrxDBXDatabase), TfrxDBXTable, 'Database',
+ TfrxDatabaseProperty);
+ frxPropertyEditors.Register(TypeInfo(TfrxDBXDatabase), TfrxDBXQuery, 'Database',
+ TfrxDatabaseProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxDBXTable, 'TableName',
+ TfrxTableNameProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxDBXTable, 'IndexName',
+ TfrxIndexNameProperty);
+
+end.
diff --git a/LibD28x64/FMX.frxDBXRTTI.pas b/LibD28x64/FMX.frxDBXRTTI.pas
new file mode 100644
index 0000000..c068bb9
--- /dev/null
+++ b/LibD28x64/FMX.frxDBXRTTI.pas
@@ -0,0 +1,68 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ DBX components RTTI }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDBXRTTI;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, FMX.fs_iinterpreter, FMX.frxDBXComponents, System.Variants;
+
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+ function CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddClass(TfrxDBXDatabase, 'TfrxCustomDatabase');
+ AddClass(TfrxDBXTable, 'TfrxCustomTable');
+ with AddClass(TfrxDBXQuery, 'TfrxCustomQuery') do
+ AddMethod('procedure ExecSQL', CallMethod);
+ end;
+end;
+
+function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+ const MethodName: String; Caller: TfsMethodHelper): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TfrxDBXQuery then
+ begin
+ if MethodName = 'EXECSQL' then
+ TfrxDBXQuery(Instance).Query.ExecSQL
+ end
+end;
+
+
+initialization
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28x64/FMX.frxDCtrl.pas b/LibD28x64/FMX.frxDCtrl.pas
new file mode 100644
index 0000000..88e823e
--- /dev/null
+++ b/LibD28x64/FMX.frxDCtrl.pas
@@ -0,0 +1,1635 @@
+
+{******************************************}
+{ }
+{ FastReport v2.4 - Dialog designer }
+{ Standard Dialog controls }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDCtrl;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UiTypes, FMX.Types, FMX.Controls, FMX.ExtCtrls, FMX.Objects,
+ FMX.Forms, FMX.Menus, FMX.Dialogs, FMX.frxClass, System.Variants, FMX.Edit, FMX.Memo, FMX.ListBox, FMX.frxFMX
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics, FMX.DateTimeCtrls
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxDialogControls = class(TComponent) // fake component
+ end;
+{$IFDEF DELPHI21}
+ TCalendarBox = class(TDateEdit);
+{$ENDIF}
+ TfrxLabelControl = class(TfrxDialogControl)
+ private
+ FLabel: TLabel;
+ function GetAlignment: TTextAlign;
+ function GetAutoSize: Boolean;
+ function GetWordWrap: Boolean;
+ procedure SetAlignment(const Value: TTextAlign);
+ procedure SetAutoSize(const Value: Boolean);
+ procedure SetWordWrap(const Value: Boolean);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ procedure BeforeStartReport; override;
+ procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
+ property LabelCtl: TLabel read FLabel;
+ published
+ property Alignment: TTextAlign read GetAlignment write SetAlignment
+ default TTextAlign.taLeading;
+ property AutoSize: Boolean read GetAutoSize write SetAutoSize default True;
+ property Caption;
+ property WordWrap: Boolean read GetWordWrap write SetWordWrap default False;
+
+ property OnClick;
+ property OnDblClick;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfrxCustomEditControl = class(TfrxDialogControl)
+ private
+ FOnChange: TfrxNotifyEvent;
+ function GetMaxLength: Integer;
+ function GetPasswordChar: Char;
+ function GetReadOnly: Boolean;
+ function GetText: String;
+ procedure DoOnChange(Sender: TObject);
+ procedure SetMaxLength(const Value: Integer);
+ procedure SetPasswordChar(const Value: Char);
+ procedure SetReadOnly(const Value: Boolean);
+ procedure SetText(const Value: String);
+ protected
+ FCustomEdit: TControl;
+ public
+ constructor Create(AOwner: TComponent); override;
+ property MaxLength: Integer read GetMaxLength write SetMaxLength;
+ property PasswordChar: Char read GetPasswordChar write SetPasswordChar;
+ property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
+ property Text: String read GetText write SetText;
+ property OnChange: TfrxNotifyEvent read FOnChange write FOnChange;
+ end;
+
+ TfrxEditControl = class(TfrxCustomEditControl)
+ private
+ FEdit: TEdit;
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property Edit: TEdit read FEdit;
+ published
+ property MaxLength;
+ property PasswordChar;
+ property ReadOnly;
+ property TabStop;
+ property Text;
+ property OnChange;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfrxMemoControl = class(TfrxDialogControl)
+ private
+ FMemo: TMemo;
+ FOnChange: TfrxNotifyEvent;
+ function GetLines: TStrings;
+ procedure SetLines(const Value: TStrings);
+ function GetShowScrollBars: Boolean;
+ function GetWordWrap: Boolean;
+ procedure SetShowScrollBars(const Value: Boolean);
+ procedure SetWordWrap(const Value: Boolean);
+ procedure DoOnChange(Sender: TObject);
+ function GetMaxLength: Integer;
+ function GetReadOnly: Boolean;
+ procedure SetMaxLength(const Value: Integer);
+ procedure SetReadOnly(const Value: Boolean);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property Memo: TMemo read FMemo;
+ published
+ property Lines: TStrings read GetLines write SetLines;
+ property MaxLength: Integer read GetMaxLength write SetMaxLength;
+ property ReadOnly: Boolean read GetReadOnly write SetReadOnly default False;
+ property ShowScrollBars: Boolean read GetShowScrollBars write SetShowScrollBars default False;
+ property TabStop;
+ property WordWrap: Boolean read GetWordWrap write SetWordWrap default True;
+ property OnChange: TfrxNotifyEvent read FOnChange write FOnChange;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfrxButtonControl = class(TfrxDialogControl)
+ private
+ FButton: TButton;
+ function GetCancel: Boolean;
+ function GetDefault: Boolean;
+ function GetModalResult: TModalResult;
+ procedure SetCancel(const Value: Boolean);
+ procedure SetDefault(const Value: Boolean);
+ procedure SetModalResult(const Value: TModalResult);
+ function GetWordWrap: Boolean;
+ procedure SetWordWrap(const Value: Boolean);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property Button: TButton read FButton;
+ published
+ property Cancel: Boolean read GetCancel write SetCancel default False;
+ property Caption;
+ property Default: Boolean read GetDefault write SetDefault default False;
+ property ModalResult: TModalResult read GetModalResult write SetModalResult default mrNone;
+ property WordWrap: Boolean read GetWordWrap write SetWordWrap default False;
+ property TabStop;
+ property OnClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfrxCheckBoxControl = class(TfrxDialogControl)
+ private
+ FCheckBox: TCheckBox;
+ FOnChange: TfrxNotifyEvent;
+ function GetChecked: Boolean;
+ procedure SetChecked(const Value: Boolean);
+ function GetWordWrap: Boolean;
+ procedure SetWordWrap(const Value: Boolean);
+ procedure DoOnChange(Sender: TObject);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property CheckBox: TCheckBox read FCheckBox;
+ published
+ property Caption;
+ property Checked: Boolean read GetChecked write SetChecked default False;
+ property TabStop;
+ property WordWrap: Boolean read GetWordWrap write SetWordWrap default False;
+ property OnChange: TfrxNotifyEvent read FOnChange write FOnChange;
+ property OnClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfrxRadioButtonControl = class(TfrxDialogControl)
+ private
+ FRadioButton: TRadioButton;
+ FOnChange: TfrxNotifyEvent;
+ function GetChecked: Boolean;
+ procedure SetChecked(const Value: Boolean);
+ function GetWordWrap: Boolean;
+ procedure SetWordWrap(const Value: Boolean);
+ procedure DoOnChange(Sender: TObject);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property RadioButton: TRadioButton read FRadioButton;
+ published
+ property Caption;
+ property Checked: Boolean read GetChecked write SetChecked default False;
+ property TabStop;
+ property WordWrap: Boolean read GetWordWrap write SetWordWrap default False;
+ property OnChange: TfrxNotifyEvent read FOnChange write FOnChange;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfrxListBoxControl = class(TfrxDialogControl)
+ private
+ FListBox: TListBox;
+ function GetItems: TStrings;
+ procedure SetItems(const Value: TStrings);
+ function GetItemIndex: Integer;
+ procedure SetItemIndex(const Value: Integer);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ class function GetDescription: String; override;
+ property ListBox: TListBox read FListBox;
+ property ItemIndex: Integer read GetItemIndex write SetItemIndex;
+ published
+ property Items: TStrings read GetItems write SetItems;
+ property TabStop;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfrxComboBoxControl = class(TfrxDialogControl)
+ private
+ FComboBox: TComboBox;
+ FOnChange: TfrxNotifyEvent;
+ function GetItemIndex: Integer;
+ function GetItems: TStrings;
+ //function GetStyle: TComboBoxStyle;
+ function GetText: String;
+ procedure DoOnChange(Sender: TObject);
+ procedure SetItemIndex(const Value: Integer);
+ procedure SetItems(const Value: TStrings);
+ //procedure SetStyle(const Value: TComboBoxStyle);
+ procedure SetText(const Value: String);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property ComboBox: TComboBox read FComboBox;
+ published
+ //property Color;
+ property Items: TStrings read GetItems write SetItems;
+ //property Style: TComboBoxStyle read GetStyle write SetStyle default csDropDown;
+ property TabStop;
+ property Text: String read GetText write SetText;
+ property ItemIndex: Integer read GetItemIndex write SetItemIndex;
+ property OnChange: TfrxNotifyEvent read FOnChange write FOnChange;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ end;
+
+ TfrxPanelControl = class(TfrxDialogControl)
+ private
+ FPanel: TPanel;
+ function GetAlignment: TAlignment;
+ //function GetBevelInner: TPanelBevel;
+ //function GetBevelOuter: TPanelBevel;
+ function GetBevelWidth: Integer;
+ procedure SetAlignment(const Value: TAlignment);
+ //procedure SetBevelInner(const Value: TPanelBevel);
+ //procedure SetBevelOuter(const Value: TPanelBevel);
+ procedure SetBevelWidth(const Value: Integer);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property Panel: TPanel read FPanel;
+ published
+ property Alignment: TAlignment read GetAlignment write SetAlignment default TAlignment.taCenter;
+ //property BevelInner: TPanelBevel read GetBevelInner write SetBevelInner default bvNone;
+ //property BevelOuter: TPanelBevel read GetBevelOuter write SetBevelOuter default bvRaised;
+ property BevelWidth: Integer read GetBevelWidth write SetBevelWidth default 1;
+ property Caption;
+ //property Color;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfrxGroupBoxControl = class(TfrxDialogControl)
+ private
+ FGroupBox: TGroupBox;
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property GroupBox: TGroupBox read FGroupBox;
+ published
+ property Caption;
+ //property Color;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfrxDateEditControl = class(TfrxDialogControl)
+ private
+ FDateEdit: TCalendarBox;
+ FOnChange: TfrxNotifyEvent;
+ FWeekNumbers: Boolean;
+ function GetDate: TDate;
+ function GetTime: TTime;
+ //function GetDateFormat: TDTDateFormat;
+ //function GetKind: TDateTimeKind;
+ procedure SetDate(const Value: TDate);
+ procedure SetTime(const Value: TTime);
+ //procedure SetDateFormat(const Value: TDTDateFormat);
+ //procedure SetKind(const Value: TDateTimeKind);
+ protected
+ // remove
+ procedure DoOnChange(Sender: TObject);
+ procedure DropDown(Sender: TObject);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property DateEdit: TCalendarBox read FDateEdit;
+ published
+ //property Color;
+ property Date: TDate read GetDate write SetDate;
+ //property DateFormat: TDTDateFormat read GetDateFormat write SetDateFormat
+ // default dfShort;
+ //property Kind: TDateTimeKind read GetKind write SetKind default dtkDate;
+ property TabStop;
+ property Time: TTime read GetTime write SetTime;
+ property WeekNumbers: Boolean read FWeekNumbers write FWeekNumbers;
+ property OnChange: TfrxNotifyEvent read FOnChange write FOnChange;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ end;
+
+ TfrxImageControl = class(TfrxDialogControl)
+ private
+ FImage: TImage;
+ function GetAutoSize: Boolean;
+ function GetCenter: Boolean;
+ function GetPicture: TBitmap;
+ function GetStretch: Boolean;
+ procedure SetAutoSize(const Value: Boolean);
+ procedure SetCenter(const Value: Boolean);
+ procedure SetPicture(const Value: TBitmap);
+ procedure SetStretch(const Value: Boolean);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property Image: TImage read FImage;
+ published
+ property AutoSize: Boolean read GetAutoSize write SetAutoSize default False;
+ property Center: Boolean read GetCenter write SetCenter default False;
+ property Picture: TBitmap read GetPicture write SetPicture;
+ property Stretch: Boolean read GetStretch write SetStretch default False;
+ property OnClick;
+ property OnDblClick;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+
+ TfrxBevelControl = class(TfrxDialogControl)
+ private
+ FBevel: TPanel;
+ //function GetBevelShape: TBevelShape;
+ //function GetBevelStyle: TBevelStyle;
+ //procedure SetBevelShape(const Value: TBevelShape);
+ //procedure SetBevelStyle(const Value: TBevelStyle);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property Bevel: TPanel read FBevel;
+ published
+ //property Shape: TBevelShape read GetBevelShape write SetBevelShape default bsBox;
+ //property Style: TBevelStyle read GetBevelStyle write SetBevelStyle default bsLowered;
+ end;
+
+ TfrxBitBtnControl = class(TfrxDialogControl)
+ private
+ FBitBtn: TfrxToolButton;
+ function GetGlyph: TBitmap;
+ //function GetKind: TBitBtnKind;
+ //function GetLayout: TButtonLayout;
+ function GetMargin: Integer;
+ function GetModalResult: TModalResult;
+ function GetSpacing: Integer;
+ procedure SetGlyph(const Value: TBitmap);
+ //procedure SetKind(const Value: TBitBtnKind);
+ //procedure SetLayout(const Value: TButtonLayout);
+ procedure SetMargin(const Value: Integer);
+ procedure SetModalResult(const Value: TModalResult);
+ procedure SetSpacing(const Value: Integer);
+ function GetNumGlyphs: Integer;
+ procedure SetNumGlyphs(const Value: Integer);
+ function GetWordWrap: Boolean;
+ procedure SetWordWrap(const Value: Boolean);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property BitBtn: TfrxToolButton read FBitBtn;
+ published
+ property Glyph: TBitmap read GetGlyph write SetGlyph;
+ //property Kind: TBitBtnKind read GetKind write SetKind default bkCustom;
+ property Caption; // should be after Kind prop
+ //property Layout: TButtonLayout read GetLayout write SetLayout default blGlyphLeft;
+ property Margin: Integer read GetMargin write SetMargin default -1;
+ property ModalResult: TModalResult read GetModalResult write SetModalResult default mrNone;
+ property NumGlyphs: Integer read GetNumGlyphs write SetNumGlyphs default 1;
+ property Spacing: Integer read GetSpacing write SetSpacing default 4;
+ property WordWrap: Boolean read GetWordWrap write SetWordWrap default False;
+ property TabStop;
+ property OnClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+{
+ TfrxSpeedButtonControl = class(TfrxDialogControl)
+ private
+ FSpeedButton: TSpeedButton;
+ function GetAllowAllUp: Boolean;
+ function GetDown: Boolean;
+ function GetFlat: Boolean;
+ function GetGlyph: TBitmap;
+ function GetGroupIndex: Integer;
+ //function GetLayout: TButtonLayout;
+ function GetMargin: Integer;
+ function GetSpacing: Integer;
+ procedure SetAllowAllUp(const Value: Boolean);
+ procedure SetDown(const Value: Boolean);
+ procedure SetFlat(const Value: Boolean);
+ procedure SetGlyph(const Value: TBitmap);
+ procedure SetGroupIndex(const Value: Integer);
+ //procedure SetLayout(const Value: TButtonLayout);
+ procedure SetMargin(const Value: Integer);
+ procedure SetSpacing(const Value: Integer);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property SpeedButton: TSpeedButton read FSpeedButton;
+ published
+ property AllowAllUp: Boolean read GetAllowAllUp write SetAllowAllUp default False;
+ property Caption;
+ property Down: Boolean read GetDown write SetDown default False;
+ property Flat: Boolean read GetFlat write SetFlat default False;
+ property Glyph: TBitmap read GetGlyph write SetGlyph;
+ property GroupIndex: Integer read GetGroupIndex write SetGroupIndex;
+ //property Layout: TButtonLayout read GetLayout write SetLayout default blGlyphLeft;
+ property Margin: Integer read GetMargin write SetMargin default -1;
+ property Spacing: Integer read GetSpacing write SetSpacing default 4;
+ property OnClick;
+ property OnDblClick;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end;
+}
+ {TfrxMaskEditControl = class(TfrxCustomEditControl)
+ private
+ FMaskEdit: TMaskEdit;
+ function GetEditMask: String;
+ procedure SetEditMask(const Value: String);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property MaskEdit: TMaskEdit read FMaskEdit;
+ published
+ property Color;
+ property EditMask: String read GetEditMask write SetEditMask;
+ property MaxLength;
+ property ReadOnly;
+ property TabStop;
+ property Text;
+ property OnChange;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end; }
+
+ {TfrxCheckListBoxControl = class(TfrxDialogControl)
+ private
+ FCheckListBox: TCheckListBox;
+ function GetAllowGrayed: Boolean;
+ function GetItems: TStrings;
+ function GetSorted: Boolean;
+ function GetChecked(Index: Integer): Boolean;
+ function GetState(Index: Integer): TCheckBoxState;
+ procedure SetAllowGrayed(const Value: Boolean);
+ procedure SetItems(const Value: TStrings);
+ procedure SetSorted(const Value: Boolean);
+ procedure SetChecked(Index: Integer; const Value: Boolean);
+ procedure SetState(Index: Integer; const Value: TCheckBoxState);
+ function GetItemIndex: Integer;
+ procedure SetItemIndex(const Value: Integer);
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ property CheckListBox: TCheckListBox read FCheckListBox;
+ property Checked[Index: Integer]: Boolean read GetChecked write SetChecked;
+ property ItemIndex: Integer read GetItemIndex write SetItemIndex;
+ property State[Index: Integer]: TCheckBoxState read GetState write SetState;
+ published
+ property AllowGrayed: Boolean read GetAllowGrayed write SetAllowGrayed default False;
+ property Color;
+ property Items: TStrings read GetItems write SetItems;
+ property Sorted: Boolean read GetSorted write SetSorted default False;
+ property TabStop;
+ property OnClick;
+ property OnDblClick;
+ property OnEnter;
+ property OnExit;
+ property OnKeyDown;
+ property OnKeyPress;
+ property OnKeyUp;
+ property OnMouseDown;
+ property OnMouseMove;
+ property OnMouseUp;
+ end; }
+
+
+
+implementation
+
+uses FMX.frxDCtrlRTTI, FMX.frxUtils, FMX.frxDsgnIntf, FMX.frxRes;
+
+type
+ THackCustomEdit = class(TCustomEdit);
+
+
+{ TfrxLabelControl }
+
+constructor TfrxLabelControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FLabel := TLabel.Create(nil);
+ InitControl(FLabel);
+end;
+
+class function TfrxLabelControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obLabel');
+end;
+
+procedure TfrxLabelControl.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX,
+ OffsetY: Extended);
+begin
+ if FLabel.AutoSize then
+ begin
+ Width := FLabel.Width;
+ Height := FLabel.Height;
+ end
+ else
+ begin
+ FLabel.Width := Round(Width);
+ FLabel.Height := Round(Height);
+ end;
+ inherited;
+end;
+
+function TfrxLabelControl.GetAlignment: TTextAlign;
+begin
+ Result := FLabel.TextAlign;
+end;
+
+function TfrxLabelControl.GetAutoSize: Boolean;
+begin
+ Result := FLabel.AutoSize;
+end;
+
+function TfrxLabelControl.GetWordWrap: Boolean;
+begin
+ Result := FLabel.WordWrap;
+end;
+
+procedure TfrxLabelControl.SetAlignment(const Value: TTextAlign);
+begin
+ FLabel.TextAlign := Value;
+end;
+
+procedure TfrxLabelControl.SetAutoSize(const Value: Boolean);
+begin
+ FLabel.AutoSize := Value;
+end;
+
+procedure TfrxLabelControl.SetWordWrap(const Value: Boolean);
+begin
+ FLabel.WordWrap := Value;
+end;
+
+procedure TfrxLabelControl.BeforeStartReport;
+begin
+ if not FLabel.AutoSize then
+ begin
+ FLabel.Width := Round(Width);
+ FLabel.Height := Round(Height);
+ end;
+end;
+
+
+{ TfrxCustomEditControl }
+
+constructor TfrxCustomEditControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ THackCustomEdit(FCustomEdit).OnChange := DoOnChange;
+ InitControl(FCustomEdit);
+end;
+
+function TfrxCustomEditControl.GetMaxLength: Integer;
+begin
+ Result := THackCustomEdit(FCustomEdit).MaxLength;
+end;
+
+function TfrxCustomEditControl.GetPasswordChar: Char;
+begin
+ Result := '-';// THackCustomEdit(FCustomEdit).PasswordChar;
+end;
+
+function TfrxCustomEditControl.GetReadOnly: Boolean;
+begin
+ Result := THackCustomEdit(FCustomEdit).ReadOnly;
+end;
+
+function TfrxCustomEditControl.GetText: String;
+begin
+ Result := THackCustomEdit(FCustomEdit).Text;
+end;
+
+procedure TfrxCustomEditControl.SetMaxLength(const Value: Integer);
+begin
+ THackCustomEdit(FCustomEdit).MaxLength := Value;
+end;
+
+procedure TfrxCustomEditControl.SetPasswordChar(const Value: Char);
+begin
+ //THackCustomEdit(FCustomEdit).PasswordChar := Value;
+end;
+
+procedure TfrxCustomEditControl.SetReadOnly(const Value: Boolean);
+begin
+ THackCustomEdit(FCustomEdit).ReadOnly := Value;
+end;
+
+procedure TfrxCustomEditControl.SetText(const Value: String);
+begin
+ THackCustomEdit(FCustomEdit).Text := Value;
+end;
+
+procedure TfrxCustomEditControl.DoOnChange(Sender: TObject);
+begin
+ if Report <> nil then
+ Report.DoNotifyEvent(Self, FOnChange, True);
+end;
+
+
+{ TfrxEditControl }
+
+constructor TfrxEditControl.Create(AOwner: TComponent);
+begin
+ FEdit := TEdit.Create(nil);
+ FCustomEdit := FEdit;
+ inherited;
+
+ Width := 121;
+ Height := 21;
+end;
+
+class function TfrxEditControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obEdit');
+end;
+
+
+{ TfrxMemoControl }
+
+constructor TfrxMemoControl.Create(AOwner: TComponent);
+begin
+ FMemo := TMemo.Create(nil);
+ //FCustomEdit := FMemo;
+ inherited;
+ InitControl(FMemo);
+ Width := 185;
+ Height := 89;
+ FMemo.OnChange := DoOnChange;
+end;
+
+procedure TfrxMemoControl.DoOnChange(Sender: TObject);
+begin
+ if Report <> nil then
+ Report.DoNotifyEvent(Self, FOnChange, True);
+end;
+
+class function TfrxMemoControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obMemoC');
+end;
+
+function TfrxMemoControl.GetLines: TStrings;
+begin
+ Result := FMemo.Lines;
+end;
+
+function TfrxMemoControl.GetMaxLength: Integer;
+begin
+ Result := FMemo.MaxLength;
+end;
+
+function TfrxMemoControl.GetReadOnly: Boolean;
+begin
+ Result := FMemo.ReadOnly;
+end;
+
+function TfrxMemoControl.GetShowScrollBars: Boolean;
+begin
+ Result := FMemo.ShowScrollBars;
+end;
+
+function TfrxMemoControl.GetWordWrap: Boolean;
+begin
+ Result := FMemo.WordWrap;
+end;
+
+procedure TfrxMemoControl.SetLines(const Value: TStrings);
+begin
+ FMemo.Lines := Value;
+end;
+
+procedure TfrxMemoControl.SetMaxLength(const Value: Integer);
+begin
+ FMemo.MaxLength := Value;
+end;
+
+procedure TfrxMemoControl.SetReadOnly(const Value: Boolean);
+begin
+ FMemo.ReadOnly := Value;
+end;
+
+procedure TfrxMemoControl.SetShowScrollBars(const Value: boolean);
+begin
+ FMemo.ShowScrollBars := Value;
+end;
+
+procedure TfrxMemoControl.SetWordWrap(const Value: Boolean);
+begin
+ FMemo.WordWrap := Value;
+end;
+
+
+{ TfrxButtonControl }
+
+constructor TfrxButtonControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FButton := TButton.Create(nil);
+ InitControl(FButton);
+
+ Width := 75;
+ Height := 25;
+end;
+
+class function TfrxButtonControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obButton');
+end;
+
+function TfrxButtonControl.GetCancel: Boolean;
+begin
+ Result := FButton.Cancel;
+end;
+
+function TfrxButtonControl.GetDefault: Boolean;
+begin
+ Result := FButton.Default;
+end;
+
+function TfrxButtonControl.GetModalResult: TModalResult;
+begin
+ Result := FButton.ModalResult;
+end;
+
+procedure TfrxButtonControl.SetCancel(const Value: Boolean);
+begin
+ FButton.Cancel := Value;
+end;
+
+procedure TfrxButtonControl.SetDefault(const Value: Boolean);
+begin
+ FButton.Default := Value;
+end;
+
+procedure TfrxButtonControl.SetModalResult(const Value: TModalResult);
+begin
+ FButton.ModalResult := Value;
+end;
+
+function TfrxButtonControl.GetWordWrap: Boolean;
+begin
+ Result := FButton.WordWrap;
+end;
+
+procedure TfrxButtonControl.SetWordWrap(const Value: Boolean);
+begin
+ FButton.WordWrap := Value;
+end;
+
+{ TfrxCheckBoxControl }
+
+constructor TfrxCheckBoxControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FCheckBox := TCheckBox.Create(nil);
+ FCheckBox.OnChange := DoOnChange;
+ InitControl(FCheckBox);
+
+ Width := 97;
+ Height := 17;
+end;
+
+class function TfrxCheckBoxControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obChBoxC');
+end;
+
+function TfrxCheckBoxControl.GetChecked: Boolean;
+begin
+ Result := FCheckBox.IsChecked;
+end;
+
+procedure TfrxCheckBoxControl.SetChecked(const Value: Boolean);
+begin
+ FCheckBox.IsChecked := Value;
+end;
+
+function TfrxCheckBoxControl.GetWordWrap: Boolean;
+begin
+ Result := FCheckBox.WordWrap;
+end;
+
+procedure TfrxCheckBoxControl.SetWordWrap(const Value: Boolean);
+begin
+ FCheckBox.WordWrap := Value;
+end;
+
+procedure TfrxCheckBoxControl.DoOnChange(Sender: TObject);
+begin
+ if Report <> nil then
+ Report.DoNotifyEvent(Self, FOnChange, True);
+end;
+
+{ TfrxRadioButtonControl }
+
+constructor TfrxRadioButtonControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FRadioButton := TRadioButton.Create(nil);
+ FRadioButton.OnChange := DoOnChange;
+ InitControl(FRadioButton);
+
+ Width := 113;
+ Height := 17;
+end;
+
+class function TfrxRadioButtonControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obRButton');
+end;
+
+function TfrxRadioButtonControl.GetChecked: Boolean;
+begin
+ Result := FRadioButton.IsChecked;
+end;
+
+procedure TfrxRadioButtonControl.SetChecked(const Value: Boolean);
+begin
+ FRadioButton.IsChecked := Value;
+end;
+
+function TfrxRadioButtonControl.GetWordWrap: Boolean;
+begin
+ Result := FRadioButton.WordWrap;
+end;
+
+procedure TfrxRadioButtonControl.SetWordWrap(const Value: Boolean);
+begin
+ FRadioButton.WordWrap := Value;
+end;
+
+procedure TfrxRadioButtonControl.DoOnChange(Sender: TObject);
+begin
+ if Report <> nil then
+ Report.DoNotifyEvent(Self, FOnChange, True);
+end;
+
+
+{ TfrxListBoxControl }
+
+constructor TfrxListBoxControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FListBox := TListBox.Create(AOwner);
+ InitControl(FListBox);
+ Width := 121;
+ Height := 97;
+end;
+
+destructor TfrxListBoxControl.Destroy;
+begin
+ inherited;
+end;
+
+class function TfrxListBoxControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obLBox');
+end;
+
+function TfrxListBoxControl.GetItems: TStrings;
+begin
+ Result := FListBox.Items;
+end;
+
+function TfrxListBoxControl.GetItemIndex: Integer;
+begin
+ Result := FListBox.ItemIndex;
+end;
+
+procedure TfrxListBoxControl.SetItems(const Value: TStrings);
+begin
+ FListBox.Items := Value;
+end;
+
+procedure TfrxListBoxControl.SetItemIndex(const Value: Integer);
+begin
+ FListBox.ItemIndex := Value;
+end;
+
+
+{ TfrxComboBoxControl }
+
+constructor TfrxComboBoxControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FComboBox := TComboBox.Create(nil);
+ FComboBox.OnChange := DoOnChange;
+ InitControl(FComboBox);
+
+ Width := 145;
+ Height := 21;
+end;
+
+class function TfrxComboBoxControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obCBox');
+end;
+
+function TfrxComboBoxControl.GetItems: TStrings;
+begin
+ Result := FComboBox.Items;
+end;
+
+function TfrxComboBoxControl.GetItemIndex: Integer;
+begin
+ Result := FComboBox.ItemIndex;
+end;
+
+{function TfrxComboBoxControl.GetStyle: TComboBoxStyle;
+begin
+ Result := FComboBox.Style;
+end; }
+
+function TfrxComboBoxControl.GetText: String;
+begin
+ Result := FComboBox.Items.Text;
+end;
+
+procedure TfrxComboBoxControl.SetItems(const Value: TStrings);
+begin
+ FComboBox.Items := Value;
+end;
+
+procedure TfrxComboBoxControl.SetItemIndex(const Value: Integer);
+begin
+ FComboBox.ItemIndex := Value;
+end;
+
+{procedure TfrxComboBoxControl.SetStyle(const Value: TComboBoxStyle);
+begin
+ FComboBox.Style := Value;
+end; }
+
+procedure TfrxComboBoxControl.SetText(const Value: String);
+begin
+ FComboBox.Items.Text := Value;
+end;
+
+procedure TfrxComboBoxControl.DoOnChange(Sender: TObject);
+begin
+ if Report <> nil then
+ Report.DoNotifyEvent(Self, FOnChange, True);
+end;
+
+
+{ TfrxDateEditControl }
+
+constructor TfrxDateEditControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FDateEdit := TCalendarBox.Create(nil);
+ //FDateEdit.OnChange := DoOnChange;
+ //FDateEdit.OnDropDown := DropDown;
+ InitControl(FDateEdit);
+
+ Width := 145;
+ Height := 21;
+end;
+
+class function TfrxDateEditControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obDateEdit');
+end;
+
+function TfrxDateEditControl.GetDate: TDate;
+begin
+ Result := FDateEdit.Date;
+end;
+
+function TfrxDateEditControl.GetTime: TTime;
+begin
+ Result := Now;
+end;
+
+{function TfrxDateEditControl.GetDateFormat: TDTDateFormat;
+begin
+ Result := FDateEdit.DateFormat;
+end;
+
+function TfrxDateEditControl.GetKind: TDateTimeKind;
+begin
+ Result := FDateEdit.Kind;
+end; }
+
+procedure TfrxDateEditControl.SetDate(const Value: TDate);
+begin
+ FDateEdit.Date := Value;
+end;
+
+procedure TfrxDateEditControl.SetTime(const Value: TTime);
+begin
+ //FDateEdit.Time := Value;
+end;
+{
+procedure TfrxDateEditControl.SetDateFormat(const Value: TDTDateFormat);
+begin
+ FDateEdit.DateFormat := Value;
+end;
+
+procedure TfrxDateEditControl.SetKind(const Value: TDateTimeKind);
+begin
+ FDateEdit.Kind := Value;
+end; }
+
+procedure TfrxDateEditControl.DoOnChange(Sender: TObject);
+begin
+ if Report <> nil then
+ Report.DoNotifyEvent(Self, FOnChange, True);
+end;
+
+
+procedure TfrxDateEditControl.DropDown(Sender: TObject);
+begin
+//
+end;
+
+{ TfrxImageControl }
+
+constructor TfrxImageControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FImage := TImage.Create(nil);
+ InitControl(FImage);
+
+ Width := 100;
+ Height := 100;
+end;
+
+class function TfrxImageControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obImageC');
+end;
+
+function TfrxImageControl.GetAutoSize: Boolean;
+begin
+ Result := False;
+end;
+
+function TfrxImageControl.GetCenter: Boolean;
+begin
+ Result := False;
+end;
+
+function TfrxImageControl.GetPicture: TBitmap;
+begin
+ Result := FImage.Bitmap;
+end;
+
+function TfrxImageControl.GetStretch: Boolean;
+begin
+ Result := False;
+end;
+
+procedure TfrxImageControl.SetAutoSize(const Value: Boolean);
+begin
+ //FImage.AutoSize := Value;
+end;
+
+procedure TfrxImageControl.SetCenter(const Value: Boolean);
+begin
+ //FImage.Center := Value;
+end;
+
+procedure TfrxImageControl.SetPicture(const Value: TBitmap);
+begin
+ FImage.Bitmap.Assign(Value);
+end;
+
+procedure TfrxImageControl.SetStretch(const Value: Boolean);
+begin
+ //FImage.Stretch := Value;
+end;
+
+
+{ TfrxBevelControl }
+
+constructor TfrxBevelControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FBevel := TPanel.Create(nil);
+ InitControl(FBevel);
+
+ Width := 50;
+ Height := 50;
+end;
+
+class function TfrxBevelControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obBevel');
+end;
+
+{function TfrxBevelControl.GetBevelShape: TBevelShape;
+begin
+ Result := FBevel.Shape;
+end;
+
+function TfrxBevelControl.GetBevelStyle: TBevelStyle;
+begin
+ Result := FBevel.Style;
+end;
+
+procedure TfrxBevelControl.SetBevelShape(const Value: TBevelShape);
+begin
+ FBevel.Shape := Value;
+end;
+
+procedure TfrxBevelControl.SetBevelStyle(const Value: TBevelStyle);
+begin
+ FBevel.Style := Value;
+end; }
+
+
+{ TfrxPanelControl }
+
+constructor TfrxPanelControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FPanel := TPanel.Create(nil);
+ InitControl(FPanel);
+ Width := 185;
+ Height := 41;
+end;
+
+class function TfrxPanelControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obPanel');
+end;
+
+function TfrxPanelControl.GetAlignment: TAlignment;
+begin
+ Result := TAlignment.taRightJustify;
+end;
+
+
+function TfrxPanelControl.GetBevelWidth: Integer;
+begin
+ Result := 0;
+end;
+
+procedure TfrxPanelControl.SetAlignment(const Value: TAlignment);
+begin
+ //FPanel.Alignment := Value;
+end;
+
+
+
+procedure TfrxPanelControl.SetBevelWidth(const Value: Integer);
+begin
+ //FPanel.BevelWidth := Value;
+end;
+
+
+{ TfrxGroupBoxControl }
+
+constructor TfrxGroupBoxControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FGroupBox := TGroupBox.Create(nil);
+ InitControl(FGroupBox);
+
+ Width := 185;
+ Height := 105;
+end;
+
+class function TfrxGroupBoxControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obGrBox');
+end;
+
+
+{ TfrxBitBtnControl }
+
+constructor TfrxBitBtnControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FBitBtn := TfrxToolButton.Create(nil);
+ InitControl(FBitBtn);
+
+ Width := 75;
+ Height := 25;
+end;
+
+class function TfrxBitBtnControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obBBtn');
+end;
+
+function TfrxBitBtnControl.GetGlyph: TBitmap;
+begin
+ Result := FBitBtn.Bitmap;
+end;
+
+{function TfrxBitBtnControl.GetKind: TBitBtnKind;
+begin
+ Result := FBitBtn.Kind;
+end;
+
+function TfrxBitBtnControl.GetLayout: TButtonLayout;
+begin
+ Result := FBitBtn.Layout;
+end; }
+
+function TfrxBitBtnControl.GetMargin: Integer;
+begin
+ Result := 0;
+end;
+
+function TfrxBitBtnControl.GetModalResult: TModalResult;
+begin
+ Result := FBitBtn.ModalResult;
+end;
+
+function TfrxBitBtnControl.GetNumGlyphs: Integer;
+begin
+ Result := 0;
+end;
+
+function TfrxBitBtnControl.GetSpacing: Integer;
+begin
+ Result := 0;
+end;
+
+function TfrxBitBtnControl.GetWordWrap: Boolean;
+begin
+ Result := FBitBtn.WordWrap;
+end;
+
+procedure TfrxBitBtnControl.SetGlyph(const Value: TBitmap);
+begin
+ //FBitBtn.Glyph := Value;
+end;
+
+{procedure TfrxBitBtnControl.SetKind(const Value: TBitBtnKind);
+begin
+ FBitBtn.Kind := Value;
+end;
+
+procedure TfrxBitBtnControl.SetLayout(const Value: TButtonLayout);
+begin
+ FBitBtn.Layout := Value;
+end; }
+
+procedure TfrxBitBtnControl.SetMargin(const Value: Integer);
+begin
+ //FBitBtn.Margin := Value;
+end;
+
+procedure TfrxBitBtnControl.SetModalResult(const Value: TModalResult);
+begin
+ FBitBtn.ModalResult := Value;
+end;
+
+procedure TfrxBitBtnControl.SetNumGlyphs(const Value: Integer);
+begin
+ //FBitBtn.NumGlyphs := Value;
+end;
+
+procedure TfrxBitBtnControl.SetSpacing(const Value: Integer);
+begin
+ //FBitBtn.Spacing := Value;
+end;
+
+procedure TfrxBitBtnControl.SetWordWrap(const Value: Boolean);
+begin
+ FBitBtn.WordWrap := Value;
+end;
+
+{ TfrxSpeedButtonControl }
+{
+constructor TfrxSpeedButtonControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FSpeedButton := TSpeedButton.Create(nil);
+ InitControl(FSpeedButton);
+
+ Width := 22;
+ Height := 22;
+end;
+
+class function TfrxSpeedButtonControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obSBtn');
+end;
+
+function TfrxSpeedButtonControl.GetAllowAllUp: Boolean;
+begin
+ //Result := FSpeedButton.AllowAllUp;
+end;
+
+function TfrxSpeedButtonControl.GetDown: Boolean;
+begin
+ // Result := FSpeedButton.Down;
+end;
+
+function TfrxSpeedButtonControl.GetFlat: Boolean;
+begin
+ //Result := FSpeedButton.Flat;
+end;
+
+function TfrxSpeedButtonControl.GetGlyph: TBitmap;
+begin
+ // Result := FSpeedButton.Glyph;
+end;
+
+function TfrxSpeedButtonControl.GetGroupIndex: Integer;
+begin
+ //Result := FSpeedButton.GroupIndex;
+end;
+
+//function TfrxSpeedButtonControl.GetLayout: TButtonLayout;
+//begin
+// //Result := FSpeedButton.Layout;
+//end;
+
+function TfrxSpeedButtonControl.GetMargin: Integer;
+begin
+ //Result := FSpeedButton.Margin;
+end;
+
+function TfrxSpeedButtonControl.GetSpacing: Integer;
+begin
+ //Result := FSpeedButton.Spacing;
+end;
+
+procedure TfrxSpeedButtonControl.SetAllowAllUp(const Value: Boolean);
+begin
+ // FSpeedButton.AllowAllUp := Value;
+end;
+
+procedure TfrxSpeedButtonControl.SetDown(const Value: Boolean);
+begin
+ //FSpeedButton.Down := Value;
+end;
+
+procedure TfrxSpeedButtonControl.SetFlat(const Value: Boolean);
+begin
+ //FSpeedButton.Flat := Value;
+end;
+
+procedure TfrxSpeedButtonControl.SetGlyph(const Value: TBitmap);
+begin
+ //FSpeedButton.Glyph := Value;
+end;
+
+procedure TfrxSpeedButtonControl.SetGroupIndex(const Value: Integer);
+begin
+ //FSpeedButton.GroupIndex := Value;
+end;
+
+//procedure TfrxSpeedButtonControl.SetLayout(const Value: TButtonLayout);
+//begin
+// FSpeedButton.Layout := Value;
+//end;
+
+procedure TfrxSpeedButtonControl.SetMargin(const Value: Integer);
+begin
+ //FSpeedButton.Margin := Value;
+end;
+
+procedure TfrxSpeedButtonControl.SetSpacing(const Value: Integer);
+begin
+ //FSpeedButton.Spacing := Value;
+end;
+}
+
+{ TfrxMaskEditControl }
+ {
+constructor TfrxMaskEditControl.Create(AOwner: TComponent);
+begin
+ FMaskEdit := TMaskEdit.Create(nil);
+ FCustomEdit := FMaskEdit;
+ inherited;
+
+ Width := 121;
+ Height := 21;
+end;
+
+class function TfrxMaskEditControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obMEdit');
+end;
+
+function TfrxMaskEditControl.GetEditMask: String;
+begin
+ Result := FMaskEdit.EditMask;
+end;
+
+procedure TfrxMaskEditControl.SetEditMask(const Value: String);
+begin
+ FMaskEdit.EditMask := Value;
+end;
+
+ }
+{ TfrxCheckListBoxControl }
+ {
+constructor TfrxCheckListBoxControl.Create(AOwner: TComponent);
+begin
+ inherited;
+ FCheckListBox := TCheckListBox.Create(nil);
+ InitControl(FCheckListBox);
+
+ Width := 121;
+ Height := 97;
+end;
+
+class function TfrxCheckListBoxControl.GetDescription: String;
+begin
+ Result := frxResources.Get('obChLB');
+end;
+
+function TfrxCheckListBoxControl.GetAllowGrayed: Boolean;
+begin
+ Result := FCheckListBox.AllowGrayed;
+end;
+
+function TfrxCheckListBoxControl.GetItems: TStrings;
+begin
+ Result := FCheckListBox.Items;
+end;
+
+function TfrxCheckListBoxControl.GetSorted: Boolean;
+begin
+ Result := FCheckListBox.Sorted;
+end;
+
+function TfrxCheckListBoxControl.GetChecked(Index: Integer): Boolean;
+begin
+ Result := FCheckListBox.Checked[Index];
+end;
+
+function TfrxCheckListBoxControl.GetState(Index: Integer): TCheckBoxState;
+begin
+ Result := FCheckListBox.State[Index];
+end;
+
+procedure TfrxCheckListBoxControl.SetAllowGrayed(const Value: Boolean);
+begin
+ FCheckListBox.AllowGrayed := Value;
+end;
+
+procedure TfrxCheckListBoxControl.SetItems(const Value: TStrings);
+begin
+ FCheckListBox.Items := Value;
+end;
+
+procedure TfrxCheckListBoxControl.SetSorted(const Value: Boolean);
+begin
+ FCheckListBox.Sorted := Value;
+end;
+
+procedure TfrxCheckListBoxControl.SetChecked(Index: Integer; const Value: Boolean);
+begin
+ FCheckListBox.Checked[Index] := Value;
+end;
+
+procedure TfrxCheckListBoxControl.SetState(Index: Integer; const Value: TCheckBoxState);
+begin
+ FCheckListBox.State[Index] := Value;
+end;
+
+function TfrxCheckListBoxControl.GetItemIndex: Integer;
+begin
+ Result := FCheckListBox.ItemIndex;
+end;
+
+procedure TfrxCheckListBoxControl.SetItemIndex(const Value: Integer);
+begin
+ FCheckListBox.ItemIndex := Value;
+end;
+ }
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxDialogControls, TFmxObject);
+ frxObjects.RegisterObject1(TfrxLabelControl, nil, '', '', 0, 112);
+ frxObjects.RegisterObject1(TfrxEditControl, nil, '', '', 0, 113);
+ frxObjects.RegisterObject1(TfrxMemoControl, nil, '', '', 0, 114);
+ frxObjects.RegisterObject1(TfrxButtonControl, nil, '', '', 0, 115);
+ frxObjects.RegisterObject1(TfrxCheckBoxControl, nil, '', '', 0, 116);
+ frxObjects.RegisterObject1(TfrxRadioButtonControl, nil, '', '', 0, 117);
+ frxObjects.RegisterObject1(TfrxListBoxControl, nil, '', '', 0, 118);
+ frxObjects.RegisterObject1(TfrxComboBoxControl, nil, '', '', 0, 119);
+ frxObjects.RegisterObject1(TfrxPanelControl, nil, '', '', 0, 144);
+ frxObjects.RegisterObject1(TfrxGroupBoxControl, nil, '', '', 0, 143);
+
+ frxObjects.RegisterObject1(TfrxDateEditControl, nil, '', '', 0, 145);
+ frxObjects.RegisterObject1(TfrxImageControl, nil, '', '', 0, 103);
+ //frxObjects.RegisterObject1(TfrxBevelControl, nil, '', '', 0, 33);
+ //frxObjects.RegisterObject1(TfrxBitBtnControl, nil, '', '', 0, 115);
+ //frxObjects.RegisterObject1(TfrxSpeedButtonControl, nil, '', '', 0, 115);
+{ frxObjects.RegisterObject1(TfrxMaskEditControl, nil, '', '', 0, 47);
+ frxObjects.RegisterObject1(TfrxCheckListBoxControl, nil, '', '', 0, 48); }
+
+
+
+end.
diff --git a/LibD28x64/FMX.frxDCtrlRTTI.pas b/LibD28x64/FMX.frxDCtrlRTTI.pas
new file mode 100644
index 0000000..bdb19d2
--- /dev/null
+++ b/LibD28x64/FMX.frxDCtrlRTTI.pas
@@ -0,0 +1,130 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Dialog controls RTTI }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDCtrlRTTI;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, System.SysUtils, FMX.Forms, FMX.fs_iinterpreter, FMX.fs_iformsrtti,
+ FMX.frxDCtrl, FMX.frxClassRTTI, System.Variants, System.Types;
+
+
+type
+ TFunctions = class(TfsRTTIModule)
+ private
+// function CallMethod(Instance: TObject; ClassType: TClass;
+// const MethodName: String; Caller: TfsMethodHelper): Variant;
+ function GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+ procedure SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+ public
+ constructor Create(AScript: TfsScript); override;
+ end;
+
+
+{ TFunctions }
+
+constructor TFunctions.Create(AScript: TfsScript);
+begin
+ inherited Create(AScript);
+ with AScript do
+ begin
+ AddClass(TfrxLabelControl, 'TfrxDialogControl');
+ AddClass(TfrxEditControl, 'TfrxDialogControl');
+ AddClass(TfrxMemoControl, 'TfrxDialogControl');
+ AddClass(TfrxButtonControl, 'TfrxDialogControl');
+ AddClass(TfrxCheckBoxControl, 'TfrxDialogControl');
+ AddClass(TfrxRadioButtonControl, 'TfrxDialogControl');
+ with AddClass(TfrxListBoxControl, 'TfrxDialogControl') do
+ AddProperty('ItemIndex', 'Integer', GetProp, SetProp);
+ AddClass(TfrxComboBoxControl, 'TfrxDialogControl');
+ AddClass(TfrxDateEditControl, 'TfrxDialogControl');
+ AddClass(TfrxImageControl, 'TfrxDialogControl');
+ AddClass(TfrxBevelControl, 'TfrxDialogControl');
+ AddClass(TfrxPanelControl, 'TfrxDialogControl');
+ AddClass(TfrxGroupBoxControl, 'TfrxDialogControl');
+ AddClass(TfrxBitBtnControl, 'TfrxDialogControl');
+// AddClass(TfrxSpeedButtonControl, 'TfrxDialogControl');
+ //AddClass(TfrxMaskEditControl, 'TfrxDialogControl');
+ {with AddClass(TfrxCheckListBoxControl, 'TfrxDialogControl') do
+ begin
+ AddIndexProperty('Checked', 'Integer', 'Boolean', CallMethod);
+ AddIndexProperty('State', 'Integer', 'TCheckBoxState', CallMethod);
+ AddProperty('ItemIndex', 'Integer', GetProp, SetProp);
+ end; }
+ end;
+end;
+
+//function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
+// const MethodName: String; Caller: TfsMethodHelper): Variant;
+//begin
+// Result := 0;
+//
+// {if ClassType = TfrxCheckListBoxControl then
+// begin
+// if MethodName = 'CHECKED.GET' then
+// Result := TfrxCheckListBoxControl(Instance).Checked[Caller.Params[0]]
+// else if MethodName = 'CHECKED.SET' then
+// TfrxCheckListBoxControl(Instance).Checked[Caller.Params[0]] := Caller.Params[1]
+// else if MethodName = 'STATE.GET' then
+// Result := TfrxCheckListBoxControl(Instance).State[Caller.Params[0]]
+// else if MethodName = 'STATE.SET' then
+// TfrxCheckListBoxControl(Instance).State[Caller.Params[0]] := Caller.Params[1]
+// end }
+//end;
+
+function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String): Variant;
+begin
+ Result := 0;
+
+ if ClassType = TfrxListBoxControl then
+ begin
+ if PropName = 'ITEMINDEX' then
+ Result := TfrxListBoxControl(Instance).ItemIndex
+ end
+ { else if ClassType = TfrxCheckListBoxControl then
+ begin
+ if PropName = 'ITEMINDEX' then
+ Result := TfrxCheckListBoxControl(Instance).ItemIndex
+ end }
+end;
+
+procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
+ const PropName: String; Value: Variant);
+begin
+ if ClassType = TfrxListBoxControl then
+ begin
+ if PropName = 'ITEMINDEX' then
+ TfrxListBoxControl(Instance).ItemIndex := Value;
+ end
+ {else if ClassType = TfrxCheckListBoxControl then
+ begin
+ if PropName = 'ITEMINDEX' then
+ TfrxCheckListBoxControl(Instance).ItemIndex := Value;
+ end }
+end;
+
+
+initialization
+ fsRTTIModules.Add(TFunctions);
+
+finalization
+ fsRTTIModules.Remove(TFunctions);
+
+end.
diff --git a/LibD28x64/FMX.frxDMPClass.pas b/LibD28x64/FMX.frxDMPClass.pas
new file mode 100644
index 0000000..525d192
--- /dev/null
+++ b/LibD28x64/FMX.frxDMPClass.pas
@@ -0,0 +1,491 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ DotMatrix printers stuff }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDMPClass;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Types, System.Variants,
+ FMX.frxClass;
+
+
+type
+ TfrxDMPFontStyle = (fsxBold, fsxItalic, fsxUnderline, fsxSuperScript,
+ fsxSubScript, fsxCondensed, fsxWide, fsx12cpi, fsx15cpi);
+ TfrxDMPFontStyles = set of TfrxDMPFontStyle;
+
+ TfrxDMPMemoView = class(TfrxCustomMemoView)
+ private
+ FFontStyle: TfrxDMPFontStyles;
+ FTruncOutboundText: Boolean;
+ procedure SetFontStyle(const Value: TfrxDMPFontStyles);
+ function IsFontStyleStored: Boolean;
+ protected
+ procedure DrawFrame; override;
+ procedure SetLeft(Value: Double); override;
+ procedure SetTop(Value: Double); override;
+ procedure SetWidth(Value: Double); override;
+ procedure SetHeight(Value: Double); override;
+ procedure SetParentFont(const Value: Boolean); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ procedure ResetFontOptions;
+ procedure SetBoundsDirect(ALeft, ATop, AWidth, AHeight: Double);
+ function CalcHeight: Double; override;
+ function CalcWidth: Double; override;
+ function Diff(AComponent: TfrxComponent): String; override;
+ function GetoutBoundText: String;
+ published
+ property AutoWidth;
+ property AllowExpressions;
+ property DataField;
+ property DataSet;
+ property DataSetName;
+ property DisplayFormat;
+ property ExpressionDelimiters;
+ property FlowTo;
+ property FontStyle: TfrxDMPFontStyles read FFontStyle write SetFontStyle
+ stored IsFontStyleStored;
+ property Frame;
+ property HAlign;
+ property HideZeros;
+ property Memo;
+ property ParentFont;
+ property RTLReading;
+ property SuppressRepeated;
+ property WordWrap;
+ property TruncOutboundText: Boolean read FTruncOutboundText write FTruncOutboundText;
+ property VAlign;
+ end;
+
+ TfrxDMPLineView = class(TfrxCustomLineView)
+ private
+ FFontStyle: TfrxDMPFontStyles;
+ procedure SetFontStyle(const Value: TfrxDMPFontStyles);
+ function IsFontStyleStored: Boolean;
+ protected
+ procedure SetLeft(Value: Double); override;
+ procedure SetTop(Value: Double); override;
+ procedure SetWidth(Value: Double); override;
+ procedure SetParentFont(const Value: Boolean); override;
+ public
+ class function GetDescription: String; override;
+ function Diff(AComponent: TfrxComponent): String; override;
+ published
+ property FontStyle: TfrxDMPFontStyles read FFontStyle write SetFontStyle
+ stored IsFontStyleStored;
+ property ParentFont;
+ end;
+
+ TfrxDMPCommand = class(TfrxView)
+ private
+ FCommand: String;
+ protected
+ procedure SetLeft(Value: Double); override;
+ procedure SetTop(Value: Double); override;
+ public
+ class function GetDescription: String; override;
+ function Diff(AComponent: TfrxComponent): String; override;
+ function ToChr: String;
+ published
+ property Command: String read FCommand write FCommand;
+ end;
+
+ TfrxDMPPage = class(TfrxReportPage)
+ private
+ FFontStyle: TfrxDMPFontStyles;
+ procedure SetFontStyle(const Value: TfrxDMPFontStyles);
+ protected
+ procedure SetPaperHeight(const Value: Double); override;
+ procedure SetPaperWidth(const Value: Double); override;
+ procedure SetPaperSize(const Value: Integer); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure SetDefaults; override;
+ procedure ResetFontOptions;
+ published
+ property FontStyle: TfrxDMPFontStyles read FFontStyle write SetFontStyle;
+ end;
+
+
+implementation
+
+uses
+ FMX.frxRes, FMX.frxDsgnIntf, FMX.frxXML, FMX.frxFMX;
+
+
+function DiffFontStyle(f: TfrxDMPFontStyles): String;
+var
+ fs: Integer;
+begin
+ fs := 0;
+ if fsxBold in f then fs := 1;
+ if fsxItalic in f then fs := fs or 2;
+ if fsxUnderline in f then fs := fs or 4;
+ if fsxSuperScript in f then fs := fs or 8;
+ if fsxSubScript in f then fs := fs or 16;
+ if fsxCondensed in f then fs := fs or 32;
+ if fsxWide in f then fs := fs or 64;
+ if fsx12cpi in f then fs := fs or 128;
+ if fsx15cpi in f then fs := fs or 256;
+ Result := ' FontStyle="' + String(IntToStr(fs)) + '"';
+end;
+
+
+{ TfrxDMPMemoView }
+
+constructor TfrxDMPMemoView.Create(AOwner: TComponent);
+begin
+ inherited;
+ ResetFontOptions;
+end;
+
+class function TfrxDMPMemoView.GetDescription: String;
+begin
+ Result := frxResources.Get('obDMPText');
+end;
+
+procedure TfrxDMPMemoView.ResetFontOptions;
+begin
+ Font.OnChange := nil;
+ Font.Name := 'Courier New';
+ Font.Size := 12;
+ Font.Style := [];
+ if fsxBold in FFontStyle then
+ Font.Style := Font.Style + [fsBold];
+ if fsxItalic in FFontStyle then
+ Font.Style := Font.Style + [fsItalic];
+ if fsxUnderline in FFontStyle then
+ Font.Style := Font.Style + [fsUnderline];
+ CharSpacing := 0;
+ LineSpacing := 1;
+ GapX := 0;
+ GapY := 0;
+end;
+
+procedure TfrxDMPMemoView.SetHeight(Value: Double);
+begin
+ Value := Round(Value / fr1CharY) * fr1CharY;
+ inherited;
+end;
+
+procedure TfrxDMPMemoView.SetLeft(Value: Double);
+begin
+ if Align = baRight then
+ Value := Trunc(Value / fr1CharX) * fr1CharX else
+ Value := Round(Value / fr1CharX) * fr1CharX;
+ inherited;
+end;
+
+procedure TfrxDMPMemoView.SetTop(Value: Double);
+begin
+ Value := Round(Value / fr1CharY) * fr1CharY;
+ inherited;
+end;
+
+procedure TfrxDMPMemoView.SetWidth(Value: Double);
+begin
+ Value := Round(Value / fr1CharX) * fr1CharX;
+ inherited;
+end;
+
+procedure TfrxDMPMemoView.SetFontStyle(const Value: TfrxDMPFontStyles);
+begin
+ FFontStyle := Value;
+ ParentFont := False;
+ ResetFontOptions;
+end;
+
+procedure TfrxDMPMemoView.SetParentFont(const Value: Boolean);
+begin
+ inherited;
+ if Value then
+ if Page is TfrxDMPPage then
+ FFontStyle := TfrxDMPPage(Page).FontStyle;
+end;
+
+function TfrxDMPMemoView.IsFontStyleStored: Boolean;
+begin
+ Result := not ParentFont;
+end;
+
+procedure TfrxDMPMemoView.DrawFrame;
+begin
+ FX := Round((AbsLeft - fr1CharX / 2) * FScaleX + FOffsetX);
+ FY := Round((AbsTop - fr1CharY / 2) * FScaleY + FOffsetY);
+ FX1 := Round((AbsLeft + Width + fr1CharX / 2) * FScaleX + FOffsetX);
+ FY1 := Round((AbsTop + Height + fr1CharY / 2) * FScaleY + FOffsetY);
+ inherited;
+end;
+
+function TfrxDMPMemoView.CalcHeight: Double;
+begin
+ Result := inherited CalcHeight;
+ Result := Round(Result / fr1CharY) * fr1CharY;
+end;
+
+function TfrxDMPMemoView.CalcWidth: Double;
+begin
+ Result := inherited CalcWidth;
+ Result := Round(Result / fr1CharX) * fr1CharX;
+end;
+
+function TfrxDMPMemoView.Diff(AComponent: TfrxComponent): String;
+var
+ m: TfrxDMPMemoView;
+begin
+ Result := inherited Diff(AComponent);
+ m := TfrxDMPMemoView(AComponent);
+ if FFontStyle <> m.FontStyle then
+ Result := Result + DiffFontStyle(FFontStyle);
+end;
+
+procedure TfrxDMPMemoView.SetBoundsDirect(ALeft, ATop, AWidth, AHeight: Double);
+begin
+ inherited SetLeft(ALeft);
+ inherited SetTop(ATop);
+ inherited SetWidth(AWidth);
+ inherited SetHeight(AHeight);
+end;
+
+function TfrxDMPMemoView.GetoutBoundText: String;
+var
+ idx, mH: Integer;
+begin
+ Result := '';
+ mH := Round(Height/fr1CharY);
+ for idx := 0 to Memo.Count - 1 do
+ if mH >= idx + 1 then
+ begin
+ Result := Result + Copy(Memo.Strings[idx], 1, Round(Width/fr1CharX)) + #13#10;
+ end;
+end;
+
+{ TfrxDMPLineView }
+
+class function TfrxDMPLineView.GetDescription: String;
+begin
+ Result := frxResources.Get('obDMPLine');
+end;
+
+procedure TfrxDMPLineView.SetLeft(Value: Double);
+begin
+ if Value < 0 then
+ Value := Trunc(Value / fr1CharX) * fr1CharX - fr1CharX / 2
+ else if Align = baRight then
+ Value := Round(Value / fr1CharX) * fr1CharX - fr1CharX / 2
+ else
+ Value := Trunc(Value / fr1CharX) * fr1CharX + fr1CharX / 2;
+ inherited;
+end;
+
+procedure TfrxDMPLineView.SetTop(Value: Double);
+begin
+ Value := Trunc(Value / fr1CharY) * fr1CharY + fr1CharY / 2;
+ inherited;
+end;
+
+procedure TfrxDMPLineView.SetWidth(Value: Double);
+begin
+ if Align = baWidth then
+ Value := Trunc(Value / fr1CharX) * fr1CharX
+ else
+ Value := Round(Value / fr1CharX) * fr1CharX;
+ inherited;
+end;
+
+procedure TfrxDMPLineView.SetFontStyle(const Value: TfrxDMPFontStyles);
+begin
+ FFontStyle := Value;
+ ParentFont := False;
+end;
+
+procedure TfrxDMPLineView.SetParentFont(const Value: Boolean);
+begin
+ inherited;
+ if Value then
+ if Page is TfrxDMPPage then
+ FFontStyle := TfrxDMPPage(Page).FontStyle;
+end;
+
+function TfrxDMPLineView.IsFontStyleStored: Boolean;
+begin
+ Result := not ParentFont;
+end;
+
+function TfrxDMPLineView.Diff(AComponent: TfrxComponent): String;
+var
+ l: TfrxDMPLineView;
+begin
+ Result := inherited Diff(AComponent);
+ l := TfrxDMPLineView(AComponent);
+ if FFontStyle <> l.FontStyle then
+ Result := Result + DiffFontStyle(FFontStyle);
+end;
+
+
+{ TfrxDMPCommand }
+
+class function TfrxDMPCommand.GetDescription: String;
+begin
+ Result := frxResources.Get('obDMPCmd');
+end;
+
+procedure TfrxDMPCommand.SetLeft(Value: Double);
+begin
+ Value := Round(Value / fr1CharX) * fr1CharX;
+ inherited;
+end;
+
+procedure TfrxDMPCommand.SetTop(Value: Double);
+begin
+ Value := Round(Value / fr1CharY) * fr1CharY;
+ inherited;
+end;
+
+function TfrxDMPCommand.Diff(AComponent: TfrxComponent): String;
+begin
+ Result := inherited Diff(AComponent);
+ if FCommand <> TfrxDMPCommand(AComponent).Command then
+ Result := Result + frxStrToXML(FCommand);
+end;
+
+function TfrxDMPCommand.ToChr: String;
+var
+ i: Integer;
+ s, s1: String;
+begin
+ Result := '';
+ s := FCommand;
+ s1 := '';
+ if Pos('#', s) = 1 then
+ begin
+ s := s + '#';
+ for i := 2 to Length(s) do
+ if s[i] = '#' then
+ begin
+ Result := Result + Chr(StrToInt(s1));
+ s1 := '';
+ end
+ else
+ s1 := s1 + s[i];
+ end
+ else
+ begin
+ for i := 1 to Length(s) do
+ begin
+ s1 := s1 + s[i];
+ if i mod 2 = 0 then
+ begin
+ Result := Result + Chr(StrToInt('$' + s1));
+ s1 := '';
+ end;
+ end;
+ end;
+end;
+
+
+{ TfrxDMPPage }
+
+constructor TfrxDMPPage.Create(AOwner: TComponent);
+begin
+ inherited;
+ ResetFontOptions;
+end;
+
+procedure TfrxDMPPage.ResetFontOptions;
+begin
+ Font.OnChange := nil;
+ Font.Name := 'Courier New';
+ Font.Size := 12;
+ Font.Style := [];
+ if fsxBold in FFontStyle then
+ Font.Style := Font.Style + [fsBold];
+ if fsxItalic in FFontStyle then
+ Font.Style := Font.Style + [fsItalic];
+ if fsxUnderline in FFontStyle then
+ Font.Style := Font.Style + [fsUnderline];
+end;
+
+procedure TfrxDMPPage.SetDefaults;
+begin
+ inherited;
+ LeftMargin := fr1CharX / fr01cm;
+ RightMargin := fr1CharX / fr01cm;
+ TopMargin := fr1CharY / fr01cm;
+ BottomMargin := fr1CharY / fr01cm;
+ FPaperWidth := Trunc(FPaperWidth * fr01cm / fr1CharX) * fr1CharX / fr01cm;
+ FPaperHeight := Trunc(FPaperHeight * fr01cm / fr1CharY) * fr1CharY / fr01cm;
+ UpdateDimensions;
+end;
+
+procedure TfrxDMPPage.SetFontStyle(const Value: TfrxDMPFontStyles);
+var
+ i: Integer;
+ l: TList;
+ c: TfrxComponent;
+begin
+ FFontStyle := Value;
+ ResetFontOptions;
+
+ l := AllObjects;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if c.ParentFont then
+ c.ParentFont := True;
+ end;
+end;
+
+procedure TfrxDMPPage.SetPaperHeight(const Value: Double);
+begin
+ inherited;
+ FPaperHeight := Round(FPaperHeight * fr01cm / fr1CharY) * fr1CharY / fr01cm;
+ UpdateDimensions;
+end;
+
+procedure TfrxDMPPage.SetPaperSize(const Value: Integer);
+begin
+ inherited;
+ FPaperWidth := Round(FPaperWidth * fr01cm / fr1CharX) * fr1CharX / fr01cm;
+ FPaperHeight := Round(FPaperHeight * fr01cm / fr1CharY) * fr1CharY / fr01cm;
+ UpdateDimensions;
+end;
+
+procedure TfrxDMPPage.SetPaperWidth(const Value: Double);
+begin
+ inherited;
+ FPaperWidth := Round(FPaperWidth * fr01cm / fr1CharX) * fr1CharX / fr01cm;
+ UpdateDimensions;
+end;
+
+
+initialization
+ RegisterFmxClasses([TfrxDMPPage]);
+ frxObjects.RegisterObject1(TfrxDMPMemoView, nil, '', '', 0, 2, [ctDMP]);
+ frxObjects.RegisterObject1(TfrxDMPLineView, nil, '', '', 0, 5, [ctDMP]);
+ frxObjects.RegisterObject1(TfrxDMPCommand, nil, '', '', 0, 21, [ctDMP]);
+
+finalization
+ UnRegisterClasses([TfrxDMPPage]);
+ frxObjects.UnRegister(TfrxDMPMemoView);
+ frxObjects.UnRegister(TfrxDMPLineView);
+ frxObjects.UnRegister(TfrxDMPCommand);
+
+
+end.
+
diff --git a/LibD28x64/FMX.frxDataTree.fmx b/LibD28x64/FMX.frxDataTree.fmx
new file mode 100644
index 0000000..4cab187
--- /dev/null
+++ b/LibD28x64/FMX.frxDataTree.fmx
@@ -0,0 +1,131 @@
+object frxDataTreeForm: TfrxDataTreeForm
+ Left = 0
+ Top = 0
+ Caption = 'Data Fields'
+ BorderStyle = bsNone
+ BorderIcons = []
+ ClientHeight = 697
+ ClientWidth = 254
+ Transparency = True
+ Visible = False
+ OnResize = FormResize
+ StyleLookup = 'backgroundstyle'
+ object MainDataPanel: TPanel
+ Align = alClient
+ Width = 254.000000000000000000
+ Height = 697.000000000000000000
+ OnDragEnd = MainDataPanelDragEnd
+ OnResize = FormResize
+ TabOrder = 0
+ object ClassesPn: TPanel
+ Position.Point = '(54,64)'
+ Width = 185.000000000000000000
+ Height = 261.000000000000000000
+ Visible = False
+ TabOrder = 0
+ end
+ object DataPn: TPanel
+ Position.Point = '(10,12)'
+ Width = 181.000000000000000000
+ Height = 301.000000000000000000
+ TabOrder = 1
+ object CBPanel: TPanel
+ Align = alBottom
+ Position.Point = '(0,248)'
+ Width = 181.000000000000000000
+ Height = 53.000000000000000000
+ Visible = False
+ TabOrder = 0
+ object InsFieldCB: TCheckBox
+ Position.Point = '(0,4)'
+ Width = 145.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 0
+ IsChecked = True
+ end
+ object InsCaptionCB: TCheckBox
+ Position.Point = '(0,20)'
+ Width = 145.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ object SortCB: TCheckBox
+ Position.Point = '(0,36)'
+ Width = 145.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = SortCBClick
+ TabOrder = 2
+ end
+ end
+ object NoDataL: TLabel
+ Position.Point = '(8,8)'
+ Width = 101.000000000000000000
+ Height = 41.000000000000000000
+ OnDblClick = DataTreeDblClick
+ TabOrder = 1
+ VertTextAlign = taLeading
+ end
+ end
+ object FunctionsPn: TPanel
+ Position.Point = '(38,44)'
+ Width = 185.000000000000000000
+ Height = 265.000000000000000000
+ Visible = False
+ TabOrder = 2
+ object Splitter1: TSplitter
+ Align = alBottom
+ Cursor = crVSplit
+ Position.Point = '(0,166)'
+ Width = 185.000000000000000000
+ Height = 3.000000000000000000
+ TabOrder = 0
+ MinSize = 20.000000000000000000
+ end
+ object HintPanel: TScrollBox
+ Align = alBottom
+ Position.Point = '(0,169)'
+ Width = 185.000000000000000000
+ Height = 96.000000000000000000
+ TabOrder = 1
+ object FunctionDescL: TLabel
+ Align = alClient
+ Position.Point = '(0,42)'
+ Width = 185.000000000000000000
+ Height = 54.000000000000000000
+ TabOrder = 0
+ end
+ object FunctionNameL: TLabel
+ Align = alTop
+ Width = 185.000000000000000000
+ Height = 42.000000000000000000
+ TabOrder = 1
+ Font.Style = [fsBold]
+ end
+ end
+ end
+ object VariablesPn: TPanel
+ Position.Point = '(22,28)'
+ Width = 185.000000000000000000
+ Height = 269.000000000000000000
+ Visible = False
+ TabOrder = 3
+ end
+ object Rectangle1: TRectangle
+ Align = alTop
+ Width = 254.000000000000000000
+ Height = 18.000000000000000000
+ Margins.Rect = '(2,1,0,0)'
+ Stroke.Kind = bkNone
+ object Label1: TLabel
+ Align = alClient
+ Position.Point = '(2,1)'
+ Width = 252.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 0
+ AutoSize = True
+ Text = 'Label1'
+ WordWrap = False
+ end
+ end
+ end
+end
diff --git a/LibD28x64/FMX.frxDataTree.pas b/LibD28x64/FMX.frxDataTree.pas
new file mode 100644
index 0000000..6d8b2f0
--- /dev/null
+++ b/LibD28x64/FMX.frxDataTree.pas
@@ -0,0 +1,765 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Data Tree tool window }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDataTree;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UiTypes, System.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.fs_xml, FMX.Types, FMX.Layouts, FMX.TreeView, FMX.frxFMX, FMX.TabControl
+, System.Variants, FMX.Objects
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+ TfrxDataTreeForm = class(TForm)
+ MainDataPanel: TPanel;
+ ClassesPn: TPanel;
+ DataPn: TPanel;
+ CBPanel: TPanel;
+ InsFieldCB: TCheckBox;
+ InsCaptionCB: TCheckBox;
+ SortCB: TCheckBox;
+ NoDataL: TLabel;
+ FunctionsPn: TPanel;
+ Splitter1: TSplitter;
+ HintPanel: TScrollBox;
+ FunctionDescL: TLabel;
+ FunctionNameL: TLabel;
+ VariablesPn: TPanel;
+ Rectangle1: TRectangle;
+ Label1: TLabel;
+ procedure FormResize(Sender: TObject);
+ //procedure DataTreeCustomDrawItem(Sender: TCustomTreeView;
+ // Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
+ procedure FunctionsTreeChange(Sender: TObject);
+ procedure DataTreeDblClick(Sender: TObject);
+ //procedure ClassesTreeExpanding(Sender: TObject; Node: TTreeNode;
+ // var AllowExpansion: Boolean);
+ //procedure ClassesTreeCustomDrawItem(Sender: TCustomTreeView;
+ // Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
+ procedure SortCBClick(Sender: TObject);
+ procedure MainDataPanelDragEnd(Sender: TObject);
+ private
+ { Private declarations }
+ FXML: TfsXMLDocument;
+ FReport: TfrxReport;
+ FUpdating: Boolean;
+ FFirstTime: Boolean;
+ DataTree: TfrxTreeView;
+ VariablesTree: TfrxTreeView;
+ FunctionsTree: TfrxTreeView;
+ ClassesTree: TfrxTreeView;
+ FTabs: TTabControl;
+
+ procedure FillClassesTree;
+ procedure FillDataTree;
+ procedure FillFunctionsTree;
+ procedure FillVariablesTree;
+ procedure TabsChange(Sender: TObject);
+ function GetCollapsedNodes: String;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure SetLastPosition(p: TPoint);
+ procedure ShowTab(Index: Integer);
+ procedure UpdateItems;
+ procedure UpdateSelection;
+ procedure UpdateSize;
+ function GetActivePage: Integer;
+ function GetFieldName: String;
+ function GetLastPosition: TPoint;
+ function IsDataField: Boolean;
+ property Report: TfrxReport read FReport write FReport;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.fs_iinterpreter, FMX.fs_itools, FMX.frxRes;
+
+type
+ THackTreeView = class(TCustomTreeView);
+
+var
+ CollapsedNodes: String;
+
+
+procedure SetImageIndex(Node: TfrxTreeViewItem; Index: Integer);
+begin
+ Node.OpenImageIndex := Index;
+ Node.CloseImageIndex := Index;
+end;
+
+
+{ TfrxDataTreeForm }
+
+constructor TfrxDataTreeForm.Create(AOwner: TComponent);
+var
+ aTabItem: TTabItem;
+begin
+ inherited;
+ //FImages := frxResources.MainButtonImages;
+ DataTree := TfrxTreeView.Create(Self);
+
+ DataTree.Parent := DataPn;
+ DataTree.Align := TAlignLayout.alClient;
+ DataTree.OnDblClick := DataTreeDblClick;
+{$IFDEF DELPHI18}
+ DataTree.DragMode := TDragMode.dmManual;
+ DataPn.Margins.Top := Rectangle1.Height;
+ DataTree.ManualDragAndDrop := True;
+{$ELSE}
+ DataTree.DragMode := TDragMode.dmAutomatic;
+{$ENDIF}
+ DataTree.SetImages(frxResources.Images);
+ DataTree.AutoCapture := False;
+
+ VariablesTree := TfrxTreeView.Create(Self);
+ VariablesTree.Parent := VariablesPn;
+ VariablesTree.Align := TAlignLayout.alClient;
+ VariablesTree.OnDblClick := DataTreeDblClick;
+{$IFDEF DELPHI18}
+ VariablesTree.DragMode := TDragMode.dmManual;
+ VariablesTree.Margins.Top := Rectangle1.Height;
+ VariablesTree.ManualDragAndDrop := True;
+{$ELSE}
+ VariablesTree.DragMode := TDragMode.dmAutomatic;
+{$ENDIF}
+ VariablesTree.SetImages(frxResources.Images);
+ VariablesTree.AutoCapture := False;
+
+ FunctionsTree := TfrxTreeView.Create(Self);
+ FunctionsTree.Parent := FunctionsPn;
+ FunctionsTree.Align := TAlignLayout.alClient;
+ FunctionsTree.OnDblClick := DataTreeDblClick;
+ FunctionsTree.OnChange := FunctionsTreeChange;
+{$IFDEF DELPHI18}
+ FunctionsTree.DragMode := TDragMode.dmManual;
+ FunctionsTree.Margins.Top := Rectangle1.Height;
+ FunctionsTree.ManualDragAndDrop := True;
+{$ELSE}
+ FunctionsTree.DragMode := TDragMode.dmAutomatic;
+{$ENDIF}
+ FunctionsTree.SetImages(frxResources.Images);
+ FunctionsTree.AutoCapture := False;
+
+ ClassesTree := TfrxTreeView.Create(Self);
+ ClassesTree.Parent := ClassesPn;
+ ClassesTree.Align := TAlignLayout.alClient;
+ ClassesTree.OnDblClick := DataTreeDblClick;
+{$IFDEF DELPHI18}
+ ClassesTree.DragMode := TDragMode.dmManual;
+ ClassesTree.Margins.Top := Rectangle1.Height;
+ ClassesTree.ManualDragAndDrop := True;
+{$ELSE}
+ ClassesTree.DragMode := TDragMode.dmAutomatic;
+{$ENDIF}
+ ClassesTree.SetImages(frxResources.Images);
+ ClassesTree.AutoCapture := False;
+
+ FXML := TfsXMLDocument.Create;
+ FFirstTime := True;
+
+ FTabs := TTabControl.Create(Self);
+ FTabs.Parent := MainDataPanel;
+{$IFDEF Delphi17}
+ FTabs.TabHeight := 21;
+{$ENDIF}
+ FTabs.SetBounds(0, 0, 40, 20);
+ FTabs.Align := TAlignLayout.alTop;
+ MainDataPanel.StyleLookup := 'backgroundstyle';
+ CBPanel.StyleLookup := 'backgroundstyle';
+
+ Label1.Text := frxGet(2100);
+
+ aTabItem := TTabItem.Create(FTabs);
+ aTabItem.TagObject := DataPn;
+ aTabItem.Text := frxGet(2101);
+ FTabs.AddObject(aTabItem);
+
+ aTabItem := TTabItem.Create(FTabs);
+ aTabItem.TagObject := VariablesPn;
+ aTabItem.Text := frxGet(2102);
+ FTabs.AddObject(aTabItem);
+
+ aTabItem := TTabItem.Create(FTabs);
+ aTabItem.TagObject := FunctionsPn;
+ aTabItem.Text := frxGet(2103);
+ FTabs.AddObject(aTabItem);
+
+ aTabItem := TTabItem.Create(FTabs);
+ aTabItem.TagObject := ClassesPn;
+ aTabItem.Text := frxGet(2106);
+ FTabs.AddObject(aTabItem);
+
+ FTabs.TabIndex := 0;
+ InsFieldCB.Text := frxGet(2104);
+ InsCaptionCB.Text := frxGet(2105);
+ SortCB.Text := frxGet(6004);
+ FTabs.OnChange := TabsChange;
+
+end;
+
+destructor TfrxDataTreeForm.Destroy;
+begin
+ if Owner is TfrxCustomDesigner then
+ CollapsedNodes := GetCollapsedNodes;
+ FUpdating := True;
+ FXML.Free;
+ inherited;
+end;
+
+procedure TfrxDataTreeForm.FillDataTree;
+var
+ ds: TfrxDataSet;
+ DatasetsList, FieldsList: TStrings;
+ i, j: Integer;
+ Root, Node1, Node2: TfrxTreeViewItem;
+ s, Collapsed: String;
+
+begin
+ DatasetsList := TStringList.Create;
+ FieldsList := TStringList.Create;
+ TStringList(FieldsList).Sorted := SortCB.IsChecked;
+ TStringList(DatasetsList).Sorted := SortCB.IsChecked;
+
+ FReport.GetDataSetList(DatasetsList);
+
+ try
+ if FFirstTime then
+ Collapsed := CollapsedNodes
+ else
+ Collapsed := GetCollapsedNodes;
+
+ DataTree.BeginUpdate;
+ DataTree.Clear;
+ if DatasetsList.Count = 0 then
+ begin
+ NoDataL.Text := frxResources.Get('dtNoData') + #13#10#13#10 +
+ frxResources.Get('dtNoData1');
+ NoDataL.BringToFront;
+ NoDataL.Visible := True;
+ end
+ else
+ begin
+ NoDataL.Visible := False;
+ s := frxResources.Get('dtData');
+
+ Root := DataTree.AddItem(DataTree, s);// DataTree.Items.AddChild(nil, s);
+ SetImageIndex(Root, 72);
+
+ for i := 0 to DatasetsList.Count - 1 do
+ begin
+ if DatasetsList.Objects[i] is TfrxDataset then
+ ds := TfrxDataSet(DatasetsList.Objects[i])
+ else ds := nil;
+ if ds = nil then continue;
+ try
+ ds.GetFieldList(FieldsList);
+ except
+ end;
+
+ Node1 := DataTree.AddItem(Root, FReport.GetAlias(ds));//DataTree.Items.AddChild(Root, FReport.GetAlias(ds));
+ Node1.Data := ds;
+ SetImageIndex(Node1, 72);
+
+ for j := 0 to FieldsList.Count - 1 do
+ begin
+ Node2 := DataTree.AddItem(Node1, FieldsList[j]);//DataTree.Items.AddChild(Node1, FieldsList[j]);
+ Node2.Data := ds;
+ SetImageIndex(Node2, 54);
+ end;
+ end;
+ DataTree.Items[0].IsExpanded := True;
+ for i := 0 to DataTree.Items[0].Count - 1 do
+ begin
+ s := DataTree.Items[0][i].Text;
+ if Pos(s + ',', Collapsed) = 0 then
+ DataTree.Items[0][i].IsExpanded := True;
+ end;
+ end;
+ finally
+ DataTree.EndUpdate;
+ DatasetsList.Free;
+ FieldsList.Free;
+ end;
+end;
+
+procedure TfrxDataTreeForm.FillVariablesTree;
+var
+ CategoriesList, VariablesList: TStrings;
+ i: Integer;
+ Root, Node: TfrxTreeViewItem;
+
+ procedure AddVariables(Node: TfrxTreeViewItem);
+ var
+ i: Integer;
+ Node1: TfrxTreeViewItem;
+ begin
+ for i := 0 to VariablesList.Count - 1 do
+ begin
+ Node1 := VariablesTree.AddItem(Node, VariablesList[i]);
+ SetImageIndex(Node1, 224);
+ end;
+ end;
+
+ procedure AddSystemVariables;
+ var
+ SysNode: TfrxTreeViewItem;
+
+ procedure AddNode(const s: String);
+ var
+ Node: TfrxTreeViewItem;
+ begin
+ Node := VariablesTree.AddItem(SysNode, s);
+ SetImageIndex(Node, 224);
+ end;
+
+ begin
+ SysNode := VariablesTree.AddItem(Root, frxResources.Get('dtSysVar'));
+ SetImageIndex(SysNode, 66);
+
+ AddNode('Date');
+ AddNode('Time');
+ AddNode('Page');
+ AddNode('Page#');
+ AddNode('TotalPages');
+ AddNode('TotalPages#');
+ AddNode('Line');
+ AddNode('Line#');
+ AddNode('CopyName#');
+ end;
+
+begin
+ CategoriesList := TStringList.Create;
+ VariablesList := TStringList.Create;
+ FReport.Variables.GetCategoriesList(CategoriesList);
+
+ VariablesTree.BeginUpdate;
+ VariablesTree.Clear;
+ Root := VariablesTree.AddItem(VariablesTree, frxResources.Get('dtVar'));
+ SetImageIndex(Root, 66);
+
+ for i := 0 to CategoriesList.Count - 1 do
+ begin
+ FReport.Variables.GetVariablesList(CategoriesList[i], VariablesList);
+ Node := VariablesTree.AddItem(Root, CategoriesList[i]);
+ SetImageIndex(Node, 66);
+ AddVariables(Node);
+ end;
+
+ if CategoriesList.Count = 0 then
+ begin
+ FReport.Variables.GetVariablesList('', VariablesList);
+ AddVariables(Root);
+ end;
+
+ AddSystemVariables;
+
+ VariablesTree.ExpandAll;
+ //VariablesTree.TopItem := Root;
+ VariablesTree.EndUpdate;
+ CategoriesList.Free;
+ VariablesList.Free;
+end;
+
+procedure TfrxDataTreeForm.FillFunctionsTree;
+
+ procedure AddFunctions(xi: TfsXMLItem; Root: TfrxTreeViewItem);
+ var
+ i: Integer;
+ Node: TfrxTreeViewItem;
+ s: String;
+ begin
+ s := xi.Prop['text'];
+ if xi.Count = 0 then
+ s := Copy(s, Pos(' ', s) + 1, 255) else { function }
+ s := frxResources.Get(s); { category }
+
+ if CompareText(s, 'hidden') = 0 then Exit;
+ if Root = nil then
+ Node := FunctionsTree.AddItem(FunctionsTree, s)
+ else
+ Node := FunctionsTree.AddItem(Root, s);
+ if xi.Count = 0 then
+ Node.Data := xi;
+ if Root = nil then
+ Node.Text := frxResources.Get('dtFunc');
+ if xi.Count = 0 then
+ SetImageIndex(Node, 52) else
+ SetImageIndex(Node, 66);
+
+ for i := 0 to xi.Count - 1 do
+ AddFunctions(xi[i], Node);
+ end;
+
+begin
+ FUpdating := True;
+
+ FunctionsTree.BeginUpdate;
+ FunctionsTree.Clear;
+ AddFunctions(FXML.Root.FindItem('Functions'), nil);
+
+ FunctionsTree.ExpandAll;
+ //FunctionsTree.TopItem := FunctionsTree.Items[0];
+ FunctionsTree.EndUpdate;
+ FUpdating := False;
+end;
+
+procedure TfrxDataTreeForm.FillClassesTree;
+
+ procedure AddClasses(xi: TfsXMLItem; Root: TfrxTreeViewItem);
+ var
+ i: Integer;
+ Node: TfrxTreeViewItem;
+ s: String;
+ begin
+ s := xi.Prop['text'];
+
+
+
+
+ if Root = nil then
+ begin
+ Node := ClassesTree.AddItem(ClassesTree, s);
+ Node.Text := frxResources.Get('2106');
+ SetImageIndex(Node, 66);
+ end
+ else
+ begin
+ Node := ClassesTree.AddItem(Root, s);
+ SetImageIndex(Node, 78);
+ end;
+ Node.Data := xi;
+
+ if Root = nil then
+ begin
+ for i := 0 to xi.Count - 1 do
+ AddClasses(xi[i], Node);
+ end
+ else
+ ClassesTree.AddItem(Node, 'more...'); // do not localize
+ end;
+
+begin
+ FUpdating := True;
+
+ ClassesTree.BeginUpdate;
+ ClassesTree.Clear;
+ AddClasses(FXML.Root.FindItem('Classes'), nil);
+
+ //ClassesTree.TopItem := ClassesTree.Items[0];
+ //ClassesTree.TopItem.Expand(False);
+ ClassesTree.EndUpdate;
+ FUpdating := False;
+end;
+
+function TfrxDataTreeForm.GetCollapsedNodes: String;
+var
+ i: Integer;
+ s: String;
+begin
+ Result := '';
+ if DataTree.Count > 0 then
+ for i := 0 to DataTree.Count - 1 do
+ begin
+ if DataTree.Items[i] is TTreeViewItem then
+ begin
+ s := DataTree.Items[i].Text;
+ if not DataTree.Items[i].ISExpanded then
+ Result := Result + s + ',';
+ end;
+ end;
+end;
+
+function TfrxDataTreeForm.GetFieldName: String;
+var
+ i, n: Integer;
+ s: String;
+ Node: TfrxTreeViewItem;
+begin
+ Result := '';
+ if FTabs.TabIndex = 0 then // data
+ begin
+ Node := TfrxTreeViewItem(DataTree.Selected);
+ if (Node <> nil) and (Node.Count = 0) and (Node.Data <> nil) then
+ Result := '<' + FReport.GetAlias(TfrxDataSet(Node.Data)) +
+ '."' + Node.Text + '"' + '>';
+ end
+ else if FTabs.TabIndex = 1 then // variables
+ begin
+ Node := TfrxTreeViewItem(VariablesTree.Selected);
+ if (Node <> nil) and (Node.Count = 0) then
+ if Node.Data <> nil then
+ Result := Node.Text else
+ Result := '<' + Node.Text + '>';
+ end
+ else if FTabs.TabIndex = 2 then // functions
+ begin
+ if (FunctionsTree.Selected <> nil) and (FunctionsTree.Selected.Count = 0) then
+ begin
+ s := FunctionsTree.Selected.Text;
+ if Pos('(', s) <> 0 then
+ n := 1 else
+ n := 0;
+ for i := 1 to Length(s) do
+ if CharInSet(s[i], [',', ';']) then
+ Inc(n);
+
+ if n = 0 then
+ s := Copy(s, 1, Pos(':', s) - 1)
+ else
+ begin
+ s := Copy(s, 1, Pos('(', s));
+ for i := 1 to n - 1 do
+ s := s + ',';
+ s := s + ')';
+ end;
+ Result := s;
+ end;
+ end;
+end;
+
+function TfrxDataTreeForm.IsDataField: Boolean;
+begin
+ Result := FTabs.TabIndex = 0;
+end;
+
+procedure TfrxDataTreeForm.MainDataPanelDragEnd(Sender: TObject);
+begin
+ShowMessage('');
+end;
+
+procedure TfrxDataTreeForm.UpdateItems;
+begin
+// XE3 bug - reset TCustomTreeView.FHoveredItem
+ //THackTreeView(DataTree).MouseMove([], -1, -1);
+ //THackTreeView(VariablesTree).MouseMove([], -1, -1);
+ //THackTreeView(FunctionsTree).MouseMove([], -1, -1);
+ //THackTreeView(ClassesTree).MouseMove([], -1, -1);
+
+ FillDataTree;
+ FillVariablesTree;
+ FFirstTime := False;
+end;
+
+procedure TfrxDataTreeForm.FormResize(Sender: TObject);
+begin
+ UpdateSize;
+end;
+
+{procedure TfrxDataTreeForm.DataTreeCustomDrawItem(Sender: TCustomTreeView;
+ Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
+begin
+ if Node.Count <> 0 then
+ Sender.Canvas.Font.Style := [fsBold];
+end;
+
+procedure TfrxDataTreeForm.ClassesTreeCustomDrawItem(Sender: TCustomTreeView;
+ Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
+begin
+ if Node.Level = 0 then
+ Sender.Canvas.Font.Style := [fsBold];
+end;}
+
+procedure TfrxDataTreeForm.FunctionsTreeChange(Sender: TObject);
+var
+ xi: TfsXMLItem;
+ Node: TfrxTreeViewItem;
+begin
+ if FUpdating then Exit;
+ Node := TfrxTreeViewItem(FunctionsTree.Selected);
+ if (Node = nil) or (Node.Data = nil) then
+ begin
+ FunctionNameL.Text := '';
+ FunctionDescL.Text := '';
+ Exit;
+ end
+ else
+ begin
+ xi := TfsXMLItem(Node.Data);
+ FunctionNameL.Text := xi.Prop['text'];
+ FunctionDescL.Text := frxResources.Get(xi.Prop['description']);
+ FunctionNameL.AutoSize := True;
+ end;
+end;
+
+procedure TfrxDataTreeForm.DataTreeDblClick(Sender: TObject);
+begin
+ if Assigned(MainDataPanel.OnDblClick) then
+ MainDataPanel.OnDblClick(Sender);
+end;
+
+//procedure TfrxDataTreeForm.ClassesTreeExpanding(Sender: TObject;
+// Node: TfrxTreeViewItem; var AllowExpansion: Boolean);
+//var
+// i: Integer;
+// xi: TfsXMLItem;
+// s: String;
+// n: TfrxTreeViewItem;
+//begin
+// if (Node.Level = 1) and (Node.Data <> nil) then
+// begin
+// FUpdating := True;
+// ClassesTree.BeginUpdate;
+//
+// Node.;
+// xi := TfsXMLItem(Node.Data);
+// Node.Data := nil;
+//
+// for i := 0 to xi.Count - 1 do
+// begin
+// s := xi[i].Prop['text'];
+// n := ClassesTree.Items.AddChild(Node, s);
+// if Pos('property', s) = 1 then
+// SetImageIndex(n, 73)
+// else if Pos('event', s) = 1 then
+// SetImageIndex(n, 79)
+// else
+// SetImageIndex(n, 74);
+// end;
+//
+// ClassesTree.Items.EndUpdate;
+// FUpdating := False;
+// end;
+//end;
+
+function TfrxDataTreeForm.GetLastPosition: TPoint;
+var
+ Item: TTreeViewItem;
+begin
+ Result.X := FTabs.TabIndex;
+ Result.Y := 0;
+ Item := nil;
+ case Result.X of
+ 0: Item := DataTree.Items[0];
+ 1: Item := VariablesTree.Items[0];
+ 2: Item := FunctionsTree.Items[0];
+ 3: Item := ClassesTree.Items[0];
+ end;
+ if Item <> nil then
+ Result.Y := Item.GlobalIndex;
+end;
+
+procedure TfrxDataTreeForm.SetLastPosition(p: TPoint);
+begin
+ ShowTab(p.X);
+ case p.X of
+ 0: if DataTree.Count > 0 then DataTree.Selected := DataTree.Items[p.Y];
+ 1: if VariablesTree.Count > 0 then VariablesTree.Selected := VariablesTree.Items[p.Y];
+ 2: if FunctionsTree.Count > 0 then FunctionsTree.Selected := FunctionsTree.Items[p.Y];
+ 3: if ClassesTree.Count > 0 then ClassesTree.Selected := ClassesTree.Items[p.Y];
+ end;
+end;
+
+procedure TfrxDataTreeForm.TabsChange(Sender: TObject);
+begin
+ ShowTab(FTabs.TabIndex);
+end;
+
+procedure TfrxDataTreeForm.ShowTab(Index: Integer);
+var
+ i: Integer;
+begin
+ if (Index < 0) or (Index > FTabs.TabCount - 1) then Exit;
+ FTabs.TabIndex := Index;
+ for i := 0 to FTabs.TabCount - 1 do
+ TControl(FTabs.Tabs[i].TagObject).Visible := i = Index;
+
+ if FXML.Root.Count = 0 then
+ begin
+ FReport.Script.AddRTTI;
+ GenerateXMLContents(FReport.Script, FXML.Root);
+ end;
+
+ if (Index = 2) and (FunctionsTree.Count < 2) then
+ FillFunctionsTree;
+ if (Index = 3) and (ClassesTree.Count < 2) then
+ FillClassesTree;
+end;
+
+
+
+procedure TfrxDataTreeForm.UpdateSize;
+var
+ Y: Integer;
+begin
+ if FTabs = nil then Exit;
+
+ with FTabs.Parent do
+ begin
+ //if Screen.PixelsPerInch > 96 then
+ // Y := 26
+ //else
+ Y := 21;
+ FTabs.SetBounds(0, Rectangle1.Height, MainDataPanel.Width, Y);
+ Y := Round(FTabs.Position.Y + FTabs.Height);
+ DataPn.SetBounds(0, Y, MainDataPanel.Width, MainDataPanel.Height - Y);
+ VariablesPn.SetBounds(0, Y, MainDataPanel.Width, MainDataPanel.Height - Y+1);
+ FunctionsPn.SetBounds(0, Y, MainDataPanel.Width, MainDataPanel.Height - Y+1);
+ ClassesPn.SetBounds(0, Y, MainDataPanel.Width, MainDataPanel.Height - Y+1);
+ NoDataL.SetBounds(10, {$IFDEF DELPHI18}20{$ELSE}10{$ENDIF}, MainDataPanel.Width - 20, MainDataPanel.Height - Y);
+ end;
+ InsCaptionCB.Width := DataPn.Width;
+ SortCB.Width := DataPn.Width;
+ InsFieldCB.Width := DataPn.Width;
+ CBPanel.Width := DataPn.Width;
+ FunctionNameL.AutoSize := False;
+ FunctionNameL.AutoSize := True;
+end;
+
+function TfrxDataTreeForm.GetActivePage: Integer;
+begin
+ Result := FTabs.TabIndex;
+end;
+
+procedure TfrxDataTreeForm.UpdateSelection;
+var
+ i: Integer;
+begin
+ if GetActivePage = 0 then
+ begin
+ DataTree.Selected := nil;
+ if (Report.Designer.SelectedObjects.Count = 1) and
+ (TObject(Report.Designer.SelectedObjects[0]) is TfrxDataset) then
+ begin
+ if (DataTree.Count > 0) then
+ for i := 0 to DataTree.Items[0].Count - 1 do
+ if TfrxTreeViewItem(DataTree.Items[0].Items[i]).Data = Report.Designer.SelectedObjects[0] then
+ begin
+ DataTree.Selected := DataTree.Items[0].Items[i];
+ break;
+ end;
+ end;
+ end;
+end;
+
+procedure TfrxDataTreeForm.SortCBClick(Sender: TObject);
+begin
+ FillDataTree;
+end;
+
+end.
diff --git a/LibD28x64/FMX.frxDesgn.fmx b/LibD28x64/FMX.frxDesgn.fmx
new file mode 100644
index 0000000..d9271a3
--- /dev/null
+++ b/LibD28x64/FMX.frxDesgn.fmx
@@ -0,0 +1,1811 @@
+object frxDesignerForm: TfrxDesignerForm
+ Left = 0
+ Top = 0
+ Caption = 'Designer'
+ ClientHeight = 610
+ ClientWidth = 988
+ StyleBook = StyleBook1
+ OnActivate = FormActivate
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnCloseQuery = FormCloseQuery
+ OnKeyDown = FormKeyDown
+ OnMouseWheel = FormMouseWheel
+ OnResize = FormResize
+ object StatusBar: TStatusBar
+ Height = 19.000000000000000000
+ Position.Y = 591.000000000000000000
+ ShowSizeGrip = True
+ Width = 988.000000000000000000
+ OnDblClick = StatusBarDblClick
+ OnMouseDown = StatusBarMouseDown
+ end
+ object ObjectsTB1: TToolBar
+ Align = alLeft
+ Height = 513.000000000000000000
+ Position.Y = 78.000000000000000000
+ Width = 27.000000000000000000
+ end
+ object PagePopup: TPopupMenu
+ Left = 760
+ Top = 104
+ end
+ object MainMenu: TMenuBar
+ Align = alMostTop
+ Height = 24.000000000000000000
+ Width = 988.000000000000000000
+ object FileMenu: TMenuItem
+ Height = 24.000000000000000000
+ StyleLookup = 'menubaritemstyle'
+ Width = 16.000000000000000000
+ object NewMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 1
+ Width = 50.000000000000000000
+ OnClick = NewItemCmdExecute
+ end
+ object NewReportMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 1
+ Width = 50.000000000000000000
+ OnClick = NewReportCmdExecute
+ end
+ object NewPageMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 1
+ Width = 50.000000000000000000
+ OnClick = NewPageCmdExecute
+ end
+ object NewDialogMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 1
+ Width = 50.000000000000000000
+ OnClick = NewDialogCmdExecute
+ end
+ object OpenMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 2
+ Width = 50.000000000000000000
+ OnClick = OpenCmdExecute
+ end
+ object SaveMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 2
+ Width = 50.000000000000000000
+ OnClick = SaveCmdExecute
+ end
+ object SaveAsMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 2
+ Width = 50.000000000000000000
+ OnClick = SaveAsCmdExecute
+ end
+ object PreviewMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 3
+ Width = 50.000000000000000000
+ OnClick = PreviewCmdExecute
+ end
+ object PageSettingsMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 3
+ Width = 50.000000000000000000
+ OnClick = PageSettingsCmdExecute
+ end
+ object ExitMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 3
+ Width = 50.000000000000000000
+ OnClick = ExitCmdExecute
+ end
+ end
+ object EditMenu: TMenuItem
+ Height = 24.000000000000000000
+ Position.X = 16.000000000000000000
+ StyleLookup = 'menubaritemstyle'
+ Width = 16.000000000000000000
+ object UndoMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 4
+ Width = 50.000000000000000000
+ OnClick = UndoCmdExecute
+ end
+ object RedoMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 4
+ Width = 50.000000000000000000
+ OnClick = RedoCmdExecute
+ end
+ object CutMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = CutCmdExecute
+ end
+ object CopyMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = CopyCmdExecute
+ end
+ object PasteMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = PasteCmdExecute
+ end
+ object DeleteMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = DeleteCmdExecute
+ end
+ object DeletePageMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = DeletePageCmdExecute
+ end
+ object SelectAllMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = SelectAllCmdExecute
+ end
+ object GroupMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 7
+ Width = 50.000000000000000000
+ OnClick = GroupCmdExecute
+ end
+ object UngroupMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 7
+ Width = 50.000000000000000000
+ OnClick = UngroupCmdExecute
+ end
+ object EditMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 7
+ Width = 50.000000000000000000
+ OnClick = EditCmdExecute
+ end
+ object N2: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 7
+ Width = 50.000000000000000000
+ end
+ object FindMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 8
+ Width = 50.000000000000000000
+ OnClick = FindCmdExecute
+ end
+ object ReplaceMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 8
+ Width = 50.000000000000000000
+ OnClick = ReplaceCmdExecute
+ end
+ object FindNextMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 8
+ Width = 50.000000000000000000
+ OnClick = FindNextCmdExecute
+ end
+ object BringtoFrontMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 9
+ Width = 50.000000000000000000
+ OnClick = BringToFrontCmdExecute
+ end
+ object SendtoBackMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 9
+ Width = 50.000000000000000000
+ OnClick = SendToBackCmdExecute
+ end
+ end
+ object ReportMenu: TMenuItem
+ Height = 24.000000000000000000
+ Position.X = 32.000000000000000000
+ StyleLookup = 'menubaritemstyle'
+ Width = 16.000000000000000000
+ object ReportDataMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = ReportDataCmdExecute
+ end
+ object VariablesMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = VariablesCmdExecute
+ end
+ object ReportStylesMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = ReportStylesCmdExecute
+ end
+ object ReportSettingsMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = ReportOptionsCmdExecute
+ end
+ end
+ object ViewMenu: TMenuItem
+ Height = 24.000000000000000000
+ Position.X = 48.000000000000000000
+ StyleLookup = 'menubaritemstyle'
+ Width = 16.000000000000000000
+ object ShowRulersMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ AutoCheck = True
+ Width = 50.000000000000000000
+ OnClick = ShowRulersCmdExecute
+ end
+ object ShowGuidesMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ AutoCheck = True
+ Width = 50.000000000000000000
+ OnClick = ShowGuidesCmdExecute
+ end
+ object DeleteGuidesMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = DeleteGuidesCmdExecute
+ end
+ object OptionsMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = OptionsCmdExecute
+ end
+ end
+ object HelpMenu: TMenuItem
+ Height = 24.000000000000000000
+ Position.X = 64.000000000000000000
+ StyleLookup = 'menubaritemstyle'
+ Width = 16.000000000000000000
+ object AboutMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = AboutCmdExecute
+ end
+ end
+ end
+ object OpenDialog: TOpenDialog
+ Left = 304
+ Top = 104
+ end
+ object SaveDialog: TSaveDialog
+ Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing]
+ Left = 264
+ Top = 104
+ end
+ object TabPopup: TPopupMenu
+ Left = 832
+ Top = 120
+ object NewPageMI1: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = NewPageCmdExecute
+ TabOrder = 0
+ ShortCut = 0
+ end
+ object NewDialogMI1: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = NewDialogCmdExecute
+ TabOrder = 1
+ ShortCut = 0
+ end
+ object DeletePageMI1: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = DeletePageCmdExecute
+ TabOrder = 2
+ ShortCut = 0
+ end
+ object PageSettingsMI1: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = PageSettingsCmdExecute
+ TabOrder = 3
+ ShortCut = 0
+ end
+ end
+ object BandsPopup: TPopupMenu
+ Left = 936
+ Top = 208
+ object ReportTitleMI: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object ReportSummaryMI: TMenuItem
+ Tag = 1
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object PageHeaderMI: TMenuItem
+ Tag = 2
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object PageFooterMI: TMenuItem
+ Tag = 3
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object HeaderMI: TMenuItem
+ Tag = 4
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object FooterMI: TMenuItem
+ Tag = 5
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object MasterDataMI: TMenuItem
+ Tag = 6
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object DetailDataMI: TMenuItem
+ Tag = 7
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object SubdetailDataMI: TMenuItem
+ Tag = 8
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object Data4levelMI: TMenuItem
+ Tag = 9
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object Data5levelMI: TMenuItem
+ Tag = 10
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object Data6levelMI: TMenuItem
+ Tag = 11
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object GroupHeaderMI: TMenuItem
+ Tag = 12
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object GroupFooterMI: TMenuItem
+ Tag = 13
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object ChildMI: TMenuItem
+ Tag = 14
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object ColumnHeaderMI: TMenuItem
+ Tag = 15
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object ColumnFooterMI: TMenuItem
+ Tag = 16
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object OverlayMI: TMenuItem
+ Tag = 17
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object N3: TMenuItem
+ Height = 50.000000000000000000
+ Text = '-'
+ Width = 50.000000000000000000
+ end
+ object VerticalbandsMI: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ object HeaderMI1: TMenuItem
+ Tag = 104
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object FooterMI1: TMenuItem
+ Tag = 105
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object MasterDataMI1: TMenuItem
+ Tag = 106
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object DetailDataMI1: TMenuItem
+ Tag = 107
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object SubdetailDataMI1: TMenuItem
+ Tag = 108
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object GroupHeaderMI1: TMenuItem
+ Tag = 112
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object GroupFooterMI1: TMenuItem
+ Tag = 113
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object ChildMI1: TMenuItem
+ Tag = 114
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ end
+ end
+ object Timer: TTimer
+ Enabled = False
+ OnTimer = TimerTimer
+ Left = 488
+ Top = 96
+ end
+ object RotationPopup: TPopupMenu
+ Left = 632
+ Top = 96
+ object R0MI: TMenuItem
+ Tag = 30
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object R45MI: TMenuItem
+ Tag = 30
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object R90MI: TMenuItem
+ Tag = 30
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object R180MI: TMenuItem
+ Tag = 30
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object R270MI: TMenuItem
+ Tag = 30
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ end
+ object OpenScriptDialog: TOpenDialog
+ Left = 392
+ Top = 104
+ end
+ object SaveScriptDialog: TSaveDialog
+ Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing]
+ Left = 344
+ Top = 104
+ end
+ object ObjectsPopup: TPopupMenu
+ Left = 880
+ Top = 176
+ end
+ object DMPPopup: TPopupMenu
+ Left = 928
+ Top = 120
+ object BoldMI: TMenuItem
+ Tag = 34
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object ItalicMI: TMenuItem
+ Tag = 35
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object UnderlineMI: TMenuItem
+ Tag = 36
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object SuperScriptMI: TMenuItem
+ Tag = 37
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object SubScriptMI: TMenuItem
+ Tag = 38
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object CondensedMI: TMenuItem
+ Tag = 39
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object WideMI: TMenuItem
+ Tag = 40
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object N12cpiMI: TMenuItem
+ Tag = 41
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object N15cpiMI: TMenuItem
+ Tag = 42
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ end
+ object BackPanel: TPanel
+ Align = alClient
+ Height = 513.000000000000000000
+ Position.X = 27.000000000000000000
+ Position.Y = 78.000000000000000000
+ Width = 961.000000000000000000
+ object ScrollBoxPanel: TPanel
+ Height = 297.000000000000000000
+ Position.X = 65.000000000000000000
+ Position.Y = 95.000000000000000000
+ Width = 297.000000000000000000
+ object ScrollBox: TfrxScrollBox
+ Align = alClient
+ Height = 274.000000000000000000
+ Position.X = 23.000000000000000000
+ Position.Y = 23.000000000000000000
+ StyleLookup = 'ScrollBoxStyle1'
+ Width = 274.000000000000000000
+ OnResize = ScrollBoxResize
+ OnPositionChanged = ScrollBoxResize
+ end
+ object LeftRuler: TfrxRuler
+ Align = alLeft
+ Cursor = crHandPoint
+ DragMode = dmAutomatic
+ Height = 274.000000000000000000
+ Position.Y = 23.000000000000000000
+ Scale = 1.000000000000000000
+ StyleLookup = 'backgroundstyle'
+ Width = 23.000000000000000000
+ OnDragOver = TopRulerDragOver
+ Offset = 0
+ Start = 0
+ Units = ruCM
+ RulerSize = 0
+ end
+ object TopRuler: TfrxRuler
+ Align = alTop
+ Cursor = crHandPoint
+ DragMode = dmAutomatic
+ Height = 23.000000000000000000
+ Scale = 1.000000000000000000
+ StyleLookup = 'backgroundstyle'
+ Width = 297.000000000000000000
+ OnDragOver = TopRulerDragOver
+ Offset = 22
+ Start = 0
+ Units = ruCM
+ RulerSize = 0
+ end
+ end
+ object CodePanel: TPanel
+ Height = 289.000000000000000000
+ Position.X = 394.000000000000000000
+ Position.Y = 98.000000000000000000
+ Width = 377.000000000000000000
+ object CodeTB: TToolBar
+ Height = 25.000000000000000000
+ Width = 377.000000000000000000
+ object OpenScriptB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 169.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = OpenScriptBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object SaveScriptB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 192.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = SaveScriptBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object RunScriptB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 223.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = RunScriptBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object RunToCursorB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 246.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = RunToCursorBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object StepScriptB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 269.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = RunScriptBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object StopScriptB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 292.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = StopScriptBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object EvaluateB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 315.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = EvaluateBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object BreakPointB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 338.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = BreakPointBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object LangCB: TComboEdit
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 48.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 100.000000000000000000
+ Height = 20.000000000000000000
+ OnChange = LangCBClick
+ end
+ end
+ end
+ object TabPanel: TPanel
+ Align = alTop
+ Height = 24.000000000000000000
+ Width = 961.000000000000000000
+ end
+ object RightDockTB: TToolBar
+ Align = alRight
+ Height = 489.000000000000000000
+ Position.X = 816.000000000000000000
+ Position.Y = 24.000000000000000000
+ Width = 145.000000000000000000
+ OnResize = RightDockTBResize
+ end
+ object Splitter1: TSplitter
+ Align = alRight
+ Cursor = crHSplit
+ Height = 489.000000000000000000
+ MinSize = 20.000000000000000000
+ Position.X = 811.000000000000000000
+ Position.Y = 24.000000000000000000
+ Width = 5.000000000000000000
+ end
+ object LeftDockTB: TToolBar
+ Align = alLeft
+ Height = 489.000000000000000000
+ Position.Y = 24.000000000000000000
+ Width = 177.000000000000000000
+ OnResize = LeftDockTBResize
+ end
+ object Splitter2: TSplitter
+ Align = alLeft
+ Cursor = crHSplit
+ Height = 489.000000000000000000
+ MinSize = 20.000000000000000000
+ Position.X = 177.000000000000000000
+ Position.Y = 24.000000000000000000
+ Width = 5.000000000000000000
+ end
+ end
+ object TopToolBox: TToolBar
+ Align = alMostTop
+ Height = 54.000000000000000000
+ Position.Y = 24.000000000000000000
+ TabOrder = 3
+ Width = 988.000000000000000000
+ object AlignTB: TToolBar
+ Align = alNone
+ Height = 27.000000000000000000
+ Position.X = 526.000000000000000000
+ Width = 318.000000000000000000
+ object Grip1: TfrxToolGrip
+ Position.X = 4.000000000000000000
+ Position.Y = 6.000000000000000000
+ Width = 4.000000000000000000
+ Height = 14.000000000000000000
+ end
+ object AlignLeftsB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 8.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignLeftsBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 0
+ end
+ object AlignHorzCentersB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 31.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignHorzCentersBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 1
+ end
+ object AlignRightsB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 54.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignRightsBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 2
+ end
+ object Sep7: TfrxToolSeparator
+ Position.X = 80.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object AlignTopsB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 85.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignTopsBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 3
+ end
+ object AlignVertCentersB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 109.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignVertCentersBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 4
+ end
+ object AlignBottomsB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 131.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignBottomsBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 5
+ end
+ object Sep8: TfrxToolSeparator
+ Position.X = 157.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object SpaceHorzB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 162.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = SpaceHorzBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 6
+ end
+ object SpaceVertB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 185.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = SpaceVertBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 7
+ end
+ object Sep9: TfrxToolSeparator
+ Position.X = 211.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object CenterHorzB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 216.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = CenterHorzBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 8
+ end
+ object CenterVertB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 239.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = CenterVertBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 9
+ end
+ object Sep10: TfrxToolSeparator
+ Position.X = 265.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object SameWidthB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 270.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = SameWidthBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 10
+ end
+ object SameHeightB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 293.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = SameHeightBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 11
+ end
+ end
+ object ExtraToolsTB: TToolBar
+ Align = alNone
+ Height = 27.000000000000000000
+ Position.X = 877.000000000000000000
+ Visible = False
+ Width = 19.000000000000000000
+ end
+ object FrameTB: TToolBar
+ Align = alNone
+ Height = 27.000000000000000000
+ Position.X = 639.000000000000000000
+ Position.Y = 27.000000000000000000
+ Width = 308.000000000000000000
+ object Grip2: TfrxToolGrip
+ Position.X = 4.000000000000000000
+ Position.Y = 6.000000000000000000
+ Width = 4.000000000000000000
+ Height = 14.000000000000000000
+ end
+ object FrameTopB: TfrxToolButton
+ Tag = 20
+ Height = 22.000000000000000000
+ Position.X = 8.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 0
+ end
+ object FrameBottomB: TfrxToolButton
+ Tag = 21
+ Height = 22.000000000000000000
+ Position.X = 31.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 1
+ end
+ object FrameLeftB: TfrxToolButton
+ Tag = 22
+ Height = 22.000000000000000000
+ Position.X = 54.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 2
+ end
+ object FrameRightB: TfrxToolButton
+ Tag = 23
+ Height = 22.000000000000000000
+ Position.X = 77.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 3
+ end
+ object Sep14: TfrxToolSeparator
+ Position.X = 103.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object FrameAllB: TfrxToolButton
+ Tag = 24
+ Height = 22.000000000000000000
+ Position.X = 108.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 4
+ end
+ object FrameNoB: TfrxToolButton
+ Tag = 25
+ Height = 22.000000000000000000
+ Position.X = 131.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 21.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 5
+ end
+ object ShadowB: TfrxToolButton
+ Tag = 32
+ Height = 22.000000000000000000
+ Position.X = 154.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 6
+ end
+ object Sep15: TfrxToolSeparator
+ Position.X = 180.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object FillColorB: TfrxToolButton
+ Tag = 26
+ Height = 22.000000000000000000
+ Position.X = 185.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = FontColorBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 7
+ end
+ object FrameColorB: TfrxToolButton
+ Tag = 27
+ Height = 22.000000000000000000
+ Position.X = 208.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = FontColorBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 8
+ end
+ object FrameStyleB: TfrxToolButton
+ Tag = 28
+ Height = 22.000000000000000000
+ Position.X = 231.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = FrameStyleBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 9
+ end
+ object FrameWidthCB: TComboEdit
+ Tag = 29
+ TabOrder = 10
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ Items.Strings = (
+ '0,1'
+ '0,5'
+ '1'
+ '1,5'
+ '2'
+ '3'
+ '4'
+ '5'
+ '6'
+ '7'
+ '8'
+ '9'
+ '10')
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 256.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 49.000000000000000000
+ Height = 20.000000000000000000
+ OnChange = ToolButtonClick
+ OnKeyDown = FrameWidthCBKeyDown
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ end
+ end
+ object StandardTB: TToolBar
+ Align = alNone
+ Height = 27.000000000000000000
+ Width = 526.000000000000000000
+ object Grip3: TfrxToolGrip
+ Position.X = 4.000000000000000000
+ Position.Y = 6.000000000000000000
+ Width = 4.000000000000000000
+ Height = 14.000000000000000000
+ end
+ object NewB: TfrxToolButton
+ Tag = 40
+ Height = 22.000000000000000000
+ Position.X = 8.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = NewReportCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 0
+ end
+ object OpenB: TfrxToolButton
+ Tag = 41
+ Height = 22.000000000000000000
+ Position.X = 31.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = OpenCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 1
+ end
+ object SaveB: TfrxToolButton
+ Tag = 42
+ Height = 22.000000000000000000
+ Position.X = 54.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = SaveCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 2
+ end
+ object PreviewB: TfrxToolButton
+ Tag = 43
+ Height = 22.000000000000000000
+ Position.X = 77.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = PreviewCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 3
+ end
+ object Sep1: TfrxToolSeparator
+ Position.X = 103.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object NewPageB: TfrxToolButton
+ Tag = 52
+ Height = 22.000000000000000000
+ Position.X = 108.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = NewPageCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 4
+ end
+ object NewDialogB: TfrxToolButton
+ Tag = 70
+ Height = 22.000000000000000000
+ Position.X = 131.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = NewDialogCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 5
+ end
+ object DeletePageB: TfrxToolButton
+ Tag = 53
+ Height = 22.000000000000000000
+ Position.X = 154.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = DeletePageCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 6
+ end
+ object PageSettingsB: TfrxToolButton
+ Tag = 54
+ Height = 22.000000000000000000
+ Position.X = 177.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = PageSettingsCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 7
+ end
+ object Sep2: TfrxToolSeparator
+ Position.X = 203.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object CutB: TfrxToolButton
+ Tag = 44
+ Height = 22.000000000000000000
+ Position.X = 208.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = CutCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 9
+ end
+ object CopyB: TfrxToolButton
+ Tag = 45
+ Height = 22.000000000000000000
+ Position.X = 231.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = CopyCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 10
+ end
+ object PasteB: TfrxToolButton
+ Tag = 46
+ Height = 22.000000000000000000
+ Position.X = 254.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = PasteCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 11
+ end
+ object Sep4: TfrxToolSeparator
+ Position.X = 280.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object UndoB: TfrxToolButton
+ Tag = 47
+ Height = 22.000000000000000000
+ Position.X = 285.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = UndoCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 12
+ end
+ object RedoB: TfrxToolButton
+ Tag = 48
+ Height = 22.000000000000000000
+ Position.X = 308.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = RedoCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 13
+ end
+ object Sep5: TfrxToolSeparator
+ Position.X = 334.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object GroupB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 339.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = GroupCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 14
+ end
+ object UngroupB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 362.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = UngroupCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 15
+ end
+ object Sep6: TfrxToolSeparator
+ Position.X = 388.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object ShowGridB: TfrxToolButton
+ Tag = 55
+ Height = 22.000000000000000000
+ Position.X = 393.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ShowGridBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 16
+ end
+ object AlignToGridB: TfrxToolButton
+ Tag = 56
+ Height = 22.000000000000000000
+ Position.X = 416.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = AlignToGridBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 17
+ end
+ object SetToGridB: TfrxToolButton
+ Tag = 31
+ Height = 22.000000000000000000
+ Position.X = 439.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 18
+ end
+ object ScaleCB: TComboEdit
+ TabOrder = 19
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 465.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 59.000000000000000000
+ Height = 20.000000000000000000
+ OnClick = ScaleCBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ end
+ end
+ object TextTB: TToolBar
+ Align = alNone
+ Height = 27.000000000000000000
+ Position.Y = 27.000000000000000000
+ Width = 639.000000000000000000
+ object Grip4: TfrxToolGrip
+ Position.X = 4.000000000000000000
+ Position.Y = 6.000000000000000000
+ Width = 4.000000000000000000
+ Height = 14.000000000000000000
+ end
+ object StyleCB: TComboEdit
+ Tag = 33
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 8.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 97.000000000000000000
+ Height = 20.000000000000000000
+ OnChange = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ end
+ object FontNameCB: TComboEdit
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 107.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 138.000000000000000000
+ Height = 20.000000000000000000
+ OnChange = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ end
+ object FontSizeCB: TComboEdit
+ Tag = 1
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ Items.Strings = (
+ '5'
+ '6'
+ '7'
+ '8'
+ '9'
+ '10'
+ '11'
+ '12'
+ '14'
+ '16'
+ '18'
+ '20'
+ '22'
+ '24'
+ '26'
+ '28'
+ '36'
+ '48'
+ '72')
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 247.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 43.000000000000000000
+ Height = 20.000000000000000000
+ OnChange = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ end
+ object BoldB: TfrxToolButton
+ Tag = 2
+ Height = 22.000000000000000000
+ Position.X = 293.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 0
+ end
+ object ItalicB: TfrxToolButton
+ Tag = 3
+ Height = 22.000000000000000000
+ Position.X = 316.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 1
+ end
+ object UnderlineB: TfrxToolButton
+ Tag = 4
+ Height = 22.000000000000000000
+ Position.X = 339.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 2
+ end
+ object Sep11: TfrxToolSeparator
+ Position.X = 365.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object FontB: TfrxToolButton
+ Tag = 43
+ Height = 22.000000000000000000
+ Position.X = 370.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 3
+ end
+ object FontColorB: TfrxToolButton
+ Tag = 5
+ Height = 22.000000000000000000
+ Position.X = 393.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = FontColorBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 4
+ end
+ object HighlightB: TfrxToolButton
+ Tag = 6
+ Height = 22.000000000000000000
+ Position.X = 416.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = HighlightBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 5
+ end
+ object RotateB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 439.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = RotateBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 6
+ end
+ object Sep12: TfrxToolSeparator
+ Position.X = 465.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object TextAlignLeftB: TfrxToolButton
+ Tag = 7
+ Height = 22.000000000000000000
+ Position.X = 470.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 7
+ end
+ object TextAlignCenterB: TfrxToolButton
+ Tag = 8
+ Height = 22.000000000000000000
+ Position.X = 493.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 8
+ end
+ object TextAlignRightB: TfrxToolButton
+ Tag = 9
+ Height = 22.000000000000000000
+ Position.X = 516.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 9
+ end
+ object TextAlignBlockB: TfrxToolButton
+ Tag = 10
+ Height = 22.000000000000000000
+ Position.X = 539.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 10
+ end
+ object Sep13: TfrxToolSeparator
+ Position.X = 565.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object TextAlignTopB: TfrxToolButton
+ Tag = 11
+ Height = 22.000000000000000000
+ Position.X = 570.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 11
+ end
+ object TextAlignMiddleB: TfrxToolButton
+ Tag = 12
+ Height = 22.000000000000000000
+ Position.X = 593.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 12
+ end
+ object TextAlignBottomB: TfrxToolButton
+ Tag = 13
+ Height = 22.000000000000000000
+ Position.X = 616.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 13
+ end
+ end
+ end
+ object StyleBook1: TStyleBook
+ Resource.Strings = (
+ 'object _1: TLayout'
+ ' Align = alClient'
+ ' Height = 715.000000000000000000'
+ ' Position.Y = 33.000000000000000000'
+ ' Width = 1162.000000000000000000'
+ ' object TLayout'
+ ' StyleName = '#39'TabControl1Style1'#39
+ ' DesignVisible = False'
+ ' Height = 101.000000000000000000'
+ ' Position.X = 278.000000000000000000'
+ ' Position.Y = 289.000000000000000000'
+ ' Width = 142.000000000000000000'
+ ' object TRectangle'
+ ' Align = alContents'
+ ' Fill.Color = claWhite'
+ ' Height = 101.000000000000000000'
+ ' HitTest = False'
+ ' Sides = [sdTop, sdLeft, sdRight]'
+ ' Stroke.Color = xFF8E8E8E'
+ ' Width = 142.000000000000000000'
+ ' end'
+ ' end'
+ ' object TCalloutRectangle'
+ ' StyleName = '#39'HintPanelStyle1'#39
+ ' Fill.Color = claBeige'
+ ' Height = 50.000000000000000000'
+ ' HitTest = False'
+ ' Position.X = 556.000000000000000000'
+ ' Position.Y = 332.000000000000000000'
+ ' Stroke.Color = xFF979797'
+ ' Width = 50.000000000000000000'
+ ' CalloutWidth = 23.000000000000000000'
+ ' CalloutLength = 11.000000000000000000'
+ ' end'
+ 'end')
+ Left = 32
+ Top = 120
+ end
+ object HintPanel: TCalloutPanel
+ Height = 57.000000000000000000
+ Margins.Top = 11.000000000000000000
+ Position.X = 520.000000000000000000
+ Position.Y = 400.000000000000000000
+ StyleLookup = 'HintPanelStyle1'
+ Visible = False
+ Width = 97.000000000000000000
+ CalloutWidth = 23.000000000000000000
+ CalloutLength = 11.000000000000000000
+ object Label1: TLabel
+ Align = alClient
+ Height = 46.000000000000000000
+ Position.Y = 11.000000000000000000
+ Text = 'Label1'
+ TextAlign = taCenter
+ Width = 97.000000000000000000
+ end
+ end
+end
diff --git a/LibD28x64/FMX.frxDesgn.pas b/LibD28x64/FMX.frxDesgn.pas
new file mode 100644
index 0000000..22c91bd
--- /dev/null
+++ b/LibD28x64/FMX.frxDesgn.pas
@@ -0,0 +1,5696 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Designer }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDesgn;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, System.Types, FMX.Types, FMX.Objects, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.Menus, FMX.frxClass, FMX.frxCtrls, FMX.frxDesgnCtrls, FMX.frxDesgnWorkspace,
+ FMX.frxInsp, FMX.frxDialogForm, FMX.frxDataTree, FMX.frxReportTree, FMX.fs_SynMemo,
+ FMX.fs_iinterpreter, FMX.Printer, FMX.frxWatchForm, FMX.frxPictureCache, System.Variants,
+ FMX.TabControl, FMX.frxFMX, FMX.Layouts, FMX.Edit, System.UIConsts
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI21}
+ , FMX.ComboEdit, FMX.Controls.Presentation
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+ TfrxDesignerUnits = (duCM, duInches, duPixels, duChars);
+ TfrxLoadReportEvent = function(Report: TfrxReport): Boolean of object;
+ TfrxLoadRecentReportEvent = function(Report: TfrxReport; FileName: String): Boolean of object;
+ TfrxSaveReportEvent = function(Report: TfrxReport; SaveAs: Boolean): Boolean of object;
+ TfrxGetTemplateListEvent = procedure(List: TStrings) of object;
+ TfrxDesignerRestriction =
+ (drDontInsertObject, drDontDeletePage, drDontCreatePage, drDontChangePageOptions,
+ drDontCreateReport, drDontLoadReport, drDontSaveReport,
+ drDontPreviewReport, drDontEditVariables, drDontChangeReportOptions,
+ drDontEditReportData, drDontShowRecentFiles, drDontEditReportScript, drDontEditInternalDatasets);
+ TfrxDesignerRestrictions = set of TfrxDesignerRestriction;
+ TSampleFormat = class;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxDesigner = class(TComponent)
+ private
+ FCloseQuery: Boolean;
+ FDefaultScriptLanguage: String;
+ FDefaultFont: TfrxFont;
+ FDefaultLeftMargin: Double;
+ FDefaultBottomMargin: Double;
+ FDefaultRightMargin: Double;
+ FDefaultTopMargin: Double;
+ FDefaultPaperSize: Integer;
+ FDefaultOrientation: TPrinterOrientation;
+ FOpenDir: String;
+ FSaveDir: String;
+ FTemplatesExt: String;
+ FTemplateDir: String;
+ FStandalone: Boolean;
+ FRestrictions: TfrxDesignerRestrictions;
+ FRTLLanguage: Boolean;
+ FMemoParentFont: Boolean;
+ FOnLoadReport: TfrxLoadReportEvent;
+ FOnLoadRecentReport: TfrxLoadRecentReportEvent;
+ FOnSaveReport: TfrxSaveReportEvent;
+ FOnShow: TNotifyEvent;
+ FOnInsertObject: TNotifyEvent;
+ FOnGetTemplateList: TfrxGetTemplateListEvent;
+ FOnShowStartupScreen: TNotifyEvent;
+ procedure SetDefaultFont(const Value: TfrxFont);
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ published
+ property CloseQuery: Boolean read FCloseQuery write FCloseQuery default True;
+ property DefaultScriptLanguage: String read FDefaultScriptLanguage write FDefaultScriptLanguage;
+ property DefaultFont: TfrxFont read FDefaultFont write SetDefaultFont;
+ property DefaultLeftMargin: Double read FDefaultLeftMargin write FDefaultLeftMargin;
+ property DefaultRightMargin: Double read FDefaultRightMargin write FDefaultRightMargin;
+ property DefaultTopMargin: Double read FDefaultTopMargin write FDefaultTopMargin;
+ property DefaultBottomMargin: Double read FDefaultBottomMargin write FDefaultBottomMargin;
+ property DefaultPaperSize: Integer read FDefaultPaperSize write FDefaultPaperSize;
+ property DefaultOrientation: TPrinterOrientation read FDefaultOrientation write FDefaultOrientation;
+ property OpenDir: String read FOpenDir write FOpenDir;
+ property SaveDir: String read FSaveDir write FSaveDir;
+ property TemplatesExt: String read FTemplatesExt write FTemplatesExt;
+ property TemplateDir: String read FTemplateDir write FTemplateDir;
+ property Standalone: Boolean read FStandalone write FStandalone default False;
+ property Restrictions: TfrxDesignerRestrictions read FRestrictions write FRestrictions;
+ property RTLLanguage: Boolean read FRTLLanguage write FRTLLanguage;
+ property MemoParentFont: Boolean read FMemoParentFont write FMemoParentFont;
+ property OnLoadReport: TfrxLoadReportEvent read FOnLoadReport write FOnLoadReport;
+ property OnLoadRecentReport: TfrxLoadRecentReportEvent read FOnLoadRecentReport write FOnLoadRecentReport;
+ property OnSaveReport: TfrxSaveReportEvent read FOnSaveReport write FOnSaveReport;
+ property OnShow: TNotifyEvent read FOnShow write FOnShow;
+ property OnInsertObject: TNotifyEvent read FOnInsertObject write FOnInsertObject;
+ property OnShowStartupScreen: TNotifyEvent read FOnShowStartupScreen write FOnShowStartupScreen;
+ property OnGetTemplateList: TfrxGetTemplateListEvent read FOnGetTemplateList write FOnGetTemplateList;
+ end;
+
+ TfrxDesignerForm = class(TfrxCustomDesigner)
+ StatusBar: TStatusBar;
+ PagePopup: TPopupMenu;
+ MainMenu: TMenuBar;
+ FileMenu: TMenuItem;
+ EditMenu: TMenuItem;
+ ViewMenu: TMenuItem;
+ OptionsMI: TMenuItem;
+ HelpMenu: TMenuItem;
+ AboutMI: TMenuItem;
+ OpenDialog: TOpenDialog;
+ SaveDialog: TSaveDialog;
+ TabPopup: TPopupMenu;
+ NewPageMI1: TMenuItem;
+ NewDialogMI1: TMenuItem;
+ DeletePageMI1: TMenuItem;
+ PageSettingsMI1: TMenuItem;
+ NewMI: TMenuItem;
+ NewReportMI: TMenuItem;
+ NewPageMI: TMenuItem;
+ NewDialogMI: TMenuItem;
+ OpenMI: TMenuItem;
+ SaveMI: TMenuItem;
+ SaveAsMI: TMenuItem;
+ VariablesMI: TMenuItem;
+ PreviewMI: TMenuItem;
+ ExitMI: TMenuItem;
+ UndoMI: TMenuItem;
+ RedoMI: TMenuItem;
+ CutMI: TMenuItem;
+ CopyMI: TMenuItem;
+ PasteMI: TMenuItem;
+ DeleteMI: TMenuItem;
+ DeletePageMI: TMenuItem;
+ SelectAllMI: TMenuItem;
+ BringtoFrontMI: TMenuItem;
+ SendtoBackMI: TMenuItem;
+ EditMI: TMenuItem;
+ ObjectsTB1: TToolBar;
+ BandsPopup: TPopupMenu;
+ ReportTitleMI: TMenuItem;
+ ReportSummaryMI: TMenuItem;
+ PageHeaderMI: TMenuItem;
+ PageFooterMI: TMenuItem;
+ HeaderMI: TMenuItem;
+ FooterMI: TMenuItem;
+ MasterDataMI: TMenuItem;
+ DetailDataMI: TMenuItem;
+ SubdetailDataMI: TMenuItem;
+ GroupHeaderMI: TMenuItem;
+ GroupFooterMI: TMenuItem;
+ ColumnHeaderMI: TMenuItem;
+ ColumnFooterMI: TMenuItem;
+ ChildMI: TMenuItem;
+ PageSettingsMI: TMenuItem;
+ Timer: TTimer;
+ ReportSettingsMI: TMenuItem;
+ Data4levelMI: TMenuItem;
+ Data5levelMI: TMenuItem;
+ Data6levelMI: TMenuItem;
+ ShowGuidesMI: TMenuItem;
+ ShowRulersMI: TMenuItem;
+ DeleteGuidesMI: TMenuItem;
+ RotationPopup: TPopupMenu;
+ R0MI: TMenuItem;
+ R45MI: TMenuItem;
+ R90MI: TMenuItem;
+ R180MI: TMenuItem;
+ R270MI: TMenuItem;
+ ReportMenu: TMenuItem;
+ ReportDataMI: TMenuItem;
+ OpenScriptDialog: TOpenDialog;
+ SaveScriptDialog: TSaveDialog;
+ ObjectsPopup: TPopupMenu;
+ OverlayMI: TMenuItem;
+ ReportStylesMI: TMenuItem;
+ N2: TMenuItem;
+ FindMI: TMenuItem;
+ FindNextMI: TMenuItem;
+ ReplaceMI: TMenuItem;
+ DMPPopup: TPopupMenu;
+ BoldMI: TMenuItem;
+ ItalicMI: TMenuItem;
+ UnderlineMI: TMenuItem;
+ SuperScriptMI: TMenuItem;
+ SubScriptMI: TMenuItem;
+ CondensedMI: TMenuItem;
+ WideMI: TMenuItem;
+ N12cpiMI: TMenuItem;
+ N15cpiMI: TMenuItem;
+ VerticalbandsMI: TMenuItem;
+ HeaderMI1: TMenuItem;
+ FooterMI1: TMenuItem;
+ MasterDataMI1: TMenuItem;
+ DetailDataMI1: TMenuItem;
+ SubdetailDataMI1: TMenuItem;
+ GroupHeaderMI1: TMenuItem;
+ GroupFooterMI1: TMenuItem;
+ ChildMI1: TMenuItem;
+ N3: TMenuItem;
+ GroupMI: TMenuItem;
+ UngroupMI: TMenuItem;
+ BackPanel: TPanel;
+ ScrollBoxPanel: TPanel;
+ ScrollBox: TfrxScrollBox;
+ LeftRuler: TfrxRuler;
+ TopRuler: TfrxRuler;
+ CodePanel: TPanel;
+ CodeTB: TToolBar;
+ OpenScriptB: TfrxToolButton;
+ SaveScriptB: TfrxToolButton;
+ RunScriptB: TfrxToolButton;
+ RunToCursorB: TfrxToolButton;
+ StepScriptB: TfrxToolButton;
+ StopScriptB: TfrxToolButton;
+ EvaluateB: TfrxToolButton;
+ BreakPointB: TfrxToolButton;
+ TabPanel: TPanel;
+ TopToolBox: TToolBar;
+ AlignTB: TToolBar;
+ AlignLeftsB: TfrxToolButton;
+ AlignHorzCentersB: TfrxToolButton;
+ AlignRightsB: TfrxToolButton;
+ AlignTopsB: TfrxToolButton;
+ AlignVertCentersB: TfrxToolButton;
+ AlignBottomsB: TfrxToolButton;
+ SpaceHorzB: TfrxToolButton;
+ SpaceVertB: TfrxToolButton;
+ CenterHorzB: TfrxToolButton;
+ CenterVertB: TfrxToolButton;
+ SameWidthB: TfrxToolButton;
+ SameHeightB: TfrxToolButton;
+ ExtraToolsTB: TToolBar;
+ FrameTB: TToolBar;
+ FrameTopB: TfrxToolButton;
+ FrameBottomB: TfrxToolButton;
+ FrameLeftB: TfrxToolButton;
+ FrameRightB: TfrxToolButton;
+ FrameAllB: TfrxToolButton;
+ FrameNoB: TfrxToolButton;
+ ShadowB: TfrxToolButton;
+ FillColorB: TfrxToolButton;
+ FrameColorB: TfrxToolButton;
+ FrameStyleB: TfrxToolButton;
+ StandardTB: TToolBar;
+ NewB: TfrxToolButton;
+ OpenB: TfrxToolButton;
+ SaveB: TfrxToolButton;
+ PreviewB: TfrxToolButton;
+ NewPageB: TfrxToolButton;
+ NewDialogB: TfrxToolButton;
+ DeletePageB: TfrxToolButton;
+ PageSettingsB: TfrxToolButton;
+ CutB: TfrxToolButton;
+ CopyB: TfrxToolButton;
+ PasteB: TfrxToolButton;
+ UndoB: TfrxToolButton;
+ RedoB: TfrxToolButton;
+ GroupB: TfrxToolButton;
+ UngroupB: TfrxToolButton;
+ ShowGridB: TfrxToolButton;
+ AlignToGridB: TfrxToolButton;
+ SetToGridB: TfrxToolButton;
+ TextTB: TToolBar;
+ BoldB: TfrxToolButton;
+ ItalicB: TfrxToolButton;
+ UnderlineB: TfrxToolButton;
+ FontB: TfrxToolButton;
+ FontColorB: TfrxToolButton;
+ HighlightB: TfrxToolButton;
+ RotateB: TfrxToolButton;
+ TextAlignLeftB: TfrxToolButton;
+ TextAlignCenterB: TfrxToolButton;
+ TextAlignRightB: TfrxToolButton;
+ TextAlignBlockB: TfrxToolButton;
+ TextAlignTopB: TfrxToolButton;
+ TextAlignMiddleB: TfrxToolButton;
+ TextAlignBottomB: TfrxToolButton;
+ ScaleCB: TComboEdit;
+ LangCB: TComboEdit;
+ FrameWidthCB: TComboEdit;
+ FontNameCB: TComboEdit;
+ StyleCB: TComboEdit;
+ FontSizeCB: TComboEdit;
+ RightDockTB: TToolBar;
+ Splitter1: TSplitter;
+ LeftDockTB: TToolBar;
+ Splitter2: TSplitter;
+ StyleBook1: TStyleBook;
+ Sep1: TfrxToolSeparator;
+ Sep2: TfrxToolSeparator;
+ Sep4: TfrxToolSeparator;
+ Sep5: TfrxToolSeparator;
+ Sep6: TfrxToolSeparator;
+ Sep7: TfrxToolSeparator;
+ Sep8: TfrxToolSeparator;
+ Sep9: TfrxToolSeparator;
+ Sep10: TfrxToolSeparator;
+ Sep11: TfrxToolSeparator;
+ Sep12: TfrxToolSeparator;
+ Sep13: TfrxToolSeparator;
+ Sep14: TfrxToolSeparator;
+ Grip1: TfrxToolGrip;
+ Grip2: TfrxToolGrip;
+ Grip3: TfrxToolGrip;
+ Grip4: TfrxToolGrip;
+ HintPanel: TCalloutPanel;
+ Label1: TLabel;
+ procedure ExitCmdExecute(Sender: TObject);
+ procedure ObjectsButtonClick(Sender: TObject);
+// procedure StatusBarDrawPanel(StatusBar: TStatusBar;
+// Panel: TStatusPanel; const ARect: TRect);
+ procedure ScrollBoxMouseWheelUp(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
+ procedure ScrollBoxMouseWheelDown(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
+ procedure ScrollBoxResize(Sender: TObject);
+ procedure ScaleCBClick(Sender: TObject);
+ procedure ShowGridBClick(Sender: TObject);
+ procedure AlignToGridBClick(Sender: TObject);
+ procedure StatusBarDblClick(Sender: TObject);
+ procedure StatusBarMouseDown(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Single);
+ procedure InsertBandClick(Sender: TObject);
+ procedure BandsPopupPopup(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure NewReportCmdExecute(Sender: TObject);
+ procedure ToolButtonClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FontColorBClick(Sender: TObject);
+ procedure FrameStyleBClick(Sender: TObject);
+ procedure TabChange(Sender: TObject);
+ procedure UndoCmdExecute(Sender: TObject);
+ procedure RedoCmdExecute(Sender: TObject);
+ procedure CutCmdExecute(Sender: TObject);
+ procedure CopyCmdExecute(Sender: TObject);
+ procedure PasteCmdExecute(Sender: TObject);
+ procedure TimerTimer(Sender: TObject);
+ procedure DeletePageCmdExecute(Sender: TObject);
+ procedure NewDialogCmdExecute(Sender: TObject);
+ procedure NewPageCmdExecute(Sender: TObject);
+ procedure SaveCmdExecute(Sender: TObject);
+ procedure SaveAsCmdExecute(Sender: TObject);
+ procedure OpenCmdExecute(Sender: TObject);
+ procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+ procedure DeleteCmdExecute(Sender: TObject);
+ procedure SelectAllCmdExecute(Sender: TObject);
+ procedure EditCmdExecute(Sender: TObject);
+ procedure TabChanging(Sender: TObject; var AllowChange: Boolean);
+ procedure PageSettingsCmdExecute(Sender: TObject);
+ procedure TopRulerDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+ procedure AlignLeftsBClick(Sender: TObject);
+ procedure AlignRightsBClick(Sender: TObject);
+ procedure AlignTopsBClick(Sender: TObject);
+ procedure AlignBottomsBClick(Sender: TObject);
+ procedure AlignHorzCentersBClick(Sender: TObject);
+ procedure AlignVertCentersBClick(Sender: TObject);
+ procedure CenterHorzBClick(Sender: TObject);
+ procedure CenterVertBClick(Sender: TObject);
+ procedure SpaceHorzBClick(Sender: TObject);
+ procedure SpaceVertBClick(Sender: TObject);
+ procedure SelectToolBClick(Sender: TObject);
+ procedure RotateBClick(Sender: TObject);
+ procedure PagePopupPopup(Sender: TObject; X, Y: Single);
+ procedure BringToFrontCmdExecute(Sender: TObject);
+ procedure SendToBackCmdExecute(Sender: TObject);
+ procedure LangCBClick(Sender: TObject);
+ procedure OpenScriptBClick(Sender: TObject);
+ procedure SaveScriptBClick(Sender: TObject);
+ procedure CodeWindowDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+ procedure CodeWindowDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+ procedure VariablesCmdExecute(Sender: TObject);
+ procedure ObjectBandBClick(Sender: TObject);
+ procedure PreviewCmdExecute(Sender: TObject);
+ procedure HighlightBClick(Sender: TObject);
+ procedure TabMouseDown(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Single);
+ procedure TabMouseMove(Sender: TObject; Shift: TShiftState; X,
+ Y: Single);
+ procedure TabMouseUp(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Single);
+ procedure TabDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+ procedure TabDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+ procedure TabDragEnd(Sender: TObject);
+ procedure TabMouseLeave(Sender: TObject);
+ procedure SameWidthBClick(Sender: TObject);
+ procedure SameHeightBClick(Sender: TObject);
+ procedure NewItemCmdExecute(Sender: TObject);
+ procedure TabOrderMIClick(Sender: TObject);
+ procedure RunScriptBClick(Sender: TObject);
+ procedure StopScriptBClick(Sender: TObject);
+ procedure EvaluateBClick(Sender: TObject);
+ procedure GroupCmdExecute(Sender: TObject);
+ procedure UngroupCmdExecute(Sender: TObject);
+ procedure LangSelectClick(Sender: TObject);
+ procedure BreakPointBClick(Sender: TObject);
+ procedure RunToCursorBClick(Sender: TObject);
+ procedure TabSetChange(Sender: TObject; NewTab: Integer;
+ var AllowChange: Boolean);
+ procedure FormShow(Sender: TObject); override;
+ procedure AddChildMIClick(Sender: TObject);
+ procedure FindCmdExecute(Sender: TObject);
+ procedure ReplaceCmdExecute(Sender: TObject);
+ procedure FindNextCmdExecute(Sender: TObject);
+ procedure ReportDataCmdExecute(Sender: TObject);
+ procedure ReportStylesCmdExecute(Sender: TObject);
+ procedure ReportOptionsCmdExecute(Sender: TObject);
+ procedure ShowRulersCmdExecute(Sender: TObject);
+ procedure ShowGuidesCmdExecute(Sender: TObject);
+ procedure DeleteGuidesCmdExecute(Sender: TObject);
+ procedure OptionsCmdExecute(Sender: TObject);
+ procedure HelpContentsCmdExecute(Sender: TObject);
+ procedure AboutCmdExecute(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
+ procedure RightDockTBResize(Sender: TObject);
+ procedure FormResize(Sender: TObject);
+ procedure LeftDockTBResize(Sender: TObject);
+ procedure FormActivate(Sender: TObject);
+ procedure FrameWidthCBKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: Char; Shift: TShiftState);
+ procedure NewPageBMouseEnter(Sender: TObject);
+ procedure NewPageBMouseLeave(Sender: TObject);
+ procedure FontBClick(Sender: TObject);
+ private
+ { Private declarations }
+ ObjectSelectB: TfrxToolButton;
+ ObjectBandB: TfrxToolButton;
+
+ FClipboard: TfrxClipboard;
+ FCodeWindow: TfsSyntaxMemo;
+ FColor: TColor;
+ FCoord1: String;
+ FCoord2: String;
+ FCoord3: String;
+ FDialogForm: TfrxDialogForm;
+ FEditAfterInsert: Boolean;
+ FDataTree: TfrxDataTreeForm;
+ FDropFields: Boolean;
+ FGridAlign: Boolean;
+ FGridSize1: Double;
+ FGridSize2: Double;
+ FGridSize3: Double;
+ FGridSize4: Double;
+ FInspector: TfrxObjectInspector;
+ FLineStyle: TfrxFrameStyle;
+ FLocalizedOI: Boolean;
+ FLockSelectionChanged: Boolean;
+ FModifiedBy: TObject;
+ FMouseDown: Boolean;
+ FDragTabItem: TTabItem;
+ FMouseTabDX: Single;
+ FOldDesignerComp: TfrxDesigner;
+ FOldUnits: TfrxDesignerUnits;
+ FPagePositions: TStrings;
+ FPictureCache: TfrxPictureCache;
+ FRecentFiles: TStringList;
+// FRecentMenuIndex: Integer;
+ FReportTree: TfrxReportTreeForm;
+ FSampleFormat: TSampleFormat;
+ FScale: Double;
+ FScriptFirstTime: Boolean;
+ FScriptRunning: Boolean;
+ FScriptStep: Boolean;
+ FScriptStopped: Boolean;
+ FSearchCase: Boolean;
+ FSearchIndex: Integer;
+ FSearchReplace: Boolean;
+ FSearchReplaceText: String;
+ FSearchText: String;
+ FShowGrid: Boolean;
+ FShowGuides: Boolean;
+ FShowRulers: Boolean;
+ FShowStartup: Boolean;
+ FTabs: TTabControl;
+ FUndoBuffer: TfrxUndoBuffer;
+ FUnits: TfrxDesignerUnits;
+ FUnitsDblClicked: Boolean;
+ FUpdatingControls: Boolean;
+ FWatchList: TfrxWatchForm;
+ FWorkspace: TfrxDesignerWorkspace;
+ FTemplatePath: String;
+ FTemplateExt: String;
+ Splitter3: TSplitter;
+ FColorSelector: TfrxColorSelector;
+ FLineSelector: TfrxLineSelector;
+ procedure CreateColorSelector(Sender: TfrxToolButton);
+ procedure CreateExtraToolbar;
+ procedure CreateToolWindows;
+ procedure CreateObjectsToolbar;
+ procedure CreateWorkspace;
+ procedure FindOrReplace(replace: Boolean);
+ procedure FindText;
+ procedure OnCodeChanged(Sender: TObject);
+// procedure OnCodeCompletion(const Name: String; List: TStrings);
+ procedure OnColorChanged(Sender: TObject);
+ procedure OnComponentMenuClick(Sender: TObject);
+ procedure OnChangePosition(Sender: TObject);
+// procedure OnDataTreeDblClick(Sender: TObject);
+ procedure OnEditObject(Sender: TObject);
+// procedure OnExtraToolClick(Sender: TObject);
+ procedure OnInsertObject(Sender: TObject);
+ procedure OnModify(Sender: TObject);
+ procedure OnNotifyPosition(ARect: TfrxRect);
+ procedure OnRunLine(Sender: TfsScript; const UnitName, SourcePos: String);
+ procedure OnSelectionChanged(Sender: TObject);
+ procedure OnStyleChanged(Sender: TObject);
+ procedure OpenRecentFile(Sender: TObject);
+ procedure ReadButtonImages;
+ procedure ReloadObjects;
+ procedure RestorePagePosition;
+ procedure SavePagePosition;
+ procedure SaveState;
+ procedure SetScale(Value: Double);
+ procedure SetGridAlign(const Value: Boolean);
+ procedure SetShowGrid(const Value: Boolean);
+ procedure SetShowRulers(const Value: Boolean);
+ procedure SetUnits(const Value: TfrxDesignerUnits);
+ procedure SwitchToolbar;
+ procedure UpdateCaption;
+ procedure UpdateControls;
+ procedure UpdatePageDimensions;
+ procedure UpdateRecentFiles(NewFile: String);
+ procedure UpdateStyles;
+ procedure UpdateSyntaxType;
+ procedure UpdateWatches;
+ function AskSave: Word;
+ function GetPageIndex: Integer;
+ function GetReportName: String;
+ procedure SetShowGuides(const Value: Boolean);
+ procedure Localize;
+ procedure CreateLangMenu;
+ procedure SetGridSize1(const Value: Double);
+ procedure SetGridSize2(const Value: Double);
+ procedure SetGridSize3(const Value: Double);
+ procedure SetGridSize4(const Value: Double);
+ protected
+ procedure SetModified(const Value: Boolean); override;
+ procedure SetPage(const Value: TfrxPage); override;
+ function GetCode: TStrings; override;
+ public
+ { Public declarations }
+ procedure Init; override;
+ procedure Done; override;
+ function CheckOp(Op: TfrxDesignerRestriction): Boolean;
+ function InsertExpression(const Expr: String): String; override;
+ procedure LoadFile(FileName: String; UseOnLoadEvent: Boolean);
+ procedure Lock; override;
+ procedure ReloadPages(Index: Integer); override;
+ procedure ReloadReport; override;
+ procedure RestoreState(RestoreDefault: Boolean = False;
+ RestoreMainForm: Boolean = False);
+ function SaveFile(SaveAs: Boolean; UseOnSaveEvent: Boolean): Boolean;
+ procedure SetReportDefaults;
+ procedure SwitchToCodeWindow;
+ procedure UpdateDataTree; override;
+ procedure UpdatePage; override;
+ procedure UpdateInspector; override;
+ function GetDefaultObjectSize: TfrxPoint;
+ function mmToUnits(mm: Extended; X: Boolean = True): Extended;
+ function UnitsTomm(mm: Extended; X: Boolean = True): Extended;
+ procedure GetTemplateList(List: TStrings);
+
+ property CodeWindow: TfsSyntaxMemo read FCodeWindow;
+ property DataTree: TfrxDataTreeForm read FDataTree;
+ property DropFields: Boolean read FDropFields write FDropFields;
+ property EditAfterInsert: Boolean read FEditAfterInsert write FEditAfterInsert;
+ property GridAlign: Boolean read FGridAlign write SetGridAlign;
+ property GridSize1: Double read FGridSize1 write SetGridSize1;
+ property GridSize2: Double read FGridSize2 write SetGridSize2;
+ property GridSize3: Double read FGridSize3 write SetGridSize3;
+ property GridSize4: Double read FGridSize4 write SetGridSize4;
+ property Inspector: TfrxObjectInspector read FInspector;
+ property PictureCache: TfrxPictureCache read FPictureCache;
+ property RecentFiles: TStringList read FRecentFiles;
+ property ReportTree: TfrxReportTreeForm read FReportTree;
+ property SampleFormat: TSampleFormat read FSampleFormat;
+ property Scale: Double read FScale write SetScale;
+ property ShowGrid: Boolean read FShowGrid write SetShowGrid;
+ property ShowGuides: Boolean read FShowGuides write SetShowGuides;
+ property ShowRulers: Boolean read FShowRulers write SetShowRulers;
+ property ShowStartup: Boolean read FShowStartup write FShowStartup;
+ property Units: TfrxDesignerUnits read FUnits write SetUnits;
+ property Workspace: TfrxDesignerWorkspace read FWorkspace;
+ property TemplatePath: String read FTemplatePath write FTemplatePath;
+ end;
+
+ TSampleFormat = class(TObject)
+ private
+ FMemo: TfrxCustomMemoView;
+ procedure Clear;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure ApplySample(Memo: TfrxCustomMemoView);
+ procedure SetAsSample(Memo: TfrxCustomMemoView);
+ property Memo: TfrxCustomMemoView read FMemo;
+ end;
+
+ TfrxCustomSavePlugin = class(TObject)
+ public
+ FileFilter: String;
+ procedure Save(Report: TfrxReport; const FileName: String); virtual; abstract;
+ end;
+
+var
+ frxDesignerComp: TfrxDesigner;
+ frxSavePlugin: TfrxCustomSavePlugin;
+
+implementation
+{$IFDEF DELPHI23}
+{$R FMX.frxDesgn_D23.FMX}
+{$ELSE}
+{$R *.FMX}
+{$ENDIF}
+{$R *.RES}
+
+uses
+ System.TypInfo, System.IniFiles,
+ FMX.frxDsgnIntf, FMX.frxUtils, FMX.frxDesgnWorkspace1,
+ FMX.frxDesgnEditors, FMX.frxEditOptions, FMX.frxEditReport, FMX.frxEditPage, FMX.frxAbout,
+ FMX.fs_itools, FMX.frxXML, FMX.frxEditReportData, FMX.frxEditVar, FMX.frxEditExpr,
+ FMX.frxEditHighlight, FMX.frxEditStyle, {FMX.frxNewItem, FMX.frxStdWizard,} FMX.frxFontForm,
+ FMX.frxEditTabOrder, FMX.frxCodeUtils, FMX.frxRes, FMX.frxrcDesgn, FMX.frxDMPClass, FMX.TreeView, FMX.Platform,
+ FMX.frxEvaluateForm, FMX.frxSearchDialog, {FMX.frxConnEditor,} FMX.fs_xml, FMX.frxVariables, FMX.frxBaseModalForm;
+
+
+ Type THackControl = class(TControl);
+
+{ TSampleFormat }
+
+constructor TSampleFormat.Create;
+begin
+ Clear;
+end;
+
+destructor TSampleFormat.Destroy;
+begin
+ FMemo.Free;
+ inherited;
+end;
+
+procedure TSampleFormat.Clear;
+begin
+ if FMemo <> nil then
+ FMemo.Free;
+ FMemo := TfrxMemoView.Create(nil);
+ if frxDesignerComp <> nil then
+ begin
+ FMemo.Font := frxDesignerComp.DefaultFont;
+ FMemo.RTLReading := frxDesignerComp.RTLLanguage;
+ FMemo.ParentFont := frxDesignerComp.MemoParentFont;
+ end;
+end;
+
+procedure TSampleFormat.ApplySample(Memo: TfrxCustomMemoView);
+begin
+ Memo.Color := FMemo.Color;
+ if not (Memo is TfrxDMPMemoView) then
+ Memo.Font := FMemo.Font;
+ Memo.Frame.Assign(FMemo.Frame);
+ Memo.HAlign := FMemo.HAlign;
+ Memo.VAlign := FMemo.VAlign;
+ Memo.RTLReading := FMemo.RTLReading;
+ Memo.ParentFont := FMemo.ParentFont;
+end;
+
+procedure TSampleFormat.SetAsSample(Memo: TfrxCustomMemoView);
+begin
+ FMemo.Color := Memo.Color;
+ if not (Memo is TfrxDMPMemoView) then
+ FMemo.Font := Memo.Font;
+ FMemo.Frame.Assign(Memo.Frame);
+ FMemo.HAlign := Memo.HAlign;
+ FMemo.VAlign := Memo.VAlign;
+ FMemo.RTLReading := Memo.RTLReading;
+ Memo.ParentFont := FMemo.ParentFont;
+end;
+
+
+{ TfrxDesigner }
+
+constructor TfrxDesigner.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+
+ FCloseQuery := True;
+ FDefaultFont := TfrxFont.Create;
+ with FDefaultFont do
+ begin
+ {$IFDEF LINUX}
+ Name := 'Liberation Sans';
+ {$ELSE}
+ Name := 'Arial';
+ {$ENDIF}
+ end;
+ FDefaultScriptLanguage := 'PascalScript';
+ FTemplatesExt := 'fr3';
+ FDefaultLeftMargin := 10;
+ FDefaultBottomMargin := 10;
+ FDefaultRightMargin := 10;
+ FDefaultTopMargin := 10;
+ FDefaultPaperSize := DMPAPER_A4;
+ FDefaultOrientation := poPortrait;
+ frxDesignerComp := Self;
+end;
+
+destructor TfrxDesigner.Destroy;
+begin
+ FDefaultFont.Free;
+ frxDesignerComp := nil;
+ inherited Destroy;
+end;
+
+procedure TfrxDesigner.SetDefaultFont(const Value: TfrxFont);
+begin
+ FDefaultFont.Assign(Value);
+end;
+
+
+{ TfrxDesignerForm }
+
+{ Form events }
+{------------------------------------------------------------------------------}
+
+procedure TfrxDesignerForm.FormShow(Sender: TObject);
+begin
+ ReadButtonImages;
+ CreateObjectsToolbar;
+ CreateWorkspace;
+ CreateToolWindows;
+ Init;
+ CreateExtraToolbar;
+
+ Localize;
+ CreateLangMenu;
+
+ with ScaleCB.Items do
+ begin
+ Clear;
+ Add('25%');
+ Add('50%');
+ Add('75%');
+ Add('100%');
+ Add('150%');
+ Add('200%');
+ Add(frxResources.Get('zmPageWidth'));
+ Add(frxResources.Get('zmWholePage'));
+ end;
+
+// if Screen.PixelsPerInch > 96 then
+// begin
+// StyleCB.Font.Height := -11;
+// FontNameCB.Font.Height := -11;
+// FontSizeCB.Font.Height := -11;
+// ScaleCB.Font.Height := -11;
+// FrameWidthCB.Font.Height := -11;
+// LangL.Font.Height := -11;
+// LangCB.Font.Height := -11;
+// end;
+ R45MI.HelpContext := 45;
+ R90MI.HelpContext := 90;
+ R180MI.HelpContext := 180;
+ R270MI.HelpContext := 270;
+ FontSizeCB.DropDownCount := FontSizeCB.Items.Count;
+
+ RestoreState;
+ ReloadReport;
+ RestoreState(False, True);
+
+ if frxDesignerComp <> nil then
+ begin
+ FTemplatePath := frxDesignerComp.FTemplateDir;
+ if Assigned(frxDesignerComp.FOnShow) then
+ frxDesignerComp.FOnShow(Self);
+ end;
+ if FTemplatePath = '' then
+ FTemplatePath := Report.GetApplicationFolder;
+ FileMenu.Visible := True;
+ OpenMI.Visible := True;
+ if (csDesigning in Report.ComponentState) then
+ BorderIcons := BorderIcons - [TBorderIcon.biMinimize];
+
+{$IFDEF LINUX}
+ ScaleCB.Width := 66;
+ FontSizeCB.Width := 46;
+{$ENDIF}
+end;
+
+procedure TfrxDesignerForm.FormActivate(Sender: TObject);
+begin
+ FDataTree.FormResize(Self);
+ FInspector.FormResize(Self);
+{$IFNDEF DELPHI20}
+ MainMenu.UpdateStyle;
+{$ENDIF}
+ FileMenu.Visible := True;
+ OpenMI.Visible := True;
+end;
+
+procedure TfrxDesignerForm.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+ SaveState;
+ BeginUpdate;
+ Done;
+ Report.Modified := Modified;
+ if not (TFmxFormState.fsModal in FormState) then
+ begin
+ Report.Designer := nil;
+ Action := TCloseAction.caFree;
+ end;
+end;
+
+procedure TfrxDesignerForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+var
+ w: Word;
+begin
+ FInspector.FormDeactivate(nil);
+ if FScriptRunning then
+ begin
+ CanClose := False;
+ Exit;
+ end;
+ CanClose := True;
+ Report.ScriptText := CodeWindow.Lines;
+
+ if (frxDesignerComp <> nil) and not frxDesignerComp.CloseQuery then
+ Exit;
+
+ if Modified and not (csDesigning in Report.ComponentState) and CheckOp(drDontSaveReport) then
+ begin
+ w := AskSave;
+
+ if IsPreviewDesigner then
+ begin
+ if w = mrNo then
+ Modified := False
+ end
+ else if w = mrYes then
+ if not SaveFile(False, True) then
+ CanClose := False;
+
+ if not IsPreviewDesigner then
+ begin
+ if w = mrNo then
+ Modified := False
+ else
+ Modified := True;
+ end;
+
+ if w = mrCancel then
+ CanClose := False;
+ end;
+end;
+
+procedure TfrxDesignerForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = vkReturn then
+ if ActiveControl = FontSizeCB then
+ ToolButtonClick(FontSizeCB)
+ else if ActiveControl = ScaleCB then
+ ScaleCBClick(Self);
+
+ if (Page <> nil) and (FWorkspace.IsFocused) then
+ begin
+ if Key = vkInsert then
+ if Shift = [ssShift] then
+ begin
+ PasteCmdExecute(nil);
+ Key := 0;
+ end
+ else if Shift = [ssCtrl] then
+ begin
+ CopyCmdExecute(nil);
+ Key := 0;
+ end;
+
+ if Key = vkDelete then
+ if Shift = [ssShift] then
+ begin
+ CutCmdExecute(nil);
+ Key := 0;
+ end;
+
+ if (Shift = [ssCtrl]) or (Shift = [ssCommand]) then
+ if Key = Ord('C') then
+ begin
+ CopyCmdExecute(nil);
+ Key := 0;
+ end
+ else if Key = Ord('V') then
+ begin
+ PasteCmdExecute(nil);
+ Key := 0;
+ end
+ else if Key = Ord('X') then
+ begin
+ CutCmdExecute(nil);
+ Key := 0;
+ end;
+ end;
+
+ if (Key = Ord('E')) and (Shift = [ssCtrl]) then
+ Page := nil;
+
+ if ((Key = vkF4) or (Key = vkF5)) and (Shift = []) and (Page = nil) then
+ begin
+ if Key = vkF4 then
+ RunToCursorBClick(nil)
+ else
+ BreakPointBClick(nil);
+ end
+ else if (Key = vkF2) and (Shift = [ssCtrl]) then
+ StopScriptBClick(StopScriptB)
+ else if (Key = vkF7) and (Shift = [ssCtrl]) and (Page = nil) then
+ EvaluateBClick(EvaluateB)
+ else if Key = vkF9 then
+ RunScriptBClick(RunScriptB)
+ else if ((Key = vkF7) or (Key = vkF8)) and (Page = nil) then
+ RunScriptBClick(StepScriptB);
+end;
+
+procedure TfrxDesignerForm.RightDockTBResize(Sender: TObject);
+begin
+ if FDataTree <> nil then
+ FDataTree.UpdateSize;
+end;
+
+{ Get/Set methods }
+{------------------------------------------------------------------------------}
+
+function TfrxDesignerForm.GetDefaultObjectSize: TfrxPoint;
+begin
+ case FUnits of
+ duCM: Result := frxPoint(fr1cm * 2.5, fr1cm * 0.5);
+ duInches: Result := frxPoint(fr1in, fr1in * 0.2);
+ duPixels: Result := frxPoint(80, 16);
+ duChars: Result := frxPoint(fr1CharX * 10, fr1CharY);
+ end;
+end;
+
+function TfrxDesignerForm.GetCode: TStrings;
+begin
+ Result := CodeWindow.Lines;
+end;
+
+procedure TfrxDesignerForm.SetGridAlign(const Value: Boolean);
+begin
+ FGridAlign := Value;
+ AlignToGridB.IsPressed := FGridAlign;
+ FWorkspace.GridAlign := FGridAlign;
+end;
+
+procedure TfrxDesignerForm.SetModified(const Value: Boolean);
+var
+ i: Integer;
+begin
+ inherited;
+ Report.ScriptText := CodeWindow.Lines;
+ if IsPreviewDesigner then
+ FUndoBuffer.AddUndo(FPage)
+ else
+ FUndoBuffer.AddUndo(Report);
+ FUndoBuffer.ClearRedo;
+ SaveMI.Visible := Modified;
+ SaveB.Enabled := Modified;
+// SaveCmd.Enabled := Modified;
+
+ if FModifiedBy <> Self then
+ UpdateControls;
+
+ if FModifiedBy = FInspector then
+ if (FSelectedObjects[0] = FPage) {or
+ (TObject(FSelectedObjects[0]) is TfrxSubreport)} then
+ begin
+ FLockSelectionChanged := True;
+ try
+ i := Report.Objects.IndexOf(FPage);
+ if i >= 0 then
+ ReloadPages(i);
+ finally
+ FLockSelectionChanged := False;
+ end;
+ end;
+
+ if FModifiedBy <> FWorkspace then
+ begin
+ FWorkspace.UpdateView;
+ FWorkspace.AdjustBands;
+ end;
+
+ if FModifiedBy <> FInspector then
+ FInspector.UpdateProperties;
+
+ FReportTree.UpdateItems;
+ FModifiedBy := nil;
+end;
+
+procedure TfrxDesignerForm.SetPage(const Value: TfrxPage);
+begin
+ inherited;
+
+ FTabs.TabIndex := Report.Objects.IndexOf(FPage) + 1;
+ ScrollBoxPanel.Visible := FPage <> nil;
+ CodePanel.Visible := FPage = nil;
+
+ SwitchToolbar;
+ UpdateControls;
+
+ if FPage = nil then
+ begin
+ CodeWindow.SetFocus;
+ Exit;
+ end
+ else if FPage is TfrxReportPage then
+ begin
+ with FWorkspace do
+ begin
+ Parent := ScrollBox;
+ Align := TAlignLayout.alNone;
+ Color := claWhite;
+ Scale := Self.Scale;
+ end;
+
+ if FPage is TfrxDMPPage then
+ Units := duChars else
+ Units := FOldUnits;
+ UpdatePageDimensions;
+ if Visible then
+ ScrollBox.SetFocus;
+ end
+ else if FPage is TfrxDialogPage then
+ begin
+ FDialogForm := TfrxDialogForm(TfrxDialogPage(FPage).DialogForm);
+ Units := duPixels;
+ with FWorkspace do
+ begin
+ FWorkspace.Parent := ScrollBox;
+ Align := TAlignLayout.alNone;
+ GridType := gtDialog;
+ GridX := FGridSize4;
+ GridY := FGridSize4;
+ Color := TfrxDialogPage(FPage).Color;
+ Scale := 1;
+ end;
+
+ UpdatePageDimensions;
+ if Visible then
+ ScrollBox.SetFocus;
+ end
+ else if FPage is TfrxDataPage then
+ begin
+ Units := duPixels;
+ with FWorkspace do
+ begin
+ Parent := ScrollBox;
+ Align := TAlignLayout.alNone;
+ Color := claWhite;
+ Scale := 1;
+ GridType := gtNone;
+ GridX := FGridSize4;
+ GridY := FGridSize4;
+ end;
+
+ UpdatePageDimensions;
+ if Visible then
+ ScrollBox.SetFocus;
+ end
+ else
+ begin
+ Report.Errors.Add('Page object is not page');
+ end;
+
+ ReloadObjects;
+ RestorePagePosition;
+end;
+
+procedure TfrxDesignerForm.SetScale(Value: Double);
+begin
+ //ScrollBox.AutoScroll := False;
+ if Value = 0 then
+ Value := 1;
+ if Value > 20 then
+ Value := 20;
+ FScale := Value;
+ TopRuler.Scale := Value;
+ LeftRuler.Scale := Value;
+ FWorkspace.Scale := Value;
+ ScaleCB.OnChange := nil;
+ ScaleCB.Text := IntToStr(Round(FScale * 100)) + '%';
+ ScaleCB.OnChange := ScaleCBClick;
+ UpdatePageDimensions;
+ //ScrollBox.AutoScroll := True;
+end;
+
+procedure TfrxDesignerForm.SetShowGrid(const Value: Boolean);
+begin
+ FShowGrid := Value;
+ ShowGridB.IsPressed := FShowGrid;
+ FWorkspace.ShowGrid := FShowGrid;
+end;
+
+procedure TfrxDesignerForm.SetShowRulers(const Value: Boolean);
+begin
+ FShowRulers := Value;
+ TopRuler.Visible := FShowRulers;
+ LeftRuler.Visible := FShowRulers;
+ ShowRulersMI.IsChecked := FShowRulers;
+// ShowRulersCmd.Checked := FShowRulers;
+end;
+
+procedure TfrxDesignerForm.SetShowGuides(const Value: Boolean);
+begin
+ FShowGuides := Value;
+ TDesignerWorkspace(FWorkspace).ShowGuides := FShowGuides;
+ ShowGuidesMI.IsChecked := FShowGuides;
+end;
+
+procedure TfrxDesignerForm.SetUnits(const Value: TfrxDesignerUnits);
+var
+ s: String;
+ gType: TfrxGridType;
+ gSizeX, gSizeY: Extended;
+begin
+ FUnits := Value;
+ s := '';
+ if FUnits = duCM then
+ begin
+ s := frxResources.Get('dsCm');
+ gType := gt1cm;
+ gSizeX := FGridSize1 * fr1cm;
+ gSizeY := gSizeX;
+ end
+ else if FUnits = duInches then
+ begin
+ s := frxResources.Get('dsInch');
+ gType := gt1in;
+ gSizeX := FGridSize2 * fr1in;
+ gSizeY := gSizeX;
+ end
+ else if FUnits = duPixels then
+ begin
+ s := frxResources.Get('dsPix');
+ gType := gt1pt;
+ gSizeX := FGridSize3;
+ gSizeY := gSizeX;
+ end
+ else {if FUnits = duChars then}
+ begin
+ s := frxResources.Get('dsChars');
+ gType := gtChar;
+ gSizeX := fr1CharX;
+ gSizeY := fr1CharY;
+ end;
+
+ //StatusBar.Panels[0].Text := s;
+ TopRuler.Units := TfrxRulerUnits(FUnits);
+ LeftRuler.Units := TfrxRulerUnits(FUnits);
+
+ with FWorkspace do
+ begin
+ GridType := gType;
+ GridX := gSizeX;
+ GridY := gSizeY;
+ AdjustBands;
+ end;
+
+ if FSelectedObjects.Count <> 0 then
+ OnSelectionChanged(Self);
+end;
+
+
+{ Service methods }
+{------------------------------------------------------------------------------}
+
+procedure TfrxDesignerForm.Init;
+var
+ i: Integer;
+begin
+ Label1.WordWrap := True;
+ FPictureCache := TfrxPictureCache.Create;
+ FScale := 1;
+ ScrollBoxPanel.Align := alClient;
+ ScrollBox.ShowScrollBars := true;
+{$IFNDEF MSWINDOWS}
+ {$IFDEF DELPHI18}
+ ScrollBox.AutoHide := false;
+ {$ENDIF}
+{$ENDIF}
+{$IFDEF DELPHI19}
+ ScrollBox.AniCalculations.AutoShowing := false;
+{$ENDIF}
+ CodePanel.Align := alClient;
+ ScrollBoxPanel.StyleLookup := 'backgroundstyle';
+ BackPanel.StyleLookup := 'backgroundstyle';
+ TabPanel.StyleLookup := 'backgroundstyle';
+ RightDockTB.StyleLookup := 'backgroundstyle';
+ LeftDockTB.StyleLookup := 'backgroundstyle';
+
+// if Screen.PixelsPerInch > 96 then
+// begin
+// StatusBar.Panels[0].Width := 100;
+// StatusBar.Panels[1].Width := 280;
+// StatusBar.Height := 24;
+// end;
+
+
+ LangCB.OnChange := nil;
+ fsGetLanguageList(LangCB.Items);
+ LangCB.OnChange := LangCBClick;
+ frxAddCodeRes;
+
+ FUndoBuffer := TfrxUndoBuffer.Create;
+ FUndoBuffer.PictureCache := FPictureCache;
+
+ FClipboard := TfrxClipboard.Create(Self);
+ FClipboard.PictureCache := FPictureCache;
+ Timer.Enabled := True;
+
+ FRecentFiles := TStringList.Create;
+// FRecentMenuIndex := FileMenu.IndexOf(SepMI4);
+ FSampleFormat := TSampleFormat.Create;
+ FPagePositions := TStringList.Create;
+ for i := 1 to 256 do
+ FPagePositions.Add('');
+
+ if IsPreviewDesigner then
+ begin
+ FOldDesignerComp := frxDesignerComp;
+ TfrxDesigner.Create(nil);
+ frxDesignerComp.Restrictions := [drDontDeletePage, drDontCreatePage,
+ drDontCreateReport, drDontLoadReport, drDontPreviewReport,
+ drDontEditVariables, drDontChangeReportOptions];
+ if FOldDesignerComp <> nil then
+ frxDesignerComp.Restrictions := frxDesignerComp.Restrictions + FOldDesignerComp.Restrictions;
+
+ ObjectBandB.Enabled := False;
+ end;
+{$IFDEF LINUX}
+
+{$ELSE}
+ Report.SelectPrinter;
+{$ENDIF}
+
+ FontNameCB.BeginUpdate;
+ FontNameCB.Clear;
+ FillFontsList(FontNameCB.Items);
+{ for i := 0 to FontNameCB.ListBox.Count - 1 do
+ begin
+ FontNameCB.ListBox.ListItems[i].Font.Family := FontNameCB.Items[i];
+ FontNameCB.ListBox.ListItems[i].Font.Size := 14;
+ end;}
+
+ FontNameCB.EndUpdate;
+
+ NewMI.Visible := False;
+
+{$IFDEF FR_VER_BASIC}
+ NewDialogMI1.Enabled := False;
+ NewDialogMI.Enabled := False;
+ NewDialogB.Enabled := False;
+{$ENDIF}
+
+ NewReportMI.Enabled := CheckOp(drDontCreateReport);
+ NewMI.Enabled := CheckOp(drDontCreateReport);
+ NewPageMI.Enabled := CheckOp(drDontCreatePage);
+ NewDialogMI1.Enabled := NewDialogMI1.Enabled and CheckOp(drDontCreatePage);
+ SaveAsMI.Enabled := CheckOp(drDontSaveReport);
+ OpenMI.Enabled := CheckOp(drDontLoadReport);
+ ReportSettingsMI.Enabled := CheckOp(drDontChangeReportOptions);
+ ReportStylesMI.Enabled := CheckOp(drDontChangeReportOptions);
+ ReportDataMI.Enabled := CheckOp(drDontEditReportData);
+ VariablesMI.Enabled := CheckOp(drDontEditVariables);
+ PreviewMI.Enabled := CheckOp(drDontPreviewReport);
+end;
+
+procedure TfrxDesignerForm.Done;
+begin
+ if IsPreviewDesigner then
+ begin
+ frxDesignerComp.Free;
+ frxDesignerComp := FOldDesignerComp;
+ end;
+
+ FPictureCache.Free;
+ FUndoBuffer.Free;
+ FClipboard.Free;
+ FRecentFiles.Free;
+ FSampleFormat.Free;
+ FPagePositions.Free;
+end;
+
+procedure TfrxDesignerForm.ReadButtonImages;
+begin
+end;
+
+procedure TfrxDesignerForm.CreateToolWindows;
+begin
+ FInspector := TfrxObjectInspector.Create(Self);
+ with FInspector do
+ begin
+ OnModify := Self.OnModify;
+ OnSelectionChanged := Self.OnSelectionChanged;
+ FInspector.MainPanel.Parent := LeftDockTB;
+ FInspector.Visible := False;
+ SelectedObjects := FSelectedObjects;
+ end;
+
+ FDataTree := TfrxDataTreeForm.Create(Self);
+ with FDataTree do
+ begin
+ Report := Self.Report;
+ CBPanel.Visible := True;
+ FDataTree.MainDataPanel.Parent := RightDockTB;
+ end;
+ UpdateDataTree;
+
+ Splitter3 := TSplitter.Create(Self);
+ Splitter3.Align := TAlignLayout.alTop;
+ Splitter3.Height := 5;
+ Splitter3.MinSize := 100;
+ Splitter3.Parent := LeftDockTB;
+
+ FReportTree := TfrxReportTreeForm.Create(Self);
+ FReportTree.OnSelectionChanged := OnSelectionChanged;
+ FReportTree.MainPanel.Parent := LeftDockTB;
+ FReportTree.MainPanel.Align := TAlignLayout.alMostTop;
+ FReportTree.MainPanel.Height := Round(LeftDockTB.Height / 2);
+
+ FWatchList := TfrxWatchForm.Create(Self);
+ FWatchList.Script := Report.Script;
+end;
+
+procedure TfrxDesignerForm.CreateWorkspace;
+begin
+ FWorkspace := TDesignerWorkspace.Create(Self);
+ with FWorkspace do
+ begin
+ Parent := ScrollBox;
+ OnNotifyPosition := Self.OnNotifyPosition;
+ OnInsert := OnInsertObject;
+ OnEdit := OnEditObject;
+ OnModify := Self.OnModify;
+ OnSelectionChanged := Self.OnSelectionChanged;
+ OnPopup := PagePopupPopup;
+ Objects := FObjects;
+ SelectedObjects := FSelectedObjects;
+ end;
+
+ FCodeWindow := TfsSyntaxMemo.Create(Self);
+ with FCodeWindow do
+ begin
+ Parent := CodePanel;
+ Align := alClient;
+ Lines := Report.ScriptText;
+ //Color := claWhite;
+ OnChange := OnCodeChanged;
+ //OnChangePos := OnChangePosition;
+ OnDragOver := CodeWindowDragOver;
+ OnDragDrop := CodeWindowDragDrop;
+ //OnCodeCompletion := Self.OnCodeCompletion;
+ end;
+
+
+ FTabs := TTabControl.Create(Self);
+ FTabs.OnChange := TabChange;
+ //FTabs.OnChanging := TabChanging;
+ FTabs.Parent := TabPanel;
+ FTabs.TabHeight := 20;
+ TabPanel.Margins.Top := 3;
+ FTabs.Align := TAlignLayout.alTop;
+ FTabs.Height := TabPanel.Height - TabPanel.Margins.Top;
+ FTabs.StyleLookup := 'TabControl1Style1';
+ ScrollBoxPanel.Margins.Top := 2;
+ FMouseTabDX := 0;
+end;
+
+procedure TfrxDesignerForm.CreateObjectsToolbar;
+var
+ i: Integer;
+ ObjCount: Integer;
+ Item: TfrxObjectItem;
+
+ function HasButtons(Item: TfrxObjectItem): Boolean;
+ var
+ i: Integer;
+ Item1: TfrxObjectItem;
+ begin
+ Result := False;
+ for i := 0 to frxObjects.Count - 1 do
+ begin
+ Item1 := frxObjects[i];
+ if (Item1.ClassRef <> nil) and (Item1.CategoryName = Item.CategoryName) then
+ Result := True;
+ end;
+ end;
+
+ procedure CreateButton(Index: Integer; Item: TfrxObjectItem);
+ var
+ b: TfrxToolButton;
+ s: String;
+ begin
+ b := TfrxToolButton.Create(Self);
+ b.Parent := ObjectsTB1;
+ frxResources.LoadImageFromResouce(b.Bitmap, Item.ButtonImageIndex);
+ b.SetBounds(0, 30, 30, 30);
+ b.Align := TAlignLayout.alTop;
+ s := Item.ButtonHint;
+ if s = '' then
+ begin
+ if Item.ClassRef <> nil then
+ s := Item.ClassRef.GetDescription;
+ end
+ else
+ s := frxResources.Get(s);
+ b.Hint := s;
+ b.OnMouseEnter := NewPageBMouseEnter;
+ b.OnMouseLeave := NewPageBMouseLeave;
+ b.Tag := Index;
+ if Item.ClassRef = nil then { category }
+ if not HasButtons(Item) then
+ begin
+ b.Free;
+ Exit;
+ end;
+ b.OnClick := ObjectsButtonClick;
+ end;
+
+begin
+ ObjectSelectB := TfrxToolButton.Create(Self);
+ with ObjectSelectB do
+ begin
+ Parent := ObjectsTB1;
+ StaysPressed := True;
+ Down := True;
+ Align := TAlignLayout.alTop;
+ Height := 30;
+ frxResources.LoadImageFromResouce(Bitmap, 10, 0);
+ OnClick := SelectToolBClick;
+ end;
+
+ ObjectBandB := TfrxToolButton.Create(Self);
+ with ObjectBandB do
+ begin
+ Parent := ObjectsTB1;
+ Tag := 1000;
+ Align := TAlignLayout.alTop;
+ Height := 30;
+ frxResources.LoadImageFromResouce(Bitmap, 21, 8);
+ OnClick := ObjectBandBClick;
+ end;
+
+ ObjCount := frxObjects.Count - 1;
+
+ { add category buttons }
+ for i := ObjCount downto 0 do
+ begin
+ Item := frxObjects[i];
+{ if (Item.ButtonBmp <> nil) and (Item.ButtonImageIndex = -1) then
+ begin
+ frxResources.SetObjectImages(Item.ButtonBmp);
+ Item.ButtonImageIndex := frxResources.ObjectImages.Count - 1;
+ end;}
+ if Item.ClassRef = nil then
+ CreateButton(i, Item);
+ end;
+
+ { add object buttons }
+ for i := ObjCount downto 0 do
+ begin
+ Item := frxObjects[i];
+{ if (Item.ButtonBmp <> nil) and (Item.ButtonImageIndex = -1) then
+ begin
+ frxResources.SetObjectImages(Item.ButtonBmp);
+ Item.ButtonImageIndex := frxResources.ObjectImages.Count - 1;
+ end;}
+
+ if (Item.ClassRef <> nil) and (Item.CategoryName = '') then
+ CreateButton(i, Item);
+ end;
+end;
+
+procedure TfrxDesignerForm.CreateExtraToolbar;
+//var
+// i: Integer;
+// Item: TfrxWizardItem;
+// b: TfrxToolButton;
+begin
+{ for i := 0 to frxWizards.Count - 1 do
+ begin
+ Item := frxWizards[i];
+ if Item.IsToolbarWizard then
+ begin
+ b := TfrxToolButton.Create(Self);
+ with b do
+ begin
+ Tag := i;
+ if (Item.ButtonBmp <> nil) and (Item.ButtonImageIndex = -1) then
+ begin
+ frxResources.SetButtonImages(Item.ButtonBmp);
+ Item.ButtonImageIndex := frxResources.MainButtonImages.Count - 1;
+ end;
+ //ImageIndex := Item.ButtonImageIndex;
+ Hint := Item.ClassRef.GetDescription;
+ SetBounds(1000, 0, 22, 22);
+ Parent := ExtraToolsTB;
+ end;
+ b.OnClick := OnExtraToolClick;
+ end;
+ end;
+
+ ExtraToolsTB.Height := 27;
+ ExtraToolsTB.Width := 27;}
+end;
+
+procedure TfrxDesignerForm.ReloadReport;
+var
+ i: Integer;
+ l: TList;
+ c: TfrxComponent;
+ p: TfrxPage;
+ isDMP: Boolean;
+begin
+ if Report.PagesCount = 0 then
+ begin
+ isDMP := Report.DotMatrixReport;
+ p := TfrxDataPage.Create(Report);
+ p.Name := 'Data';
+ if isDMP then
+ p := TfrxDMPPage.Create(Report)
+ else
+ begin
+ p := TfrxReportPage.Create(Report);
+ TfrxReportPage(p).SetDefaults;
+ end;
+ p.Name := 'Page1';
+ end;
+
+ if not IsPreviewDesigner then
+ Report.CheckDataPage;
+ LangCB.OnChange := nil;
+ LangCB.ItemIndex := LangCB.Items.IndexOf(Report.ScriptLanguage);
+ LangCB.OnChange := LangCBClick;
+ CodeWindow.Lines := Report.ScriptText;
+ UpdateSyntaxType;
+ ReloadPages(-2);
+ UpdateRecentFiles(Report.FileName);
+ UpdateCaption;
+ UpdateStyles;
+
+ FPictureCache.Clear;
+ l := Report.AllObjects;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if c is TfrxPictureView then
+ FPictureCache.AddPicture(TfrxPictureView(c));
+ end;
+
+ FUndoBuffer.ClearUndo;
+ Modified := False;
+end;
+
+procedure TfrxDesignerForm.ReloadPages(Index: Integer);
+var
+ i: Integer;
+ c: TfrxPage;
+ s: String;
+ tItem: TTabItem;
+begin
+{$IFDEF Delphi20}
+ FTabs.BeginUpdate;
+{$ENDIF}
+ while FTabs.TabCount > 0 do
+{$IFNDEF Delphi17}
+ FTabs.RemoveObject(FTabs.Tabs[FTabs.TabCount - 1]);
+{$ELSE}
+ FTabs.Tabs[0].Free;
+{$ENDIF}
+{$IFDEF Delphi20}
+ FTabs.TabIndex := -1;
+{$ENDIF}
+ tItem := TTabItem.Create(FTabs);
+ tItem.Text := frxResources.Get('dsCode');
+ FTabs.AddObject(tItem);
+ FTabs.OnMouseLeave := TabMouseLeave;
+ FTabs.OnDragEnd := TabDragEnd;
+
+ for i := 0 to Report.PagesCount - 1 do
+ begin
+ c := Report.Pages[i];
+ c.IsDesigning := True;
+ if (c is TfrxReportPage) and (TfrxReportPage(c).Subreport <> nil) then
+ s := TfrxReportPage(c).Subreport.Name
+ else if c is TfrxDataPage then
+ s := frxResources.Get('dsData')
+ else if c.Name = '' then
+ s := frxResources.Get('dsPage') + IntToStr(i + 1) else
+ s := c.Name;
+ tItem := TTabItem.Create(FTabs);
+ tItem.Tag := i;
+ tItem.Text := s;
+ FTabs.AddObject(tItem);
+ tItem.OnDragDrop := TabDragDrop;
+ tItem.OnDragOver := TabDragOver;
+ tItem.OnMouseDown := TabMouseDown;
+ tItem.OnMouseMove := TabMouseMove;
+ tItem.OnMouseUp := TabMouseUp;
+ tItem.OnDragEnd := TabDragEnd;
+ end;
+{$IFDEF Delphi20}
+ FTabs.EndUpdate;
+{$ENDIF}
+ if Index = -1 then
+ Page := nil
+ else if Index = -2 then
+ begin
+ for i := 0 to Report.PagesCount - 1 do
+ begin
+ c := Report.Pages[i];
+ if not (c is TfrxDataPage) then
+ begin
+ Page := c;
+ break;
+ end;
+ end;
+ end
+ else if Index < Report.PagesCount then
+ Page := Report.Pages[Index] else
+ Page := Report.Pages[0];
+end;
+
+procedure TfrxDesignerForm.ReloadObjects;
+var
+ i: Integer;
+begin
+ FObjects.Clear;
+ FSelectedObjects.Clear;
+
+ for i := 0 to FPage.AllObjects.Count - 1 do
+ FObjects.Add(FPage.AllObjects[i]);
+
+ FObjects.Add(Report);
+ FObjects.Add(FPage);
+ FSelectedObjects.Add(FPage);
+ FWorkspace.Page := FPage;
+ FWorkspace.EnableUpdate;
+ FWorkspace.AdjustBands;
+
+ FInspector.EnableUpdate;
+
+ UpdateDataTree;
+ FReportTree.UpdateItems;
+ OnSelectionChanged(Self);
+end;
+
+procedure TfrxDesignerForm.SetReportDefaults;
+begin
+ if frxDesignerComp <> nil then
+ begin
+ Report.ScriptLanguage := frxDesignerComp.DefaultScriptLanguage;
+ frxEmptyCode(CodeWindow.Lines, Report.ScriptLanguage);
+ UpdateSyntaxType;
+ LangCB.OnChange := nil;
+ LangCB.ItemIndex := LangCB.Items.IndexOf(Report.ScriptLanguage);
+ LangCB.OnChange := LangCBClick;
+
+ with TfrxReportPage(Report.Pages[1]) do
+ begin
+ LeftMargin := frxDesignerComp.DefaultLeftMargin;
+ BottomMargin := frxDesignerComp.DefaultBottomMargin;
+ RightMargin := frxDesignerComp.DefaultRightMargin;
+ TopMargin := frxDesignerComp.DefaultTopMargin;
+ PaperSize := frxDesignerComp.DefaultPaperSize;
+ Orientation := frxDesignerComp.DefaultOrientation;
+ end;
+ end
+ else
+ begin
+ Report.ScriptLanguage := 'PascalScript';
+ frxEmptyCode(CodeWindow.Lines, Report.ScriptLanguage);
+ UpdateSyntaxType;
+ LangCB.OnChange := nil;
+ LangCB.ItemIndex := LangCB.Items.IndexOf(Report.ScriptLanguage);
+ LangCB.OnChange := LangCBClick;
+
+ TfrxReportPage(Report.Pages[1]).SetDefaults;
+ end;
+ Report.ScriptText.Text := CodeWindow.Lines.Text;
+end;
+
+procedure TfrxDesignerForm.UpdatePageDimensions;
+var
+ h: Extended;
+begin
+ if FPage is TfrxReportPage then
+ begin
+ with FPage as TfrxReportPage do
+ begin
+{$IFDEF DELPHI18}
+ ScrollBox.ViewportPosition := PointF(0, 0);
+{$ELSE}
+ ScrollBox.HScrollBar.Value := 0;
+ ScrollBox.VScrollBar.Value := 0;
+{$ENDIF}
+
+ FWorkspace.Origin := Point(10, 10);
+ h := PaperHeight;
+ if LargeDesignHeight then
+ h := h * 5;
+ FWorkspace.SetPageDimensions(
+ Round(PaperWidth * 96 / 25.4),
+ Round(h * 96 / 25.4),
+ Rect(Round(LeftMargin * 96 / 25.4), Round(TopMargin * 96 / 25.4),
+ Round(RightMargin * 96 / 25.4), Round(BottomMargin * 96 / 25.4)));
+ end;
+ end
+ else if FPage is TfrxDialogPage then
+ begin
+ with FPage as TfrxDialogPage do
+ begin
+{$IFDEF DELPHI18}
+ ScrollBox.ViewportPosition := PointF(0, 0);
+{$ELSE}
+ ScrollBox.HScrollBar.Value := 0;
+ ScrollBox.VScrollBar.Value := 0;
+{$ENDIF}
+
+ FWorkspace.Origin := Point(10, 10);
+ TfrxDialogPage(FPage).UpdateClientRect;
+ FWorkspace.SetPageDimensions(Round(ClientWidth), Round(ClientHeight), Rect(0, 0, 0, 0));
+ end;
+ end
+ else if FPage is TfrxDataPage then
+ begin
+{$IFDEF DELPHI18}
+ ScrollBox.ViewportPosition := PointF(0, 0);
+{$ELSE}
+ ScrollBox.HScrollBar.Value := 0;
+ ScrollBox.VScrollBar.Value := 0;
+{$ENDIF}
+
+ FWorkspace.Origin := Point(0, 0);
+ FWorkspace.SetPageDimensions(
+ Round(FPage.Width),
+ Round(FPage.Height),
+ Rect(0, 0, 0, 0));
+ end;
+
+ ScrollBoxResize(nil);
+end;
+
+procedure TfrxDesignerForm.UpdateControls;
+
+const WidthsArr: array[0..12] of Extended = (0.1, 0.5, 1, 1.5, 2, 3, 4, 5, 6, 7, 8, 9, 10);
+
+var
+ c: TfrxComponent;
+ p1, p2, p3: PPropInfo;
+ Count, i: Integer;
+ FontEnabled, AlignEnabled, IsReportPage: Boolean;
+ Frame1Enabled, Frame2Enabled, Frame3Enabled, ObjSelected, DMPEnabled: Boolean;
+ s: String;
+ Frame: TfrxFrame;
+ DMPFontStyle: TfrxDMPFontStyles;
+
+ procedure SetEnabled(cAr: array of TControl; Enabled: Boolean);
+ var
+ i: Integer;
+ begin
+ for i := 0 to High(cAr) do
+ begin
+ cAr[i].Enabled := Enabled;
+ if (cAr[i] is TfrxToolButton) and not Enabled then
+ TfrxToolButton(cAr[i]).IsPressed := False;
+ end;
+ end;
+
+ procedure ButtonUp(cAr: array of TfrxToolButton);
+ var
+ i: Integer;
+ begin
+ for i := 0 to High(cAr) do
+ cAr[i].IsPressed := False;
+ end;
+
+begin
+ FUpdatingControls := True;
+
+ Count := FSelectedObjects.Count;
+ if Count > 0 then
+ begin
+ c := FSelectedObjects[0];
+ p1 := GetPropInfo(PTypeInfo(c.ClassInfo), 'Font');
+ p2 := GetPropInfo(PTypeInfo(c.ClassInfo), 'Frame');
+ p3 := GetPropInfo(PTypeInfo(c.ClassInfo), 'Color');
+ end
+ else
+ begin
+ c := nil;
+ p1 := nil;
+ p2 := nil;
+ p3 := nil;
+ end;
+
+ if Count = 1 then
+ begin
+ FontNameCB.Text := c.Font.Name;
+ FontSizeCB.Text := IntToStr(Round(c.Font.Size));
+
+ BoldB.IsPressed := fsBold in c.Font.Style;
+ ItalicB.IsPressed := fsItalic in c.Font.Style;
+ UnderlineB.IsPressed := fsUnderline in c.Font.Style;
+
+ if c is TfrxCustomMemoView then
+ with TfrxCustomMemoView(c) do
+ begin
+ TextAlignLeftB.IsPressed := HAlign = haLeft;
+ TextAlignCenterB.IsPressed := HAlign = haCenter;
+ TextAlignRightB.IsPressed := HAlign = haRight;
+ TextAlignBlockB.IsPressed := HAlign = haBlock;
+
+ TextAlignTopB.IsPressed := VAlign = vaTop;
+ TextAlignMiddleB.IsPressed := VAlign = vaCenter;
+ TextAlignBottomB.IsPressed := VAlign = vaBottom;
+ if not (c is TfrxDMPMemoView) then
+ if Style = '' then
+ StyleCB.Text := StyleCB.Items[0] else
+ StyleCB.Text := Style;
+ end;
+
+ Frame := nil;
+ if c is TfrxView then
+ Frame := TfrxView(c).Frame
+ else if c is TfrxReportPage then
+ Frame := TfrxReportPage(c).Frame;
+ FrameWidthCB.BeginUpdate;
+{$IFDEF DELPHI23}
+ FrameWidthCB.Clear;
+{$ELSE}
+ FrameWidthCB.Items.Clear;
+{$ENDIF}
+ for i := 0 to 12 do
+ FrameWidthCB.Items.Add(FloatToStr(WidthsArr[i]));
+ FrameWidthCB.EndUpdate;
+ if Frame <> nil then
+ with Frame do
+ begin
+ FrameTopB.IsPressed := ftTop in Typ;
+ FrameBottomB.IsPressed := ftBottom in Typ;
+ FrameLeftB.IsPressed := ftLeft in Typ;
+ FrameRightB.IsPressed := ftRight in Typ;
+ ShadowB.IsPressed := DropShadow;
+
+ FrameWidthCB.Text := FloatToStr(Width);
+ end;
+ end
+ else
+ begin
+ FontNameCB.Text := '';
+ FontSizeCB.Text := '';
+ FrameWidthCB.Text := '';
+
+ ButtonUp([BoldB, ItalicB, UnderlineB, TextAlignLeftB, TextAlignCenterB,
+ TextAlignRightB, TextAlignBlockB, TextAlignTopB, TextAlignMiddleB,
+ TextAlignBottomB, FrameTopB, FrameBottomB, FrameLeftB,
+ FrameRightB, ShadowB]);
+ end;
+
+ FontEnabled := (p1 <> nil) and not (c is TfrxDMPPage) and (FPage <> nil);
+ AlignEnabled := (c is TfrxCustomMemoView) and (FPage <> nil);
+ Frame1Enabled := (p2 <> nil) and not (c is TfrxLineView) and
+ not (c is TfrxShapeView) and not (c is TfrxDMPPage) and (FPage <> nil);
+ Frame2Enabled := (p2 <> nil) and not (c is TfrxDMPPage) and (FPage <> nil);
+ Frame3Enabled := (p3 <> nil) and not (c is TfrxDMPPage) and (FPage <> nil);
+ IsReportPage := FPage is TfrxReportPage;
+ ObjSelected := (Count <> 0) and (FPage <> nil) and (FSelectedObjects[0] <> FPage);
+ DMPEnabled := (c is TfrxDMPMemoView) or (c is TfrxDMPLineView) or
+ (c is TfrxDMPCommand) or (c is TfrxDMPPage);
+
+ SetEnabled([FontNameCB, FontSizeCB, BoldB, ItalicB, UnderlineB, FontColorB],
+ (FontEnabled or (Count > 1)) and not (FPage is TfrxDMPPage));
+ SetEnabled([FontB], (FontEnabled or DMPEnabled or (Count > 1)));
+ SetEnabled([TextAlignLeftB, TextAlignCenterB, TextAlignRightB,
+ TextAlignBlockB, TextAlignTopB, TextAlignMiddleB, TextAlignBottomB],
+ AlignEnabled or (Count > 1));
+ SetEnabled([StyleCB, HighlightB, RotateB],
+ (AlignEnabled or (Count > 1)) and not (FPage is TfrxDMPPage));
+ SetEnabled([FrameTopB, FrameBottomB, FrameLeftB, FrameRightB, FrameAllB,
+ FrameNoB, ShadowB], Frame1Enabled or (Count > 1));
+ SetEnabled([FrameColorB, FrameStyleB, FrameWidthCB],
+ (Frame2Enabled or (Count > 1)) and not (FPage is TfrxDMPPage));
+ SetEnabled([FillColorB], Frame3Enabled and not (FPage is TfrxDMPPage));
+ if Report.DotMatrixReport then
+ begin
+ //FontB.DropDownMenu := DMPPopup;
+ FontB.OnClick := nil;
+ end
+ else
+ begin
+ //FontB.DropDownMenu := nil;
+ FontB.OnClick := FontBClick;
+ end;
+
+ DMPFontStyle := [];
+ if c is TfrxDMPMemoView then
+ DMPFontStyle := TfrxDMPMemoView(c).FontStyle;
+ if c is TfrxDMPLineView then
+ DMPFontStyle := TfrxDMPLineView(c).FontStyle;
+ if c is TfrxDMPPage then
+ DMPFontStyle := TfrxDMPPage(c).FontStyle;
+
+ BoldMI.IsChecked := fsxBold in DMPFontStyle;
+ ItalicMI.IsChecked := fsxItalic in DMPFontStyle;
+ UnderlineMI.IsChecked := fsxUnderline in DMPFontStyle;
+ SuperScriptMI.IsChecked := fsxSuperScript in DMPFontStyle;
+ SubScriptMI.IsChecked := fsxSubScript in DMPFontStyle;
+ CondensedMI.IsChecked := fsxCondensed in DMPFontStyle;
+ WideMI.IsChecked := fsxWide in DMPFontStyle;
+ N12cpiMI.IsChecked := fsx12cpi in DMPFontStyle;
+ N15cpiMI.IsChecked := fsx15cpi in DMPFontStyle;
+
+ UndoB.Enabled := (FUndoBuffer.UndoCount > 1);
+ RedoB.Enabled := (FUndoBuffer.RedoCount > 0) and (FPage <> nil);
+ CutB.Enabled := ((Count <> 0) and (FSelectedObjects[0] <> FPage)) or (FPage = nil);
+ CopyB.Enabled := CutB.Enabled;
+ TimerTimer(nil);
+
+ PageSettingsB.Enabled := IsReportPage and CheckOp(drDontChangePageOptions);
+ DeletePageB.Enabled := (Report.PagesCount > 2) and (FPage <> nil) and
+ not (FPage is TfrxDataPage) and CheckOp(drDontDeletePage) and
+ not Page.IsAncestor;
+ SaveB.Enabled := Modified and CheckOp(drDontSaveReport);
+ DeleteMI.Enabled := ObjSelected;
+ SelectAllMI.Enabled := (FObjects.Count > 2) or (FPage = nil);
+ EditMI.Enabled := (Count = 1) and (FPage <> nil);
+ SetToGridB.Enabled := ObjSelected;
+ BringtoFrontMI.Enabled := ObjSelected;
+ SendtoBackMI.Enabled := ObjSelected;
+ GroupB.Enabled := ObjSelected and (FSelectedObjects[0] <> Report);
+ UngroupB.Enabled := GroupB.Enabled;
+ ScaleCB.Enabled := IsReportPage;
+
+ if Count <> 1 then
+ s := ''
+ else
+ begin
+ s := c.Name;
+ if c is TfrxView then
+ if TfrxView(c).IsDataField then
+ s := s + ': ' + Report.GetAlias(TfrxView(c).DataSet) + '."' + TfrxView(c).DataField + '"'
+ else if c is TfrxCustomMemoView then
+ s := s + ': ' + Copy(TfrxCustomMemoView(c).Text, 1, 128);
+ if c is TfrxDataBand then
+ if TfrxDataBand(c).DataSet <> nil then
+ s := s + ': ' + Report.GetAlias(TfrxDataBand(c).DataSet);
+ if c is TfrxGroupHeader then
+ s := s + ': ' + TfrxGroupHeader(c).Condition
+ end;
+
+ //StatusBar.Panels[2].Text := s;
+
+ FUpdatingControls := False;
+end;
+
+procedure TfrxDesignerForm.UpdateDataTree;
+begin
+ FDataTree.UpdateItems;
+end;
+
+procedure TfrxDesignerForm.UpdateInspector;
+begin
+ FInspector.UpdateProperties;
+end;
+
+procedure TfrxDesignerForm.UpdateStyles;
+begin
+ Report.Styles.GetList(StyleCB.Items);
+ StyleCB.Items.Insert(0, frxResources.Get('dsNoStyle'));
+end;
+
+procedure TfrxDesignerForm.UpdateSyntaxType;
+begin
+ //CodeWindow.SyntaxType := Report.ScriptLanguage;
+ if CompareText(Report.ScriptLanguage, 'PascalScript') = 0 then
+ begin
+ CodeWindow.SyntaxType := TSyntaxType.stPascal;
+ OpenScriptDialog.FilterIndex := 1;
+ OpenScriptDialog.DefaultExt := 'pas';
+ SaveScriptDialog.FilterIndex := 1;
+ SaveScriptDialog.DefaultExt := 'pas';
+ end
+ else if CompareText(Report.ScriptLanguage, 'C++Script') = 0 then
+ begin
+ CodeWindow.SyntaxType := TSyntaxType.stCpp;
+ OpenScriptDialog.FilterIndex := 2;
+ OpenScriptDialog.DefaultExt := 'cpp';
+ SaveScriptDialog.FilterIndex := 2;
+ SaveScriptDialog.DefaultExt := 'cpp';
+ end
+ else if CompareText(Report.ScriptLanguage, 'JScript') = 0 then
+ begin
+ CodeWindow.SyntaxType := TSyntaxType.stJs;
+ OpenScriptDialog.FilterIndex := 3;
+ OpenScriptDialog.DefaultExt := 'js';
+ SaveScriptDialog.FilterIndex := 3;
+ SaveScriptDialog.DefaultExt := 'js';
+ end
+ else if CompareText(Report.ScriptLanguage, 'BasicScript') = 0 then
+ begin
+ CodeWindow.SyntaxType := TSyntaxType.stVB;
+ OpenScriptDialog.FilterIndex := 4;
+ OpenScriptDialog.DefaultExt := 'vb';
+ SaveScriptDialog.FilterIndex := 4;
+ SaveScriptDialog.DefaultExt := 'vb';
+ end
+ else
+ begin
+ OpenScriptDialog.FilterIndex := 5;
+ OpenScriptDialog.DefaultExt := '';
+ SaveScriptDialog.FilterIndex := 5;
+ SaveScriptDialog.DefaultExt := '';
+ end
+end;
+
+procedure TfrxDesignerForm.FindOrReplace(replace: Boolean);
+begin
+ with TfrxSearchDialog.Create(Application) do
+ begin
+ FSearchReplace := replace;
+ //if FSearchReplace then
+ // ReplacePanel.Show;
+ if Page <> nil then
+ TopCB.Enabled := False;
+ if ShowModal = mrOk then
+ begin
+ FSearchText := TextE.Text;
+ FSearchReplaceText := ReplaceE.Text;
+ FSearchCase := CaseCB.IsChecked;
+ FSearchIndex := 0;
+ //if (Page = nil) and not TopCB.IsChecked then
+ // FSearchIndex := CodeWindow.GetPlainPos;
+ FindNextMI.Enabled := True;
+ FindText;
+ end;
+ Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.Lock;
+begin
+ FObjects.Clear;
+ FSelectedObjects.Clear;
+ FWorkspace.DisableUpdate;
+ FInspector.DisableUpdate;
+end;
+
+procedure TfrxDesignerForm.CreateColorSelector(Sender: TfrxToolButton);
+var
+ AColor: TAlphaColor;
+ i: Integer;
+begin
+ AColor := claBlack;
+ for i := 0 to SelectedObjects.Count - 1 do
+ if TObject(SelectedObjects[i]) is TfrxView then
+ begin
+ if Sender = FontColorB then
+ AColor := TfrxView(SelectedObjects[i]).Font.Color
+ else if Sender = FrameColorB then
+ AColor := TfrxView(SelectedObjects[i]).Frame.Color
+ else
+ AColor := TfrxView(SelectedObjects[i]).Color;
+ break;
+ end;
+
+ if FColorSelector = nil then
+ begin
+ FColorSelector := TfrxColorSelector.Create(Self);
+ FColorSelector.Parent := Self;
+ FColorSelector.OnColorChanged := Self.OnColorChanged;
+ end;
+
+ with FColorSelector do
+ begin
+ Color := AColor;
+ BtnCaption := frxResources.Get('dsColorOth');
+ Popup(Sender);
+ end;
+end;
+
+procedure TfrxDesignerForm.SwitchToCodeWindow;
+begin
+ Page := nil;
+end;
+
+function TfrxDesignerForm.AskSave: Word;
+begin
+ if IsPreviewDesigner then
+ Result := frxConfirmMsg(frxResources.Get('dsSavePreviewChanges'), [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo, TMsgDlgBtn.mbCancel])
+ else
+ Result := frxConfirmMsg(frxResources.Get('dsSaveChangesTo') + ' ' +
+ GetReportName + '?', [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo, TMsgDlgBtn.mbCancel]);
+end;
+
+function TfrxDesignerForm.CheckOp(Op: TfrxDesignerRestriction): Boolean;
+begin
+ Result := True;
+ if (frxDesignerComp <> nil) and (Op in frxDesignerComp.Restrictions) then
+ Result := False;
+end;
+
+function TfrxDesignerForm.GetPageIndex: Integer;
+begin
+ Result := Report.Objects.IndexOf(FPage);
+end;
+
+function TfrxDesignerForm.GetReportName: String;
+begin
+ if Report.FileName = '' then
+ Result := 'Untitled.'+ FTemplateExt else
+ Result := ExtractFileName(Report.FileName);
+end;
+
+procedure TfrxDesignerForm.LoadFile(FileName: String; UseOnLoadEvent: Boolean);
+var
+ SaveSilentMode: Boolean;
+
+ function SaveCurrentFile: Boolean;
+ var
+ w: Word;
+ begin
+ Result := True;
+ if Modified then
+ begin
+ w := AskSave;
+ if w = mrYes then
+ SaveFile(False, UseOnLoadEvent)
+ else if w = mrCancel then
+ Result := False;
+ end;
+ end;
+
+ procedure EmptyReport;
+ var
+ p: TfrxPage;
+ begin
+ Report.Clear;
+ p := TfrxDataPage.Create(Report);
+ p.Name := 'Data';
+ p := TfrxReportPage.Create(Report);
+ p.Name := 'Page1';
+ end;
+
+ procedure Error;
+ begin
+ frxErrorMsg(frxResources.Get('dsCantLoad'));
+ end;
+
+begin
+ SaveSilentMode := Report.EngineOptions.SilentMode;
+ Report.EngineOptions.SilentMode := False;
+
+ if FileName <> '' then // call from recent filelist
+ begin
+ if SaveCurrentFile then
+ begin
+ Lock;
+ if UseOnLoadEvent and (frxDesignerComp <> nil) and
+ Assigned(frxDesignerComp.FOnLoadRecentReport) then
+ begin
+ if frxDesignerComp.FOnLoadRecentReport(Report, FileName) then
+ ReloadReport else
+ ReloadPages(-2);
+ end
+ else
+ begin
+ try
+ if not Report.LoadFromFile(FileName) then
+ Error;
+ except
+ EmptyReport;
+ end;
+ end;
+ end;
+ Report.EngineOptions.SilentMode := SaveSilentMode;
+ ReloadReport;
+ Exit;
+ end;
+
+ if UseOnLoadEvent then
+ if (frxDesignerComp <> nil) and Assigned(frxDesignerComp.FOnLoadReport) then
+ begin
+ Lock;
+ if frxDesignerComp.FOnLoadReport(Report) then
+ ReloadReport else
+ ReloadPages(-2);
+ Report.EngineOptions.SilentMode := SaveSilentMode;
+ Exit;
+ end;
+
+ if frxDesignerComp <> nil then
+ OpenDialog.InitialDir := frxDesignerComp.OpenDir;
+ if OpenDialog.Execute then
+ begin
+ if SaveCurrentFile then
+ begin
+ Lock;
+ if not Report.LoadFromFile(OpenDialog.FileName) then
+ begin
+ Error;
+ EmptyReport;
+ end;
+ end;
+ Report.EngineOptions.SilentMode := SaveSilentMode;
+ ReloadReport;
+ end;
+ PeekLastModalResult;
+end;
+
+function TfrxDesignerForm.SaveFile(SaveAs: Boolean; UseOnSaveEvent: Boolean): Boolean;
+var
+ Saved: Boolean;
+ FilterCount: Integer;
+begin
+ Result := True;
+ Report.ScriptText := CodeWindow.Lines;
+ Report.ReportOptions.LastChange := Now;
+
+ if UseOnSaveEvent then
+ if (frxDesignerComp <> nil) and Assigned(frxDesignerComp.FOnSaveReport) then
+ begin
+ if frxDesignerComp.FOnSaveReport(Report, SaveAs) then
+ begin
+ UpdateRecentFiles(Report.FileName);
+ UpdateCaption;
+ Modified := False;
+ end;
+ Exit;
+ end;
+
+ Saved := True;
+ if SaveAs or (Report.FileName = '') then
+ begin
+ SaveDialog.DefaultExt := FTemplateExt;
+ SaveDialog.Filter := frxResources.Get('dsRepFilter');
+ FilterCount := 1;
+ if frxCompressorClass <> nil then
+ begin
+ SaveDialog.Filter := SaveDialog.Filter + '|' + frxResources.Get('dsComprRepFilter');
+ Inc(FilterCount);
+ end;
+ if frxSavePlugin <> nil then
+ begin
+ SaveDialog.Filter := SaveDialog.Filter + '|' + frxSavePlugin.FileFilter;
+ Inc(FilterCount);
+ end;
+
+ if Report.ReportOptions.Compressed and (frxCompressorClass <> nil) then
+ SaveDialog.FilterIndex := 2 else
+ SaveDialog.FilterIndex := 1;
+ if frxDesignerComp <> nil then
+ SaveDialog.InitialDir := frxDesignerComp.SaveDir;
+
+ Saved := SaveDialog.Execute;
+ PeekLastModalResult;
+ if Saved then
+ begin
+ if (frxSavePlugin <> nil) and (SaveDialog.FilterIndex = FilterCount) then
+ frxSavePlugin.Save(Report, SaveDialog.FileName)
+ else
+ begin
+ Report.ReportOptions.Compressed := SaveDialog.FilterIndex = 2;
+ Report.FileName := SaveDialog.FileName;
+ Report.SaveToFile(Report.FileName);
+ end;
+ end
+ end
+ else
+ Report.SaveToFile(Report.FileName);
+
+ UpdateRecentFiles(Report.FileName);
+ UpdateCaption;
+ if Saved then
+ Modified := False;
+ Result := Saved;
+end;
+
+procedure TfrxDesignerForm.UpdateCaption;
+begin
+ Caption := 'FastReport - ' + GetReportName;
+end;
+
+procedure TfrxDesignerForm.UpdateRecentFiles(NewFile: String);
+var
+ i: Integer;
+ m: TMenuItem;
+begin
+ if NewFile <> '' then
+ begin
+ if FRecentFiles.IndexOf(NewFile) <> -1 then
+ FRecentFiles.Delete(FRecentFiles.IndexOf(NewFile));
+ FRecentFiles.Add(NewFile);
+ while FRecentFiles.Count > 8 do
+ FRecentFiles.Delete(0);
+ end;
+
+ //SepMI11.Visible := FRecentFiles.Count <> 0;
+
+// for i := FileMenu.Count - 1 downto 0 do
+// begin
+// m := FileMenu.Items[i];
+// if m.Tag = 100 then
+// m.Free;
+// end;
+
+ if CheckOp(drDontShowRecentFiles) then
+ for i := FRecentFiles.Count - 1 downto 0 do
+ begin
+ m := TMenuItem.Create(FileMenu);
+ m.Text := FRecentFiles[i];
+ m.OnClick := OpenRecentFile;
+ m.Tag := 100;
+ //FileMenu.Insert(FileMenu.IndexOf(SepMI4), m);
+ end;
+end;
+
+procedure TfrxDesignerForm.SwitchToolbar;
+var
+ i: Integer;
+ Item: TfrxObjectItem;
+ b: TfrxToolButton;
+ Category: TfrxObjectCategories;
+ IsToolandBand: Boolean;
+
+ function GetCategory(Category: Integer): TfrxObjectCategories;
+ var
+ i: Integer;
+ Item: TfrxObjectItem;
+ begin
+ Result := [];
+ for i := 0 to frxObjects.Count - 1 do
+ begin
+ Item := frxObjects[i];
+ if (Item.ClassRef <> nil) and
+ (Item.CategoryName = frxObjects[Category].CategoryName) then
+ begin
+ Result := Item.Category;
+ break;
+ end;
+ end;
+ end;
+
+begin
+ ObjectSelectB.IsPressed := True;
+ SelectToolBClick(nil);
+
+ for i := ObjectsTB1.ChildrenCount - 1 downto 0 do
+ begin
+ b := TfrxToolButton(ObjectsTB1.Children[i]);
+
+ if b <> ObjectSelectB then
+ begin
+ IsToolandBand := False;
+ Category := [];
+
+ if b.Tag = 1000 then { tools and band }
+ IsToolandBand := True
+ else { object or category }
+ begin
+ Item := frxObjects[b.Tag];
+ if Item.ClassRef <> nil then { object }
+ Category := Item.Category
+ else
+ Category := GetCategory(b.Tag);
+ end;
+
+ if FPage is TfrxDialogPage then
+ b.Visible := ctDialog in Category
+ else if FPage is TfrxDMPPage then
+ b.Visible := (ctDMP in Category) or IsToolandBand
+ else if FPage is TfrxReportPage then
+ b.Visible := (ctReport in Category) or IsToolandBand
+ else if FPage is TfrxDataPage then
+ b.Visible := ctData in Category
+ else if FPage = nil then
+ b.Visible := False;
+ end;
+ end;
+end;
+
+function TfrxDesignerForm.mmToUnits(mm: Extended; X: Boolean = True): Extended;
+begin
+ Result := 0;
+ case FUnits of
+ duCM:
+ Result := mm / 10;
+ duInches:
+ Result := mm / 25.4;
+ duPixels:
+ Result := mm * 96 / 25.4;
+ duChars:
+ if X then
+ Result := Round(mm * fr01cm / fr1CharX) else
+ Result := Round(mm * fr01cm / fr1CharY);
+ end;
+end;
+
+function TfrxDesignerForm.UnitsTomm(mm: Extended; X: Boolean = True): Extended;
+begin
+ Result := 0;
+ case FUnits of
+ duCM:
+ Result := mm * 10;
+ duInches:
+ Result := mm * 25.4;
+ duPixels:
+ Result := mm / 96 * 25.4;
+ duChars:
+ if X then
+ Result := Round(mm) * fr1CharX / fr01cm else
+ Result := Round(mm) * fr1CharY / fr01cm;
+ end;
+end;
+
+function TfrxDesignerForm.InsertExpression(const Expr: String): String;
+begin
+ with TfrxExprEditorForm.Create(Self) do
+ begin
+ ExprMemo.Text := Expr;
+ if ShowModal = mrOk then
+ Result := ExprMemo.Text else
+ Result := '';
+ Free;
+ end
+end;
+
+procedure TfrxDesignerForm.UpdatePage;
+begin
+ FWorkspace.Repaint;
+end;
+
+procedure TfrxDesignerForm.FindText;
+var
+ i: Integer;
+ c: TfrxComponent;
+ s: String;
+ Found, FoundOne: Boolean;
+ Flags: TReplaceFlags;
+ ReplaceAll: Boolean;
+
+ function AskReplace: Boolean;
+ var
+ i: Integer;
+ begin
+ if not ReplaceAll then
+ i := MessageDlg(Format(frxResources.Get('dsReplace'), [FSearchText]),
+ TMsgDlgType.mtConfirmation, [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo, TMsgDlgBtn.mbCancel, TMsgDlgBtn.mbAll], 0)
+ else
+ i := mrAll;
+ Result := i in [mrYes, mrAll];
+ ReplaceAll := i = mrAll;
+
+{ Result := Application.MessageBox(
+ PChar(Format(frxResources.Get('dsReplace'), [FSearchText])),
+ PChar(frxResources.Get('mbConfirm')), mb_IconQuestion + mb_YesNo) = mrYes;}
+ end;
+
+begin
+ ReplaceAll := False;
+ FoundOne := False;
+
+ repeat
+ Found := False;
+ if FPage <> nil then
+ begin
+ c := nil;
+ for i := FSearchIndex to Objects.Count - 1 do
+ begin
+ c := Objects[i];
+ if c is TfrxCustomMemoView then
+ begin
+ s := TfrxCustomMemoView(c).Text;
+ if FSearchCase then
+ begin
+ if Pos(FSearchText, s) <> 0 then
+ Found := True;
+ end
+ else if Pos(AnsiUpperCase(FSearchText), AnsiUpperCase(s)) <> 0 then
+ Found := True;
+ end;
+ if Found then break;
+ end;
+
+ if Found then
+ begin
+ FSearchIndex := i + 1;
+ SelectedObjects.Clear;
+ SelectedObjects.Add(c);
+ OnSelectionChanged(Self);
+ if FSearchReplace then
+ if AskReplace then
+ begin
+ Flags := [rfReplaceAll];
+ if not FSearchCase then
+ Flags := Flags + [rfIgnoreCase];
+ TfrxCustomMemoView(c).Text := StringReplace(s, FSearchText,
+ FSearchReplaceText, Flags);
+ Modified := True;
+ end;
+ end;
+ end
+ else
+ begin
+ Found := CodeWindow.Find(FSearchText);//, FSearchCase, FSearchIndex);
+ if FSearchReplace then
+ if Found and AskReplace then
+ begin
+ CodeWindow.SelText := FSearchReplaceText;
+ Modified := True;
+ end;
+ end;
+
+ if Found then
+ FoundOne := True;
+ until not ReplaceAll or not Found;
+
+ if not FoundOne then
+ frxInfoMsg(Format(frxResources.Get('dsTextNotFound'), [FSearchText]));
+end;
+
+procedure TfrxDesignerForm.RestorePagePosition;
+var
+ pt: TPoint;
+begin
+ if (FTabs.TabIndex > 0) and (FTabs.TabIndex < 255) then
+ begin
+ pt := fsPosToPoint(FPagePositions[FTabs.TabIndex]);
+{$IFDEF DELPHI18}
+ ScrollBox.ViewportPosition := PointF(pt.X, pt.Y);
+{$ELSE}
+ ScrollBox.VScrollBar.Value := pt.X;
+ ScrollBox.HScrollBar.Value := pt.Y;
+{$ENDIF}
+ end;
+end;
+
+procedure TfrxDesignerForm.SavePagePosition;
+begin
+ if (FTabs.TabIndex > 0) and (FTabs.TabIndex < 255) then
+{$IFDEF DELPHI18}
+ FPagePositions[FTabs.TabIndex] := IntToStr(Round(ScrollBox.ViewportPosition.X)) +
+ ':' + IntToStr(Round(ScrollBox.ViewportPosition.Y));
+{$ELSE}
+ FPagePositions[FTabs.TabIndex] := IntToStr(Round(ScrollBox.HScrollBar.Value)) +
+ ':' + IntToStr(Round(ScrollBox.VScrollBar.Value));
+{$ENDIF}
+
+end;
+
+
+{ Workspace/Inspector event handlers }
+{------------------------------------------------------------------------------}
+
+procedure TfrxDesignerForm.OnModify(Sender: TObject);
+begin
+ FModifiedBy := Sender;
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.OnSelectionChanged(Sender: TObject);
+var
+ c: TfrxComponent;
+begin
+ if FLockSelectionChanged then Exit;
+ if Sender = FReportTree then
+ begin
+ c := SelectedObjects[0];
+ if (c <> Report) and (Page <> nil) then
+ if c.Page <> Page then
+ begin
+ Page := c.Page;
+ SelectedObjects[0] := c;
+ FReportTree.UpdateSelection;
+ end;
+ end
+ else
+ FReportTree.UpdateSelection;
+
+ if Sender <> FWorkspace then
+ FWorkspace.UpdateView;
+
+ if Sender <> FInspector then
+ begin
+ FInspector.Objects := FObjects;
+ FInspector.UpdateProperties;
+ end;
+
+ FDataTree.UpdateSelection;
+ UpdateControls;
+end;
+
+procedure TfrxDesignerForm.OnEditObject(Sender: TObject);
+var
+ ed: TfrxComponentEditor;
+begin
+ if FSelectedObjects[0] <> nil then
+ if rfDontEdit in TfrxComponent(FSelectedObjects[0]).Restrictions then
+ Exit;
+
+ ed := frxComponentEditors.GetComponentEditor(FSelectedObjects[0], Self, nil);
+ if (ed <> nil) and ed.HasEditor then
+ if ed.Edit then
+ begin
+ Modified := True;
+ if FSelectedObjects[0] = FPage then
+ UpdatePageDimensions;
+ end;
+ ed.Free;
+end;
+
+procedure TfrxDesignerForm.OnInsertObject(Sender: TObject);
+var
+ c: TfrxComponent;
+ SaveLeft, SaveTop, SaveWidth, SaveHeight: Extended;
+
+ function CheckContainers(Obj: TfrxComponent): Boolean;
+ var
+ i: Integer;
+ c: TfrxComponent;
+ begin
+ Result := False;
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if (c <> Obj) and (csContainer in c.frComponentStyle) then
+ if (Obj.Left >= c.AbsLeft) and (Obj.Top >= c.AbsTop) and
+ (Obj.Left + Obj.Width <= c.AbsLeft + c.Width) and
+ (Obj.Top + Obj.Height <= c.AbsTop + c.Height) then
+ begin
+ Result := c.ContainerAdd(Obj);
+ break;
+ end;
+ end;
+ end;
+
+begin
+ if (not CheckOp(drDontInsertObject) or (FWorkspace.Insertion.Top < 0)) then
+ begin
+ FWorkspace.SetInsertion(nil, 0, 0, 0);
+ ObjectSelectB.IsPressed := True;
+ Exit;
+ end;
+
+ with FWorkspace.Insertion do
+ begin
+ if (ComponentClass = nil) or ((Width = 0) and (Height = 0)) then Exit;
+
+ SaveLeft := Left;
+ SaveTop := Top;
+ SaveWidth := Width;
+ SaveHeight := Height;
+ c := TfrxComponent(ComponentClass.NewInstance);
+ c.DesignCreate(FPage, Flags);
+ c.SetBounds(SaveLeft, SaveTop, SaveWidth, SaveHeight);
+ c.CreateUniqueName;
+ if c is TfrxCustomLineView then
+ FWorkspace.SetInsertion(ComponentClass, 0, 0, Flags)
+ else
+ begin
+ FWorkspace.SetInsertion(nil, 0, 0, 0);
+ ObjectSelectB.IsPressed := True;
+ end;
+
+ if c is TfrxCustomMemoView then
+ begin
+ FSampleFormat.ApplySample(TfrxCustomMemoView(c));
+ if FPage is TfrxDataPage then
+ TfrxCustomMemoView(c).Wysiwyg := False;
+ end;
+
+ if not CheckContainers(c) then
+ FObjects.Add(c);
+ FSelectedObjects.Clear;
+ FSelectedObjects.Add(c);
+
+ if (frxDesignerComp <> nil) and Assigned(frxDesignerComp.FOnInsertObject) then
+ frxDesignerComp.FOnInsertObject(c);
+
+ if c is TfrxSubreport then
+ begin
+ NewPageCmdExecute(Self);
+ TfrxSubreport(c).Page := TfrxReportPage(Report.Pages[Report.PagesCount - 1]);
+ ReloadPages(Report.PagesCount - 1);
+ end
+ else
+ begin
+ Modified := True;
+ if EditAfterInsert and not
+ ((c is TfrxDialogControl) or (c is TfrxDialogComponent)) then
+ OnEditObject(Self);
+ end;
+
+ FWorkspace.BringToFront;
+ end;
+end;
+
+procedure TfrxDesignerForm.OnNotifyPosition(ARect: TfrxRect);
+var
+ dx, dy: Extended;
+begin
+ with ARect do
+ begin
+ if FUnits = duCM then
+ begin
+ dx := 1 / 96 * 2.54;
+ dy := dx;
+ end
+ else if FUnits = duChars then
+ begin
+ dx := 1 / fr1CharX;
+ dy := 1 / fr1CharY;
+ end
+ else if FUnits = duPixels then
+ begin
+ dx := 1;
+ dy := dx;
+ end
+ else
+ begin
+ dx := 1 / 96;
+ dy := dx;
+ end;
+
+ Left := Left * dx;
+ Top := Top * dy;
+ if FWorkspace.Mode <> dmScale then
+ begin
+ Right := Right * dx;
+ Bottom := Bottom * dy;
+ end;
+
+ if FUnits = duChars then
+ begin
+ Left := Trunc(Left);
+ Top := Trunc(Top);
+ Right := Trunc(Right);
+ Bottom := Trunc(Bottom);
+ end;
+
+
+ FCoord1 := '';
+ FCoord2 := '';
+ FCoord3 := '';
+ if (not FWorkspace.IsMouseDown) and (FWorkspace.Mode <> dmInsertObject) then
+ if (FSelectedObjects.Count > 0) and (FSelectedObjects[0] = FPage) then
+ FCoord1 := Format('%f; %f', [Left, Top])
+ else
+ begin
+ FCoord1 := Format('%f; %f', [Left, Top]);
+ FCoord2 := Format('%f; %f', [Right, Bottom]);
+ end
+ else
+ case FWorkspace.Mode of
+ dmMove, dmSize, dmSizeBand, dmInsertObject, dmInsertLine:
+ begin
+ FCoord1 := Format('%f; %f', [Left, Top]);
+ FCoord2 := Format('%f; %f', [Right, Bottom]);
+ end;
+
+ dmScale:
+ begin
+ FCoord1 := Format('%f; %f', [Left, Top]);
+ FCoord3 := Format('%s%f; %s%f', ['%', Right * 100, '%', Bottom * 100]);
+ end;
+ end;
+ end;
+
+ LeftRuler.RulePosition := ARect.Top;
+ TopRuler.RulePosition := ARect.Left;
+
+ if FPage = nil then
+ OnChangePosition(Self);
+
+// StatusBar.Repaint;
+end;
+
+
+{ Toolbar buttons' events }
+{------------------------------------------------------------------------------}
+
+procedure TfrxDesignerForm.SelectToolBClick(Sender: TObject);
+begin
+ if Sender is TfrxToolButton then
+ TfrxToolButton(Sender).IsPressed := True;
+
+ FWorkspace.SetInsertion(nil, 0, 0, 0);
+end;
+
+procedure TfrxDesignerForm.ObjectBandBClick(Sender: TObject);
+var
+ pt: TPointF;
+begin
+ pt := Self.ClientToScreen(PointF(TControl(Sender).AbsoluteRect.Right, TControl(Sender).AbsoluteRect.Top));
+ BandsPopup.Popup(pt.X, pt.Y);
+end;
+
+procedure TfrxDesignerForm.ObjectsButtonClick(Sender: TObject);
+var
+ i: Integer;
+ Obj, Item: TfrxObjectItem;
+ c: TfrxComponent;
+ dx, dy: Extended;
+ m: TMenuItem;
+ pt: TPointF;
+ s: String;
+begin
+ SelectToolBClick(Sender);
+ if Page = nil then Exit;
+ Obj := frxObjects[TComponent(Sender).Tag];
+
+ if Obj.ClassRef = nil then { it's a category }
+ begin
+{$IFDEF Delphi17}
+ ObjectsPopup.Clear;
+{$ELSE}
+ while ObjectsPopup.ChildrenCount > 0 do
+ ObjectsPopup.Children[0].Free;
+{$ENDIF}
+ for i := 0 to frxObjects.Count - 1 do
+ begin
+ Item := frxObjects[i];
+ if (Item.ClassRef <> nil) and (Item.CategoryName = Obj.CategoryName) then
+ begin
+ if FPage is TfrxDMPPage then
+ if not ((Item.ClassRef.ClassName = 'TfrxCrossView') or
+ (Item.ClassRef.ClassName = 'TfrxDBCrossView') or
+ (Item.ClassRef.InheritsFrom(TfrxDialogComponent))) then continue;
+
+ m := TMenuItem.Create(ObjectsPopup);
+ m.Parent := ObjectsPopup;
+ frxResources.LoadImageFromResouce(m.Bitmap, Item.ButtonImageIndex);
+ s := Item.ButtonHint;
+ if s = '' then
+ s := Item.ClassRef.GetDescription else
+ s := frxResources.Get(s);
+ m.Text := s;
+ m.OnClick := ObjectsButtonClick;
+ m.Tag := i;
+ end;
+ end;
+
+ pt := Self.ClientToScreen(PointF(TControl(Sender).AbsoluteRect.Right, TControl(Sender).AbsoluteRect.Top));
+ ObjectsPopup.Popup(pt.X, pt.Y);
+ end
+ else { it's a simple object }
+ begin
+ c := TfrxComponent(Obj.ClassRef.NewInstance);
+ try
+ c.Create(FPage);
+ except
+ Exit;
+ end;
+ dx := c.Width;
+ dy := c.Height;
+ c.Free;
+
+ if (dx = 0) and (dy = 0) then
+ begin
+ dx := GetDefaultObjectSize.X;
+ dy := GetDefaultObjectSize.Y;
+ end;
+
+ FWorkspace.SetInsertion(Obj.ClassRef, dx, dy, Obj.Flags);
+ end;
+end;
+
+{procedure TfrxDesignerForm.OnExtraToolClick(Sender: TObject);
+var
+ w: TfrxCustomWizard;
+ Item: TfrxWizardItem;
+begin
+ Item := frxWizards[TfrxToolButton(Sender).Tag];
+ w := TfrxCustomWizard(Item.ClassRef.NewInstance);
+ w.Create(Self);
+ if w.Execute then
+ Modified := True;
+ w.Free;
+end;}
+
+procedure TfrxDesignerForm.InsertBandClick(Sender: TObject);
+var
+ i: Integer;
+ Band: TfrxBand;
+ Size: Extended;
+
+ function FindFreeSpace: Extended;
+ var
+ i: Integer;
+ b: TfrxComponent;
+ begin
+ Result := 0;
+ for i := 0 to FPage.Objects.Count - 1 do
+ begin
+ b := FPage.Objects[i];
+ if (b is TfrxBand) and not TfrxBand(b).Vertical then
+ if b.Top + b.Height > Result then
+ Result := b.Top + b.Height;
+ end;
+
+ Result := Round((Result + Workspace.BandHeader + 4) / Workspace.GridY) * Workspace.GridY;
+ Result := Round(Result * 100000000) / 100000000;
+ end;
+
+begin
+ if Page = nil then Exit;
+
+ i := (Sender as TMenuItem).Tag;
+
+ Band := TfrxBand(frxBands[i mod 100].NewInstance);
+ Band.Create(FPage);
+ Band.CreateUniqueName;
+{$IFNDEF RAD_ED}
+ if i >= 100 then
+ Band.Vertical := True;
+{$ENDIF}
+
+ if not Band.Vertical then
+ if Workspace.FreeBandsPlacement then
+ Band.Top := FindFreeSpace else
+ Band.Top := 10000;
+
+ Size := 0;
+ case FUnits of
+ duCM: Size := fr01cm * 6;
+ duInches: Size := fr01in * 3;
+ duPixels: Size := 20;
+ duChars: Size := fr1CharY;
+ end;
+
+ if not Band.Vertical then
+ Band.Height := Size
+ else
+ begin
+ Band.Left := Size;
+ Band.Width := Size;
+ end;
+
+ FObjects.Add(Band);
+ FSelectedObjects.Clear;
+ FSelectedObjects.Add(Band);
+ Modified := True;
+ OnSelectionChanged(Self);
+
+ ObjectSelectB.IsPressed := True;
+ SelectToolBClick(Sender);
+
+ if EditAfterInsert then
+ OnEditObject(Self);
+end;
+
+procedure TfrxDesignerForm.ToolButtonClick(Sender: TObject);
+var
+ i, cbIdx: Integer;
+ c: TfrxComponent;
+ wasModified: Boolean;
+ gx, gy: Extended;
+ TheFont: TfrxFont;
+
+ procedure EditFont;
+ begin
+// with TFontDialog.Create(Application) do
+// begin
+// Font := TfrxComponent(FSelectedObjects[0]).Font;
+// Options := Options + [fdForceFontExist];
+// if Execute then
+// begin
+// TheFont := TFont.Create;
+// TheFont.Assign(Font);
+// end;
+// Free;
+// end;
+ end;
+
+ procedure SetFontStyle(c: TfrxComponent; fStyle: TFontStyle; Include: Boolean);
+ begin
+ with c.Font do
+ if Include then
+ Style := Style + [fStyle] else
+ Style := Style - [fStyle];
+ end;
+
+ procedure SetFrameType(c: TfrxComponent; fType: TfrxFrameType; Include: Boolean);
+ var
+ f: TfrxFrame;
+ begin
+ if c is TfrxView then
+ f := TfrxView(c).Frame
+ else if c is TfrxReportPage then
+ f := TfrxReportPage(c).Frame else
+ Exit;
+
+ with f do
+ if Include then
+ Typ := Typ + [fType] else
+ Typ := Typ - [fType];
+ end;
+
+ procedure SetDMPFontStyle(c: TfrxComponent; fStyle: TfrxDMPFontStyle;
+ Include: Boolean);
+ var
+ Style: TfrxDMPFontStyles;
+ begin
+ Style := [];
+ if c is TfrxDMPMemoView then
+ Style := TfrxDMPMemoView(c).FontStyle;
+ if c is TfrxDMPLineView then
+ Style := TfrxDMPLineView(c).FontStyle;
+ if c is TfrxDMPPage then
+ Style := TfrxDMPPage(c).FontStyle;
+ if not Include then
+ Style := Style + [fStyle] else
+ Style := Style - [fStyle];
+ if c is TfrxDMPMemoView then
+ TfrxDMPMemoView(c).FontStyle := Style;
+ if c is TfrxDMPLineView then
+ TfrxDMPLineView(c).FontStyle := Style;
+ if c is TfrxDMPPage then
+ TfrxDMPPage(c).FontStyle := Style;
+ end;
+
+begin
+ if FUpdatingControls then Exit;
+
+ TheFont := nil;
+ wasModified := False;
+ if TComponent(Sender).Tag = 43 then
+ EditFont;
+
+ for i := 0 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if rfDontModify in c.Restrictions then continue;
+
+ case TComponent(Sender).Tag of
+
+ 0:
+ begin
+ // OSX is a case sensetive to font names
+ cbIdx := FontNameCB.Items.IndexOf(FontNameCB.Text);
+ if(cbIdx <> -1) then
+ c.Font.Name := FontNameCB.Items[cbIdx];
+ end;
+
+ 1: c.Font.Size := StrToInt(FontSizeCB.Text);
+
+ 2: SetFontStyle(c, fsBold, BoldB.IsPressed);
+
+ 3: SetFontStyle(c, fsItalic, ItalicB.IsPressed);
+
+ 4: SetFontStyle(c, fsUnderline, UnderlineB.IsPressed);
+
+ 5: c.Font.Color := FColor;
+
+ 6:;
+
+ 7:
+ if c is TfrxCustomMemoView then
+ TfrxCustomMemoView(c).HAlign := haLeft;
+ 8:
+ if c is TfrxCustomMemoView then
+ TfrxCustomMemoView(c).HAlign := haCenter;
+ 9:
+ if c is TfrxCustomMemoView then
+ TfrxCustomMemoView(c).HAlign := haRight;
+ 10:
+ if c is TfrxCustomMemoView then
+ TfrxCustomMemoView(c).HAlign := haBlock;
+ 11:
+ if c is TfrxCustomMemoView then
+ TfrxCustomMemoView(c).VAlign := vaTop;
+ 12:
+ if c is TfrxCustomMemoView then
+ TfrxCustomMemoView(c).VAlign := vaCenter;
+ 13:
+ if c is TfrxCustomMemoView then
+ TfrxCustomMemoView(c).VAlign := vaBottom;
+
+ 20: SetFrameType(c, ftTop, FrameTopB.IsPressed);
+
+ 21: SetFrameType(c, ftBottom, FrameBottomB.IsPressed);
+
+ 22: SetFrameType(c, ftLeft, FrameLeftB.IsPressed);
+
+ 23: SetFrameType(c, ftRight, FrameRightB.IsPressed);
+
+ 24: begin
+ SetFrameType(c, ftTop, True);
+ SetFrameType(c, ftBottom, True);
+ SetFrameType(c, ftLeft, True);
+ SetFrameType(c, ftRight, True);
+ end;
+
+ 25: begin
+ SetFrameType(c, ftTop, False);
+ SetFrameType(c, ftBottom, False);
+ SetFrameType(c, ftLeft, False);
+ SetFrameType(c, ftRight, False);
+ end;
+
+ 26: if c is TfrxView then
+ TfrxView(c).Color := FColor
+ else if c is TfrxReportPage then
+ TfrxReportPage(c).Color := FColor
+ else if c is TfrxDialogPage then
+ begin
+ TfrxDialogPage(c).Color := FColor;
+ FWorkspace.Color := FColor;
+ end;
+ //else if c is TfrxDialogControl then
+ //TfrxDialogControl(c).Color := FColor;
+
+ 27: if c is TfrxView then
+ TfrxView(c).Frame.Color := FColor
+ else if c is TfrxReportPage then
+ TfrxReportPage(c).Frame.Color := FColor;
+
+ 28: if c is TfrxView then
+ TfrxView(c).Frame.Style := FLineStyle
+ else if c is TfrxReportPage then
+ TfrxReportPage(c).Frame.Style := FLineStyle;
+
+ 29:
+ begin
+ if FrameWidthCB.Text = '' then exit;
+ if c is TfrxView then
+ TfrxView(c).Frame.Width := frxStrToFloat(FrameWidthCB.Text)
+ else if c is TfrxReportPage then
+ TfrxReportPage(c).Frame.Width := frxStrToFloat(FrameWidthCB.Text);
+ end;
+
+ 30: if c is TfrxCustomMemoView then
+ TfrxCustomMemoView(c).Rotation := TMenuItem(Sender).HelpContext;
+
+ 31:
+ begin
+ gx := FWorkspace.GridX;
+ gy := FWorkspace.GridY;
+ c.Left := Round(c.Left / gx) * gx;
+ c.Top := Round(c.Top / gy) * gy;
+ c.Width := Round(c.Width / gx) * gx;
+ c.Height := Round(c.Height / gy) * gy;
+ if c.Width = 0 then
+ c.Width := gx;
+ if c.Height = 0 then
+ c.Height := gy;
+ end;
+
+ 32: if c is TfrxView then
+ TfrxView(c).Frame.DropShadow := ShadowB.IsPressed
+ else if c is TfrxReportPage then
+ TfrxReportPage(c).Frame.DropShadow := ShadowB.IsPressed;
+
+ 33: if c is TfrxCustomMemoView then
+ if StyleCB.ItemIndex = 0 then
+ TfrxCustomMemoView(c).Style := '' else
+ TfrxCustomMemoView(c).Style := StyleCB.Text;
+
+ 34: SetDMPFontStyle(c, fsxBold, BoldMI.IsChecked);
+
+ 35: SetDMPFontStyle(c, fsxItalic, ItalicMI.IsChecked);
+
+ 36: SetDMPFontStyle(c, fsxUnderline, UnderlineMI.IsChecked);
+
+ 37: SetDMPFontStyle(c, fsxSuperScript, SuperScriptMI.IsChecked);
+
+ 38: SetDMPFontStyle(c, fsxSubScript, SubScriptMI.IsChecked);
+
+ 39: SetDMPFontStyle(c, fsxCondensed, CondensedMI.IsChecked);
+
+ 40: SetDMPFontStyle(c, fsxWide, WideMI.IsChecked);
+
+ 41: SetDMPFontStyle(c, fsx12cpi, N12cpiMI.IsChecked);
+
+ 42: SetDMPFontStyle(c, fsx15cpi, N15cpiMI.IsChecked);
+
+ 43: if TheFont <> nil then
+ c.Font := TheFont;
+ end;
+
+ if TComponent(Sender).Tag in [0..5, 20..29, 32] then
+ if c is TfrxCustomMemoView then
+ begin
+ TfrxCustomMemoView(c).Style := '';
+ StyleCB.Text := StyleCB.Items[0];
+ end;
+
+ if c is TfrxCustomMemoView then
+ FSampleFormat.SetAsSample(TfrxCustomMemoView(c));
+ wasModified := True;
+ end;
+
+ if TheFont <> nil then
+ TheFont.Free;
+
+ if not TComponent(Sender).Tag in [1] then
+ ScrollBox.SetFocus;
+
+ if wasModified then
+ begin
+ FModifiedBy := Self;
+ Modified := True;
+
+ if TComponent(Sender).Tag in [7..13, 24, 25, 34..43] then
+ UpdateControls;
+ end;
+end;
+
+procedure TfrxDesignerForm.FontBClick(Sender: TObject);
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ with TfrxFontForm.Create(nil) do
+ begin
+ if FSelectedObjects.Count > 0 then
+ begin
+ c := FSelectedObjects[0];
+ FontS.Assign(c.Font);
+ end;
+ FormActivate(Sender);
+ if ShowModal = mrOk then
+ begin
+ for i := 0 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if rfDontModify in c.Restrictions then continue;
+ c.Font.Assign(FontS);
+ end;
+ FModifiedBy := Self;
+ Modified := True;
+ end;
+ Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.FontColorBClick(Sender: TObject);
+begin
+ CreateColorSelector(Sender as TfrxToolButton);
+end;
+
+procedure TfrxDesignerForm.FrameStyleBClick(Sender: TObject);
+begin
+ if FLineSelector = nil then
+ begin
+ FLineSelector := TfrxLineSelector.Create(Self);
+ FLineSelector.Parent := Self;
+ FLineSelector.OnStyleChanged := Self.OnStyleChanged;
+ end;
+
+ FLineSelector.Popup(TControl(Sender));
+end;
+
+procedure TfrxDesignerForm.ScaleCBClick(Sender: TObject);
+var
+ s: String;
+ dx, dy: Integer;
+begin
+ if ScaleCB.ItemIndex = 6 then
+ s := IntToStr(Round((ScrollBox.Width - 40) / (TfrxReportPage(FPage).PaperWidth * 96 / 25.4) * 100))
+ else if ScaleCB.ItemIndex = 7 then
+ begin
+ dx := Round(TfrxReportPage(FPage).PaperWidth * 96 / 25.4);
+ dy := Round(TfrxReportPage(FPage).PaperHeight * 96 / 25.4);
+ if (ScrollBox.Width - 20) / dx < (ScrollBox.Height - 20) / dy then
+ s := IntToStr(Round((ScrollBox.Width - 20) / dx * 100)) else
+ s := IntToStr(Round((ScrollBox.Height - 20) / dy * 100));
+ end
+ else
+ s := ScaleCB.Text;
+
+ if Pos('%', s) <> 0 then
+ s[Pos('%', s)] := ' ';
+ while Pos(' ', s) <> 0 do
+ Delete(s, Pos(' ', s), 1);
+
+ if s <> '' then
+ begin
+ Scale := frxStrToFloat(s) / 100;
+ ScaleCB.OnChange := nil;
+ ScaleCB.Text := s + '%';
+ ScaleCB.OnChange := ScaleCBClick;
+ ScrollBox.SetFocus;
+ end;
+end;
+
+procedure TfrxDesignerForm.ShowGridBClick(Sender: TObject);
+begin
+ ShowGrid := ShowGridB.IsPressed;
+end;
+
+procedure TfrxDesignerForm.AlignToGridBClick(Sender: TObject);
+begin
+ GridAlign := AlignToGridB.IsPressed;
+end;
+
+procedure TfrxDesignerForm.LangCBClick(Sender: TObject);
+begin
+ LangCB.OnChange := nil;
+ if frxConfirmMsg(frxResources.Get('dsClearScript'), [TMsgDlgBtn.mbYes, TMsgDlgBtn.mbNo]) <> mrYes then
+ begin
+ LangCB.ItemIndex := LangCB.Items.IndexOf(Report.ScriptLanguage);
+ Exit;
+ end;
+
+ Report.ScriptLanguage := LangCB.Text;
+ frxEmptyCode(CodeWindow.Lines, Report.ScriptLanguage);
+
+ UpdateSyntaxType;
+ Modified := True;
+ CodeWindow.SetFocus;
+ LangCB.OnChange := LangCBClick;
+end;
+
+procedure TfrxDesignerForm.OpenScriptBClick(Sender: TObject);
+begin
+ with OpenScriptDialog do
+ if Execute then
+ begin
+ CodeWindow.Lines.LoadFromFile(FileName);
+ Modified := True;
+ end;
+end;
+
+procedure TfrxDesignerForm.SaveScriptBClick(Sender: TObject);
+begin
+ with SaveScriptDialog do
+ if Execute then
+ CodeWindow.Lines.SaveToFile(FileName);
+end;
+
+procedure TfrxDesignerForm.HighlightBClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ with TfrxHighlightEditorForm.Create(Self) do
+ begin
+ MemoView := SelectedObjects[0];
+ FormShow(Self);
+ if ShowModal = mrOk then
+ begin
+ for i := 1 to SelectedObjects.Count - 1 do
+ if TObject(SelectedObjects[i]) is TfrxMemoView then
+ TfrxMemoView(SelectedObjects[i]).Highlight.Assign(MemoView.Highlight);
+
+ Modified := True;
+ end;
+ Free;
+ end;
+end;
+
+
+{ Controls' event handlers }
+{------------------------------------------------------------------------------}
+
+procedure TfrxDesignerForm.OnCodeChanged(Sender: TObject);
+begin
+ if FPage = nil then
+ begin
+ FModified := True;
+ SaveB.Enabled := CheckOp(drDontSaveReport);
+ UndoB.Enabled := True;
+ end;
+end;
+
+procedure TfrxDesignerForm.OnChangePosition(Sender: TObject);
+begin
+ if FPage = nil then
+ begin
+ FCoord1 := Format('%d; %d', [CodeWindow.GetPos.Y, CodeWindow.GetPos.X]);
+ FCoord2 := '';
+ FCoord3 := '';
+ end;
+ StatusBar.Repaint;
+end;
+
+procedure TfrxDesignerForm.OnColorChanged(Sender: TObject);
+begin
+ with TfrxColorSelector(Sender) do
+ begin
+ FColor := Color;
+ ToolButtonClick(TfrxColorSelector(Sender));
+ end;
+end;
+
+procedure TfrxDesignerForm.OnStyleChanged(Sender: TObject);
+begin
+ with TfrxLineSelector(Sender) do
+ begin
+ FLineStyle := TfrxFrameStyle(Style);
+ ToolButtonClick(TfrxLineSelector(Sender));
+ end;
+end;
+
+procedure TfrxDesignerForm.ScrollBoxMouseWheelUp(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
+begin
+{$IFDEF DELPHI18}
+ with ScrollBox.ViewportPosition do
+ ScrollBox.ViewportPosition := PointF(X, Y - 16)
+{$ELSE}
+ with ScrollBox.VScrollBar do
+ Value := Value - 16;
+{$ENDIF}
+end;
+
+procedure TfrxDesignerForm.ScrollBoxMouseWheelDown(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
+begin
+{$IFDEF DELPHI18}
+ with ScrollBox.ViewportPosition do
+ ScrollBox.ViewportPosition := PointF(X, Y + 16)
+{$ELSE}
+ with ScrollBox.VScrollBar do
+ Value := Value + 16;
+{$ENDIF}
+end;
+
+procedure TfrxDesignerForm.ScrollBoxResize(Sender: TObject);
+var
+ ofs, st: Single;
+begin
+ if FWorkspace = nil then Exit;
+{$IFDEF DELPHI18}
+ ofs := ScrollBox.Position.X + 2 + FWorkspace.Position.X - ScrollBox.ViewportPosition.X;
+{$ELSE}
+ ofs := ScrollBox.Position.X + 2 + FWorkspace.Position.X - ScrollBox.HScrollBar.Value;
+{$ENDIF}
+ st := 0;
+ if ofs < ScrollBox.Position.X + 2 then
+ begin
+ st := ScrollBox.Position.X + 2 - ofs;
+ ofs := ScrollBox.Position.X + 2;
+ end;
+
+ TopRuler.Offset := Round(ofs);
+ TopRuler.Start := Round(st);
+
+
+{$IFDEF DELPHI18}
+ ofs := 2 + FWorkspace.Position.Y - ScrollBox.ViewportPosition.Y;
+{$ELSE}
+ ofs := 2 + FWorkspace.Position.Y - ScrollBox.VScrollBar.Value;
+{$ENDIF}
+ st := 0;
+ if ofs < 2 then
+ begin
+ st := 2 - ofs;
+ ofs := 2;
+ end;
+
+ LeftRuler.Offset := Round(ofs);
+ LeftRuler.Start := Round(st);
+end;
+
+procedure TfrxDesignerForm.StatusBarMouseDown(Sender: TObject;
+ Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+begin
+ //FUnitsDblClicked := X < StatusBar.Panels[0].Width;
+end;
+
+procedure TfrxDesignerForm.StatusBarDblClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ if FUnitsDblClicked and not
+ ((FWorkspace.GridType = gtDialog) or (FWorkspace.GridType = gtChar)) then
+ begin
+ i := Integer(FUnits);
+ Inc(i);
+ if i > 2 then
+ i := 0;
+ Units := TfrxDesignerUnits(i);
+ FOldUnits := FUnits;
+ end;
+end;
+
+//procedure TfrxDesignerForm.StatusBarDrawPanel(StatusBar: TStatusBar;
+// Panel: TStatusPanel; const ARect: TRect);
+//begin
+// with StatusBar.Canvas do
+// begin
+// FillRect(ARect);
+//
+// if FCoord1 <> '' then
+// begin
+// frxResources.MainButtonImages.Draw(StatusBar.Canvas, ARect.Left + 2, ARect.Top - 1, 62);
+// TextOut(ARect.Left + 20, ARect.Top + 1, FCoord1);
+// end;
+//
+// if FCoord2 <> '' then
+// begin
+// frxResources.MainButtonImages.Draw(StatusBar.Canvas, ARect.Left + 110, ARect.Top - 1, 63);
+// TextOut(ARect.Left + 130, ARect.Top + 1, FCoord2);
+// end;
+//
+// if FCoord3 <> '' then
+// TextOut(ARect.Left + 110, ARect.Top + 1, FCoord3);
+// end;
+//end;
+
+procedure TfrxDesignerForm.TimerTimer(Sender: TObject);
+begin
+ PasteB.Enabled := FClipboard.PasteAvailable or (FPage = nil);
+end;
+
+procedure TfrxDesignerForm.BandsPopupPopup(Sender: TObject);
+
+ function FindBand(Band: TfrxComponentClass): TfrxBand;
+ var
+ i: Integer;
+ begin
+ Result := nil;
+ if FPage = nil then Exit;
+ for i := 0 to FPage.Objects.Count - 1 do
+ if TObject(FPage.Objects[i]) is Band then
+ Result := FPage.Objects[i];
+ end;
+
+begin
+ ReportTitleMI.Enabled := FindBand(TfrxReportTitle) = nil;
+ ReportSummaryMI.Enabled := FindBand(TfrxReportSummary) = nil;
+ PageHeaderMI.Enabled := FindBand(TfrxPageHeader) = nil;
+ PageFooterMI.Enabled := FindBand(TfrxPageFooter) = nil;
+ ColumnHeaderMI.Enabled := FindBand(TfrxColumnHeader) = nil;
+ ColumnFooterMI.Enabled := FindBand(TfrxColumnFooter) = nil;
+end;
+
+procedure TfrxDesignerForm.TopRulerDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+{$IFDEF DELPHI20}
+var
+ Accept: Boolean;
+{$ENDIF}
+begin
+ Accept := Data.Source is TfrxDesignerWorkspace;
+ {$IFDEF DELPHI20}
+ if Accept then
+ Operation := TDragOperation.Copy;
+{$ENDIF}
+end;
+
+procedure TfrxDesignerForm.PagePopupPopup(Sender: TObject; X, Y: Single);
+var
+ ed: TfrxComponentEditor;
+ pt: TPointF;
+ // m: TMenuItem;
+ EditMI1, AddChildMI, CutMI1, CopyMI1, PasteMI1, DeleteMI1, SelectAllMI1,
+ BringtoFrontMI1, SendtoBackMI1, TabOrderMI, SepMI: TMenuItem;
+begin
+{$IFDEF Delphi17}
+ PagePopup.Clear;
+{$ELSE}
+ while PagePopup.ChildrenCount > 0 do
+ PagePopup.Children[0].Free;
+{$ENDIF}
+
+ EditMI1 := TMenuItem.Create(PagePopup);
+ EditMI1.Parent := PagePopup;
+ EditMI1.Text := frxGet(2415);
+ EditMI1.OnClick := EditCmdExecute;
+
+ if (TObject(FSelectedObjects[0]) is TfrxBand) and
+ not (TObject(FSelectedObjects[0]) is TfrxColumnFooter) and
+ not (TObject(FSelectedObjects[0]) is TfrxOverlay) then
+ begin
+ AddChildMI := TMenuItem.Create(PagePopup);
+ AddChildMI.Text := frxGet(2478);
+ AddChildMI.OnClick := AddChildMIClick;
+ AddChildMI.Parent := PagePopup;
+ end;
+
+
+ ed := frxComponentEditors.GetComponentEditor(FSelectedObjects[0], Self, PagePopup);
+ if ed <> nil then
+ begin
+ EditMI1.Enabled := ed.HasEditor;
+
+ ed.GetMenuItems(OnComponentMenuClick);
+ ed.Free;
+ end
+ else
+ begin
+ EditMI1.Enabled := False;
+ end;
+
+ SepMI := TMenuItem.Create(PagePopup);
+ SepMI.Text := '-';
+ SepMI.Parent := PagePopup;
+
+ CutMI1 := TMenuItem.Create(PagePopup);
+ CutMI1.Text := frxGet(2407);
+ CutMI1.OnClick := CutCmdExecute;
+ CutMI1.Parent := PagePopup;
+ frxResources.LoadImageFromResouce(CutMI1.Bitmap, 0, 5);
+
+ CopyMI1 := TMenuItem.Create(PagePopup);
+ CopyMI1.Text := frxGet(2408);
+ CopyMI1.OnClick := CopyCmdExecute;
+ CopyMI1.Parent := PagePopup;
+ frxResources.LoadImageFromResouce(CopyMI1.Bitmap, 0, 6);
+
+ PasteMI1 := TMenuItem.Create(PagePopup);
+ PasteMI1.Text := frxGet(2409);
+ PasteMI1.OnClick := PasteCmdExecute;
+ PasteMI1.Parent := PagePopup;
+ frxResources.LoadImageFromResouce(PasteMI1.Bitmap, 0, 7);
+
+ DeleteMI1 := TMenuItem.Create(PagePopup);
+ DeleteMI1.Text := frxGet(2412);
+ DeleteMI1.OnClick := DeleteCmdExecute;
+ DeleteMI1.Parent := PagePopup;
+ frxResources.LoadImageFromResouce(DeleteMI1.Bitmap, 5, 1);
+
+ SelectAllMI1 := TMenuItem.Create(PagePopup);
+ SelectAllMI1.Text := frxGet(2414);
+ SelectAllMI1.OnClick := SelectAllCmdExecute;
+ SelectAllMI1.Parent := PagePopup;
+
+ BringtoFrontMI1 := TMenuItem.Create(PagePopup);
+ BringtoFrontMI1.Text := frxGet(2416);
+ BringtoFrontMI1.OnClick := BringToFrontCmdExecute;
+ BringtoFrontMI1.Parent := PagePopup;
+ frxResources.LoadImageFromResouce(BringtoFrontMI1.Bitmap, 1, 4);
+
+ SendtoBackMI1 := TMenuItem.Create(PagePopup);
+ SendtoBackMI1.Text := frxGet(2417);
+ SendtoBackMI1.OnClick := SendToBackCmdExecute;
+ SendtoBackMI1.Parent := PagePopup;
+ frxResources.LoadImageFromResouce(SendtoBackMI1.Bitmap, 1, 5);
+
+ if FPage is TfrxDialogPage then
+ begin
+ TabOrderMI := TMenuItem.Create(PagePopup);
+ TabOrderMI.Text := frxGet(2404);
+ TabOrderMI.OnClick := TabOrderMIClick;
+ TabOrderMI.Parent := PagePopup;
+ end;
+
+ pt := Self.ClientToScreen(PointF((Sender as TControl).AbsoluteRect.Left + X, (Sender as TControl).AbsoluteRect.Top + Y));
+ PagePopup.Popup(pt.X, pt.Y);
+ //p.Free;
+end;
+
+procedure TfrxDesignerForm.CodeWindowDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+{$IFDEF DELPHI20}
+var
+ Accept: Boolean;
+{$ENDIF}
+begin
+ Accept := (Data.Source is TTreeView) and (TTreeView(Data.Source).Owner = FDataTree) and
+ (FDataTree.GetFieldName <> '');
+ {$IFDEF DELPHI20}
+ if Accept then
+ Operation := TDragOperation.Copy;
+{$ENDIF}
+end;
+
+procedure TfrxDesignerForm.CodeWindowDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+begin
+ CodeWindow.SelText := FDataTree.GetFieldName;
+ CodeWindow.SetFocus;
+end;
+
+{procedure TfrxDesignerForm.OnDataTreeDblClick(Sender: TObject);
+begin
+ if Page = nil then
+ begin
+ CodeWindow.SelText := FDataTree.GetFieldName;
+ CodeWindow.SetFocus;
+ end
+ else if (FDataTree.GetActivePage = 0) and
+ (Report.DataSets.Count = 0) then
+ ReportDataCmdExecute(Self);
+end;}
+
+procedure TfrxDesignerForm.TabChanging(Sender: TObject; var AllowChange: Boolean);
+begin
+ if IsPreviewDesigner or FScriptRunning then
+ AllowChange := False;
+
+ if (FTabs.TabIndex = 0) and CodeWindow.Modified then
+ begin
+ Modified := True;
+ CodeWindow.Modified := False;
+ end;
+
+ SavePagePosition;
+end;
+
+procedure TfrxDesignerForm.TabSetChange(Sender: TObject; NewTab: Integer;
+ var AllowChange: Boolean);
+begin
+ TabChanging(nil, AllowChange);
+end;
+
+procedure TfrxDesignerForm.TabChange(Sender: TObject);
+begin
+ if FTabs.TabIndex = -1 then Exit;
+
+ if (FTabs.TabIndex = 0) then
+{$IFDEF FR_VER_BASIC}
+ FTabs.TabIndex := 1 else
+{$ELSE}
+ begin
+ if CheckOp(drDontEditReportScript) then Page := nil
+ else FTabs.TabIndex := 1
+ end else
+{$ENDIF}
+ if (FTabs.TabIndex = 1) and not CheckOp(drDontEditInternalDatasets) then
+ FTabs.TabIndex := 2
+ else Page := Report.Pages[FTabs.TabIndex - 1];
+end;
+
+procedure TfrxDesignerForm.TabMouseDown(Sender: TObject;
+ Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+
+begin
+ FMouseTabDX := X;
+ FMouseDown := True;
+end;
+
+procedure TfrxDesignerForm.TabMouseLeave(Sender: TObject);
+var
+ i: Integer;
+begin
+ FMouseDown := False;
+ if FDragTabItem = nil then Exit;
+ if Sender is TTabControl then
+ begin
+ for i := 0 to FTabs.TabCount - 1 do
+ begin
+ FMouseDown := FTabs.Tabs[i].IsMouseOver;
+ if FMouseDown then break;
+ end;
+ end;
+ if Sender is TTabItem then
+ FMouseDown := FTabs.IsMouseOver;
+ if not FMouseDown then
+ THackControl(FDragTabItem).DragEnd;
+end;
+
+procedure TfrxDesignerForm.TabMouseUp(Sender: TObject;
+ Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+var
+ pt: TPointF;
+begin
+ FMouseDown := False;
+ if (Button = mbRight) and (Sender is TTabItem) then
+ begin
+ pt := Self.ClientToScreen(TTabItem(Sender).LocalToAbsolute(PointF(X, Y)));
+ TabPopup.Popup(pt.X, pt.Y);
+ end
+ else if (Button = mbLeft) and Assigned(FDragTabItem) then
+ THackControl(FDragTabItem).DragEnd;
+end;
+
+procedure TfrxDesignerForm.TabMouseMove(Sender: TObject;
+ Shift: TShiftState; X, Y: Single);
+var
+ s: TBitmap;
+ TabItem: TTabItem;
+begin
+ if FMouseDown and (Sender is TTabItem) then
+ begin
+ FMouseTabDX := X - FMouseTabDX;
+ if Abs(FMouseTabDX) > 3 then
+ begin
+ TabItem := TTabItem(Sender);
+ S := TabItem.MakeScreenshot;
+ try
+ TabItem.Root.BeginInternalDrag(TabItem, s);
+ FDragTabItem := TabItem;
+ finally
+ FreeAndNil(S);
+ end;
+ end;
+ end;
+end;
+
+procedure TfrxDesignerForm.TabDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+{$IFDEF DELPHI20}
+var
+ Accept: Boolean;
+{$ENDIF}
+begin
+ { regular page marked with Tag = 1 }
+ Accept := (Data.Source is Sender.ClassType) and (Data.Source is TComponent)
+ and (TComponent(Data.Source).Tag > 0);
+ if Accept then
+ begin
+{$IFDEF DELPHI20}
+ Operation := TDragOperation.Copy;
+{$ENDIF}
+ end;
+end;
+
+
+procedure TfrxDesignerForm.TabDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+begin
+ FMouseDown := False;
+ FTabs.BeginUpdate;
+ if (Data.Source is TTabItem) and (Sender is TTabItem) and (TTabItem(Sender).Tag > 0) and (TTabItem(Data.Source).Tag > 0) then
+ begin
+ Report.Objects.Move(TTabItem(Data.Source).Index - 1, TTabItem(Sender).Index - 1);
+ TTabItem(Data.Source).Index := TTabItem(Sender).Index;
+ Modified := True;
+ THackControl(Sender).DragEnd;
+ end;
+ FTabs.EndUpdate;
+end;
+
+
+procedure TfrxDesignerForm.TabDragEnd(Sender: TObject);
+begin
+ FDragTabItem := nil;
+ FMouseDown := False;
+end;
+
+{ Menu commands }
+{------------------------------------------------------------------------------}
+
+procedure TfrxDesignerForm.ExitCmdExecute(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure TfrxDesignerForm.UndoCmdExecute(Sender: TObject);
+var
+ i: Integer;
+ SaveX, SaveY: Single;
+ TmpPage: TfrxReportPage;
+begin
+ if FPage = nil then
+ begin
+ CodeWindow.Undo;
+ Exit;
+ end;
+ Lock;
+ Report.ScriptText := CodeWindow.Lines;
+{$IFDEF DELPHI18}
+ SaveY := ScrollBox.ViewportPosition.Y;
+ SaveX := ScrollBox.ViewportPosition.X;
+{$ELSE}
+ SaveY := ScrollBox.VScrollBar.Value;
+ SaveX := ScrollBox.HScrollBar.Value;
+{$ENDIF}
+ if IsPreviewDesigner then
+ begin
+ i := 1;
+ if FPage is TfrxDMPPage then
+ TmpPage := TfrxDMPPage.Create(nil)
+ else
+ TmpPage := TfrxReportPage.Create(nil);
+
+ FUndoBuffer.AddRedo(FPage);
+ FPage.Free;
+ FUndoBuffer.GetUndo(TmpPage);
+ TmpPage.Parent := Report;
+ FPage := TmpPage;
+ end
+ else
+ begin
+ i := GetPageIndex;
+ FUndoBuffer.AddRedo(Report);
+ FUndoBuffer.GetUndo(Report);
+ CodeWindow.Lines := Report.ScriptText;
+ end;
+
+ ReloadPages(i);
+{$IFDEF DELPHI18}
+ ScrollBox.ViewportPosition := PointF(Savex, SaveY);
+{$ELSE}
+ ScrollBox.VScrollBar.Value := SaveY;
+ ScrollBox.HScrollBar.Value := SaveX;
+{$ENDIF}
+ if not Modified then
+ SaveB.Enabled := True;
+end;
+
+procedure TfrxDesignerForm.RedoCmdExecute(Sender: TObject);
+var
+ i: Integer;
+ SaveX, SaveY: Single;
+ TmpPage: TfrxReportPage;
+begin
+ Lock;
+{$IFDEF DELPHI18}
+ SaveY := ScrollBox.ViewportPosition.Y;
+ SaveX := ScrollBox.ViewportPosition.X;
+{$ELSE}
+ SaveY := ScrollBox.VScrollBar.Value;
+ SaveX := ScrollBox.HScrollBar.Value;
+{$ENDIF}
+ if IsPreviewDesigner then
+ begin
+ i := 1;
+ if FPage is TfrxDMPPage then
+ TmpPage := TfrxDMPPage.Create(nil)
+ else
+ TmpPage := TfrxReportPage.Create(nil);
+
+ FUndoBuffer.GetRedo(TmpPage);
+ FUndoBuffer.AddUndo(TmpPage);
+ FPage.Free;
+ TmpPage.Parent := Report;
+ FPage := TmpPage;
+ end
+ else
+ begin
+ i := GetPageIndex;
+ Report.Reloading := True;
+ FUndoBuffer.GetRedo(Report);
+ Report.Reloading := False;
+ FUndoBuffer.AddUndo(Report);
+ CodeWindow.Lines := Report.ScriptText;
+ end;
+
+ ReloadPages(i);
+{$IFDEF DELPHI18}
+ ScrollBox.ViewportPosition := PointF(Savex, SaveY);
+{$ELSE}
+ ScrollBox.VScrollBar.Value := SaveY;
+ ScrollBox.HScrollBar.Value := SaveX;
+{$ENDIF}
+end;
+
+procedure TfrxDesignerForm.CutCmdExecute(Sender: TObject);
+begin
+ if FPage = nil then
+ begin
+ CodeWindow.CutToClipboard;
+ Exit;
+ end;
+
+ FClipboard.Copy;
+ FWorkspace.DeleteObjects;
+ FInspector.Objects := FObjects;
+
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.CopyCmdExecute(Sender: TObject);
+begin
+ if FPage = nil then
+ begin
+ CodeWindow.CopyToClipboard;
+ Exit;
+ end;
+
+ FClipboard.Copy;
+ TimerTimer(nil);
+end;
+
+procedure TfrxDesignerForm.PasteCmdExecute(Sender: TObject);
+begin
+ if FPage = nil then
+ begin
+ CodeWindow.PasteFromClipboard;
+ Exit;
+ end;
+
+ FClipboard.Paste;
+ FWorkspace.BringToFront;
+ FInspector.Objects := FObjects;
+ FInspector.UpdateProperties;
+
+ if TfrxComponent(FSelectedObjects[0]) is TfrxDialogComponent then
+ Modified := True
+ else if FSelectedObjects[0] <> FPage then
+ TDesignerWorkspace(FWorkspace).SimulateMove;
+end;
+
+procedure TfrxDesignerForm.GroupCmdExecute(Sender: TObject);
+begin
+ FWorkspace.GroupObjects;
+end;
+
+procedure TfrxDesignerForm.UngroupCmdExecute(Sender: TObject);
+begin
+ FWorkspace.UngroupObjects;
+end;
+
+procedure TfrxDesignerForm.DeletePageCmdExecute(Sender: TObject);
+begin
+ if not CheckOp(drDontDeletePage) then Exit;
+
+ Lock;
+ if (FPage is TfrxReportPage) and (TfrxReportPage(FPage).Subreport <> nil) then
+ TfrxReportPage(FPage).Subreport.Free;
+
+ FPage.Free;
+ ReloadPages(-2);
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.NewPageBMouseEnter(Sender: TObject);
+var
+ p, r: TRectF;
+ s: String;
+begin
+ if (Sender is TControl) then
+ begin
+
+ if Sender is TfrxToolButton then
+ s:= TfrxToolButton(Sender).Hint
+ else
+ s := TControl(Sender).TagString;
+ p := TControl(Sender).AbsoluteRect;
+
+ r := RectF(0, 0, 300, 1000);
+ if Label1.Canvas <> nil then
+ begin
+ Label1.Canvas.MeasureText(r, s, True, [], TTextAlign.taCenter, TTextAlign.taCenter);
+ HintPanel.Width := r.Width + 12;
+ HintPanel.Height := r.Height + HintPanel.CalloutLength + 10;
+ end;
+
+
+ if (p.Left + TControl(Sender).Width/2 > HintPanel.Width/2) then
+ begin
+ HintPanel.CalloutPosition := TCalloutPosition.cpTop;
+ HintPanel.Position.X := p.Left + TControl(Sender).Width/2 - HintPanel.Width/2;
+ HintPanel.Position.Y := p.Top + TControl(Sender).Height;
+{$IFDEF DELPHI18}
+ Label1.Margins.Left := 0;
+ Label1.Margins.Top := 0;
+{$ELSE}
+ Label1.Padding.Left := 0;
+ Label1.Padding.Top := 0;
+{$ENDIF}
+ end
+ else
+ begin
+ HintPanel.CalloutPosition := TCalloutPosition.cpLeft;
+ HintPanel.Position.X := p.Left + TControl(Sender).Width;
+ HintPanel.Position.Y := p.Top - HintPanel.Height/2 + TControl(Sender).Height/2;
+ HintPanel.Width := HintPanel.Width + HintPanel.CalloutLength;
+{$IFDEF DELPHI18}
+ Label1.Margins.Left := HintPanel.CalloutLength / 2;
+ Label1.Margins.Top := HintPanel.CalloutLength / 2;
+{$ELSE}
+ Label1.Padding.Left := HintPanel.CalloutLength;
+ Label1.Padding.Top := -HintPanel.CalloutLength;
+{$ENDIF}
+ end;
+ HintPanel.Visible := True;
+ Label1.Text := s;
+end;
+
+end;
+
+procedure TfrxDesignerForm.NewPageBMouseLeave(Sender: TObject);
+begin
+HintPanel.Visible := False;
+end;
+
+procedure TfrxDesignerForm.NewPageCmdExecute(Sender: TObject);
+begin
+ if not CheckOp(drDontCreatePage) then Exit;
+
+ Lock;
+ if Report.DotMatrixReport then
+ FPage := TfrxDMPPage.Create(Report)
+ else
+ FPage := TfrxReportPage.Create(Report);
+ FPage.CreateUniqueName;
+ TfrxReportPage(FPage).SetDefaults;
+ ReloadPages(Report.PagesCount - 1);
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.NewDialogCmdExecute(Sender: TObject);
+begin
+ if not CheckOp(drDontCreatePage) then Exit;
+
+ Lock;
+ FPage := TfrxDialogPage.Create(Report);
+ FPage.CreateUniqueName;
+ FPage.SetBounds(265, 150, 300, 200);
+ if frxDesignerComp <> nil then
+ FPage.Font.Assign(frxDesignerComp.DefaultFont);
+ ReloadPages(Report.PagesCount - 1);
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.NewReportCmdExecute(Sender: TObject);
+var
+ dp: TfrxDataPage;
+ p: TfrxReportPage;
+ b: TfrxBand;
+ m: TfrxMemoView;
+ h, t: Extended;
+ w: Word;
+begin
+ if not CheckOp(drDontCreateReport) then Exit;
+
+ if Modified then
+ begin
+ w := AskSave;
+ if w = mrYes then
+ SaveCmdExecute(Self)
+ else if w = mrCancel then
+ Exit;
+ end;
+
+ t := FWorkspace.BandHeader;
+ h := 0;
+ case FUnits of
+ duCM: h := fr01cm * 6;
+ duInches: h := fr01in * 3;
+ duPixels: h := 20;
+ duChars: h := fr1CharY;
+ end;
+
+ ObjectSelectB.IsPressed := True;
+ SelectToolBClick(Self);
+
+ Lock;
+ Report.Clear;
+ Report.FileName := '';
+
+ dp := TfrxDataPage.Create(Report);
+ dp.Name := 'Data';
+
+ p := TfrxReportPage.Create(Report);
+ p.Name := 'Page1';
+ SetReportDefaults;
+
+ b := TfrxReportTitle.Create(p);
+ b.Name := 'ReportTitle1';
+ b.Top := t;
+ b.Height := h;
+
+ b := TfrxMasterData.Create(p);
+ b.Name := 'MasterData1';
+ b.Height := h;
+ b.Top := t * 2 + h * 2;
+
+ b := TfrxPageFooter.Create(p);
+ b.Name := 'PageFooter1';
+ b.Height := h;
+ b.Top := t * 3 + h * 4;
+
+ m := TfrxMemoView.Create(b);
+ m.Name := 'Memo1';
+ m.SetBounds((p.PaperWidth - p.LeftMargin - p.RightMargin - 20) * fr01cm, 0,
+ 2 * fr1cm, 5 * fr01cm);
+ m.HAlign := haRight;
+ m.Memo.Text := '[Page#]';
+
+ ReloadPages(-2);
+ UpdateCaption;
+ Modified := False;
+end;
+
+procedure TfrxDesignerForm.SaveCmdExecute(Sender: TObject);
+begin
+ FInspector.ItemIndex := FInspector.ItemIndex;
+ if CheckOp(drDontSaveReport) then
+ SaveFile(False, Sender = Self);
+end;
+
+procedure TfrxDesignerForm.SaveAsCmdExecute(Sender: TObject);
+begin
+ FInspector.ItemIndex := FInspector.ItemIndex;
+ if CheckOp(drDontSaveReport) then
+ SaveFile(True, Sender = Self);
+end;
+
+procedure TfrxDesignerForm.OpenCmdExecute(Sender: TObject);
+begin
+ if CheckOp(drDontLoadReport) then
+ LoadFile('', Sender = Self);
+end;
+
+procedure TfrxDesignerForm.OpenRecentFile(Sender: TObject);
+begin
+ if CheckOp(drDontLoadReport) then
+ LoadFile(TMenuItem(Sender).Text, True);
+end;
+
+procedure TfrxDesignerForm.DeleteCmdExecute(Sender: TObject);
+begin
+ FWorkspace.DeleteObjects;
+end;
+
+procedure TfrxDesignerForm.SelectAllCmdExecute(Sender: TObject);
+var
+ i: Integer;
+ Parent: TfrxComponent;
+begin
+ if Page = nil then
+ begin
+ //CodeWindow.SelectAll;
+ Exit;
+ end;
+
+ Parent := FPage;
+ if FSelectedObjects.Count = 1 then
+ if TfrxComponent(FSelectedObjects[0]) is TfrxBand then
+ Parent := FSelectedObjects[0]
+ else if TfrxComponent(FSelectedObjects[0]).Parent is TfrxBand then
+ Parent := TfrxComponent(FSelectedObjects[0]).Parent;
+
+ if Parent.Objects.Count <> 0 then
+ FSelectedObjects.Clear;
+ for i := 0 to Parent.Objects.Count - 1 do
+ FSelectedObjects.Add(Parent.Objects[i]);
+ OnSelectionChanged(Self);
+end;
+
+procedure TfrxDesignerForm.EditCmdExecute(Sender: TObject);
+begin
+ FWorkspace.EditObject;
+end;
+
+procedure TfrxDesignerForm.BringToFrontCmdExecute(Sender: TObject);
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ for i := 0 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if c.Parent <> nil then
+ if (c is TfrxReportComponent) and not (rfDontMove in c.Restrictions) then
+ begin
+ c.Parent.Objects.Remove(c);
+ c.Parent.Objects.Add(c);
+ end;
+ end;
+
+ ReloadObjects;
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.SendToBackCmdExecute(Sender: TObject);
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ for i := 0 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if c.Parent <> nil then
+ if (c is TfrxReportComponent) and not (rfDontMove in c.Restrictions) then
+ begin
+ c.Parent.Objects.Remove(c);
+ c.Parent.Objects.Insert(0, c);
+ end;
+ end;
+
+ ReloadObjects;
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.TabOrderMIClick(Sender: TObject);
+begin
+ with TfrxTabOrderEditorForm.Create(Self) do
+ begin
+ if ShowModal = mrOk then
+ Modified := True;
+ ReloadObjects;
+ Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.PageSettingsCmdExecute(Sender: TObject);
+begin
+ if CheckOp(drDontChangePageOptions) then
+ if (FPage is TfrxReportPage) and (TfrxReportPage(FPage).Subreport = nil) then
+ with TfrxPageEditorForm.Create(Self) do
+ begin
+ if ShowModal = mrOk then
+ begin
+ Modified := True;
+ UpdatePageDimensions;
+ end;
+ Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.OnComponentMenuClick(Sender: TObject);
+var
+ ed: TfrxComponentEditor;
+begin
+ ed := frxComponentEditors.GetComponentEditor(FSelectedObjects[0], Self, nil);
+ if ed <> nil then
+ begin
+ if ed.Execute(TMenuItem(Sender).Tag, not TMenuItem(Sender).IsChecked) then
+ Modified := True;
+ ed.Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.ReportDataCmdExecute(Sender: TObject);
+begin
+ if CheckOp(drDontEditReportData) then
+ with TfrxReportDataForm.Create(Self) do
+ begin
+ Report := Self.Report;
+ FormShow(Self);
+ if ShowModal = mrOk then
+ begin
+ Modified := True;
+ UpdateDataTree;
+ end;
+ Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.ReportStylesCmdExecute(Sender: TObject);
+begin
+ if CheckOp(drDontChangeReportOptions) then
+ with TfrxStyleEditorForm.Create(Self) do
+ begin
+ FormShow(Self);
+ if ShowModal = mrOk then
+ begin
+ Modified := True;
+ UpdateStyles;
+ Report.Styles.Apply;
+ end;
+ Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.ReportOptionsCmdExecute(Sender: TObject);
+{$IFNDEF DELPHI21}
+var
+ i: Integer;
+{$ENDIF}
+begin
+ if CheckOp(drDontChangeReportOptions) then
+ with TfrxReportEditorForm.Create(Self) do
+ begin
+ if ShowModal = mrOk then
+ begin
+ { reload printer fonts }
+ FontNameCB.BeginUpdate;
+ FontNameCB.Clear;
+ FillFontsList(FontNameCB.Items);
+{$IFNDEF DELPHI21}
+ for i := 0 to FontNameCB.ListBox.Count - 1 do
+ FontNameCB.ListBox.ListItems[i].Font.Family := FontNameCB.Items[i];
+{$ENDIF}
+ FontNameCB.EndUpdate;
+ Modified := True;
+ end;
+ Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.VariablesCmdExecute(Sender: TObject);
+begin
+ if CheckOp(drDontEditVariables) then
+ with TfrxVarEditorForm.Create(Self) do
+ begin
+ if ShowModal = mrOk then
+ begin
+ Modified := True;
+ UpdateDataTree;
+ end;
+ Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.PreviewCmdExecute(Sender: TObject);
+var
+ Preview: TfrxCustomPreview;
+ pt: TPoint;
+ SavePageNo: Integer;
+ SaveModalPreview: Boolean;
+ SaveDestroyForms: Boolean;
+ SaveMDIChild: Boolean;
+ SaveVariables: TfrxVariables;
+begin
+ FInspector.ItemIndex := FInspector.ItemIndex;
+ if not CheckOp(drDontPreviewReport) then Exit;
+
+ if FScriptStopped then
+ begin
+ RunScriptBClick(RunScriptB);
+ Exit;
+ end;
+
+ SavePagePosition;
+ Report.ScriptText := CodeWindow.Lines;
+ if not Report.PrepareScript then
+ begin
+ pt := fsPosToPoint(Report.Script.ErrorPos);
+ SwitchToCodeWindow;
+ FCodeWindow.SetPos(pt.X, pt.Y);
+ FCodeWindow.ShowMessage(Report.Script.ErrorMsg);
+ Exit;
+ end;
+
+ SavePageNo := GetPageIndex;
+ SaveModalPreview := Report.PreviewOptions.Modal;
+ SaveDestroyForms := Report.EngineOptions.DestroyForms;
+ SaveMDIChild := Report.PreviewOptions.MDIChild;
+ SaveVariables := TfrxVariables.Create;
+ SaveVariables.Assign(Report.Variables);
+
+ FUndoBuffer.AddUndo(Report);
+
+ Preview := Report.Preview;
+ try
+ Report.Preview := nil;
+ Report.PreviewOptions.Modal := True;
+ Report.EngineOptions.DestroyForms := False;
+ Report.PreviewOptions.MDIChild := False;
+ FWatchList.ScriptRunning := True;
+ Report.ShowReport;
+ except
+ end;
+
+ FWatchList.ScriptRunning := False;
+ Lock;
+ FUndoBuffer.GetUndo(Report);
+
+ Report.Script.ClearItems(Report);
+ Report.Preview := Preview;
+ Report.PreviewOptions.Modal := SaveModalPreview;
+ Report.EngineOptions.DestroyForms := SaveDestroyForms;
+ Report.PreviewOptions.MDIChild := SaveMDIChild;
+ Report.Variables.Assign(SaveVariables);
+ SaveVariables.Free;
+
+ if SavePageNo <> -1 then
+ ReloadPages(SavePageNo)
+ else
+ begin
+ ReloadPages(-2);
+ Page := nil;
+ end;
+
+ UpdateWatches;
+end;
+
+procedure TfrxDesignerForm.NewItemCmdExecute(Sender: TObject);
+begin
+// if CheckOp(drDontCreateReport) then
+// with TfrxNewItemForm.Create(Self) do
+// begin
+// ShowModal;
+// Free;
+// end;
+end;
+
+procedure TfrxDesignerForm.FindCmdExecute(Sender: TObject);
+begin
+ FindOrReplace(False);
+end;
+
+procedure TfrxDesignerForm.ReplaceCmdExecute(Sender: TObject);
+begin
+ FindOrReplace(True);
+end;
+
+procedure TfrxDesignerForm.FindNextCmdExecute(Sender: TObject);
+begin
+ FindText;
+end;
+
+procedure TfrxDesignerForm.FrameWidthCBKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: Char; Shift: TShiftState);
+begin
+ if not CharInSet(KeyChar, [#30 .. #39]) then
+ begin
+ Key := 0;
+ KeyChar := #0;
+ end;
+end;
+
+procedure TfrxDesignerForm.RotateBClick(Sender: TObject);
+var
+ pt: TPointF;
+begin
+ pt := Self.ClientToScreen(PointF(RotateB.AbsoluteRect.Left, RotateB.AbsoluteRect.Bottom));
+ RotationPopup.Popup(pt.X, pt.Y);
+end;
+
+procedure TfrxDesignerForm.ShowRulersCmdExecute(Sender: TObject);
+begin
+ ShowRulersMI.IsChecked := not ShowRulersMI.IsChecked;
+ ShowRulers := ShowRulersMI.IsChecked;
+end;
+
+procedure TfrxDesignerForm.ShowGuidesCmdExecute(Sender: TObject);
+begin
+ ShowGuidesMI.IsChecked := not ShowGuidesMI.IsChecked;
+ ShowGuides := ShowGuidesMI.IsChecked;
+end;
+
+procedure TfrxDesignerForm.DeleteGuidesCmdExecute(Sender: TObject);
+begin
+ if FPage is TfrxReportPage then
+ begin
+ TfrxReportPage(FPage).ClearGuides;
+ FWorkspace.Repaint;
+ Modified := True;
+ end;
+end;
+
+procedure TfrxDesignerForm.OptionsCmdExecute(Sender: TObject);
+var
+ u: TfrxDesignerUnits;
+begin
+ u := FUnits;
+
+ with TfrxOptionsEditor.Create(Self) do
+ begin
+ ShowModal;
+ Free;
+ end;
+
+ if u <> FUnits then
+ FOldUnits := FUnits;
+
+ if FWorkspace.GridType = gtDialog then
+ begin
+ FWorkspace.GridX := FGridSize4;
+ FWorkspace.GridY := FGridSize4;
+ end;
+
+ FWorkspace.UpdateView;
+ CodeWindow.Repaint;
+end;
+
+procedure TfrxDesignerForm.HelpContentsCmdExecute(Sender: TObject);
+var
+ tempC: TfrxDialogComponent;
+begin
+ if Page = nil then
+ frxResources.Help(FCodeWindow)
+ else if Page is TfrxDialogPage then
+ frxResources.Help(Page)
+ else if TObject(SelectedObjects[0]) is TfrxDialogComponent then
+ begin
+ tempC := TfrxDialogComponent.Create(nil);
+ frxResources.Help(tempC);
+ tempC.Free;
+ end
+ else
+ frxResources.Help(Self);
+end;
+
+procedure TfrxDesignerForm.AboutCmdExecute(Sender: TObject);
+begin
+ with TfrxAboutForm.Create(Self) do
+ begin
+ ShowModal;
+ Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.AddChildMIClick(Sender: TObject);
+var
+ b, bc: TfrxBand;
+begin
+ b := FSelectedObjects[0];
+ bc := b.Child;
+ InsertBandClick(ChildMI);
+ b.Child := FSelectedObjects[0];
+ b.Child.Child := TfrxChild(bc);
+ Modified := True;
+end;
+
+
+{ Debugging }
+{------------------------------------------------------------------------------}
+
+procedure TfrxDesignerForm.RunScriptBClick(Sender: TObject);
+begin
+ if FScriptRunning then
+ begin
+ FScriptStep := Sender = StepScriptB;
+ //if (Sender = RunScriptB) and (CodeWindow.BreakPoints.Count = 0) then
+ // Report.Script.OnRunLine := nil;
+ FScriptStopped := False;
+ Exit;
+ end;
+
+ //if (Sender = RunScriptB) and (CodeWindow.BreakPoints.Count = 0) then
+ // Report.Script.OnRunLine := nil
+ //else
+ Report.Script.OnRunLine := OnRunLine;
+
+ try
+ FScriptRunning := True;
+ FScriptFirstTime := True;
+ PreviewCmdExecute(Self);
+ finally
+ FScriptRunning := False;
+ Report.Script.OnRunLine := nil;
+ //CodeWindow.DeleteF4BreakPoints;
+ //CodeWindow.ActiveLine := -1;
+ end;
+end;
+
+procedure TfrxDesignerForm.StopScriptBClick(Sender: TObject);
+begin
+ Report.Script.OnRunLine := nil;
+ Report.Script.Terminate;
+ Report.Terminated := True;
+ FScriptStopped := False;
+end;
+
+procedure TfrxDesignerForm.EvaluateBClick(Sender: TObject);
+begin
+ with TfrxEvaluateForm.Create(Self) do
+ begin
+ Script := Report.Script;
+ if CodeWindow.SelText <> '' then
+ ExpressionE.Text := CodeWindow.SelText;
+ ShowModal;
+ Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.BreakPointBClick(Sender: TObject);
+begin
+ //CodeWindow.ToggleBreakPoint(CodeWindow.GetPos.Y, '');
+end;
+
+procedure TfrxDesignerForm.RunToCursorBClick(Sender: TObject);
+begin
+ //CodeWindow.AddBreakPoint(CodeWindow.GetPos.Y, 'F4');
+ RunScriptBClick(nil);
+end;
+
+procedure TfrxDesignerForm.OnRunLine(Sender: TfsScript; const UnitName,
+ SourcePos: String);
+//var
+// p: TPoint;
+// SaveActiveForm: TForm;
+// Condition: String;
+//
+// procedure CreateLineMarks;
+// var
+//
+// i: Integer;
+// begin
+// for i := 0 to Report.Script.Lines.Count - 1 do
+// CodeWindow.RunLine[i + 1] := Report.Script.IsExecutableLine(i + 1);
+// end;
+
+begin
+// p := fsPosToPoint(SourcePos);
+// if not FScriptStep and (CodeWindow.BreakPoints.Count > 0) then
+// if not CodeWindow.IsBreakPoint(p.Y) then
+// Exit;
+//
+// Condition := CodeWindow.GetBreakPointCondition(p.Y);
+// { F4 - run to line, remove the breakpoint }
+// if Condition = 'F4' then
+// CodeWindow.DeleteBreakPoint(p.Y);
+//
+// if FScriptFirstTime then
+// CreateLineMarks;
+// FScriptFirstTime := False;
+//
+// SaveActiveForm := Screen.ActiveForm;
+//
+// if ParentForm <> nil then
+// begin
+// EnableWindow(ParentForm.Handle, True);
+////{$IFDEF Delphi9}
+// ParentForm.Enabled := True;
+////{$ENDIF}
+// ParentForm.SetFocus;
+// end
+// else
+// begin
+// EnableWindow(Handle, True);
+////{$IFDEF Delphi9}
+// Enabled := True;
+////{$ENDIF}
+// SetFocus;
+// end;
+//
+// {switch to code Tab}
+// if FTabs.TabIndex <> 0 then
+// SetPage(nil);
+//
+// CodeWindow.ActiveLine := p.Y;
+// CodeWindow.SetPos(p.X, p.Y);
+// UpdateWatches;
+//
+// FScriptStopped := True;
+// while FScriptStopped do
+// Application.ProcessMessages;
+//
+// if SaveActiveForm <> nil then
+// SaveActiveForm.SetFocus;
+end;
+
+
+{ Alignment palette }
+{------------------------------------------------------------------------------}
+
+procedure TfrxDesignerForm.AlignLeftsBClick(Sender: TObject);
+var
+ i: Integer;
+ c0, c: TfrxComponent;
+begin
+ if FSelectedObjects.Count < 2 then Exit;
+
+ c0 := FSelectedObjects[0];
+ for i := 1 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if not (rfDontMove in c.Restrictions) then
+ c.Left := c0.Left;
+ end;
+
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.AlignRightsBClick(Sender: TObject);
+var
+ i: Integer;
+ c0, c: TfrxComponent;
+begin
+ if FSelectedObjects.Count < 2 then Exit;
+
+ c0 := FSelectedObjects[0];
+ for i := 1 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if not (rfDontMove in c.Restrictions) then
+ c.Left := c0.Left + c0.Width - c.Width;
+ end;
+
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.AlignTopsBClick(Sender: TObject);
+var
+ i: Integer;
+ c0, c: TfrxComponent;
+begin
+ if FSelectedObjects.Count < 2 then Exit;
+
+ c0 := FSelectedObjects[0];
+ for i := 1 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if not (rfDontMove in c.Restrictions) then
+ if Abs(c.Top - c.AbsTop) < 1e-4 then
+ c.Top := c0.AbsTop
+ else
+ c.Top := c0.AbsTop - c.AbsTop + c.Top;
+ end;
+
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.AlignBottomsBClick(Sender: TObject);
+var
+ i: Integer;
+ c0, c: TfrxComponent;
+begin
+ if FSelectedObjects.Count < 2 then Exit;
+
+ c0 := FSelectedObjects[0];
+ for i := 1 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if not (rfDontMove in c.Restrictions) then
+ if Abs(c.Top - c.AbsTop) < 1e-4 then
+ c.Top := c0.AbsTop + c0.Height - c.Height
+ else
+ c.Top := c0.AbsTop - c.AbsTop + c.Top + c0.Height - c.Height;
+ end;
+
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.AlignHorzCentersBClick(Sender: TObject);
+var
+ i: Integer;
+ c0, c: TfrxComponent;
+begin
+ if FSelectedObjects.Count < 2 then Exit;
+
+ c0 := FSelectedObjects[0];
+ for i := 1 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if not (rfDontMove in c.Restrictions) then
+ c.Left := c0.Left + c0.Width / 2 - c.Width / 2;
+ end;
+
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.AlignVertCentersBClick(Sender: TObject);
+var
+ i: Integer;
+ c0, c: TfrxComponent;
+begin
+ if FSelectedObjects.Count < 2 then Exit;
+
+ c0 := FSelectedObjects[0];
+ for i := 1 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if not (rfDontMove in c.Restrictions) then
+ c.Top := c0.Top + c0.Height / 2 - c.Height / 2;
+ end;
+
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.CenterHorzBClick(Sender: TObject);
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ if FSelectedObjects.Count < 1 then Exit;
+
+ for i := 0 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if not (rfDontMove in c.Restrictions) and (c is TfrxView) then
+ if c.Parent is TfrxBand then
+ c.Left := (c.Parent.Width - c.Width) / 2 else
+ c.Left := (FWorkspace.Width / Scale - c.Width) / 2;
+ end;
+
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.CenterVertBClick(Sender: TObject);
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ if FSelectedObjects.Count < 1 then Exit;
+
+ for i := 0 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if not (rfDontMove in c.Restrictions) and (c is TfrxView) then
+ if c.Parent is TfrxBand then
+ c.Top := (c.Parent.Height - c.Height) / 2 else
+ c.Top := (FWorkspace.Height / Scale - c.Height) / 2;
+ end;
+
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.SpaceHorzBClick(Sender: TObject);
+var
+ i: Integer;
+ c: TfrxComponent;
+ sl: TStringList;
+ dx: Extended;
+begin
+ if FSelectedObjects.Count < 3 then Exit;
+
+ sl := TfrxStringList.Create;
+ sl.Sorted := True;
+ sl.Duplicates := dupAccept;
+
+ for i := 0 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ sl.AddObject(Format('%4.4d', [Round(c.Left)]), c);
+ end;
+
+ dx := (TfrxComponent(sl.Objects[sl.Count - 1]).Left -
+ TfrxComponent(sl.Objects[0]).Left) / (sl.Count - 1);
+
+ for i := 1 to sl.Count - 2 do
+ begin
+ c := TfrxComponent(sl.Objects[i]);
+ if not (rfDontMove in c.Restrictions) then
+ c.Left := TfrxComponent(sl.Objects[i - 1]).Left + dx;
+ end;
+
+ sl.Free;
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.SpaceVertBClick(Sender: TObject);
+var
+ i: Integer;
+ c: TfrxComponent;
+ sl: TStringList;
+ dy: Extended;
+begin
+ if FSelectedObjects.Count < 3 then Exit;
+
+ sl := TfrxStringList.Create;
+ sl.Sorted := True;
+ sl.Duplicates := dupAccept;
+
+ for i := 0 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ sl.AddObject(Format('%4.4d', [Round(c.Top)]), c);
+ end;
+
+ dy := (TfrxComponent(sl.Objects[sl.Count - 1]).Top -
+ TfrxComponent(sl.Objects[0]).Top) / (sl.Count - 1);
+
+ for i := 1 to sl.Count - 2 do
+ begin
+ c := TfrxComponent(sl.Objects[i]);
+ if not (rfDontMove in c.Restrictions) then
+ c.Top := TfrxComponent(sl.Objects[i - 1]).Top + dy;
+ end;
+
+ sl.Free;
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.SameWidthBClick(Sender: TObject);
+var
+ i: Integer;
+ c0, c: TfrxComponent;
+begin
+ if FSelectedObjects.Count < 2 then Exit;
+
+ c0 := FSelectedObjects[0];
+ for i := 1 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if not (rfDontSize in c.Restrictions) then
+ c.Width := c0.Width;
+ end;
+
+ Modified := True;
+end;
+
+procedure TfrxDesignerForm.SameHeightBClick(Sender: TObject);
+var
+ i: Integer;
+ c0, c: TfrxComponent;
+begin
+ if FSelectedObjects.Count < 2 then Exit;
+
+ c0 := FSelectedObjects[0];
+ for i := 1 to FSelectedObjects.Count - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if not (rfDontSize in c.Restrictions) then
+ c.Height := c0.Height;
+ end;
+
+ Modified := True;
+end;
+
+
+{ Save/restore state }
+{------------------------------------------------------------------------------}
+
+procedure TfrxDesignerForm.SaveState;
+var
+ Ini: TCustomIniFile;
+ Nm: String;
+begin
+ if IsPreviewDesigner then Exit;
+
+ Ini := Report.GetIniFile;
+
+ try
+ if Ini is TIniFile then
+ begin
+ Nm := ExtractFilePath(Ini.FileName);
+ if not DirectoryExists(Nm) then
+ if not CreateDir(Nm) then
+ begin
+ Ini.Free;
+ Exit;
+ end;
+ end;
+
+ Nm := 'TfrxDesignerForm';
+ Ini.WriteInteger('TfrxObjectInspector', 'SplitPos', Round(FInspector.SplitterPos));
+ Ini.WriteInteger('TfrxObjectInspector', 'Split1Pos', Round(FInspector.Splitter1Pos));
+ Ini.WriteInteger(Nm, 'LeftDockSize', Round(LeftDockTB.Width));
+ Ini.WriteInteger(Nm, 'RightDockSize', Round(RightDockTB.Width));
+ Ini.WriteInteger(Nm, 'LeftDockSplit', Round(FReportTree.MainPanel.Height));
+ Ini.WriteFloat(Nm, 'Scale', FScale);
+ Ini.WriteBool(Nm, 'ShowGrid', FShowGrid);
+ Ini.WriteBool(Nm, 'GridAlign', FGridAlign);
+ Ini.WriteBool(Nm, 'ShowRulers', FShowRulers);
+ Ini.WriteBool(Nm, 'ShowGuides', FShowGuides);
+ Ini.WriteFloat(Nm, 'Grid1', FGridSize1);
+ Ini.WriteFloat(Nm, 'Grid2', FGridSize2);
+ Ini.WriteFloat(Nm, 'Grid3', FGridSize3);
+ Ini.WriteFloat(Nm, 'Grid4', FGridSize4);
+ FUnits := FOldUnits;
+ Ini.WriteInteger(Nm, 'Units', Integer(FUnits));
+// Ini.WriteString(Nm, 'ScriptFontName', CodeWindow.Font.Name);
+// Ini.WriteInteger(Nm, 'ScriptFontSize', CodeWindow.Font.Size);
+ Ini.WriteString(Nm, 'MemoFontName', MemoFontName);
+ Ini.WriteInteger(Nm, 'MemoFontSize', MemoFontSize);
+ Ini.WriteBool(Nm, 'UseObjectFont', UseObjectFont);
+ Ini.WriteBool(Nm, 'EditAfterInsert', FEditAfterInsert);
+ Ini.WriteBool(Nm, 'LocalizedOI', FLocalizedOI);
+ {$IFDEF LINUX}
+
+ {$ELSE}
+ Ini.WriteString(Nm, 'RecentFiles', '"'+FRecentFiles.CommaText+'"');
+ {$ENDIF}
+ Ini.WriteBool(Nm, 'FreeBands', FWorkspace.FreeBandsPlacement);
+ Ini.WriteInteger(Nm, 'BandsGap', FWorkspace.GapBetweenBands);
+ Ini.WriteBool(Nm, 'ShowBandCaptions', FWorkspace.ShowBandCaptions);
+ Ini.WriteBool(Nm, 'DropFields', FDropFields);
+ Ini.WriteString(Nm, 'WatchList', FWatchList.Watches.Text);
+
+ frxSaveFormPosition(Ini, Self);
+ finally
+ Ini.Free;
+ end;
+
+end;
+
+procedure TfrxDesignerForm.RestoreState(RestoreDefault: Boolean = False;
+ RestoreMainForm: Boolean = False);
+var
+ Ini: TCustomIniFile;
+ Nm: String;
+
+ function Def(Value, DefValue: Extended): Extended;
+ begin
+ if Value = 0 then
+ Result := DefValue else
+ Result := Value;
+ end;
+
+ procedure DoRestore;
+ begin
+ if not RestoreMainForm then
+ begin
+ FInspector.SplitterPos := Ini.ReadInteger('TfrxObjectInspector',
+ 'SplitPos', FInspector.Width div 2);
+ if FInspector.SplitterPos > FInspector.Width - 10 then
+ FInspector.SplitterPos := FInspector.Width div 2;
+ FInspector.Splitter1Pos := Ini.ReadInteger('TfrxObjectInspector',
+ 'Split1Pos', 65);
+ if (FInspector.Splitter1Pos < 10) or (FInspector.Splitter1Pos > FInspector.Height - 20) then
+ FInspector.Splitter1Pos := 65;
+ LeftDockTB.Width := Ini.ReadInteger(Nm, 'LeftDockSize', 200);
+ RightDockTB.Width := Ini.ReadInteger(Nm, 'RightDockSize', 150);
+ FReportTree.MainPanel.Height := Ini.ReadInteger(Nm, 'LeftDockSplit', 150);
+ Scale := Ini.ReadFloat(Nm, 'Scale', 1);
+ ShowGrid := Ini.ReadBool(Nm, 'ShowGrid', True);
+ GridAlign := Ini.ReadBool(Nm, 'GridAlign', True);
+ ShowRulers := Ini.ReadBool(Nm, 'ShowRulers', True);
+ ShowGuides := Ini.ReadBool(Nm, 'ShowGuides', True);
+ FGridSize1 := Def(Ini.ReadFloat(Nm, 'Grid1', 0), 0.1);
+ FGridSize2 := Def(Ini.ReadFloat(Nm, 'Grid2', 0), 0.1);
+ FGridSize3 := Def(Ini.ReadFloat(Nm, 'Grid3', 0), 4);
+ FGridSize4 := Def(Ini.ReadFloat(Nm, 'Grid4', 0), 4);
+ Units := TfrxDesignerUnits(Ini.ReadInteger(Nm, 'Units', 0));
+ FOldUnits := FUnits;
+
+// CodeWindow.Font.Name := Ini.ReadString(Nm, 'ScriptFontName', 'Courier New');
+// CodeWindow.Font.Size := Ini.ReadInteger(Nm, 'ScriptFontSize', 10);
+
+ {$IFDEF LINUX}
+ MemoFontName := Ini.ReadString(Nm, 'MemoFontName', 'Liberation Sans');
+ {$ELSE}
+ MemoFontName := Ini.ReadString(Nm, 'MemoFontName', 'Arial');
+ {$ENDIF}
+ MemoFontSize := Ini.ReadInteger(Nm, 'MemoFontSize', 10);
+ UseObjectFont := Ini.ReadBool(Nm, 'UseObjectFont', True);
+ FEditAfterInsert := Ini.ReadBool(Nm, 'EditAfterInsert', False);
+ FRecentFiles.CommaText := Ini.ReadString(Nm, 'RecentFiles', '');
+ FWorkspace.FreeBandsPlacement := Ini.ReadBool(Nm, 'FreeBands', False);
+ FWorkspace.GapBetweenBands := Ini.ReadInteger(Nm, 'BandsGap', 4);
+ FWorkspace.ShowBandCaptions := Ini.ReadBool(Nm, 'ShowBandCaptions', True);
+ FDropFields := Ini.ReadBool(Nm, 'DropFields', True);
+ FWatchList.Watches.Text := Ini.ReadString(Nm, 'WatchList', '');
+ FWatchList.UpdateWatches;
+
+ end
+ else
+ frxRestoreFormPosition(Ini, Self);
+ end;
+
+ procedure ReadDefIni;
+ begin
+ Scale := 1;
+ ShowGrid := True;
+ GridAlign := True;
+ ShowRulers := True;
+ ShowGuides := True;
+ FGridSize1 := 0.1;
+ FGridSize2 := 0.1;
+ FGridSize3 := 4;
+ FGridSize4 := 4;
+ Units := TfrxDesignerUnits(0);
+ FWorkspace.ShowBandCaptions := true;
+ FOldUnits := FUnits;
+ end;
+
+begin
+ Ini := Report.GetIniFile;
+ Nm := 'TfrxDesignerForm';
+ try
+ if RestoreDefault or (Ini.ReadFloat(Nm, 'Scale', 0) = 0) then
+ ReadDefIni
+ else
+ begin
+ try
+ DoRestore;
+ except
+ ReadDefIni;
+ end
+ end;
+ finally
+ Ini.Free;
+ end;
+end;
+
+procedure TfrxDesignerForm.Localize;
+begin
+ OpenScriptB.Hint := frxGet(2300);
+ SaveScriptB.Hint := frxGet(2301);
+ RunScriptB.Hint := frxGet(2302);
+ StepScriptB.Hint := frxGet(2303);
+ StopScriptB.Hint := frxGet(2304);
+ EvaluateB.Hint := frxGet(2305);
+ //LangCB.Text := frxGet(2306);
+ AlignLeftsB.Hint := frxGet(2308);
+ AlignHorzCentersB.Hint := frxGet(2309);
+ AlignRightsB.Hint := frxGet(2310);
+ AlignTopsB.Hint := frxGet(2311);
+ AlignVertCentersB.Hint := frxGet(2312);
+ AlignBottomsB.Hint := frxGet(2313);
+ SpaceHorzB.Hint := frxGet(2314);
+ SpaceVertB.Hint := frxGet(2315);
+ CenterHorzB.Hint := frxGet(2316);
+ CenterVertB.Hint := frxGet(2317);
+ SameWidthB.Hint := frxGet(2318);
+ SameHeightB.Hint := frxGet(2319);
+ StyleCB.TagString := frxGet(2321);
+ FontNameCB.TagString := frxGet(2322);
+ FontSizeCB.TagString := frxGet(2323);
+ BoldB.Hint := frxGet(2324);
+ ItalicB.Hint := frxGet(2325);
+ UnderlineB.Hint := frxGet(2326);
+ FontColorB.Hint := frxGet(2327);
+ HighlightB.Hint := frxGet(2328);
+ RotateB.Hint := frxGet(2329);
+ TextAlignLeftB.Hint := frxGet(2330);
+ TextAlignCenterB.Hint := frxGet(2331);
+ TextAlignRightB.Hint := frxGet(2332);
+ TextAlignBlockB.Hint := frxGet(2333);
+ TextAlignTopB.Hint := frxGet(2334);
+ TextAlignMiddleB.Hint := frxGet(2335);
+ TextAlignBottomB.Hint := frxGet(2336);
+ FrameTopB.Hint := frxGet(2338);
+ FrameBottomB.Hint := frxGet(2339);
+ FrameLeftB.Hint := frxGet(2340);
+ FrameRightB.Hint := frxGet(2341);
+ FrameAllB.Hint := frxGet(2342);
+ FrameNoB.Hint := frxGet(2343);
+ ShadowB.Hint := frxGet(2344);
+ FillColorB.Hint := frxGet(2345);
+ FrameColorB.Hint := frxGet(2346);
+ FrameStyleB.Hint := frxGet(2347);
+ FrameWidthCB.TagString := frxGet(2348);
+ NewB.Hint := frxGet(2350);
+ OpenB.Hint := frxGet(2351);
+ SaveB.Hint := frxGet(2352);
+ PreviewB.Hint := frxGet(2353);
+ NewPageB.Hint := frxGet(2354);
+ NewDialogB.Hint := frxGet(2355);
+ DeletePageB.Hint := frxGet(2356);
+ PageSettingsB.Hint := frxGet(2357);
+ CutB.Hint := frxGet(2359);
+ CopyB.Hint := frxGet(2360);
+ PasteB.Hint := frxGet(2361);
+ UndoB.Hint := frxGet(2363);
+ RedoB.Hint := frxGet(2364);
+ GroupB.Hint := frxGet(2365);
+ UngroupB.Hint := frxGet(2366);
+ ShowGridB.Hint := frxGet(2367);
+ AlignToGridB.Hint := frxGet(2368);
+ SetToGridB.Hint := frxGet(2369);
+ ScaleCB.TagString := frxGet(2370);
+
+ ObjectSelectB.Hint := frxGet(2372);
+ ObjectBandB.Hint := frxGet(2377);
+ FileMenu.Text := frxGet(2378);
+ EditMenu.Text := frxGet(2379);
+ FindMI.Text := frxGet(2380);
+ FindNextMI.Text := frxGet(2381);
+ ReplaceMI.Text := frxGet(2382);
+ ReportMenu.Text := frxGet(2383);
+ ReportDataMI.Text := frxGet(2384);
+ ReportSettingsMI.Text := frxGet(2385);
+ ReportStylesMI.Text := frxGet(2386);
+ ViewMenu.Text := frxGet(2387);
+ ShowRulersMI.Text := frxGet(2397);
+ ShowGuidesMI.Text := frxGet(2398);
+ DeleteGuidesMI.Text := frxGet(2399);
+ OptionsMI.Text := frxGet(2400);
+ HelpMenu.Text := frxGet(2401);
+
+ AboutMI.Text := frxGet(2403);
+//
+ UndoMI.Text := frxGet(2405);
+ RedoMI.Text := frxGet(2406);
+ CutMI.Text := frxGet(2407);
+ CopyMI.Text := frxGet(2408);
+ PasteMI.Text := frxGet(2409);
+ GroupMI.Text := frxGet(2410);
+ UngroupMI.Text := frxGet(2411);
+ DeleteMI.Text := frxGet(2412);
+ DeletePageMI.Text := frxGet(2413);
+ DeletePageMI1.Text := frxGet(2413);
+ SelectAllMI.Text := frxGet(2414);
+ EditMI.Text := frxGet(2415);
+ BringtoFrontMI.Text := frxGet(2416);
+ SendtoBackMI.Text := frxGet(2417);
+ NewMI.Text := frxGet(2418);
+ NewReportMI.Text := frxGet(2419);
+ NewPageMI1.Text := frxGet(2420);
+ NewPageMI.Text := frxGet(2420);
+ NewDialogMI1.Text := frxGet(2421);
+ NewDialogMI.Text := frxGet(2421);
+ OpenMI.Text := frxGet(2422);
+ SaveMI.Text := frxGet(2423);
+ SaveAsMI.Text := frxGet(2424);
+ VariablesMI.Text := frxGet(2425);
+ PageSettingsMI1.Text := frxGet(2426);
+ PageSettingsMI.Text := frxGet(2426);
+ PreviewMI.Text := frxGet(2427);
+ ExitMI.Text := frxGet(2428);
+ ReportTitleMI.Text := frxGet(2429);
+ ReportSummaryMI.Text := frxGet(2430);
+ PageHeaderMI.Text := frxGet(2431);
+ PageFooterMI.Text := frxGet(2432);
+ HeaderMI.Text := frxGet(2433);
+ FooterMI.Text := frxGet(2434);
+ MasterDataMI.Text := frxGet(2435);
+ DetailDataMI.Text := frxGet(2436);
+ SubdetailDataMI.Text := frxGet(2437);
+ Data4levelMI.Text := frxGet(2438);
+ Data5levelMI.Text := frxGet(2439);
+ Data6levelMI.Text := frxGet(2440);
+ GroupHeaderMI.Text := frxGet(2441);
+ GroupFooterMI.Text := frxGet(2442);
+ ChildMI.Text := frxGet(2443);
+ ColumnHeaderMI.Text := frxGet(2444);
+ ColumnFooterMI.Text := frxGet(2445);
+ OverlayMI.Text := frxGet(2446);
+ VerticalbandsMI.Text := frxGet(2447);
+ HeaderMI1.Text := frxGet(2448);
+ FooterMI1.Text := frxGet(2449);
+ MasterDataMI1.Text := frxGet(2450);
+ DetailDataMI1.Text := frxGet(2451);
+ SubdetailDataMI1.Text := frxGet(2452);
+ GroupHeaderMI1.Text := frxGet(2453);
+ GroupFooterMI1.Text := frxGet(2454);
+ ChildMI1.Text := frxGet(2455);
+ R0MI.Text := frxGet(2456);
+ R45MI.Text := frxGet(2457);
+ R90MI.Text := frxGet(2458);
+ R180MI.Text := frxGet(2459);
+ R270MI.Text := frxGet(2460);
+ FontB.Hint := frxGet(2461);
+ BoldMI.Text := frxGet(2462);
+ ItalicMI.Text := frxGet(2463);
+ UnderlineMI.Text := frxGet(2464);
+ SuperScriptMI.Text := frxGet(2465);
+ SubScriptMI.Text := frxGet(2466);
+ CondensedMI.Text := frxGet(2467);
+ WideMI.Text := frxGet(2468);
+ N12cpiMI.Text := frxGet(2469);
+ N15cpiMI.Text := frxGet(2470);
+ OpenDialog.Filter := frxGet(2471);
+ OpenDialog.Options := OpenDialog.Options + [TOpenOption.ofNoChangeDir];
+ SaveDialog.Options := SaveDialog.Options + [TOpenOption.ofNoChangeDir];
+ OpenScriptDialog.Options := OpenScriptDialog.Options + [TOpenOption.ofNoChangeDir];
+ SaveScriptDialog.Options := SaveScriptDialog.Options + [TOpenOption.ofNoChangeDir];
+ OpenScriptDialog.Filter := frxGet(2472);
+ SaveScriptDialog.Filter := frxGet(2473);
+ BreakPointB.Hint := frxGet(2476);
+ RunToCursorB.Hint := frxGet(2477);
+
+
+ frxResources.LoadImageFromResouce(NewB.Bitmap, 0, 0);
+ frxResources.LoadImageFromResouce(NewReportMI.Bitmap, 0, 0);
+ frxResources.LoadImageFromResouce(OpenB.Bitmap, 0, 1);
+ frxResources.LoadImageFromResouce(OpenMI.Bitmap, 0, 1);
+ frxResources.LoadImageFromResouce(SaveB.Bitmap, 0, 2);
+ frxResources.LoadImageFromResouce(SaveMI.Bitmap, 0, 2);
+ frxResources.LoadImageFromResouce(SaveAsMI.Bitmap, 0, 2);
+ frxResources.LoadImageFromResouce(PreviewB.Bitmap, 0, 3);
+ frxResources.LoadImageFromResouce(PreviewMI.Bitmap, 0, 3);
+ frxResources.LoadImageFromResouce(NewDialogB.Bitmap, 0, 4);
+ frxResources.LoadImageFromResouce(NewDialogMI1.Bitmap, 0, 4);
+ frxResources.LoadImageFromResouce(NewDialogMI.Bitmap, 0, 4);
+ frxResources.LoadImageFromResouce(NewPageB.Bitmap, 1, 0);
+ frxResources.LoadImageFromResouce(NewPageMI1.Bitmap, 1, 0);
+ frxResources.LoadImageFromResouce(NewPageMI.Bitmap, 1, 0);
+
+ frxResources.LoadImageFromResouce(DeletePageB.Bitmap, 1, 2);
+ frxResources.LoadImageFromResouce(DeletePageMI1.Bitmap, 1, 2);
+ frxResources.LoadImageFromResouce(DeletePageMI.Bitmap, 1, 2);
+
+ frxResources.LoadImageFromResouce(PageSettingsB.Bitmap, 1, 3);
+ frxResources.LoadImageFromResouce(PageSettingsMI.Bitmap, 1, 3);
+ frxResources.LoadImageFromResouce(PageSettingsMI1.Bitmap, 1, 3);
+ frxResources.LoadImageFromResouce(CutB.Bitmap, 0, 5);
+ frxResources.LoadImageFromResouce(CutMI.Bitmap, 0, 5);
+ frxResources.LoadImageFromResouce(CopyB.Bitmap, 0, 6);
+ frxResources.LoadImageFromResouce(CopyMI.Bitmap, 0, 6);
+ frxResources.LoadImageFromResouce(PasteB.Bitmap, 0, 7);
+ frxResources.LoadImageFromResouce(PasteMI.Bitmap, 0, 7);
+
+ frxResources.LoadImageFromResouce(UndoB.Bitmap, 0, 8);
+ frxResources.LoadImageFromResouce(UndoMI.Bitmap, 0, 8);
+ frxResources.LoadImageFromResouce(RedoB.Bitmap, 0, 9);
+ frxResources.LoadImageFromResouce(RedoMI.Bitmap, 0, 9);
+ frxResources.LoadImageFromResouce(GroupB.Bitmap, 1, 7);
+ frxResources.LoadImageFromResouce(GroupMI.Bitmap, 1, 7);
+ frxResources.LoadImageFromResouce(UngroupB.Bitmap, 1, 6);
+ frxResources.LoadImageFromResouce(UngroupMI.Bitmap, 1, 6);
+ frxResources.LoadImageFromResouce(ShowGridB.Bitmap, 12, 7);
+ frxResources.LoadImageFromResouce(AlignToGridB.Bitmap, 9, 8);
+ frxResources.LoadImageFromResouce(SetToGridB.Bitmap, 5, 7);
+ frxResources.LoadImageFromResouce(AlignLeftsB.Bitmap, 4, 1);
+ frxResources.LoadImageFromResouce(AlignHorzCentersB.Bitmap, 4, 7);
+ frxResources.LoadImageFromResouce(AlignRightsB.Bitmap, 4, 5);
+ frxResources.LoadImageFromResouce(AlignTopsB.Bitmap, 4, 6);
+ frxResources.LoadImageFromResouce(AlignVertCentersB.Bitmap, 4, 2);
+ frxResources.LoadImageFromResouce(AlignBottomsB.Bitmap, 5, 0);
+
+ frxResources.LoadImageFromResouce(SpaceHorzB.Bitmap, 4, 4);
+ frxResources.LoadImageFromResouce(SpaceVertB.Bitmap, 4, 9);
+ frxResources.LoadImageFromResouce(CenterHorzB.Bitmap, 4, 3);
+ frxResources.LoadImageFromResouce(CenterVertB.Bitmap, 4, 9);
+ frxResources.LoadImageFromResouce(SameWidthB.Bitmap, 8, 3);
+ frxResources.LoadImageFromResouce(SameHeightB.Bitmap, 8, 4);
+
+
+ frxResources.LoadImageFromResouce(BoldB.Bitmap, 2, 0);
+ frxResources.LoadImageFromResouce(ItalicB.Bitmap, 2, 1);
+ frxResources.LoadImageFromResouce(UnderlineB.Bitmap, 2, 2);
+ frxResources.LoadImageFromResouce(FontB.Bitmap, 5, 9);
+ frxResources.LoadImageFromResouce(FontColorB.Bitmap, 2, 3);
+ frxResources.LoadImageFromResouce(HighlightB.Bitmap, 2, 4);
+ frxResources.LoadImageFromResouce(RotateB.Bitmap, 6, 4);
+
+ frxResources.LoadImageFromResouce(TextAlignLeftB.Bitmap, 2, 5);
+ frxResources.LoadImageFromResouce(TextAlignCenterB.Bitmap, 2, 6);
+ frxResources.LoadImageFromResouce(TextAlignRightB.Bitmap, 2, 7);
+ frxResources.LoadImageFromResouce(TextAlignBlockB.Bitmap, 2, 8);
+
+ frxResources.LoadImageFromResouce(TextAlignTopB.Bitmap, 2, 9);
+ frxResources.LoadImageFromResouce(TextAlignMiddleB.Bitmap, 3, 0);
+ frxResources.LoadImageFromResouce(TextAlignBottomB.Bitmap, 3, 1);
+
+ frxResources.LoadImageFromResouce(FrameTopB.Bitmap, 3, 2);
+ frxResources.LoadImageFromResouce(FrameBottomB.Bitmap, 3, 3);
+ frxResources.LoadImageFromResouce(FrameRightB.Bitmap, 3, 5);
+ frxResources.LoadImageFromResouce(FrameLeftB.Bitmap, 3, 4);
+ frxResources.LoadImageFromResouce(FrameNoB.Bitmap, 3, 7);
+ frxResources.LoadImageFromResouce(FrameAllB.Bitmap, 3, 6);
+ frxResources.LoadImageFromResouce(ShadowB.Bitmap, 4, 0);
+ frxResources.LoadImageFromResouce(FillColorB.Bitmap, 3, 8);
+ frxResources.LoadImageFromResouce(FrameColorB.Bitmap, 3, 9);
+ frxResources.LoadImageFromResouce(FrameStyleB.Bitmap, 7, 1);
+
+ frxResources.LoadImageFromResouce(DeleteMI.Bitmap, 5, 1);
+ frxResources.LoadImageFromResouce(FindMI.Bitmap, 18, 1);
+
+ frxResources.LoadImageFromResouce(BringtoFrontMI.Bitmap, 1, 4);
+ frxResources.LoadImageFromResouce(SendtoBackMI.Bitmap, 1, 5);
+
+ frxResources.LoadImageFromResouce(ReportDataMI.Bitmap, 5, 3);
+ frxResources.LoadImageFromResouce(ReportSettingsMI.Bitmap, 4, 0);
+ frxResources.LoadImageFromResouce(ReportStylesMI.Bitmap, 8, 7);
+ frxResources.LoadImageFromResouce(VariablesMI.Bitmap, 11, 3);
+end;
+
+procedure TfrxDesignerForm.CreateLangMenu;
+//var
+// m, t: TMenuItem;
+// i: Integer;
+// reg: TRegistry;
+// current: String;
+begin
+// current := '';
+// reg := TRegistry.Create;
+// try
+// reg.RootKey := HKEY_CURRENT_USER;
+// if reg.OpenKey('\Software\Fast Reports\Resources', false) then
+// current := reg.ReadString('Language');
+// finally
+// reg.Free;
+// end;
+// if frxResources.Languages.Count > 0 then
+// begin
+// m := TMenuItem.Create(ViewMenu);
+// m.Caption := '-';
+// ViewMenu.Add(m);
+// m := TMenuItem.Create(ViewMenu);
+// m.Caption := frxGet(2475);
+// ViewMenu.Add(m);
+// for i := 0 to frxResources.Languages.Count - 1 do
+// begin
+// t := TMenuItem.Create(m);
+// t.Caption := frxResources.Languages[i];
+// t.RadioItem := True;
+// t.OnClick := LangSelectClick;
+// if UpperCase(t.Caption) = UpperCase(current) then
+// t.Checked := True;
+// m.Add(t);
+// end;
+// end;
+end;
+
+procedure TfrxDesignerForm.LangSelectClick(Sender: TObject);
+//var
+// m: TMenuItem;
+// reg: TRegistry;
+begin
+// m := Sender as TMenuItem;
+// m.Checked := True;
+// frxResources.LoadFromFile(GetAppPath + m.Caption + '.frc');
+// Localize;
+// reg := TRegistry.Create;
+// try
+// reg.RootKey := HKEY_CURRENT_USER;
+// if reg.OpenKey('\Software\Fast Reports\Resources', false) then
+// reg.WriteString('Language', m.Caption);
+// finally
+// reg.Free;
+// end;
+end;
+
+procedure TfrxDesignerForm.LeftDockTBResize(Sender: TObject);
+begin
+ if FInspector <> nil then
+ FInspector.DoResize;
+end;
+
+{procedure TfrxDesignerForm.OnCodeCompletion(const Name: String; List: TStrings);
+var
+ obj: TPersistent;
+ xd: TfsXMLDocument;
+ i, j: Integer;
+ sl, members: TStringList;
+ s: String;
+ clName: String;
+ clVar: TfsClassVariable;
+ clMethod: TfsCustomHelper;
+ cl: TClass;
+ l: TList;
+begin
+ members := TStringList.Create;
+ frxSetCommaText(Name, members, '.');
+ if members.Count = 0 then
+ begin
+ List.Clear;
+ l := Report.AllObjects;
+ for i := 0 to l.Count - 1 do
+ List.AddObject(TfrxComponent(l[i]).Name + ' : ' + TfrxComponent(l[i]).ClassName, nil);
+
+ members.Free;
+ Exit;
+ end;
+
+ for i := 0 to members.Count - 1 do
+ members[i] := Trim(members[i]);
+
+ if CompareText('Report', members[0]) = 0 then
+ obj := Report
+ else if CompareText('Engine', members[0]) = 0 then
+ obj := Report.Engine
+ else if CompareText('Outline', members[0]) = 0 then
+ obj := Report.PreviewPages.Outline
+ else
+ obj := Report.FindObject(members[0]);
+
+ clName := '';
+ if obj <> nil then
+ clName := obj.ClassName;
+
+ i := 1;
+ while (clName <> '') and (i < members.Count) do
+ begin
+ clVar := Report.Script.FindClass(clName);
+ clName := '';
+ if clVar <> nil then
+ begin
+ clMethod := clVar.Find(members[i]);
+ if clMethod <> nil then
+ clName := clMethod.TypeName;
+ Inc(i);
+ end;
+ end;
+
+ if clName <> '' then
+ begin
+ clVar := Report.Script.FindClass(clName);
+ if clVar <> nil then
+ begin
+ cl := Report.Script.FindClass(clName).ClassRef;
+
+ xd := TfsXMLDocument.Create;
+ GenerateMembers(Report.Script, cl, xd.Root);
+ sl := TStringList.Create;
+ sl.Sorted := True;
+ sl.Duplicates := dupIgnore;
+ for i := 0 to xd.Root.Count - 1 do
+ begin
+ s := xd.Root[i].Prop['text'];
+ j := 0;
+ if Pos('property', s) = 1 then
+ begin
+ Delete(s, 1, 9);
+ j := 1;
+ end;
+ if Pos('index property', s) = 1 then
+ begin
+ Delete(s, 1, 15);
+ j := 1;
+ end;
+ if Pos('procedure', s) = 1 then
+ begin
+ Delete(s, 1, 10);
+ j := 2;
+ end;
+ if Pos('function', s) = 1 then
+ begin
+ Delete(s, 1, 9);
+ j := 3;
+ end;
+
+ sl.AddObject(s, TObject(j));
+ end;
+ List.Assign(sl);
+ sl.Free;
+ xd.Free;
+ end;
+ end;
+end;
+}
+procedure TfrxDesignerForm.FormCreate(Sender: TObject);
+begin
+ FGridSize4 := fr01cm;
+ //FormShow(Sender);
+
+{$IFDEF RAD_ED}
+ VerticalbandsMI.Visible := False;
+ VerticalbandsMI.Enabled := False;
+{$ENDIF}
+ if frxDesignerComp <> nil then
+ begin
+ if (Length(frxDesignerComp.FTemplatesExt) > 1) and
+ (frxDesignerComp.FTemplatesExt[1] = '.') then
+ Delete(frxDesignerComp.FTemplatesExt, 1, 1);
+ FTemplateExt := frxDesignerComp.FTemplatesExt;
+ end
+ else
+ FTemplateExt := 'fr3'
+end;
+
+
+procedure TfrxDesignerForm.GetTemplateList(List: TStrings);
+var
+ sr: TSearchRec;
+ dir, DefExt: String;
+
+ function NormalDir(const DirName: string): string;
+ begin
+ Result := DirName;
+ if (Result <> '') and
+ not (CharInSet(Result[Length(Result)], [':', '\'])) then
+ begin
+ if (Length(Result) = 1) and (CharInSet(UpCase(Result[1]),['A'..'Z'])) then
+ Result := Result + ':\'
+ else Result := Result + '\';
+ end;
+ end;
+
+begin
+ List.Clear;
+ DefExt := FTemplateExt;
+
+ if (frxDesignerComp <> nil) and Assigned(frxDesignerComp.OnGetTemplateList) then
+ frxDesignerComp.OnGetTemplateList(List)
+ else
+ begin
+ dir := FTemplatePath;
+ if (Trim(dir) = '') or (Trim(dir) = '.') then
+ if csDesigning in ComponentState then
+ dir := GetCurrentDir
+ else
+ dir := ExtractFilePath(ParamStr(0));
+ dir := NormalDir(dir);
+ if FindFirst(dir + '*.' + DefExt, faAnyFile, sr) = 0 then
+ begin
+ repeat
+ List.Add(dir + sr.Name);
+ until FindNext(sr) <> 0;
+ FindClose(sr);
+ end;
+ end;
+end;
+
+
+procedure TfrxDesignerForm.SetGridSize1(const Value: Double);
+begin
+ if Value > 0 then
+ FGridSize1 := Value;
+end;
+
+procedure TfrxDesignerForm.SetGridSize2(const Value: Double);
+begin
+ if Value > 0 then
+ FGridSize2 := Value;
+end;
+
+procedure TfrxDesignerForm.SetGridSize3(const Value: Double);
+begin
+ if Value > 0 then
+ FGridSize3 := Value;
+end;
+
+procedure TfrxDesignerForm.SetGridSize4(const Value: Double);
+begin
+ if Value > 0 then
+ FGridSize4 := Value;
+end;
+
+procedure TfrxDesignerForm.FormMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
+begin
+ if ssCtrl in Shift then
+ begin
+ Scale := Scale + Round(WheelDelta / Abs(WheelDelta)) / 20;
+ if Scale < 0.3 then
+ Scale := 0.3;
+ ScaleCB.Text := frxFloatToStr(Round(Scale * 100)) + '%';
+ ScrollBox.SetFocus;
+ end;
+end;
+
+procedure TfrxDesignerForm.FormResize(Sender: TObject);
+begin
+ RightDockTBResize(Self);
+end;
+
+procedure TfrxDesignerForm.UpdateWatches;
+var
+ ErrCount: Integer;
+begin
+ ErrCount := Report.Errors.Count;
+ FWatchList.UpdateWatches;
+ ErrCount := Report.Errors.Count - ErrCount;
+ while (ErrCount <> 0) do
+ begin
+ Report.Errors.Delete(Report.Errors.Count - 1);
+ dec(ErrCount);
+ end;
+end;
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxDesigner, TFmxObject);
+ frxDesignerClass := TfrxDesignerForm;
+
+end.
diff --git a/LibD28x64/FMX.frxDesgn.res b/LibD28x64/FMX.frxDesgn.res
new file mode 100644
index 0000000..21ecd30
Binary files /dev/null and b/LibD28x64/FMX.frxDesgn.res differ
diff --git a/LibD28x64/FMX.frxDesgnCtrls.pas b/LibD28x64/FMX.frxDesgnCtrls.pas
new file mode 100644
index 0000000..17d22ad
--- /dev/null
+++ b/LibD28x64/FMX.frxDesgnCtrls.pas
@@ -0,0 +1,1298 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Designer controls }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDesgnCtrls;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.Types, System.UITypes, FMX.Objects, FMX.Types,
+ FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.Layouts, FMX.frxClass, FMX.frxPictureCache,
+ System.Variants, FMX.TabControl, System.UIConsts
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+ TfrxRulerUnits = (ruCM, ruInches, ruPixels, ruChars);
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxRuler = class(TPanel)
+ private
+ FOffset: Integer;
+ FScale: Double;
+ FStart: Integer;
+ FUnits: TfrxRulerUnits;
+ FPosition: Double;
+ FRulerSize: Integer;
+ FBitmap: TBitmap;
+ FNeedRedraw: Boolean;
+ FBackgroundColor: TAlphaColor;
+ procedure SetOffset(const Value: Integer);
+ procedure SetScale(const Value: Double);
+ procedure SetStart(const Value: Integer);
+ procedure SetUnits(const Value: TfrxRulerUnits);
+ procedure SetPosition(const Value: Double);
+ procedure SetRulerSize(const Value: Integer);
+ protected
+ procedure DoContentPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF); virtual;
+ procedure DrawRuler;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure ApplyStyle; override;
+ published
+ property Offset: Integer read FOffset write SetOffset;
+ property Scale: Double read FScale write SetScale;
+ property Start: Integer read FStart write SetStart;
+ property Units: TfrxRulerUnits read FUnits write SetUnits default ruPixels;
+ property RulePosition: Double read FPosition write SetPosition;
+ property RulerSize: Integer read FRulerSize write SetRulerSize;
+ end;
+
+ TfrxScrollBox = class(TScrollBox)
+ private
+ FContent: TContent;
+ FOnPositionChanged: TNotifyEvent;
+ protected
+ procedure ApplyStyle; override;
+ procedure DoContentPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF); virtual;
+ procedure DialogKey(var Key: Word; Shift: TShiftState); override;
+ procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
+ procedure KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
+{$IFDEF DELPHI18}
+ procedure HScrollChange; override;
+ procedure VScrollChange; override;
+{$ELSE}
+ procedure HScrollChange(Sender: TObject); override;
+ procedure VScrollChange(Sender: TObject); override;
+{$ENDIF}
+{$IFDEF DELPHI18}
+// public
+// property HScrollBar;
+// property VScrollBar;
+{$ENDIF}
+ published
+ property OnPositionChanged: TNotifyEvent read FOnPositionChanged write FOnPositionChanged;
+ end;
+
+ TfrxTabControl = class(TTabControl)
+ protected
+ procedure ApplyStyle; override;
+ end;
+
+ TfrxCustomSelector = class(TPopup)
+ protected
+ FMouseOver: Boolean;
+ FX, FY: Single;
+ procedure DrawEdge(X, Y: Single); virtual; abstract;
+ procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
+ procedure DoMouseEnter; override;
+ procedure DoMouseLeave; override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure Popup(AControl: TControl); reintroduce; overload;
+ end;
+
+ TfrxColorSelector = class(TfrxCustomSelector)
+ private
+ FColor: TColor;
+ FOnColorChanged: TNotifyEvent;
+ FBtnCaption: String;
+ protected
+ procedure DrawEdge(X, Y: Single); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Single); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure DoPaint; override;
+ property Color: TColor read FColor write FColor;
+ property OnColorChanged: TNotifyEvent read FOnColorChanged write FOnColorChanged;
+ property BtnCaption: String read FBtnCaption write FBtnCaption;
+ end;
+
+ TfrxLineSelector = class(TfrxCustomSelector)
+ private
+ FStyle: Byte;
+ FOnStyleChanged: TNotifyEvent;
+ protected
+ procedure DrawEdge(X, Y: Single); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Single); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure DoPaint; override;
+ property Style: Byte read FStyle;
+ property OnStyleChanged: TNotifyEvent read FOnStyleChanged write FOnStyleChanged;
+ end;
+
+ TfrxUndoBuffer = class(TObject)
+ private
+ FPictureCache: TfrxPictureCache;
+ FRedo: TList;
+ FUndo: TList;
+ function GetRedoCount: Integer;
+ function GetUndoCount: Integer;
+ procedure SetPictureFlag(ReportComponent: TfrxComponent; Flag: Boolean);
+ procedure SetPictures(ReportComponent: TfrxComponent);
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure AddUndo(ReportComponent: TfrxComponent);
+ procedure AddRedo(ReportComponent: TfrxComponent);
+ procedure GetUndo(ReportComponent: TfrxComponent);
+ procedure GetRedo(ReportComponent: TfrxComponent);
+ procedure ClearUndo;
+ procedure ClearRedo;
+ property UndoCount: Integer read GetUndoCount;
+ property RedoCount: Integer read GetRedoCount;
+ property PictureCache: TfrxPictureCache read FPictureCache write FPictureCache;
+ end;
+
+ TfrxClipboard = class(TObject)
+ private
+ FDesigner: TfrxCustomDesigner;
+ FPictureCache: TfrxPictureCache;
+ function GetPasteAvailable: Boolean;
+ public
+ constructor Create(ADesigner: TfrxCustomDesigner);
+ procedure Copy;
+ procedure Paste;
+ property PasteAvailable: Boolean read GetPasteAvailable;
+ property PictureCache: TfrxPictureCache read FPictureCache write FPictureCache;
+ end;
+
+implementation
+
+uses
+ System.Math, FMX.frxDMPClass, FMX.frxDsgnIntf, FMX.frxCtrls, FMX.frxXMLSerializer, FMX.Platform,
+ FMX.frxUtils, FMX.frxXML, FMX.frxFMX;
+
+const
+ Colors: array[0..47] of TAlphaColor =
+ (claNull, claWhite, claBlack, claMaroon, claGreen, claOlive, claNavy, claPurple,
+ claGray, claSilver, claTeal, claRed, claLime, claYellow, claBlue, claFuchsia,
+ $FFCCCCCC, $FFE4E4E4, claAqua, $FF00CCFF, $FF00CC98, $FF98FFFF, $FFFFCC00, $FFFF98CC,
+ $FFD8D8D8, $FFF0F0F0, $FFFFFFDC, $FFCAE4FF, $FFCCFFCC, $FFCCFFFF, $FFFFF4CC, $FFCC98FF,
+ claGray, $FF46DAFF, $FF9BEBFF, $FF00A47B, $FFFDBD97, $FFFED3BA, $FF6ACFFF, $FFFFF4CC,
+ claGray, claGray, claGray, claGray, claGray, claGray, claGray, claGray);
+
+
+
+{ TfrxRuler }
+
+procedure TfrxRuler.ApplyStyle;
+var
+ StyleObject: TFmxObject;
+begin
+ inherited;
+ StyleObject := GetStyleObject;
+ try
+ if StyleObject is TRectangle then
+ FBackgroundColor := TRectangle(StyleObject).Fill.Color
+ finally
+ StyleObject.Free;
+ end;
+end;
+
+constructor TfrxRuler.Create(AOwner: TComponent);
+begin
+ inherited;
+ FScale := 1;
+ OnPaint := DoContentPaint;
+ StyleLookup := 'backgroundstyle';
+ FBackgroundColor := $FFF5F5F5;
+ FBitmap := TBitmap.Create(1, 1);
+ FNeedRedraw := True;
+end;
+
+destructor TfrxRuler.Destroy;
+begin
+ FBitmap.Free;
+ inherited;
+end;
+
+procedure TfrxRuler.DoContentPaint(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF);
+var
+ SaveState: TCanvasSaveState;
+
+ procedure Line(x, y, dx, dy: Integer);
+ begin
+ Canvas.DrawLine(PointF(x + 0.5, y + 0.5), PointF(x + dx + 0.5, y + dy + 0.5), 1);
+ end;
+
+ procedure DrawLines;
+ var
+ i, dx: Single;
+ ofs: Integer;
+ begin
+ with Canvas do
+ begin
+ Stroke.Color := claBlack;
+ Stroke.Kind := TBrushKind.bkSolid;
+ Fill.Kind := TBrushKind.bkNone;
+
+ if FUnits = ruCM then
+ dx := fr01cm * FScale
+ else if FUnits = ruInches then
+ dx := fr01in * FScale
+ else if FUnits = ruChars then
+ begin
+ if Align = TAlignLayout.alLeft then
+ dx := fr1CharY * FScale / 10 else
+ dx := fr1CharX * FScale / 10
+ end
+ else
+ dx := FScale;
+
+ ofs := FOffset - FStart;
+ if FUnits = ruChars then
+ begin
+ if Align = TAlignLayout.alLeft then
+ Inc(ofs, Round(fr1CharY * FScale / 2)) else
+ Inc(ofs, Round(fr1CharX * FScale / 2))
+ end;
+ i := FPosition * dx;
+ if FUnits <> ruPixels then
+ i := i * 10;
+ if ofs + i >= FOffset then
+ if Align = TAlignLayout.alLeft then
+ Line(3, ofs + Round(i), 13, 0) else
+ Line(ofs + Round(i), 3, 0, 13);
+ end;
+ end;
+
+begin
+ if FNeedRedraw then
+ begin
+ FNeedRedraw := False;
+ DrawRuler;
+ end;
+
+ SaveState := Canvas.SaveState;
+ try
+ Canvas.IntersectClipRect(ARect);
+ Canvas.DrawBitmap(FBitmap, RectF(0, 0, FBitmap.Width, FBitmap.Height), ARect, 1);
+ DrawLines;
+ finally
+ Canvas.RestoreState(SaveState);
+ end;
+end;
+
+procedure TfrxRuler.DrawRuler;
+var
+ sz: Single;
+ SaveStateA, SaveStateB: TCanvasSaveState;
+ RMatrix, OldM: TMatrix;
+
+
+ procedure Line(x, y, dx, dy: Integer);
+ begin
+ FBitmap.Canvas.DrawLine(PointF(x + 0.5, y + 0.5), PointF(x + dx + 0.5, y + dy + 0.5), 1);
+ end;
+
+ procedure DrawLines;
+ var
+ i, dx, maxi, maxw, tx, ty: Single;
+ i1, h, w, w5, w10, ofs: Integer;
+ s: String;
+ begin
+ with FBitmap.Canvas do
+ begin
+ Stroke.Color := claBlack;
+ Stroke.Kind := TBrushKind.bkSolid;
+ Fill.Kind := TBrushKind.bkNone;
+ w5 := 5;
+ w10 := 10;
+ if FUnits = ruCM then
+ dx := fr01cm * FScale
+ else if FUnits = ruInches then
+ dx := fr01in * FScale
+ else if FUnits = ruChars then
+ begin
+ if Align = TAlignLayout.alLeft then
+ dx := fr1CharY * FScale / 10 else
+ dx := fr1CharX * FScale / 10
+ end
+ else
+ begin
+ dx := FScale;
+ w5 := 50;
+ w10 := 100;
+ end;
+
+ if FRulerSize = 0 then
+ begin
+ if Align = TAlignLayout.alLeft then
+ maxi := Height + FStart else
+ maxi := Self.Width + FStart;
+ end
+ else
+ maxi := FRulerSize;
+
+ if FUnits = ruPixels then
+ s := IntToStr(FStart + Round(maxi / dx)) else
+ s := IntToStr((FStart + Round(maxi / dx)) div 10);
+
+ maxw := TextWidth(s);
+ ofs := FOffset - FStart;
+ if FUnits = ruChars then
+ begin
+ if Align = TAlignLayout.alLeft then
+ Inc(ofs, Round(fr1CharY * FScale / 2)) else
+ Inc(ofs, Round(fr1CharX * FScale / 2))
+ end;
+
+ i := 0;
+ i1 := 0;
+ while i < maxi do
+ begin
+ h := 0;
+ if i1 = 0 then
+ h := 0
+ else if i1 mod w10 = 0 then
+ h := 6
+ else if i1 mod w5 = 0 then
+ h := 4
+ else if FUnits <> ruPixels then
+ h := 2;
+
+ if (h = 2) and (dx * w10 < 41) then
+ h := 0;
+ if (h = 4) and (dx * w10 < 21) then
+ h := 0;
+
+ w := 0;
+ if h = 6 then
+ begin
+ if maxw > dx * w10 * 1.5 then
+ w := w10 * 4
+ else if maxw > dx * w10 * 0.7 then
+ w := w10 * 2
+ else
+ w := w10;
+ end;
+
+ if FUnits = ruPixels then
+ s := IntToStr(i1) else
+ s := IntToStr(i1 div 10);
+ Fill.Color := claBlack;
+ Fill.Kind := TBrushKind.bkSolid;
+ if (w <> 0) and (i1 mod w = 0) and (ofs + i >= FOffset) then
+ begin
+ if Align = TAlignLayout.alLeft then
+ begin
+ tx := -(ofs + i - TextWidth(s) / 2 + 6);
+ ty := Self.Width - FBitmap.Canvas.TextHeight(s) - 8;
+ SaveStateB := SaveState;
+
+ SetMatrix(RMatrix);
+ end
+ else
+ begin
+ tx := ofs + Round(i) - TextWidth(s) / 2 + 1;
+ ty := 5;
+ end;
+
+ FillText(RectF(tx, ty, tx + 100, ty + 100), s, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ if Align = TAlignLayout.alLeft then
+ RestoreState(SaveStateB);
+ end
+ else if (h <> 0) and (ofs + i >= FOffset) then
+ if Align = TAlignLayout.alLeft then
+ Line(3 + (13 - h) div 2, ofs + Round(i), h, 0) else
+ Line(ofs + Round(i), 3 + (13 - h) div 2, 0, h);
+
+ i := i + dx;
+ Inc(i1);
+ end;
+ end;
+ end;
+
+begin
+ FBitmap.SetSize(Round(Self.Width), Round(Self.Height));
+ FBitmap.Canvas.BeginScene();
+ SaveStateA := FBitmap.Canvas.SaveState;
+ try
+ with FBitmap.Canvas do
+ begin
+ Fill.Kind := TBrushKind.bkSolid;
+ Fill.Color := FBackgroundColor;
+ FillRect(RectF(0, 0, FBitmap.Width, FBitmap.Height), 1, 1, AllCorners, 1);
+ Fill.Color := claWhite;
+
+ {$IFDEF LINUX}
+ Font.Family := 'Liberation Sans';
+ {$ELSE}
+ Font.Family := 'Arial';
+ {$ENDIF}
+ Font.Size := 8;
+ if Align = TAlignLayout.alLeft then
+ begin
+ if FRulerSize = 0 then
+ sz := Self.Height
+ else
+ sz := FRulerSize + FOffset;
+ FillRect(RectF(3, FOffset, Self.Width - 5, sz), 1, 1, AllCorners, 1);
+ RMatrix := CreateRotationMatrix(-DegToRad(90));
+ //RMatrix.m31 := Self.GetAbsoluteRect.Left;
+ //RMatrix.m32 := Self.GetAbsoluteRect.Top;
+ RMatrix := MatrixMultiply(RMatrix, Matrix);
+ OldM := Matrix;
+ end
+ else
+ begin
+ if FRulerSize = 0 then
+ sz := Self.Width
+ else
+ sz := FRulerSize + FOffset;
+ FillRect(RectF(FOffset, 3, sz, Self.Height - 5), 1, 1, AllCorners, 1);
+ end;
+ end;
+ DrawLines;
+ finally
+ FBitmap.Canvas.RestoreState(SaveStateA);
+ FBitmap.Canvas.EndScene;
+ end;
+end;
+
+procedure TfrxRuler.SetOffset(const Value: Integer);
+begin
+ FOffset := Value;
+ FNeedRedraw := True;
+ Repaint;
+end;
+
+procedure TfrxRuler.SetPosition(const Value: Double);
+begin
+ FPosition := Value;
+ Repaint;
+end;
+
+procedure TfrxRuler.SetScale(const Value: Double);
+begin
+ FScale := Value;
+ FNeedRedraw := True;
+ Repaint;
+end;
+
+procedure TfrxRuler.SetStart(const Value: Integer);
+begin
+ FStart := Value;
+ FNeedRedraw := True;
+ Repaint;
+end;
+
+procedure TfrxRuler.SetUnits(const Value: TfrxRulerUnits);
+begin
+ FUnits := Value;
+ FNeedRedraw := True;
+ Repaint;
+end;
+
+procedure TfrxRuler.SetRulerSize(const Value: Integer);
+begin
+ FRulerSize := Value;
+ FNeedRedraw := True;
+ Repaint;
+end;
+
+
+{ TfrxScrollBox }
+
+procedure TfrxScrollBox.ApplyStyle;
+var
+ B: TFmxObject;
+begin
+ inherited;
+ B := FindStyleResource('content');
+ if (B <> nil) and (B is TControl) then
+ begin
+ FContent := TContent(B);
+ FContent.OnPaint := DoContentPaint;
+ end;
+end;
+
+procedure TfrxScrollBox.DialogKey(var Key: Word; Shift: TShiftState);
+begin
+ inherited;
+end;
+
+procedure TfrxScrollBox.DoContentPaint(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF);
+begin
+ Canvas.Fill.Kind := TBrushKind.bkSolid;
+ Canvas.Fill.Color := $FFE0E0E0;
+ Canvas.FillRect(ARect, 1, 1, AllCorners, 1, TCornerType.ctBevel);
+end;
+
+procedure TfrxScrollBox.KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+//var
+// i: Integer;
+begin
+ inherited;
+ {for i := 0 to ControlCount - 1 do
+ if Controls[i] is TWinControl then
+ THackControl(Controls[i]).KeyDown(Key, Shift);}
+end;
+
+//procedure TfrxScrollBox.KeyPress(var Key: Char);
+//var
+// i: Integer;
+//begin
+// inherited;
+// for i := 0 to ControlCount - 1 do
+// if Controls[i] is TWinControl then
+// THackControl(Controls[i]).KeyPress(Key);
+//end;
+
+procedure TfrxScrollBox.KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+//var
+// i: Integer;
+begin
+ inherited;
+ {for i := 0 to ControlCount - 1 do
+ if Controls[i] is TWinControl then
+ THackControl(Controls[i]).KeyUp(Key, Shift);}
+end;
+
+{$IFDEF DELPHI18}
+procedure TfrxScrollBox.HScrollChange;
+{$ELSE}
+procedure TfrxScrollBox.HScrollChange(Sender: TObject);
+{$ENDIF}
+begin
+ inherited;
+ if Assigned(FOnPositionChanged) then
+ FOnPositionChanged(Self);
+end;
+
+{$IFDEF DELPHI18}
+procedure TfrxScrollBox.VScrollChange;
+{$ELSE}
+procedure TfrxScrollBox.VScrollChange(Sender: TObject);
+{$ENDIF}
+begin
+ inherited;
+ if Assigned(FOnPositionChanged) then
+ FOnPositionChanged(Self);
+end;
+
+
+
+{ TfrxCustomSelector }
+
+constructor TfrxCustomSelector.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ StyleLookup := 'panelstyle';
+end;
+
+procedure TfrxCustomSelector.Popup(AControl: TControl);
+begin
+ Tag := AControl.Tag;
+ PlacementTarget := AControl;
+ Popup;
+end;
+
+procedure TfrxCustomSelector.DoMouseEnter;
+begin
+ FMouseOver := True;
+ Repaint;
+end;
+
+procedure TfrxCustomSelector.DoMouseLeave;
+begin
+ FMouseOver := False;
+ Repaint;
+end;
+
+procedure TfrxCustomSelector.MouseMove(Shift: TShiftState; X, Y: Single);
+begin
+ inherited;
+ FX := X;
+ FY := Y;
+ Repaint;
+end;
+
+
+
+{ TfrxColorSelector }
+
+constructor TfrxColorSelector.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ Width := 155;
+ Height := 143;
+ FBtnCaption := 'Other...';
+end;
+
+procedure TfrxColorSelector.DrawEdge(X, Y: Single);
+var
+ r: TRectF;
+begin
+ X := Trunc((X - 5) / 18);
+ if X >= 8 then
+ X := 7;
+ Y := Trunc((Y - 5) / 18);
+
+ if Y < 6 then
+ r := RectF(X * 18 + 5.5, Y * 18 + 5.5, X * 18 + 23.5, Y * 18 + 23.5) else
+ r := RectF(5.5, 113.5, Width - 5.5, Height - 5.5);
+
+ with Canvas do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := $FFC56A31;
+
+ DrawRect(r, 0, 0, AllCorners, 1);
+ InflateRect(r, -1, -1);
+ Stroke.Color := $FFE8E6E2;
+
+ DrawRect(r, 0, 0, AllCorners, 1);
+ InflateRect(r, -1, -1);
+
+ DrawRect(r, 0, 0, AllCorners, 1);
+ end;
+end;
+
+procedure TfrxColorSelector.MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Single);
+//var
+ //cd: TColorDialog;
+
+ procedure AddCustomColor;
+ var
+ i: Integer;
+ Found: Boolean;
+ Empty: Integer;
+ begin
+ Found := False;
+ Empty := 0;
+ for i := 0 to 47 do
+ begin
+ if Colors[i] = Cardinal(FColor) then
+ Found := True;
+ if (i > 37) and (Colors[i] = claGray) and (Empty = 0) then
+ Empty := i;
+ end;
+
+ if Found then exit;
+
+ if Empty = 0 then
+ begin
+ for i := 40 to 46 do
+ Colors[i] := Colors[i + 1];
+ Empty := 47;
+ end;
+ Colors[Empty] := FColor
+ end;
+
+begin
+ X := Trunc((X - 5) / 18);
+ if X >= 8 then
+ X := 7;
+ Y := Trunc((Y - 5) / 18);
+
+ if Y < 6 then
+ FColor := Colors[Round(X + Y * 8)]
+ else
+ begin
+ //TForm(Parent).AutoSize := False;
+ //Parent.Height := 0;
+ //cd := TColorDialog.Create(Self);
+ //cd.Options := [cdFullOpen];
+ //cd.Color := FColor;
+ //if cd.Execute then
+ // FColor := cd.Color else
+ // Exit;
+ // todo color selector form
+ AddCustomColor;
+ end;
+
+ ClosePopup;
+ if Assigned(FOnColorChanged) then
+ FOnColorChanged(Self);
+end;
+
+procedure TfrxColorSelector.DoPaint;
+var
+ i, j: Integer;
+ s: String;
+ r: TRectF;
+begin
+ inherited;
+
+ with Canvas do
+ begin
+ Fill.Kind := TBrushKind.bkSolid;
+ Stroke.Kind := TBrushKind.bkSolid;
+ for j := 0 to 5 do
+ for i := 0 to 7 do
+ begin
+ if (i = 0) and (j = 0) then
+ Fill.Color := claWhite else
+ Fill.Color := Colors[i + j * 8];
+ Stroke.Color := claGray;
+ r := RectF(i * 18 + 8.5, j * 18 + 8.5, i * 18 + 20.5, j * 18 + 20.5);
+ FillRect(r, 0, 0, AllCorners, 1);
+ DrawRect(r, 0, 0, AllCorners, 1);
+ if (i = 0) and (j = 0) then
+ begin
+ DrawLine(PointF(i * 18 + 10.5, j * 18 + 10.5), PointF(i * 18 + 18.5, j * 18 + 18.5), 1);
+ DrawLine(PointF(i * 18 + 18.5, j * 18 + 10.5), PointF(i * 18 + 10.5, j * 18 + 18.5), 1);
+ end;
+ end;
+
+ Stroke.Color := claGray;
+ Fill.Color := claGray;
+ s := FBtnCaption;
+
+{$IFDEF LINUX}
+ DrawRect(RectF(8.5, 116.5, Width - 20, Height - 20), 0, 0, AllCorners, 1);
+ FillText(RectF(8.5, 116.5, Width - 20, Height - 20), s, False, 1, [], TTextAlign.taCenter, TTextAlign.taCenter)
+{$ELSE}
+ DrawRect(RectF(8.5, 116.5, Width - 8.5, Height - 8.5), 0, 0, AllCorners, 1);
+ FillText(RectF(10, 116, Width - 10, Height - 8), s, False, 1, [], TTextAlign.taCenter, TTextAlign.taCenter)
+{$ENDIF}
+ end;
+
+ if FMouseOver then
+ DrawEdge(FX, FY);
+end;
+
+
+{ TfrxLineSelector }
+
+constructor TfrxLineSelector.Create(AOwner: TComponent);
+begin
+ inherited;
+ Width := 98;
+ Height := 106;
+end;
+
+procedure TfrxLineSelector.DrawEdge(X, Y: Single);
+var
+ r: TRectF;
+begin
+ Y := Trunc((Y - 5) / 16);
+ if Y > 5 then
+ Y := 5;
+
+ r := RectF(5.5, Y * 16 + 5.5, Width - 6.5, Y * 16 + 19.5);
+ with Canvas do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := claGray;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ DrawRect(r, 0, 0, AllCorners, 1);
+ end;
+end;
+
+procedure TfrxLineSelector.MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Single);
+begin
+ Y := Trunc((Y - 5) / 16);
+ if Y > 5 then
+ Y := 5;
+
+ FStyle := Round(Y);
+
+ ClosePopup;
+ if Assigned(FOnStyleChanged) then
+ FOnStyleChanged(Self);
+end;
+
+procedure TfrxLineSelector.DoPaint;
+var
+ i: Integer;
+
+ procedure DrawLine(Y, Style: Integer);
+ begin
+ if Style = 5 then
+ begin
+ Style := 0;
+ DrawLine(Y - 2, Style);
+ Inc(Y, 2);
+ end;
+
+ with Canvas do
+ begin
+ Stroke.Color := claBlack;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 2;
+ Stroke.Dash := TStrokeDash(Style);
+{$ELSE}
+ StrokeDash := TStrokeDash(Style);
+ StrokeThickness := 2;
+{$ENDIF}
+ DrawLine(PointF(7, Y), PointF(Self.Width - 8, Y), 1);
+ end;
+ end;
+
+begin
+ inherited;
+ for i := 0 to 5 do
+ DrawLine(12 + i * 16, i);
+ if FMouseOver then
+ DrawEdge(FX, FY);
+end;
+
+
+{ TfrxUndoBuffer }
+
+constructor TfrxUndoBuffer.Create;
+begin
+ FRedo := TList.Create;
+ FUndo := TList.Create;
+end;
+
+destructor TfrxUndoBuffer.Destroy;
+begin
+ ClearUndo;
+ ClearRedo;
+ FUndo.Free;
+ FRedo.Free;
+ inherited;
+end;
+
+procedure TfrxUndoBuffer.AddUndo(ReportComponent: TfrxComponent);
+var
+ m: TMemoryStream;
+begin
+ m := TMemoryStream.Create;
+ FUndo.Add(m);
+ SetPictureFlag(ReportComponent, False);
+ try
+ ReportComponent.SaveToStream(m);
+ finally
+ SetPictureFlag(ReportComponent, True);
+ end;
+end;
+
+procedure TfrxUndoBuffer.AddRedo(ReportComponent: TfrxComponent);
+var
+ m: TMemoryStream;
+begin
+ m := TMemoryStream.Create;
+ FRedo.Add(m);
+ SetPictureFlag(ReportComponent, False);
+ try
+ ReportComponent.SaveToStream(m);
+ finally
+ SetPictureFlag(ReportComponent, True);
+ end;
+end;
+
+procedure TfrxUndoBuffer.GetUndo(ReportComponent: TfrxComponent);
+var
+ m: TMemoryStream;
+ IsReport: Boolean;
+begin
+ IsReport := False;
+ if ReportComponent is TfrxReport then
+ isReport := True;
+ m := FUndo[FUndo.Count - 2];
+ m.Position := 0;
+ if IsReport then
+ TfrxReport(ReportComponent).Reloading := True;
+ try
+ ReportComponent.LoadFromStream(m);
+ finally
+ if IsReport then
+ TfrxReport(ReportComponent).Reloading := False;
+ end;
+ SetPictures(ReportComponent);
+
+ m := FUndo[FUndo.Count - 1];
+ m.Free;
+ FUndo.Delete(FUndo.Count - 1);
+end;
+
+procedure TfrxUndoBuffer.GetRedo(ReportComponent: TfrxComponent);
+var
+ m: TMemoryStream;
+ IsReport: Boolean;
+begin
+ IsReport := False;
+ if ReportComponent is TfrxReport then
+ isReport := True;
+ m := FRedo[FRedo.Count - 1];
+ m.Position := 0;
+ if IsReport then
+ TfrxReport(ReportComponent).Reloading := True;
+ try
+ ReportComponent.LoadFromStream(m);
+ finally
+ if IsReport then
+ TfrxReport(ReportComponent).Reloading := False;
+ end;
+ SetPictures(ReportComponent);
+
+ m.Free;
+ FRedo.Delete(FRedo.Count - 1);
+end;
+
+procedure TfrxUndoBuffer.ClearUndo;
+begin
+ while FUndo.Count > 0 do
+ begin
+ TMemoryStream(FUndo[0]).Free;
+ FUndo.Delete(0);
+ end;
+end;
+
+procedure TfrxUndoBuffer.ClearRedo;
+begin
+ while FRedo.Count > 0 do
+ begin
+ TMemoryStream(FRedo[0]).Free;
+ FRedo.Delete(0);
+ end;
+end;
+
+function TfrxUndoBuffer.GetRedoCount: Integer;
+begin
+ Result := FRedo.Count;
+end;
+
+function TfrxUndoBuffer.GetUndoCount: Integer;
+begin
+ Result := FUndo.Count;
+end;
+
+procedure TfrxUndoBuffer.SetPictureFlag(ReportComponent: TfrxComponent; Flag: Boolean);
+var
+ i: Integer;
+ l: TList;
+ c: TfrxComponent;
+begin
+ l := ReportComponent.AllObjects;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if c is TfrxPictureView then
+ begin
+ TfrxPictureView(c).IsPictureStored := Flag;
+ TfrxPictureView(c).IsImageIndexStored := not Flag;
+ end;
+ end;
+end;
+
+procedure TfrxUndoBuffer.SetPictures(ReportComponent: TfrxComponent);
+var
+ i: Integer;
+ l: TList;
+ c: TfrxComponent;
+begin
+ l := ReportComponent.AllObjects;
+ for i := 0 to l.Count - 1 do
+ begin
+ c := l[i];
+ if c is TfrxPictureView then
+ FPictureCache.GetPicture(TfrxPictureView(c));
+ end;
+end;
+
+
+{ TfrxClipboard }
+
+constructor TfrxClipboard.Create(ADesigner: TfrxCustomDesigner);
+begin
+ FDesigner := ADesigner;
+end;
+
+procedure TfrxClipboard.Copy;
+var
+ c, c1: TfrxComponent;
+ i, j: Integer;
+ text: String;
+ minX, minY: Extended;
+ List: TList;
+ Flag: Boolean;
+
+ procedure Write(c: TfrxComponent);
+ var
+ c1: TfrxComponent;
+ Writer: TfrxXMLSerializer;
+ begin
+ c1 := TfrxComponent(c.NewInstance);
+ c1.Create(FDesigner.Page);
+
+ if c is TfrxPictureView then
+ begin
+ TfrxPictureView(c).IsPictureStored := False;
+ TfrxPictureView(c).IsImageIndexStored := True;
+ end;
+
+ try
+ c1.Assign(c);
+ finally
+ if c is TfrxPictureView then
+ begin
+ TfrxPictureView(c).IsPictureStored := True;
+ TfrxPictureView(c).IsImageIndexStored := False;
+ TfrxPictureView(c1).IsImageIndexStored := True;
+ end;
+ end;
+
+ c1.Left := c1.Left - minX;
+ c1.Top := c.AbsTop - minY;
+
+ Writer := TfrxXMLSerializer.Create(nil);
+ Writer.Owner := c1.Report;
+ text := text + '<' + c1.ClassName + ' Name="' + c.Name + '"' + Writer.ObjToXML(c1) + '/>';
+ Writer.Free;
+
+ c1.Free;
+ end;
+
+begin
+ text := '#FR3 clipboard#' + #10#13;
+
+ minX := 100000;
+ minY := 100000;
+ for i := 0 to FDesigner.SelectedObjects.Count - 1 do
+ begin
+ c := FDesigner.SelectedObjects[i];
+ if c.AbsLeft < minX then
+ minX := c.AbsLeft;
+ if c.AbsTop < minY then
+ minY := c.AbsTop;
+ end;
+
+ List := FDesigner.Page.AllObjects;
+ for i := 0 to List.Count - 1 do
+ begin
+ c := List[i];
+ if FDesigner.SelectedObjects.IndexOf(c) <> -1 then
+ begin
+ Write(c);
+ if c is TfrxBand then
+ begin
+ Flag := False;
+ for j := 0 to c.Objects.Count - 1 do
+ begin
+ c1 := c.Objects[j];
+ if FDesigner.SelectedObjects.IndexOf(c1) <> -1 then
+ Flag := True;
+ end;
+
+ if not Flag then
+ for j := 0 to c.Objects.Count - 1 do
+ Write(c.Objects[j]);
+ end;
+ end;
+ end;
+
+ SetClipboard(text);
+end;
+
+function TfrxClipboard.GetPasteAvailable: Boolean;
+var
+ cb: Variant;
+begin
+ Result := False;
+ try
+ cb := GetClipboard;
+ if cb <> null then
+ Result := (Pos('#FR3 clipboard#', cb) = 1);
+ except
+ Result := False;
+ end;
+end;
+
+procedure TfrxClipboard.Paste;
+var
+ c: TfrxComponent;
+ sl: TStrings;
+ s: TStream;
+ List: TList;
+ NewCompName: string;
+ NewComp: TfrxComponent;
+
+ function ReadComponent_(AReader: TfrxXMLSerializer; Root: TfrxComponent): TfrxComponent;
+ var
+ rd: TfrxXMLReader;
+ RootItem: TfrxXMLItem;
+ begin
+ rd := TfrxXMLReader.Create(AReader.Stream);
+ RootItem := TfrxXMLItem.Create;
+
+ try
+ rd.ReadRootItem(RootItem, False);
+ Result := AReader.ReadComponentStr(Root, RootItem.Name + ' ' + RootItem.Text);
+
+ NewCompName := RootItem.Prop['Name'];
+ finally
+ rd.Free;
+ RootItem.Free;
+ end;
+ end;
+
+ function ReadComponent: TfrxComponent;
+ var
+ Reader: TfrxXMLSerializer;
+ begin
+ Reader := TfrxXMLSerializer.Create(s);
+ Result := ReadComponent_(Reader, FDesigner.Report);
+ Reader.Free;
+ end;
+
+ function FindBand(Band: TfrxComponent): Boolean;
+ var
+ i: Integer;
+ begin
+ Result := False;
+ for i := 0 to FDesigner.Page.Objects.Count - 1 do
+ if (FDesigner.Page.Objects[i] <> Band) and
+ (TObject(FDesigner.Page.Objects[i]) is Band.ClassType) then
+ Result := True;
+ end;
+
+ function CanInsert(c: TfrxComponent): Boolean;
+ begin
+ Result := True;
+ if (c is TfrxDialogControl) and (FDesigner.Page is TfrxReportPage) then
+ Result := False;
+ if not (c is TfrxDialogComponent) and not (c is TfrxDialogControl) and
+ (FDesigner.Page is TfrxDialogPage) then
+ Result := False;
+ if ((c is TfrxDMPMemoView) or (c is TfrxDMPLineView) or (c is TfrxDMPCommand)) and
+ not (FDesigner.Page is TfrxDMPPage) then
+ Result := False;
+ if not ((c is TfrxBand) or (c is TfrxDMPMemoView) or (c is TfrxDMPLineView) or
+ (c is TfrxDMPCommand)) and (FDesigner.Page is TfrxDMPPage) then
+ Result := False;
+ if not ((c is TfrxCustomLineView) or (c is TfrxCustomMemoView) or
+ (c is TfrxShapeView) or (c is TfrxDialogComponent)) and
+ (FDesigner.Page is TfrxDataPage) then
+ Result := False;
+ end;
+
+ procedure FindParent(c: TfrxComponent);
+ var
+ i: Integer;
+ Found: Boolean;
+ c1: TfrxComponent;
+ begin
+ Found := False;
+ if not (c is TfrxBand) then
+ for i := List.Count - 1 downto 0 do
+ begin
+ c1 := List[i];
+ if c1 is TfrxBand then
+ if (c.Top >= c1.Top) and (c.Top < c1.Top + c1.Height) then
+ begin
+ c.Parent := c1;
+ c.Top := c.Top - c1.Top;
+ Found := True;
+ break;
+ end;
+ end;
+ if not Found then
+ c.Parent := FDesigner.Page;
+ end;
+
+begin
+ FDesigner.SelectedObjects.Clear;
+
+ sl := TStringList.Create;
+ sl.Text := GetClipboard;
+ sl.Delete(0);
+
+ s := TMemoryStream.Create;
+ sl.SaveToStream(s, TEncoding.UTF8);
+ sl.Free;
+ s.Position := 0;
+
+ List := TList.Create;
+
+ while s.Position < s.Size do
+ begin
+ c := ReadComponent;
+ if c = nil then break;
+
+ if (((c is TfrxReportTitle) or (c is TfrxReportSummary) or
+ (c is TfrxPageHeader) or (c is TfrxPageFooter) or
+ (c is TfrxColumnHeader) or (c is TfrxColumnFooter)) and FindBand(c)) or
+ not CanInsert(c) then
+ c.Free
+ else
+ begin
+ if c is TfrxPictureView then
+ FPictureCache.GetPicture(TfrxPictureView(c));
+ List.Add(c);
+ FindParent(c);
+ if FDesigner.IsPreviewDesigner then
+ NewComp := FDesigner.Report.FindObject(NewCompName) as TfrxComponent
+ else
+ NewComp := FDesigner.Report.FindComponent(NewCompName) as TfrxComponent;
+ if ((NewComp <> nil) and (NewComp <> c)) or (NewCompName = '') then
+ c.CreateUniqueName
+ else
+ c.Name := NewCompName;
+ c.GroupIndex := 0;
+ FDesigner.Objects.Add(c);
+ if c.Parent = FDesigner.Page then
+ FDesigner.SelectedObjects.Add(c);
+ c.OnPaste;
+ end;
+ end;
+
+ if FDesigner.SelectedObjects.Count = 0 then
+ FDesigner.SelectedObjects.Add(FDesigner.Page);
+
+ List.Free;
+ s.Free;
+end;
+
+
+{ TfrxTabControl }
+
+procedure TfrxTabControl.ApplyStyle;
+var
+ B: TFmxObject;
+begin
+ inherited;
+ B := FindStyleResource('rectangle');
+ if (B <> nil) and (B is TRectangle) then
+ TRectangle(B).Sides := [];
+end;
+
+
+initialization
+ StartClassGroup(TFmxObject);
+ ActivateClassGroup(TFmxObject);
+ GroupDescendentsWith(TfrxRuler, TFmxObject);
+ GroupDescendentsWith(TfrxScrollBox, TFmxObject);
+ RegisterFmxClasses([TfrxRuler, TfrxScrollBox]);
+
+end.
diff --git a/LibD28x64/FMX.frxDesgnEditors.pas b/LibD28x64/FMX.frxDesgnEditors.pas
new file mode 100644
index 0000000..d948139
--- /dev/null
+++ b/LibD28x64/FMX.frxDesgnEditors.pas
@@ -0,0 +1,1557 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Property editors for Designer }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDesgnEditors;
+
+interface
+
+{$I frx.inc}
+
+implementation
+
+uses
+ System.Classes, System.SysUtils, System.UITypes, System.Types, System.UIConsts,
+ FMX.Types, FMX.Objects, FMX.Controls, FMX.Forms, FMX.Menus,
+ FMX.Dialogs, FMX.frxClass, FMX.frxDMPClass, FMX.frxDesgn, FMX.frxDsgnIntf, FMX.frxUtils,
+ FMX.frxCtrls, FMX.frxCustomEditors, FMX.frxEditPage, FMX.frxEditMemo,
+ FMX.frxEditDataBand, FMX.frxEditStrings, FMX.frxEditFormat, FMX.frxEditGroup, FMX.frxEditSysMemo,
+ FMX.frxCodeUtils, FMX.frxEditPicture, FMX.frxEditFrame, FMX.frxRes,
+ FMX.frxUnicodeUtils, FMX.frxPrinter, System.Variants, System.WideStrings, FMX.ListBox
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+
+type
+ { Component editors }
+
+ TfrxPageEditor = class(TfrxComponentEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ end;
+
+ TfrxMemoEditor = class(TfrxCustomMemoEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ end;
+
+ TfrxSysMemoEditor = class(TfrxCustomMemoEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ end;
+
+ TfrxLineEditor = class(TfrxViewEditor)
+ public
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxPictureEditor = class(TfrxViewEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxBandEditor = class(TfrxComponentEditor)
+ public
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxDataBandEditor = class(TfrxBandEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxHeaderEditor = class(TfrxBandEditor)
+ public
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxPageHeaderEditor = class(TfrxBandEditor)
+ public
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxPageFooterEditor = class(TfrxComponentEditor)
+ public
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxGroupHeaderEditor = class(TfrxBandEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxColumnHeaderEditor = class(TfrxBandEditor)
+ public
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxColumnFooterEditor = class(TfrxBandEditor)
+ public
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ TfrxOverlayEditor = class(TfrxBandEditor)
+ public
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+
+ TfrxDialogControlEditor = class(TfrxComponentEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ end;
+
+ TfrxSubreportEditor = class(TfrxComponentEditor)
+ public
+ function Edit: Boolean; override;
+ function HasEditor: Boolean; override;
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); override;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; override;
+ end;
+
+ { Property editors }
+
+ TfrxMemoProperty = class(TfrxClassProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+ TfrxFrameProperty = class(TfrxClassProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+ TfrxPictureProperty = class(TfrxClassProperty)
+ public
+ function GetValue: String; override;
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+ TfrxBitmapProperty = class(TfrxClassProperty)
+ public
+ function GetValue: String; override;
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+ TfrxDataSetProperty = class(TfrxPropertyEditor)
+ public
+ function GetValue: String; override;
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxDataFieldProperty = class(TfrxPropertyEditor)
+ public
+ function GetValue: String; override;
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxEventProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ procedure GetValues; override;
+ end;
+
+ TfrxLocSizeXProperty = class(TfrxFloatProperty)
+ protected
+ FRatio: Extended;
+ public
+ constructor Create(Designer: TfrxCustomDesigner); override;
+ function GetValue: String; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxLocSizeYProperty = class(TfrxLocSizeXProperty)
+ public
+ constructor Create(Designer: TfrxCustomDesigner); override;
+ end;
+
+ TfrxPaperXProperty = class(TfrxFloatProperty)
+ protected
+ FRatio: Extended;
+ public
+ constructor Create(Designer: TfrxCustomDesigner); override;
+ function GetValue: String; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxPaperYProperty = class(TfrxPaperXProperty)
+ public
+ constructor Create(Designer: TfrxCustomDesigner); override;
+ end;
+
+ TfrxStringsProperty = class(TfrxClassProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+ TfrxBrushProperty = class(TfrxEnumProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure OnDrawLBItem(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF); override;
+ procedure OnDrawItem(Canvas: TCanvas; ARect: TRectF); override;
+ end;
+
+ TfrxFrameStyleProperty = class(TfrxEnumProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function GetExtraLBSize: Integer; override;
+ procedure OnDrawLBItem(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF); override;
+ procedure OnDrawItem(Canvas: TCanvas; ARect: TRectF); override;
+ end;
+
+ TfrxDisplayFormatProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function Edit: Boolean; override;
+ end;
+
+ TfrxBooleanProperty = class(TfrxEnumProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure OnDrawLBItem(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF); override;
+ procedure OnDrawItem(Canvas: TCanvas; ARect: TRectF); override;
+ end;
+
+ TfrxPrinterProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ end;
+
+ TfrxPaperProperty = class(TfrxIntegerProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ function GetValue: String; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxStyleProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ end;
+
+
+
+{ TfrxPageEditor }
+
+function TfrxPageEditor.Edit: Boolean;
+begin
+ Result := False;
+ if (Component is TfrxReportPage) and
+ (TfrxReportPage(Component).Subreport = nil) then
+ with TfrxPageEditorForm.Create(Designer) do
+ begin
+ Result := ShowModal = mrOk;
+ Free;
+ end;
+end;
+
+function TfrxPageEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+
+{ TfrxMemoEditor }
+
+function TfrxMemoEditor.Edit: Boolean;
+begin
+ with TfrxMemoEditorForm.Create(Designer) do
+ begin
+ MemoView := TfrxMemoView(Component);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ begin
+ MemoView.Text := Text;
+ MemoView.DataField := '';
+ end;
+ Free;
+ end;
+end;
+
+function TfrxMemoEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+
+{ TfrxSysMemoEditor }
+
+function TfrxSysMemoEditor.Edit: Boolean;
+begin
+ with TfrxSysMemoEditorForm.Create(Designer) do
+ begin
+ Text := TfrxSysMemoView(Component).Text;
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ TfrxSysMemoView(Component).Text := Text;
+ Free;
+ end;
+end;
+
+function TfrxSysMemoEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+
+{ TfrxLineEditor }
+
+function TfrxLineEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ i: Integer;
+ c: TfrxComponent;
+ l: TfrxCustomLineView;
+begin
+ Result := inherited Execute(Tag, Checked);
+
+ for i := 0 to Designer.SelectedObjects.Count - 1 do
+ begin
+ c := Designer.SelectedObjects[i];
+ if (c is TfrxCustomLineView) and not (rfDontModify in c.Restrictions) then
+ begin
+ l := TfrxCustomLineView(c);
+ case Tag of
+ 0: l.Diagonal := Checked;
+ 1: if Checked then
+ l.StretchMode := smMaxHeight else
+ l.StretchMode := smDontStretch;
+ end;
+
+ Result := True;
+ end;
+ end;
+end;
+
+procedure TfrxLineEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ l: TfrxCustomLineView;
+begin
+ inherited;
+ l := TfrxCustomLineView(Component);
+
+ if l is TfrxLineView then
+ AddItem(frxResources.Get('lvDiagonal'), 0, l.Diagonal);
+ AddItem(frxResources.Get('mvStretch'), 1, l.StretchMode = smMaxHeight);
+
+ inherited;
+end;
+
+
+{ TfrxPictureEditor }
+
+function TfrxPictureEditor.Edit: Boolean;
+begin
+ with TfrxPictureEditorForm.Create(Designer) do
+ begin
+ Image.Bitmap.Assign(TfrxPictureView(Component).Picture);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ begin
+ TfrxPictureView(Component).Picture.Assign(Image.Bitmap);
+ TfrxDesignerForm(Self.Designer).PictureCache.AddPicture(TfrxPictureView(Component));
+ end;
+ Free;
+ end;
+end;
+
+function TfrxPictureEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+function TfrxPictureEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ i: Integer;
+ c: TfrxComponent;
+ p: TfrxPictureView;
+begin
+ Result := inherited Execute(Tag, Checked);
+
+ for i := 0 to Designer.SelectedObjects.Count - 1 do
+ begin
+ c := Designer.SelectedObjects[i];
+ if (c is TfrxPictureView) and not (rfDontModify in c.Restrictions) then
+ begin
+ p := TfrxPictureView(c);
+ case Tag of
+ 0: p.AutoSize := Checked;
+ 1: p.Stretched := Checked;
+ 2: p.Center := Checked;
+ 3: p.KeepAspectRatio := Checked;
+ end;
+
+ Result := True;
+ end;
+ end;
+end;
+
+procedure TfrxPictureEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ p: TfrxPictureView;
+begin
+ inherited;
+ p := TfrxPictureView(Component);
+
+ AddItem(frxResources.Get('pvAutoSize'), 0, p.AutoSize);
+ AddItem(frxResources.Get('mvStretch'), 1, p.Stretched);
+ AddItem(frxResources.Get('pvCenter'), 2, p.Center);
+ AddItem(frxResources.Get('pvAspect'), 3, p.KeepAspectRatio);
+ AddItem('-', -1);
+
+ inherited;
+end;
+
+
+{ TfrxBandEditor }
+
+function TfrxBandEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ b: TfrxBand;
+begin
+ Result := False;
+
+ b := Designer.SelectedObjects[0];
+ if not (rfDontModify in b.Restrictions) then
+ begin
+ case Tag of
+ 10: b.Stretched := Checked;
+ 11: b.AllowSplit := Checked;
+ 12: b.KeepChild := Checked;
+ 13: b.PrintChildIfInvisible := Checked;
+ 14: b.StartNewPage := Checked;
+ end;
+ Result := True;
+ end;
+end;
+
+procedure TfrxBandEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ b: TfrxBand;
+begin
+ inherited;
+ if Designer.SelectedObjects.Count > 1 then Exit;
+ b := TfrxBand(Component);
+
+ if not b.Vertical then
+ begin
+ AddItem(frxResources.Get('mvStretch'), 10, b.Stretched);
+ if not (b.BandNumber in [2,3,15,16]) then
+ AddItem(frxResources.Get('bvSplit'), 11, b.AllowSplit);
+ if not (b.BandNumber in [2,15]) then
+ AddItem(frxResources.Get('bvKeepChild'), 12, b.KeepChild);
+ end;
+ AddItem(frxResources.Get('bvPrintChild'), 13, b.PrintChildIfInvisible);
+ if not (b.BandNumber in [2,3,5,13,15,16]) then
+ AddItem(frxResources.Get('bvStartPage'), 14, b.StartNewPage);
+end;
+
+
+{ TfrxDataBandEditor }
+
+function TfrxDataBandEditor.Edit: Boolean;
+begin
+ with TfrxDataBandEditorForm.Create(Designer) do
+ begin
+ DataBand := TfrxDataBand(Component);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ Free;
+ end;
+end;
+
+function TfrxDataBandEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+function TfrxDataBandEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ b: TfrxDataBand;
+begin
+ Result := inherited Execute(Tag, Checked);
+
+ b := Designer.SelectedObjects[0];
+ if not (rfDontModify in b.Restrictions) then
+ begin
+ case Tag of
+ 0: b.PrintIfDetailEmpty := Checked;
+ 1: b.FooterAfterEach := Checked;
+ 2: b.KeepTogether := Checked;
+ 3: b.KeepFooter := Checked;
+ 4: b.KeepHeader := Checked;
+ end;
+ Result := True;
+ end;
+end;
+
+procedure TfrxDataBandEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ b: TfrxDataBand;
+begin
+ inherited;
+ if Designer.SelectedObjects.Count > 1 then Exit;
+ b := TfrxDataBand(Component);
+
+ AddItem(frxResources.Get('bvPrintIfEmpty'), 0, b.PrintIfDetailEmpty);
+ AddItem(frxResources.Get('bvFooterAfterEach'), 1, b.FooterAfterEach);
+ if not b.Vertical then
+ begin
+ AddItem(frxResources.Get('bvKeepDetail'), 2, b.KeepTogether);
+ AddItem(frxResources.Get('bvKeepFooter'), 3, b.KeepFooter);
+ AddItem(frxResources.Get('bvKeepHeader'), 4, b.KeepHeader);
+ end;
+end;
+
+
+{ TfrxHeaderEditor }
+
+function TfrxHeaderEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ b: TfrxHeader;
+begin
+ Result := inherited Execute(Tag, Checked);
+
+ b := Designer.SelectedObjects[0];
+ if not (rfDontModify in b.Restrictions) then
+ begin
+ if Tag = 0 then
+ b.ReprintOnNewPage := Checked;
+ Result := True;
+ end;
+end;
+
+procedure TfrxHeaderEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ b: TfrxHeader;
+begin
+ inherited;
+ if Designer.SelectedObjects.Count > 1 then Exit;
+ b := TfrxHeader(Component);
+
+ AddItem(frxResources.Get('bvReprint'), 0, b.ReprintOnNewPage);
+end;
+
+
+{ TfrxPageHeaderEditor }
+
+function TfrxPageHeaderEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ b: TfrxPageHeader;
+begin
+ Result := inherited Execute(Tag, Checked);
+
+ b := Designer.SelectedObjects[0];
+ if not (rfDontModify in b.Restrictions) then
+ begin
+ if Tag = 0 then
+ b.PrintOnFirstPage := Checked;
+ Result := True;
+ end;
+end;
+
+procedure TfrxPageHeaderEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ b: TfrxPageHeader;
+begin
+ inherited;
+ if Designer.SelectedObjects.Count > 1 then Exit;
+ b := TfrxPageHeader(Component);
+
+ AddItem(frxResources.Get('bvOnFirst'), 0, b.PrintOnFirstPage);
+end;
+
+
+{ TfrxPageFooterEditor }
+
+function TfrxPageFooterEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ b: TfrxPageFooter;
+begin
+ Result := False;
+
+ b := Designer.SelectedObjects[0];
+ if not (rfDontModify in b.Restrictions) then
+ begin
+ case Tag of
+ 0: b.PrintOnFirstPage := Checked;
+ 1: b.PrintOnLastPage := Checked;
+ end;
+ Result := True;
+ end;
+end;
+
+procedure TfrxPageFooterEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ b: TfrxPageFooter;
+begin
+ inherited;
+ if Designer.SelectedObjects.Count > 1 then Exit;
+ b := TfrxPageFooter(Component);
+
+ AddItem(frxResources.Get('bvOnFirst'), 0, b.PrintOnFirstPage);
+ AddItem(frxResources.Get('bvOnLast'), 1, b.PrintOnLastPage);
+end;
+
+
+{ TfrxGroupHeaderEditor }
+
+function TfrxGroupHeaderEditor.Edit: Boolean;
+begin
+ with TfrxGroupEditorForm.Create(Designer) do
+ begin
+ GroupHeader := TfrxGroupHeader(Component);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ Free;
+ end;
+end;
+
+function TfrxGroupHeaderEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+function TfrxGroupHeaderEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ b: TfrxGroupHeader;
+begin
+ Result := inherited Execute(Tag, Checked);
+
+ b := Designer.SelectedObjects[0];
+ if not (rfDontModify in b.Restrictions) then
+ begin
+ if Tag = 0 then
+ b.KeepTogether := Checked
+ else if Tag = 1 then
+ b.ReprintOnNewPage := Checked
+ else if Tag = 2 then
+ b.DrillDown := Checked
+ else if Tag = 3 then
+ begin
+ b.ResetPageNumbers := Checked;
+ if Checked then
+ b.StartNewPage := True;
+ end;
+ Result := True;
+ end;
+end;
+
+procedure TfrxGroupHeaderEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ b: TfrxGroupHeader;
+begin
+ inherited;
+ if Designer.SelectedObjects.Count > 1 then Exit;
+ b := TfrxGroupHeader(Component);
+
+ AddItem(frxResources.Get('bvKeepGroup'), 0, b.KeepTogether);
+ AddItem(frxResources.Get('bvReprint'), 1, b.ReprintOnNewPage);
+ AddItem(frxResources.Get('bvDrillDown'), 2, b.DrillDown);
+ AddItem(frxResources.Get('bvResetPageNo'), 3, b.ResetPageNumbers);
+end;
+
+
+{ TfrxDialogControlEditor }
+
+function TfrxDialogControlEditor.Edit: Boolean;
+var
+ i: Integer;
+ c: TfrxDialogControl;
+ s: String;
+begin
+ c := TfrxDialogControl(Component);
+ if c.OnClick = '' then
+ begin
+ s := c.Name + 'OnClick';
+ c.OnClick := s;
+ i := frxLocateEventHandler(Designer.Code, Designer.Report.ScriptLanguage, s);
+ if i = -1 then
+ i := frxAddEvent(Designer.Code, Designer.Report.ScriptLanguage,
+ TypeInfo(TfrxNotifyEvent), s) else
+ Inc(i, 3);
+
+ TfrxDesignerForm(Designer).SwitchToCodeWindow;
+ TfrxDesignerForm(Designer).CodeWindow.UpdateView;
+ TfrxDesignerForm(Designer).CodeWindow.SetPos(3, i);
+ Result := True;
+ end
+ else
+ begin
+ i := frxLocateEventHandler(Designer.Code, Designer.Report.ScriptLanguage,
+ c.OnClick);
+
+ TfrxDesignerForm(Designer).SwitchToCodeWindow;
+ TfrxDesignerForm(Designer).CodeWindow.SetPos(1, i + 3);
+ Result := False;
+ end;
+end;
+
+function TfrxDialogControlEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+
+{ TfrxSubreportEditor }
+
+function TfrxSubreportEditor.Edit: Boolean;
+var
+ s: TfrxSubreport;
+begin
+ Result := False;
+ s := TfrxSubreport(Component);
+ if s.Page <> nil then
+ Designer.Page := s.Page;
+end;
+
+function TfrxSubreportEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ s: TfrxSubreport;
+begin
+ Result := inherited Execute(Tag, Checked);
+
+ s := TfrxSubreport(Component);
+ if not (rfDontModify in s.Restrictions) then
+ begin
+ if Tag = 0 then
+ s.PrintOnParent := Checked;
+ Result := True;
+ end;
+end;
+
+procedure TfrxSubreportEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+begin
+ inherited;
+ AddItem(frxResources.Get('srParent'), 0, TfrxSubreport(Component).PrintOnParent);
+end;
+
+function TfrxSubreportEditor.HasEditor: Boolean;
+begin
+ Result := True;
+end;
+
+
+{ TfrxMemoProperty }
+
+function TfrxMemoProperty.Edit: Boolean;
+begin
+ with TfrxMemoEditorForm.Create(Designer) do
+ begin
+ MemoView := TfrxMemoView(Component);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ MemoView.Text := Memo.Text;
+ Free;
+ end;
+end;
+
+function TfrxMemoProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog, paReadOnly];
+end;
+
+
+{ TfrxFrameProperty }
+
+function TfrxFrameProperty.Edit: Boolean;
+begin
+ with TfrxFrameEditorForm.Create(Designer) do
+ begin
+ Frame.Assign(TfrxFrame(GetOrdValue));
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ TfrxFrame(GetOrdValue).Assign(Frame);
+ Free;
+ end;
+end;
+
+function TfrxFrameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paDialog, paReadOnly];
+end;
+
+
+{ TfrxPictureProperty }
+
+function TfrxPictureProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog, paReadOnly];
+end;
+
+function TfrxPictureProperty.Edit: Boolean;
+var
+ Pict: TBitmap;
+begin
+ with TfrxPictureEditorForm.Create(Designer) do
+ begin
+ Pict := TBitmap(GetOrdValue);
+ Image.Bitmap.Assign(Pict);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ Pict.Assign(Image.Bitmap);
+ Free;
+ end;
+end;
+
+function TfrxPictureProperty.GetValue: String;
+var
+ Pict: TBitmap;
+begin
+ Pict := TBitmap(GetOrdValue);
+ if Pict.IsEmpty then
+ Result := frxResources.Get('prNotAssigned') else
+ Result := frxResources.Get('prPict');
+end;
+
+
+{ TfrxBitmapProperty }
+
+function TfrxBitmapProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog, paReadOnly];
+end;
+
+function TfrxBitmapProperty.Edit: Boolean;
+var
+ Bmp: TBitmap;
+begin
+ with TfrxPictureEditorForm.Create(Designer) do
+ begin
+ Bmp := TBitmap(GetOrdValue);
+ Image.Bitmap.Assign(Bmp);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ Bmp.Assign(Image.Bitmap);
+ Free;
+ end;
+end;
+
+function TfrxBitmapProperty.GetValue: String;
+begin
+ Result := frxResources.Get('prPict');
+end;
+
+
+{ TfrxDataSetProperty }
+
+function TfrxDataSetProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList];
+end;
+
+function TfrxDataSetProperty.GetValue: String;
+var
+ ds: TfrxDataSet;
+begin
+ ds := TfrxDataSet(GetOrdValue);
+ if (ds <> nil) and (frComponent.Report <> nil) then
+ Result := frComponent.Report.GetAlias(ds) else
+ Result := frxResources.Get('prNotAssigned');
+end;
+
+procedure TfrxDataSetProperty.GetValues;
+begin
+ if frComponent.Report = nil then Exit;
+ frComponent.Report.GetDataSetList(Values);
+ if Component is TfrxDataSet then
+ Values.Delete(Values.IndexOf(TfrxDataSet(Component).UserName));
+end;
+
+procedure TfrxDataSetProperty.SetValue(const Value: String);
+var
+ ds: TfrxDataSet;
+begin
+ if Value = '' then
+ SetOrdValue(0)
+ else
+ begin
+ ds := frComponent.Report.GetDataSet(Value);
+ if ds <> nil then
+ SetOrdValue(frxInteger(ds)) else
+ raise Exception.Create(frxResources.Get('prInvProp'));
+
+ if Component is TfrxCustomMemoView then
+ with TfrxCustomMemoView(Component) do
+ if IsDataField then
+ Text := '[' + DataSet.UserName + '."' + DataField + '"]';
+ end;
+end;
+
+
+{ TfrxDataFieldProperty }
+
+function TfrxDataFieldProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList];
+end;
+
+function TfrxDataFieldProperty.GetValue: String;
+begin
+ Result := GetStrValue;
+end;
+
+procedure TfrxDataFieldProperty.SetValue(const Value: String);
+begin
+ SetStrValue(Value);
+ if Component is TfrxCustomMemoView then
+ with TfrxCustomMemoView(Component) do
+ if IsDataField then
+ Text := '[' + DataSet.UserName + '."' + DataField + '"]';
+end;
+
+procedure TfrxDataFieldProperty.GetValues;
+var
+ ds: TfrxDataSet;
+begin
+ inherited;
+ ds := TfrxView(Component).DataSet;
+ if ds <> nil then
+ ds.GetFieldList(Values);
+end;
+
+
+{ TfrxLocSizeXProperty }
+
+constructor TfrxLocSizeXProperty.Create(Designer: TfrxCustomDesigner);
+begin
+ inherited;
+ FRatio := fr1CharX;
+end;
+
+function TfrxLocSizeXProperty.GetValue: String;
+var
+ e: Extended;
+begin
+ e := GetFloatValue;
+ case TfrxDesignerForm(Designer).Units of
+ duCM: e := e / 96 * 2.54;
+ duInches: e := e / 96;
+ duChars: e := e / FRatio;
+ end;
+
+ if e = Int(e) then
+ Result := FloatToStr(e) else
+ Result := Format('%f', [e]);
+end;
+
+procedure TfrxLocSizeXProperty.SetValue(const Value: String);
+var
+ e: Extended;
+begin
+ e := frxStrToFloat(Value);
+ case TfrxDesignerForm(Designer).Units of
+ duCM: e := e * 96 / 2.54;
+ duInches: e := e * 96;
+ duChars: e := e * FRatio;
+ end;
+
+ SetFloatValue(e);
+end;
+
+
+{ TfrxLocSizeYProperty }
+
+constructor TfrxLocSizeYProperty.Create(Designer: TfrxCustomDesigner);
+begin
+ inherited;
+ FRatio := fr1CharY;
+end;
+
+
+{ TfrxPaperXProperty }
+
+constructor TfrxPaperXProperty.Create(Designer: TfrxCustomDesigner);
+begin
+ inherited;
+ FRatio := fr1CharX;
+end;
+
+function TfrxPaperXProperty.GetValue: String;
+var
+ e: Extended;
+begin
+ e := GetFloatValue;
+ case TfrxDesignerForm(Designer).Units of
+ duCM: e := e / 10;
+ duInches: e := e / 25.4;
+ duPixels: e := e * 96 / 25.4;
+ duChars: e := e * 96 / 25.4 / FRatio;
+ end;
+
+ if e = Int(e) then
+ Result := FloatToStr(e) else
+ Result := Format('%f', [e]);
+end;
+
+procedure TfrxPaperXProperty.SetValue(const Value: String);
+var
+ e: Extended;
+begin
+ e := frxStrToFloat(Value);
+ case TfrxDesignerForm(Designer).Units of
+ duCM: e := e * 10;
+ duInches: e := e * 25.4;
+ duPixels: e := e * 25.4 / 96;
+ duChars: e := e * 25.4 / 96 * FRatio;
+ end;
+
+ SetFloatValue(e);
+end;
+
+
+{ TfrxPaperYProperty }
+
+constructor TfrxPaperYProperty.Create(Designer: TfrxCustomDesigner);
+begin
+ inherited;
+ FRatio := fr1CharY;
+end;
+
+
+{ TfrxEventProperty }
+
+function TfrxEventProperty.Edit: Boolean;
+var
+ i: Integer;
+begin
+ if not TfrxDesignerForm(Designer).CheckOp(drDontEditReportScript) then
+ begin
+ Result := False;
+ Exit;
+ end;
+ if Value = '' then
+ begin
+ Value := frComponent.Name + GetName;
+ i := frxLocateEventHandler(Designer.Code, Designer.Report.ScriptLanguage,
+ Value);
+ if i = -1 then
+ i := frxAddEvent(Designer.Code, Designer.Report.ScriptLanguage,
+ PropInfo.PropType^, Value) else
+ Inc(i, 3);
+
+ if i = -1 then
+ begin
+ Value := '';
+ raise Exception.Create(frxResources.Get('dsCantFindProc'));
+ end;
+
+ TfrxDesignerForm(Designer).SwitchToCodeWindow;
+ TfrxDesignerForm(Designer).CodeWindow.UpdateView;
+ TfrxDesignerForm(Designer).CodeWindow.SetPos(3, i);
+ Result := True;
+ end
+ else
+ begin
+ i := frxLocateEventHandler(Designer.Code, Designer.Report.ScriptLanguage,
+ Value);
+
+ TfrxDesignerForm(Designer).SwitchToCodeWindow;
+ TfrxDesignerForm(Designer).CodeWindow.SetPos(1, i + 3);
+ Result := False;
+ end;
+end;
+
+function TfrxEventProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList];
+end;
+
+procedure TfrxEventProperty.GetValues;
+begin
+ inherited;
+ frxGetEventHandlersList(Designer.Code, Designer.Report.ScriptLanguage,
+ PropInfo.PropType^, Values);
+end;
+
+
+{ TfrxStringsProperty }
+
+function TfrxStringsProperty.Edit: Boolean;
+var
+ l: TStrings;
+begin
+ with TfrxStringsEditorForm.Create(Designer) do
+ begin
+ l := TStrings(GetOrdValue);
+ Memo.Lines.Assign(l);
+ Result := ShowModal = mrOk;
+ if Result then
+ l.Assign(Memo.Lines);
+ Free;
+ end;
+end;
+
+function TfrxStringsProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog, paReadOnly];
+end;
+
+
+{ TfrxBrushProperty }
+
+function TfrxBrushProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paOwnerDraw];
+end;
+
+procedure TfrxBrushProperty.OnDrawLBItem(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF);
+begin
+ inherited;
+// with TListBox(Control), TListBox(Control).Canvas do
+// begin
+// Brush.Style := TBrushStyle(Index);
+// Brush.Color := clBlack;
+// Rectangle(ARect.Left + 2, ARect.Top + 2, ARect.Left + (ARect.Bottom - ARect.Top - 2), ARect.Bottom - 2);
+// end;
+end;
+
+procedure TfrxBrushProperty.OnDrawItem(Canvas: TCanvas; ARect: TRectF);
+begin
+ inherited;
+// with Canvas do
+// begin
+// Brush.Style := TBrushStyle(GetOrdValue);
+// Brush.Color := clBlack;
+// Rectangle(ARect.Left, ARect.Top + 1, ARect.Left + (ARect.Bottom - ARect.Top - 5), ARect.Bottom - 4);
+// end;
+end;
+
+
+{ TfrxFrameStyleProperty }
+
+function TfrxFrameStyleProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paOwnerDraw];
+end;
+
+procedure HLine(Canvas: TCanvas; X, Y, DX: Integer);
+var
+ i: Integer;
+begin
+ with Canvas do
+ begin
+ Stroke.Color := claBlack;
+ if Stroke.Kind = TBrushKind.bkNone then
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+ for i := 0 to 1 do
+ DrawLine(PointF(X, Y - 2 + i * 2), PointF(X + DX, Y - 2 + i * 2), 1);
+ end
+ else
+ for i := 0 to 1 do
+ DrawLine(PointF(X, Y - 1 + i), PointF(X + DX, Y - 1 + i), 1);
+ end;
+end;
+
+procedure TfrxFrameStyleProperty.OnDrawLBItem(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF);
+begin
+// with TListBox(Control), TListBox(Control).Canvas do
+// begin
+// FillRect(ARect);
+// TextOut(ARect.Left + 40, ARect.Top + 1, TListBox(Control).Items[Index]);
+//
+// Pen.Color := clGray;
+// Brush.Color := clWhite;
+// Rectangle(ARect.Left + 2, ARect.Top + 2, ARect.Left + 36, ARect.Bottom - 2);
+//
+// Pen.Style := TPenStyle(Index);
+// HLine(TListBox(Control).Canvas, ARect.Left + 3, ARect.Top + (ARect.Bottom - ARect.Top) div 2, 32);
+// Pen.Style := psSolid;
+// end;
+end;
+
+procedure TfrxFrameStyleProperty.OnDrawItem(Canvas: TCanvas; ARect: TRectF);
+begin
+// with Canvas do
+// begin
+// TextOut(ARect.Left + 38, ARect.Top, Value);
+//
+// Pen.Color := clGray;
+// Brush.Color := clWhite;
+// Rectangle(ARect.Left, ARect.Top + 1, ARect.Left + 34, ARect.Bottom - 4);
+//
+// Pen.Color := clBlack;
+// Pen.Style := TPenStyle(GetOrdValue);
+// HLine(Canvas, ARect.Left + 1, ARect.Top + (ARect.Bottom - ARect.Top) div 2 - 1, 32);
+// Pen.Style := psSolid;
+// end;
+end;
+
+function TfrxFrameStyleProperty.GetExtraLBSize: Integer;
+begin
+ Result := 36;
+end;
+
+
+{ TfrxDisplayFormatProperty }
+
+function TfrxDisplayFormatProperty.Edit: Boolean;
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ with TfrxFormatEditorForm.Create(Designer) do
+ begin
+ Format.Assign(TfrxCustomMemoView(Component).DisplayFormat);
+ FormShow(Self);
+ Result := ShowModal = mrOk;
+ if Result then
+ for i := 0 to Self.Designer.SelectedObjects.Count - 1 do
+ begin
+ c := Self.Designer.SelectedObjects[i];
+ if (c is TfrxCustomMemoView) and not (rfDontModify in c.Restrictions) then
+ TfrxCustomMemoView(c).DisplayFormat := Format;
+ end;
+ Free;
+ end;
+end;
+
+function TfrxDisplayFormatProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paDialog, paMultiSelect, paReadOnly];
+end;
+
+
+{ TfrxBooleanProperty }
+
+function TfrxBooleanProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paOwnerDraw];
+end;
+
+procedure TfrxBooleanProperty.OnDrawItem(Canvas: TCanvas; ARect: TRectF);
+var
+ add, i: Integer;
+begin
+ inherited;
+ with Canvas do
+ begin
+ Stroke.Color := claDimGray;
+ DrawRect(RectF(Round(ARect.Left) + 0.5, Round(ARect.Top) + 1.5, Round(ARect.Left + (ARect.Bottom - ARect.Top - 5)) - 0.5, Round(ARect.Bottom) - 4.5),
+ 0, 0, allCorners, 1);
+ Stroke.Color := claBlack;
+// if Screen.PixelsPerInch > 96 then
+// add := 2
+// else
+ add := 0;
+ if Boolean(GetOrdValue) = True then
+ begin
+ for i := 0 to 2 do
+ begin
+ DrawLine(PointF(Round(ARect.Left) + 2.5 + add, Round(ARect.Top) + 5.5 + add + i), PointF(Round(ARect.Left) + 4.5 + add, Round(ARect.Top) + 7.5 + add + i), 1);
+ DrawLine(PointF(Round(ARect.Left) + 4.5 + add, Round(ARect.Top) + 7.5 + add + i), PointF(Round(ARect.Left) + 8.5 + add, Round(ARect.Top) + 3.5 + add + i), 1);
+ end;
+ end;
+ end;
+end;
+
+procedure TfrxBooleanProperty.OnDrawLBItem(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF);
+var
+ add, i: Integer;
+begin
+ inherited;
+ with Canvas do
+ begin
+ Fill.Color := claWhite;
+ Fill.Kind := TBrushKind.bkSolid;
+ FillRect(RectF(ARect.Left + 2, ARect.Top + 2, ARect.Left + (ARect.Bottom - ARect.Top - 2), ARect.Bottom - 2),
+ 0, 0, allCorners, 1);
+ Stroke.Color := claDimGray;
+ Stroke.Kind := TBrushKind.bkSolid;
+ DrawRect(RectF(Round(ARect.Left) + 3.5, Round(ARect.Top) + 3.5, Round(ARect.Left + (ARect.Bottom - ARect.Top - 2)) - 0.5, Round(ARect.Bottom) - 2.5),
+ 0, 0, allCorners, 1);
+ Stroke.Color := claBlack;
+// if Screen.PixelsPerInch > 96 then
+// add := 2
+// else
+ add := 0;
+ if TListBoxItem(Sender).Text = 'True' then
+ begin
+ for i := 0 to 2 do
+ begin
+ DrawLine(PointF(Round(ARect.Left) + 5.5 + add, Round(ARect.Top) + 7.5 + add + i), PointF(Round(ARect.Left) + 7.5 + add, Round(ARect.Top) + 9.5 + add + i), 1);
+ DrawLine(PointF(Round(ARect.Left) + 7.5 + add, Round(ARect.Top) + 9.5 + add + i), PointF(Round(ARect.Left) + 11.5 + add, Round(ARect.Top) + 5.5 + add + i), 1);
+ end;
+ end;
+ end;
+end;
+
+
+{ TfrxPrinterProperty }
+
+function TfrxPrinterProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paValueList];
+end;
+
+procedure TfrxPrinterProperty.GetValues;
+begin
+ inherited;
+ Values.Assign(frxPrinters.Printers);
+ Values.Insert(0, frxResources.Get('prDefault'));
+end;
+
+
+{ TfrxPaperProperty }
+
+function TfrxPaperProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paValueList];
+end;
+
+function TfrxPaperProperty.GetValue: String;
+var
+ i: Integer;
+begin
+//{$IFDEF LINUX}
+ // Result := 'A4';
+//{$ELSE}
+ i := frxPrinters.Printer.PaperIndex(GetOrdValue);
+ if i = -1 then
+ i := frxPrinters.Printer.PaperIndex(256);
+ Result := frxPrinters.Printer.Papers[i];
+//{$ENDIF}
+end;
+
+procedure TfrxPaperProperty.GetValues;
+begin
+ inherited;
+ Values.Assign(frxPrinters.Printer.Papers);
+end;
+
+procedure TfrxPaperProperty.SetValue(const Value: String);
+begin
+ SetOrdValue(frxPrinters.Printer.PaperNameToNumber(Value));
+end;
+
+
+{ TfrxStyleProperty }
+
+function TfrxStyleProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paValueList, paMultiSelect];
+end;
+
+procedure TfrxStyleProperty.GetValues;
+begin
+ inherited;
+ Designer.Report.Styles.GetList(Values);
+end;
+
+
+{ TfrxColumnFooterEditor }
+
+function TfrxColumnFooterEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+begin
+// do nothing
+ Result := False;
+end;
+
+procedure TfrxColumnFooterEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+begin
+// do nothing
+end;
+
+{ TfrxColumnHeaderEditor }
+
+function TfrxColumnHeaderEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+var
+ b: TfrxBand;
+begin
+ Result := False;
+ b := Designer.SelectedObjects[0];
+ if not (rfDontModify in b.Restrictions) then
+ begin
+ case Tag of
+ 10: b.Stretched := Checked;
+ end;
+ Result := True;
+ end;
+end;
+
+procedure TfrxColumnHeaderEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ b: TfrxBand;
+begin
+ if Designer.SelectedObjects.Count > 1 then Exit;
+ inherited;
+ b := TfrxBand(Component);
+ AddItem(frxResources.Get('mvStretch'), 10, b.Stretched);
+end;
+
+{ TfrxOverlayEditor }
+
+function TfrxOverlayEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+begin
+ //do nothhing
+ Result := False;
+end;
+
+procedure TfrxOverlayEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+begin
+ //do nothhing
+end;
+
+initialization
+ frxObjects.RegisterObject1(TfrxMemoView, nil, '', '', 0, 102, [ctReport, ctData]);
+ frxObjects.RegisterObject1(TfrxPictureView, nil, '', '', 0, 103);
+ frxObjects.RegisterObject1(TfrxSubreport, nil, '', '', 0, 104, [ctReport, ctDMP]);
+ frxObjects.RegisterObject1(TfrxSysMemoView, nil, '', '', 0, 132);
+ frxObjects.RegisterCategory('Draw', nil, 'obCatDraw', 106);
+ frxObjects.RegisterCategory('Other', nil, 'obCatOther', 179);
+ {$IFDEF DB_CAT}
+ frxObjects.RegisterCategory('DATABASES',nil,'obDataBases',53);
+ frxObjects.RegisterCategory('TABLES',nil,'obTables',54);
+ frxObjects.RegisterCategory('QUERIES',nil,'obQueries',56);
+ {$ENDIF}
+ frxObjects.RegisterObject1(TfrxLineView, nil, '', 'Draw', 0, 105, [ctReport, ctData]);
+ frxObjects.RegisterObject1(TfrxLineView, nil, 'obDiagLine', 'Draw', 1, 107);
+ frxObjects.RegisterObject1(TfrxLineView, nil, 'obDiagLine', 'Draw', 2, 150);
+ frxObjects.RegisterObject1(TfrxLineView, nil, 'obDiagLine', 'Draw', 3, 151);
+ frxObjects.RegisterObject1(TfrxLineView, nil, 'obDiagLine', 'Draw', 4, 152);
+ frxObjects.RegisterObject1(TfrxShapeView, nil, 'obRect', 'Draw', 0, 108);
+ frxObjects.RegisterObject1(TfrxShapeView, nil, 'obRoundRect', 'Draw', 1, 109);
+ frxObjects.RegisterObject1(TfrxShapeView, nil, 'obEllipse', 'Draw', 2, 110);
+ frxObjects.RegisterObject1(TfrxShapeView, nil, 'obTrian', 'Draw', 3, 111);
+ frxObjects.RegisterObject1(TfrxShapeView, nil, 'obDiamond', 'Draw', 4, 131);
+
+ frxComponentEditors.Register(TfrxReportPage, TfrxPageEditor);
+ frxComponentEditors.Register(TfrxView, TfrxViewEditor);
+ frxComponentEditors.Register(TfrxMemoView, TfrxMemoEditor);
+ frxComponentEditors.Register(TfrxSysMemoView, TfrxSysMemoEditor);
+ frxComponentEditors.Register(TfrxDMPMemoView, TfrxMemoEditor);
+ frxComponentEditors.Register(TfrxLineView, TfrxLineEditor);
+ frxComponentEditors.Register(TfrxDMPLineView, TfrxLineEditor);
+ frxComponentEditors.Register(TfrxPictureView, TfrxPictureEditor);
+ frxComponentEditors.Register(TfrxBand, TfrxBandEditor);
+ frxComponentEditors.Register(TfrxDataBand, TfrxDataBandEditor);
+ frxComponentEditors.Register(TfrxHeader, TfrxHeaderEditor);
+ frxComponentEditors.Register(TfrxPageHeader, TfrxPageHeaderEditor);
+ frxComponentEditors.Register(TfrxPageFooter, TfrxPageFooterEditor);
+ frxComponentEditors.Register(TfrxGroupHeader, TfrxGroupHeaderEditor);
+ frxComponentEditors.Register(TfrxColumnHeader, TfrxColumnHeaderEditor);
+ frxComponentEditors.Register(TfrxColumnFooter, TfrxColumnFooterEditor);
+ frxComponentEditors.Register(TfrxOverlay, TfrxOverlayEditor);
+ frxComponentEditors.Register(TfrxDialogControl, TfrxDialogControlEditor);
+ frxComponentEditors.Register(TfrxSubreport, TfrxSubreportEditor);
+
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxComponent, 'Left', TfrxLocSizeXProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxComponent, 'Top', TfrxLocSizeYProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxComponent, 'Width', TfrxLocSizeXProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxComponent, 'Height', TfrxLocSizeYProperty);
+
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxReportPage, 'PaperWidth', TfrxPaperXProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxReportPage, 'PaperHeight', TfrxPaperYProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxReportPage, 'LeftMargin', TfrxPaperXProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxReportPage, 'RightMargin', TfrxPaperXProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxReportPage, 'TopMargin', TfrxPaperYProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxReportPage, 'BottomMargin', TfrxPaperYProperty);
+ frxPropertyEditors.Register(TypeInfo(Integer), TfrxReportPage, 'PaperSize', TfrxPaperProperty);
+
+ frxPropertyEditors.RegisterEventEditor(TfrxEventProperty);
+
+ frxPropertyEditors.Register(TypeInfo(Boolean), nil, '', TfrxBooleanProperty);
+ frxPropertyEditors.Register(TypeInfo(TfrxFrame), nil, '', TfrxFrameProperty);
+ frxPropertyEditors.Register(TypeInfo(TBitmap), nil, '', TfrxPictureProperty);
+ frxPropertyEditors.Register(TypeInfo(TBitmap), nil, '', TfrxBitmapProperty);
+ frxPropertyEditors.Register(TypeInfo(TfrxDataSet), nil, '', TfrxDataSetProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxView, 'DataField', TfrxDataFieldProperty);
+ frxPropertyEditors.Register(TypeInfo(TStrings), nil, '', TfrxStringsProperty);
+ frxPropertyEditors.Register(TypeInfo(TWideStrings), TfrxCustomMemoView, 'Memo', TfrxMemoProperty);
+ frxPropertyEditors.Register(TypeInfo(TBrushKind), nil, '', TfrxBrushProperty);
+ frxPropertyEditors.Register(TypeInfo(TfrxFrameStyle), nil, '', TfrxFrameStyleProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxMemoView, 'DisplayFormat', TfrxDisplayFormatProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxDMPMemoView, 'DisplayFormat', TfrxDisplayFormatProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxMemoView, 'Style', TfrxStyleProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxDataBand, 'ColumnWidth', TfrxLocSizeXProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), TfrxDataBand, 'ColumnGap', TfrxLocSizeXProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxPrintOptions, 'Printer', TfrxPrinterProperty);
+ frxPropertyEditors.Register(TypeInfo(Integer), TfrxPrintOptions, 'PrintOnSheet', TfrxPaperProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), nil, 'NextCrossGap', TfrxLocSizeXProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), nil, 'AddWidth', TfrxLocSizeXProperty);
+ frxPropertyEditors.Register(TypeInfo(Double), nil, 'AddHeight', TfrxLocSizeYProperty);
+
+ frxHideProperties(TfrxReport, 'DefaultLanguage;IniFile;Name;Preview;ScriptLanguage;ScriptText;Tag;Variables;DataSetName;DotMatrixReport;OldStyleProgress;ShowProgress;StoreInDFM;ParentReport');
+ frxHideProperties(TfrxEngineOptions, 'NewSilentMode;MaxMemSize;PrintIfEmpty;SilentMode;TempDir;UseFileCache');
+ frxHideProperties(TfrxPreviewOptions, 'AllowEdit;Buttons;DoubleBuffered;Maximized;MDIChild;Modal;ShowCaptions;Zoom;ZoomMode');
+ frxHideProperties(TfrxReportOptions, 'CreateDate;LastChange;Compressed;Password');
+ frxHideProperties(TfrxReportPage, 'Bin;BinOtherPages;ColumnWidth;ColumnPositions;DataSetName;HGuides;VGuides');
+ frxHideProperties(TfrxDialogPage, 'Font');
+ frxHideProperties(TfrxDMPPage, 'BackPicture;Color;Font;Frame');
+ frxHideProperties(TfrxReportComponent, 'GroupIndex');
+ frxHideProperties(TfrxView, 'DataSetName');
+ frxHideProperties(TfrxBand, 'Vertical');
+ frxHideProperties(TfrxDataBand, 'DataSetName');
+ frxHideProperties(TfrxGroupHeader, 'DrillName');
+ frxHideProperties(TFont, 'Height;Pitch');
+ frxHideProperties(TfrxHighlight, 'Active');
+ frxHideProperties(TfrxPictureView, 'ImageIndex');
+ frxHideProperties(TfrxSubreport, 'Page');
+ frxHideProperties(TfrxDataPage, 'Left;Tag;Top;Visible');
+ frxHideProperties(TfrxCustomMemoView, 'FirstParaBreak;LastParaBreak');
+
+
+end.
diff --git a/LibD28x64/FMX.frxDesgnWorkspace.pas b/LibD28x64/FMX.frxDesgnWorkspace.pas
new file mode 100644
index 0000000..081671e
--- /dev/null
+++ b/LibD28x64/FMX.frxDesgnWorkspace.pas
@@ -0,0 +1,3102 @@
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Common designer workspace }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDesgnWorkspace;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.Types, System.UITypes, FMX.Platform, FMX.Controls, FMX.Objects, FMX.Types, FMX.Forms,
+ FMX.Dialogs, FMX.ExtCtrls, FMX.Memo, FMX.frxClass, System.Variants, System.UIConsts
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+ TfrxDesignMode = (dmSelect, dmInsert, dmDrag);
+ TfrxDesignMode1 = (dmNone, dmMove, dmSize, dmSizeBand, dmScale,
+ dmSelectionRect, dmInsertObject, dmInsertLine,
+ dmMoveGuide, dmContainer);
+ TfrxGridType = (gt1pt, gt1cm, gt1in, gtDialog, gtChar, gtNone);
+ TfrxCursorType = (ct0, ct1, ct2, ct3, ct4, ct5, ct6, ct7, ct8, ct9, ct10);
+ TfrxNotifyPositionEvent = procedure (ARect: TfrxRect) of object;
+ TfrxPopupEvent = procedure(Sender: TObject; X, Y: Single) of object;
+
+ TfrxInsertion = packed record
+ ComponentClass: TfrxComponentClass;
+ Left: Extended;
+ Top: Extended;
+ Width: Extended;
+ Height: Extended;
+ OriginalWidth: Extended;
+ OriginalHeight: Extended;
+ Flags: Word;
+ end;
+
+ TfrxDesignerWorkspace = class(TPanel)
+ protected
+ FBandHeader: Extended;
+ FCanvas: TCanvas;
+ FColor: TAlphaColor;
+ FCT: TfrxCursorType;
+ FDblClicked: Boolean;
+ FDisableUpdate: Boolean;
+ FFreeBandsPlacement: Boolean;
+ FGapBetweenBands: Integer;
+ FGridAlign: Boolean;
+ FGridLCD: Boolean;
+ FGridType: TfrxGridType;
+ FGridX: Extended;
+ FGridY: Extended;
+ FInplaceMemo: TMemo;
+ FInplaceObject: TfrxCustomMemoView;
+ FInsertion: TfrxInsertion;
+ FLastMousePointX: Extended;
+ FLastMousePointY: Extended;
+ FMargins: TRect;
+ FMarginsPanel: TPanel;
+ FMode: TfrxDesignMode;
+ FMode1: TfrxDesignMode1;
+ FModifyFlag: Boolean;
+ FMouseDown: Boolean;
+ FObjects: TList;
+ FOffsetX: Extended;
+ FOffsetY: Extended;
+ FPage: TfrxPage;
+ FPageHeight: Integer;
+ FPageWidth: Integer;
+ FScale: Extended;
+ FScaleRect: TfrxRect;
+ FScaleRect1: TfrxRect;
+ FSelectedObjects: TList;
+ FSavedAlign: TList;
+ FSelectionRect: TfrxRect;
+ FShowBandCaptions: Boolean;
+ FShowEdges: Boolean;
+ FShowGrid: Boolean;
+ FSizedBand: TfrxBand;
+ FOnModify: TNotifyEvent;
+ FOnEdit: TNotifyEvent;
+ FOnInsert: TNotifyEvent;
+ FOnNotifyPosition: TfrxNotifyPositionEvent;
+ FOnSelectionChanged: TNotifyEvent;
+ FDrawSelection: Boolean;
+ FDrawInsertion: Boolean;
+ FOnPopup: TfrxPopupEvent;
+ FFastCanvas: TCanvas;
+ FParentForm: TFmxObject;
+ procedure DoModify;
+ procedure AdjustBandHeight(Bnd: TfrxBand);
+ procedure CheckGuides(var kx, ky: Extended; var Result: Boolean); virtual;
+ procedure DoNudge(dx, dy: Extended; Smooth: Boolean);
+ procedure DoSize(dx, dy: Extended);
+ procedure DoStick(dx, dy: Integer);
+ procedure DoTab;
+ procedure DrawBackground;
+ procedure DrawCross;
+ procedure DrawInsertionRect;
+ procedure DrawObjects; virtual;
+ procedure DrawSelectionRect;
+ procedure FindNearest(dx, dy: Integer);
+ procedure MouseLeave;
+ procedure NormalizeCoord(c: TfrxComponent);
+ procedure NormalizeRect(var R: TfrxRect);
+ procedure SelectionChanged;
+ procedure SetScale(Value: Extended);
+ procedure SetShowBandCaptions(const Value: Boolean);
+ procedure UpdateBandHeader;
+ procedure DblClick; override;
+ procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
+ procedure KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
+ procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
+
+ // debug
+ procedure PrepareShiftTree(Band: TfrxBand);
+
+ procedure SetColor(const Value: TAlphaColor);
+ procedure SetGridType(const Value: TfrxGridType);
+ procedure SetOrigin(const Value: TPoint);
+ procedure SetParent(const Value: TFmxObject); override;
+ procedure SetShowGrid(const Value: Boolean);
+ function GetOrigin: TPoint;
+ function GetRightBottomObject: TfrxComponent;
+ function GetSelectionBounds: TfrxRect;
+ function ListsEqual(List1, List2: TList): Boolean;
+ function SelectedCount: Integer;
+ procedure DoDraw(ACanvas: TCanvas); virtual;
+ procedure DoDeactivate;{$IFDEF Delphi19} override;{$ENDIF}
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure DoPaint; override;
+ procedure AdjustBands(AttachObjects: Boolean = True);
+ procedure DeleteObjects; virtual;
+ procedure DisableUpdate;
+ procedure EnableUpdate;
+ procedure EditObject; virtual;
+ procedure GroupObjects;
+ procedure UngroupObjects;
+ procedure SetInsertion(AClass: TfrxComponentClass;
+ AWidth, AHeight: Extended; AFlag: Word); virtual;
+ procedure SetPageDimensions(AWidth, AHeight: Integer; AMargins: TRect);
+ procedure UpdateView;
+
+ property BandHeader: Extended read FBandHeader write FBandHeader;
+ property Color: TAlphaColor read FColor write SetColor;
+ property FastCanvas: TCanvas read FFastCanvas;
+ property FreeBandsPlacement: Boolean read FFreeBandsPlacement write FFreeBandsPlacement;
+ property GapBetweenBands: Integer read FGapBetweenBands write FGapBetweenBands;
+ property GridAlign: Boolean read FGridAlign write FGridAlign;
+ property GridLCD: Boolean read FGridLCD write FGridLCD;
+ property GridType: TfrxGridType read FGridType write SetGridType;
+ property GridX: Extended read FGridX write FGridX;
+ property GridY: Extended read FGridY write FGridY;
+ property Insertion: TfrxInsertion read FInsertion;
+ property IsMouseDown: Boolean read FMouseDown;
+ property Mode: TfrxDesignMode1 read FMode1;
+ property Objects: TList read FObjects write FObjects;
+ property OffsetX: Extended read FOffsetX write FOffsetX;
+ property OffsetY: Extended read FOffsetY write FOffsetY;
+ property Origin: TPoint read GetOrigin write SetOrigin;
+ property Page: TfrxPage read FPage write FPage;
+ property Scale: Extended read FScale write SetScale;
+ property SelectedObjects: TList read FSelectedObjects write FSelectedObjects;
+ property ShowBandCaptions: Boolean read FShowBandCaptions write SetShowBandCaptions;
+ property ShowEdges: Boolean read FShowEdges write FShowEdges;
+ property ShowGrid: Boolean read FShowGrid write SetShowGrid;
+ property OnModify: TNotifyEvent read FOnModify write FOnModify;
+ property OnEdit: TNotifyEvent read FOnEdit write FOnEdit;
+ property OnInsert: TNotifyEvent read FOnInsert write FOnInsert;
+ property OnNotifyPosition: TfrxNotifyPositionEvent read FOnNotifyPosition write
+ FOnNotifyPosition;
+ property OnSelectionChanged: TNotifyEvent read FOnSelectionChanged write
+ FOnSelectionChanged;
+ property OnPopup: TfrxPopupEvent read FOnPopup write FOnPopup;
+ end;
+
+
+implementation
+
+uses FMX.frxRes, FMX.frxDMPClass, FMX.frxUtils, FMX.frxCtrls, FMX.frxFMX;
+
+const
+ DefFontName = 'Tahoma';
+
+
+type
+ TMarginsPanel = class(TPanel)
+ private
+ FColor: TAlphaColor;
+ protected
+ FWorkspace: TfrxDesignerWorkspace;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single); override;
+ procedure MouseMove(Shift: TShiftState; x, y: Single); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState; x, y: Single); override;
+ public
+ constructor Create(AOwner: TComponent); override;
+ procedure DoPaint; override;
+ property Color: TAlphaColor read FColor write FColor default claWhite;
+ end;
+
+ THackComponent = class(TfrxComponent);
+
+
+{ TMarginsPanel }
+
+constructor TMarginsPanel.Create(AOwner: TComponent);
+begin
+ inherited;
+ Color := claWhite;
+ StyleLookup := 'backgroundstyle';
+end;
+
+procedure TMarginsPanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+begin
+ inherited;
+ FWorkspace.MouseDown(Button, Shift, X - (FWorkspace.Left - Left),
+ Y - (FWorkspace.Top - Top));
+end;
+
+procedure TMarginsPanel.MouseMove(Shift: TShiftState; x, y: Single);
+begin
+ inherited;
+
+ if FWorkspace.FMode = dmSelect then
+ FWorkspace.MouseMove(Shift, X - (FWorkspace.Left - Left),
+ Y - (FWorkspace.Top - Top)) else
+ FWorkspace.MouseLeave;
+ Cursor := FWorkspace.Cursor;
+end;
+
+procedure TMarginsPanel.MouseUp(Button: TMouseButton; Shift: TShiftState; x, y: Single);
+begin
+ inherited;
+ FWorkspace.MouseUp(Button, Shift, X - (FWorkspace.Left - Left),
+ Y - (FWorkspace.Top - Top));
+end;
+
+procedure TMarginsPanel.DoPaint;
+var
+ r: TRectF;
+ poly: TPolygon;
+ Sstate: TCanvasSaveState;
+ oldM: TMatrix;
+begin
+ Sstate := Canvas.SaveState;
+ oldM := Canvas.Matrix;
+ try
+ Canvas.SetMatrix(CreateTranslateMatrix(AbsoluteRect.Left, AbsoluteRect.Top));
+
+ with Canvas do
+ begin
+ Fill.Color := Color;
+ Fill.Kind := TBrushKind.bkSolid;
+ Stroke.Color := $FF505050;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ Stroke.Kind := TBrushKind.bkSolid;
+
+ FillRect(RectF(0, 0, Self.Width - 1, Self.Height - 1), 1, 1, AllCorners, 1);
+ SetLength(poly, 4);
+ poly[0] := PointF(1, Self.Height - 1);
+ poly[1] := PointF(Self.Width - 1, Self.Height - 1);
+ poly[2] := PointF(Self.Width - 1, 1);
+ poly[3] := PointF(1, 1);
+ DrawPolygon(poly, 1);
+
+ Stroke.Color := claSilver;
+ with FWorkspace, FWorkspace.FMargins do
+ r := RectF(Round(Left * FScale) + 0.5, Round(Top * FScale) + 0.5,
+ Self.Width - Round(Right * FScale) + 1.5,
+ Self.Height - Round(Bottom * FScale) + 1.5);
+ SetLength(poly, 5);
+
+ poly[0] := PointF(r.Left - 1, r.Top - 1);
+ poly[1] := PointF(r.Left - 1, r.Bottom);
+ poly[2] := PointF(r.Right, r.Bottom);
+ poly[3] := PointF(r.Right, r.Top - 1);
+ poly[4] := PointF(r.Left - 1, r.Top - 1);
+{$IFDEF Delphi25}
+ Stroke.Dash := TStrokeDash.sdDash;
+{$ELSE}
+ StrokeDash := TStrokeDash.sdDash;
+{$ENDIF}
+ DrawPolygon(poly, 1);
+ end;
+ finally
+ Canvas.SetMatrix(oldM);
+ Canvas.RestoreState(sstate);
+ end;
+end;
+
+
+{ TfrxDesignerWorkspace }
+
+constructor TfrxDesignerWorkspace.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FSavedAlign := TList.Create;
+ FDrawSelection := False;
+ FMarginsPanel := TMarginsPanel.Create(AOwner);
+ TMarginsPanel(FMarginsPanel).FWorkspace := Self;
+
+ FBandHeader := fr01cm * 5;
+ FColor := claWhite;
+ FGridAlign := True;
+ FGridType := gt1cm;
+ FGridX := fr01cm;
+ FGridY := fr01cm;
+ FMode := dmSelect;
+ FMode1 := dmNone;
+ FScale := 1;
+ FShowGrid := True;
+ FShowEdges := True;
+ FGridLCD := True;
+ StyleLookup := 'backgroundstyle';
+ CanFocus := True;
+ AutoCapture := True;
+ FFastCanvas := nil;
+ FParentForm := nil;
+ if frxCanvasClass <> nil then
+ FFastCanvas := frxCanvasClass.Create;
+end;
+
+destructor TfrxDesignerWorkspace.Destroy;
+begin
+ FSavedAlign.Free;
+ FreeAndNil(FFastCanvas);
+ inherited;
+end;
+
+procedure TfrxDesignerWorkspace.SetParent(const Value: TFmxObject);
+begin
+ if not (csDestroying in ComponentState) then
+ FMarginsPanel.Parent := Value;
+ inherited;
+ FParentForm := nil;
+end;
+
+procedure TfrxDesignerWorkspace.DisableUpdate;
+begin
+ FDisableUpdate := True;
+ FMode := dmSelect;
+ FMode1 := dmNone;
+end;
+
+procedure TfrxDesignerWorkspace.EnableUpdate;
+begin
+ FDisableUpdate := False;
+end;
+
+procedure TfrxDesignerWorkspace.UpdateView;
+var
+ NotifyRect: TfrxRect;
+begin
+ Repaint;
+ if SelectedCount = 0 then
+ NotifyRect := frxRect(0, 0, 0, 0) else
+ NotifyRect := GetSelectionBounds;
+ if Assigned(FOnNotifyPosition) then
+ FOnNotifyPosition(NotifyRect);
+end;
+
+procedure TfrxDesignerWorkspace.SetInsertion(AClass: TfrxComponentClass;
+ AWidth, AHeight: Extended; AFlag: Word);
+begin
+ with FInsertion do
+ begin
+ ComponentClass := AClass;
+ Width := AWidth;
+ Height := AHeight;
+ OriginalWidth := AWidth;
+ OriginalHeight := AHeight;
+ Flags := AFlag;
+ end;
+
+ FMode := dmInsert;
+ if AClass = nil then
+ begin
+ Cursor := crDefault;
+ FMode := dmSelect;
+ FMode1 := dmNone;
+ end
+ else if AClass.InheritsFrom(TfrxCustomLineView) then
+ begin
+ FMode1 := dmInsertLine;
+ if FGridType = gtChar then
+ begin
+ FInsertion.Left := - FGridX / 2;
+ FInsertion.Top := - FGridY / 2;
+ end
+ else
+ begin
+ FInsertion.Left := - FGridX;
+ FInsertion.Top := - FGridY;
+ end;
+ end
+ else
+ begin
+ Cursor := crCross;
+ FMode1 := dmInsertObject;
+ FInsertion.Left := -1000 * FGridX;
+ FInsertion.Top := -1000 * FGridY;
+ end;
+end;
+
+procedure TfrxDesignerWorkspace.SetScale(Value: Extended);
+begin
+ FScale := Value;
+ FMarginsPanel.Width := Round(FPageWidth * FScale);
+ FMarginsPanel.Height := Round(FPageHeight * FScale);
+
+ SetBounds(FMarginsPanel.Position.X + Round(FMargins.Left * FScale),
+ FMarginsPanel.Position.Y + Round(FMargins.Top * FScale),
+ FMarginsPanel.Width - Round((FMargins.Left + FMargins.Right - 1) * FScale),
+ FMarginsPanel.Height - Round((FMargins.Top + FMargins.Bottom - 1) * FScale));
+
+ FMarginsPanel.Repaint;
+ Repaint;
+end;
+
+procedure TfrxDesignerWorkspace.SetPageDimensions(AWidth, AHeight: Integer;
+ AMargins: TRect);
+begin
+ FPageWidth := AWidth;
+ FPageHeight := AHeight;
+ FMargins := AMargins;
+ SetScale(FScale);
+ AdjustBands;
+ Resize;
+{$IFNDEF Delphi17}
+ if Parent is TControl then
+ TControl(Parent).Realign;
+{$ENDIF}
+end;
+
+procedure TfrxDesignerWorkspace.SetShowGrid(const Value: Boolean);
+begin
+ FShowGrid := Value;
+ Repaint;
+end;
+
+procedure TfrxDesignerWorkspace.UpdateBandHeader;
+begin
+ case FGridType of
+ gt1pt, gtDialog:
+ FBandHeader := 16;
+ gt1cm:
+ FBandHeader := fr01cm * 5;
+ gt1in:
+ FBandHeader := fr01in * 2;
+ gtChar:
+ FBandHeader := fr1CharY;
+ end;
+
+ if not FShowBandCaptions then
+ FBandHeader := 0;
+end;
+
+procedure TfrxDesignerWorkspace.SetGridType(const Value: TfrxGridType);
+begin
+ FGridType := Value;
+ UpdateBandHeader;
+ if FSelectedObjects.Count <> 0 then
+ MouseMove([], 0, 0);
+ AdjustBands;
+ Repaint;
+end;
+
+procedure TfrxDesignerWorkspace.SetShowBandCaptions(const Value: Boolean);
+begin
+ FShowBandCaptions := Value;
+ UpdateBandHeader;
+ AdjustBands;
+ Repaint;
+end;
+
+function TfrxDesignerWorkspace.GetOrigin: TPoint;
+begin
+ Result.X := Round(FMarginsPanel.Position.X);
+ Result.Y := Round(FMarginsPanel.Position.Y);
+end;
+
+procedure TfrxDesignerWorkspace.SetOrigin(const Value: TPoint);
+begin
+ FMarginsPanel.Position.X := Value.X;
+ FMarginsPanel.Position.Y := Value.Y;
+end;
+
+procedure TfrxDesignerWorkspace.SetColor(const Value: TAlphaColor);
+begin
+ FColor := Value;
+end;
+
+procedure TfrxDesignerWorkspace.DoDeactivate;
+begin
+ inherited;
+ if FMouseDown then
+ MouseUp(TMouseButton.mbLeft, [], FLastMousePointX * FScale, FLastMousePointY * FScale);
+end;
+
+procedure TfrxDesignerWorkspace.DoDraw(ACanvas: TCanvas);
+begin
+ ACanvas.Fill.Color := FColor;
+ ACanvas.Fill.Kind := TBrushKind.bkSolid;
+ DrawBackground;
+ if not FDisableUpdate then
+ begin
+ if (FPage <> nil) and (FPage is TfrxReportPage) then
+ TfrxReportPage(FPage).Draw(ACanvas, FScale, FScale,
+ -FMargins.Left * FScale, -FMargins.Top * FScale);
+ DrawObjects;
+ end;
+ DrawSelectionRect;
+ DrawInsertionRect;
+ DrawCross;
+end;
+
+procedure TfrxDesignerWorkspace.DoModify;
+begin
+ if FModifyFlag then
+ if Assigned(FOnModify) then
+ FOnModify(Self);
+ FModifyFlag := False;
+end;
+
+procedure TfrxDesignerWorkspace.SelectionChanged;
+var
+ i, j: Integer;
+ c, c1: TfrxComponent;
+begin
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if (c is TfrxReportComponent) and (c.GroupIndex <> 0) then
+ for j := 0 to FObjects.Count - 1 do
+ begin
+ c1 := FObjects[j];
+ if (c1 is TfrxReportComponent) and (c1.GroupIndex = c.GroupIndex) then
+ begin
+ if FSelectedObjects.IndexOf(c1) = -1 then
+ FSelectedObjects.Add(c1);
+ end;
+ end;
+ end;
+
+ if Assigned(FOnSelectionChanged) then
+ FOnSelectionChanged(Self);
+ Repaint;
+end;
+
+function TfrxDesignerWorkspace.GetSelectionBounds: TfrxRect;
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ if SelectedCount = 1 then
+ begin
+ with TfrxComponent(FSelectedObjects[0]) do
+ Result := frxRect(Left, Top, Width, Height);
+ Exit;
+ end;
+
+ Result := frxRect(1e10, 1e10, -1e10, -1e10);
+
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+
+ if c.AbsLeft < Result.Left then
+ Result.Left := c.AbsLeft;
+ if c.AbsTop < Result.Top then
+ Result.Top := c.AbsTop;
+ if c.AbsLeft + c.Width > Result.Right then
+ Result.Right := c.AbsLeft + c.Width;
+ if c.AbsTop + c.Height > Result.Bottom then
+ Result.Bottom := c.AbsTop + c.Height;
+ end;
+
+ with Result do
+ Result := frxRect(Left, Top, Right - Left, Bottom - Top);
+end;
+
+function TfrxDesignerWorkspace.GetRightBottomObject: TfrxComponent;
+var
+ i: Integer;
+ c: TfrxComponent;
+ maxx, maxy: Extended;
+begin
+ maxx := 0;
+ maxy := 0;
+ Result := nil;
+
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if (c.AbsLeft + c.Width > maxx) or
+ ((c.AbsLeft + c.Width = maxx) and (c.AbsTop + c.Height > maxy)) then
+ begin
+ maxx := c.AbsLeft + c.Width;
+ maxy := c.AbsTop + c.Height;
+ Result := c;
+ end;
+ end;
+end;
+
+function TfrxDesignerWorkspace.SelectedCount: Integer;
+begin
+ Result := FSelectedObjects.Count;
+ if (Result = 1) and
+ ((FSelectedObjects[0] = FPage) or (TObject(FSelectedObjects[0]) is TfrxReport)) then
+ Result := 0;
+end;
+
+procedure TfrxDesignerWorkspace.DoPaint;
+var
+ Sstate: TCanvasSaveState;
+ oldM: TMatrix;
+begin
+ FCanvas := Canvas;
+ Sstate := FCanvas.SaveState;
+ oldM := FCanvas.Matrix;
+ try
+ FCanvas.SetMatrix(CreateTranslateMatrix(AbsoluteRect.Left, AbsoluteRect.Top));
+ DoDraw(FCanvas);
+ finally
+ FCanvas.SetMatrix(oldM);
+ FCanvas.RestoreState(Sstate);
+ end;
+ FCanvas := nil;
+end;
+
+procedure TfrxDesignerWorkspace.DrawObjects;
+var
+ i: Integer;
+ c: TfrxComponent;
+
+ procedure DrawPoint(x, y: Extended);
+ var
+ i, w: Integer;
+ begin
+ if FScale > 1.7 then
+ w := 7
+ else if FScale < 0.7 then
+ w := 3 else
+ w := 5;
+ for i := 0 to w - 1 do
+ begin
+ FCanvas.DrawLine(
+ PointF(Round(x * FScale - w div 2) + 0.5, Round(y * FScale - w div 2 + i) + 0.5),
+ PointF(Round(x * FScale + w div 2) + 0.5, Round(y * FScale - w div 2 + i) + 0.5), 1);
+ end;
+ end;
+
+ procedure DrawLineA(x, y, dx, dy: Extended);
+ begin
+ FCanvas.DrawLine(PointF(Round(x * FScale) + 0.5, Round(y * FScale) + 0.5),
+ PointF(Round((x + dx) * FScale) + 0.5, Round((y + dy) * FScale) + 0.5), 1);
+ end;
+
+ procedure DrawSqares(c: TfrxComponent);
+ var
+ px, py: Extended;
+ begin
+ with c, FCanvas do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ Stroke.Color := claBlack;
+ px := AbsLeft + c.Width / 2;
+ py := AbsTop + c.Height / 2;
+
+ DrawPoint(AbsLeft, AbsTop);
+ if not (c is TfrxCustomLineView) then
+ begin
+ DrawPoint(AbsLeft + c.Width, AbsTop);
+ DrawPoint(AbsLeft, AbsTop + c.Height);
+ end;
+ if (SelectedCount > 1) and (c = GetRightBottomObject) then
+ Stroke.Color := claTeal;
+ DrawPoint(AbsLeft + c.Width, AbsTop + c.Height);
+
+ Stroke.Color := claBlack;
+ if (SelectedCount = 1) and not (c is TfrxCustomLineView) then
+ begin
+ DrawPoint(px, AbsTop); DrawPoint(px, AbsTop + c.Height);
+ DrawPoint(AbsLeft, py); DrawPoint(AbsLeft + c.Width, py);
+ end;
+ end;
+ end;
+
+ procedure DrawDialogPageSquares;
+ begin
+ with FCanvas, TfrxDialogPage(FPage) do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ Stroke.Color := claBlack;
+
+ DrawPoint(ClientWidth - 2, ClientHeight - 2);
+ DrawPoint(ClientWidth - 2, ClientHeight / 2 - 1);
+ DrawPoint(ClientWidth / 2 - 1, ClientHeight - 2);
+ end;
+ end;
+
+ procedure DrawScriptSign(c: TfrxReportComponent);
+ var
+ NeedDraw: Boolean;
+ Offs: Extended;
+ begin
+ NeedDraw := False;
+ Offs := 0;
+ if c is TfrxReportComponent then
+ with c do
+ if (OnBeforePrint <> '') or (OnAfterPrint <> '') or
+ (OnAfterData <> '') or (OnPreviewClick <> '') then
+ NeedDraw := True;
+ if c is TfrxDialogControl then
+ with TfrxDialogControl(c) do
+ if (OnClick <> '') or (OnDblClick <> '') or
+ (OnEnter <> '') or (OnExit <> '') or
+ (OnKeyDown <> '') or (OnKeyPress <> '') or
+ (OnKeyUp <> '') or (OnMouseDown <> '') or
+ (OnMouseMove <> '') or (OnMouseUp <> '') then
+ NeedDraw := True;
+ if c is TfrxBand then
+ with TfrxBand(c) do
+ begin
+ if (OnAfterCalcHeight <> '') then
+ NeedDraw := True;
+ if not Vertical then
+ Offs := -FBandHeader + 2;
+ end;
+
+ if NeedDraw then
+ with c, FCanvas do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := claRed;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ DrawLineA(AbsLeft + 2, AbsTop + Offs + 1, 0, 7);
+ DrawLineA(AbsLeft + 3, AbsTop + Offs + 2, 0, 5);
+ DrawLineA(AbsLeft + 4, AbsTop + Offs + 3, 0, 3);
+ DrawLineA(AbsLeft + 5, AbsTop + Offs + 4, 0, 1);
+ end;
+ end;
+
+ procedure DrawObject(c: TfrxReportComponent);
+ var
+ s: String;
+ i, x: Integer;
+ y, w: Single;
+ d: TfrxDataBand;
+ MatrixR: TMatrix;
+ StateSave: TCanvasSaveState;
+ bName: String;
+ begin
+ c.IsDesigning := True;
+ if c is TfrxView then
+ TfrxView(c).SetFastCanvas(FFastCanvas);
+ c.Draw(FCanvas, FScale, FScale, FOffsetX, FOffsetY);
+ if c is TfrxBand then
+ with c as TfrxBand, FCanvas do
+ begin
+ if Vertical then
+ begin
+ Top := 0;
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := claGray;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ Fill.Kind := TBrushKind.bkSolid;
+ x := Round((Left - FBandHeader) * FScale);
+ DrawRect(RectF(x, 0, Round((Left + c.Width) * FScale) + 1, Round((c.Height) * FScale)), 1, 1, AllCorners, 1, TCornerType.ctBevel);
+
+ if FShowBandCaptions then
+ begin
+ Fill.Kind := TBrushKind.bkSolid;
+ if c is TfrxDataBand then
+ Fill.Color := $FFEEBB00 else
+ Fill.Color := claGray;
+ FillRect(RectF(x + 1, 1, Round(Left * FScale), Round(c.Height * FScale)), 1, 1, AllCorners, 1, TCornerType.ctBevel);
+ end;
+
+ Font.Family := DefFontName;
+ Font.Size := Round(8 * FScale);
+ Font.Style := [];
+ MatrixR := CreateRotationMatrix(90);
+ StateSave := SaveState;
+ y := TextWidth(Name) + 4;
+ FillText(RectF(x + 2, y, 20, y * 2), Name, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ Font.Style := [TFontStyle.fsBold];
+ bName := frxResources.Get(BandName);
+ FillText(RectF(x + 2, y + TextWidth(bName + ': ') + 2, 20, (y + TextWidth(bName + ': ') + 2) * 2), bName + ': ', False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ RestoreState(StateSave);
+ end
+ else
+ begin
+ Left := 0;
+ //if (Page is TfrxReportPage) and (TfrxReportPage(Page).Columns > 1) then
+ //if BandNumber in [4..16] then
+ //Width := TfrxReportPage(Page).ColumnWidth * fr01cm;
+ //todo
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := claGray;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ Fill.Kind := TBrushKind.bkNone;
+ y := Round((Top - FBandHeader) * FScale);
+ DrawRect(RectF(0.5, y + 0.5, Round(c.Width * FScale) + 0.5, Round((c.Top + c.Height) * FScale) + 0.5), 1, 1, AllCorners, 1);
+
+ if FShowBandCaptions then
+ begin
+ Fill.Kind := TBrushKind.bkSolid;
+ if c is TfrxDataBand then
+ Fill.Color := $FFE0A730
+ else
+ Fill.Color := claLightgray;
+ FillRect(RectF(1, y + 1, Round(c.Width * FScale), Round(c.Top * FScale)), 1, 1, AllCorners, 1, TCornerType.ctBevel);
+ end;
+
+ Font.Family := DefFontName;
+ Font.Size := Round(10 * FScale);
+ Font.Style := [TFontStyle.fsBold];
+ bName := frxResources.Get(BandName);
+ Fill.Kind := TBrushKind.bkSolid;
+ Fill.Color := claBlack;
+ FillText(RectF(6, y + 2, c.Width, y + 22), bName, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+
+ w := TextWidth(bName);
+ Font.Style := [];
+ FillText(RectF(6 + w, y + 2, c.Width, y + 22), ': ' + Name, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+
+ if c is TfrxDataBand then
+ begin
+ d := TfrxDataBand(c);
+
+ if FShowBandCaptions then
+ begin
+ if (d.DataSet <> nil) and (c.Report <> nil) then
+ s := c.Report.GetAlias(d.DataSet)
+ else if d.RowCount <> 0 then
+ s := IntToStr(d.RowCount)
+ else
+ s := '';
+ w := TextWidth(s);
+ //if FScale > 0.7 then
+ // frxResources.MainButtonImages.Draw(FCanvas,
+ // Round(Width * FScale - w - 24), Round(y + 2 * FScale), 53);
+ if s <> '' then
+ FillText(RectF(c.Width * FScale - w - 3, y + 3, c.Width, (y + 3) * 2), s, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ end;
+
+ if d.Columns > 1 then
+ begin
+{$IFDEF Delphi25}
+ Stroke.Dash := TStrokeDash.sdDot;
+{$ELSE}
+ StrokeDash := TStrokeDash.sdDot;
+{$ENDIF}
+ Stroke.Color := claBlack;
+ Fill.Kind := TBrushKind.bkNone;
+ for i := 1 to d.Columns do
+ DrawRect(RectF((i - 1) * (d.ColumnWidth + d.ColumnGap) * FScale, Top * FScale, ((i - 1) * (d.ColumnWidth + d.ColumnGap) + d.ColumnWidth) * FScale, (Top + c.Height) * FScale), 1, 1, AllCorners, 1, TCornerType.ctBevel);
+ end;
+ end;
+ if c is TfrxGroupHeader then
+ begin
+ s := TfrxGroupHeader(c).Condition;
+ if s <> '' then
+ if FShowBandCaptions then
+ FillText(RectF(c.Width * FScale - TextWidth(s) - 3, y + 3, 20, (c.Width * FScale - TextWidth(s) - 3) * 2), s, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ end;
+ end
+ end
+ else if not (c is TfrxCustomLineView) and not (c is TfrxDialogComponent) and
+ not (c is TfrxDialogControl) then
+ with c, FCanvas do
+ if FShowEdges and not (FPage is TfrxDataPage) and (c is TfrxView) and
+ (TfrxView(c).Frame.Typ <> [ftLeft, ftRight, ftTop, ftBottom]) then
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := claBlack;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ DrawLineA(AbsLeft, AbsTop + 3, 0, -3);
+ DrawLineA(AbsLeft, AbsTop, 4, 0);
+ DrawLineA(AbsLeft, AbsTop + c.Height - 3, 0, 3);
+ DrawLineA(AbsLeft, AbsTop + c.Height, 4, 0);
+ DrawLineA(AbsLeft + c.Width - 3, AbsTop, 3, 0);
+ DrawLineA(AbsLeft + c.Width, AbsTop, 0, 4);
+ DrawLineA(AbsLeft + c.Width - 3, AbsTop + c.Height, 3, 0);
+ DrawLineA(AbsLeft + c.Width, AbsTop + c.Height, 0, -4);
+ end;
+ if c is TfrxView then
+ TfrxView(c).SetFastCanvas(nil);
+ DrawScriptSign(c);
+
+{ if c.IsAncestor then
+ frxResources.MainButtonImages.Draw(FCanvas,
+ Round((c.AbsLeft + 2) * FScale), Round((c.AbsTop + 1) * FScale), 99);}
+ end;
+
+ // debug
+ procedure DrawShiftTree(c: TfrxReportComponent);
+ var
+ i: Integer;
+ c1: TfrxReportComponent;
+ begin
+ for i := 0 to c.FShiftChildren.Count - 1 do
+ begin
+ c1 := c.FShiftChildren[i];
+ with FCanvas do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := claRed;
+ //Pen.Mode := pmCopy;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ if c is TfrxBand then
+ DrawLine(PointF(c.AbsLeft + c.Width / 2, c.AbsTop), PointF(c1.AbsLeft + c1.Width / 2, c1.AbsTop), 1)
+ else
+ DrawLine(PointF(c.AbsLeft + c.Width / 2, c.AbsTop + c.Height), PointF(c1.AbsLeft + c1.Width / 2, c1.AbsTop), 1);
+ end;
+ DrawShiftTree(c1);
+ end;
+ end;
+
+
+begin
+ if Assigned(FFastCanvas)then
+ begin
+ TfrxFastCanvasLayer(FFastCanvas).UpdateHandle(Parent);
+ TfrxFastCanvasLayer(FFastCanvas).Canvas := Canvas;
+ end;
+ { update aligned objects }
+ if Page is TfrxReportPage then
+ Page.AlignChildren;
+
+ { draw objects }
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if c is TfrxReportComponent then
+ DrawObject(TfrxReportComponent(c));
+ end;
+
+ // debug
+{ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if c is TfrxBand then
+ begin
+ PrepareShiftTree(TfrxBand(c));
+ DrawShiftTree(TfrxReportComponent(c));
+ end;
+ end;}
+
+
+ { draw selection }
+ for i := 0 to SelectedCount - 1 do
+ if not FMouseDown then
+ DrawSqares(FSelectedObjects[i]);
+ if (FSelectedObjects.Count = 1) and (TObject(FSelectedObjects[0]) is TfrxDialogPage) then
+ DrawDialogPageSquares;
+end;
+
+procedure TfrxDesignerWorkspace.DrawBackground;
+
+ procedure Line(x, y, x1, y1: Extended);
+ begin
+ FCanvas.DrawLine(PointF(x, y), PointF(x1, y1), 1);
+ end;
+
+ procedure DrawPoints;
+ var
+ GridBmp: TBitmap;
+{$IFDEF Delphi17}
+ map: TBitmapData;
+{$ENDIF}
+ i: Extended;
+ c: TAlphaColor;
+ dx, dy: Extended;
+ begin
+ if FGridType = gtDialog then
+ c := claBlack else
+ c := claGray;
+ dx := FGridX * FScale;
+ dy := FGridY * FScale;
+ if (dx > 2) and (dy > 2) then
+ begin
+ GridBmp := TBitmap.Create(Round(Width), 1);
+
+ GridBmp.Canvas.BeginScene();
+ GridBmp.Canvas.Stroke.Color := FColor;
+ GridBmp.Canvas.DrawLine(PointF(0, 0), PointF(Width, 0), 1);
+
+{$IFDEF Delphi17}
+ if GridBmp.Map(TMapAccess.maReadWrite, map) then
+ begin
+ i := 0;
+ while i < Width do
+ begin
+ map.SetPixel(Round(i), 0, c);
+ i := i + dx;
+ end;
+ GridBmp.UnMap(map);
+ end;
+{$ELSE}
+ i := 0;
+ while i < Width do
+ begin
+ GridBmp.Pixels[Round(i), 0] := c;
+ i := i + dx;
+ end;
+{$ENDIF}
+
+ GridBmp.Canvas.EndScene;
+ i := 0;
+ while i < Height do
+ begin
+ FCanvas.DrawBitmap(GridBmp, RectF(0, 0, Width, 1), RectF(0, i, Width, i + 1), 1, True);
+ i := i + dy;
+ end;
+
+ GridBmp.Free;
+ end;
+ end;
+
+ procedure DrawMM;
+ var
+ i, dx, maxi: Extended;
+ i1: Integer;
+ Color5, Color10: TAlphaColor;
+ SState: TCanvasSaveState;
+ begin
+ if FGridLCD then
+ begin
+ Color5 := $FFF2F2F2;
+ Color10 := $FFE2E2E2;
+ end
+ else
+ begin
+ Color5 := $FFF8F8F8;
+ Color10 := $FFE8E8E8;
+ end;
+
+ with FCanvas do
+ begin
+ SState := SaveState;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ Stroke.Kind := TBrushKind.bkSolid;
+ Canvas.IntersectClipRect(RectF(0,0,(Self.FPageWidth - (FMargins.Left + FMargins.Right)) * FScale, (Self.FPageHeight - (FMargins.Top + FMargins.Bottom)) * FScale));
+ if FGridType = gt1cm then
+ dx := fr01cm * FScale else
+ dx := fr01in * FScale;
+
+ if Self.Width > Self.Height then
+ maxi := Self.FPageWidth * FScale else
+ maxi := Self.FPageHeight * FScale;
+
+ i := 0;
+ i1 := 0;
+ while i < maxi do
+ begin
+ if i1 mod 10 = 0 then
+ Stroke.Color := Color10
+ else if i1 mod 5 = 0 then
+ Stroke.Color := Color5
+ else if FGridType = gt1in then
+ Stroke.Color := Color5
+ else
+ Stroke.Color := claWhite;
+ if Stroke.Color <> claWhite then
+ begin
+ if Self.Width >= Round(i) then
+ Line(Round(i) + 0.5, 0, Round(i) + 0.5, Round(Self.FPageHeight) * FScale);
+ if Self.Height >= Round(i) then
+ Line(0, Round(i) + 0.5, Round(Self.FPageWidth) * FScale, Round(i) + 0.5);
+ end;
+ i := i + dx;
+ Inc(i1);
+ end;
+ RestoreState(SState);
+ end;
+ end;
+
+begin
+ FCanvas.Fill.Color := FColor;
+ FCanvas.Fill.Kind := TBrushKind.bkSolid;
+ FCanvas.FillRect(RectF(0, 0, Width, Height), 1, 1, AllCorners, 1, TCornerType.ctBevel);
+
+ if FShowGrid then
+ case FGridType of
+ gt1pt, gtDialog, gtChar:
+ DrawPoints;
+ gt1cm, gt1in:
+ DrawMM;
+ end;
+end;
+
+procedure TfrxDesignerWorkspace.DrawSelectionRect;
+var
+ sLeft, sTop, sRight, sBottom: Single;
+begin
+ if not FDrawSelection then Exit;
+
+ with Canvas do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := claBlack;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+ Stroke.Dash := TStrokeDash.sdDot;
+{$ELSE}
+ StrokeThickness := 1;
+ StrokeDash := TStrokeDash.sdDot;
+{$ENDIF}
+ Fill.Kind := TBrushKind.bkNone;
+ with FSelectionRect do
+ begin
+ sLeft := Left;
+ sRight := Right;
+ sTop := Top;
+ sBottom := Bottom;
+ if Right < Left then
+ begin
+ sLeft := Right;
+ sRight := Left;
+ end;
+ if Bottom < Top then
+ begin
+ sTop := Bottom;
+ sBottom := Top;
+ end;
+ end;
+
+ DrawRect(RectF(Round(sLeft) + 0.5, Round(sTop) + 0.5, Round(sRight) + 0.5, Round(sBottom) + 0.5), 1, 1, AllCorners, 0.5);
+ Fill.Kind := TBrushKind.bkSolid;
+ end;
+end;
+
+procedure TfrxDesignerWorkspace.DrawInsertionRect;
+var
+ R: TfrxRect;
+begin
+ if not FDrawInsertion then Exit;
+
+ with Canvas do
+ begin
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := claBlack;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+ Stroke.Dash := TStrokeDash.sdDot;
+{$ELSE}
+ StrokeThickness := 1;
+ StrokeDash := TStrokeDash.sdDot;
+{$ENDIF}
+ with FInsertion do
+ R := frxRect(Left, Top, Left + FInsertion.Width, Top + FInsertion.Height);
+ NormalizeRect(R);
+ DrawRect(RectF(Round(R.Left * FScale) + 0.5, Round(R.Top * FScale) + 0.5, Round(R.Right * FScale) + 0.5, Round(R.Bottom * FScale) + 0.5), 1, 1, AllCorners, 1);
+ end;
+end;
+
+procedure TfrxDesignerWorkspace.DrawCross;
+var
+ x, y: Extended;
+begin
+ if FMode1 <> dmInsertLine then
+ Exit;
+
+ with FInsertion do
+ if FMouseDown then
+ begin
+ if Flags <> 0 then
+ begin
+ x := (Left + Width) * FScale;
+ y := (Top + Height) * FScale;
+ end
+ else if Abs(Width) > Abs(Height) then
+ begin
+ x := (Left + Width) * FScale;
+ y := Top * FScale;
+ end
+ else
+ begin
+ x := Left * FScale;
+ y := (Top + Height) * FScale;
+ end;
+ end
+ else
+ begin
+ x := Left * FScale;
+ y := Top * FScale;
+ end;
+
+ with Canvas do
+ begin
+ Stroke.Color := claBlack;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ Stroke.Kind := TBrushKind.bkSolid;
+
+ DrawLine(PointF(Round(x) - 3.5, Round(y) + 0.5), PointF(Round(x) + 4.5, Round(y) + 0.5), 1);
+ DrawLine(PointF(Round(x) + 0.5, Round(y) - 3.5), PointF(Round(x) + 0.5, Round(y) + 4.5), 1);
+
+ if FMouseDown then
+ DrawLine(PointF(Round(FInsertion.Left * FScale) + 0.5, Round(FInsertion.Top * FScale) + 0.5),
+ PointF(Round(x) + 0.5, Round(y) + 0.5), 1);
+ end;
+end;
+
+procedure TfrxDesignerWorkspace.FindNearest(dx, dy: Integer);
+var
+ i: Integer;
+ c, sel, found: TfrxComponent;
+ min, dist, dist_dx, dist_dy: Extended;
+ r1, r2, r3: TfrxRect;
+
+ function RectsIntersect(r1, r2: TfrxRect): Boolean;
+ begin
+ Result := not ((r2.Left > r1.Right) or (r2.Right < r1.Left) or
+ (r2.Top > r1.Bottom) or (r2.Bottom < r1.Top));
+ end;
+
+begin
+ if SelectedCount <> 1 then Exit;
+
+ found := nil;
+ sel := FSelectedObjects[0];
+ min := 1e10;
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if not (c is TfrxReportComponent) or (c is TfrxBand) or (c = sel) then continue;
+
+ r1 := frxRect(c.AbsLeft, c.AbsTop, c.AbsLeft + c.Width, c.AbsTop + c.Height);
+ dist := 0;
+ dist_dx := 0;
+ dist_dy := 0;
+ with sel do
+ if dx = 1 then
+ begin
+ r2 := frxRect(AbsLeft, AbsTop, 1e10, AbsTop + Height);
+ r3 := frxRect(AbsLeft, 0, 1e10, 1e10);
+ dist := r1.Left - r2.Left;
+ dist_dx := r1.Left - (AbsLeft + Width);
+ if r1.Top > r2.Top then
+ dist_dy := r1.Top - r2.Bottom else
+ dist_dy := r2.Top - r1.Bottom;
+ end
+ else if dx = -1 then
+ begin
+ r2 := frxRect(-1e10, AbsTop, AbsLeft + Width, AbsTop + Height);
+ r3 := frxRect(0, 0, AbsLeft + Width, 1e10);
+ dist := r2.Right - r1.Right;
+ dist_dx := AbsLeft - r1.Right;
+ if r1.Top > r2.Top then
+ dist_dy := r1.Top - r2.Bottom else
+ dist_dy := r2.Top - r1.Bottom;
+ end
+ else if dy = 1 then
+ begin
+ r2 := frxRect(AbsLeft, AbsTop, AbsLeft + Width, 1e10);
+ r3 := frxRect(0, AbsTop, 1e10, 1e10);
+ dist := r1.Top - r2.Top;
+ dist_dy := r1.Top - (AbsTop + Height);
+ if r1.Left > r2.Left then
+ dist_dx := r1.Left - r2.Right else
+ dist_dx := r2.Left - r1.Right;
+ end
+ else if dy = -1 then
+ begin
+ r2 := frxRect(AbsLeft, -1e10, AbsLeft + Width, AbsTop + Height);
+ r3 := frxRect(0, 0, 1e10, AbsTop + Height);
+ dist := r2.Bottom - r1.Bottom;
+ dist_dy := AbsTop - r1.Bottom;
+ if r1.Left > r2.Left then
+ dist_dx := r1.Left - r2.Right else
+ dist_dx := r2.Left - r1.Right;
+ end;
+
+ if not RectsIntersect(r1, r2) then
+ begin
+ if (not RectsIntersect(r1, r3)) or
+ ((dx <> 0) and (dist_dx < dist_dy)) or
+ ((dy <> 0) and (dist_dy < dist_dx)) or
+ ((dist_dx = 0) and (dist_dy = 0)) then continue;
+ dist := sqrt(dist_dx * dist_dx + dist_dy * dist_dy) * (Width + Height);
+ end;
+
+ if dist < min then
+ begin
+ found := c;
+ min := dist;
+ end;
+ end;
+
+ if found <> nil then
+ begin
+ FSelectedObjects.Clear;
+ FSelectedObjects.Add(found);
+ if Assigned(FOnNotifyPosition) then
+ FOnNotifyPosition(GetSelectionBounds);
+ SelectionChanged;
+ end;
+end;
+
+procedure TfrxDesignerWorkspace.NormalizeCoord(c: TfrxComponent);
+begin
+ if c.Width < 0 then
+ begin
+ c.Width := -c.Width;
+ c.Left := c.Left - c.Width;
+ end;
+ if c.Height < 0 then
+ begin
+ c.Height := -c.Height;
+ c.Top := c.Top - c.Height;
+ end;
+end;
+
+procedure TfrxDesignerWorkspace.NormalizeRect(var R: TfrxRect);
+var
+ i: Extended;
+begin
+ with R do
+ begin
+ if Left > Right then
+ begin
+ i := Left;
+ Left := Right;
+ Right := i
+ end;
+ if Top > Bottom then
+ begin
+ i := Top;
+ Top := Bottom;
+ Bottom := i
+ end;
+ end;
+end;
+
+procedure TfrxDesignerWorkspace.AdjustBands(AttachObjects: Boolean = True);
+var
+ i, j: Integer;
+ sl: TfrxStringList;
+ b: TfrxBand;
+ c, c0: TfrxComponent;
+ add, add1: Extended;
+ l: TList;
+ ch: TfrxChild;
+
+ procedure DoBand(Bnd: TfrxBand);
+ var
+ y: Extended;
+ begin
+ if Bnd.Vertical then Exit;
+
+ if Bnd is TfrxPageHeader then
+ y := 0
+ else if Bnd is TfrxReportTitle then
+ y := 0.01
+ else if Bnd is TfrxColumnHeader then
+ y := 0.02
+ else if Bnd is TfrxColumnFooter then
+ y := 99999
+ else if Bnd is TfrxReportSummary then
+ y := 100000
+ else if Bnd is TfrxPageFooter then
+ y := 100001
+ else
+ y := Abs(Bnd.Top);
+
+ if TfrxReportPage(FPage).TitleBeforeHeader then
+ begin
+ if Bnd is TfrxReportTitle then
+ y := 0
+ else if Bnd is TfrxPageHeader then
+ y := 0.01
+ end;
+
+ sl.AddObject(Format('%9.2f', [y]), Bnd);
+ end;
+
+ procedure TossObjects(Bnd: TfrxBand);
+ var
+ i: Integer;
+ c: TfrxComponent;
+ SaveRestrictions: TfrxRestrictions;
+ begin
+ if Bnd.Vertical then Exit;
+
+ while Bnd.Objects.Count > 0 do
+ begin
+ c := Bnd.Objects[0];
+ SaveRestrictions := c.Restrictions;
+ c.Restrictions := [];
+ c.Top := c.AbsTop;
+ c.Restrictions := SaveRestrictions;
+ c.Parent := Bnd.Parent;
+ end;
+
+ if AttachObjects then
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if (c is TfrxView) and (c.AbsTop >= Bnd.Top - 1e-4) and (c.AbsTop < Bnd.Top + Bnd.Height + 1e-4) then
+ begin
+ SaveRestrictions := c.Restrictions;
+ c.Restrictions := [];
+ c.Top := c.AbsTop - Bnd.Top;
+ c.Restrictions := SaveRestrictions;
+ c.Parent := Bnd;
+ end;
+ end;
+ end;
+
+ function Round8(e: Extended): Extended;
+ begin
+ Result := Round(e * 100000000) / 100000000;
+ end;
+
+ procedure AdjustParent(Ctrl: TfrxComponent; Index: Integer);
+ var
+ i: Integer;
+ c: TfrxComponent;
+ found: Boolean;
+ begin
+ found := False;
+ for i := Index - 1 downto 0 do
+ begin
+ c := FObjects[i];
+ if (c <> Ctrl) and (c is TfrxDialogControl) {and
+ (csAcceptsControls in TfrxDialogControl(c).Control.ComponentStyle) }then
+ if (Ctrl.AbsLeft >= c.AbsLeft) and
+ (Ctrl.AbsTop >= c.AbsTop) and (Ctrl.AbsLeft < c.AbsLeft + c.Width) and
+ (Ctrl.AbsTop < c.AbsTop + c.Height) then
+ begin
+ Ctrl.Top := Ctrl.AbsTop - c.AbsTop;
+ Ctrl.Left := Ctrl.AbsLeft - c.AbsLeft;
+ Ctrl.Parent := c;
+ found := True;
+ break;
+ end;
+ end;
+
+ if not found and (Ctrl.Parent <> Page) then
+ begin
+ Ctrl.Top := Ctrl.AbsTop;
+ Ctrl.Left := Ctrl.AbsLeft;
+ Ctrl.Parent := Page;
+ BringToFront;
+ end;
+ //if Ctrl is TfrxDialogComponent then
+ // Ctrl.Parent := Self;
+
+ end;
+
+begin
+ sl := TfrxStringList.Create;
+ sl.Sorted := True;
+ sl.Duplicates := dupAccept;
+
+ { sort bands }
+ for i := 0 to FObjects.Count - 1 do
+ if TObject(FObjects[i]) is TfrxBand then
+ DoBand(FObjects[i]);
+
+ { arrange child bands }
+ sl.Sorted := False;
+ i := 0;
+ while i < sl.Count do
+ begin
+ sl[i] := '';
+ b := TfrxBand(sl.Objects[i]);
+ if b.Child <> nil then
+ begin
+ j := sl.IndexOfObject(b.Child);
+ if j <> -1 then
+ begin
+ c := TfrxComponent(sl.Objects[j]);
+ sl.Delete(j);
+ if j < i then
+ Dec(i);
+ sl.InsertObject(i + 1, '', c);
+ end;
+ end;
+ Inc(i);
+ end;
+
+ { set top/middle/bottom indexes }
+ i := 0;
+ while i < sl.Count do
+ begin
+ b := TfrxBand(sl.Objects[i]);
+ if sl[i] = '' then
+ if (b is TfrxPageHeader) or (b is TfrxReportTitle) or (b is TfrxColumnHeader) then
+ sl[i] := 'top'
+ else if (b is TfrxPageFooter) or (b is TfrxReportSummary) or (b is TfrxColumnFooter) then
+ sl[i] := 'bottom'
+ else
+ sl[i] := 'middle';
+ ch := b.Child;
+ while ch <> nil do
+ begin
+ j := sl.IndexOfObject(ch);
+ if j <> -1 then
+ sl[j] := sl[i];
+ ch := ch.Child;
+ end;
+ Inc(i);
+ end;
+
+ add1 := 0;
+ case FGridType of
+ gt1pt: add1 := 40;
+ gt1cm: add1 := fr1cm;
+ gt1in: add1 := fr1in * 0.4;
+ gtChar: add1 := fr1CharY;
+ end;
+
+ { rearrange all bands }
+ if not FFreeBandsPlacement then
+ for i := 0 to sl.Count - 1 do
+ begin
+ c := TfrxComponent(sl.Objects[i]);
+ if i = 0 then
+ c.Top := Round8(FBandHeader)
+ else
+ begin
+ c0 := TfrxComponent(sl.Objects[i - 1]);
+ if ((sl[i - 1] = 'top') and (sl[i] <> 'top')) or
+ ((sl[i] = 'bottom') and (sl[i - 1] <> 'bottom')) then
+ add := add1 else
+ add := 0;
+
+ c.Top := Round8(Round((c0.Top + c0.Height + FBandHeader + FGapBetweenBands)
+ / FGridY) * FGridY + add);
+ end;
+ end;
+
+ sl.Free;
+
+ { toss objects }
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if c is TfrxBand then
+ TossObjects(TfrxBand(c))
+ else if c is TfrxDialogControl then
+ AdjustParent(c, i);
+ end;
+
+ { move all bands to the begin of objects list }
+ l := TList.Create;
+ for i := 0 to FObjects.Count - 1 do
+ if TObject(FObjects[i]) is TfrxBand then
+ l.Add(FObjects[i]);
+ for i := 0 to FObjects.Count - 1 do
+ if not (TObject(FObjects[i]) is TfrxBand) then
+ l.Add(FObjects[i]);
+
+ FObjects.Clear;
+ for i := 0 to l.Count - 1 do
+ FObjects.Add(l[i]);
+ l.Free;
+end;
+
+procedure TfrxDesignerWorkspace.PrepareShiftTree(Band: TfrxBand);
+var
+ i, j, k: Integer;
+ c0, c1, c2, top: TfrxReportComponent;
+ allObjects: TStringList;
+ Found: Boolean;
+ area0, area1, area2, area01: TfrxRectArea;
+begin
+ allObjects := TfrxStringList.Create;
+ allObjects.Duplicates := dupAccept;
+
+ { temporary top object }
+ top := TfrxMemoView.Create(nil);
+ top.SetBounds(0, Band.Top-2, Band.Width, 1);
+
+ { sort objects }
+ for i := 0 to Band.Objects.Count - 1 do
+ begin
+ c0 := Band.Objects[i];
+ allObjects.AddObject(Format('%9.2f', [c0.Top]), c0);
+ c0.FShiftChildren.Clear;
+ end;
+ allObjects.Sort;
+ allObjects.InsertObject(0, Format('%10.2f', [top.Top]), top);
+
+ for i := 0 to allObjects.Count - 1 do
+ begin
+ c0 := TfrxReportComponent(allObjects.Objects[i]);
+ area0 := TfrxRectArea.Create(c0);
+
+ { find an object under c0 }
+ for j := i + 1 to allObjects.Count - 1 do
+ begin
+ c1 := TfrxReportComponent(allObjects.Objects[j]);
+ area1 := TfrxRectArea.Create(c1);
+
+ if not (area0.InterceptsY(area1)) and (area0.Y < area1.Y) and
+ area0.InterceptsX(area1) then
+ begin
+ area01 := area0.InterceptX(area1);
+ Found := False;
+
+ { check if there is no other objects between c1 and c0 }
+ for k := j - 1 downto i + 1 do
+ begin
+ c2 := TfrxReportComponent(allObjects.Objects[k]);
+ area2 := TfrxRectArea.Create(c2);
+
+ if not (area0.InterceptsY(area2)) and not (area1.InterceptsY(area2)) and
+ area01.InterceptsX(area2) then
+ Found := True;
+
+ area2.Free;
+ if Found then
+ break;
+ end;
+
+ if not Found then
+ c0.FShiftChildren.Add(c1);
+
+ area01.Free;
+ end;
+
+ area1.Free;
+ end;
+
+ area0.Free;
+ end;
+
+ { copy children from the top object to the band }
+ Band.FShiftChildren.Clear;
+ for i := 0 to top.FShiftChildren.Count - 1 do
+ Band.FShiftChildren.Add(top.FShiftChildren[i]);
+
+ allObjects.Free;
+ top.Free;
+end;
+
+procedure TfrxDesignerWorkspace.AdjustBandHeight(Bnd: TfrxBand);
+var
+ i: Integer;
+ max, min: Extended;
+ c: TfrxComponent;
+begin
+ max := 0;
+ min := 0;
+ for i := 0 to Bnd.Objects.Count - 1 do
+ begin
+ c := Bnd.Objects[i];
+ if (c is TfrxView) and (TfrxView(c).Align in [baClient, baBottom]) then
+ continue;
+ if c.Top + c.Height > max then
+ max := c.Top + c.Height;
+ if c.Top < min then
+ min := c.Top;
+ end;
+
+ max := max - min;
+ if Bnd.Height < max then
+ Bnd.Height := max;
+ if min < 0 then
+ for i := 0 to Bnd.Objects.Count - 1 do
+ with TfrxComponent(Bnd.Objects[i]) do
+ Top := Top - min;
+end;
+
+function TfrxDesignerWorkspace.ListsEqual(List1, List2: TList): Boolean;
+var
+ i: Integer;
+begin
+ Result := List1.Count = List2.Count;
+ if Result then
+ for i := 0 to List1.Count - 1 do
+ if List1.List[i] <> List2.List[i] then
+ Result := False;
+end;
+
+procedure TfrxDesignerWorkspace.DeleteObjects;
+var
+ c, c1: TfrxComponent;
+ i: Integer;
+begin
+ if SelectedCount = 0 then exit;
+
+ i := 0;
+ while FSelectedObjects.Count > i do
+ begin
+ c := FSelectedObjects[i];
+
+ if not (rfDontDelete in c.Restrictions) then
+ begin
+ if c.IsAncestor then
+ raise Exception.Create('Could not delete ' + c.Name + ', it was introduced in the ancestor report');
+ FSelectedObjects.Remove(c);
+ FObjects.Remove(c);
+
+ while c.Objects.Count > 0 do
+ begin
+ c1 := c.Objects[0];
+ FSelectedObjects.Remove(c1);
+ FObjects.Remove(c1);
+ c1.Free;
+ end;
+
+ c.Free;
+ end
+ else
+ Inc(i);
+ end;
+
+ if FSelectedObjects.Count = 0 then
+ FSelectedObjects.Add(FPage);
+
+ AdjustBands;
+ FModifyFlag := True;
+ DoModify;
+ SelectionChanged;
+end;
+
+procedure TfrxDesignerWorkspace.EditObject;
+begin
+ if FSelectedObjects.Count = 1 then
+ if Assigned(FOnEdit) then
+ FOnEdit(Self);
+end;
+
+procedure TfrxDesignerWorkspace.DoNudge(dx, dy: Extended; Smooth: Boolean);
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ if SelectedCount = 0 then exit;
+ if not Smooth or (GridType = gtChar) then
+ begin
+ dx := dx * FGridX;
+ dy := dy * FGridY;
+ end;
+
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ c.Left := c.Left + dx;
+ c.Top := c.Top + dy;
+ end;
+
+ FModifyFlag := True;
+ if Assigned(FOnNotifyPosition) then
+ FOnNotifyPosition(GetSelectionBounds);
+ Repaint;
+end;
+
+procedure TfrxDesignerWorkspace.DoSize(dx, dy: Extended);
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ if SelectedCount = 0 then exit;
+ dx := dx * FGridX;
+ dy := dy * FGridY;
+
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ c.Width := c.Width + dx;
+ if c.Width < 0 then
+ c.Width := c.Width - dx;
+ c.Height := c.Height + dy;
+ if c.Height < 0 then
+ c.Height := c.Height - dy;
+ end;
+
+ FModifyFlag := True;
+ if Assigned(FOnNotifyPosition) then
+ FOnNotifyPosition(GetSelectionBounds);
+ Repaint;
+end;
+
+procedure TfrxDesignerWorkspace.DoStick(dx, dy: Integer);
+var
+ i: Integer;
+ c, sel, found: TfrxComponent;
+ min, dist: Extended;
+ r1, r2: TfrxRect;
+ gapLeft, gapRight, gapTop, gapBottom: Extended;
+
+ function RectsIntersect(r1, r2: TfrxRect): Boolean;
+ begin
+ Result := not ((r2.Left > r1.Right) or (r2.Right < r1.Left) or
+ (r2.Top > r1.Bottom) or (r2.Bottom < r1.Top));
+ end;
+
+begin
+ if SelectedCount <> 1 then exit;
+
+ found := nil;
+ sel := FSelectedObjects[0];
+ min := 1e10;
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if not (c is TfrxReportComponent) or (c is TfrxBand) or (c = sel) then continue;
+
+ r1 := frxRect(c.AbsLeft, c.AbsTop, c.AbsLeft + c.Width, c.AbsTop + c.Height);
+ dist := 0;
+ with sel do
+ if dx = 1 then
+ begin
+ r2 := frxRect(AbsLeft, AbsTop, 1e10, AbsTop + Height);
+ dist := r1.Left - r2.Left;
+ end
+ else if dx = -1 then
+ begin
+ r2 := frxRect(-1e10, AbsTop, AbsLeft + Width, AbsTop + Height);
+ dist := r2.Right - r1.Right;
+ end
+ else if dy = 1 then
+ begin
+ r2 := frxRect(AbsLeft, AbsTop, AbsLeft + Width, 1e10);
+ dist := r1.Top - r2.Top;
+ end
+ else if dy = -1 then
+ begin
+ r2 := frxRect(AbsLeft, -1e10, AbsLeft + Width, AbsTop + Height);
+ dist := r2.Bottom - r1.Bottom;
+ end;
+
+ if RectsIntersect(r1, r2) then
+ if dist < min then
+ begin
+ found := c;
+ min := dist;
+ end;
+ end;
+
+ if found <> nil then
+ begin
+ gapLeft := 0;
+ gapRight := 0;
+ gapTop := 0;
+ gapBottom := 0;
+ if (sel is TfrxDMPMemoView) and (found is TfrxDMPMemoView) then
+ begin
+ if (ftLeft in TfrxDMPMemoView(sel).Frame.Typ) or
+ (ftRight in TfrxDMPMemoView(found).Frame.Typ) then
+ gapLeft := fr1CharX;
+ if (ftRight in TfrxDMPMemoView(sel).Frame.Typ) or
+ (ftLeft in TfrxDMPMemoView(found).Frame.Typ) then
+ gapRight := fr1CharX;
+ if (ftTop in TfrxDMPMemoView(sel).Frame.Typ) or
+ (ftBottom in TfrxDMPMemoView(found).Frame.Typ) then
+ gapTop := fr1CharY;
+ if (ftBottom in TfrxDMPMemoView(sel).Frame.Typ) or
+ (ftTop in TfrxDMPMemoView(found).Frame.Typ) then
+ gapBottom := fr1CharY;
+ end;
+ if dx = 1 then
+ sel.Left := found.Left - sel.Width - gapRight
+ else if dx = -1 then
+ sel.Left := found.Left + found.Width + gapLeft
+ else if dy = 1 then
+ sel.Top := found.Top - sel.Height - gapBottom
+ else if dy = -1 then
+ sel.Top := found.Top + found.Height + gapTop;
+
+ FModifyFlag := True;
+ if Assigned(FOnNotifyPosition) then
+ FOnNotifyPosition(GetSelectionBounds);
+ Repaint;
+ end;
+end;
+
+procedure TfrxDesignerWorkspace.DoTab;
+var
+ c: TfrxComponent;
+ i: Integer;
+begin
+ if SelectedCount <> 1 then Exit;
+
+ c := SelectedObjects[0];
+ if (c is TfrxBand) and (c.Objects.Count > 0) then
+ SelectedObjects[0] := c.Objects[0]
+ else if c is TfrxView then
+ begin
+ i := c.Parent.Objects.IndexOf(c);
+ if i = c.Parent.Objects.Count - 1 then
+ i := 0
+ else
+ Inc(i);
+ SelectedObjects[0] := c.Parent.Objects[i];
+ end;
+
+ if Assigned(FOnNotifyPosition) then
+ FOnNotifyPosition(GetSelectionBounds);
+ SelectionChanged;
+end;
+
+procedure TfrxDesignerWorkspace.KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+var
+ dx, dy: Integer;
+begin
+ if FDisableUpdate then
+ Exit;
+
+ dx := 0; dy := 0;
+
+ //if Shift = [] then
+ case Key of
+ vkDelete,
+ vkBack:
+ DeleteObjects;
+
+ vkReturn:
+ EditObject;
+
+ vkLeft:
+ dx := -1;
+
+ vkRight:
+ dx := 1;
+
+ vkUp:
+ dy := -1;
+
+ vkDown:
+ dy := 1;
+
+ vkTab:
+ DoTab;
+ end;
+
+ if (dx <> 0) or (dy <> 0) then
+ begin
+ if ssCtrl in Shift then
+ DoNudge(dx, dy, not (ssShift in Shift))
+ else if ssShift in Shift then
+ DoSize(dx, dy)
+ else if ssAlt in Shift then
+ DoStick(dx, dy)
+ else
+ FindNearest(dx, dy);
+ AdjustBands;
+ end;
+end;
+
+procedure TfrxDesignerWorkspace.KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if FDisableUpdate then exit;
+ DoModify;
+end;
+
+procedure TfrxDesignerWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+var
+ i, j: Integer;
+ c, c1: TfrxComponent;
+ EmptySpace: Boolean;
+ l: TList;
+ NeedRepaint: Boolean;
+
+ function Contain(c: TfrxComponent): Boolean;
+ var
+ w0, w1, w2, w3: Extended;
+ Left, Top, Right, Bottom, e, k, mx, my: Extended;
+ begin
+ Result := False;
+ w0 := 0;
+ w1 := 0;
+ w2 := 0;
+ if c.Width = 0 then
+ begin
+ w0 := 4;
+ w1 := 4
+ end
+ else if c.Height = 0 then
+ w2 := 4;
+ w3 := w2;
+ if c is TfrxBand then
+ if TfrxBand(c).Vertical then
+ w0 := FBandHeader
+ else
+ w2 := FBandHeader;
+
+ Left := c.AbsLeft;
+ Right := c.AbsLeft + c.Width;
+ Top := c.AbsTop;
+ Bottom := c.AbsTop + c.Height;
+ mx := X / FScale;
+ my := Y / FScale;
+
+ if Right < Left then
+ begin
+ e := Right;
+ Right := Left;
+ Left := e;
+ end;
+ if Bottom < Top then
+ begin
+ e := Bottom;
+ Bottom := Top;
+ Top := e;
+ end;
+
+ if (c is TfrxLineView) and TfrxLineView(c).Diagonal and
+ (c.Width <> 0) and (c.Height <> 0) then
+ begin
+ k := c.Height / c.Width;
+ if Abs((k * (mx - c.AbsLeft) - (my - c.AbsTop)) * cos(arctan(k))) < 5 then
+ Result := True;
+ if (mx < Left - 5) or (mx > Right + 5) or (my < Top - 5) or (my > Bottom + 5) then
+ Result := False;
+ end
+ else if (mx >= Left - w0) and (mx <= Right + w1) and
+ (my >= Top - w2) and (my <= Bottom + w3) then
+ Result := True;
+ end;
+
+begin
+ inherited;
+{$IFDEF MACOS}
+ X := X - 2;
+ Y := Y - 2;
+{$ENDIF}
+
+ if FDisableUpdate or FMouseDown then exit;
+ if FDblClicked then
+ begin
+ FDblClicked := False;
+ exit;
+ end;
+
+ l := TList.Create;
+ for i := 0 to FSelectedObjects.Count - 1 do
+ l.Add(FSelectedObjects[i]);
+
+ //if FPage is TfrxReportPage then
+ // ValidParentForm(Self).ActiveControl := Parent else
+ // ValidParentForm(Self).ActiveControl := nil;
+
+ SetFocus;
+
+ FMouseDown := True;
+ FLastMousePointX := X / FScale;
+ FLastMousePointY := Y / FScale;
+ NeedRepaint := False;
+
+// Ctrl was pressed
+ if (FMode1 = dmNone) and (ssCtrl in Shift) then
+ begin
+ FSelectedObjects.Clear;
+ FSelectedObjects.Add(FPage);
+ FMode1 := dmSelectionRect;
+ FDrawSelection := True;
+ FSelectionRect := frxRect(X, Y, X, Y);
+ NeedRepaint := True;
+ end;
+
+// clicked on object or on empty space
+ if FMode1 = dmNone then
+ begin
+ EmptySpace := True;
+
+ for i := FObjects.Count - 1 downto 0 do
+ begin
+ c := FObjects[i];
+ if (c is TfrxReportComponent) and Contain(c) then
+ begin
+ EmptySpace := False;
+
+ if csContainer in c.frComponentStyle then
+ begin
+ if c.ContainerMouseDown(Self, Round(X), Round(Y)) then
+ FMode1 := dmContainer
+ else
+ for j := c.ContainerObjects.Count - 1 downto 0 do
+ begin
+ c1 := c.ContainerObjects[j];
+ if c1.Visible and Contain(c1) then
+ begin
+ c := c1;
+ break;
+ end;
+ end;
+ end;
+
+ if ssShift in Shift then
+ if FSelectedObjects.IndexOf(c) <> -1 then
+ FSelectedObjects.Remove(c) else
+ FSelectedObjects.Add(c)
+ else if FSelectedObjects.IndexOf(c) = -1 then
+ begin
+ FSelectedObjects.Clear;
+ FSelectedObjects.Add(c);
+ end;
+
+ break;
+ end;
+ end;
+
+ if EmptySpace then
+ begin
+ FSelectedObjects.Clear;
+ FSelectedObjects.Add(FPage);
+ FMode1 := dmSelectionRect;
+ FDrawSelection := True;
+ FSelectionRect := frxRect(X, Y, X, Y);
+ end
+ else if FSelectedObjects.Count = 0 then
+ begin
+ FSelectedObjects.Add(FPage);
+ FMode1 := dmNone;
+ end
+ else
+ begin
+ FSelectedObjects.Remove(FPage);
+ if FMode1 <> dmContainer then
+ FMode1 := dmMove;
+ end;
+
+ NeedRepaint := True;
+ end;
+
+//band detach band objects
+ if (FMode1 = dmMove) and (FSelectedObjects.Count = 1) and
+ (TObject(FSelectedObjects[0]) is TfrxBand) and (ssAlt in Shift) then
+ AdjustBands(False);
+
+// scaling
+ if FMode1 = dmScale then
+ begin
+ FScaleRect := GetSelectionBounds;
+ FScaleRect.Right := FScaleRect.Right + FScaleRect.Left;
+ FScaleRect.Bottom := FScaleRect.Bottom + FScaleRect.Top;
+ FScaleRect1 := FScaleRect;
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ THackComponent(c).FOriginalRect := frxRect(c.AbsLeft, c.AbsTop, c.Width, c.Height);
+ end;
+ end;
+
+// inserting a line
+ if FMode1 = dmInsertLine then
+ begin
+ FInsertion.Width := 0;
+ FInsertion.Height := 0;
+ end;
+
+ if NeedRepaint then
+ if not ListsEqual(l, FSelectedObjects) then
+ SelectionChanged else
+ Repaint;
+
+ if Button = TMouseButton.mbRight then
+ begin
+ FMode1 := dmNone;
+ FMouseDown := False;
+ Repaint;
+ if Assigned(FOnPopup) then
+ FOnPopup(Self, X, Y);
+ end;
+
+ if FMode1 = dmMove then
+ begin
+ for i := 0 to FSelectedObjects.Count - 1 do
+ if TObject(FSelectedObjects[i]) is TfrxView then
+ begin
+ FSavedAlign.Add(Pointer(Integer(TfrxView(FSelectedObjects[i]).Align)));
+ TfrxView(FSelectedObjects[i]).Align := baNone;
+ end;
+ end;
+
+ l.Free;
+end;
+
+procedure TfrxDesignerWorkspace.MouseMove(Shift: TShiftState; X, Y: Single);
+var
+ c: TfrxComponent;
+ kx, ky, nx, ny: Extended;
+ i: Integer;
+ NotifyRect, SaveBounds: TfrxRect;
+ dpage: TfrxDialogPage;
+
+ function Contain(px, py: Extended): Boolean;
+ begin
+ Result := (X / FScale >= px - 2) and (X / FScale <= px + 3) and
+ (Y / FScale >= py - 2) and (Y / FScale <= py + 3);
+ end;
+
+ function Contain0(py: Extended): Boolean;
+ begin
+ Result := (Y / FScale >= py - 2) and (Y / FScale <= py + 2);
+ end;
+
+ function Contain1(px, py: Extended): Boolean;
+ begin
+ Result := (FLastMousePointX >= px - 2) and (FLastMousePointX <= px + 3) and
+ (FLastMousePointY >= py - 2) and (FLastMousePointY <= py + 3);
+ end;
+
+ function Contain2(c: TfrxComponent): Boolean;
+ var
+ w1, w2: Integer;
+ begin
+ w1 := 0;
+ w2 := 0;
+ if c.Width = 0 then
+ w1 := 4 else
+ w2 := 4;
+ if (X / FScale >= c.AbsLeft - w1) and (X / FScale <= c.AbsLeft + c.Width + w1) and
+ (Y / FScale >= c.AbsTop - w2) and (Y / FScale <= c.AbsTop + c.Height + w2) then
+ Result := True else
+ Result := False;
+ end;
+
+ function Contain3(px: Extended): Boolean;
+ begin
+ Result := (X / FScale >= px - 2) and (X / FScale <= px + 2);
+ end;
+
+ function GridCheck: Boolean;
+ begin
+ Result := (kx >= FGridX) or (kx <= -FGridX) or
+ (ky >= FGridY) or (ky <= -FGridY);
+ if Result then
+ begin
+ kx := Trunc(kx / FGridX) * FGridX;
+ ky := Trunc(ky / FGridY) * FGridY;
+ end;
+ end;
+
+ function CheckMove: Boolean;
+ var
+ al: Boolean;
+ begin
+ al := FGridAlign;
+ if ssAlt in Shift then
+ al := not al;
+
+ Result := False;
+
+ if (al and not GridCheck) or ((kx = 0) and (ky = 0)) then
+ Result := True;
+
+ CheckGuides(kx, ky, Result);
+ end;
+
+ procedure CheckNegative(c: TfrxComponent);
+ const
+ ar1: array[ct1..ct8] of TfrxCursorType = (ct3, ct4, ct1, ct2, ct6, ct5, ct0, ct0);
+ ar2: array[ct1..ct8] of TfrxCursorType = (ct4, ct3, ct2, ct1, ct0, ct0, ct8, ct7);
+ ar3: array[ct1..ct8] of TfrxCursorType = (ct2, ct1, ct4, ct3, ct0, ct0, ct0, ct0);
+ begin
+ if (c is TfrxLineView) and (TfrxLineView(c).Diagonal = True) then exit;
+ if (c.Width < 0) and (c.Height < 0) then
+ FCT := ar3[FCT]
+ else if c.Width < 0 then
+ FCT := ar1[FCT]
+ else if c.Height < 0 then
+ FCT := ar2[FCT];
+ NormalizeCoord(c);
+ end;
+
+ procedure CTtoCursor;
+ const
+ ar: array[ct0..ct10] of TCursor =
+ (crDefault, crSizeNWSE, crSizeNWSE, crSizeNESW,
+ crSizeNESW, crSizeWE, crSizeWE, crSizeNS, crSizeNS, crCross, crCross);
+ begin
+ Cursor := ar[FCT];
+ end;
+
+begin
+ inherited;
+ if FDisableUpdate then Exit;
+{$IFDEF MACOS}
+ X := X - 2;
+ Y := Y - 2;
+{$ENDIF}
+
+ if SelectedCount = 0 then
+ NotifyRect := frxRect(X / FScale, Y / FScale, 0, 0) else
+ NotifyRect := GetSelectionBounds;
+
+// cursor shapes
+ if not FMouseDown and (FMode = dmSelect) then
+ if SelectedCount = 1 then
+ begin
+ FMode1 := dmSize;
+ c := FSelectedObjects[0];
+ FCT := ct0;
+ if Contain(c.AbsLeft, c.AbsTop) then
+ FCT := ct1
+ else if Contain(c.AbsLeft + c.Width, c.AbsTop + c.Height) then
+ FCT := ct2
+ else if Contain(c.AbsLeft + c.Width, c.AbsTop) then
+ FCT := ct3
+ else if Contain(c.AbsLeft, c.AbsTop + c.Height) then
+ FCT := ct4
+ else if Contain(c.AbsLeft + c.Width, c.AbsTop + c.Height / 2) then
+ FCT := ct5
+ else if Contain(c.AbsLeft, c.AbsTop + c.Height / 2) then
+ FCT := ct6
+ else if Contain(c.AbsLeft + c.Width / 2, c.AbsTop) then
+ FCT := ct7
+ else if Contain(c.AbsLeft + c.Width / 2, c.AbsTop + c.Height) then
+ FCT := ct8;
+
+ if c is TfrxCustomLineView then
+ if not TfrxCustomLineView(c).Diagonal then
+ begin
+ if c.Width = 0 then
+ if FCT in [ct1, ct3] then
+ FCT := ct7
+ else if FCT in [ct4, ct2] then
+ FCT := ct8
+ else
+ FCT := ct0;
+ if c.Height = 0 then
+ if FCT in [ct1, ct4] then
+ FCT := ct6
+ else if FCT in [ct3, ct2] then
+ FCT := ct5
+ else
+ FCT := ct0;
+ end
+ else
+ if FCT = ct1 then
+ FCT := ct9
+ else if FCT = ct2 then
+ FCT := ct10
+ else
+ FCT := ct0;
+
+
+ if FCT = ct0 then
+ FMode1 := dmNone;
+ CTtoCursor;
+ end
+ else if SelectedCount > 1 then
+ begin
+ FMode1 := dmScale;
+ c := GetRightBottomObject;
+ if (c <> nil) and Contain(c.AbsLeft + c.Width, c.AbsTop + c.Height) then
+ Cursor := crSizeNWSE
+ else
+ begin
+ Cursor := crDefault;
+ FMode1 := dmNone;
+ end;
+ end
+ else if FPage is TfrxDialogPage then
+ begin
+ FMode1 := dmSize;
+ dpage := TfrxDialogPage(FPage);
+ FCT := ct0;
+ if Contain(dpage.ClientWidth - 2, dpage.ClientHeight - 2) then
+ FCT := ct2
+ else if Contain(dpage.ClientWidth - 2, dpage.ClientHeight / 2 - 1) then
+ FCT := ct5
+ else if Contain(dpage.ClientWidth / 2 - 1, dpage.ClientHeight - 2) then
+ FCT := ct8;
+
+ if FCT = ct0 then
+ FMode1 := dmNone;
+ CTtoCursor;
+ end
+ else
+ Cursor := crDefault;
+
+// resizing a band - setup
+ if not FMouseDown and (FMode = dmSelect) and not (FMode1 in [dmSize, dmScale]) then
+ begin
+ Cursor := crDefault;
+ FMode1 := dmNone;
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+
+ if c is TfrxBand then
+ if TfrxBand(c).Vertical then
+ begin
+ if Contain3(c.Left + c.Width) then
+ begin
+ Cursor := crHSplit;
+ FMode1 := dmSizeBand;
+ FSizedBand := TfrxBand(c);
+ break;
+ end;
+ end
+ else
+ begin
+ if Contain0(c.Top + c.Height) then
+ begin
+ Cursor := crVSplit;
+ FMode1 := dmSizeBand;
+ FSizedBand := TfrxBand(c);
+ break;
+ end;
+ end;
+ end;
+ end;
+
+// resizing a band
+ if FMouseDown and (FMode1 = dmSizeBand) then
+ begin
+ kx := X / FScale - FLastMousePointX;
+ ky := Y / FScale - FLastMousePointY;
+ if CheckMove then Exit;
+
+ FModifyFlag := True;
+ if FSizedBand.Vertical then
+ FSizedBand.Width := FSizedBand.Width + kx
+ else
+ FSizedBand.Height := FSizedBand.Height + ky;
+ AdjustBandHeight(FSizedBand);
+ AdjustBands;
+
+ FLastMousePointX := FLastMousePointX + kx;
+ FLastMousePointY := FLastMousePointY + ky;
+ Repaint;
+ with FSizedBand do
+ NotifyRect := frxRect(Left, Top, Width, Height);
+ end;
+
+// inserting
+ if not FMouseDown and (FMode1 = dmInsertObject) then
+ begin
+ kx := X / FScale - FInsertion.Left;
+ ky := Y / FScale - FInsertion.Top;
+ if CheckMove then Exit;
+
+ FInsertion.Left := FInsertion.Left + kx;
+ FInsertion.Top := FInsertion.Top + ky;
+ FDrawInsertion := True;
+ Repaint;
+ with FInsertion do
+ NotifyRect := frxRect(Left, Top, Width, Height);
+ end;
+
+// inserting + resizing
+ if FMouseDown and (FMode1 = dmInsertObject) then
+ begin
+ kx := X / FScale - FInsertion.Left;
+ ky := Y / FScale - FInsertion.Top;
+ if CheckMove then Exit;
+
+ FInsertion.Width := kx;
+ FInsertion.Height := ky;
+ FDrawInsertion := True;
+ Repaint;
+ with FInsertion do
+ NotifyRect := frxRect(Left, Top, Width, Height);
+ end;
+
+// moving
+ if FMouseDown and (FMode1 = dmMove) and not(ssShift in Shift) then
+ begin
+ kx := X / FScale - FLastMousePointX;
+ ky := Y / FScale - FLastMousePointY;
+ if CheckMove then Exit;
+
+ { vertical band }
+ if not FModifyFlag and (SelectedCount = 1) and
+ (TObject(FSelectedObjects[0]) is TfrxBand) and
+ (TfrxBand(FSelectedObjects[0]).Vertical) then
+ begin
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if (c is TfrxView) and
+ (c.Left >= TfrxBand(FSelectedObjects[0]).Left - 1e-4) and
+ (c.Left + c.Width <= TfrxBand(FSelectedObjects[0]).Left +
+ TfrxBand(FSelectedObjects[0]).Width + 1e-4) then
+ FSelectedObjects.Add(c);
+ end;
+ end;
+
+ if (TObject(FSelectedObjects[0]) is TfrxBand) and
+ (TfrxBand(FSelectedObjects[0]).Vertical) then
+ ky := 0;
+
+ FModifyFlag := True;
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ c.Left := c.Left + kx;
+ if FSelectedObjects.IndexOf(c.Parent) = -1 then
+ begin
+ if c.IsAncestor and (c is TfrxView) then
+ if (c.Top + ky < -1e-4) or (c.Top + ky > c.Parent.Height) then
+ continue;
+ c.Top := c.Top + ky;
+ end;
+ end;
+
+ FLastMousePointX := FLastMousePointX + kx;
+ FLastMousePointY := FLastMousePointY + ky;
+ Repaint;
+ NotifyRect := GetSelectionBounds;
+ end;
+
+// resizing one object
+ if FMouseDown and (FMode1 = dmSize) and (SelectedCount = 1) then
+ begin
+ kx := X / FScale - FLastMousePointX;
+ ky := Y / FScale - FLastMousePointY;
+ if CheckMove then Exit;
+
+ FModifyFlag := True;
+ c := FSelectedObjects[0];
+ SaveBounds := frxRect(c.Left, c.Top, c.Width, c.Height);
+ case FCT of
+ ct1, ct9:
+ begin
+ c.Left := c.Left + kx;
+ c.Width := c.Width - kx;
+ c.Top := c.Top + ky;
+ c.Height := c.Height - ky;
+ end;
+
+ ct2, ct10:
+ begin
+ c.Width := c.Width + kx;
+ c.Height := c.Height + ky;
+ end;
+
+ ct3:
+ begin
+ c.Top := c.Top + ky;
+ c.Width := c.Width + kx;
+ c.Height := c.Height - ky;
+ end;
+
+ ct4:
+ begin
+ c.Left := c.Left + kx;
+ c.Width := c.Width - kx;
+ c.Height := c.Height + ky;
+ end;
+
+ ct5:
+ begin
+ c.Width := c.Width + kx;
+ end;
+
+ ct6:
+ begin
+ c.Left := c.Left + kx;
+ c.Width := c.Width - kx;
+ end;
+
+ ct7:
+ begin
+ c.Top := c.Top + ky;
+ c.Height := c.Height - ky;
+ end;
+
+ ct8:
+ begin
+ c.Height := c.Height + ky;
+ end;
+ end;
+ CheckNegative(c);
+ CTtoCursor;
+
+ if c.Left < 0 then
+ c.Left := 0;
+
+ if c.IsAncestor and (c is TfrxView) then
+ if (c.Top < -1e-4) or (c.Top > c.Parent.Height) then
+ c.SetBounds(SaveBounds.Left, SaveBounds.Top, SaveBounds.Right, SaveBounds.Bottom);
+
+ if c is TfrxBand then
+ begin
+ if FCT in [ct1, ct3, ct7] then
+ for i := 0 to c.Objects.Count - 1 do
+ with TfrxComponent(c.Objects[i]) do
+ Top := Top - ky;
+ AdjustBandHeight(TfrxBand(c));
+ AdjustBands;
+ end;
+
+ FLastMousePointX := FLastMousePointX + kx;
+ FLastMousePointY := FLastMousePointY + ky;
+ Repaint;
+ NotifyRect := frxRect(c.Left, c.Top, c.Width, c.Height);
+ end;
+
+// resizing dialogue form
+ if FMouseDown and (FMode1 = dmSize) and (TObject(FSelectedObjects[0]) is TfrxDialogPage) then
+ begin
+ kx := X / FScale - FLastMousePointX;
+ ky := Y / FScale - FLastMousePointY;
+ if CheckMove then Exit;
+
+ FModifyFlag := True;
+ dpage := TObject(FSelectedObjects[0]) as TfrxDialogPage;
+ case FCT of
+ ct2:
+ begin
+ dpage.ClientWidth := dpage.ClientWidth + kx;
+ dpage.ClientHeight := dpage.ClientHeight + ky;
+ end;
+
+ ct5:
+ begin
+ dpage.ClientWidth := dpage.ClientWidth + kx;
+ end;
+
+ ct8:
+ begin
+ dpage.ClientHeight := dpage.ClientHeight + ky;
+ end;
+ end;
+
+ FLastMousePointX := FLastMousePointX + kx;
+ FLastMousePointY := FLastMousePointY + ky;
+ SetPageDimensions(Round(dpage.ClientWidth), Round(dpage.ClientHeight), Rect(0, 0, 0, 0));
+ Repaint;
+ NotifyRect := frxRect(0, 0, dpage.ClientWidth, dpage.ClientHeight);
+ end;
+
+// scaling
+ if FMouseDown and (FMode1 = dmScale) then
+ begin
+ kx := X / FScale - FLastMousePointX;
+ ky := Y / FScale - FLastMousePointY;
+ if CheckMove then Exit;
+
+ FModifyFlag := True;
+ with FScaleRect do
+ if not ((Right + kx < Left) or (Bottom + ky < Top)) then
+ FScaleRect := frxRect(Left, Top, Right + kx, Bottom + ky);
+ nx := (FScaleRect.Right - FScaleRect.Left) / (FScaleRect1.Right - FScaleRect1.Left);
+ ny := (FScaleRect.Bottom - FScaleRect.Top) / (FScaleRect1.Bottom - FScaleRect1.Top);
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ c.Left := FScaleRect1.Left + (THackComponent(c).FOriginalRect.Left - FScaleRect1.Left) * nx;
+ c.Top := FScaleRect1.Top + (THackComponent(c).FOriginalRect.Top - FScaleRect1.Top) * ny;
+ if c.Parent is TfrxBand then
+ c.Top := c.Top - c.Parent.Top;
+ c.Width := THackComponent(c).FOriginalRect.Right * nx;
+ c.Height := THackComponent(c).FOriginalRect.Bottom * ny;
+ end;
+
+ FLastMousePointX := FLastMousePointX + kx;
+ FLastMousePointY := FLastMousePointY + ky;
+ Repaint;
+ with FScaleRect do
+ NotifyRect := frxRect(Right - Left, Bottom - Top, nx, ny);
+ end;
+
+// drawing selection rectangle
+ if FMouseDown and (FMode1 = dmSelectionRect) then
+ begin
+ FSelectionRect := frxRect(FSelectionRect.Left, FSelectionRect.Top, X, Y);
+ Repaint;
+ end;
+
+// inserting a line
+ if not FMouseDown and (FMode1 = dmInsertLine) then
+ begin
+ kx := X / FScale - FInsertion.Left;
+ ky := Y / FScale - FInsertion.Top;
+ if CheckMove then Exit;
+
+ FInsertion.Left := FInsertion.Left + kx;
+ FInsertion.Top := FInsertion.Top + ky;
+ with FInsertion do
+ NotifyRect := frxRect(Left, Top, 0, 0);
+ Repaint;
+ end;
+
+// inserting a line + resizing
+ if FMouseDown and (FMode1 = dmInsertLine) then
+ begin
+ kx := X / FScale - (FInsertion.Left + FInsertion.Width);
+ ky := Y / FScale - (FInsertion.Top + FInsertion.Height);
+ if CheckMove then Exit;
+
+ FInsertion.Width := FInsertion.Width + kx;
+ FInsertion.Height := FInsertion.Height + ky;
+ with FInsertion do
+ NotifyRect := frxRect(Left, Top, Width, Height);
+ Repaint;
+ end;
+
+// check containers
+ if not FMouseDown and (FMode = dmSelect) and not (FMode1 in [dmSize, dmScale]) then
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if (csContainer in c.frComponentStyle) and Contain2(c) then
+ c.ContainerMouseMove(Self, Round(X), Round(Y));
+ end;
+
+// handle containers
+ if FMouseDown and (FMode1 = dmContainer) then
+ begin
+ kx := X / FScale - FLastMousePointX;
+ ky := Y / FScale - FLastMousePointY;
+ if CheckMove then Exit;
+
+ FModifyFlag := True;
+ c := FSelectedObjects[0];
+ c.ContainerMouseMove(Self, Round(X), Round(Y));
+ FLastMousePointX := FLastMousePointX + kx;
+ FLastMousePointY := FLastMousePointY + ky;
+ Repaint;
+ end;
+//todo
+// if FMouseDown and (Cursor <> crHand) then
+// if Parent is TScrollingWinControl then
+// with TScrollingWinControl(Parent) do
+// begin
+// x := x + Round(FMargins.Left * FScale);
+// y := y + Round(FMargins.Top * FScale);
+// if x > (ClientRect.Right + HorzScrollBar.Position) then
+// begin
+// i := x - (ClientRect.Right + HorzScrollBar.Position);
+// HorzScrollBar.Position := HorzScrollBar.Position + i;
+// end;
+// if x < HorzScrollBar.Position then
+// begin
+// i := HorzScrollBar.Position - x;
+// HorzScrollBar.Position := HorzScrollBar.Position - i;
+// end;
+// if y > (ClientRect.Bottom + VertScrollBar.Position) then
+// begin
+// i := y - (ClientRect.Bottom + VertScrollBar.Position);
+// VertScrollBar.Position := VertScrollBar.Position + i;
+// end;
+// if y < VertScrollBar.Position then
+// begin
+// i := VertScrollBar.Position - y;
+// VertScrollBar.Position := VertScrollBar.Position - i;
+// end;
+// end;
+
+ if (SelectedCount = 0) or FMouseDown then
+ if Assigned(FOnNotifyPosition) then
+ FOnNotifyPosition(NotifyRect);
+end;
+
+procedure TfrxDesignerWorkspace.MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+var
+ i, j: Integer;
+ c, c1: TfrxComponent;
+ R: TfrxRect;
+ l: TList;
+ NotifyRect: TfrxRect;
+
+ function Round8(e: Extended): Extended;
+ begin
+ Result := Round(e * 100000000) / 100000000;
+ end;
+
+ function Contain(c: TfrxComponent): Boolean;
+ var
+ cLeft, cTop, cRight, cBottom, e: Extended;
+ Sign: Boolean;
+
+ function Dist(x, y: Extended): Boolean;
+ var
+ k: Extended;
+ begin
+ k := c.Height / c.Width;
+ k := (k * (x / FScale - c.AbsLeft) - (y / FScale - c.AbsTop)) * cos(arctan(k));
+ Result := k >= 0;
+ end;
+
+ function RectInRect: Boolean;
+ begin
+ with FSelectionRect do
+ Result := not ((cLeft > Right / FScale) or
+ (cRight < Left / FScale) or
+ (cTop > Bottom / FScale) or
+ (cBottom < Top / FScale));
+ end;
+
+ begin
+ Result := False;
+ cLeft := c.AbsLeft;
+ cRight := c.AbsLeft + c.Width;
+ cTop := c.AbsTop;
+ cBottom := c.AbsTop + c.Height;
+
+ if cRight < cLeft then
+ begin
+ e := cRight;
+ cRight := cLeft;
+ cLeft := e;
+ end;
+ if cBottom < cTop then
+ begin
+ e := cBottom;
+ cBottom := cTop;
+ cTop := e;
+ end;
+
+ if (c is TfrxLineView) and TfrxLineView(c).Diagonal and
+ (c.Width <> 0) and (c.Height <> 0) then
+ with FSelectionRect do
+ begin
+ Sign := Dist(Left, Top);
+ if Dist(Right, Top) <> Sign then
+ Result := True;
+ if Dist(Left, Bottom) <> Sign then
+ Result := True;
+ if Dist(Right, Bottom) <> Sign then
+ Result := True;
+
+ if Result then
+ Result := RectInRect;
+ end
+ else
+ Result := RectInRect;
+ end;
+
+begin
+ inherited;
+ if FDisableUpdate then Exit;
+ if Button <> TMouseButton.mbLeft then Exit;
+{$IFDEF MACOS}
+ X := X - 2;
+ Y := Y - 2;
+{$ENDIF}
+
+ l := TList.Create;
+ for i := 0 to FSelectedObjects.Count - 1 do
+ l.Add(FSelectedObjects[i]);
+ FMouseDown := False;
+
+// insert an object
+ if FMode = dmInsert then
+ begin
+ with FInsertion do
+ begin
+ R := frxRect(Left, Top, Left + Width, Top + Height);
+ if ((ComponentClass.InheritsFrom(TfrxCustomLineView)) and (Flags = 0)) then
+ begin
+ if Width < 0 then
+ R.Right := Left - Width;
+ if Height < 0 then
+ R.Bottom := Top - Height;
+
+ if (Width < 0) and (Abs(Width) > Abs(Height)) then
+ begin
+ R.Left := Left + Width;
+ R.Right := Left;
+ end;
+ if (Height < 0) and (Abs(Height) > Abs(Width)) then
+ begin
+ R.Top := Top + Height;
+ R.Bottom := Top;
+ end;
+ end
+ else if not ((ComponentClass.InheritsFrom(TfrxLineView)) and (Flags <> 0)) then
+ begin
+ if ((Width >= 0) and (Width < 4)) or ((Height > 0) and (Height < 4)) then
+ R := frxRect(Left, Top, Left + OriginalWidth, Top + OriginalHeight);
+ NormalizeRect(R);
+ end;
+ Left := Round8(R.Left);
+ Top := Round8(R.Top);
+ Width := Round8(R.Right - R.Left);
+ Height := Round8(R.Bottom - R.Top);
+ end;
+ FDrawInsertion := False;
+
+ if Assigned(FOnInsert) then
+ FOnInsert(Self);
+ end;
+
+// select objects that inside of selection rect
+ if FMode1 = dmSelectionRect then
+ begin
+ NormalizeRect(FSelectionRect);
+ FSelectedObjects.Clear;
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ if (c is TfrxReportComponent) and not (c is TfrxBand) and Contain(c) then
+ if not (csContainer in c.frComponentStyle) then
+ FSelectedObjects.Add(c)
+ else
+ begin
+ for j := 0 to c.ContainerObjects.Count - 1 do
+ begin
+ c1 := c.ContainerObjects[j];
+ if c1.Visible and Contain(c1) then
+ FSelectedObjects.Add(c1);
+ end;
+ end;
+ end;
+ FDrawSelection := False;
+ if FSelectedObjects.Count = 0 then
+ FSelectedObjects.Add(FPage);
+ Repaint;
+ end;
+
+// round coordinates
+ if FMode1 in [dmMove, dmSize] then
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ if (c is TfrxView) and (FMode1 = dmMove) then
+ if FSavedAlign.Count > 0 then
+ begin
+ TfrxView(c).Align := TfrxAlign(FSavedAlign[0]);
+ FSavedAlign.Delete(0);
+ end;
+ c.Left := Round8(c.Left);
+ c.Top := Round8(c.Top);
+ c.Width := Round8(c.Width);
+ c.Height := Round8(c.Height);
+ end;
+ if FMode1 = dmSizeBand then
+ FSizedBand.Height := Round8(FSizedBand.Height);
+
+ // container
+ if FMode1 = dmContainer then
+ begin
+ c := SelectedObjects[0];
+ c.ContainerMouseUp(Self, Round(X), Round(Y));
+ end;
+
+ AdjustBands;
+ if not ListsEqual(l, FSelectedObjects) then
+ SelectionChanged else
+ Repaint;
+ DoModify;
+ l.Free;
+ FCT := ct0;
+ if not ((FMode = dmInsert) and (FInsertion.ComponentClass <> nil)) then
+ FMode1 := dmNone;
+
+ if SelectedCount = 0 then
+ NotifyRect := frxRect(X / FScale, Y / FScale, 0, 0) else
+ NotifyRect := GetSelectionBounds;
+ if Assigned(FOnNotifyPosition) then
+ FOnNotifyPosition(NotifyRect);
+end;
+
+procedure TfrxDesignerWorkspace.DblClick;
+begin
+ inherited;
+ EditObject;
+ FDblClicked := True;
+end;
+
+procedure TfrxDesignerWorkspace.MouseLeave;
+begin
+ if not FMouseDown and (FMode1 = dmInsertObject) then
+ begin
+ FInsertion.Left := -FGridX * 1000;
+ FInsertion.Top := -FGridY * 1000;
+ FDrawInsertion := False;
+ Repaint;
+ end;
+ if not FMouseDown and (FMode1 = dmInsertLine) then
+ begin
+ if FGridType = gtChar then
+ begin
+ FInsertion.Left := - FGridX / 2;
+ FInsertion.Top := - FGridY / 2;
+ end
+ else
+ begin
+ FInsertion.Left := - FGridX;
+ FInsertion.Top := - FGridY;
+ end;
+ Repaint;
+ end;
+ if FMode = dmDrag then
+ SetInsertion(nil, 0, 0, 0);
+end;
+
+procedure TfrxDesignerWorkspace.CheckGuides(var kx, ky: Extended;
+ var Result: Boolean);
+begin
+//
+end;
+
+procedure TfrxDesignerWorkspace.GroupObjects;
+var
+ i, j: Integer;
+ c: TfrxComponent;
+ sl: TStringList;
+begin
+ sl := TfrxStringList.Create;
+ sl.Sorted := True;
+ sl.Duplicates := dupIgnore;
+
+ { reset group index }
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ c.GroupIndex := 0;
+ end;
+
+ { collect available indexes }
+ for i := 0 to FObjects.Count - 1 do
+ begin
+ c := FObjects[i];
+ sl.Add(IntToStr(c.GroupIndex));
+ end;
+
+ { find an unique index }
+ j := 0;
+ repeat
+ Inc(j);
+ until sl.IndexOf(IntToStr(j)) = -1;
+
+ { set group index }
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ c.GroupIndex := j;
+ end;
+
+ sl.Free;
+end;
+
+procedure TfrxDesignerWorkspace.UngroupObjects;
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ c.GroupIndex := 0;
+ end;
+end;
+
+end.
diff --git a/LibD28x64/FMX.frxDesgnWorkspace.res b/LibD28x64/FMX.frxDesgnWorkspace.res
new file mode 100644
index 0000000..247c567
Binary files /dev/null and b/LibD28x64/FMX.frxDesgnWorkspace.res differ
diff --git a/LibD28x64/FMX.frxDesgnWorkspace1.pas b/LibD28x64/FMX.frxDesgnWorkspace1.pas
new file mode 100644
index 0000000..7a3c96e
--- /dev/null
+++ b/LibD28x64/FMX.frxDesgnWorkspace1.pas
@@ -0,0 +1,939 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Designer workspace }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDesgnWorkspace1;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, System.Types, FMX.Types,
+ FMX.Objects, FMX.Controls, FMX.Forms, FMX.Dialogs, FMX.frxClass,
+ FMX.frxDesgn, FMX.frxDesgnWorkspace, FMX.frxPopupForm,
+ System.Variants, System.UIConsts, FMX.ListBox
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI20}
+ , System.Math.Vectors
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+ TfrxGuideItem = class(TCollectionItem)
+ public
+ Left, Top, Right, Bottom: Extended;
+ end;
+
+ TfrxVirtualGuides = class(TCollection)
+ private
+ function GetGuides(Index: Integer): TfrxGuideItem;
+ public
+ constructor Create;
+ procedure Add(Left, Top, Right, Bottom: Extended);
+ property Items[Index: Integer]: TfrxGuideItem read GetGuides; default;
+ end;
+
+ TDesignerWorkspace = class(TfrxDesignerWorkspace)
+ private
+ FDesigner: TfrxDesignerForm;
+ FGuide: Integer;
+ FListBox: TListBox;
+ FMemo: TfrxMemoView;
+ FPopupForm: TfrxPopupForm;
+ FPopupFormVisible: Boolean;
+ FShowGuides: Boolean;
+ FSimulateMove: Boolean;
+ FVirtualGuides: TfrxVirtualGuides;
+ FVirtualGuideObjects: TList;
+ FDragObject: TObject;
+ FDragPoint: TPointF;
+ procedure DoLBClick(Sender: TObject);
+ procedure DoPopupHide(Sender: TObject);
+ procedure CreateVirtualGuides;
+ //procedure LBDrawItem(Control: TWinControl; Index: Integer;
+ // ARect: TRect; State: TOwnerDrawState);
+ procedure SetShowGuides(const Value: Boolean);
+ procedure SetHGuides(const Value: TStrings);
+ procedure SetVGuides(const Value: TStrings);
+ function GetHGuides: TStrings;
+ function GetVGuides: TStrings;
+ property HGuides: TStrings read GetHGuides write SetHGuides;
+ property VGuides: TStrings read GetVGuides write SetVGuides;
+ protected
+ procedure CheckGuides(var kx, ky: Extended; var Result: Boolean); override;
+ procedure DragEnter(const Data: TDragObject; const Point: TPointF); override;
+ procedure DragLeave; override;
+ procedure DragEnd; override;
+ procedure DragOver(const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF}); override;
+ procedure DrawObjects; override;
+ procedure DoDraw(ACanvas: TCanvas); override;
+ procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
+ procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Single); override;
+ procedure MouseMove(Shift: TShiftState; X, Y: Single); override;
+ procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Single); override;
+ public
+ constructor Create(AOwner: TComponent); overload; override;
+ destructor Destroy; override;
+ procedure DeleteObjects; override;
+ procedure DragDrop(const Data: TDragObject; const Point: TPointF); override;
+ procedure SimulateMove;
+ procedure SetInsertion(AClass: TfrxComponentClass;
+ AWidth, AHeight: Extended; AFlag: Word); override;
+ property ShowGuides: Boolean read FShowGuides write SetShowGuides;
+ end;
+
+implementation
+
+uses
+ FMX.frxFMX, FMX.frxDesgnCtrls, FMX.frxUtils, FMX.frxDataTree, FMX.frxDMPClass, FMX.frxRes, FMX.TreeView, FMX.Platform, FMX.Layouts;
+
+type
+ THackMemo = class(TfrxCustomMemoView);
+
+function Round8(e: Extended): Extended;
+begin
+ Result := Round(e * 100000000) / 100000000;
+end;
+
+function ToIdent(const s: String): String;
+var
+ I: Integer;
+begin
+ Result := '';
+ for i := 1 to Length(s) do
+ if i = 1 then
+ begin
+ if CharInSet(s[i], ['A'..'Z','a'..'z','_']) then
+ Result := Result + s[i]
+ end
+ else if CharInSet(s[i], ['A'..'Z','a'..'z','_','0'..'9']) then
+ Result := Result + s[i];
+ if Length(Result) < Length(s) * 2 div 3 then
+ Result := 'Memo';
+end;
+
+
+{ TfrxVirtualGuides }
+
+constructor TfrxVirtualGuides.Create;
+begin
+ inherited Create(TfrxGuideItem);
+end;
+
+procedure TfrxVirtualGuides.Add(Left, Top, Right, Bottom: Extended);
+var
+ Item: TfrxGuideItem;
+begin
+ Item := TfrxGuideItem(inherited Add);
+ Item.Left := Left;
+ Item.Top := Top;
+ Item.Right := Right;
+ Item.Bottom := Bottom;
+end;
+
+function TfrxVirtualGuides.GetGuides(Index: Integer): TfrxGuideItem;
+begin
+ Result := TfrxGuideItem(inherited Items[Index]);
+end;
+
+
+{ TDesignerWorkspace }
+
+constructor TDesignerWorkspace.Create(AOwner: TComponent);
+begin
+ inherited;
+ FDesigner := TfrxDesignerForm(AOwner);
+ FVirtualGuides := TfrxVirtualGuides.Create;
+ FVirtualGuideObjects := TList.Create;
+end;
+
+destructor TDesignerWorkspace.Destroy;
+begin
+ FVirtualGuides.Free;
+ FVirtualGuideObjects.Free;
+ inherited;
+end;
+
+procedure TDesignerWorkspace.DeleteObjects;
+var
+ i: Integer;
+ NeedReload: Boolean;
+begin
+ NeedReload := False;
+ for i := 0 to FSelectedObjects.Count - 1 do
+ if TObject(FSelectedObjects[i]) is TfrxSubreport then
+ NeedReload := True;
+
+ FMemo := nil;
+ inherited;
+
+ if NeedReload then
+ FDesigner.ReloadPages(FDesigner.Report.Objects.IndexOf(Page));
+end;
+
+procedure TDesignerWorkspace.SetInsertion(AClass: TfrxComponentClass;
+ AWidth, AHeight: Extended; AFlag: Word);
+begin
+ inherited;
+ CreateVirtualGuides;
+end;
+
+procedure TDesignerWorkspace.DrawObjects;
+var
+ r: TRect;
+ i, d: Integer;
+ poly: TPolygon;
+begin
+ if FDesigner.Page is TfrxReportPage then
+ with TfrxReportPage(FDesigner.Page) do
+ if Columns > 1 then
+ for i := 0 to Columns - 1 do
+ begin
+ d := Round(frxStrToFloat(ColumnPositions[i]) * fr01cm * FScale);
+ if d = 0 then continue;
+ FCanvas.Stroke.Color := claSilver;
+ FCanvas.DrawLine(PointF(d, 0), PointF(d, Self.Height), 1);
+ end;
+
+ if FShowGuides and (FPage is TfrxReportPage) then
+ begin
+ with FCanvas do
+ begin
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := $FFFFCC00;
+ //Pen.Mode := pmCopy;
+ end;
+
+ for i := 0 to HGuides.Count - 1 do
+ begin
+ d := Round(frxStrToFloat(HGuides[i]) * Scale);
+ FCanvas.DrawLine(PointF(0, d), PointF(Width, d), 1);
+ end;
+
+ for i := 0 to VGuides.Count - 1 do
+ begin
+ d := Round(frxStrToFloat(VGuides[i]) * Scale);
+ FCanvas.DrawLine(PointF(d, 0), PointF(d, Height), 1);
+ end;
+ end;
+
+ inherited;
+
+ if (FMemo <> nil) and FDesigner.DropFields then
+ with FCanvas do
+ begin
+ r.TopLeft := Point(Round((FMemo.Left + FMemo.Width) * FScale) - 16,
+ Round((FMemo.AbsTop) * FScale) + 2);
+ r.BottomRight := Point(r.Left + 16, r.Top + 16);
+ //DrawButtonFace(FCanvas, r, 1, bsNew, False, False, False);
+ //todo
+ Fill.Color := claBlack;
+ Fill.Kind := TBrushKind.bkSolid;
+ Stroke.Color := claBlack;
+ Stroke.Kind := TBrushKind.bkSolid;
+ SetLength(poly, 4);
+ poly[0] := PointF(r.Left + 4, r.Top + 6);
+ poly[1] := PointF(r.Left + 7, r.Top + 9);
+ poly[2] := PointF(r.Left + 10, r.Top + 6);
+ poly[3] := PointF(r.Left + 4, r.Top + 6);
+ FCanvas.DrawPolygon(poly, 1);
+ end;
+
+
+ if FVirtualGuides.Count > 0 then
+ begin
+ if FMouseDown or (FMode1 = dmInsertObject) or (FMode1 = dmInsertLine) then
+ with FCanvas do
+ begin
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := $FFFFCC00;
+ for i := 0 to FVirtualGuides.Count - 1 do
+ begin
+ FCanvas.DrawLine(
+ PointF(Round(FVirtualGuides[i].Left * Scale) + 0.5, Round(FVirtualGuides[i].Top * Scale) + 0.5),
+ PointF(Round(FVirtualGuides[i].Right * Scale) + 0.5, Round(FVirtualGuides[i].Bottom * Scale) + 0.5), 1);
+ end;
+ end;
+ FVirtualGuides.Clear;
+ end;
+end;
+
+procedure TDesignerWorkspace.DragOver(const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+var
+ ds: TfrxDataset;
+ s, fld: String;
+ w: Integer;
+ X, Y: Single;
+{$IFDEF DELPHI20}
+ Accept: Boolean;
+{$ENDIF}
+begin
+ Accept := ((FDesigner.CheckOp(drDontInsertObject) and
+ (Data.Source is TTreeView) and
+ (TTreeView(Data.Source).Owner = FDesigner.DataTree) and
+ (FDesigner.DataTree.GetFieldName <> '')) or
+ ((Data.Source is TfrxRuler) and FDesigner.ShowGuides)) and (FDesigner.Page is TfrxReportPage);
+ if not Accept then Exit;
+{$IFDEF DELPHI20}
+ Operation := TDragOperation.Copy;
+{$ENDIF}
+ FMode := dmDrag;
+ if Data.Source is TfrxRuler then
+ begin
+ FDragObject := Data.Source;
+ if GridAlign then
+ begin
+ X := Round(Trunc(Point.X / (GridX * Scale)) * GridX * Scale);
+ Y := Round(Trunc(Point.Y / (GridY * Scale)) * GridY * Scale);
+ end
+ else
+ begin
+ X := Point.X;
+ Y := Point.Y;
+ end;
+ FDragPoint := PointF(X, Y);
+ Repaint;
+ MouseMove([], X, Y);
+ end
+ else
+ begin
+ if (FInsertion.ComponentClass = nil) and
+ (FDesigner.DataTree.InsFieldCB.IsChecked or
+ FDesigner.DataTree.InsCaptionCB.IsChecked or
+ not FDesigner.DataTree.IsDataField) then
+ begin
+ s := FDesigner.DataTree.GetFieldName;
+ s := Copy(s, 2, Length(s) - 2);
+ FDesigner.Report.GetDatasetAndField(s, ds, fld);
+ try
+ if (ds <> nil) and (fld <> '') then
+ w := ds.DisplayWidth[fld] else
+ w := 10;
+ except
+ w := 10;
+ end;
+
+ if w > 50 then
+ w := 50;
+
+ SetInsertion(TfrxMemoView, Round(w * 8 / GridX) * GridX,
+ FDesigner.GetDefaultObjectSize.Y, 0);
+ end;
+ MouseMove([], Point.X, Point.Y);
+ end;
+end;
+
+procedure TDesignerWorkspace.DragDrop(const Data: TDragObject; const Point: TPointF);
+var
+ eX, eY: Extended;
+ m: TfrxCustomMemoView;
+ ds: TfrxDataset;
+ s, fld: String;
+begin
+ if (Data.Source is TfrxRuler) and (FPage is TfrxReportPage) then
+ begin
+ if GridAlign then
+ begin
+ eX := Trunc(Point.X / Scale / GridX) * GridX;
+ eY := Trunc(Point.Y / Scale / GridY) * GridY;
+ end
+ else
+ begin
+ eX := Point.X / Scale;
+ eY := Point.Y / Scale;
+ end;
+
+ eX := Round8(eX);
+ eY := Round8(eY);
+
+ if TfrxRuler(Data.Source).Align = TAlignLayout.alLeft then
+ VGuides.Add(FloatToStr(eX)) else
+ HGuides.Add(FloatToStr(eY));
+ FMode := dmSelect;
+ end
+ else if (FDesigner.DataTree.InsFieldCB.IsChecked or
+ FDesigner.DataTree.InsCaptionCB.IsChecked or
+ not FDesigner.DataTree.IsDataField) then
+ begin
+ FSelectedObjects.Clear;
+
+ if Page is TfrxDMPPage then
+ m := TfrxDMPMemoView.Create(Page)
+ else
+ m := TfrxMemoView.Create(Page);
+ s := ToIdent(FDesigner.DataTree.GetFieldName);
+ if (s <> 'Memo') and (FDesigner.Report.FindObject(s) = nil) then
+ m.Name := s
+ else
+ begin
+ THackMemo(m).FBaseName := s;
+ m.CreateUniqueName;
+ end;
+ m.IsDesigning := True;
+ s := FDesigner.DataTree.GetFieldName;
+ s := Copy(s, 2, Length(s) - 2);
+ FDesigner.Report.GetDataSetAndField(s, ds, fld);
+
+ if not FDesigner.DataTree.IsDataField or FDesigner.DataTree.InsFieldCB.IsChecked then
+ begin
+ m.DataSet := ds;
+ m.DataField := fld;
+ if (ds = nil) and (fld = '') then
+ begin
+ if Pos('<', FDesigner.DataTree.GetFieldName) = 1 then
+ m.Text := '[' + s + ']' else
+ m.Text := '[' + FDesigner.DataTree.GetFieldName + ']';
+ end;
+ m.SetBounds(Round8(FInsertion.Left), Round8(FInsertion.Top),
+ Round8(FInsertion.Width), Round8(FInsertion.Height));
+ FDesigner.SampleFormat.ApplySample(m);
+ FObjects.Add(m);
+ FSelectedObjects.Add(m);
+ FInsertion.Top := FInsertion.Top - FInsertion.Height;
+ end
+ else
+ m.Free;
+ if FDesigner.DataTree.IsDataField and FDesigner.DataTree.InsCaptionCB.IsChecked then
+ begin
+ if Page is TfrxDMPPage then
+ m := TfrxDMPMemoView.Create(Page) else
+ m := TfrxMemoView.Create(Page);
+ m.CreateUniqueName;
+ m.IsDesigning := True;
+ m.Text := fld;
+ m.SetBounds(Round8(FInsertion.Left), Round8(FInsertion.Top),
+ Round8(FInsertion.Width), Round8(FInsertion.Height));
+ FDesigner.SampleFormat.ApplySample(m);
+ FObjects.Add(m);
+ FSelectedObjects.Add(m);
+ end;
+
+ if (frxDesignerComp <> nil) and Assigned(frxDesignerComp.OnInsertObject) then
+ frxDesignerComp.OnInsertObject(m);
+ SetInsertion(nil, 0, 0, 0);
+ end;
+
+ FModifyFlag := True;
+ MouseUp(TMouseButton.mbLeft, [], Point.X, Point.Y);
+ SelectionChanged;
+ FDragObject := nil;
+ FDragPoint := PointF(-1, - 1);
+end;
+
+procedure TDesignerWorkspace.DragEnd;
+begin
+ inherited;
+ FDragObject := nil;
+ FDragPoint := PointF(-1, - 1);
+end;
+
+procedure TDesignerWorkspace.DragEnter(const Data: TDragObject;
+ const Point: TPointF);
+begin
+ inherited;
+ FDragObject := Data.Source;
+ FDragPoint := Point;
+end;
+
+procedure TDesignerWorkspace.DragLeave;
+begin
+ inherited;
+ FDragObject := nil;
+ FDragPoint := PointF(-1, - 1);
+end;
+
+procedure TDesignerWorkspace.MouseDown(Button: TMouseButton; Shift: TShiftState;
+ X, Y: Single);
+var
+ ds: TfrxDataset;
+ r: TRectF;
+ p: TPointF;
+
+ function Contain(c: TfrxComponent): Boolean;
+ begin
+ Result := (X / FScale >= c.Left + c.Width - 16) and (X / FScale <= c.Left + c.Width) and
+ (Y / FScale >= c.AbsTop) and (Y / FScale <= c.AbsTop + 16);
+ end;
+
+begin
+ if FDisableUpdate then Exit;
+ if FPopupFormVisible then FPopupForm.Close;
+
+ if (FMode = dmSelect) and (FMemo <> nil) and Contain(FMemo) and FDesigner.DropFields then
+ begin
+ FPopupForm := TfrxPopupForm.Create(Self);
+ FPopupForm.OnDestroy := DoPopupHide;
+ FListBox := TListBox.Create(FPopupForm);
+ with FListBox do
+ begin
+ Parent := FPopupForm;
+ //Ctl3D := False;
+ Align := TAlignLayout.alClient;
+ //Style := lbOwnerDrawFixed;
+ ItemHeight := 16;
+ OnClick := DoLBClick;
+ //OnDrawItem := LBDrawItem;
+ r.Top := Round(FMemo.AbsTop * FScale) + 18;
+ r.Right := Round((FMemo.Left + FMemo.Width) * FScale);
+ r.Left := r.Right - 140;
+ r.Bottom := r.Top + 162;
+
+ if r.Left < 0 then
+ begin
+ r.Right := r.Right - r.Left;
+ r.Left := 0;
+ end;
+ p := Self.LocalToAbsolute(r.TopLeft);
+ p := GetComponentForm(Self).ClientToScreen(p);
+ FPopupForm.SetBounds(p.Round.X, p.Round.Y, r.Round.Right - r.Round.Left, r.Round.Bottom - r.Round.Top);
+
+ ds := TfrxDataBand(FMemo.Parent).Dataset;
+ if ds <> nil then
+ begin
+ ds.GetFieldList(Items);
+ ItemIndex := Items.IndexOf(FMemo.DataField);
+ FPopupForm.Show;
+ FPopupFormVisible := True;
+ end;
+ end;
+
+ FMode1 := dmNone;
+ FMouseDown := False;
+ Exit;
+ end;
+
+ inherited;
+
+ CreateVirtualGuides;
+end;
+
+procedure TDesignerWorkspace.MouseMove(Shift: TShiftState; X, Y: Single);
+var
+ i: Integer;
+ c, cOver: TfrxComponent;
+ ds: TfrxDataset;
+ e, kx, ky: Extended;
+
+ function Contain(c: TfrxComponent): Boolean;
+ begin
+ Result := (X / FScale >= c.Left) and (X / FScale <= c.Left + c.Width - 4) and
+ (Y / FScale >= c.AbsTop) and (Y / FScale <= c.AbsTop + c.Height);
+ end;
+
+ function GridCheck: Boolean;
+ begin
+ Result := (kx >= GridX) or (kx <= -GridX) or
+ (ky >= GridY) or (ky <= -GridY);
+ if Result then
+ begin
+ kx := Trunc(kx / GridX) * GridX;
+ ky := Trunc(ky / GridY) * GridY;
+ end;
+ end;
+
+begin
+ if FDisableUpdate then Exit;
+ inherited;
+
+ if not FMouseDown and (FMode = dmSelect) and
+ ((FMode1 = dmNone) or (FMode1 = dmMoveGuide)) and not FPopupFormVisible then
+ begin
+ if FPage is TfrxReportPage then
+ begin
+ for i := 0 to HGuides.Count - 1 do
+ begin
+ e := frxStrToFloat(HGuides[i]);
+ if (Y / Scale > e - 5) and (Y / Scale < e + 5) then
+ begin
+ FMode1 := dmMoveGuide;
+ Cursor := crVSplit;
+ FGuide := i;
+ end;
+ end;
+
+ for i := 0 to VGuides.Count - 1 do
+ begin
+ e := frxStrToFloat(VGuides[i]);
+ if (X / Scale > e - 5) and (X / Scale < e + 5) then
+ begin
+ FMode1 := dmMoveGuide;
+ Cursor := crHSplit;
+ FGuide := i;
+ end;
+ end;
+ end;
+
+ if FMode1 = dmNone then
+ begin
+ cOver := nil;
+ for i := FObjects.Count - 1 downto 0 do
+ begin
+ c := FObjects[i];
+ if (c is TfrxMemoView) and Contain(c) and
+ (c.Parent is TfrxDataBand) and
+ (TfrxDataBand(c.Parent).Dataset <> nil) and
+ (TfrxDataBand(c.Parent).Dataset.FieldsCount > 0) then
+ begin
+ ds := TfrxDataBand(c.Parent).Dataset;
+ if ds <> nil then
+ cOver := c;
+ break;
+ end;
+ end;
+
+ if FMemo <> cOver then
+ begin
+ FMemo := TfrxMemoView(cOver);
+ Repaint;
+ end;
+ end;
+ end;
+
+// moving the guideline
+ if FMouseDown and (FMode1 = dmMoveGuide) then
+ begin
+ if Cursor = crHSplit then
+ begin
+ e := frxStrToFloat(VGuides[FGuide]);
+ kx := X / Scale - FLastMousePointX;
+ ky := 0;
+
+ if not (GridAlign and not GridCheck) then
+ begin
+ FModifyFlag := True;
+ e := Round((e + kx) * 100000000) / 100000000;
+ FLastMousePointX := FLastMousePointX + kx;
+ end;
+
+ VGuides[FGuide] := FloatToStr(e);
+ end
+ else
+ begin
+ e := frxStrToFloat(HGuides[FGuide]);
+ kx := 0;
+ ky := Y / Scale - FLastMousePointY;
+
+ if not (GridAlign and not GridCheck) then
+ begin
+ FModifyFlag := True;
+ e := Round((e + ky) * 100000000) / 100000000;
+ FLastMousePointY := FLastMousePointY + ky;
+ end;
+
+ HGuides[FGuide] := FloatToStr(e);
+ end;
+
+ Repaint;
+ end;
+end;
+
+procedure TDesignerWorkspace.MouseUp(Button: TMouseButton;
+ Shift: TShiftState; X, Y: Single);
+var
+ e: Extended;
+begin
+ if FDisableUpdate then Exit;
+ FSimulateMove := False;
+ FVirtualGuideObjects.Clear;
+
+ if FMode1 = dmMoveGuide then
+ begin
+ if Cursor = crHSplit then
+ begin
+ e := frxStrToFloat(VGuides[FGuide]);
+ if (e < 3) or (e > (Width / Scale) - 3) then
+ VGuides.Delete(FGuide);
+ end
+ else
+ begin
+ e := frxStrToFloat(HGuides[FGuide]);
+ if (e < 3) or (e > (Height / Scale) - 3) then
+ HGuides.Delete(FGuide);
+ end;
+
+ Repaint;
+ end;
+
+ inherited;
+end;
+
+procedure TDesignerWorkspace.KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if (Key = VKESCAPE) and FSimulateMove then
+ begin
+ Key := VKDELETE;
+ MouseUp(TMouseButton.mbLeft, [], 0, 0);
+ end;
+ inherited;
+end;
+
+procedure TDesignerWorkspace.SimulateMove;
+var
+ r: TfrxRect;
+begin
+ FMode1 := dmMove;
+ r := GetSelectionBounds;
+ MouseDown(TMouseButton.mbLeft, [], Round(r.Left / Scale) + 20, Round(r.Top / Scale) + 20);
+ FSimulateMove := True;
+end;
+
+procedure TDesignerWorkspace.CreateVirtualGuides;
+var
+ i: Integer;
+begin
+ FVirtualGuideObjects.Clear;
+ for i := 0 to Objects.Count - 1 do
+ FVirtualGuideObjects.Add(Objects[i]);
+end;
+
+procedure TDesignerWorkspace.DoDraw(ACanvas: TCanvas);
+begin
+ inherited;
+ if FDragObject is TfrxRuler then
+ with ACanvas do
+ begin
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ Stroke.Kind := TBrushKind.bkSolid;
+ Stroke.Color := claBlack;
+
+ if TfrxRuler(FDragObject).Align = TAlignLayout.alLeft then
+ DrawLine(PointF(FDragPoint.X, 0), PointF(FDragPoint.X, Self.Height), 1)
+ else
+ DrawLine(PointF(0, FDragPoint.Y), PointF(Self.Width, FDragPoint.Y), 1);
+ end
+end;
+
+procedure TDesignerWorkspace.DoLBClick(Sender: TObject);
+begin
+ if FMemo <> nil then
+ begin
+ FMemo.DataSet := TfrxDataBand(FMemo.Parent).Dataset;
+ FMemo.DataField := FListBox.Items[FListBox.ItemIndex];
+ end;
+ FPopupForm.Close;
+
+ FModifyFlag := True;
+ DoModify;
+end;
+
+procedure TDesignerWorkspace.DoPopupHide(Sender: TObject);
+begin
+ FPopupFormVisible := False;
+end;
+
+//procedure TDesignerWorkspace.LBDrawItem(Control: TWinControl; Index: Integer;
+// ARect: TRect; State: TOwnerDrawState);
+//begin
+// with FListBox do
+// begin
+// Canvas.FillRect(ARect);
+// frxResources.MainButtonImages.Draw(Canvas, ARect.Left, ARect.Top, 54);
+// Canvas.TextOut(ARect.Left + 20, ARect.Top + 1, Items[Index]);
+// end;
+//end;
+
+procedure TDesignerWorkspace.CheckGuides(var kx, ky: Extended;
+ var Result: Boolean);
+var
+ i: Integer;
+ c: TfrxComponent;
+
+ procedure CheckH(coord: Extended);
+ var
+ i: Integer;
+ e: Extended;
+ begin
+ if FPage is TfrxReportPage then
+ for i := 0 to HGuides.Count - 1 do
+ begin
+ e := frxStrToFloat(HGuides[i]);
+ if Abs(coord + ky - e) < 6 then
+ begin
+ ky := e - coord;
+ break;
+ end;
+ end;
+ end;
+
+ procedure CheckV(coord: Extended);
+ var
+ i: Integer;
+ e: Extended;
+ begin
+ if FPage is TfrxReportPage then
+ for i := 0 to VGuides.Count - 1 do
+ begin
+ e := frxStrToFloat(VGuides[i]);
+ if Abs(coord + kx - e) < 6 then
+ begin
+ kx := e - coord;
+ break;
+ end;
+ end;
+ end;
+
+ procedure CheckHH(Left, Top: Extended; Obj: TfrxComponent);
+ var
+ i: Integer;
+ c: TfrxComponent;
+ e: Extended;
+ begin
+ for i := 0 to FVirtualGuideObjects.Count - 1 do
+ begin
+ c := FVirtualGuideObjects[i];
+ if c = Obj then continue;
+ e := c.AbsTop;
+ if Abs(Top + ky - e) < 0.001 then
+ FVirtualGuides.Add(Left, e, c.AbsLeft, e);
+ e := c.AbsTop + c.Height;
+ if Abs(Top + ky - e) < 0.001 then
+ FVirtualGuides.Add(Left, e, c.AbsLeft, e);
+ end;
+ end;
+
+ procedure CheckVV(Left, Top: Extended; Obj: TfrxComponent);
+ var
+ i: Integer;
+ c: TfrxComponent;
+ e: Extended;
+ begin
+ for i := 0 to FVirtualGuideObjects.Count - 1 do
+ begin
+ c := FVirtualGuideObjects[i];
+ if c = Obj then continue;
+ e := c.AbsLeft;
+ if Abs(Left + kx - e) < 0.001 then
+ FVirtualGuides.Add(e, c.AbsTop, e, Top);
+ e := c.AbsLeft + c.Width;
+ if Abs(Left + kx - e) < 0.001 then
+ FVirtualGuides.Add(e, c.AbsTop, e, Top);
+ end;
+ end;
+
+begin
+ if not FShowGuides then Exit;
+
+ FVirtualGuides.Clear;
+
+ if FMouseDown and (FMode1 = dmSizeBand) then
+ CheckH(FSizedBand.Top + FSizedBand.Height);
+
+ if not FMouseDown and ((FMode1 = dmInsertObject) or (FMode1 = dmInsertLine)) then
+ begin
+ CheckV(FInsertion.Left);
+ CheckH(FInsertion.Top);
+ CheckVV(FInsertion.Left, FInsertion.Top, nil);
+ CheckHH(FInsertion.Left, FInsertion.Top, nil);
+ CheckV(FInsertion.Left + FInsertion.Width);
+ CheckH(FInsertion.Top + FInsertion.Height);
+ CheckVV(FInsertion.Left + FInsertion.Width, FInsertion.Top, nil);
+ CheckHH(FInsertion.Left, FInsertion.Top + FInsertion.Height, nil);
+ end;
+
+ if FMouseDown and ((FMode1 = dmInsertObject) or (FMode1 = dmInsertLine)) then
+ begin
+ CheckV(FInsertion.Left);
+ CheckH(FInsertion.Top);
+ CheckVV(FInsertion.Left, FInsertion.Top, nil);
+ CheckHH(FInsertion.Left, FInsertion.Top, nil);
+ end;
+
+ if FMouseDown and (FMode1 = dmMove) then
+ for i := 0 to SelectedCount - 1 do
+ begin
+ c := FSelectedObjects[i];
+ CheckV(c.Left);
+ CheckVV(c.AbsLeft, c.AbsTop, c);
+ CheckHH(c.AbsLeft, c.AbsTop, c);
+ CheckH(c.AbsTop);
+ CheckH(c.Top);
+ CheckV(c.Left + c.Width);
+ CheckVV(c.AbsLeft + c.Width, c.AbsTop, c);
+ CheckHH(c.AbsLeft, c.AbsTop + c.Height, c);
+ CheckH(c.AbsTop + c.Height);
+ end;
+
+ if FMouseDown and (FMode1 = dmSize) then
+ begin
+ c := FSelectedObjects[0];
+ if FCT in [ct1, ct6, ct4] then
+ begin
+ CheckV(c.Left);
+ CheckVV(c.AbsLeft, c.AbsTop, c);
+ end;
+ if FCT in [ct1, ct7, ct3] then
+ begin
+ CheckH(c.AbsTop);
+ CheckHH(c.AbsLeft, c.AbsTop, c);
+ end;
+ if FCT in [ct3, ct5, ct2] then
+ begin
+ CheckV(c.Left + c.Width);
+ CheckVV(c.AbsLeft + c.Width, c.AbsTop, c);
+ end;
+ if FCT in [ct4, ct8, ct2] then
+ begin
+ CheckH(c.AbsTop + c.Height);
+ CheckHH(c.AbsLeft, c.AbsTop + c.Height, c);
+ end;
+ end;
+end;
+
+procedure TDesignerWorkspace.SetShowGuides(const Value: Boolean);
+begin
+ FShowGuides := Value;
+ Repaint;
+ //Invalidate;
+end;
+
+function TDesignerWorkspace.GetHGuides: TStrings;
+begin
+ Result := TfrxReportPage(FPage).HGuides;
+end;
+
+function TDesignerWorkspace.GetVGuides: TStrings;
+begin
+ Result := TfrxReportPage(FPage).VGuides;
+end;
+
+procedure TDesignerWorkspace.SetHGuides(const Value: TStrings);
+begin
+ TfrxReportPage(FPage).HGuides := Value;
+end;
+
+procedure TDesignerWorkspace.SetVGuides(const Value: TStrings);
+begin
+ TfrxReportPage(FPage).VGuides := Value;
+end;
+
+end.
diff --git a/LibD28x64/FMX.frxDesgn_D23.fmx b/LibD28x64/FMX.frxDesgn_D23.fmx
new file mode 100644
index 0000000..46a5a7f
--- /dev/null
+++ b/LibD28x64/FMX.frxDesgn_D23.fmx
@@ -0,0 +1,1800 @@
+object frxDesignerForm: TfrxDesignerForm
+ Left = 0
+ Top = 0
+ Caption = 'Designer'
+ ClientHeight = 610
+ ClientWidth = 988
+ StyleBook = StyleBook1
+ OnActivate = FormActivate
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnCloseQuery = FormCloseQuery
+ OnKeyDown = FormKeyDown
+ OnMouseWheel = FormMouseWheel
+ OnResize = FormResize
+ object StatusBar: TStatusBar
+ Height = 19.000000000000000000
+ Position.Y = 591.000000000000000000
+ ShowSizeGrip = True
+ Width = 988.000000000000000000
+ OnDblClick = StatusBarDblClick
+ OnMouseDown = StatusBarMouseDown
+ end
+ object ObjectsTB1: TToolBar
+ Align = alLeft
+ Height = 513.000000000000000000
+ Position.Y = 78.000000000000000000
+ Width = 27.000000000000000000
+ end
+ object PagePopup: TPopupMenu
+ Left = 760
+ Top = 104
+ end
+ object MainMenu: TMenuBar
+ Align = alMostTop
+ Height = 24.000000000000000000
+ Width = 988.000000000000000000
+ object FileMenu: TMenuItem
+ Height = 24.000000000000000000
+ StyleLookup = 'menubaritemstyle'
+ Width = 16.000000000000000000
+ object NewMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 1
+ Width = 50.000000000000000000
+ OnClick = NewItemCmdExecute
+ end
+ object NewReportMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 1
+ Width = 50.000000000000000000
+ OnClick = NewReportCmdExecute
+ end
+ object NewPageMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 1
+ Width = 50.000000000000000000
+ OnClick = NewPageCmdExecute
+ end
+ object NewDialogMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 1
+ Width = 50.000000000000000000
+ OnClick = NewDialogCmdExecute
+ end
+ object OpenMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 2
+ Width = 50.000000000000000000
+ OnClick = OpenCmdExecute
+ end
+ object SaveMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 2
+ Width = 50.000000000000000000
+ OnClick = SaveCmdExecute
+ end
+ object SaveAsMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 2
+ Width = 50.000000000000000000
+ OnClick = SaveAsCmdExecute
+ end
+ object PreviewMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 3
+ Width = 50.000000000000000000
+ OnClick = PreviewCmdExecute
+ end
+ object PageSettingsMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 3
+ Width = 50.000000000000000000
+ OnClick = PageSettingsCmdExecute
+ end
+ object ExitMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 3
+ Width = 50.000000000000000000
+ OnClick = ExitCmdExecute
+ end
+ end
+ object EditMenu: TMenuItem
+ Height = 24.000000000000000000
+ Position.X = 16.000000000000000000
+ StyleLookup = 'menubaritemstyle'
+ Width = 16.000000000000000000
+ object UndoMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 4
+ Width = 50.000000000000000000
+ OnClick = UndoCmdExecute
+ end
+ object RedoMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 4
+ Width = 50.000000000000000000
+ OnClick = RedoCmdExecute
+ end
+ object CutMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = CutCmdExecute
+ end
+ object CopyMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = CopyCmdExecute
+ end
+ object PasteMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = PasteCmdExecute
+ end
+ object DeleteMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = DeleteCmdExecute
+ end
+ object DeletePageMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = DeletePageCmdExecute
+ end
+ object SelectAllMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 6
+ Width = 50.000000000000000000
+ OnClick = SelectAllCmdExecute
+ end
+ object GroupMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 7
+ Width = 50.000000000000000000
+ OnClick = GroupCmdExecute
+ end
+ object UngroupMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 7
+ Width = 50.000000000000000000
+ OnClick = UngroupCmdExecute
+ end
+ object EditMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 7
+ Width = 50.000000000000000000
+ OnClick = EditCmdExecute
+ end
+ object N2: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 7
+ Width = 50.000000000000000000
+ end
+ object FindMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 8
+ Width = 50.000000000000000000
+ OnClick = FindCmdExecute
+ end
+ object ReplaceMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 8
+ Width = 50.000000000000000000
+ OnClick = ReplaceCmdExecute
+ end
+ object FindNextMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 8
+ Width = 50.000000000000000000
+ OnClick = FindNextCmdExecute
+ end
+ object BringtoFrontMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 9
+ Width = 50.000000000000000000
+ OnClick = BringToFrontCmdExecute
+ end
+ object SendtoBackMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ GroupIndex = 9
+ Width = 50.000000000000000000
+ OnClick = SendToBackCmdExecute
+ end
+ end
+ object ReportMenu: TMenuItem
+ Height = 24.000000000000000000
+ Position.X = 32.000000000000000000
+ StyleLookup = 'menubaritemstyle'
+ Width = 16.000000000000000000
+ object ReportDataMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = ReportDataCmdExecute
+ end
+ object VariablesMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = VariablesCmdExecute
+ end
+ object ReportStylesMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = ReportStylesCmdExecute
+ end
+ object ReportSettingsMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = ReportOptionsCmdExecute
+ end
+ end
+ object ViewMenu: TMenuItem
+ Height = 24.000000000000000000
+ Position.X = 48.000000000000000000
+ StyleLookup = 'menubaritemstyle'
+ Width = 16.000000000000000000
+ object ShowRulersMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ AutoCheck = True
+ Width = 50.000000000000000000
+ OnClick = ShowRulersCmdExecute
+ end
+ object ShowGuidesMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ AutoCheck = True
+ Width = 50.000000000000000000
+ OnClick = ShowGuidesCmdExecute
+ end
+ object DeleteGuidesMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = DeleteGuidesCmdExecute
+ end
+ object OptionsMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = OptionsCmdExecute
+ end
+ end
+ object HelpMenu: TMenuItem
+ Height = 24.000000000000000000
+ Position.X = 64.000000000000000000
+ StyleLookup = 'menubaritemstyle'
+ Width = 16.000000000000000000
+ object AboutMI: TMenuItem
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = AboutCmdExecute
+ end
+ end
+ end
+ object OpenDialog: TOpenDialog
+ Left = 304
+ Top = 104
+ end
+ object SaveDialog: TSaveDialog
+ Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing]
+ Left = 264
+ Top = 104
+ end
+ object TabPopup: TPopupMenu
+ Left = 832
+ Top = 120
+ object NewPageMI1: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = NewPageCmdExecute
+ TabOrder = 0
+ ShortCut = 0
+ end
+ object NewDialogMI1: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = NewDialogCmdExecute
+ TabOrder = 1
+ ShortCut = 0
+ end
+ object DeletePageMI1: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = DeletePageCmdExecute
+ TabOrder = 2
+ ShortCut = 0
+ end
+ object PageSettingsMI1: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = PageSettingsCmdExecute
+ TabOrder = 3
+ ShortCut = 0
+ end
+ end
+ object BandsPopup: TPopupMenu
+ Left = 936
+ Top = 208
+ object ReportTitleMI: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object ReportSummaryMI: TMenuItem
+ Tag = 1
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object PageHeaderMI: TMenuItem
+ Tag = 2
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object PageFooterMI: TMenuItem
+ Tag = 3
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object HeaderMI: TMenuItem
+ Tag = 4
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object FooterMI: TMenuItem
+ Tag = 5
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object MasterDataMI: TMenuItem
+ Tag = 6
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object DetailDataMI: TMenuItem
+ Tag = 7
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object SubdetailDataMI: TMenuItem
+ Tag = 8
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object Data4levelMI: TMenuItem
+ Tag = 9
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object Data5levelMI: TMenuItem
+ Tag = 10
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object Data6levelMI: TMenuItem
+ Tag = 11
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object GroupHeaderMI: TMenuItem
+ Tag = 12
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object GroupFooterMI: TMenuItem
+ Tag = 13
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object ChildMI: TMenuItem
+ Tag = 14
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object ColumnHeaderMI: TMenuItem
+ Tag = 15
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object ColumnFooterMI: TMenuItem
+ Tag = 16
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object OverlayMI: TMenuItem
+ Tag = 17
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object N3: TMenuItem
+ Height = 50.000000000000000000
+ Text = '-'
+ Width = 50.000000000000000000
+ end
+ object VerticalbandsMI: TMenuItem
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ object HeaderMI1: TMenuItem
+ Tag = 104
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object FooterMI1: TMenuItem
+ Tag = 105
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object MasterDataMI1: TMenuItem
+ Tag = 106
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object DetailDataMI1: TMenuItem
+ Tag = 107
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object SubdetailDataMI1: TMenuItem
+ Tag = 108
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object GroupHeaderMI1: TMenuItem
+ Tag = 112
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object GroupFooterMI1: TMenuItem
+ Tag = 113
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ object ChildMI1: TMenuItem
+ Tag = 114
+ Height = 50.000000000000000000
+ Locked = True
+ Width = 50.000000000000000000
+ OnClick = InsertBandClick
+ end
+ end
+ end
+ object Timer: TTimer
+ Enabled = False
+ OnTimer = TimerTimer
+ Left = 488
+ Top = 96
+ end
+ object RotationPopup: TPopupMenu
+ Left = 632
+ Top = 96
+ object R0MI: TMenuItem
+ Tag = 30
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object R45MI: TMenuItem
+ Tag = 30
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object R90MI: TMenuItem
+ Tag = 30
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object R180MI: TMenuItem
+ Tag = 30
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object R270MI: TMenuItem
+ Tag = 30
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ end
+ object OpenScriptDialog: TOpenDialog
+ Left = 392
+ Top = 104
+ end
+ object SaveScriptDialog: TSaveDialog
+ Options = [ofOverwritePrompt, ofHideReadOnly, ofEnableSizing]
+ Left = 344
+ Top = 104
+ end
+ object ObjectsPopup: TPopupMenu
+ Left = 880
+ Top = 176
+ end
+ object DMPPopup: TPopupMenu
+ Left = 928
+ Top = 120
+ object BoldMI: TMenuItem
+ Tag = 34
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object ItalicMI: TMenuItem
+ Tag = 35
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object UnderlineMI: TMenuItem
+ Tag = 36
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object SuperScriptMI: TMenuItem
+ Tag = 37
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object SubScriptMI: TMenuItem
+ Tag = 38
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object CondensedMI: TMenuItem
+ Tag = 39
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object WideMI: TMenuItem
+ Tag = 40
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object N12cpiMI: TMenuItem
+ Tag = 41
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ object N15cpiMI: TMenuItem
+ Tag = 42
+ Height = 50.000000000000000000
+ Width = 50.000000000000000000
+ OnClick = ToolButtonClick
+ end
+ end
+ object BackPanel: TPanel
+ Align = alClient
+ Height = 513.000000000000000000
+ Position.X = 27.000000000000000000
+ Position.Y = 78.000000000000000000
+ Width = 961.000000000000000000
+ object ScrollBoxPanel: TPanel
+ Height = 297.000000000000000000
+ Position.X = 65.000000000000000000
+ Position.Y = 95.000000000000000000
+ Width = 297.000000000000000000
+ object ScrollBox: TfrxScrollBox
+ Align = alClient
+ Height = 274.000000000000000000
+ Position.X = 23.000000000000000000
+ Position.Y = 23.000000000000000000
+ StyleLookup = 'ScrollBoxStyle1'
+ Width = 274.000000000000000000
+ OnResize = ScrollBoxResize
+ OnPositionChanged = ScrollBoxResize
+ end
+ object LeftRuler: TfrxRuler
+ Align = alLeft
+ Cursor = crHandPoint
+ DragMode = dmAutomatic
+ Height = 274.000000000000000000
+ Position.Y = 23.000000000000000000
+ Scale = 1.000000000000000000
+ StyleLookup = 'backgroundstyle'
+ Width = 23.000000000000000000
+ OnDragOver = TopRulerDragOver
+ Offset = 0
+ Start = 0
+ Units = ruCM
+ RulerSize = 0
+ end
+ object TopRuler: TfrxRuler
+ Align = alTop
+ Cursor = crHandPoint
+ DragMode = dmAutomatic
+ Height = 23.000000000000000000
+ Scale = 1.000000000000000000
+ StyleLookup = 'backgroundstyle'
+ Width = 297.000000000000000000
+ OnDragOver = TopRulerDragOver
+ Offset = 22
+ Start = 0
+ Units = ruCM
+ RulerSize = 0
+ end
+ end
+ object CodePanel: TPanel
+ Height = 289.000000000000000000
+ Position.X = 394.000000000000000000
+ Position.Y = 98.000000000000000000
+ Width = 377.000000000000000000
+ object CodeTB: TToolBar
+ Height = 25.000000000000000000
+ Width = 377.000000000000000000
+ object OpenScriptB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 169.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = OpenScriptBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object SaveScriptB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 192.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = SaveScriptBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object RunScriptB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 223.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = RunScriptBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object RunToCursorB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 246.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = RunToCursorBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object StepScriptB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 269.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = RunScriptBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object StopScriptB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 292.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = StopScriptBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object EvaluateB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 315.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = EvaluateBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object BreakPointB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 338.000000000000000000
+ Visible = False
+ Width = 22.000000000000000000
+ OnClick = BreakPointBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ end
+ object LangCB: TComboEdit
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 48.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 100.000000000000000000
+ Height = 20.000000000000000000
+ OnChange = LangCBClick
+ end
+ end
+ end
+ object TabPanel: TPanel
+ Align = alTop
+ Height = 24.000000000000000000
+ Width = 961.000000000000000000
+ end
+ object RightDockTB: TToolBar
+ Align = alRight
+ Height = 489.000000000000000000
+ Position.X = 816.000000000000000000
+ Position.Y = 24.000000000000000000
+ Width = 145.000000000000000000
+ OnResize = RightDockTBResize
+ end
+ object Splitter1: TSplitter
+ Align = alRight
+ Cursor = crHSplit
+ Height = 489.000000000000000000
+ MinSize = 20.000000000000000000
+ Position.X = 811.000000000000000000
+ Position.Y = 24.000000000000000000
+ Width = 5.000000000000000000
+ end
+ object LeftDockTB: TToolBar
+ Align = alLeft
+ Height = 489.000000000000000000
+ Position.Y = 24.000000000000000000
+ Width = 177.000000000000000000
+ OnResize = LeftDockTBResize
+ end
+ object Splitter2: TSplitter
+ Align = alLeft
+ Cursor = crHSplit
+ Height = 489.000000000000000000
+ MinSize = 20.000000000000000000
+ Position.X = 177.000000000000000000
+ Position.Y = 24.000000000000000000
+ Width = 5.000000000000000000
+ end
+ end
+ object TopToolBox: TToolBar
+ Align = alMostTop
+ Height = 54.000000000000000000
+ Position.Y = 24.000000000000000000
+ TabOrder = 3
+ Width = 988.000000000000000000
+ object AlignTB: TToolBar
+ Align = alNone
+ Height = 27.000000000000000000
+ Position.X = 526.000000000000000000
+ Width = 318.000000000000000000
+ object Grip1: TfrxToolGrip
+ Position.X = 4.000000000000000000
+ Position.Y = 6.000000000000000000
+ Width = 4.000000000000000000
+ Height = 14.000000000000000000
+ end
+ object AlignLeftsB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 8.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignLeftsBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 0
+ end
+ object AlignHorzCentersB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 31.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignHorzCentersBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 1
+ end
+ object AlignRightsB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 54.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignRightsBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 2
+ end
+ object Sep7: TfrxToolSeparator
+ Position.X = 80.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object AlignTopsB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 85.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignTopsBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 3
+ end
+ object AlignVertCentersB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 109.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignVertCentersBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 4
+ end
+ object AlignBottomsB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 131.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = AlignBottomsBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 5
+ end
+ object Sep8: TfrxToolSeparator
+ Position.X = 157.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object SpaceHorzB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 162.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = SpaceHorzBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 6
+ end
+ object SpaceVertB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 185.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = SpaceVertBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 7
+ end
+ object Sep9: TfrxToolSeparator
+ Position.X = 211.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object CenterHorzB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 216.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = CenterHorzBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 8
+ end
+ object CenterVertB: TfrxToolButton
+ Tag = 60
+ Height = 22.000000000000000000
+ Position.X = 239.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = CenterVertBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 9
+ end
+ object Sep10: TfrxToolSeparator
+ Position.X = 265.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object SameWidthB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 270.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = SameWidthBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 10
+ end
+ object SameHeightB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 293.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = SameHeightBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 11
+ end
+ end
+ object ExtraToolsTB: TToolBar
+ Align = alNone
+ Height = 27.000000000000000000
+ Position.X = 877.000000000000000000
+ Visible = False
+ Width = 19.000000000000000000
+ end
+ object FrameTB: TToolBar
+ Align = alNone
+ Height = 27.000000000000000000
+ Position.X = 639.000000000000000000
+ Position.Y = 27.000000000000000000
+ Width = 308.000000000000000000
+ object Grip2: TfrxToolGrip
+ Position.X = 4.000000000000000000
+ Position.Y = 6.000000000000000000
+ Width = 4.000000000000000000
+ Height = 14.000000000000000000
+ end
+ object FrameTopB: TfrxToolButton
+ Tag = 20
+ Height = 22.000000000000000000
+ Position.X = 8.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 0
+ end
+ object FrameBottomB: TfrxToolButton
+ Tag = 21
+ Height = 22.000000000000000000
+ Position.X = 31.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 1
+ end
+ object FrameLeftB: TfrxToolButton
+ Tag = 22
+ Height = 22.000000000000000000
+ Position.X = 54.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 2
+ end
+ object FrameRightB: TfrxToolButton
+ Tag = 23
+ Height = 22.000000000000000000
+ Position.X = 77.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 3
+ end
+ object Sep14: TfrxToolSeparator
+ Position.X = 103.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object FrameAllB: TfrxToolButton
+ Tag = 24
+ Height = 22.000000000000000000
+ Position.X = 108.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 4
+ end
+ object FrameNoB: TfrxToolButton
+ Tag = 25
+ Height = 22.000000000000000000
+ Position.X = 131.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 21.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 5
+ end
+ object ShadowB: TfrxToolButton
+ Tag = 32
+ Height = 22.000000000000000000
+ Position.X = 154.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 6
+ end
+ object Sep15: TfrxToolSeparator
+ Position.X = 180.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object FillColorB: TfrxToolButton
+ Tag = 26
+ Height = 22.000000000000000000
+ Position.X = 185.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = FontColorBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 7
+ end
+ object FrameColorB: TfrxToolButton
+ Tag = 27
+ Height = 22.000000000000000000
+ Position.X = 208.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = FontColorBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 8
+ end
+ object FrameStyleB: TfrxToolButton
+ Tag = 28
+ Height = 22.000000000000000000
+ Position.X = 231.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = FrameStyleBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 9
+ end
+ object FrameWidthCB: TComboEdit
+ Tag = 29
+ TabOrder = 10
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ Items.Strings = (
+ '0,1'
+ '0,5'
+ '1'
+ '1,5'
+ '2'
+ '3'
+ '4'
+ '5'
+ '6'
+ '7'
+ '8'
+ '9'
+ '10')
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 256.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 49.000000000000000000
+ Height = 20.000000000000000000
+ OnChange = ToolButtonClick
+ OnKeyDown = FrameWidthCBKeyDown
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ end
+ end
+ object StandardTB: TToolBar
+ Align = alNone
+ Height = 27.000000000000000000
+ Width = 526.000000000000000000
+ object Grip3: TfrxToolGrip
+ Position.X = 4.000000000000000000
+ Position.Y = 6.000000000000000000
+ Width = 4.000000000000000000
+ Height = 14.000000000000000000
+ end
+ object NewB: TfrxToolButton
+ Tag = 40
+ Height = 22.000000000000000000
+ Position.X = 8.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = NewReportCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 0
+ end
+ object OpenB: TfrxToolButton
+ Tag = 41
+ Height = 22.000000000000000000
+ Position.X = 31.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = OpenCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 1
+ end
+ object SaveB: TfrxToolButton
+ Tag = 42
+ Height = 22.000000000000000000
+ Position.X = 54.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = SaveCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 2
+ end
+ object PreviewB: TfrxToolButton
+ Tag = 43
+ Height = 22.000000000000000000
+ Position.X = 77.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = PreviewCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 3
+ end
+ object Sep1: TfrxToolSeparator
+ Position.X = 103.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object NewPageB: TfrxToolButton
+ Tag = 52
+ Height = 22.000000000000000000
+ Position.X = 108.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = NewPageCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 4
+ end
+ object NewDialogB: TfrxToolButton
+ Tag = 70
+ Height = 22.000000000000000000
+ Position.X = 131.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = NewDialogCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 5
+ end
+ object DeletePageB: TfrxToolButton
+ Tag = 53
+ Height = 22.000000000000000000
+ Position.X = 154.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = DeletePageCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 6
+ end
+ object PageSettingsB: TfrxToolButton
+ Tag = 54
+ Height = 22.000000000000000000
+ Position.X = 177.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = PageSettingsCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 7
+ end
+ object Sep2: TfrxToolSeparator
+ Position.X = 203.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object CutB: TfrxToolButton
+ Tag = 44
+ Height = 22.000000000000000000
+ Position.X = 208.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = CutCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 9
+ end
+ object CopyB: TfrxToolButton
+ Tag = 45
+ Height = 22.000000000000000000
+ Position.X = 231.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = CopyCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 10
+ end
+ object PasteB: TfrxToolButton
+ Tag = 46
+ Height = 22.000000000000000000
+ Position.X = 254.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = PasteCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 11
+ end
+ object Sep4: TfrxToolSeparator
+ Position.X = 280.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object UndoB: TfrxToolButton
+ Tag = 47
+ Height = 22.000000000000000000
+ Position.X = 285.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = UndoCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 12
+ end
+ object RedoB: TfrxToolButton
+ Tag = 48
+ Height = 22.000000000000000000
+ Position.X = 308.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = RedoCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 13
+ end
+ object Sep5: TfrxToolSeparator
+ Position.X = 334.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object GroupB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 339.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = GroupCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 14
+ end
+ object UngroupB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 362.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = UngroupCmdExecute
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 15
+ end
+ object Sep6: TfrxToolSeparator
+ Position.X = 388.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object ShowGridB: TfrxToolButton
+ Tag = 55
+ Height = 22.000000000000000000
+ Position.X = 393.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ShowGridBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 16
+ end
+ object AlignToGridB: TfrxToolButton
+ Tag = 56
+ Height = 22.000000000000000000
+ Position.X = 416.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = AlignToGridBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 17
+ end
+ object SetToGridB: TfrxToolButton
+ Tag = 31
+ Height = 22.000000000000000000
+ Position.X = 439.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 18
+ end
+ object ScaleCB: TComboEdit
+ TabOrder = 19
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 465.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 59.000000000000000000
+ Height = 20.000000000000000000
+ OnClick = ScaleCBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ end
+ end
+ object TextTB: TToolBar
+ Align = alNone
+ Height = 27.000000000000000000
+ Position.Y = 27.000000000000000000
+ Width = 639.000000000000000000
+ object Grip4: TfrxToolGrip
+ Position.X = 4.000000000000000000
+ Position.Y = 6.000000000000000000
+ Width = 4.000000000000000000
+ Height = 14.000000000000000000
+ end
+ object StyleCB: TComboEdit
+ Tag = 33
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 8.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 97.000000000000000000
+ Height = 20.000000000000000000
+ OnChange = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ end
+ object FontNameCB: TComboEdit
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 107.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 138.000000000000000000
+ Height = 20.000000000000000000
+ OnChange = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ end
+ object FontSizeCB: TComboEdit
+ Tag = 1
+ Cursor = crIBeam
+ DisableFocusEffect = False
+ KeyboardType = vktDefault
+ ItemHeight = 19.000000000000000000
+ ItemIndex = -1
+ Items.Strings = (
+ '5'
+ '6'
+ '7'
+ '8'
+ '9'
+ '10'
+ '11'
+ '12'
+ '14'
+ '16'
+ '18'
+ '20'
+ '22'
+ '24'
+ '26'
+ '28'
+ '36'
+ '48'
+ '72')
+ ListBoxResource = 'combolistboxstyle'
+ Position.X = 247.000000000000000000
+ Position.Y = 3.000000000000000000
+ Width = 43.000000000000000000
+ Height = 20.000000000000000000
+ OnChange = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ end
+ object BoldB: TfrxToolButton
+ Tag = 2
+ Height = 22.000000000000000000
+ Position.X = 293.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 0
+ end
+ object ItalicB: TfrxToolButton
+ Tag = 3
+ Height = 22.000000000000000000
+ Position.X = 316.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 1
+ end
+ object UnderlineB: TfrxToolButton
+ Tag = 4
+ Height = 22.000000000000000000
+ Position.X = 339.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 2
+ end
+ object Sep11: TfrxToolSeparator
+ Position.X = 365.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object FontB: TfrxToolButton
+ Tag = 43
+ Height = 22.000000000000000000
+ Position.X = 370.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 3
+ end
+ object FontColorB: TfrxToolButton
+ Tag = 5
+ Height = 22.000000000000000000
+ Position.X = 393.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = FontColorBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 4
+ end
+ object HighlightB: TfrxToolButton
+ Tag = 6
+ Height = 22.000000000000000000
+ Position.X = 416.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = HighlightBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 5
+ end
+ object RotateB: TfrxToolButton
+ Height = 22.000000000000000000
+ Position.X = 439.000000000000000000
+ Position.Y = 2.000000000000000000
+ Width = 22.000000000000000000
+ OnClick = RotateBClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 6
+ end
+ object Sep12: TfrxToolSeparator
+ Position.X = 465.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object TextAlignLeftB: TfrxToolButton
+ Tag = 7
+ Height = 22.000000000000000000
+ Position.X = 470.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 7
+ end
+ object TextAlignCenterB: TfrxToolButton
+ Tag = 8
+ Height = 22.000000000000000000
+ Position.X = 493.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 8
+ end
+ object TextAlignRightB: TfrxToolButton
+ Tag = 9
+ Height = 22.000000000000000000
+ Position.X = 516.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 9
+ end
+ object TextAlignBlockB: TfrxToolButton
+ Tag = 10
+ Height = 22.000000000000000000
+ Position.X = 539.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 10
+ end
+ object Sep13: TfrxToolSeparator
+ Position.X = 565.000000000000000000
+ Position.Y = 5.000000000000000000
+ Width = 4.000000000000000000
+ Height = 16.000000000000000000
+ end
+ object TextAlignTopB: TfrxToolButton
+ Tag = 11
+ Height = 22.000000000000000000
+ Position.X = 570.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 11
+ end
+ object TextAlignMiddleB: TfrxToolButton
+ Tag = 12
+ Height = 22.000000000000000000
+ Position.X = 593.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 12
+ end
+ object TextAlignBottomB: TfrxToolButton
+ Tag = 13
+ Height = 22.000000000000000000
+ Position.X = 616.000000000000000000
+ Position.Y = 2.000000000000000000
+ StaysPressed = True
+ Width = 22.000000000000000000
+ OnClick = ToolButtonClick
+ OnMouseEnter = NewPageBMouseEnter
+ OnMouseLeave = NewPageBMouseLeave
+ Hint = ''
+ TabOrder = 13
+ end
+ end
+ end
+ object StyleBook1: TStyleBook
+ Styles = <
+ item
+ ResourcesBin = {
+ 464D585F5354594C4520322E35010611546162436F6E74726F6C315374796C65
+ 31034901060F48696E7450616E656C5374796C6531030A01005450463007544C
+ 61796F757400095374796C654E616D650611546162436F6E74726F6C31537479
+ 6C65310A506F736974696F6E2E5805000000000000008B07400A506F73697469
+ 6F6E2E5905000000000000809007400A53697A652E5769647468050000000000
+ 00008E06400B53697A652E4865696768740500000000000000CA05401453697A
+ 652E506C6174666F726D44656661756C7408000A5452656374616E676C650005
+ 416C69676E0708436F6E74656E74730A46696C6C2E436F6C6F720708636C6157
+ 686974650748697454657374080553696465730B03546F70044C656674055269
+ 676874000A53697A652E576964746805000000000000008E06400B53697A652E
+ 4865696768740500000000000000CA05401453697A652E506C6174666F726D44
+ 656661756C74080C5374726F6B652E436F6C6F72070978464638453845384500
+ 000054504630115443616C6C6F757452656374616E676C6500095374796C654E
+ 616D65060F48696E7450616E656C5374796C65310A46696C6C2E436F6C6F7207
+ 08636C6142656967650748697454657374080A506F736974696F6E2E58050000
+ 00000000008B08400A506F736974696F6E2E590500000000000000A607400A53
+ 697A652E57696474680500000000000000C804400B53697A652E486569676874
+ 0500000000000000C804401453697A652E506C6174666F726D44656661756C74
+ 080C5374726F6B652E436F6C6F7207097846463937393739370C43616C6C6F75
+ 7457696474680500000000000000B803400D43616C6C6F75744C656E67746805
+ 00000000000000B002400000}
+ end>
+ Left = 32
+ Top = 120
+ end
+ object HintPanel: TCalloutPanel
+ Height = 57.000000000000000000
+ Margins.Top = 11.000000000000000000
+ Position.X = 520.000000000000000000
+ Position.Y = 400.000000000000000000
+ StyleLookup = 'HintPanelStyle1'
+ Visible = False
+ Width = 97.000000000000000000
+ CalloutWidth = 23.000000000000000000
+ CalloutLength = 11.000000000000000000
+ object Label1: TLabel
+ Align = alClient
+ Height = 46.000000000000000000
+ Position.Y = 11.000000000000000000
+ Text = 'Label1'
+ TextAlign = taCenter
+ Width = 97.000000000000000000
+ end
+ end
+end
diff --git a/LibD28x64/FMX.frxDialogForm.fmx b/LibD28x64/FMX.frxDialogForm.fmx
new file mode 100644
index 0000000..423d7c0
--- /dev/null
+++ b/LibD28x64/FMX.frxDialogForm.fmx
@@ -0,0 +1,10 @@
+object frxDialogForm: TfrxDialogForm
+ Left = 0
+ Top = 0
+ Caption = ' '
+ ClientHeight = 59
+ ClientWidth = 115
+ Visible = False
+ OnCloseQuery = FormCloseQuery
+ StyleLookup = 'backgroundstyle'
+end
diff --git a/LibD28x64/FMX.frxDialogForm.pas b/LibD28x64/FMX.frxDialogForm.pas
new file mode 100644
index 0000000..59e0191
--- /dev/null
+++ b/LibD28x64/FMX.frxDialogForm.pas
@@ -0,0 +1,98 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Dialog form }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDialogForm;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.UITypes,
+ FMX.Controls, FMX.Forms
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm, System.SysUtils, System.Types
+{$ENDIF}
+ ;
+
+
+type
+{$IFDEF LINUX}
+ TfrxDialogForm = class(TfrxForm)
+{$ELSE}
+ TfrxDialogForm = class(TForm)
+{$ENDIF}
+ procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+ protected
+ procedure ReadState(Reader: TReader); override;
+ private
+ FOnModify: TNotifyEvent;
+ FThreadSafe: Boolean;
+ public
+ constructor Create(AOwner: TComponent); override;
+ property OnModify: TNotifyEvent read FOnModify write FOnModify;
+ property ThreadSafe: Boolean read FThreadSafe write FThreadSafe;
+{$IFDEF LINUX}
+ function ShowModal: TModalResult; overload;
+{$ENDIF}
+ end;
+
+implementation
+
+{$R *.FMX}
+
+{procedure TfrxDialogForm.WMExitSizeMove(var Msg: TMessage);
+begin
+ inherited;
+ if Assigned(OnModify) then
+ OnModify(Self);
+end;}
+
+procedure TfrxDialogForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+begin
+ CanClose := False;
+end;
+
+procedure TfrxDialogForm.ReadState(Reader: TReader);
+begin
+ if not ThreadSafe then
+ inherited ReadState(Reader);
+end;
+
+constructor TfrxDialogForm.Create(AOwner: TComponent);
+begin
+ if AOwner <> nil then
+ FThreadSafe := AOwner.Tag = 318;
+ AOwner := nil;
+
+ inherited CreateNew(AOwner);
+end;
+{$IFDEF LINUX}
+function TfrxDialogForm.ShowModal: TModalResult;
+var FDefaultWindowRect: TRectF;
+begin
+
+ if BorderStyle = TFmxFormBorderStyle.Single then
+ if GnomeAndRedHat then
+ begin
+ FDefaultWindowRect := TRectF.Create(0, 0,
+ ClientWidth,
+ ScaleWidthOrHeightForm(ClientHeight, 1.35));
+ FWinService.SetWindowRect(self, FDefaultWindowRect);
+ Height := Round(FDefaultWindowRect.Height);
+ end;
+
+ Result := inherited;
+end;
+{$ENDIF}
+end.
diff --git a/LibD28x64/FMX.frxDsgnIntf.pas b/LibD28x64/FMX.frxDsgnIntf.pas
new file mode 100644
index 0000000..c873b41
--- /dev/null
+++ b/LibD28x64/FMX.frxDsgnIntf.pas
@@ -0,0 +1,1789 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Design interface }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxDsgnIntf;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.Classes, System.SysUtils, System.TypInfo, System.Types, System.Variants,
+ System.UIConsts, System.UITypes, FMX.Types, FMX.Menus, FMX.Colors,
+ FMX.frxClass, FMX.frxFMX
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+ TfrxPropertyAttribute = (paValueList, paSortList, paDialog,
+ paMultiSelect, paSubProperties, paReadOnly, paOwnerDraw);
+ TfrxPropertyAttributes = set of TfrxPropertyAttribute;
+
+ TfrxPropertyEditor = class(TObject)
+ private
+ FDesigner: TfrxCustomDesigner;
+ FCompList: TList;
+ FPropList: TList;
+ FItemHeight: Integer;
+ FValues: TStrings;
+ function GetPropInfo: PPropInfo;
+ function GetComponent: TPersistent;
+ function GetfrComponent: TfrxComponent;
+ protected
+ procedure GetStrProc(const s: String);
+ function GetFloatValue: Extended;
+ function GetOrdValue: NativeInt;
+ function GetStrValue: String;
+ function GetVarValue: Variant;
+ procedure SetFloatValue(Value: Extended);
+ procedure SetOrdValue(Value: frxInteger);
+ procedure SetStrValue(const Value: String);
+ procedure SetVarValue(Value: Variant);
+ public
+ constructor Create(Designer: TfrxCustomDesigner); virtual;
+ destructor Destroy; override;
+ function Edit: Boolean; virtual;
+ function GetAttributes: TfrxPropertyAttributes; virtual;
+ function GetName: String; virtual;
+ function GetExtraLBSize: Integer; virtual;
+ function GetValue: String; virtual;
+ procedure GetValues; virtual;
+ procedure SetValue(const Value: String); virtual;
+ procedure OnDrawLBItem(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF); virtual;
+ procedure OnDrawItem(Canvas: TCanvas; ARect: TRectF); virtual;
+ property Component: TPersistent read GetComponent;
+ property frComponent: TfrxComponent read GetfrComponent;
+ property Designer: TfrxCustomDesigner read FDesigner;
+ property ItemHeight: Integer read FItemHeight write FItemHeight;
+ property PropInfo: PPropInfo read GetPropInfo;
+ property Value: String read GetValue write SetValue;
+ property Values: TStrings read FValues;
+ end;
+
+ TfrxPropertyEditorClass = class of TfrxPropertyEditor;
+
+ TfrxComponentEditor = class(TObject)
+ private
+ FComponent: TfrxComponent;
+ FDesigner: TfrxCustomDesigner;
+ FMenu: TPopupMenu;
+ FOnClick: TNotifyEvent;
+ protected
+ function AddItem(const Caption: String; Tag: Integer;
+ Checked: Boolean = False): TMenuItem;
+ public
+ constructor Create(Component: TfrxComponent; Designer: TfrxCustomDesigner;
+ Menu: TPopupMenu);
+ function Edit: Boolean; virtual;
+ function HasEditor: Boolean; virtual;
+ procedure GetMenuItems(OnClickEvent: TNotifyEvent); virtual;
+ function Execute(Tag: Integer; Checked: Boolean): Boolean; virtual;
+ property Component: TfrxComponent read FComponent;
+ property Designer: TfrxCustomDesigner read FDesigner;
+ end;
+
+ TfrxComponentEditorClass = class of TfrxComponentEditor;
+
+ TfrxIntegerProperty = class(TfrxPropertyEditor)
+ public
+ function GetValue: String; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxFloatProperty = class(TfrxPropertyEditor)
+ public
+ function GetValue: String; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxCharProperty = class(TfrxPropertyEditor)
+ public
+ function GetValue: String; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxStringProperty = class(TfrxPropertyEditor)
+ public
+ function GetValue: String; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxEnumProperty = class(TfrxPropertyEditor)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function GetValue: String; override;
+ procedure GetValues; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxSetProperty = class(TfrxPropertyEditor)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function GetValue: String; override;
+ end;
+
+ TfrxSetElementProperty = class(TfrxPropertyEditor)
+ private
+ FElement: Integer;
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function GetName: String; override;
+ function GetValue: String; override;
+ procedure GetValues; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxClassProperty = class(TfrxPropertyEditor)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function GetValue: String; override;
+ end;
+
+ TfrxComponentProperty = class(TfrxPropertyEditor)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function GetValue: String; override;
+ procedure GetValues; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ end;
+
+ TfrxColorProperty = class(TfrxIntegerProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function GetValue: String; override;
+ procedure GetValues; override;
+ procedure SetValue(const Value: String); override;
+ procedure OnDrawLBItem(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF); override;
+ procedure OnDrawItem(Canvas: TCanvas; ARect: TRectF); override;
+ end;
+
+ TfrxFontProperty = class(TfrxClassProperty)
+ public
+ function Edit: Boolean; override;
+ function GetAttributes: TfrxPropertyAttributes; override;
+ end;
+
+ TfrxFontNameProperty = class(TfrxStringProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ procedure GetValues; override;
+ end;
+
+ TfrxModalResultProperty = class(TfrxIntegerProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function GetValue: String; override;
+ procedure GetValues; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxCursorProperty = class(TfrxIntegerProperty)
+ public
+ function GetAttributes: TfrxPropertyAttributes; override;
+ function GetValue: String; override;
+ procedure GetValues; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxDateTimeProperty = class(TfrxPropertyEditor)
+ public
+ function GetValue: String; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxDateProperty = class(TfrxPropertyEditor)
+ public
+ function GetValue: String; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+ TfrxTimeProperty = class(TfrxPropertyEditor)
+ public
+ function GetValue: String; override;
+ procedure SetValue(const Value: String); override;
+ end;
+
+{ Internal classes used by Object Inspector }
+
+ TfrxPropertyList = class;
+
+ TfrxPropertyItem = class(TCollectionItem)
+ private
+ FEditor: TfrxPropertyEditor;
+ FExpanded: Boolean;
+ FSubProperty: TfrxPropertyList;
+ public
+ destructor Destroy; override;
+ property Editor: TfrxPropertyEditor read FEditor;
+ property Expanded: Boolean read FExpanded write FExpanded;
+ property SubProperty: TfrxPropertyList read FSubProperty;
+ end;
+
+ TfrxPropertyList = class(TCollection)
+ private
+ FComponent: TPersistent;
+ FDesigner: TfrxCustomDesigner;
+ FParent: TfrxPropertyList;
+ procedure AddProperties(PropertyList: TfrxPropertyList);
+ procedure FillProperties(AClass: TPersistent);
+ procedure FillCommonProperties(PropertyList: TfrxPropertyList);
+ procedure SetComponent(Value: TPersistent);
+ function GetPropertyItem(Index: Integer): TfrxPropertyItem;
+ public
+ constructor Create(Designer: TfrxCustomDesigner);
+ function Add: TfrxPropertyItem;
+ property Component: TPersistent read FComponent write SetComponent;
+ property Items[Index: Integer]: TfrxPropertyItem read GetPropertyItem; default;
+ property Parent: TfrxPropertyList read FParent;
+ end;
+
+
+{ registered items }
+
+ TfrxObjectCategory = (ctData, ctReport, ctDialog, ctDMP);
+ TfrxObjectCategories = set of TfrxObjectCategory;
+
+ TfrxObjectItem = class(TCollectionItem)
+ public
+ ClassRef: TfrxComponentClass;
+ ButtonBmp: TBitmap;
+ ButtonImageIndex: Integer;
+ ButtonHint: String;
+ CategoryName: String;
+ Flags: Word;
+ Category: TfrxObjectCategories;
+ end;
+
+ TfrxComponentEditorItem = class(TCollectionItem)
+ public
+ ComponentClass: TfrxComponentClass;
+ ComponentEditor: TfrxComponentEditorClass;
+ end;
+
+ TfrxPropertyEditorItem = class(TCollectionItem)
+ public
+ PropertyType: PTypeInfo;
+ ComponentClass: TClass;
+ PropertyName: String;
+ EditorClass: TfrxPropertyEditorClass;
+ end;
+
+ TfrxExportFilterItem = class(TCollectionItem)
+ public
+ Filter: TfrxCustomExportFilter;
+ end;
+
+ TfrxWizardItem = class(TCollectionItem)
+ public
+ ClassRef: TfrxWizardClass;
+ ButtonBmp: TBitmap;
+ ButtonImageIndex: Integer;
+ IsToolbarWizard: Boolean;
+ end;
+
+ TfrxObjectCollection = class(TCollection)
+ private
+ function GetObjectItem(Index: Integer): TfrxObjectItem;
+ public
+ constructor Create;
+ procedure RegisterCategory(const CategoryName: String; ButtonBmp: TBitmap;
+ const ButtonHint: String; ImageIndex: Integer = -1);
+ procedure RegisterObject(ClassRef: TfrxComponentClass; ButtonBmp: TBitmap;
+ const CategoryName: String = '');
+ procedure RegisterObject1(ClassRef: TfrxComponentClass; ButtonBmp: TBitmap;
+ const ButtonHint: String = ''; const CategoryName: String = '';
+ Flags: Integer = 0; ImageIndex: Integer = -1;
+ Category: TfrxObjectCategories = []);
+ procedure Unregister(ClassRef: TfrxComponentClass);
+ property Items[Index: Integer]: TfrxObjectItem read GetObjectItem; default;
+ end;
+
+ TfrxComponentEditorCollection = class(TCollection)
+ private
+ function GetComponentEditorItem(Index: Integer): TfrxComponentEditorItem;
+ public
+ constructor Create;
+ procedure Register(ComponentClass: TfrxComponentClass;
+ ComponentEditor: TfrxComponentEditorClass);
+ procedure UnRegister(ComponentEditor: TfrxComponentEditorClass);
+ function GetComponentEditor(Component: TfrxComponent;
+ Designer: TfrxCustomDesigner; Menu: TPopupMenu): TfrxComponentEditor;
+ property Items[Index: Integer]: TfrxComponentEditorItem
+ read GetComponentEditorItem; default;
+ end;
+
+ TfrxPropertyEditorCollection = class(TCollection)
+ private
+ FEventEditorItem: Integer;
+ function GetPropertyEditorItem(Index: Integer): TfrxPropertyEditorItem;
+ public
+ constructor Create;
+ procedure Register(PropertyType: PTypeInfo; ComponentClass: TClass;
+ const PropertyName: String; EditorClass: TfrxPropertyEditorClass);
+ procedure RegisterEventEditor(EditorClass: TfrxPropertyEditorClass);
+ procedure UnRegister(EditorClass: TfrxPropertyEditorClass);
+ function GetPropertyEditor(PropertyType: PTypeInfo; Component: TPersistent;
+ PropertyName: String): Integer;
+ property Items[Index: Integer]: TfrxPropertyEditorItem
+ read GetPropertyEditorItem; default;
+ end;
+
+ TfrxExportFilterCollection = class(TCollection)
+ private
+ function GetExportFilterItem(Index: Integer): TfrxExportFilterItem;
+ public
+ constructor Create;
+ procedure Register(Filter: TfrxCustomExportFilter);
+ procedure Unregister(Filter: TfrxCustomExportFilter);
+ property Items[Index: Integer]: TfrxExportFilterItem
+ read GetExportFilterItem; default;
+ end;
+
+ TfrxWizardCollection = class(TCollection)
+ private
+ function GetWizardItem(Index: Integer): TfrxWizardItem;
+ public
+ constructor Create;
+ procedure Register(ClassRef: TfrxWizardClass; ButtonBmp: TBitmap;
+ IsToolbarWizard: Boolean = False);
+ procedure Register1(ClassRef: TfrxWizardClass; ImageIndex: Integer);
+ procedure Unregister(ClassRef: TfrxWizardClass);
+ property Items[Index: Integer]: TfrxWizardItem read GetWizardItem; default;
+ end;
+
+
+{ internal methods }
+
+function frxCreatePropertyList(ComponentList: TList; Designer: TfrxCustomDesigner): TfrxPropertyList;
+procedure frxHideProperties(ComponentClass: TClass; const Properties: String);
+
+
+function frxObjects: TfrxObjectCollection;
+function frxComponentEditors: TfrxComponentEditorCollection;
+function frxPropertyEditors: TfrxPropertyEditorCollection;
+function frxExportFilters: TfrxExportFilterCollection;
+function frxWizards: TfrxWizardCollection;
+
+
+implementation
+
+uses
+ FMX.frxUtils, FMX.frxRes, FMX.ListBox, FMX.frxFontForm;
+
+type
+ TIntegerSet = set of 0..31;
+
+var
+ FObjects: TfrxObjectCollection = nil;
+ FComponentEditors: TfrxComponentEditorCollection = nil;
+ FPropertyEditors: TfrxPropertyEditorCollection = nil;
+ FExportFilters: TfrxExportFilterCollection = nil;
+ FWizards: TfrxWizardCollection = nil;
+
+{ Routines }
+
+procedure frxHideProperties(ComponentClass: TClass; const Properties: String);
+var
+ i: Integer;
+ sl: TStringList;
+begin
+ sl := TStringList.Create;
+ frxSetCommaText(Properties, sl);
+
+ for i := 0 to sl.Count - 1 do
+ frxPropertyEditors.Register(nil, ComponentClass, sl[i], nil);
+
+ sl.Free;
+end;
+
+function frxCreatePropertyList(ComponentList: TList;
+ Designer: TfrxCustomDesigner): TfrxPropertyList;
+var
+ i: Integer;
+ p: TfrxPropertyList;
+ l: TList;
+begin
+ if ComponentList.Count = 0 then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ l := TList.Create;
+ for i := 0 to ComponentList.Count - 1 do
+ begin
+ p := TfrxPropertyList.Create(Designer);
+ l.Add(p);
+ p.Component := ComponentList[i];
+ end;
+
+ Result := l[0];
+ for i := 1 to ComponentList.Count - 1 do
+ Result.FillCommonProperties(TfrxPropertyList(l[i]));
+
+ for i := 1 to ComponentList.Count - 1 do
+ begin
+ TfrxPropertyList(l[i]).FillCommonProperties(Result);
+ Result.AddProperties(TfrxPropertyList(l[i]));
+ TfrxPropertyList(l[i]).Free;
+ end;
+
+ l.Free;
+end;
+
+function frStrToFloat(s: String): Extended;
+var
+ i: Integer;
+begin
+ for i := 1 to Length(s) do
+ if CharInSet(s[i], [',', '.']) then
+ s[i] := FormatSettings.DecimalSeparator;
+ Result := StrToFloat(Trim(s));
+end;
+
+
+{ TfrxPropertyEditor }
+
+constructor TfrxPropertyEditor.Create(Designer: TfrxCustomDesigner);
+begin
+ FDesigner := Designer;
+ FCompList := TList.Create;
+ FPropList := TList.Create;
+ FValues := TfrxStringList.Create;
+end;
+
+destructor TfrxPropertyEditor.Destroy;
+begin
+ FCompList.Free;
+ FPropList.Free;
+ FValues.Free;
+ inherited;
+end;
+
+function TfrxPropertyEditor.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect];
+end;
+
+function TfrxPropertyEditor.GetName: String;
+begin
+ Result := String(PropInfo.Name);
+end;
+
+function TfrxPropertyEditor.GetComponent: TPersistent;
+begin
+ Result := FCompList[0];
+end;
+
+function TfrxPropertyEditor.GetfrComponent: TfrxComponent;
+begin
+ if TObject(FCompList[0]) is TfrxComponent then
+ Result := FCompList[0] else
+ Result := nil;
+end;
+
+function TfrxPropertyEditor.GetPropInfo: PPropInfo;
+begin
+ Result := FPropList[0];
+end;
+
+function TfrxPropertyEditor.GetValue: String;
+begin
+ Result := '(Unknown)';
+end;
+
+procedure TfrxPropertyEditor.SetValue(const Value: String);
+begin
+ { empty method }
+end;
+
+function TfrxPropertyEditor.GetFloatValue: Extended;
+begin
+ Result := GetFloatProp(Component, PropInfo);
+end;
+
+function TfrxPropertyEditor.GetOrdValue: NativeInt;
+begin
+ Result := GetOrdProp(Component, PropInfo);
+end;
+
+function TfrxPropertyEditor.GetStrValue: String;
+begin
+ Result := GetStrProp(Component, PropInfo);
+end;
+
+function TfrxPropertyEditor.GetVarValue: Variant;
+begin
+ Result := GetVariantProp(Component, PropInfo);
+end;
+
+procedure TfrxPropertyEditor.SetFloatValue(Value: Extended);
+var
+ i: Integer;
+begin
+ for i := 0 to FCompList.Count - 1 do
+ if (PPropInfo(FPropList[i]).SetProc <> nil) then
+ SetFloatProp(TObject(FCompList[i]), PPropInfo(FPropList[i]), Value);
+end;
+
+procedure TfrxPropertyEditor.SetOrdValue(Value: frxInteger);
+var
+ i: Integer;
+begin
+ for i := 0 to FCompList.Count - 1 do
+ if (PPropInfo(FPropList[i]).SetProc <> nil) then
+ SetOrdProp(TObject(FCompList[i]), PPropInfo(FPropList[i]), Value);
+end;
+
+procedure TfrxPropertyEditor.SetStrValue(const Value: String);
+var
+ i: Integer;
+begin
+ for i := 0 to FCompList.Count - 1 do
+ if (PPropInfo(FPropList[i]).SetProc <> nil) then
+ SetStrProp(TObject(FCompList[i]), PPropInfo(FPropList[i]), Value);
+end;
+
+procedure TfrxPropertyEditor.SetVarValue(Value: Variant);
+var
+ i: Integer;
+begin
+ for i := 0 to FCompList.Count - 1 do
+ if (PPropInfo(FPropList[i]).SetProc <> nil) then
+ SetVariantProp(TObject(FCompList[i]), PPropInfo(FPropList[i]), Value);
+end;
+
+procedure TfrxPropertyEditor.GetValues;
+begin
+ FValues.Clear;
+ TStringList(FValues).Sorted := paSortList in GetAttributes;
+end;
+
+procedure TfrxPropertyEditor.GetStrProc(const s: String);
+begin
+ FValues.Add(s);
+end;
+
+function TfrxPropertyEditor.Edit: Boolean;
+var
+ i: Integer;
+begin
+ Result := False;
+ GetValues;
+ if FValues.Count > 0 then
+ begin
+ i := FValues.IndexOf(Value) + 1;
+ if i = FValues.Count then
+ i := 0;
+ Value := FValues[i];
+ Result := True;
+ end;
+end;
+
+procedure TfrxPropertyEditor.OnDrawLBItem(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF);
+begin
+ with Canvas do
+ begin
+ Fill.Kind := TBrushKind.bkSolid;
+ Fill.Color := claWhite;
+ FillRect(ARect, 0, 0, allCorners, 1);
+ Fill.Color := claBlack;
+ FillText(RectF(ARect.Left + FItemHeight + 4, ARect.Top + 1, ARect.Right, ARect.Bottom),
+ TListBoxItem(Sender).Text, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ end;
+end;
+
+procedure TfrxPropertyEditor.OnDrawItem(Canvas: TCanvas; ARect: TRectF);
+begin
+ with Canvas do
+ begin
+ Fill.Kind := TBrushKind.bkSolid;
+ FillText(RectF(ARect.Left + FItemHeight - 2, ARect.Top, ARect.Right, ARect.Bottom), Value, False, 1, [], TTextAlign.taLeading, TTextAlign.taLeading);
+ end;
+end;
+
+function TfrxPropertyEditor.GetExtraLBSize: Integer;
+begin
+ Result := FItemHeight + 2;
+end;
+
+
+{ TfrxComponentEditor }
+
+function TfrxComponentEditor.Edit: Boolean;
+begin
+ Result := False;
+end;
+
+procedure TfrxComponentEditor.GetMenuItems(OnClickEvent: TNotifyEvent);
+var
+ SepMI: TMenuItem;
+begin
+ SepMI := TMenuItem.Create(FMenu);
+ SepMI.Text := '-';
+ SepMI.Parent := FMenu;
+ FOnClick := OnClickEvent;
+end;
+
+function TfrxComponentEditor.Execute(Tag: Integer; Checked: Boolean): Boolean;
+begin
+ Result := False;
+end;
+
+function TfrxComponentEditor.HasEditor: Boolean;
+begin
+ Result := False;
+end;
+
+function TfrxComponentEditor.AddItem(const Caption: String; Tag: Integer;
+ Checked: Boolean): TMenuItem;
+begin
+ Result := TMenuItem.Create(FMenu);
+ Result.Text := Caption;
+ Result.Tag := Tag;
+ Result.IsChecked := Checked;
+ Result.OnClick := FOnClick;
+ FMenu.AddObject(Result);
+end;
+
+
+constructor TfrxComponentEditor.Create(Component: TfrxComponent;
+ Designer: TfrxCustomDesigner; Menu: TPopupMenu);
+begin
+ FComponent := Component;
+ FDesigner := Designer;
+ FMenu := Menu;
+ FOnClick := nil;
+end;
+
+
+{ TfrxPropertyList }
+
+constructor TfrxPropertyList.Create(Designer: TfrxCustomDesigner);
+begin
+ inherited Create(TfrxPropertyItem);
+ FDesigner := Designer;
+end;
+
+function TfrxPropertyList.GetPropertyItem(Index: Integer): TfrxPropertyItem;
+begin
+ Result := TfrxPropertyItem(inherited Items[Index]);
+end;
+
+function TfrxPropertyList.Add: TfrxPropertyItem;
+begin
+ Result := TfrxPropertyItem(inherited Add);
+end;
+
+procedure TfrxPropertyList.SetComponent(Value: TPersistent);
+begin
+ FComponent := Value;
+ Clear;
+ FillProperties(FComponent);
+end;
+
+procedure TfrxPropertyList.FillProperties(AClass: TPersistent);
+var
+ Item, Item1: TfrxPropertyItem;
+ TypeInfo: PTypeInfo;
+ PropertyCount: Integer;
+ PropertyList: PPropList;
+ i, j: Integer;
+ FClass: TClass;
+
+ function CreateEditor(EditorClass: TfrxPropertyEditorClass; AClass: TPersistent;
+ PropInfo: PPropInfo): TfrxPropertyEditor;
+ var
+ Item: TfrxPropertyEditorItem;
+ e: Integer;
+ begin
+ Result := nil;
+ e := frxPropertyEditors.GetPropertyEditor(PropInfo.PropType^, AClass, String(PropInfo.Name));
+ if e <> -1 then
+ begin
+ Item := frxPropertyEditors[e];
+ if Item.EditorClass <> nil then
+ Result := TfrxPropertyEditor(Item.EditorClass.NewInstance) else
+ Exit;
+ end
+ else
+ Result := TfrxPropertyEditor(EditorClass.NewInstance);
+
+ Result.Create(FDesigner);
+ Result.FCompList.Add(AClass);
+ Result.FPropList.Add(PropInfo);
+ end;
+
+begin
+ if AClass = nil then exit;
+
+ TypeInfo := AClass.ClassInfo;
+ PropertyCount := GetPropList(TypeInfo, tkProperties, nil);
+ GetMem(PropertyList, PropertyCount * SizeOf(PPropInfo));
+ GetPropList(TypeInfo, tkProperties, PropertyList);
+
+ for i := 0 to PropertyCount - 1 do
+ begin
+ Item := Add;
+ case PropertyList[i].PropType^.Kind of
+ tkInteger:
+ Item.FEditor := CreateEditor(TfrxIntegerProperty, AClass, PropertyList[i]);
+
+ tkChar, tkWChar:
+ Item.FEditor := CreateEditor(TfrxCharProperty, AClass, PropertyList[i]);
+
+ tkFloat:
+ Item.FEditor := CreateEditor(TfrxFloatProperty, AClass, PropertyList[i]);
+
+ tkString, tkLString, tkWString, tkUString:
+ Item.FEditor := CreateEditor(TfrxStringProperty, AClass, PropertyList[i]);
+
+ tkEnumeration:
+ Item.FEditor := CreateEditor(TfrxEnumProperty, AClass, PropertyList[i]);
+
+ tkSet:
+ begin
+ Item.FSubProperty := TfrxPropertyList.Create(FDesigner);
+ Item.FSubProperty.FParent := Self;
+ Item.FEditor := CreateEditor(TfrxSetProperty, AClass, PropertyList[i]);
+ with GetTypeData(GetTypeData(PropertyList[i].PropType^).CompType^)^ do
+ for j := MinValue to MaxValue do
+ begin
+ Item1 := Item.FSubProperty.Add;
+ Item1.FEditor := CreateEditor(TfrxSetElementProperty, AClass, PropertyList[i]);
+ if Item1.FEditor <> nil then
+ TfrxSetElementProperty(Item1.FEditor).FElement := j;
+ end;
+ end;
+
+ tkClass:
+ begin
+ FClass := GetTypeData(PropertyList[i].PropType^)^.ClassType;
+ if FClass.InheritsFrom(TComponent) then
+ Item.FEditor := CreateEditor(TfrxComponentProperty, AClass, PropertyList[i])
+ else if FClass.InheritsFrom(TPersistent) then
+ begin
+ Item.FEditor := CreateEditor(TfrxClassProperty, AClass, PropertyList[i]);
+ Item.FSubProperty := TfrxPropertyList.Create(FDesigner);
+ Item.FSubProperty.FParent := Self;
+ Item.FSubProperty.Component := TPersistent(GetOrdProp(AClass, PropertyList[i]));
+ if Item.SubProperty.Count = 0 then
+ begin
+ Item.FSubProperty.Free;
+ Item.FSubProperty := nil;
+ end;
+ end;
+ end;
+ end;
+ if Item.FEditor = nil then
+ Item.Free;
+ end;
+
+ FreeMem(PropertyList, PropertyCount * SizeOf(PPropInfo));
+end;
+
+procedure TfrxPropertyList.FillCommonProperties(PropertyList: TfrxPropertyList);
+var
+ i, j: Integer;
+ p, p1: TfrxPropertyItem;
+ Found: Boolean;
+begin
+ i := 0;
+ while i < Count do
+ begin
+ p := Items[i];
+ Found := False;
+ if paMultiSelect in p.Editor.GetAttributes then
+ for j := 0 to PropertyList.Count - 1 do
+ begin
+ p1 := PropertyList.Items[j];
+ if (p1.Editor.GetPropInfo.PropType^.Kind = p.Editor.GetPropInfo.PropType^.Kind) and
+ (p1.Editor.GetPropInfo.Name = p.Editor.GetPropInfo.Name) then
+ begin
+ Found := True;
+ break;
+ end;
+ end;
+
+ if not Found then
+ p.Free else
+ Inc(i);
+ end;
+end;
+
+procedure TfrxPropertyList.AddProperties(PropertyList: TfrxPropertyList);
+
+ procedure EnumProperties(p1, p2: TfrxPropertyList);
+ var
+ i: Integer;
+ begin
+ for i := 0 to p1.Count - 1 do
+ begin
+ p1[i].Editor.FCompList.Add(p2[i].Editor.FCompList[0]);
+ p1[i].Editor.FPropList.Add(p2[i].Editor.FPropList[0]);
+ if p1[i].SubProperty <> nil then
+ EnumProperties(p1[i].SubProperty, p2[i].SubProperty);
+ end;
+ end;
+
+begin
+ EnumProperties(Self, PropertyList);
+end;
+
+
+{ TfrxPropertyItem }
+
+destructor TfrxPropertyItem.Destroy;
+begin
+ if Editor <> nil then
+ Editor.Free;
+ if SubProperty <> nil then
+ SubProperty.Free;
+ inherited;
+end;
+
+
+{ TfrxIntegerProperty }
+
+function TfrxIntegerProperty.GetValue: String;
+begin
+ Result := IntToStr(GetOrdValue);
+end;
+
+procedure TfrxIntegerProperty.SetValue(const Value: String);
+begin
+ SetOrdValue(StrToInt(Value));
+end;
+
+
+{ TfrxFloatProperty }
+
+function TfrxFloatProperty.GetValue: String;
+begin
+ Result := FloatToStr(GetFloatValue);
+end;
+
+procedure TfrxFloatProperty.SetValue(const Value: String);
+begin
+ SetFloatValue(frStrToFloat(Value));
+end;
+
+
+{ TfrxCharProperty }
+
+function TfrxCharProperty.GetValue: String;
+var
+ Ch: Char;
+begin
+ Ch := Chr(GetOrdValue);
+ if CharInSet(Ch, [#33..#255]) then
+ Result := Ch else
+ FmtStr(Result, '#%d', [Ord(Ch)]);
+end;
+
+procedure TfrxCharProperty.SetValue(const Value: String);
+var
+ i: Integer;
+begin
+ if Length(Value) = 0 then i := 0 else
+ if Length(Value) = 1 then i := Ord(Value[1]) else
+ if Value[1] = '#' then i := StrToInt(Copy(Value, 2, 255)) else
+ raise Exception.Create(frxResources.Get('prInvProp'));
+ SetOrdValue(i);
+end;
+
+
+{ TfrxStringProperty }
+
+function TfrxStringProperty.GetValue: String;
+begin
+ Result := GetStrValue;
+end;
+
+procedure TfrxStringProperty.SetValue(const Value: String);
+begin
+ SetStrValue(Value);
+end;
+
+
+{ TfrxEnumProperty }
+
+function TfrxEnumProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paSortList];
+end;
+
+function TfrxEnumProperty.GetValue: String;
+var
+ i: Integer;
+begin
+ i := GetOrdValue;
+ try
+ Result := GetEnumName(PropInfo.PropType^, i);
+ except
+ Result := '';
+ end;
+end;
+
+procedure TfrxEnumProperty.GetValues;
+var
+ i: Integer;
+begin
+ inherited;
+ with GetTypeData(PropInfo.PropType^)^ do
+ for i := MinValue to MaxValue do
+ Values.Add(GetEnumName(PropInfo.PropType^, i));
+end;
+
+procedure TfrxEnumProperty.SetValue(const Value: String);
+var
+ i: Integer;
+begin
+ i := GetEnumValue(PropInfo.PropType^, Value);
+ if i < 0 then
+ raise Exception.Create(frxResources.Get('prInvProp'));
+ SetOrdValue(i);
+end;
+
+
+{ TfrxSetProperty }
+
+function TfrxSetProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paSubProperties, paReadOnly];
+end;
+
+function TfrxSetProperty.GetValue: String;
+var
+ S: TIntegerSet;
+ TypeInfo: PTypeInfo;
+ I: Integer;
+begin
+ Integer(S) := GetOrdValue;
+ TypeInfo := GetTypeData(PropInfo.PropType^).CompType^;
+ Result := '[';
+ for i := 0 to 31 do
+ if i in S then
+ begin
+ if Length(Result) <> 1 then
+ Result := Result + ',';
+ Result := Result + GetEnumName(TypeInfo, i);
+ end;
+ Result := Result + ']';
+end;
+
+
+{ TfrxSetElementProperty }
+
+function TfrxSetElementProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paSortList];
+end;
+
+function TfrxSetElementProperty.GetName: String;
+begin
+ Result := GetEnumName(GetTypeData(PropInfo.PropType^).CompType^, FElement);
+end;
+
+function TfrxSetElementProperty.GetValue: String;
+var
+ S: TIntegerSet;
+begin
+ Integer(S) := GetOrdValue;
+ if FElement in S then
+ Result := 'True' else
+ Result := 'False';
+end;
+
+procedure TfrxSetElementProperty.GetValues;
+begin
+ inherited;
+ Values.Add('False');
+ Values.Add('True');
+end;
+
+procedure TfrxSetElementProperty.SetValue(const Value: String);
+var
+ S: TIntegerSet;
+begin
+ Integer(S) := GetOrdValue;
+ if CompareText(Value, 'True') = 0 then
+ Include(S, FElement)
+ else if CompareText(Value, 'False') = 0 then
+ Exclude(S, FElement)
+ else
+ raise Exception.Create(frxResources.Get('prInvProp'));
+
+ SetOrdValue(Integer(S));
+end;
+
+
+{ TfrxClassProperty }
+
+function TfrxClassProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paSubProperties, paReadOnly];
+end;
+
+function TfrxClassProperty.GetValue: String;
+begin
+ Result := {'';//}'(' + String(PropInfo.PropType^.Name) + ')';
+end;
+
+
+{ TComponentProperty }
+
+function TfrxComponentProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paSortList];
+end;
+
+function TfrxComponentProperty.GetValue: String;
+var
+ c: TComponent;
+begin
+ c := TComponent(GetOrdValue);
+ if c <> nil then
+ Result := c.Name else
+ Result := '';
+end;
+
+procedure TfrxComponentProperty.GetValues;
+var
+ i: Integer;
+ c, c1: TfrxComponent;
+begin
+ inherited;
+
+ if frComponent <> nil then
+ begin
+ if frComponent is TfrxReportComponent then
+ c := frComponent.Page else
+ c := frComponent;
+ for i := 0 to c.AllObjects.Count - 1 do
+ begin
+ c1 := c.AllObjects[i];
+ if (c1 <> frComponent) and
+ c1.InheritsFrom(GetTypeData(PropInfo.PropType^)^.ClassType) then
+ Values.Add(c1.Name);
+ end;
+ end;
+end;
+
+procedure TfrxComponentProperty.SetValue(const Value: String);
+var
+ c: TComponent;
+begin
+ c := nil;
+ if Value <> '' then
+ begin
+ c := frComponent.Report.FindObject(Value);
+ if c = nil then
+ raise Exception.Create(frxResources.Get('prInvProp'));
+ end;
+
+ SetOrdValue(frxInteger(c));
+end;
+
+
+{ TfrxNameProperty }
+
+function TfrxNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [];
+end;
+
+
+{ TfrxColorProperty }
+
+function TfrxColorProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paOwnerDraw];
+end;
+
+function TfrxColorProperty.GetValue: String;
+begin
+ Result := AlphaColorToString(GetOrdValue);
+end;
+
+procedure TfrxColorProperty.SetValue(const Value: String);
+begin
+ SetOrdValue(StringToAlphaColor(Value));
+end;
+
+procedure TfrxColorProperty.GetValues;
+begin
+ inherited;
+ GetAlphaColorValues(GetStrProc);
+end;
+
+procedure TfrxColorProperty.OnDrawLBItem(Sender: TObject; Canvas: TCanvas;
+ const ARect: TRectF);
+var
+ r: TRectF;
+ c: Integer;
+begin
+ inherited;
+ with Canvas do
+ begin
+ r := RectF(Round(ARect.Left + 2) + 0.5, Round(ARect.Top + 2) + 0.5, Round(ARect.Left + (ARect.Bottom - ARect.Top - 2)) - 0.5, Round(ARect.Bottom - 2) + 0.5);
+ IdentToAlphaColor('cla' + TListBoxItem(Sender).Text, c);
+ Fill.Color := c;
+ Fill.Kind := TBrushKind.bkSolid;
+ FillRect(r, 0, 0, allCorners, 1);
+ Stroke.Color := claDimGray;
+ Stroke.Kind := TBrushKind.bkSolid;
+ DrawRect(r, 0, 0, allCorners, 1);
+ end;
+end;
+
+procedure TfrxColorProperty.OnDrawItem(Canvas: TCanvas; ARect: TRectF);
+var
+ r: TRectF;
+begin
+ inherited;
+ with Canvas do
+ begin
+ r := RectF(Round(ARect.Left) + 0.5, Round(ARect.Top) + 1.5, Round(ARect.Left + (ARect.Bottom - ARect.Top - 5)) - 0.5, Round(ARect.Bottom - 5) + 0.5);
+ Fill.Color := Cardinal(GetOrdValue) or $FF000000;
+ Fill.Kind := TBrushKind.bkSolid;
+ FillRect(r, 0, 0, allCorners, 1);
+ Stroke.Color := claDimGray;
+ Stroke.Kind := TBrushKind.bkSolid;
+ DrawRect(r, 0, 0, allCorners, 1);
+ end;
+end;
+
+
+{ TfrxFontProperty }
+
+function TfrxFontProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paDialog, paSubProperties, paReadOnly];
+end;
+
+function TfrxFontProperty.Edit: Boolean;
+//var
+ //FontDialog: TFontDialog;
+begin
+// todo
+{ FontDialog := TFontDialog.Create(Application);
+ try
+ FontDialog.Font := TFont(GetOrdValue);
+ FontDialog.Options := FontDialog.Options + [fdForceFontExist];
+ FontDialog.Device := fdBoth;
+ Result := FontDialog.Execute;
+ if Result then
+ SetOrdValue(Integer(FontDialog.Font));
+ finally
+ FontDialog.Free;
+ end;}
+ with TfrxFontForm.Create(nil) do
+ begin
+
+ try
+ FontS.Assign(TfrxFont(GetOrdValue));
+ FormActivate(nil);
+ if ShowModal = mrOk then
+ SetOrdValue(frxInteger(FontS));
+ finally
+ Free;
+ end;
+ end;
+ Result := True;
+end;
+
+
+{ TfrxFontNameProperty }
+
+function TfrxFontNameProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paSortList];
+end;
+
+procedure TfrxFontNameProperty.GetValues;
+begin
+ if Values.Count = 0 then
+ FillFontsList(Values);
+end;
+
+
+{ TfrxModalResultProperty }
+
+const
+ ModalResults: array[mrNone..mrYesToAll] of string = (
+ 'mrNone',
+ 'mrOk',
+ 'mrCancel',
+ 'mrAbort',
+ 'mrRetry',
+ 'mrIgnore',
+ 'mrYes',
+ 'mrNo',
+ 'mrClose',
+ 'mrHelp',
+ 'mrTryAgain',
+ 'mrContinue',
+ 'mrAll',
+ 'mrNoToAll',
+ 'mrYesToAll');
+
+function TfrxModalResultProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList];
+end;
+
+function TfrxModalResultProperty.GetValue: String;
+begin
+ if GetOrdValue in [mrNone..mrYesToAll] then
+ Result := ModalResults[GetOrdValue] else
+ Result := inherited GetValue;
+end;
+
+procedure TfrxModalResultProperty.SetValue(const Value: String);
+var
+ i: Integer;
+ s: String;
+begin
+ s := Value;
+ if s = '' then
+ s := '0';
+ for i := Low(ModalResults) to High(ModalResults) do
+ if CompareText(ModalResults[i], s) = 0 then
+ begin
+ SetOrdValue(i);
+ Exit;
+ end;
+ inherited SetValue(s);
+end;
+
+procedure TfrxModalResultProperty.GetValues;
+var
+ i: Integer;
+begin
+ inherited;
+ for i := mrNone to mrYesToAll do
+ Values.Add(ModalResults[i]);
+end;
+
+
+
+{ TfrxCursorProperty }
+
+function TfrxCursorProperty.GetAttributes: TfrxPropertyAttributes;
+begin
+ Result := [paMultiSelect, paValueList, paSortList];
+end;
+
+function TfrxCursorProperty.GetValue: string;
+begin
+ Result := CursorToString(TCursor(GetOrdValue));
+end;
+
+procedure TfrxCursorProperty.GetValues;
+begin
+ inherited;
+ GetCursorValues(GetStrProc);
+end;
+
+procedure TfrxCursorProperty.SetValue(const Value: string);
+var
+ NewValue: Integer;
+begin
+ if IdentToCursor(Value, NewValue) then
+ SetOrdValue(NewValue) else
+ inherited;
+end;
+
+
+{ TfrxDateTimeProperty }
+
+function TfrxDateTimeProperty.GetValue: String;
+var
+ DT: TDateTime;
+begin
+ DT := GetFloatValue;
+ if DT = 0.0 then
+ Result := ''
+ else
+ Result := DateTimeToStr(DT);
+end;
+
+procedure TfrxDateTimeProperty.SetValue(const Value: String);
+var
+ DT: TDateTime;
+begin
+ if Value = '' then
+ DT := 0.0
+ else
+ DT := StrToDateTime(Value);
+ SetFloatValue(DT);
+end;
+
+
+{ TfrxDateProperty }
+
+function TfrxDateProperty.GetValue: String;
+var
+ DT: TDateTime;
+begin
+ DT := GetFloatValue;
+ if DT = 0.0 then
+ Result := ''
+ else
+ Result := DateToStr(DT);
+end;
+
+procedure TfrxDateProperty.SetValue(const Value: String);
+var
+ DT: TDateTime;
+begin
+ if Value = '' then
+ DT := 0.0
+ else
+ DT := StrToDate(Value);
+ SetFloatValue(DT);
+end;
+
+
+{ TfrxTimeProperty }
+
+function TfrxTimeProperty.GetValue: String;
+var
+ DT: TDateTime;
+begin
+ DT := GetFloatValue;
+ if DT = 0.0 then
+ Result := ''
+ else
+ Result := TimeToStr(DT);
+end;
+
+procedure TfrxTimeProperty.SetValue(const Value: String);
+var
+ DT: TDateTime;
+begin
+ if Value = '' then
+ DT := 0.0
+ else
+ DT := StrToTime(Value);
+ SetFloatValue(DT);
+end;
+
+
+{ TfrxObjectCollection }
+
+constructor TfrxObjectCollection.Create;
+begin
+ inherited Create(TfrxObjectItem);
+end;
+
+function TfrxObjectCollection.GetObjectItem(Index: Integer): TfrxObjectItem;
+begin
+ Result := TfrxObjectItem(inherited Items[Index]);
+end;
+
+procedure TfrxObjectCollection.RegisterCategory(const CategoryName: String;
+ ButtonBmp: TBitmap; const ButtonHint: String; ImageIndex: Integer);
+begin
+ RegisterObject1(nil, ButtonBmp, ButtonHint, CategoryName, 0, ImageIndex);
+end;
+
+procedure TfrxObjectCollection.RegisterObject(ClassRef: TfrxComponentClass;
+ ButtonBmp: TBitmap; const CategoryName: String);
+begin
+ RegisterObject1(ClassRef, ButtonBmp, '', CategoryName);
+end;
+
+procedure TfrxObjectCollection.RegisterObject1(
+ ClassRef: TfrxComponentClass; ButtonBmp: TBitmap;
+ const ButtonHint: String = ''; const CategoryName: String = '';
+ Flags: Integer = 0; ImageIndex: Integer = -1;
+ Category: TfrxObjectCategories = []);
+var
+ i: Integer;
+ Item: TfrxObjectItem;
+begin
+ for i := 0 to Count - 1 do
+ begin
+ Item := Items[i];
+ if (Item.ClassRef <> nil) and (Item.ClassRef = ClassRef) and
+ (Item.Flags = Flags) then
+ Exit;
+ end;
+
+ if ClassRef <> nil then
+ RegisterFmxClasses([ClassRef]);
+
+ Item := TfrxObjectItem(Add);
+ Item.ClassRef := ClassRef;
+ Item.ButtonBmp := ButtonBmp;
+ Item.ButtonImageIndex := ImageIndex;
+ Item.ButtonHint := ButtonHint;
+ Item.CategoryName := CategoryName;
+ Item.Flags := Flags;
+ Item.Category := Category;
+
+ { if category is not set, determine it automatically }
+ if (ClassRef <> nil) and (Category = []) then
+ begin
+ if ClassRef.InheritsFrom(TfrxDataset) or
+ ClassRef.InheritsFrom(TfrxCustomDatabase) then
+ Item.Category := [ctData]
+ else if ClassRef.InheritsFrom(TfrxDialogControl) or
+ ClassRef.InheritsFrom(TfrxDialogComponent) then
+ Item.Category := [ctDialog]
+ else
+ Item.Category := [ctReport];
+ end;
+end;
+
+procedure TfrxObjectCollection.UnRegister(ClassRef: TfrxComponentClass);
+var
+ i: Integer;
+begin
+ i := 0;
+ while i < Count do
+ begin
+ if Items[i].ClassRef = ClassRef then
+ Items[i].Free else
+ Inc(i);
+ end;
+end;
+
+
+{ TfrxComponentEditorCollection }
+
+constructor TfrxComponentEditorCollection.Create;
+begin
+ inherited Create(TfrxComponentEditorItem);
+end;
+
+function TfrxComponentEditorCollection.GetComponentEditorItem(
+ Index: Integer): TfrxComponentEditorItem;
+begin
+ Result := TfrxComponentEditorItem(inherited Items[Index]);
+end;
+
+function TfrxComponentEditorCollection.GetComponentEditor(Component: TfrxComponent;
+ Designer: TfrxCustomDesigner; Menu: TPopupMenu): TfrxComponentEditor;
+var
+ i, j: Integer;
+begin
+ Result := nil;
+ j := -1;
+ for i := 0 to Count - 1 do
+ if Items[i].ComponentClass = Component.ClassType then
+ begin
+ j := i;
+ break;
+ end
+ else if Component.InheritsFrom(Items[i].ComponentClass) then
+ j := i;
+
+ if j <> -1 then
+ begin
+ Result := TfrxComponentEditor(Items[j].ComponentEditor.NewInstance);
+ Result.Create(Component, Designer, Menu);
+ end;
+end;
+
+procedure TfrxComponentEditorCollection.Register(ComponentClass: TfrxComponentClass;
+ ComponentEditor: TfrxComponentEditorClass);
+var
+ Item: TfrxComponentEditorItem;
+begin
+ Item := TfrxComponentEditorItem(Add);
+ Item.ComponentClass := ComponentClass;
+ Item.ComponentEditor := ComponentEditor;
+end;
+
+procedure TfrxComponentEditorCollection.UnRegister(ComponentEditor: TfrxComponentEditorClass);
+var
+ i: Integer;
+begin
+ i := 0;
+ while i < Count do
+ begin
+ if Items[i].ComponentEditor = ComponentEditor then
+ Items[i].Free else
+ Inc(i);
+ end;
+end;
+
+
+{ TfrxPropertyEditorCollection }
+
+constructor TfrxPropertyEditorCollection.Create;
+begin
+ inherited Create(TfrxPropertyEditorItem);
+ FEventEditorItem := -1;
+end;
+
+function TfrxPropertyEditorCollection.GetPropertyEditorItem(
+ Index: Integer): TfrxPropertyEditorItem;
+begin
+ Result := TfrxPropertyEditorItem(inherited Items[Index]);
+end;
+
+function TfrxPropertyEditorCollection.GetPropertyEditor(PropertyType: PTypeInfo;
+ Component: TPersistent; PropertyName: String): Integer;
+var
+ i: Integer;
+ Item: TfrxPropertyEditorItem;
+begin
+ if (Pos('tfrx', LowerCase(String(PropertyType.Name))) = 1) and
+ (Pos('event', LowerCase(String(PropertyType.Name))) = Length(PropertyType.Name) - 4) then
+ begin
+ Result := FEventEditorItem;
+ Exit;
+ end;
+
+ Result := -1;
+ for i := Count - 1 downto 0 do
+ begin
+ Item := Items[i];
+ if (Item.ComponentClass = nil) and (Item.PropertyName = '') and
+ (Item.PropertyType = PropertyType) then
+ Result := i
+ else if (Item.ComponentClass = nil) and (Item.PropertyType = PropertyType) and
+ (CompareText(Item.PropertyName, PropertyName) = 0) then
+ begin
+ Result := i;
+ break;
+ end
+ else if (Component.InheritsFrom(Item.ComponentClass)) and
+ (CompareText(Item.PropertyName, PropertyName) = 0) then
+ begin
+ Result := i;
+ break;
+ end;
+ end;
+end;
+
+procedure TfrxPropertyEditorCollection.Register(PropertyType: PTypeInfo;
+ ComponentClass: TClass; const PropertyName: String;
+ EditorClass: TfrxPropertyEditorClass);
+var
+ Item: TfrxPropertyEditorItem;
+begin
+ Item := TfrxPropertyEditorItem(Add);
+ Item.PropertyType := PropertyType;
+ Item.ComponentClass := ComponentClass;
+ Item.PropertyName := PropertyName;
+ Item.EditorClass := EditorClass;
+end;
+
+procedure TfrxPropertyEditorCollection.RegisterEventEditor(
+ EditorClass: TfrxPropertyEditorClass);
+begin
+ Register(nil, nil, '', EditorClass);
+ FEventEditorItem := Count - 1;
+end;
+
+procedure TfrxPropertyEditorCollection.UnRegister(EditorClass: TfrxPropertyEditorClass);
+var
+ i: Integer;
+begin
+ i := 0;
+ while i < Count do
+ begin
+ if Items[i].EditorClass = EditorClass then
+ Items[i].Free else
+ Inc(i);
+ end;
+end;
+
+
+{ TfrxExportFilterCollection }
+
+constructor TfrxExportFilterCollection.Create;
+begin
+ inherited Create(TfrxExportFilterItem);
+end;
+
+function TfrxExportFilterCollection.GetExportFilterItem(
+ Index: Integer): TfrxExportFilterItem;
+begin
+ Result := TfrxExportFilterItem(inherited Items[Index]);
+end;
+
+procedure TfrxExportFilterCollection.Register(Filter: TfrxCustomExportFilter);
+var
+ i: Integer;
+ Item: TfrxExportFilterItem;
+begin
+ if Filter = nil then Exit;
+ for i := 0 to Count - 1 do
+ if Items[i].Filter = Filter then
+ Exit;
+
+ Item := TfrxExportFilterItem(Add);
+ Item.Filter := Filter;
+end;
+
+procedure TfrxExportFilterCollection.UnRegister(Filter: TfrxCustomExportFilter);
+var
+ i: Integer;
+begin
+ i := 0;
+ while i < Count do
+ begin
+ if Items[i].Filter = Filter then
+ Items[i].Free else
+ Inc(i);
+ end;
+end;
+
+
+{ TfrxWizardCollection }
+
+constructor TfrxWizardCollection.Create;
+begin
+ inherited Create(TfrxWizardItem);
+end;
+
+function TfrxWizardCollection.GetWizardItem(Index: Integer): TfrxWizardItem;
+begin
+ Result := TfrxWizardItem(inherited Items[Index]);
+end;
+
+procedure TfrxWizardCollection.Register(ClassRef: TfrxWizardClass;
+ ButtonBmp: TBitmap; IsToolbarWizard: Boolean);
+var
+ i: Integer;
+ Item: TfrxWizardItem;
+begin
+ for i := 0 to Count - 1 do
+ if Items[i].ClassRef = ClassRef then
+ Exit;
+
+ Item := TfrxWizardItem(Add);
+ Item.ClassRef := ClassRef;
+ Item.ButtonBmp := ButtonBmp;
+ Item.ButtonImageIndex := -1;
+ Item.IsToolbarWizard := IsToolbarWizard;
+end;
+
+procedure TfrxWizardCollection.Register1(ClassRef: TfrxWizardClass;
+ ImageIndex: Integer);
+var
+ i: Integer;
+ Item: TfrxWizardItem;
+begin
+ for i := 0 to Count - 1 do
+ if Items[i].ClassRef = ClassRef then
+ Exit;
+
+ Item := TfrxWizardItem(Add);
+ Item.ClassRef := ClassRef;
+ Item.ButtonImageIndex := ImageIndex;
+end;
+
+procedure TfrxWizardCollection.UnRegister(ClassRef: TfrxWizardClass);
+var
+ i: Integer;
+begin
+ i := 0;
+ while i < Count do
+ begin
+ if Items[i].ClassRef = ClassRef then
+ Items[i].Free else
+ Inc(i);
+ end;
+end;
+
+
+{ globals }
+
+function frxObjects: TfrxObjectCollection;
+begin
+ if FObjects = nil then
+ FObjects := TfrxObjectCollection.Create;
+ Result := FObjects;
+end;
+
+function frxComponentEditors: TfrxComponentEditorCollection;
+begin
+ if FComponentEditors = nil then
+ FComponentEditors := TfrxComponentEditorCollection.Create;
+ Result := FComponentEditors;
+end;
+
+function frxPropertyEditors: TfrxPropertyEditorCollection;
+begin
+ if FPropertyEditors = nil then
+ FPropertyEditors := TfrxPropertyEditorCollection.Create;
+ Result := FPropertyEditors;
+end;
+
+function frxExportFilters: TfrxExportFilterCollection;
+begin
+ if FExportFilters = nil then
+ FExportFilters := TfrxExportFilterCollection.Create;
+ Result := FExportFilters;
+end;
+
+function frxWizards: TfrxWizardCollection;
+begin
+ if FWizards = nil then
+ FWizards := TfrxWizardCollection.Create;
+ Result := FWizards;
+end;
+
+
+initialization
+ frxPropertyEditors.Register(TypeInfo(TComponentName), nil, 'Name', TfrxNameProperty);
+ frxPropertyEditors.Register(TypeInfo(TAlphaColor), nil, '', TfrxColorProperty);
+// frxPropertyEditors.Register(TypeInfo(TfrxFont), nil, '', TfrxFontProperty);
+ frxPropertyEditors.Register(TypeInfo(String), TfrxFont, 'Name', TfrxFontNameProperty);
+ frxPropertyEditors.Register(TypeInfo(TModalResult), nil, '', TfrxModalResultProperty);
+ frxPropertyEditors.Register(TypeInfo(TCursor), nil, '', TfrxCursorProperty);
+ frxPropertyEditors.Register(TypeInfo(TDateTime), nil, '', TfrxDateTimeProperty);
+ frxPropertyEditors.Register(TypeInfo(TDate), nil, '', TfrxDateProperty);
+ frxPropertyEditors.Register(TypeInfo(TTime), nil, '', TfrxTimeProperty);
+
+
+finalization
+ if FObjects <> nil then
+ FObjects.Free;
+ FObjects := nil;
+ if FComponentEditors <> nil then
+ FComponentEditors.Free;
+ FComponentEditors := nil;
+ if FPropertyEditors <> nil then
+ FPropertyEditors.Free;
+ FPropertyEditors := nil;
+ if FExportFilters <> nil then
+ FExportFilters.Free;
+ FExportFilters := nil;
+ if FWizards <> nil then
+ FWizards.Free;
+ FWizards := nil;
+
+
+end.
+
diff --git a/LibD28x64/FMX.frxEditAliases.fmx b/LibD28x64/FMX.frxEditAliases.fmx
new file mode 100644
index 0000000..5d74512
--- /dev/null
+++ b/LibD28x64/FMX.frxEditAliases.fmx
@@ -0,0 +1,69 @@
+object frxAliasesEditorForm: TfrxAliasesEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Edit Aliases'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 386
+ ClientWidth = 349
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object HintL: TLabel
+ Position.Point = '(232,32)'
+ Width = 112.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object DSAliasL: TLabel
+ Position.Point = '(4,8)'
+ Width = 125.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object FieldAliasesL: TLabel
+ Position.Point = '(4,32)'
+ Width = 57.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 2
+ end
+ object OkB: TButton
+ Position.Point = '(188,356)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 3
+ ModalResult = 1
+ end
+ object CancelB: TButton
+ Position.Point = '(268,356)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 4
+ ModalResult = 2
+ end
+ object ResetB: TButton
+ Position.Point = '(4,356)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = ResetBClick
+ TabOrder = 5
+ end
+ object DSAliasE: TEdit
+ Position.Point = '(148,4)'
+ Width = 197.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 6
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object UpdateB: TButton
+ Position.Point = '(84,356)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = UpdateBClick
+ TabOrder = 7
+ end
+end
diff --git a/LibD28x64/FMX.frxEditAliases.pas b/LibD28x64/FMX.frxEditAliases.pas
new file mode 100644
index 0000000..6a5d65c
--- /dev/null
+++ b/LibD28x64/FMX.frxEditAliases.pas
@@ -0,0 +1,404 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ Aliases editor }
+{ }
+{ Copyright (c) 1998-2011 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditAliases;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Objects, FMX.Controls, FMX.Forms, FMX.Dialogs, System.Math,
+ FMX.frxClass, System.Variants, FMX.Edit, FMX.Types, FMX.Layouts, FMX.Grid, System.UITypes, System.Rtti
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+
+type
+
+
+{$IFNDEF DELPHI17}
+ TfrxStringGrid = class(TStringGrid)
+ protected
+ function GetValue(Col, Row: Integer): Variant; override;
+ procedure SetValue(Col, Row: Integer; const Value: Variant); override;
+ end;
+ THackStringGrid = class(TfrxStringGrid);
+{$ELSE}
+ THackStringGrid = class(TStringGrid);
+{$ENDIF}
+
+{$IFDEF LINUX}
+ TfrxAliasesEditorForm = class(TfrxForm)
+{$ELSE}
+ TfrxAliasesEditorForm = class(TForm)
+{$ENDIF}
+ OkB: TButton;
+ CancelB: TButton;
+ ResetB: TButton;
+ HintL: TLabel;
+ DSAliasL: TLabel;
+ DSAliasE: TEdit;
+ FieldAliasesL: TLabel;
+ UpdateB: TButton;
+ procedure FormHide(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure ResetBClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure UpdateBClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ FDataSet: TfrxCustomDBDataset;
+{$IFDEF DELPHI17}
+ AliasGrid: TStringGrid;
+{$ELSE}
+ AliasGrid: TfrxStringGrid;
+{$ENDIF}
+ procedure BuildAliasList(List: TStrings);
+ public
+ property DataSet: TfrxCustomDBDataset read FDataSet write FDataSet;
+ end;
+
+ { TStringColumn }
+
+ TStringCheckColumn = class(TCheckColumn)
+ private
+{$IFNDEF DELPHI24}
+ FRowCount: integer;
+ FCheckCells: array of Boolean;
+{$ENDIF}
+ protected
+{$IFNDEF DELPHI17}
+ procedure UpdateColumn; override;
+{$ELSE}
+{$IFNDEF DELPHI24}
+ procedure UpdateRowCount(const RowCount: integer); override;
+ function GetCells(ARow: Integer): TValue; override;
+ procedure SetCells(ARow: Integer; const Value: TValue); override;
+{$ENDIF}
+{$ENDIF}
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxRes, FMX.frxFMX;
+
+
+{ TStringColumn }
+
+{$IFNDEF DELPHI17}
+procedure TStringCheckColumn.UpdateColumn;
+begin
+ inherited;
+ FRowCount := Min(Grid.RowCount, Grid.VisibleRows);
+ SetLength(FCellControls, FRowCount);
+end;
+{$ELSE}
+{$IFNDEF DELPHI24}
+procedure TStringCheckColumn.UpdateRowCount(const RowCount: integer);
+begin
+ if (RowCount > 0) then
+ SetLength(FCheckCells, RowCount);
+ FRowCount := RowCount;
+end;
+
+function TStringCheckColumn.GetCells(ARow: Integer): TValue;
+begin
+ if (ARow >= 0) and (ARow < Length(FCheckCells)) then
+ Result := FCheckCells[ARow]
+ else
+ Result := inherited GetCells(ARow);
+end;
+
+procedure TStringCheckColumn.SetCells(ARow: Integer; const Value: TValue);
+var
+ S: Boolean;
+ LGrid : TCustomGrid;
+begin
+ if (ARow >= 0) and (ARow < Length(FCheckCells)) then
+ begin
+ S := Value.AsBoolean;
+ if FCheckCells[ARow] <> S then
+ begin
+ FCheckCells[ARow] := S;
+ LGrid := Grid;
+ if Assigned(LGrid) then
+{$IFDEF DELPHI20}
+ UpdateCell(ARow);
+{$ELSE}
+ UpdateColumn;
+{$ENDIF}
+ end;
+ end
+ else
+ inherited SetCells(ARow, Value);
+end;
+{$ENDIF}
+{$ENDIF}
+
+procedure TfrxAliasesEditorForm.BuildAliasList(List: TStrings);
+var
+ i, CheckColumn, AliasColumn, NameColumn: Integer;
+ s: String;
+begin
+ AliasGrid.BeginUpdate;
+ AliasGrid.RowCount := List.Count;
+ CheckColumn := 0;
+ AliasColumn := 1;
+ NameColumn := 2;
+ // in case column was moved
+ for i := 0 to AliasGrid.ColumnCount - 1 do
+ case AliasGrid.Columns[i].Tag of
+ 1: CheckColumn := AliasGrid.Columns[i].Index;
+ 2: AliasColumn := AliasGrid.Columns[i].Index;
+ 3: NameColumn := AliasGrid.Columns[i].Index;
+ end;
+
+ for i := 0 to List.Count - 1 do
+ begin
+ s := List.Names[i];
+{$IFNDEF DELPHI24}
+ THackStringGrid(AliasGrid).SetValue(CheckColumn, i, False);
+{$ELSE}
+ THackStringGrid(AliasGrid).Cells[CheckColumn, i] := BoolToStr(False);
+{$ENDIF}
+ AliasGrid.Cells[AliasColumn, i] := List.Values[s];
+ if s[1] = '-' then { field is disabled }
+ s := Copy(s, 2, 255) else
+{$IFNDEF DELPHI24}
+ THackStringGrid(AliasGrid).SetValue(CheckColumn, i, True);
+{$ELSE}
+ THackStringGrid(AliasGrid).Cells[CheckColumn, i] := BoolToStr(True);
+{$ENDIF}
+ AliasGrid.Cells[NameColumn, i] := s;
+ end;
+ AliasGrid.EndUpdate;
+end;
+
+
+
+procedure TfrxAliasesEditorForm.FormShow(Sender: TObject);
+begin
+ DSAliasE.Text := FDataSet.UserName;
+ BuildAliasList(FDataSet.FieldAliases);
+ if FDataSet.FieldAliases.Count = 0 then
+ ResetBClick(nil);
+end;
+
+procedure TfrxAliasesEditorForm.FormHide(Sender: TObject);
+var
+ i, CheckColumn, AliasColumn, NameColumn: Integer;
+ s: String;
+begin
+ if ModalResult = mrOk then
+ begin
+ CheckColumn := 0;
+ AliasColumn := 1;
+ NameColumn := 2;
+ FDataSet.UserName := DSAliasE.Text;
+ FDataSet.FieldAliases.Clear;
+
+ // in case column was moved
+ for i := 0 to AliasGrid.ColumnCount - 1 do
+ case AliasGrid.Columns[i].Tag of
+ 1: CheckColumn := AliasGrid.Columns[i].Index;
+ 2: AliasColumn := AliasGrid.Columns[i].Index;
+ 3: NameColumn := AliasGrid.Columns[i].Index;
+ end;
+
+ for i := 0 to AliasGrid.RowCount - 1 do
+ begin
+ s := AliasGrid.Cells[NameColumn, i];
+{$IFNDEF DELPHI17}
+ if THackStringGrid(AliasGrid).GetValue(CheckColumn, i) <> True then { disable the field }
+{$ELSE}
+{$IFNDEF DELPHI24}
+ if THackStringGrid(AliasGrid).GetValue(CheckColumn, i).AsBoolean <> True then { disable the field }
+{$ELSE}
+ if StrToBool(AliasGrid.Cells[CheckColumn, i]) <> True then { disable the field }
+{$ENDIF}
+{$ENDIF}
+ s := '-' + s;
+ FDataSet.FieldAliases.Add(s + '=' + AliasGrid.Cells[AliasColumn, i]);
+ end;
+ end;
+end;
+
+procedure TfrxAliasesEditorForm.ResetBClick(Sender: TObject);
+var
+ i: Integer;
+ l1, l2: TStrings;
+begin
+ l1 := TStringList.Create;
+ l2 := TStringList.Create;
+ l1.Assign(FDataSet.FieldAliases);
+ { clear aliases to get real field names }
+ FDataSet.FieldAliases.Clear;
+ FDataSet.GetFieldList(l2);
+ { set aliases back }
+ FDataSet.FieldAliases.Assign(l1);
+ l1.Free;
+
+ for i := 0 to l2.Count - 1 do
+ l2[i] := l2[i] + '=' + l2[i];
+
+ BuildAliasList(l2);
+ l2.Free;
+end;
+
+procedure TfrxAliasesEditorForm.UpdateBClick(Sender: TObject);
+var
+ i: Integer;
+ l1, l2: TStrings;
+begin
+ l1 := TStringList.Create;
+ l2 := TStringList.Create;
+ l1.Assign(FDataSet.FieldAliases);
+ try
+ { clear aliases to get real field names }
+ FDataSet.FieldAliases.Clear;
+ FDataSet.GetFieldList(l2);
+ finally
+ { set aliases back }
+ FDataSet.FieldAliases.Assign(l1);
+ end;
+
+ for i := 0 to l2.Count - 1 do
+ if l1.IndexOfName(l2[i]) = -1 then
+ l2[i] := l2[i] + '=' + l2[i]
+ else
+ l2[i] := l2[i] + '=' + l1.Values[l2[i]];
+
+ BuildAliasList(l2);
+ l1.Free;
+ l2.Free;
+end;
+
+procedure TfrxAliasesEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ FormHide(Self);
+end;
+
+procedure TfrxAliasesEditorForm.FormCreate(Sender: TObject);
+var
+ SColumn: TStringColumn;
+ CBColumn: TStringCheckColumn;
+begin
+ Caption := frxGet(3600);
+ HintL.Text := frxGet(3601);
+ DSAliasL.Text := frxGet(3602);
+ FieldAliasesL.Text := frxGet(3603);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ ResetB.Text := frxGet(3604);
+ UpdateB.Text := frxGet(3605);
+
+{$IFDEF DELPHI17}
+ AliasGrid := TStringGrid.Create(Self);
+{$ELSE}
+ AliasGrid := TfrxStringGrid.Create(Self);
+{$ENDIF}
+ AliasGrid.Parent := Self;
+ with AliasGrid do
+ begin
+ Position.X := 5;
+ Position.Y := 32;
+ Width := 337;
+ Height := 321;
+ StyleLookup := 'gridstyle';
+ TabOrder := 8;
+{$IFDEF DELPHI20}
+ Options := Options + [TGridOption.AlternatingRowBackground];
+{$ELSE}
+ AlternatingRowBackground := True;
+{$ENDIF}
+ RowHeight := 21;
+ RowCount := 0;
+ end;
+
+ AliasGrid.BeginUpdate;
+
+ AliasGrid.RowCount := 0;
+ CBColumn := TStringCheckColumn.Create(AliasGrid);
+ CBColumn.Tag := 1;
+ CBColumn.Header := ' - ';
+ CBColumn.Width := 20;
+ AliasGrid.AddObject(CBColumn);
+
+ SColumn := TStringColumn.Create(AliasGrid);
+ SColumn.Header := frxResources.Get('alUserName');
+ SColumn.Tag := 2;
+ AliasGrid.AddObject(SColumn);
+
+ SColumn := TStringColumn.Create(AliasGrid);
+ SColumn.Header := frxResources.Get('alOriginal');
+ SColumn.ReadOnly := True;
+ SColumn.Tag := 3;
+ AliasGrid.AddObject(SColumn);
+ TCheckColumn(AliasGrid.ColumnByIndex(0)).Header := '-';
+
+ AliasGrid.EndUpdate;
+end;
+
+procedure TfrxAliasesEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VK_F1 then
+ frxResources.Help(Self);
+ if Key = vkF5 then
+ UpdateBClick(nil);
+end;
+
+{$IFNDEF DELPHI17}
+{ TfrxStringGrid }
+
+function TfrxStringGrid.GetValue(Col, Row: Integer): Variant;
+var
+ C: TColumn;
+begin
+ C := Columns[Col];
+ if C is TStringCheckColumn then
+ begin
+ if Length(TStringCheckColumn(C).FCheckCells) <> RowCount then
+ SetLength(TStringCheckColumn(C).FCheckCells, RowCount);
+ Result := TStringCheckColumn(C).FCheckCells[Row]
+ end
+ else
+ Result := inherited GetValue(Col, Row);
+end;
+
+procedure TfrxStringGrid.SetValue(Col, Row: Integer; const Value: Variant);
+var
+ C: TColumn;
+begin
+ C := Columns[Col];
+ if C is TStringCheckColumn then
+ begin
+ if Length(TStringCheckColumn(C).FCheckCells) <> RowCount then
+ SetLength(TStringCheckColumn(C).FCheckCells, RowCount);
+ TStringCheckColumn(C).FCheckCells[Row] := Value;
+ //TStringCheckColumn(C).UpdateColumn;
+ end
+ else
+ inherited;
+end;
+{$ENDIF}
+
+end.
diff --git a/LibD28x64/FMX.frxEditDataBand.fmx b/LibD28x64/FMX.frxEditDataBand.fmx
new file mode 100644
index 0000000..fa03fe4
--- /dev/null
+++ b/LibD28x64/FMX.frxEditDataBand.fmx
@@ -0,0 +1,65 @@
+object frxDataBandEditorForm: TfrxDataBandEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Select DataSet'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 221
+ ClientWidth = 261
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object OkB: TButton
+ Position.Point = '(102,192)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = OkBClick
+ HelpContext = 40
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(182,192)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 50
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object GroupBox1: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 253.000000000000000000
+ Height = 177.000000000000000000
+ TabOrder = 2
+ object RecordsL: TLabel
+ Position.Point = '(16,148)'
+ Width = 151.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object DatasetsLB: TListBox
+ Position.Point = '(8,12)'
+ Width = 237.000000000000000000
+ Height = 121.000000000000000000
+ OnClick = DatasetsLBClick
+ OnDblClick = DatasetsLBDblClick
+ HelpContext = 88
+ TabOrder = 1
+ ItemHeight = 18.000000000000000000
+ end
+ object RecordsS: TSpinBox
+ Position.Point = '(179,144)'
+ Width = 65.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 2
+ KeyboardType = vktDefault
+ Max = 10000.000000000000000000
+ Increment = 1.000000000000000000
+ end
+ end
+end
diff --git a/LibD28x64/FMX.frxEditDataBand.pas b/LibD28x64/FMX.frxEditDataBand.pas
new file mode 100644
index 0000000..3c00b7a
--- /dev/null
+++ b/LibD28x64/FMX.frxEditDataBand.pas
@@ -0,0 +1,171 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Data Band editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditDataBand;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Objects, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.ExtCtrls, FMX.frxClass, FMX.Edit, FMX.Layouts, FMX.ListBox,
+ FMX.Types, System.Variants
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI21}
+ ,FMX.SpinBox
+{$ENDIF};
+
+
+type
+{$IFDEF LINUX}
+ TfrxDataBandEditorForm = class(TfrxForm)
+{$ELSE}
+ TfrxDataBandEditorForm = class(TForm)
+{$ENDIF}
+ OkB: TButton;
+ CancelB: TButton;
+ GroupBox1: TGroupBox;
+ DatasetsLB: TListBox;
+ RecordsL: TLabel;
+ RecordsS: TSpinBox;
+// procedure DatasetsLBDrawItem(Control: TWinControl; Index: Integer;
+// ARect: TRect; State: TOwnerDrawState);
+ procedure DatasetsLBDblClick(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure DatasetsLBClick(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure OkBClick(Sender: TObject);
+ private
+ { Private declarations }
+ FDataBand: TfrxDataBand;
+ FDesigner: TfrxCustomDesigner;
+ public
+ { Public declarations }
+ property DataBand: TfrxDataBand read FDataBand write FDataBand;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxUtils, FMX.frxRes;
+
+
+procedure TfrxDataBandEditorForm.FormShow(Sender: TObject);
+var
+ i: Integer;
+ dsList: TStringList;
+begin
+ FDesigner := TfrxCustomDesigner(Owner);
+
+ dsList := TStringList.Create;
+ FDesigner.Report.GetDatasetList(dsList);
+ dsList.Sort;
+ //DatasetsLB.Items := dsList;
+ DatasetsLB.Items.Add(frxResources.Get('dbNotAssigned'));
+ for i := 0 to dsList.Count - 1 do
+ DatasetsLB.Items.AddObject(dsList[i], dsList.Objects[i]);
+ //Add(dsList[i]);
+
+ dsList.Free;
+
+ i := DatasetsLB.Items.IndexOfObject(FDataBand.DataSet);
+ if i = -1 then
+ i := 0;
+ DatasetsLB.ItemIndex := i;
+
+ RecordsS.Text := IntToStr(FDataBand.RowCount);
+end;
+
+procedure TfrxDataBandEditorForm.OkBClick(Sender: TObject);
+begin
+
+end;
+
+//procedure TfrxDataBandEditorForm.DatasetsLBDrawItem(Control: TWinControl;
+// Index: Integer; ARect: TRect; State: TOwnerDrawState);
+//var
+// r: TRect;
+//begin
+// r := ARect;
+// r.Right := r.Left + 18;
+// r.Bottom := r.Top + 16;
+// OffsetRect(r, 2, 0);
+// with TListBox(Control) do
+// begin
+// Canvas.FillRect(ARect);
+// if Index > 0 then
+// frxResources.MainButtonImages.Draw(Canvas, ARect.Left + 2, ARect.Top + 1, 53);
+// Canvas.TextOut(ARect.Left + 22, ARect.Top + 2, Items[Index]);
+// end;
+//end;
+
+procedure TfrxDataBandEditorForm.DatasetsLBDblClick(Sender: TObject);
+begin
+ ModalResult := mrOk;
+end;
+
+procedure TfrxDataBandEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ if ModalResult = mrOk then
+ if DatasetsLB.ItemIndex = 0 then
+ begin
+ FDataBand.DataSet := nil;
+ FDataBand.RowCount := StrToInt(RecordsS.Text);
+ end
+ else
+ begin
+ FDataBand.DataSet := TfrxDataSet(DatasetsLB.Items.Objects[DatasetsLB.ItemIndex]);
+ FDataBand.RowCount := StrToInt(RecordsS.Text);
+ end;
+end;
+
+procedure TfrxDataBandEditorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(3100);
+ RecordsL.Text := frxGet(3101);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxDataBandEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+procedure TfrxDataBandEditorForm.DatasetsLBClick(Sender: TObject);
+begin
+ if DatasetsLB.ItemIndex <> 0 then
+ RecordsS.Text := '0';
+end;
+
+end.
+
diff --git a/LibD28x64/FMX.frxEditExpr.fmx b/LibD28x64/FMX.frxEditExpr.fmx
new file mode 100644
index 0000000..7fc6b1d
--- /dev/null
+++ b/LibD28x64/FMX.frxEditExpr.fmx
@@ -0,0 +1,75 @@
+object frxExprEditorForm: TfrxExprEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Expression Editor'
+ BorderIcons = [biSystemMenu, biMinimize, biMaximize, biHelp]
+ ClientHeight = 546
+ ClientWidth = 640
+ Visible = False
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ OnResize = FormResize
+ ActiveControl = ExprMemo
+ StyleLookup = 'backgroundstyle'
+ object Splitter1: TSplitter
+ Align = alBottom
+ Cursor = crVSplit
+ Position.Point = '(0,450)'
+ Width = 640.000000000000000000
+ Height = 3.000000000000000000
+ TabOrder = 0
+ MinSize = 20.000000000000000000
+ end
+ object ExprMemo: TMemo
+ Align = alBottom
+ Position.Point = '(0,453)'
+ Width = 640.000000000000000000
+ Height = 56.000000000000000000
+ OnDragOver = ExprMemoDragOver
+ OnDragDrop = ExprMemoDragDrop
+ TabOrder = 1
+ KeyboardType = vktDefault
+ end
+ object Panel1: TPanel
+ Align = alBottom
+ Position.Point = '(0,509)'
+ Width = 640.000000000000000000
+ Height = 37.000000000000000000
+ TabOrder = 2
+ StyleLookup = 'backgroundstyle'
+ object OkB: TButton
+ Position.Point = '(4,8)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 0
+ ModalResult = 1
+ end
+ object CancelB: TButton
+ Position.Point = '(84,8)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ end
+ object Panel2: TPanel
+ Align = alBottom
+ Position.Point = '(0,431)'
+ Width = 640.000000000000000000
+ Height = 19.000000000000000000
+ TabOrder = 3
+ object ExprL: TLabel
+ Position.Point = '(4,2)'
+ Width = 141.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ end
+ object Panel: TPanel
+ Align = alClient
+ Width = 640.000000000000000000
+ Height = 431.000000000000000000
+ TabOrder = 4
+ end
+end
diff --git a/LibD28x64/FMX.frxEditExpr.pas b/LibD28x64/FMX.frxEditExpr.pas
new file mode 100644
index 0000000..b4eb056
--- /dev/null
+++ b/LibD28x64/FMX.frxEditExpr.pas
@@ -0,0 +1,147 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Expression Editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditExpr;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.Types, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.ExtCtrls, FMX.frxDataTree,
+ FMX.Types, FMX.Layouts, FMX.Memo, System.Variants
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI22}
+ ,FMX.Memo.Types
+{$ENDIF};
+
+
+type
+ TfrxExprEditorForm = class(TForm)
+ ExprMemo: TMemo;
+ Panel1: TPanel;
+ OkB: TButton;
+ CancelB: TButton;
+ Splitter1: TSplitter;
+ Panel2: TPanel;
+ ExprL: TLabel;
+ Panel: TPanel;
+ procedure FormCreate(Sender: TObject);
+ procedure ExprMemoDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; var Accept: Boolean);
+ procedure ExprMemoDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+ procedure FormShow(Sender: TObject);
+ procedure FormHide(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormResize(Sender: TObject);
+ private
+ FDataTree: TfrxDataTreeForm;
+ FReport: TfrxReport;
+ procedure OnDataTreeDblClick(Sender: TObject);
+ public
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses
+ System.IniFiles, FMX.frxRes, FMX.TreeView, FMX.frxUtils;
+
+
+
+{ TfrxExprEditorForm }
+
+procedure TfrxExprEditorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(4400);
+ ExprL.Text := frxGet(4401);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+
+
+ FReport := TfrxCustomDesigner(Owner).Report;
+ FDataTree := TfrxDataTreeForm.Create(Self);
+ FDataTree.Report := FReport;
+ FDataTree.MainDataPanel.Parent := Panel;
+ FDataTree.MainDataPanel.OnDblClick := OnDataTreeDblClick;
+ //FDataTree.SetControlsParent(Panel);
+ FDataTree.HintPanel.Height := 60;
+ FDataTree.UpdateItems;
+end;
+
+procedure TfrxExprEditorForm.FormShow(Sender: TObject);
+var
+ Ini: TCustomIniFile;
+begin
+ Ini := FReport.GetIniFile;
+ Ini.WriteBool('TfrxExprEditorForm', 'Visible', True);
+ frxRestoreFormPosition(Ini, Self);
+ Ini.Free;
+// FDataTree.SetLastPosition(lastPosition);
+end;
+
+procedure TfrxExprEditorForm.FormHide(Sender: TObject);
+var
+ Ini: TCustomIniFile;
+begin
+ Ini := FReport.GetIniFile;
+ frxSaveFormPosition(Ini, Self);
+ Ini.Free;
+// lastPosition := FDataTree.GetLastPosition;
+end;
+
+procedure TfrxExprEditorForm.OnDataTreeDblClick(Sender: TObject);
+var
+ SelStart: TCaretPosition;
+ SelLen: Integer;
+begin
+ SelLen := ExprMemo.SelLength;
+ SelStart := ExprMemo.TextPosToPos(ExprMemo.SelStart);
+ ExprMemo.DeleteFrom(SelStart, SelLen, []);
+ ExprMemo.InsertAfter(SelStart, FDataTree.GetFieldName, []);
+ ExprMemo.SetFocus;
+end;
+
+procedure TfrxExprEditorForm.ExprMemoDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; var Accept: Boolean);
+begin
+ Accept := (Data.Source is TTreeView) and (TControl(Data.Source).Owner = FDataTree) and
+ (FDataTree.GetFieldName <> '');
+end;
+
+procedure TfrxExprEditorForm.ExprMemoDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+var
+ SelStart: TCaretPosition;
+ SelLen: Integer;
+begin
+ SelLen := ExprMemo.SelLength;
+ SelStart := ExprMemo.TextPosToPos(ExprMemo.SelStart);
+ ExprMemo.DeleteFrom(SelStart, SelLen, []);
+ ExprMemo.InsertAfter(SelStart, FDataTree.GetFieldName, []);
+ ExprMemo.SetFocus;
+end;
+
+procedure TfrxExprEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = vkF1 then
+ frxResources.Help(Self);
+end;
+
+procedure TfrxExprEditorForm.FormResize(Sender: TObject);
+begin
+ FDataTree.UpdateSize;
+end;
+
+end.
diff --git a/LibD28x64/FMX.frxEditFormat.fmx b/LibD28x64/FMX.frxEditFormat.fmx
new file mode 100644
index 0000000..7698bb6
--- /dev/null
+++ b/LibD28x64/FMX.frxEditFormat.fmx
@@ -0,0 +1,93 @@
+object frxFormatEditorForm: TfrxFormatEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Display Format'
+ ClientHeight = 264
+ ClientWidth = 316
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object OkB: TButton
+ Position.Point = '(156,232)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(236,232)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object CategoryL: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 151.000000000000000000
+ Height = 137.000000000000000000
+ TabOrder = 2
+ object CategoryLB: TListBox
+ Position.Point = '(8,20)'
+ Width = 133.000000000000000000
+ Height = 105.000000000000000000
+ OnClick = CategoryLBClick
+ TabOrder = 0
+ ItemHeight = 13.000000000000000000
+ end
+ end
+ object FormatL: TGroupBox
+ Position.Point = '(160,4)'
+ Width = 151.000000000000000000
+ Height = 137.000000000000000000
+ TabOrder = 3
+ object FormatLB: TListBox
+ Position.Point = '(8,20)'
+ Width = 133.000000000000000000
+ Height = 105.000000000000000000
+ OnClick = FormatLBClick
+ TabOrder = 0
+ ItemHeight = 13.000000000000000000
+ end
+ end
+ object GroupBox1: TGroupBox
+ Position.Point = '(4,146)'
+ Width = 307.000000000000000000
+ Height = 73.000000000000000000
+ TabOrder = 4
+ object FormatStrL: TLabel
+ Position.Point = '(8,16)'
+ Width = 129.000000000000000000
+ Height = 13.000000000000000000
+ OnClick = FormatStrLClick
+ TabOrder = 0
+ end
+ object SeparatorL: TLabel
+ Position.Point = '(8,44)'
+ Width = 129.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object FormatE: TEdit
+ Position.Point = '(152,12)'
+ Width = 133.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 2
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object SeparatorE: TEdit
+ Position.Point = '(152,40)'
+ Width = 25.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 3
+ KeyboardType = vktDefault
+ Password = False
+ Text = ','
+ end
+ end
+end
diff --git a/LibD28x64/FMX.frxEditFormat.pas b/LibD28x64/FMX.frxEditFormat.pas
new file mode 100644
index 0000000..f780440
--- /dev/null
+++ b/LibD28x64/FMX.frxEditFormat.pas
@@ -0,0 +1,223 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ DisplayFormat editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditFormat;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, System.Types, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.ExtCtrls, FMX.ListBox, FMX.Edit, FMX.frxClass, System.Variants, FMX.Layouts
+ {$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+
+type
+ TfrxFormatEditorForm = class(TForm)
+ OkB: TButton;
+ CancelB: TButton;
+ CategoryL: TGroupBox;
+ CategoryLB: TListBox;
+ FormatL: TGroupBox;
+ FormatLB: TListBox;
+ GroupBox1: TGroupBox;
+ FormatStrL: TLabel;
+ SeparatorL: TLabel;
+ FormatE: TEdit;
+ SeparatorE: TEdit;
+ procedure FormCreate(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure CategoryLBClick(Sender: TObject);
+ //procedure FormatLBDrawItem(Control: TWinControl; Index: Integer;
+ // ARect: TRect; State: TOwnerDrawState);
+ procedure FormatLBClick(Sender: TObject);
+ procedure FormHide(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormatStrLClick(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ { Private declarations }
+ FFormat: TfrxFormat;
+ public
+ { Public declarations }
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ procedure HostControls(Host: TFmxObject);
+ procedure UnhostControls;
+ property Format: TfrxFormat read FFormat write FFormat;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxRes;
+
+const
+ CategoryNames: array[0..3] of String =
+ ('fkText', 'fkNumber', 'fkDateTime', 'fkBoolean');
+
+
+constructor TfrxFormatEditorForm.Create(AOwner: TComponent);
+begin
+ inherited;
+ FFormat := TfrxFormat.Create;
+end;
+
+destructor TfrxFormatEditorForm.Destroy;
+begin
+ FFormat.Free;
+ inherited;
+end;
+
+procedure TfrxFormatEditorForm.FormShow(Sender: TObject);
+
+ procedure FillCategory;
+ var
+ i: Integer;
+ begin
+ for i := 0 to 3 do
+ CategoryLB.Items.Add(frxResources.Get(CategoryNames[i]));
+ end;
+
+ procedure FindFormat;
+ var
+ i: Integer;
+ s: String;
+ begin
+ for i := 0 to FormatLB.Items.Count - 1 do
+ begin
+ s := FormatLB.Items[i];
+ if Copy(s, Pos(';', s) + 1, 255) = FFormat.FormatStr then
+ FormatLB.ItemIndex := i;
+ end;
+ end;
+
+begin
+ FillCategory;
+ CategoryLB.ItemIndex := Integer(FFormat.Kind);
+ CategoryLBClick(Self);
+ FindFormat;
+ FormatE.Text := FFormat.FormatStr;
+ SeparatorE.Text := FFormat.DecimalSeparator;
+end;
+
+procedure TfrxFormatEditorForm.FormHide(Sender: TObject);
+var
+ s: String;
+begin
+ FFormat.Kind := TfrxFormatKind(CategoryLB.ItemIndex);
+ FFormat.FormatStr := FormatE.Text;
+ s := SeparatorE.Text;
+ if s = '' then
+ FFormat.DecimalSeparator := ''
+ else
+ FFormat.DecimalSeparator := s[1];
+end;
+
+procedure TfrxFormatEditorForm.CategoryLBClick(Sender: TObject);
+var
+ i, n: Integer;
+ s: String;
+begin
+{$IFDEF DELPHI23}
+ FormatLB.Clear;
+{$ELSE}
+ FormatLB.Items.Clear;
+{$ENDIF}
+ n := CategoryLB.ItemIndex;
+ SeparatorE.Enabled := n = 1;
+ SeparatorL.Enabled := n = 1;
+
+ if (n = 0) or (n = 4) or (n = -1) then
+ Exit;
+
+ for i := 1 to 10 do
+ begin
+ s := frxResources.Get(CategoryNames[n] + IntToStr(i));
+ if Pos('fk', s) = 0 then
+ FormatLB.Items.Add(s);
+ end;
+end;
+
+procedure TfrxFormatEditorForm.FormatLBClick(Sender: TObject);
+var
+ s: String;
+begin
+ s := FormatLB.Items[FormatLB.ItemIndex];
+ FormatE.Text := Copy(s, Pos(';', s) + 1, 255);
+end;
+
+procedure TfrxFormatEditorForm.FormatStrLClick(Sender: TObject);
+begin
+
+end;
+
+//procedure TfrxFormatEditorForm.FormatLBDrawItem(Control: TWinControl;
+// Index: Integer; ARect: TRect; State: TOwnerDrawState);
+//var
+// s: String;
+//begin
+// with FormatLB do
+// begin
+// Canvas.FillRect(ARect);
+// s := Items[Index];
+// if Pos(';', s) <> 0 then
+// s := Copy(s, 1, Pos(';', s) - 1);
+// Canvas.TextOut(ARect.Left + 2, ARect.Top, s);
+// end;
+//end;
+
+procedure TfrxFormatEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ FormHide(Self);
+end;
+
+procedure TfrxFormatEditorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(4500);
+ CategoryL.Text := frxGet(4501);
+ FormatL.Text := frxGet(4502);
+ FormatStrL.Text := frxGet(4503);
+ SeparatorL.Text := frxGet(4504);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+end;
+
+procedure TfrxFormatEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+procedure TfrxFormatEditorForm.HostControls(Host: TFmxObject);
+begin
+ CategoryL.Parent := Host;
+ FormatL.Parent := Host;
+ GroupBox1.Parent := Host;
+ FormShow(Self);
+end;
+
+procedure TfrxFormatEditorForm.UnhostControls;
+begin
+ FormHide(Self);
+end;
+
+end.
diff --git a/LibD28x64/FMX.frxEditFrame.fmx b/LibD28x64/FMX.frxEditFrame.fmx
new file mode 100644
index 0000000..57ee349
--- /dev/null
+++ b/LibD28x64/FMX.frxEditFrame.fmx
@@ -0,0 +1,232 @@
+object frxFrameEditorForm: TfrxFrameEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Edit Frame'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 159
+ ClientWidth = 223
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object FrameL: TLabel
+ Position.Point = '(8,12)'
+ Width = 54.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object LineL: TLabel
+ Position.Point = '(8,64)'
+ Width = 57.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object ShadowL: TLabel
+ Position.Point = '(8,92)'
+ Width = 57.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 2
+ end
+ object FLineL: TLabel
+ Position.Point = '(8,37)'
+ Width = 57.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 3
+ end
+ object OkB: TButton
+ Position.Point = '(60,124)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 4
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(140,124)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 5
+ ModalResult = 2
+ Cancel = True
+ end
+ object ToolBar1: TToolBar
+ Align = alNone
+ Position.Point = '(72,8)'
+ Width = 149.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 6
+ object FrameTopB: TfrxToolButton
+ Tag = 1
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BClick
+ TabOrder = 0
+ end
+ object FrameBottomB: TfrxToolButton
+ Tag = 2
+ Position.Point = '(22,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BClick
+ TabOrder = 1
+ end
+ object FrameLeftB: TfrxToolButton
+ Tag = 3
+ Position.Point = '(44,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BClick
+ TabOrder = 2
+ end
+ object FrameRightB: TfrxToolButton
+ Tag = 4
+ Position.Point = '(66,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BClick
+ TabOrder = 3
+ end
+ object FrameAllB: TfrxToolButton
+ Tag = 5
+ Position.Point = '(96,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BClick
+ TabOrder = 4
+ end
+ object FrameNoB: TfrxToolButton
+ Tag = 6
+ Position.Point = '(118,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BClick
+ TabOrder = 5
+ end
+ end
+ object ToolBar2: TToolBar
+ Align = alNone
+ Position.Point = '(72,60)'
+ Width = 93.000000000000000000
+ Height = 23.000000000000000000
+ TabOrder = 7
+ object FrameColorB: TfrxToolButton
+ Tag = 7
+ Position.Point = '(50,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BClick
+ TabOrder = 0
+ end
+ object FrameStyleB: TfrxToolButton
+ Tag = 8
+ Position.Point = '(70,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BClick
+ TabOrder = 1
+ end
+ object Sep2: TPanel
+ Align = alLeft
+ Width = 47.000000000000000000
+ Height = 23.000000000000000000
+ TabOrder = 2
+ object FrameWidthCB: TComboEdit
+ Tag = 9
+ Cursor = crIBeam
+ Position.Point = '(5,2)'
+ Width = 40.000000000000000000
+ Height = 19.000000000000000000
+ OnClick = BClick
+ TabOrder = 0
+ KeyboardType = vktDefault
+ ItemHeight = 13.000000000000000000
+ ItemIndex = 0
+ Items.Strings = (
+ '0,1'
+ '0,5'
+ '1'
+ '1,5'
+ '2'
+ '3'
+ '4'
+ '5'
+ '6'
+ '7'
+ '8'
+ '9'
+ '10')
+ ListBoxResource = 'combolistboxstyle'
+ Text = '0,1'
+ end
+ end
+ end
+ object ToolBar3: TToolBar
+ Align = alNone
+ Position.Point = '(72,88)'
+ Width = 93.000000000000000000
+ Height = 23.000000000000000000
+ TabOrder = 8
+ object ShadowB: TfrxToolButton
+ Tag = 10
+ Position.Point = '(50,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BClick
+ TabOrder = 0
+ end
+ object ShadowColorB: TfrxToolButton
+ Tag = 11
+ Position.Point = '(70,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BClick
+ TabOrder = 1
+ end
+ object Sep3: TPanel
+ Align = alLeft
+ Width = 47.000000000000000000
+ Height = 23.000000000000000000
+ TabOrder = 2
+ object ShadowWidthCB: TComboEdit
+ Tag = 12
+ Cursor = crIBeam
+ Position.Point = '(5,2)'
+ Width = 40.000000000000000000
+ Height = 19.000000000000000000
+ OnClick = BClick
+ TabOrder = 0
+ KeyboardType = vktDefault
+ ItemHeight = 13.000000000000000000
+ ItemIndex = 0
+ Items.Strings = (
+ '1'
+ '2'
+ '3'
+ '4'
+ '5'
+ '6'
+ '7'
+ '8'
+ '9'
+ '10')
+ ListBoxResource = 'combolistboxstyle'
+ Text = '1'
+ end
+ end
+ end
+ object FrameLineCB: TComboEdit
+ Cursor = crIBeam
+ Position.Point = '(72,34)'
+ Width = 91.000000000000000000
+ Height = 19.000000000000000000
+ OnClick = BClick
+ TabOrder = 9
+ KeyboardType = vktDefault
+ ItemHeight = 13.000000000000000000
+ ItemIndex = -1
+ ListBoxResource = 'combolistboxstyle'
+ end
+end
diff --git a/LibD28x64/FMX.frxEditFrame.pas b/LibD28x64/FMX.frxEditFrame.pas
new file mode 100644
index 0000000..1a609c1
--- /dev/null
+++ b/LibD28x64/FMX.frxEditFrame.pas
@@ -0,0 +1,224 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Frame editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditFrame;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.ExtCtrls, FMX.frxCtrls, FMX.frxClass, FMX.frxFMX, FMX.ListBox, FMX.Edit
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+ {$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI21}
+ , FMX.ComboEdit, FMX.Controls.Presentation
+{$ENDIF};
+
+type
+{$IFDEF LINUX}
+ TfrxFrameEditorForm = class(TfrxForm)
+{$ELSE}
+ TfrxFrameEditorForm = class(TForm)
+{$ENDIF}
+ FrameL: TLabel;
+ LineL: TLabel;
+ ShadowL: TLabel;
+ OkB: TButton;
+ CancelB: TButton;
+ ToolBar1: TToolBar;
+ FrameTopB: TfrxToolButton;
+ FrameBottomB: TfrxToolButton;
+ FrameLeftB: TfrxToolButton;
+ FrameRightB: TfrxToolButton;
+ FrameAllB: TfrxToolButton;
+ FrameNoB: TfrxToolButton;
+ ToolBar2: TToolBar;
+ FrameColorB: TfrxToolButton;
+ FrameStyleB: TfrxToolButton;
+ Sep2: TPanel;
+ FrameWidthCB: TComboEdit;
+ ToolBar3: TToolBar;
+ ShadowB: TfrxToolButton;
+ ShadowColorB: TfrxToolButton;
+ Sep3: TPanel;
+ ShadowWidthCB: TComboEdit;
+ FrameLineCB: TComboEdit;
+ FLineL: TLabel;
+ procedure FormCreate(Sender: TObject);
+ procedure BClick(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ private
+ FFrame: TfrxFrame;
+ procedure UpdateControls;
+ function GetFrameLine: TfrxFrameLine;
+ public
+ property Frame: TfrxFrame read FFrame;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxDesgnCtrls, FMX.frxUtils, FMX.frxRes;
+
+
+procedure TfrxFrameEditorForm.FormCreate(Sender: TObject);
+begin
+ FFrame := TfrxFrame.Create;
+ Caption := frxGet(5200);
+ FrameL.Text := frxGet(5201);
+ LineL.Text := frxGet(2321);
+ ShadowL.Text := frxGet(5203);
+ FrameTopB.Hint := frxGet(5204);
+ FrameBottomB.Hint := frxGet(5205);
+ FrameLeftB.Hint := frxGet(5206);
+ FrameRightB.Hint := frxGet(5207);
+ FrameAllB.Hint := frxGet(5208);
+ FrameNoB.Hint := frxGet(5209);
+ FrameColorB.Hint := frxGet(5210);
+ FrameStyleB.Hint := frxGet(5211);
+ //FrameWidthCB.Hint := frxGet(5212);
+ ShadowB.Hint := frxGet(5213);
+ ShadowColorB.Hint := frxGet(5214);
+ //ShadowWidthCB.Hint := frxGet(5215);
+ FrameLineCB.Items.Add(frxGet(5208));
+ FrameLineCB.Items.Add(frxGet(5206));
+ FrameLineCB.Items.Add(frxGet(5207));
+ FrameLineCB.Items.Add(frxGet(5204));
+ FrameLineCB.Items.Add(frxGet(5205));
+ FLineL.Text := frxGet(5202);
+ FrameLineCB.ItemIndex := 1;
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ //FImageList := frxResources.MainButtonImages;
+ frxResources.LoadImageFromResouce(FrameTopB.Bitmap, 3, 2);
+ frxResources.LoadImageFromResouce(FrameBottomB.Bitmap, 3, 3);
+ frxResources.LoadImageFromResouce(FrameRightB.Bitmap, 3, 5);
+ frxResources.LoadImageFromResouce(FrameLeftB.Bitmap, 3, 4);
+ frxResources.LoadImageFromResouce(FrameNoB.Bitmap, 3, 7);
+ frxResources.LoadImageFromResouce(FrameAllB.Bitmap, 3, 6);
+ frxResources.LoadImageFromResouce(ShadowB.Bitmap, 7, 1);
+ frxResources.LoadImageFromResouce(FrameColorB.Bitmap, 3, 9);
+ frxResources.LoadImageFromResouce(FrameStyleB.Bitmap, 4, 0);
+ FormShow(Self);
+ //ToolBar1.Images := FImageList;
+ //ToolBar2.Images := FImageList;
+ //ToolBar3.Images := FImageList;
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+function TfrxFrameEditorForm.GetFrameLine: TfrxFrameLine;
+begin
+ case FrameLineCB.ItemIndex of
+ 2: Result := FFrame.RightLine;
+ 3: Result := FFrame.TopLine;
+ 4: Result := FFrame.BottomLine;
+ else Result := FFrame.LeftLine;
+ end;
+end;
+
+procedure TfrxFrameEditorForm.FormDestroy(Sender: TObject);
+begin
+ FFrame.Free;
+end;
+
+procedure TfrxFrameEditorForm.FormShow(Sender: TObject);
+begin
+ UpdateControls;
+end;
+
+procedure TfrxFrameEditorForm.UpdateControls;
+begin
+ FrameTopB.Down := ftTop in FFrame.Typ;
+ FrameBottomB.Down := ftBottom in FFrame.Typ;
+ FrameLeftB.Down := ftLeft in FFrame.Typ;
+ FrameRightB.Down := ftRight in FFrame.Typ;
+ ShadowB.Down := FFrame.DropShadow;
+ FrameWidthCB.Text := FloatToStr(GetFrameLine.Width);
+ ShadowWidthCB.Text := FloatToStr(FFrame.ShadowWidth);
+ if FrameLineCB.ItemIndex = 0 then
+ with FFrame do
+ begin
+ Style := GetFrameLine.Style;
+ Color := GetFrameLine.Color;
+ Width := GetFrameLine.Width;
+ end;
+
+end;
+
+procedure TfrxFrameEditorForm.BClick(Sender: TObject);
+
+ procedure SetFrameType(fType: TfrxFrameType; Include: Boolean);
+ begin
+ with FFrame do
+ if Include then
+ Typ := Typ + [fType] else
+ Typ := Typ - [fType];
+ end;
+
+begin
+ case TControl(Sender).Tag of
+ 1: SetFrameType(ftTop, FrameTopB.Down);
+ 2: SetFrameType(ftBottom, FrameBottomB.Down);
+ 3: SetFrameType(ftLeft, FrameLeftB.Down);
+ 4: SetFrameType(ftRight, FrameRightB.Down);
+ 5: FFrame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
+ 6: FFrame.Typ := [];
+ 7:
+ with TfrxColorSelector.Create(TComponent(Sender)) do
+ begin
+ OnColorChanged := BClick;
+ Tag := 70;
+ end;
+ 70: GetFrameLine.Color := TfrxColorSelector(Sender).Color;
+ 8:
+ with TfrxLineSelector.Create(TComponent(Sender)) do
+ begin
+ OnStyleChanged := BClick;
+ Tag := 80;
+ end;
+ 80: GetFrameLine.Style := TfrxFrameStyle(TfrxLineSelector(Sender).Style);
+ 9: GetFrameLine.Width := frxStrToFloat(FrameWidthCB.Text);
+ 10: FFrame.DropShadow := ShadowB.Down;
+ 11:
+ with TfrxColorSelector.Create(TComponent(Sender)) do
+ begin
+ OnColorChanged := BClick;
+ Tag := 110;
+ end;
+ 110: FFrame.ShadowColor := TfrxColorSelector(Sender).Color;
+ 12: FFrame.ShadowWidth := frxStrToFloat(ShadowWidthCB.Text);
+ end;
+
+ UpdateControls;
+end;
+
+procedure TfrxFrameEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VK_F1 then
+ frxResources.Help(Self);
+end;
+
+end.
diff --git a/LibD28x64/FMX.frxEditGroup.fmx b/LibD28x64/FMX.frxEditGroup.fmx
new file mode 100644
index 0000000..6424323
--- /dev/null
+++ b/LibD28x64/FMX.frxEditGroup.fmx
@@ -0,0 +1,113 @@
+object frxGroupEditorForm: TfrxGroupEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Group'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 307
+ ClientWidth = 365
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object OKB: TButton
+ Position.Point = '(205,276)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 40
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(285,276)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 50
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object BreakOnL: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 357.000000000000000000
+ Height = 125.000000000000000000
+ TabOrder = 2
+ object DataFieldCB: TComboBox
+ Position.Point = '(188,40)'
+ Width = 161.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 0
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ end
+ object DataSetCB: TComboBox
+ Position.Point = '(8,40)'
+ Width = 173.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 1
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ OnChange = DataSetCBChange
+ end
+ object ExpressionE: TfrxEditWithButton
+ Position.Point = '(8,92)'
+ Width = 341.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 2
+ OnButtonClick = ExpressionEButtonClick
+ end
+ object DataFieldRB: TRadioButton
+ Position.Point = '(8,20)'
+ Width = 173.000000000000000000
+ Height = 17.000000000000000000
+ OnChange = DataFieldRBClick
+ TabOrder = 3
+ end
+ object ExpressionRB: TRadioButton
+ Position.Point = '(8,72)'
+ Width = 173.000000000000000000
+ Height = 17.000000000000000000
+ OnChange = DataFieldRBClick
+ TabOrder = 4
+ end
+ end
+ object OptionsL: TGroupBox
+ Position.Point = '(4,136)'
+ Width = 357.000000000000000000
+ Height = 129.000000000000000000
+ TabOrder = 3
+ object KeepGroupTogetherCB: TCheckBox
+ Position.Point = '(8,20)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 0
+ end
+ object StartNewPageCB: TCheckBox
+ Position.Point = '(8,40)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ object OutlineCB: TCheckBox
+ Position.Point = '(8,60)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object DrillCB: TCheckBox
+ Position.Point = '(8,80)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ object ResetCB: TCheckBox
+ Position.Point = '(8,100)'
+ Width = 237.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 4
+ end
+ end
+end
diff --git a/LibD28x64/FMX.frxEditGroup.pas b/LibD28x64/FMX.frxEditGroup.pas
new file mode 100644
index 0000000..358a025
--- /dev/null
+++ b/LibD28x64/FMX.frxEditGroup.pas
@@ -0,0 +1,199 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Group editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditGroup;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.ExtCtrls, FMX.frxClass, FMX.frxCtrls, FMX.ListBox, FMX.Types, FMX.Edit, System.Variants
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+
+type
+{$IFDEF LINUX}
+ TfrxGroupEditorForm = class(TfrxForm)
+{$ELSE}
+ TfrxGroupEditorForm = class(TForm)
+{$ENDIF}
+ OKB: TButton;
+ CancelB: TButton;
+ BreakOnL: TGroupBox;
+ DataFieldCB: TComboBox;
+ DataSetCB: TComboBox;
+ ExpressionE: TfrxEditWithButton;
+ DataFieldRB: TRadioButton;
+ ExpressionRB: TRadioButton;
+ OptionsL: TGroupBox;
+ KeepGroupTogetherCB: TCheckBox;
+ StartNewPageCB: TCheckBox;
+ OutlineCB: TCheckBox;
+ DrillCB: TCheckBox;
+ ResetCB: TCheckBox;
+ procedure ExpressionEButtonClick(Sender: TObject);
+ procedure DataFieldRBClick(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure DataSetCBChange(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ FGroupHeader: TfrxGroupHeader;
+ FReport: TfrxReport;
+ procedure FillDataFieldCB;
+ procedure FillDataSetCB;
+ public
+ property GroupHeader: TfrxGroupHeader read FGroupHeader write FGroupHeader;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxUtils, FMX.frxRes;
+
+
+procedure TfrxGroupEditorForm.FormShow(Sender: TObject);
+var
+ ds: TfrxDataSet;
+ fld: String;
+begin
+ FReport := FGroupHeader.Report;
+ FillDataSetCB;
+
+ DataFieldRB.IsChecked := True;
+ FReport.GetDataSetAndField(FGroupHeader.Condition, ds, fld);
+ if FGroupHeader.Condition = '' then
+ begin
+ DataSetCB.ItemIndex := 0;
+ FillDataFieldCB;
+ DataFieldCB.SetFocus;
+ end
+ else if (ds <> nil) and (fld <> '') then
+ begin
+ DataSetCB.ItemIndex := DataSetCB.Items.IndexOf(FReport.GetAlias(ds));
+ FillDataFieldCB;
+ DataFieldCB.ItemIndex := DataFieldCB.Items.IndexOf(fld);
+ DataFieldCB.SetFocus;
+ end
+ else
+ begin
+ ExpressionE.Text := FGroupHeader.Condition;
+ ExpressionRB.IsChecked := True;
+ ExpressionE.SetFocus;
+ end;
+
+ KeepGroupTogetherCB.IsChecked := FGroupHeader.KeepTogether;
+ StartNewPageCB.IsChecked := FGroupHeader.StartNewPage;
+ OutlineCB.IsChecked := Trim(FGroupHeader.OutlineText) <> '';
+ DrillCB.IsChecked := FGroupHeader.DrillDown;
+ ResetCB.IsChecked := FGroupHeader.ResetPageNumbers;
+end;
+
+procedure TfrxGroupEditorForm.FillDataSetCB;
+begin
+ FReport.GetDataSetList(DataSetCB.Items);
+end;
+
+procedure TfrxGroupEditorForm.FillDataFieldCB;
+var
+ ds: TfrxDataSet;
+begin
+ ds := nil;
+ if DataSetCB.Selected <> nil then
+ ds := FReport.GetDataSet(DataSetCB.Selected.Text);
+ if ds <> nil then
+ ds.GetFieldList(DataFieldCB.Items) else
+{$IFDEF DELPHI23}
+ DataFieldCB.Clear;
+{$ELSE}
+ DataFieldCB.Items.Clear;
+{$ENDIF}
+end;
+
+procedure TfrxGroupEditorForm.ExpressionEButtonClick(Sender: TObject);
+var
+ s: String;
+begin
+ s := TfrxCustomDesigner(Owner).InsertExpression(ExpressionE.Text);
+ if s <> '' then
+ ExpressionE.Text := s;
+end;
+
+procedure TfrxGroupEditorForm.DataFieldRBClick(Sender: TObject);
+begin
+ DataSetCB.Enabled := DataFieldRB.IsChecked;
+ DataFieldCB.Enabled := DataFieldRB.IsChecked;
+ ExpressionE.Enabled := ExpressionRB.IsChecked;
+end;
+
+procedure TfrxGroupEditorForm.DataSetCBChange(Sender: TObject);
+begin
+ FillDataFieldCB;
+end;
+
+procedure TfrxGroupEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ if ModalResult = mrOk then
+ begin
+ if DataFieldRB.IsChecked then
+ if (DataSetCB.Selected <> nil) and (DataFieldCB.Selected <> nil) then
+ FGroupHeader.Condition := DataSetCB.Selected.Text + '."' + DataFieldCB.Selected.Text + '"' else
+ FGroupHeader.Condition := ExpressionE.Text;
+
+ FGroupHeader.KeepTogether := KeepGroupTogetherCB.IsChecked;
+ FGroupHeader.StartNewPage := StartNewPageCB.IsChecked;
+ if OutlineCB.IsChecked then
+ FGroupHeader.OutlineText := FGroupHeader.Condition else
+ FGroupHeader.OutlineText := '';
+ FGroupHeader.DrillDown := DrillCB.IsChecked;
+ FGroupHeader.ResetPageNumbers := ResetCB.IsChecked;
+ end;
+end;
+
+procedure TfrxGroupEditorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(3200);
+ BreakOnL.Text := frxGet(3201);
+ OptionsL.Text := frxGet(3202);
+ OKB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ DataFieldRB.Text := frxGet(3203);
+ ExpressionRB.Text := frxGet(3204);
+ KeepGroupTogetherCB.Text := frxGet(3205);
+ StartNewPageCB.Text := frxGet(3206);
+ OutlineCB.Text := frxGet(3207);
+ DrillCB.Text := frxResources.Get('bvDrillDown');
+ ResetCB.Text := frxResources.Get('bvResetPageNo');
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+end;
+
+procedure TfrxGroupEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+end.
+
diff --git a/LibD28x64/FMX.frxEditHighlight.fmx b/LibD28x64/FMX.frxEditHighlight.fmx
new file mode 100644
index 0000000..685a3f7
--- /dev/null
+++ b/LibD28x64/FMX.frxEditHighlight.fmx
@@ -0,0 +1,98 @@
+object frxHighlightEditorForm: TfrxHighlightEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Highlight'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 263
+ ClientWidth = 294
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object OKB: TButton
+ Position.Point = '(134,232)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(214,232)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object ConditionL: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 285.000000000000000000
+ Height = 53.000000000000000000
+ TabOrder = 2
+ object ConditionE: TfrxEditWithButton
+ Position.Point = '(8,20)'
+ Width = 269.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 0
+ OnButtonClick = ConditionEButtonClick
+ end
+ end
+ object FontL: TGroupBox
+ Position.Point = '(4,64)'
+ Width = 285.000000000000000000
+ Height = 85.000000000000000000
+ TabOrder = 3
+ object FontColorB: TColorComboBox
+ Position.Point = '(144,48)'
+ Width = 129.000000000000000000
+ Height = 25.000000000000000000
+ end
+ object BoldCB: TCheckBox
+ Position.Point = '(8,20)'
+ Width = 105.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ object ItalicCB: TCheckBox
+ Position.Point = '(8,40)'
+ Width = 105.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object UnderlineCB: TCheckBox
+ Position.Point = '(8,60)'
+ Width = 105.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ end
+ object BackgroundL: TGroupBox
+ Position.Point = '(4,156)'
+ Width = 285.000000000000000000
+ Height = 65.000000000000000000
+ TabOrder = 4
+ object BackColorB: TColorComboBox
+ Position.Point = '(144,28)'
+ Width = 129.000000000000000000
+ Height = 25.000000000000000000
+ end
+ object TransparentRB: TRadioButton
+ Position.Point = '(8,20)'
+ Width = 113.000000000000000000
+ Height = 17.000000000000000000
+ OnChange = TransparentRBClick
+ TabOrder = 1
+ end
+ object OtherRB: TRadioButton
+ Position.Point = '(8,40)'
+ Width = 113.000000000000000000
+ Height = 17.000000000000000000
+ OnChange = TransparentRBClick
+ TabOrder = 2
+ end
+ end
+end
diff --git a/LibD28x64/FMX.frxEditHighlight.pas b/LibD28x64/FMX.frxEditHighlight.pas
new file mode 100644
index 0000000..40ce5e0
--- /dev/null
+++ b/LibD28x64/FMX.frxEditHighlight.pas
@@ -0,0 +1,174 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Highlight editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditHighlight;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Types, FMX.Controls,
+ FMX.Forms, FMX.Dialogs, FMX.frxClass, FMX.ExtCtrls, FMX.frxCtrls,
+ System.Variants, FMX.ListBox, FMX.Edit, System.UIConsts, FMX.Colors
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+
+type
+{$IFDEF LINUX}
+ TfrxHighlightEditorForm = class(TfrxForm)
+{$ELSE}
+ TfrxHighlightEditorForm = class(TForm)
+{$ENDIF}
+ OKB: TButton;
+ CancelB: TButton;
+ ConditionL: TGroupBox;
+ ConditionE: TfrxEditWithButton;
+ FontL: TGroupBox;
+ FontColorB: TColorComboBox;
+ BoldCB: TCheckBox;
+ ItalicCB: TCheckBox;
+ UnderlineCB: TCheckBox;
+ //ColorDialog1: TColorDialog;
+ BackgroundL: TGroupBox;
+ BackColorB: TColorComboBox;
+ TransparentRB: TRadioButton;
+ OtherRB: TRadioButton;
+ procedure TransparentRBClick(Sender: TObject);
+ procedure ConditionEButtonClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ FHighlight: TfrxHighlight;
+ FMemoView: TfrxCustomMemoView;
+ public
+ property MemoView: TfrxCustomMemoView read FMemoView write FMemoView;
+ procedure HostControls(Host: TFmxObject);
+ procedure UnhostControls(AModalResult: TModalResult);
+ procedure FormShow(Sender: TObject);
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxRes;
+
+
+procedure TfrxHighlightEditorForm.FormShow(Sender: TObject);
+begin
+ FHighlight := FMemoView.Highlight;
+
+ ConditionE.Text := FHighlight.Condition;
+ BoldCB.IsChecked := TFontStyle.fsBold in FHighlight.Font.Style;
+ ItalicCB.IsChecked := TFontStyle.fsItalic in FHighlight.Font.Style;
+ UnderlineCB.IsChecked := TFontStyle.fsUnderline in FHighlight.Font.Style;
+ FontColorB.Color := FHighlight.Font.Color;
+
+ if FHighlight.Color = claNull then
+ TransparentRB.IsChecked := True else
+ OtherRB.IsChecked := True;
+ BackColorB.Color := FHighlight.Color;
+
+ TransparentRBClick(nil);
+end;
+
+
+procedure TfrxHighlightEditorForm.TransparentRBClick(Sender: TObject);
+begin
+ BackColorB.Enabled := OtherRB.IsChecked;
+ if TransparentRB.IsChecked then
+ BackColorB.Color := claNull;
+end;
+
+procedure TfrxHighlightEditorForm.ConditionEButtonClick(Sender: TObject);
+var
+ s: String;
+begin
+ s := TfrxCustomDesigner(Owner).InsertExpression(ConditionE.Text);
+ if s <> '' then
+ ConditionE.Text := s;
+end;
+
+procedure TfrxHighlightEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+var
+ fs: TFontStyles;
+begin
+ if ModalResult = mrOk then
+ begin
+ FHighlight.Condition := ConditionE.Text;
+
+ fs := [];
+ if BoldCB.IsChecked then
+ fs := fs + [TFontStyle.fsBold];
+ if ItalicCB.IsChecked then
+ fs := fs + [TFontStyle.fsItalic];
+ if UnderlineCB.IsChecked then
+ fs := fs + [TFontStyle.fsUnderline];
+
+ FHighlight.Font := MemoView.Font;
+ FHighlight.Font.Style := fs;
+ FHighlight.Font.Color := FontColorB.Color;
+ FHighlight.Color := BackColorB.Color;
+ end;
+end;
+
+procedure TfrxHighlightEditorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(4600);
+ ConditionL.Text := frxGet(4603);
+ FontL.Text := frxGet(4604);
+ BackgroundL.Text := frxGet(4605);
+ OKB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ BoldCB.Text := frxGet(4606);
+ ItalicCB.Text := frxGet(4607);
+ UnderlineCB.Text := frxGet(4608);
+ TransparentRB.Text := frxGet(4609);
+ OtherRB.Text := frxGet(4610);
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+end;
+
+procedure TfrxHighlightEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+procedure TfrxHighlightEditorForm.HostControls(Host: TFmxObject);
+begin
+ ConditionL.Parent := Host;
+ FontL.Parent := Host;
+ BackgroundL.Parent := Host;
+ FormShow(Self);
+end;
+
+procedure TfrxHighlightEditorForm.UnhostControls(AModalResult: TModalResult);
+var
+ ca: TCloseAction;
+begin
+ ModalResult := AModalResult;
+ FormClose(Self, ca);
+end;
+
+end.
+
diff --git a/LibD28x64/FMX.frxEditMD.fmx b/LibD28x64/FMX.frxEditMD.fmx
new file mode 100644
index 0000000..ace2e18
--- /dev/null
+++ b/LibD28x64/FMX.frxEditMD.fmx
@@ -0,0 +1,94 @@
+object frxMDEditorForm: TfrxMDEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Master-Detail link'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 250
+ ClientWidth = 324
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object Label1: TLabel
+ Position.Point = '(4,8)'
+ Width = 157.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object Label2: TLabel
+ Position.Point = '(17,8)'
+ Width = 187.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object Label3: TLabel
+ Position.Point = '(4,120)'
+ Width = 237.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 2
+ end
+ object DetailLB: TListBox
+ Position.Point = '(4,24)'
+ Width = 115.000000000000000000
+ Height = 85.000000000000000000
+ OnClick = DetailLBClick
+ HelpContext = 137
+ TabOrder = 3
+ ItemHeight = 13.000000000000000000
+ end
+ object MasterLB: TListBox
+ Position.Point = '(204,24)'
+ Width = 115.000000000000000000
+ Height = 85.000000000000000000
+ OnClick = MasterLBClick
+ HelpContext = 146
+ TabOrder = 4
+ ItemHeight = 13.000000000000000000
+ end
+ object AddB: TButton
+ Enabled = False
+ Position.Point = '(124,24)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = AddBClick
+ HelpContext = 156
+ TabOrder = 5
+ end
+ object LinksLB: TListBox
+ Position.Point = '(4,136)'
+ Width = 235.000000000000000000
+ Height = 61.000000000000000000
+ HelpContext = 164
+ TabOrder = 6
+ ItemHeight = 13.000000000000000000
+ end
+ object ClearB: TButton
+ Position.Point = '(244,136)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = ClearBClick
+ HelpContext = 174
+ TabOrder = 7
+ end
+ object OkB: TButton
+ Position.Point = '(164,220)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 40
+ TabOrder = 8
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(244,220)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 50
+ TabOrder = 9
+ ModalResult = 2
+ Cancel = True
+ end
+end
diff --git a/LibD28x64/FMX.frxEditMD.pas b/LibD28x64/FMX.frxEditMD.pas
new file mode 100644
index 0000000..5d36be6
--- /dev/null
+++ b/LibD28x64/FMX.frxEditMD.pas
@@ -0,0 +1,165 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ Master-Detail editor }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditMD;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.frxCustomDB, FMX.Layouts, FMX.ListBox, System.Variants
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+
+type
+ TfrxMDEditorForm = class(TForm)
+ DetailLB: TListBox;
+ MasterLB: TListBox;
+ Label1: TLabel;
+ Label2: TLabel;
+ AddB: TButton;
+ LinksLB: TListBox;
+ Label3: TLabel;
+ ClearB: TButton;
+ OkB: TButton;
+ CancelB: TButton;
+ procedure FormShow(Sender: TObject);
+ procedure FormHide(Sender: TObject);
+ procedure ClearBClick(Sender: TObject);
+ procedure DetailLBClick(Sender: TObject);
+ procedure MasterLBClick(Sender: TObject);
+ procedure AddBClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ FDetailDS: TfrxCustomDataset;
+ FMasterDS: TfrxCustomDBDataset;
+ FMasterFields: String;
+ procedure FillLists;
+ public
+ property DataSet: TfrxCustomDataset read FDetailDS write FDetailDS;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxUtils, FMX.frxRes, FMX.frxFMX;
+
+
+procedure TfrxMDEditorForm.FillLists;
+var
+ i: Integer;
+ s: String;
+ sl: TStrings;
+begin
+ FDetailDS.GetFieldList(DetailLB.Items);
+ FMasterDS.GetFieldList(MasterLB.Items);
+{$IFDEF DELPHI23}
+ LinksLB.Clear;
+{$ELSE}
+ LinksLB.Items.Clear;
+{$ENDIF}
+
+ sl := TStringList.Create;
+ frxSetCommaText(FMasterFields, sl);
+
+ for i := 0 to sl.Count - 1 do
+ begin
+ s := sl.Names[i];
+ if DetailLB.Items.IndexOf(s) <> -1 then
+ DetailLB.Items.Delete(DetailLB.Items.IndexOf(s));
+ s := sl.Values[sl.Names[i]];
+ if MasterLB.Items.IndexOf(s) <> -1 then
+ MasterLB.Items.Delete(MasterLB.Items.IndexOf(s));
+ LinksLB.Items.Add(sl[i]);
+ end;
+
+ AddB.Enabled := False;
+ sl.Free;
+end;
+
+procedure TfrxMDEditorForm.FormShow(Sender: TObject);
+begin
+ FMasterDS := FDetailDS.Master;
+ FMasterFields := FDetailDS.MasterFields;
+ FillLists;
+end;
+
+procedure TfrxMDEditorForm.FormHide(Sender: TObject);
+begin
+ if ModalResult = mrOk then
+ FDetailDS.MasterFields := FMasterFields;
+end;
+
+procedure TfrxMDEditorForm.ClearBClick(Sender: TObject);
+begin
+ FMasterFields := '';
+ FillLists;
+end;
+
+procedure TfrxMDEditorForm.DetailLBClick(Sender: TObject);
+begin
+ if MasterLB.ItemIndex <> -1 then
+ AddB.Enabled := True;
+end;
+
+procedure TfrxMDEditorForm.MasterLBClick(Sender: TObject);
+begin
+ if DetailLB.ItemIndex <> -1 then
+ AddB.Enabled := True;
+end;
+
+procedure TfrxMDEditorForm.AddBClick(Sender: TObject);
+var
+ s: String;
+begin
+ s := DetailLB.Items[DetailLB.ItemIndex] + '=' + MasterLB.Items[MasterLB.ItemIndex];
+ if FMasterFields = '' then
+ FMasterFields := s else
+ FMasterFields := FMasterFields + ';' + s;
+ FillLists;
+end;
+
+procedure TfrxMDEditorForm.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+ FormHide(Self);
+end;
+
+procedure TfrxMDEditorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(3800);
+ Label1.Text := frxGet(3801);
+ Label2.Text := frxGet(3802);
+ Label3.Text := frxGet(3803);
+ AddB.Text := frxGet(3804);
+ ClearB.Text := frxGet(3805);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+
+
+end;
+
+procedure TfrxMDEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VK_F1 then
+ frxResources.Help(Self);
+end;
+
+end.
+
diff --git a/LibD28x64/FMX.frxEditMemo.fmx b/LibD28x64/FMX.frxEditMemo.fmx
new file mode 100644
index 0000000..b9d46ed
--- /dev/null
+++ b/LibD28x64/FMX.frxEditMemo.fmx
@@ -0,0 +1,98 @@
+object frxMemoEditorForm: TfrxMemoEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Memo'
+ BorderIcons = [biSystemMenu, biMaximize]
+ ClientHeight = 404
+ ClientWidth = 458
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object TabControl: TTabControl
+ Align = alClient
+ Width = 458.000000000000000000
+ Height = 352.000000000000000000
+ TabIndex = 0
+ TabHeight = 20.000000000000000000
+ object TextTS: TTabItem
+ Width = 66.666664123535160000
+ Height = 20.000000000000000000
+ Index = 0
+ Text = 'TextTS'
+ WordWrap = False
+ object ToolBar: TToolBar
+ Width = 458.000000000000000000
+ Height = 28.000000000000000000
+ TabOrder = 0
+ object ExprB: TfrxToolButton
+ Position.Point = '(4,2)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = ExprBClick
+ Hint = 'Insert Expression'
+ end
+ object AggregateB: TfrxToolButton
+ Position.Point = '(27,2)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = AggregateBClick
+ end
+ object LocalFormatB: TfrxToolButton
+ Position.Point = '(50,2)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = LocalFormatBClick
+ end
+ object WordWrapB: TfrxToolButton
+ Position.Point = '(73,2)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = WordWrapBClick
+ Hint = 'Word Wrap'
+ end
+ end
+ end
+ object FormatTS: TTabItem
+ Width = 66.666664123535160000
+ Height = 20.000000000000000000
+ Index = 1
+ Text = 'FormatTS'
+ WordWrap = False
+ end
+ object HighlightTS: TTabItem
+ Width = 66.666664123535160000
+ Height = 20.000000000000000000
+ Index = 2
+ Text = 'HighlightTS'
+ WordWrap = False
+ end
+ end
+ object Panel1: TPanel
+ Align = alBottom
+ Position.Point = '(0,352)'
+ Width = 458.000000000000000000
+ Height = 50.000000000000000000
+ StyleLookup = 'backgroundstyle'
+ object CancelB: TButton
+ Position.Point = '(371,12)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object OkB: TButton
+ Position.Point = '(291,12)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 2
+ ModalResult = 1
+ end
+ end
+ object SaveDialog1: TSaveDialog
+ Left = 152
+ Top = 176
+ end
+end
diff --git a/LibD28x64/FMX.frxEditMemo.pas b/LibD28x64/FMX.frxEditMemo.pas
new file mode 100644
index 0000000..353d642
--- /dev/null
+++ b/LibD28x64/FMX.frxEditMemo.pas
@@ -0,0 +1,313 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Memo editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditMemo;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, System.Types, FMX.Types, FMX.Controls,
+ FMX.Forms, FMX.Dialogs, FMX.ExtCtrls, FMX.frxClass, FMX.TabControl,
+ FMX.frxEditFormat, FMX.frxEditHighlight, FMX.frxFMX, FMX.Memo, System.Variants, System.StrUtils,
+ FMX.frxBaseModalForm
+ {$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+ {$IFDEF DELPHI22}
+ ,FMX.Memo.Types
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+ TfrxMemoEditorForm = class(TfrxForm)
+ SaveDialog1: TSaveDialog;
+ TabControl: TTabControl;
+ TextTS: TTabItem;
+ FormatTS: TTabItem;
+ HighlightTS: TTabItem;
+ ToolBar: TToolBar;
+ ExprB: TfrxToolButton;
+ AggregateB: TfrxToolButton;
+ LocalFormatB: TfrxToolButton;
+ WordWrapB: TfrxToolButton;
+ Panel1: TPanel;
+ CancelB: TButton;
+ OkB: TButton;
+ procedure WordWrapBClick(Sender: TObject);
+ procedure MemoKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure ExprBClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure AggregateBClick(Sender: TObject);
+ procedure LocalFormatBClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure FormShow2(Sender: TObject);
+ private
+ FFormat: TfrxFormatEditorForm;
+ FHighlight: TfrxHighlightEditorForm;
+ FMemoView: TfrxCustomMemoView;
+ FText: WideString;
+ public
+ Memo: TMemo;
+ procedure FormShow(Sender: TObject);
+ property MemoView: TfrxCustomMemoView read FMemoView write FMemoView;
+ property Text: WideString read FText write FText;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses
+ FMX.frxEditSysMemo, System.IniFiles, FMX.frxRes, FMX.frxUnicodeUtils, FMX.frxUtils;
+
+
+{ TfrxMemoEditorForm }
+
+procedure TfrxMemoEditorForm.FormShow2(Sender: TObject);
+begin
+Memo.SetFocus;
+end;
+
+procedure TfrxMemoEditorForm.FormShow(Sender: TObject);
+var
+ Ini: TCustomIniFile;
+begin
+ Memo := TMemo.Create(TextTS);
+
+ with Memo do
+ begin
+ Parent := TextTS;
+ Align := TAlignLayout.alClient;
+ ///ScrollBars := ssBoth;
+ //TabOrder := 1;
+ OnKeyDown := MemoKeyDown;
+ end;
+
+ FFormat := TfrxFormatEditorForm.Create(Owner);
+ FFormat.Format.Assign(MemoView.DisplayFormat);
+ FFormat.HostControls(FormatTS);
+
+ FHighlight := TfrxHighlightEditorForm.Create(Owner);
+ FHighlight.MemoView := MemoView;
+ FHighlight.HostControls(HighlightTS);
+
+ Ini := TfrxCustomDesigner(Owner).Report.GetIniFile;
+ WordWrapB.Down := Ini.ReadBool('TfrxMemoEditorForm', 'WordWrap', False);
+ WordWrapBClick(nil);
+ frxRestoreFormPosition(Ini, Self);
+ Ini.Free;
+
+ with TfrxCustomDesigner(Owner) do
+ begin
+ if UseObjectFont then
+ begin
+ FMemoView.Font.AssignToFont(Memo.Font);
+ end
+ else
+ begin
+ {$IFDEF LINUX}
+ Memo.Font.Family := 'Liberation Sans';
+ {$ELSE}
+ Memo.Font.Family := 'Arial';
+ {$ENDIF}
+ Memo.Font.Size := 13;
+ end;
+ end;
+
+
+ Memo.Text := FMemoView.Text;
+ Memo.SelStart := Length(Memo.Text);
+ Memo.SelLength := 1;
+end;
+
+
+procedure TfrxMemoEditorForm.ExprBClick(Sender: TObject);
+var
+ s, s1, s2: String;
+ SelStart: TCaretPosition;
+ SelLen: Integer;
+
+ function BracketCount: Integer;
+ var
+ i: Integer;
+ begin
+ Result := 0;
+ for i := 1 to Length(s) do
+ if s[i] = '<' then
+ Inc(Result);
+ end;
+
+begin
+ s := TfrxCustomDesigner(Owner).InsertExpression('');
+ if s <> '' then
+ begin
+ s1 := MemoView.ExpressionDelimiters;
+ s2 := Copy(s1, Pos(',', s1) + 1, 255);
+ s1 := Copy(s1, 1, Pos(',', s1) - 1);
+ if (s[1] = '<') and (s[Length(s)] = '>') and (BracketCount = 1) then
+ s := Copy(s, 2, Length(s) - 2);
+ SelLen := Memo.SelLength;
+ SelStart := Memo.TextPosToPos(Memo.SelStart);
+ Memo.DeleteFrom(SelStart, SelLen, []);
+ Memo.InsertAfter(SelStart, s1 + s + s2, []);
+ //Memo.SelText := s1 + s + s2;
+ //todo
+ end;
+
+end;
+
+procedure TfrxMemoEditorForm.WordWrapBClick(Sender: TObject);
+begin
+ Memo.WordWrap := WordWrapB.Down;
+end;
+
+procedure TfrxMemoEditorForm.MemoKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if (Key = vkReturn) and (ssCtrl in Shift) then
+ ModalResult := mrOk
+ else if Key = vkEscape then
+ ModalResult := mrCancel
+ else if (Key = Ord('A')) and (Shift = [ssCtrl]) then
+ Memo.SelectAll;
+end;
+
+procedure TfrxMemoEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+var
+ Ini: TCustomIniFile;
+begin
+ Ini := TfrxCustomDesigner(Owner).Report.GetIniFile;
+ frxSaveFormPosition(Ini, Self);
+ Ini.WriteBool('TfrxMemoEditorForm', 'WordWrap', Memo.WordWrap);
+ Ini.Free;
+
+ FText := Memo.Text;
+
+ FFormat.UnhostControls;
+ if ModalResult = mrOk then
+ FMemoView.DisplayFormat.Assign(FFormat.Format);
+ FFormat.Free;
+ FHighlight.UnhostControls(ModalResult);
+ FHighlight.Free;
+end;
+
+
+procedure TfrxMemoEditorForm.FormCreate(Sender: TObject);
+begin
+ frxResources.LoadImageFromResouce(ExprB.Bitmap, 11, 3);
+ frxResources.LoadImageFromResouce(AggregateB.Bitmap, 6, 5);
+ frxResources.LoadImageFromResouce(LocalFormatB.Bitmap, 5, 2);
+ frxResources.LoadImageFromResouce(WordWrapB.Bitmap, 2, 5);
+ Caption := frxGet(3900);
+ ExprB.Hint := frxGet(3901);
+ AggregateB.Hint := frxGet(3902);
+ LocalFormatB.Hint := frxGet(3903);
+ WordWrapB.Hint := frxGet(3904);
+ TextTS.Text := frxGet(3905);
+ FormatTS.Text := frxGet(3906);
+ HighlightTS.Text := frxGet(3907);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+{$IFDEF DELPHI18}
+ CancelB.Anchors := [TAnchorKind.akRight, TAnchorKind.akTop];
+ OkB.Anchors := [TAnchorKind.akRight, TAnchorKind.akTop];
+{$ENDIF}
+{$IFDEF DELPHI18}
+ OnShow := FormShow2;
+{$ENDIF}
+
+ Toolbar.StyleLookup := 'backgroundstyle';
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxMemoEditorForm.AggregateBClick(Sender: TObject);
+var
+ SelStart: TCaretPosition;
+ SelLen: Integer;
+begin
+ with TfrxSysMemoEditorForm.Create(Owner) do
+ begin
+ AggregateOnly := True;
+ FormShow(nil);
+ if ShowModal = mrOk then
+ begin
+ SelLen := Memo.SelLength;
+ SelStart := Memo.TextPosToPos(Memo.SelStart);
+ Memo.DeleteFrom(SelStart, SelLen, []);
+ Memo.InsertAfter(SelStart, Text, []);
+ end;
+ ///Memo.SelText := Text;
+ Free;
+ end;
+end;
+
+procedure TfrxMemoEditorForm.LocalFormatBClick(Sender: TObject);
+var
+ s: String;
+ i: Integer;
+begin
+ with TfrxFormatEditorForm.Create(Owner) do
+ begin
+ FormShow(nil);
+ if ShowModal = mrOk then
+ begin
+ case Format.Kind of
+ fkText:
+ s := '';
+
+ fkNumeric:
+ begin
+ s := Format.FormatStr;
+ for i := 1 to Length(s) do
+ if CharInSet(s[i], ['.', ',', '-']) then
+ if Format.DecimalSeparator <> '' then
+ s[i] := Format.DecimalSeparator[1] else
+ s[i] := FormatSettings.DecimalSeparator;
+ s := ' #n' + s;
+ end;
+
+ fkDateTime:
+ s := ' #d' + Format.FormatStr;
+
+ fkBoolean:
+ s := ' #b' + Format.FormatStr;
+ end;
+
+ if s <> '' then
+ begin
+ i := Memo.SelStart;
+ if (i > 0) and (Memo.Text[i] = ']') then
+ Memo.SelStart := Memo.SelStart - 1;
+ //Memo.SelText := s;
+
+ end;
+ end;
+ Free;
+ end;
+end;
+
+procedure TfrxMemoEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+end.
+
diff --git a/LibD28x64/FMX.frxEditOptions.fmx b/LibD28x64/FMX.frxEditOptions.fmx
new file mode 100644
index 0000000..2d17468
--- /dev/null
+++ b/LibD28x64/FMX.frxEditOptions.fmx
@@ -0,0 +1,274 @@
+object frxOptionsEditor: TfrxOptionsEditor
+ Left = 0
+ Top = 0
+ Caption = 'Designer Options'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 443
+ ClientWidth = 349
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object OkB: TButton
+ Position.Point = '(188,412)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(268,412)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object RestoreDefaultsB: TButton
+ Position.Point = '(8,412)'
+ Width = 137.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = RestoreDefaultsBClick
+ TabOrder = 2
+ end
+ object Label1: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 341.000000000000000000
+ Height = 137.000000000000000000
+ TabOrder = 3
+ object Label2: TLabel
+ Position.Point = '(8,16)'
+ Width = 105.000000000000000000
+ Height = 18.000000000000000000
+ TabOrder = 0
+ end
+ object Label3: TLabel
+ Position.Point = '(128,16)'
+ Width = 89.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 1
+ end
+ object Label4: TLabel
+ Position.Point = '(26,110)'
+ Width = 95.000000000000000000
+ Height = 14.000000000000000000
+ TabOrder = 2
+ end
+ object Label13: TLabel
+ Position.Point = '(168,37)'
+ Width = 25.000000000000000000
+ Height = 15.000000000000000000
+ TabOrder = 3
+ end
+ object Label14: TLabel
+ Position.Point = '(168,61)'
+ Width = 25.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 4
+ end
+ object Label15: TLabel
+ Position.Point = '(168,85)'
+ Width = 33.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 5
+ end
+ object Label16: TLabel
+ Position.Point = '(168,109)'
+ Width = 41.000000000000000000
+ Height = 15.000000000000000000
+ TabOrder = 6
+ end
+ object CMRB: TRadioButton
+ Position.Point = '(8,36)'
+ Width = 109.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 7
+ end
+ object InchesRB: TRadioButton
+ Position.Point = '(8,60)'
+ Width = 109.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 8
+ end
+ object PixelsRB: TRadioButton
+ Position.Point = '(8,84)'
+ Width = 109.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 9
+ end
+ object CME: TEdit
+ Position.Point = '(128,34)'
+ Width = 37.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 10
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object InchesE: TEdit
+ Position.Point = '(128,58)'
+ Width = 37.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 11
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object PixelsE: TEdit
+ Position.Point = '(128,82)'
+ Width = 37.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 12
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object DialogFormE: TEdit
+ Position.Point = '(128,106)'
+ Width = 37.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 13
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object ShowGridCB: TCheckBox
+ Position.Point = '(196,36)'
+ Width = 137.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 14
+ end
+ object AlignGridCB: TCheckBox
+ Position.Point = '(196,56)'
+ Width = 137.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 15
+ end
+ end
+ object Label6: TGroupBox
+ Position.Point = '(4,144)'
+ Width = 341.000000000000000000
+ Height = 93.000000000000000000
+ TabOrder = 4
+ object Label7: TLabel
+ Position.Point = '(8,20)'
+ Width = 97.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object Label8: TLabel
+ Position.Point = '(8,48)'
+ Width = 97.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object Label9: TLabel
+ Position.Point = '(240,20)'
+ Width = 39.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object Label10: TLabel
+ Position.Point = '(240,48)'
+ Width = 39.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ object CodeWindowFontCB: TComboBox
+ Position.Point = '(112,18)'
+ Width = 121.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 4
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ DropDownCount = 12
+ end
+ object CodeWindowSizeCB: TComboBox
+ Position.Point = '(288,18)'
+ Width = 44.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 5
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ end
+ object MemoEditorFontCB: TComboBox
+ Position.Point = '(112,46)'
+ Width = 121.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 6
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ DropDownCount = 12
+ end
+ object MemoEditorSizeCB: TComboBox
+ Position.Point = '(288,46)'
+ Width = 44.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 7
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ end
+ object ObjectFontCB: TCheckBox
+ Position.Point = '(112,68)'
+ Width = 189.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 8
+ end
+ end
+ object Label5: TGroupBox
+ Position.Point = '(4,244)'
+ Width = 341.000000000000000000
+ Height = 153.000000000000000000
+ TabOrder = 5
+ object Label12: TLabel
+ Position.Point = '(8,127)'
+ Width = 140.000000000000000000
+ Height = 15.000000000000000000
+ TabOrder = 0
+ end
+ object Label17: TLabel
+ Position.Point = '(212,126)'
+ Width = 85.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ object EditAfterInsCB: TCheckBox
+ Position.Point = '(8,20)'
+ Width = 293.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object FreeBandsCB: TCheckBox
+ Position.Point = '(8,80)'
+ Width = 293.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ object GapE: TEdit
+ Position.Point = '(172,124)'
+ Width = 37.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 4
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object BandsCaptionsCB: TCheckBox
+ Position.Point = '(8,40)'
+ Width = 293.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 5
+ end
+ object DropFieldsCB: TCheckBox
+ Position.Point = '(8,60)'
+ Width = 293.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 6
+ end
+ object StartupCB: TCheckBox
+ Position.Point = '(8,100)'
+ Width = 293.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 7
+ end
+ end
+end
diff --git a/LibD28x64/FMX.frxEditOptions.pas b/LibD28x64/FMX.frxEditOptions.pas
new file mode 100644
index 0000000..9a0c6fc
--- /dev/null
+++ b/LibD28x64/FMX.frxEditOptions.pas
@@ -0,0 +1,266 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Designer options }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditOptions;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.Types, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.ExtCtrls, FMX.frxCtrls, FMX.Objects, FMX.ListBox, FMX.Edit, FMX.Types, System.Variants
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+
+type
+{$IFDEF LINUX}
+ TfrxOptionsEditor = class(TfrxForm)
+{$ELSE}
+ TfrxOptionsEditor = class(TForm)
+{$ENDIF}
+ OkB: TButton;
+ CancelB: TButton;
+ RestoreDefaultsB: TButton;
+ Label1: TGroupBox;
+ Label2: TLabel;
+ Label3: TLabel;
+ Label4: TLabel;
+ Label13: TLabel;
+ Label14: TLabel;
+ Label15: TLabel;
+ Label16: TLabel;
+ CMRB: TRadioButton;
+ InchesRB: TRadioButton;
+ PixelsRB: TRadioButton;
+ CME: TEdit;
+ InchesE: TEdit;
+ PixelsE: TEdit;
+ DialogFormE: TEdit;
+ ShowGridCB: TCheckBox;
+ AlignGridCB: TCheckBox;
+ Label6: TGroupBox;
+ Label7: TLabel;
+ Label8: TLabel;
+ Label9: TLabel;
+ Label10: TLabel;
+ CodeWindowFontCB: TComboBox;
+ CodeWindowSizeCB: TComboBox;
+ MemoEditorFontCB: TComboBox;
+ MemoEditorSizeCB: TComboBox;
+ ObjectFontCB: TCheckBox;
+ Label5: TGroupBox;
+ Label12: TLabel;
+ Label17: TLabel;
+ EditAfterInsCB: TCheckBox;
+ FreeBandsCB: TCheckBox;
+ GapE: TEdit;
+ BandsCaptionsCB: TCheckBox;
+ DropFieldsCB: TCheckBox;
+ StartupCB: TCheckBox;
+ procedure FormCreate(Sender: TObject);
+ procedure RestoreDefaultsBClick(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxDesgn, FMX.frxDesgnWorkspace, FMX.frxUtils, FMX.frxRes, FMX.frxFMX;
+
+
+{ TfrxPreferencesEditor }
+
+procedure TfrxOptionsEditor.FormShow(Sender: TObject);
+ var
+ aIndex: Integer;
+ procedure SetEnabled(cAr: Array of TControl; Enabled: Boolean);
+ var
+ i: Integer;
+ begin
+ for i := 0 to High(cAr) do
+ cAr[i].Enabled := Enabled;
+ end;
+
+ procedure FillSizes(Items: TStrings);
+ begin
+ Items.BeginUpdate;
+ Items.Add('4');
+ Items.Add('5');
+ Items.Add('6');
+ Items.Add('7');
+ Items.Add('8');
+ Items.Add('9');
+ Items.Add('10');
+ Items.Add('12');
+ Items.Add('14');
+ Items.Add('16');
+ Items.Add('18');
+ Items.Add('20');
+ Items.Add('22');
+ Items.Add('24');
+ Items.Add('26');
+ Items.Add('28');
+ Items.Add('36');
+ Items.EndUpdate;
+ end;
+
+begin
+ //ColorDialog.CustomColors.Add('ColorA=' + IntToHex(ColorToRGB(clBtnFace), 6));
+
+ with TfrxDesignerForm(Owner) do
+ begin
+ FillFontsList(CodeWindowFontCB.Items);
+ FillSizes(CodeWindowSizeCB.Items);
+ FillFontsList(MemoEditorFontCB.Items);
+
+ SetEnabled([CMRB, InchesRB, PixelsRB, CME, InchesE, PixelsE],
+ (Workspace.GridType <> gtDialog) and (Workspace.GridType <> gtChar));
+
+ CMRB.IsChecked := Units = duCM;
+ InchesRB.IsChecked := Units = duInches;
+ PixelsRB.IsChecked := Units = duPixels;
+
+ CME.Text := FloatToStr(GridSize1);
+ InchesE.Text := FloatToStr(GridSize2);
+ PixelsE.Text := FloatToStr(GridSize3);
+ DialogFormE.Text := FloatToStr(GridSize4);
+
+ ShowGridCB.IsChecked := ShowGrid;
+ AlignGridCB.IsChecked := GridAlign;
+ EditAfterInsCB.IsChecked := EditAfterInsert;
+ BandsCaptionsCB.IsChecked := Workspace.ShowBandCaptions;
+ DropFieldsCB.IsChecked := DropFields;
+ StartupCB.IsChecked := ShowStartup;
+ StartupCB.Visible := False;
+ FreeBandsCB.IsChecked := Workspace.FreeBandsPlacement;
+ GapE.Text := IntToStr(Workspace.GapBetweenBands);
+ aIndex := CodeWindowFontCB.Items.IndexOf(CodeWindow.FontSettings.Font.Family);
+ if aIndex <> -1 then
+ CodeWindowFontCB.ItemIndex := aIndex;
+ aIndex := CodeWindowSizeCB.Items.IndexOf(IntToStr(Round(CodeWindow.FontSettings.Font.Size)));
+ if aIndex = -1 then
+ aIndex := CodeWindowSizeCB.Items.Add(IntToStr(Round(CodeWindow.FontSettings.Font.Size)));
+ CodeWindowSizeCB.ItemIndex := aIndex;
+ MemoEditorFontCB.ItemIndex := MemoEditorFontCB.Items.IndexOf(MemoFontName);
+ MemoEditorSizeCB.ItemIndex := MemoEditorSizeCB.Items.IndexOf(IntToStr(MemoFontSize));
+ ObjectFontCB.IsChecked := UseObjectFont;
+ end;
+end;
+
+
+procedure TfrxOptionsEditor.RestoreDefaultsBClick(Sender: TObject);
+begin
+ TfrxDesignerForm(Owner).RestoreState(True);
+ ModalResult := mrOk;
+end;
+
+procedure TfrxOptionsEditor.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ if ModalResult = mrOk then
+ with TfrxDesignerForm(Owner) do
+ begin
+ GridSize4 := frxStrToFloat(DialogFormE.Text);
+
+ if CMRB.Enabled then
+ begin
+ GridSize1 := frxStrToFloat(CME.Text);
+ GridSize2 := frxStrToFloat(InchesE.Text);
+ GridSize3 := frxStrToFloat(PixelsE.Text);
+
+ if CMRB.IsChecked then
+ Units := duCM
+ else if InchesRB.IsChecked then
+ Units := duInches else
+ Units := duPixels;
+ end;
+
+ ShowGrid := ShowGridCB.IsChecked;
+ GridAlign := AlignGridCB.IsChecked;
+ EditAfterInsert := EditAfterInsCB.IsChecked;
+ Workspace.ShowBandCaptions := BandsCaptionsCB.IsChecked;
+ DropFields := DropFieldsCB.IsChecked;
+ ShowStartup := StartupCB.IsChecked;
+ Workspace.FreeBandsPlacement := FreeBandsCB.IsChecked;
+ Workspace.GapBetweenBands := StrToInt(GapE.Text);
+
+ if Assigned(CodeWindowFontCB.Selected) then
+ CodeWindow.FontSettings.Font.Family := CodeWindowFontCB.Selected.Text;
+ if Assigned(CodeWindowSizeCB.Selected) then
+ CodeWindow.FontSettings.Font.Size := StrToInt(CodeWindowSizeCB.Selected.Text);
+ if MemoEditorFontCB.Selected <> nil then
+ MemoFontName := MemoEditorFontCB.Selected.Text;
+ if MemoEditorSizeCB.Selected <> nil then
+ MemoFontSize := StrToInt(MemoEditorSizeCB.Selected.Text);
+ UseObjectFont := ObjectFontCB.IsChecked;
+ end;
+end;
+
+procedure TfrxOptionsEditor.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(3000);
+ Label1.Text := frxGet(3001);
+ Label2.Text := frxGet(3002);
+ Label3.Text := frxGet(3003);
+ Label4.Text := frxGet(3004);
+ Label5.Text := frxGet(3005);
+ Label6.Text := frxGet(3006);
+ Label7.Text := frxGet(3007);
+ Label8.Text := frxGet(3008);
+ Label9.Text := frxGet(3009);
+ Label10.Text := frxGet(3010);
+ Label12.Text := frxGet(3012);
+ Label13.Text := frxGet(3013);
+ Label14.Text := frxGet(3014);
+ Label15.Text := frxGet(3015);
+ Label16.Text := frxGet(3016);
+ Label17.Text := frxGet(3017);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ CMRB.Text := frxGet(3018);
+ InchesRB.Text := frxGet(3019);
+ PixelsRB.Text := frxGet(3020);
+ ShowGridCB.Text := frxGet(3021);
+ AlignGridCB.Text := frxGet(3022);
+ EditAfterInsCB.Text := frxGet(3023);
+ ObjectFontCB.Text := frxGet(3024);
+ FreeBandsCB.Text := frxGet(3028);
+ DropFieldsCB.Text := frxGet(3029);
+ StartupCB.Text := frxGet(3030);
+ RestoreDefaultsB.Text := frxGet(3031);
+ BandsCaptionsCB.Text := frxGet(3032);
+ FormShow(Self);
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxOptionsEditor.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VK_F1 then
+ frxResources.Help(Self);
+end;
+
+end.
diff --git a/LibD28x64/FMX.frxEditPage.fmx b/LibD28x64/FMX.frxEditPage.fmx
new file mode 100644
index 0000000..17a90d9
--- /dev/null
+++ b/LibD28x64/FMX.frxEditPage.fmx
@@ -0,0 +1,367 @@
+object frxPageEditorForm: TfrxPageEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Page options'
+ BorderStyle = bsSingle
+ BorderIcons = []
+ ClientHeight = 410
+ ClientWidth = 302
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object OKB: TButton
+ Position.Point = '(138,380)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(220,380)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object TabControl1: TTabControl
+ Position.Point = '(6,0)'
+ Width = 289.000000000000000000
+ Height = 377.000000000000000000
+ TabOrder = 2
+ TabIndex = 0
+ TabHeight = 20.000000000000000000
+ object TabSheet1: TTabItem
+ Width = 144.500000000000000000
+ Height = 20.000000000000000000
+ TabOrder = 0
+ Index = 0
+ Text = 'TabSheet1'
+ WordWrap = False
+ object Label11: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 277.000000000000000000
+ Height = 101.000000000000000000
+ TabOrder = 0
+ object Label1: TLabel
+ Position.Point = '(8,47)'
+ Width = 51.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 0
+ end
+ object Label2: TLabel
+ Position.Point = '(8,72)'
+ Width = 52.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 1
+ end
+ object UnitL1: TLabel
+ Position.Point = '(112,48)'
+ Width = 25.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object UnitL2: TLabel
+ Position.Point = '(112,72)'
+ Width = 33.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 3
+ end
+ object WidthE: TEdit
+ Position.Point = '(64,46)'
+ Width = 45.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 4
+ KeyboardType = vktDefault
+ OnChange = WidthEChange
+ Password = False
+ end
+ object HeightE: TEdit
+ Position.Point = '(64,70)'
+ Width = 45.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 5
+ KeyboardType = vktDefault
+ OnChange = WidthEChange
+ Password = False
+ end
+ object SizeCB: TComboBox
+ Position.Point = '(8,18)'
+ Width = 261.000000000000000000
+ Height = 21.000000000000000000
+ OnClick = SizeCBClick
+ TabOrder = 6
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ end
+ end
+ object Label12: TGroupBox
+ Position.Point = '(4,108)'
+ Width = 277.000000000000000000
+ Height = 65.000000000000000000
+ TabOrder = 1
+ object PortraitImg: TImage
+ Position.Point = '(148,21)'
+ Width = 26.000000000000000000
+ Height = 32.000000000000000000
+ end
+ object LandscapeImg: TImage
+ Position.Point = '(145,25)'
+ Width = 32.000000000000000000
+ Height = 26.000000000000000000
+ end
+ object PortraitRB: TRadioButton
+ Position.Point = '(8,20)'
+ Width = 109.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = PortraitRBClick
+ TabOrder = 2
+ end
+ object LandscapeRB: TRadioButton
+ Position.Point = '(8,40)'
+ Width = 109.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = PortraitRBClick
+ TabOrder = 3
+ end
+ end
+ object Label13: TGroupBox
+ Position.Point = '(4,176)'
+ Width = 277.000000000000000000
+ Height = 73.000000000000000000
+ TabOrder = 2
+ object Label3: TLabel
+ Position.Point = '(8,20)'
+ Width = 50.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 0
+ end
+ object Label4: TLabel
+ Position.Point = '(8,43)'
+ Width = 49.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ object Label5: TLabel
+ Position.Point = '(152,19)'
+ Width = 49.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 2
+ end
+ object Label6: TLabel
+ Position.Point = '(152,42)'
+ Width = 52.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ object UnitL3: TLabel
+ Position.Point = '(108,20)'
+ Width = 29.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 4
+ end
+ object UnitL4: TLabel
+ Position.Point = '(108,44)'
+ Width = 29.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 5
+ end
+ object UnitL5: TLabel
+ Position.Point = '(252,20)'
+ Width = 21.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 6
+ end
+ object UnitL6: TLabel
+ Position.Point = '(252,44)'
+ Width = 21.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 7
+ end
+ object MarginLeftE: TEdit
+ Position.Point = '(64,18)'
+ Width = 40.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 8
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object MarginTopE: TEdit
+ Position.Point = '(64,42)'
+ Width = 40.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 9
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object MarginRightE: TEdit
+ Position.Point = '(208,18)'
+ Width = 40.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 10
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object MarginBottomE: TEdit
+ Position.Point = '(208,42)'
+ Width = 40.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 11
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+ object Label14: TGroupBox
+ Position.Point = '(4,252)'
+ Width = 277.000000000000000000
+ Height = 73.000000000000000000
+ TabOrder = 3
+ object Label9: TLabel
+ Position.Point = '(8,20)'
+ Width = 89.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 0
+ end
+ object Label10: TLabel
+ Position.Point = '(8,44)'
+ Width = 97.000000000000000000
+ Height = 15.000000000000000000
+ TabOrder = 1
+ end
+ object Tray1CB: TComboBox
+ Position.Point = '(128,18)'
+ Width = 141.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 2
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ end
+ object Tray2CB: TComboBox
+ Position.Point = '(128,42)'
+ Width = 141.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 3
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ end
+ end
+ end
+ object TabSheet3: TTabItem
+ Width = 144.500000000000000000
+ Height = 20.000000000000000000
+ TabOrder = 1
+ Index = 1
+ Text = 'TabSheet3'
+ WordWrap = False
+ object Label17: TGroupBox
+ Position.Point = '(4,156)'
+ Width = 277.000000000000000000
+ Height = 169.000000000000000000
+ TabOrder = 0
+ object Label18: TLabel
+ Position.Point = '(8,132)'
+ Width = 73.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 0
+ end
+ object PrintOnPrevCB: TCheckBox
+ Position.Point = '(8,20)'
+ Width = 261.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ object MirrorMarginsCB: TCheckBox
+ Position.Point = '(8,40)'
+ Width = 261.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object LargeHeightCB: TCheckBox
+ Position.Point = '(8,100)'
+ Width = 261.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ object DuplexCB: TComboBox
+ Position.Point = '(88,130)'
+ Width = 141.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 4
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ end
+ object EndlessWidthCB: TCheckBox
+ Position.Point = '(8,60)'
+ Width = 261.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 5
+ end
+ object EndlessHeightCB: TCheckBox
+ Position.Point = '(8,80)'
+ Width = 261.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 6
+ end
+ end
+ object Label7: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 277.000000000000000000
+ Height = 149.000000000000000000
+ TabOrder = 1
+ object Label8: TLabel
+ Position.Point = '(8,19)'
+ Width = 73.000000000000000000
+ Height = 15.000000000000000000
+ TabOrder = 0
+ end
+ object Label15: TLabel
+ Position.Point = '(8,44)'
+ Width = 74.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 1
+ end
+ object Label16: TLabel
+ Position.Point = '(8,68)'
+ Width = 73.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object UnitL7: TLabel
+ Position.Point = '(136,44)'
+ Width = 13.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 3
+ end
+ object ColumnWidthE: TEdit
+ Position.Point = '(88,42)'
+ Width = 57.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 4
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object ColumnPositionsM: TMemo
+ Position.Point = '(88,66)'
+ Width = 113.000000000000000000
+ Height = 71.000000000000000000
+ TabOrder = 5
+ KeyboardType = vktDefault
+ end
+ object ColumnsNumberS: TSpinBox
+ Position.Point = '(88,16)'
+ Width = 57.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 6
+ KeyboardType = vktDefault
+ OnChange = ColumnsNumberSChange
+ Max = 10.000000000000000000
+ Increment = 1.000000000000000000
+ end
+ end
+ end
+ end
+end
diff --git a/LibD28x64/FMX.frxEditPage.pas b/LibD28x64/FMX.frxEditPage.pas
new file mode 100644
index 0000000..8fc485e
--- /dev/null
+++ b/LibD28x64/FMX.frxEditPage.pas
@@ -0,0 +1,375 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Page options }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditPage;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Types, FMX.Objects, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.ExtCtrls, FMX.frxCtrls, FMX.TabControl, FMX.LIstBox, FMX.Edit, Fmx.Memo, FMX.frxFMX
+, System.Variants, FMX.Layouts
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI21}
+ ,FMX.SpinBox
+{$ENDIF};
+
+
+type
+{$IFDEF LINUX}
+ TfrxPageEditorForm = class(TfrxForm)
+{$ELSE}
+ TfrxPageEditorForm = class(TForm)
+{$ENDIF}
+ OKB: TButton;
+ CancelB: TButton;
+ TabControl1: TTabControl;
+ TabSheet1: TTabItem;
+ TabSheet3: TTabItem;
+ Label11: TGroupBox;
+ Label1: TLabel;
+ Label2: TLabel;
+ UnitL1: TLabel;
+ UnitL2: TLabel;
+ WidthE: TEdit;
+ HeightE: TEdit;
+ SizeCB: TComboBox;
+ Label12: TGroupBox;
+ PortraitImg: TImage;
+ LandscapeImg: TImage;
+ PortraitRB: TRadioButton;
+ LandscapeRB: TRadioButton;
+ Label13: TGroupBox;
+ Label3: TLabel;
+ Label4: TLabel;
+ Label5: TLabel;
+ Label6: TLabel;
+ UnitL3: TLabel;
+ UnitL4: TLabel;
+ UnitL5: TLabel;
+ UnitL6: TLabel;
+ MarginLeftE: TEdit;
+ MarginTopE: TEdit;
+ MarginRightE: TEdit;
+ MarginBottomE: TEdit;
+ Label14: TGroupBox;
+ Label9: TLabel;
+ Label10: TLabel;
+ Tray1CB: TComboBox;
+ Tray2CB: TComboBox;
+ Label17: TGroupBox;
+ Label18: TLabel;
+ PrintOnPrevCB: TCheckBox;
+ MirrorMarginsCB: TCheckBox;
+ LargeHeightCB: TCheckBox;
+ DuplexCB: TComboBox;
+ EndlessWidthCB: TCheckBox;
+ EndlessHeightCB: TCheckBox;
+ Label7: TGroupBox;
+ Label8: TLabel;
+ Label15: TLabel;
+ Label16: TLabel;
+ UnitL7: TLabel;
+ ColumnWidthE: TEdit;
+ ColumnPositionsM: TMemo;
+ ColumnsNumberS: TSpinBox;
+ procedure PortraitRBClick(Sender: TObject);
+ procedure SizeCBClick(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure WidthEChange(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure ColumnsNumberSChange(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ { Private declarations }
+ FUpdating: Boolean;
+ public
+ { Public declarations }
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.Printer, FMX.frxPrinter, FMX.frxClass, FMX.frxUtils, FMX.frxDesgn, FMX.frxRes;
+
+
+procedure TfrxPageEditorForm.FormShow(Sender: TObject);
+var
+ i: Integer;
+ p: TfrxReportPage;
+begin
+ FUpdating := True;
+ SizeCB.OnChange := SizeCBClick;
+ with frxPrinters.Printer, TfrxDesignerForm(Owner) do
+ begin
+ p := TfrxReportPage(Page);
+
+ SizeCB.Items := Papers;
+ i := PaperIndex(p.PaperSize);
+ if i = -1 then
+ i := PaperIndex(256);
+ SizeCB.ItemIndex := i;
+
+ WidthE.Text := frxFloatToStr(mmToUnits(p.PaperWidth));
+ HeightE.Text := frxFloatToStr(mmToUnits(p.PaperHeight, False));
+ PortraitRB.IsChecked := p.Orientation = TPrinterOrientation.poPortrait;
+ LandscapeRB.IsChecked := p.Orientation = TPrinterOrientation.poLandscape;
+
+ MarginLeftE.Text := frxFloatToStr(mmToUnits(p.LeftMargin));
+ MarginRightE.Text := frxFloatToStr(mmToUnits(p.RightMargin));
+ MarginTopE.Text := frxFloatToStr(mmToUnits(p.TopMargin, False));
+ MarginBottomE.Text := frxFloatToStr(mmToUnits(p.BottomMargin, False));
+
+ Tray1CB.Items := Bins;
+ Tray2CB.Items := Tray1CB.Items;
+ i := BinIndex(p.Bin);
+ if i = -1 then
+ i := BinIndex(DMBIN_AUTO);
+ Tray1CB.ItemIndex := i;
+ i := BinIndex(p.BinOtherPages);
+ if i = -1 then
+ i := BinIndex(DMBIN_AUTO);
+ Tray2CB.ItemIndex := i;
+
+ ColumnsNumberS.Text := IntToStr(p.Columns);
+ ColumnWidthE.Text := frxFloatToStr(mmToUnits(p.ColumnWidth));
+ for i := 0 to p.ColumnPositions.Count - 1 do
+ ColumnPositionsM.Lines.Add(frxFloatToStr(mmToUnits(frxStrToFloat(p.ColumnPositions[i]))));
+ PrintOnPrevCB.IsChecked := p.PrintOnPreviousPage;
+ MirrorMarginsCB.IsChecked := p.MirrorMargins;
+ EndlessHeightCB.IsChecked := p.EndlessHeight;
+ EndlessWidthCB.IsChecked := p.EndlessWidth;
+ LargeHeightCB.IsChecked := p.LargeDesignHeight;
+ DuplexCB.ItemIndex := Integer(p.Duplex);
+ end;
+
+ PortraitRBClick(nil);
+ FUpdating := False;
+end;
+
+procedure TfrxPageEditorForm.PortraitRBClick(Sender: TObject);
+begin
+ PortraitImg.Visible := PortraitRB.IsChecked;
+ LandscapeImg.Visible := LandscapeRB.IsChecked;
+ SizeCBClick(nil);
+end;
+
+procedure TfrxPageEditorForm.SizeCBClick(Sender: TObject);
+var
+ pOr: TPrinterOrientation;
+ pNumber: Integer;
+ pWidth, pHeight: Extended;
+begin
+ if FUpdating then Exit;
+ FUpdating := True;
+
+ with frxPrinters.Printer, TfrxDesignerForm(Owner) do
+ begin
+ pNumber := PaperNameToNumber(SizeCB.Selected.Text);
+ pWidth := UnitsTomm(frxStrToFloat(WidthE.Text));
+ pHeight := UnitsTomm(frxStrToFloat(HeightE.Text), False);
+ if not PortraitRB.IsChecked then
+ pOr := poPortrait else
+ pOr := poLandscape;
+
+ if pNumber = 256 then
+ SetViewParams(pNumber, pHeight, pWidth, pOr) else
+ SetViewParams(pNumber, pWidth, pHeight, pOr);
+
+ if frxPrinters.Printer.Orientation = poPortrait then
+ PortraitRB.IsChecked := True
+ else
+ LandscapeRB.IsChecked := True;
+
+ WidthE.Text := frxFloatToStr(mmToUnits(PaperWidth));
+ HeightE.Text := frxFloatToStr(mmToUnits(PaperHeight, False));
+ end;
+
+ FUpdating := False;
+end;
+
+procedure TfrxPageEditorForm.ColumnsNumberSChange(Sender: TObject);
+var
+ n: Integer;
+ w: Extended;
+begin
+ if FUpdating then Exit;
+
+ n := StrToInt(ColumnsNumberS.Text);
+ if n = 0 then
+ n := 1;
+
+ with TfrxDesignerForm(Owner) do
+ begin
+ w := (UnitsTomm(frxStrToFloat(WidthE.Text)) -
+ UnitsTomm(frxStrToFloat(MarginLeftE.Text)) -
+ UnitsTomm(frxStrToFloat(MarginRightE.Text))) / n;
+ ColumnWidthE.Text := frxFloatToStr(mmToUnits(w));
+
+ with ColumnPositionsM.Lines do
+ begin
+ Clear;
+ while Count < n do
+ Add(frxFloatToStr(mmToUnits(Count * w)));
+ end;
+ end;
+end;
+
+
+procedure TfrxPageEditorForm.WidthEChange(Sender: TObject);
+begin
+ if not FUpdating then
+ SizeCB.ItemIndex := 0;
+end;
+
+procedure TfrxPageEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+var
+ p: TfrxReportPage;
+ i: Integer;
+ c: TfrxReportComponent;
+
+ procedure ChangePage(p: TfrxReportPage);
+ var
+ i: Integer;
+ begin
+ with frxPrinters.Printer, TfrxDesignerForm(Owner) do
+ begin
+ if PortraitRB.IsChecked then
+ p.Orientation := TPrinterOrientation.poPortrait else
+ p.Orientation := TPrinterOrientation.poLandscape;
+
+ p.SetSizeAndDimensions(PaperNameToNumber(SizeCB.Selected.Text),
+ UnitsTomm(frxStrToFloat(WidthE.Text)),
+ UnitsTomm(frxStrToFloat(HeightE.Text), False));
+
+ p.LeftMargin := UnitsTomm(frxStrToFloat(MarginLeftE.Text));
+ p.RightMargin := UnitsTomm(frxStrToFloat(MarginRightE.Text));
+ p.TopMargin := UnitsTomm(frxStrToFloat(MarginTopE.Text), False);
+ p.BottomMargin := UnitsTomm(frxStrToFloat(MarginBottomE.Text), False);
+
+ p.Bin := BinNameToNumber(Tray1CB.Selected.Text);
+ p.BinOtherPages := BinNameToNumber(Tray2CB.Selected.Text);
+
+ p.Columns := StrToInt(ColumnsNumberS.Text);
+ p.ColumnWidth := UnitsTomm(frxStrToFloat(ColumnWidthE.Text));
+ p.ColumnPositions.Clear;
+ for i := 0 to ColumnPositionsM.Lines.Count - 1 do
+ p.ColumnPositions.Add(frxFloatToStr(UnitsTomm(frxStrToFloat(ColumnPositionsM.Lines[i]))));
+ p.PrintOnPreviousPage := PrintOnPrevCB.IsChecked;
+ p.MirrorMargins := MirrorMarginsCB.IsChecked;
+ p.EndlessWidth := EndlessWidthCB.IsChecked;
+ p.EndlessHeight := EndlessHeightCB.IsChecked;
+ p.LargeDesignHeight := LargeHeightCB.IsChecked;
+ p.Duplex := TfrxDuplexMode(DuplexCB.ItemIndex);
+ end;
+ end;
+
+begin
+ if ModalResult = mrOk then
+ begin
+ p := TfrxReportPage(TfrxDesignerForm(Owner).Page);
+ ChangePage(p);
+
+ { change all subreport pages }
+ for i := 0 to p.AllObjects.Count - 1 do
+ begin
+ c := p.AllObjects[i];
+ if c is TfrxSubreport then
+ ChangePage(TfrxSubreport(c).Page);
+ end;
+ end;
+
+end;
+
+procedure TfrxPageEditorForm.FormCreate(Sender: TObject);
+var
+ uStr: String;
+begin
+ Caption := frxGet(2700);
+ OKB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ TabSheet1.Text := frxGet(2701);
+ Label1.Text := frxGet(2702);
+ Label2.Text := frxGet(2703);
+ Label11.Text := frxGet(2704);
+ Label12.Text := frxGet(2705);
+ Label3.Text := frxGet(2706);
+ Label4.Text := frxGet(2707);
+ Label5.Text := frxGet(2708);
+ Label6.Text := frxGet(2709);
+ Label13.Text := frxGet(2710);
+ Label14.Text := frxGet(2711);
+ Label9.Text := frxGet(2712);
+ Label10.Text := frxGet(2713);
+ PortraitRB.Text := frxGet(2714);
+ LandscapeRB.Text := frxGet(2715);
+ TabSheet3.Text := frxGet(2716);
+ Label7.Text := frxGet(2717);
+ Label8.Text := frxGet(2718);
+ Label15.Text := frxGet(2719);
+ Label16.Text := frxGet(2720);
+ Label17.Text := frxGet(2721);
+ Label18.Text := frxGet(2722);
+ PrintOnPrevCB.Text := frxGet(2723);
+ MirrorMarginsCB.Text := frxGet(2724);
+ LargeHeightCB.Text := frxGet(2725);
+ EndlessWidthCB.Text := frxGet(2726);
+ EndlessHeightCB.Text := frxGet(2727);
+{$IFDEF DELPHI23}
+ DuplexCB.Clear;
+{$ELSE}
+ DuplexCB.Items.Clear;
+{$ENDIF}
+ DuplexCB.Items.Add(frxResources.Get('dupDefault'));
+ DuplexCB.Items.Add(frxResources.Get('dupVert'));
+ DuplexCB.Items.Add(frxResources.Get('dupHorz'));
+ DuplexCB.Items.Add(frxResources.Get('dupSimpl'));
+
+ uStr := '';
+ case TfrxDesignerForm(Owner).Units of
+ duCM: uStr := frxResources.Get('uCm');
+ duInches: uStr := frxResources.Get('uInch');
+ duPixels: uStr := frxResources.Get('uPix');
+ duChars: uStr := frxResources.Get('uChar');
+ end;
+
+ UnitL1.Text := uStr;
+ UnitL2.Text := uStr;
+ UnitL3.Text := uStr;
+ UnitL4.Text := uStr;
+ UnitL5.Text := uStr;
+ UnitL6.Text := uStr;
+ UnitL7.Text := uStr;
+ FormShow(Self);
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxPageEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+end.
+
diff --git a/LibD28x64/FMX.frxEditPicture.fmx b/LibD28x64/FMX.frxEditPicture.fmx
new file mode 100644
index 0000000..a7348a5
--- /dev/null
+++ b/LibD28x64/FMX.frxEditPicture.fmx
@@ -0,0 +1,78 @@
+object frxPictureEditorForm: TfrxPictureEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Picture'
+ ClientHeight = 307
+ ClientWidth = 336
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnActivate = FormActivate
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object ToolBar: TToolBar
+ Width = 336.000000000000000000
+ Height = 31.000000000000000000
+ TabOrder = 0
+ object LoadB: TfrxToolButton
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = LoadBClick
+ TabOrder = 0
+ end
+ object CopyB: TfrxToolButton
+ Position.Point = '(23,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = CopyBClick
+ TabOrder = 1
+ end
+ object PasteB: TfrxToolButton
+ Position.Point = '(46,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = PasteBClick
+ TabOrder = 2
+ end
+ object ClearB: TfrxToolButton
+ Position.Point = '(69,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = ClearBClick
+ TabOrder = 3
+ end
+ object CancelB: TfrxToolButton
+ Position.Point = '(102,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = CancelBClick
+ TabOrder = 4
+ end
+ object OkB: TfrxToolButton
+ Position.Point = '(125,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = OkBClick
+ TabOrder = 5
+ end
+ end
+ object Box: TScrollBox
+ Align = alClient
+ Position.Point = '(0,31)'
+ Width = 336.000000000000000000
+ Height = 257.000000000000000000
+ TabOrder = 1
+ object Image: TImage
+ Position.Point = '(4,4)'
+ Width = 325.000000000000000000
+ Height = 241.000000000000000000
+ end
+ end
+ object StatusBar: TStatusBar
+ Position.Point = '(0,288)'
+ Width = 336.000000000000000000
+ Height = 19.000000000000000000
+ TabOrder = 2
+ ShowSizeGrip = True
+ end
+end
diff --git a/LibD28x64/FMX.frxEditPicture.pas b/LibD28x64/FMX.frxEditPicture.pas
new file mode 100644
index 0000000..9198afa
--- /dev/null
+++ b/LibD28x64/FMX.frxEditPicture.pas
@@ -0,0 +1,194 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Picture editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditPicture;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Controls,
+ FMX.Forms, FMX.Dialogs, FMX.ExtCtrls, FMX.frxCtrls, FMX.frxBaseModalForm,
+ FMX.Objects, FMX.Layouts, FMX.Types, FMX.frxFMX, System.Variants
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+
+type
+ TfrxPictureEditorForm = class(TfrxForm)
+ ToolBar: TToolBar;
+ LoadB: TfrxToolButton;
+ ClearB: TfrxToolButton;
+ OkB: TfrxToolButton;
+ Box: TScrollBox;
+ CancelB: TfrxToolButton;
+ Image: TImage;
+ StatusBar: TStatusBar;
+ CopyB: TfrxToolButton;
+ PasteB: TfrxToolButton;
+ procedure ClearBClick(Sender: TObject);
+ procedure LoadBClick(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure OkBClick(Sender: TObject);
+ procedure CancelBClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure CopyBClick(Sender: TObject);
+ procedure PasteBClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormActivate(Sender: TObject);
+ private
+ //FStatusBarOldWindowProc: TWndMethod;
+ //procedure StatusBarWndProc(var Message: TMessage);
+ { Private declarations }
+ procedure UpdateImage;
+ public
+ { Public declarations }
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxClass, FMX.frxUtils, FMX.frxRes, FMX.Platform ;
+
+
+{ TfrxPictureEditorForm }
+
+procedure TfrxPictureEditorForm.UpdateImage;
+begin
+// if (Image.Bitmap = nil) or Image.Bitmap.IsEmpty then
+// StatusBar.Panels[0].Text := frxResources.Get('piEmpty')
+// else
+// begin
+// StatusBar. Panels[0].Text := Format('%d x %d',
+// [Image.Picture.Width, Image.Picture.Height]);
+// Image.Stretch := (Image.Picture.Width > Image.Width) or
+// (Image.Picture.Height > Image.Height);
+// end;
+end;
+
+procedure TfrxPictureEditorForm.FormShow(Sender: TObject);
+begin
+ //Toolbar.Images := frxResources.MainButtonImages;
+
+
+end;
+
+procedure TfrxPictureEditorForm.ClearBClick(Sender: TObject);
+begin
+ Image.Bitmap.Assign(nil);
+ UpdateImage;
+end;
+
+procedure TfrxPictureEditorForm.LoadBClick(Sender: TObject);
+var
+ OpenDlg: TOpenDialog;
+begin
+ OpenDlg := TOpenDialog.Create(nil);
+ OpenDlg.Options := [];
+ OpenDlg.Filter := frxResources.Get('ftPictures') + ' (*.bmp ' +
+{$IFDEF JPEG}
+ '*.jpg ' +
+{$ENDIF}
+{$IFDEF PNG}
+ '*.png ' +
+{$ENDIF}
+ '*.ico *.wmf *.emf)|*.bmp;' +
+{$IFDEF JPEG}
+ '*.jpg;' +
+{$ENDIF}
+{$IFDEF PNG}
+ '*.png;' +
+{$ENDIF}
+ '*.ico;*.wmf;*.emf|' + frxResources.Get('ftAllFiles') + '|*.*';
+ if OpenDlg.Execute then
+ Image.Bitmap.LoadFromFile(OpenDlg.FileName);
+ PeekLastModalResult;
+ OpenDlg.Free;
+ UpdateImage;
+end;
+
+procedure TfrxPictureEditorForm.OkBClick(Sender: TObject);
+begin
+ ModalResult := mrOk;
+end;
+
+procedure TfrxPictureEditorForm.CancelBClick(Sender: TObject);
+begin
+ ModalResult := mrCancel;
+end;
+
+procedure TfrxPictureEditorForm.FormActivate(Sender: TObject);
+begin
+ UpdateImage;
+end;
+
+procedure TfrxPictureEditorForm.FormCreate(Sender: TObject);
+begin
+ //FStatusBarOldWindowProc := StatusBar.WindowProc;
+ //StatusBar.WindowProc := StatusBarWndProc;
+ Caption := frxGet(4000);
+ LoadB.Hint := frxGet(4001);
+ CopyB.Hint := frxGet(4002);
+ PasteB.Hint := frxGet(4003);
+ ClearB.Hint := frxGet(4004);
+ CancelB.Hint := frxGet(2);
+ OkB.Hint := frxGet(1);
+ frxResources.LoadImageFromResouce(OkB.Bitmap, 21, 0);
+ frxResources.LoadImageFromResouce(CancelB.Bitmap, 21, 2);
+ frxResources.LoadImageFromResouce(ClearB.Bitmap, 8, 2);
+ frxResources.LoadImageFromResouce(PasteB.Bitmap, 0, 7);
+ frxResources.LoadImageFromResouce(CopyB.Bitmap, 0, 6);
+ frxResources.LoadImageFromResouce(LoadB.Bitmap, 0, 1);
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxPictureEditorForm.CopyBClick(Sender: TObject);
+begin
+ //if Image.Bitmap <> nil then
+ //Platform.SetClipboard();
+ // Clipboard.Assign(Image.Picture);
+ //todo Platform.SetClipboard support only trxt clipboard
+end;
+
+procedure TfrxPictureEditorForm.PasteBClick(Sender: TObject);
+begin
+// if Clipboard.HasFormat(CF_BITMAP) or Clipboard.HasFormat(CF_METAFILEPICT) or
+// Clipboard.HasFormat(CF_PICTURE) then
+// begin
+// Image.Picture.Assign(Clipboard);
+// UpdateImage;
+// end
+// else
+// ShowMessage(frxResources.Get('erInvalidImg'));
+end;
+
+procedure TfrxPictureEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+//procedure TfrxPictureEditorForm.StatusBarWndProc(var Message: TMessage);
+//begin
+// if Message.Msg = WM_SYSCOLORCHANGE then
+// DefWindowProc(StatusBar.Handle,Message.Msg,Message.WParam,Message.LParam)
+// else
+// FStatusBarOldWindowProc(Message);
+//end;
+
+end.
+
diff --git a/LibD28x64/FMX.frxEditQueryParams.fmx b/LibD28x64/FMX.frxEditQueryParams.fmx
new file mode 100644
index 0000000..de2aebc
--- /dev/null
+++ b/LibD28x64/FMX.frxEditQueryParams.fmx
@@ -0,0 +1,65 @@
+object frxParamsEditorForm: TfrxParamsEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Parameters editor'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 381
+ ClientWidth = 392
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object OkB: TButton
+ Position.Point = '(232,348)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = OkBClick
+ TabOrder = 0
+ ModalResult = 1
+ end
+ object CancelB: TButton
+ Position.Point = '(312,348)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object ParamGrid: TStringGrid
+ Position.Point = '(8,8)'
+ Width = 377.000000000000000000
+ Height = 329.000000000000000000
+ OnResize = ParamGridResize
+ StyleLookup = 'gridstyle'
+ TabOrder = 2
+ RowHeight = 21.000000000000000000
+ OnSelChanged = ParamGridResize
+ RowCount = 100
+ end
+ object TypeCB: TComboBox
+ Position.Point = '(104,23)'
+ Width = 84.000000000000000000
+ Height = 19.000000000000000000
+ Visible = False
+ TabOrder = 3
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ ListBoxResource = 'transparentlistboxstyle'
+ OnChange = TypeCBChange
+ end
+ object ButtonPanel: TPanel
+ Position.Point = '(360,24)'
+ Width = 17.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 4
+ object ExpressionB: TSpeedButton
+ Width = 17.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = ValueEButtonClick
+ Text = '...'
+ end
+ end
+end
diff --git a/LibD28x64/FMX.frxEditQueryParams.pas b/LibD28x64/FMX.frxEditQueryParams.pas
new file mode 100644
index 0000000..7f0ad89
--- /dev/null
+++ b/LibD28x64/FMX.frxEditQueryParams.pas
@@ -0,0 +1,265 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ Query params editor }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditQueryParams;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Types, FMX.Controls, FMX.Forms,
+ Data.DB, FMX.frxCustomDB, FMX.frxCtrls, System.Rtti, System.UITypes
+, System.Variants, FMX.Edit, FMX.ListBox, FMX.Layouts, FMX.Grid, System.Types
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI24}
+ ,FMX.Grid.Style
+{$ENDIF}
+;
+
+
+type
+ THackStringGrid = class(TStringGrid);
+ TfrxParamsEditorForm = class(TForm)
+ TypeCB: TComboBox;
+ OkB: TButton;
+ CancelB: TButton;
+ ButtonPanel: TPanel;
+ ExpressionB: TSpeedButton;
+ ParamGrid: TStringGrid;
+ procedure FormShow(Sender: TObject);
+ procedure OkBClick(Sender: TObject);
+ procedure FormHide(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure ValueEButtonClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure TypeCBChange(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure ParamGridResize(Sender: TObject);
+ private
+ FParams: TfrxParams;
+ procedure ParamGridDragOver(Sender: TObject; const Data: TDragObject;
+ const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+ procedure ParamGridMouseUp(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Single);
+ public
+ property Params: TfrxParams read FParams write FParams;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxClass, FMX.frxRes, FMX.frxFMX;
+
+{ TfrxParamEditorForm }
+
+procedure TfrxParamsEditorForm.FormShow(Sender: TObject);
+var
+ i, NameColumn, dTypeColumn, ExpColumn: Integer;
+ t: TFieldType;
+begin
+ // in case column was moved
+
+ ExpColumn := 2;
+ dTypeColumn := 1;
+ NameColumn := 0;
+ for i := 0 to ParamGrid.ColumnCount - 1 do
+ case ParamGrid.Columns[i].Tag of
+ 1: NameColumn := ParamGrid.Columns[i].Index;
+ 2: dTypeColumn := ParamGrid.Columns[i].Index;
+ 3: ExpColumn := ParamGrid.Columns[i].Index;
+ end;
+
+ ParamGrid.RowCount := Params.Count;
+ ParamGrid.BeginUpdate;
+ for i := 0 to Params.Count - 1 do
+ begin
+ ParamGrid.Cells[NameColumn, i] := Params[i].Name;
+ ParamGrid.Cells[dTypeColumn, i] := FieldTypeNames[Params[i].DataType];
+ ParamGrid.Cells[ExpColumn, i] := Params[i].Expression;
+ end;
+ ParamGrid.EndUpdate;
+ for t := Low(TFieldType) to High(TFieldType) do
+ TypeCB.Items.Add(FieldTypeNames[t]);
+
+ ButtonPanel.Height := TypeCB.Height - 2;
+ ExpressionB.Height := TypeCB.Height - 2;
+ ButtonPanel.Visible := False;
+ TypeCB.Visible := False;
+end;
+
+procedure TfrxParamsEditorForm.FormHide(Sender: TObject);
+var
+ i, dTypeColumn, ExpColumn: Integer;
+ t: TFieldType;
+begin
+ if ModalResult <> mrOk then Exit;
+ ExpColumn := 2;
+ dTypeColumn := 1;
+ // in case column was moved
+ for i := 0 to ParamGrid.ColumnCount - 1 do
+ case ParamGrid.Columns[i].Tag of
+ 2: dTypeColumn := ParamGrid.Columns[i].Index;
+ 3: ExpColumn := ParamGrid.Columns[i].Index;
+ end;
+
+ for i := 0 to ParamGrid.RowCount - 1 do
+ begin
+ for t := Low(TFieldType) to High(TFieldType) do
+ if ParamGrid.Cells[dTypeColumn, i] = FieldTypeNames[t] then
+ begin
+ Params[i].DataType := t;
+ break;
+ end;
+ Params[i].Expression := ParamGrid.Cells[ExpColumn, i];
+ end;
+end;
+
+procedure TfrxParamsEditorForm.ParamGridDragOver(Sender: TObject;
+ const Data: TDragObject; const Point: TPointF; {$IFNDEF DELPHI20}var Accept: Boolean{$ELSE} var Operation: TDragOperation{$ENDIF});
+begin
+ ParamGridResize(nil);
+end;
+
+procedure TfrxParamsEditorForm.ParamGridMouseUp(Sender: TObject;
+ Button: TMouseButton; Shift: TShiftState; X, Y: Single);
+var
+ C: TColumn;
+ RowIndex, i: Integer;
+begin
+ TypeCB.Visible := False;
+ ButtonPanel.Visible := False;
+ C := ParamGrid.ColumnByPoint(X, Y);
+ if C <> nil then
+ begin
+ if C.Tag = 2 then
+ begin
+ TypeCB.Position.X := C.Position.X + ParamGrid.Position.X + 2;
+ RowIndex := ParamGrid.RowByPoint(X, Y);
+ if RowIndex > ParamGrid.RowCount - 1 then Exit;
+ i := TypeCB.Items.IndexOf(ParamGrid.Cells[C.Index, RowIndex]);
+ if i <> -1 then
+ TypeCB.ListItems[i].IsSelected := True
+ else
+ TypeCB.ListItems[0].IsSelected := True;
+ TypeCB.Position.Y := RowIndex * ParamGrid.RowHeight + ParamGrid.Position.Y + ParamGrid.RowHeight + 3;
+ TypeCB.Width := C.Width;
+ TypeCB.Visible := True;
+ end
+ else
+ if C.Tag = 3 then
+ begin
+ ButtonPanel.Visible := True;
+ ButtonPanel.Position.X := C.Position.X + ParamGrid.Position.X + C.Width - ButtonPanel.Width - 2;
+ RowIndex := ParamGrid.RowByPoint(X, Y);
+ if RowIndex > ParamGrid.RowCount - 1 then Exit;
+
+ ButtonPanel.Position.Y := RowIndex * ParamGrid.RowHeight + ParamGrid.Position.Y + ParamGrid.RowHeight + 3;
+ ButtonPanel.Visible := True;
+ end;
+ end;
+end;
+
+
+procedure TfrxParamsEditorForm.ParamGridResize(Sender: TObject);
+begin
+ TypeCB.Visible := False;
+ ButtonPanel.Visible := False;
+end;
+
+procedure TfrxParamsEditorForm.TypeCBChange(Sender: TObject);
+begin
+ if TypeCB.Selected <> nil then
+ ParamGrid.Cells[ParamGrid.ColumnIndex, ParamGrid.Selected] := TypeCB.Selected.Text;
+end;
+
+procedure TfrxParamsEditorForm.OkBClick(Sender: TObject);
+begin
+// ParamsLV.Selected := ParamsLV.Items[0];
+end;
+
+procedure TfrxParamsEditorForm.ValueEButtonClick(Sender: TObject);
+var
+ s: String;
+begin
+ s := TfrxCustomDesigner(Owner).InsertExpression(ParamGrid.Cells[ParamGrid.ColumnIndex, ParamGrid.Selected]);
+ if s <> '' then
+ ParamGrid.Cells[ParamGrid.ColumnIndex, ParamGrid.Selected] := s;
+end;
+
+procedure TfrxParamsEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ FormHide(Self);
+end;
+
+procedure TfrxParamsEditorForm.FormCreate(Sender: TObject);
+var
+ SColumn: TStringColumn;
+begin
+
+ Caption := frxGet(3700);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ ParamGrid.BeginUpdate;
+
+ ParamGrid.RowCount := 0;
+
+ SColumn := TStringColumn.Create(ParamGrid);
+ SColumn.Header := frxResources.Get('qpName');
+ SColumn.ReadOnly := True;
+ SColumn.Tag := 1;
+ SColumn.OnResize := ParamGridResize;
+ SColumn.OnDragEnd := ParamGridResize;
+ SColumn.OnDragOver := ParamGridDragOver;
+ ParamGrid.AddObject(SColumn);
+
+ SColumn := TStringColumn.Create(ParamGrid);
+ SColumn.Header := frxResources.Get('qpDataType');
+ SColumn.ReadOnly := True;
+ SColumn.Tag := 2;
+ SColumn.OnResize := ParamGridResize;
+ SColumn.OnDragEnd := ParamGridResize;
+ SColumn.OnDragOver := ParamGridDragOver;
+ ParamGrid.AddObject(SColumn);
+
+ SColumn := TStringColumn.Create(ParamGrid);
+ SColumn.Header := frxResources.Get('qpValue');
+ SColumn.ReadOnly := False;
+ SColumn.OnResize := ParamGridResize;
+ SColumn.OnDragEnd := ParamGridResize;
+ SColumn.OnDragOver := ParamGridDragOver;
+ SColumn.Tag := 3;
+ ParamGrid.AddObject(SColumn);
+ ParamGrid.OnMouseUp := ParamGridMouseUp;
+ ParamGrid.OnDragOver := ParamGridDragOver;
+ ParamGrid.OnDragEnd := ParamGridResize;
+{$IFDEF DELPHI20}
+ ParamGrid.Options := ParamGrid.Options + [TGridOption.AlternatingRowBackground];
+{$ELSE}
+ ParamGrid.AlternatingRowBackground := True;
+{$ENDIF}
+ ParamGrid.EndUpdate;
+
+end;
+
+procedure TfrxParamsEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VK_F1 then
+ frxResources.Help(Self);
+end;
+
+end.
diff --git a/LibD28x64/FMX.frxEditReport.fmx b/LibD28x64/FMX.frxEditReport.fmx
new file mode 100644
index 0000000..670709f
--- /dev/null
+++ b/LibD28x64/FMX.frxEditReport.fmx
@@ -0,0 +1,350 @@
+object frxReportEditorForm: TfrxReportEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Report settings'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 418
+ ClientWidth = 416
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object OkB: TButton
+ Position.Point = '(254,340)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(334,340)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object PageControl: TTabControl
+ Position.Point = '(8,16)'
+ Width = 401.000000000000000000
+ Height = 321.000000000000000000
+ TabOrder = 2
+ TabIndex = 2
+ TabHeight = 20.000000000000000000
+ object GeneralTS: TTabItem
+ Width = 80.000000000000000000
+ Height = 20.000000000000000000
+ TabOrder = 0
+ Index = 0
+ Text = 'GeneralTS'
+ WordWrap = False
+ object GeneralL: TGroupBox
+ Position.Point = '(4,200)'
+ Width = 389.000000000000000000
+ Height = 93.000000000000000000
+ TabOrder = 0
+ object PasswordL: TLabel
+ Position.Point = '(186,19)'
+ Width = 73.000000000000000000
+ Height = 15.000000000000000000
+ TabOrder = 0
+ end
+ object DoublePassCB: TCheckBox
+ Position.Point = '(8,20)'
+ Width = 169.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ object PrintIfEmptyCB: TCheckBox
+ Position.Point = '(8,44)'
+ Width = 169.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object PasswordE: TEdit
+ Position.Point = '(268,16)'
+ Width = 109.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 3
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+ object ReportSettingsL: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 389.000000000000000000
+ Height = 193.000000000000000000
+ TabOrder = 1
+ object CopiesL: TLabel
+ Position.Point = '(16,164)'
+ Width = 47.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object PrintersLB: TListBox
+ Position.Point = '(12,18)'
+ Width = 365.000000000000000000
+ Height = 135.000000000000000000
+ TabOrder = 1
+ ItemHeight = 16.000000000000000000
+ end
+ object CopiesE: TEdit
+ Position.Point = '(68,160)'
+ Width = 37.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 2
+ KeyboardType = vktDefault
+ Password = False
+ Text = '1'
+ end
+ object CollateCB: TCheckBox
+ Position.Point = '(116,162)'
+ Width = 189.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ end
+ end
+ object DescriptionTS: TTabItem
+ Width = 80.000000000000000000
+ Height = 20.000000000000000000
+ TabOrder = 1
+ Index = 1
+ Text = 'DescriptionTS'
+ WordWrap = False
+ object DescriptionL: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 389.000000000000000000
+ Height = 213.000000000000000000
+ TabOrder = 0
+ object NameL: TLabel
+ Position.Point = '(8,20)'
+ Width = 73.000000000000000000
+ Height = 15.000000000000000000
+ TabOrder = 0
+ end
+ object PictureImg: TImage
+ Position.Point = '(88,124)'
+ Width = 81.000000000000000000
+ Height = 69.000000000000000000
+ end
+ object Description1L: TLabel
+ Position.Point = '(8,68)'
+ Width = 73.000000000000000000
+ Height = 22.000000000000000000
+ TabOrder = 2
+ end
+ object PictureL: TLabel
+ Position.Point = '(8,120)'
+ Width = 65.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 3
+ end
+ object AuthorL: TLabel
+ Position.Point = '(8,44)'
+ Width = 73.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 4
+ end
+ object NameE: TEdit
+ Position.Point = '(88,18)'
+ Width = 289.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 5
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object DescriptionE: TMemo
+ Position.Point = '(88,66)'
+ Width = 289.000000000000000000
+ Height = 47.000000000000000000
+ TabOrder = 6
+ KeyboardType = vktDefault
+ end
+ object PictureB: TButton
+ Position.Point = '(180,120)'
+ Width = 75.000000000000000000
+ Height = 21.000000000000000000
+ OnClick = PictureBClick
+ TabOrder = 7
+ end
+ object AuthorE: TEdit
+ Position.Point = '(88,42)'
+ Width = 289.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 8
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+ object VersionL: TGroupBox
+ Position.Point = '(4,220)'
+ Width = 389.000000000000000000
+ Height = 73.000000000000000000
+ TabOrder = 1
+ object MajorL: TLabel
+ Position.Point = '(8,21)'
+ Width = 41.000000000000000000
+ Height = 15.000000000000000000
+ TabOrder = 0
+ end
+ object MinorL: TLabel
+ Position.Point = '(100,20)'
+ Width = 40.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 1
+ end
+ object ReleaseL: TLabel
+ Position.Point = '(196,19)'
+ Width = 50.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object BuildL: TLabel
+ Position.Point = '(300,21)'
+ Width = 36.000000000000000000
+ Height = 15.000000000000000000
+ TabOrder = 3
+ end
+ object CreatedL: TLabel
+ Position.Point = '(8,46)'
+ Width = 65.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 4
+ end
+ object Created1L: TLabel
+ Position.Point = '(76,46)'
+ Width = 133.000000000000000000
+ Height = 19.000000000000000000
+ TabOrder = 5
+ end
+ object ModifiedL: TLabel
+ Position.Point = '(212,46)'
+ Width = 77.000000000000000000
+ Height = 19.000000000000000000
+ TabOrder = 6
+ end
+ object Modified1L: TLabel
+ Position.Point = '(276,46)'
+ Width = 109.000000000000000000
+ Height = 19.000000000000000000
+ TabOrder = 7
+ end
+ object MajorE: TEdit
+ Position.Point = '(52,18)'
+ Width = 37.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 8
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object MinorE: TEdit
+ Position.Point = '(144,18)'
+ Width = 37.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 9
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object ReleaseE: TEdit
+ Position.Point = '(252,18)'
+ Width = 37.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 10
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object BuildE: TEdit
+ Position.Point = '(340,18)'
+ Width = 37.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 11
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+ end
+ object InheritTS: TTabItem
+ Width = 80.000000000000000000
+ Height = 20.000000000000000000
+ TabOrder = 2
+ Index = 2
+ Text = 'InheritTS'
+ WordWrap = False
+ object InheritGB: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 389.000000000000000000
+ Height = 289.000000000000000000
+ TabOrder = 0
+ object InheritStateL: TLabel
+ Position.Point = '(8,20)'
+ Width = 233.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 0
+ end
+ object SelectL: TLabel
+ Position.Point = '(8,44)'
+ Width = 135.000000000000000000
+ Height = 16.000000000000000000
+ TabOrder = 1
+ end
+ object PathLB: TLabel
+ Position.Point = '(12,260)'
+ Width = 101.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 2
+ end
+ object DetachRB: TRadioButton
+ Position.Point = '(8,84)'
+ Width = 205.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ object InheritRB: TRadioButton
+ Position.Point = '(8,104)'
+ Width = 205.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 4
+ end
+ object DontChangeRB: TRadioButton
+ Position.Point = '(8,64)'
+ Width = 205.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 5
+ end
+ object PathE: TEdit
+ Position.Point = '(112,256)'
+ Width = 241.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 6
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object BrowseB: TButton
+ Position.Point = '(352,256)'
+ Width = 25.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = BrowseBClick
+ TabOrder = 7
+ Text = '...'
+ end
+ object InheritLV: TListBox
+ Position.Point = '(10,128)'
+ Width = 369.000000000000000000
+ Height = 121.000000000000000000
+ TabOrder = 8
+ Sorted = True
+ end
+ end
+ end
+ end
+ object OpenDialog1: TOpenDialog
+ Left = 300
+ Top = 192
+ end
+end
diff --git a/LibD28x64/FMX.frxEditReport.pas b/LibD28x64/FMX.frxEditReport.pas
new file mode 100644
index 0000000..0d23bc6
--- /dev/null
+++ b/LibD28x64/FMX.frxEditReport.pas
@@ -0,0 +1,348 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Report options }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditReport;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, System.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.ExtCtrls, FMX.frxCtrls, FMX.Memo, FMX.Objects, FMX.frxBaseModalForm,
+ FMX.Edit, FMX.Layouts, FMX.ListBox, FMX.Types, System.Variants, FMX.TabControl
+ {$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+
+type
+ TfrxReportEditorForm = class(TfrxForm)
+ OkB: TButton;
+ CancelB: TButton;
+ PageControl: TTabControl;
+ GeneralTS: TTabItem;
+ DescriptionTS: TTabItem;
+ InheritTS: TTabItem;
+ GeneralL: TGroupBox;
+ PasswordL: TLabel;
+ DoublePassCB: TCheckBox;
+ PrintIfEmptyCB: TCheckBox;
+ PasswordE: TEdit;
+ ReportSettingsL: TGroupBox;
+ CopiesL: TLabel;
+ PrintersLB: TListBox;
+ CopiesE: TEdit;
+ CollateCB: TCheckBox;
+ DescriptionL: TGroupBox;
+ NameL: TLabel;
+ PictureImg: TImage;
+ Description1L: TLabel;
+ PictureL: TLabel;
+ AuthorL: TLabel;
+ NameE: TEdit;
+ DescriptionE: TMemo;
+ PictureB: TButton;
+ AuthorE: TEdit;
+ VersionL: TGroupBox;
+ MajorL: TLabel;
+ MinorL: TLabel;
+ ReleaseL: TLabel;
+ BuildL: TLabel;
+ CreatedL: TLabel;
+ Created1L: TLabel;
+ ModifiedL: TLabel;
+ Modified1L: TLabel;
+ MajorE: TEdit;
+ MinorE: TEdit;
+ ReleaseE: TEdit;
+ BuildE: TEdit;
+ InheritGB: TGroupBox;
+ InheritStateL: TLabel;
+ SelectL: TLabel;
+ PathLB: TLabel;
+ DetachRB: TRadioButton;
+ InheritRB: TRadioButton;
+ DontChangeRB: TRadioButton;
+ PathE: TEdit;
+ BrowseB: TButton;
+ InheritLV: TListBox;
+ OpenDialog1: TOpenDialog;
+ procedure FormCreate(Sender: TObject);
+ procedure PictureBClick(Sender: TObject);
+ //procedure PrintersLBDrawItem(Control: TWinControl; Index: Integer;
+ // ARect: TRect; State: TOwnerDrawState);
+ procedure FormShow(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormDestroy(Sender: TObject);
+ procedure BrowseBClick(Sender: TObject);
+ procedure FillTemplatelist;
+ procedure PathEKeyPress(Sender: TObject; var Key: Char);
+ procedure PageControlChange(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ { Private declarations }
+ FTemplates: TStringList;
+ public
+ { Public declarations }
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses
+ System.IOUtils, FMX.frxDesgn, FMX.frxEditPicture, FMX.frxPrinter, FMX.frxUtils, FMX.frxRes, FMX.frxClass;
+
+
+procedure TfrxReportEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+//var
+// templ: String;
+begin
+ if ModalResult = mrOk then
+ with TfrxDesignerForm(Owner).Report do
+ begin
+ if PrintersLB.ItemIndex <> -1 then
+ begin
+ PrintOptions.Printer := PrintersLB.Items[PrintersLB.ItemIndex];
+ SelectPrinter;
+ end;
+ PrintOptions.Collate := CollateCB.IsChecked;
+ PrintOptions.Copies := StrToInt(CopiesE.Text);
+ EngineOptions.DoublePass := DoublePassCB.IsChecked;
+ EngineOptions.PrintIfEmpty := PrintIfEmptyCB.IsChecked;
+
+ if ReportOptions.HiddenPassword = '' then
+ ReportOptions.Password := PasswordE.Text;
+
+ if not DontChangeRB.IsChecked then
+ begin
+ Designer.Lock;
+ try
+ if DetachRB.IsChecked then
+ ParentReport := ''
+ else if InheritRB.IsChecked and (InheritLV.Selected <> nil) then
+ begin
+ ParentReport := '';
+ //templ := FTemplates[Integer(InheritLV.Selected.Data)];
+ InheritFromTemplate(InheritLV.Selected.Text{templ});
+ end;
+ finally
+ Designer.ReloadReport;
+ end;
+ end;
+
+ ReportOptions.Name := NameE.Text;
+ ReportOptions.Author := AuthorE.Text;
+ ReportOptions.Description.Text := DescriptionE.Lines.Text;
+ ReportOptions.Picture.Assign(PictureImg.Bitmap);
+ ReportOptions.VersionMajor := MajorE.Text;
+ ReportOptions.VersionMinor := MinorE.Text;
+ ReportOptions.VersionRelease := ReleaseE.Text;
+ ReportOptions.VersionBuild := BuildE.Text;
+ end;
+end;
+
+procedure TfrxReportEditorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(4700);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ GeneralTS.Text := frxGet(4701);
+ ReportSettingsL.Text := frxGet(4702);
+ CopiesL.Text := frxGet(4703);
+ GeneralL.Text := frxGet(4704);
+ PasswordL.Text := frxGet(4705);
+ CollateCB.Text := frxGet(4706);
+ DoublePassCB.Text := frxGet(4707);
+ PrintIfEmptyCB.Text := frxGet(4708);
+ DescriptionTS.Text := frxGet(4709);
+ NameL.Text := frxGet(4710);
+ Description1L.Text := frxGet(4711);
+ PictureL.Text := frxGet(4712);
+ AuthorL.Text := frxGet(4713);
+ MajorL.Text := frxGet(4714);
+ MinorL.Text := frxGet(4715);
+ ReleaseL.Text := frxGet(4716);
+ BuildL.Text := frxGet(4717);
+ CreatedL.Text := frxGet(4718);
+ ModifiedL.Text := frxGet(4719);
+ DescriptionL.Text := frxGet(4720);
+ VersionL.Text := frxGet(4721);
+ PictureB.Text := frxGet(4722);
+ InheritTS.Text := frxGet(4728);
+ InheritGB.Text := frxGet(4723);
+ SelectL.Text := frxGet(4724);
+ DontChangeRB.Text := frxGet(4725);
+ DetachRB.Text := frxGet(4726);
+ InheritRB.Text := frxGet(4727);
+ PathLB.Text := frxGet(4729);
+
+ //if Screen.PixelsPerInch > 96 then
+ // PrintersLB.ItemHeight := 19;
+ //InheritLV.LargeImages := frxResources.WizardImages;
+
+ FTemplates := TStringList.Create;
+ FTemplates.Sorted := True;
+ FormShow(Self);
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxReportEditorForm.FormDestroy(Sender: TObject);
+begin
+ FTemplates.Free;
+end;
+
+procedure TfrxReportEditorForm.FormShow(Sender: TObject);
+var
+ i: Integer;
+begin
+ with TfrxDesignerForm(Owner).Report do
+ begin
+ PrintersLB.Items.BeginUpdate;
+ PrintersLB.Items.Add(frxResources.Get('prDefault'));
+ for i := 0 to frxPrinters.Printers.Count - 1 do
+ PrintersLB.Items.Add(frxPrinters.Printers[i]);
+ PrintersLB.Items.EndUpdate;
+
+ CollateCB.IsChecked := PrintOptions.Collate;
+ CopiesE.Text := IntToStr(PrintOptions.Copies);
+ DoublePassCB.IsChecked := EngineOptions.DoublePass;
+ PrintIfEmptyCB.IsChecked := EngineOptions.PrintIfEmpty;
+ if ReportOptions.HiddenPassword = '' then
+ PasswordE.Text := ReportOptions.Password
+ else
+ begin
+ PasswordE.Enabled := False;
+ //PasswordE.Color := claGray;
+ end;
+
+ if Trim(ParentReport) = '' then
+ begin
+ InheritStateL.Text := frxResources.Get('riNotInherited');
+ DetachRB.Enabled := False;
+ end
+ else
+ InheritStateL.Text := Format(frxResources.Get('riInherited'), [ParentReport]);
+
+ FillTemplatelist;
+ NameE.Text := ReportOptions.Name;
+ AuthorE.Text := ReportOptions.Author;
+ DescriptionE.Lines.Text := ReportOptions.Description.Text;
+ PictureImg.Bitmap.Assign(ReportOptions.Picture);
+ //PictureImg.Stretch := (PictureImg.Picture.Width > PictureImg.Width) or
+ // (PictureImg.Picture.Height > PictureImg.Height);
+
+ MajorE.Text := ReportOptions.VersionMajor;
+ MinorE.Text := ReportOptions.VersionMinor;
+ ReleaseE.Text := ReportOptions.VersionRelease;
+ BuildE.Text := ReportOptions.VersionBuild;
+ Created1L.Text := DateTimeToStr(ReportOptions.CreateDate);
+ Modified1L.Text := DateTimeToStr(ReportOptions.LastChange);
+ end;
+end;
+
+
+procedure TfrxReportEditorForm.PictureBClick(Sender: TObject);
+begin
+ with TfrxPictureEditorForm.Create(Owner) do
+ begin
+ Image.Bitmap.Assign(PictureImg.Bitmap);
+ if ShowModal = mrOk then
+ begin
+ PictureImg.Bitmap.Assign(Image.Bitmap);
+ //PictureImg.Stretch := (PictureImg.Picture.Width > PictureImg.Width) or
+ // (PictureImg.Picture.Height > PictureImg.Height);
+ end;
+ Free;
+ end;
+end;
+
+//procedure TfrxReportEditorForm.PrintersLBDrawItem(Control: TWinControl;
+// Index: Integer; ARect: TRect; State: TOwnerDrawState);
+//var
+// s: String;
+//begin
+// with PrintersLB.Canvas do
+// begin
+// FillRect(ARect);
+// frxResources.PreviewButtonImages.Draw(PrintersLB.Canvas, ARect.Left + 2, ARect.Top, 2);
+// s := PrintersLB.Items[Index];
+// if (Index <> 0) and (frxPrinters[Index - 1].Port <> '') then
+// s := s + ' ' + frxResources.Get('rePrnOnPort') + ' ' + frxPrinters[Index - 1].Port;
+// TextOut(ARect.Left + 24, ARect.Top + 1, s);
+// end;
+//end;
+
+procedure TfrxReportEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+procedure TfrxReportEditorForm.BrowseBClick(Sender: TObject);
+var
+ FolderName: String;
+begin
+ OpenDialog1.InitialDir := PathE.Text;
+ if OpenDialog1.Execute() then
+ begin
+ FolderName := ExtractFilePath(OpenDialog1.FileName);
+ TfrxDesignerForm(Owner).TemplatePath := FolderName;
+ FillTemplatelist;
+ end;
+ PeekLastModalResult;
+end;
+
+procedure TfrxReportEditorForm.FillTemplatelist;
+//var
+// i: Integer;
+begin
+ PathE.Text := TfrxDesignerForm(Owner).TemplatePath;
+ TfrxDesignerForm(Owner).GetTemplateList(FTemplates);
+ InheritLV.Clear;
+ InheritLV.Items := FTemplates;
+// InheritLV.Items.Clear;
+// for i := 0 to FTemplates.Count - 1 do
+// begin
+// lvItem := InheritLV.Items.Add;
+// lvItem.Caption := ExtractFileName(FTemplates[i]);
+// lvItem.Data := Pointer(i);
+// lvItem.ImageIndex := 5;
+// end;
+end;
+
+procedure TfrxReportEditorForm.PathEKeyPress(Sender: TObject;
+ var Key: Char);
+begin
+ if Key = #13 then
+ if DirectoryExists(PathE.Text) then
+ begin
+ TfrxDesignerForm(Owner).TemplatePath := PathE.Text;
+ FillTemplatelist;
+ end;
+end;
+
+procedure TfrxReportEditorForm.PageControlChange(Sender: TObject);
+begin
+ if PageControl.ActiveTab = InheritTS then
+ OkB.Default := False
+ else OkB.Default := True;
+end;
+
+end.
diff --git a/LibD28x64/FMX.frxEditReportData.fmx b/LibD28x64/FMX.frxEditReportData.fmx
new file mode 100644
index 0000000..d679e1a
--- /dev/null
+++ b/LibD28x64/FMX.frxEditReportData.fmx
@@ -0,0 +1,38 @@
+object frxReportDataForm: TfrxReportDataForm
+ Left = 0
+ Top = 0
+ Caption = 'Select Report Datasets'
+ BorderStyle = bsSingle
+ BorderIcons = []
+ ClientHeight = 239
+ ClientWidth = 229
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object OKB: TButton
+ Position.Point = '(68,208)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 0
+ ModalResult = 1
+ end
+ object CancelB: TButton
+ Position.Point = '(148,208)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object DatasetsLB: TListBox
+ Position.Point = '(4,4)'
+ Width = 221.000000000000000000
+ Height = 197.000000000000000000
+ TabOrder = 2
+ ItemHeight = 16.000000000000000000
+ ShowCheckboxes = True
+ end
+end
diff --git a/LibD28x64/FMX.frxEditReportData.pas b/LibD28x64/FMX.frxEditReportData.pas
new file mode 100644
index 0000000..98cb976
--- /dev/null
+++ b/LibD28x64/FMX.frxEditReportData.pas
@@ -0,0 +1,216 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Report datasets selector }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditReportData;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.Layouts, FMX.ListBox, FMX.Types, System.Variants
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+
+type
+{$IFDEF LINUX}
+ TfrxReportDataForm = class(TfrxForm)
+{$ELSE}
+ TfrxReportDataForm = class(TForm)
+{$ENDIF}
+
+ OKB: TButton;
+ CancelB: TButton;
+ DatasetsLB: TListBox;
+ procedure FormShow(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure DatasetsLBClickCheck(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ FStandalone: Boolean;
+ //procedure BuildConnectionList;
+ procedure BuildDatasetList;
+ public
+ Report: TfrxReport;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxDesgn, FMX.frxUtils, FMX.frxRes, System.IniFiles;
+
+var
+ PrevWidth: Integer = 0;
+ PrevHeight: Integer = 0;
+
+procedure TfrxReportDataForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+var
+ i: Integer;
+begin
+ PrevWidth := Width;
+ PrevHeight := Height;
+ if ModalResult <> mrOk then Exit;
+
+
+ Report.Datasets.Clear;
+
+ for i := 0 to DatasetsLB.Items.Count - 1 do
+ if DatasetsLB.ListItems[i].IsChecked then
+ Report.DataSets.Add(TfrxDataSet(DatasetsLB.Items.Objects[i]));
+end;
+
+procedure TfrxReportDataForm.FormCreate(Sender: TObject);
+begin
+ FStandalone := (frxDesignerComp <> nil) and frxDesignerComp.Standalone;
+ if FStandalone then
+ Caption := frxGet(5800)
+ else
+ Caption := frxGet(2800);
+ OKB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxReportDataForm.FormShow(Sender: TObject);
+begin
+ if PrevWidth <> 0 then
+ begin
+ Width := PrevWidth;
+ Height := PrevHeight;
+ end;
+
+ DatasetsLB.SetBounds(4, 4, ClientWidth - 8, ClientHeight - OkB.Height - 12);
+ OkB.Position.X := ClientWidth - OkB.Width - CancelB.Width - 8;
+ CancelB.Position.X := ClientWidth - CancelB.Width - 4;
+ OkB.Position.Y := ClientHeight - OkB.Height - 4;
+ CancelB.Position.Y := OkB.Position.Y;
+
+// if FStandalone then
+// BuildConnectionList
+// else
+ BuildDatasetList;
+end;
+
+
+// todo win only ?
+//procedure TfrxReportDataForm.BuildConnectionList;
+//var
+// i: Integer;
+// sl: TStringList;
+// s2: TStringList;
+//begin
+//
+// try
+// sl := TStringList.Create;
+// s2 := TStringList.Create;
+// try
+// ini.RootKey := HKEY_LOCAL_MACHINE;
+// if ini.OpenKeyReadOnly(DEF_REG_CONNECTIONS) then
+// begin
+// ini.GetValueNames(sl);
+// ini.CloseKey;
+// end;
+//
+// ini.RootKey := HKEY_CURRENT_USER;
+// if ini.OpenKeyReadOnly(DEF_REG_CONNECTIONS) then
+// begin
+// ini.GetValueNames(s2);
+// ini.CloseKey;
+// end;
+//
+// sl.AddStrings(s2);
+//
+// for i := 0 to sl.Count - 1 do
+// begin
+// DataSetsLB.Items.Add(sl[i]);
+// DataSetsLB.Checked[i] := CompareText(sl[i], Report.ReportOptions.ConnectionName) = 0;
+// end;
+// finally
+// sl.Free;
+// s2.Free;
+// end;
+// finally
+// ini.Free;
+// end;
+//end;
+
+procedure TfrxReportDataForm.BuildDatasetList;
+var
+ i: Integer;
+ ds: TfrxDataSet;
+ dsList: TStringList;
+begin
+ dsList := TStringList.Create;
+
+ if Report.EnabledDataSets.Count > 0 then
+ begin
+ for i := 0 to Report.EnabledDataSets.Count - 1 do
+ begin
+ ds := Report.EnabledDataSets[i].DataSet;
+ if ds <> nil then
+ dsList.AddObject(ds.UserName, ds);
+ end;
+ end
+ else
+ Report.GetActiveDataSetList(dsList);
+
+ dsList.Sort;
+
+ for i := 0 to dsList.Count - 1 do
+ begin
+ ds := TfrxDataSet(dsList.Objects[i]);
+ if (csDesigning in Report.ComponentState) and
+ ((ds.Owner is TForm) or (ds.Owner is TDataModule)) then
+ DataSetsLB.Items.AddObject(ds.UserName + ' (' + ds.Owner.Name + '.' + ds.Name + ')', ds)
+ else
+ begin
+ if not (ds.Owner is TfrxReport) or (ds.Owner = Report) then
+ DataSetsLB.Items.AddObject(ds.UserName, ds);
+ end;
+ if Report.Datasets.Find(ds) <> nil then
+ DataSetsLB.ListItems[DataSetsLB.Items.Count - 1].IsChecked := True;
+ end;
+
+ dsList.Free;
+end;
+
+procedure TfrxReportDataForm.DatasetsLBClickCheck(Sender: TObject);
+var
+ i: Integer;
+begin
+ if FStandalone then
+ for i := 0 to DatasetsLB.Items.Count - 1 do
+ if i <> DatasetsLB.ItemIndex then
+ DatasetsLB.ListItems[i].IsChecked := False;
+end;
+
+procedure TfrxReportDataForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+end.
diff --git a/LibD28x64/FMX.frxEditSQL.fmx b/LibD28x64/FMX.frxEditSQL.fmx
new file mode 100644
index 0000000..c159f97
--- /dev/null
+++ b/LibD28x64/FMX.frxEditSQL.fmx
@@ -0,0 +1,49 @@
+object frxSQLEditorForm: TfrxSQLEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Lines'
+ ClientHeight = 307
+ ClientWidth = 432
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnClose = FormClose
+ StyleLookup = 'backgroundstyle'
+ object ToolBar: TToolBar
+ Width = 432.000000000000000000
+ Height = 31.000000000000000000
+ TabOrder = 0
+ object QBB: TfrxToolButton
+ Position.Point = '(2,4)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ OnClick = QBBClick
+ TabOrder = 0
+ end
+ object ParamsB: TfrxToolButton
+ Position.Point = '(28,4)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = ParamsBClick
+ TabOrder = 1
+ end
+ object CancelB: TfrxToolButton
+ Position.Point = '(86,4)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = CancelBClick
+ TabOrder = 2
+ Hint = 'Cancel'
+ end
+ object OkB: TfrxToolButton
+ Position.Point = '(61,4)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = OkBClick
+ TabOrder = 3
+ Hint = 'OK'
+ end
+ end
+end
diff --git a/LibD28x64/FMX.frxEditSQL.pas b/LibD28x64/FMX.frxEditSQL.pas
new file mode 100644
index 0000000..570e716
--- /dev/null
+++ b/LibD28x64/FMX.frxEditSQL.pas
@@ -0,0 +1,220 @@
+
+{******************************************}
+{ }
+{ FastReport FMX v1.0 }
+{ SQL editor }
+{ }
+{ Copyright (c) 1998-2013 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditSQL;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Controls, System.UITypes, System.UIConsts,
+ FMX.Forms, FMX.Dialogs, FMX.fs_SynMemo, FMX.frxFMX,
+ FMX.frxCustomDB
+, System.Variants, FMX.Types
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF QBUILDER}
+, FMX.fqbClass
+{$ENDIF};
+
+
+type
+ TfrxSQLEditorForm = class(TForm)
+ ToolBar: TToolBar;
+ OkB: TfrxToolButton;
+ CancelB: TfrxToolButton;
+ QBB: TfrxToolButton;
+ ParamsB: TfrxToolButton;
+ procedure OkBClick(Sender: TObject);
+ procedure CancelBClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure MemoKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormHide(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure QBBClick(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure ParamsBClick(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ { Private declarations }
+ FMemo: TfsSyntaxMemo;
+ FQuery: TfrxCustomQuery;
+{$IFDEF QBUILDER}
+ FQBEngine: TfqbEngine;
+{$ENDIF}
+ FSaveSQL: TStrings;
+ FSaveSchema: String;
+ FSaveParams: TfrxParams;
+ public
+ { Public declarations }
+ property Query: TfrxCustomQuery read FQuery write FQuery;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxClass, FMX.frxRes, System.IniFiles, FMX.frxEditQueryParams;
+
+
+procedure TfrxSQLEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ FormHide(Self);
+end;
+
+procedure TfrxSQLEditorForm.FormCreate(Sender: TObject);
+begin
+ FSaveSQL := TStringList.Create;
+ FSaveParams := TfrxParams.Create;
+
+ FMemo := TfsSyntaxMemo.Create(Self);
+ with FMemo do
+ begin
+ Parent := Self;
+ Align := alClient;
+ SyntaxType := stSQL;
+ ShowGutter := True;
+// GutterWidth := 20;
+ Fill.Color := claWhite;
+ OnKeyDown := MemoKeyDown;
+{$I frxEditSQL.inc}
+ end;
+ frxResources.LoadImageFromResouce(QBB.Bitmap, 5, 8);
+ frxResources.LoadImageFromResouce(ParamsB.Bitmap, 5, 6);
+ frxResources.LoadImageFromResouce(OkB.Bitmap, 21, 0);
+ frxResources.LoadImageFromResouce(CancelB.Bitmap, 21, 2);
+{$IFDEF QBUILDER}
+ QBB.Visible := True;
+{$ENDIF}
+ Caption := frxGet(4900);
+ QBB.Hint := frxGet(4901);
+ ParamsB.Hint := frxGet(5714);
+ CancelB.Hint := frxGet(2);
+ OkB.Hint := frxGet(1);
+
+// if UseRightToLeftAlignment then
+// FlipChildren(True);
+end;
+
+procedure TfrxSQLEditorForm.FormDestroy(Sender: TObject);
+begin
+ FSaveSQL.Free;
+ FSaveParams.Free;
+end;
+
+procedure TfrxSQLEditorForm.FormShow(Sender: TObject);
+var
+ Ini: TCustomIniFile;
+begin
+ FSaveSQL.Assign(Query.SQL);
+ FSaveParams.Assign(Query.Params);
+ FSaveSchema := Query.SQLSchema;
+{$IFDEF QBUILDER}
+ FQBEngine := Query.QBEngine;
+{$ENDIF}
+ FMemo.Lines.Assign(Query.SQL);
+
+ Ini := TfrxCustomDesigner(Owner).Report.GetIniFile;
+ Ini.WriteBool('Form4.TfrxSQLEditorForm', 'Visible', True);
+// frxRestoreFormPosition(Ini, Self);
+ Ini.Free;
+end;
+
+procedure TfrxSQLEditorForm.FormHide(Sender: TObject);
+var
+ Ini: TCustomIniFile;
+begin
+ if ModalResult = mrOk then
+ begin
+ Query.SQL.Assign(FMemo.Lines);
+ end
+ else
+ begin
+ Query.SQL.Assign(FSaveSQL);
+ Query.Params.Assign(FSaveParams);
+ Query.SQLSchema := FSaveSchema;
+ end;
+
+ Ini := TfrxCustomDesigner(Owner).Report.GetIniFile;
+ //frxSaveFormPosition(Ini, Self);
+ Ini.Free;
+{$IFDEF QBUILDER}
+ if FQBEngine <> nil then
+ FQBEngine.Free;
+{$ENDIF}
+end;
+
+procedure TfrxSQLEditorForm.OkBClick(Sender: TObject);
+begin
+ ModalResult := mrOk;
+end;
+
+procedure TfrxSQLEditorForm.CancelBClick(Sender: TObject);
+begin
+ ModalResult := mrCancel;
+end;
+
+procedure TfrxSQLEditorForm.MemoKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if (Key = vkReturn) and (ssCtrl in Shift) then
+ ModalResult := mrOk
+ else if Key = vkEscape then
+ ModalResult := mrCancel
+ else if Key = vkF1 then
+ frxResources.Help(Self);
+end;
+
+procedure TfrxSQLEditorForm.QBBClick(Sender: TObject);
+{$IFDEF QBUILDER}
+var
+ fqbDialog: TfqbDialog;
+{$ENDIF}
+begin
+{$IFDEF QBUILDER}
+ fqbDialog := TfqbDialog.Create(nil);
+ try
+ fqbDialog.Engine := FQBEngine;
+ fqbDialog.SchemaInsideSQL := False;
+ fqbDialog.SQL := FMemo.Lines.Text;
+ fqbDialog.SQLSchema := Query.SQLSchema;
+
+ if fqbDialog.Execute then
+ begin
+ FMemo.Lines.Text := fqbDialog.SQL;
+ Query.SQLSchema := fqbDialog.SQLSchema;
+ end;
+ finally
+ fqbDialog.Free;
+ end;
+{$ENDIF}
+end;
+
+procedure TfrxSQLEditorForm.ParamsBClick(Sender: TObject);
+begin
+ Query.SQL.Assign(FMemo.Lines);
+ if Query.Params.Count <> 0 then
+ with TfrxParamsEditorForm.Create(Owner) do
+ begin
+ Params := Query.Params;
+ FormShow(Self);
+ if ShowModal = mrOk then
+ Query.UpdateParams;
+ Free;
+ end;
+end;
+
+end.
+
diff --git a/LibD28x64/FMX.frxEditStrings.fmx b/LibD28x64/FMX.frxEditStrings.fmx
new file mode 100644
index 0000000..15ae38d
--- /dev/null
+++ b/LibD28x64/FMX.frxEditStrings.fmx
@@ -0,0 +1,41 @@
+object frxStringsEditorForm: TfrxStringsEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Lines'
+ ClientHeight = 226
+ ClientWidth = 432
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object ToolBar: TToolBar
+ Width = 432.000000000000000000
+ Height = 35.000000000000000000
+ TabOrder = 0
+ object CancelB: TfrxToolButton
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = CancelBClick
+ TabOrder = 0
+ Hint = 'Cancel'
+ end
+ object OkB: TfrxToolButton
+ Position.Point = '(23,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = OkBClick
+ TabOrder = 1
+ Hint = 'OK'
+ end
+ end
+ object Memo: TMemo
+ Align = alClient
+ Position.Point = '(0,35)'
+ Width = 432.000000000000000000
+ Height = 191.000000000000000000
+ OnKeyDown = MemoKeyDown
+ TabOrder = 1
+ KeyboardType = vktDefault
+ end
+end
diff --git a/LibD28x64/FMX.frxEditStrings.pas b/LibD28x64/FMX.frxEditStrings.pas
new file mode 100644
index 0000000..1de11a4
--- /dev/null
+++ b/LibD28x64/FMX.frxEditStrings.pas
@@ -0,0 +1,93 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ TStrings editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditStrings;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Controls,
+ FMX.Forms, FMX.Dialogs, FMX.ExtCtrls, FMX.Layouts,
+ FMX.Memo, FMX.Types, FMX.frxFMX
+, System.Variants
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+
+type
+ TfrxStringsEditorForm = class(TForm)
+ ToolBar: TToolBar;
+ OkB: TfrxToolButton;
+ CancelB: TfrxToolButton;
+ Memo: TMemo;
+ procedure OkBClick(Sender: TObject);
+ procedure CancelBClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure MemoKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ private
+ { Private declarations }
+ public
+ { Public declarations }
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxClass, FMX.frxRes;
+
+
+procedure TfrxStringsEditorForm.OkBClick(Sender: TObject);
+begin
+ ModalResult := mrOk;
+end;
+
+procedure TfrxStringsEditorForm.CancelBClick(Sender: TObject);
+begin
+ ModalResult := mrCancel;
+end;
+
+procedure TfrxStringsEditorForm.FormCreate(Sender: TObject);
+begin
+ //Toolbar.Images := frxResources.MainButtonImages;
+ //todo images
+ Caption := frxGet(4800);
+ CancelB.Hint := frxGet(2);
+ OkB.Hint := frxGet(1);
+ frxResources.LoadImageFromResouce(CancelB.Bitmap, 21, 2);
+ frxResources.LoadImageFromResouce(OkB.Bitmap, 21, 0);
+
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxStringsEditorForm.MemoKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if (Key = vkReturn) and (ssCtrl in Shift) then
+ ModalResult := mrOk
+ else if Key = vkEscape then
+ ModalResult := mrCancel;
+end;
+
+procedure TfrxStringsEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+end.
+
diff --git a/LibD28x64/FMX.frxEditStyle.fmx b/LibD28x64/FMX.frxEditStyle.fmx
new file mode 100644
index 0000000..8b15cfd
--- /dev/null
+++ b/LibD28x64/FMX.frxEditStyle.fmx
@@ -0,0 +1,138 @@
+object frxStyleEditorForm: TfrxStyleEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Style Editor'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 251
+ ClientWidth = 389
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object PaintBox: TPaintBox
+ Position.Point = '(164,150)'
+ Width = 216.000000000000000000
+ Height = 78.000000000000000000
+ OnPaint = PaintBoxPaint
+ end
+ object ToolBar: TToolBar
+ Width = 389.000000000000000000
+ Height = 35.000000000000000000
+ TabOrder = 1
+ object AddB: TfrxToolButton
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = AddBClick
+ TabOrder = 0
+ end
+ object DeleteB: TfrxToolButton
+ Position.Point = '(23,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = DeleteBClick
+ TabOrder = 1
+ end
+ object EditB: TfrxToolButton
+ Position.Point = '(46,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = EditBClick
+ TabOrder = 2
+ end
+ object LoadB: TfrxToolButton
+ Position.Point = '(77,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = LoadBClick
+ TabOrder = 3
+ end
+ object SaveB: TfrxToolButton
+ Position.Point = '(100,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = SaveBClick
+ TabOrder = 4
+ end
+ object CancelB: TfrxToolButton
+ Position.Point = '(131,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = CancelBClick
+ TabOrder = 5
+ end
+ object OkB: TfrxToolButton
+ Position.Point = '(154,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = OkBClick
+ TabOrder = 6
+ end
+ end
+ object ColorB: TButton
+ Tag = 2
+ Position.Point = '(164,46)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = BClick
+ TabOrder = 2
+ end
+ object FontB: TButton
+ Tag = 3
+ Position.Point = '(164,78)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = BClick
+ TabOrder = 3
+ end
+ object FrameB: TButton
+ Tag = 4
+ Position.Point = '(164,110)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = BClick
+ TabOrder = 4
+ end
+ object OpenDialog: TOpenDialog
+ Left = 72
+ Top = 104
+ end
+ object SaveDialog: TSaveDialog
+ Left = 40
+ Top = 88
+ end
+ object StylesTV: TfrxTreeView
+ Align = alLeft
+ Position.Point = '(0,35)'
+ Width = 161.000000000000000000
+ Height = 216.000000000000000000
+ OnClick = StylesTVClick
+ TabOrder = 5
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 0
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 1
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 2
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+end
diff --git a/LibD28x64/FMX.frxEditStyle.pas b/LibD28x64/FMX.frxEditStyle.pas
new file mode 100644
index 0000000..d01c582
--- /dev/null
+++ b/LibD28x64/FMX.frxEditStyle.pas
@@ -0,0 +1,326 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Style editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditStyle;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.Types, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.Layouts, FMX.TreeView, FMX.Types, FMX.frxFMX, FMX.Objects,
+ FMX.Edit, System.UIConsts, FMX.frxFontForm, FMX.frxBaseModalForm
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+type
+ TfrxStyleEditorForm = class(TfrxForm)
+ ToolBar: TToolBar;
+ AddB: TfrxToolButton;
+ DeleteB: TfrxToolButton;
+ LoadB: TfrxToolButton;
+ SaveB: TfrxToolButton;
+ CancelB: TfrxToolButton;
+ OkB: TfrxToolButton;
+ OpenDialog: TOpenDialog;
+ SaveDialog: TSaveDialog;
+ EditB: TfrxToolButton;
+ PaintBox: TPaintBox;
+ ColorB: TButton;
+ FontB: TButton;
+ FrameB: TButton;
+ StylesTV: TfrxTreeView;
+ procedure FormCreate(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure CancelBClick(Sender: TObject);
+ procedure OkBClick(Sender: TObject);
+ procedure PaintBoxPaint(Sender: TObject; Canvas: TCanvas);
+ procedure FormHide(Sender: TObject);
+ procedure AddBClick(Sender: TObject);
+ procedure DeleteBClick(Sender: TObject);
+ procedure LoadBClick(Sender: TObject);
+ procedure SaveBClick(Sender: TObject);
+ procedure BClick(Sender: TObject);
+ procedure StylesTVClick(Sender: TObject);
+ procedure StylesTVEdited(Sender: TObject; Node: TfrxTreeViewItem; var S: String);
+ procedure EditBClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ FReport: TfrxReport;
+ FStyles: TfrxStyles;
+ procedure UpdateStyles(Focus: Integer = 0);
+ procedure UpdateControls;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxDesgn, FMX.frxEditFrame, FMX.frxDesgnCtrls, FMX.frxRes;
+
+
+constructor TfrxStyleEditorForm.Create(AOwner: TComponent);
+begin
+ inherited;
+ FStyles := TfrxStyles.Create(nil);
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+end;
+
+destructor TfrxStyleEditorForm.Destroy;
+begin
+ FStyles.Free;
+ inherited;
+end;
+
+procedure TfrxStyleEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ FormHide(Self);
+end;
+
+procedure TfrxStyleEditorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(5100);
+ ColorB.Text := frxGet(5101);
+ FontB.Text := frxGet(5102);
+ FrameB.Text := frxGet(5103);
+ AddB.Hint := frxGet(5104);
+ DeleteB.Hint := frxGet(5105);
+ EditB.Hint := frxGet(5106);
+ LoadB.Hint := frxGet(5107);
+ SaveB.Hint := frxGet(5108);
+ CancelB.Hint := frxGet(2);
+ OkB.Hint := frxGet(1);
+ StylesTV.Editable := True;
+ StylesTV.OnEdited := StylesTVEdited;
+ FReport := TfrxCustomDesigner(Owner).Report;
+ frxResources.LoadImageFromResouce(AddB.Bitmap, 8, 7);
+ frxResources.LoadImageFromResouce(DeleteB.Bitmap, 5, 1);
+ frxResources.LoadImageFromResouce(EditB.Bitmap, 10, 5);
+ frxResources.LoadImageFromResouce(LoadB.Bitmap, 0, 1);
+ frxResources.LoadImageFromResouce(SaveB.Bitmap, 0, 2);
+ frxResources.LoadImageFromResouce(CancelB.Bitmap, 21, 2);
+ frxResources.LoadImageFromResouce(OkB.Bitmap, 21, 0);
+end;
+
+procedure TfrxStyleEditorForm.FormShow(Sender: TObject);
+begin
+ FStyles.Assign(FReport.Styles);
+ UpdateStyles;
+end;
+
+procedure TfrxStyleEditorForm.FormHide(Sender: TObject);
+begin
+ if ModalResult = mrOk then
+ FReport.Styles.Assign(FStyles);
+end;
+
+procedure TfrxStyleEditorForm.UpdateStyles(Focus: Integer = 0);
+var
+ i: Integer;
+ Node: TfrxTreeViewItem;
+begin
+ StylesTV.BeginUpdate;
+ StylesTV.Clear;
+ for i := 0 to FStyles.Count - 1 do
+ begin
+ Node := StylesTV.AddItem(StylesTV, FStyles[i].Name);
+ Node.TagObject := FStyles[i];
+ end;
+ StylesTV.EndUpdate;
+
+ if Focus >= StylesTV.Count then
+ Focus := StylesTV.Count - 1;
+ if Focus <> -1 then
+ StylesTV.Selected := StylesTV.Items[Focus];
+ StylesTVClick(nil);
+end;
+
+procedure TfrxStyleEditorForm.UpdateControls;
+var
+ b: Boolean;
+begin
+ b := StylesTV.Selected <> nil;
+ ColorB.Enabled := b;
+ FontB.Enabled := b;
+ FrameB.Enabled := b;
+end;
+
+procedure TfrxStyleEditorForm.PaintBoxPaint(Sender: TObject; Canvas: TCanvas);
+var
+ m: TfrxMemoView;
+begin
+ with PaintBox.Canvas do
+ begin
+ Fill.Color := claWhite;
+ Stroke.Color := claGray;
+{$IFDEF Delphi25}
+ Stroke.Thickness := 1;
+{$ELSE}
+ StrokeThickness := 1;
+{$ENDIF}
+ Stroke.Kind := TBrushKind.bkSolid;
+ DrawRect(RectF(0, 0, PaintBox.Width, PaintBox.Height), 1, 1, AllCorners, 1, TCornerType.ctBevel);
+ end;
+
+ if StylesTV.Selected = nil then Exit;
+
+ m := TfrxMemoView.Create(nil);
+ m.ApplyStyle(TfrxStyleItem(StylesTV.Selected.TagObject));
+ m.Text := frxResources.Get('dsStyleSample');
+ m.GapX := 20;
+ m.GapY := 10;
+ m.Width := m.CalcWidth;
+ m.Height := m.CalcHeight;
+ m.Left := (PaintBox.Width - m.Width) / 2;
+ m.Top := (PaintBox.Height - m.Height) / 2;
+ m.Draw(PaintBox.Canvas, 1, 1, 0, 0);
+ m.Free;
+end;
+
+procedure TfrxStyleEditorForm.StylesTVClick(Sender: TObject);
+begin
+ UpdateControls;
+ //PaintBoxPaint(nil, PaintBox.Canvas);
+ Self.InvalidateRect(RectF(0, 0, Self.Width, Self.Height));
+end;
+
+procedure TfrxStyleEditorForm.BClick(Sender: TObject);
+var
+ Style: TfrxStyleItem;
+begin
+ if StylesTV.Selected = nil then Exit;
+ Style := TfrxStyleItem(StylesTV.Selected.TagObject);
+
+ case TControl(Sender).Tag of
+ 2:
+ with TfrxColorSelector.Create(TComponent(Sender)) do
+ begin
+ OnColorChanged := BClick;
+
+ //Color := AColor;
+ BtnCaption := frxResources.Get('dsColorOth');
+ Popup(ColorB);
+ Tag := 20;
+ end;
+
+ 20:
+ Style.Color := TfrxColorSelector(Sender).Color;
+
+ 3:
+ with TfrxFontForm.Create(Application) do
+ begin
+ FontS.Assign(Style.Font);
+ FormActivate(Sender);
+ if ShowModal = mrOk then
+ Style.Font.Assign(FontS);
+ Free;
+ end;
+
+ 4:
+ with TfrxFrameEditorForm.Create(Owner) do
+ begin
+ Frame.Assign(Style.Frame);
+ if ShowModal = mrOk then
+ Style.Frame := Frame;
+ Free;
+ end;
+ end;
+ Self.InvalidateRect(RectF(0, 0, Self.Width, Self.Height));
+ //PaintBoxPaint(nil, PaintBox.Canvas);
+end;
+
+procedure TfrxStyleEditorForm.AddBClick(Sender: TObject);
+begin
+ FStyles.Add.CreateUniqueName;
+ UpdateStyles(FStyles.Count - 1);
+ StylesTV.DoEdit;
+end;
+
+procedure TfrxStyleEditorForm.DeleteBClick(Sender: TObject);
+begin
+ if StylesTV.Selected = nil then Exit;
+ TfrxStyleItem(StylesTV.Selected.TagObject).Free;
+ UpdateStyles(StylesTV.Selected.Index);
+end;
+
+procedure TfrxStyleEditorForm.LoadBClick(Sender: TObject);
+begin
+ OpenDialog.Filter := frxResources.Get('dsStyleFile') + ' (*.fs3)|*.fs3';
+ if frxDesignerComp <> nil then
+ OpenDialog.InitialDir := frxDesignerComp.OpenDir;
+ if OpenDialog.Execute then
+ begin
+ FStyles.LoadFromFile(OpenDialog.FileName);
+ UpdateStyles;
+ end;
+ PeekLastModalResult;
+end;
+
+procedure TfrxStyleEditorForm.SaveBClick(Sender: TObject);
+begin
+ SaveDialog.Filter := frxResources.Get('dsStyleFile') + ' (*.fs3)|*.fs3';
+ if frxDesignerComp <> nil then
+ SaveDialog.InitialDir := frxDesignerComp.SaveDir;
+ if SaveDialog.Execute then
+ FStyles.SaveToFile(ChangeFileExt(SaveDialog.FileName, '.fs3'));
+ PeekLastModalResult;
+end;
+
+procedure TfrxStyleEditorForm.CancelBClick(Sender: TObject);
+begin
+ ModalResult := mrCancel;
+end;
+
+procedure TfrxStyleEditorForm.OkBClick(Sender: TObject);
+begin
+ ModalResult := mrOk;
+end;
+
+procedure TfrxStyleEditorForm.StylesTVEdited(Sender: TObject; Node: TfrxTreeViewItem; var S: String);
+var
+ Style: TfrxStyleItem;
+begin
+ Style := TfrxStyleItem(Node.TagObject);
+ Style.Name := s;
+end;
+
+procedure TfrxStyleEditorForm.EditBClick(Sender: TObject);
+begin
+ if StylesTV.Selected = nil then Exit;
+ StylesTV.DoEdit;
+end;
+
+procedure TfrxStyleEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+ if Key = VKF2 then
+ EditBClick(nil);
+end;
+
+end.
diff --git a/LibD28x64/FMX.frxEditSysMemo.fmx b/LibD28x64/FMX.frxEditSysMemo.fmx
new file mode 100644
index 0000000..591b9ca
--- /dev/null
+++ b/LibD28x64/FMX.frxEditSysMemo.fmx
@@ -0,0 +1,178 @@
+object frxSysMemoEditorForm: TfrxSysMemoEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'System Memo'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 435
+ ClientWidth = 290
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object OKB: TButton
+ Position.Point = '(129,404)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 40
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(209,404)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ HelpContext = 50
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object AggregateRB: TRadioButton
+ Position.Point = '(4,80)'
+ Width = 173.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object SysVariableRB: TRadioButton
+ Position.Point = '(4,4)'
+ Width = 173.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ object TextRB: TRadioButton
+ Position.Point = '(4,324)'
+ Width = 173.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 4
+ end
+ object AggregatePanel: TGroupBox
+ Position.Point = '(4,100)'
+ Width = 281.000000000000000000
+ Height = 217.000000000000000000
+ TabOrder = 5
+ object DataBandL: TLabel
+ Position.Point = '(8,44)'
+ Width = 89.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object DataSetL: TLabel
+ Position.Point = '(8,76)'
+ Width = 89.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object DataFieldL: TLabel
+ Position.Point = '(8,100)'
+ Width = 89.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 2
+ end
+ object FunctionL: TLabel
+ Position.Point = '(8,20)'
+ Width = 89.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 3
+ end
+ object ExpressionL: TLabel
+ Position.Point = '(8,124)'
+ Width = 89.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 4
+ end
+ object SampleL: TLabel
+ Position.Point = '(8,196)'
+ Width = 265.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 5
+ end
+ object DataFieldCB: TComboBox
+ Position.Point = '(100,96)'
+ Width = 173.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 6
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ OnChange = DataFieldCBChange
+ end
+ object DataSetCB: TComboBox
+ Position.Point = '(100,72)'
+ Width = 173.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 7
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ OnChange = DataSetCBChange
+ end
+ object DataBandCB: TComboBox
+ Position.Point = '(100,40)'
+ Width = 173.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 8
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ OnChange = DataBandCBChange
+ end
+ object CountInvisibleCB: TCheckBox
+ Position.Point = '(8,148)'
+ Width = 265.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = FunctionCBChange
+ TabOrder = 9
+ end
+ object FunctionCB: TComboBox
+ Position.Point = '(100,16)'
+ Width = 173.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 10
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ OnChange = FunctionCBChange
+ end
+ object ExpressionE: TfrxEditWithButton
+ Position.Point = '(100,120)'
+ Width = 173.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 11
+ OnButtonClick = ExpressionEButtonClick
+ end
+ object RunningTotalCB: TCheckBox
+ Position.Point = '(8,168)'
+ Width = 265.000000000000000000
+ Height = 17.000000000000000000
+ OnClick = FunctionCBChange
+ TabOrder = 12
+ end
+ end
+ object GroupBox1: TGroupBox
+ Position.Point = '(4,24)'
+ Width = 281.000000000000000000
+ Height = 49.000000000000000000
+ TabOrder = 6
+ object SysVariableCB: TComboBox
+ Position.Point = '(8,16)'
+ Width = 173.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 0
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ end
+ end
+ object GroupBox2: TGroupBox
+ Position.Point = '(4,344)'
+ Width = 281.000000000000000000
+ Height = 49.000000000000000000
+ TabOrder = 7
+ object TextE: TEdit
+ Position.Point = '(8,16)'
+ Width = 265.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 0
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+end
diff --git a/LibD28x64/FMX.frxEditSysMemo.pas b/LibD28x64/FMX.frxEditSysMemo.pas
new file mode 100644
index 0000000..d2ccd25
--- /dev/null
+++ b/LibD28x64/FMX.frxEditSysMemo.pas
@@ -0,0 +1,319 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ SysMemo editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditSysMemo;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UiTypes, FMX.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.ExtCtrls, FMX.frxClass, FMX.frxCtrls, FMX.ListBox, FMX.Edit, System.Variants
+{$IFDEF LINUX}
+ ,FMX.frxBaseModalForm
+{$ENDIF}
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+
+type
+{$IFDEF LINUX}
+ TfrxSysMemoEditorForm = class(TfrxForm)
+{$ELSE}
+ TfrxSysMemoEditorForm = class(TForm)
+{$ENDIF}
+ OKB: TButton;
+ CancelB: TButton;
+ AggregateRB: TRadioButton;
+ SysVariableRB: TRadioButton;
+ TextRB: TRadioButton;
+ AggregatePanel: TGroupBox;
+ DataBandL: TLabel;
+ DataSetL: TLabel;
+ DataFieldL: TLabel;
+ FunctionL: TLabel;
+ ExpressionL: TLabel;
+ DataFieldCB: TComboBox;
+ DataSetCB: TComboBox;
+ DataBandCB: TComboBox;
+ CountInvisibleCB: TCheckBox;
+ FunctionCB: TComboBox;
+ ExpressionE: TfrxEditWithButton;
+ RunningTotalCB: TCheckBox;
+ GroupBox1: TGroupBox;
+ SysVariableCB: TComboBox;
+ GroupBox2: TGroupBox;
+ TextE: TEdit;
+ SampleL: TLabel;
+ procedure ExpressionEButtonClick(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure DataSetCBChange(Sender: TObject);
+ procedure DataBandCBChange(Sender: TObject);
+ procedure DataFieldCBChange(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FunctionCBChange(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ FAggregateOnly: Boolean;
+ FReport: TfrxReport;
+ FText: String;
+ procedure FillDataBandCB;
+ procedure FillDataFieldCB;
+ procedure FillDataSetCB;
+ function CreateAggregate: String;
+ procedure UpdateSample;
+ public
+ property AggregateOnly: Boolean read FAggregateOnly write FAggregateOnly;
+ property Text: String read FText write FText;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxUtils, FMX.frxRes;
+
+
+procedure TfrxSysMemoEditorForm.FormShow(Sender: TObject);
+var
+ s: String;
+ i: Integer;
+
+ procedure HideControls(ar: array of TControl);
+ var
+ i: Integer;
+ begin
+ for i := 0 to High(ar) do
+ ar[i].Visible := False;
+ end;
+
+begin
+ FReport := TfrxCustomDesigner(Owner).Report;
+ SysVariableRB.IsChecked := True;
+ FillDataBandCB;
+ FillDataSetCB;
+
+ s := FText;
+ if s <> '' then
+ SetLength(s, Length(s) - 2); { cut #13#10 }
+ i := SysVariableCB.Items.IndexOf(s);
+ if FAggregateOnly then
+ begin
+ Caption := frxResources.Get('agAggregate');
+ AggregateRB.IsChecked := True;
+ HideControls([SysVariableRB, AggregateRB, TextRB, SysVariableCB, TextE,
+ GroupBox1, GroupBox2]);
+ AggregatePanel.Position.Y := 4;
+ OkB.Position.Y := AggregatePanel.Height + 18;
+ CancelB.Position.Y := OkB.Position.Y;
+ ClientHeight := Round(CancelB.Position.Y + 33);
+ end
+ else if (i <> -1) or (s = '') then
+ begin
+ SysVariableRB.IsChecked := True;
+ SysVariableCB.ItemIndex := i;
+ end
+ else
+ begin
+ TextRB.IsChecked := True;
+ TextE.Text := s;
+ TextE.SetFocus;
+ end;
+ UpdateSample;
+end;
+
+function TfrxSysMemoEditorForm.CreateAggregate: String;
+var
+ s: String;
+ i: Integer;
+begin
+ if FunctionCB.Selected <> nil then
+ s := FunctionCB.Selected.Text;
+ i := 0;
+ if CountInvisibleCB.IsChecked then
+ i := i or 1;
+ if RunningTotalCB.IsChecked then
+ i := i or 2;
+
+ if s <> 'COUNT' then
+ begin
+ s := s + '(';
+ if ExpressionE.Text <> '' then
+ s := s + ExpressionE.Text
+ else if(DataSetCB.Selected <> nil) and (DataFieldCB.Selected <> nil) then
+ s := s + '<' + DataSetCB.Selected.Text + '."' + DataFieldCB.Selected.Text + '">';
+
+ if (DataBandCB.Selected <> nil) and (DataBandCB.Selected.Text <> '') then
+ begin
+ s := s + ',' + DataBandCB.Selected.Text;
+ if i <> 0 then
+ s := s + ',' + IntToStr(i);
+ end;
+ s := s + ')';
+ end
+ else
+ begin
+ s := s + '(';
+ if (DataBandCB.Selected <> nil) then
+ s := s + DataBandCB.Selected.Text;
+ if i <> 0 then
+ s := s + ',' + IntToStr(i);
+ s := s + ')';
+ end;
+
+ Result := s;
+end;
+
+procedure TfrxSysMemoEditorForm.FillDataBandCB;
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+{$IFDEF DELPHI23}
+ DataBandCB.Clear;
+{$ELSE}
+ DataBandCB.Items.Clear;
+{$ENDIF}
+ for i := 0 to FReport.Designer.Objects.Count - 1 do
+ begin
+ c := FReport.Designer.Objects[i];
+ if c is TfrxDataBand then
+ DataBandCB.Items.Add(c.Name);
+ end;
+end;
+
+procedure TfrxSysMemoEditorForm.FillDataSetCB;
+begin
+ FReport.GetDataSetList(DataSetCB.Items);
+end;
+
+procedure TfrxSysMemoEditorForm.FillDataFieldCB;
+var
+ ds: TfrxDataSet;
+begin
+ ds := FReport.GetDataSet(DataSetCB.Selected.Text);
+ if ds <> nil then
+ ds.GetFieldList(DataFieldCB.Items) else
+{$IFDEF DELPHI23}
+ DataFieldCB.Clear;
+{$ELSE}
+ DataFieldCB.Items.Clear;
+{$ENDIF}
+end;
+
+procedure TfrxSysMemoEditorForm.DataBandCBChange(Sender: TObject);
+var
+ b: TfrxDataBand;
+begin
+ b := nil;
+ if DataBandCB.Selected <> nil then
+ b := FReport.Designer.Page.FindObject(DataBandCB.Selected.Text) as TfrxDataBand;
+ if (DataSetCB.Selected <> nil) and (b <> nil) and (b.DataSet <> nil) and not (b.DataSet is TfrxUserDataSet) then
+ begin
+ DataSetCB.Selected.Text := FReport.GetAlias(b.DataSet);
+ DataSetCBChange(nil);
+ end;
+end;
+
+procedure TfrxSysMemoEditorForm.DataSetCBChange(Sender: TObject);
+begin
+ FillDataFieldCB;
+ ExpressionE.Text := '';
+ UpdateSample;
+end;
+
+procedure TfrxSysMemoEditorForm.DataFieldCBChange(Sender: TObject);
+begin
+ ExpressionE.Text := '';
+ UpdateSample;
+end;
+
+procedure TfrxSysMemoEditorForm.ExpressionEButtonClick(Sender: TObject);
+var
+ s: String;
+begin
+ s := TfrxCustomDesigner(Owner).InsertExpression(ExpressionE.Text);
+ if s <> '' then
+ ExpressionE.Text := s;
+ UpdateSample;
+end;
+
+procedure TfrxSysMemoEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+begin
+ if ModalResult = mrOk then
+ begin
+ if (SysVariableRB.IsChecked) and (SysVariableCB.Selected <> nil) then
+ FText := SysVariableCB.Selected.Text
+ else if AggregateRB.IsChecked then
+ FText := '[' + CreateAggregate + ']'
+ else
+ FText := TextE.Text
+ end;
+end;
+
+procedure TfrxSysMemoEditorForm.FormCreate(Sender: TObject);
+var
+ i: Integer;
+begin
+ Caption := frxGet(3300);
+ DataBandL.Text := frxGet(3301);
+ DataSetL.Text := frxGet(3302);
+ DataFieldL.Text := frxGet(3303);
+ FunctionL.Text := frxGet(3304);
+ ExpressionL.Text := frxGet(3305);
+ OKB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ AggregateRB.Text := frxGet(3306);
+ SysVariableRB.Text := frxGet(3307);
+ CountInvisibleCB.Text := frxGet(3308);
+ TextRB.Text := frxGet(3309);
+ RunningTotalCB.Text := frxGet(3310);
+ FunctionCB.BeginUpdate;
+ FunctionCB.Items.Add('SUM');
+ FunctionCB.Items.Add('MIN');
+ FunctionCB.Items.Add('MAX');
+ FunctionCB.Items.Add('AVG');
+ FunctionCB.Items.Add('COUNT');
+ FunctionCB.EndUpdate;
+ for i := 1 to 6 do
+ SysVariableCB.Items.Add(frxResources.Get('vt' + IntToStr(i)));
+ FormShow(Self);
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxSysMemoEditorForm.UpdateSample;
+begin
+ if AggregateRB.IsChecked then
+ SampleL.Text := CreateAggregate
+ else
+ SampleL.Text := '';
+end;
+
+procedure TfrxSysMemoEditorForm.FunctionCBChange(Sender: TObject);
+begin
+ UpdateSample;
+end;
+
+procedure TfrxSysMemoEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+end.
+
diff --git a/LibD28x64/FMX.frxEditTabOrder.fmx b/LibD28x64/FMX.frxEditTabOrder.fmx
new file mode 100644
index 0000000..5c15a76
--- /dev/null
+++ b/LibD28x64/FMX.frxEditTabOrder.fmx
@@ -0,0 +1,58 @@
+object frxTabOrderEditorForm: TfrxTabOrderEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Tab Order'
+ BorderStyle = bsSingle
+ BorderIcons = [biSystemMenu]
+ ClientHeight = 215
+ ClientWidth = 303
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnClose = FormClose
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object Label1: TLabel
+ Position.Point = '(8,8)'
+ Width = 131.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object OkB: TButton
+ Position.Point = '(220,28)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(220,56)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 2
+ ModalResult = 2
+ Cancel = True
+ end
+ object UpB: TButton
+ Position.Point = '(220,100)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = UpBClick
+ TabOrder = 3
+ end
+ object DownB: TButton
+ Position.Point = '(220,128)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ OnClick = DownBClick
+ TabOrder = 4
+ end
+ object ControlsLB: TListBox
+ Position.Point = '(8,28)'
+ Width = 201.000000000000000000
+ Height = 177.000000000000000000
+ TabOrder = 5
+ ItemHeight = 13.000000000000000000
+ end
+end
diff --git a/LibD28x64/FMX.frxEditTabOrder.pas b/LibD28x64/FMX.frxEditTabOrder.pas
new file mode 100644
index 0000000..3ebd771
--- /dev/null
+++ b/LibD28x64/FMX.frxEditTabOrder.pas
@@ -0,0 +1,166 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Tab order editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditTabOrder;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.Layouts, FMX.ListBox, FMX.Types
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+type
+ TfrxTabOrderEditorForm = class(TForm)
+ OkB: TButton;
+ CancelB: TButton;
+ Label1: TLabel;
+ UpB: TButton;
+ DownB: TButton;
+ ControlsLB: TListBox;
+ procedure FormCreate(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure UpBClick(Sender: TObject);
+ procedure DownBClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ private
+ FOldOrder: TList;
+ FParent: TfrxComponent;
+ procedure UpdateOrder;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxRes;
+
+
+constructor TfrxTabOrderEditorForm.Create(AOwner: TComponent);
+begin
+ inherited;
+ FOldOrder := TList.Create;
+end;
+
+destructor TfrxTabOrderEditorForm.Destroy;
+begin
+ FOldOrder.Free;
+ inherited;
+end;
+
+procedure TfrxTabOrderEditorForm.FormClose(Sender: TObject;
+ var Action: TCloseAction);
+var
+ i: Integer;
+begin
+ if ModalResult <> mrOk then
+ for i := 0 to FOldOrder.Count - 1 do
+ FParent.Objects[i] := FOldOrder[i];
+end;
+
+procedure TfrxTabOrderEditorForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(5400);
+ Label1.Text := frxGet(5401);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ UpB.Text := frxGet(5402);
+ DownB.Text := frxGet(5403);
+ FormShow(Self);
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxTabOrderEditorForm.FormShow(Sender: TObject);
+var
+ i: Integer;
+ l: TList;
+begin
+ if TfrxCustomDesigner(Owner).SelectedObjects.Count = 0 then
+ FParent := TfrxCustomDesigner(Owner).Page
+ else
+ FParent := TfrxCustomDesigner(Owner).SelectedObjects[0];
+ l := FParent.Objects;
+ for i := 0 to l.Count - 1 do
+ begin
+ FOldOrder.Add(l[i]);
+ if (TObject(l[i]) is TfrxDialogControl) and
+ (TfrxDialogControl(l[i]).Control is TControl) then
+ ControlsLB.Items.AddObject(TfrxDialogControl(l[i]).Name + ': ' +
+ TfrxDialogControl(l[i]).GetDescription, l[i]);
+ end;
+end;
+
+
+procedure TfrxTabOrderEditorForm.UpdateOrder;
+var
+ i: Integer;
+ c: TfrxDialogControl;
+begin
+ { TabOrder is self-arranged property, set it to big values to avoid conflicts }
+ for i := 0 to ControlsLB.Items.Count - 1 do
+ begin
+ c := TfrxDialogControl(ControlsLB.Items.Objects[i]);
+ c.Control.TabOrder := 1000 + i;
+ end;
+ { set to normal values }
+ for i := 0 to ControlsLB.Items.Count - 1 do
+ begin
+ c := TfrxDialogControl(ControlsLB.Items.Objects[i]);
+ c.Control.TabOrder := i;
+ end;
+end;
+
+procedure TfrxTabOrderEditorForm.UpBClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ i := ControlsLB.ItemIndex;
+ if (i = -1) or (i = 0) then Exit;
+
+ FParent.Objects.Exchange(FParent.Objects.IndexOf(ControlsLB.Items.Objects[i]),
+ FParent.Objects.IndexOf(ControlsLB.Items.Objects[i - 1]));
+ ControlsLB.Items.Exchange(i, i - 1);
+ ControlsLB.ItemIndex := i - 1;
+ UpdateOrder;
+end;
+
+procedure TfrxTabOrderEditorForm.DownBClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ i := ControlsLB.ItemIndex;
+ if (i = -1) or (i = ControlsLB.Items.Count - 1) then Exit;
+
+ FParent.Objects.Exchange(FParent.Objects.IndexOf(ControlsLB.Items.Objects[i]),
+ FParent.Objects.IndexOf(ControlsLB.Items.Objects[i + 1]));
+ ControlsLB.Items.Exchange(i, i + 1);
+ ControlsLB.ItemIndex := i + 1;
+ UpdateOrder;
+end;
+
+procedure TfrxTabOrderEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+end.
diff --git a/LibD28x64/FMX.frxEditVar.fmx b/LibD28x64/FMX.frxEditVar.fmx
new file mode 100644
index 0000000..e17688c
--- /dev/null
+++ b/LibD28x64/FMX.frxEditVar.fmx
@@ -0,0 +1,189 @@
+object frxVarEditorForm: TfrxVarEditorForm
+ Left = 0
+ Top = 0
+ Caption = 'Edit Variables'
+ BorderIcons = [biSystemMenu, biMinimize, biMaximize, biHelp]
+ ClientHeight = 548
+ ClientWidth = 532
+ Visible = False
+ OnCreate = FormCreate
+ OnDestroy = FormDestroy
+ OnActivate = FormActivate
+ OnKeyDown = FormKeyDown
+ OnResize = Splitter2Moved
+ StyleLookup = 'backgroundstyle'
+ object Splitter1: TSplitter
+ Align = alBottom
+ Cursor = crVSplit
+ Position.Point = '(0,469)'
+ Width = 532.000000000000000000
+ Height = 3.000000000000000000
+ TabOrder = 0
+ MinSize = 20.000000000000000000
+ end
+ object Splitter2: TSplitter
+ Align = alRight
+ Cursor = crHSplit
+ Position.Point = '(129,31)'
+ Width = 3.000000000000000000
+ Height = 421.000000000000000000
+ TabOrder = 1
+ MinSize = 20.000000000000000000
+ end
+ object ToolBar: TToolBar
+ Width = 532.000000000000000000
+ Height = 31.000000000000000000
+ TabOrder = 2
+ object NewCategoryB: TfrxToolButton
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = NewCategoryBClick
+ TabOrder = 0
+ end
+ object NewVarB: TfrxToolButton
+ Position.Point = '(23,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = NewVarBClick
+ TabOrder = 1
+ end
+ object EditB: TfrxToolButton
+ Position.Point = '(46,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = EditBClick
+ TabOrder = 2
+ end
+ object DeleteB: TfrxToolButton
+ Position.Point = '(69,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = DeleteBClick
+ TabOrder = 3
+ end
+ object EditListB: TfrxToolButton
+ Position.Point = '(92,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = EditListBClick
+ TabOrder = 4
+ end
+ object LoadB: TfrxToolButton
+ Position.Point = '(123,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = LoadBClick
+ TabOrder = 5
+ end
+ object SaveB: TfrxToolButton
+ Position.Point = '(146,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = SaveBClick
+ TabOrder = 6
+ end
+ object CancelB: TfrxToolButton
+ Position.Point = '(177,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = CancelBClick
+ TabOrder = 7
+ ModalResult = 2
+ end
+ object OkB: TfrxToolButton
+ Position.Point = '(200,0)'
+ Width = 22.000000000000000000
+ Height = 22.000000000000000000
+ OnClick = OkBClick
+ TabOrder = 8
+ ModalResult = 1
+ end
+ end
+ object ExprMemo: TMemo
+ Align = alBottom
+ Position.Point = '(0,472)'
+ Width = 532.000000000000000000
+ Height = 76.000000000000000000
+ OnChange = ExprMemoChange
+ OnDragOver = ExprMemoDragOver
+ OnDragDrop = ExprMemoDragDrop
+ OnEnter = ExprMemoEnter
+ TabOrder = 3
+ KeyboardType = vktDefault
+ end
+ object ExprPanel: TPanel
+ Align = alBottom
+ Position.Point = '(0,452)'
+ Width = 532.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 4
+ end
+ object Panel: TPanel
+ Align = alRight
+ Position.Point = '(132,31)'
+ Width = 400.000000000000000000
+ Height = 421.000000000000000000
+ TabOrder = 5
+ end
+ object OpenDialog1: TOpenDialog
+ DefaultExt = '.fd3'
+ Left = 368
+ Top = 104
+ end
+ object SaveDialog1: TSaveDialog
+ DefaultExt = '.fd3'
+ Left = 232
+ Top = 112
+ end
+ object VarTree: TfrxTreeView
+ Align = alClient
+ Position.Point = '(0,31)'
+ Width = 129.000000000000000000
+ Height = 421.000000000000000000
+ OnResize = VarTreeResize
+ TabOrder = 6
+ OnChange = VarTreeChange
+ OnBeforeChange = VarTreeChanging
+ Editable = False
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 0
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 1
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 2
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 3
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object TEdit
+ Width = 100.000000000000000000
+ Height = 22.000000000000000000
+ Visible = False
+ TabOrder = 4
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+end
diff --git a/LibD28x64/FMX.frxEditVar.pas b/LibD28x64/FMX.frxEditVar.pas
new file mode 100644
index 0000000..9f6a54f
--- /dev/null
+++ b/LibD28x64/FMX.frxEditVar.pas
@@ -0,0 +1,554 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Variables editor }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEditVar;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, System.Types, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.frxVariables, FMX.frxDataTree, FMX.Memo, FMX.Types, FMX.frxFMX,
+ FMX.Layouts, FMX.TreeView, System.Variants, FMX.Edit, FMX.frxBaseModalForm
+ {$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI22}
+ ,FMX.Memo.Types
+{$ENDIF}
+{$IFDEF DELPHI28}
+ , FMX.BaseTypeAliases, FMX.FormTypeAliases
+{$ENDIF};
+
+
+type
+ TfrxVarEditorForm = class(TfrxForm)
+ ToolBar: TToolBar;
+ NewCategoryB: TfrxToolButton;
+ NewVarB: TfrxToolButton;
+ EditB: TfrxToolButton;
+ DeleteB: TfrxToolButton;
+ EditListB: TfrxToolButton;
+ OkB: TfrxToolButton;
+ CancelB: TfrxToolButton;
+ ExprMemo: TMemo;
+ Splitter1: TSplitter;
+ Splitter2: TSplitter;
+ ExprPanel: TPanel;
+ LoadB: TfrxToolButton;
+ SaveB: TfrxToolButton;
+ OpenDialog1: TOpenDialog;
+ SaveDialog1: TSaveDialog;
+ Panel: TPanel;
+ VarTree: TfrxTreeView;
+ procedure FormShow(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ procedure DeleteBClick(Sender: TObject);
+ procedure NewCategoryBClick(Sender: TObject);
+ procedure NewVarBClick(Sender: TObject);
+ procedure OkBClick(Sender: TObject);
+ procedure EditBClick(Sender: TObject);
+ procedure VarTreeEdited(Sender: TObject; Node: TfrxTreeViewItem; var S: String);
+ procedure ExprMemoDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; var Accept: Boolean);
+ procedure ExprMemoDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+ procedure VarTreeChange(Sender: TObject);
+ procedure VarTreeChanging(Sender: TObject; OldNode: TfrxTreeViewItem; NewNode: TfrxTreeViewItem);
+ //procedure VarTreeChanging(Sender: TObject; Node: TTreeNode;
+ // var AllowChange: Boolean);
+ procedure CancelBClick(Sender: TObject);
+ procedure EditListBClick(Sender: TObject);
+ procedure FormHide(Sender: TObject);
+ procedure LoadBClick(Sender: TObject);
+ procedure SaveBClick(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ procedure Splitter2Moved(Sender: TObject);
+ procedure VarTreeResize(Sender: TObject);
+ procedure FormActivate(Sender: TObject);
+ procedure ExprMemoChange(Sender: TObject);
+ procedure ExprMemoEnter(Sender: TObject);
+ private
+ FReport: TfrxReport;
+ FUpdating: Boolean;
+ FVariables: TfrxVariables;
+ FDataTree: TfrxDataTreeForm;
+ FExprMemoModified: Boolean;
+ FNodeOldText: String;
+ function Root: TfrxTreeViewItem;
+ procedure CreateUniqueName(var s: String);
+ procedure FillVariables;
+ procedure UpdateItem0;
+ procedure OnDataTreeDblClick(Sender: TObject);
+ procedure VarTreeKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ public
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxEditStrings, FMX.frxUtils, FMX.frxRes, System.IniFiles;
+
+var
+ lastPosition: TPoint;
+
+
+procedure SetImageIndex(Node: TfrxTreeViewItem; Index: Integer);
+begin
+ Node.OpenImageIndex := Index;
+ Node.CloseImageIndex := Index;
+end;
+
+{ TfrxVarEditorForm }
+
+procedure TfrxVarEditorForm.FormActivate(Sender: TObject);
+begin
+ if FDataTree <> nil then FDataTree.FormResize(FDataTree);
+end;
+
+procedure TfrxVarEditorForm.FormCreate(Sender: TObject);
+begin
+
+ FReport := TfrxCustomDesigner(Owner).Report;
+ //VarTree.Images := frxResources.MainButtonImages;
+ //Toolbar.Images := VarTree.Images;
+ VarTree.Editable := True;
+ VarTree.OnKeyDown := VarTreeKeyDown;
+
+ FVariables := TfrxVariables.Create;
+ FVariables.Assign(FReport.Variables);
+
+ FDataTree := TfrxDataTreeForm.Create(Owner);
+ FDataTree.Report := FReport;
+ FDataTree.MainDataPanel.Parent := Self.Panel;
+ FDataTree.MainDataPanel.Align := TAlignLayout.alClient;
+ FDataTree.Visible := False;
+ FDataTree.MainDataPanel.OnDblClick := OnDataTreeDblClick;
+ //FDataTree.OnDblClick := OnDataTreeDblClick;
+ //FDataTree.SetControlsParent(Panel);
+ FDataTree.HintPanel.Height := 64;
+ FDataTree.UpdateItems;
+
+ Caption := frxGet(2900);
+ NewCategoryB.Hint := frxGet(2901);
+ NewVarB.Hint := frxGet(2902);
+ EditB.Hint := frxGet(2903);
+ DeleteB.Hint := frxGet(2904);
+ EditListB.Hint := frxGet(2905);
+ LoadB.Hint := frxGet(2906);
+ SaveB.Hint := frxGet(2907);
+ CancelB.Hint := frxGet(2);
+ OkB.Hint := frxGet(1);
+ OpenDialog1.Filter := frxGet(2909);
+ SaveDialog1.Filter := frxGet(2910);
+ VarTree.OnEdited := VarTreeEdited;
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+ FillVariables;
+ VarTree.SetFocus;
+ FDataTree.SetLastPosition(lastPosition);
+ frxResources.LoadImageFromResouce(NewCategoryB.Bitmap, 20, 2);
+ frxResources.LoadImageFromResouce(NewVarB.Bitmap, 6, 0);
+ frxResources.LoadImageFromResouce(EditB.Bitmap, 11, 3);
+ frxResources.LoadImageFromResouce(DeleteB.Bitmap, 5, 1);
+ frxResources.LoadImageFromResouce(EditListB.Bitmap, 10, 5);
+ frxResources.LoadImageFromResouce(LoadB.Bitmap, 0, 1);
+ frxResources.LoadImageFromResouce(SaveB.Bitmap, 0, 2);
+ frxResources.LoadImageFromResouce(CancelB.Bitmap, 21, 2);
+ frxResources.LoadImageFromResouce(OkB.Bitmap, 21, 0);
+ VarTree.SetImages(frxResources.Images);
+end;
+
+procedure TfrxVarEditorForm.FormDestroy(Sender: TObject);
+begin
+ FDataTree.Free;
+ FVariables.Free;
+end;
+
+procedure TfrxVarEditorForm.FormShow(Sender: TObject);
+//var
+// Ini: TCustomIniFile;
+begin
+// Ini := FReport.GetIniFile;
+// Ini.WriteBool('Form4.TfrxVarEditorForm', 'Visible', True);
+// frxRestoreFormPosition(Ini, Self);
+// ExprMemo.Height := Ini.ReadInteger('Form4.TfrxVarEditorForm', 'Split1Pos', 76);
+// Panel.Width := Ini.ReadInteger('Form4.TfrxVarEditorForm', 'Split2Pos', 400);
+// FDataTree.UpdateSize;
+// Ini.Free;
+
+
+end;
+
+procedure TfrxVarEditorForm.FormHide(Sender: TObject);
+//var
+// Ini: TCustomIniFile;
+begin
+// Ini := FReport.GetIniFile;
+// frxSaveFormPosition(Ini, Self);
+// Ini.WriteInteger('Form4.TfrxVarEditorForm', 'Split1Pos', ExprMemo.Height);
+// Ini.WriteInteger('Form4.TfrxVarEditorForm', 'Split2Pos', Panel.Width);
+// Ini.Free;
+ lastPosition := FDataTree.GetLastPosition;
+end;
+
+procedure TfrxVarEditorForm.OkBClick(Sender: TObject);
+begin
+ FExprMemoModified := True; //save variable's value if OkB pressed without leaving of ExprMemo
+ ModalResult := mrOk;
+ VarTree.Selected := VarTree.ItemByGlobalIndex(0);
+ FReport.Variables.Assign(FVariables);
+end;
+
+procedure TfrxVarEditorForm.CancelBClick(Sender: TObject);
+begin
+ ModalResult := mrCancel;
+end;
+
+function TfrxVarEditorForm.Root: TfrxTreeViewItem;
+begin
+ //VarTree.UpdateGlobalIndexes;
+// Result := TfrxTreeViewItem(VarTree.ItemByGlobalIndex(0));
+ Result := TfrxTreeViewItem(VarTree.Items[0]);
+end;
+
+procedure TfrxVarEditorForm.UpdateItem0;
+begin
+ if Root.Count = 0 then
+ Root.Text := frxResources.Get('vaNoVar') else
+ Root.Text := frxResources.Get('vaVar');
+end;
+
+procedure TfrxVarEditorForm.CreateUniqueName(var s: String);
+var
+ i: Integer;
+begin
+ i := 0;
+ repeat
+ Inc(i);
+ until FVariables.IndexOf(s + IntToStr(i)) = -1;
+ s := s + IntToStr(i);
+end;
+
+procedure TfrxVarEditorForm.FillVariables;
+var
+ i: Integer;
+ CategoriesList, VariablesList: TStrings;
+ Node: TfrxTreeViewItem;
+
+ procedure AddVariables(Node: TfrxTreeViewItem);
+ var
+ i: Integer;
+ Node1: TfrxTreeViewItem;
+ begin
+ for i := 0 to VariablesList.Count - 1 do
+ begin
+ Node1 := VarTree.AddItem(Node, VariablesList[i]);
+ SetImageIndex(Node1, 80);
+ end;
+ end;
+
+begin
+ FUpdating := True;
+ CategoriesList := TStringList.Create;
+ VariablesList := TStringList.Create;
+ FVariables.GetCategoriesList(CategoriesList);
+
+ VarTree.Clear;
+ VarTree.AddItem(VarTree, '');
+
+
+ SetImageIndex(Root, 66);
+ VarTree.BeginUpdate;
+ for i := 0 to CategoriesList.Count - 1 do
+ begin
+ FVariables.GetVariablesList(CategoriesList[i], VariablesList);
+ Node := VarTree.AddItem(Root, CategoriesList[i]);
+ SetImageIndex(Node, 66);
+ AddVariables(Node);
+ end;
+
+ if CategoriesList.Count = 0 then
+ begin
+ FVariables.GetVariablesList('', VariablesList);
+ AddVariables(Root);
+ end;
+ VarTree.EndUpdate;
+ UpdateItem0;
+ VarTree.ExpandAll;
+
+ CategoriesList.Free;
+ VariablesList.Free;
+ FUpdating := False;
+end;
+
+procedure TfrxVarEditorForm.DeleteBClick(Sender: TObject);
+var
+ Node: TTreeViewItem;
+begin
+ Node := VarTree.Selected;
+ if (Node = nil) or (Node = Root) then Exit;
+
+ FUpdating := True;
+ if Node.ParentItem <> Root then
+ FVariables.DeleteVariable(Node.Text) else
+ FVariables.DeleteCategory(Node.Text);
+ Node.Free;
+ FUpdating := False;
+ UpdateItem0;
+end;
+
+procedure TfrxVarEditorForm.NewCategoryBClick(Sender: TObject);
+var
+ Node: TfrxTreeViewItem;
+ s: String;
+begin
+ s := ' New Category';
+ CreateUniqueName(s);
+ VarTree.BeginUpdate;
+ Node := VarTree.AddItem(Root, Trim(s));
+ VarTree.EndUpdate;
+ SetImageIndex(Node, 66);
+ FVariables.Add.Name := s;
+ VarTree.ExpandAll;
+ UpdateItem0;
+end;
+
+procedure TfrxVarEditorForm.NewVarBClick(Sender: TObject);
+var
+ Node: TTreeViewItem;
+ s: String;
+begin
+ if Root.Count = 0 then Exit;
+ Node := VarTree.Selected;
+ if (Node = nil) or (Node = Root) then
+ Node := VarTree.ItemByGlobalIndex(Root.Count - 1)
+ else if (Node.ParentItem <> Root) and (Node.ParentItem is TTreeViewItem) then
+ Node := TTreeViewItem(Node.ParentItem);
+
+ s := 'New Variable';
+ CreateUniqueName(s);
+ FVariables.AddVariable(Node.Text, s, '');
+ VarTree.BeginUpdate;
+ Node := VarTree.AddItem(Node, s);
+ VarTree.EndUpdate;
+ SetImageIndex(TfrxTreeViewItem(Node), 80);
+
+ VarTree.ExpandAll;
+ UpdateItem0;
+end;
+
+procedure TfrxVarEditorForm.EditBClick(Sender: TObject);
+var
+ Node: TTreeViewItem;
+begin
+ Node := VarTree.Selected;
+ if (Node = nil) or (Node = Root) then Exit;
+ VarTree.DoEdit;
+end;
+
+procedure TfrxVarEditorForm.VarTreeEdited(Sender: TObject; Node: TfrxTreeViewItem; var S: String);
+var
+ s1, s2: String;
+begin
+ if (FNodeOldText = s) or (Root.Count = 0) then Exit;
+ s1 := s;
+ s2 := FNodeOldText;
+
+ if Node.ParentItem = Root then
+ begin
+ s1 := ' ' + s1;
+ s2 := ' ' + s2;
+ end;
+
+ if FVariables.IndexOf(s1) <> -1 then
+ begin
+ s := FNodeOldText;
+ frxErrorMsg(frxResources.Get('vaDupName'));
+ end
+ else
+ FVariables.Items[FVariables.IndexOf(s2)].Name := s1;
+end;
+
+procedure TfrxVarEditorForm.VarTreeKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ case Key of
+ vkInsert:
+ if not VarTree.IsEditing then
+ if Root.Count = 0 then
+ NewCategoryBClick(nil) else
+ NewVarBClick(nil);
+ vkDelete:
+ if not VarTree.IsEditing then
+ DeleteBClick(nil);
+ vkReturn, vkF2:
+ if not VarTree.IsEditing then
+ EditBClick(nil);
+ end;
+end;
+
+procedure TfrxVarEditorForm.VarTreeResize(Sender: TObject);
+begin
+ if Assigned(FDataTree) then
+ FDataTree.UpdateSize;
+end;
+
+procedure TfrxVarEditorForm.ExprMemoDragOver(Sender: TObject; const Data: TDragObject; const Point: TPointF; var Accept: Boolean);
+begin
+ Accept := (Data.Source is TTreeView) and (TControl(Data.Source).Owner = FDataTree) and
+ (FDataTree.GetFieldName <> '');
+end;
+
+procedure TfrxVarEditorForm.ExprMemoDragDrop(Sender: TObject; const Data: TDragObject; const Point: TPointF);
+var
+ SelStart: TCaretPosition;
+ SelLen: Integer;
+begin
+ SelLen := ExprMemo.SelLength;
+ SelStart := ExprMemo.TextPosToPos(ExprMemo.SelStart);
+ ExprMemo.DeleteFrom(SelStart, SelLen, []);
+ ExprMemo.InsertAfter(SelStart, FDataTree.GetFieldName, []);
+end;
+
+procedure TfrxVarEditorForm.ExprMemoEnter(Sender: TObject);
+begin
+ FExprMemoModified := False;
+end;
+
+procedure TfrxVarEditorForm.ExprMemoChange(Sender: TObject);
+begin
+ FExprMemoModified := True;
+end;
+
+procedure TfrxVarEditorForm.OnDataTreeDblClick(Sender: TObject);
+var
+ SelStart: TCaretPosition;
+ SelLen: Integer;
+begin
+ SelLen := ExprMemo.SelLength;
+ SelStart := ExprMemo.TextPosToPos(ExprMemo.SelStart);
+ ExprMemo.DeleteFrom(SelStart, SelLen, []);
+ ExprMemo.InsertAfter(SelStart, FDataTree.GetFieldName, []);
+end;
+
+procedure TfrxVarEditorForm.VarTreeChange(Sender: TObject);
+begin
+ if FUpdating then Exit;
+ FNodeOldText := VarTree.Selected.Text;
+ if (VarTree.Selected = nil) or (VarTree.Selected = Root) or (VarTree.Selected.ParentItem = Root) then
+ ExprMemo.Text := '' else
+ ExprMemo.Text := VarToStr(FVariables[VarTree.Selected.Text]);
+end;
+
+procedure TfrxVarEditorForm.VarTreeChanging(Sender: TObject; OldNode: TfrxTreeViewItem; NewNode: TfrxTreeViewItem);
+begin
+ if FUpdating then Exit;
+
+ if FExprMemoModified then
+ if not ((OldNode = nil) or (OldNode = Root) or (OldNode.ParentItem = Root) or (csDestroying in OldNode.ComponentState)) then
+ begin
+ FVariables[OldNode.Text] := ExprMemo.Text;
+ FExprMemoModified := False;
+ end;
+end;
+
+procedure TfrxVarEditorForm.EditListBClick(Sender: TObject);
+
+ procedure VarToStrings(Lines: TStrings);
+ var
+ i: Integer;
+ s: String;
+ begin
+ for i := 0 to FVariables.Count - 1 do
+ begin
+ s := FVariables.Items[i].Name;
+ if s <> '' then
+ if s[1] = ' ' then
+ s := Copy(s, 2, 255) else
+ s := ' ' + s;
+ Lines.Add(s);
+ end;
+ end;
+
+ procedure StringsToVar(Lines: TStrings);
+ var
+ i: Integer;
+ v: TfrxVariables;
+ s: String;
+ begin
+ v := TfrxVariables.Create;
+ for i := 0 to Lines.Count - 1 do
+ begin
+ s := Lines[i];
+ if Trim(s) <> '' then
+ begin
+ if s[1] = ' ' then
+ s := Copy(s, 2, 255) else
+ s := ' ' + s;
+ if FVariables.IndexOf(s) <> -1 then
+ v[s] := FVariables[s] else
+ v[s] := '';
+ end;
+ end;
+
+ FVariables.Assign(v);
+ FillVariables;
+ v.Free;
+ end;
+
+begin
+ with TfrxStringsEditorForm.Create(Owner) do
+ begin
+ VarToStrings(Memo.Lines);
+ if ShowModal = mrOk then
+ StringsToVar(Memo.Lines);
+ VarTree.Selected := VarTree.ItemByGlobalIndex(0);
+ Free;
+ end;
+end;
+
+procedure TfrxVarEditorForm.LoadBClick(Sender: TObject);
+begin
+ if OpenDialog1.Execute then
+ begin
+ FVariables.LoadFromFile(OpenDialog1.FileName);
+ FillVariables;
+ end;
+ PeekLastModalResult;
+end;
+
+procedure TfrxVarEditorForm.SaveBClick(Sender: TObject);
+begin
+ VarTree.Selected := VarTree.Items[0];
+ if SaveDialog1.Execute then
+ FVariables.SaveToFile(SaveDialog1.FileName);
+ PeekLastModalResult;
+end;
+
+procedure TfrxVarEditorForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if (Shift = [ssCtrl]) and (Key = vkReturn) then
+ OkBClick(nil);
+ if Key = VKESCAPE then
+ CancelBClick(nil);
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+procedure TfrxVarEditorForm.Splitter2Moved(Sender: TObject);
+begin
+ if FDataTree <> nil then FDataTree.UpdateSize;
+end;
+
+end.
diff --git a/LibD28x64/FMX.frxEngine.pas b/LibD28x64/FMX.frxEngine.pas
new file mode 100644
index 0000000..70d297f
--- /dev/null
+++ b/LibD28x64/FMX.frxEngine.pas
@@ -0,0 +1,2810 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Report engine }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEngine;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.Variants, System.UITypes, System.Types,
+ FMX.Forms,
+ FMX.frxClass, FMX.frxAggregate, FMX.frxXML, FMX.frxDMPClass;
+
+
+type
+ { TfrxHeaderList holds a set of bands that should appear on each new page.
+ This includes page header, column header and header bands with
+ "Reprint on new page" setting }
+
+ TfrxHeaderListItem = class(TObject)
+ public
+ Band: TfrxBand;
+ Left: Extended;
+ IsInKeepList: Boolean;
+ end;
+
+ TfrxHeaderList = class(TObject)
+ private
+ FList: TList;
+ function GetCount: Integer;
+ function GetItems(Index: Integer): TfrxHeaderListItem;
+ public
+ constructor Create;
+ destructor Destroy; override;
+ procedure Clear;
+ procedure AddItem(ABand: TfrxBand; ALeft: Extended; AInKeepList: Boolean);
+ procedure RemoveItem(ABand: TfrxBand);
+ property Count: Integer read GetCount;
+ property Items[Index: Integer]: TfrxHeaderListItem read GetItems; default;
+ end;
+
+ TfrxEngine = class(TfrxCustomEngine)
+ private
+ FAggregates: TfrxAggregateList;
+ FCallFromAddPage: Boolean;
+ FCallFromEndPage: Boolean;
+ FCurBand: TfrxBand;
+ FLastBandOnPage: TfrxBand;
+ FDontShowHeaders: Boolean;
+ FHeaderList: TfrxHeaderList; { list of header bands }
+ FFirstReportPage: Boolean; { needed for correct setting of PreviewPages.FirstPage }
+ FFirstColumnY: Extended; { position of the first column }
+ FIsFirstBand: Boolean; { needed for KeepTogether }
+ FIsFirstPage: Boolean; { first and last page flags }
+ FIsLastPage: Boolean; { }
+ FTitlePrinted: Boolean;
+ FHBandNamesTree: TStrings; { need for correct work with drill down in master-detail-subtetail-... }
+ FKeepBand: TfrxBand;
+ FKeepFooter: Boolean;
+ FKeeping: Boolean;
+ FKeepHeader: Boolean;
+ FKeepCurY: Extended; { need when group doesn't fit on the whole page}
+ FPrevFooterHeight: Extended; {need for correct freespace calculation when use printOnPreviousPage}
+ FKeepOutline: TfrxXMLItem;
+ FKeepPosition: Integer;
+ FKeepAnchor: Integer;
+ FCallFromPHeader: Boolean; { endless loop fix }
+ FOutputTo: TfrxNullBand; { used in the subreports }
+ FPage: TfrxReportPage; { currently proceeded page }
+ FPageCurX: Extended;
+ FStartNewPageBand: TfrxBand; { needed in addpage }
+ FVHeaderList: TList; { list of vheader bands }
+ FVMasterBand: TfrxBand; { master hband for vbands }
+ FVPageList: TList; { list of page breaks for vbands }
+ FFastCanvas: TObject;
+ procedure AddBandOutline(Band: TfrxBand);
+ procedure AddColumn;
+ procedure AddPage;
+ procedure AddPageOutline;
+ procedure AddToHeaderList(Band: TfrxBand);
+ procedure AddToVHeaderList(Band: TfrxBand);
+ procedure CheckBandColumns(Band: TfrxDataBand; ColumnKeepPos: Integer;
+ SaveCurY: Extended);
+ procedure CheckDrill(Master: TfrxDataBand; Band: TfrxGroupHeader);
+ procedure CheckGroups(Master: TfrxDataBand; Band: TfrxGroupHeader;
+ ColumnKeepPos: Integer; SaveCurY: Extended);
+ procedure CheckSubReports(Band: TfrxBand);
+ procedure CheckSuppress(Band: TfrxBand);
+ procedure DoShow(Band: TfrxBand);
+ procedure DrawSplit(Band: TfrxBand);
+ procedure EndColumn;
+ procedure EndKeep(Band: TfrxBand);
+ procedure InitGroups(Master: TfrxDataBand; Band: TfrxGroupHeader;
+ Index: Integer; ResetLineN: Boolean = False);
+ procedure InitPage;
+ procedure NotifyObjects(Band: TfrxBand);
+ procedure OutlineRoot;
+ procedure OutlineUp(Band: TfrxBand);
+ procedure PreparePage(ErrorList: TStrings; PrepareVBands: Boolean);
+ procedure PrepareShiftTree(Band: TfrxBand);
+ procedure RemoveFromHeaderList(Band: TfrxBand);
+ procedure RemoveFromVHeaderList(Band: TfrxBand);
+ procedure ResetSuppressValues(Band: TfrxBand);
+ procedure RunPage(Page: TfrxReportPage);
+ procedure RunReportPages;
+ procedure ShowGroupFooters(Band: TfrxGroupHeader; Index: Integer; Master: TfrxDataBand);
+ procedure ShowVBands(HBand: TfrxBand);
+ procedure StartKeep(Band: TfrxBand; Position: Integer = 0);
+ procedure Stretch(Band: TfrxBand);
+ procedure UnStretch(Band: TfrxBand);
+ function CanShow(Obj: TObject; PrintIfDetailEmpty: Boolean): Boolean;
+ function FindBand(Band: TfrxBandClass): TfrxBand;
+ function RunDialogs: Boolean;
+ protected
+ function GetPageHeight: Double; override;
+ public
+ constructor Create(AReport: TfrxReport); override;
+ destructor Destroy; override;
+ procedure EndPage; override;
+ procedure NewColumn; override;
+ procedure NewPage; override;
+ function Run: Boolean; override;
+ procedure ShowBand(Band: TfrxBand); overload; override;
+ procedure ShowBand(Band: TfrxBandClass); overload; override;
+ function HeaderHeight: Double; override;
+ function FooterHeight: Double; override;
+ function FreeSpace: Double; override;
+ procedure BreakAllKeep; override; { used in crosstab }
+ function GetAggregateValue(const Name, Expression: String;
+ Band: TfrxBand; Flags: Integer): Variant; override;
+ function Initialize: Boolean;
+ procedure Finalize;
+ end;
+
+
+implementation
+
+uses
+ FMX.frxUtils, FMX.frxPreviewPages, FMX.frxRes, FMX.frxFMX;
+
+type
+ THackComponent = class(TfrxComponent);
+ THackMemoView = class(TfrxCustomMemoView);
+
+
+{ TfrxHeaderList }
+
+constructor TfrxHeaderList.Create;
+begin
+ FList := TList.Create;
+end;
+
+destructor TfrxHeaderList.Destroy;
+begin
+ Clear;
+ FList.Free;
+ inherited;
+end;
+
+procedure TfrxHeaderList.Clear;
+begin
+ while FList.Count > 0 do
+ begin
+ TObject(FList[0]).Free;
+ FList.Delete(0);
+ end;
+end;
+
+function TfrxHeaderList.GetCount: Integer;
+begin
+ Result := FList.Count;
+end;
+
+function TfrxHeaderList.GetItems(Index: Integer): TfrxHeaderListItem;
+begin
+ Result := FList[Index];
+end;
+
+procedure TfrxHeaderList.AddItem(ABand: TfrxBand; ALeft: Extended; AInKeepList: Boolean);
+var
+ Item: TfrxHeaderListItem;
+begin
+ Item := TfrxHeaderListItem.Create;
+ Item.Band := ABand;
+ Item.Left := ALeft;
+ Item.IsInKeepList := AInKeepList;
+ FList.Add(Item);
+end;
+
+procedure TfrxHeaderList.RemoveItem(ABand: TfrxBand);
+var
+ i: Integer;
+begin
+ for i := 0 to Count - 1 do
+ if Items[i].Band = ABand then
+ begin
+ Items[i].Free;
+ FList.Delete(i);
+ break;
+ end;
+end;
+
+
+{ TfrxEngine }
+
+constructor TfrxEngine.Create(AReport: TfrxReport);
+begin
+ inherited;
+ FHeaderList := TfrxHeaderList.Create;
+ FVHeaderList := TList.Create;
+ FVPageList := TList.Create;
+ FAggregates := TfrxAggregateList.Create(AReport);
+ FHBandNamesTree := TStringList.Create;
+ FLastBandOnPage := nil;
+ FFastCanvas := nil;
+ if frxCanvasClass <> nil then
+ FFastCanvas := frxCanvasClass.Create;
+end;
+
+destructor TfrxEngine.Destroy;
+begin
+ FHeaderList.Free;
+ FVHeaderList.Free;
+ FVPageList.Free;
+ FAggregates.Free;
+ FHBandNamesTree.Free;
+ if Assigned(FFastCanvas) then
+ FFastCanvas.Free;
+ inherited;
+end;
+
+function TfrxEngine.Initialize: Boolean;
+var
+ i, j: Integer;
+ b: TfrxDataBand;
+begin
+ FPrevFooterHeight := 0;
+ PreviewPages.Initialize;
+ PreviewPages.AddPageAction := apAdd;
+ StartDate := Date;
+ StartTime := Time;
+ Running := True;
+ FKeeping := False;
+ CurVColumn := 0;
+ FOutputTo := nil;
+
+ { clear all aggregate items }
+ FAggregates.Clear;
+
+ { add all report pages to the PreviewPages }
+ for i := 0 to Report.PagesCount - 1 do
+ if Report.Pages[i] is TfrxReportPage then
+ begin
+ { set the current page }
+ FPage := TfrxReportPage(Report.Pages[i]);
+ { create band tree for the current page }
+ PreparePage(Report.Errors, False);
+ PreparePage(Report.Errors, True);
+ end;
+
+ { check datasets used }
+ for i := 0 to Report.PagesCount - 1 do
+ if Report.Pages[i] is TfrxReportPage then
+ begin
+ FPage := TfrxReportPage(Report.Pages[i]);
+ if (Report.DataSet <> nil) and (Report.DataSet = FPage.DataSet) then
+ begin
+ Report.Errors.Add('Cannot use the same dataset for Report.DataSet and Page.DataSet');
+ break;
+ end;
+ for j := 0 to FPage.FSubBands.Count - 1 do
+ begin
+ b := FPage.FSubBands[j];
+ if (b <> nil) and (b.DataSet <> nil) then
+ if Report.DataSet = b.DataSet then
+ begin
+ Report.Errors.Add('Cannot use the same dataset for Report.DataSet and Band.DataSet');
+ break;
+ end
+ else if FPage.DataSet = b.DataSet then
+ begin
+ Report.Errors.Add('Cannot use the same dataset for Page.DataSet and Band.DataSet');
+ break;
+ end
+ end;
+ end;
+
+ Result := Report.Errors.Count = 0;
+end;
+
+procedure TfrxEngine.Finalize;
+begin
+ try
+ Report.DataSets.Finalize;
+ finally
+ PreviewPages.Finish;
+ Running := False;
+ end;
+end;
+
+function TfrxEngine.Run: Boolean;
+var
+ i: Integer;
+begin
+ Result := False;
+ try
+ if Initialize then
+ try
+ Report.DataSets.Initialize;
+ Report.DoNotifyEvent(Report, Report.OnStartReport);
+ if RunDialogs then
+ begin
+ Result := True;
+
+ { add all report pages to the PreviewPages }
+ for i := 0 to Report.PagesCount - 1 do
+ if Report.Pages[i] is TfrxReportPage then
+ begin
+ FPage := TfrxReportPage(Report.Pages[i]);
+ PreviewPages.AddSourcePage(FPage);
+ { find aggregates }
+ FAggregates.AddItems(FPage);
+ end;
+
+ { start the report }
+ FinalPass := not DoublePass;
+ TotalPages := 0;
+ PreviewPages.BeginPass;
+ RunReportPages;
+ if DoublePass then
+ begin
+ TotalPages := PreviewPages.Count;
+ PreviewPages.CurPage := PreviewPages.Count - 1;
+ PreviewPages.ClearFirstPassPages;
+ FAggregates.ClearValues;
+ FinalPass := True;
+ RunReportPages;
+ end;
+ end
+ finally
+ Report.DoNotifyEvent(Report, Report.OnStopReport);
+ end;
+ finally
+ Finalize;
+ end;
+end;
+
+{$HINTS OFF}
+function TfrxEngine.RunDialogs: Boolean;
+var
+ i: Integer;
+ p: TfrxDialogPage;
+ v: Variant;
+begin
+ Result := True;
+{$IFNDEF FR_VER_BASIC}
+ if Trim(Report.OnRunDialogs) <> '' then
+ begin
+ v := VarArrayOf([True]);
+ Report.DoParamEvent(Report.OnRunDialogs, v);
+ Result := v[0];
+ end
+ else
+ for i := 0 to Report.PagesCount - 1 do
+ if (Report.Pages[i] is TfrxDialogPage) and Report.Pages[i].Visible then
+ begin
+ p := TfrxDialogPage(Report.Pages[i]);
+ { refresh the border style - it was bsSizeable in the designer }
+ p.DialogForm.BorderStyle := p.BorderStyle;
+ { don't show empty form }
+ if p.DialogForm.ChildrenCount <> 0 then
+ begin
+ if Assigned(OnRunDialog) then
+ OnRunDialog(p) else
+ p.ShowModal;
+ if p.ModalResult = mrCancel then
+ begin
+ Result := False;
+ break;
+ end;
+ end;
+ end;
+{$ENDIF}
+end;
+{$HINTS ON}
+
+procedure TfrxEngine.RunReportPages;
+
+ procedure DoPages;
+ var
+ i: Integer;
+ begin
+ for i := 0 to Report.PagesCount - 1 do
+ if Report.Pages[i] is TfrxReportPage then
+ begin
+ FPage := TfrxReportPage(Report.Pages[i]);
+ { ignore subreport pages and invisible pages }
+ if not FPage.IsSubReport and FPage.Visible then
+ RunPage(FPage);
+ if Report.Terminated then break;
+ FFirstReportPage := False;
+ end;
+ end;
+
+begin
+ FFirstReportPage := True;
+ if Report.DataSet = nil then
+ DoPages
+ else
+ begin
+ Report.DataSet.First;
+ while not Report.DataSet.Eof do
+ begin
+ if Report.Terminated then break;
+ DoPages;
+ Report.DataSet.Next;
+ end;
+ end;
+end;
+
+procedure TfrxEngine.PreparePage(ErrorList: TStrings; PrepareVBands: Boolean);
+var
+ i, j, k: Integer;
+ t, c: TfrxComponent;
+ b: TfrxBand;
+ Bands: TList;
+ SortBands: TStringList;
+
+ procedure ClearNils;
+ var
+ i: Integer;
+ begin
+ i := 0;
+ while i < Bands.Count do
+ if Bands[i] = nil then
+ Bands.Delete(i) else
+ Inc(i);
+ end;
+
+ procedure MakeTree(Obj: TObject; From: Integer);
+ var
+ i: Integer;
+ b: TfrxBand;
+ begin
+ if Obj is TfrxReportPage then
+ begin
+ { fill the first level - TfrxReportPage.FMasterBands }
+ for i := 0 to Bands.Count - 1 do
+ begin
+ b := Bands[i];
+ if b = nil then continue;
+ if b is TfrxMasterData then
+ begin
+// if TfrxDataBand(b).DataSet <> nil then { ignore empty datasets }
+ if PrepareVBands then
+ TfrxReportPage(Obj).FVSubBands.Add(b)
+ else
+ TfrxReportPage(Obj).FSubBands.Add(b);
+ Bands[i] := nil;
+ MakeTree(b, i + 1);
+ end;
+ end;
+ end
+ else
+ begin
+ { fill next levels - TfrxBand.FSubBands }
+ for i := From to Bands.Count - 1 do
+ begin
+ b := Bands[i];
+ if b = nil then continue;
+ { looking for sub-level bands }
+ if b.BandNumber = TfrxBand(Obj).BandNumber + 1 then
+ begin
+// if TfrxDataBand(b).DataSet <> nil then { ignore empty datasets }
+ TfrxBand(Obj).FSubBands.Add(b);
+ Bands[i] := nil;
+ if not (b is TfrxDataBand6) then
+ MakeTree(b, i + 1);
+ end
+ else if b.BandNumber <= TfrxBand(Obj).BandNumber then
+ break; { found higher-level data band }
+ end;
+ end;
+ end;
+
+ procedure ConnectHeaders;
+ var
+ i: Integer;
+ b1, b2: TfrxBand;
+ begin
+ for i := 0 to Bands.Count - 1 do
+ begin
+ b1 := Bands[i];
+ { looking for data band }
+ if b1 is TfrxDataBand then
+ begin
+ if i > 0 then
+ begin
+ b2 := Bands[i - 1];
+ if b2 is TfrxHeader then { if top band is header, connect it }
+ begin
+ b1.FHeader := b2;
+ Bands[i - 1] := nil;
+ end;
+ end;
+
+ if i < Bands.Count - 1 then { if bottom band is footer, connect it }
+ begin
+ b2 := Bands[i + 1];
+ if b2 is TfrxFooter then
+ begin
+ b1.FFooter := b2;
+ Bands[i + 1] := nil;
+ end;
+ end;
+ end;
+ end;
+
+ ClearNils;
+ { now all headers/footers must be connected. If not, add an error }
+ for i := 0 to Bands.Count - 1 do
+ begin
+ b1 := Bands[i];
+ if (b1 is TfrxHeader) or (b1 is TfrxFooter) then
+ begin
+ ErrorList.Add(frxResources.Get('enUnconnHeader') + ' ' + b1.Name);
+ Bands[i] := nil;
+ end;
+ end;
+
+ ClearNils;
+ end;
+
+ procedure ConnectGroups;
+ var
+ i, j: Integer;
+ b1, b2: TfrxBand;
+ begin
+ { connect group headers }
+ i := 0;
+ while i < Bands.Count do
+ begin
+ b1 := Bands[i];
+ if b1 is TfrxGroupHeader then
+ begin
+ b1.FSubBands.Add(b1);
+ Inc(i);
+ { add all subsequent headers to the first header's FSubBands }
+ while (i < Bands.Count) and (TfrxBand(Bands[i]) is TfrxGroupHeader) do
+ begin
+ b1.FSubBands.Add(Bands[i]);
+ Inc(i);
+ end;
+
+ { search for databand }
+ while (i < Bands.Count) and not (TfrxBand(Bands[i]) is TfrxDataBand) do
+ Inc(i);
+
+ { now we expect to see the databand }
+ if (i = Bands.Count) or not (TObject(Bands[i]) is TfrxDataBand) then
+ ErrorList.Add(frxResources.Get('enUnconnGroup') + ' ' + b1.Name)
+ else
+ TfrxBand(Bands[i]).FGroup := b1;
+ end
+ else
+ Inc(i);
+ end;
+
+ { connect group footers }
+ for i := 0 to Bands.Count - 1 do
+ begin
+ b1 := Bands[i];
+ if b1 is TfrxGroupFooter then
+ for j := i - 1 downto 0 do
+ begin
+ b2 := Bands[j];
+ if b2 is TfrxGroupHeader then { connect to top-nearest header }
+ begin
+ b2.FFooter := b1;
+ Bands[i] := nil;
+ Bands[j] := nil;
+ break;
+ end;
+ end;
+ end;
+
+ { remove header bands from the list }
+ for i := 0 to Bands.Count - 1 do
+ begin
+ b1 := Bands[i];
+ if b1 is TfrxGroupHeader then
+ Bands[i] := nil;
+ end;
+
+ { looking for footers w/o corresponding header }
+ for i := 0 to Bands.Count - 1 do
+ begin
+ b1 := Bands[i];
+ if b1 is TfrxGroupFooter then
+ begin
+ ErrorList.Add(frxResources.Get('enUnconnGFooter') + ' ' + b1.Name);
+ Bands[i] := nil;
+ end;
+ end;
+
+ ClearNils;
+ end;
+
+begin
+ SortBands := TfrxStringList.Create;
+ SortBands.Sorted := True;
+
+ { align all objects with Align property <> baNone }
+ FPage.AlignChildren;
+
+ { clear all page SubBands }
+ if PrepareVBands then
+ FPage.FVSubBands.Clear
+ else
+ FPage.FSubBands.Clear;
+
+ for i := 0 to FPage.Objects.Count - 1 do
+ begin
+ t := FPage.Objects[i];
+ if t is TfrxBand then
+ begin
+ b := TfrxBand(t);
+ if b.Vertical <> PrepareVBands then
+ continue;
+ PrepareShiftTree(b);
+ b.FSubBands.Clear;
+ b.FHeader := nil;
+ b.FFooter := nil;
+ b.FGroup := nil;
+ b.FHasVBands := False;
+ if b is TfrxDataBand then
+ if (TfrxDataBand(b).DataSet = nil) and (TfrxDataBand(b).RowCount > 0) then
+ begin
+ TfrxDataBand(b).DataSet := TfrxDataBand(b).VirtualDataSet;
+ TfrxDataBand(b).DataSet.Initialize;
+ end;
+
+ { connect objects to vertical bands }
+ if (not PrepareVBands) and not (b is TfrxOverlay) then
+ for j := 0 to FPage.Objects.Count - 1 do
+ begin
+ t := FPage.Objects[j];
+ if (t is TfrxBand) and TfrxBand(t).Vertical then
+ begin
+ k := 0;
+ while k < b.Objects.Count do
+ begin
+ c := b.Objects[k];
+ if (c.Left >= t.Left - 1e-4) and
+ (c.Left + c.Width <= t.Left + t.Width + 1e-4) then
+ begin
+ b.FHasVBands := True;
+ c.Parent := t;
+ THackComponent(c).FOriginalBand := b;
+ c.Left := c.Left - t.Left;
+ end
+ else
+ Inc(k);
+ end;
+ end;
+ end;
+ end;
+ end;
+
+ { sort bands by position }
+ for i := 0 to FPage.Objects.Count - 1 do
+ begin
+ t := FPage.Objects[i];
+ if t is TfrxBand then
+ begin
+ b := TfrxBand(t);
+ if b.Vertical <> PrepareVBands then
+ continue;
+ if b.BandNumber in [4..13] then
+ if b.Vertical then
+ SortBands.AddObject(Format('%9.2f', [b.Left]), b)
+ else
+ SortBands.AddObject(Format('%9.2f', [b.Top]), b);
+ end;
+ end;
+
+ { copy sorted items to TList - it's easier to work with it }
+ Bands := TList.Create;
+ for i := 0 to SortBands.Count - 1 do
+ begin
+ t := TfrxComponent(SortBands.Objects[i]);
+ Bands.Add(t);
+ end;
+
+ SortBands.Free;
+
+ ConnectGroups;
+ ConnectHeaders;
+ MakeTree(FPage, 0);
+
+ ClearNils;
+ for i := 0 to Bands.Count - 1 do
+ begin
+ t := Bands[i];
+ ErrorList.Add(frxResources.Get('enBandPos') + ' ' + t.Name);
+ end;
+
+ Bands.Free;
+end;
+
+procedure TfrxEngine.PrepareShiftTree(Band: TfrxBand);
+var
+ i, j, k: Integer;
+ c0, c1, c2, top: TfrxReportComponent;
+ allObjects: TStringList;
+ Found: Boolean;
+ area0, area1, area2, area01: TfrxRectArea;
+begin
+ if Band.FShiftChildren.Count <> 0 then
+ Exit;
+
+ allObjects := TfrxStringList.Create;
+ allObjects.Duplicates := dupAccept;
+
+ { temporary top object }
+ top := TfrxMemoView.Create(nil);
+ top.SetBounds(0, Band.Top-2, Band.Width, 1);
+
+ { sort objects }
+ for i := 0 to Band.Objects.Count - 1 do
+ begin
+ c0 := Band.Objects[i];
+ allObjects.AddObject(Format('%9.2f', [c0.Top]), c0);
+ c0.FShiftChildren.Clear;
+ end;
+ allObjects.Sort;
+ allObjects.InsertObject(0, Format('%10.2f', [top.Top]), top);
+
+ for i := 0 to allObjects.Count - 1 do
+ begin
+ c0 := TfrxReportComponent(allObjects.Objects[i]);
+ area0 := TfrxRectArea.Create(c0);
+
+ { find an object under c0 }
+ for j := i + 1 to allObjects.Count - 1 do
+ begin
+ c1 := TfrxReportComponent(allObjects.Objects[j]);
+ area1 := TfrxRectArea.Create(c1);
+
+ if not (area0.InterceptsY(area1)) and (area0.Y < area1.Y) and
+ area0.InterceptsX(area1) then
+ begin
+ area01 := area0.InterceptX(area1);
+ Found := False;
+
+ { check if there is no other objects between c1 and c0 }
+ for k := j - 1 downto i + 1 do
+ begin
+ c2 := TfrxReportComponent(allObjects.Objects[k]);
+ area2 := TfrxRectArea.Create(c2);
+
+ if not (area0.InterceptsY(area2)) and not (area1.InterceptsY(area2)) and
+ area01.InterceptsX(area2) then
+ Found := True;
+
+ area2.Free;
+ if Found then
+ break;
+ end;
+
+ if not Found then
+ c0.FShiftChildren.Add(c1);
+
+ area01.Free;
+ end;
+
+ area1.Free;
+ end;
+
+ area0.Free;
+ end;
+
+ { copy children from the top object to the band }
+ Band.FShiftChildren.Clear;
+ for i := 0 to top.FShiftChildren.Count - 1 do
+ Band.FShiftChildren.Add(top.FShiftChildren[i]);
+
+ allObjects.Free;
+ top.Free;
+end;
+
+function TfrxEngine.CanShow(Obj: TObject; PrintIfDetailEmpty: Boolean): Boolean;
+var
+ i: Integer;
+ Bands: TList;
+ b: TfrxDataBand;
+ res: Boolean;
+begin
+ if Obj is TfrxReportPage then
+ Bands := TfrxReportPage(Obj).FSubBands else
+ Bands := TfrxBand(Obj).FSubBands;
+
+ Result := True;
+ { Check all subdetail bands to ensure they all have records }
+ if not PrintIfDetailEmpty then
+ begin
+ Result := False;
+ if (Bands.Count = 0) and not (Obj is TfrxPage) then
+ Result := True;
+
+ for i := 0 to Bands.Count - 1 do
+ begin
+ b := Bands[i];
+ if b.DataSet <> nil then
+ begin
+ Report.DoNotifyEvent(b, b.OnMasterDetail);
+ b.DataSet.First;
+
+ while not b.DataSet.Eof do
+ begin
+ res := CanShow(b, b.PrintIfDetailEmpty);
+ if res then
+ begin
+ Result := True;
+ break;
+ end
+ else
+ b.DataSet.Next;
+ end;
+ end;
+ end;
+ end;
+end;
+
+procedure TfrxEngine.ResetSuppressValues(Band: TfrxBand);
+var
+ i: Integer;
+begin
+ for i := 0 to Band.Objects.Count - 1 do
+ if TObject(Band.Objects[i]) is TfrxCustomMemoView then
+ THackMemoView(Band.Objects[i]).FLastValue := Null;
+end;
+
+procedure TfrxEngine.InitGroups(Master: TfrxDataBand; Band: TfrxGroupHeader;
+ Index: Integer; ResetLineN: Boolean = False);
+var
+ i: Integer;
+ b: TfrxGroupHeader;
+begin
+ for i := Index to Band.FSubBands.Count - 1 do
+ begin
+ b := Band.FSubBands[i];
+ if ResetLineN then
+ begin
+ b.FLineN := 1;
+ b.FLineThrough := 1;
+ ResetSuppressValues(b);
+ end
+ else
+ begin
+ Inc(b.FLineN);
+ if i < Band.FSubBands.Count - 1 then
+ TfrxBand(Band.FSubBands[i + 1]).FLineN := 0;
+ Inc(b.FLineThrough);
+ end;
+ end;
+
+ CheckDrill(Master, Band);
+
+ for i := Index to Band.FSubBands.Count - 1 do
+ begin
+ b := Band.FSubBands[i];
+ CurLine := b.FLineN;
+ CurLineThrough := b.FLineThrough;
+ Report.CurObject := b.Name;
+ b.FLastValue := Report.Calc(b.Condition);
+ if b.KeepTogether then
+ StartKeep(b);
+ ShowBand(b);
+ AddBandOutline(b);
+ if b.Vertical then
+ AddToVHeaderList(b)
+ else
+ AddToHeaderList(b);
+ end;
+end;
+
+procedure TfrxEngine.ShowGroupFooters(Band: TfrxGroupHeader; Index: Integer;
+ Master: TfrxDataBand);
+var
+ i: Integer;
+ b: TfrxGroupHeader;
+begin
+ for i := Band.FSubBands.Count - 1 downto Index do
+ begin
+ b := Band.FSubBands[i];
+ if b.FFooter <> nil then
+ if not TfrxGroupFooter(b.FFooter).HideIfSingleDataRecord or (Master.FLineN > 2) then
+ ShowBand(b.FFooter)
+ else
+ FAggregates.Reset(b.FFooter);
+
+ OutlineUp(b);
+ if b.Vertical then
+ RemoveFromVHeaderList(b)
+ else
+ RemoveFromHeaderList(b);
+ if b.KeepTogether then
+ EndKeep(b);
+ end;
+end;
+
+procedure TfrxEngine.CheckDrill(Master: TfrxDataBand; Band: TfrxGroupHeader);
+var
+ i, j: Integer;
+ b, b1: TfrxGroupHeader;
+ drillVisible: Boolean;
+ BandNamesList: TStrings;
+begin
+ BandNamesList := FHBandNamesTree;
+
+ for i := 0 to Band.FSubBands.Count - 1 do
+ begin
+ b := Band.FSubBands[i];
+ if b.DrillDown then
+ begin
+ b.DrillName := '';
+ for j := 0 to BandNamesList.Count - 1 do
+ b.DrillName := b.DrillName + BandNamesList[j] + '.' + IntToStr(Integer(BandNamesList.Objects[j])) + '.';
+ b.DrillName := b.DrillName + b.Name + '.' + IntToStr(b.FLineThrough);
+ drillVisible := Report.DrillState.IndexOf(b.DrillName) <> -1;
+ if b.ExpandDrillDown then
+ drillVisible := not DrillVisible;
+ if (b.Child <> nil) and not Band.ShowChildIfDrillDown then
+ b.Child.Visible := drillVisible;
+ for j := i + 1 to Band.FSubBands.Count - 1 do
+ begin
+ b1 := Band.FSubBands[j];
+ b1.Visible := drillVisible;
+ if b1.FFooter <> nil then
+ b1.FFooter.Visible := drillVisible;
+ end;
+ Master.Visible := drillVisible;
+ if not b.ShowFooterIfDrillDown and (b.FFooter <> nil) then
+ b.FFooter.Visible := drillVisible;
+ if not drillVisible then
+ break;
+ end;
+ end;
+end;
+
+procedure TfrxEngine.CheckGroups(Master: TfrxDataBand; Band: TfrxGroupHeader;
+ ColumnKeepPos: Integer; SaveCurY: Extended);
+var
+ i: Integer;
+ b: TfrxGroupHeader;
+ NextNeeded: Boolean;
+begin
+ CheckDrill(Master, Band);
+
+ for i := 0 to Band.FSubBands.Count - 1 do
+ begin
+ b := Band.FSubBands[i];
+
+ Report.CurObject := b.Name;
+ if Report.Calc(b.Condition) <> b.FLastValue then
+ begin
+ Master.CurColumn := Master.Columns;
+ CheckBandColumns(Master, ColumnKeepPos, SaveCurY);
+
+ { avoid exception in uni-directional datasets }
+ NextNeeded := True;
+ try
+ Master.DataSet.Prior;
+ except
+ NextNeeded := False;
+ end;
+ ShowGroupFooters(Band, i, Master);
+ if NextNeeded then
+ Master.DataSet.Next;
+
+ InitGroups(Master, Band, i);
+ Master.FLineN := 1;
+ ResetSuppressValues(Master);
+ break;
+ end;
+ end;
+end;
+
+procedure TfrxEngine.CheckBandColumns(Band: TfrxDataBand; ColumnKeepPos: Integer;
+ SaveCurY: Extended);
+begin
+ if Band.Columns > 1 then
+ begin
+ { collect max position in b.FMaxY }
+ if CurY > Band.FMaxY then
+ Band.FMaxY := CurY;
+ { all columns have been printed }
+ if Band.CurColumn >= Band.Columns then
+ begin
+ { need page break, don't break if page has Endless Height}
+ if ((PageHeight - FooterHeight) - Band.FMaxY <= 1e-4) and (not FPage.EndlessHeight) then
+ begin
+ if FKeeping then { standard keep procedure }
+ NewColumn
+ else
+ begin
+ PreviewPages.CutObjects(ColumnKeepPos);
+ NewColumn;
+ PreviewPages.PasteObjects(CurX, CurY);
+ CurY := CurY + Band.FMaxY - SaveCurY;
+ end;
+ end
+ else
+ CurY := Band.FMaxY; { start the new band from saved b.FMaxY }
+ end
+ else
+ CurY := SaveCurY; { start the new band from saved SaveCurY }
+ if Band.Visible then
+ Band.CurColumn := Band.CurColumn + 1;
+ end;
+end;
+
+procedure TfrxEngine.NotifyObjects(Band: TfrxBand);
+var
+ i: Integer;
+ c: TfrxComponent;
+begin
+ for i := 0 to NotifyList.Count - 1 do
+ begin
+ c := NotifyList[i];
+ if c <> nil then
+ c.OnNotify(Band);
+ end;
+end;
+
+procedure TfrxEngine.RunPage(Page: TfrxReportPage);
+var
+ PageCount: Integer;
+{$IFNDEF MSWINDOWS}
+ bIDLE: Boolean;
+{$ENDIF}
+ { "Null" band contains all free-placed objects that don't have a parent band }
+ procedure ShowNullBand;
+ var
+ i: Integer;
+ b: TfrxNullBand;
+ SaveCurY: Extended;
+ begin
+ b := TfrxNullBand.Create(nil);
+ b.Width := PageWidth;
+ b.Height := PageHeight;
+ SaveCurY := CurY;
+ for i := 0 to FPage.Objects.Count - 1 do
+ if not (TObject(FPage.Objects[i]) is TfrxBand) then
+ b.Objects.Add(FPage.Objects[i]);
+ try
+ b.AlignChildren;
+ ShowBand(b);
+ finally
+ CurY := SaveCurY;
+ b.Objects.Clear;
+ b.Free;
+ end;
+ end;
+
+ { Band tree is the structure that we created in the PreparePage method }
+ procedure ShowBandTree(Obj: TObject);
+ var
+ i: Integer;
+ Bands: TList;
+ b: TfrxDataBand;
+ FirstTime: Boolean;
+ FooterKeepPos, ColumnKeepPos: Integer;
+ SaveCurY: Extended;
+ begin
+ if not Report.EngineOptions.EnableThreadSafe then
+{$IFDEF MSWINDOWS}
+ Application.ProcessMessages;
+{$ELSE}
+ Application.DoIdle(bIDLE);
+{$ENDIF}
+ if Report.Terminated then Exit;
+
+ FooterKeepPos := 0;
+ ColumnKeepPos := 0;
+ SaveCurY := CurY;
+ if Obj is TfrxReportPage then
+ Bands := TfrxReportPage(Obj).FSubBands else
+ Bands := TfrxBand(Obj).FSubBands;
+
+ for i := 0 to Bands.Count - 1 do
+ begin
+ b := Bands[i];
+ if b.DataSet = nil then
+ continue;
+ b.DataSet.First;
+ b.FLineN := 1;
+ b.FLineThrough := 1;
+ b.CurColumn := 1;
+ FirstTime := True;
+ ResetSuppressValues(b);
+
+ while not b.DataSet.Eof do
+ begin
+ if CanShow(b, b.PrintIfDetailEmpty) then
+ begin
+ if FirstTime then
+ begin
+ if b.KeepHeader and (b.FHeader <> nil) then
+ begin
+ if FIsFirstBand then
+ FIsFirstBand := not FTitlePrinted;
+ FKeepHeader := not FIsFirstBand;
+ StartKeep(b);
+ end;
+ AddToHeaderList(b.FHeader);
+ ShowBand(b.FHeader);
+ if b.KeepTogether then
+ StartKeep(b);
+
+ end
+ { keeping a master-detail differs from keeping a group }
+ else if (b.FGroup = nil) and b.KeepTogether then
+ StartKeep(b);
+
+ if b.FGroup <> nil then
+ if FirstTime then
+ InitGroups(b, TfrxGroupHeader(b.FGroup), 0, True) else
+ CheckGroups(b, TfrxGroupHeader(b.FGroup), ColumnKeepPos, SaveCurY);
+
+ if b.KeepFooter then
+ FooterKeepPos := PreviewPages.GetCurPosition;
+ if (b.Columns > 1) and (b.CurColumn = 1) then
+ ColumnKeepPos := PreviewPages.GetCurPosition;
+
+ SaveCurY := CurY;
+ CurLine := b.FLineN;
+ CurLineThrough := b.FLineThrough;
+ ShowBand(b);
+ FKeepHeader := False;
+ NotifyObjects(b);
+
+ if FirstTime then
+ if b.KeepHeader and (b.FHeader <> nil) then
+ EndKeep(b);
+ FirstTime := False;
+
+ FHBandNamesTree.AddObject(b.Name, TObject(b.FLineThrough));
+ Inc(b.FLineN);
+ Inc(b.FLineThrough);
+ CheckBandColumns(b, ColumnKeepPos, SaveCurY);
+ AddBandOutline(b);
+ ShowBandTree(b);
+ FHBandNamesTree.Delete(FHBandNamesTree.Count - 1);
+ OutlineUp(b);
+
+ FIsFirstBand := False;
+
+ if b.FooterAfterEach then
+ ShowBand(b.FFooter);
+ end;
+
+ { keeping a master-detail differs from keeping a group }
+ if (b.FGroup = nil) and b.KeepTogether then
+ EndKeep(b);
+ b.DataSet.Next;
+ if b.RowCount <> 0 then
+ if b.FLineN > b.RowCount then break;
+
+ if Report.Terminated then break;
+ end;
+
+ { update the CurY if band is multicolumn }
+ b.CurColumn := b.Columns;
+ CheckBandColumns(b, ColumnKeepPos, SaveCurY);
+
+ if not FirstTime then { some bands have been printed }
+ begin
+ if b.FGroup <> nil then
+ ShowGroupFooters(TfrxGroupHeader(b.FGroup), 0, b);
+
+ if FKeeping then
+ RemoveFromHeaderList(b.FHeader);
+
+ if not b.FooterAfterEach then
+ begin
+ if b.KeepFooter then
+ StartKeep(b, FooterKeepPos);
+ FKeepFooter := True;
+ ShowBand(b.FFooter);
+ if b.KeepFooter then
+ EndKeep(b);
+ FKeepFooter := False;
+ end;
+ RemoveFromHeaderList(b.FHeader);
+ if (b.FGroup <> nil) and b.KeepTogether then
+ EndKeep(b);
+ end;
+
+ if Report.Terminated then break;
+ FIsFirstBand := False;
+ end;
+ end;
+
+ procedure ShowPage;
+ var
+ pgWidth, pgHeight: Extended;
+ begin
+ if CanShow(FPage, Report.EngineOptions.PrintIfEmpty) then
+ begin
+ InitPage;
+ ShowNullBand;
+
+ if Assigned(Report.OnManualBuild) then
+ Report.OnManualBuild(FPage)
+ else if Trim(FPage.OnManualBuild) <> '' then
+ Report.DoNotifyEvent(FPage, FPage.OnManualBuild)
+ else
+ ShowBandTree(FPage);
+ FIsLastPage := True;
+ if FPage.EndlessHeight or FPage.EndlessWidth then
+ begin
+ if FPage.EndlessWidth then
+ pgWidth := PageWidth + FPage.LeftMargin * fr01cm + FPage.RightMargin * fr01cm
+ else
+ pgWidth := FPage.PaperWidth * fr01cm;
+ if FPage.EndlessHeight then
+ begin
+ PageHeight := CurY + FooterHeight;
+ pgHeight := PageHeight + FPage.TopMargin * fr01cm + FPage.BottomMargin * fr01cm
+ end
+ else
+ pgHeight := FPage.PaperHeight * fr01cm;
+ TfrxPreviewPages(PreviewPages).UpdatePageDimensions(FPage, pgWidth, pgHeight);
+ end;
+
+ EndPage;
+ FIsLastPage := False;
+ end;
+ end;
+
+begin
+ { The Page parameter needed only for subreport pages. General is FPage }
+ if Page.IsSubReport then
+ begin
+ ShowBandTree(Page);
+ Exit;
+ end;
+
+ FIsFirstBand := True;
+ Report.DoNotifyEvent(FPage, FPage.OnBeforePrint);
+
+ if FPage.DataSet <> nil then
+ begin
+ FPage.DataSet.First;
+
+ while not FPage.DataSet.Eof do
+ begin
+ if Report.Terminated then break;
+ ShowPage;
+ FPage.DataSet.Next;
+ end;
+ end
+ else
+ for PageCount := 1 to FPage.PageCount do
+ begin
+ if Report.Terminated then break;
+ ShowPage;
+ end;
+
+ Report.DoNotifyEvent(FPage, FPage.OnAfterPrint);
+end;
+
+procedure TfrxEngine.ShowVBands(HBand: TfrxBand);
+var
+ SavePageNo: Integer;
+ procedure ShowBandTree(Bands: TList);
+ var
+ i: Integer;
+ b: TfrxDataBand;
+ FirstTime: Boolean;
+ begin
+ if Report.Terminated then Exit;
+
+ for i := 0 to Bands.Count - 1 do
+ begin
+ b := Bands[i];
+ if b.DataSet = nil then
+ continue;
+ b.DataSet.First;
+ b.FLineN := 1;
+ b.FLineThrough := 1;
+ b.CurColumn := 1;
+ CurLine := b.FLineN;
+ CurLineThrough := b.FLineThrough;
+ FirstTime := True;
+ ResetSuppressValues(b);
+
+ while not b.DataSet.Eof do
+ begin
+ if FirstTime then
+ begin
+ ShowBand(b.FHeader);
+ AddToVHeaderList(b.FHeader);
+ end;
+
+ if b.FGroup <> nil then
+ if FirstTime then
+ InitGroups(b, TfrxGroupHeader(b.FGroup), 0, True) else
+ CheckGroups(b, TfrxGroupHeader(b.FGroup), 0, 0);
+
+ FirstTime := False;
+
+ CurLine := b.FLineN;
+ CurLineThrough := b.FLineThrough;
+ ShowBand(b);
+ NotifyObjects(b);
+ Inc(b.FLineN);
+ Inc(b.FLineThrough);
+ ShowBandTree(b.FSubBands);
+
+ if b.FooterAfterEach then
+ ShowBand(b.FFooter);
+
+ b.DataSet.Next;
+ if b.RowCount <> 0 then
+ if b.FLineN > b.RowCount then break;
+ if Report.Terminated then break;
+ end;
+
+ if b.FGroup <> nil then
+ ShowGroupFooters(TfrxGroupHeader(b.FGroup), 0, b);
+
+ if not FirstTime then { some bands have been printed }
+ begin
+ RemoveFromVHeaderList(b.FHeader);
+ if not b.FooterAfterEach then
+ ShowBand(b.FFooter);
+ end;
+
+ if Report.Terminated then break;
+ end;
+ end;
+
+begin
+ FVMasterBand := HBand;
+ FVMasterBand.FOriginalObjectsCount := FVMasterBand.Objects.Count;
+ FVMasterBand.AllowSplit := False;
+ SavePageNo := PreviewPages.CurPage;
+ FVHeaderList.Clear;
+ FVPageList.Clear;
+ FVPageList.Add(Pointer(0));
+
+ CurVColumn := 0;
+ ShowBandTree(TfrxReportPage(HBand.Page).FVSubBands);
+ FVPageList.Add(Pointer(FVMasterBand.Objects.Count));
+ PreviewPages.CurPage := SavePageNo;
+end;
+
+procedure TfrxEngine.InitPage;
+begin
+ { fill in the header/footer lists }
+ FHeaderList.Clear;
+ if FPage.TitleBeforeHeader then
+ begin
+ FHeaderList.AddItem(FindBand(TfrxReportTitle), 0, False);
+ FHeaderList.AddItem(FindBand(TfrxPageHeader), 0, False);
+ end
+ else
+ begin
+ FHeaderList.AddItem(FindBand(TfrxPageHeader), 0, False);
+ FHeaderList.AddItem(FindBand(TfrxReportTitle), 0, False);
+ end;
+
+ { calculating the page/footer sizes }
+ PageHeight := FPage.PaperHeight * fr01cm - FPage.TopMargin * fr01cm -
+ FPage.BottomMargin * fr01cm;
+ PageWidth := FPage.PaperWidth * fr01cm - FPage.LeftMargin * fr01cm -
+ FPage.RightMargin * fr01cm;
+
+ { reset the current position }
+ CurX := 0;
+ CurY := 0;
+ CurColumn := 1;
+ FPageCurX := 0;
+ FVMasterBand := nil;
+
+ FIsFirstPage := True;
+ FIsLastPage := False;
+ OutlineRoot;
+ if FPage.ResetPageNumbers then
+ PreviewPages.ResetLogicalPageNumber;
+
+ if (PreviewPages.Count = 0) or not FPage.PrintOnPreviousPage then
+ AddPage
+ else
+ begin
+ PreviewPages.CurPage := PreviewPages.Count - 1;
+ CurY := PreviewPages.GetLastY;
+ RemoveFromHeaderList(FindBand(TfrxReportTitle));
+ ShowBand(TfrxReportTitle);
+ end;
+
+ if FFirstReportPage then
+ PreviewPages.FirstPage := PreviewPages.CurPage;
+ FFirstColumnY := CurY;
+ ShowBand(TfrxColumnHeader);
+ FHeaderList.AddItem(FindBand(TfrxColumnHeader), 0, False);
+ RemoveFromHeaderList(FindBand(TfrxReportTitle));
+ AddPageOutline;
+end;
+
+function TfrxEngine.HeaderHeight: Double;
+var
+ Band: TfrxBand;
+begin
+ Result := 0;
+
+ Band := FindBand(TfrxColumnHeader);
+ while Band <> nil do
+ begin
+ Result := Result + Band.Height;
+ Band := Band.Child;
+ end;
+ Band := FindBand(TfrxPageHeader);
+ while Band <> nil do
+ begin
+ Result := Result + Band.Height;
+ Band := Band.Child;
+ end;
+end;
+
+function TfrxEngine.FooterHeight: Double;
+var
+ Band: TfrxBand;
+begin
+ Result := 0;
+
+ Band := FindBand(TfrxColumnFooter);
+ if Band <> nil then
+ Result := Result + Band.Height;
+ Band := FindBand(TfrxPageFooter);
+ if Band <> nil then
+ Result := Result + Band.Height;
+end;
+
+function TfrxEngine.FindBand(Band: TfrxBandClass): TfrxBand;
+begin
+ Result := FPage.FindBand(Band);
+end;
+
+procedure TfrxEngine.ShowBand(Band: TfrxBand);
+var
+ chBand: TfrxBand;
+begin
+ if Band <> nil then
+ begin
+ if Band.KeepChild then
+ StartKeep(Band);
+ DoShow(Band);
+ if (Band is TfrxDataBand) and (TfrxDataBand(Band).CurColumn > 1) then { dont show childs for columns}
+ chBand := nil
+ else
+ chBand := Band.Child;
+ if (chBand <> nil) and (Band.Visible or Band.PrintChildIfInvisible) then
+ ShowBand(chBand);
+ if Band.KeepChild then
+ EndKeep(Band);
+ if Band is TfrxDataBand then
+ FAggregates.AddValue(Band);
+ end;
+end;
+
+procedure TfrxEngine.ShowBand(Band: TfrxBandClass);
+begin
+ ShowBand(FindBand(Band));
+end;
+
+procedure TfrxEngine.AddToHeaderList(Band: TfrxBand);
+begin
+ { only header bands with "Reprint on new page" flag can be added }
+ if ((Band is TfrxHeader) and TfrxHeader(Band).ReprintOnNewPage) or
+ ((Band is TfrxGroupHeader) and TfrxGroupHeader(Band).ReprintOnNewPage) then
+ FHeaderList.AddItem(Band, FPageCurX, FKeeping and not (Band is TfrxHeader));
+end;
+
+procedure TfrxEngine.AddToVHeaderList(Band: TfrxBand);
+begin
+ { only header bands with "Reprint on new page" flag can be added }
+ if ((Band is TfrxHeader) and TfrxHeader(Band).ReprintOnNewPage) or
+ ((Band is TfrxGroupHeader) and TfrxGroupHeader(Band).ReprintOnNewPage) then
+ FVHeaderList.Add(Band);
+end;
+
+procedure TfrxEngine.BreakAllKeep;
+begin
+ inherited;
+ FKeepCurY := 0;
+ FKeeping := False;
+ FKeepBand := nil;
+ FAggregates.EndKeep;
+ FKeepHeader := False;
+end;
+
+procedure TfrxEngine.RemoveFromHeaderList(Band: TfrxBand);
+begin
+ if Band <> nil then
+ FHeaderList.RemoveItem(Band);
+end;
+
+procedure TfrxEngine.RemoveFromVHeaderList(Band: TfrxBand);
+begin
+ if Band <> nil then
+ FVHeaderList.Remove(Band);
+end;
+
+function TfrxEngine.FreeSpace: Double;
+begin
+ if FPage.EndlessHeight then
+ Result := 1e+6
+ else
+ if FPrevFooterHeight <> 0 then
+ Result := PageHeight - FPrevFooterHeight - CurY
+ else Result := PageHeight - FooterHeight - CurY;
+end;
+
+procedure TfrxEngine.Stretch(Band: TfrxBand);
+var
+ i: Integer;
+ h, maxh: Extended;
+ c, maxc: TfrxView;
+ HaveSub, NeedShift: Boolean;
+
+ procedure DoSubReports;
+ var
+ i: Integer;
+ SaveCurX, SaveCurY, SavePageCurX: Extended;
+ Sub: TfrxSubreport;
+ MainBand: Boolean;
+ AllObjects: TList;
+ c: TfrxComponent;
+ begin
+ { create a band which will accepts all subsequent output }
+ MainBand := False;
+ if FOutputTo = nil then
+ begin
+ Band.FOriginalObjectsCount := Band.Objects.Count;
+ FOutputTo := TfrxNullBand.Create(nil);
+ MainBand := True;
+ end;
+
+ { save the current position }
+ SaveCurX := CurX;
+ SaveCurY := CurY;
+ SavePageCurX := FPageCurX;
+
+ { looking for subreport objects }
+ for i := 0 to Band.Objects.Count - 1 do
+ if TObject(Band.Objects[i]) is TfrxSubreport then
+ begin
+ Sub := TfrxSubreport(Band.Objects[i]);
+ if not Sub.Visible or not Sub.PrintOnParent or not MainBand then continue;
+
+ { set up all properties... }
+ FPageCurX := SavePageCurX + Sub.Left;
+ CurX := Sub.Left;
+ CurY := Sub.Top;
+ { ...and run the subreport }
+ RunPage(Sub.Page);
+ end;
+
+ { restore saved position }
+ CurX := SaveCurX;
+ CurY := SaveCurY;
+ FPageCurX := SavePageCurX;
+
+ if MainBand then
+ begin
+ { copy all output to the band }
+ AllObjects := FOutputTo.AllObjects;
+
+ for i := 0 to AllObjects.Count - 1 do
+ begin
+ c := AllObjects[i];
+ if (c is TfrxView) and not (c is TfrxSubreport) then
+ begin
+ c.Left := c.AbsLeft;
+ c.Top := c.AbsTop;
+ c.ParentFont := False;
+ c.Parent := Band;
+ end;
+ if c is TfrxStretcheable then
+ TfrxStretcheable(c).StretchMode := smDontStretch;
+ end;
+
+ { Clear the FOutputTo property. Extra objects will be freed
+ in the Unstretch method. }
+ FOutputTo.Free;
+ FOutputTo := nil;
+ end;
+ end;
+
+ procedure ShiftObjects(Parent: TfrxReportComponent; Amount: Extended);
+ var
+ i: Integer;
+ v: TfrxView;
+ diff: Extended;
+ begin
+ for i := 0 to Parent.FShiftChildren.Count - 1 do
+ begin
+ v := Parent.FShiftChildren[i];
+ if v.ShiftMode = smAlways then
+ begin
+ v.Top := v.Top + Amount;
+ ShiftObjects(v, Amount + v.FShiftAmount);
+ end
+ else if v.ShiftMode = smWhenOverlapped then
+ begin
+ if not (Parent is TfrxBand) and (v.Top < Parent.Top + Parent.Height) then
+ begin
+ diff := Parent.Top + Parent.Height - v.Top;
+ v.Top := Parent.Top + Parent.Height;
+ ShiftObjects(v, diff + v.FShiftAmount);
+ end
+ else
+ ShiftObjects(v, v.FShiftAmount);
+ end
+ else {if v.FShiftAmount <> 0 then}
+ ShiftObjects(v, Amount + v.FShiftAmount);
+
+ v.FShiftAmount := 0;
+ end;
+ end;
+
+begin
+ FCurBand := Band;
+ HaveSub := False;
+ NeedShift := False;
+ PrepareShiftTree(Band);
+
+ { it is not necessary for vertical bands }
+ if Band <> FVMasterBand then
+ begin
+ { firing band OnBeforePrint event }
+ Report.CurObject := Band.Name;
+ Band.BeforePrint;
+ Report.DoBeforePrint(Band);
+ end;
+
+ { firing OnBeforePrint events, stretching objects }
+ for i := 0 to Band.Objects.Count - 1 do
+ begin
+ c := Band.Objects[i];
+ if (c is TfrxSubreport) and TfrxSubreport(c).PrintOnParent then
+ HaveSub := True;
+
+ { skip getdata for vertical bands' objects }
+ if (Band <> FVMasterBand) or (i < Band.FOriginalObjectsCount) then
+ begin
+ Report.CurObject := c.Name;
+ c.BeforePrint;
+ if Band.Visible then
+ begin
+ Report.DoBeforePrint(c);
+ if c.Visible then
+ begin
+ c.GetData;
+ Report.DoNotifyEvent(c, c.OnAfterData);
+ end;
+ end;
+ end;
+ if not Band.Visible or not c.Visible then continue;
+
+ if (c is TfrxStretcheable) and (TfrxStretcheable(c).StretchMode <> smDontStretch) then
+ begin
+ TfrxStretcheable(c).SetFastCanvas(TfrxFastCanvaslayer(FFastCanvas));
+ h := TfrxStretcheable(c).CalcHeight;
+ TfrxStretcheable(c).SetFastCanvas(nil);
+ if h > c.Height then
+ begin
+ c.FShiftAmount := h - c.Height; { needed to shift underlying objects }
+ c.Height := h; { stretch the object }
+ NeedShift := True;
+ end
+ else
+ c.FShiftAmount := 0;
+ end;
+ end;
+
+ if not Band.Visible then Exit;
+
+ { shift objects }
+ if NeedShift then
+ ShiftObjects(Band, 0);
+
+ { check subreports that have PrintOnParent option }
+ if HaveSub then
+ DoSubReports;
+
+ { calculate the max height of the band }
+ maxh := 0;
+ maxc := nil;
+ for i := 0 to Band.Objects.Count - 1 do
+ begin
+ c := Band.Objects[i];
+ if c.Top + c.Height > maxh then
+ begin
+ maxh := c.Top + c.Height;
+ maxc := c;
+ end;
+ end;
+ if (maxc <> nil) and (maxc is TfrxDMPMemoView) and
+ (ftBottom in TfrxDMPMemoView(maxc).Frame.Typ) then
+ maxh := maxh + fr1CharY;
+ if Band.Stretched then
+ Band.Height := maxh;
+
+ { fire Band.OnAfterCalcHeight event }
+ Report.CurObject := Band.Name;
+ Report.DoNotifyEvent(Band, Band.OnAfterCalcHeight);
+
+ { set the height of objects that should stretch to max height }
+ for i := 0 to Band.Objects.Count - 1 do
+ begin
+ c := Band.Objects[i];
+ if (c is TfrxStretcheable) and (TfrxStretcheable(c).StretchMode = smMaxHeight) then
+ begin
+ c.Height := maxh - c.Top;
+ if (c is TfrxDMPMemoView) and (ftBottom in TfrxDMPMemoView(c).Frame.Typ) then
+ c.Height := c.Height - fr1CharY;
+ end;
+ end;
+end;
+
+procedure TfrxEngine.UnStretch(Band: TfrxBand);
+var
+ i: Integer;
+ c: TfrxView;
+begin
+ { fire OnAfterPrint event }
+ if Band.Visible then
+ for i := 0 to Band.Objects.Count - 1 do
+ begin
+ c := Band.Objects[i];
+ Report.CurObject := c.Name;
+ Report.DoAfterPrint(c);
+ end;
+
+ { restore state }
+
+ for i := 0 to Band.Objects.Count - 1 do
+ if (Band <> FVMasterBand) or (i < Band.FOriginalObjectsCount) then
+ begin
+ c := Band.Objects[i];
+ c.AfterPrint;
+ end
+ else break;
+
+
+ Report.CurObject := Band.Name;
+ Report.DoAfterPrint(Band);
+ Band.AfterPrint;
+
+ { remove extra band objects if any }
+ if Band.FOriginalObjectsCount <> -1 then
+ begin
+ while Band.Objects.Count > Band.FOriginalObjectsCount do
+ TObject(Band.Objects[Band.Objects.Count - 1]).Free;
+ Band.FOriginalObjectsCount := -1;
+ end;
+end;
+
+procedure TfrxEngine.AddPage;
+var
+ i: Integer;
+ SaveCurX: Extended;
+ SaveCurLine, SaveCurLineThrough: Integer;
+ Band: TfrxBand;
+ IsHeaderBand: Boolean;
+begin
+ FPrevFooterHeight := 0;
+ PreviewPages.AddPage(FPage);
+ CurY := 0;
+ Band := FindBand(TfrxOverlay);
+ if (Band <> nil) and not TfrxOverlay(Band).PrintOnTop then
+ ShowBand(Band);
+
+ CurY := 0;
+ SaveCurX := CurX;
+ FFirstColumnY := 0;
+
+ for i := 0 to FHeaderList.Count - 1 do
+ begin
+ { use own CurX - we may be inside subreports now }
+ CurX := FHeaderList[i].Left;
+ Band := FHeaderList[i].Band;
+ if Band = FStartNewPageBand then
+ continue;
+
+ if FIsFirstPage and (Band is TfrxPageHeader) and
+ not TfrxPageHeader(Band).PrintOnFirstPage then
+ begin
+ if Band.PrintChildIfInvisible then
+ Band := Band.Child
+ else
+ continue;
+ end;
+
+ IsHeaderBand := (Band is TfrxHeader);
+ if Band <> nil then
+ if not (FKeepHeader and IsHeaderBand) and not FHeaderList[i].IsInKeepList or FKeepFooter
+ {or (FKeeping and (FKeepBand.FHeader = Band))} then
+ begin
+ if (IsHeaderBand and FDontShowHeaders) or (IsHeaderBand and (FLastBandOnPage = Band)) or
+ ((Band is TfrxGroupHeader) and FDontShowHeaders) then
+ continue;
+ Band.Overflow := True;
+ SaveCurLine := CurLine;
+ SaveCurLineThrough := CurLineThrough;
+ CurLine := Band.FLineN;
+ CurLineThrough := Band.FLineThrough;
+ FCallFromAddPage := True;
+ FCallFromPHeader := (Band is TfrxPageHeader);
+
+ { fix the stack overflow error if call NewPage from ReportTitle }
+ if Band is TfrxReportTitle then
+ FHeaderList[i].Band := nil;
+
+ ShowBand(Band);
+ { correct column y position }
+ if Band is TfrxPageHeader then
+ FFirstColumnY := Band.FStretchedHeight;
+
+ if (FIsFirstBand) and (Band is TfrxReportTitle) then
+ FTitlePrinted := True;
+ FCallFromPHeader := False;
+ FCallFromAddPage := False;
+ Band.Overflow := False;
+ CurLine := SaveCurLine;
+ CurLineThrough := SaveCurLineThrough;
+ end;
+ end;
+
+ CurX := SaveCurX;
+end;
+
+procedure TfrxEngine.EndPage;
+var
+ Band: TfrxBand;
+ Offset: Extended;
+
+ procedure ShowBand(Band: TfrxBand);
+ begin
+ if Band = nil then Exit;
+
+ Stretch(Band);
+ try
+ if Band.Visible then
+ begin
+ Band.Left := 0;
+ Band.Top := CurY;
+
+ if Band is TfrxPageFooter then
+ if (FIsFirstPage and not TfrxPageFooter(Band).PrintOnFirstPage) or
+ (FIsLastPage and not TfrxPageFooter(Band).PrintOnLastPage and not FCallFromEndPage) then
+ Exit;
+
+ if not PreviewPages.BandExists(Band) then
+ PreviewPages.AddObject(Band);
+ CurY := CurY + Band.Height;
+ end;
+ finally
+ UnStretch(Band);
+ end;
+
+ FAggregates.Reset(Band);
+ end;
+
+begin
+ if not FCallFromEndPage then
+ EndColumn;
+ if not FIsLastPage then
+ begin
+ CurX := FPageCurX;
+ CurColumn := 1;
+ end;
+
+ if FIsLastPage and not FCallFromEndPage then
+ begin
+ { avoid stack overflow if reportsummary does not fit on the page }
+ FCallFromEndPage := True;
+ try
+ Offset := CurY;
+ Band := FindBand(TfrxReportSummary);
+ Self.ShowBand(Band);
+ if (Band <> nil) and (FPage.EndlessHeight) then
+ begin
+ Offset := CurY - Offset;
+ PageHeight := PageHeight + Offset;
+ TfrxPreviewPages(PreviewPages).UpdatePageDimensions(FPage, PageWidth + FPage.LeftMargin * fr01cm + FPage.RightMargin * fr01cm, PageHeight + FPage.TopMargin * fr01cm + FPage.BottomMargin * fr01cm);
+ end;
+ finally
+ FCallFromEndPage := False;
+ end;
+ end;
+
+ Band := FindBand(TfrxPageFooter);
+ if Band <> nil then
+ begin
+ CurY := PageHeight - Band.Height;
+ if FIsLastPage and TfrxPageFooter(Band).PrintOnLastPage and not FCallFromEndPage then
+ FPrevFooterHeight := Band.Height
+ else FPrevFooterHeight := 0;
+ end;
+ ShowBand(Band);
+ Band := FindBand(TfrxOverlay);
+ if (Band <> nil) and TfrxOverlay(Band).PrintOnTop then
+ begin
+ CurY := 0;
+ ShowBand(Band);
+ end;
+
+ FIsFirstPage := False;
+end;
+
+procedure TfrxEngine.AddColumn;
+var
+ i: Integer;
+ AddX: Extended;
+
+ procedure DoShow(Band: TfrxBand);
+ begin
+ Band.Overflow := True;
+ Stretch(Band);
+
+ try
+ if Band.Visible then
+ begin
+ Band.Left := CurX;
+ Band.Top := CurY;
+ PreviewPages.AddObject(Band);
+ CurY := CurY + Band.Height;
+ end;
+ finally
+ UnStretch(Band);
+ Band.Overflow := False;
+ end;
+ end;
+
+ procedure ShowBand(Band: TfrxBand);
+ begin
+ while Band <> nil do
+ begin
+ DoShow(Band);
+ if Band.Visible or Band.PrintChildIfInvisible then
+ Band := Band.Child else
+ break;
+ end;
+ end;
+
+begin
+ CurColumn := CurColumn + 1;
+ AddX := frxStrToFloat(FPage.ColumnPositions[CurColumn - 1]) * fr01cm;
+ CurY := FFirstColumnY;
+
+ for i := 0 to FHeaderList.Count - 1 do
+ begin
+ CurX := FHeaderList[i].Left + AddX;
+ if not (FHeaderList[i].Band is TfrxPageHeader) {and ((FHeaderList[i].Band is TfrxHeader)} and
+ (FLastBandOnPage <> FHeaderList[i].Band) and not FHeaderList[i].IsInKeepList and not FKeepHeader then
+ ShowBand(FHeaderList[i].Band);
+ end;
+
+ CurX := FPageCurX + AddX;
+end;
+
+procedure TfrxEngine.EndColumn;
+var
+ Band: TfrxBand;
+begin
+ Band := FindBand(TfrxColumnFooter);
+ if Band = nil then Exit;
+
+ Stretch(Band);
+ try
+ if Band.Visible then
+ begin
+ Band.Left := CurX - FPageCurX;
+ Band.Top := CurY;
+ PreviewPages.AddObject(Band);
+ { move the current position }
+ CurY := CurY + Band.Height;
+ end;
+ finally
+ UnStretch(Band);
+ end;
+
+ FAggregates.Reset(Band);
+end;
+
+procedure TfrxEngine.NewPage;
+var
+ CorrPage: TfrxReportPage;
+ RepeatedHeader: TfrxBand;
+ LastY: Extended;
+begin
+ { keep objects doesn't fit on whole page, so break keeping and leave the objets }
+ if (FKeepBand <> nil) and (CurY - FKeepCurY + FKeepBand.Height > PageHeight - FooterHeight) then
+ begin
+ FKeeping := False;
+ FAggregates.EndKeep;
+ end;
+ RepeatedHeader := nil;
+
+ if FKeeping then
+ begin
+ if FKeepFooter then
+ FAggregates.DeleteValue(FKeepBand);
+ PreviewPages.CutObjects(FKeepPosition);
+ LastY := PreviewPages.GetLastY;
+ if (ABS(LastY - CurY) >= 1e-4) and (FCurBand is TfrxDataband) then
+ RepeatedHeader := TfrxDataband(FCurBand).FHeader;
+ RemoveFromHeaderList(RepeatedHeader);
+ end;
+ FLastBandOnPage := FCurBand;
+ EndPage;
+ { fix for report with several pages and EndlessHeight }
+ { data dictionary doesn't using in this case }
+ if FPage.EndlessHeight then
+ with TfrxPreviewPages(PreviewPages) do
+ begin
+ CorrPage := Page[Count - 1];
+ CorrPage.PaperWidth := PageWidth / fr01cm + FPage.LeftMargin + FPage.RightMargin;
+ CorrPage.PaperHeight := (CurY + FooterHeight) / fr01cm + FPage.TopMargin + FPage.BottomMargin;
+ CorrPage.PaperSize := 256;
+ ModifyPage(Count - 1, CorrPage);
+ end;
+ AddPage;
+ FLastBandOnPage := nil;
+ if FKeeping then
+ begin
+ FAggregates.EndKeep;
+ PreviewPages.PasteObjects(0, CurY);
+ PreviewPages.Outline.ShiftItems(FKeepOutline, Round(CurY));
+ PreviewPages.ShiftAnchors(FKeepAnchor, Round(CurY));
+// if (FKeepBand is TfrxDataBand) and (TfrxDataBand(FKeepBand).CurColumn = 1) then
+// FSaveCurY := CurY;
+ CurY := PreviewPages.GetLastY;
+ if FKeepFooter then
+ FAggregates.AddValue(FKeepBand);
+ AddToHeaderList(RepeatedHeader);
+ end;
+ FKeeping := False;
+ FKeepHeader := False;
+ FKeepCurY := 0;
+ AddPageOutline;
+end;
+
+procedure TfrxEngine.NewColumn;
+begin
+ if CurColumn >= FPage.Columns then
+ NewPage
+ else
+ begin
+ { keeping for columns }
+ if FKeeping then
+ begin
+ if FKeepFooter then
+ FAggregates.DeleteValue(FKeepBand);
+ PreviewPages.CutObjects(FKeepPosition);
+ CurY := PreviewPages.GetLastY;
+ end;
+ FLastBandOnPage := FCurBand;
+ EndColumn;
+ AddColumn;
+ FLastBandOnPage := nil;
+ if FKeeping then
+ begin
+ FAggregates.EndKeep;
+ PreviewPages.PasteObjects(CurX, CurY);
+ PreviewPages.Outline.ShiftItems(FKeepOutline, Round(CurY));
+ PreviewPages.ShiftAnchors(FKeepAnchor, Round(CurY));
+ { new version of GetLastY has one parameter by default = 0,}
+ { it determinate column position for correct Y out result. }
+ { if parameter = 0 ,then function return last position on the page, }
+ { in other cases it return last Y position on X coordinate .}
+ CurY := PreviewPages.GetLastY(CurX);
+ if FKeepFooter then
+ FAggregates.AddValue(FKeepBand);
+ end;
+ FKeeping := False;
+ FKeepHeader := False;
+ end;
+end;
+
+procedure TfrxEngine.DrawSplit(Band: TfrxBand);
+var
+ i, ObjCount: Integer;
+ List, SaveObjects, ShiftedList: TList;
+ View: TfrxView;
+ StrView: TfrxStretcheable;
+ CurHeight, Corr, SavedHeight: Extended;
+ ObjStretch, HasNextPart: Boolean;
+{$IFNDEF MSWINDOWS}
+ bIDLE: Boolean;
+{$ENDIF}
+ procedure ShiftObjects(TopView: TfrxView; Delta: Extended);
+ var
+ i: Integer;
+ View: TfrxView;
+ begin
+ for i := 0 to List.Count - 1 do
+ begin
+ View := List[i];
+ if (View <> TopView) and (ShiftedList.IndexOf(View) = -1) and
+ (View.Top >= TopView.Top + TopView.Height) and
+ // (View.Left < TopView.Left + TopView.Width) and
+ (TopView.Left + TopView.Width - View.Left > 1e-4) and // MB: 10212009
+ // (TopView.Left < View.Left + View.Width)
+ (View.Left + View.Width - TopView.Left > 1e-4) // MB: 10212009
+ then
+ begin
+ View.Top := View.Top + Delta;
+ ShiftedList.Add(View);
+ end;
+ end;
+ end;
+
+ procedure DrawPart;
+ var
+ i: Integer;
+ View: TfrxView;
+ begin
+ { draw current objects }
+ Band.Left := CurX;
+ Band.Top := CurY;
+ PreviewPages.AddObject(Band);
+ { add new column/page }
+ CurY := CurY + Band.Height;
+ FCurBand := Band;
+ if List.Count > 0 then NewColumn;
+ { correct the top coordinate of remained objects }
+ Band.Objects.Clear;
+ for i := 0 to List.Count - 1 do
+ begin
+ View := List[i];
+ View.Top := View.Top - CurHeight;
+ { restore the height of stretched objects }
+ if View is TfrxStretcheable then
+ begin
+ { there is no splited objects, correct top positions }
+ if not ObjStretch and (List.Count = ObjCount) then
+ View.Top := TfrxStretcheable(View).FSavedTop;
+
+ if View.Top < 0 then
+ View.Top := 0;
+ View.Height := TfrxStretcheable(View).FSaveHeight;
+ end;
+ end;
+ end;
+
+ procedure CalcBandHeight;
+ var
+ i: Integer;
+ View: TfrxView;
+ begin
+ Band.Height := 0;
+ { calculate the band's height }
+ for i := 0 to Band.Objects.Count - 1 do
+ begin
+ View := Band.Objects[i];
+ if View.Top + View.Height > Band.Height then
+ Band.Height := View.Top + View.Height;
+ end;
+
+ { correct objects with StretchToMaxHeight or BandAlign = baBottom }
+ if List.Count = 0 then
+ for i := 0 to Band.Objects.Count - 1 do
+ begin
+ View := Band.Objects[i];
+ if View.Align = baBottom then
+ View.Top := Band.Height - View.Height
+ else if (View is TfrxStretcheable) and
+ (TfrxStretcheable(View).StretchMode = smMaxHeight) then
+ View.Height := Band.Height - View.Top;
+ end;
+ end;
+
+begin
+ List := TList.Create;
+ SaveObjects := TList.Create;
+ ShiftedList := TList.Create;
+ ObjStretch := False;
+
+ { initializing lists }
+ for i := 0 to Band.Objects.Count - 1 do
+ begin
+ View := Band.Objects[i];
+ if not (View is TfrxSubreport) then
+ List.Add(View);
+ SaveObjects.Add(View);
+ if View is TfrxStretcheable then
+ begin
+ TfrxStretcheable(View).InitPart;
+ TfrxStretcheable(View).FSaveHeight := View.Height;
+ end;
+ end;
+
+ Band.Objects.Clear;
+ ObjCount := List.Count;
+
+ CurHeight := FreeSpace;
+
+ while List.Count > 0 do
+ begin
+ ShiftedList.Clear;
+ i := 0;
+ if not Report.EngineOptions.EnableThreadSafe then
+{$IFDEF MSWINDOWS}
+ Application.ProcessMessages;
+{$ELSE}
+ Application.DoIdle(bIDLE);
+{$ENDIF}
+ if Report.Terminated then Break;
+
+ while i < List.Count do
+ begin
+ View := List[i];
+ Corr := 0;
+ SavedHeight := View.Height;
+ HasNextPart := False;
+ { call DrawPart above to proceess /page tag in rich object }
+ if View is TfrxStretcheable then
+ begin
+ { Save object top for streched object }
+ StrView := List[i];
+ StrView.FSavedTop := StrView.Top;
+ StrView.Height := CurHeight - StrView.Top;
+ StrView.SetFastCanvas(TfrxFastCanvaslayer(FFastCanvas));
+
+ if StrView.Top < CurHeight then
+ { trying to place it }
+ { DrawPart method returns the amount of unused space. If view
+ can't fit in the height, this method returns the Height }
+ Corr := StrView.DrawPart;
+ StrView.SetFastCanvas(nil);
+ SavedHeight := StrView.FSaveHeight;
+ { check: does object has new part of data independently from it size}
+ HasNextPart := StrView.HasNextDataPart;
+ end;
+
+ { whole object fits in the page }
+ if (View.Top + SavedHeight <= CurHeight) and not HasNextPart then
+ begin
+ View.Height := SavedHeight;
+ { add to band and remove from list }
+ Band.Objects.Add(View);
+ List.Remove(View);
+ continue;
+ end;
+
+ if View is TfrxStretcheable then
+ begin
+ StrView := List[i];
+
+ { view is inside draw area }
+ if StrView.Top < CurHeight then
+ begin
+ ShiftObjects(StrView, Corr);
+
+ if Abs(Corr - StrView.Height) < 1e-4 then
+ begin
+ { view can't fit, return back the height and correct the top }
+ StrView.Top := CurHeight;
+ { shift the underlying objects down }
+ StrView.Height := StrView.FSaveHeight;
+ end
+ else
+ begin
+ { view can draw something }
+ Band.Objects.Add(StrView);
+ { decrease the remained height }
+ StrView.FSaveHeight := StrView.FSaveHeight - StrView.Height + Corr;
+ ObjStretch := True;
+ end;
+
+ end;
+ end
+ else
+ begin
+ { non-stretcheable view can't be splitted, draw it in the next page }
+ if View.Height > PageHeight - FooterHeight then
+ begin
+ { add to band and remove from list }
+ Band.Objects.Add(View);
+ List.Remove(View);
+ { prepare last part of text }
+ continue;
+ end
+ else if View.Top < CurHeight then
+ begin
+ { shift the underlying objects down }
+ ShiftObjects(View, CurHeight - View.Top);
+ View.Top := CurHeight;
+ end;
+ end;
+
+ Inc(i);
+ end;
+
+ { draw the visible part }
+ CalcBandHeight;
+ DrawPart;
+ CurHeight := FreeSpace;
+ end;
+
+ { get objects back to the band }
+ Band.Objects.Clear;
+ for i := 0 to SaveObjects.Count - 1 do
+ Band.Objects.Add(SaveObjects[i]);
+
+ List.Free;
+ SaveObjects.Free;
+ ShiftedList.Free;
+end;
+
+procedure TfrxEngine.CheckSuppress(Band: TfrxBand);
+var
+ i: Integer;
+ c: TfrxComponent;
+ hasSuppress: Boolean;
+begin
+ hasSuppress := False;
+ for i := 0 to Band.Objects.Count - 1 do
+ begin
+ c := Band.Objects[i];
+ if (c is TfrxCustomMemoView) and TfrxCustomMemoView(c).SuppressRepeated then
+ begin
+ hasSuppress := True;
+ TfrxCustomMemoView(c).ResetSuppress;
+ end;
+ end;
+
+ if hasSuppress and not Band.FHasVBands then
+ begin
+ UnStretch(Band);
+ CurLine := Band.FLineN;
+ CurLineThrough := Band.FLineThrough;
+ SecondScriptCall := True;
+ try
+ Stretch(Band);
+ finally
+ SecondScriptCall := False;
+ end;
+ end;
+end;
+
+procedure TfrxEngine.DoShow(Band: TfrxBand);
+var
+ IsMultiColumnBand, IsSplit: Boolean;
+ TempBand: TfrxBand;
+ SaveCurX: Extended;
+ SavePageList: TList;
+ SaveVMasterBand: TfrxBand;
+ i: Integer;
+
+ procedure RenderVBand;
+ var
+ i, j, SavePageN: Integer;
+ SaveCurY: Extended;
+ c: TfrxComponent;
+ SaveObjects: TList;
+ begin
+ SaveObjects := TList.Create;
+ SavePageN := PreviewPages.CurPage;
+ SaveCurY := CurY;
+ { the next NewPage call shouldn't form a new page }
+ PreviewPages.AddPageAction := apWriteOver;
+
+ { save hband objects }
+ for i := 0 to FVMasterBand.Objects.Count - 1 do
+ SaveObjects.Add(FVMasterBand.Objects[i]);
+
+ for i := 0 to FVPageList.Count - 2 do
+ begin
+ FVMasterBand.Objects.Clear;
+ for j := Integer(FVPageList[i]) to Integer(FVPageList[i + 1]) - 1 do
+ begin
+ c := SaveObjects[j];
+ FVMasterBand.Objects.Add(c);
+ end;
+ PreviewPages.AddObject(FVMasterBand);
+
+ if i <> FVPageList.Count - 2 then
+ begin
+ FDontShowHeaders := True;
+ NewPage;
+ FDontShowHeaders := False;
+ end
+ else
+ EndPage;
+ end;
+
+ { restore hband objects }
+ FVMasterBand.Objects.Clear;
+ for i := 0 to SaveObjects.Count - 1 do
+ FVMasterBand.Objects.Add(SaveObjects[i]);
+ SaveObjects.Free;
+
+ PreviewPages.CurPage := SavePageN;
+ CurY := SaveCurY;
+ CurX := SaveCurX;
+ { the next NewPage call should form a new page }
+ PreviewPages.AddPageAction := apAdd;
+ end;
+
+ procedure AddVBand;
+ var
+ i: Integer;
+ c, c1: TfrxReportComponent;
+ begin
+ if Band is TfrxDataBand then
+ CurVColumn := CurVColumn + 1;
+ if (Band is TfrxFooter) or (Band is TfrxGroupFooter) then
+ FCurBand := Band
+ else
+ FCurBand := FVMasterBand;
+
+ { fire beforeprint }
+ Report.CurObject := Band.Name;
+ Band.BeforePrint;
+ Report.DoBeforePrint(Band);
+
+ if Band.Visible then
+ begin
+ if CurX + Band.Width > PageWidth then
+ if FPage.EndlessWidth then
+ PageWidth := PageWidth + Band.Width
+ else
+ begin
+ {need for correct Page calculation when move VBand to the next page}
+ with PreviewPages do
+ begin
+ if Count - 1 <= CurPage then
+ AddPage(FPage)
+ else
+ CurPage := CurPage + 1;
+ end;
+ CurX := 0;
+ FVPageList.Add(Pointer(FVMasterBand.Objects.Count));
+ { reprint headers }
+ for i := 0 to FVHeaderList.Count - 1 do
+ ShowBand(TfrxBand(FVHeaderList[i]));
+ end;
+
+ { find objects that intersect with vertical Band }
+ for i := 0 to Band.Objects.Count - 1 do
+ begin
+ c := Band.Objects[i];
+ if THackComponent(c).FOriginalBand = FVMasterBand then
+ begin
+ { fire beforeprint and getdata }
+ Report.CurObject := c.Name;
+ c.BeforePrint;
+ Report.DoBeforePrint(c);
+ c.GetData;
+ Report.DoNotifyEvent(c, c.OnAfterData);
+
+ { copy the object }
+ c1 := TfrxReportComponent(c.NewInstance);
+ c1.Create(FVMasterBand);
+ c1.Assign(c);
+ with THackComponent(c1) do
+ begin
+ FAliasName := THackComponent(c).FAliasName;
+ FOriginalComponent := THackComponent(c).FOriginalComponent;
+ end;
+ c1.Left := c1.Left + CurX;
+
+ { restore the object's state }
+ c.AfterPrint;
+ end;
+ end;
+
+ CurX := CurX + Band.Width;
+ end;
+
+ { fire afterprint }
+ Report.CurObject := Band.Name;
+ Report.DoAfterPrint(Band);
+ Band.AfterPrint;
+
+ if Band is TfrxDataBand then
+ FAggregates.AddValue(FVMasterBand, CurVColumn);
+
+ { reset aggregates }
+ if (Band is TfrxFooter) or (Band is TfrxGroupFooter) then
+ FAggregates.Reset(Band);
+ end;
+
+begin
+ SavePageList := nil;
+ SaveVMasterBand := nil;
+
+ { make cross-bands }
+ if Band.FHasVBands and not (Band is TfrxPageHeader) then
+ begin
+ SaveCurX := CurX;
+ { fire onbeforeprint }
+ Report.CurObject := Band.Name;
+ Band.BeforePrint;
+ Report.DoBeforePrint(Band);
+ { show vertical bands }
+ ShowVBands(Band);
+ CurX := 0;
+ { restore Line variables}
+ CurLine := Band.FLineN;
+ CurLineThrough := Band.FLineThrough;
+ { the next NewPage call should form a new page }
+ PreviewPages.AddPageAction := apAdd;
+
+ { save global variables - FVPageList and FVMasterBand }
+ { they may be changed in the NewPage call, if cross has a h-header }
+ { with ReprintOnNewPage option }
+ SavePageList := TList.Create;
+ for i := 0 to FVPageList.Count - 1 do
+ SavePageList.Add(FVPageList[i]);
+ SaveVMasterBand := FVMasterBand;
+ end;
+
+ { show one vertical band }
+ if Band.Vertical then
+ begin
+ AddVBand;
+ Exit;
+ end;
+
+ IsMultiColumnBand := (Band is TfrxDataBand) and (TfrxDataBand(Band).Columns > 1);
+ IsSplit := False;
+
+ { check for StartNewPage flag }
+ if not FCallFromAddPage then
+ if Band.Visible then { don't process invisible bands }
+ if Band.StartNewPage then
+ if FOutputTo = nil then
+ if not (((Band is TfrxDataBand) or (Band is TfrxGroupHeader)) and (Band.FLineN = 1)) then
+ begin
+ FStartNewPageBand := Band;
+ if (Band is TfrxGroupHeader) and (TfrxGroupHeader(Band).ResetPageNumbers) then
+ PreviewPages.ResetLogicalPageNumber;
+ NewPage;
+ FStartNewPageBand := nil;
+ end;
+
+ Stretch(Band);
+ Band.FStretchedHeight := Band.Height;
+ try
+ if Band.Visible then
+ begin
+ { if band has columns, print all columns in one page. Page feed will be
+ performed after the last column }
+ if not IsMultiColumnBand and not (Band is TfrxOverlay) and not (Band is TfrxNullBand) and
+ (Band.Height > FreeSpace) then
+ if FOutputTo = nil then
+ if (Band.AllowSplit and not FKeeping) or
+ ((Band.Height > PageHeight - FooterHeight) and not band.FHasVBands) then
+ begin
+ if (not Band.AllowSplit) and (Band.FLineThrough > 1) and (not Band.StartNewPage) then
+ begin
+ FCurBand := Band;
+ NewColumn;
+ end;
+ if FKeeping then
+ EndKeep(Band);
+ DrawSplit(Band);
+ IsSplit := True;
+ end
+ else
+ begin
+ if not FKeeping then
+ CheckSuppress(Band);
+ if not((Band is TfrxChild) and FCallFromPHeader) then {endless loop fix}
+ NewColumn;
+ end;
+
+ if not IsSplit then
+ begin
+ if not (Band is TfrxNullBand) then
+ begin
+ { multicolumn band manages its Left property itself }
+ if IsMultiColumnBand then
+ begin
+ Band.Left := Band.Left + CurX;
+ {if (TfrxDataBand(Band).CurColumn = 1) and (Band.Height > FreeSpace) then
+ begin
+ FCurBand := Band;
+ NewColumn;
+ // FSaveCurY := CurY;
+ end;}
+ end
+ else
+ Band.Left := CurX;
+ Band.Top := CurY;
+ end;
+
+ { output the band }
+ if FOutputTo = nil then
+ begin
+ if (Band.FHasVBands) and not (Band is TfrxPageHeader) then
+ begin
+ { restore global variables - FVPageList and FVMasterBand }
+ { they may be changed in the NewPage call, if cross has a h-header }
+ { with ReprintOnNewPage option }
+ FVPageList.Clear;
+ for i := 0 to SavePageList.Count - 1 do
+ FVPageList.Add(SavePageList[i]);
+ SavePageList.Free;
+ FVMasterBand := SaveVMasterBand;
+ Band.Left := 0;
+ RenderVBand;
+ end
+ else if (not FCallFromAddPage) or (not PreviewPages.BandExists(Band)) then
+ PreviewPages.AddObject(Band)
+ end
+ else
+ begin
+ TempBand := TfrxBand.Create(FOutputTo);
+ TempBand.AssignAll(Band, True);
+ end;
+
+ { move the current position }
+ CurY := CurY + Band.Height;
+ end;
+ end;
+ finally
+ UnStretch(Band);
+ end;
+
+ { reset aggregate values }
+// if (Band is TfrxFooter) or (Band is TfrxGroupFooter) or
+// (Band is TfrxPageFooter) or (Band is TfrxReportSummary) then
+ FAggregates.Reset(Band);
+
+ { print subreports contained in this band }
+ if Band.Visible then
+ CheckSubReports(Band);
+end;
+
+procedure TfrxEngine.CheckSubReports(Band: TfrxBand);
+var
+ i, SavePageN, SaveColumnN: Integer;
+ SaveCurX, SaveCurY, SavePageCurX: Extended;
+ HaveSub: Boolean;
+ Sub: TfrxSubreport;
+ MaxPageN, MaxColumnN: Integer;
+ MaxCurY: Extended;
+begin
+ { save the current position }
+ HaveSub := False;
+ SavePageN := PreviewPages.CurPage;
+ SaveColumnN := CurColumn;
+ SaveCurX := CurX;
+ SaveCurY := CurY;
+ SavePageCurX := FPageCurX;
+
+ { init max position }
+ MaxPageN := SavePageN; //0
+ MaxColumnN := SaveColumnN; //0
+ MaxCurY := SaveCurY; //0
+
+ { looking for subreport objects }
+ for i := 0 to Band.Objects.Count - 1 do
+ if TObject(Band.Objects[i]) is TfrxSubreport then
+ begin
+ Sub := TfrxSubreport(Band.Objects[i]);
+ if not Sub.Visible or Sub.PrintOnParent then continue;
+ HaveSub := True;
+
+ { set up all properties... }
+ PreviewPages.CurPage := SavePageN;
+ FPageCurX := SavePageCurX + Sub.Left;
+ CurColumn := SaveColumnN;
+ CurX := SaveCurX + Sub.Left;
+ CurY := SaveCurY - Band.FStretchedHeight + Sub.Top; //SaveCurY - Sub.Height;
+ { ...and run the subreport }
+ RunPage(Sub.Page);
+
+ { calc max position }
+ if PreviewPages.CurPage > MaxPageN then
+ begin
+ MaxPageN := PreviewPages.CurPage;
+ MaxColumnN := CurColumn;
+ MaxCurY := CurY;
+ end
+ else if PreviewPages.CurPage = MaxPageN then
+ if CurColumn > MaxColumnN then
+ begin
+ MaxColumnN := CurColumn;
+ MaxCurY := CurY;
+ end
+ else if CurColumn = MaxColumnN then
+ if CurY > MaxCurY then
+ MaxCurY := CurY;
+ end;
+
+ { move the current position to the last generated page }
+ if HaveSub then
+ begin
+ PreviewPages.CurPage := MaxPageN;
+ CurColumn := MaxColumnN;
+ CurX := SavePageCurX;
+ if CurColumn > 1 then
+ CurX := CurX + frxStrToFloat(FPage.ColumnPositions[CurColumn - 1]) * fr01cm;
+ CurY := MaxCurY;
+ FPageCurX := SavePageCurX;
+ end;
+end;
+
+procedure TfrxEngine.StartKeep(Band: TfrxBand; Position: Integer = 0);
+begin
+ if FKeeping or FIsFirstBand then Exit;
+
+ FKeepCurY := CurY;
+ FKeeping := True;
+ FKeepBand := Band;
+ if Position = 0 then
+ Position := PreviewPages.GetCurPosition;
+ FKeepPosition := Position;
+ FKeepOutline := PreviewPages.Outline.GetCurPosition;
+ FKeepAnchor := PreviewPages.GetAnchorCurPosition;
+ FAggregates.StartKeep;
+end;
+
+procedure TfrxEngine.EndKeep(Band: TfrxBand);
+begin
+ if FKeepBand = Band then
+ begin
+ FKeepCurY := 0;
+ FKeeping := False;
+ FKeepBand := nil;
+ FAggregates.EndKeep;
+ FKeepHeader := False;
+ end;
+end;
+
+function TfrxEngine.GetAggregateValue(const Name, Expression: String;
+ Band: TfrxBand; Flags: Integer): Variant;
+begin
+ Result := FAggregates.GetValue(FCurBand, CurVColumn, Name, Expression, Band, Flags);
+end;
+
+procedure TfrxEngine.AddBandOutline(Band: TfrxBand);
+var
+ pos: Integer;
+begin
+ if Band.OutlineText <> '' then
+ begin
+ Report.CurObject := Band.Name;
+ if Band.Stretched then
+ pos := Round(CurY - Band.FStretchedHeight)
+ else
+ pos := Round(CurY - Band.Height);
+ if Band.Visible then
+ PreviewPages.Outline.AddItem(VarToStr(Report.Calc(Band.OutlineText)), pos);
+ end;
+end;
+
+procedure TfrxEngine.AddPageOutline;
+begin
+ if FPage.OutlineText <> '' then
+ begin
+ OutlineRoot;
+ Report.CurObject := FPage.Name;
+ PreviewPages.Outline.AddItem(VarToStr(Report.Calc(FPage.OutlineText)), 0);
+ end;
+end;
+
+procedure TfrxEngine.OutlineRoot;
+begin
+ PreviewPages.Outline.LevelRoot;
+end;
+
+procedure TfrxEngine.OutlineUp(Band: TfrxBand);
+begin
+ if Band.OutlineText <> '' then
+ PreviewPages.Outline.LevelUp;
+end;
+
+
+function TfrxEngine.GetPageHeight: Double;
+begin
+ if (FPage <> nil) and FPage.EndlessHeight then
+ Result := CurY + FooterHeight
+ else
+ Result := inherited GetPageHeight;
+end;
+
+end.
diff --git a/LibD28x64/FMX.frxEvaluateForm.fmx b/LibD28x64/FMX.frxEvaluateForm.fmx
new file mode 100644
index 0000000..7ae9afe
--- /dev/null
+++ b/LibD28x64/FMX.frxEvaluateForm.fmx
@@ -0,0 +1,57 @@
+object frxEvaluateForm: TfrxEvaluateForm
+ Left = 0
+ Top = 0
+ Caption = 'Evaluate'
+ ClientHeight = 163
+ ClientWidth = 281
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object Label1: TLabel
+ Position.Point = '(4,4)'
+ Width = 52.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object Label2: TLabel
+ Position.Point = '(4,52)'
+ Width = 30.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 1
+ end
+ object ExpressionE: TEdit
+ Position.Point = '(4,20)'
+ Width = 273.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 2
+ KeyboardType = vktDefault
+ Password = False
+ end
+ object ResultM: TMemo
+ Position.Point = '(4,68)'
+ Width = 273.000000000000000000
+ Height = 89.000000000000000000
+ TabOrder = 3
+ KeyboardType = vktDefault
+ end
+ object OkB: TButton
+ Position.Point = '(120,56)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ Visible = False
+ TabOrder = 4
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(200,56)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ Visible = False
+ TabOrder = 5
+ ModalResult = 2
+ Cancel = True
+ end
+end
diff --git a/LibD28x64/FMX.frxEvaluateForm.pas b/LibD28x64/FMX.frxEvaluateForm.pas
new file mode 100644
index 0000000..6283f6d
--- /dev/null
+++ b/LibD28x64/FMX.frxEvaluateForm.pas
@@ -0,0 +1,109 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ Evaluate dialog }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Tzyganenko, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxEvaluateForm;
+
+interface
+
+{$I frx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.fs_iinterpreter, FMX.Layouts, FMX.Memo, FMX.Edit, FMX.Types, System.Variants
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF};
+
+type
+ TfrxEvaluateForm = class(TForm)
+ Label1: TLabel;
+ ExpressionE: TEdit;
+ Label2: TLabel;
+ ResultM: TMemo;
+ OkB: TButton;
+ CancelB: TButton;
+ procedure FormShow(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ private
+ FScript: TfsScript;
+ FIsWatch: Boolean;
+ public
+ property IsWatch: Boolean read FIsWatch write FIsWatch;
+ property Script: TfsScript read FScript write FScript;
+ end;
+
+
+implementation
+
+{$R *.FMX}
+
+uses FMX.frxRes;
+
+
+procedure TfrxEvaluateForm.FormShow(Sender: TObject);
+begin
+ ExpressionE.SelectAll;
+ ResultM.Text := '';
+ if IsWatch then
+ begin
+ OkB.Visible := True;
+ CancelB.Visible := True;
+ ResultM.Visible := False;
+ Label2.Visible := False;
+ ClientHeight := Round(OkB.Position.Y + OkB.Height + 4);
+ end;
+end;
+
+procedure TfrxEvaluateForm.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(5500);
+ Label1.Text := frxGet(5501);
+ Label2.Text := frxGet(5502);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ FormShow(Self);
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxEvaluateForm.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+var
+ v: Variant;
+ s: String;
+begin
+ if IsWatch then Exit;
+ if Key = vkReturn then
+ begin
+ v := FScript.Evaluate(ExpressionE.Text);
+ s := VarToStr(v);
+ if TVarData(v).VType = varBoolean then
+ if Boolean(v) = True then
+ s := 'True' else
+ s := 'False'
+ else if (TVarData(v).VType = varString) or (TVarData(v).VType = varOleStr)
+ or (TVarData(v).VType = varOleStr) then
+ s := '''' + v + ''''
+ else if v = Null then
+ s := 'Null';
+ ResultM.Text := s;
+ ExpressionE.SelectAll;
+ end
+ else if Key = VKESCAPE then
+ Close;
+ //if Key = VKESCAPE then
+ // ModalResult := mrCancel;
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+end.
diff --git a/LibD28x64/FMX.frxExportCSV.fmx b/LibD28x64/FMX.frxExportCSV.fmx
new file mode 100644
index 0000000..73001da
--- /dev/null
+++ b/LibD28x64/FMX.frxExportCSV.fmx
@@ -0,0 +1,110 @@
+object frxCSVExportDialog: TfrxCSVExportDialog
+ Left = 0
+ Top = 0
+ Caption = 'Export to CSV'
+ ClientHeight = 261
+ ClientWidth = 277
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ ActiveControl = OkB
+ StyleLookup = 'backgroundstyle'
+ object OkB: TButton
+ Position.Point = '(118,228)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 0
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(198,228)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 1
+ ModalResult = 2
+ Cancel = True
+ end
+ object GroupPageRange: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 269.000000000000000000
+ Height = 141.000000000000000000
+ TabOrder = 2
+ object DescrL: TLabel
+ Position.Point = '(12,82)'
+ Width = 249.000000000000000000
+ Height = 47.000000000000000000
+ TabOrder = 0
+ end
+ object AllRB: TRadioButton
+ Position.Point = '(12,20)'
+ Width = 153.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 108
+ TabOrder = 1
+ IsChecked = True
+ end
+ object CurPageRB: TRadioButton
+ Position.Point = '(12,40)'
+ Width = 153.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 118
+ TabOrder = 2
+ end
+ object PageNumbersRB: TRadioButton
+ Position.Point = '(12,60)'
+ Width = 77.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 124
+ TabOrder = 3
+ end
+ object PageNumbersE: TEdit
+ Position.Point = '(92,58)'
+ Width = 165.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 133
+ TabOrder = 4
+ KeyboardType = vktDefault
+ OnChange = PageNumbersEChange
+ Password = False
+ end
+ end
+ object GroupQuality: TGroupBox
+ Position.Point = '(4,144)'
+ Width = 269.000000000000000000
+ Height = 53.000000000000000000
+ TabOrder = 3
+ object SeparatorLB: TLabel
+ Position.Point = '(137,21)'
+ Width = 76.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object OEMCB: TCheckBox
+ Position.Point = '(12,20)'
+ Width = 121.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ object SeparatorE: TEdit
+ Position.Point = '(224,16)'
+ Width = 33.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 2
+ KeyboardType = vktDefault
+ Password = False
+ end
+ end
+ object OpenCB: TCheckBox
+ Position.Point = '(16,200)'
+ Width = 253.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 4
+ end
+ object SaveDialog1: TSaveDialog
+ DefaultExt = '.txt'
+ Filter = 'CSV file (*.csv)|*.csv'
+ Options = [ofHideReadOnly, ofNoChangeDir, ofEnableSizing]
+ end
+end
diff --git a/LibD28x64/FMX.frxExportCSV.pas b/LibD28x64/FMX.frxExportCSV.pas
new file mode 100644
index 0000000..42a9188
--- /dev/null
+++ b/LibD28x64/FMX.frxExportCSV.pas
@@ -0,0 +1,593 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ CSV export }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Fediachov, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+{ The specification of the CSV document file format
+ can be downloaded from here:
+
+ http://www.rfc-editor.org/rfc/rfc4180.txt }
+
+unit FMX.frxExportCSV;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, System.UITypes, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.frxExportMatrix, FMX.Edit, FMX.Types
+, System.Variants, FMX.Controls, FMX.frxBaseModalForm
+{$IFDEF DELPHI18}
+ , FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+type
+ TfrxCSVExportDialog = class(TfrxForm)
+ OkB: TButton;
+ CancelB: TButton;
+ SaveDialog1: TSaveDialog;
+ GroupPageRange: TGroupBox;
+ DescrL: TLabel;
+ AllRB: TRadioButton;
+ CurPageRB: TRadioButton;
+ PageNumbersRB: TRadioButton;
+ PageNumbersE: TEdit;
+ GroupQuality: TGroupBox;
+ OpenCB: TCheckBox;
+ OEMCB: TCheckBox;
+ SeparatorLB: TLabel;
+ SeparatorE: TEdit;
+ procedure FormCreate(Sender: TObject);
+ procedure PageNumbersEChange(Sender: TObject);
+ procedure PageNumbersEKeyPress(Sender: TObject; var Key: Char);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+ end;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxCSVExport = class(TfrxCustomExportFilter)
+ private
+
+ FMatrix: TfrxIEMatrix;
+ FOpenAfterExport: Boolean;
+ Exp: TStream;
+ FPage: TfrxReportPage;
+ FOEM: Boolean;
+ FSeparator: String;
+ FNoSysSymbols: Boolean;
+ FForcedQuotes: Boolean;
+
+ procedure ExportPage(Stream: TStream);
+
+ public
+
+ constructor Create(AOwner: TComponent); override;
+ class function GetDescription: String; override;
+ function ShowModal: TModalResult; override;
+ function Start: Boolean; override;
+ procedure Finish; override;
+ procedure FinishPage(Page: TfrxReportPage; Index: Integer); override;
+ procedure StartPage(Page: TfrxReportPage; Index: Integer); override;
+ procedure ExportObject(Obj: TfrxComponent); override;
+
+ published
+
+ property Separator: String read FSeparator write FSeparator;
+ property OEMCodepage: Boolean read FOEM write FOEM;
+ property OpenAfterExport: Boolean read FOpenAfterExport write FOpenAfterExport default False;
+ property OverwritePrompt;
+
+ { CSV export can ignore exporting of special system characters
+ from original strings in the report. The special characters are
+ all characters with ASCII codes $00..$1F. }
+
+ property NoSysSymbols: Boolean read FNoSysSymbols write FNoSysSymbols; {default True}
+
+ { Specification of CSV format allows to leave some fields to be unquoted.
+ The ForcedQuotes option allows to enclose all fields in double quotes. }
+
+ property ForcedQuotes: Boolean read FForcedQuotes write FForcedQuotes; {default False}
+
+ end;
+
+
+implementation
+
+uses FMX.frxUtils, {FMX.frxFileUtils,} FMX.frxUnicodeUtils, FMX.frxRes, FMX.frxFMX, FMX.frxrcExports
+{$IFDEF MSWINDOWS}
+, Winapi.ShellAPI, Winapi.Windows
+{$ENDIF}
+{$IFDEF LINUX}
+ ,FMUX.Api
+{$ENDIF}
+{$IFDEF MACOS}
+, Posix.Stdlib
+{$ENDIF};
+
+{$R *.FMX}
+
+
+function AnsiPos(const Substr, S: AnsiString): Integer;
+var
+ P: PAnsiChar;
+begin
+ Result := 0;
+ P := AnsiStrPos(PAnsiChar(S), PAnsiChar(SubStr));
+ if P <> nil then
+ Result := frxInteger(P) - frxInteger(PAnsiChar(S)) + 1;
+end;
+
+ function StringReplace(const S, OldPattern, NewPattern: AnsiString;
+ Flags: TReplaceFlags): AnsiString;
+var
+ SearchStr, Patt, NewStr: AnsiString;
+ Offset: Integer;
+begin
+ if rfIgnoreCase in Flags then
+ begin
+ SearchStr := AnsiString(AnsiUpperCase(String(S)));
+ Patt := AnsiString(AnsiUpperCase(String(OldPattern)));
+ end else
+ begin
+ SearchStr := S;
+ Patt := OldPattern;
+ end;
+ NewStr := S;
+ Result := '';
+ while SearchStr <> '' do
+ begin
+ Offset := AnsiPos(Patt, SearchStr);
+ if Offset = 0 then
+ begin
+ Result := Result + NewStr;
+ Break;
+ end;
+ Result := Result + Copy(NewStr, 1, Offset - 1) + NewPattern;
+ NewStr := Copy(NewStr, Offset + Length(OldPattern), MaxInt);
+ if not (rfReplaceAll in Flags) then
+ begin
+ Result := Result + NewStr;
+ Break;
+ end;
+ SearchStr := Copy(SearchStr, Offset + Length(Patt), MaxInt);
+ end;
+end;
+
+
+{ TfrxCSVExport }
+
+constructor TfrxCSVExport.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FOEM := False;
+ FSeparator := FormatSettings.ListSeparator;
+ FNoSysSymbols := True;
+ FilterDesc := frxGet(8851);
+ DefaultExt := frxGet(8852);
+end;
+
+class function TfrxCSVExport.GetDescription: String;
+begin
+ Result := frxResources.Get('CSVExport');
+end;
+
+procedure TfrxCSVExport.ExportPage(Stream: TStream);
+var
+ x, y: Integer;
+ Obj: TfrxIEMObject;
+ s: AnsiString;
+
+ { Before a byte string can be written to an output CSV document,
+ it must be prepaired as follows:
+
+ 1. text with special characters must be enclosed in double quotes
+ 2. if the text contains double quotes and was enclosed in double quotes,
+ its double quotes must be escaped by double quotes
+ 3. append the text by a separator (usually it's ";" or ",") }
+
+ function PrepareString(const Str: AnsiString): AnsiString;
+
+ { Returns count of a character within a byte string }
+
+ function CharCount(const s: AnsiString; c: AnsiChar): Integer;
+ var
+ i: Integer;
+ begin
+ Result := 0;
+
+ for i := 1 to Length(s) do
+ if s[i] = c then
+ Inc(Result);
+ end;
+
+ { Copies a source byte string to a destination byte string.
+ A specified character is copied twice. }
+
+ procedure DoubleCharacter(r: PAnsiChar; const s: AnsiString; c: AnsiChar);
+ var
+ si, ri: Integer;
+
+ procedure PushChar(c: AnsiChar);
+ begin
+ PAnsiChar(frxInteger(r) + ri)^ := c;
+ Inc(ri);
+ end;
+
+ begin
+ ri := 0;
+
+ for si := 1 to Length(s) do
+ begin
+ PushChar(s[si]);
+
+ if s[si] = c then
+ PushChar(s[si]);
+ end;
+ end;
+
+ { This routine finds special characters in a byte string.
+ If characters were found, the result is true, otherwise
+ the result is false.
+
+ Special characters are:
+
+ a) all characters with codes 00..31
+ b) the double quote character "
+ c) a specified character in the 2-nd argument }
+
+ function FindSpecChar(const s: AnsiString; c: AnsiChar): Boolean;
+ var
+ i: Integer;
+ begin
+ for i := 1 to Length(s) do
+ if (s[i] = c) or (Ord(s[i]) < 32) or (s[i] = '"') then
+ begin
+ Result := True;
+ Exit;
+ end;
+
+ Result := False;
+ end;
+
+ { Removes system symbols and returns a count of characters in
+ the cleaned up string. System symbols are characters with codes 0..31. }
+
+ function CleanSysSymbols(var s: AnsiString): Integer;
+ var
+ i, j: Integer;
+ begin
+ j := 1;
+
+ for i := 1 to Length(s) do
+ if Ord(s[i]) > 31 then
+ begin
+ s[j] := s[i];
+ Inc(j);
+ end;
+
+ Result := j - 1;
+ end;
+
+ var
+ s: AnsiString; // buffer
+ len: LongWord; // Length(Str)
+ qn: LongWord; // Count of the quote characters in Str
+ sep: AnsiChar;
+ begin
+
+ { FSeparator must never be empty,
+ but if it's empty, the export must not
+ crash }
+
+ if FSeparator = '' then
+ sep := AnsiChar(FormatSettings.ListSeparator)
+ else
+ sep := AnsiChar(FSeparator[1]);
+
+ if Str = '' then
+ begin
+ Result := sep;
+ Exit;
+ end;
+
+ { Convert to the OEM codepage if it needs }
+
+ if FOEM then
+ s := Str // todo oem
+ else
+ s := Str;
+
+ len := Length(s);
+
+ { Suppress ending trash }
+
+ if (len >= 2) and (s[len] = #10) and (s[len - 1] = #13) then
+ begin
+ Dec(len, 2);
+ SetLength(s, len);
+ end;
+
+ { Remove system symbols if it needs. }
+
+ if (len > 0) and NoSysSymbols then
+ begin
+ len := CleanSysSymbols(s);
+ SetLength(s, len);
+ end;
+
+ if len = 0 then
+ begin
+ Result := sep;
+ Exit;
+ end;
+
+ { If the text has no special characters,
+ it can be written directly to the output CSV
+ document }
+
+ if not FindSpecChar(s, sep) then
+ begin
+ if not ForcedQuotes then
+ Result := s + sep
+ else
+ begin
+ SetLength(Result, Length(s) + 3);
+ Result[1] := '"';
+ Result[2 + Length(s)] := '"';
+ Result[3 + Length(s)] := sep;
+ Move(s[1], Result[2], Length(s));
+ end;
+
+ Exit;
+ end;
+
+ { If the text contains special characters,
+ escape all double quotes with additional double quotes and
+ enclose the text in double quotes }
+
+ qn := CharCount(s, '"');
+ SetLength(Result, len + qn + 3);
+
+ Result[1] := '"';
+ Result[2 + qn + len] := '"';
+ Result[3 + qn + len] := sep;
+
+ DoubleCharacter(@Result[2], s, '"');
+ end;
+
+var
+ eoln: Word;
+ n: Integer;
+begin
+ FMatrix.Prepare;
+ eoln := $0a0d;
+
+ for y := 0 to FMatrix.Height - 2 do
+ begin
+ n := 0;
+
+ for x := 0 to FMatrix.Width - 1 do
+ begin
+ Obj := FMatrix.GetObject(x, y);
+ if Obj = nil then Continue;
+ Inc(n);
+
+ if Obj.Counter = 0 then
+ begin
+ s := AnsiString(Obj.Memo.Text);
+ s := PrepareString(s);
+ Stream.Write(s[1], Length(s));
+ Obj.Counter := 1;
+ end
+ else
+ begin
+ s := AnsiString(FSeparator);
+ Stream.Write(s[1], Length(s));
+ end;
+ end;
+
+ { this removes the last separator symbol }
+
+ if n > 0 then
+ Stream.Seek(Int64(-1), soFromCurrent);
+
+ Stream.Write(eoln, 2);
+ end;
+end;
+
+function TfrxCSVExport.ShowModal: TModalResult;
+begin
+ if not Assigned(Stream) then
+ begin
+ with TfrxCSVExportDialog.Create(nil) do
+ begin
+ OpenCB.Visible := not SlaveExport;
+ if OverwritePrompt then
+ SaveDialog1.Options := SaveDialog1.Options + [TOpenOption.ofOverwritePrompt];
+ if SlaveExport then
+ FOpenAfterExport := False;
+
+ if (FileName = '') and (not SlaveExport) then
+ SaveDialog1.FileName := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(Report.FileName)), SaveDialog1.DefaultExt)
+ else
+ SaveDialog1.FileName := FileName;
+
+ OpenCB.IsChecked := FOpenAfterExport;
+ OEMCB.IsChecked := FOEM;
+ SeparatorE.Text := FSeparator;
+
+ if PageNumbers <> '' then
+ begin
+ PageNumbersE.Text := PageNumbers;
+ PageNumbersRB.IsChecked := True;
+ end;
+
+ Result := ShowModal;
+ PeekLastModalResult;
+ if Result = mrOk then
+ begin
+ PageNumbers := '';
+ CurPage := False;
+ if CurPageRB.IsChecked then
+ CurPage := True
+ else if PageNumbersRB.IsChecked then
+ PageNumbers := PageNumbersE.Text;
+
+ FOpenAfterExport := OpenCB.IsChecked;
+ FOEM := OEMCB.IsChecked;
+ FSeparator := SeparatorE.Text;
+
+ if not SlaveExport then
+ begin
+ if DefaultPath <> '' then
+ SaveDialog1.InitialDir := DefaultPath;
+ if SaveDialog1.Execute then
+ FileName := SaveDialog1.FileName
+ else
+ Result := mrCancel;
+ PeekLastModalResult;
+ end;
+ end;
+ Free;
+ end;
+ end else
+ Result := mrOk;
+end;
+
+function TfrxCSVExport.Start: Boolean;
+begin
+ if SlaveExport then
+ begin
+ if Report.FileName <> '' then
+ FileName := ChangeFileExt(GetTemporaryFolder + ExtractFileName(Report.FileName), frxGet(8852))
+ else
+ FileName := ChangeFileExt(GetTempFile, frxGet(8852))
+ end;
+ if (FileName <> '') or Assigned(Stream) then
+ begin
+ if (ExtractFilePath(FileName) = '') and (DefaultPath <> '') then
+ FileName := DefaultPath + '\' + FileName;
+ FMatrix := TfrxIEMatrix.Create(UseFileCache, Report.EngineOptions.TempDir);
+ FMatrix.Background := False;
+ FMatrix.BackgroundImage := False;
+ FMatrix.Printable := ExportNotPrintable;
+ FMatrix.RichText := True;
+ FMatrix.PlainRich := True;
+ FMatrix.AreaFill := False;
+ FMatrix.CropAreaFill := True;
+ FMatrix.Inaccuracy := 0.5;
+ FMatrix.DeleteHTMLTags := True;
+ FMatrix.Images := False;
+ FMatrix.WrapText := True;
+ FMatrix.ShowProgress := False;
+ FMatrix.FramesOptimization := True;
+ try
+ if Assigned(Stream) then
+ Exp := Stream
+ else
+ Exp := TFileStream.Create(FileName, fmCreate);
+ Result := True;
+ except
+ Result := False;
+ end;
+ end
+ else
+ Result := False;
+end;
+
+procedure TfrxCSVExport.StartPage(Page: TfrxReportPage; Index: Integer);
+begin
+ FMatrix.Clear;
+end;
+
+procedure TfrxCSVExport.ExportObject(Obj: TfrxComponent);
+begin
+ if Obj is TfrxView then
+ FMatrix.AddObject(TfrxView(Obj));
+end;
+
+procedure TfrxCSVExport.FinishPage(Page: TfrxReportPage; Index: Integer);
+begin
+ FPage := Page;
+ ExportPage(Exp);
+end;
+
+procedure TfrxCSVExport.Finish;
+begin
+ FMatrix.Free;
+ if not Assigned(Stream) then
+ Exp.Free;
+ //if FOpenAfterExport and (not Assigned(Stream)) then
+ // ShellExecute(GetDesktopWindow, 'open', PChar(FileName), nil, nil, SW_SHOW);
+ if FOpenAfterExport and (not Assigned(Stream)) then
+ {$IFDEF MSWINDOWS}
+ ShellExecute(0, 'open', PChar(FileName), '', '', 5);
+ {$ENDIF}
+ {$IFDEF LINUX}
+ FmuxOpenFile(PChar(FileName));
+ {$ENDIF}
+ {$IFDEF MACOS}
+ ShellExecute(FileName);
+ {$ENDIF}
+end;
+
+{ TfrxCSVExportDialog }
+
+procedure TfrxCSVExportDialog.FormCreate(Sender: TObject);
+begin
+ Caption := frxGet(8850);
+ OkB.Text := frxGet(1);
+ CancelB.Text := frxGet(2);
+ GroupPageRange.Text := frxGet(7);
+ AllRB.Text := frxGet(3);
+ CurPageRB.Text := frxGet(4);
+ PageNumbersRB.Text := frxGet(5);
+ DescrL.Text := frxGet(9);
+ GroupQuality.Text := frxGet(8302);
+ OEMCB.Text := frxGet(8304);
+ OpenCB.Text := frxGet(8706);
+ SaveDialog1.Filter := frxGet(8851);
+ SaveDialog1.DefaultExt := frxGet(8852);
+ SeparatorLB.Text := frxGet(8853);
+{$IFDEF LINUX}
+ BorderStyleSizeable(Self);
+{$ENDIF}
+ //if UseRightToLeftAlignment then
+ // FlipChildren(True);
+end;
+
+procedure TfrxCSVExportDialog.PageNumbersEChange(Sender: TObject);
+begin
+ PageNumbersRB.IsChecked := True;
+end;
+
+procedure TfrxCSVExportDialog.PageNumbersEKeyPress(Sender: TObject;
+ var Key: Char);
+begin
+ case key of
+ '0'..'9':;
+ #8, '-', ',':;
+ else
+ key := #0;
+ end;
+end;
+
+procedure TfrxCSVExportDialog.FormKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
+begin
+ if Key = VKF1 then
+ frxResources.Help(Self);
+end;
+
+end.
diff --git a/LibD28x64/FMX.frxExportHTML.fmx b/LibD28x64/FMX.frxExportHTML.fmx
new file mode 100644
index 0000000..8f7db1e
--- /dev/null
+++ b/LibD28x64/FMX.frxExportHTML.fmx
@@ -0,0 +1,171 @@
+object frxHTMLExportDialog: TfrxHTMLExportDialog
+ Left = 0
+ Top = 0
+ Caption = 'Export to HTML'
+ ClientHeight = 318
+ ClientWidth = 290
+ Position = poScreenCenter
+ Visible = False
+ OnCreate = FormCreate
+ OnKeyDown = FormKeyDown
+ StyleLookup = 'backgroundstyle'
+ object GroupQuality: TGroupBox
+ Position.Point = '(4,144)'
+ Width = 281.000000000000000000
+ Height = 109.000000000000000000
+ TabOrder = 0
+ object PicturesL: TLabel
+ Position.Point = '(12,84)'
+ Width = 73.000000000000000000
+ Height = 13.000000000000000000
+ TabOrder = 0
+ end
+ object StylesCB: TCheckBox
+ Position.Point = '(12,20)'
+ Width = 129.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 1
+ end
+ object PicsSameCB: TCheckBox
+ Position.Point = '(12,40)'
+ Width = 129.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 2
+ end
+ object FixWidthCB: TCheckBox
+ Position.Point = '(144,20)'
+ Width = 129.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 3
+ end
+ object NavigatorCB: TCheckBox
+ Position.Point = '(12,60)'
+ Width = 129.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 4
+ end
+ object MultipageCB: TCheckBox
+ Position.Point = '(144,40)'
+ Width = 129.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 5
+ end
+ object BackgrCB: TCheckBox
+ Position.Point = '(144,60)'
+ Width = 129.000000000000000000
+ Height = 17.000000000000000000
+ TabOrder = 6
+ end
+ object PFormatCB: TComboBox
+ Position.Point = '(88,80)'
+ Width = 181.000000000000000000
+ Height = 21.000000000000000000
+ TabOrder = 7
+ ItemIndex = -1
+ ItemHeight = 13.000000000000000000
+ object ListBoxItem1: TListBoxItem
+ Position.Point = '(5000,5000)'
+ Width = 19.000000000000000000
+ Height = 19.000000000000000000
+ HitTest = False
+ TabOrder = 0
+ Text = 'None'
+ end
+ object ListBoxItem2: TListBoxItem
+ Position.Point = '(5000,5000)'
+ Width = 19.000000000000000000
+ Height = 19.000000000000000000
+ HitTest = False
+ TabOrder = 1
+ Text = 'JPEG'
+ end
+ object ListBoxItem3: TListBoxItem
+ Position.Point = '(5000,5000)'
+ Width = 19.000000000000000000
+ Height = 19.000000000000000000
+ HitTest = False
+ TabOrder = 2
+ Text = 'BMP'
+ end
+ object ListBoxItem4: TListBoxItem
+ Position.Point = '(5000,5000)'
+ Width = 19.000000000000000000
+ Height = 19.000000000000000000
+ HitTest = False
+ TabOrder = 3
+ Text = 'GIF'
+ end
+ end
+ end
+ object GroupPageRange: TGroupBox
+ Position.Point = '(4,4)'
+ Width = 281.000000000000000000
+ Height = 141.000000000000000000
+ TabOrder = 1
+ object DescrL: TLabel
+ Position.Point = '(12,82)'
+ Width = 249.000000000000000000
+ Height = 47.000000000000000000
+ TabOrder = 0
+ end
+ object AllRB: TRadioButton
+ Position.Point = '(12,20)'
+ Width = 153.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 108
+ TabOrder = 1
+ IsChecked = True
+ end
+ object CurPageRB: TRadioButton
+ Position.Point = '(12,40)'
+ Width = 153.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 118
+ TabOrder = 2
+ end
+ object PageNumbersRB: TRadioButton
+ Position.Point = '(12,60)'
+ Width = 77.000000000000000000
+ Height = 17.000000000000000000
+ HelpContext = 124
+ TabOrder = 3
+ end
+ object PageNumbersE: TEdit
+ Position.Point = '(92,58)'
+ Width = 177.000000000000000000
+ Height = 21.000000000000000000
+ HelpContext = 133
+ TabOrder = 4
+ KeyboardType = vktDefault
+ OnChange = PageNumbersEChange
+ Password = False
+ end
+ end
+ object OpenAfterCB: TCheckBox
+ Position.Point = '(12,260)'
+ Width = 257.000000000000000000
+ Height = 17.000000000000000000
+ Visible = False
+ TabOrder = 2
+ end
+ object OkB: TButton
+ Position.Point = '(130,288)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 3
+ ModalResult = 1
+ Default = True
+ end
+ object CancelB: TButton
+ Position.Point = '(210,288)'
+ Width = 75.000000000000000000
+ Height = 25.000000000000000000
+ TabOrder = 4
+ ModalResult = 2
+ Cancel = True
+ end
+ object SaveDialog1: TSaveDialog
+ FilterIndex = 0
+ Options = [ofHideReadOnly, ofNoChangeDir, ofEnableSizing]
+ end
+end
diff --git a/LibD28x64/FMX.frxExportHTML.pas b/LibD28x64/FMX.frxExportHTML.pas
new file mode 100644
index 0000000..4376db6
--- /dev/null
+++ b/LibD28x64/FMX.frxExportHTML.pas
@@ -0,0 +1,1244 @@
+
+{******************************************}
+{ }
+{ FastReport v4.0 }
+{ HTML table export filter }
+{ }
+{ Copyright (c) 1998-2008 }
+{ by Alexander Fediachov, }
+{ Fast Reports Inc. }
+{ }
+{******************************************}
+
+unit FMX.frxExportHTML;
+
+interface
+
+{$I fmx.inc}
+{$I frx.inc}
+{$I fmx.inc}
+
+uses
+ System.SysUtils, System.Classes, FMX.Types, System.UITypes, FMX.Controls, FMX.Forms, FMX.Dialogs,
+ FMX.frxClass, FMX.frxExportMatrix, FMX.frxProgress, fmx.frxImageConverter, System.UIConsts,
+ System.Variants, FMX.Edit, FMX.ListBox, FMX.frxBaseModalForm
+{$IFDEF DELPHI18}
+ ,FMX.StdCtrls
+{$ENDIF}
+{$IFDEF DELPHI19}
+ , FMX.Graphics
+{$ENDIF};
+
+type
+ TfrxHTMLExportDialog = class(TfrxForm)
+ SaveDialog1: TSaveDialog;
+ GroupQuality: TGroupBox;
+ StylesCB: TCheckBox;
+ PicsSameCB: TCheckBox;
+ FixWidthCB: TCheckBox;
+ NavigatorCB: TCheckBox;
+ MultipageCB: TCheckBox;
+ GroupPageRange: TGroupBox;
+ DescrL: TLabel;
+ AllRB: TRadioButton;
+ CurPageRB: TRadioButton;
+ PageNumbersRB: TRadioButton;
+ PageNumbersE: TEdit;
+ OpenAfterCB: TCheckBox;
+ OkB: TButton;
+ CancelB: TButton;
+ BackgrCB: TCheckBox;
+ PicturesL: TLabel;
+ PFormatCB: TComboBox;
+ ListBoxItem1: TListBoxItem;
+ ListBoxItem2: TListBoxItem;
+ ListBoxItem3: TListBoxItem;
+ ListBoxItem4: TListBoxItem;
+ procedure FormCreate(Sender: TObject);
+ procedure PageNumbersEChange(Sender: TObject);
+ procedure PageNumbersEKeyPress(Sender: TObject; var Key: Char);
+ procedure FormKeyDown(Sender: TObject; var Key: Word;
+ var KeyChar: WideChar; Shift: TShiftState);
+ end;
+
+ TfrxHTMLExportGetNavTemplate = procedure(const ReportName: String;
+ Multipage: Boolean; PicsInSameFolder: Boolean; Prefix: String;
+ TotalPages: Integer; var Template: String) of object;
+
+ TfrxHTMLExportGetMainTemplate = procedure(const Title: String;
+ const FrameFolder: String;
+ Multipage: Boolean; var Template: String) of object;
+
+{$I frxFMX_PlatformsAttribute.inc}
+ TfrxHTMLExport = class(TfrxCustomExportFilter)
+ private
+ Exp: TStream;
+ FAbsLinks: Boolean;
+ FCurrentPage: Integer;
+ FExportPictures: Boolean;
+ FExportStyles: Boolean;
+ FFixedWidth: Boolean;
+ FMatrix: TfrxIEMatrix;
+ FMozillaBrowser: Boolean;
+ FMultipage: Boolean;
+ FNavigator: Boolean;
+ FOpenAfterExport: Boolean;
+ FPicsInSameFolder: Boolean;
+ FPicturesCount: Integer;
+ FProgress: TfrxProgress;
+ FServer: Boolean;
+ FPrintLink: String;
+ FRefreshLink: String;
+ FBackground: Boolean;
+ FBackImage: TBitmap;
+ FBackImageExist: Boolean;
+ FReportPath: String;
+ FCentered: Boolean;
+ FEmptyLines: Boolean;
+ FURLTarget: String;
+ FPictureType: TfrxPictureType;
+
+// FAvExports: String;
+// FSession: String;
+ FPrint: Boolean;
+
+ FUseTemplates: Boolean;
+ FGetNavTemplate: TfrxHTMLExportGetNavTemplate;
+ FGetMainTemplate: TfrxHTMLExportGetMainTemplate;
+
+ FHTMLDocumentBegin: TStrings;
+ FHTMLDocumentBody: TStrings;
+ FHTMLDocumentEnd: TStrings;
+
+ procedure WriteExpLn(const str: String);
+ procedure WriteExpLnA(const str: AnsiString);
+ procedure ExportPage;
+ function ChangeReturns(const Str: String): String;
+ function TruncReturns(const Str: WideString): WideString;
+ function GetPicsFolder: String;
+ function GetPicsFolderRel: String;
+ function GetFrameFolder: String;
+ function ReverseSlash(const S: String): String;
+ function HTMLCodeStr(const Str: String): String;
+ public
+ constructor Create(AOwner: TComponent); override;
+ destructor Destroy; override;
+ function ShowModal: TModalResult; override;
+ function Start: Boolean; override;
+ procedure Finish; override;
+ procedure FinishPage(Page: TfrxReportPage; Index: Integer); override;
+ procedure StartPage(Page: TfrxReportPage; Index: Integer); override;
+ procedure ExportObject(Obj: TfrxComponent); override;
+ class function GetDescription: String; override;
+ property Server: Boolean read FServer write FServer;
+ property PrintLink: String read FPrintLink write FPrintLink;
+ property RefreshLink: String read FRefreshLink write FRefreshLink;
+ property ReportPath: String read FReportPath write FReportPath;
+
+ property UseTemplates: Boolean read FUseTemplates write FUseTemplates;
+ property OnGetMainTemplate: TfrxHTMLExportGetMainTemplate read FGetMainTemplate
+ write FGetMainTemplate;
+ property OnGetNavTemplate: TfrxHTMLExportGetNavTemplate read FGetNavTemplate
+ write FGetNavTemplate;
+ published
+ property OpenAfterExport: Boolean read FOpenAfterExport write FOpenAfterExport default False;
+ property FixedWidth: Boolean read FFixedWidth write FFixedWidth default False;
+ property ExportPictures: Boolean read FExportPictures write FExportPictures default True;
+ property PicsInSameFolder: Boolean read FPicsInSameFolder write FPicsInSameFolder default False;
+ property ExportStyles: Boolean read FExportStyles write FExportStyles default True;
+ property Navigator: Boolean read FNavigator write FNavigator default False;
+ property Multipage: Boolean read FMultipage write FMultipage default False;
+ property MozillaFrames: Boolean read FMozillaBrowser write FMozillaBrowser default False;
+ property AbsLinks: Boolean read FAbsLinks write FAbsLinks default False;
+ property Background: Boolean read FBackground write FBackground;
+ property Centered: Boolean read FCentered write FCentered;
+ property EmptyLines: Boolean read FEmptyLines write FEmptyLines;
+ property OverwritePrompt;
+ property HTMLDocumentBegin: TStrings read FHTMLDocumentBegin;
+ property HTMLDocumentBody: TStrings read FHTMLDocumentBody;
+ property HTMLDocumentEnd: TStrings read FHTMLDocumentEnd;
+ property URLTarget: String read FURLTarget write FURLTarget;
+ property Print: Boolean read FPrint write FPrint;
+ property PictureType: TfrxPictureType read FPictureType write FPictureType;
+ end;
+
+
+implementation
+
+uses FMX.frxUtils, {FMX.frxFileUtils,} FMX.frxUnicodeUtils, FMX.frxRes, FMX.frxrcExports, System.Math, FMX.frxGraphicUtils, FMX.frxFMX
+ {$IFDEF MSWINDOWS}
+ , Winapi.ShellAPI
+ {$ENDIF}
+ {$IFDEF LINUX}
+ ,FMUX.Api
+ {$ENDIF};
+
+{$R *.fmx}
+
+const
+ Xdivider = 1;
+ Ydivider = 1.03;
+ Navigator_src =
+ ''#13#10 +
+ '' +
+ '' +
+ '' +
+ ''#13#10 +
+ ''#13#10 +
+ '';
+ Server_sect =
+ '
'#13#10 +
+ '
'#13#10;
+ DefPrint = 'parent.mainFrame.focus(); parent.mainFrame.print();';
+ LinkPrint = 'parent.location = "%s";';
+ DefRefresh = 'parent.location = "result?report=" + frRepName + "&multipage=" + frMultipage;';
+ LinkRefresh = 'parent.location = "%s";';
+
+{ TfrxHTMLExport }
+
+constructor TfrxHTMLExport.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FExportPictures := True;
+ FExportStyles := True;
+ FFixedWidth := True;
+ FServer := False;
+ FPrintLink := '';
+ FBackground := False;
+ FCentered := False;
+ FBackImage := TBitmap.Create(0, 0);
+ FilterDesc := frxGet(8210);
+ DefaultExt := frxGet(8211);
+ FEmptyLines := True;
+ Files := TStringList.Create;
+ FUseTemplates := False;
+ FHTMLDocumentBegin := TStringList.Create;
+ FHTMLDocumentBegin.Add('');
+ FHTMLDocumentBegin.Add('');
+ FHTMLDocumentBegin.Add('');
+ FHTMLDocumentBegin.Add('');
+ FHTMLDocumentBody := TStringList.Create;
+ FHTMLDocumentEnd := TStringList.Create;
+ FHTMLDocumentEnd.Add('');
+ FURLTarget := '';
+ FPrint := false;
+end;
+
+class function TfrxHTMLExport.GetDescription: String;
+begin
+ Result := frxResources.Get('HTMLexport');
+end;
+
+function TfrxHTMLExport.TruncReturns(const Str: WideString): WideString;
+var
+ l: Integer;
+begin
+ l := Length(Str);
+ if (l > 1) and (Str[l - 1] = #13) and (Str[l] = #10) then
+ Result := Copy(Str, 1, l - 2)
+ else
+ Result := Str;
+end;
+
+function TfrxHTMLExport.ChangeReturns(const Str: string): string;
+
+ function Hex(x: Byte): string;
+ const
+ d: string = '0123456789abcdef';
+ begin
+ Result := d[1 + x div 16] + d[1 + x mod 16];
+ end;
+
+ function HexColor(x: TColor): string;
+ var
+ r, g, b: Byte;
+ begin
+ r := x and 255;
+ g := (x shr 8) and 255;
+ b := (x shr 16) and 255;
+
+ Result := Hex(r) + Hex(g) + Hex(b);
+ end;
+
+ function EscapeSymbols(s: string): string;
+ var
+ i: Integer;
+ c: string;
+ begin
+ Result := '';
+
+ for i := 1 to Length(s) do
+ begin
+ c := s[i];
+
+ case s[i] of
+ '<': c := '<';
+ '>': c := '>';
+ '&': c := '&';
+ '"': c := '"';
+ #13: c := '';
+ #10:
+ if (i > 1) and (s[i - 1] = #13) then
+ c := ' ';
+ end;
+
+ Result := Result + c;
+ end;
+ end;
+
+ { function TaggedStr(s: string; t: TfrxHTMLTag): string;
+ begin
+ s := EscapeSymbols(s);
+
+ if fsBold in t.Style then
+ s := '' + s + '';
+
+ if fsItalic in t.Style then
+ s := '' + s + '';
+
+ if fsUnderline in t.Style then
+ s := '' + s + '';
+
+ if fsStrikeOut in t.Style then
+ s := '' + s + '';
+
+ if t.Color <> 0 then
+ s := '' + s + '';
+
+ Result := s;
+ end; }
+
+{var
+ i, j: Integer;
+ ht: TfrxHTMLTagsList;
+ LastTag, Tag: TfrxHTMLTag;
+ s: WideString;}
+begin
+{ s := Str;
+
+ ht := TfrxHTMLTagsList.Create;
+ ht.AllowTags := True;
+ ht.ExpandHTMLTags(s);
+
+ LastTag := nil;
+ s := '';
+ Result := '';
+
+ for i := 0 to ht.Count - 1 do
+ for j := 0 to ht[i].Count - 1 do
+ begin
+ Tag := ht[i][j];
+
+ if (LastTag <> nil) and ((LastTag.Style <> Tag.Style) or (LastTag.Color <> Tag.Color)) then
+ begin
+ Result := Result + TaggedStr(s, LastTag);
+ s := '';
+ end;
+
+ s := s + Str[Tag.Position + 1];
+ LastTag := Tag;
+ end;
+
+
+ if s <> '' then
+ Result := Result + TaggedStr(s, LastTag);
+
+ ht.Free; }
+ //todo
+ Result := Str;
+end;
+
+procedure TfrxHTMLExport.WriteExpLn(const str: String);
+var
+ TempStr: AnsiString;
+begin
+ TempStr := UTF8Encode(str);
+ Exp.Write(TempStr[1], Length(TempStr));
+ Exp.Write(AnsiChar(#13)+AnsiChar(#10), 2);
+end;
+
+procedure TfrxHTMLExport.WriteExpLnA(const str: AnsiString);
+begin
+ Exp.Write(str[1], Length(str));
+ Exp.Write(AnsiChar(#13)+AnsiChar(#10), 2);
+end;
+
+procedure TfrxHTMLExport.ExportPage;
+var
+ i, x, y, dx, dy, fx, fy, pbk: Integer;
+ dcol, drow: Integer;
+ text, buff: String;
+ s, s1, sb, si, su: String;
+ Vert, Horiz: String;
+ obj: TfrxIEMObject;
+ EStyle: TfrxIEMStyle;
+ St: String;
+ hlink, newpage: Boolean;
+ tableheader, columnWidths: String;
+
+ procedure AlignFR2AlignExcel(HAlign: TfrxHAlign; VAlign: TfrxVAlign;
+ var AlignH, AlignV: String);
+ begin
+ if HAlign = haLeft then
+ AlignH := 'Left'
+ else if HAlign = haRight then
+ AlignH := 'Right'
+ else if HAlign = haCenter then
+ AlignH := 'Center'
+ else if HAlign = haBlock then
+ AlignH := 'Justify'
+ else
+ AlignH := '';
+ if VAlign = vaTop then
+ AlignV := 'Top'
+ else if VAlign = vaBottom then
+ AlignV := 'Bottom'
+ else if VAlign = vaCenter then
+ AlignV := 'Middle'
+ else
+ AlignV := '';
+ end;
+
+begin
+ WriteExpLn(FHTMLDocumentBegin.Text);
+ if FPrint then
+ WriteExpLn('');
+ if Length(Report.ReportOptions.Name) > 0 then
+ s := Report.ReportOptions.Name
+ else
+ s := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(Report.FileName)), '');
+ WriteExpLnA('' + UTF8Encode(s) + '');
+
+ if FExportStyles then
+ begin
+ WriteExpLn('');
+ end;
+ WriteExpLn('');
+ WriteExpLn('');
+ WriteExpLn(FHTMLDocumentBody.Text);
+ WriteExpLn('');
+ if FFixedWidth then
+ st := ' width="' + IntToStr(Round((FMatrix.MaxWidth - FMatrix.Left) / Xdivider)) + '"'
+ else
+ st := '';
+ if FCentered then
+ st := st + ' align="center"';
+ tableheader := '');
+
+ columnWidths := '
';
+ for x := 0 to FMatrix.Width - 2 do
+ begin
+ dcol := Round((FMatrix.GetXPosById(x + 1) - FMatrix.GetXPosById(x)) / Xdivider);
+ columnWidths := columnWidths + '
';
+ end;
+ if FMatrix.Width < 2 then
+ columnWidths := columnWidths + '
';
+ columnWidths := columnWidths + '
';
+ WriteExpLn(columnWidths);
+
+ pbk := 0;
+ st := '';
+ newpage := False;
+
+ for y := 0 to FMatrix.Height - 2 do
+ begin
+ if ShowProgress and (not FMultipage) then
+ if FProgress.Terminated then
+ break;
+ drow := Round((FMatrix.GetYPosById(y + 1) - FMatrix.GetYPosById(y)) / Ydivider);
+ s := '';
+ if FMatrix.PagesCount > pbk then
+ if Round(FMatrix.GetPageBreak(pbk)) <= Round(FMatrix.GetYPosById(y + 1)) then
+ begin
+ Inc(pbk);
+ if ShowProgress and (not FMultipage) then
+ FProgress.Tick;
+ newpage := True;
+ end;
+ if drow = 0 then
+ drow := 1;
+ WriteExpLn('
'#13#10;
+ DefPrint = 'parent.mainFrame.focus(); parent.mainFrame.print();';
+ LinkPrint = 'parent.location = "%s";';
+ DefRefresh = 'parent.location = "result?report=" + frRepName + "&multipage=" + frMultipage;';
+ LinkRefresh = 'parent.location = "%s";';
+
+{ TfrxHTMLExport }
+
+constructor TfrxHTMLExport.Create(AOwner: TComponent);
+begin
+ inherited Create(AOwner);
+ FExportPictures := True;
+ FExportStyles := True;
+ FFixedWidth := True;
+ FServer := False;
+ FPrintLink := '';
+ FBackground := False;
+ FCentered := False;
+ FBackImage := TBitmap.Create(0, 0);
+ FilterDesc := frxGet(8210);
+ DefaultExt := frxGet(8211);
+ FEmptyLines := True;
+ Files := TStringList.Create;
+ FUseTemplates := False;
+ FHTMLDocumentBegin := TStringList.Create;
+ FHTMLDocumentBegin.Add('');
+ FHTMLDocumentBegin.Add('');
+ FHTMLDocumentBegin.Add('');
+ FHTMLDocumentBegin.Add('');
+ FHTMLDocumentBody := TStringList.Create;
+ FHTMLDocumentEnd := TStringList.Create;
+ FHTMLDocumentEnd.Add('');
+ FURLTarget := '';
+ FPrint := false;
+end;
+
+class function TfrxHTMLExport.GetDescription: String;
+begin
+ Result := frxResources.Get('HTMLexport');
+end;
+
+function TfrxHTMLExport.TruncReturns(const Str: WideString): WideString;
+var
+ l: Integer;
+begin
+ l := Length(Str);
+ if (l > 1) and (Str[l - 1] = #13) and (Str[l] = #10) then
+ Result := Copy(Str, 1, l - 2)
+ else
+ Result := Str;
+end;
+
+function TfrxHTMLExport.ChangeReturns(const Str: string): string;
+
+ function Hex(x: Byte): string;
+ const
+ d: string = '0123456789abcdef';
+ begin
+ Result := d[1 + x div 16] + d[1 + x mod 16];
+ end;
+
+ function HexColor(x: TColor): string;
+ var
+ r, g, b: Byte;
+ begin
+ r := x and 255;
+ g := (x shr 8) and 255;
+ b := (x shr 16) and 255;
+
+ Result := Hex(r) + Hex(g) + Hex(b);
+ end;
+
+ function EscapeSymbols(s: string): string;
+ var
+ i: Integer;
+ c: string;
+ begin
+ Result := '';
+
+ for i := 1 to Length(s) do
+ begin
+ c := s[i];
+
+ case s[i] of
+ '<': c := '<';
+ '>': c := '>';
+ '&': c := '&';
+ '"': c := '"';
+ #13: c := '';
+ #10:
+ if (i > 1) and (s[i - 1] = #13) then
+ c := ' ';
+ end;
+
+ Result := Result + c;
+ end;
+ end;
+
+ { function TaggedStr(s: string; t: TfrxHTMLTag): string;
+ begin
+ s := EscapeSymbols(s);
+
+ if fsBold in t.Style then
+ s := '' + s + '';
+
+ if fsItalic in t.Style then
+ s := '' + s + '';
+
+ if fsUnderline in t.Style then
+ s := '' + s + '';
+
+ if fsStrikeOut in t.Style then
+ s := '' + s + '';
+
+ if t.Color <> 0 then
+ s := '' + s + '';
+
+ Result := s;
+ end; }
+
+{var
+ i, j: Integer;
+ ht: TfrxHTMLTagsList;
+ LastTag, Tag: TfrxHTMLTag;
+ s: WideString;}
+begin
+{ s := Str;
+
+ ht := TfrxHTMLTagsList.Create;
+ ht.AllowTags := True;
+ ht.ExpandHTMLTags(s);
+
+ LastTag := nil;
+ s := '';
+ Result := '';
+
+ for i := 0 to ht.Count - 1 do
+ for j := 0 to ht[i].Count - 1 do
+ begin
+ Tag := ht[i][j];
+
+ if (LastTag <> nil) and ((LastTag.Style <> Tag.Style) or (LastTag.Color <> Tag.Color)) then
+ begin
+ Result := Result + TaggedStr(s, LastTag);
+ s := '';
+ end;
+
+ s := s + Str[Tag.Position + 1];
+ LastTag := Tag;
+ end;
+
+
+ if s <> '' then
+ Result := Result + TaggedStr(s, LastTag);
+
+ ht.Free; }
+ //todo
+ Result := Str;
+end;
+
+procedure TfrxHTMLExport.WriteExpLn(const str: String);
+var
+ TempStr: AnsiString;
+begin
+ TempStr := UTF8Encode(str);
+ Exp.Write(TempStr[1], Length(TempStr));
+ Exp.Write(AnsiChar(#13)+AnsiChar(#10), 2);
+end;
+
+procedure TfrxHTMLExport.WriteExpLnA(const str: AnsiString);
+begin
+ Exp.Write(str[1], Length(str));
+ Exp.Write(AnsiChar(#13)+AnsiChar(#10), 2);
+end;
+
+procedure TfrxHTMLExport.ExportPage;
+var
+ i, x, y, dx, dy, fx, fy, pbk: Integer;
+ dcol, drow: Integer;
+ text, buff: String;
+ s, s1, sb, si, su: String;
+ Vert, Horiz: String;
+ obj: TfrxIEMObject;
+ EStyle: TfrxIEMStyle;
+ St: String;
+ hlink, newpage: Boolean;
+ tableheader, columnWidths: String;
+
+ procedure AlignFR2AlignExcel(HAlign: TfrxHAlign; VAlign: TfrxVAlign;
+ var AlignH, AlignV: String);
+ begin
+ if HAlign = haLeft then
+ AlignH := 'Left'
+ else if HAlign = haRight then
+ AlignH := 'Right'
+ else if HAlign = haCenter then
+ AlignH := 'Center'
+ else if HAlign = haBlock then
+ AlignH := 'Justify'
+ else
+ AlignH := '';
+ if VAlign = vaTop then
+ AlignV := 'Top'
+ else if VAlign = vaBottom then
+ AlignV := 'Bottom'
+ else if VAlign = vaCenter then
+ AlignV := 'Middle'
+ else
+ AlignV := '';
+ end;
+
+begin
+ WriteExpLn(FHTMLDocumentBegin.Text);
+ if FPrint then
+ WriteExpLn('');
+ if Length(Report.ReportOptions.Name) > 0 then
+ s := Report.ReportOptions.Name
+ else
+ s := ChangeFileExt(ExtractFileName(frxUnixPath2WinPath(Report.FileName)), '');
+ WriteExpLnA('' + UTF8Encode(s) + '');
+
+ if FExportStyles then
+ begin
+ WriteExpLn('');
+ end;
+ WriteExpLn('');
+ WriteExpLn('');
+ WriteExpLn(FHTMLDocumentBody.Text);
+ WriteExpLn('');
+ if FFixedWidth then
+ st := ' width="' + IntToStr(Round((FMatrix.MaxWidth - FMatrix.Left) / Xdivider)) + '"'
+ else
+ st := '';
+ if FCentered then
+ st := st + ' align="center"';
+ tableheader := '');
+
+ columnWidths := '
';
+ for x := 0 to FMatrix.Width - 2 do
+ begin
+ dcol := Round((FMatrix.GetXPosById(x + 1) - FMatrix.GetXPosById(x)) / Xdivider);
+ columnWidths := columnWidths + '
';
+ end;
+ if FMatrix.Width < 2 then
+ columnWidths := columnWidths + '
';
+ columnWidths := columnWidths + '
';
+ WriteExpLn(columnWidths);
+
+ pbk := 0;
+ st := '';
+ newpage := False;
+
+ for y := 0 to FMatrix.Height - 2 do
+ begin
+ if ShowProgress and (not FMultipage) then
+ if FProgress.Terminated then
+ break;
+ drow := Round((FMatrix.GetYPosById(y + 1) - FMatrix.GetYPosById(y)) / Ydivider);
+ s := '';
+ if FMatrix.PagesCount > pbk then
+ if Round(FMatrix.GetPageBreak(pbk)) <= Round(FMatrix.GetYPosById(y + 1)) then
+ begin
+ Inc(pbk);
+ if ShowProgress and (not FMultipage) then
+ FProgress.Tick;
+ newpage := True;
+ end;
+ if drow = 0 then
+ drow := 1;
+ WriteExpLn('